fastmm4.pas

超级Delphi函数包,包括编程时常需要的一些函数

{$endif}
{$ifdef ver180}
  {$define BDS2006}
{$endif}

{$ifndef Delphi4or5}
  {$ifndef BCB}
    {$define Delphi6AndUp}
  {$endif}
  {$ifndef Delphi6}
    {$define BCB6OrDelphi7AndUp}
    {$ifndef BCB}
      {$define Delphi7AndUp}
    {$endif}
    {$ifndef BCB}
      {$ifndef Delphi7}
        {$ifndef Delphi2005}
          {$define BDS2006AndUp}
        {$endif}
      {$endif}
    {$endif}
  {$endif}
{$endif}

{$ifdef Delphi6AndUp}
  {$WARN SYMBOL_PLATFORM OFF}
  {$WARN SYMBOL_DEPRECATED OFF}
{$endif}

{Leak detail logging requires error logging}
{$ifndef LogErrorsToFile}
  {$undef LogMemoryLeakDetailToFile}
  {$undef ClearLogFileOnStartup}
{$endif}

{Manual leak reporting control requires leak reporting to be enabled}
{$ifndef EnableMemoryLeakReporting}
  {$undef ManualLeakReportingControl}
{$endif}

{$ifndef EnableMMX}
  {$undef ForceMMX}
{$endif}

{-------------------------Public constants-----------------------------}
const
  {The number of small block types}
{$ifdef Align16Bytes}
  NumSmallBlockTypes = 46;
{$else}
  NumSmallBlockTypes = 55;
{$endif}

{----------------------------Public types------------------------------}
type
  TSmallBlockTypeState = packed record
    {The internal size of the block type}
    InternalBlockSize: Cardinal;
    {Useable block size: The number of non-reserved bytes inside the block.}
    UseableBlockSize: Cardinal;
    {The number of allocated blocks}
    AllocatedBlockCount: Cardinal;
    {The total address space reserved for this block type (both allocated and
     free blocks)}
    ReservedAddressSpace: Cardinal;
  end;
  TSmallBlockTypeStates = array[0..NumSmallBlockTypes - 1] of TSmallBlockTypeState;

  TMemoryManagerState = packed record
    {Small block type states}
    SmallBlockTypeStates: TSmallBlockTypeStates;
    {Medium block stats}
    AllocatedMediumBlockCount: Cardinal;
    TotalAllocatedMediumBlockSize: Cardinal;
    ReservedMediumBlockAddressSpace: Cardinal;
    {Large block stats}
    AllocatedLargeBlockCount: Cardinal;
    TotalAllocatedLargeBlockSize: Cardinal;
    ReservedLargeBlockAddressSpace: Cardinal;
  end;

  {Memory map}
  TChunkStatus = (csUnallocated, csAllocated, csReserved,
    csSysAllocated, csSysReserved);
  TMemoryMap = array[0..65535] of TChunkStatus;

{$ifdef EnableMemoryLeakReporting}
  {List of registered leak}
  TRegisteredMemoryLeak = packed record
    LeakAddress: Pointer;
    LeakedClass: TClass;
    LeakSize: Integer;
    LeakCount: Integer;
  end;
  TRegisteredMemoryLeaks = array of TRegisteredMemoryLeak;
{$endif}

{--------------------------Public variables----------------------------}
{$ifdef ManualLeakReportingControl}
  {Variable is declared in system.pas in newer Delphi versions.}
  {$ifndef BDS2006AndUp}
var
  ReportMemoryLeaksOnShutdown: Boolean;
  {$endif}
{$endif}

{-------------------------Public procedures----------------------------}
{Installation procedures must be exposed for the BCB helper unit FastMM4BCB.cpp}
{$ifdef BCB}
procedure InitializeMemoryManager;
function CheckCanInstallMemoryManager: boolean;
procedure InstallMemoryManager;
{$endif}

{$ifndef FullDebugMode}
{The standard memory manager functions}
function FastGetMem(ASize: Integer): Pointer;
function FastFreeMem(APointer: Pointer): Integer;
function FastReallocMem(APointer: Pointer; ANewSize: Integer): Pointer;
function FastAllocMem(ASize: Cardinal): Pointer;
{$else}
{The FullDebugMode memory manager functions}
function DebugGetMem(ASize: Integer): Pointer;
function DebugFreeMem(APointer: Pointer): Integer;
function DebugReallocMem(APointer: Pointer; ANewSize: Integer): Pointer;
function DebugAllocMem(ASize: Cardinal): Pointer;
{$endif}

