On Tue, Oct 9, 2018 at 5:56 PM Sven Barth via fpc-pascal <
fpc-pascal@lists.freepascal.org> wrote:
> The main challenge is to find the time and motivation to implement the
> whole extended RTTI shenanigans. Though I hope that after my birthday this
> weekend I'll find the time to work on this as well as finish the support
> for dynamic packages.
>
Awesome.
Late happy birthday! ^^
Feel free to contribute here. A x64 SysV variant would be welcome as well.
>
I took a look at some System V ABI manuals to start a draft based on them,
adapting the assembly to the InvokeKernelWin64() signature idea. The draft
works fine for six or more arguments and returns the function value too,
but I need to check (probably next weekend) how to pass floating-point
values to the XMM registers (I'm looking for references/manuals about).
The "attachment A" is my first draft (improvements are welcome) for SysV,
and the "attachment B" is the original SystemInvoke() with just few
adjustments to handle the first six arguments in the six general use
registers and the rest on the stack.
Regards,
> Sven
>
Attachment A:
function InvokeKernelSysV(aArgsStackLen: PtrUInt; aArgsStack, aArgsReg:
Pointer; aFunc: CodePointer): PtrUInt; assembler; nostackframe;
asm
{ save the base pointer }
pushq %rbp
{ set new base pointer }
movq %rsp, %rbp
{ save callee-saved registers }
pushq %rbx
pushq %r12
pushq %r13
pushq %r14
pushq %r15
{ check if is six of less arguments, if so ... }
cmpq $0, %rdi
je .L2
{ iterates and push all extra arguments to the stack }
movq %rdi, %rax
.L1:
decq %rax
cmpq $0, %rax
movq (%rsi, %rax, 8), %rbx
pushq %rbx
jne .L1
{ ... skip the iteration above }
.L2:
{ get the stack and the function pointer }
movq %rdx, %rbx
movq %rcx, %rax
{ setup general purpose registers }
movq 0(%rbx), %rdi
movq 8(%rbx), %rsi
movq 16(%rbx), %rdx
movq 24(%rbx), %rcx
movq 32(%rbx), %r8
movq 40(%rbx), %r9
{ TODO: fill XMM0..XMM7 registers }
{ call the function }
callq *%rax
{ restore callee-saved registers }
popq %r15
popq %r14
popq %r13
popq %r12
popq %rbx
{ reset stack to base pointer }
movq %rbp, %rsp
{ restore the old base pointer }
popq %rbp
{ return to caller }
ret
end;
Attachment B:
procedure SystemInvoke(aCodeAddress: CodePointer; const aArgs:
TFunctionCallParameterArray; aCallConv: TCallConv;
aResultType: PTypeInfo; aResultValue: Pointer; aFlags:
TFunctionCallFlags);
type
PBoolean16 = ^Boolean16;
PBoolean32 = ^Boolean32;
PBoolean64 = ^Boolean64;
PByteBool = ^ByteBool;
PQWordBool = ^QWordBool;
var
stackarea: array of PtrUInt;
stackptr: Pointer;
regs: array[0..5] of PtrUInt; // six registers
i, regidx, stackidx: LongInt;
val: PtrUInt;
td: PTypeData;
retinparam: Boolean;
argcount, resreg: SizeInt;
begin
if Assigned(aResultType) and not Assigned(aResultValue) then
raise EInvocationError.Create(SErrInvokeResultTypeNoValue);
retinparam := False;
if Assigned(aResultType) then begin
case aResultType^.Kind of
tkSString,
tkAString,
tkUString,
tkWString,
tkInterface,
tkDynArray:
retinparam := True;
end;
end;
stackidx := 0;
regidx := 0;
argcount := Length(aArgs);
if retinparam then begin
if fcfStatic in aFlags then
resreg := 0
else
resreg := 1;
regs[resreg] := PtrUInt(aResultValue);
Inc(argcount);
end else
resreg := -1;
if argcount > 6 then
SetLength(stackarea, argcount - 6);
for i := 0 to High(aArgs) do begin
if pfArray in aArgs[i].Info.ParamFlags then
val := PtrUInt(aArgs[i].ValueRef)
else if aArgs[i].Info.ParamFlags * [pfOut, pfVar, pfConstRef] <> [] then
val := PtrUInt(aArgs[i].ValueRef)
else begin
td := GetTypeData(aArgs[i].Info.ParamType);
case aArgs[i].Info.ParamType^.Kind of
tkSString,
tkMethod:
val := PtrUInt(aArgs[i].ValueRef);
tkArray:
if td^.ArrayData.Size in [1, 2, 4, 8] then
val := PPtrUInt(aArgs[i].ValueRef)^
else
val := PtrUInt(aArgs[i].ValueRef);
tkRecord:
if td^.RecSize in [1, 2, 4, 8] then
val := PPtrUInt(aArgs[i].ValueRef)^
else
val := PtrUInt(aArgs[i].ValueRef);
{ ToDo: handle object like record? }
tkObject,
tkWString,
tkUString,
tkAString,
tkDynArray,
tkClass,
tkClassRef,
tkInterface,
tkInterfaceRaw,
tkProcVar,
tkPointer:
val := PPtrUInt(aArgs[i].ValueRef)^;
tkInt64,
tkQWord:
val := PInt64(aArgs[i].ValueRef)^;
tkSet: begin
case td^.OrdType of
otUByte: begin
case td^.SetSize of
0, 1:
val := PByte(aArgs[i].ValueRef)^;
2:
val := PWord(aArgs[i].ValueRef)^;
3:
val := PtrUInt(aArgs[i].ValueRef);
4:
val := PLongWord(aArgs[i].ValueRef)^;
5..7:
val := PtrUInt(aArgs[i].ValueRef);
8:
val := Int64(PQWord(aArgs[i].ValueRef)^);
else
val := PtrUInt(aArgs[i].ValueRef);
end;
end;
otUWord:
val := PWord(aArgs[i].ValueRef)^;
otULong:
val := PLongWord(aArgs[i].ValueRef)^;
end;
end;
tkEnumeration,
tkInteger: begin
case td^.OrdType of
otSByte: val := PShortInt(aArgs[i].ValueRef)^;
otUByte: val := PByte(aArgs[i].ValueRef)^;
otSWord: val := PSmallInt(aArgs[i].ValueRef)^;
otUWord: val := PWord(aArgs[i].ValueRef)^;
otSLong: val := PLongInt(aArgs[i].ValueRef)^;
otULong: val := PLongWord(aArgs[i].ValueRef)^;
end;
end;
tkBool: begin
case td^.OrdType of
otUByte: val := ShortInt(PBoolean(aArgs[i].ValueRef)^);
otUWord: val := Byte(PBoolean16(aArgs[i].ValueRef)^);
otULong: val := SmallInt(PBoolean32(aArgs[i].ValueRef)^);
otUQWord: val := QWord(PBoolean64(aArgs[i].ValueRef)^);
otSByte: val := Word(PByteBool(aArgs[i].ValueRef)^);
otSWord: val := LongInt(PWordBool(aArgs[i].ValueRef)^);
otSLong: val := LongWord(PLongBool(aArgs[i].ValueRef)^);
otSQWord: val := Int64(PQWordBool(aArgs[i].ValueRef)^);
end;
end;
tkFloat: begin
case td^.FloatType of
ftCurr : val := PInt64(PCurrency(aArgs[i].ValueRef))^;
ftSingle : val := PInt64(PSingle(aArgs[i].ValueRef))^;
ftDouble : val := PInt64(PDouble(aArgs[i].ValueRef))^;
ftExtended: val := PInt64(PExtended(aArgs[i].ValueRef))^;
ftComp : val := PInt64(PComp(aArgs[i].ValueRef))^;
end;
end;
else
raise EInvocationError.CreateFmt(SErrFailedToConvertArg, [i,
aArgs[i].Info.ParamType^.Name]);
end;
end;
if regidx = resreg then
Inc(regidx);
if regidx < 6 then begin
regs[regidx] := val;
Inc(regidx);
end else begin
stackarea[stackidx] := val;
Inc(stackidx);
end;
end;
if stackidx > 0 then
stackptr := @stackarea[0]
else
stackptr := Nil;
val := InvokeKernelSysV(stackidx { just count }, stackptr, @regs[0],
aCodeAddress);
if Assigned(aResultType) and not retinparam then begin
PPtrUInt(aResultValue)^ := val;
end;
end;
--
Silvio Clécio
_______________________________________________
fpc-pascal maillist - fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal
