Tuesday, February 12, 2008

TDM#5: Slimming the Fat off Your Apps

I think that the best TDM article title I've had is Slimming the Fat off Your Apps. It was published in November 1998 and we're still in the Delphi 4 era (but as always many people were still using the older versions, D2 and D3).

The article intro said:

"Hallvard Vassbotn wants to slim the fat off your software: tune in here if you want [your programs] to be leaner and fitter..."

The core points of the article are:

  • The Windows NT family of operating systems reduce the apparent memory footprint of an application when you minimize it
  • The code for compiler-generated  initialization and finalization sections of units changed between D2 and D3 (to the better and worse)
  • The mechanism and code for invoking initialization and finalization sections changed markedly between D2 and D3
  • Initialization code is spread out through the EXE file - causing "heavy" memory usage after startup.
  • There is a trick to simulate the minimize-app memory "savings" in code (calling SetProcessWorkingSetSize)

In my opinion, the whole memory savings issue is a game of smoke and mirrors - no actual memory is saved, just the internal accounting and how pages are marked as belonging to an applications working set or not is affected. It may impress users looking at the mostly misleading memory usage in Task Manager, but it has no effect on the real memory pressure of the machine.

Here is the code (courtesy of Ray Nelson) for trimming the "fat":

unit TrimMem;
//
// Code courtesy of Roy Nelson (rnelson@inprise.com),
// Inprise European Professional Support
//
// Call TrimWorkingSet from you project file or from a package
// to reduce the memory overhead - note that this will only work
// on Windows NT.
//
// From Delphi Magazine article "Slimming the fat off your Apps"
// by Hallvard Vassbotn, hallvard@falcon.no
//
interface

procedure TrimWorkingSet;

implementation

uses
Windows,
SysUtils;

procedure TrimWorkingSet;
var
MainHandle : THandle;
begin
MainHandle := OpenProcess(PROCESS_ALL_ACCESS, false, GetCurrentProcessID);
SetProcessWorkingSetSize(MainHandle,DWORD(-1),DWORD(-1));
CloseHandle(MainHandle);
end;

end.

The full PDF article and code are available for download.

5 comments:

Anonymous said...

Guys, you rock. This can be done in one line:
if Win32Platform = VER_PLATFORM_WIN32_NT then SetProcessWorkingSetSize(GetCurrentProcess,DWord(-1),DWord(-1));

gabr42 said...

I recall this article very well - it helped us stabilize some memory intensive server. There were no leaks but plenty of allocations and deallocations and the machine running the server gradually crawled to a stop after two weeks because process' working set grew just too big. A SetProcessWorkingSetSize triggered once per hour fixed the problem.

(And then came FastMM4 and all such problems became a history.)

Roy Nelson said...

Hi Hallvard,

I changed the code a bit since then...
>>>>>>>>>>>>>>>>>>
unit WorkingAggr;

interface
const
WorkingSetTimeOut : Integer = 1000;
VeryAggressive : boolean = true;
AutoStartWSTrimming : boolean = true;

procedure StartWSWorkerThread;
procedure StopWSWorkerThread;

implementation
uses Windows,SysUtils;
var
WorkingSetID : DWORD = 0;
hWorkingSet : THandle = 0;
//lightweight criticalsection
SpinLock : integer = 1;


function WSWorkerThread(Parameter: Pointer): Integer;
var
FocusedProcID, CurProcID : THandle;
MainProcHandle : THandle;
PseudoTime : integer;
IsForeGroundApp : boolean;
AtStartUp : boolean;
LostForeGroundOnce : boolean;
begin
try
Result := 0;
MainProcHandle := 0;
CurProcID := GetCurrentProcessID;
AtStartUp := true;
IsForeGroundApp := true;
LostForeGroundOnce := false;
MainProcHandle := OpenProcess(PROCESS_SET_QUOTA, false,CurProcID);
if MainProcHandle <> 0 then
begin
try
while boolean(SpinLock) do
begin
PseudoTime := 0;
while boolean(SpinLock) and (WorkingSetTimeOut > PseudoTime) do
begin
Sleep(100);
Inc(PseudoTime,100);
end;
if not boolean(SpinLock) then Exit;
if (not VeryAggressive) then
begin
GetWindowThreadProcessId(GetForegroundWindow,@FocusedProcID);
//Check if this application is in the foreground
IsForeGroundApp := (CurProcID = FocusedProcID);
if IsForeGroundApp then
begin
//This will only hit at the start
LostForeGroundOnce := false;
if not AtStartUp then Continue;
AtStartUp := false;
end;
end;
//Trim that working set to the bone!!!!
if (IsForeGroundApp or AtStartUp) or (not LostForeGroundOnce) then
SetProcessWorkingSetSize(MainProcHandle,Cardinal(-1),Cardinal(-1));
LostForeGroundOnce := not IsForeGroundApp;
end;
finally
CloseHandle(MainProcHandle);
end;
end;
finally
EndThread(Result);
end;
end;

procedure StartWSWorkerThread;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then Exit;
if hWorkingSet = 0 then
hWorkingSet := BeginThread(nil, 0, @WSWorkerThread, nil, 0, WorkingSetID);
end;

procedure StopWSWorkerThread;
var
lpExitCode : DWORD;
begin
if hWorkingSet <> 0 then
begin
//Only do this once to reduce the load on the cache lines
InterlockedExchange(SpinLock,0); //signal that the thread must stop
lpExitCode := DWORD(-1);
//this code might not be needed when the application shuts down
//Force the calling thread to yield until the worker exits.
//So we can clean up the thread handle
while GetExitCodeThread(hWorkingSet,lpExitCode)
and (lpExitCode = STILL_ACTIVE) do Sleep(0);
CloseHandle(hWorkingSet);
hWorkingSet := 0;
SpinLock := 1;
end;
end;

initialization
if AutoStartWSTrimming then StartWSWorkerThread;
finalization
StopWSWorkerThread;
end.

>>>>>>>>>>>>>>>>>>


Roy.

lmiller7 said...

The SetProcessWorkingSetSize() function has legitimate uses, otherwise Microsoft would not have included it. But it must be used with care and understanding of what you are doing. Doing it simply to reduce memory usage as reported in Task Manager is not a good reason. The improvement will usually be cosmetic only with no improvement in performance or stability. NT platform memory management is very good, it is fully capable of reclaiming memory - when it is needed.

lexdean said...

Slimming the Fat off Your Apps,
I like the insight HALLVARD gave in raise and fall of TObject. But the creation of each descendant class creates a descendant class header that uses memory. And at the same time the memory of the abstract class is held by the complier only through the final descendant class header (educated guess hear). How can the Delphi complier see the memory it needs to hold for the final descendant class, thus removing abstract objects and simplifying coding at the same time. It also removes confusion saying TStringList when you want TStrings and simplifies large object creation.

If you can identify a descendant class header can you identify a specific type of byte in the last descendant as one way to over come the problem? Naturally the byte has to be missed if it’s not the last descendant. If we just wish to remove confusion alone can we place all methods into the abstract class with none in the final class?



Copyright © 2004-2007 by Hallvard Vassbotn