moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2025-02-07 10:40:19 -05:00
Code Issues Releases Wiki Activity

PS update

Browse Source 
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@63 3f818213-9676-44b0-a9b4-5e4c4e03d09d
This commit is contained in:
Wizzup? 2009-09-14 19:50:19 +00:00
parent 0c380b49ec
commit c14ee4987d
2 changed files with 87 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
Units/PascalScript/uPSR_dll.pas
View File

@ -1,4 +1,3 @@
unit uPSR_dll; unit uPSR_dll;
{$I PascalScript.inc} {$I PascalScript.inc}
@ -16,12 +15,8 @@ function UnloadProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSSt
implementation implementation
uses uses
{$IFDEF UNIX} {$IFDEF UNIX}
{$IFDEF Darwin}
LCLIntf, Unix, baseunix, dynlibs, termio, sockets; LCLIntf, Unix, baseunix, dynlibs, termio, sockets;
{$ELSE} {$ELSE}
dl;{$IFNDEF FPC}, Windows{$ENDIF}
{$ENDIF}
{$ELSE}
Windows; Windows;
{$ENDIF} {$ENDIF}
@ -36,11 +31,7 @@ type
TLoadedDll = record TLoadedDll = record
dllnamehash: Longint; dllnamehash: Longint;
dllname: tbtstring; dllname: tbtstring;
{$IFDEF LINUX}
dllhandle: Pointer;
{$ELSE}
dllhandle: THandle; dllhandle: THandle;
{$ENDIF}
end; end;
TMyExec = class(TPSExec); TMyExec = class(TPSExec);
PInteger = ^Integer; PInteger = ^Integer;
@ -77,11 +68,7 @@ end;
procedure DllFree(Sender: TPSExec; P: PLoadedDll); procedure DllFree(Sender: TPSExec; P: PLoadedDll);
begin begin
{$IFDEF LINUX}
dlclose(p^.dllhandle);
{$ELSE}
FreeLibrary(p^.dllhandle); FreeLibrary(p^.dllhandle);
{$ENDIF}
Dispose(p); Dispose(p);
end; end;
@ -90,11 +77,7 @@ var
s, s2, s3: tbtstring; s, s2, s3: tbtstring;
h, i: Longint; h, i: Longint;
ph: PLoadedDll; ph: PLoadedDll;
{$IFDEF LINUX}
dllhandle: Pointer;
{$ELSE}
dllhandle: THandle; dllhandle: THandle;
{$ENDIF}
loadwithalteredsearchpath: Boolean; loadwithalteredsearchpath: Boolean;
begin begin
s := p.Decl; s := p.Decl;
@ -119,18 +102,14 @@ begin
exit; exit;
end; end;
{$IFDEF UNIX} {$IFDEF UNIX}
{$IFDEF DARWIN}
dllhandle := LoadLibrary(PChar(s2)); dllhandle := LoadLibrary(PChar(s2));
{$ELSE} {$ELSE}
dllhandle := dlopen(PChar(s2), RTLD_LAZY);
{$ENDIF}
{$ELSE}
if loadwithalteredsearchpath then if loadwithalteredsearchpath then
dllhandle := LoadLibraryExA(PAnsiChar(AnsiString(s2)), 0, LOAD_WITH_ALTERED_SEARCH_PATH) dllhandle := LoadLibraryExA(PAnsiChar(AnsiString(s2)), 0, LOAD_WITH_ALTERED_SEARCH_PATH)
else else
dllhandle := LoadLibraryA(PAnsiChar(AnsiString(s2))); dllhandle := LoadLibraryA(PAnsiChar(AnsiString(s2)));
{$ENDIF} {$ENDIF}
if dllhandle = {$IFDEF LINUX}nil{$ELSE}0{$ENDIF}then if dllhandle = 0 then
begin begin
p.Ext2 := Pointer(1); p.Ext2 := Pointer(1);
Result := False; Result := False;
@ -146,12 +125,8 @@ begin
begin begin
dllhandle := ph^.dllhandle; dllhandle := ph^.dllhandle;
end; end;
until dllhandle <> {$IFDEF LINUX}nil{$ELSE}0{$ENDIF}; until dllhandle <> 0;
{$IFDEF LINUX}
p.Ext1 := dlsym(dllhandle, pchar(s3));
{$ELSE}
p.Ext1 := GetProcAddress(dllhandle, pansichar(s3)); p.Ext1 := GetProcAddress(dllhandle, pansichar(s3));
{$ENDIF}
if p.Ext1 = nil then if p.Ext1 = nil then
begin begin
p.Ext2 := Pointer(1); p.Ext2 := Pointer(1);
@ -284,11 +259,7 @@ begin
if (ph = nil) then break; if (ph = nil) then break;
if (ph.dllnamehash = h) and (ph.dllname = sname) then if (ph.dllnamehash = h) and (ph.dllname = sname) then
begin begin
{$IFDEF LINUX}
dlclose(ph^.dllhandle);
{$ELSE}
FreeLibrary(ph^.dllhandle); FreeLibrary(ph^.dllhandle);
{$ENDIF}
Caller.DeleteResource(ph); Caller.DeleteResource(ph);
dispose(ph); dispose(ph);
end; end;

