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:

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

    ReplyDelete
  2. 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.)

    ReplyDelete
  3. 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.

    ReplyDelete
  4. 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.

    ReplyDelete
  5. 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?

    ReplyDelete

Comments are moderated - spam and non-relevant links to will be deleted.