Is the memory not reclaimed for Delphi apps running on Windows Server 2008 (sp1)?

Question

We have a D2007 application whose memory footprint grows steadily when running on Windows Server 2008 (x64, sp1).
It behaves normally on Windows Server 2003 (x32 or x64)

Answer 1

There is a new sysinternals tool called VMMap which visualizes the allocated memory. Maybe it could show you what the big memory blocks are.

Answer 2

Actually, Microsoft made a change to the Critical Sections to add some debug information. This debug memory is not released until the end of the application but somehow cached and reused which is why after a while it can plateau.

The solution if you want to create a lot of Critical Sections without feeling this memory penalty is to patch the VCL code to replace calls to InitializeCriticalSection by calls to InitializeCriticalSectionEx and pass it the flag CRITICAL_SECTION_NO_DEBUG_INFO to avoid the creation of the debug structure.

Answer 3

Check if you have this issue (this is another issue, unrelated to the one, which I've mentioned in the comments to your question).

Answer 4

Are you referring to the Private Bytes, Virtual Size or the Working Set? Run Process Explorer from SysInternals to monitor the memory for a better idea of what is going on.

I don't have any specific experience with this (although I am running 2008 x64 SP1, so could test it) but I am going to suggest you create a test application that allocates a bunch of memory and then free it. Run Process Explorer from SysInternals to monitor the memory.

If you test application reproduces the same behavior then try creating some memory pressure by allocating memory in another process - so much that it will fail unless that previously freed memory in the first process is reclaimed.

If that continues to fail, then try a different memory manager. Maybe it is FastMM that is doing it.

Answer 5

Did you include FastMM with full debug mode? Just include the FastMM4 unit directly in your project and set

ReportMemoryLeaksOnShutdown := True

If there is nothing reported, maybe everything is normally freed on program exit (maybe because of reference counting). You could use AQTime to monitor memory in real time. With this application you can see the bytes "counting" for each class name and for rest of the used memory. Maybe you can see who uses the memory. The time limited demo version is enough for this job.

Answer 6

I did this code to correct this problem on my applications. Is the same case of FastCode, to make the fix run you must to put the unit as the first unit of your project. Like the uRedirecionamentos in this case:

unit uCriticalSectionFix;
// By Rodrigo F. Rezino - rodrigofrezino@gmail.com

interface

uses
  Windows;

implementation

uses
  SyncObjs, SysUtils;

type
  InitializeCriticalSectionExProc = function(var lpCriticalSection: TRTLCriticalSection; dwSpinCount: DWORD; Flags: DWORD): BOOL; stdcall;

var
  IsNewerThenXP: Boolean;
  InitializeCriticalSectionEx: InitializeCriticalSectionExProc;

type
  PJump = ^TJump;
  TJump = packed record
    OpCode: Byte;
    Distance: Pointer;
  end;

  TCriticalSectionHack = class(TSynchroObject)
  protected
    FSection: TRTLCriticalSection;
  public
    constructor Create;
  end;

function GetMethodAddress(AStub: Pointer): Pointer;
const
  CALL_OPCODE = $E8;
begin
  if PBYTE(AStub)^ = CALL_OPCODE then
  begin
    Inc(Integer(AStub));
    Result := Pointer(Integer(AStub) + SizeOf(Pointer) + PInteger(AStub)^);
  end
  else
    Result := nil;
end;

procedure AddressPatch(const ASource, ADestination: Pointer);
const
  JMP_OPCODE = $E9;
  SIZE = SizeOf(TJump);
var
  NewJump: PJump;
  OldProtect: Cardinal;
begin
  if VirtualProtect(ASource, SIZE, PAGE_EXECUTE_READWRITE, OldProtect) then
  begin
    NewJump := PJump(ASource);
    NewJump.OpCode := JMP_OPCODE;
    NewJump.Distance := Pointer(Integer(ADestination) - Integer(ASource) - 5);

    FlushInstructionCache(GetCurrentProcess, ASource, SizeOf(TJump));
    VirtualProtect(ASource, SIZE, OldProtect, @OldProtect);
  end;
end;

procedure OldCriticalSectionMethod;
asm
  call TCriticalSection.Create;
end;

{ TCriticalSectionHack }

const
  CRITICAL_SECTION_NO_DEBUG_INFO = $01000000;
  NEW_THEN_XP = 6;

constructor TCriticalSectionHack.Create;
begin
  inherited Create;
  if IsNewerThenXP then
    InitializeCriticalSectionEx(FSection, 0, CRITICAL_SECTION_NO_DEBUG_INFO)
  else
    InitializeCriticalSection(FSection);
end;

procedure AdjustMethod;
var
  LKernel32: HModule;
begin
  if IsNewerThenXP then
  begin
    LKernel32 := LoadLibrary('kernel32.dll');
    @InitializeCriticalSectionEx := GetProcAddress(LKernel32, 'InitializeCriticalSectionEx');
  end;
end;

initialization
  AddressPatch(GetMethodAddress(@OldCriticalSectionMethod), @TCriticalSectionHack.Create);
  IsNewerThenXP := CheckWin32Version(NEW_THEN_XP, 0);
  AdjustMethod;


end.