{$IFDEF DELPHI}
  {$DEFINE PS_RESBEFOREPARAMETERS}
  {$DEFINE x64_string_result_as_varparameter}
{$ENDIF}

{ implementation of x64 abi }
//procedure DebugBreak; external 'Kernel32.dll';
const
  EmptyPchar: array[0..0] of char = #0;
{$IFDEF FPC}
{$ASMMODE INTEL}
{$ENDIF}
{$IFDEF MSWINDOWS}{$DEFINE WINDOWS}{$ENDIF}

{$IFDEF WINDOWS}
type
  TRegisters = packed record
    _RCX,                  // 0
    _RDX,                  // 8
    _R8,                   // 16
    _R9: IPointer;         // 24
    _XMM1,                 // 32
    _XMM2,                 // 40
    _XMM3: Double;         // 48
    Stack: Pointer;        // 56
    Items: {$IFDEF FPC}PtrUInt{$ELSE}IntPtr{$ENDIF}; // 64
    SingleBits: Integer; // 72
    // @OpenSoldatPatch
    Patch_btProcPtr: Boolean;  // 76
  end;

// @OpenSoldatPatch
{$PUSH}
{$WARN 7104 OFF}
procedure x64call(
  Address: Pointer;
  out _RAX: IPointer;
  var _XMM0: Double;
  var Registers: TRegisters); assembler; {$IFDEF FPC}nostackframe;{$ENDIF}
asm
(* Registers:
    RCX: Address
    RDX: *_RAX
    R8:  * _XMM0
    R9: _REGISTERS
    fpc inserts an 20h empty space
*)
//{$IFDEF FPC}
  push rbp
  mov rbp,rsp
//{$ENDIF}
  push rcx  // address         ;rbp -8
  push rdx  // @_rax           ;rbp -16
  push r8   // @_xmm0          ;rbp -24
  push r9   // _registers      ;rbp -32

  mov rax, [rbp-32] //registers

  mov rcx, [rax+64] // items/count
  mov rdx, [rax+56] // stack
  jmp @compareitems
@work:
{$IFDEF FPC}
  push qword ptr [rdx]
{$ELSE}
  push [rdx]
{$ENDIF}
  dec rcx
  // @OpenSoldatPatch
  or rcx, rcx
  jnz @next
@Patch_RegisterEventPropertyHelper:
  cmp byte ptr [rax+76], 0  // Patch_btProcPtr
  jz @next
  push rbx
  lea rbx, [rsp+8]   // load address of previous pushed item
  mov [rax+8], rbx   // store the address to be invoked by call rax later
  pop rbx
@next:
  sub rdx,8
@compareitems:
  or rcx, rcx
  jnz @work

  // copy registers
  mov rcx, [rax+72] // single bits

  bt rcx, 1
  jnc @g1
  cvtsd2ss xmm1, [rax+32]
  jmp @g1e
  @g1:
  movsd xmm1, [rax+32]
  @g1e:


  bt rcx, 2
  jnc @g2
  cvtsd2ss xmm2, [rax+40]
  jmp @g2e
  @g2:
  movsd xmm2, [rax+40]
  @g2e:

  bt rcx, 3
  jnc @g3
  cvtsd2ss xmm3, [rax+48]
  jmp @g3e
  @g3:
  movsd xmm3, [rax+48]
  @g3e:



  // rbp-16: address of xmm0

  bt rcx, 0
  jnc @g0
  mov rdx, [rbp -24]
  cvtsd2ss xmm0, [rdx]
  jmp @g0e
  @g0:
  mov rdx, [rbp -24]
  movsd xmm0, [rdx]
  @g0e:

  // other registers
  mov rcx, [rax]
  mov rdx, [rax+8]
  mov r8, [rax+16]
  mov r9, [rax+24]


  mov RAX, [rbp-8]

  // weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in
  sub RSP, 32

  call RAX

  add RSP, 32 // undo the damage done earlier

  // copy result back
  mov RDX, [rbp-16]
  mov [RDX], RAX

  mov rax, [rbp-32] //registers

  // @OpenSoldatPatch
  bt dword ptr [rax+72], 8       // if atype.basetype  <> btSingle
  jnc @g5                        //
  cvtss2sd xmm1,xmm0             // convert single to double  into xmm1
  mov rdx,[rbp-24]               // @_xmm0  ;rbp -24
  // @OpenSoldatPatch
  movsd [rdx], xmm1              // save  xmm1 to param _xmm0
  jmp @g5e                       // exit if atype.basetype  = btSingle

  @g5:                           //else "if atype.basetype  = btSingle"
    mov rdx,[rbp-24]             // @_xmm0  ;rbp -24
    // @OpenSoldatPatch
    movsd [rdx], xmm0            // save  xmm1 to param _xmm0

  @g5e:


  leave
  ret
