Преобразование соглашения Cdecl метода вызова в соглашение Паскаля метода вызова - PullRequest
Новая
       12

Преобразование соглашения Cdecl метода вызова в соглашение Паскаля метода вызова

0 голосов
/ 02 июня 2011

Я пытаюсь разработать некоторый код, чтобы сделать общие вызовы методов по его имени.Например, кто-то из Интернета отправил мне текст «TTest.MethodTest.Param1.Param2», и я нашел класс и вызвал его методом по имени с параметрами.Хорошо, я сделал это, я получил некоторый код от Андреаса Хаусладена, который немного изменил настройки, чтобы работать там, где мне нужно.Но реализация ExecuteAsyncCall была создана для создания функций cdecl. Мне нужно изменить его код для работы с методами соглашения Паскаль.

Вот пример кода, если кто-то захочет протестировать.Кто-нибудь может мне помочь?Я учусь, чтобы решить это, но это сложно для меня. 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  published
    { Public declarations }
    procedure Test(AString: string; AInteger: Integer); cdecl;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function CopyVarRec(const Data: TVarRec): TVarRec;
begin
  if (Data.VPointer <> nil) and
     (Data.VType in [vtString, vtAnsiString, vtWideString,
                     {$IFDEF UNICODE}vtUnicodeString,{$ENDIF} vtExtended,
                     vtCurrency, vtInt64, vtVariant, vtInterface]) then
  begin
    Result.VType := Data.VType;
    Result.VPointer := nil;
    { Copy and redirect TVarRec data to prevent conflicts with other threads,
      especially the calling thread. Otherwise reference counted types could
      be freed while this asynchron function is still executed. }
    case Result.VType of
      vtAnsiString: AnsiString(Result.VAnsiString) := AnsiString(Data.VAnsiString);
      vtWideString: WideString(Result.VWideString) := WideString(Data.VWideString);
      {$IFDEF UNICODE}
      vtUnicodeString: UnicodeString(Result.VUnicodeString) := UnicodeString(data.VUnicodeString);
      {$ENDIF UNICODE}
      vtInterface : IInterface(Result.VInterface) := IInterface(Data.VInterface);

      vtString    : begin New(Result.VString);   Result.VString^ := Data.VString^; end;
      vtExtended  : begin New(Result.VExtended); Result.VExtended^ := Data.VExtended^; end;
      vtCurrency  : begin New(Result.VCurrency); Result.VCurrency^ := Data.VCurrency^; end;
      vtInt64     : begin New(Result.VInt64);    Result.VInt64^ := Data.VInt64^; end;
      vtVariant   : begin New(Result.VVariant);  Result.VVariant^ := Data.VVariant^; end;
    end;
  end
  else
    Result := Data;
end;

function ExecuteAsyncCall(AProc: Pointer; MethodData: TObject; const AArgs: array of const): Integer;
var
  I: Integer;
  V: ^TVarRec;
  ByteCount: Integer;
  FArgs: array of TVarRec;
  FProc: function: Integer register;
begin
  FProc := AProc;
  SetLength(FArgs, 1 + Length(AArgs));

  // insert "Self"
  FArgs[0].VType := vtObject;
  FArgs[0].VObject := MethodData;

  for I := 0 to High(AArgs) do
    FArgs[I + 1] := CopyVarRec(AArgs[I]);

  ByteCount := Length(FArgs) * SizeOf(Integer) + $40;
  { Create a zero filled buffer for functions that want more arguments than
    specified. }
  asm
    xor eax, eax
    mov ecx, $40 / 8
@@FillBuf:
    push eax
    push eax
