From fa55490db0bcbcfe68a22f14a97d65daa7addc32 Mon Sep 17 00:00:00 2001
From: Martin <User4martin@users.noreply.github.com>
Date: Sat, 28 Oct 2017 16:12:13 +0100
Subject: [PATCH] Fix constructor 64bit (#167)

* use 64bit variant

* Fix registers for FPC constructor

* fix only fpc 3.0.0 and up
---
 Source/uPSRuntime.pas |  2 +-
 Source/x64.inc        | 23 +++++++++++++++++++++++
 2 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas
index 7796c41..b4c0046 100644
--- a/Source/uPSRuntime.pas
+++ b/Source/uPSRuntime.pas
@@ -10261,7 +10261,7 @@ begin
   // the VMT class pointer in EDX so they are effectively swaped
   // using register calling convention
   {$IFDEF CPU64}
-  PPSVariantU32(IntVal).Data := Int64(FSelf);
+  PPSVariantS64(IntVal).Data := Int64(FSelf);
   {$ELSE}
   PPSVariantU32(IntVal).Data := Cardinal(FSelf);
   {$ENDIF}
diff --git a/Source/x64.inc b/Source/x64.inc
index 23a6850..f5f1f63 100644
--- a/Source/x64.inc
+++ b/Source/x64.inc
@@ -340,6 +340,9 @@ _XMM0: Double;
   Registers: TRegisters;
 {$IFNDEF WINDOWS}
   RegUsageFloat: Byte;
+{$ENDIF}
+{$IFDEF FPC}
+  IsConstructor,IsVirtualCons: Boolean;
 {$ENDIF}
   RegUsage: Byte;
   CallData: TPSList;
@@ -628,6 +631,19 @@ _XMM0: Double;
     Result := True;
   end;
 begin
+  {$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
@@ -650,6 +666,13 @@ begin
   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;