end;
// @OpenSoldatPatch
{$POP}
{$ELSE}
type
  TRegisters = packed record
    _RDI,               //  0
    _RSI,               //  8
    _RDX,               // 16
    _RCX,               // 24
    _R8,                // 32
    _R9: IPointer;      // 40
    _XMM1,              // 48
    _XMM2,              // 56
    _XMM3,              // 64
    _XMM4,              // 72
    _XMM5,              // 80
    _XMM6,              // 88
    _XMM7: Double;      // 96
    SingleBits: Integer; //104
    // @OpenSoldatPatch
    _ST0: Extended;     // 108
  end;

// @OpenSoldatPatch
{$PUSH}
{$WARN 7104 OFF}
procedure x64call(
  Address: Pointer;
  out _RAX: IPointer;

  var Registers: TRegisters;
  aStack: Pointer; aItems: Integer; var _XMM0: Double); assembler; nostackframe;


asm
(* Registers:
    RDI: Address
    RSI: _RAX
    RDX: Registers
    RCX: aStack
    R8:  aItems
    R9:  XMM0

    rbp-8    addr
    rbp-16   _rax
    rbp-24   _xmm0
    rbp-32   regs
*)
  push rbp
  mov rbp,rsp
  push rdi  // address
  push rsi  // _rax
  push r9   // xmm0
  push rdx
{$IFDEF PS_STACKALIGN}
  bt r8, 0
  jnc @skipjump
  sub rsp, 8
@skipjump:
{$ENDIF}
  mov rax, rdx
  jmp @compareitems
@work:
{$IFDEF FPC}
  push qword ptr [rcx]
{$ELSE}
  push [rcx]
{$ENDIF}
  dec r8
  sub rcx,8
@compareitems:
  or r8, r8
  jnz @work

  // copy registers
  // xmm0
  // @OpenSoldatPatch
  mov rdx,[rbp-24]
  bt dword ptr [rax+104], 0
  jnc @skipxmm0
  cvtsd2ss xmm0,[rdx]
  jmp @skipxmm0re
  @skipxmm0:
  movq xmm0,[rdx]            // move quadword to xmm0 from _XMM0
  @skipxmm0re:

  // xmm1
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 1
  jnc @skipxmm1
  cvtsd2ss xmm1,[rax+48]
  jmp @skipxmm1re
  @skipxmm1:
  movq xmm1,[rax+48]         // move quadword to xmm1 from Registers._XMM1
  @skipxmm1re:

  // xmm2
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 2
  jnc @skipxmm2
  cvtsd2ss xmm2,[rax+56]
  jmp @skipxmm2re
  @skipxmm2:
  movq xmm2,[rax+56]         // move quadword to xmm2 from Registers._XMM2
  @skipxmm2re:

  // xmm3
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 3
  jnc @skipxmm3
  cvtsd2ss xmm3,[rax+64]
  jmp @skipxmm3re
  @skipxmm3:
  movq xmm3,[rax+64]         // move quadword to xmm3 from Registers._XMM3
  @skipxmm3re:

  // xmm4
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 4
  jnc @skipxmm4
  cvtsd2ss xmm4,[rax+72]
  jmp @skipxmm4re
  @skipxmm4:
  movq xmm4,[rax+72]         // move quadword to xmm4 from Registers._XMM4
  @skipxmm4re:

  // xmm5
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 5
  jnc @skipxmm5
  cvtsd2ss xmm5,[rax+80]
  jmp @skipxmm5re
  @skipxmm5:
  movq xmm5,[rax+80]         // move quadword to xmm5 from Registers._XMM5
  @skipxmm5re:

  // xmm6
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 6
  jnc @skipxmm6
  cvtsd2ss xmm6,[rax+88]
  jmp @skipxmm6re
  @skipxmm6:
  movq xmm6,[rax+88]         // move quadword to xmm6 from Registers._XMM6
  @skipxmm6re:

  // xmm7
  // @OpenSoldatPatch
  bt dword ptr [rax+104], 7
  jnc @skipxmm7
  cvtsd2ss xmm7,[rax+96]
  jmp @skipxmm7re
  @skipxmm7:
  movq xmm7,[rax+96]         // move quadword to xmm7 from Registers._XMM7
  @skipxmm7re:


  mov RDI, [rax]
  mov RSI, [rax+ 8]
  mov RDX, [rax+16]
  mov RCX, [rax+24]
  mov R8,  [rax+32]
  mov R9,  [rax+40]

  // weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux
  //sub RSP, 32

  mov rax, [rbp-8]
  call RAX

