Why does this optimization of a smartpointer not work?

Question

I've been playing around with the smartpointer example by Sergey Antonov, see: http://blog.barrkel.com/2008/11/reference-counted-pointers-revisited.html (somewhere in the comments).

SSCCE:

program TestSmartPointer;
{$APPTYPE CONSOLE}    
uses
  System.SysUtils;

type
TInjectType<T> = record
public
  VMT: pointer;
  unknown: IInterface;
  RefCount: integer;
  AValue: T;
end;

TInject<T> = class
public type
  TInjectType = TInjectType<T>;
  PInjectType = ^TInjectType;
end;

PInjectObjectType = TInject<TObject>.PInjectType;


TSmartPointer<T: class> = class
  class function Wrap(const AValue: T): TFunc<T>; static;
end;

function Trick_Release(const obj:  PInjectObjectType): Integer; stdcall; forward;
function Trick_AddRef(const obj: PInjectObjectType): Integer; stdcall; forward;
function Invoke(var obj): TObject; forward;

const
  PSEUDO_VMT: array [0 .. 3] of pointer = (nil, @Trick_AddRef, @Trick_Release, @Invoke);

function Trick_AddRef(const obj: PInjectObjectType): Integer; stdcall;
begin
  Result:= AtomicIncrement(Obj^.RefCount);
end;

function Trick_Release(const obj:  PInjectObjectType): Integer; stdcall;
begin
  Result:= AtomicDecrement(Obj^.RefCount);
  if Result = 0 then obj^.AValue.Free;
end;

function Invoke(const obj:  PInjectObjectType): TObject;
begin
  Result:= obj^.AValue;
end;

class function TSmartPointer<T>.Wrap(const AValue: T): TFunc<T>;
var
  h: TInjectType<T>;
begin
  h.RefCount:= 1;
  pointer(h.unknown):= @h;
  h.VMT:= @PSEUDO_VMT;
  h.AValue:= AValue;
  //Alternative A, this fails
  Result:= TFunc<T>(@h);   
  Inc(h.RefCount);          
  ////Alternative B, this works
  //Result:= function: T      
  //  begin
  //    Result:= h.AValue;
  //  end;
end;

type
  TTestObject = class(TObject)
    procedure Test;
    destructor Destroy; override;
  end;


{ TTestObject }

procedure TTestObject.Test;
begin
  WriteLn('Test');
end;

destructor TTestObject.Destroy;
begin
  WriteLn('Free');
  inherited;
end;

procedure Test;
var
  TestObject: TFunc<TTestObject>;
begin
  TestObject:= TSmartPointer<TTestObject>.Wrap(TTestObject.Create);
  TestObject.Test;
  ReadLn;   //Works up to this point.
  <<<--- generates a AV here.
end;

begin
  WriteLn('Start');
  Test;
  WriteLn('End');
  ReadLn;
end.

Barry Kelly explains that:

TFunc = reference to function: T;

is directly equivalent to:

TFunc = interface function Invoke: T; end;

except that locations of a method reference type are assignable using values of a function, method or anonymous method.

Anonymous methods are implemented as interfaces that look just like the method reference, on a hidden class. Location capture is implemented as moving (for locals) and copying (for parameters) to fields on the hidden class. Any accesses of captured locations in the body of the main procedure are converted to access the fields on the hidden class; a local variable, called $frame, points to an instance of this hidden class.

Goal
I want to optimize the creation of the smartpointer.
In order to do this I handcraft the VMT and use that to emulate the interface.

If I define my wrap function like so:

class function TSmartPointer<T>.Wrap(const AValue: T): TFunc<T>;
var
  h: TInjectType<T>;
begin
  pointer(h.unknown):= @h;
  h.VMT:= @PSEUDO_VMT;
  h.AValue:= AValue;
  Result:= function: T      
    begin
      Result:= h.AValue;
    end;
end;

Everything works.

If I optimize it to:

class function TSmartPointer<T>.Wrap(const AValue: T): TFunc<T>;
var
  h: TInjectType<T>;
