Some useful FastMM related methods to track memory usage

  

Below, for my link archive, some searches and relevant posts on FastMM related method calls to track or report memory usage.
Searches:

LogMemoryManagerStateToFile
FastGetHeapStatus {Returns summarised information about the state of the memory manager. (For
backward compatibility.)}
GetMemoryManagerState (InternalBlockSize, UseableBlockSize, AllocatedBlockCount, ReservedAddressSpace) {Returns statistics about the current state of the memory manager}GetMemoryManagerUsageSummary {Returns a summary of the information returned by GetMemoryManagerState}
GetMemoryMap {Non-POSIX only; Gets the state of every 64K block in the 4GB address space}
ScanMemoryPoolForCorruptions; {Scans the memory pool for any corruptions. If a corruption is encountered an “Out of Memory” exception is raised.}

It is very costly in CPU usage, but helps finding heap corruption quickly.

function GetCurrentAllocationGroup: Cardinal;

{Returns the current “allocation group”. Whenever a GetMem request is serviced
in FullDebugMode, the current “allocation group” is stored in the block header.
This may help with debugging. Note that if a block is subsequently reallocated
that it keeps its original “allocation group” and “allocation number” (all
allocations are also numbered sequentially).}

procedure PushAllocationGroup(ANewCurrentAllocationGroup: Cardinal);
procedure PopAllocationGroup;

{Allocation groups work in a stack like fashion. Group numbers are pushed onto
and popped off the stack. Note that the stack size is limited, so every push
should have a matching pop.}

LogAllocatedBlocksToFile

{Logs detail about currently allocated memory blocks for the specified range of
allocation groups. if ALastAllocationGroupToLog is less than
AFirstAllocationGroupToLog or it is zero, then all allocation groups are
logged. This routine also checks the memory pool for consistency at the same
time, raising an “Out of Memory” error if the check fails.}

SetMMLogFileName

{Specify the full path and name for the filename to be used for logging memory
errors, etc. If ALogFileName is nil or points to an empty string it will
revert to the default log file name.}

Posts (note that not all of them get their calculations right):

[WayBack] How to get the Memory Used by a Delphi Program – Stack Overflow
[WayBack] delphi – FastMM: Total Allocated Memory – Stack Overflow
[WayBack] delphi – Does calling FastMM4 LogAllocatedBlocksToFile() periodically use up memory space? – Stack Overflow:
I have tracked this down to be a version mismatch of the support library FastMM_FullDebugMode.dll.
An older version of the library works with the newer version compiled into the executable. There seems to be no check that versions do match. However, modules don’t really work together at run-time.

[WayBack] delphi – How to solve memory segmentation and force FastMM to release memory to OS? – Stack Overflow
[WayBack] TURBU Tech » Blog Archive » Wanted: live leak detection for FastMM
[WayBack] Strategy or tools to find “non-leak” memory usage problems in Delphi? – Stack Overflow:

use non-FastMM tools: AQTime, MemProof, SleuthQA
use FastMM methods GetMemoryManagerSTate, GetMemoryManagerUsageSummary, LogMemoryStateToFile

FastMM4991 introduced a new method, LogMemoryManagerStateToFile:
Added the LogMemoryManagerStateToFile call. This call logs a summary of the memory manager state to file: The total allocated memory, overhead, efficiency, and a breakdown of allocated memory by class and string type. This call may be useful to catch objects that do not necessarily leak, but do linger longer than they should.

[WayBack] delphi – How can I find out how much memory is used by a specific component or class? – Stack Overflow
[WayBack] What does GetMemoryManagerState, ReservedAddressSpace do in Delphi? – Stack Overflow

These help you track leaks that do not appear as leaks during shutdown: memory allocations that will be released at the end of your application, but are mostly unused while your application is still alive.
A few things to take away from these:

“Out of Memory” (or exception EOutOfMemor) could mean that the memory manager structures are hosed, but memory is still available.
You can specify the FastMM log file used (for instance to include a PID or run-time ID in them so each run gets a separate filename)
When carefully setting up allocation groups, you are able to zoom in at allocations

A gist with a MemoryManagerUnit showing a few of these calls is below.
An example of its usage is this:

procedure TMyTestClass.TestMethod();
begin
TLogMemoryStatesHelper.DumpMemoryStatesBeforeAndAfter(‘TestMethod’,
TLogging.LogDir,
TFileLogger.GetLogFileName,
procedure (const AFormat: string; const Args: array of const)
begin
TLogging.LogEvent(ltInfoHigh, aFormat, Args);
end,
procedure()
begin
try
// Given
BuildSomeTestScenario();
// When
InitializeTestScenario();
// Then
CheckEquals(0, TestScenarioSummary());
finally
// Cleanup
CleanUpTestScenario();
end;
end
);
end;

–jeroen

.gist table { margin-bottom: 0; }

This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters

Show hidden characters

unit MemoryManagerUnit;

// based on ideas in https://stackoverflow.com/questions/437683/how-to-get-the-memory-used-by-a-delphi-program/437749

// and code from https://github.com/pleriche/FastMM4/blob/master/Demos/Usage%20Tracker/FastMMUsageTracker.pas

interface

{$Include FastMM4Options.inc} // So defines like FullDebugMode are handled correctly.

{.define FastMMLogAllocatedBlocks} // Only do this in severe situations, as it will take forever to log the blocks (1 hour or more for a simple compenda run/stop)

uses

{$ifdef FastMM}

FastMM4,

{$endif FastMM}

Winapi.Windows,

System.SysUtils;

type

TMemoryManagerStateHelper = record helper for TMemoryManagerState