155
Units/PascalScript/x64.inc
View File

@ -21,8 +21,8 @@ asm
fpc inserts an 20h emty space fpc inserts an 20h emty space
*) *)
push ebp push rbp
mov ebp,esp mov rbp,rsp
// call debugbreak // call debugbreak
push rcx // address push rcx // address
push rdx // _rax push rdx // _rax
@ -70,80 +70,92 @@ asm
ret ret
end; end;
{$ELSE} {$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
end;
procedure x64call( procedure x64call(
Address: Pointer; Address: Pointer;
out _RAX: IPointer; out _RAX: IPointer;
_RDI, _RSI, _RDX, _RCX, _R8, _R9: IPointer;
var _XMM0: Double; var Registers: TRegisters;
var _XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7: Double; aStack: Pointer; aItems: Integer; var _XMM0: Double); assembler; nostackframe;
aStack: Pointer; aItems: Integer); assembler; nostackframe;
asm asm
(* Registers: (* Registers:
RDI: Address RDI: Address
RSI: _RAX RSI: _RAX
RDX: _RDI RDX: Registers
RCX: _RSI RCX: aStack
R8: _RDX R8: aItems
R9: _RCX R9: XMM0
rbp-8 addr
rbp-16 _rax
rbp-24 _xmm0
*) *)
push ebp push rbp
mov ebp,esp mov rbp,rsp
push rdi // address push rdi // address
push rsi // _rax push rsi // _rax
push rdx // _rdi push r9 // xmm0
push rcx // _rsi mov rax, rdx
push r8 // _rdx
push r9 // _rcx
mov rcx, aItems
mov rdx, aStack
jmp @compareitems jmp @compareitems
@work: @work:
push [rdx] push [rcx]
dec rcx dec r8
sub rdx,8 sub rcx,8
@compareitems: @compareitems:
or rcx, rcx or r8, r8
jnz @work jnz @work
// copy registers // copy registers
movd xmm0,[_XMM0] movd xmm0,[rbp-24]
movd xmm1,_XMM1 movd xmm1,[rax+48]
movd xmm2,_XMM2 movd xmm2,[rax+56]
movd xmm3,_XMM3 movd xmm3,[rax+64]
movd xmm4,_XMM4 movd xmm4,[rax+72]
movd xmm5,_XMM5 movd xmm5,[rax+80]
movd xmm6,_XMM6 movd xmm6,[rax+88]
movd xmm7,_XMM7 movd xmm7,[rax+96]
mov RAX, [rbp-8] mov RDI, [rax]
mov RDI, [rbp-24] mov RSI, [rax+ 8]
mov RSI, [rbp-32] mov RDX, [rax+16]
mov RDX, [rbp-40] mov RCX, [rax+24]
mov RCX, [rbp-48] mov R8, [rax+32]
mov R8, _R8 mov R9, [rax+40]
mov R9, _R9
// weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux // weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux
//sub RSP, 32 //sub RSP, 32
mov rax, [rbp-8]
call RAX call RAX
// add RSP, 32 // undo the damage done earlier // add RSP, 32 // undo the damage done earlier
// copy result back // copy result back
mov RDX, [rbp-16] mov rsi, [rbp-16]
mov [RDX], RAX mov [rsi], RAX
movd [_XMM0],xmm0 mov rsi, [rbp-24]
movd [rsi],xmm0
pop r9 pop r9 // xmm0
pop r8 pop rsi // _rax
pop rdx pop rdi // address
pop rcx
pop rsi
pop rdi
leave leave
ret ret
end; end;
@ -152,13 +164,13 @@ end;
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean; function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
var var
Stack: array of Byte; Stack: array of Byte;
_RAX, _RAX: IPointer;
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
_RCX, _RDX, _R8, _R9: IPointer; _RCX, _RDX, _R8, _R9: IPointer;
_XMM0, _XMM1, _XMM2, _XMM3: Double; _XMM0, _XMM1, _XMM2, _XMM3: Double;
{$ELSE} {$ELSE}
_RDI, _RSI, _RDX, _RCX, _R8, _R9: IPointer; _XMM0: Double;
_XMM0, _XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7: Double; Registers: TRegisters;
RegUsageFloat: Byte; RegUsageFloat: Byte;
{$ENDIF} {$ENDIF}
RegUsage: Byte; RegUsage: Byte;
@ -201,12 +213,12 @@ var
var p: Pointer; var p: Pointer;
begin begin
case RegUsage of case RegUsage of
0: begin inc(RegUsage); _RDI:=Data; end; 0: begin inc(RegUsage); Registers._RDI:=Data; end;
1: begin inc(RegUsage); _RSI:=Data; end; 1: begin inc(RegUsage); Registers._RSI:=Data; end;
2: begin inc(RegUsage); _RDX:=Data; end; 2: begin inc(RegUsage); Registers._RDX:=Data; end;
3: begin inc(RegUsage); _RCX:=Data; end; 3: begin inc(RegUsage); Registers._RCX:=Data; end;
4: begin inc(RegUsage); _R8:=Data; end; 4: begin inc(RegUsage); Registers._R8:=Data; end;
5: begin inc(RegUsage); _R9:=Data; end; 5: begin inc(RegUsage); Registers._R9:=Data; end;
else begin else begin
SetLength(Stack, Length(Stack)+8); SetLength(Stack, Length(Stack)+8);
p := @Stack[LEngth(Stack)-8]; p := @Stack[LEngth(Stack)-8];
@ -251,13 +263,13 @@ var
begin begin
case RegUsageFloat of case RegUsageFloat of
0: begin inc(RegUsageFloat); _XMM0:=Data; end; 0: begin inc(RegUsageFloat); _XMM0:=Data; end;
1: begin inc(RegUsageFloat); _XMM1:=Data; end; 1: begin inc(RegUsageFloat); Registers._XMM1:=Data; end;
2: begin inc(RegUsageFloat); _XMM2:=Data; end; 2: begin inc(RegUsageFloat); Registers._XMM2:=Data; end;
3: begin inc(RegUsageFloat); _XMM3:=Data; end; 3: begin inc(RegUsageFloat); Registers._XMM3:=Data; end;
4: begin inc(RegUsageFloat); _XMM4:=Data; end; 4: begin inc(RegUsageFloat); Registers._XMM4:=Data; end;
5: begin inc(RegUsageFloat); _XMM5:=Data; end; 5: begin inc(RegUsageFloat); Registers._XMM5:=Data; end;
6: begin inc(RegUsageFloat); _XMM6:=Data; end; 6: begin inc(RegUsageFloat); Registers._XMM6:=Data; end;
7: begin inc(RegUsageFloat); _XMM7:=Data; end; 7: begin inc(RegUsageFloat); Registers._XMM7:=Data; end;
else begin else begin
SetLength(Stack, Length(Stack)+8); SetLength(Stack, Length(Stack)+8);
p := @Stack[LEngth(Stack)-8]; p := @Stack[LEngth(Stack)-8];
@ -413,14 +425,16 @@ begin
res.VarParam := true; res.VarParam := true;
try try
{$IFNDEF WINDOWS} {$IFNDEF WINDOWS}
_RSI := 0; (*_RSI := 0;
_RDI := 0; _RDI := 0;
_XMM4 := 0; _XMM4 := 0;
_XMM5 := 0; _XMM5 := 0;
_XMM6 := 0; _XMM6 := 0;
_XMM7 := 0; _XMM7 := 0;*)
FillChar(Registers, Sizeof(REgisters), 0);
_XMM0 := 0;
RegUsageFloat := 0; RegUsageFloat := 0;
{$ENDIF} {$ELSE}
_RCX := 0; _RCX := 0;
_RDX := 0; _RDX := 0;
_R8 := 0; _R8 := 0;
@ -429,10 +443,11 @@ begin
_XMM1 := 0; _XMM1 := 0;
_XMM2 := 0; _XMM2 := 0;
_XMM3 := 0; _XMM3 := 0;
{$ENDIF}
_RAX := 0;
RegUsage := 0; RegUsage := 0;
if assigned(_Self) then begin if assigned(_Self) then begin
RegUsage := 1; StoreReg(IPointer(_Self));
_RCX := IPointer(_Self);
end; end;
for I := 0 to Params.Count - 1 do for I := 0 to Params.Count - 1 do
begin begin
@ -454,7 +469,7 @@ begin
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8); x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
{$ELSE} {$ELSE}
x64call(Address, _RAX, _RDI, _RSI, _RDX, _RCX, _R8, _R9,_XMM0,_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7, pp, Length(Stack) div 8); x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
{$ENDIF} {$ENDIF}
case res^.aType.BaseType of case res^.aType.BaseType of
btSet: btSet:
@ -494,7 +509,7 @@ begin
{$IFDEF WINDOWS} {$IFDEF WINDOWS}
x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8); x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
{$ELSE} {$ELSE}
x64call(Address, _RAX, _RDI, _RSI, _RDX, _RCX, _R8, _R9,_XMM0,_XMM1, _XMM2, _XMM3, _XMM4, _XMM5, _XMM6, _XMM7, pp, Length(Stack) div 8); x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
{$ENDIF} {$ENDIF}
end; end;
Result := True; Result := True;