{Releases all allocated memory (use with extreme care)}
procedure FreeAllMemory;

{Returns summarised information about the state of the memory manager. (For
 backward compatibility.)}
function FastGetHeapStatus: THeapStatus;
{Returns statistics about the current state of the memory manager}
procedure GetMemoryManagerState(var AMemoryManagerState: TMemoryManagerState);
{$ifndef LINUX}
{Gets the state of every 64K block in the 4GB address space}
procedure GetMemoryMap(var AMemoryMap: TMemoryMap);
{$endif}

{$ifdef EnableMemoryLeakReporting}
{Registers expected memory leaks. Returns true on success. The list of leaked
 blocks is limited, so failure is possible if the list is full.}
function RegisterExpectedMemoryLeak(ALeakedPointer: Pointer): boolean; overload;
function RegisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): boolean; overload;
function RegisterExpectedMemoryLeak(ALeakedBlockSize: Integer; ACount: Integer = 1): boolean; overload;
{Removes expected memory leaks. Returns true on success.}
function UnregisterExpectedMemoryLeak(ALeakedPointer: Pointer): boolean; overload;
function UnregisterExpectedMemoryLeak(ALeakedObjectClass: TClass; ACount: Integer = 1): boolean; overload;
function UnregisterExpectedMemoryLeak(ALeakedBlockSize: Integer; ACount: Integer = 1): boolean; overload;
{Returns a list of all expected memory leaks}
function GetRegisteredMemoryLeaks: TRegisteredMemoryLeaks;
{$endif}

implementation

uses
{$ifndef Linux}
  Windows,
{$else}
  Libc,
{$endif}
  FastMM4Messages;

{Fixed size move procedures}
procedure Move12(const ASource; var ADest; ACount: Integer); forward;
procedure Move20(const ASource; var ADest; ACount: Integer); forward;
procedure Move28(const ASource; var ADest; ACount: Integer); forward;
procedure Move36(const ASource; var ADest; ACount: Integer); forward;
procedure Move44(const ASource; var ADest; ACount: Integer); forward;
procedure Move52(const ASource; var ADest; ACount: Integer); forward;
procedure Move60(const ASource; var ADest; ACount: Integer); forward;
procedure Move68(const ASource; var ADest; ACount: Integer); forward;

{$ifdef DetectMMOperationsAfterUninstall}
{Invalid handlers to catch MM operations after uninstall}
function InvalidFreeMem(APointer: Pointer): Integer; forward;
function InvalidGetMem(ASize: Integer): Pointer; forward;
function InvalidReallocMem(APointer: Pointer; ANewSize: Integer): Pointer; forward;
function InvalidAllocMem(ASize: Cardinal): Pointer; forward;
function InvalidRegisterAndUnRegisterMemoryLeak(APointer: Pointer): Boolean; forward;
{$endif}

