type
RObjclass_pvmt = record // Must be multiple of 8 bytes, see below.
_object: TObject; // The vmt of the allocated TObject descendent
{$IFDEF CPU32}
locked_incr: longint; // Global increment of GetMem
{$ENDIF}
{$IFDEF CPU64}
locked_incr: int64; // Global increment of GetMem
{$ENDIF}
end;
PObjclass_pvmt = ^RObjclass_pvmt;
pheap_mem_info = ^theap_mem_info;
pheap_extra_info = ^theap_extra_info;
theap_extra_info = record
exact_info_size: dword; // exact_info_size as calculated in
fillproc: tfillextrainfoProc;
displayproc: tdisplayextrainfoProc;
sig: TSig; // used to check if pheap_extra_info^ is still valid
{$IFDEF CPU64}
sig_al64: dword; // pad to align data on 16 bytes
{$ENDIF}
Data: packed Record end; // variable sized array of byte
end;
ppheap_mem_info = ^pheap_mem_info;
{ warning the size of theap_mem_info
must be a multiple of uintptr so processor that require
register load alignment on 4/8 bytes wont cause errors. }
{ theap_mem_info }
theap_mem_info = packed record
public
previous,
Next: pheap_mem_info;
todolist: ppheap_mem_info;
todonext: pheap_mem_info;
size: ptruint;
{$IFDEF TrackObjectClasses}
objclass_pvmt: RObjclass_pvmt;
{$ENDIF}
sig: TSig; // crc calculated signature
{$ifndef EXTRA and defined(CPU64)}
sig_al64: dword; // pad to reach 64
{$ENDIF}
calls: array [1..tracesize] of codepointer;
extra_info_size: dword; // SizeOf(theap_extra_info) +
// SizeOftheap_extra_info desired .Data.size
// 0 if no extra_info
VarRec : packed record
case Boolean of
False :
(mem_info : pheap_mem_info; // Back pointer to theap_mem_info record
data : record end);
True :
(extra_info : theap_extra_info);
end;
{ Copies pre-allocated record to self }
procedure Initialize;
{ Return the memory size requested to hold both theap_mem_info and Data
if Self <> nil returns the size that was previously allocated }
function NewAllocSize(aSize: ptruint): ptruint;
function calculate_sig : TSig;
{ Retrieve pointer to the mem_info that sits in front of data }
function GetBackPointerP : pheap_mem_info; { inline; }
function HasExtraInfo : boolean;
{ Retrieves place to plug deadbeef }
function TailPointer: PLongWord;
{ Recalculate / adjust the VarRec.mem_info during GetMem and ReallocMem }
procedure UpdateBackPointer; inline;
end;