function LargeBlockSizeUsageBytes: Cardinal;

function LogicalSmallBlockSizeUsageBytes: Cardinal;

function MediumBlockSizeUsageBytes: Cardinal;

function PysicalSmallBlockSizeUsageBytes: Cardinal;

function ReservedSmallBlockSizeUsageBytes: Cardinal;

function ReservedMemoryUsageBytes: Cardinal;

function TotalBlockSizeUsageBytes: Cardinal;

class function GetMemoryManagerState: TMemoryManagerState; static;

function ToString: string;

end;

TSmallBlockTypeStateHelper = record helper for TSmallBlockTypeState

function LogicalBlockSizeUsageBytes: Cardinal;

function PhysicalBlockSizeUsageBytes: Cardinal;

end;

{$ifndef FastMM}

{ From FastMM4.TMemoryManagerUsageSummary }

TMemoryManagerUsageSummary = record

{The total number of bytes allocated by the application.}

AllocatedBytes: NativeUInt;

{The total number of address space bytes used by control structures, or

lost due to fragmentation and other overhead.}

OverheadBytes: NativeUInt;

{The efficiency of the memory manager expressed as a percentage. This is

100 * AllocatedBytes / (AllocatedBytes + OverheadBytes).}

EfficiencyPercentage: Double;

class function GetMemoryManagerUsageSummary: TMemoryManagerUsageSummary; static;

end;

{$endif FastMM}

TMemoryManagerUsageSummaryHelper = record helper for TMemoryManagerUsageSummary

{$ifdef FastMM}

class function GetMemoryManagerUsageSummary: TMemoryManagerUsageSummary; static;

{$endif FastMM}

function ToString: string;

end;

// Various Windows API call results involving processor and memory state:

TWindowsProcessorAndMemoryStatus = record

public

ProcessorCount: DWORD;

AllocationGranularity: DWORD;

AvailablePhysicalMemory: Int64;

TotalPhysicalMemory: Int64;

AvailableVirtualMemory: Int64;

TotalVirtualMemory: Int64;

TotalVirtualExtendedMemory: Int64;

HaveTotalVirtualExtendedMemory: Boolean;

MaximumIncrement: ULONG;

PageSize: ULONG;

NumberOfPhysicalPages: ULONG;

LowestPhysicalPage: ULONG;

HighestPhysicalPage: ULONG;

HaveMaximumIncrement: Boolean;

HavePageSize: Boolean;

HaveNumberOfPhysicalPages: Boolean;

HaveLowestPhysicalPage: Boolean;

HaveHighestPhysicalPage: Boolean;

PageFaultCount: DWORD;

PeakWorkingSetSize: SIZE_T;

WorkingSetSize: SIZE_T;

QuotaPeakPagedPoolUsage: SIZE_T;

QuotaPagedPoolUsage: SIZE_T;

QuotaPeakNonPagedPoolUsage: SIZE_T;

QuotaNonPagedPoolUsage: SIZE_T;

PagefileUsage: SIZE_T;

PeakPagefileUsage: SIZE_T;

HavePageFaultCount: Boolean;

HavePeakWorkingSetSize: Boolean;

HaveWorkingSetSize: Boolean;

HaveQuotaPeakPagedPoolUsage: Boolean;

HaveQuotaPagedPoolUsage: Boolean;

HaveQuotaPeakNonPagedPoolUsage: Boolean;

HaveQuotaNonPagedPoolUsage: Boolean;

HavePagefileUsage: Boolean;

HavePeakPagefileUsage: Boolean;

CurrentProcessId: DWORD;

MinimumAddress: DWORD;

MaximumVMAddress: DWORD;

PageProtectionAndCommitSize: DWORD;

MinimumQuota: NativeUInt;

MaximumQuota: NativeUInt;

// TotalFree: DWord;

// TotalReserve: DWord;

// TotalCommit: DWord;

class function GetWindowsProcessorAndMemoryStatus: TWindowsProcessorAndMemoryStatus; static;

function ToString: string;

end;

TLogMemoryStates = record

public

MemoryManagerUsageSummary: TMemoryManagerUsageSummary;

MemoryManagerState: TMemoryManagerState;

WindowsProcessorAndMemoryStatus: TWindowsProcessorAndMemoryStatus;

end;

TLogMemoryStatesHelper = record

strict private

const

SBefore = 'before';

SAfter = 'after';

public

type

/// <summary>Decouples actual logging mechanism.</summary>

TLogMethod = reference to procedure(const AFormat: string; const Args: array of const);

/// <summary>Logs before/after states of memory allocator and Windows memory usage to `ALogMethod`, dumps before/after memory alloctor blocks, and calls `AMethod` inbetween.

/// <param name="AState">User defined logged in each `ALogMethod` call.</param>

/// <param name="AGetLogDirectory">To store dump file in.</param>

/// <param name="AGetLogFileName">To generate dump filename.</param>

/// <param name="ALogMethod">Decouples actual logging mechanism.</param>

/// <param name="AMethod">Method to call inbetween before/after substate.</param>

/// <returns>`TLogMemoryStates` instance for potential post processing like performing comparisons.</returns>

/// </summary>

class procedure DumpMemoryStatesBeforeAndAfter(const AState: string; const AGetLogDirectory, AGetLogFileName: TFunc<string>; const ALogMethod: TLogMethod; const AMethod: TProc); overload; static;

/// <summary> Logs current states of memory allocator and Windows memory usage to `ALogMethod`.

/// <param name="AState">User defined logged in each `ALogMethod` call.</param>

/// <param name="ALogMethod">Decouples actual logging mechanism.</param>

