ついに自動で初期化/終了メソッドが呼べるようになった

さて、言ってることとやっていることが違うのは、YTという人格の中心を形成するとても大事な要素につき、聞く耳は持ちませんのであしからず。
実は大きく進展がありまして、「らぃなたんかわいいよらぃなたん」さんが、_InitializeRecordを乗っ取ってゼロ初期化する方法を編み出されました。
お見事です。
ランタイム乗っ取りを忘れるとは、不覚なり。
ここまでできているのであれば、もうあと一歩ですね。

あと_FinalizeRecordみたいなものも存在しているので、こちらを乗っ取るとまた違った遊びができそうですが、誰かやらないかな。

やれ、と書かれている(超曲解)ので、最後の一歩を勝手に踏ませていただきます。
まず自動で呼ばれるメソッドは仮想関数にします。要は関数ポインタをどっかに登録しておけさえすればいいのですが、VMTの中が一番安心確実です。オーバーライドにはIDEの支援機能も使えますし使えなかった。特定のobject型から派生させる形を取ります。

type
  TControlled = object
  protected
    procedure Initialize; virtual;
    procedure Finalize; virtual;
    procedure Adjust; virtual;
  public
    constructor Register(TypeInfo: Pointer);
  end;

名前は勿論Ada.Finalization.Controlledから。初期化時にInitialize、代入時にAdjust、破棄時にFinalizeが呼ばれるつもりです。
で、こんなふうに使います。

program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  ObjRAII in '..\..\ObjRAII.pas';

type
  PData = ^TData;
  TData = record
    RefCount: Integer;
    Text: string;
  end;

  T = object(TControlled)
  private
    {$HINTS OFF} FDummy: TControlledTable; {$HINTS ON} //先頭に置く
    FData: PData;
  protected
    procedure Initialize; virtual;
    procedure Adjust; virtual;
    procedure Finalize; virtual;
  public
    procedure Dump;
  end;

procedure T.Adjust;
begin
  Inc(FData^.RefCount);
  WriteLn(Cardinal(@Self), '.Adjust')
end;

procedure T.Dump;
begin
  WriteLn('{', FData^.RefCount, ',', FData^.Text, '}')
end;

procedure T.Finalize;
begin
  Dec(FData^.RefCount);
  if FData^.RefCount = 0 then
  begin
    Dispose(FData);
    WriteLn('<free>');
  end;
  WriteLn(Cardinal(@Self), '.Finalize')
end;

procedure T.Initialize;
begin
  New(FData);
  FData^.RefCount := 1;
  Str(Random(1000)+ 1000, FData.Text);
  WriteLn(Cardinal(@Self), '.Initialize')
end;

procedure Test;
var
  A, B: T;
begin
  A.Dump;
  B.Dump;
  A := B;
  A.Dump;
  B.Dump;
end;

begin
  ReportMemoryLeaksOnShutdown := True;
  try
    Randomize;
    T(nil^).Register(TypeInfo(T)); {登録}
    Test;
    WriteLn('OK');
  except
    on E: Exception do Writeln(E.ClassName, ':', E.Message);
  end;
  {$WARN SYMBOL_PLATFORM OFF}
  if DebugHook <> 0 then ReadLn
  {$WARN SYMBOL_PLATFORM ON}
end.

実行結果。

1244804.Initialize
1244792.Initialize
{1,1202}
{1,1102}

1244804.Finalize
1244804.Adjust
{2,1102}
{2,1102}
1244792.Finalize

1244804.Finalize
OK

できたできた。
禁則事項はたぶんいっぱいあって、恐らくここから更に継承してもダメですし、New(P, Init);やDispose(P, Done);なんかもどうなるか。他のレコードやクラスのフィールドや配列の要素になった時の動作も試して無いです。とりあえずInitInstanceの動作からしてクラスのフィールドにした場合は動かないと思われます。
で、ObjRAIIユニットのソースですが……ほとんどSystemユニットの複製だからなあ……。
いつもなら気にしないのですが、たまたま↓こんなのを見つけてしまったとこなのです。
http://www.stevetrefethen.com/blog/CopyrightAndTheFreePascalProject.aspx
様子見で検閲状態で出してみる。どうぞ{ ... same as System.pas ... }のところをSystem.pasからコピーして埋めてお試しください。

unit ObjRAII;

