Interfaces without objects

Delphi interfaces are usually implemented by objects, but that is not necessary. Like you can implement a COM interface in pure C, you can implement a Delphi interface (which follows COM specifications in general) in pure Pascal without using objects.

To demonstrate the technique let us consider the following example:

unit CalcIntf;

interface

type
  ICalculator = interface
    procedure Clear;
    procedure Add(AValue: Integer);
    procedure Sub(AValue: Integer);
    function GetAccumulator: Integer;
  end;

implementation

end.

Here is a standard Delphi implementation of ICalculator interface by TInterfacedObject descendant:

unit CalcObjects;

interface

uses CalcIntf;

function GetCalculator: ICalculator;

implementation

type
  TCalcObj = class(TInterfacedObject, ICalculator)
    FAccumulator: Integer;
    procedure Clear;
    procedure Add(AValue: Integer);
    procedure Sub(AValue: Integer);
    function GetAccumulator: Integer;
  end;

procedure TCalcObj.Clear;
begin
  FAccumulator:= 0;
end;

function TCalcObj.GetAccumulator: Integer;
begin
  Result:= FAccumulator;
end;

procedure TCalcObj.Add(AValue: Integer);
begin
  Inc(FAccumulator, AValue);
end;

procedure TCalcObj.Sub(AValue: Integer);
begin
  Dec(FAccumulator, AValue);
end;

function GetCalculator: ICalculator;
begin
  Result:= TCalcObj.Create;
end;

end.

Our task is to implement ICalculator interface using a record instance instead of an object instance. I have described the internals of Delphi interfaces before. In the above example the GetCalculator function returns a pointer to the hidden vtable field of TCalcObj instance. If we use a record instead of an object we should declare this field explicitely; if we declare this field first we also get rid of stub code that converts a pointer to vtable field of an instance to a pointer to an instance itself and make interface functions’ calls faster:

type
  PCalcData = ^TCalcData;
  TCalcData = record
    FVTable: Pointer;
    FRefCount: Integer;
    FAccumulator: Integer;
  end;

Now the GetCalculator function should return a pointer to FVTable field of a record; since FVTable field is the first field of the TCalcData record, it is a pointer to record instance itself. A working solution is presented below; I used static class methods of an advanced record instead of ordinary functions only to scope the functions’ names:

unit CalcRecords;

interface

uses CalcIntf;

function GetCalculator: ICalculator;

implementation

type
  PCalcData = ^TCalcData;
  TCalcData = record
    FVTable: Pointer;
    FRefCount: Integer;
    FAccumulator: Integer;
  end;

  TCalcRec = record
    Data: PCalcData;
    class function QueryIntf(Inst: PCalcData; const IID: TGUID;
                             out Obj): HResult; stdcall; static;
    class function Addref(Inst: PCalcData): Integer; stdcall; static;
    class function Release(Inst: PCalcData): Integer; stdcall; static;
    class procedure Clear(Inst: PCalcData); static;
    class procedure Add(Inst: PCalcData; AValue: Integer); static;
    class procedure Sub(Inst: PCalcData; AValue: Integer); static;
    class function GetAccumulator(Inst: PCalcData): Integer; static;
  end;

function InterlockedAdd(var Value: Integer; Increment: Integer): Integer;
asm
      MOV   ECX,EAX
      MOV   EAX,EDX
 LOCK XADD  [ECX],EAX
      ADD   EAX,EDX
end;

function InterlockedIncrement(var Value: Integer): Integer;
asm
      MOV   EDX,1
      JMP   InterlockedAdd
end;

function InterlockedDecrement(var Value: Integer): Integer;
asm
      MOV   EDX,-1
      JMP   InterlockedAdd
end;

class function TCalcRec.QueryIntf(Inst: PCalcData; const IID: TGUID; out Obj): HResult;
begin
  Result:= E_NOINTERFACE;
end;

class function TCalcRec.Addref(Inst: PCalcData): Integer;
begin
  Result:= InterlockedIncrement(Inst^.FRefCount);
end;

class function TCalcRec.Release(Inst: PCalcData): Integer;
begin
  Result:= InterlockedDecrement(Inst^.FRefCount);
  if Result = 0 then
    Dispose(Inst);
end;

class procedure TCalcRec.Clear(Inst: PCalcData);
begin
  Inst^.FAccumulator:= 0;
end;

class function TCalcRec.GetAccumulator(Inst: PCalcData): Integer;
begin
  Result:= Inst^.FAccumulator;
end;

class procedure TCalcRec.Add(Inst: PCalcData; AValue: Integer);
begin
  Inc(Inst^.FAccumulator, AValue);
end;

class procedure TCalcRec.Sub(Inst: PCalcData; AValue: Integer);
begin
  Dec(Inst^.FAccumulator, AValue);
end;

const
  CalcVTable: array[0..6] of Pointer =
  (
    @TCalcRec.QueryIntf,
    @TCalcRec.Addref,
    @TCalcRec.Release,
    @TCalcRec.Clear,
    @TCalcRec.Add,
    @TCalcRec.Sub,
    @TCalcRec.GetAccumulator
  );

function GetCalculator: ICalculator;
var
  P: PCalcData;

begin
  New(P);
  P^.FVTable:= @CalcVTable;
  P^.FRefCount:= 0;
  P^.FAccumulator:= 0;
  Result:= ICalculator(P);
end;

end.

Here is a simple test code:

uses CalcIntf, CalcObjects, CalcRecords;

procedure TForm1.Button1Click(Sender: TObject);
var
  ICalc: ICalculator;

begin
  ICalc:= CalcObjects.GetCalculator;
  ICalc.Add(42);
  ShowMessage(IntToStr(ICalc.GetAccumulator));
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  ICalc: ICalculator;

begin
  ICalc:= CalcRecords.GetCalculator;
  ICalc.Add(42);
  ShowMessage(IntToStr(ICalc.GetAccumulator));
end;