/// <returns>`TLogMemoryStates` instance for potential post processing like performing comparisons.</returns>

/// </summary>

class function LogMemoryStates(const AState: string; const ALogMethod: TLogMethod): TLogMemoryStates; overload; static;

/// <summary>Logs before/after states of memory allocator and Windows memory usage to `ALogMethod`, calls `AMethod` inbetween.

/// <param name="AState">User defined logged in each `ALogMethod` call.</param>

/// <param name="ALogMethod">Decouples actual logging mechanism.</param>

/// <param name="AMethod">Method to call inbetween before/after substate.</param>

/// <returns>`TLogMemoryStates` instance for potential post processing like performing comparisons.</returns>

/// </summary>

class procedure LogMemoryStatesBeforeAndAfter(const AState: string; const ALogMethod: TLogMethod; const AMethod: TProc); overload; static;

end;

implementation

uses

Winapi.PsAPI,

{$ifdef FastMM}

{$ifdef FullDebugMode}

FastMM4Messages,

System.DateUtils,

System.IOUtils,

{$endif FullDebugMode}

{$endif FastMM}

REST.Json;

function ToJsonStringAndFree(const InstanceToFree: TObject): string;

begin

try

Result := TJson.ObjectToJsonString(InstanceToFree);

finally

InstanceToFree.Free();

end;

end;

{ Windows API calls from FastMMUsageTracker.pas: }

type

TMemoryStatusEx = packed record

dwLength: DWORD;

dwMemoryLoad: DWORD;

ullTotalPhys: Int64;

ullAvailPhys: Int64;

ullTotalPageFile: Int64;

ullAvailPageFile: Int64;

ullTotalVirtual: Int64;

ullAvailVirtual: Int64;

ullAvailExtendedVirtual: Int64;

end;

PMemoryStatusEx = ^TMemoryStatusEx;

LPMEMORYSTATUSEX = PMemoryStatusEx;

TP_GlobalMemoryStatusEx = function(var PR_MemStatusEx: TMemoryStatusEx): LongBool; stdcall;

TSystem_Basic_Information = packed record

dwUnknown1: DWORD;

uKeMaximumIncrement: ULONG;

uPageSize: ULONG;

uMmNumberOfPhysicalPages: ULONG;

uMmLowestPhysicalPage: ULONG;

uMmHighestPhysicalPage: ULONG;

uAllocationGranularity: ULONG;

pLowestUserAddress: Pointer;

pMmHighestUserAddress: Pointer;

uKeActiveProcessors: ULONG;

bKeNumberProcessors: Byte;

bUnknown2: Byte;

wUnknown3: Word;

end;

TSystem_Performance_Information = packed record

liIdleTime: LARGE_INTEGER;

dwSpare: array[0..75] of DWORD;

end;

TSystem_Time_Information = packed record

liKeBootTime: LARGE_INTEGER;

liKeSystemTime: LARGE_INTEGER;

liExpTimeZoneBias: LARGE_INTEGER;

uCurrentTimeZoneId: ULONG;

dwReserved: DWORD;

end;

TP_NtQuerySystemInformation = function(InfoClass: DWORD; Buffer: Pointer; BufSize: DWORD; ReturnSize: PCardinal): DWORD; stdcall;

var

MP_GlobalMemoryStatusEx: TP_GlobalMemoryStatusEx = nil;

MP_NtQuerySystemInformation: TP_NtQuerySystemInformation = nil;

{ Record helpers: }

function TMemoryManagerStateHelper.LargeBlockSizeUsageBytes: Cardinal;

begin

Result := TotalAllocatedLargeBlockSize * AllocatedLargeBlockCount;

end;

function TMemoryManagerStateHelper.LogicalSmallBlockSizeUsageBytes: Cardinal;

var

SmallBlockTypeState: TSmallBlockTypeState;

begin

Result := 0;

for SmallBlockTypeState in SmallBlockTypeStates do

begin

Inc(Result, SmallBlockTypeState.LogicalBlockSizeUsageBytes);

end;

end;

function TMemoryManagerStateHelper.MediumBlockSizeUsageBytes: Cardinal;

begin

Result := TotalAllocatedMediumBlockSize * AllocatedMediumBlockCount;

end;

function TMemoryManagerStateHelper.PysicalSmallBlockSizeUsageBytes: Cardinal;

var

SmallBlockTypeState: TSmallBlockTypeState;

begin

Result := 0;

for SmallBlockTypeState in SmallBlockTypeStates do

begin

Inc(Result, SmallBlockTypeState.PhysicalBlockSizeUsageBytes);

end;

end;

function TMemoryManagerStateHelper.ReservedSmallBlockSizeUsageBytes: Cardinal;

var

SmallBlockTypeState: TSmallBlockTypeState;

begin

Result := 0;

for SmallBlockTypeState in SmallBlockTypeStates do

begin

Inc(Result, SmallBlockTypeState.ReservedAddressSpace);

end;

end;

function TMemoryManagerStateHelper.ReservedMemoryUsageBytes: Cardinal;

begin

Result := ReservedMediumBlockAddressSpace + ReservedLargeBlockAddressSpace + ReservedSmallBlockSizeUsageBytes;

end;

{ Utility functions from FastMMUsageTracker.pas: }

function CardinalToStringFormatted(const ACardinal: Cardinal): string;

begin

Result := FormatFloat('#,##0', ACardinal);

end;

function Int64ToStringFormatted(const AInt64: Int64): string;

begin

Result := FormatFloat('#,##0', AInt64);

end;

function CardinalToKStringFormatted(const ACardinal: Cardinal): string;

begin

Result := FormatFloat('#,##0', ACardinal div 1024) + 'K';