begin
  h.RefCount:= 1;
  pointer(h.unknown):= @h;
  h.VMT:= @PSEUDO_VMT;
  h.AValue:= AValue;
  //Alternative A, this fails
  Result:= TFunc<T>(@h);   
  Inc(h.RefCount);          
end;

It almost works, but gives an AV as soon as the calling function closes.

procedure Test;
var
  TestObject: TFunc<TTestObject>;
begin
  TestObject:= TSmartPointer<TTestObject>.Wrap(TTestObject.Create);
  TestObject.Test;
  ReadLn;   
  //Works up to this point.
  <<<--- generates a AV here.
end; 

You'd expect the AV to occur in _Release, but that's not the case, in fact to happens before that.

    TestNewStringHelper.dpr.98: TestObject.Test;
00419F0B 8B45FC           mov eax,[ebp-$04]        

Here EAX = 0018FF40

00419F0E 8B10             mov edx,[eax]
00419F10 FF520C           call dword ptr [edx+$0c]
00419F13 E82CFFFFFF       call TTestObject.Test
TestNewStringHelper.dpr.100: end;
00419F18 33C0             xor eax,eax
00419F1A 5A               pop edx
00419F1B 59               pop ecx
00419F1C 59               pop ecx
00419F1D 648910           mov fs:[eax],edx
00419F20 68359F4100       push $00419f35
00419F25 8D45FC           lea eax,[ebp-$04]

Here EAX = 0018FF6C Obviously it should be the same as before. That fact that it is not is the cause of the AV that is to follow:

00419F28 E87BF6FEFF       call @IntfClear    <<-- AV

The call to IntfClear AV's, because it cannot find a suitable target for _Release. IOW the call never reaches _Release, but jumps into the unknown.

System.pas.36036: MOV     EDX,[EAX]
004095A8 8B10             mov edx,[eax]
System.pas.36037: TEST    EDX,EDX
004095AA 85D2             test edx,edx
System.pas.36038: JE      @@1
004095AC 740E             jz $004095bc
System.pas.36039: MOV     DWORD PTR [EAX],0
004095AE C70000000000     mov [eax],$00000000
System.pas.36043: PUSH    EAX
004095B4 50               push eax
System.pas.36044: PUSH    EDX
004095B5 52               push edx
System.pas.36045: MOV     EAX,[EDX]
004095B6 8B02             mov eax,[edx]
System.pas.36046: CALL    DWORD PTR [EAX] + VMTOFFSET IInterface._Release
004095B8 FF5008           call dword ptr [eax+$08]  <<-- AV here

Why does it do this and what do I need to tweak to get the optimized version to work?

Answer 1

The code that works captures the local variable h. That means that its lifetime is extended. The compiler does that by allocating the variable h on the heap.

Your code doesn't have any variable capture. Which means that h is allocated on the stack and its lifetime ends when the function returns. Your subsequent references to h are thus invalid.

Answer 2

Expanding on @David's answer:

Problem
I forgot/got blindsided by the fact that TFunc... is really a pointer.
So the assignment Result:= TFunc<T>(@h); returns a pointer to an out of scope local variable.
(The @ sign is a dead giveaway that we're dealing with pointers (missed that too)).

Now that we return an out-of-scope pointer, AV's are sure to follow sooner or later.
In this case at was later, causing the Test function to succeed, but the (hidden) call to _Release to fail.

Solution
The answer is to move stuff to the heap and adjust the _Release to do the cleanup.

class function TSmartPointer<T>.Wrap(const AValue: T): TFunc<T>;
type
  TS = TSmartPointer<T>;
  PS = ^TS;
var
  p: PS;
begin
  P:= GetMemory(SizeOf(TS));
  p.RefCount:= 1;
  pointer(p.unknown):= p;
  p.VMT:= @PSEUDO_VMT;
  p.AValue:= AValue;
  pointer(Result):= pointer(TFunc<T>(p));
end;

function Trick_Release(const obj:  PInjectObjectType): Integer; stdcall;
begin
  Result:= AtomicDecrement(Obj^.RefCount);
  WriteLn('Release '+IntToStr(Obj.RefCount));
  if Result = 0 then begin
    obj^.AValue.Free;
    FreeMem(obj);
  end;
end;

Now it works: