711 lines
18 KiB
PHP
711 lines
18 KiB
PHP
{$IFDEF DELPHI}
|
|
{$DEFINE PS_RESBEFOREPARAMETERS}
|
|
{$DEFINE x64_string_result_as_varparameter}
|
|
{$ENDIF}
|
|
|
|
{ implementation of x64 abi }
|
|
//procedure DebugBreak; external 'Kernel32.dll';
|
|
const
|
|
EmptyPchar: array[0..0] of char = #0;
|
|
{$IFDEF FPC}
|
|
{$ASMMODE INTEL}
|
|
{$ENDIF}
|
|
{$IFDEF MSWINDOWS}{$DEFINE WINDOWS}{$ENDIF}
|
|
|
|
{$IFDEF WINDOWS}
|
|
procedure x64call(
|
|
Address: Pointer;
|
|
out _RAX: IPointer;
|
|
_RCX, _RDX, _R8, _R9: IPointer;
|
|
var _XMM0: Double;
|
|
_XMM1, _XMM2, _XMM3: Double;
|
|
aStack: Pointer; aItems: {$IFDEF FPC}PtrUInt{$ELSE}IntPtr{$ENDIF}); assembler; {$IFDEF FPC}nostackframe;{$ENDIF}
|
|
asm
|
|
(* Registers:
|
|
RCX: Address
|
|
RDX: *_RAX
|
|
R8: _RCX
|
|
R9: _RDX
|
|
|
|
fpc inserts an 20h emty space
|
|
*)
|
|
{$IFDEF FPC}
|
|
push rbp
|
|
mov rbp,rsp
|
|
{$ENDIF}
|
|
// call debugbreak
|
|
push rcx // address
|
|
push rdx // _rax
|
|
push r8 // _rcx
|
|
push r9 // _rdx
|
|
mov rcx, aItems
|
|
mov rdx, aStack
|
|
jmp @compareitems
|
|
@work:
|
|
{$IFDEF FPC}
|
|
push qword ptr [rdx]
|
|
{$ELSE}
|
|
push [rdx]
|
|
{$ENDIF}
|
|
dec rcx
|
|
sub rdx,8
|
|
@compareitems:
|
|
or rcx, rcx
|
|
jnz @work
|
|
|
|
// copy registers
|
|
{$IFDEF FPC}
|
|
movd xmm0,[_XMM0]
|
|
movd xmm1,_XMM1
|
|
movd xmm2,_XMM2
|
|
movd xmm3,_XMM3
|
|
{$ELSE}
|
|
mov rax, [_XMM0]
|
|
movsd xmm0, qword ptr [rax]
|
|
movsd xmm1,_XMM1
|
|
movsd xmm2,_XMM2
|
|
movsd xmm3,_XMM3
|
|
{$ENDIF}
|
|
mov RAX, [rbp-8]
|
|
mov RCX, [rbp-24]
|
|
mov RDX, [rbp-32]
|
|
mov R8, _R8
|
|
mov R9, _R9
|
|
|
|
// weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in
|
|
sub RSP, 32
|
|
|
|
call RAX
|
|
|
|
add RSP, 32 // undo the damage done earlier
|
|
|
|
// copy result back
|
|
mov RDX, [rbp-16]
|
|
mov [RDX], RAX
|
|
{$IFDEF FPC}
|
|
movd [_XMM0],xmm0
|
|
{$ELSE}
|
|
mov rax, [_XMM0]
|
|
movsd qword ptr [rax], xmm0
|
|
{$ENDIF}
|
|
|
|
pop r9
|
|
pop r8
|
|
pop rdx
|
|
pop rcx
|
|
leave
|
|
ret
|
|
end;
|
|
{$ELSE}
|
|
type
|
|
TRegisters = packed record
|
|
_RDI, // 0
|
|
_RSI, // 8
|
|
_RDX, // 16
|
|
_RCX, // 24
|
|
_R8, // 32
|
|
_R9: IPointer; // 40
|
|
_XMM1, // 48
|
|
_XMM2, // 56
|
|
_XMM3, // 64
|
|
_XMM4, // 72
|
|
_XMM5, // 80
|
|
_XMM6, // 88
|
|
_XMM7: Double; // 96
|
|
SingleBits: Integer; //104
|
|
end;
|
|
|
|
procedure x64call(
|
|
Address: Pointer;
|
|
out _RAX: IPointer;
|
|
|
|
var Registers: TRegisters;
|
|
aStack: Pointer; aItems: Integer; var _XMM0: Double); assembler; nostackframe;
|
|
|
|
|
|
asm
|
|
(* Registers:
|
|
RDI: Address
|
|
RSI: _RAX
|
|
RDX: Registers
|
|
RCX: aStack
|
|
R8: aItems
|
|
R9: XMM0
|
|
|
|
rbp-8 addr
|
|
rbp-16 _rax
|
|
rbp-24 _xmm0
|
|
rbp-32 regs
|
|
*)
|
|
push rbp
|
|
mov rbp,rsp
|
|
push rdi // address
|
|
push rsi // _rax
|
|
push r9 // xmm0
|
|
push rdx
|
|
{$IFDEF PS_STACKALIGN}
|
|
bt r8, 0
|
|
jnc @skipjump
|
|
sub rsp, 8
|
|
@skipjump:
|
|
{$ENDIF}
|
|
mov rax, rdx
|
|
jmp @compareitems
|
|
@work:
|
|
{$IFDEF FPC}
|
|
push qword ptr [rcx]
|
|
{$ELSE}
|
|
push [rcx]
|
|
{$ENDIF}
|
|
dec r8
|
|
sub rcx,8
|
|
@compareitems:
|
|
or r8, r8
|
|
jnz @work
|
|
|
|
// copy registers
|
|
// xmm0
|
|
mov rdx,[rbp-24]
|
|
bt [rax+104], 0
|
|
jnc @skipxmm0
|
|
cvtsd2ss xmm0,[rdx]
|
|
jmp @skipxmm0re
|
|
@skipxmm0:
|
|
movd xmm0,[rdx]
|
|
@skipxmm0re:
|
|
|
|
// xmm1
|
|
bt [rax+104], 1
|
|
jnc @skipxmm1
|
|
cvtsd2ss xmm1,[rax+48]
|
|
jmp @skipxmm1re
|
|
@skipxmm1:
|
|
movd xmm1,[rax+48]
|
|
@skipxmm1re:
|
|
|
|
// xmm2
|
|
bt [rax+104], 2
|
|
jnc @skipxmm2
|
|
cvtsd2ss xmm2,[rax+56]
|
|
jmp @skipxmm2re
|
|
@skipxmm2:
|
|
movd xmm2,[rax+56]
|
|
@skipxmm2re:
|
|
|
|
// xmm3
|
|
bt [rax+104], 3
|
|
jnc @skipxmm3
|
|
cvtsd2ss xmm3,[rax+64]
|
|
jmp @skipxmm3re
|
|
@skipxmm3:
|
|
movd xmm3,[rax+64]
|
|
@skipxmm3re:
|
|
|
|
// xmm4
|
|
bt [rax+104], 4
|
|
jnc @skipxmm4
|
|
cvtsd2ss xmm4,[rax+72]
|
|
jmp @skipxmm4re
|
|
@skipxmm4:
|
|
movd xmm4,[rax+72]
|
|
@skipxmm4re:
|
|
|
|
// xmm5
|
|
bt [rax+104], 5
|
|
jnc @skipxmm5
|
|
cvtsd2ss xmm5,[rax+80]
|
|
jmp @skipxmm5re
|
|
@skipxmm5:
|
|
movd xmm5,[rax+80]
|
|
@skipxmm5re:
|
|
|
|
// xmm6
|
|
bt [rax+104], 6
|
|
jnc @skipxmm6
|
|
cvtsd2ss xmm6,[rax+88]
|
|
jmp @skipxmm6re
|
|
@skipxmm6:
|
|
movd xmm6,[rax+88]
|
|
@skipxmm6re:
|
|
// xmm7
|
|
bt [rax+104], 7
|
|
jnc @skipxmm7
|
|
cvtsd2ss xmm7,[rax+96]
|
|
jmp @skipxmm7re
|
|
@skipxmm7:
|
|
movd xmm7,[rax+96]
|
|
@skipxmm7re:
|
|
|
|
|
|
mov RDI, [rax]
|
|
mov RSI, [rax+ 8]
|
|
mov RDX, [rax+16]
|
|
mov RCX, [rax+24]
|
|
mov R8, [rax+32]
|
|
mov R9, [rax+40]
|
|
|
|
// weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux
|
|
//sub RSP, 32
|
|
|
|
mov rax, [rbp-8]
|
|
call RAX
|
|
|
|
// add rsp, 8
|
|
|
|
// add RSP, 32 // undo the damage done earlier
|
|
|
|
// copy result back
|
|
mov rsi, [rbp-16]
|
|
mov [rsi], RAX
|
|
mov rsi, [rbp-24]
|
|
|
|
// xmm0 res
|
|
mov rax, [rbp-32]
|
|
bt [rax+104], 8
|
|
jnc @skipres
|
|
cvtss2sd xmm1,xmm0
|
|
movd [rsi],xmm1
|
|
jmp @skipresre
|
|
@skipres:
|
|
movd [rsi],xmm0
|
|
@skipresre:
|
|
|
|
pop rdx
|
|
pop r9 // xmm0
|
|
pop rsi // _rax
|
|
pop rdi // address
|
|
leave
|
|
ret
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
|
|
var
|
|
Stack: array of Byte;
|
|
_RAX: IPointer;
|
|
{$IFDEF WINDOWS}
|
|
_RCX, _RDX, _R8, _R9: IPointer;
|
|
_XMM0, _XMM1, _XMM2, _XMM3: Double;
|
|
{$ELSE}
|
|
_XMM0: Double;
|
|
Registers: TRegisters;
|
|
RegUsageFloat: Byte;
|
|
{$ENDIF}
|
|
RegUsage: Byte;
|
|
CallData: TPSList;
|
|
I: Integer;
|
|
pp: ^Byte;
|
|
|
|
function rp(p: PPSVariantIFC): PPSVariantIFC;
|
|
begin
|
|
if p = nil then
|
|
begin
|
|
result := nil;
|
|
exit;
|
|
end;
|
|
if p.aType.BaseType = btPointer then
|
|
begin
|
|
p^.aType := Pointer(Pointer(IPointer(p^.dta) + PointerSize)^);
|
|
p^.Dta := Pointer(p^.dta^);
|
|
end;
|
|
Result := p;
|
|
end;
|
|
{$IFDEF WINDOWS}
|
|
procedure StoreReg(data: IPointer); overload;
|
|
var p: Pointer;
|
|
begin
|
|
case RegUsage of
|
|
0: begin inc(RegUsage); _RCX:=Data; end;
|
|
1: begin inc(RegUsage); _RDX:=Data; end;
|
|
2: begin inc(RegUsage); _R8:=Data; end;
|
|
3: begin inc(RegUsage); _R9:=Data; end;
|
|
else begin
|
|
SetLength(Stack, Length(Stack)+8);
|
|
p := @Stack[LEngth(Stack)-8];
|
|
IPointer(p^) := data;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
procedure StoreReg(data: IPointer); overload;
|
|
var p: Pointer;
|
|
begin
|
|
case RegUsage of
|
|
0: begin inc(RegUsage); Registers._RDI:=Data; end;
|
|
1: begin inc(RegUsage); Registers._RSI:=Data; end;
|
|
2: begin inc(RegUsage); Registers._RDX:=Data; end;
|
|
3: begin inc(RegUsage); Registers._RCX:=Data; end;
|
|
4: begin inc(RegUsage); Registers._R8:=Data; end;
|
|
5: begin inc(RegUsage); Registers._R9:=Data; end;
|
|
else begin
|
|
SetLength(Stack, Length(Stack)+8);
|
|
p := @Stack[LEngth(Stack)-8];
|
|
IPointer(p^) := data;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure StoreStack(const aData; Len: Integer);
|
|
var
|
|
p: Pointer;
|
|
begin
|
|
if Len > 8 then
|
|
if Length(Stack) mod 16 <> 0 then begin
|
|
SetLength(Stack, Length(Stack)+ (16-(Length(Stack) mod 16)));
|
|
end;
|
|
SetLength(Stack, Length(Stack)+Len);
|
|
p := @Stack[Length(Stack)-Len];
|
|
Move(aData, p^, Len);
|
|
end;
|
|
|
|
{$IFDEF WINDOWS}
|
|
procedure StoreReg(data: Double); overload;
|
|
var p: Pointer;
|
|
begin
|
|
case RegUsage of
|
|
0: begin inc(RegUsage); _XMM0:=Data; end;
|
|
1: begin inc(RegUsage); _XMM1:=Data; end;
|
|
2: begin inc(RegUsage); _XMM2:=Data; end;
|
|
3: begin inc(RegUsage); _XMM3:=Data; end;
|
|
else begin
|
|
SetLength(Stack, Length(Stack)+8);
|
|
p := @Stack[LEngth(Stack)-8];
|
|
Double(p^) := data;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ELSE}
|
|
procedure StoreReg(data: Double); overload;
|
|
var p: Pointer;
|
|
begin
|
|
case RegUsageFloat of
|
|
0: begin inc(RegUsageFloat); _XMM0:=Data; end;
|
|
1: begin inc(RegUsageFloat); Registers._XMM1:=Data; end;
|
|
2: begin inc(RegUsageFloat); Registers._XMM2:=Data; end;
|
|
3: begin inc(RegUsageFloat); Registers._XMM3:=Data; end;
|
|
4: begin inc(RegUsageFloat); Registers._XMM4:=Data; end;
|
|
5: begin inc(RegUsageFloat); Registers._XMM5:=Data; end;
|
|
6: begin inc(RegUsageFloat); Registers._XMM6:=Data; end;
|
|
7: begin inc(RegUsageFloat); Registers._XMM7:=Data; end;
|
|
else begin
|
|
SetLength(Stack, Length(Stack)+8);
|
|
p := @Stack[LEngth(Stack)-8];
|
|
Double(p^) := data;
|
|
end;
|
|
end;
|
|
end;
|
|
procedure StoreReg(data: Single); overload;
|
|
var p: Pointer;
|
|
begin
|
|
case RegUsageFloat of
|
|
0: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 1; _XMM0:=Data; end;
|
|
1: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 2; Registers._XMM1:=Data; end;
|
|
2: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 4; Registers._XMM2:=Data; end;
|
|
3: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 8; Registers._XMM3:=Data; end;
|
|
4: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 16; Registers._XMM4:=Data; end;
|
|
5: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 32; Registers._XMM5:=Data; end;
|
|
6: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 64; Registers._XMM6:=Data; end;
|
|
7: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 128; Registers._XMM7:=Data; end;
|
|
else begin
|
|
SetLength(Stack, Length(Stack)+8);
|
|
p := @Stack[LEngth(Stack)-8];
|
|
Double(p^) := data;
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
function GetPtr(fVar: PPSVariantIFC): Boolean;
|
|
var
|
|
varPtr: Pointer;
|
|
//UseReg: Boolean;
|
|
//tempstr: tbtstring;
|
|
p: Pointer;
|
|
begin
|
|
Result := False;
|
|
if FVar = nil then exit;
|
|
if fVar.VarParam then
|
|
begin
|
|
case fvar.aType.BaseType of
|
|
btArray:
|
|
begin
|
|
if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
|
begin
|
|
p := CreateOpenArray(True, Self, FVar);
|
|
if p = nil then exit;
|
|
CallData.Add(p);
|
|
StoreReg(IPointer(POpenArray(p)^.Data));
|
|
StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
|
|
Result := True;
|
|
Exit;
|
|
end else begin
|
|
varptr := fvar.Dta;
|
|
// Exit;
|
|
end;
|
|
end;
|
|
btVariant,
|
|
btSet,
|
|
btStaticArray,
|
|
btRecord,
|
|
btInterface,
|
|
btClass,
|
|
{$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16,
|
|
btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
|
|
{$IFNDEF PS_NOINT64}, bts64{$ENDIF}:
|
|
begin
|
|
Varptr := fvar.Dta;
|
|
end;
|
|
else begin
|
|
exit; //invalid type
|
|
end;
|
|
end; {case}
|
|
|
|
StoreReg(IPointer(VarPtr));
|
|
end else begin
|
|
// UseReg := True;
|
|
case fVar^.aType.BaseType of
|
|
btSet:
|
|
begin
|
|
case TPSTypeRec_Set(fvar.aType).aByteSize of
|
|
1: StoreReg(IPointer(byte(fvar.dta^)));
|
|
2: StoreReg(IPointer(word(fvar.dta^)));
|
|
3, 4: StoreReg(IPointer(cardinal(fvar.dta^)));
|
|
5,6,7,8: StoreReg(IPointer(fVar.Dta^));
|
|
else
|
|
StoreReg(IPointer(fvar.Dta));
|
|
end;
|
|
end;
|
|
btArray:
|
|
begin
|
|
if Copy(fvar^.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
|
begin
|
|
p := CreateOpenArray(False, SElf, FVar);
|
|
if p =nil then exit;
|
|
CallData.Add(p);
|
|
StoreReg(IPointer(POpenArray(p)^.Data));
|
|
StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
|
|
Result := True;
|
|
exit;
|
|
end else begin
|
|
{$IFDEF FPC}
|
|
StoreReg(IPointer(FVar.Dta));
|
|
{$ELSE}
|
|
StoreReg(IPointer(FVar.Dta^));
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
btRecord:
|
|
begin
|
|
if fvar^.aType.RealSize <= sizeof(IPointer) then
|
|
StoreReg(IPointer(fvar.dta^))
|
|
else
|
|
StoreReg(IPointer(fVar.Dta));
|
|
end;
|
|
btVariant
|
|
, btStaticArray:
|
|
begin
|
|
StoreReg(IPointer(fVar.Dta));
|
|
end;
|
|
btExtended, btDouble: {8 bytes} begin
|
|
StoreReg(double(fvar.dta^));
|
|
end;
|
|
btCurrency: {8 bytes} begin
|
|
StoreReg(IPointer(fvar.dta^));
|
|
end;
|
|
btSingle: {4 bytes} begin
|
|
StoreReg(single(fvar.dta^));
|
|
end;
|
|
|
|
btChar,
|
|
btU8,
|
|
btS8: begin
|
|
StoreReg(IPointer(byte(fVar^.dta^)));
|
|
end;
|
|
btWideChar,
|
|
btu16, btS16: begin
|
|
StoreReg(IPointer(word(fVar^.dta^)));
|
|
end;
|
|
btu32, bts32: begin
|
|
StoreReg(IPointer(cardinal(fVar^.dta^)));
|
|
end;
|
|
btPchar:
|
|
begin
|
|
if pointer(fvar^.dta^) = nil then
|
|
StoreReg(IPointer(@EmptyPchar))
|
|
else
|
|
StoreReg(IPointer(fvar^.dta^));
|
|
end;
|
|
btclass, btinterface, btString:
|
|
begin
|
|
StoreReg(IPointer(fvar^.dta^));
|
|
end;
|
|
btWideString: begin
|
|
StoreReg(IPointer(fvar^.dta^));
|
|
end;
|
|
btUnicodeString: begin
|
|
StoreReg(IPointer(fvar^.dta^));
|
|
end;
|
|
|
|
btProcPtr:
|
|
begin
|
|
GetMem(p, PointerSize2);
|
|
TMethod(p^) := MKMethod(Self, Longint(FVar.Dta^));
|
|
StoreStack(p^, Pointersize2);
|
|
FreeMem(p);
|
|
end;
|
|
|
|
bts64:
|
|
begin
|
|
StoreReg(IPointer(int64(fvar^.dta^)));
|
|
end;
|
|
end; {case}
|
|
end;
|
|
Result := True;
|
|
end;
|
|
begin
|
|
InnerfuseCall := False;
|
|
if Address = nil then
|
|
exit; // need address
|
|
SetLength(Stack, 0);
|
|
CallData := TPSList.Create;
|
|
res := rp(res);
|
|
if res <> nil then
|
|
res.VarParam := true;
|
|
try
|
|
{$IFNDEF WINDOWS}
|
|
(*_RSI := 0;
|
|
_RDI := 0;
|
|
_XMM4 := 0;
|
|
_XMM5 := 0;
|
|
_XMM6 := 0;
|
|
_XMM7 := 0;*)
|
|
FillChar(Registers, Sizeof(REgisters), 0);
|
|
_XMM0 := 0;
|
|
RegUsageFloat := 0;
|
|
{$ELSE}
|
|
_RCX := 0;
|
|
_RDX := 0;
|
|
_R8 := 0;
|
|
_R9 := 0;
|
|
_XMM0 := 0;
|
|
_XMM1 := 0;
|
|
_XMM2 := 0;
|
|
_XMM3 := 0;
|
|
{$ENDIF}
|
|
_RAX := 0;
|
|
RegUsage := 0;
|
|
if assigned(_Self) then begin
|
|
StoreReg(IPointer(_Self));
|
|
end;
|
|
{$IFNDEF WINDOWS}
|
|
if assigned(res) and (res^.atype.basetype = btSingle) then begin
|
|
Registers.Singlebits := Registers.Singlebits or 256;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF PS_RESBEFOREPARAMETERS}
|
|
if assigned(res) then begin
|
|
case res^.aType.BaseType of
|
|
{$IFDEF x64_string_result_as_varparameter}
|
|
btstring, btWideString, btUnicodeString,
|
|
{$ENDIF}
|
|
btInterface, btArray, btVariant, btStaticArray:
|
|
GetPtr(res);
|
|
btRecord,
|
|
btSet:
|
|
begin
|
|
if res.aType.RealSize > PointerSize then GetPtr(res);
|
|
end;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
for I := 0 to Params.Count - 1 do
|
|
begin
|
|
if not GetPtr(rp(Params[I])) then Exit;
|
|
end;
|
|
if assigned(res) then begin
|
|
{$IFNDEF PS_RESBEFOREPARAMETERS}
|
|
case res^.aType.BaseType of
|
|
{$IFDEF x64_string_result_as_varparameter}
|
|
btstring, btWideString, btUnicodeString,
|
|
{$ENDIF}
|
|
btInterface, btArray, btVariant, btStaticArray:
|
|
GetPtr(res);
|
|
btRecord,
|
|
btSet:
|
|
begin
|
|
if res.aType.RealSize > PointerSize then GetPtr(res);
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
{$IFDEF WINDOWS}
|
|
if (length(Stack) mod 16) <> 0 then begin
|
|
SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
|
|
end;
|
|
{$ENDIF}
|
|
if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
|
|
{$IFDEF WINDOWS}
|
|
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
|
|
{$ELSE}
|
|
x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
|
|
{$ENDIF}
|
|
case res^.aType.BaseType of
|
|
btRecord, btSet:
|
|
begin
|
|
case res.aType.RealSize of
|
|
1: byte(res.Dta^) := _RAX;
|
|
2: word(res.Dta^) := _RAX;
|
|
3,
|
|
4: Longint(res.Dta^) := _RAX;
|
|
5,6,7,8: IPointer(res.dta^) := _RAX;
|
|
end;
|
|
end;
|
|
btSingle: tbtsingle(res.Dta^) := _XMM0;
|
|
btDouble: tbtdouble(res.Dta^) := _XMM0;
|
|
btExtended: tbtextended(res.Dta^) := _XMM0;
|
|
btchar,btU8, btS8: tbtu8(res.dta^) := _RAX;
|
|
btWideChar, btu16, bts16: tbtu16(res.dta^) := _RAX;
|
|
btClass : IPointer(res.dta^) := _RAX;
|
|
btu32,bts32: tbtu32(res.dta^) := _RAX;
|
|
btPChar: pansichar(res.dta^) := Pansichar(_RAX);
|
|
bts64: tbts64(res.dta^) := Int64(_RAX);
|
|
btCurrency: tbts64(res.Dta^) := Int64(_RAX);
|
|
btInterface,
|
|
btVariant,
|
|
{$IFDEF x64_string_result_as_varparameter}
|
|
btWidestring,btUnicodestring, btstring ,
|
|
{$ENDIF}
|
|
btStaticArray, btArray:;
|
|
{$IFNDEF x64_string_result_as_varparameter}
|
|
btUnicodeString, btWideString, btstring: Int64(res.dta^) := _RAX;
|
|
{$ENDIF}
|
|
else
|
|
exit;
|
|
end;
|
|
end else begin
|
|
{$IFDEF WINDOWS}
|
|
if (length(Stack) mod 16) <> 0 then begin
|
|
SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
|
|
end;
|
|
{$ENDIF}
|
|
if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
|
|
{$IFDEF WINDOWS}
|
|
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
|
|
{$ELSE}
|
|
x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
|
|
{$ENDIF}
|
|
end;
|
|
Result := True;
|
|
finally
|
|
for i := CallData.Count -1 downto 0 do
|
|
begin
|
|
pp := CallData[i];
|
|
case pp^ of
|
|
0: DestroyOpenArray(Self, Pointer(pp));
|
|
end;
|
|
end;
|
|
CallData.Free;
|
|
end;
|
|
end;
|
|
|
|
|