end;

function Int64ToKStringFormatted(const AInt64: Int64): string;

begin

Result := FormatFloat('#,##0', AInt64 div 1024) + 'K';

end;

// REST.Json does not support converting records to JSON, so introduce an intermediate class

type

TMemoryManagerStateClass = class

LargeBlockSizeUsageBytes: Cardinal;

LogicalSmallBlockSizeUsageBytes: Cardinal;

MediumBlockSizeUsageBytes: Cardinal;

PysicalSmallBlockSizeUsageBytes: Cardinal;

ReservedSmallBlockSizeUsageBytes: Cardinal;

ReservedMemoryUsageBytes: Cardinal;

TotalBlockSizeUsageBytes: Cardinal;

public

constructor Create(const AMemoryManagerState: TMemoryManagerState);

end;

constructor TMemoryManagerStateClass.Create(const AMemoryManagerState: TMemoryManagerState);

begin

inherited Create();

LargeBlockSizeUsageBytes := AMemoryManagerState.LargeBlockSizeUsageBytes;

LogicalSmallBlockSizeUsageBytes := AMemoryManagerState.LogicalSmallBlockSizeUsageBytes;

MediumBlockSizeUsageBytes := AMemoryManagerState.MediumBlockSizeUsageBytes;

PysicalSmallBlockSizeUsageBytes := AMemoryManagerState.PysicalSmallBlockSizeUsageBytes;

ReservedSmallBlockSizeUsageBytes := AMemoryManagerState.ReservedSmallBlockSizeUsageBytes;

ReservedMemoryUsageBytes := AMemoryManagerState.ReservedMemoryUsageBytes;

TotalBlockSizeUsageBytes := AMemoryManagerState.TotalBlockSizeUsageBytes;

end;

class function TMemoryManagerStateHelper.GetMemoryManagerState: TMemoryManagerState;

begin

{$ifdef FastMM}

FastMM4

{$else}

System

{$endif FastMM}

.GetMemoryManagerState(Result);

end;

function TMemoryManagerStateHelper.ToString: string;

begin

Result := ToJsonStringAndFree(TMemoryManagerStateClass.Create(Self));

end;

function TMemoryManagerStateHelper.TotalBlockSizeUsageBytes: Cardinal;

begin

Result := TotalAllocatedMediumBlockSize + TotalAllocatedLargeBlockSize + PysicalSmallBlockSizeUsageBytes;

end;

function TSmallBlockTypeStateHelper.LogicalBlockSizeUsageBytes: Cardinal;

begin

Result := AllocatedBlockCount * InternalBlockSize;

end;

function TSmallBlockTypeStateHelper.PhysicalBlockSizeUsageBytes: Cardinal;

begin

Result := AllocatedBlockCount * UseableBlockSize;

end;

{$ifndef FastMM}

class function TMemoryManagerUsageSummary.GetMemoryManagerUsageSummary: TMemoryManagerUsageSummary;

var

LMMS: TMemoryManagerState;

LAllocatedBytes, LReservedBytes: NativeUInt;

begin

GetMemoryManagerState(LMMS);

LAllocatedBytes := LMMS.TotalBlockSizeUsageBytes;

LReservedBytes := LMMS.ReservedMemoryUsageBytes;

{Set the structure values}

Result.AllocatedBytes := LAllocatedBytes;

Result.OverheadBytes := LReservedBytes – LAllocatedBytes;

if LReservedBytes > 0 then

begin

Result.EfficiencyPercentage := LAllocatedBytes / LReservedBytes * 100;

end

else

Result.EfficiencyPercentage := 100;

end;

{$endif FastMM}

{$ifdef FastMM}

class function TMemoryManagerUsageSummaryHelper.GetMemoryManagerUsageSummary: TMemoryManagerUsageSummary;

begin

FastMM4.GetMemoryManagerUsageSummary(Result);

end;

{$endif FastMM}

// REST.Json does not support converting records to JSON, so introduce an intermediate class

type

TMemoryManagerUsageSummaryClass = class

AllocatedBytes: NativeUInt;

OverheadBytes: NativeUInt;

EfficiencyPercentage: Double;

public

constructor Create(const AMemoryManagerUsageSummary: TMemoryManagerUsageSummary);

end;

constructor TMemoryManagerUsageSummaryClass.Create(const AMemoryManagerUsageSummary: TMemoryManagerUsageSummary);

begin

inherited Create();

AllocatedBytes := AMemoryManagerUsageSummary.AllocatedBytes;

OverheadBytes := AMemoryManagerUsageSummary.OverheadBytes;

EfficiencyPercentage := AMemoryManagerUsageSummary.EfficiencyPercentage;

end;

function TMemoryManagerUsageSummaryHelper.ToString: string;

begin

Result := ToJsonStringAndFree(TMemoryManagerUsageSummaryClass.Create(Self));

end;

procedure ModuleInit;

begin

if Win32Platform = VER_PLATFORM_WIN32_NT then

begin

MP_GlobalMemoryStatusEx := TP_GlobalMemoryStatusEx(GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx'));

MP_NtQuerySystemInformation := TP_NtQuerySystemInformation(GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQuerySystemInformation'));

end;

end;

class function TWindowsProcessorAndMemoryStatus.GetWindowsProcessorAndMemoryStatus: TWindowsProcessorAndMemoryStatus;

const

SystemBasicInformation = 0;

var

LR_SystemInfo: TSystemInfo;

LR_GlobalMemoryStatus: TMemoryStatus;

LR_GlobalMemoryStatusEx: TMemoryStatusEx;

LR_ProcessMemoryCounters: TProcessMemoryCounters;

LR_SysBaseInfo: TSystem_Basic_Information;

LU_MinQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend};

LU_MaxQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend};

