Unit for logging Windows and Delphi memory manager state (including FastMM if enabled)

MemoryManagerUnit.pas

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.