converting and writing real constants exactly

the scanner built a decimal constant digit by digit, rounding at
each step (1.1D3 was not 1100), and the code generator wrote reals
with 15 digits, so very small values came out as 0 (LowReal.small,
LowLReal.small, MathL's miny). now the scanner converts with strtod
and strtof, a constant is out of range only when its value is, and
reals are written with 17 significant digits, which read back as the
same double. MAX(REAL) and MAX(LONGREAL) are set from their bits
(MAX(LONGREAL) was 1.79769296342094D308).

src/compiler/OPM.Mod

@@ -754,13 +754,30 @@ MODULE OPM;  (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96  *)
     END;
   END WriteInt;
 
+  (* r with 17 significant digits, which read back as the same double: 15 digits lost precision,
+     and very small values (as LowLReal.small) came out as 0 *)
+  PROCEDURE -AAincludeStdio '#include <stdio.h>';
+  PROCEDURE -FormatReal(buf: SYSTEM.ADDRESS; r: LONGREAL) 'snprintf((char*)(ADDRESS)(buf), 40, "%.17g", r)';
+
+  PROCEDURE WriteExactReal(r: LONGREAL);
+    VAR s: ARRAY 40 OF CHAR; i: INTEGER; real: BOOLEAN;
+  BEGIN
+    FormatReal(SYSTEM.ADR(s), r);
+    i := 0; real := FALSE;
+    WHILE s[i] # 0X DO IF (s[i] = ".") OR (s[i] = "e") THEN real := TRUE END; INC(i) END;
+    IF ~real THEN s[i] := "."; s[i+1] := "0"; s[i+2] := 0X END;  (* not an integer constant in C *)
+    WriteStringVar(s)
+  END WriteExactReal;
+
   PROCEDURE WriteReal* (r: LONGREAL; suffx: CHAR);
     VAR W: Texts.Writer; T: Texts.Text; R: Texts.Reader; s: ARRAY 32 OF CHAR; ch: CHAR; i: INTEGER;
   BEGIN
-(*should be improved *)
     IF (r < SignedMaximum(LongintSize)) & (r > SignedMinimum(LongintSize)) & (r = ENTIER(r)) THEN
       IF suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ;
       WriteInt(ENTIER(r))
+    ELSIF SYSTEM.VAL(SYSTEM.INT64, r) DIV 10000000000000H MOD 800H # 7FFH THEN  (* not inf or nan *)
+      IF suffx = "f" THEN WriteString("(REAL)") ELSE WriteString("(LONGREAL)") END ;
+      WriteExactReal(r)
     ELSE
       Texts.OpenWriter(W);
       IF suffx = "f" THEN Texts.WriteLongReal(W, r, 16) ELSE Texts.WriteLongReal(W, r, 23) END ;
@@ -895,9 +912,17 @@ MODULE OPM;  (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96  *)
 
 
 
+  (* the largest REAL and LONGREAL, from their bits: 1.7976931348623157D307 * 9.999999 was
+     1.79769296342094D308, and older compilers refuse the exponent 308 *)
+  PROCEDURE SetMaxReals;
+    VAR i32: SYSTEM.INT32; i64: SYSTEM.INT64; r: REAL;
+  BEGIN
+    i32 := 7F7FFFFFH; r := SYSTEM.VAL(REAL, i32); MaxReal := r;
+    i64 := 7FEFFFFFFFFFFFFFH; MaxLReal := SYSTEM.VAL(LONGREAL, i64)
+  END SetMaxReals;
+
 BEGIN
-  MaxReal := 3.40282346D38;                      (* REAL is 4 bytes *)
+  SetMaxReals;
-  MaxLReal := 1.7976931348623157D307 * 9.999999; (* LONGREAL is 8 bytes, should be 1.7976931348623157D308 *)
   MinReal  := -MaxReal;
   MinLReal := -MaxLReal;
   FindInstallDir;

src/compiler/OPS.Mod

@@ -89,20 +89,15 @@ MODULE OPS;  (* NW, RC 6.3.89 / 18.10.92 *)    (* object model 3.6.92 *)
     name[i] := 0X; sym := ident
   END Identifier;
 
+  (* the decimal constants of the scanner, correctly rounded by the C library *)
+  PROCEDURE -Astdlib '#include <stdlib.h>';
+  PROCEDURE -strtod(s: SYSTEM.ADDRESS): LONGREAL '(LONGREAL)strtod((const char*)(ADDRESS)(s), 0)';
+  PROCEDURE -strtof(s: SYSTEM.ADDRESS): REAL '(REAL)strtof((const char*)(ADDRESS)(s), 0)';
+
   PROCEDURE Number;
     CONST maxhexdigits = 16;
-    VAR i, m, n, d, e: INTEGER; dig: ARRAY 24 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
+    VAR i, m, n, d, e, k, j: INTEGER; dig: ARRAY 40 OF CHAR; f: LONGREAL; expCh: CHAR; neg: BOOLEAN;
-
+      num: ARRAY 64 OF CHAR; exp: ARRAY 8 OF CHAR;
-    PROCEDURE Ten(e: INTEGER): LONGREAL;
-      VAR x, p: LONGREAL;
-    BEGIN x := 1; p := 10;
-      WHILE e > 0 DO
-        IF ODD(e) THEN x := x*p END;
-        e := e DIV 2;
-        IF e > 0 THEN p := p*p END (* prevent overflow *)
-      END;
-      RETURN x
-    END Ten;
 
     PROCEDURE Ord(ch: CHAR; hex: BOOLEAN): INTEGER;
     BEGIN (* ("0" <= ch) & (ch <= "9") OR ("A" <= ch) & (ch <= "F") *)
@@ -153,6 +148,8 @@ MODULE OPS;  (* NW, RC 6.3.89 / 18.10.92 *)    (* object model 3.6.92 *)
       END
     ELSE (* fraction *)
       f := 0; e := 0; expCh := "E";
+      num[0] := "0"; num[1] := "."; k := 2; j := 0;  (* "0.digits" for strtod, with "e" exp below *)
+      WHILE j < n DO num[k] := dig[j]; INC(k); INC(j) END;
       WHILE n > 0 DO (* 0 <= f < 1 *) DEC(n); f := (Ord(dig[n], FALSE) + f)/10 END;
       IF (ch = "E") OR (ch = "D") THEN expCh := ch; OPM.Get(ch); neg := FALSE;
         IF ch = "-" THEN neg := TRUE; OPM.Get(ch)
@@ -169,20 +166,18 @@ MODULE OPS;  (* NW, RC 6.3.89 / 18.10.92 *)    (* object model 3.6.92 *)
         END
       END;
       DEC(e, i-d-m); (* decimal point shift *)
+      num[k] := "e"; INC(k); IF e < 0 THEN num[k] := "-"; INC(k) END;
+      j := ABS(e); n := 0; REPEAT exp[n] := CHR(ORD("0") + j MOD 10); j := j DIV 10; INC(n) UNTIL j = 0;
+      WHILE n > 0 DO DEC(n); num[k] := exp[n]; INC(k) END;
+      num[k] := 0X;
+      (* the range is that of the result: infinite, or 0 from digits that are not, is too large
+         (was: the decimal exponent within MaxRExp, MaxLExp, which refused 1.17549435E-38) *)
       IF expCh = "E" THEN numtyp := real;
-        IF (1-OPM.MaxRExp < e) & (e <= OPM.MaxRExp) THEN
+        IF (e > -400) & (e < 400) THEN realval := strtof(SYSTEM.ADR(num)) ELSE realval := 0 END;
-          IF e < 0 THEN realval := SHORT(f / Ten(-e))
+        IF (realval > MAX(REAL)) OR (realval = 0) & (m > 0) THEN err(203) END
-          ELSE realval := SHORT(f * Ten(e))
-          END
-        ELSE err(203)
-        END
       ELSE numtyp := longreal;
-        IF (1-OPM.MaxLExp < e) & (e <= OPM.MaxLExp) THEN
+        IF (e > -400) & (e < 400) THEN lrlval := strtod(SYSTEM.ADR(num)) ELSE lrlval := 0 END;
-          IF e < 0 THEN lrlval := f / Ten(-e)
+        IF (lrlval > MAX(LONGREAL)) OR (lrlval = 0) & (m > 0) THEN err(203) END
-          ELSE lrlval := f * Ten(e)
-          END
-        ELSE err(203)
-        END
       END
     END
   END Number;

src/test/confidence/out/expected

@@ -6,7 +6,7 @@ Real number hex representation.
 -1.1D0:                BFF199999999999A
  1.1D3:                4091300000000000
  1.1D-3:               3F5205BC01A36E2F
- 1.2345678987654321D3: 40934A45874103D8
+ 1.2345678987654321D3: 40934A45874103E1
  0.0:                  0000000000000000
  0.000123D0:           3F201F31F46ED246
  1/0.0:                7FF0000000000000
@@ -68,7 +68,7 @@ Testing LONGREAL.
 -1.1D0:                                -1.1000000000000000D+000
  1.1D3:                                 1.1000000000000000D+003
  1.1D-3:                                1.1000000000000000D-003
- 1.2345678987654321D3:                  1.2345678987654300D+003
+ 1.2345678987654321D3:                  1.2345678987654320D+003
  0.0:                                   0.0000000000000000D+000
  0.000123D0:                            1.2300000000000000D-004
  1/0.0:                                                Infinity
@@ -134,7 +134,7 @@ Real number hex representation.
 -1.1D0:                BFF199999999999A
  1.1D3:                4091300000000000
  1.1D-3:               3F5205BC01A36E2F
- 1.2345678987654321D3: 40934A45874103D8
+ 1.2345678987654321D3: 40934A45874103E1
  0.0:                  0000000000000000
  0.000123D0:           3F201F31F46ED246
  1/0.0:                7FF0000000000000
@@ -196,7 +196,7 @@ Testing LONGREAL.
 -1.1D0:                                -1.1000000000000000D+000
  1.1D3:                                 1.1000000000000000D+003
  1.1D-3:                                1.1000000000000000D-003
- 1.2345678987654321D3:                  1.2345678987654300D+003
+ 1.2345678987654321D3:                  1.2345678987654320D+003
  0.0:                                   0.0000000000000000D+000
  0.000123D0:                            1.2300000000000000D-004
  1/0.0:                                                Infinity

src/test/confidence/planned-binary-change

@@ -1 +1 @@
-18 Dec 2016 16:55:53
+Tue Oct  6 20:11:12 +04 2026