{*******************************************************}
{                                                       }
{       Delphi Run-time Library                         }
{       Auto initialization/finalization                }
{                                                       }
{       2008 YT                                         }
{       Original idea: http://twc.xrea.jp/?20080125     }
{                                                       }
{*******************************************************}

interface

type
  TControlledTable = type string;

  PControlledTypeInfo = ^TControlledTypeInfo;
  TControlledTypeInfo = packed record
    Kind: Byte;
    Name: string[10]; { 2 + 4 + 4 }
    VMT: Pointer;
    SelfInfo: Pointer;
  end;

  PControlled = ^TControlled;
  TControlled = object
  protected
    procedure Initialize; virtual;
    procedure Finalize; virtual;
    procedure Adjust; virtual;
  public
    constructor Register(TypeInfo: Pointer);
  end;

implementation

uses
  SysHacks, Windows;

const
  tkControlled = 26; { Ord(High(TTypeKind)) + 9; }

{ Runtime patch }

procedure ReplaceProc(OldProc, NewProc: Pointer);
var
  OldProtect, Dummy: Cardinal;
begin
  VirtualProtect(OldProc, 5, PAGE_READWRITE, @OldProtect);
  PByte(OldProc)^ := $e9; {jmp}
  PInteger(Integer(OldProc) + 1)^ := Integer(NewProc) - Integer(OldProc) - 5;
  VirtualProtect(OldProc, 5, OldProtect, @Dummy);
end;

procedure ReplacePointer(var Old; const New: Pointer);
var
  OldProtect, Dummy: Cardinal;
begin
  VirtualProtect(@Old, SizeOf(Pointer), PAGE_READWRITE, @OldProtect);
  Pointer(Old) := New;
  VirtualProtect(@Old, SizeOf(Pointer), OldProtect, @Dummy);
end;

{ System unit replacing }

procedure _InitializeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
var
  Self: PControlled;
begin
  { ... same as System.pas ... }
    tkControlled:
      begin
        Self := PControlled(Integer(P) - SizeOf(Pointer));
        PPointer(Self)^ := PControlledTypeInfo(typeInfo).VMT;
        Self^.Initialize;
      end;  
  { ... same as System.pas ... }
end;

procedure _FinalizeArray(p: Pointer; typeInfo: Pointer; elemCount: Cardinal);
var
  Self: PControlled;
begin
  { ... same as System.pas ... }
    tkControlled:
      begin
        Self := PControlled(Integer(P) - SizeOf(Pointer));
        Self^.Finalize;
      end;
  { ... same as System.pas ... }
end;

procedure _CopyRecord{ dest, source, typeInfo: Pointer };
asm
  { ... same as System.pas ... }
  push 0
  { ... same as System.pas ... }
  cmp cl, tkControlled
  je @@Controlled
  { ... same as System.pas ... }
@@Controlled:
  mov edx, [ebx]
  mov [esp + 4], 1
  mov edx, [edx + vmtoffset TControlled.Finalize]
  mov eax, ebx
  call edx
  mov eax, 4
  jmp @@common
  { ... same as System.pas ... }
  cmp [esp + 4], 0
  jz @@exit
  mov edx, [ebx]
  mov edx, [edx + vmtoffset TControlled.Adjust]
  mov eax, ebx
  call edx
@@exit:
  pop eax
  { ... same as System.pas ... }
end;

{ TControlled }

procedure TControlled.Adjust;
begin
end;

procedure TControlled.Finalize;
begin
end;

procedure TControlled.Initialize;
begin
end;

constructor TControlled.Register(TypeInfo: Pointer);
var
  VMT: Pointer;
  FT: PFieldTable;
  CT_TypeInfo: SysHacks.PTypeInfo;
  NewTypeInfo: PControlledTypeInfo;
begin
  { eax <- Self(nil) }
  { edx <- VMT }
  { ecx <- TypeInfo }
  VMT := PPointer(@Self)^;

  //WriteLn(Cardinal(VMT));

  Dispose(@Self);

  Assert(PTypeInfo(TypeInfo).Kind = tkRecord);

  //WriteLn(Cardinal(TypeInfo));

  FT := PFieldTable(Integer(TypeInfo) + Byte(PTypeInfo(TypeInfo).Name[0]));

  Assert(FT.Count > 0);

  CT_TypeInfo := System.TypeInfo(TControlledTable);

  //WriteLn(CT_TypeInfo.Name);
  //WriteLn(FT.Fields[0].TypeInfo^.Name);

  Assert(FT.Fields[0].TypeInfo^ = CT_TypeInfo);
  Assert(FT.Fields[0].Offset = SizeOf(Pointer));

  New(NewTypeInfo);
  RegisterExpectedMemoryLeak(NewTypeInfo);

  NewTypeInfo^.Kind := tkControlled;
  NewTypeInfo^.Name := 'Controlled'; { 2 + 4 + 4 }
  NewTypeInfo^.VMT := VMT;
  NewTypeInfo^.SelfInfo := NewTypeInfo;

  ReplacePointer(FT.Fields[0].TypeInfo, @NewTypeInfo^.SelfInfo);
end;

initialization

  asm
    mov eax, offset System.@InitializeArray
    mov edx, offset ObjRAII._InitializeArray
    call ReplaceProc
    mov eax, offset System.@FinalizeArray
    mov edx, offset ObjRAII._FinalizeArray
    call ReplaceProc
    mov eax, offset System.@CopyRecord
    mov edx, offset ObjRAII._CopyRecord
    call ReplaceProc
  end

end.