Hi.

First, thanks for the great work in the invoke.inc for win64! ☺

So, consider the following example:

uses RTTI;
type
  TFoo = class
  public
    function Bar(const A: string; B: Integer): string;
  end;
function TFoo.Bar(const A: string; B: Integer): string;
begin
end;
var
  m: TRttiMethod;
  p: TRttiParameter;
begin
  m := TRttiContext.Create.GetType(TFoo.ClassInfo).GetMethod('Bar');
  Writeln('m: ', m.ReturnType.ToString);
  for p in m.GetParameters do
    Writeln(' p: ', p.ParamType.ToString);
end.

in Delphi, it returns:

m: string
p: string
p: Integer

in the current stage of RTTI or TypInfo, is there any way to retrieve the type (even as string) of the parameters and the return of a function passing its name as string and only the vtypeinfo of the instance of showed in the above example?

Thanks in advance!

silvioprog schrieb am Mo., 8. Okt. 2018, 10:11:

Short answer: No.

Long answer: No. The extended RTTI required for that is currently only generated for interfaces with $M+ set.

Regards,
Sven

On Mon, Oct 8, 2018 at 6:21 AM Sven Barth via fpc-pascal <

Hi Sven, thanks for replying.

What are the challenges to implement this feature? (Besides changes in the current ABI, new types in the typinfo etc.)

I'm busy developing a library for the company, but, after that, I would like to contribute the assembly on invoke.inc for x86/ARM (32-bit only).

silvioprog schrieb am Di., 9. Okt. 2018, 19:56:

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.

I'm busy developing a library for the company, but, after that, I would like to contribute the assembly on invoke.inc for x86/ARM (32-bit only).

Feel free to contribute here. A x64 SysV variant would be welcome as well.

Regards,
Sven

On Tue, Oct 9, 2018 at 5:56 PM Sven Barth via fpc-pascal <

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;

On Thu, Nov 1, 2018 at 2:11 AM silvioprog wrote:
[...]

Finally, I found a awesome material to study: the GCC's X86-64 assembly for compiler writers. And after some successful tests, I concluded that:

- floating-point types with size 8 or less (double, single etc.) must be set in XMM registers aligned in 8;
- floating-point types larger than 8 (extended) must be pushed to the stack aligned in 10.

This is a small example to check it (environment used in the tests: Lazarus 2.1.0 r59363 FPC 3.1.1 x86_64-linux-gtk2):

===
program project1;
{$MODE DELPHI}
{$MACRO ON}
//{$DEFINE USE_EXTENDED}
{$IFDEF USE_EXTENDED}
 {$DEFINE FLOAT_TYPE := extended} // size 10
{$ELSE}
 {$DEFINE FLOAT_TYPE := double} // size 8
{$ENDIF}
uses sysutils;
procedure test(const a, b: FLOAT_TYPE);
begin
  writeln(a:0:2, ' - ', b:0:2);
end;

procedure call_test(arr: pointer; f: codepointer); 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

{$IFDEF USE_EXTENDED}
leaq 0(%rdi), %rdx
movq (%rdx), %rax
movq %rax, (%rsp)
movq 0x8(%rdx), %ax
movq %ax, 0x8(%rsp)

leaq 10(%rdi), %rax
movq (%rax), %rdx
movq %rdx, 0x10(%rsp)
movq 0x8(%rax), %ax
movq %ax, 0x18(%rsp)
{$ELSE}
movq 0(%rdi), %xmm0
movq 8(%rdi), %xmm1
{$ENDIF}

{ call the function }
callq *%rsi

{ 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 }
retq
end;

var
  arr: array of FLOAT_TYPE;
begin
  Writeln(IntToStr(SizeOf(FLOAT_TYPE)));
{$PUSH}{$WARN 5090 OFF}
  setlength(arr, 2);
{$POP}
  arr[0] := 12.34;
  arr[1] := 45.67;
  call_test(@arr[0], @test);
end.
===

and the results was:

//{$DEFINE USE_EXTENDED}:

===
...
8
12.34 - 45.67
===

{$DEFINE USE_EXTENDED}:

===
...
10
12.34 - 45.67
===

I'm going to clone the Free Pascal repository from Github to work on this feature (sysv ABI for Linux 64 for now). After some functional code I'll send it as patch to the Mantis issues. I'm very interested in rtti.invoke() support on Linux/ARM and Win32. :-)

(P.S.: Could you check the issue #34496? I'm not sure if saving the base pointer is best way to solve the problem, but at least fixed the AV for extended types)