//  add rsp, 8

  // add RSP, 32 // undo the damage done earlier

  // copy result back
  mov rsi, [rbp-16]           // _RAX parameter
  mov [rsi], RAX
  mov rsi, [rbp-24]           // _XMM0 parameter

  // xmm0 res
  // @OpenSoldatPatch
  mov rax, qword ptr [rbp-32] // Registers parameter
  bt dword ptr [rax+104], 8   // if atype.basetype  <> btSingle
  jnc @skipres                // then goto skipres else begin
  cvtss2sd xmm1,xmm0          // convert single to double  into xmm1
  movq [rsi],xmm1             // move quadword to _XMM0
  jmp @skipresre              // end
  @skipres:
  movq [rsi],xmm0             // move quadword to _XMM0
  @skipresre:

  // @OpenSoldatPatch
  // st0 res
  bt qword ptr [rax+104], 9  // if atype.basetype  <> btExtended
  jnc @skipextres            // then goto skipextres else begin
  fstp tbyte ptr [rax+108]   // pop real10 to Registers._ST0
  @skipextres:

  // @OpenSoldatPatch: For returning record results
  mov [rax+16], rdx
  movq [rax+48], xmm1

  pop rdx
  pop r9   // xmm0
  pop rsi  // _rax
  pop rdi  // address
  leave
  ret
end;
// @OpenSoldatPatch
{$POP}
{$ENDIF}

// @OpenSoldatPatch
{$IFNDEF WINDOWS}
// System V x86-64 storage class implementation.
// This is decently tested although there may still be edge cases missing.
// It does not support vector or complex types (neither does PascalScript in
// general). Also static arrays and sets probably don't work.
type
  PSVStorageClass = ^TSVStorageClass;
  TSVStorageClass = (SVNO_CLASS, SVSSE, SVINT, SVX87, SVMEM);

const
  MAX_CLASSES = 2;

type
  TStorageClasses = Array[0..MAX_CLASSES - 1] of TSVStorageClass;

// Get alignment of non-aggregate types.
function GetSimpleAlignment(AType: TPSTypeRec): Integer;
begin
  case AType.BaseType of
    btU8, btS8, btChar:
      Result := 1;
    btU16, btS16, {$IFNDEF PS_NOWIDESTRING}btWideChar{$ENDIF}:
      Result := 2;
    btU32, btS32, btSingle:
      Result := 4;
    btString, btArray, btPointer, btPChar, {$IFNDEF PS_NOINT64}btS64,{$ENDIF}
    {$IFNDEF PS_NOWIDESTRING}btWideString,{$ENDIF} btStaticArray, btSet,
    btCurrency, btClass, btInterface, btUnicodeString, btEnum, btExtClass,
    btDouble, btProcPtr, btNotificationVariant:
      Result := 8;
    btExtended:
      Result := 16;
  end;
end;

procedure ClassifyStorageInt(var Classes: TStorageClasses; AType: TPSTypeRec;
  var Alignment: Integer; Offset: Integer);
var
  i, SubAlignment: Integer;
  StartEightByte, EndEightByte: Integer;
  Rec: TPSTypeRec_Record;
  FieldClass: TSVStorageClass;
