Skip to content

Instantly share code, notes, and snippets.

@jpluimers

jpluimers/MemoryManagerUnit.pas Secret

Created Jul 10, 2019
Embed
What would you like to do?
Unit for logging Windows and Delphi memory manager state (including FastMM if enabled)
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.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment