RTL底层释放或回收对象

对象实例数据链表结构

PObjectInstance = ^TObjectInstance;
TObjectInstance = packed record
Code: Byte;
Offset: Integer;
case Integer of
0: (Next: PObjectInstance);
1: (FMethod: TMethod);
end;

对象实体块链表结构

`PInstanceBlock = ^TInstanceBlock;`
`TInstanceBlock = packed record`
`Next: PInstanceBlock;`
`Code: array[1..CodeBytes] of Byte;`
`WndProcPtr: Pointer;` // 窗口回调处理过程指针
`Instances: array[0..InstanceCount] of TObjectInstance;` //实体对象数组

end;

var
(* 运行程序所占内存块链表的首地址 *)
InstBlockList: PInstanceBlock;
(* InstFreeList指向空闲对象实例链表的首地址 *)
InstFreeList: PObjectInstance;

// 为对象分配内存空间，并指定回调方法(代码区)
function MakeObjectInstance(const AMethod: TWndMethod): Pointer;
const
BlockCode: array[1..CodeBytes] of Byte = (
{$IF Defined(CPUX86)}
$59, { POP ECX }
$E9); { JMP StdWndProc }
{$ELSEIF Defined(CPUX64)}
$41,$5b, { POP R11 }
$FF,$25,$00,$00,$00,$00); { JMP [RIP+0] }
{$ENDIF}
PageSize = 4096;
var
Block: PInstanceBlock;
Instance: PObjectInstance;
begin
if InstFreeList = nil then
begin
Block := VirtualAlloc(nil, PageSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE);
Block^.Next := InstBlockList;
Move(BlockCode, Block^.Code, SizeOf(BlockCode));
{$IF Defined(CPUX86)}
Block^.WndProcPtr := Pointer(CalcJmpOffset(@Block^.Code[2], @StdWndProc));
{$ELSEIF Defined(CPUX64)}
Block^.WndProcPtr := @StdWndProc;
{$ENDIF}
Instance := @Block^.Instances;
repeat
Instance^.Code := $E8; { CALL NEAR PTR Offset }
Instance^.Offset := CalcJmpOffset(Instance, @Block^.Code);
Instance^.Next := InstFreeList;
InstFreeList := Instance;
Inc(PByte(Instance), SizeOf(TObjectInstance));
until IntPtr(Instance) - IntPtr(Block) >= SizeOf(TInstanceBlock);
InstBlockList := Block;
end;
Result := InstFreeList;
Instance := InstFreeList;
InstFreeList := Instance^.Next;
Instance^.FMethod := TMethod(AMethod);
end;

//回收空闲的对象
procedure FreeObjectInstance(ObjectInstance: Pointer);
begin
if ObjectInstance <> nil then
begin
// 将需要释放的对象ObjectInstance掺入链表首部
PObjectInstance(ObjectInstance)^.Next := InstFreeList;
InstFreeList := ObjectInstance;
end;
`end;