begin
  // Simple case
  if AType.BaseType <> btRecord then
  begin
    Alignment := GetSimpleAlignment(AType);

    case AType.BaseType of
      btSingle, btDouble:
        FieldClass := SVSSE;
      btU8, btS8, btU16, btS16, btU32, btS32, btString, btArray, btPointer,
      btPChar, {$IFNDEF PS_NOINT64}btS64,{$ENDIF} btChar,
      {$IFNDEF PS_NOWIDESTRING}btWideString, btWideChar,{$ENDIF} btProcPtr,
      btStaticArray, btVariant, btSet, btCurrency, btClass, btInterface,
      btNotificationVariant, btUnicodeString, btEnum, btExtClass:
        FieldClass := SVINT;
      btExtended:
        FieldClass := SVX87;
    end;

    if Offset mod Alignment <> 0 then
      FieldClass := SVMEM;

    StartEightByte := Offset div 8;
    // Alignment is the same as type size for non-aggregate types we support.
    EndEightByte := (Offset + Alignment - 1) div 8;

    for i := StartEightByte to EndEightByte do
    begin
      if i > High(Classes) then
        Break;

      if (FieldClass <> SVX87) and (Classes[i] = SVX87) then
        Classes[i] := SVMEM;
      if Ord(FieldClass) > Ord(Classes[i]) then
        Classes[i] := FieldClass;
    end;

    Exit;
  end;

  // Record case
  Rec := TPSTypeRec_Record(AType);

  Rec.CalcSize;
  if Rec.RealSize > 16 then
    Classes[0] := SVMEM;

  Alignment := 0;

  for i := 0 to Rec.FieldTypes.Count - 1 do
  begin
    ClassifyStorageInt(Classes, Rec.FieldTypes[i], SubAlignment,
      Offset + IPointer(Rec.RealFieldOffsets[i]));

    if SubAlignment > Alignment then
      Alignment := SubAlignment;
  end;

  for i := Low(Classes) to High(Classes) do
  begin
    if Classes[i] = SVMEM then
    begin
      Classes[0] := SVMEM;
      Break;
    end;
  end;
end;

procedure ClassifyStorage(var Classes: TStorageClasses; AType: TPSTypeRec;
  var Alignment: Integer);
var
  i: Integer;
begin
  for i := Low(Classes) to High(Classes) do
    Classes[i] := SVNO_CLASS;

  ClassifyStorageInt(Classes, AType, Alignment, 0);
end;

function ContainsManaged(AType: TPSTypeRec): Boolean;
var
  i: Integer;
  Rec: TPSTypeRec_Record;
begin
  if AType.BaseType in [btString, btWideString, btUnicodeString, btVariant] then
  begin
    Result := True;
    Exit;
  end
  else if AType.BaseType <> btRecord then
  begin
    Result := False;
    Exit;
  end;

  Rec := TPSTypeRec_Record(AType);
  for i := 0 to Rec.FieldTypes.Count - 1 do
    if ContainsManaged(Rec.FieldTypes[i]) then
      Exit;

  Result := False;
end;
{$ENDIF}

// @OpenSoldatPatch
{$PUSH}
{$WARN 5027 OFF}
function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
var
  Stack: array of Byte;
  _RAX: IPointer;
_XMM0: Double;
  Registers: TRegisters;
{$IFNDEF WINDOWS}
  RegUsageFloat: Byte;
  // @OpenSoldatPatch
  Alignment: Integer;
  StorageClasses: TStorageClasses;
  p: Pointer;
  ResultReg, ResultRegFloat: Integer;
  ResContainsManaged: Boolean;
{$ENDIF}
{$IFDEF FPC}
  IsConstructor,IsVirtualCons: Boolean;
{$ENDIF}
  RegUsage: Byte;
  CallData: TPSList;
  I: Integer;
  pp: ^Byte;

  procedure StoreStack(const aData; Len: Integer);
  var
    p: Pointer;
  begin
    SetLength(Stack, Length(Stack)+Len);
    p := @Stack[Length(Stack)-Len];
    Move(aData, p^, Len);

    // @OpenSoldatPatch
    if Length(Stack) mod 8 <> 0 then
      SetLength(Stack, Length(Stack)+ (8-(Length(Stack) mod 8)));
  end;

  function rp(p: PPSVariantIFC): PPSVariantIFC;
  begin
    if p = nil then
    begin
      result := nil;
      exit;
    end;
    if p.aType.BaseType = btPointer then
    begin
      p^.aType := Pointer(Pointer(IPointer(p^.dta) + PointerSize)^);
      p^.Dta := Pointer(p^.dta^);
    end;
    Result := p;
  end;
{$IFDEF WINDOWS}
  procedure StoreReg(data: IPointer);   overload;
  begin
    case RegUsage of
      0: begin inc(RegUsage); Registers._RCX:=Data; end;
      1: begin inc(RegUsage); Registers._RDX:=Data; end;
      2: begin inc(RegUsage); Registers._R8:=Data; end;
      3: begin inc(RegUsage); Registers._R9:=Data; end;
    else begin
      // @OpenSoldatPatch
      StoreStack(data, SizeOf(data));
    end;
    end;
  end;
  {$ELSE}
  procedure StoreReg(data: IPointer);   overload;
  begin
    case RegUsage of
      0: begin inc(RegUsage); Registers._RDI:=Data; end;
      1: begin inc(RegUsage); Registers._RSI:=Data; end;
      2: begin inc(RegUsage); Registers._RDX:=Data; end;
      3: begin inc(RegUsage); Registers._RCX:=Data; end;
      4: begin inc(RegUsage); Registers._R8:=Data; end;
      5: begin inc(RegUsage); Registers._R9:=Data; end;
    else begin
      // @OpenSoldatPatch
      StoreStack(data, SizeOf(data));
    end;
    end;
  end;
{$ENDIF}

