From f4baabb9ce814dfe4d233ceca1fd5c23ecf461df Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 3 Jun 2026 13:22:10 +0100 Subject: [PATCH] fix(codegen): WriteLn(Double/Single) crashed QBE with type mismatch EmitWrite had no tyDouble/tySingle case; floats fell through to _SysWriteInt with a d-typed temp, which QBE rejected as an invalid argument type. Add _SysWriteDouble and _SysWriteSingle RTL stubs in rtl.platform.pas and rtl.platform.posix.pas (using the existing _DoubleToStr/_SingleToStr functions from blaise_float.pas). EmitWrite now dispatches to these stubs so WriteLn(someDouble) and WriteLn(someSingle) compile and run correctly without requiring DoubleToStr at the call site. Two new e2e tests (TestRun_WriteLn_Double_Direct, TestRun_WriteLn_Single_Direct) verify direct float output; 2375 tests pass. --- compiler/src/main/pascal/uCodeGenQBE.pas | 6 +++ compiler/src/test/pascal/cp.test.e2e.math.pas | 42 ++++++++++++++++++ runtime/src/main/pascal/rtl.platform.pas | 2 + .../src/main/pascal/rtl.platform.posix.pas | 44 +++++++++++++++++++ 4 files changed, 94 insertions(+) diff --git a/compiler/src/main/pascal/uCodeGenQBE.pas b/compiler/src/main/pascal/uCodeGenQBE.pas index c2f8230..78ae899 100644 --- a/compiler/src/main/pascal/uCodeGenQBE.pas +++ b/compiler/src/main/pascal/uCodeGenQBE.pas @@ -6711,6 +6711,12 @@ begin ArgTemp := EmitExpr(ArgExpr); if IsString then EmitLine(Format(' call $_SysWriteStr(w %s, l %s)', [FdLit, ArgTemp])) + else if (ArgExpr.ResolvedType <> nil) and + (ArgExpr.ResolvedType.Kind = tyDouble) then + EmitLine(Format(' call $_SysWriteDouble(w %s, d %s)', [FdLit, ArgTemp])) + else if (ArgExpr.ResolvedType <> nil) and + (ArgExpr.ResolvedType.Kind = tySingle) then + EmitLine(Format(' call $_SysWriteSingle(w %s, s %s)', [FdLit, ArgTemp])) else if (ArgExpr.ResolvedType <> nil) and (ArgExpr.ResolvedType.Kind = tyUInt64) then EmitLine(Format(' call $_SysWriteUInt64(w %s, l %s)', [FdLit, ArgTemp])) diff --git a/compiler/src/test/pascal/cp.test.e2e.math.pas b/compiler/src/test/pascal/cp.test.e2e.math.pas index 8529dcc..191ecd8 100644 --- a/compiler/src/test/pascal/cp.test.e2e.math.pas +++ b/compiler/src/test/pascal/cp.test.e2e.math.pas @@ -148,6 +148,10 @@ type { Real division `/` with Integer operands yields a float } procedure TestRun_RealDiv_IntegerOperands_RoundTrunc; procedure TestRun_RealDiv_TenOverFour_Half; + + { WriteLn(Double) / WriteLn(Single) — direct float output without DoubleToStr } + procedure TestRun_WriteLn_Double_Direct; + procedure TestRun_WriteLn_Single_Direct; end; implementation @@ -1441,6 +1445,44 @@ begin AssertEquals('10/4', '2.5', Trim(Output)); end; +{ ------------------------------------------------------------------ } +{ WriteLn(Double) / WriteLn(Single) direct float output } +{ ------------------------------------------------------------------ } + +procedure TE2EMathTests.TestRun_WriteLn_Double_Direct; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRun( + ''' + program P; + var D: Double; + begin + D := 3.14; + WriteLn(D) + end. + ''', Output, RCode)); + AssertEquals('exit code', 0, RCode); + AssertEquals('WriteLn(Double)', '3.14', Trim(Output)); +end; + +procedure TE2EMathTests.TestRun_WriteLn_Single_Direct; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable then begin Ignore('toolchain unavailable'); Exit; end; + AssertTrue('compile+run', CompileAndRun( + ''' + program P; + var S: Single; + begin + S := 1.5; + WriteLn(S) + end. + ''', Output, RCode)); + AssertEquals('exit code', 0, RCode); + AssertEquals('WriteLn(Single)', '1.5', Trim(Output)); +end; + initialization RegisterTest(TE2EMathTests); diff --git a/runtime/src/main/pascal/rtl.platform.pas b/runtime/src/main/pascal/rtl.platform.pas index 760dc5e..4ff7f71 100644 --- a/runtime/src/main/pascal/rtl.platform.pas +++ b/runtime/src/main/pascal/rtl.platform.pas @@ -58,6 +58,8 @@ type procedure SysWriteInt(Fd: Integer; N: Integer); virtual; abstract; procedure SysWriteInt64(Fd: Integer; N: Int64); virtual; abstract; procedure SysWriteUInt64(Fd: Integer; N: UInt64); virtual; abstract; + procedure SysWriteDouble(Fd: Integer; V: Double); virtual; abstract; + procedure SysWriteSingle(Fd: Integer; V: Single); virtual; abstract; procedure SysWriteNewline(Fd: Integer); virtual; abstract; { File-descriptor primitives — used by streams } diff --git a/runtime/src/main/pascal/rtl.platform.posix.pas b/runtime/src/main/pascal/rtl.platform.posix.pas index 9a2f171..2662748 100644 --- a/runtime/src/main/pascal/rtl.platform.posix.pas +++ b/runtime/src/main/pascal/rtl.platform.posix.pas @@ -66,6 +66,8 @@ type procedure SysWriteInt(Fd: Integer; N: Integer); override; procedure SysWriteInt64(Fd: Integer; N: Int64); override; procedure SysWriteUInt64(Fd: Integer; N: UInt64); override; + procedure SysWriteDouble(Fd: Integer; V: Double); override; + procedure SysWriteSingle(Fd: Integer; V: Single); override; procedure SysWriteNewline(Fd: Integer); override; { File-descriptor primitives } @@ -157,6 +159,8 @@ procedure _BlaiseFreeMem(Ptr: Pointer); external name '_BlaiseFreeMem'; function _IntToStr(N: Integer): Pointer; external name '_IntToStr'; function _Int64ToStr(N: Int64): Pointer; external name '_Int64ToStr'; function _UInt64ToStr(N: UInt64): Pointer; external name '_UInt64ToStr'; +function _DoubleToStr(V: Double): Pointer; external name '_DoubleToStr'; +function _SingleToStr(V: Single): Pointer; external name '_SingleToStr'; procedure _StringAddRef(Ptr: Pointer); external name '_StringAddRef'; procedure _StringRelease(Ptr: Pointer); external name '_StringRelease'; @@ -237,6 +241,8 @@ procedure _SysWriteStr(Fd: Integer; S: Pointer); procedure _SysWriteInt(Fd: Integer; N: Integer); procedure _SysWriteInt64(Fd: Integer; N: Int64); procedure _SysWriteUInt64(Fd: Integer; N: UInt64); +procedure _SysWriteDouble(Fd: Integer; V: Double); +procedure _SysWriteSingle(Fd: Integer; V: Single); procedure _SysWriteNewline(Fd: Integer); { File-descriptor primitives } @@ -768,6 +774,34 @@ begin _StringRelease(S); end; +procedure TRtlPlatformPosix.SysWriteDouble(Fd: Integer; V: Double); +var + S: Pointer; + LPtr: ^Integer; + Len: Integer; +begin + S := _DoubleToStr(V); + _StringAddRef(S); + LPtr := S - 8; + Len := LPtr^; + WriteAllToFd(Fd, PChar(S), Len); + _StringRelease(S); +end; + +procedure TRtlPlatformPosix.SysWriteSingle(Fd: Integer; V: Single); +var + S: Pointer; + LPtr: ^Integer; + Len: Integer; +begin + S := _SingleToStr(V); + _StringAddRef(S); + LPtr := S - 8; + Len := LPtr^; + WriteAllToFd(Fd, PChar(S), Len); + _StringRelease(S); +end; + { ================================================================== } { TRtlPlatformPosix — File-descriptor primitives } { ================================================================== } @@ -1233,6 +1267,16 @@ begin GRtlPlatform.SysWriteUInt64(Fd, N); end; +procedure _SysWriteDouble(Fd: Integer; V: Double); +begin + GRtlPlatform.SysWriteDouble(Fd, V); +end; + +procedure _SysWriteSingle(Fd: Integer; V: Single); +begin + GRtlPlatform.SysWriteSingle(Fd, V); +end; + procedure _SysWriteNewline(Fd: Integer); begin GRtlPlatform.SysWriteNewline(Fd);