mirror of
https://github.com/moparisthebest/Simba
synced 2024-11-29 20:32:18 -05:00
843c57a8d8
git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@465 3f818213-9676-44b0-a9b4-5e4c4e03d09d
740 lines
25 KiB
PHP
740 lines
25 KiB
PHP
{ implementation of x86 abi }
|
|
{$ifdef FPC}
|
|
{$define PS_ARRAY_ON_STACK}
|
|
{$endif}
|
|
function RealFloatCall_Register(p: Pointer;
|
|
_EAX, _EDX, _ECX: Cardinal;
|
|
StackData: Pointer;
|
|
StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
|
|
): Extended; Stdcall; // make sure all things are on stack
|
|
var
|
|
E: Extended;
|
|
begin
|
|
asm
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
mov eax, stackdata
|
|
@@1:
|
|
mov edx, [eax]
|
|
push edx
|
|
sub eax, 4
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@1
|
|
@@2:
|
|
mov eax,_EAX
|
|
mov edx,_EDX
|
|
mov ecx,_ECX
|
|
call p
|
|
fstp tbyte ptr [e]
|
|
end;
|
|
Result := E;
|
|
end;
|
|
|
|
function RealFloatCall_Other(p: Pointer;
|
|
StackData: Pointer;
|
|
StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
|
|
): Extended; Stdcall; // make sure all things are on stack
|
|
var
|
|
E: Extended;
|
|
begin
|
|
asm
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
mov eax, stackdata
|
|
@@1:
|
|
mov edx, [eax]
|
|
push edx
|
|
sub eax, 4
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@1
|
|
@@2:
|
|
call p
|
|
fstp tbyte ptr [e]
|
|
end;
|
|
Result := E;
|
|
end;
|
|
|
|
function RealFloatCall_CDecl(p: Pointer;
|
|
StackData: Pointer;
|
|
StackDataLen: Longint // stack length are in 4 bytes. (so 1 = 4 bytes)
|
|
): Extended; Stdcall; // make sure all things are on stack
|
|
var
|
|
E: Extended;
|
|
begin
|
|
asm
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
mov eax, stackdata
|
|
@@1:
|
|
mov edx, [eax]
|
|
push edx
|
|
sub eax, 4
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@1
|
|
@@2:
|
|
call p
|
|
fstp tbyte ptr [e]
|
|
@@5:
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
@@6:
|
|
pop edx
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@6
|
|
end;
|
|
Result := E;
|
|
end;
|
|
|
|
function RealCall_Register(p: Pointer;
|
|
_EAX, _EDX, _ECX: Cardinal;
|
|
StackData: Pointer;
|
|
StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
|
|
ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; // make sure all things are on stack
|
|
var
|
|
r: Longint;
|
|
begin
|
|
asm
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
mov eax, stackdata
|
|
@@1:
|
|
mov edx, [eax]
|
|
push edx
|
|
sub eax, 4
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@1
|
|
@@2:
|
|
mov eax,_EAX
|
|
mov edx,_EDX
|
|
mov ecx,_ECX
|
|
call p
|
|
mov ecx, resultlength
|
|
cmp ecx, 0
|
|
je @@5
|
|
cmp ecx, 1
|
|
je @@3
|
|
cmp ecx, 2
|
|
je @@4
|
|
mov r, eax
|
|
jmp @@5
|
|
@@3:
|
|
xor ecx, ecx
|
|
mov cl, al
|
|
mov r, ecx
|
|
jmp @@5
|
|
@@4:
|
|
xor ecx, ecx
|
|
mov cx, ax
|
|
mov r, ecx
|
|
@@5:
|
|
mov ecx, resedx
|
|
jecxz @@6
|
|
mov [ecx], edx
|
|
@@6:
|
|
end;
|
|
Result := r;
|
|
end;
|
|
|
|
function RealCall_Other(p: Pointer;
|
|
StackData: Pointer;
|
|
StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
|
|
ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; // make sure all things are on stack
|
|
var
|
|
r: Longint;
|
|
begin
|
|
asm
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
mov eax, stackdata
|
|
@@1:
|
|
mov edx, [eax]
|
|
push edx
|
|
sub eax, 4
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@1
|
|
@@2:
|
|
call p
|
|
mov ecx, resultlength
|
|
cmp ecx, 0
|
|
je @@5
|
|
cmp ecx, 1
|
|
je @@3
|
|
cmp ecx, 2
|
|
je @@4
|
|
mov r, eax
|
|
jmp @@5
|
|
@@3:
|
|
xor ecx, ecx
|
|
mov cl, al
|
|
mov r, ecx
|
|
jmp @@5
|
|
@@4:
|
|
xor ecx, ecx
|
|
mov cx, ax
|
|
mov r, ecx
|
|
@@5:
|
|
mov ecx, resedx
|
|
jecxz @@6
|
|
mov [ecx], edx
|
|
@@6:
|
|
end;
|
|
Result := r;
|
|
end;
|
|
|
|
function RealCall_CDecl(p: Pointer;
|
|
StackData: Pointer;
|
|
StackDataLen: Longint; // stack length are in 4 bytes. (so 1 = 4 bytes)
|
|
ResultLength: Longint; ResEDX: Pointer): Longint; Stdcall; // make sure all things are on stack
|
|
var
|
|
r: Longint;
|
|
begin
|
|
asm
|
|
mov ecx, stackdatalen
|
|
jecxz @@2
|
|
mov eax, stackdata
|
|
@@1:
|
|
mov edx, [eax]
|
|
push edx
|
|
sub eax, 4
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@1
|
|
@@2:
|
|
call p
|
|
mov ecx, resultlength
|
|
cmp ecx, 0
|
|
je @@5
|
|
cmp ecx, 1
|
|
je @@3
|
|
cmp ecx, 2
|
|
je @@4
|
|
mov r, eax
|
|
jmp @@5
|
|
@@3:
|
|
xor ecx, ecx
|
|
mov cl, al
|
|
mov r, ecx
|
|
jmp @@5
|
|
@@4:
|
|
xor ecx, ecx
|
|
mov cx, ax
|
|
mov r, ecx
|
|
@@5:
|
|
mov ecx, stackdatalen
|
|
jecxz @@7
|
|
@@6:
|
|
pop eax
|
|
dec ecx
|
|
or ecx, ecx
|
|
jnz @@6
|
|
mov ecx, resedx
|
|
jecxz @@7
|
|
mov [ecx], edx
|
|
@@7:
|
|
end;
|
|
Result := r;
|
|
end;
|
|
|
|
const
|
|
EmptyPchar: array[0..0] of char = #0;
|
|
|
|
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
|
|
var
|
|
Stack: ansistring;
|
|
I: Longint;
|
|
RegUsage: Byte;
|
|
CallData: TPSList;
|
|
pp: ^Byte;
|
|
IsConstructor: Boolean;
|
|
|
|
EAX, EDX, ECX: Longint;
|
|
|
|
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) + 4)^);
|
|
p^.Dta := Pointer(p^.dta^);
|
|
end;
|
|
Result := p;
|
|
end;
|
|
|
|
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);
|
|
case RegUsage of
|
|
0: begin EAX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
|
1: begin EDX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
|
2: begin ECX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
|
else begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
|
Pointer((@Stack[1])^) := POpenArray(p)^.Data;
|
|
end;
|
|
end;
|
|
case RegUsage of
|
|
0: begin EAX := Longint(POpenArray(p)^.ItemCount - 1); Inc(RegUsage); end;
|
|
1: begin EDX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
|
2: begin ECX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
|
else begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
|
Longint((@Stack[1])^) := POpenArray(p)^.ItemCount -1;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
Exit;
|
|
end else begin
|
|
{$IFDEF PS_DYNARRAY}
|
|
varptr := fvar.Dta;
|
|
{$ELSE}
|
|
Exit;
|
|
{$ENDIF}
|
|
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}
|
|
case RegUsage of
|
|
0: begin EAX := Longint(VarPtr); Inc(RegUsage); end;
|
|
1: begin EDX := Longint(VarPtr); Inc(RegUsage); end;
|
|
2: begin ECX := Longint(VarPtr); Inc(RegUsage); end;
|
|
else begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
|
Pointer((@Stack[1])^) := VarPtr;
|
|
end;
|
|
end;
|
|
end else begin
|
|
UseReg := True;
|
|
case fVar^.aType.BaseType of
|
|
btSet:
|
|
begin
|
|
tempstr := StringOfChar(AnsiChar(#0),4);
|
|
case TPSTypeRec_Set(fvar.aType).aByteSize of
|
|
1: Byte((@tempstr[1])^) := byte(fvar.dta^);
|
|
2: word((@tempstr[1])^) := word(fvar.dta^);
|
|
3, 4: cardinal((@tempstr[1])^) := cardinal(fvar.dta^);
|
|
else
|
|
pointer((@tempstr[1])^) := 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);
|
|
case RegUsage of
|
|
0: begin EAX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
|
1: begin EDX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
|
2: begin ECX := Longint(POpenArray(p)^.Data); Inc(RegUsage); end;
|
|
else begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
|
Pointer((@Stack[1])^) := POpenArray(p)^.Data;
|
|
end;
|
|
end;
|
|
case RegUsage of
|
|
0: begin EAX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
|
1: begin EDX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
|
2: begin ECX := Longint(POpenArray(p)^.ItemCount -1); Inc(RegUsage); end;
|
|
else begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
|
Longint((@Stack[1])^) := POpenArray(p)^.ItemCount -1;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
exit;
|
|
end else begin
|
|
{$IFDEF PS_DYNARRAY}
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Pointer((@TempStr[1])^) := Pointer(fvar.Dta^);
|
|
{$IFDEF PS_ARRAY_ON_STACK}
|
|
UseReg := false;
|
|
{$ENDIF}
|
|
{$ELSE}
|
|
Exit;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
btVariant
|
|
, btStaticArray, btRecord:
|
|
begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Pointer((@TempStr[1])^) := Pointer(fvar.Dta);
|
|
end;
|
|
btDouble: {8 bytes} begin
|
|
TempStr := StringOfChar(AnsiChar(#0),8);
|
|
UseReg := False;
|
|
double((@TempStr[1])^) := double(fvar.dta^);
|
|
end;
|
|
btCurrency: {8 bytes} begin
|
|
TempStr := StringOfChar(AnsiChar(#0),8);
|
|
UseReg := False;
|
|
currency((@TempStr[1])^) := currency(fvar.dta^);
|
|
end;
|
|
btSingle: {4 bytes} begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);;
|
|
UseReg := False;
|
|
Single((@TempStr[1])^) := single(fvar.dta^);
|
|
end;
|
|
|
|
btExtended: {10 bytes} begin
|
|
UseReg := False;
|
|
TempStr:= StringOfChar(AnsiChar(#0),12);
|
|
Extended((@TempStr[1])^) := extended(fvar.dta^);
|
|
end;
|
|
btChar,
|
|
btU8,
|
|
btS8: begin
|
|
TempStr := tbtchar(fVar^.dta^) + tbtstring(StringOfChar(AnsiChar(#0),3));
|
|
end;
|
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}
|
|
btu16, btS16: begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Word((@TempStr[1])^) := word(fVar^.dta^);
|
|
end;
|
|
btu32, bts32: begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Longint((@TempStr[1])^) := Longint(fVar^.dta^);
|
|
end;
|
|
btPchar:
|
|
begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
if pointer(fvar^.dta^) = nil then
|
|
Pointer((@TempStr[1])^) := @EmptyPchar
|
|
else
|
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
|
end;
|
|
btclass, btinterface, btString:
|
|
begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
|
end;
|
|
{$IFNDEF PS_NOWIDESTRING}
|
|
btWideString: begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
|
end;
|
|
btUnicodeString: begin
|
|
TempStr := StringOfChar(AnsiChar(#0),4);
|
|
Pointer((@TempStr[1])^) := pointer(fvar^.dta^);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
btProcPtr:
|
|
begin
|
|
tempstr := StringOfChar(AnsiChar(#0),8);
|
|
TMethod((@TempStr[1])^) := MKMethod(Self, Longint(FVar.Dta^));
|
|
UseReg := false;
|
|
end;
|
|
|
|
{$IFNDEF PS_NOINT64}bts64:
|
|
begin
|
|
TempStr:= StringOfChar(AnsiChar(#0),8);
|
|
Int64((@TempStr[1])^) := int64(fvar^.dta^);
|
|
UseReg := False;
|
|
end;{$ENDIF}
|
|
end; {case}
|
|
if UseReg then
|
|
begin
|
|
case RegUsage of
|
|
0: begin EAX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
|
|
1: begin EDX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
|
|
2: begin ECX := Longint((@Tempstr[1])^); Inc(RegUsage); end;
|
|
else begin
|
|
{$IFDEF FPC_OLD_FIX}
|
|
if CallingConv = cdRegister then
|
|
Stack := Stack + TempStr
|
|
else
|
|
{$ENDIF}
|
|
Stack := TempStr + Stack;
|
|
end;
|
|
end;
|
|
end else begin
|
|
{$IFDEF FPC_OLD_FIX}
|
|
if CallingConv = cdRegister then
|
|
Stack := Stack + TempStr
|
|
else
|
|
{$ENDIF}
|
|
Stack := TempStr + Stack;
|
|
end;
|
|
end;
|
|
Result := True;
|
|
end;
|
|
begin
|
|
if (Integer(CallingConv) and 64) <> 0 then begin
|
|
IsConstructor := true;
|
|
CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
|
|
end else IsConstructor := false;
|
|
|
|
InnerfuseCall := False;
|
|
if Address = nil then
|
|
exit; // need address
|
|
Stack := '';
|
|
CallData := TPSList.Create;
|
|
res := rp(res);
|
|
if res <> nil then
|
|
res.VarParam := true;
|
|
try
|
|
case CallingConv of
|
|
cdRegister: begin
|
|
EAX := 0;
|
|
EDX := 0;
|
|
ECX := 0;
|
|
RegUsage := 0;
|
|
|
|
{$IFDEF FPC} // FIX FOR FPC constructor calls
|
|
if IsConstructor then begin
|
|
if not GetPtr(rp(Params[0])) then exit; // this goes first
|
|
RegUsage := 2;
|
|
EDX := Longint(_Self);
|
|
Params.Delete(0);
|
|
end else
|
|
{$ENDIF}
|
|
if assigned(_Self) then begin
|
|
RegUsage := 1;
|
|
EAX := Longint(_Self);
|
|
end;
|
|
|
|
for I := 0 to Params.Count - 1 do
|
|
begin
|
|
if not GetPtr(rp(Params[I])) then Exit;
|
|
end;
|
|
|
|
if assigned(res) then begin
|
|
case res^.aType.BaseType of
|
|
{$IFNDEF PS_NOWIDESTRING}btWideString, btUnicodeString, {$ENDIF}
|
|
btInterface, btArray, btrecord, {$IFNDEF PS_FPCSTRINGWORKAROUND}btstring, {$ENDIF}btVariant, btStaticArray: GetPtr(res);
|
|
btSet:
|
|
begin
|
|
if TPSTypeRec_Set(res.aType).aByteSize >4 then GetPtr(res);
|
|
end;
|
|
end;
|
|
case res^.aType.BaseType of
|
|
btSet:
|
|
begin
|
|
case TPSTypeRec_Set(res.aType).aByteSize of
|
|
1: byte(res.Dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
|
2: word(res.Dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
|
3,
|
|
4: Longint(res.Dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
|
else RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil)
|
|
end;
|
|
end;
|
|
btSingle: tbtsingle(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btDouble: tbtdouble(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btExtended: tbtextended(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btchar,btU8, btS8: tbtu8(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
|
btClass :
|
|
{$IFDEF FPC}
|
|
tbtu32(res.dta^) := RealCall_Register(Address, EDX, EAX, ECX,
|
|
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
|
|
{$ELSE}
|
|
tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX,
|
|
@Stack[Length(Stack) - 3], Length(Stack) div 4, 4, nil);
|
|
{$ENDIF}
|
|
|
|
btu32,bts32: tbtu32(res.dta^) := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
|
btPChar: pansichar(res.dta^) := Pansichar(RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
|
{$IFNDEF PS_NOINT64}bts64:
|
|
begin
|
|
EAX := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
|
tbts64(res.dta^) := Int64(Cardinal(EDX)) shl 32 or Cardinal(EAX);
|
|
end;
|
|
{$ENDIF}
|
|
btCurrency: tbtCurrency(res.Dta^) := RealFloatCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4) / 10000;
|
|
btInterface,
|
|
btVariant,
|
|
{$IFNDEF PS_NOWIDESTRING}btWidestring,btUnicodestring, {$ENDIF}
|
|
btStaticArray, btArray, btrecord{$IFNDEF PS_FPCSTRINGWORKAROUND}, btstring {$ENDIF}: RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
|
{$IFDEF PS_FPCSTRINGWORKAROUND}
|
|
btstring: begin
|
|
eax := RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
|
Longint(res.dta^) := eax;
|
|
end;
|
|
{$ENDIF}
|
|
else
|
|
exit;
|
|
end;
|
|
end else
|
|
RealCall_Register(Address, EAX, EDX, ECX, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
|
Result := True;
|
|
end;
|
|
cdPascal: begin
|
|
RegUsage := 3;
|
|
for I := 0 to Params.Count - 1 do begin
|
|
if not GetPtr(Params[i]) then Exit;
|
|
end;
|
|
if assigned(res) then begin
|
|
case res^.aType.BaseType of
|
|
{$IFNDEF PS_NOWIDESTRING}btWideString, btUnicodeString, {$ENDIF}btInterface, btArray, btrecord, btstring, btVariant: GetPtr(res);
|
|
end;
|
|
end;
|
|
if assigned(_Self) then begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) +Stack;
|
|
Pointer((@Stack[1])^) := _Self;
|
|
end;
|
|
if assigned(res) then begin
|
|
case res^.aType.BaseType of
|
|
btSingle: tbtsingle(res^.Dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btDouble: tbtdouble(res^.Dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btExtended: tbtextended(res^.Dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btChar, btU8, btS8: tbtu8(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.Dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
|
btClass, btu32, bts32: tbtu32(res^.Dta^):= RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
|
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
|
{$IFNDEF PS_NOINT64}bts64:
|
|
begin
|
|
EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
|
tbts64(res^.dta^) := Int64(EAX) shl 32 or EDX;
|
|
end;
|
|
{$ENDIF}
|
|
btVariant,
|
|
btInterface, btrecord, btstring: RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
|
else
|
|
exit;
|
|
end;
|
|
end else
|
|
RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
|
Result := True;
|
|
end;
|
|
cdSafeCall: begin
|
|
RegUsage := 3;
|
|
if assigned(res) then begin
|
|
GetPtr(res);
|
|
end;
|
|
for I := Params.Count - 1 downto 0 do begin
|
|
if not GetPtr(Params[i]) then Exit;
|
|
end;
|
|
if assigned(_Self) then begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) +Stack;
|
|
Pointer((@Stack[1])^) := _Self;
|
|
end;
|
|
OleCheck(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
|
Result := True;
|
|
end;
|
|
|
|
CdCdecl: begin
|
|
RegUsage := 3;
|
|
if assigned(_Self) then begin
|
|
Stack := StringOfChar(AnsiChar(#0),4);
|
|
Pointer((@Stack[1])^) := _Self;
|
|
end;
|
|
for I := Params.Count - 1 downto 0 do begin
|
|
if not GetPtr(Params[I]) then Exit;
|
|
end;
|
|
if assigned(res) then begin
|
|
case res^.aType.BaseType of
|
|
btSingle: tbtsingle(res^.dta^) := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btDouble: tbtdouble(res^.dta^) := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btExtended: tbtextended(res^.dta^) := RealFloatCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btCHar, btU8, btS8: tbtu8(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
|
btClass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
|
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
|
{$IFNDEF PS_NOINT64}bts64:
|
|
begin
|
|
EAX := RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
|
tbts64(res^.Dta^) := Int64(EAX) shl 32 or EDX;
|
|
end;
|
|
{$ENDIF}
|
|
btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF}
|
|
btInterface,
|
|
btArray, btrecord, btstring: begin GetPtr(res); RealCall_Cdecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); end;
|
|
else
|
|
exit;
|
|
end;
|
|
end else begin
|
|
RealCall_CDecl(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
CdStdCall: begin
|
|
RegUsage := 3;
|
|
for I := Params.Count - 1 downto 0 do begin
|
|
if not GetPtr(Params[I]) then exit;
|
|
end;
|
|
if assigned(_Self) then begin
|
|
Stack := StringOfChar(AnsiChar(#0),4) + Stack;
|
|
Pointer((@Stack[1])^) := _Self;
|
|
end;
|
|
if assigned(res) then begin
|
|
case res^.aType.BaseType of
|
|
btSingle: tbtsingle(res^.dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btDouble: tbtdouble(res^.dta^) := RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btExtended: tbtextended(res^.dta^):= RealFloatCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4);
|
|
btChar, btU8, btS8: tbtu8(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 1, nil);
|
|
{$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}btu16, bts16: tbtu16(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 2, nil);
|
|
btclass, btu32, bts32: tbtu32(res^.dta^) := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil);
|
|
btPChar: TBTSTRING(res^.dta^) := Pansichar(RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, nil));
|
|
{$IFNDEF PS_NOINT64}bts64:
|
|
begin
|
|
EAX := RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 4, @EDX);
|
|
tbts64(res^.dta^) := Int64(EAX) shl 32 or EDX;
|
|
end;
|
|
{$ENDIF}
|
|
btVariant, {$IFNDEF PS_NOWIDESTRING}btUnicodeString, btWideString, {$ENDIF}
|
|
btInterface, btArray, btrecord, btstring: begin GetPtr(res); RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil); end;
|
|
else
|
|
exit;
|
|
end;
|
|
end else begin
|
|
RealCall_Other(Address, @Stack[Length(Stack)-3], Length(Stack) div 4, 0, nil);
|
|
end;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
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;
|
|
|
|
|