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