├── .gitignore ├── BorlndMM DLL ├── BorlndMM.dpr ├── BorlndMM.dproj └── Precompiled │ ├── 32Bit │ ├── Debug │ │ └── BorlndMM.dll │ └── Release │ │ └── BorlndMM.dll │ └── 64Bit │ ├── Debug │ └── BorlndMM.dll │ └── Release │ └── BorlndMM.dll ├── Demos ├── Debug Features │ ├── Log Leaks and Errors To File │ │ ├── LogLeaksAndErrorsToFile.dpr │ │ └── LogLeaksAndErrorsToFile.dproj │ └── Memory Corruption Detection │ │ ├── MemoryCorruptionDetectionDemo.dpr │ │ └── MemoryCorruptionDetectionDemo.dproj ├── Memory Manager Sharing │ ├── Delay loaded DLL │ │ ├── FastMMInitSharing.pas │ │ ├── TestApp.dpr │ │ └── TestLibrary.dpr │ ├── ShareMem │ │ ├── ShareMemDemo.dpr │ │ ├── ShareMemDemo.dproj │ │ ├── ShareMemDemo.res │ │ ├── TestLibrary.dpr │ │ ├── TestLibrary.dproj │ │ └── TestLibrary.res │ └── Statically Linked DLL │ │ ├── FastMMInitSharing.pas │ │ ├── TestApp.dpr │ │ └── TestLibrary.dpr └── Usage Tracker │ ├── DemoForm.dfm │ ├── DemoForm.pas │ ├── FastMMUsageTracker.dfm │ ├── FastMMUsageTracker.pas │ ├── UsageTrackerDemo.dpr │ └── UsageTrackerDemo.dproj ├── FastMM5.pas ├── FullDebugMode DLL ├── FastMM_FullDebugMode.dpr ├── FastMM_FullDebugMode.dproj └── Precompiled │ ├── FastMM_FullDebugMode.dll │ └── FastMM_FullDebugMode64.dll ├── Images ├── FastMM5-social.png ├── FastMM5.jpg ├── FastMM5.png ├── FastMMv5-square.jpg └── FastMMv5-square.png └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | # Uncomment these types if you want even more clean repository. But be careful. 2 | # It can make harm to an existing project source. Read explanations below. 3 | # 4 | # Resource files are binaries containing manifest, project icon and version info. 5 | # They can not be viewed as text or compared by diff-tools. Consider replacing them with .rc files. 6 | #*.res 7 | # 8 | # Type library file (binary). In old Delphi versions it should be stored. 9 | # Since Delphi 2009 it is produced from .ridl file and can safely be ignored. 10 | #*.tlb 11 | # 12 | # Diagram Portfolio file. Used by the diagram editor up to Delphi 7. 13 | # Uncomment this if you are not using diagrams or use newer Delphi version. 14 | #*.ddp 15 | # 16 | # Visual LiveBindings file. Added in Delphi XE2. 17 | # Uncomment this if you are not using LiveBindings Designer. 18 | #*.vlb 19 | # 20 | # Deployment Manager configuration file for your project. Added in Delphi XE2. 21 | # Uncomment this if it is not mobile development and you do not use remote debug feature. 22 | #*.deployproj 23 | # 24 | # C++ object files produced when C/C++ Output file generation is configured. 25 | # Uncomment this if you are not using external objects (zlib library for example). 26 | #*.obj 27 | # 28 | 29 | # Delphi compiler-generated binaries (safe to delete) 30 | *.exe 31 | *.dll 32 | *.bpl 33 | *.bpi 34 | *.dcp 35 | *.so 36 | *.apk 37 | *.drc 38 | *.map 39 | *.dres 40 | *.rsm 41 | *.tds 42 | *.dcu 43 | *.lib 44 | *.a 45 | *.o 46 | *.ocx 47 | 48 | # Delphi autogenerated files (duplicated info) 49 | *.cfg 50 | *.hpp 51 | *Resource.rc 52 | 53 | # Delphi local files (user-specific info) 54 | *.local 55 | *.identcache 56 | *.projdata 57 | *.tvsconfig 58 | *.dsk 59 | 60 | # Delphi history and backups 61 | __history/ 62 | __recovery/ 63 | *.~* 64 | 65 | # Castalia statistics file (since XE7 Castalia is distributed with Delphi) 66 | *.stat 67 | 68 | # Boss dependency manager vendor folder https://github.com/HashLoad/boss 69 | modules/ 70 | -------------------------------------------------------------------------------- /BorlndMM DLL/BorlndMM.dpr: -------------------------------------------------------------------------------- 1 | { 2 | 3 | Replacement BorlndMM.DLL using FastMM5 4 | 5 | Description: 6 | A replacement borlndmm.dll using FastMM5 instead of the RTL memory manager. This DLL may be used instead of the 7 | default DLL together with your own applications, exposing the benefits of using FastMM5 to them. 8 | 9 | Usage: 10 | 1) Compile this DLL 11 | 2) Ship it with your applications that currently use the borlndmm.dll file that ships with Delphi. 12 | 13 | } 14 | 15 | {$IMAGEBASE $00D20000} 16 | 17 | // JCL_DEBUG_EXPERT_INSERTJDBG ON 18 | library BorlndMM; 19 | 20 | uses 21 | FastMM5 in '..\FastMM5.pas', 22 | {System.SysUtils is needed for exception handling.} 23 | System.SysUtils; 24 | 25 | {$R *.RES} 26 | 27 | function GetAllocMemCount: Integer; 28 | begin 29 | Result := 0; 30 | end; 31 | 32 | function GetAllocMemSize: Integer; 33 | begin 34 | Result := 0; 35 | end; 36 | 37 | procedure DumpBlocks; 38 | begin 39 | {Do nothing} 40 | end; 41 | 42 | function HeapRelease: Integer; 43 | begin 44 | {Do nothing} 45 | Result := 2; 46 | end; 47 | 48 | function HeapAddRef: Integer; 49 | begin 50 | {Do nothing} 51 | Result := 2; 52 | end; 53 | 54 | function FastMM_GetOutputDebugStringEvents: TFastMM_MemoryManagerEventTypeSet; 55 | begin 56 | Result := FastMM_OutputDebugStringEvents; 57 | end; 58 | 59 | procedure FastMM_SetOutputDebugStringEvents(AEventTypes: TFastMM_MemoryManagerEventTypeSet); 60 | begin 61 | FastMM_OutputDebugStringEvents := AEventTypes; 62 | end; 63 | 64 | function FastMM_GetLogToFileEvents: TFastMM_MemoryManagerEventTypeSet; 65 | begin 66 | Result := FastMM_LogToFileEvents; 67 | end; 68 | 69 | procedure FastMM_SetLogToFileEvents(AEventTypes: TFastMM_MemoryManagerEventTypeSet); 70 | begin 71 | FastMM_LogToFileEvents := AEventTypes; 72 | end; 73 | 74 | function FastMM_GetMessageBoxEvents: TFastMM_MemoryManagerEventTypeSet; 75 | begin 76 | Result := FastMM_MessageBoxEvents; 77 | end; 78 | 79 | procedure FastMM_SetMessageBoxEvents(AEventTypes: TFastMM_MemoryManagerEventTypeSet); 80 | begin 81 | FastMM_MessageBoxEvents := AEventTypes; 82 | end; 83 | 84 | {$ifdef DEBUG} 85 | {The debug support library must be statically linked in order to prevent it from being unloaded before the leak check 86 | can be performed.} 87 | function LogStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; 88 | external {$if SizeOf(Pointer) = 4}'FastMM_FullDebugMode.dll'{$else}'FastMM_FullDebugMode64.dll'{$endif} 89 | name 'LogStackTrace'; 90 | {$endif} 91 | 92 | exports 93 | GetAllocMemSize name 'GetAllocMemSize', 94 | GetAllocMemCount name 'GetAllocMemCount', 95 | FastMM_GetHeapStatus name 'GetHeapStatus', 96 | DumpBlocks name 'DumpBlocks', 97 | System.ReallocMemory name 'ReallocMemory', 98 | System.FreeMemory name 'FreeMemory', 99 | System.GetMemory name 'GetMemory', 100 | {$ifdef DEBUG} 101 | FastMM_DebugReallocMem name '@Borlndmm@SysReallocMem$qqrpvi', 102 | FastMM_DebugFreeMem name '@Borlndmm@SysFreeMem$qqrpv', 103 | FastMM_DebugGetMem name '@Borlndmm@SysGetMem$qqri', 104 | FastMM_DebugAllocMem name '@Borlndmm@SysAllocMem$qqri', 105 | {$else} 106 | FastMM_ReallocMem name '@Borlndmm@SysReallocMem$qqrpvi', 107 | FastMM_FreeMem name '@Borlndmm@SysFreeMem$qqrpv', 108 | FastMM_GetMem name '@Borlndmm@SysGetMem$qqri', 109 | FastMM_AllocMem name '@Borlndmm@SysAllocMem$qqri', 110 | {$endif} 111 | FastMM_RegisterExpectedMemoryLeak(ALeakedPointer: Pointer) name '@Borlndmm@SysRegisterExpectedMemoryLeak$qqrpi', 112 | FastMM_UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer) name '@Borlndmm@SysUnregisterExpectedMemoryLeak$qqrpi', 113 | HeapRelease name '@Borlndmm@HeapRelease$qqrv', 114 | HeapAddRef name '@Borlndmm@HeapAddRef$qqrv', 115 | {Export additional calls in order to make FastMM specific functionality available to the application and/or library.} 116 | FastMM_WalkBlocks, 117 | FastMM_ScanDebugBlocksForCorruption, 118 | FastMM_GetUsageSummary, 119 | FastMM_LogStateToFile, 120 | FastMM_EnterMinimumAddressAlignment, 121 | FastMM_ExitMinimumAddressAlignment, 122 | FastMM_GetCurrentMinimumAddressAlignment, 123 | FastMM_SetDefaultEventLogFilename, 124 | FastMM_SetEventLogFilename, 125 | FastMM_GetEventLogFilename, 126 | FastMM_DeleteEventLogFile, 127 | FastMM_GetOutputDebugStringEvents, 128 | FastMM_SetOutputDebugStringEvents, 129 | FastMM_GetLogToFileEvents, 130 | FastMM_SetLogToFileEvents, 131 | FastMM_GetMessageBoxEvents, 132 | FastMM_SetMessageBoxEvents; 133 | 134 | begin 135 | {$ifdef DEBUG} 136 | {Touch LogStackTrace in order to prevent the linker from eliminating the static link to the debug support library.} 137 | if @LogStackTrace <> nil then 138 | begin 139 | FastMM_EnterDebugMode; 140 | FastMM_MessageBoxEvents := FastMM_MessageBoxEvents + [mmetUnexpectedMemoryLeakDetail, mmetUnexpectedMemoryLeakSummary]; 141 | end; 142 | {$endif} 143 | end. 144 | -------------------------------------------------------------------------------- /BorlndMM DLL/BorlndMM.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {E9ECF6BA-0002-4690-B2C9-B93DEFE83ADC} 4 | BorlndMM.dpr 5 | True 6 | Release 7 | 3 8 | Library 9 | None 10 | 19.5 11 | Win32 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | true 56 | Cfg_2 57 | true 58 | true 59 | 60 | 61 | false 62 | false 63 | false 64 | false 65 | false 66 | 00400000 67 | true 68 | BorlndMM 69 | 1033 70 | CompanyName=;FileDescription=FastMM5 BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments=;CFBundleName= 71 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 72 | true 73 | 5 74 | 3 75 | 4 76 | 77 | 78 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 79 | Debug 80 | CompanyName=;FileDescription=FastMM5 BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments=;ProgramID= 81 | (None) 82 | none 83 | 84 | 85 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 86 | Debug 87 | CompanyName=;FileDescription=FastMM5 BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments= 88 | (None) 89 | none 90 | 91 | 92 | RELEASE;$(DCC_Define) 93 | 94 | 95 | CompanyName=;FileDescription=FastMM5 BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments=;ProgramID= 96 | 97 | 98 | CompanyName=;FileDescription=FastMM5 BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments= 99 | 100 | 101 | DEBUG;$(DCC_Define) 102 | 103 | 104 | CompanyName=;FileDescription=FastMM5 Debug BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments=;ProgramID= 105 | 106 | 107 | CompanyName=;FileDescription=FastMM5 Debug BorlndMM library;FileVersion=5.0.4.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=;ProductName=$(MSBuildProjectName);ProductVersion=5.0.4.0;Comments= 108 | 109 | 110 | 111 | MainSource 112 | 113 | 114 | 115 | Base 116 | 117 | 118 | Cfg_1 119 | Base 120 | 121 | 122 | Cfg_2 123 | Base 124 | 125 | 126 | 127 | Delphi.Personality.12 128 | 129 | 130 | 131 | 132 | BorlndMM.dpr 133 | 134 | 135 | 136 | True 137 | True 138 | 139 | 140 | 12 141 | 142 | 143 | 144 | 145 | -------------------------------------------------------------------------------- /BorlndMM DLL/Precompiled/32Bit/Debug/BorlndMM.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/BorlndMM DLL/Precompiled/32Bit/Debug/BorlndMM.dll -------------------------------------------------------------------------------- /BorlndMM DLL/Precompiled/32Bit/Release/BorlndMM.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/BorlndMM DLL/Precompiled/32Bit/Release/BorlndMM.dll -------------------------------------------------------------------------------- /BorlndMM DLL/Precompiled/64Bit/Debug/BorlndMM.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/BorlndMM DLL/Precompiled/64Bit/Debug/BorlndMM.dll -------------------------------------------------------------------------------- /BorlndMM DLL/Precompiled/64Bit/Release/BorlndMM.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/BorlndMM DLL/Precompiled/64Bit/Release/BorlndMM.dll -------------------------------------------------------------------------------- /Demos/Debug Features/Log Leaks and Errors To File/LogLeaksAndErrorsToFile.dpr: -------------------------------------------------------------------------------- 1 | {Memory error and leak logging demo application. 2 | 3 | When deploying this application, be sure to include the .map file generated by the linker, as well as the debug mode 4 | support DLL: FastMM_FullDebugMode.dll (FastMM_FullDebugMode64.dll for 64-bit) in the same folder as the executable.} 5 | 6 | program LogLeaksAndErrorsToFile; 7 | 8 | {$APPTYPE CONSOLE} 9 | 10 | {$R *.res} 11 | 12 | uses 13 | FastMM5, 14 | System.SysUtils; 15 | 16 | procedure ConfigureFastMM; 17 | begin 18 | {Puts FastMM in debug mode. In order to obtain stack traces for leaks and errors you need to do the following: 19 | 1) Enable a detailed map file in Project Options under Linking -> Map File 20 | 2) Put the FastMM_FullDebugMode.dll (FastMM_FullDebugMode64.dll for 64-bit) in the same folder as the executable. 21 | 3) Either put the .map file in the same folder as the executable OR embed JCL debug info into the executable.} 22 | FastMM_EnterDebugMode; 23 | 24 | {We do not want any dialog boxes for errors or leaks.} 25 | FastMM_MessageBoxEvents := []; 26 | 27 | {We want all errors, memory leak details as well as leak summaries logged to a text file.} 28 | FastMM_LogToFileEvents := FastMM_LogToFileEvents + [mmetUnexpectedMemoryLeakDetail, mmetUnexpectedMemoryLeakSummary]; 29 | end; 30 | 31 | procedure LeakMemory; 32 | begin 33 | TObject.Create; 34 | end; 35 | 36 | begin 37 | ConfigureFastMM; 38 | 39 | LeakMemory; 40 | end. 41 | -------------------------------------------------------------------------------- /Demos/Debug Features/Log Leaks and Errors To File/LogLeaksAndErrorsToFile.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {25FDB4DD-EC21-44F3-AD97-83532E5AB40A} 4 | 19.5 5 | None 6 | True 7 | Debug 8 | Win32 9 | 3 10 | Console 11 | LogLeaksAndErrorsToFile.dpr 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | false 44 | false 45 | false 46 | false 47 | false 48 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 49 | LogLeaksAndErrorsToFile 50 | 1033 51 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 52 | 53 | 54 | soapserver;IndySystem;vclwinx;fmx;vclie;DbxCommonDriver;bindengine;vcldb;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;frxTee;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;vclFireDAC;bindcompvclwinx;bindcomp;FireDACCommon;FmxTeeUI;QR5_R;IndyCore;RESTBackendComponents;bindcompfmx;PascalScript_Core_D;A407_R;bindcompdbx;frxADO;inetdb;rtl;FireDACMySQLDriver;FireDACSqliteDriver;DbxClientDriver;FireDACADSDriver;RESTComponents;soapmidas;DBXSqliteDriver;vcl;vclactnband;IndyIPServer;dsnapxml;fmxFireDAC;dbexpress;dsnapcon;adortl;TeeUI;Tee;Jcl;DBXMySQLDriver;CCL_R;frx;VclSmp;inet;frxe;vclimg;vcltouch;FireDACPgDriver;FireDAC;fmxase;inetdbxpress;xmlrtl;tethering;dbrtl;bindcompvcl;dsnap;fmxdae;TeeDB;CloudService;FireDACMSAccDriver;CustomIPTransport;fmxobj;bindcompvclsmp;FMXTee;JclDeveloperTools;frxDB;soaprtl;vcldsnap;DBXInterBaseDriver;FireDACIBDriver;$(DCC_UsePackage) 55 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 56 | Debug 57 | true 58 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 59 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 60 | 3 61 | C:\Temp5\(None) 62 | none 63 | 64 | 65 | soapserver;IndySystem;vclwinx;fmx;vclie;DbxCommonDriver;bindengine;vcldb;IndyIPCommon;VCLRESTComponents;FireDACCommonODBC;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;vclFireDAC;bindcompvclwinx;bindcomp;FireDACCommon;FmxTeeUI;IndyCore;RESTBackendComponents;bindcompfmx;bindcompdbx;inetdb;rtl;FireDACMySQLDriver;FireDACSqliteDriver;DbxClientDriver;FireDACADSDriver;RESTComponents;soapmidas;DBXSqliteDriver;vcl;vclactnband;IndyIPServer;dsnapxml;fmxFireDAC;dbexpress;dsnapcon;adortl;TeeUI;Tee;DBXMySQLDriver;VclSmp;inet;vclimg;vcltouch;FireDACPgDriver;FireDAC;fmxase;inetdbxpress;xmlrtl;tethering;dbrtl;bindcompvcl;dsnap;fmxdae;TeeDB;CloudService;FireDACMSAccDriver;CustomIPTransport;fmxobj;bindcompvclsmp;FMXTee;soaprtl;vcldsnap;DBXInterBaseDriver;FireDACIBDriver;$(DCC_UsePackage) 66 | true 67 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 68 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 69 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 70 | Debug 71 | 3 72 | C:\Temp5\(None) 73 | none 74 | 75 | 76 | DEBUG;$(DCC_Define) 77 | true 78 | false 79 | true 80 | true 81 | true 82 | true 83 | true 84 | 85 | 86 | false 87 | 88 | 89 | false 90 | RELEASE;$(DCC_Define) 91 | 0 92 | 0 93 | 94 | 95 | 96 | MainSource 97 | 98 | 99 | Base 100 | 101 | 102 | Cfg_1 103 | Base 104 | 105 | 106 | Cfg_2 107 | Base 108 | 109 | 110 | 111 | Delphi.Personality.12 112 | Application 113 | 114 | 115 | 116 | LogLeaksAndErrorsToFile.dpr 117 | 118 | 119 | 120 | True 121 | True 122 | 123 | 124 | 12 125 | 126 | 127 | 128 | 129 | 130 | -------------------------------------------------------------------------------- /Demos/Debug Features/Memory Corruption Detection/MemoryCorruptionDetectionDemo.dpr: -------------------------------------------------------------------------------- 1 | program MemoryCorruptionDetectionDemo; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | {FastMM5 has to be the first unit in the DPR, otherwise FastMM5 cannot install itself.} 7 | FastMM5, 8 | System.SysUtils; 9 | 10 | procedure Test; 11 | var 12 | LPointer: PByte; 13 | begin 14 | {Allocate a 1 byte memory block.} 15 | GetMem(LPointer, 1); 16 | 17 | {Write beyond the end of the allocated memory block, thus corrupting the memory pool.} 18 | LPointer[1] := 0; 19 | 20 | {Now try to free the block. FastMM will detect that the block has been corrupted and display an error report. This 21 | error report will also be logged to a file in the same folder as the application.} 22 | FreeMem(LPointer); 23 | end; 24 | 25 | begin 26 | {Debug mode enables various consistency checks that will catch most memory corruption issues. Enabling debug mode 27 | will attempt to load the FastMM_FullDebugMode.dll library - make sure it is in the same folder, or on the path. If 28 | successful, and a map file for the application (or embedded jdbg info) is available, then crash reports will include 29 | unit and line information that will help with finding the cause of the error.} 30 | FastMM_EnterDebugMode; 31 | 32 | try 33 | Test; 34 | except 35 | on E: Exception do 36 | Writeln(E.ClassName, ': ', E.Message); 37 | end; 38 | end. 39 | -------------------------------------------------------------------------------- /Demos/Debug Features/Memory Corruption Detection/MemoryCorruptionDetectionDemo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {E87AE5B9-CF97-43D2-BC80-0734BF20C3A9} 4 | 19.5 5 | None 6 | True 7 | Debug 8 | Win32 9 | 3 10 | Console 11 | MemoryCorruptionDetectionDemo.dpr 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Base 40 | true 41 | 42 | 43 | false 44 | false 45 | false 46 | false 47 | false 48 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 49 | MemoryCorruptionDetectionDemo 50 | 3 51 | 7177 52 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 53 | 54 | 55 | vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;QR5_R;emsedge;bindcompfmx;DBXFirebirdDriver;A407_R;frxADO;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;Jcl;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;JclDeveloperTools;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;vcldb;frxTee;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;PascalScript_Core_D;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;CCL_R;DBXSybaseASEDriver;DBXDb2Driver;frx;frxe;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;FMXTee;frxDB;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) 56 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 57 | Debug 58 | 1033 59 | true 60 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 61 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 62 | (None) 63 | none 64 | 65 | 66 | vclwinx;DataSnapServer;fmx;emshosting;vclie;DbxCommonDriver;bindengine;IndyIPCommon;VCLRESTComponents;DBXMSSQLDriver;FireDACCommonODBC;emsclient;FireDACCommonDriver;appanalytics;IndyProtocols;vclx;IndyIPClient;dbxcds;vcledge;bindcompvclwinx;FmxTeeUI;emsedge;bindcompfmx;DBXFirebirdDriver;inetdb;FireDACSqliteDriver;DbxClientDriver;FireDACASADriver;Tee;soapmidas;vclactnband;TeeUI;fmxFireDAC;dbexpress;FireDACInfxDriver;DBXMySQLDriver;VclSmp;inet;DataSnapCommon;vcltouch;fmxase;DBXOdbcDriver;dbrtl;FireDACDBXDriver;FireDACOracleDriver;fmxdae;TeeDB;FireDACMSAccDriver;CustomIPTransport;FireDACMSSQLDriver;DataSnapIndy10ServerTransport;DataSnapConnectors;vcldsnap;DBXInterBaseDriver;FireDACMongoDBDriver;IndySystem;FireDACTDataDriver;vcldb;vclFireDAC;bindcomp;FireDACCommon;DataSnapServerMidas;FireDACODBCDriver;emsserverresource;IndyCore;RESTBackendComponents;bindcompdbx;rtl;FireDACMySQLDriver;FireDACADSDriver;RESTComponents;DBXSqliteDriver;vcl;IndyIPServer;dsnapxml;dsnapcon;DataSnapClient;DataSnapProviderClient;adortl;DBXSybaseASEDriver;DBXDb2Driver;vclimg;DataSnapFireDAC;emsclientfiredac;FireDACPgDriver;FireDAC;FireDACDSDriver;inetdbxpress;xmlrtl;tethering;bindcompvcl;dsnap;CloudService;DBXSybaseASADriver;DBXOracleDriver;FireDACDb2Driver;DBXInformixDriver;fmxobj;bindcompvclsmp;DataSnapNativeClient;FMXTee;DatasnapConnectorsFreePascal;soaprtl;soapserver;FireDACIBDriver;$(DCC_UsePackage) 67 | true 68 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 69 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 70 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 71 | Debug 72 | 1033 73 | (None) 74 | none 75 | 76 | 77 | DEBUG;$(DCC_Define) 78 | true 79 | false 80 | true 81 | true 82 | true 83 | true 84 | true 85 | 86 | 87 | false 88 | 1033 89 | (None) 90 | none 91 | 92 | 93 | false 94 | RELEASE;$(DCC_Define) 95 | 0 96 | 0 97 | 98 | 99 | 100 | MainSource 101 | 102 | 103 | Base 104 | 105 | 106 | Cfg_1 107 | Base 108 | 109 | 110 | Cfg_2 111 | Base 112 | 113 | 114 | 115 | 116 | 117 | 118 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/Delay loaded DLL/FastMMInitSharing.pas: -------------------------------------------------------------------------------- 1 | {Important note: This has to be the first unit in the DPR, because memory managers cannot be switched once memory has 2 | been allocated, and the initialization sections of other units are likely to allocate memory.} 3 | 4 | unit FastMMInitSharing; 5 | 6 | interface 7 | 8 | uses 9 | FastMM5; 10 | 11 | implementation 12 | 13 | initialization 14 | {First try to share this memory manager. This will fail if another module is already sharing its memory manager. In 15 | case of the latter, try to use the memory manager shared by the other module.} 16 | if FastMM_ShareMemoryManager then 17 | begin 18 | {Try to load the debug support library (FastMM_FullDebugMode.dll, or FastMM_FullDebugMode64.dll under 64-bit). If 19 | it is available, then enter debug mode.} 20 | if FastMM_LoadDebugSupportLibrary then 21 | begin 22 | FastMM_EnterDebugMode; 23 | {In debug mode, also show the stack traces for memory leaks.} 24 | FastMM_MessageBoxEvents := FastMM_MessageBoxEvents + [mmetUnexpectedMemoryLeakDetail]; 25 | end; 26 | end 27 | else 28 | begin 29 | {Another module is already sharing its memory manager, so try to use that.} 30 | FastMM_AttemptToUseSharedMemoryManager; 31 | end; 32 | 33 | end. 34 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/Delay loaded DLL/TestApp.dpr: -------------------------------------------------------------------------------- 1 | // JCL_DEBUG_EXPERT_INSERTJDBG ON 2 | program TestApp; 3 | 4 | {$APPTYPE CONSOLE} 5 | 6 | uses 7 | FastMMInitSharing, 8 | System.Classes; 9 | 10 | {Note that TestLibrary.dll is delay loaded, so it will be initialized after the main application. Consequently the 11 | library will be sharing the memory manager of the main application.} 12 | procedure LeakMemory; external 'TestLibrary' delayed; 13 | 14 | begin 15 | ReportMemoryLeaksOnShutdown := True; 16 | 17 | {Leak a TPersistent in the main application} 18 | TPersistent.Create; 19 | {Leak a TObject in the library} 20 | LeakMemory; 21 | end. 22 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/Delay loaded DLL/TestLibrary.dpr: -------------------------------------------------------------------------------- 1 | {This sample library exports a single call that will leak a TObject.} 2 | 3 | // JCL_DEBUG_EXPERT_INSERTJDBG ON 4 | library TestLibrary; 5 | 6 | uses 7 | FastMMInitSharing; 8 | 9 | procedure LeakMemory; 10 | begin 11 | TObject.Create; 12 | end; 13 | 14 | exports LeakMemory; 15 | 16 | begin 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/ShareMem/ShareMemDemo.dpr: -------------------------------------------------------------------------------- 1 | // JCL_DEBUG_EXPERT_INSERTJDBG ON 2 | program ShareMemDemo; 3 | 4 | {$APPTYPE CONSOLE} 5 | 6 | uses 7 | System.ShareMem, 8 | System.Classes; 9 | 10 | procedure LeakMemory; external 'TestLibrary'; 11 | 12 | begin 13 | {Leak memory in the library} 14 | LeakMemory; 15 | 16 | {Leak memory in the main application.} 17 | TPersistent.Create; 18 | 19 | end. 20 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/ShareMem/ShareMemDemo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {0F3B4294-351C-4BD5-8742-30FF9F553FA1} 4 | ShareMemDemo.dpr 5 | True 6 | Debug 7 | 3 8 | Console 9 | None 10 | 19.4 11 | Win64 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | true 56 | Cfg_2 57 | true 58 | true 59 | 60 | 61 | false 62 | false 63 | false 64 | false 65 | false 66 | 00400000 67 | ShareMemDemo 68 | 7177 69 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 70 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 71 | $(BDS)\bin\delphi_PROJECTICON.ico 72 | $(BDS)\bin\delphi_PROJECTICNS.icns 73 | rtl;$(DCC_UsePackage) 74 | 3 75 | true 76 | 77 | 78 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 79 | Debug 80 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 81 | 1033 82 | (None) 83 | none 84 | 85 | 86 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 87 | Debug 88 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 89 | 1033 90 | (None) 91 | none 92 | 93 | 94 | RELEASE;$(DCC_Define) 95 | 0 96 | false 97 | 0 98 | 99 | 100 | 1033 101 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 102 | 103 | 104 | 1033 105 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 106 | 107 | 108 | DEBUG;$(DCC_Define) 109 | false 110 | true 111 | true 112 | true 113 | 114 | 115 | 1033 116 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 117 | 118 | 119 | 1033 120 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 121 | 122 | 123 | 124 | MainSource 125 | 126 | 127 | Base 128 | 129 | 130 | Cfg_1 131 | Base 132 | 133 | 134 | Cfg_2 135 | Base 136 | 137 | 138 | 139 | Delphi.Personality.12 140 | 141 | 142 | 143 | 144 | ShareMemDemo.dpr 145 | 146 | 147 | Microsoft Office 2000 Sample Automation Server Wrapper Components 148 | Microsoft Office XP Sample Automation Server Wrapper Components 149 | 150 | 151 | 152 | True 153 | True 154 | 155 | 156 | 12 157 | 158 | 159 | 160 | 161 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/ShareMem/ShareMemDemo.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Demos/Memory Manager Sharing/ShareMem/ShareMemDemo.res -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/ShareMem/TestLibrary.dpr: -------------------------------------------------------------------------------- 1 | {This sample library exports a single call that will leak a TObject.} 2 | 3 | // JCL_DEBUG_EXPERT_INSERTJDBG ON 4 | library TestLibrary; 5 | 6 | uses 7 | System.ShareMem; 8 | 9 | procedure LeakMemory; 10 | begin 11 | TObject.Create; 12 | end; 13 | 14 | exports LeakMemory; 15 | 16 | begin 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/ShareMem/TestLibrary.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {AB6FEE68-0141-4E9F-99D5-EB10122B5946} 4 | TestLibrary.dpr 5 | True 6 | Debug 7 | 3 8 | Library 9 | None 10 | 19.4 11 | Win64 12 | 13 | 14 | true 15 | 16 | 17 | true 18 | Base 19 | true 20 | 21 | 22 | true 23 | Base 24 | true 25 | 26 | 27 | true 28 | Base 29 | true 30 | 31 | 32 | true 33 | Cfg_1 34 | true 35 | true 36 | 37 | 38 | true 39 | Cfg_1 40 | true 41 | true 42 | 43 | 44 | true 45 | Base 46 | true 47 | 48 | 49 | true 50 | Cfg_2 51 | true 52 | true 53 | 54 | 55 | true 56 | Cfg_2 57 | true 58 | true 59 | 60 | 61 | false 62 | false 63 | false 64 | false 65 | false 66 | 00400000 67 | true 68 | TestLibrary 69 | 7177 70 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName= 71 | System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace) 72 | rtl;$(DCC_UsePackage) 73 | 3 74 | true 75 | 76 | 77 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 78 | Debug 79 | true 80 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 81 | 1033 82 | ShareMemDemo.exe 83 | (None) 84 | none 85 | 86 | 87 | Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 88 | Debug 89 | true 90 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 91 | 1033 92 | ShareMemDemo.exe 93 | (None) 94 | none 95 | 96 | 97 | RELEASE;$(DCC_Define) 98 | 0 99 | false 100 | 0 101 | 102 | 103 | true 104 | 1033 105 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 106 | 107 | 108 | true 109 | 1033 110 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 111 | 112 | 113 | DEBUG;$(DCC_Define) 114 | false 115 | true 116 | true 117 | true 118 | 119 | 120 | true 121 | 1033 122 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 123 | 124 | 125 | true 126 | 1033 127 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 128 | 129 | 130 | 131 | MainSource 132 | 133 | 134 | Base 135 | 136 | 137 | Cfg_1 138 | Base 139 | 140 | 141 | Cfg_2 142 | Base 143 | 144 | 145 | 146 | Delphi.Personality.12 147 | 148 | 149 | 150 | 151 | TestLibrary.dpr 152 | 153 | 154 | Microsoft Office 2000 Sample Automation Server Wrapper Components 155 | Microsoft Office XP Sample Automation Server Wrapper Components 156 | 157 | 158 | 159 | True 160 | True 161 | 162 | 163 | 12 164 | 165 | 166 | 167 | 168 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/ShareMem/TestLibrary.res: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Demos/Memory Manager Sharing/ShareMem/TestLibrary.res -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/Statically Linked DLL/FastMMInitSharing.pas: -------------------------------------------------------------------------------- 1 | {Important note: This has to be the first unit in the DPR, because memory managers cannot be switched once memory has 2 | been allocated, and the initialization sections of other units are likely to allocate memory.} 3 | 4 | unit FastMMInitSharing; 5 | 6 | interface 7 | 8 | uses 9 | FastMM5; 10 | 11 | implementation 12 | 13 | initialization 14 | {First try to share this memory manager. This will fail if another module is already sharing its memory manager. In 15 | case of the latter, try to use the memory manager shared by the other module.} 16 | if not FastMM_ShareMemoryManager then 17 | FastMM_AttemptToUseSharedMemoryManager; 18 | end. 19 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/Statically Linked DLL/TestApp.dpr: -------------------------------------------------------------------------------- 1 | program TestApp; 2 | 3 | {$APPTYPE CONSOLE} 4 | 5 | uses 6 | FastMMInitSharing, 7 | System.Classes; 8 | 9 | {Note that TestLibrary.dll is statically linked, so it will be initialized before the main application. This means the 10 | main application will actually be sharing the memory manager of the DLL. (If TestLibrary was loaded dynamically then 11 | it would be sharing the memory manager of the main application.)} 12 | procedure LeakMemory; external 'TestLibrary'; 13 | 14 | begin 15 | {Leak a TPersistent in the main application} 16 | TPersistent.Create; 17 | {Leak a TObject in the library} 18 | LeakMemory; 19 | end. 20 | -------------------------------------------------------------------------------- /Demos/Memory Manager Sharing/Statically Linked DLL/TestLibrary.dpr: -------------------------------------------------------------------------------- 1 | {This sample library exports a single call that will leak a TObject.} 2 | 3 | library TestLibrary; 4 | 5 | uses 6 | FastMMInitSharing; 7 | 8 | procedure LeakMemory; 9 | begin 10 | TObject.Create; 11 | end; 12 | 13 | exports LeakMemory; 14 | 15 | begin 16 | ReportMemoryLeaksOnShutdown := True; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/Usage Tracker/DemoForm.dfm: -------------------------------------------------------------------------------- 1 | object fDemo: TfDemo 2 | Left = 199 3 | Top = 114 4 | BorderIcons = [biSystemMenu] 5 | BorderStyle = bsSingle 6 | Caption = 'Usage Tracker Demo' 7 | ClientHeight = 53 8 | ClientWidth = 239 9 | Color = clBtnFace 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'MS Sans Serif' 14 | Font.Style = [] 15 | Position = poScreenCenter 16 | TextHeight = 13 17 | object bShowTracker: TButton 18 | Left = 8 19 | Top = 8 20 | Width = 221 21 | Height = 37 22 | Caption = 'Show Usage Tracker' 23 | TabOrder = 0 24 | OnClick = bShowTrackerClick 25 | end 26 | end 27 | -------------------------------------------------------------------------------- /Demos/Usage Tracker/DemoForm.pas: -------------------------------------------------------------------------------- 1 | unit DemoForm; 2 | 3 | interface 4 | 5 | uses 6 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, FastMMUsageTracker; 7 | 8 | type 9 | TfDemo = class(TForm) 10 | bShowTracker: TButton; 11 | procedure bShowTrackerClick(Sender: TObject); 12 | private 13 | public 14 | end; 15 | 16 | var 17 | fDemo: TfDemo; 18 | 19 | implementation 20 | 21 | {$R *.dfm} 22 | 23 | procedure TfDemo.bShowTrackerClick(Sender: TObject); 24 | begin 25 | ShowFastMMUsageTracker; 26 | end; 27 | 28 | end. 29 | -------------------------------------------------------------------------------- /Demos/Usage Tracker/FastMMUsageTracker.dfm: -------------------------------------------------------------------------------- 1 | object fFastMMUsageTracker: TfFastMMUsageTracker 2 | Left = 460 3 | Top = 178 4 | BorderIcons = [biSystemMenu] 5 | BorderStyle = bsSingle 6 | Caption = 'FastMM Memory Usage Tracker' 7 | ClientHeight = 556 8 | ClientWidth = 553 9 | Color = clBtnFace 10 | Font.Charset = DEFAULT_CHARSET 11 | Font.Color = clWindowText 12 | Font.Height = -11 13 | Font.Name = 'MS Sans Serif' 14 | Font.Style = [] 15 | Position = poScreenCenter 16 | OnClose = FormClose 17 | OnCreate = FormCreate 18 | TextHeight = 13 19 | object bClose: TBitBtn 20 | Left = 472 21 | Top = 524 22 | Width = 75 23 | Height = 25 24 | Caption = 'Close' 25 | Glyph.Data = { 26 | 76010000424D7601000000000000760000002800000020000000100000000100 27 | 04000000000000010000130B0000130B00001000000000000000000000000000 28 | 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 29 | FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00333333333333 30 | 3333333333FFFFF3333333333999993333333333F77777FFF333333999999999 31 | 3333333777333777FF3333993333339993333377FF3333377FF3399993333339 32 | 993337777FF3333377F3393999333333993337F777FF333337FF993399933333 33 | 399377F3777FF333377F993339993333399377F33777FF33377F993333999333 34 | 399377F333777FF3377F993333399933399377F3333777FF377F993333339993 35 | 399377FF3333777FF7733993333339993933373FF3333777F7F3399933333399 36 | 99333773FF3333777733339993333339933333773FFFFFF77333333999999999 37 | 3333333777333777333333333999993333333333377777333333} 38 | NumGlyphs = 2 39 | TabOrder = 0 40 | OnClick = bCloseClick 41 | end 42 | object bUpdate: TBitBtn 43 | Left = 392 44 | Top = 524 45 | Width = 75 46 | Height = 25 47 | Caption = 'Update' 48 | Glyph.Data = { 49 | 76010000424D7601000000000000760000002800000020000000100000000100 50 | 04000000000000010000120B0000120B00001000000000000000000000000000 51 | 800000800000008080008000000080008000808000007F7F7F00BFBFBF000000 52 | FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00370777033333 53 | 3330337F3F7F33333F3787070003333707303F737773333373F7007703333330 54 | 700077337F3333373777887007333337007733F773F333337733700070333333 55 | 077037773733333F7F37703707333300080737F373333377737F003333333307 56 | 78087733FFF3337FFF7F33300033330008073F3777F33F777F73073070370733 57 | 078073F7F7FF73F37FF7700070007037007837773777F73377FF007777700730 58 | 70007733FFF77F37377707700077033707307F37773F7FFF7337080777070003 59 | 3330737F3F7F777F333778080707770333333F7F737F3F7F3333080787070003 60 | 33337F73FF737773333307800077033333337337773373333333} 61 | NumGlyphs = 2 62 | TabOrder = 1 63 | OnClick = bUpdateClick 64 | end 65 | object ChkAutoUpdate: TCheckBox 66 | Left = 280 67 | Top = 528 68 | Width = 97 69 | Height = 17 70 | Caption = 'Auto Update' 71 | TabOrder = 2 72 | OnClick = ChkAutoUpdateClick 73 | end 74 | object pcUsageTracker: TPageControl 75 | Left = 0 76 | Top = 0 77 | Width = 553 78 | Height = 521 79 | ActivePage = tsGeneralInformation 80 | Align = alTop 81 | TabOrder = 3 82 | object tsAllocation: TTabSheet 83 | Caption = 'FastMM4 Allocation' 84 | object sgBlockStatistics: TStringGrid 85 | Left = 4 86 | Top = 4 87 | Width = 533 88 | Height = 481 89 | DefaultColWidth = 83 90 | DefaultRowHeight = 17 91 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] 92 | PopupMenu = smMM4Allocation 93 | ScrollBars = ssVertical 94 | TabOrder = 0 95 | OnDrawCell = sgBlockStatisticsDrawCell 96 | ColWidths = ( 97 | 83 98 | 104 99 | 106 100 | 106 101 | 108) 102 | end 103 | end 104 | object tsVMGraph: TTabSheet 105 | Caption = 'VM Graph' 106 | ImageIndex = 1 107 | object Label1: TLabel 108 | Left = 8 109 | Top = 440 110 | Width = 38 111 | Height = 13 112 | Caption = 'Address' 113 | end 114 | object Label2: TLabel 115 | Left = 152 116 | Top = 440 117 | Width = 25 118 | Height = 13 119 | Caption = 'State' 120 | end 121 | object Label3: TLabel 122 | Left = 8 123 | Top = 468 124 | Width = 43 125 | Height = 13 126 | Caption = 'Exe/DLL' 127 | end 128 | object eAddress: TEdit 129 | Left = 60 130 | Top = 436 131 | Width = 81 132 | Height = 21 133 | Enabled = False 134 | TabOrder = 0 135 | Text = '$00000000' 136 | end 137 | object eState: TEdit 138 | Left = 184 139 | Top = 436 140 | Width = 105 141 | Height = 21 142 | Enabled = False 143 | TabOrder = 1 144 | Text = 'Unallocated' 145 | end 146 | object eDLLName: TEdit 147 | Left = 60 148 | Top = 464 149 | Width = 477 150 | Height = 21 151 | ReadOnly = True 152 | TabOrder = 2 153 | end 154 | object ChkSmallGraph: TCheckBox 155 | Left = 304 156 | Top = 436 157 | Width = 97 158 | Height = 21 159 | Caption = 'Small Map' 160 | Checked = True 161 | State = cbChecked 162 | TabOrder = 3 163 | OnClick = ChkSmallGraphClick 164 | end 165 | object dgMemoryMap: TDrawGrid 166 | Left = 4 167 | Top = 4 168 | Width = 533 169 | Height = 425 170 | ColCount = 64 171 | DefaultColWidth = 8 172 | DefaultRowHeight = 8 173 | FixedCols = 0 174 | RowCount = 1024 175 | FixedRows = 0 176 | GridLineWidth = 0 177 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] 178 | ScrollBars = ssVertical 179 | TabOrder = 4 180 | OnDrawCell = dgMemoryMapDrawCell 181 | OnSelectCell = dgMemoryMapSelectCell 182 | end 183 | end 184 | object tsVMDump: TTabSheet 185 | Caption = 'VM Dump' 186 | ImageIndex = 2 187 | object sgVMDump: TStringGrid 188 | Left = 4 189 | Top = 4 190 | Width = 533 191 | Height = 481 192 | DefaultColWidth = 83 193 | DefaultRowHeight = 17 194 | FixedCols = 0 195 | Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine] 196 | PopupMenu = smVMDump 197 | ScrollBars = ssVertical 198 | TabOrder = 0 199 | OnDrawCell = sgVMDumpDrawCell 200 | OnMouseDown = sgVMDumpMouseDown 201 | OnMouseUp = sgVMDumpMouseUp 202 | ColWidths = ( 203 | 83 204 | 96 205 | 60 206 | 58 207 | 209) 208 | end 209 | end 210 | object tsGeneralInformation: TTabSheet 211 | Caption = 'General Information' 212 | ImageIndex = 3 213 | object mVMStatistics: TMemo 214 | Left = 4 215 | Top = 4 216 | Width = 533 217 | Height = 481 218 | Font.Charset = ANSI_CHARSET 219 | Font.Color = clWindowText 220 | Font.Height = -11 221 | Font.Name = 'Courier New' 222 | Font.Style = [] 223 | ParentFont = False 224 | PopupMenu = smGeneralInformation 225 | ReadOnly = True 226 | ScrollBars = ssVertical 227 | TabOrder = 0 228 | end 229 | end 230 | end 231 | object tTimer: TTimer 232 | Enabled = False 233 | Interval = 2000 234 | OnTimer = tTimerTimer 235 | Left = 128 236 | Top = 512 237 | end 238 | object smVMDump: TPopupMenu 239 | Left = 100 240 | Top = 512 241 | object miVMDumpCopyAlltoClipboard: TMenuItem 242 | Caption = '&Copy All to Clipboard' 243 | OnClick = miVMDumpCopyAlltoClipboardClick 244 | end 245 | end 246 | object smGeneralInformation: TPopupMenu 247 | Left = 68 248 | Top = 512 249 | object miGeneralInformationCopyAlltoClipboard: TMenuItem 250 | Caption = '&Copy All to Clipboard' 251 | OnClick = miGeneralInformationCopyAlltoClipboardClick 252 | end 253 | end 254 | object smMM4Allocation: TPopupMenu 255 | Left = 36 256 | Top = 512 257 | object siMM4AllocationCopyAlltoClipboard: TMenuItem 258 | Caption = '&Copy All to Clipboard' 259 | OnClick = siMM4AllocationCopyAlltoClipboardClick 260 | end 261 | end 262 | end 263 | -------------------------------------------------------------------------------- /Demos/Usage Tracker/FastMMUsageTracker.pas: -------------------------------------------------------------------------------- 1 | (* 2 | 3 | Fast Memory Manager Usage Tracker 2.20 4 | 5 | Description: 6 | 7 | - Shows FastMM5 allocation usage 8 | 9 | - Shows VM Memory in graphical map 10 | - Free 11 | - Commit 12 | - Reserved 13 | - EXE (Red) 14 | - DLLs (Blue) 15 | 16 | - VM Dump of the whole process 17 | (2GB standard, 3GB with the /3G switch set, and 4GB under WoW64) 18 | 19 | - General Information 20 | - System memory usage 21 | - Process memory usage 22 | - 5 Largest contiguous free VM memory spaces 23 | - FastMM5 summary information 24 | 25 | Usage: 26 | - Add the FastMMUsageTracker unit 27 | - Add the ShowFastMMUsageTracker procedure to an event 28 | - FastMMUsageTracker form should not be autocreated 29 | 30 | Notes: 31 | - Consider setting the base adress of your BPLs & DLLs or use Microsoft's 32 | ReBase.exe to set third party BPLs and DLLs. Libraries that do not have to 33 | be relocated can be shared across processes, thus conserving system 34 | resources. 35 | - The first of the "Largest contiguous free VM memory spaces" gives you an 36 | indication of the largest single memory block that can be allocated. 37 | 38 | Change log: 39 | 40 | Version 2.10 (22 September 2009): 41 | - New usage tracker implemented by Hanspeter Widmer with many new features. 42 | (Thanks Hanspeter!); 43 | - Colour coding of changes in the allocation map added by Murray McGowan 44 | (red for an increase in usage, green for a decrease). (Thanks Murray!) 45 | Version 2.2 (2 April 2024): 46 | - Updated for FastMM5 47 | *) 48 | 49 | unit FastMMUsageTracker; 50 | 51 | interface 52 | 53 | uses 54 | Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Grids, 55 | Buttons, ComCtrls, Menus, FastMM5; 56 | 57 | type 58 | TChunkStatusEx = ( 59 | {Items that correspond to the same entry in TChunkStatus} 60 | csExUnallocated, 61 | csExAllocated, 62 | csExReserved, 63 | csExSysAllocated, 64 | csExSysReserved, 65 | {TChunkStatusEx additional detail} 66 | csExSysExe, 67 | csExSysDLL); 68 | 69 | TMemoryMapEx = array[0..65535] of TChunkStatusEx; 70 | 71 | TfFastMMUsageTracker = class(TForm) 72 | tTimer: TTimer; 73 | bClose: TBitBtn; 74 | bUpdate: TBitBtn; 75 | ChkAutoUpdate: TCheckBox; 76 | smVMDump: TPopupMenu; 77 | smMM4Allocation: TPopupMenu; 78 | smGeneralInformation: TPopupMenu; 79 | miVMDumpCopyAlltoClipboard: TMenuItem; 80 | miGeneralInformationCopyAlltoClipboard: TMenuItem; 81 | siMM4AllocationCopyAlltoClipboard: TMenuItem; 82 | pcUsageTracker: TPageControl; 83 | tsAllocation: TTabSheet; 84 | tsVMGraph: TTabSheet; 85 | tsVMDump: TTabSheet; 86 | tsGeneralInformation: TTabSheet; 87 | mVMStatistics: TMemo; 88 | sgVMDump: TStringGrid; 89 | Label1: TLabel; 90 | Label2: TLabel; 91 | Label3: TLabel; 92 | eAddress: TEdit; 93 | eState: TEdit; 94 | eDLLName: TEdit; 95 | ChkSmallGraph: TCheckBox; 96 | sgBlockStatistics: TStringGrid; 97 | dgMemoryMap: TDrawGrid; 98 | procedure FormClose(Sender: TObject; var Action: TCloseAction); 99 | procedure tTimerTimer(Sender: TObject); 100 | procedure FormCreate(Sender: TObject); 101 | procedure bCloseClick(Sender: TObject); 102 | procedure dgMemoryMapDrawCell(Sender: TObject; ACol, ARow: Integer; 103 | Rect: TRect; State: TGridDrawState); 104 | procedure dgMemoryMapSelectCell(Sender: TObject; ACol, ARow: Integer; 105 | var CanSelect: Boolean); 106 | procedure bUpdateClick(Sender: TObject); 107 | procedure ChkAutoUpdateClick(Sender: TObject); 108 | procedure ChkSmallGraphClick(Sender: TObject); 109 | procedure sgVMDumpMouseDown(Sender: TObject; Button: TMouseButton; 110 | Shift: TShiftState; X, Y: Integer); 111 | procedure sgVMDumpMouseUp(Sender: TObject; Button: TMouseButton; 112 | Shift: TShiftState; X, Y: Integer); 113 | procedure sgVMDumpDrawCell(Sender: TObject; ACol, ARow: Integer; 114 | Rect: TRect; State: TGridDrawState); 115 | procedure miVMDumpCopyAlltoClipboardClick(Sender: TObject); 116 | procedure miGeneralInformationCopyAlltoClipboardClick(Sender: TObject); 117 | procedure siMM4AllocationCopyAlltoClipboardClick(Sender: TObject); 118 | procedure sgBlockStatisticsDrawCell(Sender: TObject; ACol, 119 | ARow: Integer; Rect: TRect; State: TGridDrawState); 120 | private 121 | {The current and previous memory manager states} 122 | FMemoryManagerState, FPrevMemoryManagerState: TFastMM_MemoryManagerState; 123 | FMemoryMapEx: TMemoryMapEx; 124 | AddressSpacePageCount: Integer; 125 | OR_VMDumpDownCell: TGridCoord; 126 | procedure HeaderClicked(AGrid: TStringgrid; const ACell: TGridCoord); 127 | procedure SortGrid(grid: TStringgrid; PB_Nummeric: Boolean; byColumn: Integer; ascending: Boolean); 128 | procedure UpdateGraphMetrics; 129 | public 130 | {Refreshes the display} 131 | procedure RefreshSnapShot; 132 | end; 133 | 134 | function ShowFastMMUsageTracker: TfFastMMUsageTracker; 135 | 136 | implementation 137 | 138 | uses 139 | Clipbrd, PsAPI; 140 | 141 | {$R *.dfm} 142 | 143 | const 144 | SystemBasicInformation = 0; 145 | SystemPerformanceInformation = 2; 146 | SystemTimeInformation = 3; 147 | 148 | 149 | type 150 | {To get access to protected methods} 151 | TLocalStringGrid = class(TStringGrid); 152 | 153 | TMemoryStatusEx = packed record 154 | dwLength: DWORD; 155 | dwMemoryLoad: DWORD; 156 | ullTotalPhys: Int64; 157 | ullAvailPhys: Int64; 158 | ullTotalPageFile: Int64; 159 | ullAvailPageFile: Int64; 160 | ullTotalVirtual: Int64; 161 | ullAvailVirtual: Int64; 162 | ullAvailExtendedVirtual: Int64; 163 | end; 164 | PMemoryStatusEx = ^TMemoryStatusEx; 165 | LPMEMORYSTATUSEX = PMemoryStatusEx; 166 | 167 | TP_GlobalMemoryStatusEx = function( 168 | var PR_MemStatusEx: TMemoryStatusEx): LongBool; stdcall; 169 | 170 | TSystem_Basic_Information = packed record 171 | dwUnknown1: DWORD; 172 | uKeMaximumIncrement: ULONG; 173 | uPageSize: ULONG; 174 | uMmNumberOfPhysicalPages: ULONG; 175 | uMmLowestPhysicalPage: ULONG; 176 | uMmHighestPhysicalPage: ULONG; 177 | uAllocationGranularity: ULONG; 178 | pLowestUserAddress: Pointer; 179 | pMmHighestUserAddress: Pointer; 180 | uKeActiveProcessors: ULONG; 181 | bKeNumberProcessors: Byte; 182 | bUnknown2: Byte; 183 | wUnknown3: Word; 184 | end; 185 | 186 | TSystem_Performance_Information = packed record 187 | liIdleTime: LARGE_INTEGER; 188 | dwSpare: array[0..75] of DWORD; 189 | end; 190 | 191 | TSystem_Time_Information = packed record 192 | liKeBootTime: LARGE_INTEGER; 193 | liKeSystemTime: LARGE_INTEGER; 194 | liExpTimeZoneBias: LARGE_INTEGER; 195 | uCurrentTimeZoneId: ULONG; 196 | dwReserved: DWORD; 197 | end; 198 | 199 | TP_NtQuerySystemInformation = function(InfoClass: DWORD; Buffer: Pointer; 200 | BufSize: DWORD; ReturnSize: PCardinal): DWORD; stdcall; 201 | 202 | var 203 | MP_GlobalMemoryStatusEx: TP_GlobalMemoryStatusEx = nil; 204 | MP_NtQuerySystemInformation: TP_NtQuerySystemInformation = nil; 205 | 206 | //----------------------------------------------------------------------------- 207 | // Various Global Procedures 208 | //----------------------------------------------------------------------------- 209 | 210 | function ShowFastMMUsageTracker: TfFastMMUsageTracker; 211 | begin 212 | Application.CreateForm(TfFastMMUsageTracker, Result); 213 | if Assigned(Result) then 214 | begin 215 | Result.RefreshSnapShot; 216 | Result.Show; 217 | end; 218 | end; 219 | 220 | function CardinalToStringFormatted(const ACardinal: Cardinal): string; 221 | begin 222 | Result := FormatFloat('#,##0', ACardinal); 223 | end; 224 | 225 | function Int64ToStringFormatted(const AInt64: Int64): string; 226 | begin 227 | Result := FormatFloat('#,##0', AInt64); 228 | end; 229 | 230 | function CardinalToKStringFormatted(const ACardinal: Cardinal): string; 231 | begin 232 | Result := FormatFloat('#,##0', ACardinal div 1024) + 'K'; 233 | end; 234 | 235 | function Int64ToKStringFormatted(const AInt64: Int64): string; 236 | begin 237 | Result := FormatFloat('#,##0', AInt64 div 1024) + 'K'; 238 | end; 239 | 240 | procedure CopyGridContentsToClipBoard(AStringGrid: TStringGrid); 241 | const 242 | TAB = Chr(VK_TAB); 243 | CRLF = #13#10; 244 | var 245 | LI_r, LI_c: Integer; 246 | LS_S: string; 247 | begin 248 | LS_S := ''; 249 | for LI_r := 0 to AStringGrid.RowCount - 1 do 250 | begin 251 | for LI_c := 0 to AStringGrid.ColCount - 1 do 252 | begin 253 | LS_S := LS_S + AStringGrid.Cells[LI_c, LI_r]; 254 | if LI_c < AStringGrid.ColCount - 1 then 255 | LS_S := LS_S + TAB; 256 | end; 257 | if LI_r < AStringGrid.RowCount - 1 then 258 | LS_S := LS_S + CRLF; 259 | end; 260 | ClipBoard.SetTextBuf(PChar(LS_S)); 261 | end; 262 | 263 | function LocSort(P1, P2: Pointer): Integer; 264 | begin 265 | if NativeUInt(P1) = NativeUInt(P2) then 266 | Result := 0 267 | else 268 | begin 269 | if NativeUInt(P1) > NativeUInt(P2) then 270 | Result := -1 271 | else 272 | Result := 1; 273 | end; 274 | end; 275 | 276 | //----------------------------------------------------------------------------- 277 | // Form TfFastMMUsageTracker 278 | //----------------------------------------------------------------------------- 279 | 280 | procedure TfFastMMUsageTracker.FormCreate(Sender: TObject); 281 | var 282 | LR_SystemInfo: TSystemInfo; 283 | begin 284 | pcUsageTracker.ActivePage := tsAllocation; 285 | GetSystemInfo(LR_SystemInfo); 286 | {Get the number of address space pages} 287 | if (Cardinal(LR_SystemInfo.lpMaximumApplicationAddress) and $80000000) = 0 then 288 | AddressSpacePageCount := 32768 289 | else 290 | AddressSpacePageCount := 65536; 291 | {Update the graph metricx} 292 | UpdateGraphMetrics; 293 | {Set up the StringGrid columns} 294 | with sgBlockStatistics do 295 | begin 296 | Cells[0, 0] := 'Block Size'; 297 | Cells[1, 0] := '# Live Pointers'; 298 | Cells[2, 0] := 'Live Size'; 299 | Cells[3, 0] := 'Used Space'; 300 | Cells[4, 0] := 'Efficiency'; 301 | end; 302 | with sgVMDump do 303 | begin 304 | Cells[0, 0] := 'VM Block'; 305 | Cells[1, 0] := 'Size'; 306 | Cells[2, 0] := 'Type'; 307 | Cells[3, 0] := 'State'; 308 | Cells[4, 0] := 'EXE/DLL'; 309 | end; 310 | end; 311 | 312 | procedure TfFastMMUsageTracker.FormClose(Sender: TObject; var Action: TCloseAction); 313 | begin 314 | Action := caFree; 315 | end; 316 | 317 | procedure TfFastMMUsageTracker.SortGrid(grid: TStringgrid; PB_Nummeric: Boolean; byColumn: Integer; ascending: Boolean); 318 | 319 | function CompareNumeric(const S1, S2: string): Integer; 320 | var 321 | LVal1, LVal2: Integer; 322 | begin 323 | begin 324 | LVal1 := StrToInt(S1); 325 | LVal2 := StrToInt(S2); 326 | if LVal1 = LVal2 then 327 | begin 328 | Result := 0; 329 | end 330 | else 331 | begin 332 | if LVal1 > LVal2 then 333 | Result := 1 334 | else 335 | Result := -1; 336 | end; 337 | end; 338 | end; 339 | 340 | procedure ExchangeGridRows(i, j: Integer); 341 | var 342 | k: Integer; 343 | begin 344 | for k := 0 to Grid.ColCount - 1 do 345 | Grid.Cols[k].Exchange(i, j); 346 | end; 347 | 348 | procedure QuickSortNummeric(L, R: Integer); 349 | var 350 | I, J: Integer; 351 | P: string; 352 | begin 353 | repeat 354 | I := L; 355 | J := R; 356 | P := Grid.Cells[byColumn, (L + R) shr 1]; 357 | repeat 358 | while CompareNumeric(Grid.Cells[byColumn, I], P) < 0 do 359 | Inc(I); 360 | while CompareNumeric(Grid.Cells[byColumn, J], P) > 0 do 361 | Dec(J); 362 | if I <= J then 363 | begin 364 | if I <> J then 365 | ExchangeGridRows(I, J); 366 | Inc(I); 367 | Dec(J); 368 | end; 369 | until I > J; 370 | if L < J then 371 | QuickSortNummeric(L, J); 372 | L := I; 373 | until I >= R; 374 | end; 375 | 376 | procedure QuickSortString(L, R: Integer); 377 | var 378 | I, J: Integer; 379 | P: string; 380 | begin 381 | repeat 382 | I := L; 383 | J := R; 384 | P := Grid.Cells[byColumn, (L + R) shr 1]; 385 | repeat 386 | while CompareText(Grid.Cells[byColumn, I], P) < 0 do 387 | Inc(I); 388 | while CompareText(Grid.Cells[byColumn, J], P) > 0 do 389 | Dec(J); 390 | if I <= J then 391 | begin 392 | if I <> J then 393 | ExchangeGridRows(I, J); 394 | Inc(I); 395 | Dec(J); 396 | end; 397 | until I > J; 398 | if L < J then 399 | QuickSortString(L, J); 400 | L := I; 401 | until I >= R; 402 | end; 403 | 404 | procedure InvertGrid; 405 | var 406 | i, j: Integer; 407 | begin 408 | i := Grid.Fixedrows; 409 | j := Grid.Rowcount - 1; 410 | while i < j do 411 | begin 412 | ExchangeGridRows(I, J); 413 | Inc(i); 414 | Dec(j); 415 | end; 416 | end; 417 | 418 | begin 419 | Screen.Cursor := crHourglass; 420 | Grid.Perform(WM_SETREDRAW, 0, 0); 421 | try 422 | if PB_Nummeric then 423 | QuickSortNummeric(Grid.FixedRows, Grid.Rowcount - 1) 424 | else 425 | QuickSortString(Grid.FixedRows, Grid.Rowcount - 1); 426 | if not Ascending then 427 | InvertGrid; 428 | finally 429 | Grid.Perform(WM_SETREDRAW, 1, 0); 430 | Grid.Refresh; 431 | Screen.Cursor := crDefault; 432 | end; 433 | end; 434 | 435 | 436 | procedure TfFastMMUsageTracker.HeaderClicked(AGrid: TStringgrid; const ACell: TGridCoord); 437 | var 438 | i: Integer; 439 | LNumericSort: Boolean; 440 | begin 441 | // The header cell stores a flag in the Objects property that signals the 442 | // current sort order of the grid column. A value of 0 shows no sort marker, 443 | // 1 means sorted ascending, -1 sorted descending 444 | // clear markers 445 | for i := AGrid.FixedCols to AGrid.ColCount - 1 do 446 | begin 447 | if Assigned(AGrid.Objects[i, 0]) and (i <> ACell.x) then 448 | begin 449 | AGrid.Objects[i, 0] := nil; 450 | TLocalStringGrid(AGrid).InvalidateCell(i, 0); 451 | end; 452 | end; 453 | // Sort grid on new column. If grid is currently sorted ascending on this 454 | // column we invert the sort direction, otherwise we sort it ascending. 455 | if ACell.X = 1 then 456 | LNumericSort := True 457 | else 458 | LNumericSort := False; 459 | if Integer(AGrid.Objects[ACell.x, ACell.y]) = 1 then 460 | begin 461 | SortGrid(AGrid, LNumericSort, ACell.x, False); 462 | AGrid.Objects[ACell.x, 0] := Pointer(-1); 463 | end 464 | else 465 | begin 466 | SortGrid(AGrid, LNumericSort, ACell.x, True); 467 | AGrid.Objects[ACell.x, 0] := Pointer(1); 468 | end; 469 | TLocalStringGrid(AGrid).InvalidateCell(ACell.x, ACell.y); 470 | end; 471 | 472 | procedure TfFastMMUsageTracker.UpdateGraphMetrics; 473 | begin 474 | if ChkSmallGraph.Checked then 475 | begin 476 | dgMemoryMap.DefaultColWidth := 4; 477 | dgMemoryMap.ColCount := 128; 478 | end 479 | else 480 | begin 481 | dgMemoryMap.DefaultColWidth := 8; 482 | dgMemoryMap.ColCount := 64; 483 | end; 484 | dgMemoryMap.DefaultRowHeight := dgMemoryMap.DefaultColWidth; 485 | dgMemoryMap.RowCount := AddressSpacePageCount div dgMemoryMap.ColCount; 486 | end; 487 | 488 | procedure TfFastMMUsageTracker.RefreshSnapShot; 489 | var 490 | LP_FreeVMList: TList; 491 | LU_MEM_FREE: SIZE_T; 492 | LU_MEM_COMMIT: SIZE_T; 493 | LU_MEM_RESERVE: SIZE_T; 494 | LAllocatedSize, LTotalBlocks, LTotalAllocated, LTotalReserved, 495 | LPrevAllocatedSize, LPrevTotalBlocks, LPrevTotalAllocated, LPrevTotalReserved: NativeUInt; 496 | 497 | procedure UpdateVMGraph(var AMemoryMap: TMemoryMapEx); 498 | var 499 | LInd, LIndTop, I1: Integer; 500 | LChunkState: TChunkStatusEx; 501 | LMBI: TMemoryBasicInformation; 502 | LA_Char: array[0..MAX_PATH] of Char; 503 | begin 504 | LInd := 0; 505 | repeat 506 | {If the chunk is not allocated by this MM, what is its status?} 507 | if AMemoryMap[LInd] = csExSysAllocated then 508 | begin 509 | {Get all the reserved memory blocks and windows allocated memory blocks, etc.} 510 | VirtualQuery(Pointer(LInd * 65536), LMBI, SizeOf(LMBI)); 511 | if LMBI.State = MEM_COMMIT then 512 | begin 513 | if (GetModuleFileName(DWord(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then 514 | begin 515 | if DWord(LMBI.AllocationBase) = SysInit.HInstance then 516 | LChunkState := csExSysExe 517 | else 518 | LChunkState := csExSysDLL; 519 | end 520 | else 521 | begin 522 | LChunkState := csExSysAllocated; 523 | end; 524 | if LMBI.RegionSize > 65536 then 525 | begin 526 | LIndTop := (Cardinal(LMBI.BaseAddress) + Cardinal(LMBI.RegionSize)) div 65536; 527 | // Fill up multiple tables 528 | for I1 := LInd to LIndTop do 529 | AMemoryMap[I1] := LChunkState; 530 | LInd := LIndTop; 531 | end 532 | else 533 | begin 534 | AMemoryMap[LInd] := LChunkState; 535 | end; 536 | end 537 | end; 538 | Inc(LInd); 539 | until LInd >= AddressSpacePageCount; 540 | end; 541 | 542 | procedure UpdateVMDump; 543 | var 544 | LP_Base: PByte; 545 | LR_Info: TMemoryBasicInformation; 546 | LU_rv: SIZE_T; 547 | LI_I: Integer; 548 | LA_Char: array[0..MAX_PATH] of Char; 549 | begin 550 | LP_Base := nil; 551 | LU_rv := VirtualQuery(LP_Base, LR_Info, sizeof(LR_Info)); 552 | LI_I := 1; 553 | while LU_rv = sizeof(LR_Info) do 554 | begin 555 | with sgVMDump do 556 | begin 557 | Cells[0, LI_I] := IntToHex(Integer(LR_Info.BaseAddress), 8); 558 | Cells[1, LI_I] := IntToStr(LR_Info.RegionSize); 559 | Cells[3, LI_I] := IntToHex(Integer(LR_Info.Protect), 8); 560 | case LR_Info.State of 561 | 562 | MEM_Commit: 563 | begin 564 | LU_MEM_COMMIT := LU_MEM_COMMIT + LR_Info.RegionSize; 565 | if (GetModuleFileName(dword(LR_Info.AllocationBase), LA_Char, MAX_PATH) <> 0) then 566 | begin 567 | if DWord(LR_Info.AllocationBase) = SysInit.HInstance then 568 | Cells[2, LI_I] := 'Exe' 569 | else 570 | Cells[2, LI_I] := 'DLL'; 571 | Cells[4, LI_I] := ExtractFileName(LA_Char); 572 | end 573 | else 574 | begin 575 | Cells[4, LI_I] := ''; 576 | Cells[2, LI_I] := 'Commited'; 577 | end; 578 | end; 579 | 580 | MEM_RESERVE: 581 | begin 582 | LU_MEM_RESERVE := LU_MEM_RESERVE + LR_Info.RegionSize; 583 | Cells[2, LI_I] := 'Reserved'; 584 | Cells[4, LI_I] := ''; 585 | end; 586 | 587 | MEM_FREE: 588 | begin 589 | LP_FreeVMList.Add(Pointer(LR_Info.RegionSize)); 590 | LU_MEM_FREE := LU_MEM_FREE + Lr_Info.RegionSize; 591 | Cells[2, LI_I] := 'Free'; 592 | Cells[4, LI_I] := ''; 593 | end; 594 | end; 595 | 596 | Inc(LP_Base, LR_Info.RegionSize); 597 | LU_rv := VirtualQuery(LP_Base, LR_Info, sizeof(LR_Info)); 598 | Inc(LI_I); 599 | end; 600 | end; 601 | 602 | sgVMDump.RowCount := LI_I; 603 | end; 604 | 605 | procedure UpdateFastMMData; 606 | var 607 | LInd: Integer; 608 | LPrevSBState, LSBState: ^TSmallBlockTypeState; 609 | 610 | procedure UpdateBlockStatistics(c, r, current, prev: Integer); 611 | var 612 | s : string; 613 | begin 614 | s := IntToStr(current); 615 | if current > prev then 616 | s := s + ' (+' + IntToStr(current - prev) + ')' 617 | else if current < prev then 618 | s := s + ' (-' + IntToStr(prev - current) + ')'; 619 | sgBlockStatistics.Cells[c, r] := s; 620 | sgBlockStatistics.Objects[c, r] := Pointer(current - prev); 621 | end; 622 | 623 | begin 624 | {Set up the row count} 625 | sgBlockStatistics.RowCount := FMemoryManagerState.SmallBlockTypeCount + 4; 626 | sgBlockStatistics.Cells[0, FMemoryManagerState.SmallBlockTypeCount + 1] := 'Medium Blocks'; 627 | sgBlockStatistics.Cells[0, FMemoryManagerState.SmallBlockTypeCount + 2] := 'Large Blocks'; 628 | sgBlockStatistics.Cells[0, FMemoryManagerState.SmallBlockTypeCount + 3] := 'Overall'; 629 | for LInd := 0 to FMemoryManagerState.SmallBlockTypeCount - 1 do 630 | begin 631 | sgBlockStatistics.Cells[0, LInd + 1] := 632 | IntToStr(FMemoryManagerState.SmallBlockTypeStates[LInd].InternalBlockSize) 633 | + '(' + IntToStr(FMemoryManagerState.SmallBlockTypeStates[LInd].UseableBlockSize) + ')'; 634 | end; 635 | {Set the texts inside the results string grid} 636 | for LInd := 0 to FMemoryManagerState.SmallBlockTypeCount - 1 do 637 | begin 638 | LPrevSBState := @FPrevMemoryManagerState.SmallBlockTypeStates[LInd]; 639 | LSBState := @FMemoryManagerState.SmallBlockTypeStates[LInd]; 640 | UpdateBlockStatistics(1, LInd + 1, LSBState.AllocatedBlockCount, LPrevSBState.AllocatedBlockCount); 641 | Inc(LTotalBlocks, LSBState.AllocatedBlockCount); 642 | Inc(LPrevTotalBlocks, LPrevSBState.AllocatedBlockCount); 643 | LAllocatedSize := LSBState.AllocatedBlockCount * LSBState.UseableBlockSize; 644 | LPrevAllocatedSize := LPrevSBState.AllocatedBlockCount * LPrevSBState.UseableBlockSize; 645 | UpdateBlockStatistics(2, LInd + 1, LAllocatedSize, LPrevAllocatedSize); 646 | Inc(LTotalAllocated, LAllocatedSize); 647 | Inc(LPrevTotalAllocated, LPrevAllocatedSize); 648 | UpdateBlockStatistics(3, LInd + 1, LSBState.ReservedAddressSpace, LPrevSBState.ReservedAddressSpace); 649 | Inc(LTotalReserved, LSBState.ReservedAddressSpace); 650 | Inc(LPrevTotalReserved, LPrevSBState.ReservedAddressSpace); 651 | if LSBState.ReservedAddressSpace > 0 then 652 | sgBlockStatistics.Cells[4, LInd + 1] := FormatFloat('0.##%', LAllocatedSize / LSBState.ReservedAddressSpace * 100) 653 | else 654 | sgBlockStatistics.Cells[4, LInd + 1] := 'N/A'; 655 | end; 656 | {-----------Medium blocks---------} 657 | LInd := FMemoryManagerState.SmallBlockTypeCount + 1; 658 | UpdateBlockStatistics(1, LInd, FMemoryManagerState.AllocatedMediumBlockCount, FPrevMemoryManagerState.AllocatedMediumBlockCount); 659 | Inc(LTotalBlocks, FMemoryManagerState.AllocatedMediumBlockCount); 660 | Inc(LPrevTotalBlocks, FPrevMemoryManagerState.AllocatedMediumBlockCount); 661 | UpdateBlockStatistics(2, LInd, FMemoryManagerState.TotalAllocatedMediumBlockSize, FPrevMemoryManagerState.TotalAllocatedMediumBlockSize); 662 | Inc(LTotalAllocated, FMemoryManagerState.TotalAllocatedMediumBlockSize); 663 | Inc(LPrevTotalAllocated, FPrevMemoryManagerState.TotalAllocatedMediumBlockSize); 664 | UpdateBlockStatistics(3, LInd, FMemoryManagerState.ReservedMediumBlockAddressSpace, FPrevMemoryManagerState.ReservedMediumBlockAddressSpace); 665 | Inc(LTotalReserved, FMemoryManagerState.ReservedMediumBlockAddressSpace); 666 | Inc(LPrevTotalReserved, FPrevMemoryManagerState.ReservedMediumBlockAddressSpace); 667 | if FMemoryManagerState.ReservedMediumBlockAddressSpace > 0 then 668 | sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', FMemoryManagerState.TotalAllocatedMediumBlockSize / FMemoryManagerState.ReservedMediumBlockAddressSpace * 100) 669 | else 670 | sgBlockStatistics.Cells[4, LInd] := 'N/A'; 671 | {----------Large blocks----------} 672 | LInd := FMemoryManagerState.SmallBlockTypeCount + 2; 673 | UpdateBlockStatistics(1, LInd, FMemoryManagerState.AllocatedLargeBlockCount, FPrevMemoryManagerState.AllocatedLargeBlockCount); 674 | Inc(LTotalBlocks, FMemoryManagerState.AllocatedLargeBlockCount); 675 | Inc(LPrevTotalBlocks, FPrevMemoryManagerState.AllocatedLargeBlockCount); 676 | UpdateBlockStatistics(2, LInd, FMemoryManagerState.TotalAllocatedLargeBlockSize, FPrevMemoryManagerState.TotalAllocatedLargeBlockSize); 677 | Inc(LTotalAllocated, FMemoryManagerState.TotalAllocatedLargeBlockSize); 678 | Inc(LPrevTotalAllocated, FPrevMemoryManagerState.TotalAllocatedLargeBlockSize); 679 | UpdateBlockStatistics(3, LInd, FMemoryManagerState.ReservedLargeBlockAddressSpace, FPrevMemoryManagerState.ReservedLargeBlockAddressSpace); 680 | Inc(LTotalReserved, FMemoryManagerState.ReservedLargeBlockAddressSpace); 681 | Inc(LPrevTotalReserved, FPrevMemoryManagerState.ReservedLargeBlockAddressSpace); 682 | if FMemoryManagerState.ReservedLargeBlockAddressSpace > 0 then 683 | sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', FMemoryManagerState.TotalAllocatedLargeBlockSize / FMemoryManagerState.ReservedLargeBlockAddressSpace * 100) 684 | else 685 | sgBlockStatistics.Cells[4, LInd] := 'N/A'; 686 | {-----------Overall--------------} 687 | LInd := FMemoryManagerState.SmallBlockTypeCount + 3; 688 | UpdateBlockStatistics(1, Lind, LTotalBlocks, LPrevTotalBlocks); 689 | UpdateBlockStatistics(2, Lind, LTotalAllocated, LPrevTotalAllocated); 690 | UpdateBlockStatistics(3, Lind, LTotalReserved, LPrevTotalReserved); 691 | if LTotalReserved > 0 then 692 | sgBlockStatistics.Cells[4, LInd] := FormatFloat('0.##%', LTotalAllocated / LTotalReserved * 100) 693 | else 694 | sgBlockStatistics.Cells[4, LInd] := 'N/A'; 695 | end; 696 | 697 | procedure UpdateStatisticsData; 698 | const 699 | CI_MaxFreeBlocksList = 9; 700 | 701 | var 702 | LR_SystemInfo: TSystemInfo; 703 | LR_GlobalMemoryStatus: TMemoryStatus; 704 | LR_GlobalMemoryStatusEx: TMemoryStatusEx; 705 | LR_ProcessMemoryCounters: TProcessMemoryCounters; 706 | LR_SysBaseInfo: TSystem_Basic_Information; 707 | LU_MinQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend}; 708 | LU_MaxQuota: {$if CompilerVersion >= 23}NativeUInt{$else}Cardinal{$ifend}; 709 | LI_I: Integer; 710 | LI_Max: Integer; 711 | begin 712 | mVMStatistics.Lines.BeginUpdate; 713 | try 714 | mVMStatistics.Clear; 715 | 716 | LU_MinQuota := 0; 717 | LU_MaxQuota := 0; 718 | 719 | if Assigned(MP_GlobalMemoryStatusEx) then 720 | begin 721 | ZeroMemory(@LR_GlobalMemoryStatusEx, SizeOf(TMemoryStatusEx)); 722 | LR_GlobalMemoryStatusEx.dwLength := SizeOf(TMemoryStatusEx); 723 | 724 | if not MP_GlobalMemoryStatusEx(LR_GlobalMemoryStatusEx) then 725 | begin 726 | mVMStatistics.Lines.Add('GlobalMemoryStatusEx err: ' + SysErrorMessage(GetLastError)); 727 | end; 728 | end 729 | else 730 | begin 731 | LR_GlobalMemoryStatus.dwLength := SizeOf(TMemoryStatus); 732 | GlobalMemoryStatus(LR_GlobalMemoryStatus); 733 | end; 734 | 735 | LP_FreeVMList.SortList(LocSort); 736 | 737 | GetProcessWorkingSetSize(GetCurrentProcess, LU_MinQuota, LU_MaxQuota); 738 | GetSystemInfo(LR_SystemInfo); 739 | 740 | with mVMStatistics.Lines do 741 | begin 742 | Add('System Info:'); 743 | Add('------------'); 744 | 745 | Add('Processor Count = ' + IntToStr(LR_SystemInfo.dwNumberOfProcessors)); 746 | Add('Allocation Granularity = ' + IntToStr(LR_SystemInfo.dwAllocationGranularity)); 747 | 748 | if Assigned(MP_GlobalMemoryStatusEx) then 749 | begin 750 | with LR_GlobalMemoryStatusEx do 751 | begin 752 | Add('Available Physical Memory = ' + Int64ToKStringFormatted(ullAvailPhys)); 753 | Add('Total Physical Memory = ' + Int64ToKStringFormatted(ullTotalPhys)); 754 | Add('Available Virtual Memory = ' + Int64ToKStringFormatted(ullAvailVirtual)); 755 | Add('Total Virtual Memory = ' + Int64ToKStringFormatted(ullTotalVirtual)); 756 | Add('Total Virtual Extended Memory = ' + Int64ToKStringFormatted(ullAvailExtendedVirtual)); 757 | end; 758 | end 759 | 760 | else 761 | begin 762 | with LR_GlobalMemoryStatus do 763 | begin 764 | Add('Available Physical Memory = ' + Int64ToKStringFormatted(dwAvailPhys)); 765 | Add('Total Physical Memory = ' + Int64ToKStringFormatted(dwTotalPhys)); 766 | Add('Available Virtual Memory = ' + Int64ToKStringFormatted(dwAvailVirtual)); 767 | Add('Total Virtual Memory = ' + Int64ToKStringFormatted(dwTotalVirtual)); 768 | end; 769 | end; 770 | 771 | if Assigned(MP_NtQuerySystemInformation) then 772 | begin 773 | if MP_NtQuerySystemInformation(SystemBasicInformation, @LR_SysBaseInfo, SizeOf(LR_SysBaseInfo), nil) = 0 then 774 | begin 775 | with LR_SysBaseInfo do begin 776 | Add('Maximum Increment = ' + CardinalToKStringFormatted(uKeMaximumIncrement)); 777 | Add('Page Size = ' + CardinalToKStringFormatted(uPageSize)); 778 | Add('Number of Physical Pages = ' + CardinalToKStringFormatted(uMmNumberOfPhysicalPages)); 779 | Add('Lowest Physical Page = ' + CardinalToStringFormatted(uMmLowestPhysicalPage)); 780 | Add('Highest Physical Page = ' + CardinalToKStringFormatted(uMmHighestPhysicalPage)); 781 | end; 782 | end; 783 | end; 784 | 785 | // same as GetProcessMemoryInfo & NtQuerySystemInformation (SystemBasicInformation 786 | 787 | // The working set is the amount of memory physically mapped to the process context at a given 788 | // time. Memory in the paged pool is system memory that can be transferred to the paging file 789 | // on disk (paged) when it is not being used. Memory in the nonpaged pool is system memory 790 | // that cannot be paged to disk as long as the corresponding objects are allocated. The pagefile 791 | // usage represents how much memory is set aside for the process in the system paging file. 792 | // When memory usage is too high, the virtual memory manager pages selected memory to disk. 793 | // When a thread needs a page that is not in memory, the memory manager reloads it from the 794 | // paging file. 795 | 796 | 797 | if GetProcessMemoryInfo(GetCurrentProcess, @LR_ProcessMemoryCounters, SizeOf(LR_ProcessMemoryCounters)) then 798 | begin 799 | with LR_ProcessMemoryCounters do 800 | begin 801 | Add('Page Fault Count = ' + CardinalToKStringFormatted(PageFaultCount)); 802 | Add('Peak Working Set Size = ' + Int64ToKStringFormatted(PeakWorkingSetSize)); 803 | Add('Working Set Size = ' + Int64ToKStringFormatted(WorkingSetSize)); 804 | Add('Quota Peak Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaPeakPagedPoolUsage)); 805 | Add('Quota Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaPagedPoolUsage)); 806 | Add('Quota Peak Non-Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaPeakNonPagedPoolUsage)); 807 | Add('Quota Non-Paged Pool Usage = ' + Int64ToKStringFormatted(QuotaNonPagedPoolUsage)); 808 | Add('Pagefile Usage = ' + Int64ToKStringFormatted(PagefileUsage)); 809 | Add('Peak Pagefile Usage = ' + Int64ToKStringFormatted(PeakPagefileUsage)); 810 | end; 811 | end; 812 | 813 | Add(''); 814 | Add('Process Info: PID (' + IntToStr(GetCurrentProcessId) + ')'); 815 | Add('------------------------'); 816 | Add('Minimum Address = ' + Int64ToKStringFormatted(NativeUInt(LR_SystemInfo.lpMinimumApplicationAddress))); 817 | Add('Maximum VM Address = ' + Int64ToKStringFormatted(NativeUInt(LR_SystemInfo.lpMaximumApplicationAddress))); 818 | Add('Page Protection & Commit Size = ' + IntToStr(LR_SystemInfo.dWPageSize)); 819 | Add(''); 820 | Add('Quota info:'); 821 | Add('-----------'); 822 | Add('Minimum Quota = ' + Int64ToKStringFormatted(LU_MinQuota)); 823 | Add('Maximum Quota = ' + Int64ToKStringFormatted(LU_MaxQuota)); 824 | Add(''); 825 | Add('VM Info:'); 826 | Add('--------'); 827 | Add('Total Free = ' + Int64ToKStringFormatted(LU_MEM_FREE)); 828 | Add('Total Reserve = ' + Int64ToKStringFormatted(LU_MEM_RESERVE)); 829 | Add('Total Commit = ' + Int64ToKStringFormatted(LU_MEM_COMMIT)); 830 | 831 | if LP_FreeVMList.Count > CI_MaxFreeBlocksList then 832 | LI_Max := CI_MaxFreeBlocksList - 1 833 | else 834 | LI_Max := LP_FreeVMList.Count - 1; 835 | 836 | for LI_I := 0 to LI_Max do 837 | begin 838 | Add('Largest Free Block ' + IntToStr(LI_I + 1) + '. = ' + Int64ToKStringFormatted(NativeUInt(LP_FreeVMList.List[LI_I]))); 839 | end; 840 | 841 | Add(''); 842 | Add('FastMM Info:'); 843 | Add('-------------'); 844 | Add('Total Blocks = ' + Int64ToKStringFormatted(LTotalBlocks)); 845 | Add('Total Allocated = ' + Int64ToKStringFormatted(LTotalAllocated)); 846 | Add('Total Reserved = ' + Int64ToKStringFormatted(LTotalReserved)); 847 | end; 848 | 849 | finally 850 | mVMStatistics.Lines.EndUpdate; 851 | end; 852 | end; 853 | 854 | var 855 | Save_Cursor: TCursor; 856 | begin 857 | if SizeOf(TMemoryMap) <> SizeOf(TMemoryMapEx) then 858 | begin 859 | Showmessage('Internal implementation error'); 860 | Exit; 861 | end; 862 | 863 | LU_MEM_FREE := 0; 864 | LU_MEM_COMMIT := 0; 865 | LU_MEM_RESERVE := 0; 866 | 867 | LTotalBlocks := 0; 868 | LTotalAllocated := 0; 869 | LTotalReserved := 0; 870 | 871 | LPrevTotalBlocks := 0; 872 | LPrevTotalAllocated := 0; 873 | LPrevTotalReserved := 0; 874 | 875 | // Set hourglass cursor 876 | Save_Cursor := Screen.Cursor; 877 | Screen.Cursor := crHourGlass; 878 | LP_FreeVMList := TList.Create; 879 | try 880 | // retrieve FastMM info 881 | 882 | FastMM_GetMemoryManagerState(FMemoryManagerState); 883 | FastMM_GetMemoryMap(TMemoryMap(FMemoryMapEx)); 884 | 885 | // Update FastMM Graph with EXE & DLL locations 886 | UpdateVMGraph(FMemoryMapEx); 887 | 888 | // VM dump 889 | UpdateVMDump; 890 | 891 | // FastMM data 892 | UpdateFastMMData; 893 | 894 | // General Information 895 | UpdateStatisticsData; 896 | 897 | // Screen updates 898 | dgMemoryMap.Invalidate; 899 | 900 | FPrevMemoryManagerState := FMemoryManagerState; 901 | finally 902 | FreeAndNil(LP_FreeVMList); 903 | Screen.Cursor := Save_Cursor; 904 | end; 905 | end; 906 | 907 | procedure TfFastMMUsageTracker.sgBlockStatisticsDrawCell(Sender: TObject; 908 | ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); 909 | var 910 | d: integer; 911 | y: integer; 912 | s: string; 913 | LOldColour, LColour: TColor; 914 | begin 915 | d := Integer(sgBlockStatistics.Objects[ACol, ARow]); 916 | if d <> 0 then 917 | begin 918 | LOldColour := sgBlockStatistics.Canvas.Brush.Color; 919 | if d < 0 then 920 | LColour := clLime 921 | else 922 | LColour := clRed; 923 | sgBlockStatistics.Canvas.Brush.Color := LColour; 924 | sgBlockStatistics.Canvas.Font.Color := clWindowText; 925 | s := sgBlockStatistics.Cells[ACol, ARow]; 926 | y := sgBlockStatistics.Canvas.TextHeight(s); 927 | y := ((Rect.Bottom - Rect.Top) - y) div 2; 928 | sgBlockStatistics.Canvas.TextRect(Rect, Rect.Left + 2, Rect.top + y, s); 929 | sgBlockStatistics.Canvas.Brush.Color := LOldColour; 930 | end; 931 | end; 932 | 933 | procedure TfFastMMUsageTracker.tTimerTimer(Sender: TObject); 934 | begin 935 | tTimer.Enabled := False; 936 | try 937 | RefreshSnapShot; 938 | finally 939 | tTimer.Enabled := True; 940 | end; 941 | end; 942 | 943 | procedure TfFastMMUsageTracker.bCloseClick(Sender: TObject); 944 | begin 945 | Close; 946 | end; 947 | 948 | procedure TfFastMMUsageTracker.dgMemoryMapDrawCell(Sender: TObject; ACol, 949 | ARow: Integer; Rect: TRect; State: TGridDrawState); 950 | var 951 | LChunkIndex: integer; 952 | LChunkColour: TColor; 953 | begin 954 | {Get the chunk index} 955 | LChunkIndex := ARow * dgMemoryMap.ColCount + ACol; 956 | 957 | {Get the correct colour} 958 | case FMemoryMapEx[LChunkIndex] of 959 | 960 | csExAllocated: 961 | begin 962 | LChunkColour := $9090FF; 963 | end; 964 | 965 | csExReserved: 966 | begin 967 | LChunkColour := $90F090; 968 | end; 969 | 970 | csExSysAllocated: 971 | begin 972 | LChunkColour := $707070; 973 | end; 974 | 975 | csExSysExe: 976 | begin 977 | LChunkColour := clRed; 978 | end; 979 | 980 | csExSysDLL: 981 | begin 982 | LChunkColour := clBlue; 983 | end; 984 | 985 | csExSysReserved: 986 | begin 987 | LChunkColour := $C0C0C0; 988 | end 989 | 990 | else 991 | begin 992 | {ExUnallocated} 993 | LChunkColour := $FFFFFF; 994 | end; 995 | end; 996 | 997 | {Draw the chunk background} 998 | dgMemoryMap.Canvas.Brush.Color := LChunkColour; 999 | 1000 | if State = [] then 1001 | dgMemoryMap.Canvas.FillRect(Rect) 1002 | else 1003 | dgMemoryMap.Canvas.Rectangle(Rect); 1004 | end; 1005 | 1006 | procedure TfFastMMUsageTracker.dgMemoryMapSelectCell(Sender: TObject; ACol, 1007 | ARow: Integer; var CanSelect: Boolean); 1008 | var 1009 | LChunkIndex: Cardinal; 1010 | LMBI: TMemoryBasicInformation; 1011 | LA_Char: array[0..MAX_PATH] of char; 1012 | begin 1013 | eDLLName.Text := ''; 1014 | LChunkIndex := ARow * dgMemoryMap.ColCount + ACol; 1015 | eAddress.Text := Format('$%0.8x', [LChunkIndex shl 16]); 1016 | 1017 | case FMemoryMapEx[LChunkIndex] of 1018 | 1019 | csExAllocated: 1020 | begin 1021 | eState.Text := 'FastMM Allocated'; 1022 | end; 1023 | 1024 | csExReserved: 1025 | begin 1026 | eState.Text := 'FastMM Reserved'; 1027 | end; 1028 | 1029 | csExSysAllocated: 1030 | begin 1031 | eState.Text := 'System Allocated'; 1032 | end; 1033 | 1034 | csExSysExe: 1035 | begin 1036 | eState.Text := 'System Exe'; 1037 | VirtualQuery(Pointer(LChunkIndex shl 16), LMBI, SizeOf(LMBI)); 1038 | if (GetModuleFileName(dword(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then 1039 | begin 1040 | eDLLName.Text := LA_Char; 1041 | end; 1042 | end; 1043 | 1044 | csExSysDLL: 1045 | begin 1046 | eState.Text := 'System/User DLL'; 1047 | VirtualQuery(Pointer(LChunkIndex shl 16), LMBI, SizeOf(LMBI)); 1048 | if (GetModuleFileName(dword(LMBI.AllocationBase), LA_Char, MAX_PATH) <> 0) then 1049 | begin 1050 | eDLLName.Text := LA_Char; 1051 | end; 1052 | end; 1053 | 1054 | csExSysReserved: 1055 | begin 1056 | eState.Text := 'System Reserved'; 1057 | end 1058 | 1059 | else 1060 | begin 1061 | {ExUnallocated} 1062 | eState.Text := 'Free'; 1063 | end; 1064 | end; 1065 | end; 1066 | 1067 | procedure TfFastMMUsageTracker.bUpdateClick(Sender: TObject); 1068 | begin 1069 | RefreshSnapShot; 1070 | end; 1071 | 1072 | procedure TfFastMMUsageTracker.ChkAutoUpdateClick(Sender: TObject); 1073 | begin 1074 | tTimer.Enabled := ChkAutoUpdate.Checked; 1075 | end; 1076 | 1077 | procedure TfFastMMUsageTracker.ChkSmallGraphClick(Sender: TObject); 1078 | begin 1079 | UpdateGraphMetrics; 1080 | dgMemoryMap.Invalidate; 1081 | dgMemoryMap.SetFocus; 1082 | end; 1083 | 1084 | procedure TfFastMMUsageTracker.sgVMDumpMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 1085 | begin 1086 | if (Button = mbLeft) and (Shift = [ssLeft]) then 1087 | begin 1088 | (Sender as TStringgrid).MouseToCell(X, Y, OR_VMDumpDownCell.X, OR_VMDumpDownCell.Y); 1089 | end 1090 | else 1091 | begin 1092 | OR_VMDumpDownCell.X := 0; 1093 | OR_VMDumpDownCell.Y := 0; 1094 | end; 1095 | end; 1096 | 1097 | procedure TfFastMMUsageTracker.sgVMDumpMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); 1098 | var 1099 | p: TGridCoord; 1100 | LGrid: TStringgrid; 1101 | begin 1102 | LGrid := Sender as TStringGrid; 1103 | if (Button = mbLeft) and (Shift = []) then 1104 | begin 1105 | LGrid.MouseToCell(X, Y, p.X, p.Y); 1106 | if CompareMem(@p, @OR_VMDumpDownCell, sizeof(p)) 1107 | and (p.Y < LGrid.FixedRows) 1108 | and (p.X >= LGrid.FixedCols) then 1109 | begin 1110 | HeaderClicked(LGrid, p); 1111 | end; 1112 | end; 1113 | OR_VMDumpDownCell.X := 0; 1114 | OR_VMDumpDownCell.Y := 0; 1115 | end; 1116 | 1117 | procedure TfFastMMUsageTracker.sgVMDumpDrawCell(Sender: TObject; ACol, ARow: Integer; Rect: TRect; State: TGridDrawState); 1118 | var 1119 | LGrid: TStringgrid; 1120 | LMarker: Char; 1121 | begin 1122 | LGrid := Sender as TStringgrid; 1123 | // paint the sort marker on header columns 1124 | if (ACol >= LGrid.FixedCols) and (aRow = 0) then 1125 | begin 1126 | if Assigned(LGrid.Objects[aCol, aRow]) then 1127 | begin 1128 | if Integer(LGrid.Objects[aCol, aRow]) > 0 then 1129 | LMarker := 't' // up wedge in Marlett font 1130 | else 1131 | LMarker := 'u'; // down wedge in Marlett font 1132 | with LGrid.canvas do 1133 | begin 1134 | Font.Name := 'Marlett'; 1135 | Font.Charset := SYMBOL_CHARSET; 1136 | Font.Size := 12; 1137 | TextOut(Rect.Right - TextWidth(LMarker), Rect.Top, LMarker); 1138 | Font := LGrid.font; 1139 | end; 1140 | end; 1141 | end; 1142 | end; 1143 | 1144 | procedure TfFastMMUsageTracker.siMM4AllocationCopyAlltoClipboardClick(Sender: TObject); 1145 | begin 1146 | CopyGridContentsToClipBoard(sgBlockStatistics); 1147 | end; 1148 | 1149 | procedure TfFastMMUsageTracker.miVMDumpCopyAlltoClipboardClick(Sender: TObject); 1150 | begin 1151 | CopyGridContentsToClipBoard(sgVMDump); 1152 | end; 1153 | 1154 | procedure TfFastMMUsageTracker.miGeneralInformationCopyAlltoClipboardClick(Sender: TObject); 1155 | begin 1156 | with mVMStatistics do 1157 | begin 1158 | Lines.BeginUpdate; 1159 | try 1160 | SelectAll; 1161 | CopyToClipboard; 1162 | SelStart := 0; 1163 | finally 1164 | Lines.EndUpdate; 1165 | end; 1166 | end; 1167 | end; 1168 | 1169 | procedure ModuleInit; 1170 | begin 1171 | if Win32Platform = VER_PLATFORM_WIN32_NT then 1172 | begin 1173 | MP_GlobalMemoryStatusEx := TP_GlobalMemoryStatusEx( 1174 | GetProcAddress(GetModuleHandle(kernel32), 'GlobalMemoryStatusEx')); 1175 | MP_NtQuerySystemInformation := TP_NtQuerySystemInformation( 1176 | GetProcAddress(GetModuleHandle('ntdll.dll'), 'NtQuerySystemInformation')); 1177 | end; 1178 | end; 1179 | 1180 | initialization 1181 | ModuleInit; 1182 | 1183 | end. 1184 | -------------------------------------------------------------------------------- /Demos/Usage Tracker/UsageTrackerDemo.dpr: -------------------------------------------------------------------------------- 1 | program UsageTrackerDemo; 2 | 3 | uses 4 | FastMM5, 5 | Forms, 6 | DemoForm in 'DemoForm.pas' {fDemo}; 7 | 8 | {$R *.res} 9 | 10 | {Enable large address space support for this demo} 11 | {$SetPEFlags $20} 12 | 13 | begin 14 | Application.Initialize; 15 | Application.CreateForm(TfDemo, fDemo); 16 | Application.Run; 17 | end. 18 | -------------------------------------------------------------------------------- /Demos/Usage Tracker/UsageTrackerDemo.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {2d29cca4-0633-47dd-b826-c21a24d53d83} 4 | UsageTrackerDemo.dpr 5 | Debug 6 | DCC32 7 | UsageTrackerDemo.exe 8 | VCL 9 | 19.5 10 | True 11 | Debug 12 | Win32 13 | 3 14 | Application 15 | 16 | 17 | true 18 | 19 | 20 | true 21 | Base 22 | true 23 | 24 | 25 | true 26 | Base 27 | true 28 | 29 | 30 | true 31 | Base 32 | true 33 | 34 | 35 | true 36 | Cfg_1 37 | true 38 | true 39 | 40 | 41 | true 42 | Cfg_1 43 | true 44 | true 45 | 46 | 47 | true 48 | Base 49 | true 50 | 51 | 52 | true 53 | Cfg_2 54 | true 55 | true 56 | 57 | 58 | true 59 | Cfg_2 60 | true 61 | true 62 | 63 | 64 | UsageTrackerDemo 65 | Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 66 | 7177 67 | CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= 68 | 69 | 70 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 71 | Debug 72 | true 73 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName) 74 | 1033 75 | $(BDS)\bin\default_app.manifest 76 | $(BDS)\bin\delphi_PROJECTICON.ico 77 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 78 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 79 | none 80 | 81 | 82 | $(BDS)\bin\delphi_PROJECTICON.ico 83 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png 84 | $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png 85 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 86 | Debug 87 | true 88 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 89 | 1033 90 | $(BDS)\bin\default_app.manifest 91 | none 92 | 93 | 94 | 7.0 95 | 0 96 | False 97 | 0 98 | RELEASE;$(DCC_Define) 99 | ..\..;$(DCC_UnitSearchPath) 100 | 101 | 102 | PerMonitorV2 103 | 104 | 105 | PerMonitorV2 106 | 107 | 108 | 7.0 109 | DEBUG;$(DCC_Define) 110 | ..\..;$(DCC_UnitSearchPath) 111 | 112 | 113 | PerMonitorV2 114 | 115 | 116 | PerMonitorV2 117 | true 118 | 1033 119 | CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments= 120 | 121 | 122 | Delphi.Personality.12 123 | VCLApplication 124 | 125 | 126 | 127 | False 128 | True 129 | False 130 | 131 | 132 | False 133 | False 134 | 1 135 | 0 136 | 0 137 | 0 138 | False 139 | False 140 | False 141 | False 142 | False 143 | 7177 144 | 1252 145 | 146 | 147 | 148 | 149 | 1.0.0.0 150 | 151 | 152 | 153 | 154 | 155 | 1.0.0.0 156 | 157 | 158 | 159 | Microsoft Office 2000 Sample Automation Server Wrapper Components 160 | Microsoft Office XP Sample Automation Server Wrapper Components 161 | 162 | 163 | UsageTrackerDemo.dpr 164 | 165 | 166 | 167 | True 168 | True 169 | 170 | 171 | 12 172 | 173 | 174 | 175 | 176 | MainSource 177 | 178 | 179 |
fDemo
180 | 181 | 182 | Base 183 | 184 | 185 | Cfg_1 186 | Base 187 | 188 | 189 | Cfg_2 190 | Base 191 | 192 | 193 | 194 | 195 | 196 | -------------------------------------------------------------------------------- /FullDebugMode DLL/FastMM_FullDebugMode.dpr: -------------------------------------------------------------------------------- 1 | { 2 | 3 | Fast Memory Manager: FullDebugMode Support DLL 1.64 4 | 5 | Description: 6 | Support DLL for FastMM. With this DLL available, FastMM will report debug info (unit name, line numbers, etc.) for 7 | stack traces. 8 | 9 | Usage: 10 | 1) To compile you will need the JCL library (http://sourceforge.net/projects/jcl/) 11 | 2) Place in the same location as the replacement borlndmm.dll or your application's executable module. 12 | 13 | Change log: 14 | Version 1.00 (9 July 2005): 15 | - Initial release. 16 | Version 1.01 (13 July 2005): 17 | - Added the option to use madExcept instead of the JCL Debug library. (Thanks to Martin Aignesberger.) 18 | Version 1.02 (30 September 2005): 19 | - Changed options to display detail for addresses inside libraries as well. 20 | Version 1.03 (13 October 2005): 21 | - Added a raw stack trace procedure that implements raw stack traces. 22 | Version 1.10 (14 October 2005): 23 | - Improved the program logic behind the skipping of stack levels to cause less incorrect entries in raw stack traces. 24 | (Thanks to Craig Peterson.) 25 | Version 1.20 (17 October 2005): 26 | - Improved support for madExcept stack traces. (Thanks to Mathias Rauen.) 27 | Version 1.30 (26 October 2005): 28 | - Changed name to FastMM_FullDebugMode to reflect the fact that there is now a static dependency on this DLL for 29 | FullDebugMode. The static dependency solves a DLL unload order issue. (Thanks to Bart van der Werf.) 30 | Version 1.40 (31 October 2005): 31 | - Added support for EurekaLog. (Thanks to Fabio Dell'Aria.) 32 | Version 1.42 (23 June 2006): 33 | - Fixed a bug in the RawStackTraces code that may have caused an A/V in some rare circumstances. (Thanks to Primoz 34 | Gabrijelcic.) 35 | Version 1.44 (16 November 2006): 36 | - Changed the RawStackTraces code to prevent it from modifying the Windows "GetLastError" error code. (Thanks to 37 | Primoz Gabrijelcic.) 38 | Version 1.50 (14 August 2008): 39 | - Added support for Delphi 2009. (Thanks to Mark Edington.) 40 | Version 1.60 (5 May 2009): 41 | - Improved the code used to identify call instructions in the stack trace code. (Thanks to the JCL team.) 42 | Version 1.61 (5 September 2010): 43 | - Recompiled using the latest JCL in order to fix a possible crash on shutdown when the executable contains no debug 44 | information. (Thanks to Hanspeter Widmer.) 45 | Version 1.62 (19 July 2012): 46 | - Added a workaround for QC 107209 (Thanks to David Heffernan.) 47 | Version 1.63 (14 September 2013): 48 | - Added support for OSX (Thanks to Sebastian Zierer) 49 | Version 1.64 (27 February 2021) 50 | - Implemented a return address information cache that greatly speeds up the conversion of many similar stack traces 51 | to text. 52 | Version 1.65 (10 July 2023) 53 | - Made LogStackTrace thread safe. 54 | 55 | } 56 | 57 | {$IFDEF MSWINDOWS} 58 | {--------------------Start of options block-------------------------} 59 | 60 | {Select the stack tracing library to use. The JCL, madExcept and EurekaLog are supported. Only one can be used at a 61 | time.} 62 | {$define JCLDebug} 63 | {.$define madExcept} 64 | {.$define EurekaLog_Legacy} 65 | {.$define EurekaLog_V7} 66 | 67 | {--------------------End of options block-------------------------} 68 | {$ENDIF} 69 | 70 | // JCL_DEBUG_EXPERT_INSERTJDBG OFF 71 | library FastMM_FullDebugMode; 72 | 73 | uses 74 | {$ifdef JCLDebug}JCLDebug,{$endif} 75 | {$ifdef madExcept}madStackTrace,{$endif} 76 | {$ifdef EurekaLog_Legacy}ExceptionLog,{$endif} 77 | {$ifdef EurekaLog_V7}EFastMM4Support,{$endif} 78 | System.SysUtils, {$IFDEF MACOS}Posix.Base, SBMapFiles {$ELSE} Winapi.Windows {$ENDIF}; 79 | 80 | {$R *.res} 81 | 82 | {$StackFrames on} 83 | {$warn Symbol_Platform off} 84 | 85 | {The name of the 64-bit DLL has a '64' at the end.} 86 | {$if SizeOf(Pointer) = 8} 87 | {$LIBSUFFIX '64'} 88 | {$ifend} 89 | 90 | {--------------------------Return Address Info Cache --------------------------} 91 | 92 | const 93 | CReturnAddressCacheSize = 4096; 94 | {FastMM assumes a maximum of 256 characters per stack trace entry. The address text and line break are in addition to 95 | the info text.} 96 | CMaxInfoTextLength = 224; 97 | 98 | type 99 | {Return address info cache: Maintains the source information for up to CReturnAddressCacheSize return addresses in 100 | a binary search tree.} 101 | 102 | PReturnAddressInfo = ^TReturnAddressInfo; 103 | TReturnAddressInfo = record 104 | ParentEntry: PReturnAddressInfo; 105 | ChildEntries: array[0..1] of PReturnAddressInfo; 106 | ReturnAddress: NativeUInt; 107 | InfoTextLength: Integer; 108 | InfoText: array[0..CMaxInfoTextLength - 1] of AnsiChar; 109 | end; 110 | 111 | TReturnAddressInfoCache = record 112 | {Entry 0 is the root of the tree.} 113 | Entries: array[0..CReturnAddressCacheSize] of TReturnAddressInfo; 114 | NextNewEntryIndex: Integer; 115 | function AddEntry(AReturnAddress: NativeUInt; const AReturnAddressInfoText: AnsiString): PReturnAddressInfo; 116 | procedure DeleteEntry(AEntry: PReturnAddressInfo); 117 | function FindEntry(AReturnAddress: NativeUInt): PReturnAddressInfo; 118 | end; 119 | 120 | function TReturnAddressInfoCache.AddEntry(AReturnAddress: NativeUInt; const AReturnAddressInfoText: AnsiString): PReturnAddressInfo; 121 | var 122 | LParentItem, LChildItem: PReturnAddressInfo; 123 | LAddressBits: NativeUInt; 124 | LChildIndex: Integer; 125 | begin 126 | {Get the address of the entry to reuse. (Entry 0 is the tree root.)} 127 | if NextNewEntryIndex = High(Entries) then 128 | NextNewEntryIndex := 0; 129 | Inc(NextNewEntryIndex); 130 | 131 | Result := @Entries[NextNewEntryIndex]; 132 | 133 | {Delete it if it is already in use} 134 | DeleteEntry(Result); 135 | 136 | {Step down the tree until an open slot is found in the required direction.} 137 | LParentItem := @Entries[0]; 138 | LAddressBits := AReturnAddress; 139 | while True do 140 | begin 141 | {Get the current child in the appropriate direction.} 142 | LChildItem := LParentItem.ChildEntries[LAddressBits and 1]; 143 | {No child -> This slot is available.} 144 | if LChildItem = nil then 145 | Break; 146 | {Traverse further down the tree.} 147 | LParentItem := LChildItem; 148 | LAddressBits := LAddressBits shr 1; 149 | end; 150 | LChildIndex := LAddressBits and 1; 151 | 152 | {Insert the node into the tree} 153 | LParentItem.ChildEntries[LChildIndex] := Result; 154 | Result.ParentEntry := LParentItem; 155 | 156 | {Set the info text for the item.} 157 | Result.ReturnAddress := AReturnAddress; 158 | Result.InfoTextLength := Length(AReturnAddressInfoText); 159 | if Result.InfoTextLength > CMaxInfoTextLength then 160 | Result.InfoTextLength := CMaxInfoTextLength; 161 | System.Move(Pointer(AReturnAddressInfoText)^, Result.InfoText, Result.InfoTextLength * SizeOf(AnsiChar)); 162 | end; 163 | 164 | procedure TReturnAddressInfoCache.DeleteEntry(AEntry: PReturnAddressInfo); 165 | var 166 | LRemovedItemChildIndex, LMovedItemChildIndex: Integer; 167 | LMovedItem, LChildItem: PReturnAddressInfo; 168 | begin 169 | {Is this entry currentlty in the tree?} 170 | if AEntry.ParentEntry = nil then 171 | Exit; 172 | 173 | LRemovedItemChildIndex := Ord(AEntry.ParentEntry.ChildEntries[1] = AEntry); 174 | 175 | {Does this item have children of its own?} 176 | if (NativeInt(AEntry.ChildEntries[0]) or NativeInt(AEntry.ChildEntries[1])) <> 0 then 177 | begin 178 | {It has children: We need to traverse child items until we find a leaf item and then move it into this item's 179 | position in the search tree.} 180 | LMovedItem := AEntry; 181 | 182 | while True do 183 | begin 184 | LChildItem := LMovedItem.ChildEntries[0]; //try left then right 185 | if LChildItem = nil then 186 | begin 187 | LChildItem := LMovedItem.ChildEntries[1]; 188 | if LChildItem = nil then 189 | Break; 190 | end; 191 | LMovedItem := LChildItem; 192 | end; 193 | 194 | {Disconnect the moved item from its current parent item.} 195 | LMovedItemChildIndex := Ord(LMovedItem.ParentEntry.ChildEntries[1] = LMovedItem); 196 | LMovedItem.ParentEntry.ChildEntries[LMovedItemChildIndex] := nil; 197 | 198 | {Set the new parent for the moved item} 199 | AEntry.ParentEntry.ChildEntries[LRemovedItemChildIndex] := LMovedItem; 200 | LMovedItem.ParentEntry := AEntry.ParentEntry; 201 | 202 | {Set the new left child for the moved item} 203 | LChildItem := AEntry.ChildEntries[0]; 204 | if LChildItem <> nil then 205 | begin 206 | LMovedItem.ChildEntries[0] := LChildItem; 207 | LChildItem.ParentEntry := LMovedItem; 208 | AEntry.ChildEntries[0] := nil; 209 | end; 210 | 211 | {Set the new right child for the moved item} 212 | LChildItem := AEntry.ChildEntries[1]; 213 | if LChildItem <> nil then 214 | begin 215 | LMovedItem.ChildEntries[1] := LChildItem; 216 | LChildItem.ParentEntry := LMovedItem; 217 | AEntry.ChildEntries[1] := nil; 218 | end; 219 | 220 | end 221 | else 222 | begin 223 | {The deleted item is a leaf item: Remove it from the tree directly.} 224 | AEntry.ParentEntry.ChildEntries[LRemovedItemChildIndex] := nil; 225 | end; 226 | {Reset the parent for the removed item.} 227 | AEntry.ParentEntry := nil; 228 | end; 229 | 230 | function TReturnAddressInfoCache.FindEntry(AReturnAddress: NativeUInt): PReturnAddressInfo; 231 | var 232 | LAddressBits: NativeUInt; 233 | LParentItem: PReturnAddressInfo; 234 | begin 235 | LAddressBits := AReturnAddress; 236 | LParentItem := @Entries[0]; 237 | {Step down the tree until the item is found or there is no child item in the required direction.} 238 | while True do 239 | begin 240 | {Get the child item in the required direction.} 241 | Result := LParentItem.ChildEntries[LAddressBits and 1]; 242 | {If there is no child, or the child's key value matches the search key value then we're done.} 243 | if (Result = nil) 244 | or (Result.ReturnAddress = AReturnAddress) then 245 | begin 246 | Exit; 247 | end; 248 | {The child key value is not a match -> Move down the tree.} 249 | LParentItem := Result; 250 | LAddressBits := LAddressBits shr 1; 251 | end; 252 | end; 253 | 254 | {--------------------------Stack Tracing Subroutines--------------------------} 255 | 256 | procedure GetStackRange(var AStackBaseAddress, ACurrentStackPointer: NativeUInt); 257 | asm 258 | {$if SizeOf(Pointer) = 8} 259 | mov rax, gs:[abs 8] 260 | mov [rcx], rax 261 | mov [rdx], rbp 262 | {$else} 263 | mov ecx, fs:[4] 264 | mov [eax], ecx 265 | mov [edx], ebp 266 | {$ifend} 267 | end; 268 | 269 | {--------------------------Frame Based Stack Tracing--------------------------} 270 | 271 | {$if SizeOf(Pointer) = 8} 272 | 273 | function CaptureStackBackTrace(FramesToSkip, FramesToCapture: DWORD; 274 | BackTrace: Pointer; BackTraceHash: PDWORD): Word; 275 | external kernel32 name 'RtlCaptureStackBackTrace'; 276 | 277 | {We use the Windows API to do frame based stack tracing under 64-bit.} 278 | procedure GetFrameBasedStackTrace(AReturnAddresses: PNativeUInt; 279 | AMaxDepth, ASkipFrames: Cardinal); 280 | begin 281 | CaptureStackBackTrace(ASkipFrames, AMaxDepth, AReturnAddresses, nil); 282 | end; 283 | 284 | {$else} 285 | 286 | {Dumps the call stack trace to the given address. Fills the list with the addresses where the called addresses can be 287 | found. This is the fast stack frame based tracing routine.} 288 | procedure GetFrameBasedStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); 289 | var 290 | LStackTop, LStackBottom, LCurrentFrame: NativeUInt; 291 | begin 292 | {Get the call stack top and current bottom} 293 | GetStackRange(LStackTop, LStackBottom); 294 | Dec(LStackTop, SizeOf(Pointer) - 1); 295 | {Get the current frame start} 296 | LCurrentFrame := LStackBottom; 297 | {Fill the call stack} 298 | while (AMaxDepth > 0) 299 | and (LCurrentFrame >= LStackBottom) 300 | and (LCurrentFrame < LStackTop) do 301 | begin 302 | {Ignore the requested number of levels} 303 | if ASkipFrames = 0 then 304 | begin 305 | AReturnAddresses^ := PNativeUInt(LCurrentFrame + SizeOf(Pointer))^; 306 | Inc(AReturnAddresses); 307 | Dec(AMaxDepth); 308 | end 309 | else 310 | Dec(ASkipFrames); 311 | {Get the next frame} 312 | LCurrentFrame := PNativeUInt(LCurrentFrame)^; 313 | end; 314 | {Clear the remaining entries} 315 | while AMaxDepth > 0 do 316 | begin 317 | AReturnAddresses^ := 0; 318 | Inc(AReturnAddresses); 319 | Dec(AMaxDepth); 320 | end; 321 | end; 322 | {$ifend} 323 | 324 | {-----------------------------Raw Stack Tracing-----------------------------} 325 | 326 | const 327 | {Hexadecimal characters} 328 | HexTable: array[0..15] of AnsiChar = '0123456789ABCDEF'; 329 | 330 | type 331 | {The state of a memory page. Used by the raw stack tracing mechanism to determine whether an address is a valid call 332 | site or not.} 333 | TMemoryPageAccess = (mpaUnknown, mpaNotExecutable, mpaExecutable); 334 | 335 | var 336 | {There are a total of 1M x 4K pages in the (low) 4GB address space} 337 | MemoryPageAccessMap: array[0..1024 * 1024 - 1] of TMemoryPageAccess; 338 | 339 | {$IFDEF MSWINDOWS} 340 | {Updates the memory page access map. Currently only supports the low 4GB of address space.} 341 | procedure UpdateMemoryPageAccessMap(AAddress: NativeUInt); 342 | var 343 | LMemInfo: TMemoryBasicInformation; 344 | LAccess: TMemoryPageAccess; 345 | LStartPage, LPageCount: NativeUInt; 346 | begin 347 | {Query the page} 348 | if VirtualQuery(Pointer(AAddress), LMemInfo, SizeOf(LMemInfo)) <> 0 then 349 | begin 350 | {Get access type} 351 | if (LMemInfo.State = MEM_COMMIT) 352 | and (LMemInfo.Protect and (PAGE_EXECUTE_READ or PAGE_EXECUTE_READWRITE or PAGE_EXECUTE_WRITECOPY or PAGE_EXECUTE) <> 0) 353 | and (LMemInfo.Protect and PAGE_GUARD = 0) then 354 | begin 355 | LAccess := mpaExecutable 356 | end 357 | else 358 | LAccess := mpaNotExecutable; 359 | {Update the map} 360 | LStartPage := NativeUInt(LMemInfo.BaseAddress) div 4096; 361 | LPageCount := LMemInfo.RegionSize div 4096; 362 | if LStartPage < NativeUInt(Length(MemoryPageAccessMap)) then 363 | begin 364 | if (LStartPage + LPageCount) >= NativeUInt(Length(MemoryPageAccessMap)) then 365 | LPageCount := NativeUInt(Length(MemoryPageAccessMap)) - LStartPage; 366 | FillChar(MemoryPageAccessMap[LStartPage], LPageCount, Ord(LAccess)); 367 | end; 368 | end 369 | else 370 | begin 371 | {Invalid address} 372 | MemoryPageAccessMap[AAddress div 4096] := mpaNotExecutable; 373 | end; 374 | end; 375 | {$ENDIF} 376 | 377 | {Thread-safe version that avoids the global variable Default8087CW.} 378 | procedure Set8087CW(ANewCW: Word); 379 | var 380 | L8087CW: Word; 381 | asm 382 | mov L8087CW, ANewCW 383 | fnclex 384 | fldcw L8087CW 385 | end; 386 | 387 | {$if CompilerVersion > 22} 388 | {Thread-safe version that avoids the global variable DefaultMXCSR.} 389 | procedure SetMXCSR(ANewMXCSR: Cardinal); 390 | var 391 | LMXCSR: Cardinal; 392 | asm 393 | {$if SizeOf(Pointer) <> 8} 394 | cmp System.TestSSE, 0 395 | je @exit 396 | {$ifend} 397 | {Remove the flag bits} 398 | and ANewMXCSR, $ffc0 399 | mov LMXCSR, ANewMXCSR 400 | ldmxcsr LMXCSR 401 | @exit: 402 | end; 403 | {$ifend} 404 | 405 | {$IFDEF MSWINDOWS} 406 | {Returns true if the return address is a valid call site. This function is only safe to call while exceptions are 407 | being handled.} 408 | function IsValidCallSite(AReturnAddress: NativeUInt): boolean; 409 | var 410 | LCallAddress: NativeUInt; 411 | LCode8Back, LCode4Back, LTemp: Cardinal; 412 | LOld8087CW: Word; 413 | LOldMXCSR: Cardinal; 414 | begin 415 | {We assume (for now) that all code will execute within the first 4GB of address space.} 416 | if (AReturnAddress > $ffff) {$if SizeOf(Pointer) = 8}and (AReturnAddress <= $ffffffff){$endif} then 417 | begin 418 | {The call address is up to 8 bytes before the return address} 419 | LCallAddress := AReturnAddress - 8; 420 | {Update the page map} 421 | if MemoryPageAccessMap[LCallAddress div 4096] = mpaUnknown then 422 | UpdateMemoryPageAccessMap(LCallAddress); 423 | {Check the page access} 424 | if (MemoryPageAccessMap[LCallAddress div 4096] = mpaExecutable) 425 | and (MemoryPageAccessMap[(LCallAddress + 8) div 4096] = mpaExecutable) then 426 | begin 427 | {Try to determine what kind of call it is (if any), more or less in order of frequency of occurrence. (Code below 428 | taken from the Jedi Code Library (jcl.sourceforge.net).) We need to retrieve the current floating point control 429 | registers, since any external exception will reset it to the DLL defaults which may not otherwise correspond to 430 | the defaults of the main application (QC 107198).} 431 | LOld8087CW := Get8087CW; 432 | LOldMXCSR := GetMXCSR; 433 | try 434 | {5 bytes, CALL NEAR REL32} 435 | if PByteArray(LCallAddress)[3] = $E8 then 436 | begin 437 | Result := True; 438 | Exit; 439 | end; 440 | {Get the 4 bytes before the return address} 441 | LCode4Back := PCardinal(LCallAddress + 4)^; 442 | {2 byte call?} 443 | LTemp := LCode4Back and $F8FF0000; 444 | {2 bytes, CALL NEAR EAX} 445 | if LTemp = $D0FF0000 then 446 | begin 447 | Result := True; 448 | Exit; 449 | end; 450 | {2 bytes, CALL NEAR [EAX]} 451 | if LTemp = $10FF0000 then 452 | begin 453 | LTemp := LCode4Back - LTemp; 454 | if (LTemp <> $04000000) and (LTemp <> $05000000) then 455 | begin 456 | Result := True; 457 | Exit; 458 | end; 459 | end; 460 | {3 bytes, CALL NEAR [EAX+EAX*i]} 461 | if (LCode4Back and $00FFFF00) = $0014FF00 then 462 | begin 463 | Result := True; 464 | Exit; 465 | end; 466 | {3 bytes, CALL NEAR [EAX+$12]} 467 | if ((LCode4Back and $00F8FF00) = $0050FF00) 468 | and ((LCode4Back and $00070000) <> $00040000) then 469 | begin 470 | Result := True; 471 | Exit; 472 | end; 473 | {4 bytes, CALL NEAR [EAX+EAX+$12]} 474 | if Word(LCode4Back) = $54FF then 475 | begin 476 | Result := True; 477 | Exit; 478 | end; 479 | {6 bytes, CALL NEAR [$12345678]} 480 | LCode8Back := PCardinal(LCallAddress)^; 481 | if (LCode8Back and $FFFF0000) = $15FF0000 then 482 | begin 483 | Result := True; 484 | Exit; 485 | end; 486 | {6 bytes, CALL NEAR [EAX+$12345678]} 487 | if ((LCode8Back and $F8FF0000) = $90FF0000) 488 | and ((LCode8Back and $07000000) <> $04000000) then 489 | begin 490 | Result := True; 491 | Exit; 492 | end; 493 | {7 bytes, CALL NEAR [EAX+EAX+$1234567]} 494 | if (LCode8Back and $00FFFF00) = $0094FF00 then 495 | begin 496 | Result := True; 497 | Exit; 498 | end; 499 | {7 bytes, CALL FAR $1234:12345678} 500 | if (LCode8Back and $0000FF00) = $00009A00 then 501 | begin 502 | Result := True; 503 | Exit; 504 | end; 505 | {Not a valid call site} 506 | Result := False; 507 | except 508 | {The access has changed} 509 | UpdateMemoryPageAccessMap(LCallAddress); 510 | {The RTL sets the FPU control words to the default values if an external exception occurs. Reset their values 511 | here to the values on entry to this call.} 512 | Set8087CW(LOld8087CW); 513 | SetMXCSR(LOldMXCSR); 514 | {Not executable} 515 | Result := False; 516 | end; 517 | end 518 | else 519 | Result := False; 520 | end 521 | else 522 | Result := False; 523 | end; 524 | {$ENDIF} 525 | 526 | {Dumps the call stack trace to the given address. Fills the list with the addresses where the called addresses can be 527 | found. This is the "raw" stack tracing routine.} 528 | 529 | {$IFDEF MACOS} 530 | function backtrace(result: PNativeUInt; size: Integer): Integer; cdecl; external libc name '_backtrace'; 531 | function _NSGetExecutablePath(buf: PAnsiChar; BufSize: PCardinal): Integer; cdecl; external libc name '__NSGetExecutablePath'; 532 | {$ENDIF} 533 | 534 | procedure GetRawStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth, ASkipFrames: Cardinal); 535 | var 536 | LStackTop, LStackBottom, LCurrentFrame, LNextFrame, LReturnAddress, 537 | LStackAddress: NativeUInt; 538 | LLastOSError: Cardinal; 539 | 540 | {$IFDEF MACOS} 541 | StackLog: PNativeUInt; //array[0..10] of Pointer; 542 | Cnt: Integer; 543 | I: Integer; 544 | {$ENDIF} 545 | begin 546 | {$IFDEF MACOS} 547 | {$POINTERMATH ON} 548 | Cnt := AMaxDepth + ASkipFrames; 549 | 550 | GetMem(StackLog, SizeOf(Pointer) * Cnt); 551 | try 552 | Cnt := backtrace(StackLog, Cnt); 553 | 554 | for I := ASkipFrames to Cnt - 1 do 555 | begin 556 | // writeln('Stack: ', inttohex(NativeUInt(stacklog[I]), 8)); 557 | AReturnAddresses[I - ASkipFrames] := StackLog[I]; 558 | end; 559 | 560 | finally 561 | FreeMem(StackLog); 562 | end; 563 | {$POINTERMATH OFF} 564 | {$ENDIF} 565 | {Are exceptions being handled? Can only do a raw stack trace if the possible access violations are going to be 566 | handled.} 567 | {$IFDEF MSWINDOWS} 568 | if Assigned(ExceptObjProc) then 569 | begin 570 | {Save the last Windows error code} 571 | LLastOSError := GetLastError; 572 | {Get the call stack top and current bottom} 573 | GetStackRange(LStackTop, LStackBottom); 574 | Dec(LStackTop, SizeOf(Pointer) - 1); 575 | {Get the current frame start} 576 | LCurrentFrame := LStackBottom; 577 | {Fill the call stack} 578 | while (AMaxDepth > 0) 579 | and (LCurrentFrame < LStackTop) do 580 | begin 581 | {Get the next frame} 582 | LNextFrame := PNativeUInt(LCurrentFrame)^; 583 | {Is it a valid stack frame address?} 584 | if (LNextFrame < LStackTop) 585 | and (LNextFrame > LCurrentFrame) then 586 | begin 587 | {The pointer to the next stack frame appears valid: Get the return address of the current frame} 588 | LReturnAddress := PNativeUInt(LCurrentFrame + SizeOf(Pointer))^; 589 | {Does this appear to be a valid return address} 590 | if (LReturnAddress > $ffff) {$if SizeOf(Pointer) = 8}and (LReturnAddress <= $ffffffff){$endif} then 591 | begin 592 | {Is the map for this return address incorrect? It may be unknown or marked as non-executable because a library 593 | was previously not yet loaded, or perhaps this is not a valid stack frame.} 594 | if MemoryPageAccessMap[(LReturnAddress - 8) div 4096] <> mpaExecutable then 595 | UpdateMemoryPageAccessMap(LReturnAddress - 8); 596 | {Is this return address actually valid?} 597 | if IsValidCallSite(LReturnAddress) then 598 | begin 599 | {Ignore the requested number of levels} 600 | if ASkipFrames = 0 then 601 | begin 602 | AReturnAddresses^ := LReturnAddress; 603 | Inc(AReturnAddresses); 604 | Dec(AMaxDepth); 605 | end; 606 | end 607 | else 608 | begin 609 | {If the return address is invalid it implies this stack frame is invalid after all.} 610 | LNextFrame := LStackTop; 611 | end; 612 | end 613 | else 614 | begin 615 | {The return address is bad - this is not a valid stack frame} 616 | LNextFrame := LStackTop; 617 | end; 618 | end 619 | else 620 | begin 621 | {This is not a valid stack frame} 622 | LNextFrame := LStackTop; 623 | end; 624 | {Do not check intermediate entries if there are still frames to skip} 625 | if ASkipFrames <> 0 then 626 | begin 627 | Dec(ASkipFrames); 628 | end 629 | else 630 | begin 631 | {Check all stack entries up to the next stack frame} 632 | LStackAddress := LCurrentFrame + 2 * SizeOf(Pointer); 633 | while (AMaxDepth > 0) 634 | and (LStackAddress < LNextFrame) do 635 | begin 636 | {Get the return address} 637 | LReturnAddress := PNativeUInt(LStackAddress)^; 638 | {Is this a valid call site?} 639 | if IsValidCallSite(LReturnAddress) then 640 | begin 641 | AReturnAddresses^ := LReturnAddress; 642 | Inc(AReturnAddresses); 643 | Dec(AMaxDepth); 644 | end; 645 | {Check the next stack address} 646 | Inc(LStackAddress, SizeOf(Pointer)); 647 | end; 648 | end; 649 | {Do the next stack frame} 650 | LCurrentFrame := LNextFrame; 651 | end; 652 | {Clear the remaining entries} 653 | while AMaxDepth > 0 do 654 | begin 655 | AReturnAddresses^ := 0; 656 | Inc(AReturnAddresses); 657 | Dec(AMaxDepth); 658 | end; 659 | {Restore the last Windows error code, since a VirtualQuery call may have modified it.} 660 | SetLastError(LLastOSError); 661 | end 662 | else 663 | begin 664 | {Exception handling is not available - do a frame based stack trace} 665 | GetFrameBasedStackTrace(AReturnAddresses, AMaxDepth, ASkipFrames); 666 | end; 667 | {$ENDIF} 668 | end; 669 | 670 | {-----------------------------Stack Trace Logging----------------------------} 671 | 672 | {Gets the textual representation of the stack trace into ABuffer and returns a pointer to the position just after the 673 | last character.} 674 | {$ifdef JCLDebug} 675 | {Converts an unsigned integer to a hexadecimal string at the buffer location, returning the new buffer position.} 676 | function NativeUIntToHexBuf(ANum: NativeUInt; APBuffer: PAnsiChar): PAnsiChar; 677 | const 678 | MaxDigits = 16; 679 | var 680 | LDigitBuffer: array[0..MaxDigits - 1] of AnsiChar; 681 | LCount: Cardinal; 682 | LDigit: NativeUInt; 683 | begin 684 | {Generate the digits in the local buffer} 685 | LCount := 0; 686 | repeat 687 | LDigit := ANum; 688 | ANum := ANum div 16; 689 | LDigit := LDigit - ANum * 16; 690 | Inc(LCount); 691 | LDigitBuffer[MaxDigits - LCount] := HexTable[LDigit]; 692 | until ANum = 0; 693 | {Add leading zeros} 694 | while LCount < SizeOf(NativeUInt) * 2 do 695 | begin 696 | Inc(LCount); 697 | LDigitBuffer[MaxDigits - LCount] := '0'; 698 | end; 699 | {Copy the digits to the output buffer and advance it} 700 | System.Move(LDigitBuffer[MaxDigits - LCount], APBuffer^, LCount); 701 | Result := APBuffer + LCount; 702 | end; 703 | 704 | {Subroutine used by LogStackTrace} 705 | procedure AppendInfoToString(var AString: string; const AInfo: string); 706 | begin 707 | if AInfo <> '' then 708 | AString := Format('%s[%s]', [AString, AInfo]); 709 | end; 710 | 711 | var 712 | LReturnAddressInfoCache: TReturnAddressInfoCache; 713 | LLogStackTrace_Locked: Integer; //0 = unlocked, 1 = locked 714 | 715 | function LogStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; 716 | var 717 | LInd: Cardinal; 718 | LAddress: NativeUInt; 719 | LInfo: TJCLLocationInfo; 720 | LTempStr: string; 721 | P: PChar; 722 | LLocationCacheInitialized: Boolean; 723 | LPInfo: PReturnAddressInfo; 724 | begin 725 | LLocationCacheInitialized := False; 726 | 727 | Result := ABuffer; 728 | 729 | {This routine is protected by a lock - only one thread can be inside it at any given time.} 730 | while AtomicCmpExchange(LLogStackTrace_Locked, 1, 0) <> 0 do 731 | Winapi.Windows.SwitchToThread; 732 | 733 | try 734 | for LInd := 0 to AMaxDepth - 1 do 735 | begin 736 | LAddress := AReturnAddresses^; 737 | if LAddress = 0 then 738 | Exit; 739 | Result^ := #13; 740 | Inc(Result); 741 | Result^ := #10; 742 | Inc(Result); 743 | Result := NativeUIntToHexBuf(LAddress, Result); 744 | 745 | {If the info for the return address is not yet in the cache, add it.} 746 | LPInfo := LReturnAddressInfoCache.FindEntry(LAddress); 747 | if LPInfo = nil then 748 | begin 749 | if not LLocationCacheInitialized then 750 | begin 751 | {$if declared(BeginGetLocationInfoCache)} // available depending on the JCL's version 752 | BeginGetLocationInfoCache; 753 | {$endif} 754 | LLocationCacheInitialized := True; 755 | end; 756 | {Get location info for the caller (at least one byte before the return address).} 757 | GetLocationInfo(Pointer(LAddress - 1), LInfo); 758 | {Build the result string} 759 | LTempStr := ' '; 760 | AppendInfoToString(LTempStr, LInfo.SourceName); 761 | AppendInfoToString(LTempStr, LInfo.UnitName); 762 | 763 | {Remove UnitName from ProcedureName, no need to output it twice} 764 | P := PChar(LInfo.ProcedureName); 765 | if (StrLComp(P, PChar(LInfo.UnitName), Length(LInfo.UnitName)) = 0) and (P[Length(LInfo.UnitName)] = '.') then 766 | AppendInfoToString(LTempStr, Copy(LInfo.ProcedureName, Length(LInfo.UnitName) + 2)) 767 | else 768 | AppendInfoToString(LTempStr, LInfo.ProcedureName); 769 | 770 | if LInfo.LineNumber <> 0 then 771 | AppendInfoToString(LTempStr, IntToStr(LInfo.LineNumber)); 772 | 773 | LPInfo := LReturnAddressInfoCache.AddEntry(LAddress, AnsiString(LTempStr)); 774 | end; 775 | 776 | System.Move(LPInfo.InfoText, Result^, LPInfo.InfoTextLength); 777 | Inc(Result, LPInfo.InfoTextLength); 778 | 779 | Inc(AReturnAddresses); 780 | end; 781 | finally 782 | if LLocationCacheInitialized then 783 | begin 784 | {$if declared(BeginGetLocationInfoCache)} // available depending on the JCL's version 785 | EndGetLocationInfoCache; 786 | {$endif} 787 | end; 788 | 789 | LLogStackTrace_Locked := 0; 790 | end; 791 | end; 792 | {$endif} 793 | 794 | {$ifdef madExcept} 795 | function LogStackTrace(AReturnAddresses: PNativeUInt; 796 | AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; 797 | begin 798 | {Needs madExcept 2.7i or madExcept 3.0a or a newer build} 799 | Result := madStackTrace.FastMM_LogStackTrace( 800 | AReturnAddresses, 801 | AMaxDepth, 802 | ABuffer, 803 | {madExcept stack trace fine tuning} 804 | false, //hide items which have no line number information? 805 | true, //show relative address offset to procedure entrypoint? 806 | true, //show relative line number offset to procedure entry point? 807 | false //skip special noise reduction processing? 808 | ); 809 | end; 810 | {$endif} 811 | 812 | {$ifdef EurekaLog_Legacy} 813 | function LogStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; 814 | ABuffer: PAnsiChar): PAnsiChar; 815 | begin 816 | {Needs EurekaLog 5 or 6} 817 | Result := ExceptionLog.FastMM_LogStackTrace( 818 | AReturnAddresses, AMaxDepth, ABuffer, 819 | {EurekaLog stack trace fine tuning} 820 | False, // Show the DLLs functions call. <--| 821 | // |-- See the note below! 822 | False, // Show the BPLs functions call. <--| 823 | True // Show relative line no. offset to procedure start point. 824 | ); 825 | // NOTE: 826 | // ----- 827 | // With these values set both to "False", EurekaLog try to returns the best 828 | // call-stack available. 829 | // 830 | // To do this EurekaLog execute the following points: 831 | // -------------------------------------------------- 832 | // 1)...try to fill all call-stack items using only debug data with line no. 833 | // 2)...if remains some empty call-stack items from the previous process (1), 834 | // EurekaLog try to fill these with the BPLs functions calls; 835 | // 3)...if remains some empty call-stack items from the previous process (2), 836 | // EurekaLog try to fill these with the DLLs functions calls; 837 | end; 838 | {$endif} 839 | 840 | {$ifdef EurekaLog_V7} 841 | function LogStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; 842 | begin 843 | {Needs EurekaLog 7 or later} 844 | Result := EFastMM4Support.FastMM_LogStackTrace(PPointer(AReturnAddresses), AMaxDepth, ABuffer, 10 * 256, 845 | [ddUnit, ddProcedure, ddSourceCode], True, False, False, True, False, True); 846 | end; 847 | {$endif} 848 | 849 | {$IFDEF MACOS} 850 | 851 | {Appends the source text to the destination and returns the new destination position} 852 | function AppendStringToBuffer(const ASource, ADestination: PAnsiChar; ACount: Cardinal): PAnsiChar; 853 | begin 854 | System.Move(ASource^, ADestination^, ACount); 855 | Result := Pointer(PByte(ADestination) + ACount); 856 | end; 857 | 858 | var 859 | MapFile: TSBMapFile; 860 | 861 | function LogStackTrace(AReturnAddresses: PNativeUInt; AMaxDepth: Cardinal; ABuffer: PAnsiChar): PAnsiChar; 862 | var 863 | s1: AnsiString; 864 | I: Integer; 865 | FileName: array[0..255] of AnsiChar; 866 | Len: Cardinal; 867 | begin 868 | {$POINTERMATH ON} 869 | // writelN('LogStackTrace'); 870 | // for I := 0 to AMaxDepth - 1 do 871 | // Writeln(IntToHex(AReturnAddresses[I], 8)); 872 | 873 | // s1 := IntToHex(Integer(AReturnAddresses[0]), 8); 874 | // result := ABuffer; 875 | // Move(pointer(s1)^, result^, Length(s1)); 876 | // inc(result, Length(s1)); 877 | 878 | if MapFile = nil then 879 | begin 880 | MapFile := TSBMapFile.Create; 881 | Len := Length(FileName); 882 | _NSGetExecutablePath(@FileName[0], @Len); 883 | if FileExists(ChangeFileExt(FileName, '.map')) then 884 | MapFile.LoadFromFile(ChangeFileExt(FileName, '.map')); 885 | end; 886 | 887 | Result := ABuffer; 888 | 889 | s1 := #13#10; 890 | Result := AppendStringToBuffer(PAnsiChar(s1), Result, Length(s1)); 891 | 892 | for I := 0 to AMaxDepth - 1 do 893 | begin 894 | s1 := IntToHex(AReturnAddresses[I], 8); 895 | s1 := s1 + ' ' + MapFile.GetFunctionName(AReturnAddresses[I]) + #13#10; 896 | Result := AppendStringToBuffer(PAnsiChar(s1), Result, Length(s1)); 897 | end; 898 | 899 | {$POINTERMATH OFF} 900 | end; 901 | {$ENDIF} 902 | 903 | {-----------------------------Exported Functions----------------------------} 904 | 905 | exports 906 | GetFrameBasedStackTrace, 907 | GetRawStackTrace, 908 | LogStackTrace; 909 | 910 | begin 911 | {$ifdef JCLDebug} 912 | JclStackTrackingOptions := JclStackTrackingOptions + [stAllModules]; 913 | {$endif} 914 | 915 | end. 916 | -------------------------------------------------------------------------------- /FullDebugMode DLL/FastMM_FullDebugMode.dproj: -------------------------------------------------------------------------------- 1 |  2 | 3 | {990612ba-64b5-4560-bc82-798c7cdf11d3} 4 | FastMM_FullDebugMode.dpr 5 | Debug 6 | DCC32 7 | FastMM_FullDebugMode.dll 8 | None 9 | 19.5 10 | True 11 | Debug 12 | Win32 13 | 3 14 | Library 15 | 16 | 17 | true 18 | 19 | 20 | true 21 | Base 22 | true 23 | 24 | 25 | true 26 | Base 27 | true 28 | 29 | 30 | true 31 | Base 32 | true 33 | 34 | 35 | true 36 | Cfg_1 37 | true 38 | true 39 | 40 | 41 | true 42 | Cfg_1 43 | true 44 | true 45 | 46 | 47 | true 48 | Base 49 | true 50 | 51 | 52 | true 53 | Cfg_2 54 | true 55 | true 56 | 57 | 58 | true 59 | Cfg_2 60 | true 61 | true 62 | 63 | 64 | None 65 | true 66 | 65 67 | System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) 68 | 8 69 | true 70 | 1033 71 | CompanyName=Pierre le Riche;FileDescription=FastMM Debug Support Library;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode.dll;ProductName=FastMM Debug Support Library;ProductVersion=1.65;Comments= 72 | FastMM_FullDebugMode 73 | 74 | 75 | FullDebugMode_DLL_TestApp.exe 76 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) 77 | CompanyName=Pierre le Riche;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode.dll;ProductVersion=1.65;Comments=;ProgramID=;FileDescription=FastMM Debug Support Library;ProductName=FastMM Debug Support Library 78 | none 79 | 80 | 81 | C:\Projects\CIMSO\Components\Current\PSD40\FastMM4\FullDebugMode DLL\FullDebugMode_DLL_TestApp.exe 82 | System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace) 83 | CompanyName=Pierre le Riche;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode64.dll;ProductVersion=1.65;Comments=;ProgramID=;FileDescription=FastMM Debug Support Library;ProductName=FastMM Debug Support Library 84 | none 85 | 86 | 87 | 7.0 88 | 0 89 | False 90 | 0 91 | 3 92 | RELEASE;$(DCC_Define) 93 | 94 | 95 | CompanyName=Pierre le Riche;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode.dll;ProductVersion=1.65;Comments=;ProgramID=;FileDescription=FastMM Debug Support Library;ProductName=FastMM Debug Support Library 96 | 97 | 98 | CompanyName=Pierre le Riche;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode64.dll;ProductVersion=1.65;Comments=;ProgramID=;FileDescription=FastMM Debug Support Library;ProductName=FastMM Debug Support Library 99 | 100 | 101 | 7.0 102 | 3 103 | DEBUG;$(DCC_Define) 104 | 105 | 106 | CompanyName=Pierre le Riche;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode.dll;ProductVersion=1.65;Comments=;ProgramID=;FileDescription=FastMM Debug Support Library;ProductName=FastMM Debug Support Library 107 | 108 | 109 | CompanyName=Pierre le Riche;FileVersion=1.65.0.8;InternalName=;LegalCopyright=(c) 2004-2023 Pierre le Riche;LegalTrademarks=;OriginalFilename=FastMM_FullDebugMode64.dll;ProductVersion=1.65;Comments=;ProgramID=;FileDescription=FastMM Debug Support Library;ProductName=FastMM Debug Support Library 110 | true 111 | 112 | 113 | Delphi.Personality.12 114 | VCLApplication 115 | 116 | 117 | 118 | False 119 | True 120 | False 121 | 122 | 123 | True 124 | False 125 | 1 126 | 61 127 | 0 128 | 6 129 | False 130 | False 131 | False 132 | False 133 | False 134 | 7177 135 | 1252 136 | 137 | 138 | PSD / Pierre le Riche 139 | FastMM FullDebugMode Support DLL 140 | 1.61.0.6 141 | 142 | (c) Professional Software Development 143 | Licence: MPL 1.1 144 | FastMM_FullDebugMode.dll 145 | FastMM FullDebugMode Support DLL 146 | 1.60 147 | 148 | 149 | 150 | FastMM_FullDebugMode.dpr 151 | 152 | 153 | 154 | True 155 | True 156 | 157 | 158 | 12 159 | 160 | 161 | 162 | 163 | MainSource 164 | 165 | 166 | Base 167 | 168 | 169 | Cfg_1 170 | Base 171 | 172 | 173 | Cfg_2 174 | Base 175 | 176 | 177 | 178 | 179 | 180 | 181 | -------------------------------------------------------------------------------- /FullDebugMode DLL/Precompiled/FastMM_FullDebugMode.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/FullDebugMode DLL/Precompiled/FastMM_FullDebugMode.dll -------------------------------------------------------------------------------- /FullDebugMode DLL/Precompiled/FastMM_FullDebugMode64.dll: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/FullDebugMode DLL/Precompiled/FastMM_FullDebugMode64.dll -------------------------------------------------------------------------------- /Images/FastMM5-social.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Images/FastMM5-social.png -------------------------------------------------------------------------------- /Images/FastMM5.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Images/FastMM5.jpg -------------------------------------------------------------------------------- /Images/FastMM5.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Images/FastMM5.png -------------------------------------------------------------------------------- /Images/FastMMv5-square.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Images/FastMMv5-square.jpg -------------------------------------------------------------------------------- /Images/FastMMv5-square.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pleriche/FastMM5/c80e84e48190d0d2ab1b184e17c50e79b5e3dcbd/Images/FastMMv5-square.png -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # FastMM5 2 | FastMM is a fast replacement memory manager for Embarcadero Delphi applications that scales well across multiple threads and CPU cores, is not prone to memory fragmentation, and supports shared memory without the use of external .DLL files. 3 | 4 | ![FastMM5-social.png](Images/FastMM5-social.png "FastMM5-social.png") 5 | 6 | Version 5 is a complete rewrite of FastMM. It is designed from the ground up to simultaneously keep the strengths and address the shortcomings of version 4.992: 7 | * Multithreaded scaling across multiple CPU cores is massively improved, without memory usage blowout. It can be configured to scale close to linearly for any number of CPU cores. 8 | * In the Fastcode memory manager benchmark tool FastMM 5 scores 15% higher than FastMM 4.992 on the single threaded benchmarks, and 30% higher on the multithreaded benchmarks. (I7-8700K CPU, EnableMMX and AssumeMultithreaded options enabled.) 9 | * It is fully configurable runtime. There is no need to change conditional defines and recompile to change options. (It is however backward compatible with many of the version 4 conditional defines.) 10 | * Debug mode uses the same debug support library as version 4 (FastMM_FullDebugMode.dll) by default, but custom stack trace routines are also supported. Call FastMM_EnterDebugMode to switch to debug mode ("FullDebugMode") and call FastMM_ExitDebugMode to return to performance mode. Calls may be nested, in which case debug mode will be exited after the last FastMM_ExitDebugMode call. 11 | * Supports 8, 16, 32 or 64 byte alignment of all blocks. Call FastMM_EnterMinimumAddressAlignment to request a minimum block alignment, and FastMM_ExitMinimumAddressAlignment to rescind a prior request. Calls may be nested, in which case the coarsest alignment request will be in effect. 12 | * All event notifications (errors, memory leak messages, etc.) may be routed to the debugger (via OutputDebugString), a log file, the screen or any combination of the three. Messages are built using templates containing mail-merge tokens. Templates may be changed runtime to facilitate different layouts and/or translation into any language. Templates fully support Unicode, and the log file may be configured to be written in UTF-8 or UTF-16 format, with or without a BOM. 13 | * It may be configured runtime to favour speed, memory usage efficiency or a blend of the two via the FastMM_SetOptimizationStrategy call. 14 | 15 | Homepage: https://github.com/pleriche/FastMM5 16 | 17 | ### Developed by 18 | Pierre le Riche, copyright 2004 - 2025, all rights reserved 19 | 20 | ### Sponsored by 21 | [gs-soft AG](https://www.gs-soft.com/) 22 | 23 | ### Licence 24 | FastMM 5 is dual-licensed. You may choose to use it under the restrictions of the GPL v3 licence at no cost to you, or you may purchase a commercial licence. A commercial licence grants you the right to use FastMM5 in your own applications, royalty free, and without any requirement to disclose your source code nor any modifications to FastMM to any other party. A commercial licence lasts into perpetuity, and entitles you to all future updates, free of charge. A commercial licence is sold per developer developing applications that use FastMM, as follows: 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 |
Number Of DevelopersPrice (USD)
1 developer$99
2 developers$189
3 developers$269
4 developers$339
5 developers$399
More than 5 developers$399 + $50 per developer from the 6th onwards
Site licence (unlimited number of developers affiliated with the owner of the licence, i.e. employees, co-workers, interns and contractors)$999
35 | 36 | Please send an e-mail to fastmm@leriche.org to request an invoice before or after payment is made. Payment may be made via PayPal at https://www.paypal.me/fastmm (paypal@leriche.org), or via bank transfer. Bank details will be provided on the invoice. 37 | 38 | Support (via e-mail) is available for users with a commercial licence. Enhancement requests submitted by users with a commercial licence will be prioritized. 39 | 40 | ### Usage Instructions 41 | Add FastMM5.pas as the first unit in your project's DPR file. It will install itself automatically during startup, replacing the default memory manager. 42 | 43 | In order to share the memory manager between the main application and libraries call FastMM_AttemptToUseSharedMemoryManager (in order to use the memory manager of another module in the process) or FastMM_ShareMemoryManager (to share the memory manager instance of the current module with other modules). It is important to share the memory manager between modules where memory allocated in the one module may be freed by the other. 44 | 45 | If the application requires memory alignment greater than the default, call FastMM_EnterMinimumAddressAlignment and once the greater alignment is no longer required call FastMM_ExitMinimumAddressAlignment. Calls may be nested. The coarsest memory alignment requested takes precedence. 46 | 47 | At the cost of performance and increased memory usage FastMM can log additional metadata together with every block. In order to enable this mode call FastMM_EnterDebugMode and to exit debug mode call FastMM_ExitDebugMode. Calls may be nested in which case debug mode will be active as long as the number of FastMM_EnterDebugMode calls exceed the number of FastMM_ExitDebugMode calls. In debug mode freed memory blocks will be filled with the byte pattern $808080... so that usage of a freed memory block or object, as well as corruption of the block header and/or footer will likely be detected. If the debug support library, FastMM_FullDebugMode.dll, is available and the application has not specified its own handlers for FastMM_GetStackTrace and FastMM_ConvertStackTraceToText then the support library will be loaded during the first call to FastMM_EnterDebugMode. 48 | 49 | Events (memory leaks, errors, etc.) may be logged to file, displayed on-screen, passed to the debugger or any combination of the three. Specify how each event should be handled via the FastMM_LogToFileEvents, FastMM_MessageBoxEvents and FastMM_OutputDebugStringEvents variables. The default event log filename will be built from the application filepath, but may be overridden via FastMM_SetEventLogFilename. Messages are built from templates that may be changed/translated by the application. 50 | 51 | The optimization strategy of the memory manager may be tuned via FastMM_SetOptimizationStrategy. It can be set to favour performance, low memory usage, or a blend of both. The default strategy is to blend the performance and low memory usage goals. 52 | 53 | The default configuration should scale close to linearly up to between 8 and 16 threads, so for most applications there should be no need to tweak any performance settings. Beyond 16 threads you may consider increasing the number of arenas (CFastMM_...BlockArenaCount), but inspect the thread contention counts first (FastMM_...BlockThreadContentionCount), before assuming that it is necessary. 54 | 55 | 56 | ### The following conditional defines are supported 57 | * FastMM_FullDebugMode (or FullDebugMode) - If defined then FastMM_EnterDebugMode will be called on startup so that the memory manager starts up in debug mode. If FullDebugMode is defined then the FastMM_DebugLibraryStaticDependency define is also implied. 58 | * FastMM_FullDebugModeWhenDLLAvailable (or FullDebugModeWhenDLLAvailable) - If defined an attempt will be made to load the debug support library during startup. If successful then FastMM_EnterDebugMode will be called so that the memory manager starts up in debug mode. 59 | * FastMM_DebugLibraryStaticDependency - If defined there will be a static dependency on the debug support library, FastMM_FullDebugMode.dll (32-bit) or FastMM_FullDebugMode64.dll (64-bit). If FastMM_EnterDebugMode will be called in the startup code while and the memory manager will also be shared between an application and libraries, then it may be necessary to enable this define in order to avoid DLL unload order issues during application shutdown (typically manifesting as an access violation when attempting to report on memory leaks during shutdown). It is a longstanding issue with Windows that it is not always able to unload DLLs in the correct order on application shutdown when DLLs are loaded dynamically during startup. Note that while enabling this define will introduce a static dependency on the debug support library, it does not actually enter debug mode by default - FastMM_EnterDebugMode must still be called to enter debug mode, and FastMM_ExitDebugMode can be called to exit debug mode at any time. 60 | * FastMM_ClearLogFileOnStartup (or ClearLogFileOnStartup) - When defined FastMM_DeleteEventLogFile will be called during startup, deleting the event log file (if it exists). 61 | * FastMM_Align16Bytes (or Align16Bytes) - When defined FastMM_EnterMinimumAddressAlignment(maa16Bytes) will be called during startup, forcing a minimum of 16 byte alignment for memory blocks. Note that this has no effect under 64 bit, since 16 bytes is already the minimum alignment. 62 | * FastMM_5Arenas, FastMM_6Arenas .. FastMM_16Arenas - Increases the number of arenas from the default values. See the notes for the CFastMM_SmallBlockArenaCount constant for guidance on the appropriate number of arenas. 63 | * FastMM_DisableAutomaticInstall - Disables automatic installation of FastMM as the memory manager. If defined then FastMM_Initialize should be called from application code in order to install FastMM, and FastMM_Finalize to uninstall and perform the leak check (if enabled), etc. 64 | * FastMM_EnableMemoryLeakReporting (or EnableMemoryLeakReporting) - If defined then the memory leak summary and detail will be added to the set of events logged to file (FastMM_LogToFileEvents) and the leak summary will be added to the set of events displayed on-screen (FastMM_MessageBoxEvents). 65 | * FastMM_RequireDebuggerPresenceForLeakReporting (or RequireDebuggerPresenceForLeakReporting) - Used in conjunction with EnableMemoryLeakReporting - if the application is not running under the debugger then the EnableMemoryLeakReporting define is ignored. 66 | * FastMM_NoMessageBoxes (or NoMessageBoxes) - Clears the set of events that will cause a message box to be displayed (FastMM_MessageBoxEvents) on startup. 67 | * FastMM_ShareMM (or ShareMM) - If defined then FastMM_ShareMemoryManager will be called during startup, sharing the memory manager of the module if the memory manager of another module is not already being shared. 68 | * FastMM_ShareMMIfLibrary (or ShareMMIfLibrary) - If defined and the module is not a library then the ShareMM define is disabled. 69 | * FastMM_AttemptToUseSharedMM (or AttemptToUseSharedMM) - If defined FastMM_AttemptToUseSharedMemoryManager will be called during startup, switching to using the memory manager shared by another module (if there is a shared memory manager). 70 | * FastMM_NeverUninstall (or NeverUninstall) - Sets the FastMM_NeverUninstall global variable to True. Use this if any leaked pointers should remain valid after this unit is finalized. 71 | * PurePascal - The assembly language code paths are disabled, and only the Pascal code paths are used. This is normally used for debugging purposes only. 72 | 73 | ### Supported Compilers 74 | Delphi XE3 and later 75 | 76 | ### Supported Platforms 77 | Windows, 32-bit and 64-bit 78 | 79 | ### Change Log 80 | ##### Version 5.00 81 | * First non-beta release of FastMM 5. 82 | 83 | ##### Version 5.01 84 | * Enhancement: Log a stack trace for the virtual method call that lead to a "virtual method call on freed object" error 85 | 86 | ##### Version 5.02 87 | * Backward compatibility improvement: If ReportMemoryLeaksOnShutdown = True then mmetUnexpectedMemoryLeakSummary will automatically be included in FastMM_MessageBoxEvents, and the the leak summary will thus be displayed on shutdown. 88 | * FastMM in debug mode will now catch all TObject virtual method calls on a freed object. Previously it only caught some commonly used ones. 89 | * Increase the number of virtual methods supported by TFastMM_FreedObject to 75. (There are some classes in the RTL that have more than 30 virtual methods, e.g. TStringList). 90 | * Add a lock timeout for FastMM_LogStateToFile and FastMM_WalkBlocks. Some severe memory corruption crashes may leave an arena locked, in which case it was previously not possible to walk blocks or dump the memory manager state to file in the crash handler. 91 | * Add backward compatibility support for the ClearLogFileOnStartup v4 define. 92 | 93 | ##### Version 5.03 94 | * Add runtime support for configuring the number of entries in the debug block allocation and free stack traces (FastMM_SetDebugModeStackTraceEntryCount) 95 | * Enhancements to BorlndMM.dll: Support for a "DEBUG" build configuration as well as additional exports 96 | * Additional demo applications 97 | * Add a FastMM_NeverUninstall boolean variable. It will be set to True on startup if "NeverUninstall" is defined (for backward compatibility with FastMM4). This is useful in the rare situation where live pointers are expected to remain valid after the FastMM unit is finalized. 98 | * Change FastMM_ScanDebugBlocksForCorruption to a function that always returns a boolean result of True. This allows it to be used in a debug watch, thus scanning blocks every time the debugger stops on a breakpoint, etc. 99 | * Expose DebugLibrary_GetRawStackTrace and DebugLibrary_GetFrameBasedStackTrace in order to allow runtime switching between raw and frame based stack traces. 100 | * Add support for a new conditional define "FastMM_DisableAutomaticInstall". When defined FastMM will not be installed automatically, and instead the application should call FastMM_Initialize to initialize and install FastMM, and finally FastMM_Finalize to uninstall it. This allows the application runtime control over whether to use FastMM or not. Note that FastMM_Initialize has to be called very early in the unit initialization sequence, before any memory is allocated through the default memory manager. Practically this means it has to be called from either the first or second (after FastMM5.pas) unit in your project DPR. 101 | * Add a new boolean configuration variable: FastMM_DebugMode_ScanForCorruptionBeforeEveryOperation. When this variable is True and debug mode is enabled, all debug blocks will be checked for corruption on entry to any memory manager operation (i.e. GetMem, FreeMem, AllocMem and ReallocMem). It is analogous to the v4 FullDebugModeScanMemoryPoolBeforeEveryOperation option. Note that this comes with an extreme performance penalty. 102 | * Add the FastMM_5Arenas through FastMM_16Arenas defines in order to allow control of the number of arenas through conditional defines instead of requiring editing of the FastMM5.pas source file. As a rule of thumb, FastMM performs optimally if the number of arenas is between 0.5x to 1x the number of threads that are expected to call the memory manager simultaneously. 103 | * Expose the FastMM_DetectStringData and FastMM_DetectClassInstance functions, which are used to determine whether a pointer potentially points to string data or a class instance. These may be useful inside the FastMM_WalkBlocks callback in order to collect more detailed statistics about the memory pool content. 104 | * Add support for a "FastMM_DebugLibraryStaticDependency" define, which is automatically defined if the legacy "FullDebugMode" option is defined. When "FastMM_DebugLibraryStaticDependency" is defined the application will have a static dependency on the debug support library. This prevents the premature unloading of the debug support library (and crash on shutdown) when the memory manager is shared between the main application and a statically linked library. 105 | * Add FastMM_GetCurrentMemoryUsage, FastMM_SetMemoryUsageLimit and FastMM_GetMemoryUsageLimit calls. FastMM_GetCurrentMemoryUsage returns the number of bytes of address space that is currently either committed or reserved by FastMM. This includes the total used by the heap, as well as all internal management structures. FastMM_SetMemoryUsageLimit allows the application to specify a maximum amount of memory that may be allocated through FastMM. An attempt to allocate more than this amount will fail and lead to an "Out of Memory" exception. Note that after the first failure the maximum amount of memory that may be allocated is slightly increased in order to allow the application to allocate some additional memory in subsequent attempts. This is to allow for a graceful shutdown. Specify 0 for no limit. FastMM_GetMemoryUsageLimit returns the current limit in effect. 0 = no limit (the default). 106 | 107 | ##### Version 5.04 108 | * Implement a return address info cache for the LogStackTrace call in FastMM_FullDebugMode. This greatly speeds up logging of memory leak detail to file when there are many leaks with the same (or similar) stack traces. 109 | * Avoid opening and reopening the event log file multiple times when logging leak detail. This improves performance significantly when logging multiple memory leaks. 110 | * Ensure that the event log file is closed before showing any dialogs, so the user can access it while the dialog is displayed. 111 | * Implement several 32-bit SSE2 move routines (64-bit already used SSE2) 112 | * Make the static dependency on the FastMM_FullDebugMode library optional when FastMM_FullDebugMode is defined. When FastMM_DebugLibraryDynamicLoading (or LoadDebugDLLDynamically) is defined then the DLL will be loaded dynamically. 113 | 114 | ##### Version 5.05 115 | * Add the FastMM_AllocateTopDown (Boolean, default False) option. When True, allocates all memory from the top of the address space downward. This is useful to catch bad pointer typecasts in 64-bit code, where pointers would otherwise often fit in a 32-bit variable. Note that this comes with a performance impact in the other of O(n^2), where n is the number of chunks obtained from the OS. 116 | * Add support for Eurekalog 7 in FastMM_FullDebugMode. 117 | * Add FastMM_BeginEraseFreedBlockContent and FastMM_EndEraseFreedBlockContent calls. These calls enable/disable the erasure of the content of freed blocks. Calls may be nested, in which case erasure is only disabled when the number of FastMM_EndEraseFreedBlockContent calls equal the number of FastMM_BeginEraseFreedBlockContent calls. When enabled the content of all freed blocks is filled with the debug pattern $80808080 before being returned to the memory pool. This is useful for security purposes, and may also help catch "use after free" programming errors (like debug mode, but at reduced CPU cost). 118 | * Add support for the FastMM_IncludeLegacyOptionsFile define. If defined the legacy FastMM4Options.inc will be included (and the version 4 options will be translated to the equivalent v5 options). 119 | * Add the FastMM_NoDebugInfo option. If defined then debug info will not be emitted for FastMM5.pas, stopping the debugger from stepping into it. 120 | * Fix a race condition in FastMM_ScanDebugBlocksForCorruption that could erroneously report a debug block that is in the process of being freed by another thread as corrupted. 121 | 122 | ##### Version 5.06 123 | * Add lock timeout parameters to FastMM_ScanDebugBlocksForCorruption, FastMM_GetHeapStatus and FastMM_GetUsageSummary, with a default of 50ms. This prevents excessive wait times in these routines if another thread that holds a lock on a memory manager resource is currently suspended. 124 | * Make the LogStackTrace routine in FastMM_FullDebugMode thread safe. 125 | * Add FastMM_RequireIDEPresenceForLeakReporting like FastMM4 had to enable leak reporting in libraries. 126 | * Add an allocation group filter to FastMM_WalkBlocks and FastMM_LogStateToFile 127 | * Under 64-bit memory blocks are always at least 16 byte aligned, and under 32-bit they are always at least 8 byte aligned. Add a check in the debug FreeMem and ReallocMem routines to catch potentially bad pointers that break these rules. 128 | * Add a debug mode demo showing how to configure FastMM to detect and report memory corruption errors 129 | * Handle a potential race condition in FastMM_DetectClassInstance: If another thread frees a block while it is being evaluated as a potential class then an A/V could occur. This indirectly affects other functionality, like FastMM_LogStateToFile. 130 | * Fix several warnings with the options enabled to warn of potential data loss with implicit integer type conversions. These warnings were all false alarms, but now that the type conversions have been made explicit the warnings will no longer be emitted. 131 | * Add an option to sort the output of FastMM_LogStateToFile either in descending total memory usage (the default) or alphabetically. 132 | * Add the current timestamp to the FastMM_LogStateToFile output, and add an option not to truncate the file. 133 | * Change the parameters of FastMM_LogStateToFile from string to PWideChar to allow the calling code to avoid allocating strings (which may add clutter to the report). Reorder the parameters so that the order is more logical. 134 | * Add support to FastMM_LogStateToFile for logging a differential state between two allocation group ranges. 135 | * Include the relative allocation time when logging memory block details. 136 | * Report thread IDs in decimal (was previously hexadecimal). 137 | * Change allocation timestamps in crash logs to absolute times 138 | * Include milliseconds in block logging timestamps 139 | * Add FastMM_GetMemoryManagerState and FastMM_GetMemoryMap calls for backward compatibility with FastMM4 140 | * Port the usage tracker demo to FastMM5 141 | * Fix to large block thread contention handling: Previously large block thread contentions were not logged, and the thread would also not yield to other threads as intended. 142 | * Add support for changing the virtual method table offsets used to correctly identify objects in e.g. leak reports. This is useful when compiling a borlndmm.dll that will be used with an application that was compiled with a different version of Delphi where the VMT offsets differ. 143 | * Use the $90909090 debug fill pattern for allocated debug blocks in order to differentiate between errors involving uninitialized allocated memory and errors involving freed memory. Previously allocated debug blocks were initialized with the same $80808080 pattern as freed debug blocks. 144 | * Add FastMM_BeginEraseAllocatedBlockContent and FastMM_EndEraseAllocatedBlockContent. When enabled this will fill newly allocated blocks with the debug pattern, helping to catch bugs involving the use of uninitialized memory. This is a subset of the debug mode functionality, at a substantially reduced CPU cost. 145 | * Add a sanity check on the class name pointer in FastMM_DetectClassInstance as an additional safety net in order to prevent blocks from being misidentified as class instances in leak and state reports 146 | * Fix the failure to correctly report class names in leak reports, etc. when the class name pointer is not aligned to SizeOf(Pointer). 147 | * Add FastMM_DebugBreakAllocationNumber: Allows triggering of a break point in the debugger if the block with the specified allocation number is allocated. 148 | --------------------------------------------------------------------------------