begin

LU_MinQuota := 0;

LU_MaxQuota := 0;

if Assigned(MP_GlobalMemoryStatusEx) then

begin

ZeroMemory(@LR_GlobalMemoryStatusEx, SizeOf(TMemoryStatusEx));

LR_GlobalMemoryStatusEx.dwLength := SizeOf(TMemoryStatusEx);

if not MP_GlobalMemoryStatusEx(LR_GlobalMemoryStatusEx) then

begin

RaiseLastOSError();

end;

end

else

begin

LR_GlobalMemoryStatus.dwLength := SizeOf(TMemoryStatus);

GlobalMemoryStatus(LR_GlobalMemoryStatus);

end;

GetProcessWorkingSetSize(GetCurrentProcess, LU_MinQuota, LU_MaxQuota);

GetSystemInfo(LR_SystemInfo);

Result.ProcessorCount := LR_SystemInfo.dwNumberOfProcessors;

Result.AllocationGranularity := LR_SystemInfo.dwAllocationGranularity;

Result.MinimumAddress := DWORD(LR_SystemInfo.lpMinimumApplicationAddress);

Result.MaximumVMAddress := DWORD(LR_SystemInfo.lpMaximumApplicationAddress);

Result.PageProtectionAndCommitSize := LR_SystemInfo.dWPageSize;

if Assigned(MP_GlobalMemoryStatusEx) then

begin

with LR_GlobalMemoryStatusEx do

begin

Result.AvailablePhysicalMemory := LR_GlobalMemoryStatusEx.ullAvailPhys;

Result.TotalPhysicalMemory := LR_GlobalMemoryStatusEx.ullTotalPhys;

Result.AvailableVirtualMemory := LR_GlobalMemoryStatusEx.ullAvailVirtual;

Result.TotalVirtualMemory := LR_GlobalMemoryStatusEx.ullTotalVirtual;

Result.TotalVirtualExtendedMemory := LR_GlobalMemoryStatusEx.ullAvailExtendedVirtual;

Result.HaveTotalVirtualExtendedMemory := True;

end;

end

else

begin

with LR_GlobalMemoryStatus do

begin

Result.AvailablePhysicalMemory := LR_GlobalMemoryStatus.dwAvailPhys;

Result.TotalPhysicalMemory := LR_GlobalMemoryStatus.dwTotalPhys;

Result.AvailableVirtualMemory := LR_GlobalMemoryStatus.dwAvailVirtual;

Result.TotalVirtualMemory := LR_GlobalMemoryStatus.dwTotalVirtual;

Result.TotalVirtualExtendedMemory := –1;

Result.HaveTotalVirtualExtendedMemory := False;

end;

end;

if Assigned(MP_NtQuerySystemInformation) and

(0 = MP_NtQuerySystemInformation(SystemBasicInformation, @LR_SysBaseInfo, SizeOf(LR_SysBaseInfo), nil))

then

begin

Result.MaximumIncrement := LR_SysBaseInfo.uKeMaximumIncrement;

Result.PageSize := LR_SysBaseInfo.uPageSize;

Result.NumberOfPhysicalPages := LR_SysBaseInfo.uMmNumberOfPhysicalPages;

Result.LowestPhysicalPage := LR_SysBaseInfo.uMmLowestPhysicalPage;

Result.HighestPhysicalPage := LR_SysBaseInfo.uMmHighestPhysicalPage;

Result.HaveMaximumIncrement := True;

Result.HavePageSize := True;

Result.HaveNumberOfPhysicalPages := True;

Result.HaveLowestPhysicalPage := True;

Result.HaveHighestPhysicalPage := True;

end

else

begin

Result.MaximumIncrement := 0;

Result.PageSize := 0;

Result.NumberOfPhysicalPages := 0;

Result.LowestPhysicalPage := 0;

Result.HighestPhysicalPage := 0;

Result.HaveMaximumIncrement := False;

Result.HavePageSize := False;

Result.HaveNumberOfPhysicalPages := False;

Result.HaveLowestPhysicalPage := False;

Result.HaveHighestPhysicalPage := False;

end;

// same as GetProcessMemoryInfo & NtQuerySystemInformation (SystemBasicInformation

// The working set is the amount of memory physically mapped to the process context at a given

// time. Memory in the paged pool is system memory that can be transferred to the paging file

// on disk (paged) when it is not being used. Memory in the nonpaged pool is system memory

// that cannot be paged to disk as long as the corresponding objects are allocated. The pagefile

// usage represents how much memory is set aside for the process in the system paging file.

// When memory usage is too high, the virtual memory manager pages selected memory to disk.

// When a thread needs a page that is not in memory, the memory manager reloads it from the

// paging file.

if GetProcessMemoryInfo(GetCurrentProcess, @LR_ProcessMemoryCounters, SizeOf(LR_ProcessMemoryCounters)) then

begin

Result.PageFaultCount := LR_ProcessMemoryCounters.PageFaultCount;

Result.PeakWorkingSetSize := LR_ProcessMemoryCounters.PeakWorkingSetSize;

Result.WorkingSetSize := LR_ProcessMemoryCounters.WorkingSetSize;

Result.QuotaPeakPagedPoolUsage := LR_ProcessMemoryCounters.QuotaPeakPagedPoolUsage;

Result.QuotaPagedPoolUsage := LR_ProcessMemoryCounters.QuotaPagedPoolUsage;

Result.QuotaPeakNonPagedPoolUsage := LR_ProcessMemoryCounters.QuotaPeakNonPagedPoolUsage;

