mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-10-10 01:37:24 +00:00
d6d99b4fbe
the exponent digits were written before the mantissa was rounded, so a carry into the next power of ten was lost: 0.99999999999999989 came out as 1.0D-001, and Math.sqrt(1.0) as 1.00000E-01.
248 lines
8.3 KiB
Modula-2
248 lines
8.3 KiB
Modula-2
MODULE Out; (* DCW Brown. 2016-09-27 *)
|
|
(** Module Out provides a set of basic routines
|
|
for formatted output of characters, numbers, and strings.
|
|
It assumes a standard output stream to which the symbols are written. *)
|
|
|
|
IMPORT SYSTEM, Platform, Heap;
|
|
|
|
VAR
|
|
IsConsole-: BOOLEAN;
|
|
|
|
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;
|
|
(** Initializes the output stream. In this library does nothing, safe to never use. *)
|
|
PROCEDURE Open*;
|
|
BEGIN
|
|
END Open;
|
|
(** Writes the character to the end of the output stream. *)
|
|
PROCEDURE Char*(ch: CHAR);
|
|
BEGIN
|
|
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;
|
|
(** Writes the null-terminated character sequence str to the end of the output stream (without 0X). *)
|
|
PROCEDURE String*(str: ARRAY OF CHAR);
|
|
VAR l: LONGINT; error: Platform.ErrorCode;
|
|
BEGIN
|
|
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;
|
|
|
|
(** Writes the integer number x to the end of the output stream.
|
|
If the textual representation of x requires m characters,
|
|
x is right adjusted in a field of Max(n, m) characters
|
|
padded with blanks at the left end. a plus sign is not written. *)
|
|
PROCEDURE Int*(x, n: HUGEINT);
|
|
CONST zero = ORD('0');
|
|
VAR s: ARRAY 22 OF CHAR; i: INTEGER; negative: BOOLEAN;
|
|
BEGIN
|
|
negative := x < 0;
|
|
IF x = MIN(HUGEINT) THEN
|
|
s := "8085774586302733229"; i := 19
|
|
ELSE
|
|
IF x < 0 THEN x := - x END;
|
|
s[0] := CHR(zero + (x MOD 10)); x := x DIV 10;
|
|
i := 1; WHILE x # 0 DO
|
|
s[i] := CHR(zero + (x MOD 10));
|
|
x := x DIV 10;
|
|
INC(i)
|
|
END
|
|
END;
|
|
IF negative THEN s[i] := '-'; INC(i) END;
|
|
WHILE n > i DO Char(' '); DEC(n) END;
|
|
WHILE i > 0 DO DEC(i); Char(s[i]) END
|
|
END Int;
|
|
|
|
|
|
PROCEDURE Hex*(x, n: HUGEINT);
|
|
BEGIN
|
|
IF n < 1 THEN n := 1 ELSIF n > 16 THEN n := 16 END;
|
|
IF x >= 0 THEN
|
|
WHILE (n < 16) & (SYSTEM.LSH(x, -4*n) # 0) DO INC(n) END
|
|
END;
|
|
x := SYSTEM.ROT(x, 4*(16-n));
|
|
WHILE n > 0 DO
|
|
x := SYSTEM.ROT(x,4); DEC(n);
|
|
IF x MOD 16 < 10 THEN Char(CHR((x MOD 16) + ORD('0')))
|
|
ELSE Char(CHR((x MOD 16) - 10 + ORD('A'))) END
|
|
END
|
|
END Hex;
|
|
(** Writes an end-of-line symbol to the end of the output stream *)
|
|
PROCEDURE Ln*;
|
|
BEGIN String(Platform.NL); Flush;
|
|
END Ln;
|
|
|
|
|
|
(* Real and Longreal display *)
|
|
|
|
PROCEDURE digit(n: HUGEINT; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
|
|
BEGIN
|
|
DEC(i); s[i] := CHR(n MOD 10 + 48);
|
|
END digit;
|
|
|
|
PROCEDURE prepend(t: ARRAY OF CHAR; VAR s: ARRAY OF CHAR; VAR i: INTEGER);
|
|
VAR j: INTEGER; l: LONGINT;
|
|
BEGIN
|
|
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): LONGREAL;
|
|
VAR r, power: LONGREAL;
|
|
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 r
|
|
END Ten;
|
|
|
|
PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(INT64)(x)";
|
|
|
|
(** RealP(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
|
|
three-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.
|
|
LONGREAL is 1/sign, 11/exponent, 52/significand *)
|
|
|
|
PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN);
|
|
|
|
|
|
VAR
|
|
e: INTEGER; (* Exponent field *)
|
|
f: HUGEINT; (* Fraction field *)
|
|
s: ARRAY 30 OF CHAR; (* Buffer built backwards *)
|
|
i: INTEGER; (* Index into s *)
|
|
el: INTEGER; (* Exponent length *)
|
|
x0: LONGREAL;
|
|
nn: BOOLEAN; (* Number negative *)
|
|
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
|
|
e := SYSTEM.VAL(INTEGER, (SYSTEM.VAL(HUGEINT, x) DIV 10000000000000H) MOD 800H);
|
|
f := SYSTEM.VAL(HUGEINT, x) MOD 10000000000000H;
|
|
nn := (SYSTEM.VAL(HUGEINT, x) < 0) & ~((e = 7FFH) & (f # 0)); (* Ignore sign on Nan *)
|
|
IF nn THEN DEC(n) END;
|
|
|
|
i := LEN(s);
|
|
IF e = 7FFH THEN (* NaN / Infinity *)
|
|
IF f = 0 THEN prepend("Infinity", s, i) ELSE prepend("NaN", s, i) END
|
|
ELSE
|
|
(* Calculate number of significant digits caller has proposed space for, and
|
|
number of digits to generate. *)
|
|
IF long THEN
|
|
el := 3;
|
|
dr := n-6; (* Leave room for dp and '+D000' *)
|
|
IF dr > 17 THEN dr := 17 END; (* Limit to max useful significant digits *)
|
|
d := dr; (* Number of digits to generate *)
|
|
IF d < 15 THEN d := 15 END (* Generate enough digits to do trailing zero supporession *)
|
|
ELSE
|
|
el := 2;
|
|
dr := n-5; (* Leave room for dp and '+E00' *)
|
|
IF dr > 9 THEN dr := 9 END; (* Limit to max useful significant digits *)
|
|
d := dr; (* Number of digits to generate *)
|
|
IF d < 6 THEN d := 6 END (* Generate enough digits to do trailing zero supporession *)
|
|
END;
|
|
|
|
IF e = 0 THEN
|
|
WHILE el > 0 DO DEC(i); s[i] := "0"; DEC(el) END;
|
|
DEC(i); s[i] := "+";
|
|
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 / Ten(e) ELSE x := Ten(-e) * x END ;
|
|
IF x >= 10.0D0 THEN x := 0.1D0 * x; INC(e) END;
|
|
|
|
(* Scale x to enough significant digits to reliably test for trailing
|
|
zeroes or to the amount of space available, if greater. *)
|
|
x0 := Ten(d-1);
|
|
x := x0 * x;
|
|
x := x + 0.5D0; (* Do not combine with previous line as doing so
|
|
introduces a least significant bit difference
|
|
between 32 bit and 64 bit builds. *)
|
|
IF x >= 10.0D0 * x0 THEN x := 0.1D0 * x; INC(e) END;
|
|
m := Entier64(x);
|
|
|
|
(* Generate the exponent digits, after the rounding above, which can carry into it
|
|
(0.99999999999999989 was written as 1.0D-001) *)
|
|
en := e < 0; IF en THEN e := - e END;
|
|
WHILE el > 0 DO digit(e, s, i); e := e DIV 10; DEC(el) END;
|
|
DEC(i); IF en THEN s[i] := "-" ELSE s[i] := "+" END
|
|
END;
|
|
|
|
DEC(i); IF long THEN s[i] := "D" ELSE s[i] := "E" END;
|
|
|
|
(* Drop trailing zeroes where caller proposes to use less space *)
|
|
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;
|
|
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 RealP;
|
|
|
|
(** 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.*)
|
|
PROCEDURE Real*(x: REAL; n: INTEGER);
|
|
BEGIN RealP(x, n, FALSE);
|
|
END Real;
|
|
|
|
(** 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 three-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. *)
|
|
PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
|
|
BEGIN RealP(x, n, TRUE);
|
|
END LongReal;
|
|
|
|
BEGIN
|
|
IsConsole := Platform.IsConsole(Platform.StdOut);
|
|
in := 0
|
|
|
|
(** This module originally was designed by Martin Reiser
|
|
for the book "Programming in Oberon".
|
|
the specification was proposed by H. Moessenbock *)
|
|
|
|
END Out.
|
|
|