From d92139acc9bc2b03e528fd21b9ce663d49c011a6 Mon Sep 17 00:00:00 2001 From: Raymond Date: Wed, 13 Jan 2010 18:13:42 +0000 Subject: [PATCH] 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 | 2 +- Units/PascalScript/PascalScriptFPC.inc | 7 ++-- Units/PascalScript/uPSRuntime.pas | 19 ++++++---- Units/PascalScript/x64.inc | 50 ++++++++++++++++++++++---- 4 files changed, 61 insertions(+), 17 deletions(-) diff --git a/Projects/SAMufasaGUI/testunit.pas b/Projects/SAMufasaGUI/testunit.pas index b9ef7f1..4463a9a 100644 --- a/Projects/SAMufasaGUI/testunit.pas +++ b/Projects/SAMufasaGUI/testunit.pas @@ -42,7 +42,7 @@ uses ocr, updateform, simbasettings, reportbug; const - SimbaVersion = 404; + SimbaVersion = 405; type diff --git a/Units/PascalScript/PascalScriptFPC.inc b/Units/PascalScript/PascalScriptFPC.inc index 040be52..f73780a 100644 --- a/Units/PascalScript/PascalScriptFPC.inc +++ b/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>=2) and (fpc_patch>=4)} + {.$if (fpc_version=2) and (fpc_release>=3) and (fpc_patch>=1)} + {$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} diff --git a/Units/PascalScript/uPSRuntime.pas b/Units/PascalScript/uPSRuntime.pas index b6f7cc1..01e5097 100644 --- a/Units/PascalScript/uPSRuntime.pas +++ b/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,12 +6547,15 @@ begin Inc(FCurrentPosition, 4); Pointer(Dest.P^) := nil; SetLength(tbtstring(Dest.P^), Param); - if not ReadData(tbtstring(Dest.P^)[1], Param) then - begin - CMD_Err(erOutOfRange); - FTempVars.Pop; - Result := False; - exit; + if Param <> 0 then begin + if not ReadData(tbtstring(Dest.P^)[1], Param) then + begin + CMD_Err(erOutOfRange); + FTempVars.Pop; + Result := False; + exit; + end; + pansichar(dest.p^)[Param] := #0; end; end; {$IFNDEF PS_NOWIDESTRING} diff --git a/Units/PascalScript/x64.inc b/Units/PascalScript/x64.inc index 5952b16..f3ebe5f 100644 --- a/Units/PascalScript/x64.inc +++ b/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; +{$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); + btSet: + begin + 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, 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; +{$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}