[fpc-pascal] Listing the type (even as string) of the parameters and the return of a function

silvioprog silvioprog at gmail.com
Thu Nov 1 06:11:50 CET 2018


On Tue, Oct 9, 2018 at 5:56 PM Sven Barth via fpc-pascal <
fpc-pascal at 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
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-pascal/attachments/20181101/27c464b3/attachment.html>


More information about the fpc-pascal mailing list