//    push eax
    dec ecx
    jnz @@FillBuf
  end;

  for I := High(FArgs) downto 0 do // cdecl => right to left
  begin
    V := @FArgs[I];
    case V.VType of
      vtInteger:     // [const] Arg: Integer
        asm
          mov eax, V
          push [eax].TVarRec.VInteger
        end;

      vtBoolean,     // [const] Arg: Boolean
      vtChar:        // [const] Arg: AnsiChar
        asm
          mov eax, V
          xor edx, edx
          mov dl, [eax].TVarRec.VBoolean
          push edx
        end;

      vtWideChar:    // [const] Arg: WideChar
        asm
          mov eax, V
          xor edx, edx
          mov dx, [eax].TVarRec.VWideChar
          push edx
        end;

      vtExtended:    // [const] Arg: Extended
        asm
          add [ByteCount], 8 // two additional DWORDs
          mov eax, V
          mov edx, [eax].TVarRec.VExtended
          movzx eax, WORD PTR [edx + 8]
          push eax
          push DWORD PTR [edx + 4]
          push DWORD PTR [edx]
        end;

      vtCurrency,    // [const] Arg: Currency
      vtInt64:       // [const] Arg: Int64
        asm
          add [ByteCount], 4 // an additional DWORD
          mov eax, V
          mov edx, [eax].TVarRec.VCurrency
          push DWORD PTR [edx + 4]
          push DWORD PTR [edx]
        end;

      vtString,      // [const] Arg: ShortString
      vtPointer,     // [const] Arg: Pointer
      vtPChar,       // [const] Arg: PChar
      vtObject,      // [const] Arg: TObject
      vtClass,       // [const] Arg: TClass
      vtAnsiString,  // [const] Arg: AnsiString
      {$IFDEF UNICODE}
      vtUnicodeString, // [const] Arg: UnicodeString
      {$ENDIF UNICODE}
      vtPWideChar,   // [const] Arg: PWideChar
      vtVariant,     // const Arg: Variant
      vtInterface,   // [const]: IInterface
      vtWideString:  // [const] Arg: WideString
        asm
          mov eax, V
          push [eax].TVarRec.VPointer
        end;
    end;
  end;

  Result := FProc;

  asm // cdecl => we must clean up
    add esp, [ByteCount]
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ExecuteAsyncCall(Self.MethodAddress('Test'), Self, ['Test ', 1])
end;

procedure TForm1.Test(AString: string; AInteger: Integer);
begin
  ShowMessage(AString +   IntToStr(AInteger));
end;

end.

Атт.

Obs: Я работаю над Delphi 2007

Ответы [ 2 ]

3 голосов
/ 02 июня 2011

Соглашение о вызовах паскаля передает параметры слева направо, тогда как cdecl передает их справа налево. Чтобы учесть эту разницу, просто измените порядок, в котором параметры помещаются в стек: 

for I := High(FArgs) downto 0 do // cdecl => right to left


for I := 0 to High(FArgs) do // pascal => left to right

Далее, параметр Self метода получает last вместо первого в соглашении Паскаля. Чистый эффект состоит в том, что в обоих соглашениях Self является последним параметром, помещаемым в стек. Вы можете добавить его в конец массива FArgs, но если бы это был мой код, я бы просто вставил его вручную после цикла основного аргумента (что также позволило бы полностью исключить массив второго аргумента). ): 

asm
  push [MethodData]
end;

Наконец, в соглашении паскаль получатель очищает стек, тогда как в cdecl вызывающий очищает его. Удалить этот код: 

asm // cdecl => we must clean up
  add esp, [ByteCount]
end;


// pascal => do nothing

Код также допускает вызов функций с меньшим параметрами, чем ожидает целевая функция. Он выделяет 40-байтовый буфер и заполняет его нулями. Это не будет работать с функцией Паскаля, хотя. Функция паскаля всегда извлекает одно и то же количество параметров из стека, поэтому, если вы укажете неправильное количество параметров при вызове, вы в конечном итоге уничтожите стек, когда функция вернется. Удалите блок ассемблера под комментарием: 

{ Create a zero filled buffer for functions that want more arguments than
  specified. }
asm
  ...
end;

Вы ничего не можете сделать, чтобы проверить, правильно ли вы получили количество параметров. Все, что вы можете сделать, это убедиться, что указатель стека при возврате из функции такой же, каким он был до того, как вы начали передавать параметры.

1 голос
/ 02 июня 2011

Я согласен, но я думаю, что Самость должна быть нажата последней:

http://docwiki.embarcadero.com/RADStudio/en/Program_Control

  // insert "Self"
    for I := 0 to High(AArgs) do
     FArgs[I] := CopyVarRec(AArgs[I]); 
   FArgs[High(AArgs)+1].VType := vtObject;
   FArgs[High(AArgs)+1].VObject := MethodData;

Но я не верю, что этот код может быть использован, и он вылетит:

1) все параметры всех методов должны быть вариантами

2) неверное количество параметров

3) неправильный тип (или порядок) параметров

Я думаю, вам нужно найти другое решение.

...