Result.QuotaNonPagedPoolUsage := LR_ProcessMemoryCounters.QuotaNonPagedPoolUsage;

Result.PagefileUsage := LR_ProcessMemoryCounters.PagefileUsage;

Result.PeakPagefileUsage := LR_ProcessMemoryCounters.PeakPagefileUsage;

Result.HavePageFaultCount := True;

Result.HavePeakWorkingSetSize := True;

Result.HaveWorkingSetSize := True;

Result.HaveQuotaPeakPagedPoolUsage := True;

Result.HaveQuotaPagedPoolUsage := True;

Result.HaveQuotaPeakNonPagedPoolUsage := True;

Result.HaveQuotaNonPagedPoolUsage := True;

Result.HavePagefileUsage := True;

Result.HavePeakPagefileUsage := True;

end

else

begin

Result.PageFaultCount := 0;

Result.PeakWorkingSetSize := 0;

Result.WorkingSetSize := 0;

Result.QuotaPeakPagedPoolUsage := 0;

Result.QuotaPagedPoolUsage := 0;

Result.QuotaPeakNonPagedPoolUsage := 0;

Result.QuotaNonPagedPoolUsage := 0;

Result.PagefileUsage := 0;

Result.PeakPagefileUsage := 0;

Result.HavePageFaultCount := False;

Result.HavePeakWorkingSetSize := False;

Result.HaveWorkingSetSize := False;

Result.HaveQuotaPeakPagedPoolUsage := False;

Result.HaveQuotaPagedPoolUsage := False;

Result.HaveQuotaPeakNonPagedPoolUsage := False;

Result.HaveQuotaNonPagedPoolUsage := False;

Result.HavePagefileUsage := False;

Result.HavePeakPagefileUsage := False;

end;

Result.CurrentProcessId := GetCurrentProcessId();

Result.MinimumQuota := LU_MinQuota;

Result.MaximumQuota := LU_MaxQuota;

{TODO -oJWP -cEnhancement : Future }

// Result.TotalFree := LU_MEM_FREE;

// Result.TotalReserve := LU_MEM_RESERVE;

// Result.TotalCommit := LU_MEM_COMMIT;

// if LP_FreeVMList.Count > CI_MaxFreeBlocksList then

// LI_Max := CI_MaxFreeBlocksList – 1

// else

// LI_Max := LP_FreeVMList.Count – 1;

//

// for LI_I := 0 to LI_Max do

// begin

// Result.Largest Free Block ' + IntToStr(LI_I + 1) + '. = ' + CardinalToKStringFormatted(Cardinal(LP_Free:= LI_I]);

// end;

// In case we want to add a FastMM4 summary:

// Result.TotalBlocks := LTotalBlocks;

// Result.TotalAllocated := LTotalAllocated;

// Result.TotalReserved := LTotalReserved;

end;

// REST.Json does not support converting records to JSON, so introduce an intermediate class

type

TWindowsProcessorAndMemoryStatusClass = class

ProcessorCount: DWORD;

AllocationGranularity: DWORD;

AvailablePhysicalMemory: Int64;

TotalPhysicalMemory: Int64;

AvailableVirtualMemory: Int64;

TotalVirtualMemory: Int64;

TotalVirtualExtendedMemory: Int64;

HaveTotalVirtualExtendedMemory: Boolean;

MaximumIncrement: ULONG;

PageSize: ULONG;

NumberOfPhysicalPages: ULONG;

LowestPhysicalPage: ULONG;

HighestPhysicalPage: ULONG;

HaveMaximumIncrement: Boolean;

HavePageSize: Boolean;

HaveNumberOfPhysicalPages: Boolean;

HaveLowestPhysicalPage: Boolean;

HaveHighestPhysicalPage: Boolean;

PageFaultCount: DWORD;

PeakWorkingSetSize: SIZE_T;

WorkingSetSize: SIZE_T;

QuotaPeakPagedPoolUsage: SIZE_T;

QuotaPagedPoolUsage: SIZE_T;

QuotaPeakNonPagedPoolUsage: SIZE_T;

QuotaNonPagedPoolUsage: SIZE_T;

PagefileUsage: SIZE_T;

PeakPagefileUsage: SIZE_T;

HavePageFaultCount: Boolean;

HavePeakWorkingSetSize: Boolean;

HaveWorkingSetSize: Boolean;

HaveQuotaPeakPagedPoolUsage: Boolean;

HaveQuotaPagedPoolUsage: Boolean;

HaveQuotaPeakNonPagedPoolUsage: Boolean;

HaveQuotaNonPagedPoolUsage: Boolean;

HavePagefileUsage: Boolean;

HavePeakPagefileUsage: Boolean;

CurrentProcessId: DWORD;

MinimumAddress: DWORD;

MaximumVMAddress: DWORD;

PageProtectionAndCommitSize: DWORD;

MinimumQuota: NativeUInt;

MaximumQuota: NativeUInt;

// TotalFree: DWord;

// TotalReserve: DWord;

// TotalCommit: DWord;

public

constructor Create(const AWindowsProcessorAndMemoryStatus: TWindowsProcessorAndMemoryStatus);

end;

constructor TWindowsProcessorAndMemoryStatusClass.Create(const AWindowsProcessorAndMemoryStatus:

TWindowsProcessorAndMemoryStatus);

begin

inherited Create();

ProcessorCount := AWindowsProcessorAndMemoryStatus.ProcessorCount;

AllocationGranularity := AWindowsProcessorAndMemoryStatus.AllocationGranularity;

