From ad34e3aaf243e680ab79314fc93ea2eb707270ba Mon Sep 17 00:00:00 2001 From: TetzkatLipHoka Date: Sat, 11 Jul 2026 11:44:13 +0200 Subject: [PATCH] Restore Delphi 7 compatibility Recent changes made the core units unbuildable on old Delphi versions (reported for Delphi 7 in issue #286). Three categories of fixes, all behavior-neutral on current compilers: - Exit(Value) needs Delphi 2009+: expanded to 'Result := ...; Exit;' in the for-loop code generation (EmitForEntryCheck/EmitForExitCheck). - High(UInt64)/High(tbtU64) is not evaluable as a constant expression on Delphi 7 (its UInt64 is a crippled signed alias): replaced with 'not UInt64(0)', which yields the same all-ones value everywhere. - 'tbtDouble(p^.textended)' is an invalid typecast on Delphi 7 (Extended -> Double must be a conversion): assign without the cast, which is the intended float conversion on every compiler. - SysUtils.StrToUInt64/StrToUInt64Def (XE4+) and SysUtils.UIntToStr (2009+) do not exist on old RTLs: uPSUtils now provides fallbacks, compiled only when SysUtils lacks them (checked via {$IF NOT DECLARED(...)}, so this adapts to any compiler and to FPC). The two qualified SysUtils.UIntToStr calls in uPSRuntime were unqualified so they resolve to whichever implementation exists. Note: pre-2010 compilers format UInt64 values above High(Int64) with a sign - an inherent limitation of their signed UInt64 alias. With this, all uPS* units (including the import units) compile on Delphi 7 again; Delphi 12 Win32/Win64 builds are unchanged. Fixes #286 (the current sources can be used on Delphi 7 again). Co-Authored-By: Claude Fable 5 --- Source/uPSCompiler.pas | 31 ++++++++++++++++++--------- Source/uPSRuntime.pas | 6 +++--- Source/uPSUtils.pas | 48 ++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 72 insertions(+), 13 deletions(-) diff --git a/Source/uPSCompiler.pas b/Source/uPSCompiler.pas index f13307e2..73036203 100644 --- a/Source/uPSCompiler.pas +++ b/Source/uPSCompiler.pas @@ -1945,7 +1945,7 @@ function BlockWriteVariant(BlockInfo: TPSBlockInfo; p: PIfRVariant{$IFNDEF PS_NO if ExecIs64Bit then begin {$IFNDEF CPU64} { On 64-bit Exec, Extended is an alias for Double, so write a Double instead } - TempDouble := tbtDouble(p^.textended); + TempDouble := p^.textended; { conversion; a tbtDouble() cast fails on Delphi 7 } BlockWriteData(BlockInfo, TempDouble, sizeof(tbtDouble)); {$ELSE} BlockWriteData(BlockInfo, p^.textended, sizeof(tbtExtended)); @@ -10214,9 +10214,9 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; TPSValueData(Result).Data^.ts64 := High(tbtS64); btU64: if Backwards then - TPSValueData(Result).Data^.tu64 := Low(tbtU64) - else - TPSValueData(Result).Data^.tu64 := High(tbtU64); + TPSValueData(Result).Data^.tu64 := 0 + else // all-ones = High(tbtU64); D7 cannot evaluate that as a constant + TPSValueData(Result).Data^.tu64 := not tbtU64(0); {$ENDIF} else begin @@ -10232,14 +10232,20 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; Does not free finVal. See also EmitForExitCheck. } begin if not (PreWriteOutRec(VariableVar, nil) and PreWriteOutRec(finVal, nil)) then - Exit(False); + begin + Result := False; + Exit; + end; BlockWriteByte(BlockInfo, CM_CO); if Backwards then BlockWriteByte(BlockInfo, 0) { >= } else BlockWriteByte(BlockInfo, 1); { <= } if not (WriteOutRec(TempBool, False) and WriteOutRec(VariableVar, True) and WriteOutRec(finVal, True)) then - Exit(False); + begin + Result := False; + Exit; + end; AfterWriteOutRec(finVal); AfterWriteOutRec(VariableVar); BlockWriteByte(BlockInfo, Cm_CNG); @@ -10260,18 +10266,23 @@ function TPSPascalCompiler.ProcessSub(BlockInfo: TPSBlockInfo): Boolean; BoundaryValue := CreateForBoundaryValue; ExitCheckEmitted := BoundaryValue <> nil; if BoundaryValue = nil then - Exit(True); + begin + Result := True; + Exit; + end; if not (PreWriteOutRec(VariableVar, nil) and PreWriteOutRec(BoundaryValue, nil)) then begin BoundaryValue.Free; - Exit(False); + Result := False; + Exit; end; BlockWriteByte(BlockInfo, CM_CO); BlockWriteByte(BlockInfo, 5); { = } if not (WriteOutRec(TempBool, False) and WriteOutRec(VariableVar, True) and WriteOutRec(BoundaryValue, True)) then begin BoundaryValue.Free; - Exit(False); + Result := False; + Exit; end; AfterWriteOutRec(BoundaryValue); AfterWriteOutRec(VariableVar); @@ -12001,7 +12012,7 @@ function TPSPascalCompiler.Compile(const s: tbtString): Boolean; if FExecIs64Bit then begin {$IFNDEF CPU64} { On 64-bit Exec, Extended is an alias for Double, so write a Double instead } - TempDouble := tbtDouble(p^.textended); + TempDouble := p^.textended; { conversion; a tbtDouble() cast fails on Delphi 7 } WriteData(TempDouble, sizeof(tbtDouble)); {$ELSE} WriteData(p^.textended, sizeof(tbtExtended)); diff --git a/Source/uPSRuntime.pas b/Source/uPSRuntime.pas index d22c6182..78923981 100644 --- a/Source/uPSRuntime.pas +++ b/Source/uPSRuntime.pas @@ -9752,10 +9752,10 @@ function DefProc(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack 40: Stack.SetAnsiString(-1, tbtstring(SysUtils.IntToStr(Stack.GetInt64(-2))));// Int64ToStr 41: Stack.SetInt64(-1, StrToInt64Def(string(Stack.GetAnsiString(-2)), Stack.GetInt64(-3))); // StrToInt64Def 45: Stack.SetUInt64(-1, StrToUInt64(string(Stack.GetAnsiString(-2)))); // StrToUInt64 - 46: Stack.SetAnsiString(-1, tbtstring(SysUtils.UIntToStr(Stack.GetUInt64(-2))));// UInt64ToStr + 46: Stack.SetAnsiString(-1, tbtstring(UIntToStr(Stack.GetUInt64(-2))));// UInt64ToStr 47: Stack.SetUInt64(-1, StrToUInt64Def(string(Stack.GetAnsiString(-2)), Stack.GetUInt64(-3))); // StrToUInt64Def {$ENDIF} - 48: Stack.SetAnsiString(-1, tbtstring(SysUtils.UIntToStr({$IFNDEF PS_NOINT64}Stack.GetUInt64(-2){$ELSE}Stack.GetUInt(-2){$ENDIF}))); // UIntToStr + 48: Stack.SetAnsiString(-1, tbtstring(UIntToStr({$IFNDEF PS_NOINT64}Stack.GetUInt64(-2){$ELSE}Stack.GetUInt(-2){$ENDIF}))); // UIntToStr 42: // sizeof begin temp := NewTPSVariantIFC(Stack[Stack.Count -2], False); @@ -10026,7 +10026,7 @@ function High_(Caller: TPSExec; p: TPSExternalProcRec; Global, Stack: TPSStack): btS32 : Stack.SetInt(-1,High(Integer)); //Integer/LongInt: 2147483647 {$IFNDEF PS_NOINT64} btS64 : Stack.SetInt64(-1,High(Int64)); //Int64: 9223372036854775807 - btU64 : Stack.SetUInt64(-1,High(UInt64)); //UInt64: 18446744073709551615 + btU64 : Stack.SetUInt64(-1,not UInt64(0)); //UInt64: 18446744073709551615 (High(UInt64); D7 cannot evaluate that as a constant) {$ENDIF} else Result:=false; end; diff --git a/Source/uPSUtils.pas b/Source/uPSUtils.pas index f3d3ce30..80fe0674 100644 --- a/Source/uPSUtils.pas +++ b/Source/uPSUtils.pas @@ -657,6 +657,27 @@ function GRLW(var s: TbtString): TbtString; function WideUpperCase(const S: WideString): WideString; function WideLowerCase(const S: WideString): WideString; {$ENDIF} + +{ SysUtils fallbacks for compilers that lack the UInt64 conversion helpers + (the StrToUInt64 family appeared in XE4, UIntToStr in 2009). Note that + pre-2010 compilers treat UInt64 as a signed alias, so values above + High(Int64) are formatted with a sign there - an inherent limit of those + RTLs. } +{$IFNDEF PS_NOINT64} +{$IF NOT DECLARED(StrToUInt64)} + {$DEFINE PS_NEED_STRTOUINT64} +{$IFEND} +{$IF NOT DECLARED(UIntToStr)} + {$DEFINE PS_NEED_UINTTOSTR} +{$IFEND} +{$ENDIF} +{$IFDEF PS_NEED_STRTOUINT64} +function StrToUInt64(const S: string): UInt64; +function StrToUInt64Def(const S: string; const Default: UInt64): UInt64; +{$ENDIF} +{$IFDEF PS_NEED_UINTTOSTR} +function UIntToStr(Value: UInt64): string; +{$ENDIF} implementation {$IFDEF DELPHI3UP } @@ -1753,6 +1774,33 @@ procedure TPSUnit.SetUnitName(const Value: TbtString); fUnitName := FastUpperCase(Value); end; +{$IFDEF PS_NEED_STRTOUINT64} +function StrToUInt64(const S: string): UInt64; +var + Err: Integer; +begin + Val(S, Result, Err); + if Err <> 0 then + raise EConvertError.CreateFmt('''%s'' is not a valid UInt64 value', [S]); +end; + +function StrToUInt64Def(const S: string; const Default: UInt64): UInt64; +var + Err: Integer; +begin + Val(S, Result, Err); + if Err <> 0 then + Result := Default; +end; +{$ENDIF} + +{$IFDEF PS_NEED_UINTTOSTR} +function UIntToStr(Value: UInt64): string; +begin + Str(Value, Result); +end; +{$ENDIF} + end.