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