fpc: INVOKECALL support for arm/aarch64
This commit is contained in:
evgeny-k
parent
e42274928a
commit
957de21fe8
@ -19,7 +19,7 @@ begin
|
||||
else
|
||||
SysCalConv := ccReg;//to prevent warning "W1036 Variable might not have been initialized"
|
||||
end;
|
||||
|
||||
|
||||
if Assigned(_Self) then
|
||||
Args := Args + [TValue.From<Pointer>( _Self )];
|
||||
|
||||
@ -36,7 +36,7 @@ begin
|
||||
btU8, btS8, btU16, btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency,
|
||||
btUnicodeString
|
||||
{$IFNDEF PS_NOINT64}, bts64{$ENDIF}:
|
||||
Arg := TValue.From<Pointer>( Pointer(fvar.dta) );
|
||||
Arg := TValue.From<Pointer>( Pointer(fvar.dta) );
|
||||
else
|
||||
begin
|
||||
Exit;
|
||||
@ -51,19 +51,19 @@ begin
|
||||
btWidestring,
|
||||
btUnicodestring,
|
||||
{$ENDIF}
|
||||
btString: Arg := TValue.From(pstring(fvar.dta)^);
|
||||
btU8, btS8: Arg := TValue.From(pbyte(fvar.dta)^);
|
||||
btU16, BtS16: Arg := TValue.From(pword(fvar.dta)^);
|
||||
btU32, btS32: Arg := TValue.From(pCardinal(fvar.dta)^);
|
||||
{$IFNDEF PS_NOINT64}bts64:{$ENDIF} Arg := TValue.From(pint64(fvar.dta)^);
|
||||
btSingle: Arg := TValue.From(PSingle(fvar.dta)^);
|
||||
btDouble: Arg := TValue.From(PDouble(fvar.dta)^);
|
||||
btExtended: Arg := TValue.From(PExtended(fvar.dta)^);
|
||||
btPChar: Arg := TValue.From(ppchar(fvar.dta)^);
|
||||
btChar: Arg := TValue.From(pchar(fvar.dta)^);
|
||||
btClass: Arg := TValue.From(TObject(fvar.dta^));
|
||||
btRecord: Arg := TValue.From<Pointer>(fvar.dta);
|
||||
btStaticArray: Arg := TValue.From<Pointer>(fvar.dta);
|
||||
btString: Arg := TValue.From<AnsiString>(pstring(fvar.dta)^);
|
||||
btU8, btS8: Arg := TValue.From<Byte>(pbyte(fvar.dta)^);
|
||||
btU16, BtS16: Arg := TValue.From<Word>(pword(fvar.dta)^);
|
||||
btU32, btS32: Arg := TValue.From<Cardinal>(pCardinal(fvar.dta)^);
|
||||
{$IFNDEF PS_NOINT64}bts64:{$ENDIF} Arg := TValue.From<Int64>(pint64(fvar.dta)^);
|
||||
btSingle: Arg := TValue.From<Single>(PSingle(fvar.dta)^);
|
||||
btDouble: Arg := TValue.From<Double>(PDouble(fvar.dta)^);
|
||||
btExtended: Arg := TValue.From<Extended>(PExtended(fvar.dta)^);
|
||||
btPChar: Arg := TValue.From<PChar>(ppchar(fvar.dta)^);
|
||||
btChar: Arg := TValue.From<Char>(pchar(fvar.dta)^);
|
||||
btClass: Arg := TValue.From<TObject>(TObject(fvar.dta^));
|
||||
btRecord: Arg := TValue.From<Pointer>(fvar.dta);
|
||||
btStaticArray: Arg := TValue.From<Pointer>(fvar.dta);
|
||||
btArray:
|
||||
begin
|
||||
if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then
|
||||
@ -79,10 +79,10 @@ begin
|
||||
btSet:
|
||||
begin
|
||||
case TPSTypeRec_Set(fvar.aType).aByteSize of
|
||||
1: Arg := TValue.From(pbyte(fvar.dta)^);
|
||||
2: Arg := TValue.From(pWord(fvar.dta)^);
|
||||
1: Arg := TValue.From<Byte>(pbyte(fvar.dta)^);
|
||||
2: Arg := TValue.From<Word>(pWord(fvar.dta)^);
|
||||
3,
|
||||
4: Arg := TValue.From(pCardinal(fvar.dta)^);
|
||||
4: Arg := TValue.From<Cardinal>(pCardinal(fvar.dta)^);
|
||||
else
|
||||
Arg := TValue.From<Pointer>(fvar.dta);
|
||||
end;
|
||||
@ -116,8 +116,13 @@ begin
|
||||
btSingle: psingle(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Single),False,IsConstr).AsExtended);
|
||||
btDouble: pdouble(res.dta)^ := Double(Invoke(Address,Args,SysCalConv,TypeInfo(Double),False,IsConstr).AsExtended);
|
||||
btExtended: pextended(res.dta)^ := Extended(Invoke(Address,Args,SysCalConv,TypeInfo(Extended),False,IsConstr).AsExtended);
|
||||
{$IFDEF FPC}
|
||||
btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsOrdinal);
|
||||
btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsChar);
|
||||
{$ELSE}
|
||||
btPChar: ppchar(res.dta)^ := pchar(Invoke(Address,Args,SysCalConv,TypeInfo(PChar),False,IsConstr).AsType<PChar>());
|
||||
btChar: pchar(res.dta)^ := Char(Invoke(Address,Args,SysCalConv,TypeInfo(Char),False,IsConstr).AsType<Char>());
|
||||
{$ENDIF}
|
||||
btSet:
|
||||
begin
|
||||
case TPSTypeRec_Set(res.aType).aByteSize of
|
||||
@ -125,6 +130,7 @@ begin
|
||||
2: word(res.Dta^) := word(Invoke(Address,Args,SysCalConv,TypeInfo(Word),False,IsConstr).AsInteger);
|
||||
3,
|
||||
4: Longint(res.Dta^) := Cardinal(Invoke(Address,Args,SysCalConv,TypeInfo(Cardinal),False,IsConstr).AsInteger);
|
||||
{$IFNDEF FPC}
|
||||
else
|
||||
begin
|
||||
for RttiType in ctx.GetTypes do
|
||||
@ -135,17 +141,19 @@ begin
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
btClass:
|
||||
begin
|
||||
for RttiType in ctx.GetTypes do
|
||||
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then
|
||||
{$IFNDEF FPC}for RttiType in ctx.GetTypes do
|
||||
if (RttiType.Name.ToUpper.EndsWith(String(res.aType.FExportName))) and (RttiType.TypeKind = tkClass) then{$ENDIF}
|
||||
begin
|
||||
TObject(res.dta^) := Invoke(Address,Args,SysCalConv,RttiType.Handle,False,IsConstr).AsObject;
|
||||
Break;
|
||||
TObject(res.dta^) := Invoke(Address,Args,SysCalConv,{$IFDEF FPC}TypeInfo(TObject){$ELSE}RttiType.Handle{$ENDIF},False,IsConstr).AsObject;
|
||||
{$IFNDEF FPC}Break;{$ENDIF}
|
||||
end;
|
||||
end;
|
||||
{$IFNDEF FPC}
|
||||
btStaticArray:
|
||||
begin
|
||||
for RttiType in ctx.GetTypes do
|
||||
@ -177,6 +185,7 @@ begin
|
||||
Break;
|
||||
end;
|
||||
end;
|
||||
{$ENDIF}
|
||||
else
|
||||
// writeln(stderr, 'Result type not implemented!');
|
||||
Exit;
|
||||
|
||||
@ -1,15 +1,20 @@
|
||||
|
||||
{$IF (defined(cpuaarch64) or defined(cpuarm))}
|
||||
{$DEFINE USEINVOKECALL}
|
||||
{$IFEND}
|
||||
|
||||
|
||||
|
||||
{$DEFINE PS_HAVEVARIANT}
|
||||
{$DEFINE PS_DYNARRAY}
|
||||
{$ifndef mswindows}
|
||||
{$DEFINE PS_NOIDISPATCH}
|
||||
{$endif}
|
||||
{$endif}
|
||||
{$if (fpc_version>2) or ((fpc_version=2) and ((fpc_release=2) and (fpc_patch>=4)) or (fpc_release>2))}
|
||||
{$UNDEF FPC_OLD_FIX}
|
||||
{$DEFINE PS_STACKALIGN}
|
||||
{$UNDEF PS_FPCSTRINGWORKAROUND}
|
||||
{$DEFINE PS_RESBEFOREPARAMETERS}
|
||||
{$DEFINE x64_string_result_as_varparameter}
|
||||
{$DEFINE x64_string_result_as_varparameter}
|
||||
{$ifdef mswindows}
|
||||
{$if (fpc_version>2) or ((fpc_version=2) and (fpc_release>5))}
|
||||
{$DEFINE PS_FPC_HAS_COM}
|
||||
|
||||
@ -10,6 +10,7 @@ Copyright (C) 2000-2009 by Carlo Kok (ck@carlo-kok.com)
|
||||
interface
|
||||
uses
|
||||
{$IFNDEF FPC} {$IFDEF DELPHI2010UP} System.Rtti,{$ENDIF} {$ENDIF}
|
||||
{$IFDEF FPC}{$IFDEF USEINVOKECALL}Rtti,{$ENDIF}{$ENDIF}
|
||||
SysUtils, uPSUtils{$IFDEF DELPHI6UP}, variants{$ENDIF}
|
||||
{$IFNDEF PS_NOIDISPATCH}{$IFDEF DELPHI3UP}, ActiveX, Windows{$ELSE}, Ole2{$ENDIF}{$ENDIF};
|
||||
|
||||
@ -9866,6 +9867,11 @@ end;
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ELSE}
|
||||
|
||||
{$IFDEF USEINVOKECALL}
|
||||
{$include InvokeCall.inc}
|
||||
{$DEFINE _INVOKECALL_INC_}
|
||||
{$ELSE}
|
||||
{$IFDEF Delphi6UP}
|
||||
{$if defined(cpu86)}
|
||||
{$include x86.inc}
|
||||
@ -9881,6 +9887,7 @@ end;
|
||||
{$ELSE}
|
||||
{$include x86.inc}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
{$ENDIF}
|
||||
|
||||
type
|
||||
|
||||
Loading…
Reference in New Issue
Block a user