466 lines
12 KiB
ObjectPascal
466 lines
12 KiB
ObjectPascal
|
// The code below is based on RTTI.pas Delphi XE5.
|
||
|
|
// Added extra parameter ByRefs.
|
||
|
|
|
||
|
|
unit PAXCOMP_ARM;
|
||
|
|
interface
|
||
|
|
uses
|
||
|
|
TypInfo, RTTI;
|
||
|
|
|
||
|
|
function Invoke(CodeAddress: Pointer;
|
||
|
|
const Args: TArray<TValue>;
|
||
|
|
const ByRefs: TArray<Boolean>;
|
||
|
|
CallingConvention: TCallConv;
|
||
|
|
AResultType: PTypeInfo;
|
||
|
|
IsStatic: Boolean;
|
||
|
|
IsConstructor: Boolean): TValue;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
function UseResultPointer(TypeInfo: PTypeInfo; IsConstructor: Boolean): Boolean;
|
||
|
|
begin
|
||
|
|
if TypeInfo = nil then
|
||
|
|
Exit(False);
|
||
|
|
|
||
|
|
case TypeInfo^.Kind of
|
||
|
|
{$IFDEF AUTOREFCOUNT}
|
||
|
|
tkClass:
|
||
|
|
Result := not IsConstructor;
|
||
|
|
{$ENDIF AUTOREFCOUNT}
|
||
|
|
tkInterface, tkMethod, tkDynArray, tkUString, tkLString, tkWString,
|
||
|
|
tkString, tkVariant:
|
||
|
|
Exit(True);
|
||
|
|
|
||
|
|
tkRecord:
|
||
|
|
case GetTypeData(TypeInfo)^.RecSize of
|
||
|
|
{$IF Defined(CPUX64)}
|
||
|
|
1, 2, 4: Result := False;
|
||
|
|
8: Result := IsManaged(TypeInfo);
|
||
|
|
{$ELSEIF Defined(CPUX86)}
|
||
|
|
|
||
|
|
1, 2: Result := False;
|
||
|
|
4: Result := IsManaged(TypeInfo);
|
||
|
|
{$ELSEIF Defined(CPUARM)}
|
||
|
|
|
||
|
|
|
||
|
|
1: Result := False;
|
||
|
|
{$ENDIF CPU}
|
||
|
|
else
|
||
|
|
Result := True;
|
||
|
|
end;
|
||
|
|
tkArray:
|
||
|
|
{$IF Defined(CPUX64)}
|
||
|
|
Result := not (GetTypeData(TypeInfo)^.ArrayData.Size in [1, 2, 4, 8]);
|
||
|
|
{$ELSEIF Defined(CPUX86) or Defined(CPUARM)}
|
||
|
|
|
||
|
|
Result := not (GetTypeData(TypeInfo)^.ArrayData.Size in [1, 2, 4]);
|
||
|
|
{$ENDIF CPU}
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function AllocReg(var Regs: UInt32): UInt32;
|
||
|
|
var
|
||
|
|
newRegs: UInt32;
|
||
|
|
begin
|
||
|
|
if Regs = 0 then
|
||
|
|
Exit(0);
|
||
|
|
newRegs := Regs and (Regs - 1); // clear lowest bit
|
||
|
|
Result := Regs and not newRegs; // reveal bit cleared
|
||
|
|
Regs := newRegs;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function Align4(Value: Integer): Integer;
|
||
|
|
begin
|
||
|
|
Result := (Value + 3) and not 3;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function PassByRef(TypeInfo: PTypeInfo; CC: TCallConv; IsConst: Boolean = False): Boolean;
|
||
|
|
begin
|
||
|
|
if TypeInfo = nil then
|
||
|
|
Exit(False);
|
||
|
|
case TypeInfo^.Kind of
|
||
|
|
tkArray:
|
||
|
|
Result := GetTypeData(TypeInfo)^.ArrayData.Size > SizeOf(Pointer);
|
||
|
|
{$IF Defined(CPUX86)}
|
||
|
|
tkRecord:
|
||
|
|
if (CC in [ccCdecl, ccStdCall, ccSafeCall]) and not IsConst then
|
||
|
|
Result := False
|
||
|
|
else
|
||
|
|
Result := GetTypeData(TypeInfo)^.RecSize > SizeOf(Pointer);
|
||
|
|
tkVariant: // like tkRecord, but hard-coded size
|
||
|
|
Result := IsConst or not (CC in [ccCdecl, ccStdCall, ccSafeCall]);
|
||
|
|
{$ELSEIF Defined(CPUX64)}
|
||
|
|
tkRecord:
|
||
|
|
Result := not (GetTypeData(TypeInfo)^.RecSize in [1,2,4,8]);
|
||
|
|
tkMethod,
|
||
|
|
tkVariant:
|
||
|
|
Result := True;
|
||
|
|
{$ELSEIF Defined(CPUARM)}
|
||
|
|
tkRecord:
|
||
|
|
Result := (CC = ccReg);
|
||
|
|
tkMethod,
|
||
|
|
tkVariant:
|
||
|
|
Result := True;
|
||
|
|
{$ENDIF CPUTYPE}
|
||
|
|
{$IFNDEF NEXTGEN}
|
||
|
|
tkString:
|
||
|
|
Result := GetTypeData(TypeInfo)^.MaxLength > SizeOf(Pointer);
|
||
|
|
{$ENDIF !NEXTGEN}
|
||
|
|
else
|
||
|
|
Result := False;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
type
|
||
|
|
PParamBlock = ^TParamBlock;
|
||
|
|
TParamBlock = record
|
||
|
|
RegCR : array[0..3] of Int32;
|
||
|
|
|
||
|
|
StackData: PByte;
|
||
|
|
StackDataSize: Integer;
|
||
|
|
|
||
|
|
case Integer of
|
||
|
|
0: ( RegD: array[0..7] of Double );
|
||
|
|
1: ( RegS: array[0..15] of Single );
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure RawInvoke(CodeAddress: Pointer; ParamBlock: PParamBlock);
|
||
|
|
external 'librtlhelper.a' name 'rtti_raw_invoke';
|
||
|
|
|
||
|
|
function Invoke(CodeAddress: Pointer;
|
||
|
|
const Args: TArray<TValue>;
|
||
|
|
const ByRefs: TArray<Boolean>;
|
||
|
|
CallingConvention: TCallConv;
|
||
|
|
AResultType: PTypeInfo;
|
||
|
|
IsStatic: Boolean;
|
||
|
|
IsConstructor: Boolean): TValue;
|
||
|
|
|
||
|
|
function CalcStackSize: Integer;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
FreeCR,
|
||
|
|
FreeVFP: Integer;
|
||
|
|
begin
|
||
|
|
// Estimate maximum stack usage, assuming everything goes
|
||
|
|
// on the stack with 4-byte alignment.
|
||
|
|
Result := SizeOf(Pointer); // for potential managed return-value
|
||
|
|
// FreeCR := 4; // Number of core registers. R0 - R3
|
||
|
|
FreeCR := 0; // Number of core registers. R0 - R3
|
||
|
|
FreeVFP := 0; // Number of VFP(FP) registers. Default is 0
|
||
|
|
{$IFDEF ANDROID}
|
||
|
|
if CallingConvention in [ccReg] then
|
||
|
|
FreeVFP := 8; // D0-D7
|
||
|
|
{$ENDIF ANDROID}
|
||
|
|
|
||
|
|
for i := 0 to Length(Args) - 1 do
|
||
|
|
if PassByRef(Args[i].TypeInfo, CallingConvention) or ByRefs[i] then
|
||
|
|
begin
|
||
|
|
if FreeCR > 0 then
|
||
|
|
Dec(FreeCR) // use core register.
|
||
|
|
else
|
||
|
|
Inc(Result, SizeOf(Pointer))
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if Args[i].Kind = tkFloat then
|
||
|
|
begin
|
||
|
|
if FreeVFP > 0 then // use VFP register.
|
||
|
|
Dec(FreeVFP)
|
||
|
|
else
|
||
|
|
Inc(Result, SizeOf(Double));
|
||
|
|
end
|
||
|
|
else if Args[i].Kind = tkInt64 then
|
||
|
|
begin
|
||
|
|
if FreeCR >= 2 then // use 2 core registers.
|
||
|
|
Dec(FreeCR, 2)
|
||
|
|
else if FreeCR = 1 then // use last register and stack
|
||
|
|
begin
|
||
|
|
FreeCR := 0;
|
||
|
|
Inc(Result, SizeOf(Int32));
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Inc(Result, SizeOf(Int64));
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if (Args[i].DataSize <= 4) and (FreeCR > 0) then
|
||
|
|
Dec(FreeCR)
|
||
|
|
else
|
||
|
|
Inc(Result, Align4(Args[i].DataSize));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
const
|
||
|
|
regNone = $00;
|
||
|
|
regCRAll = $0F;
|
||
|
|
regFPRAll = $FFFF;
|
||
|
|
|
||
|
|
var
|
||
|
|
stackData: array of byte;
|
||
|
|
block: TParamBlock;
|
||
|
|
top: PByte;
|
||
|
|
freeCRegs: UInt32; // 4-core registers (32bit)
|
||
|
|
freeFPRegs: UInt32; // 16-Single VFP registers (32bit)
|
||
|
|
// 8-Double VFP registers (64bit)
|
||
|
|
src: PByte;
|
||
|
|
|
||
|
|
// If RegFlag doesn't have any bit, -1 is returned.
|
||
|
|
function RegFlagToIndex(RegFlag: UInt32): Integer;
|
||
|
|
begin
|
||
|
|
Result := -1;
|
||
|
|
while (RegFlag <> 0) do
|
||
|
|
begin
|
||
|
|
inc(Result);
|
||
|
|
RegFlag := RegFlag shr 1;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function RegDoubleFlagToIndex(RegFlag: UInt32): Integer;
|
||
|
|
begin
|
||
|
|
Result := -1;
|
||
|
|
while (RegFlag <> 0) do
|
||
|
|
begin
|
||
|
|
inc(Result);
|
||
|
|
RegFlag := RegFlag shr 2;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function AllocDoubleReg: UInt32;
|
||
|
|
var
|
||
|
|
freeDoubleReg: Uint32;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
freeDoubleReg := freeFPRegs and $55555555; // remove odd FP registers.
|
||
|
|
// no free Double register.
|
||
|
|
if freeDoubleReg = 0 then Exit;
|
||
|
|
// get a free single register at even index.
|
||
|
|
Result := not(freeDoubleReg and (freeDoubleReg - 1)) and freeDoubleReg;
|
||
|
|
// Remove two Single registers from FreeFPRegs;
|
||
|
|
freeFPRegs := freeFPRegs and not( Result or Result shl 1);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IF not defined(IOS)}
|
||
|
|
function AllocEvenReg(var Regs: UInt32): UInt32;
|
||
|
|
begin
|
||
|
|
Result := AllocReg(Regs);
|
||
|
|
// If get a odd reg, alloc a reg again
|
||
|
|
// 0002 - R1
|
||
|
|
// 0008 - R3
|
||
|
|
if (Result and ($2 + $8) <> 0) then
|
||
|
|
Result := AllocReg(Regs);
|
||
|
|
end;
|
||
|
|
{$ENDIF !IOS}
|
||
|
|
|
||
|
|
procedure PutArg(const Arg: TValue);
|
||
|
|
var
|
||
|
|
dataSize: Integer;
|
||
|
|
reg,
|
||
|
|
regL, regH: UInt32;
|
||
|
|
L32, H32: UInt32;
|
||
|
|
U64: UInt64;
|
||
|
|
begin
|
||
|
|
dataSize := Arg.DataSize;
|
||
|
|
if (Arg.Kind = tkFloat) and (Arg.TypeData.FloatType in [ftSingle, ftDouble, ftExtended]) then
|
||
|
|
begin
|
||
|
|
if dataSize = 4 then // Single
|
||
|
|
begin
|
||
|
|
// First, allocate one single VFP register.
|
||
|
|
reg := AllocReg(freeFPRegs);
|
||
|
|
if reg <> 0 then
|
||
|
|
begin
|
||
|
|
Arg.ExtractRawData(@block.RegS[RegFlagToIndex(reg)]);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else if Arg.DataSize = 8 then // Double and Extended
|
||
|
|
begin
|
||
|
|
// First, allocate one Double VFP register.
|
||
|
|
reg := AllocDoubleReg;
|
||
|
|
if reg <> 0 then
|
||
|
|
begin
|
||
|
|
Arg.ExtractRawData(@block.RegD[RegDoubleFlagToIndex(reg)]);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else if (Arg.Kind = tkRecord) then
|
||
|
|
begin
|
||
|
|
src := Arg.GetReferenceToRawData;
|
||
|
|
while datasize > 0 do
|
||
|
|
begin
|
||
|
|
reg := AllocReg(freeCRegs);
|
||
|
|
if reg <> regNone then
|
||
|
|
begin
|
||
|
|
Move(src^, block.RegCR[RegFlagToIndex(reg)], 4);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
Move(src^, top^, 4);
|
||
|
|
//Inc(top, Align4(dataSize));
|
||
|
|
Inc(top, 4);
|
||
|
|
end;
|
||
|
|
Dec(dataSize, 4);
|
||
|
|
Inc(Src, 4);
|
||
|
|
end;
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if (dataSize in [1, 2, 4]) then
|
||
|
|
begin
|
||
|
|
reg := AllocReg(freeCRegs);
|
||
|
|
if reg <> regNone then
|
||
|
|
begin
|
||
|
|
Arg.ExtractRawDataNoCopy(@block.RegCR[RegFlagToIndex(reg)]);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
Arg.ExtractRawDataNoCopy(top);
|
||
|
|
Inc(top, Align4(dataSize));
|
||
|
|
end
|
||
|
|
else if (dataSize in [8]) then // 64bit data
|
||
|
|
begin
|
||
|
|
// Next, allocate two core register
|
||
|
|
{$IFDEF IOS}
|
||
|
|
regL := AllocReg(freeCRegs);
|
||
|
|
{$ELSE}
|
||
|
|
regL := AllocEvenReg(freeCRegs);
|
||
|
|
{$ENDIF}
|
||
|
|
regH := AllocReg(freeCRegs);
|
||
|
|
if (Arg.Kind = tkFloat) then
|
||
|
|
begin
|
||
|
|
case Arg.TypeData.FloatType of
|
||
|
|
ftSingle,
|
||
|
|
ftDouble,
|
||
|
|
ftExtended:
|
||
|
|
PDouble(@U64)^ := Arg.AsExtended;
|
||
|
|
ftComp,
|
||
|
|
ftCurr:
|
||
|
|
Arg.ExtractRawDataNoCopy(@U64);
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
U64 := Arg.AsUInt64;
|
||
|
|
L32 := U64 and $FFFFFFFF;
|
||
|
|
H32 := (U64 shr 32) and $FFFFFFFF;
|
||
|
|
if regL <> 0 then
|
||
|
|
begin
|
||
|
|
block.RegCR[ RegFlagToIndex(regL)] := L32;
|
||
|
|
if regH <> 0 then
|
||
|
|
block.RegCR[ RegFlagToIndex(regH)] := H32
|
||
|
|
else // regH = 0;
|
||
|
|
begin
|
||
|
|
PCardinal(top)^ := H32;
|
||
|
|
Inc(top, SizeOf(H32)); // 4
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else // if regL = 0, regH also 0.
|
||
|
|
begin
|
||
|
|
{$IF not defined(IOS)}
|
||
|
|
if ((NativeInt(top) - NativeInt(@stackData[0])) mod 8) <> 0 then
|
||
|
|
Inc(top, 4); // Set 8 byte align
|
||
|
|
{$ENDIF !IOS}
|
||
|
|
PCardinal(top)^ := L32;
|
||
|
|
Inc(top, SizeOf(L32)); // 4
|
||
|
|
PCardinal(top)^ := H32;
|
||
|
|
Inc(top, SizeOf(H32)); // 4
|
||
|
|
end;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
Assert(False, 'somethig wrong');
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure PutRefArg(const Loc: Pointer);
|
||
|
|
var
|
||
|
|
reg: UInt32;
|
||
|
|
begin
|
||
|
|
reg := AllocReg(freeCRegs);
|
||
|
|
if reg <> regNone then
|
||
|
|
begin
|
||
|
|
block.RegCR[ RegFlagToIndex(reg)] := UInt32(Loc);
|
||
|
|
Exit;
|
||
|
|
end;
|
||
|
|
PPointer(top)^ := Loc;
|
||
|
|
Inc(top, SizeOf(Pointer));
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
i : integer;
|
||
|
|
begin
|
||
|
|
FillChar(block, SizeOf(block), 0);
|
||
|
|
SetLength(stackData, CalcStackSize);
|
||
|
|
top := @stackData[0];
|
||
|
|
|
||
|
|
freeCRegs := regCRAll;
|
||
|
|
freeFPRegs := regNone;
|
||
|
|
{$IFDEF ANDROID}
|
||
|
|
if CallingConvention in [ccReg] then
|
||
|
|
freeFPRegs := regFPRAll;
|
||
|
|
{$ENDIF ANDROID}
|
||
|
|
|
||
|
|
if IsStatic then
|
||
|
|
begin
|
||
|
|
if (CallingConvention <> ccSafeCall) and UseResultPointer(AResultType, IsConstructor) then
|
||
|
|
begin
|
||
|
|
TValue.Make(nil, AResultType, Result);
|
||
|
|
PutRefArg(Result.GetReferenceToRawData);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if Length(Args) > 0 then
|
||
|
|
if PassByRef(Args[0].TypeInfo, CallingConvention) or ByRefs[0] then
|
||
|
|
PutRefArg(Args[0].GetReferenceToRawData)
|
||
|
|
else
|
||
|
|
PutArg(Args[0]);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin // not IsStatic / It class method
|
||
|
|
|
||
|
|
// Put result first.
|
||
|
|
if (CallingConvention <> ccSafeCall) and UseResultPointer(AResultType, IsConstructor) then
|
||
|
|
begin
|
||
|
|
TValue.Make(nil, AResultType, Result);
|
||
|
|
PutRefArg(Result.GetReferenceToRawData);
|
||
|
|
end;
|
||
|
|
|
||
|
|
// First arg is "self". place to 2nd.
|
||
|
|
if Length(Args) > 0 then
|
||
|
|
if PassByRef(Args[0].TypeInfo, CallingConvention) or ByRefs[0] then
|
||
|
|
PutRefArg(Args[0].GetReferenceToRawData)
|
||
|
|
else
|
||
|
|
PutArg(Args[0]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
for i := 1 to Length(Args) - 1 do
|
||
|
|
if PassByRef(Args[i].TypeInfo, CallingConvention) or ByRefs[i] then
|
||
|
|
PutRefArg(Args[i].GetReferenceToRawData)
|
||
|
|
else
|
||
|
|
PutArg(Args[i]);
|
||
|
|
|
||
|
|
if CallingConvention = ccSafeCall then
|
||
|
|
begin
|
||
|
|
TValue.Make(nil, AResultType, Result);
|
||
|
|
PutRefArg(Result.GetReferenceToRawData);
|
||
|
|
end;
|
||
|
|
|
||
|
|
block.StackData := @stackData[0];
|
||
|
|
block.StackDataSize := top - PByte(@stackData[0]);
|
||
|
|
|
||
|
|
RawInvoke(CodeAddress, @block);
|
||
|
|
|
||
|
|
if AResultType = nil then
|
||
|
|
Result := TValue.Empty
|
||
|
|
else if UseResultPointer(AResultType, IsConstructor) then
|
||
|
|
// do nothing
|
||
|
|
{$IFDEF ANDROID}
|
||
|
|
else if (CallingConvention = ccReg) and
|
||
|
|
(AResultType^.Kind = tkFloat) and
|
||
|
|
(AResultType.TypeData.FloatType in [ftSingle, ftDouble, ftExtended]) then
|
||
|
|
TValue.MakeWithoutCopy(@block.RegD[0], AResultType, Result)
|
||
|
|
{$ENDIF ANDROID}
|
||
|
|
else
|
||
|
|
TValue.Make(@block.RegCR[0], AResultType, Result);
|
||
|
|
end;
|
||
|
|
|
||
|
|
end.
|