Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Issue 61: 64bits support (Linux; untested)

Browse Source 
git-svn-id: http://code.remobjects.com/svn/pascalscript@172 5c9d2617-0215-0410-a2ee-e80e04d1c6d8
This commit is contained in:
carlokok 2009-09-11 09:07:24 +00:00
parent 84f4572344
commit 3a2d8f6bd8
1 changed files with 150 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

157
Source/x64.inc
View File

@ -3,6 +3,8 @@
const
EmptyPchar: array[0..0] of char = #0;
{$ASMMODE INTEL}
{$IFDEF WINDOWS}
procedure x64call(
Address: Pointer;
out _RAX: IPointer;
@ -67,13 +69,98 @@ asm
leave
ret
end;
{$ELSE}
procedure x64call(
Address: Pointer;
out _RAX: IPointer;
_RDI, _RSI, _RDX, _RCX, _R8, _R9: IPointer;
var _XMM0: Double;
_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7: Double;
aStack: Pointer; aItems: Integer); assembler; nostackframe;
asm
(* Registers:
RDI: Address
RSI: _RAX
RDX: _RDI
RCX: _RSI
R8: _RDX
R9: _RCX
*)
push ebp
mov ebp,esp
push rdi // address
push rsi // _rax
push rdx // _rdi
push rcx // _rsi
push r8 // _rdx
push r9 // _rcx
mov rcx, aItems
mov rdx, aStack
jmp @compareitems
@work:
push [rdx]
dec rcx
sub rdx,8
@compareitems:
or rcx, rcx
jnz @work
// copy registers
movd xmm0,[_XMM0]
movd xmm1,_XMM1
movd xmm2,_XMM2
movd xmm3,_XMM3
movd xmm4,_XMM4
movd xmm5,_XMM5
movd xmm6,_XMM6
movd xmm7,_XMM7
mov RAX, [rbp-8]
mov RDI, [rbp-24]
mov RSI, [rbp-32]
mov RDX, [rbp-40]
mov RCX, [rbp-48]
mov R8, _R8
mov R9, _R9
// weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux
//sub RSP, 32
call RAX
// add RSP, 32 // undo the damage done earlier
// copy result back
mov RDX, [rbp-16]
mov [RDX], RAX
movd [_XMM0],xmm0
pop r9
pop r8
pop rdx
pop rcx
pop rsi
pop rdi
leave
ret
end;
{$ENDIF}
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
var
Stack: array of Byte;
_RAX,
{$IFDEF WINDOWS}
_RCX, _RDX, _R8, _R9: IPointer;
_XMM0, _XMM1, _XMM2, _XMM3: Double;
{$ELSE}
_RDI, _RSI, _RDX, _RCX, _R8, _R9: IPointer;
_XMM0, _XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7: Double;
RegUsageFloat: Byte;
{$ENDIF}
RegUsage: Byte;
CallData: TPSList;
I: Integer;
@ -93,7 +180,7 @@ var
end;
Result := p;
end;
{$IFDEF WINDOWS}
procedure StoreReg(data: IPointer); overload;
var p: Pointer;
begin
@ -109,7 +196,25 @@ var
end;
end;
end;
{$ELSE}
procedure StoreReg(data: IPointer); overload;
var p: Pointer;
begin
case RegUsage of
0: begin inc(RegUsage); _RDI:=Data; end;
1: begin inc(RegUsage); _RSI:=Data; end;
2: begin inc(RegUsage); _RDX:=Data; end;
3: begin inc(RegUsage); _RCX:=Data; end;
4: begin inc(RegUsage); _R8:=Data; end;
5: begin inc(RegUsage); _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
@ -124,6 +229,7 @@ var
Move(aData, p^, Len);
end;
{$IFDEF WINDOWS}
procedure StoreReg(data: Double); overload;
var p: Pointer;
begin
@ -139,12 +245,32 @@ var
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); _XMM1:=Data; end;
2: begin inc(RegUsageFloat); _XMM2:=Data; end;
3: begin inc(RegUsageFloat); _XMM3:=Data; end;
4: begin inc(RegUsageFloat); _XMM4:=Data; end;
5: begin inc(RegUsageFloat); _XMM5:=Data; end;
6: begin inc(RegUsageFloat); _XMM6:=Data; end;
7: begin inc(RegUsageFloat); _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;
//UseReg: Boolean;
//tempstr: tbtstring;
p: Pointer;
begin
Result := False;
@ -187,7 +313,7 @@ var
StoreReg(IPointer(VarPtr));
end else begin
UseReg := True;
// UseReg := True;
case fVar^.aType.BaseType of
btSet:
begin
@ -286,6 +412,15 @@ begin
if res <> nil then
res.VarParam := true;
try
{$IFNDEF WINDOWS}
_RSI := 0;
_RDI := 0;
_XMM4 := 0;
_XMM5 := 0;
_XMM6 := 0;
_XMM7 := 0;
RegUsageFloat := 0;
{$ENDIF}
_RCX := 0;
_RDX := 0;
_R8 := 0;
@ -297,7 +432,7 @@ begin
RegUsage := 0;
if assigned(_Self) then begin
RegUsage := 1;
_RCX := Longint(_Self);
_RCX := IPointer(_Self);
end;
for I := 0 to Params.Count - 1 do
begin
@ -316,7 +451,11 @@ begin
end;
end;
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, _RDI, _RSI, _RDX, _RCX, _R8, _R9,_XMM0,_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7, pp, Length(Stack) div 8);
{$ENDIF}
case res^.aType.BaseType of
btSet:
begin
@ -352,7 +491,11 @@ begin
end;
end else begin
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, _RDI, _RSI, _RDX, _RCX, _R8, _R9,_XMM0,_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7, pp, Length(Stack) div 8);
{$ENDIF}
end;
Result := True;
finally