{$IFDEF WINDOWS}
  procedure StoreReg(data: Double); overload;
  begin
    case RegUsage of
      0: begin inc(RegUsage); _XMM0:=Data; end;
      1: begin inc(RegUsage); Registers._XMM1:=Data; end;
      2: begin inc(RegUsage); Registers._XMM2:=Data; end;
      3: begin inc(RegUsage); Registers._XMM3:=Data; end;
    else begin
      // @OpenSoldatPatch
      StoreStack(data, SizeOf(data));
    end;
    end;
  end;
  procedure StoreReg(data: Single); overload;
  begin
    case RegUsage of
      0: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 1;_XMM0:=Data; end;
      1: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 2; Registers._XMM1:=Data; end;
      2: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 4;Registers._XMM2:=Data; end;
      3: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 8; Registers._XMM3:=Data; end;
    else begin
      // @OpenSoldatPatch
      StoreStack(data, SizeOf(data));
    end;
    end;
  end;
  {$ELSE}
  procedure StoreReg(data: Double); overload;
  begin
    case RegUsageFloat of
      0: begin inc(RegUsageFloat); _XMM0:=Data; end;
      1: begin inc(RegUsageFloat); Registers._XMM1:=Data; end;
      2: begin inc(RegUsageFloat); Registers._XMM2:=Data; end;
      3: begin inc(RegUsageFloat); Registers._XMM3:=Data; end;
      4: begin inc(RegUsageFloat); Registers._XMM4:=Data; end;
      5: begin inc(RegUsageFloat); Registers._XMM5:=Data; end;
      6: begin inc(RegUsageFloat); Registers._XMM6:=Data; end;
      7: begin inc(RegUsageFloat); Registers._XMM7:=Data; end;
    else begin
      // @OpenSoldatPatch
      StoreStack(data, SizeOf(data));
    end;
    end;
  end;
  procedure StoreReg(data: Single); overload;
  begin
    case RegUsageFloat of
      0: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 1; _XMM0:=Data; end;
      1: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 2; Registers._XMM1:=Data; end;
      2: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 4; Registers._XMM2:=Data; end;
      3: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 8; Registers._XMM3:=Data; end;
      4: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 16; Registers._XMM4:=Data; end;
      5: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 32; Registers._XMM5:=Data; end;
      6: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 64; Registers._XMM6:=Data; end;
      7: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 128; Registers._XMM7:=Data; end;
    else begin
      // @OpenSoldatPatch
      StoreStack(data, SizeOf(data));
    end;
    end;
  end;
  {$ENDIF}
  // @OpenSoldatPatch
  {$IFNDEF WINDOWS}
  procedure DoClassifyStorage(var Classes: TStorageClasses; AType: TPSTypeRec;
    var Alignment: Integer; RegUsageCheck, RegUsageFloatCheck: Integer);
  var
    i: Integer;
  begin
    ClassifyStorage(Classes, AType, Alignment);

    for i := Low(Classes) to High(Classes) do
    begin
      if Classes[i] = SVINT then
        Inc(RegUsageCheck);
      if Classes[i] = SVSSE then
        Inc(RegUsageFloatCheck);
    end;

    if (RegUsageCheck > 6) or (RegUsageFloatCheck > 8) then
      Classes[0] := SVMEM;
  end;
  {$ENDIF}
  function GetPtr(fVar: PPSVariantIFC): Boolean;
  var
    varPtr: Pointer;
    //UseReg: Boolean;
    //tempstr: tbtstring;
    p: Pointer;
    // @OpenSoldatPatch
    {$IFNDEF WINDOWS}
    ip: IPointer;
    i, Alignment: Integer;
    StorageClasses: TStorageClasses;
    {$ENDIF}
  begin
    Result := False;
    if FVar = nil then exit;
    if fVar.VarParam then
    begin
      case fvar.aType.BaseType of
        btArray:
          begin
            if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then
            begin
              p := CreateOpenArray(True, Self, FVar);
              if p = nil then exit;
              CallData.Add(p);
              StoreReg(IPointer(POpenArray(p)^.Data));
              StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
              Result := True;
              Exit;
            end else begin
              varptr := fvar.Dta;