AvailablePhysicalMemory := AWindowsProcessorAndMemoryStatus.AvailablePhysicalMemory;

TotalPhysicalMemory := AWindowsProcessorAndMemoryStatus.TotalPhysicalMemory;

AvailableVirtualMemory := AWindowsProcessorAndMemoryStatus.AvailableVirtualMemory;

TotalVirtualMemory := AWindowsProcessorAndMemoryStatus.TotalVirtualMemory;

TotalVirtualExtendedMemory := AWindowsProcessorAndMemoryStatus.TotalVirtualExtendedMemory;

HaveTotalVirtualExtendedMemory := AWindowsProcessorAndMemoryStatus.HaveTotalVirtualExtendedMemory;

MaximumIncrement := AWindowsProcessorAndMemoryStatus.MaximumIncrement;

PageSize := AWindowsProcessorAndMemoryStatus.PageSize;

NumberOfPhysicalPages := AWindowsProcessorAndMemoryStatus.NumberOfPhysicalPages;

LowestPhysicalPage := AWindowsProcessorAndMemoryStatus.LowestPhysicalPage;

HighestPhysicalPage := AWindowsProcessorAndMemoryStatus.HighestPhysicalPage;

HaveMaximumIncrement := AWindowsProcessorAndMemoryStatus.HaveMaximumIncrement;

HavePageSize := AWindowsProcessorAndMemoryStatus.HavePageSize;

HaveNumberOfPhysicalPages := AWindowsProcessorAndMemoryStatus.HaveNumberOfPhysicalPages;

HaveLowestPhysicalPage := AWindowsProcessorAndMemoryStatus.HaveLowestPhysicalPage;

HaveHighestPhysicalPage := AWindowsProcessorAndMemoryStatus.HaveHighestPhysicalPage;

PageFaultCount := AWindowsProcessorAndMemoryStatus.PageFaultCount;

PeakWorkingSetSize := AWindowsProcessorAndMemoryStatus.PeakWorkingSetSize;

WorkingSetSize := AWindowsProcessorAndMemoryStatus.WorkingSetSize;

QuotaPeakPagedPoolUsage := AWindowsProcessorAndMemoryStatus.QuotaPeakPagedPoolUsage;

QuotaPagedPoolUsage := AWindowsProcessorAndMemoryStatus.QuotaPagedPoolUsage;

QuotaPeakNonPagedPoolUsage := AWindowsProcessorAndMemoryStatus.QuotaPeakNonPagedPoolUsage;

QuotaNonPagedPoolUsage := AWindowsProcessorAndMemoryStatus.QuotaNonPagedPoolUsage;

PagefileUsage := AWindowsProcessorAndMemoryStatus.PagefileUsage;

PeakPagefileUsage := AWindowsProcessorAndMemoryStatus.PeakPagefileUsage;

HavePageFaultCount := AWindowsProcessorAndMemoryStatus.HavePageFaultCount;

HavePeakWorkingSetSize := AWindowsProcessorAndMemoryStatus.HavePeakWorkingSetSize;

HaveWorkingSetSize := AWindowsProcessorAndMemoryStatus.HaveWorkingSetSize;

HaveQuotaPeakPagedPoolUsage := AWindowsProcessorAndMemoryStatus.HaveQuotaPeakPagedPoolUsage;

HaveQuotaPagedPoolUsage := AWindowsProcessorAndMemoryStatus.HaveQuotaPagedPoolUsage;

HaveQuotaPeakNonPagedPoolUsage := AWindowsProcessorAndMemoryStatus.HaveQuotaPeakNonPagedPoolUsage;

HaveQuotaNonPagedPoolUsage := AWindowsProcessorAndMemoryStatus.HaveQuotaNonPagedPoolUsage;

HavePagefileUsage := AWindowsProcessorAndMemoryStatus.HavePagefileUsage;

HavePeakPagefileUsage := AWindowsProcessorAndMemoryStatus.HavePeakPagefileUsage;

CurrentProcessId := AWindowsProcessorAndMemoryStatus.CurrentProcessId;

MinimumAddress := AWindowsProcessorAndMemoryStatus.MinimumAddress;

MaximumVMAddress := AWindowsProcessorAndMemoryStatus.MaximumVMAddress;

PageProtectionAndCommitSize := AWindowsProcessorAndMemoryStatus.PageProtectionAndCommitSize;

MinimumQuota := AWindowsProcessorAndMemoryStatus.MinimumQuota;

MaximumQuota := AWindowsProcessorAndMemoryStatus.MaximumQuota;

end;

function TWindowsProcessorAndMemoryStatus.ToString: string;

begin

Result := ToJsonStringAndFree(TWindowsProcessorAndMemoryStatusClass.Create(Self));

end;

class procedure TLogMemoryStatesHelper.DumpMemoryStatesBeforeAndAfter(const AState: string; const AGetLogDirectory, AGetLogFileName: TFunc<string>; const

ALogMethod: TLogMethod; const AMethod: TProc);

{TODO -ojwp -cOptimise : Make all variables non-dynamic and stack based so they do not cause heap allocation differences }

var

AfterState: string;

BeforeState: string;

begin

BeforeState := SBefore + ' ' + AState;

AfterState := SAfter + ' ' + AState;