{-------------------------Private constants----------------------------}
const
  {The size of a medium block pool. This is allocated through
   VirtualAlloc and is used to serve medium blocks. In Full Debug mode we leave
   a trailing 256 bytes to be able to safely do a memory dump.}
  MediumBlockPoolSize = 20 * 64 * 1024{$ifdef FullDebugMode} - 256{$endif};
  {The granularity of small blocks}
{$ifdef Align16Bytes}
  SmallBlockGranularity = 16;
{$else}
  SmallBlockGranularity = 8;
{$endif}
  {The granularity of medium blocks. Newly allocated medium blocks are
   a multiple of this size plus MediumBlockSizeOffset, to avoid cache line
   conflicts}
  MediumBlockGranularity = 256;
  MediumBlockSizeOffset = 48;
  {The granularity of large blocks}
  LargeBlockGranularity = 65536;
  {The maximum size of a small block. Blocks Larger than this are either
   medium or large blocks.}
  MaximumSmallBlockSize = 2608;
  {The smallest medium block size. (Medium blocks are rounded up to the nearest
   multiple of MediumBlockGranularity plus MediumBlockSizeOffset)}
  MinimumMediumBlockSize = 11 * 256 + MediumBlockSizeOffset;
  {The number of bins reserved for medium blocks}
  MediumBlockBinsPerGroup = 32;
  MediumBlockBinGroupCount = 32;
  MediumBlockBinCount = MediumBlockBinGroupCount * MediumBlockBinsPerGroup;
  {The maximum size allocatable through medium blocks. Blocks larger than this
   fall through to VirtualAlloc ( = large blocks).}
  MaximumMediumBlockSize = MinimumMediumBlockSize + (MediumBlockBinCount - 1) * MediumBlockGranularity;
  {The target number of small blocks per pool. The actual number of blocks per
   pool may be much greater for very small sizes and less for larger sizes. The
   cost of allocating the small block pool is amortized across all the small
   blocks in the pool, however the blocks may not all end up being used so they
   may be lying idle.}
  TargetSmallBlocksPerPool = 48;
  {The minimum number of small blocks per pool. Any available medium block must
   have space for roughly this many small blocks (or more) to be useable as a
   small block pool.}
  MinimumSmallBlocksPerPool = 12;
  {The lower and upper limits for the optimal small block pool size}
  OptimalSmallBlockPoolSizeLowerLimit = 29 * 1024 - MediumBlockGranularity + MediumBlockSizeOffset;
  OptimalSmallBlockPoolSizeUpperLimit = 64 * 1024 - MediumBlockGranularity + MediumBlockSizeOffset;
  {The maximum small block pool size. If a free block is this size or larger
   then it will be split.}
  MaximumSmallBlockPoolSize = OptimalSmallBlockPoolSizeUpperLimit + MinimumMediumBlockSize;
  {-------------Block type flags--------------}
  {The lower 3 bits in the dword header of small blocks (4 bits in medium and
   large blocks) are used as flags to indicate the state of the block}
  {Set if the block is not in use}
  IsFreeBlockFlag = 1;
  {Set if this is a medium block}
  IsMediumBlockFlag = 2;
  {Set if it is a medium block being used as a small block pool. Only valid if
   IsMediumBlockFlag is set.}
  IsSmallBlockPoolInUseFlag = 4;
  {Set if it is a large block. Only valid if IsMediumBlockFlag is not set.}
  IsLargeBlockFlag = 4;
  {Is the medium block preceding this block available? (Only used by medium
   blocks)}
  PreviousMediumBlockIsFreeFlag = 8;
  {Is this large block segmented? I.e. is it actually built up from more than
   one chunk allocated through VirtualAlloc? (Only used by large blocks.)}
  LargeBlockIsSegmented = 8;
  {The flags masks for small blocks}
  DropSmallFlagsMask = -8;
  ExtractSmallFlagsMask = 7;
  {The flags masks for medium and large blocks}
  DropMediumAndLargeFlagsMask = -16;
  ExtractMediumAndLargeFlagsMask = 15;
  {-------------Block resizing constants---------------}
  SmallBlockDownsizeCheckAdder = 64;
  SmallBlockUpsizeAdder = 32;
  {This constant is used when determining whether medium blocks should be moved
   or downsized in place during a ReallocMem call. The value is chosen to
   prevent unnecessary block move operations when downsizing a medium block into
   the small block size range.}
  MediumDownsizeAdder = 114;
  {-------------Memory leak reporting constants---------------}
  ExpectedMemoryLeaksListSize = 64 * 1024;
  {-------------FullDebugMode constants---------------}
{$ifdef FullDebugMode}
  {The stack trace depth}
  StackTraceDepth = 9;
  {The number of fake VMT entries - used to track virtual method calls on
   freed objects. Do not change this value without also updating TFreedObject.GetVirtualMethodIndex}
  MaxFakeVMTEntries = 200;
  {The pattern used to fill unused memory}
  DebugFillByte = $80;
  DebugFillDWord = $01010101 * Cardinal(DebugFillByte);
  {The address that is reserved so that accesses to the address of the fill
   pattern will result in an A/V}
  DebugReservedAddress = $01010000 * Cardinal(DebugFillByte);
{$endif}
  {-------------Other constants---------------}
  {Sleep time when a resource (small/medium/large block manager) is in use}
  InitialSleepTime = 0;
  {Used when the resource is still in use after the first sleep}
  AdditionalSleepTime = 10;
  {Hexadecimal characters}
  HexTable: array[0..15] of char = '0123456789ABCDEF';
  {Copyright message - not used anywhere in the code}
  Copyright: string = 'FastMM4