//              Exit;
            end;
          end;
        btVariant,
        btSet,
        btStaticArray,
        btRecord,
        btInterface,
        btClass,
        {$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16,
        btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
        {$IFNDEF PS_NOINT64}, bts64{$ENDIF}:
          begin
            Varptr := fvar.Dta;
          end;
      else begin
          exit; //invalid type
        end;
      end; {case}

      StoreReg(IPointer(VarPtr));
    end else begin
//      UseReg := True;
      case fVar^.aType.BaseType of
        btSet:
          begin
            case TPSTypeRec_Set(fvar.aType).aByteSize of
              1: StoreReg(IPointer(byte(fvar.dta^)));
              2: StoreReg(IPointer(word(fvar.dta^)));
              3, 4: StoreReg(IPointer(cardinal(fvar.dta^)));
              5,6,7,8: StoreReg(IPointer(fVar.Dta^));
              else
                StoreReg(IPointer(fvar.Dta));
            end;
          end;
        btArray:
          begin
            if Copy(fvar^.aType.ExportName, 1, 10) = '!OPENARRAY' then
            begin
              p := CreateOpenArray(False, SElf, FVar);
              if p =nil then exit;
              CallData.Add(p);
              StoreReg(IPointer(POpenArray(p)^.Data));
              StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
              Result := True;
              exit;
            end else begin
            {$IFDEF FPC}
              StoreReg(IPointer(FVar.Dta));
            {$ELSE}
              StoreReg(IPointer(FVar.Dta^));
            {$ENDIF}
            end;
          end;
        btRecord:
          begin
            // @OpenSoldatPatch
            {$IFDEF WINDOWS}
            fvar^.aType.CalcSize;
            if fvar^.aType.RealSize in [1, 2, 4, 8] then
              StoreReg(IPointer(fvar.dta^))
            else
              StoreReg(IPointer(fVar.Dta));
            {$ELSE}
            fvar^.aType.CalcSize;
            DoClassifyStorage(StorageClasses, fVar.aType, Alignment, RegUsage, RegUsageFloat);
            if (StorageClasses[0] = SVMEM) or (StorageClasses[0] = SVX87) then
            begin
              // Because the records are packed, only align to 8...
              StoreStack(fvar.Dta^, fVar^.aType.RealSize);
            end
            else
            begin
              p := fVar.Dta;
              for i := Low(StorageClasses) to High(StorageClasses) do
              begin
                if StorageClasses[i] = SVINT then
                begin
                  StoreReg(IPointer(p^));
                  Inc(p, 8);
                end;
                if StorageClasses[i] = SVSSE then
                begin
                  StoreReg(Double(p^));
                  Inc(p, 8);
                end;
              end;
            end;
            {$ENDIF}
          end;
        btVariant
        , btStaticArray:
          begin
            StoreReg(IPointer(fVar.Dta));
          end;
        // @OpenSoldatPatch
        btDouble: {8 bytes} begin
            StoreReg(double(fvar.dta^));
          end;
        btExtended: begin
            {$IFDEF WINDOWS}
            StoreReg(double(fvar.dta^));
            {$ELSE}
            StoreStack(fvar.dta^, SizeOf(Extended));
            {$ENDIF}
          end;
        btCurrency: {8 bytes} begin
            StoreReg(IPointer(fvar.dta^));
          end;
        btSingle: {4 bytes} begin
            StoreReg(single(fvar.dta^));
          end;

        btChar,
        btU8,
        btS8: begin
            StoreReg(IPointer(byte(fVar^.dta^)));
          end;
        btWideChar,
        btu16, btS16: begin
            StoreReg(IPointer(word(fVar^.dta^)));
          end;
        btu32, bts32: begin
            StoreReg(IPointer(cardinal(fVar^.dta^)));
          end;
        btPchar:
          begin
            if pointer(fvar^.dta^) = nil then
              StoreReg(IPointer(@EmptyPchar))
            else
              StoreReg(IPointer(fvar^.dta^));
          end;
        btclass, btinterface, btString:
          begin
            StoreReg(IPointer(fvar^.dta^));
          end;
        btWideString: begin
            StoreReg(IPointer(fvar^.dta^));
          end;
        btUnicodeString: begin
            StoreReg(IPointer(fvar^.dta^));
          end;

        btProcPtr:
          begin
            // @OpenSoldatPatch
            {$IFNDEF WINDOWS}
            // Code pointer
            ip := IPointer(@MyAllMethodsHandler);
            StoreReg(ip);
            // Data pointer
            ip := IPointer(GetMethodInfoRec(Self, LongInt(FVar.Dta^)));
            StoreReg(ip);
            {$ELSE}
            GetMem(p, PointerSize2);
            TMethod(p^) := MKMethod(Self, Longint(FVar.Dta^));
            if Length(Stack) mod 16 <> 0 then
              SetLength(Stack, Length(Stack)+ (16-(Length(Stack) mod 16)));
            StoreStack(p^, Pointersize2);
            FreeMem(p);
            // @OpenSoldatPatch
            if RegUsage < 4 then
              Registers.Patch_btProcPtr := True;
            {$ENDIF}
          end;

        bts64:
          begin
            StoreReg(IPointer(int64(fvar^.dta^)));
        end;
      end; {case}
    end;
    Result := True;
  end;
begin
  // @OpenSoldatPatch
  {$IFDEF WINDOWS}
  Registers.Patch_btProcPtr := False;
  {$ELSE}
  for i := Low(StorageClasses) to High(StorageClasses) do
    StorageClasses[i] := SVNO_CLASS;
  {$ENDIF}
  {$IFDEF FPC}
  if (Integer(CallingConv) and 128) <> 0 then begin
    IsVirtualCons := true;
    CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 128);
  end else
    IsVirtualCons:= false;
  if (Integer(CallingConv) and 64) <> 0 then begin
    IsConstructor := true;
    CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
  end else
    IsConstructor := false;
  {$ENDIF}

  InnerfuseCall := False;
  if Address = nil then
    exit; // need address
  SetLength(Stack, 0);
  CallData := TPSList.Create;
  res := rp(res);
  if res <> nil then
    res.VarParam := true;
  try
    {$IFNDEF WINDOWS}
    (*_RSI := 0;
    _RDI := 0;
    _XMM4 := 0;
    _XMM5 := 0;
    _XMM6 := 0;
    _XMM7 := 0;*)
    RegUsageFloat := 0;
    {$ENDIF}
    _XMM0 := 0;
    FillChar(Registers, Sizeof(REgisters), 0);
    _RAX := 0;
    RegUsage := 0;

    {$IF DEFINED (fpc) and (fpc_version >= 3)} // FIX FOR FPC constructor calls
    if IsConstructor then begin
      if not GetPtr(rp(Params[0])) then exit; // this goes first
      DisposePPSVariantIFC(Params[0]);
      Params.Delete(0);
    end;
    {$ENDIF}

    if assigned(_Self) then begin
      StoreReg(IPointer(_Self));
    end;

    // @OpenSoldatPatch
    {$IFDEF PS_RESBEFOREPARAMETERS}
    if assigned(res) then begin
      case res^.aType.BaseType of
        {$IFDEF x64_string_result_as_varparameter}
        btstring, btWideString, btUnicodeString,
        {$ENDIF}
        btInterface, btArray, btVariant, btStaticArray:
          GetPtr(res);
        // @OpenSoldatPatch
        btRecord: begin
          {$IFNDEF WINDOWS}
          res^.aType.CalcSize;
          DoClassifyStorage(StorageClasses, res^.aType, Alignment, RegUsage, RegUsageFloat);
          ResContainsManaged := ContainsManaged(res^.aType);
          if (StorageClasses[0] = SVMEM) or ResContainsManaged then
            StoreReg(IPointer(res.dta));
          {$ELSE}
          res^.aType.CalcSize;
          if not (res^.aType.RealSize in [1, 2, 4, 8]) then
          begin
            if not GetPtr(res) then
              Exit;
          end;
          {$ENDIF}
        end;
        btSet:
          begin
            // @OpenSoldatPatch
            res.aType.CalcSize;
            if res.aType.RealSize > PointerSize then GetPtr(res);
          end;
      end;
    end;
    {$ENDIF}

    if assigned(res) and (res^.atype.basetype = btSingle) then begin
      Registers.Singlebits  := Registers.Singlebits or 256;
    end;

    for I := 0 to Params.Count - 1 do
    begin
      if not GetPtr(rp(Params[I])) then Exit;
    end;

    if assigned(res) then begin
      // @OpenSoldatPatch
      {$IFNDEF WINDOWS}
      if (res^.aType.BaseType = btExtended) or (StorageClasses[0] = SVX87) then
        Registers.SingleBits := Registers.SingleBits or 512;
      {$ENDIF}
      {$IFNDEF PS_RESBEFOREPARAMETERS}
      case res^.aType.BaseType of
        {$IFDEF x64_string_result_as_varparameter}
        btstring, btWideString, btUnicodeString,
        {$ENDIF}
        btInterface, btArray, btVariant, btStaticArray:
          GetPtr(res);
        //btRecord,
        btSet:
          begin
            // @OpenSoldatPatch
            res.aType.CalcSize;
            if res.aType.RealSize > PointerSize then GetPtr(res);
          end;
      end;
      {$ENDIF}
      {$IFDEF WINDOWS}
      if (length(Stack) mod 16) <> 0 then begin
        SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
      end;
      {$ENDIF}
      if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
      {$IFDEF WINDOWS}
      Registers.Stack := pp;
      Registers.Items := Length(Stack) div 8;
      x64call(Address, _RAX, _XMM0, Registers);
      {$ELSE}
      x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
      {$ENDIF}

      case res^.aType.BaseType of
        btRecord, btSet:
          begin
            // @OpenSoldatPatch
            {$IFNDEF WINDOWS}
            if StorageClasses[0] = SVX87 then
            begin
              PExtended(res.Dta)^ := Registers._ST0;
            end
            else if (StorageClasses[0] <> SVMEM) and (not ResContainsManaged) then
            begin
              ResultReg := 0;
              ResultRegFloat := 0;
              p := res.Dta;
              for i := Low(StorageClasses) to High(StorageClasses) do
              begin
                if StorageClasses[i] = SVINT then
                begin
                  if ResultReg = 0 then
                    PUint64(p)^ := _RAX
                  else if ResultReg = 1 then
                    PUint64(p)^ := Registers._RDX;

                  Inc(ResultReg);
                end;
                if StorageClasses[i] = SVSSE then
                begin
                  if ResultRegFloat = 0 then
                    PDouble(p)^ := _XMM0
                  else if ResultRegFloat = 1 then
                    PDouble(p)^ := Registers._XMM1;

                  Inc(ResultRegFloat);
                end;

                Inc(p, 8);
              end;
            end;
            {$ELSE}
            if (res.aType.BaseType = btRecord) and (res.aType.RealSize in [1, 2, 4, 8]) then
            begin
              IPointer(res.dta^) := _RAX;
            end else if res.aType.BaseType = btSet then
            begin
              case res.aType.RealSize of
                1: byte(res.Dta^) := _RAX;
                2: word(res.Dta^) := _RAX;
                3,
                4: Longint(res.Dta^) := _RAX;
                5,6,7,8: IPointer(res.dta^) := _RAX;
              end;
            end;
            {$ENDIF}
          end;
        btSingle:      tbtsingle(res.Dta^) := _XMM0;
        btDouble:      tbtdouble(res.Dta^) := _XMM0;
        // @OpenSoldatPatch
        {$IFNDEF WINDOWS}
        btExtended:    tbtextended(res.Dta^) := Registers._ST0;
        {$ELSE}
        btExtended:    tbtdouble(res.Dta^) := _XMM0;
        {$ENDIF}
        btchar,btU8, btS8:    tbtu8(res.dta^) := _RAX;
        btWideChar, btu16, bts16:  tbtu16(res.dta^) := _RAX;
        btClass : IPointer(res.dta^) := _RAX;
        btu32,bts32:   tbtu32(res.dta^) := _RAX;
        btPChar:       pansichar(res.dta^) := Pansichar(_RAX);
        bts64: tbts64(res.dta^) := Int64(_RAX);
        btCurrency:    tbts64(res.Dta^) := Int64(_RAX);
        btInterface,
        btVariant,
        {$IFDEF x64_string_result_as_varparameter}
        btWidestring,btUnicodestring, btstring ,
        {$ENDIF}
        btStaticArray, btArray:;
        {$IFNDEF x64_string_result_as_varparameter}
        btUnicodeString, btWideString, btstring:  Int64(res.dta^) := _RAX;
        {$ENDIF}
      else
        exit;
      end;
    end else begin
      {$IFDEF WINDOWS}
      if (length(Stack) mod 16) <> 0 then begin
        SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
      end;
      {$ENDIF}
        if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
        {$IFDEF WINDOWS}
        Registers.Stack := pp;
        Registers.Items := Length(Stack) div 8;
        x64call(Address, _RAX, _XMM0, Registers);
        {$ELSE}
       x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
        {$ENDIF}
    end;

    Result := True;
  finally
    for i := CallData.Count -1 downto 0 do
    begin
      pp := CallData[i];
      case pp^ of
        0: DestroyOpenArray(Self, Pointer(pp));
      end;
    end;
    CallData.Free;
  end;
end;
// @OpenSoldatPatch
{$POP}