LogMemoryStatesBeforeAndAfter(AState, ALogMethod,

procedure

// note that the `FastMM` `FullDebugMode` related methods need to be local, as otherwise they cannot be captured into the anonymous method.

{$ifdef FastMM}

{$ifdef FullDebugMode}

/// <summary>Memory dump is in the log directory with an extension so it is recognisable as FastMM related.</summary>

function GetMemoryManagerLogPath(const AStartIso8601: string; const AAllocationGroup: Cardinal; const AState: string; const AWhat: string; const AWhen: string): string;

var

LogDirectory: string;

LogFileExtension: string;

LogFileName: string;

begin

LogDirectory := AGetLogDirectory();

LogFileName := AGetLogFileName();

LogFileExtension := PChar(FastMM4Messages.LogFileExtension); // strip any trailing #0

LogFileExtension := Format('%s_%d_%s_%s_%s%s', // last %s has no underscore, as it is already in FastMM4Messages.LogFileExtension

[AStartIso8601, AAllocationGroup, AWhat, AWhen, AState, LogFileExtension]);

LogFileName := TPath.ChangeExtension(LogFileName, LogFileExtension);

Result := TPath.Combine(LogDirectory, LogFileName);

end;

/// <summary>By default only logs memory manager state; only logs blocks when `FastMMLogAllocatedBlocks` is defined.</summary>

function LogStateAndBlocksAndReturnCurrentAllocationGroup(const AStartIso8601: string; const AState: string; const AWhen: string; const AAdditionalDetails: string): Cardinal;

const

SState = 'state';

{$ifdef FastMMLogAllocatedBlocks}

SBlocks = 'blocks';

{$endif FastMMLogAllocatedBlocks}

var

CurrentAllocationGroup: Cardinal;

MemoryManagerLogPath: string;

{$ifdef FastMMLogAllocatedBlocks}

AnsiMemoryManagerLogPath: AnsiString;

{$endif FastMMLogAllocatedBlocks}

begin

CurrentAllocationGroup := FastMM4.GetCurrentAllocationGroup();

MemoryManagerLogPath := GetMemoryManagerLogPath(AStartIso8601, CurrentAllocationGroup, SState, AWhen, AState);

LogMemoryManagerStateToFile(MemoryManagerLogPath, AAdditionalDetails); // logs to a specific filename

{$ifdef FastMMLogAllocatedBlocks}

if CurrentAllocationGroup <> 0 then

begin

MemoryManagerLogPath := GetMemoryManagerLogPath(AStartIso8601, CurrentAllocationGroup, SBlocks, AWhen, AState);

AnsiMemoryManagerLogPath := AnsiString(MemoryManagerLogPath); // suppress W1058; see https://stackoverflow.com/questions/20402653/how-can-i-convert-a-unicode-string-to-an-ansistring

// Only do this in severe situations, as it will take forever to log the blocks

FastMM4.SetMMLogFileName(PAnsiChar(AnsiMemoryManagerLogPath));

LogAllocatedBlocksToFile(CurrentAllocationGroup, CurrentAllocationGroup); // logs to the current MMLogFileName

end;

{$endif FastMMLogAllocatedBlocks}

Result := CurrentAllocationGroup;

end;

var

CurrentAllocationGroup: Cardinal;

Start: TDateTime;

StartIso8601: string;

{$endif FullDebugMode}

{$endif FastMM}

begin

{$ifdef FastMM}

{$ifdef FullDebugMode}

Start := Now();

StartIso8601 := DateToISO8601(Start, False).Replace('–', '').Replace(':', ''); // https://en.wikipedia.org/wiki/ISO_8601#Time_zone_designators

CurrentAllocationGroup := LogStateAndBlocksAndReturnCurrentAllocationGroup(StartIso8601, AState, SBefore, BeforeState);

FastMM4.PushAllocationGroup(CurrentAllocationGroup+1);

{$endif FullDebugMode}

{$endif FastMM}

try

AMethod();

finally

{$ifdef FastMM}

{$ifdef FullDebugMode}

try

LogStateAndBlocksAndReturnCurrentAllocationGroup(StartIso8601, AState, SAfter, AfterState);

finally

FastMM4.PopAllocationGroup();

FastMM4.SetMMLogFileName(nil) // calls SetDefaultMMLogFileName();

end;

{$endif FullDebugMode}

{$endif FastMM}

end;

end);

end;

class function TLogMemoryStatesHelper.LogMemoryStates(const AState: string; const ALogMethod: TLogMethod): TLogMemoryStates;

begin

ALogMethod(AState, []);

Result.MemoryManagerUsageSummary := TMemoryManagerUsageSummary.GetMemoryManagerUsageSummary();

Result.MemoryManagerState := TMemoryManagerState.GetMemoryManagerState();

Result.WindowsProcessorAndMemoryStatus := TWindowsProcessorAndMemoryStatus.GetWindowsProcessorAndMemoryStatus();

ALogMethod('%s %s: %s.', ['Memory manager summary', AState, Result.MemoryManagerUsageSummary.ToString()]);

ALogMethod('%s %s: %s.', ['Memory manager state', AState, Result.MemoryManagerState.ToString()]);

ALogMethod('%s %s: %s.', ['Windows process and memory state', AState, Result.WindowsProcessorAndMemoryStatus.ToString()]);

end;

class procedure TLogMemoryStatesHelper.LogMemoryStatesBeforeAndAfter(const AState: string; const ALogMethod: TLogMethod; const AMethod: TProc);

var

Before: TLogMemoryStates;

After: TLogMemoryStates;

AfterState: string;

BeforeState: string;

begin

BeforeState := SBefore + ' ' + AState;

Before := LogMemoryStates(BeforeState, ALogMethod);

try

AMethod();

finally

AfterState := SAfter + ' ' + AState;

After := LogMemoryStates(AfterState, ALogMethod);

{TODO -ojwp -cFeature : log the diff }

end;

end;

initialization

ModuleInit();

end.

view raw

MemoryManagerUnit.pas

hosted with ❤ by GitHub

Comments are closed.