1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-24 08:18:52 -05:00
Simba/Units/PascalScript/x86.inc
2010-03-12 18:10:10 +01:00

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;