1{ implementation of x64 abi }
2//procedure DebugBreak; external 'Kernel32.dll';
3const
4  EmptyPchar: array[0..0] of char = #0;
5{$IFDEF FPC}
6{$ASMMODE INTEL}
7{$ENDIF}
8{$IFDEF MSWINDOWS}{$DEFINE WINDOWS}{$ENDIF}
9
10{$IFDEF WINDOWS}
11type
12  TRegisters = packed record
13    _RCX,                  // 0
14    _RDX,                  // 8
15    _R8,                   // 16
16    _R9: IPointer;         // 24
17    _XMM1,                 // 32
18    _XMM2,                 // 40
19    _XMM3: Double;         // 48
20    Stack: Pointer;        // 56
21    Items: {$IFDEF FPC}PtrUInt{$ELSE}IntPtr{$ENDIF}; // 64
22    SingleBits: Integer; // 72
23  end;
24
25procedure x64call(
26  Address: Pointer;
27  out _RAX: IPointer;
28  var _XMM0: Double;
29  var Registers: TRegisters); assembler; {$IFDEF FPC}nostackframe;{$ENDIF}
30asm
31(* Registers:
32    RCX: Address
33    RDX: *_RAX
34    R8:  * _XMM0
35    R9: _REGISTERS
36    fpc inserts an 20h empty space
37*)
38//{$IFDEF FPC}
39  push rbp
40  mov rbp,rsp
41//{$ENDIF}
42  push rcx  // address         ;rbp -8
43  push rdx  // @_rax           ;rbp -16
44  push r8   // @_xmm0          ;rbp -24
45  push r9   // _registers      ;rbp -32
46
47  mov rax, [rbp-32] //registers
48
49  mov rcx, [rax+64] // items/count
50  mov rdx, [rax+56] // stack
51  jmp @compareitems
52@work:
53{$IFDEF FPC}
54  push qword ptr [rdx]
55{$ELSE}
56  push [rdx]
57{$ENDIF}
58  dec rcx
59  sub rdx,8
60@compareitems:
61  or rcx, rcx
62  jnz @work
63
64  // copy registers
65  mov rcx, [rax+72] // single bits
66
67  bt rcx, 1
68  jnc @g1
69  cvtsd2ss xmm1, [rax+32]
70  jmp @g1e
71  @g1:
72  movsd xmm1, [rax+32]
73  @g1e:
74
75
76  bt rcx, 2
77  jnc @g2
78  cvtsd2ss xmm2, [rax+40]
79  jmp @g2e
80  @g2:
81  movsd xmm2, [rax+40]
82  @g2e:
83
84  bt rcx, 3
85  jnc @g3
86  cvtsd2ss xmm3, [rax+48]
87  jmp @g3e
88  @g3:
89  movsd xmm3, [rax+48]
90  @g3e:
91
92
93
94  // rbp-16: address of xmm0
95
96  bt rcx, 0
97  jnc @g0
98  mov rdx, [rbp -24]
99  cvtsd2ss xmm0, [rdx]
100  jmp @g0e
101  @g0:
102  mov rdx, [rbp -24]
103  movsd xmm0, [rdx]
104  @g0e:
105
106  // other registers
107  mov rcx, [rax]
108  mov rdx, [rax+8]
109  mov r8, [rax+16]
110  mov r9, [rax+24]
111
112
113  mov RAX, [rbp-8]
114
115  // weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in
116  sub RSP, 32
117
118  call RAX
119
120  add RSP, 32 // undo the damage done earlier
121
122  // copy result back
123  mov RDX, [rbp-16]
124  mov [RDX], RAX
125
126  mov rax, [rbp-32] //registers
127
128  bt [rax+72], 8                 // if atype.basetype  <> btSingle
129  jnc @g5                        //
130  cvtss2sd xmm1,xmm0             // convert single to double  into xmm1
131  mov rdx,[rbp-24]               // @_xmm0  ;rbp -24
132  movsd qword ptr [rdx], xmm1    // save  xmm1 to param _xmm0
133  jmp @g5e                       // exit if atype.basetype  = btSingle
134
135  @g5:                           //else "if atype.basetype  = btSingle"
136    mov rdx,[rbp-24]             // @_xmm0  ;rbp -24
137    movsd qword ptr [rdx], xmm0  // save  xmm1 to param _xmm0
138
139  @g5e:
140
141
142  leave
143  ret
144end;
145{$ELSE}
146type
147  TRegisters = packed record
148    _RDI,               //  0
149    _RSI,               //  8
150    _RDX,               // 16
151    _RCX,               // 24
152    _R8,                // 32
153    _R9: IPointer;      // 40
154    _XMM1,              // 48
155    _XMM2,              // 56
156    _XMM3,              // 64
157    _XMM4,              // 72
158    _XMM5,              // 80
159    _XMM6,              // 88
160    _XMM7: Double;      // 96
161    SingleBits: Integer; //104
162  end;
163
164procedure x64call(
165  Address: Pointer;
166  out _RAX: IPointer;
167
168  var Registers: TRegisters;
169  aStack: Pointer; aItems: Integer; var _XMM0: Double); assembler; nostackframe;
170
171
172asm
173(* Registers:
174    RDI: Address
175    RSI: _RAX
176    RDX: Registers
177    RCX: aStack
178    R8:  aItems
179    R9:  XMM0
180
181    rbp-8    addr
182    rbp-16   _rax
183    rbp-24   _xmm0
184    rbp-32   regs
185*)
186  push rbp
187  mov rbp,rsp
188  push rdi  // address
189  push rsi  // _rax
190  push r9   // xmm0
191  push rdx
192{$IFDEF PS_STACKALIGN}
193  bt r8, 0
194  jnc @skipjump
195  sub rsp, 8
196@skipjump:
197{$ENDIF}
198  mov rax, rdx
199  jmp @compareitems
200@work:
201{$IFDEF FPC}
202  push qword ptr [rcx]
203{$ELSE}
204  push [rcx]
205{$ENDIF}
206  dec r8
207  sub rcx,8
208@compareitems:
209  or r8, r8
210  jnz @work
211
212  // copy registers
213  // xmm0
214  mov rdx,[rbp-24]
215  bt [rax+104], 0
216  jnc @skipxmm0
217  cvtsd2ss xmm0,[rdx]
218  jmp @skipxmm0re
219  @skipxmm0:
220  movq xmm0,[rdx]            // move quadword to xmm0 from _XMM0
221  @skipxmm0re:
222
223  // xmm1
224  bt [rax+104], 1
225  jnc @skipxmm1
226  cvtsd2ss xmm1,[rax+48]
227  jmp @skipxmm1re
228  @skipxmm1:
229  movq xmm1,[rax+48]         // move quadword to xmm1 from Registers._XMM1
230  @skipxmm1re:
231
232  // xmm2
233  bt [rax+104], 2
234  jnc @skipxmm2
235  cvtsd2ss xmm2,[rax+56]
236  jmp @skipxmm2re
237  @skipxmm2:
238  movq xmm2,[rax+56]         // move quadword to xmm2 from Registers._XMM2
239  @skipxmm2re:
240
241  // xmm3
242  bt [rax+104], 3
243  jnc @skipxmm3
244  cvtsd2ss xmm3,[rax+64]
245  jmp @skipxmm3re
246  @skipxmm3:
247  movq xmm3,[rax+64]         // move quadword to xmm3 from Registers._XMM3
248  @skipxmm3re:
249
250  // xmm4
251  bt [rax+104], 4
252  jnc @skipxmm4
253  cvtsd2ss xmm4,[rax+72]
254  jmp @skipxmm4re
255  @skipxmm4:
256  movq xmm4,[rax+72]         // move quadword to xmm4 from Registers._XMM4
257  @skipxmm4re:
258
259  // xmm5
260  bt [rax+104], 5
261  jnc @skipxmm5
262  cvtsd2ss xmm5,[rax+80]
263  jmp @skipxmm5re
264  @skipxmm5:
265  movq xmm5,[rax+80]         // move quadword to xmm5 from Registers._XMM5
266  @skipxmm5re:
267
268  // xmm6
269  bt [rax+104], 6
270  jnc @skipxmm6
271  cvtsd2ss xmm6,[rax+88]
272  jmp @skipxmm6re
273  @skipxmm6:
274  movq xmm6,[rax+88]         // move quadword to xmm6 from Registers._XMM6
275  @skipxmm6re:
276
277// xmm7
278  bt [rax+104], 7
279  jnc @skipxmm7
280  cvtsd2ss xmm7,[rax+96]
281  jmp @skipxmm7re
282  @skipxmm7:
283  movq xmm7,[rax+96]         // move quadword to xmm7 from Registers._XMM7
284  @skipxmm7re:
285
286
287  mov RDI, [rax]
288  mov RSI, [rax+ 8]
289  mov RDX, [rax+16]
290  mov RCX, [rax+24]
291  mov R8,  [rax+32]
292  mov R9,  [rax+40]
293
294  // weird thing on windows, it needs 32 bytes in the CALLEE side to do whatever in; not sure about linux
295  //sub RSP, 32
296
297  mov rax, [rbp-8]
298  call RAX
299
300//  add rsp, 8
301
302  // add RSP, 32 // undo the damage done earlier
303
304  // copy result back
305  mov rsi, [rbp-16]          // _RAX parameter
306  mov [rsi], RAX
307  mov rsi, [rbp-24]          // _XMM0 parameter
308
309  // xmm0 res
310  mov rax, [rbp-32]          // Registers parameter
311  bt [rax+104], 8            // if atype.basetype  <> btSingle
312  jnc @skipres               // then goto skipres else begin
313  cvtss2sd xmm1,xmm0         // convert single to double  into xmm1
314  movq [rsi],xmm1            // move quadword to _XMM0
315  jmp @skipresre             // end
316  @skipres:
317  movq [rsi],xmm0            // move quadword to _XMM0
318  @skipresre:
319
320
321  pop rdx
322  pop r9   // xmm0
323  pop rsi  // _rax
324  pop rdi  // address
325  leave
326  ret
327end;
328{$ENDIF}
329
330function TPSExec.InnerfuseCall(_Self, Address: Pointer; CallingConv: TPSCallingConvention; Params: TPSList; res: PPSVariantIFC): Boolean;
331var
332  Stack: array of Byte;
333  _RAX: IPointer;
334_XMM0: Double;
335  Registers: TRegisters;
336{$IFNDEF WINDOWS}
337  RegUsageFloat: Byte;
338{$ENDIF}
339{$IFDEF FPC}
340  IsConstructor,IsVirtualCons: Boolean;
341{$ENDIF}
342  RegUsage: Byte;
343  CallData: TPSList;
344  I: Integer;
345  pp: ^Byte;
346
347  function rp(p: PPSVariantIFC): PPSVariantIFC;
348  begin
349    if p = nil then
350    begin
351      result := nil;
352      exit;
353    end;
354    if p.aType.BaseType = btPointer then
355    begin
356      p^.aType := Pointer(Pointer(IPointer(p^.dta) + PointerSize)^);
357      p^.Dta := Pointer(p^.dta^);
358    end;
359    Result := p;
360  end;
361{$IFDEF WINDOWS}
362  procedure StoreReg(data: IPointer);   overload;
363  var p: Pointer;
364  begin
365    case RegUsage of
366      0: begin inc(RegUsage); Registers._RCX:=Data; end;
367      1: begin inc(RegUsage); Registers._RDX:=Data; end;
368      2: begin inc(RegUsage); Registers._R8:=Data; end;
369      3: begin inc(RegUsage); Registers._R9:=Data; end;
370    else begin
371      SetLength(Stack, Length(Stack)+8);
372      p := @Stack[LEngth(Stack)-8];
373      IPointer(p^) := data;
374    end;
375    end;
376  end;
377  {$ELSE}
378  procedure StoreReg(data: IPointer);   overload;
379  var p: Pointer;
380  begin
381    case RegUsage of
382      0: begin inc(RegUsage); Registers._RDI:=Data; end;
383      1: begin inc(RegUsage); Registers._RSI:=Data; end;
384      2: begin inc(RegUsage); Registers._RDX:=Data; end;
385      3: begin inc(RegUsage); Registers._RCX:=Data; end;
386      4: begin inc(RegUsage); Registers._R8:=Data; end;
387      5: begin inc(RegUsage); Registers._R9:=Data; end;
388    else begin
389      SetLength(Stack, Length(Stack)+8);
390      p := @Stack[LEngth(Stack)-8];
391      IPointer(p^) := data;
392    end;
393    end;
394  end;
395{$ENDIF}
396
397  procedure StoreStack(const aData; Len: Integer);
398  var
399    p: Pointer;
400  begin
401    if Len > 8 then
402      if Length(Stack) mod 16 <> 0 then begin
403        SetLength(Stack, Length(Stack)+ (16-(Length(Stack) mod 16)));
404      end;
405    SetLength(Stack, Length(Stack)+Len);
406    p := @Stack[Length(Stack)-Len];
407    Move(aData, p^, Len);
408  end;
409
410{$IFDEF WINDOWS}
411  procedure StoreReg(data: Double); overload;
412  var p: Pointer;
413  begin
414    case RegUsage of
415      0: begin inc(RegUsage); _XMM0:=Data; end;
416      1: begin inc(RegUsage); Registers._XMM1:=Data; end;
417      2: begin inc(RegUsage); Registers._XMM2:=Data; end;
418      3: begin inc(RegUsage); Registers._XMM3:=Data; end;
419    else begin
420      SetLength(Stack, Length(Stack)+8);
421      p := @Stack[LEngth(Stack)-8];
422      Double(p^) := data;
423    end;
424    end;
425  end;
426  procedure StoreReg(data: Single); overload;
427  var p: Pointer;
428  begin
429    case RegUsage of
430      0: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 1;_XMM0:=Data; end;
431      1: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 2; Registers._XMM1:=Data; end;
432      2: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 4;Registers._XMM2:=Data; end;
433      3: begin inc(RegUsage); Registers.SingleBits := Registers.SingleBits or 8; Registers._XMM3:=Data; end;
434    else begin
435      SetLength(Stack, Length(Stack)+8);
436      p := @Stack[LEngth(Stack)-8];
437      Double(p^) := data;
438    end;
439    end;
440  end;
441  {$ELSE}
442  procedure StoreReg(data: Double); overload;
443  var p: Pointer;
444  begin
445    case RegUsageFloat of
446      0: begin inc(RegUsageFloat); _XMM0:=Data; end;
447      1: begin inc(RegUsageFloat); Registers._XMM1:=Data; end;
448      2: begin inc(RegUsageFloat); Registers._XMM2:=Data; end;
449      3: begin inc(RegUsageFloat); Registers._XMM3:=Data; end;
450      4: begin inc(RegUsageFloat); Registers._XMM4:=Data; end;
451      5: begin inc(RegUsageFloat); Registers._XMM5:=Data; end;
452      6: begin inc(RegUsageFloat); Registers._XMM6:=Data; end;
453      7: begin inc(RegUsageFloat); Registers._XMM7:=Data; end;
454    else begin
455      SetLength(Stack, Length(Stack)+8);
456      p := @Stack[LEngth(Stack)-8];
457      Double(p^) := data;
458    end;
459    end;
460  end;
461  procedure StoreReg(data: Single); overload;
462  var p: Pointer;
463  begin
464    case RegUsageFloat of
465      0: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 1; _XMM0:=Data; end;
466      1: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 2; Registers._XMM1:=Data; end;
467      2: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 4; Registers._XMM2:=Data; end;
468      3: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 8; Registers._XMM3:=Data; end;
469      4: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 16; Registers._XMM4:=Data; end;
470      5: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 32; Registers._XMM5:=Data; end;
471      6: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 64; Registers._XMM6:=Data; end;
472      7: begin inc(RegUsageFloat); Registers.SingleBits := Registers.SingleBits or 128; Registers._XMM7:=Data; end;
473    else begin
474      SetLength(Stack, Length(Stack)+8);
475      p := @Stack[LEngth(Stack)-8];
476      Double(p^) := data;
477    end;
478    end;
479  end;
480  {$ENDIF}
481  function GetPtr(fVar: PPSVariantIFC): Boolean;
482  var
483    varPtr: Pointer;
484    //UseReg: Boolean;
485    //tempstr: tbtstring;
486    p: Pointer;
487  begin
488    Result := False;
489    if FVar = nil then exit;
490    if fVar.VarParam then
491    begin
492      case fvar.aType.BaseType of
493        btArray:
494          begin
495            if Copy(fvar.aType.ExportName, 1, 10) = '!OPENARRAY' then
496            begin
497              p := CreateOpenArray(True, Self, FVar);
498              if p = nil then exit;
499              CallData.Add(p);
500              StoreReg(IPointer(POpenArray(p)^.Data));
501              StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
502              Result := True;
503              Exit;
504            end else begin
505              varptr := fvar.Dta;
506//              Exit;
507            end;
508          end;
509        btVariant,
510        btSet,
511        btStaticArray,
512        btRecord,
513        btInterface,
514        btClass,
515        {$IFNDEF PS_NOWIDESTRING} btUnicodeString, btWideString, btWideChar, {$ENDIF} btU8, btS8, btU16,
516        btS16, btU32, btS32, btSingle, btDouble, btExtended, btString, btPChar, btChar, btCurrency
517        {$IFNDEF PS_NOINT64}, bts64{$ENDIF}:
518          begin
519            Varptr := fvar.Dta;
520          end;
521      else begin
522          exit; //invalid type
523        end;
524      end; {case}
525
526      StoreReg(IPointer(VarPtr));
527    end else begin
528//      UseReg := True;
529      case fVar^.aType.BaseType of
530        btSet:
531          begin
532            case TPSTypeRec_Set(fvar.aType).aByteSize of
533              1: StoreReg(IPointer(byte(fvar.dta^)));
534              2: StoreReg(IPointer(word(fvar.dta^)));
535              3, 4: StoreReg(IPointer(cardinal(fvar.dta^)));
536              5,6,7,8: StoreReg(IPointer(fVar.Dta^));
537              else
538                StoreReg(IPointer(fvar.Dta));
539            end;
540          end;
541        btArray:
542          begin
543            if Copy(fvar^.aType.ExportName, 1, 10) = '!OPENARRAY' then
544            begin
545              p := CreateOpenArray(False, SElf, FVar);
546              if p =nil then exit;
547              CallData.Add(p);
548              StoreReg(IPointer(POpenArray(p)^.Data));
549              StoreReg(IPointer(POpenArray(p)^.ItemCount -1));
550              Result := True;
551              exit;
552            end else begin
553            {$IFDEF FPC}
554              StoreReg(IPointer(FVar.Dta));
555            {$ELSE}
556              StoreReg(IPointer(FVar.Dta^));
557            {$ENDIF}
558            end;
559          end;
560        btRecord:
561          begin
562            if fvar^.aType.RealSize <= sizeof(IPointer) then
563              StoreReg(IPointer(fvar.dta^))
564            else
565              StoreReg(IPointer(fVar.Dta));
566          end;
567        btVariant
568        , btStaticArray:
569          begin
570            StoreReg(IPointer(fVar.Dta));
571          end;
572        btExtended, btDouble: {8 bytes} begin
573            StoreReg(double(fvar.dta^));
574          end;
575        btCurrency: {8 bytes} begin
576            StoreReg(IPointer(fvar.dta^));
577          end;
578        btSingle: {4 bytes} begin
579            StoreReg(single(fvar.dta^));
580          end;
581
582        btChar,
583        btU8,
584        btS8: begin
585            StoreReg(IPointer(byte(fVar^.dta^)));
586          end;
587        btWideChar,
588        btu16, btS16: begin
589            StoreReg(IPointer(word(fVar^.dta^)));
590          end;
591        btu32, bts32: begin
592            StoreReg(IPointer(cardinal(fVar^.dta^)));
593          end;
594        btPchar:
595          begin
596            if pointer(fvar^.dta^) = nil then
597              StoreReg(IPointer(@EmptyPchar))
598            else
599              StoreReg(IPointer(fvar^.dta^));
600          end;
601        btclass, btinterface, btString:
602          begin
603            StoreReg(IPointer(fvar^.dta^));
604          end;
605        btWideString: begin
606            StoreReg(IPointer(fvar^.dta^));
607          end;
608        btUnicodeString: begin
609            StoreReg(IPointer(fvar^.dta^));
610          end;
611
612        btProcPtr:
613          begin
614            GetMem(p, PointerSize2);
615            TMethod(p^) := MKMethod(Self, Longint(FVar.Dta^));
616            StoreStack(p^, Pointersize2);
617            FreeMem(p);
618          end;
619
620        bts64:
621          begin
622            StoreReg(IPointer(int64(fvar^.dta^)));
623        end;
624      end; {case}
625    end;
626    Result := True;
627  end;
628begin
629  {$IFDEF FPC}
630  if (Integer(CallingConv) and 128) <> 0 then begin
631    IsVirtualCons := true;
632    CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 128);
633  end else
634    IsVirtualCons:= false;
635  if (Integer(CallingConv) and 64) <> 0 then begin
636    IsConstructor := true;
637    CAllingConv := TPSCallingConvention(Integer(CallingConv) and not 64);
638  end else
639    IsConstructor := false;
640  {$ENDIF}
641
642  InnerfuseCall := False;
643  if Address = nil then
644    exit; // need address
645  SetLength(Stack, 0);
646  CallData := TPSList.Create;
647  res := rp(res);
648  if res <> nil then
649    res.VarParam := true;
650  try
651{$IFNDEF WINDOWS}
652    (*_RSI := 0;
653    _RDI := 0;
654    _XMM4 := 0;
655    _XMM5 := 0;
656    _XMM6 := 0;
657    _XMM7 := 0;*)
658    RegUsageFloat := 0;
659{$ENDIF}
660  _XMM0 := 0;
661  FillChar(Registers, Sizeof(REgisters), 0);
662    _RAX := 0;
663    RegUsage := 0;
664    {$IF DEFINED (fpc) and (fpc_version >= 3)} // FIX FOR FPC constructor calls
665    if IsConstructor then begin
666      if not GetPtr(rp(Params[0])) then exit; // this goes first
667      DisposePPSVariantIFC(Params[0]);
668      Params.Delete(0);
669    end;
670    {$ENDIF}
671    if assigned(_Self) then begin
672      StoreReg(IPointer(_Self));
673    end;
674    if assigned(res) and (res^.atype.basetype = btSingle) then begin
675      Registers.Singlebits  := Registers.Singlebits or 256;
676    end;
677{$IFDEF PS_RESBEFOREPARAMETERS}
678   if assigned(res) then begin
679    case res^.aType.BaseType of
680      {$IFDEF x64_string_result_as_varparameter}
681      btstring, btWideString, btUnicodeString,
682      {$ENDIF}
683      btInterface, btArray, btVariant, btStaticArray:
684        GetPtr(res);
685      btRecord,
686      btSet:
687        begin
688          if res.aType.RealSize > PointerSize then GetPtr(res);
689        end;
690    end;
691   end;
692{$ENDIF}
693    for I := 0 to Params.Count - 1 do
694    begin
695      if not GetPtr(rp(Params[I])) then Exit;
696    end;
697    if assigned(res) then begin
698{$IFNDEF PS_RESBEFOREPARAMETERS}
699      case res^.aType.BaseType of
700        {$IFDEF x64_string_result_as_varparameter}
701        btstring, btWideString, btUnicodeString,
702        {$ENDIF}
703        btInterface, btArray, btVariant, btStaticArray:
704          GetPtr(res);
705        btRecord,
706        btSet:
707          begin
708            if res.aType.RealSize > PointerSize then GetPtr(res);
709          end;
710      end;
711{$ENDIF}
712      {$IFDEF WINDOWS}
713      if (length(Stack) mod 16) <> 0 then begin
714        SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
715      end;
716      {$ENDIF}
717      if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
718{$IFDEF WINDOWS}
719      Registers.Stack := pp;
720      Registers.Items := Length(Stack) div 8;
721      x64call(Address, _RAX, _XMM0, Registers);
722{$ELSE}
723      x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
724{$ENDIF}
725      case res^.aType.BaseType of
726        btRecord, btSet:
727          begin
728            case res.aType.RealSize of
729              1: byte(res.Dta^) := _RAX;
730              2: word(res.Dta^) := _RAX;
731              3,
732              4: Longint(res.Dta^) := _RAX;
733              5,6,7,8: IPointer(res.dta^) := _RAX;
734            end;
735          end;
736        btSingle:      tbtsingle(res.Dta^) := _XMM0;
737        btDouble:      tbtdouble(res.Dta^) := _XMM0;
738        btExtended:    tbtextended(res.Dta^) := _XMM0;
739        btchar,btU8, btS8:    tbtu8(res.dta^) := _RAX;
740        btWideChar, btu16, bts16:  tbtu16(res.dta^) := _RAX;
741        btClass : IPointer(res.dta^) := _RAX;
742        btu32,bts32:   tbtu32(res.dta^) := _RAX;
743        btPChar:       pansichar(res.dta^) := Pansichar(_RAX);
744        bts64: tbts64(res.dta^) := Int64(_RAX);
745        btCurrency:    tbts64(res.Dta^) := Int64(_RAX);
746        btInterface,
747        btVariant,
748        {$IFDEF x64_string_result_as_varparameter}
749        btWidestring,btUnicodestring, btstring ,
750        {$ENDIF}
751        btStaticArray, btArray:;
752        {$IFNDEF x64_string_result_as_varparameter}
753        btUnicodeString, btWideString, btstring:  Int64(res.dta^) := _RAX;
754        {$ENDIF}
755      else
756        exit;
757      end;
758    end else begin
759      {$IFDEF WINDOWS}
760      if (length(Stack) mod 16) <> 0 then begin
761        SetLength(Stack, Length(Stack)+16 - (Length(Stack) mod 16));
762      end;
763      {$ENDIF}
764	if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
765{$IFDEF WINDOWS}
766        Registers.Stack := pp;
767        Registers.Items := Length(Stack) div 8;
768        x64call(Address, _RAX, _XMM0, Registers);
769{$ELSE}
770       x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
771{$ENDIF}
772    end;
773    Result := True;
774  finally
775    for i := CallData.Count -1 downto 0 do
776    begin
777      pp := CallData[i];
778      case pp^ of
779        0: DestroyOpenArray(Self, Pointer(pp));
780      end;
781    end;
782    CallData.Free;
783  end;
784end;
785
786
787