#1345. Ни о чём. Размышления пока

Есть определённые мысли.
Пока изучаю:

TPrivateHeap
CodeHeap

function CodeHeap: TPrivateHeap;
var
  Temp: TPrivateHeap;
begin
  if FCodeHeap = nil then
  begin
    Temp := TPrivateHeap.Create;
    if AtomicCmpExchange(Pointer(FCodeHeap), Pointer(Temp), nil) = nil then
    // - интересный метод создания потокозащищённого синглетона. Если я правильно понял
      Pointer(Temp) := nil // For ARC-based platforms this will ensure the local var doesn't affect the refcount
      // - интересный "хак"
    else
      Temp.Free;
  end;
  Result := FCodeHeap;
end;

TMethodImplementation
TRttiMethod

Жаль не работает вот это:

type
 Tl3ObjectSpy<T: TObject> = class(T)

 end;//Tl3ObjectSpy

Интересно - почему написано так:

  ObjectAppearance := TCommonObjectAppearance(AppearanceClass.NewInstance);
  ObjectAppearance.Create;

А не так:

type
 RCommonObjectAppearance = clas of TCommonObjectAppearance;
  ObjectAppearance := RCommonObjectAppearance(AppearanceClass).Create;

{$IFDEF FireDAC_DEBUG}
class function TFDDatSRow.NewInstance: TObject {$IFDEF AUTOREFCOUNT} unsafe {$ENDIF};
begin
  Result := inherited NewInstance;
  Inc(GRowsAlive);
end;

{-------------------------------------------------------------------------------}
procedure TFDDatSRow.FreeInstance;
begin
  inherited FreeInstance;
  Dec(GRowsAlive);
end;
{$ENDIF}

vmtNewInstance

unit l3ObjectsSpy;

interface

procedure Test;

implementation

uses
 System.Classes
 ;

type
 PMem = PAnsiChar;

function NewInstancePtr(aClass: TClass): PPointer;
begin
 Result := PPointer(PMem(aClass) + vmtNewInstance);

end;
function FreeInstancePtr(aClass: TClass): PPointer;
begin
 Result := PPointer(PMem(aClass) + vmtFreeInstance);
end;

procedure TestClass(aClass: TClass);
begin
 WriteLn(NativeInt(NewInstancePtr(aClass)^));
 WriteLn(NativeInt(FreeInstancePtr(aClass)^));
end;

procedure Test;
begin
 TestClass(TObject);
 TestClass(TStream);
 WriteLn(vmtNewInstance);
end;

end.