vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-06 04:02:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Out.Mod. Add buffer, simplify real output.

Browse source
This commit is contained in:
David Brown 2016-10-11 11:42:22 +01:00
parent ebd1a2e695
commit ee77ec43ca
200 changed files with 803 additions and 1045 deletions
Download patch file Download diff file Expand all files Collapse all files

170
src/runtime/Out.Mod
View file

@ -1,24 +1,46 @@
MODULE Out; (* DCW Brown. 2016-09-27 *)
IMPORT SYSTEM, Platform, Strings;
IMPORT SYSTEM, Platform;
VAR buf: ARRAY 128 OF CHAR; in: INTEGER;
PROCEDURE Flush*;
VAR error: Platform.ErrorCode;
BEGIN
IF in > 0 THEN error := Platform.Write(Platform.StdOut, SYSTEM.ADR(buf), in) END;
in := 0;
END Flush;
PROCEDURE Open*;
BEGIN
END Open;
PROCEDURE Char*(ch: CHAR);
VAR error: Platform.ErrorCode;
BEGIN
error := Platform.Write(Platform.StdOut, SYSTEM.ADR(ch), 1)
IF in >= LEN(buf) THEN Flush END;
buf[in] := ch; INC(in);
IF ch = 0AX THEN Flush END;
END Char;
PROCEDURE Length(VAR s: ARRAY OF CHAR): LONGINT;
VAR l: LONGINT;
BEGIN l := 0; WHILE (l < LEN(s)) & (s[l] # 0X) DO INC(l) END; RETURN l
END Length;
PROCEDURE String*(str: ARRAY OF CHAR);
VAR l: LONGINT; error: Platform.ErrorCode;
BEGIN
l := 0; WHILE (l < LEN(str)) & (str[l] # 0X) DO INC(l) END;
error := Platform.Write(Platform.StdOut, SYSTEM.ADR(str), l)
l := Length(str);
IF in + l > LEN(buf) THEN Flush END;
IF l > LEN(buf) THEN
(* Doesn't fit buf. Bypass buffering. *)
error := Platform.Write(Platform.StdOut, SYSTEM.ADR(str), l)
ELSE
SYSTEM.MOVE(SYSTEM.ADR(str), SYSTEM.ADR(buf[in]), l); INC(in, SHORT(l));
END
END String;
PROCEDURE Int*(x, n: HUGEINT);
CONST zero = ORD('0');
VAR s: ARRAY 22 OF CHAR; i: INTEGER; negative: BOOLEAN;
@ -41,7 +63,7 @@ BEGIN
END Int;
PROCEDURE Ln*;
BEGIN String(Platform.NL)
BEGIN String(Platform.NL); Flush;
END Ln;
@ -53,109 +75,27 @@ BEGIN
END digit;
PROCEDURE prepend(t: ARRAY OF CHAR; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
VAR j, l: INTEGER;
VAR j: INTEGER; l: LONGINT;
BEGIN
l := Strings.Length(t); IF l > i THEN l := i END;
DEC(i, l); j := 0;
l := Length(t); IF l > i THEN l := i END;
DEC(i, SHORT(l)); j := 0;
WHILE j < l DO s[i+j] := t[j]; INC(j) END
END prepend;
PROCEDURE Ten*(e: INTEGER): REAL;
PROCEDURE Ten*(e: INTEGER): LONGREAL;
VAR r, power: LONGREAL;
BEGIN r := 1.0; power := 10.0;
BEGIN r := 1.0D0; power := 1.0D1;
WHILE e > 0 DO
IF ODD(e) THEN r := r*power END;
power := power*power; e := e DIV 2
END;
RETURN SHORT(r)
END Ten;
PROCEDURE -Entier32(x: REAL): SYSTEM.INT32 "(int32)(x)";
PROCEDURE Real*(x: REAL; n: INTEGER);
(* Real(x, n) writes the real number x to the end of the output stream using an
exponential form. If the textual representation of x requires m characters (including a
two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters padded
with blanks at the left end. A plus sign of the mantissa is not written.
REAL is 1/sign, 8/exponent, 23/significand *)
CONST
maxsigdigits = 8; (* Max significant digits to display from mantissa *)
VAR
e: INTEGER; (* Exponent field *)
f: SYSTEM.INT32; (* Fraction field *)
s: ARRAY 30 OF CHAR; (* Buffer built backwards *)
i: INTEGER; (* Index into s *)
x0: REAL;
nn: BOOLEAN; (* Number negative *)
en: BOOLEAN; (* Exponent negative *)
m: SYSTEM.INT32; (* Mantissa digits *)
d: INTEGER; (* Significant digit count to display *)
BEGIN
nn := SYSTEM.VAL(SYSTEM.INT32, x) < 0; IF nn THEN DEC(n) END;
e := SYSTEM.VAL(INTEGER, (SYSTEM.VAL(SYSTEM.INT32, x) DIV 800000H) MOD 100H);
f := SYSTEM.VAL(SYSTEM.INT32, x) MOD 800000H;
i := LEN(s);
IF e = 0FFH THEN (* NaN / Infinity *)
IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
ELSE
IF e = 0 THEN prepend("E+00", s, i); m := 0;
ELSE
IF nn THEN x := -x END;
(* Scale e to be an exponent of 10 rather than 2 *)
e := (e - 127) * 77 DIV 256;
IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
IF x >= 10.0 THEN x := 0.1 * x; INC(e) END;
(* Generate the exponent digits *)
en := e < 0; IF en THEN e := - e END;
d := 2; WHILE d > 0 DO digit(e, s, i); e := e DIV 10; DEC(d) END;
IF en THEN prepend("E-", s, i) ELSE prepend("E+", s, i) END;
(* Scale x to 8 significant digits *)
x0 := Ten(maxsigdigits-1); x := x0*x + 0.5;
IF x >= 10.0*x0 THEN x := 0.1*x; INC(e) END;
m := Entier32(x)
END;
(* Drop trailing zeroes where we don't have room *)
d := maxsigdigits;
WHILE (d > 2) & (d > n-5) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
(* Render significant digits *)
WHILE d > 1 DO digit(m, s, i); m := m DIV 10; DEC(d) END;
DEC(i); s[i] := '.';
digit(m, s, i);
END;
(* Generate leading padding *)
DEC(n, LEN(s)-i); WHILE n > 0 DO Char(" "); DEC(n) END;
(* Render prepared number from right end of buffer s *)
IF nn THEN Char("-") END;
WHILE i < LEN(s) DO Char(s[i]); INC(i) END
END Real;
PROCEDURE TenL(e: INTEGER): LONGREAL;
VAR r, power: LONGREAL;
BEGIN r := 1.0; power := 10.0;
WHILE e > 0 DO
IF ODD(e) THEN r := r*power END;
power := power*power; e := e DIV 2;
END;
RETURN r
END TenL;
END Ten;
PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(int64)(x)";
PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
PROCEDURE RealP(x: LONGREAL; n, exponentdigits, maxsigdigits: INTEGER; exp: CHAR);
(* LongReal(x, n) writes the long real number x to the end of the output stream using an
exponential form. If the textual representation of x requires m characters (including a
@ -163,9 +103,6 @@ PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
with blanks at the left end. A plus sign of the mantissa is not written.
LONGREAL is 1/sign, 11/exponent, 52/significand *)
CONST
maxsigdigits = 16; (* Max significant digits to display from mantissa *)
VAR
e: INTEGER; (* Exponent field *)
f: HUGEINT; (* Fraction field *)
@ -176,6 +113,7 @@ VAR
en: BOOLEAN; (* Exponent negative *)
m: HUGEINT; (* Mantissa digits *)
d: INTEGER; (* Significant digit count to display *)
dr: INTEGER; (* Number of insignificant digits that can be dropped *)
BEGIN
nn := SYSTEM.VAL(HUGEINT, x) < 0; IF nn THEN DEC(n) END;
@ -186,22 +124,32 @@ BEGIN
IF e = 7FFH THEN (* NaN / Infinity *)
IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
ELSE
IF e = 0 THEN prepend("D+000", s, i); m := 0;
IF e = 0 THEN
d := i - exponentdigits; WHILE i > d DO DEC(i); s[i] := "0" END;
DEC(i); s[i] := "+";
DEC(i); s[i] := exp;
m := 0;
ELSE
IF nn THEN x := -x END;
(* Scale e to be an exponent of 10 rather than 2 *)
e := SHORT(LONG(e - 1023) * 77 DIV 256);
IF e >= 0 THEN x := x / TenL(e) ELSE x := TenL(-e) * x END ;
IF e >= 0 THEN x := x / Ten(e) ELSE x := Ten(-e) * x END ;
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
(* Generate the exponent digits *)
en := e < 0; IF en THEN e := - e END;
d := 3; WHILE d > 0 DO digit(e, s, i); e := e DIV 10; DEC(d) END;
IF en THEN prepend("D-", s, i) ELSE prepend("D+", s, i) END;
d := exponentdigits;
WHILE d > 0 DO digit(e, s, i); e := e DIV 10; DEC(d) END;
DEC(i); IF en THEN s[i] := "-" ELSE s[i] := "+" END;
DEC(i); s[i] := exp;
(* Scale x to 15 significant digits *)
x0 := TenL(maxsigdigits-1);
(* Todo: generate more than maxsigdigits if we have room for them *)
(* Scale x to enoughsignificant digits to reliably test for trailing
zeroes.
todo or to the amount of space available, if greater. *)
x0 := Ten(maxsigdigits-1);
x := x0 * x + 0.5D0;
IF x >= 10.0D0 * x0 THEN x := 0.1D0 * x; INC(e) END;
m := Entier64(x)
@ -209,7 +157,9 @@ BEGIN
(* Drop trailing zeroes where we don't have room *)
d := maxsigdigits;
WHILE (d > 2) & (d > n-6) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
dr := n - (exponentdigits + 3); (* 3 for '.', D/E and +/- *)
IF dr < 2 THEN dr := 2 END;
WHILE (d > dr) & (m MOD 10 = 0) DO m := m DIV 10; DEC(d) END;
(* Render significant digits *)
WHILE d > 1 DO digit(m, s, i); m := m DIV 10; DEC(d) END;
@ -223,7 +173,15 @@ BEGIN
(* Render prepared number from right end of buffer s *)
IF nn THEN Char("-") END;
WHILE i < LEN(s) DO Char(s[i]); INC(i) END
END RealP;
PROCEDURE Real*(x: REAL; n: INTEGER);
BEGIN RealP(x, n, 2, 7, "E");
END Real;
PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
BEGIN RealP(x, n, 3, 16, "D");
END LongReal;
END Out.

6
src/runtime/Strings.Mod
View file

@ -32,10 +32,10 @@ MODULE Strings; (*HM 94-06-22 / *)
PROCEDURE Length* (s: ARRAY OF CHAR): INTEGER;
VAR i: INTEGER;
VAR i: LONGINT;
BEGIN
i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END ;
RETURN i
i := 0; WHILE (i < LEN(s)) & (s[i] # 0X) DO INC(i) END;
IF i <= MAX(INTEGER) THEN RETURN SHORT(i) ELSE RETURN MAX(INTEGER) END
END Length;

36
src/test/confidence/out/expected
View file

@ -80,15 +80,15 @@ Testing REAL.
1 2 3
123456789012345678901234567890
1.0E0: 1.0000000E+00
1.1E0: 1.1000000E+00
2.1E0: 2.1000000E+00
-1.1E0: -1.1000000E+00
1.1E3: 1.1000000E+03
1.1E-3: 1.1000000E-03
1.2345678987654321E3: 1.2345680E+03
0.0: 0.0000000E+00
0.000123E0: 1.2300000E-04
1.0E0: 1.000000E+00
1.1E0: 1.100000E+00
2.1E0: 2.100000E+00
-1.1E0: -1.100000E+00
1.1E3: 1.100000E+03
1.1E-3: 1.100000E-03
1.2345678987654321E3: 1.234568E+03
0.0: 0.000000E+00
0.000123E0: 1.230000E-04
1/0.0: Infinity
-1/0.0: -Infinity
@ -176,15 +176,15 @@ Testing REAL.
1 2 3
123456789012345678901234567890
1.0E0: 1.0000000E+00
1.1E0: 1.1000000E+00
2.1E0: 2.1000000E+00
-1.1E0: -1.1000000E+00
1.1E3: 1.1000000E+03
1.1E-3: 1.1000000E-03
1.2345678987654321E3: 1.2345680E+03
0.0: 0.0000000E+00
0.000123E0: 1.2300000E-04
1.0E0: 1.000000E+00
1.1E0: 1.100000E+00
2.1E0: 2.100000E+00
-1.1E0: -1.100000E+00
1.1E3: 1.100000E+03
1.1E-3: 1.100000E-03
1.2345678987654321E3: 1.234568E+03
0.0: 0.000000E+00
0.000123E0: 1.230000E-04
1/0.0: Infinity
-1/0.0: -Infinity

18
src/test/confidence/out/result-O2
View file

@ -79,15 +79,15 @@ Testing REAL.
1 2 3
123456789012345678901234567890
1.0E0: 1.0000000E+00
1.1E0: 1.1000000E+00
2.1E0: 2.1000000E+00
-1.1E0: -1.1000000E+00
1.1E3: 1.1000000E+03
1.1E-3: 1.1000000E-03
1.2345678987654321E3: 1.2345680E+03
0.0: 0.0000000E+00
0.000123E0: 1.2300000E-04
1.0E0: 1.000000E+00
1.1E0: 1.100000E+00
2.1E0: 2.100000E+00
-1.1E0: -1.100000E+00
1.1E3: 1.100000E+03
1.1E-3: 1.100000E-03
1.2345678987654321E3: 1.234568E+03
0.0: 0.000000E+00
0.000123E0: 1.230000E-04
1/0.0: Infinity
-1/0.0: -Infinity

18
src/test/confidence/out/result-OC
View file

@ -79,15 +79,15 @@ Testing REAL.
1 2 3
123456789012345678901234567890
1.0E0: 1.0000000E+00
1.1E0: 1.1000000E+00
2.1E0: 2.1000000E+00
-1.1E0: -1.1000000E+00
1.1E3: 1.1000000E+03
1.1E-3: 1.1000000E-03
1.2345678987654321E3: 1.2345680E+03
0.0: 0.0000000E+00
0.000123E0: 1.2300000E-04
1.0E0: 1.000000E+00
1.1E0: 1.100000E+00
2.1E0: 2.100000E+00
-1.1E0: -1.100000E+00
1.1E3: 1.100000E+03
1.1E-3: 1.100000E-03
1.2345678987654321E3: 1.234568E+03
0.0: 0.000000E+00
0.000123E0: 1.230000E-04
1/0.0: Infinity
-1/0.0: -Infinity