Changed the rev-verison in TestUnit and new PS!

git-svn-id: http://www.villavu.com/repositories/merlijn/mufasa@407 3f818213-9676-44b0-a9b4-5e4c4e03d09d

Projects/SAMufasaGUI/testunit.pas

@@ -42,7 +42,7 @@ uses
   ocr, updateform, simbasettings, reportbug;
 
 const
-    SimbaVersion = 404;
+    SimbaVersion = 405;
 
 type
 

Units/PascalScript/PascalScriptFPC.inc

@@ -2,10 +2,13 @@
   {$DEFINE PS_HAVEVARIANT}
   {$DEFINE PS_DYNARRAY}
   {$DEFINE PS_NOIDISPATCH}
-  {$if (fpc_version=2) and (fpc_release>=3) and (fpc_patch>=1)}
+  {.$if (fpc_version=2) and (fpc_release>=3) and (fpc_patch>=1)}
-  {.$if (fpc_version=2) and (fpc_release>=2) and (fpc_patch>=4)}
+  {$if (fpc_version=2) and ((fpc_release=2) and (fpc_patch>=4)) or (fpc_release>2)}
     {$UNDEF FPC_OLD_FIX}
+    {$DEFINE PS_STACKALIGN}
     {$UNDEF PS_FPCSTRINGWORKAROUND}
+    {$DEFINE PS_RESBEFOREPARAMETERS}
+    {$DEFINE x64_string_result_as_varparameter}
   {FreePascal 2.3.1 and above has much Delphi compatibility bugs fixed}
   {$else}
     {$DEFINE FPC_OLD_FIX}

Units/PascalScript/uPSRuntime.pas

@@ -1,4 +1,5 @@
 unit uPSRuntime;
+
 {$I PascalScript.inc}
 {
 
@@ -1702,8 +1703,9 @@ begin
     {$IFNDEF PS_NOWIDESTRING}btWideChar, {$ENDIF}bts16, btU16: FrealSize := 2;
     {$IFNDEF PS_NOWIDESTRING}btWideString,
     btUnicodeString,
-    {$ENDIF}{$IFNDEF PS_NOINTERFACES}btInterface, {$ENDIF}btSingle, bts32, btU32,
+    {$ENDIF}{$IFNDEF PS_NOINTERFACES}btInterface, {$ENDIF}
     btclass, btPChar, btString: FrealSize := PointerSize;
+    btSingle, bts32, btU32: FRealSize := 4;
     btProcPtr: FRealSize := 2 * sizeof(Pointer) + sizeof(Cardinal);
     btCurrency: FrealSize := Sizeof(Currency);
     btPointer: FRealSize := 2 * sizeof(Pointer) + sizeof(LongBool); // ptr, type, freewhendone
@@ -6545,6 +6547,7 @@ begin
               Inc(FCurrentPosition, 4);
               Pointer(Dest.P^) := nil;
               SetLength(tbtstring(Dest.P^), Param);
+              if Param <> 0 then begin
                 if not ReadData(tbtstring(Dest.P^)[1], Param) then
                 begin
                   CMD_Err(erOutOfRange);
@@ -6552,6 +6555,8 @@ begin
                   Result := False;
                   exit;
                 end;
+                pansichar(dest.p^)[Param] := #0;
+              end;
             end;
           {$IFNDEF PS_NOWIDESTRING}
           btWidestring:

Units/PascalScript/x64.inc

@@ -113,6 +113,12 @@ asm
   push rdi  // address
   push rsi  // _rax
   push r9   // xmm0
+{$IFDEF PS_STACKALIGN}
+  bt r8, 0
+  jc @skipjump
+  sub rsp, 8
+@skipjump:
+{$ENDIF}
   mov rax, rdx
   jmp @compareitems
 @work:
@@ -145,6 +151,8 @@ asm
   mov rax, [rbp-8]
   call RAX
 
+//  add rsp, 8
+
   // add RSP, 32 // undo the damage done earlier
 
   // copy result back
@@ -350,11 +358,22 @@ _XMM0: Double;
               Result := True;
               exit;
             end else begin
+            {$IFDEF FPC}
+              StoreReg(IPointer(FVar.Dta));
+            {$ELSE}
               StoreReg(IPointer(FVar.Dta^));
+            {$ENDIF}
             end;
           end;
+        btRecord:
+          begin
+            if fvar^.aType.RealSize <= sizeof(IPointer) then
+              StoreReg(IPointer(fvar.dta^))
+            else
+              StoreReg(IPointer(fVar.Dta));
+          end;
         btVariant
-        , btStaticArray, btRecord:
+        , btStaticArray:
           begin
             StoreReg(IPointer(fVar.Dta));
           end;
@@ -449,22 +468,39 @@ begin
     if assigned(_Self) then begin
       StoreReg(IPointer(_Self));
     end;
-    for I := 0 to Params.Count - 1 do
+{$IFDEF PS_RESBEFOREPARAMETERS}
-    begin
-      if not GetPtr(rp(Params[I])) then Exit;
-    end;
-
    if assigned(res) then begin
     case res^.aType.BaseType of
       {$IFDEF x64_string_result_as_varparameter}
       btstring, btWideString, btUnicodeString,
       {$ENDIF}
-        btInterface, btArray, btrecord, btVariant, btStaticArray: GetPtr(res);
+      btInterface, btArray, btVariant, btStaticArray:
+        GetPtr(res);
       btSet:
         begin
-            if TPSTypeRec_Set(res.aType).aByteSize > PointerSize then GetPtr(res);
+          if res.aType.RealSize > PointerSize then GetPtr(res);
         end;
     end;
+   end;
+{$ENDIF}
+    for I := 0 to Params.Count - 1 do
+    begin
+      if not GetPtr(rp(Params[I])) then Exit;
+    end;
+    if assigned(res) then begin
+{$IFNDEF PS_RESBEFOREPARAMETERS}
+      case res^.aType.BaseType of
+        {$IFDEF x64_string_result_as_varparameter}
+        btstring, btWideString, btUnicodeString,
+        {$ENDIF}
+        btInterface, btArray, btVariant, btStaticArray:
+          GetPtr(res);
+        btSet:
+          begin
+            if res.aType.RealSize > PointerSize then GetPtr(res);
+          end;
+      end;
+{$ENDIF}
       if Stack = nil then pp := nil else pp := @Stack[Length(Stack) -8];
 {$IFDEF WINDOWS}
       x64call(Address, _RAX, _RCX, _RDX, _R8, _R9, _XMM0, _XMM1, _XMM2, _XMM3, pp, Length(Stack) div 8);
@@ -472,9 +508,9 @@ begin
       x64call(Address, _RAX, Registers, pp, Length(Stack) div 8, _XMM0);
 {$ENDIF}
       case res^.aType.BaseType of
-        btSet:
+        btRecord, btSet:
           begin
-            case TPSTypeRec_Set(res.aType).aByteSize  of
+            case res.aType.RealSize of
               1: byte(res.Dta^) := _RAX;
               2: word(res.Dta^) := _RAX;
               3,
@@ -497,7 +533,7 @@ begin
         {$IFDEF x64_string_result_as_varparameter}
         btWidestring,btUnicodestring, btstring ,
         {$ENDIF}
-        btStaticArray, btArray, btrecord:;
+        btStaticArray, btArray:;
         {$IFNDEF x64_string_result_as_varparameter}
         btUnicodeString, btWideString, btstring:  Int64(res.dta^) := _RAX;
         {$ENDIF}