Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to assert what given method pointer uses stdcall calling convention?

Tags:

delphi

rtti

In my library i'm invoking methods under specific conditions, which requires stdcall calling convention. Currently i'm using compiler static resolution, implemented as rather large list of well-known method signatures and corresponding overloaded versions of my subroutine. This works but looks quite fugly and doesnt 100% cover all possible methods. I would like to add a possibility to work with generic method pointer and assert proper calling convention by asking RTTI. And here i'm stuck, please advise.

Input: code/data pair of pointers as in TMethod 
Output: boolean indicator, true if method is stdcall

I'd preferable use "classic" RTTI to create less version dependencies, however i cant find any calling convention indicator within "classic" RTTI...


NB: This question is UNRELATED to importing external functions

like image 984
Premature Optimization Avatar asked May 22 '11 00:05

Premature Optimization


2 Answers

You can extract calling convention information from extended RTTI (available since Delphi 2010).

uses RTTI, TypInfo;

function GetMethCallConv(AMeth: TMethod; out Conv: TCallConv): Boolean;
var
  Ctx: TRttiContext;
  Meth: TRttiMethod;
  Typ: TRttiType;

begin
  Ctx:= TRttiContext.Create;
  try
    Typ:= Ctx.GetType(TObject(AMeth.Data).ClassType);
    for Meth in Typ.GetMethods do begin
      if Meth.CodeAddress = AMeth.Code then begin
        Conv:= Meth.CallingConvention;
        Exit(True);
      end;
    end;
    Exit(False);
  finally
    Ctx.Free;
  end;
end;

//test

type
  TMyObj = class
  public
    procedure MyMeth(I: Integer); stdcall;
  end;

procedure TMyObj.MyMeth(I: Integer);
begin
  ShowMessage(IntToStr(I));
end;
procedure TForm2.Button2Click(Sender: TObject);
var
  Conv: TCallConv;
  Meth: TMethod;
  MyObj: TMyObj;

begin
  MyObj:= TMyObj.Create;
  Meth.Code:= @TMyObj.MyMeth;
  Meth.Data:= MyObj;
  if GetMethCallConv(Meth, Conv) then begin
    case Conv of
      ccReg: ShowMessage('Register');
      ccCdecl: ShowMessage('cdecl');
      ccPascal: ShowMessage('Pascal');
      ccStdCall: ShowMessage('StdCall');
      ccSafeCall: ShowMessage('SafeCall');
    end;
  end;
  MyObj.Free;
end;

Update

For "classic" RTTI read Sertac answer; the following works OK on Delphi 2010:

uses ObjAuto;

function GetMethCallConv2(AMeth: TMethod; out Conv: TCallingConvention): Boolean;
var
  Methods: TMethodInfoArray;
  I: Integer;
  P: PMethodInfoHeader;

begin
  Result:= False;
  Methods:= GetMethods(TObject(AMeth.Data).ClassType);
  if not Assigned(Methods) then Exit;

  for I:= Low(Methods) to High(Methods) do begin
    P:= Methods[I];
    if P^.Addr = AMeth.Code then begin
      Inc(Integer(P), SizeOf(TMethodInfoHeader) - SizeOf(ShortString) + 1 +
        Length(PMethodInfoHeader(P)^.Name));
      Conv:= PReturnInfo(P).CallingConvention;
      Result:= True;
      Exit;
    end;
  end;
end;

{$TYPEINFO ON}
{$METHODINFO ON}
type
  TMyObj = class
  public
    procedure MyMeth(I: Integer);
  end;

procedure TMyObj.MyMeth(I: Integer);
begin
  ShowMessage(IntToStr(I));
end;

procedure TForm2.Button3Click(Sender: TObject);
var
  Conv: TCallingConvention;
  Meth: TMethod;
  MyObj: TMyObj;

begin
  MyObj:= TMyObj.Create;
  Meth.Code:= @TMyObj.MyMeth;
  Meth.Data:= MyObj;
  if GetMethCallConv2(Meth, Conv) then begin
    case Conv of
      ccRegister: ShowMessage('Register');
      ccCdecl: ShowMessage('cdecl');
      ccPascal: ShowMessage('Pascal');
      ccStdCall: ShowMessage('StdCall');
      ccSafeCall: ShowMessage('SafeCall');
    end;
  end;
  MyObj.Free;
end;
like image 159
kludg Avatar answered Nov 15 '22 06:11

kludg


Including Delphi 7 and up, when METHODINFO directive is on, run-time generates information about, at least having public visibility, method parameters and return types and calling convention (TYPEINFO should also be on).

Not sure if the below sample would help you directly since it works on an instance and method's name and not its address, but perhaps you can construct a look-up table for name-address of methods beforehand.

type
{$METHODINFO ON}
  TSomeClass = class
  public
    procedure Proc1(i: Integer; d: Double); stdcall;
    procedure Proc2;
  end;
{$METHODINFO OFF}

  TForm1 = class(TForm)
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
  private
    FSomeClass: TSomeClass;

  ..

uses
  objauto;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FSomeClass := TSomeClass.Create;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Info: Pointer;
begin
  Info := GetMethodInfo(FSomeClass, 'Proc1');
  if Assigned(Info) then begin
    Inc(Integer(Info), SizeOf(TMethodInfoHeader) - SizeOf(ShortString) + 1 +
      Length(PMethodInfoHeader(Info).Name));
    if PReturnInfo(Info).CallingConvention = ccStdCall then
      // ...

  end;


Beware and do some testing though, tested on D2007 the working is somewhat unpredictable. For instance, if the above 'Proc1' is changed to procedure Proc1(i: Pointer; d: Double); no detailed RTTI is generated.

like image 38
Sertac Akyuz Avatar answered Nov 15 '22 08:11

Sertac Akyuz