¿Cómo convertir un método a un procedimiento de devolución de llamada en Delphi XE2 de 64 bits?

Question

La Biblioteca Mustangpeak común (http://code.google.com/p/mustangpeakcommonlib/) contiene el código siguiente que convierte un método para un procedimiento que se puede utilizar en una devolución de llamada:

const 
    AsmPopEDX = $5A; 
    AsmMovEAX = $B8; 
    AsmPushEAX = $50; 
    AsmPushEDX = $52; 
    AsmJmpShort = $E9; 

type 
    TStub = packed record 
    PopEDX: Byte; 
    MovEAX: Byte; 
    SelfPointer: Pointer; 
    PushEAX: Byte; 
    PushEDX: Byte; 
    JmpShort: Byte; 
    Displacement: Integer; 
    end; 

{ ----------------------------------------------------------------------------- } 
function CreateStub(ObjectPtr: Pointer; MethodPtr: Pointer): Pointer; 
var 
    Stub: ^TStub; 
begin 
    // Allocate memory for the stub 
    // 1/10/04 Support for 64 bit, executable code must be in virtual space 
    Stub := VirtualAlloc(nil, SizeOf(TStub), MEM_COMMIT, PAGE_EXECUTE_READWRITE); 

    // Pop the return address off the stack 
    Stub^.PopEDX := AsmPopEDX; 

    // Push the object pointer on the stack 
    Stub^.MovEAX := AsmMovEAX; 
    Stub^.SelfPointer := ObjectPtr; 
    Stub^.PushEAX := AsmPushEAX; 

    // Push the return address back on the stack 
    Stub^.PushEDX := AsmPushEDX; 

    // Jump to the 'real' procedure, the method. 
    Stub^.JmpShort := AsmJmpShort; 
    Stub^.Displacement := (Integer(MethodPtr) - Integer(@(Stub^.JmpShort))) - 
    (SizeOf(Stub^.JmpShort) + SizeOf(Stub^.Displacement)); 

    // Return a pointer to the stub 
    Result := Stub; 
end; 
{ ----------------------------------------------------------------------------- } 

{ ----------------------------------------------------------------------------- } 
procedure DisposeStub(Stub: Pointer); 
begin 
    // 1/10/04 Support for 64 bit, executable code must be in virtual space 
    VirtualFree(Stub, SizeOf(TStub),MEM_DECOMMIT); 
end; 

lo haría Agradecemos cualquier ayuda para convertirlo a 64 bits. Sé que la convención de llamadas en Win64 es diferente y que se pasan hasta cuatro parámetros en los registros. Así que CreateStub puede tener que ser modificado para incluir la cantidad de parámetros. En realidad, no se usa con más de cuatro parámetros que son enteros o punteros (sin argumentos de coma flotante).

Answer 1

Aquí está la versión de 64 bits de CreateStub. Felicitaciones a Andrey Gruzdev que proporcionó el código.

type 
    ICallbackStub = interface(IInterface) 
    function GetStubPointer: Pointer; 
    property StubPointer : Pointer read GetStubPointer; 
    end; 

    TCallbackStub = class(TInterfacedObject, ICallbackStub) 
    private 
    fStubPointer : Pointer; 
    fCodeSize : integer; 
    function GetStubPointer: Pointer; 
    public 
    constructor Create(Obj : TObject; MethodPtr: Pointer; NumArgs : integer); 
    destructor Destroy; override; 
    end; 



constructor TCallBackStub.Create(Obj: TObject; MethodPtr: Pointer; 
    NumArgs: integer); 
{$IFNDEF CPUX64} 
// as before 
{$ELSE CPUX64} 
const 
RegParamCount = 4; 
ShadowParamCount = 4; 

Size32Bit = 4; 
Size64Bit = 8; 

ShadowStack = ShadowParamCount * Size64Bit; 
SkipParamCount = RegParamCount - ShadowParamCount; 

StackSrsOffset = 3; 
c64stack: array[0..14] of byte = (
$48, $81, $ec, 00, 00, 00, 00,//  sub rsp,$0 
$4c, $89, $8c, $24, ShadowStack, 00, 00, 00//  mov [rsp+$20],r9 
); 

CopySrcOffset=4; 
CopyDstOffset=4; 
c64copy: array[0..15] of byte = (
$4c, $8b, $8c, $24, 00, 00, 00, 00,//  mov r9,[rsp+0] 
$4c, $89, $8c, $24, 00, 00, 00, 00//  mov [rsp+0],r9 
); 

RegMethodOffset = 10; 
RegSelfOffset = 11; 
c64regs: array[0..28] of byte = (
$4d, $89, $c1,  // mov r9,r8 
$49, $89, $d0,  // mov r8,rdx 
$48, $89, $ca,  // mov rdx,rcx 
$48, $b9, 00, 00, 00, 00, 00, 00, 00, 00, // mov rcx, Obj 
$48, $b8, 00, 00, 00, 00, 00, 00, 00, 00 // mov rax, MethodPtr 
); 

c64jump: array[0..2] of byte = (
$48, $ff, $e0 // jump rax 
); 

CallOffset = 6; 
c64call: array[0..10] of byte = (
$48, $ff, $d0, // call rax 
$48, $81,$c4, 00, 00, 00, 00, //  add rsp,$0 
$c3// ret 
); 
var 
    i: Integer; 
    P,PP,Q: PByte; 
    lCount : integer; 
    lSize : integer; 
    lOffset : integer; 
begin 
    lCount := SizeOf(c64regs); 
    if NumArgs>=RegParamCount then 
     Inc(lCount,sizeof(c64stack)+(NumArgs-RegParamCount)*sizeof(c64copy)+sizeof(c64call)) 
    else 
     Inc(lCount,sizeof(c64jump)); 

    Q := VirtualAlloc(nil, lCount, MEM_COMMIT, PAGE_EXECUTE_READWRITE); 
    P := Q; 

    lSize := 0; 
    if NumArgs>=RegParamCount then 
    begin 
     lSize := (1+ ((NumArgs + 1 - SkipParamCount) div 2) * 2)* Size64Bit; // 16 byte stack align 

     pp := p; 
     move(c64stack,P^,SizeOf(c64stack)); 
     Inc(P,StackSrsOffset); 
     move(lSize,P^,Size32Bit); 
     p := pp; 
     Inc(P,SizeOf(c64stack)); 
     for I := 0 to NumArgs - RegParamCount -1 do 
     begin 
      pp := p; 
      move(c64copy,P^,SizeOf(c64copy)); 
      Inc(P,CopySrcOffset); 
      lOffset := lSize + (i+ShadowParamCount+1)*Size64Bit; 
      move(lOffset,P^,Size32Bit); 
      Inc(P,CopyDstOffset+Size32Bit); 
      lOffset := (i+ShadowParamCount+1)*Size64Bit; 
      move(lOffset,P^,Size32Bit); 
      p := pp; 
      Inc(P,SizeOf(c64copy)); 
     end; 
    end; 

    pp := p; 
    move(c64regs,P^,SizeOf(c64regs)); 
    Inc(P,RegSelfOffset); 
    move(Obj,P^,SizeOf(Obj)); 
    Inc(P,RegMethodOffset); 
    move(MethodPtr,P^,SizeOf(MethodPtr)); 
    p := pp; 
    Inc(P,SizeOf(c64regs)); 

    if NumArgs<RegParamCount then 
     move(c64jump,P^,SizeOf(c64jump)) 
    else 
    begin 
     move(c64call,P^,SizeOf(c64call)); 
     Inc(P,CallOffset); 
     move(lSize,P^,Size32Bit); 
    end; 
    fCodeSize := lcount; 
    fStubPointer := Q; 
{$ENDIF CPUX64} 
end; 

destructor TCallBackStub.Destroy; 
begin 
    VirtualFree(fStubPointer, fCodeSize, MEM_DECOMMIT); 
    inherited; 
end; 

function TCallBackStub.GetStubPointer: Pointer; 
begin 
    Result := fStubPointer; 
end; 

Answer 2

Estoy 99% convencido de que no hay una solución equivalente en x64. En x86, el código aprovecha la propiedad de stdcall que todos los parámetros se pasan en la pila. El código que crea el código no necesita saber nada sobre los parámetros que se pasan. Simplemente empuja un parámetro extra, el auto puntero, a la pila. Todos los otros parámetros se desplazan hacia abajo en la pila.

En x64, al menos en Windows, hay un single calling convention. Esta convención de llamadas hace un uso extenso de los registros. Cuando los registros se agotan, se usa la pila. Se usan registros enteros y de punto flotante. Las reglas para las que se pasan los parámetros en los registros son complejas por decir lo menos. Por lo tanto, para convertir un método en un procedimiento autónomo, creo que la rutina CreateStub debería conocer la información sobre los parámetros: cuántos parámetros, qué tipos, etc. Como CreateStub no tiene ninguna de esta información, es simplemente no es posible realizar una conversión x64 de esta función, con la misma interfaz.