(*
BSD 2-Clause License
Copyright (c) 2016, 2018, 2020, Anton Krotov
All rights reserved.
*)
MODULE Out;
IMPORT HOST, SYSTEM;
PROCEDURE Char* (c: CHAR);
BEGIN
HOST.OutChar(c)
END Char;
PROCEDURE String* (s: ARRAY OF CHAR);
VAR
i, n: INTEGER;
BEGIN
n := LENGTH(s) - 1;
FOR i := 0 TO n DO
Char(s[i])
END
END String;
PROCEDURE Int* (x, width: INTEGER);
VAR
i, a: INTEGER;
str: ARRAY 12 OF CHAR;
BEGIN
IF x = 80000000H THEN
COPY("-2147483648", str);
DEC(width, 11)
ELSE
i := 0;
IF x < 0 THEN
x := -x;
i := 1;
str[0] := "-"
END;
a := x;
REPEAT
INC(i);
a := a DIV 10
UNTIL a = 0;
str[i] := 0X;
DEC(width, i);
REPEAT
DEC(i);
str[i] := CHR(x MOD 10 + ORD("0"));
x := x DIV 10
UNTIL x = 0
END;
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
String(str)
END Int;
PROCEDURE Inf (x: REAL; width: INTEGER);
VAR
s: ARRAY 5 OF CHAR;
BEGIN
DEC(width, 4);
IF x # x THEN
s := " Nan"
ELSIF x = SYSTEM.INF() THEN
s := "+Inf"
ELSIF x = -SYSTEM.INF() THEN
s := "-Inf"
END;
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
String(s)
END Inf;
PROCEDURE Ln*;
BEGIN
Char(0DX);
Char(0AX)
END Ln;
PROCEDURE unpk10 (VAR x: REAL; VAR n: INTEGER);
VAR
a, b: REAL;
BEGIN
ASSERT(x > 0.0);
n := 0;
WHILE x < 1.0 DO
x := x * 10.0;
DEC(n)
END;
a := 10.0;
b := 1.0;
WHILE a <= x DO
b := a;
a := a * 10.0;
INC(n)
END;
x := x / b
END unpk10;
PROCEDURE _Real (x: REAL; width: INTEGER);
VAR
n, k, p: INTEGER;
BEGIN
p := MIN(MAX(width - 7, 1), 10);
width := width - p - 7;
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
IF x < 0.0 THEN
Char("-");
x := -x
ELSE
Char(20X)
END;
unpk10(x, n);
k := FLOOR(x);
Char(CHR(k + 30H));
Char(".");
WHILE p > 0 DO
x := (x - FLT(k)) * 10.0;
k := FLOOR(x);
Char(CHR(k + 30H));
DEC(p)
END;
Char("E");
IF n >= 0 THEN
Char("+")
ELSE
Char("-")
END;
n := ABS(n);
Char(CHR(n DIV 10 + 30H));
Char(CHR(n MOD 10 + 30H))
END _Real;
PROCEDURE Real* (x: REAL; width: INTEGER);
BEGIN
IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
Inf(x, width)
ELSIF x = 0.0 THEN
WHILE width > 17 DO
Char(20X);
DEC(width)
END;
DEC(width, 8);
String(" 0.0");
WHILE width > 0 DO
Char("0");
DEC(width)
END;
String("E+00")
ELSE
_Real(x, width)
END
END Real;
PROCEDURE _FixReal (x: REAL; width, p: INTEGER);
VAR
n, k: INTEGER;
minus: BOOLEAN;
BEGIN
minus := x < 0.0;
IF minus THEN
x := -x
END;
unpk10(x, n);
DEC(width, 3 + MAX(p, 0) + MAX(n, 0));
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
IF minus THEN
Char("-")
ELSE
Char(20X)
END;
IF n < 0 THEN
INC(n);
Char("0");
Char(".");
WHILE (n < 0) & (p > 0) DO
Char("0");
INC(n);
DEC(p)
END
ELSE
WHILE n >= 0 DO
k := FLOOR(x);
Char(CHR(k + 30H));
x := (x - FLT(k)) * 10.0;
DEC(n)
END;
Char(".")
END;
WHILE p > 0 DO
k := FLOOR(x);
Char(CHR(k + 30H));
x := (x - FLT(k)) * 10.0;
DEC(p)
END
END _FixReal;
PROCEDURE FixReal* (x: REAL; width, p: INTEGER);
BEGIN
IF (x # x) OR (ABS(x) = SYSTEM.INF()) THEN
Inf(x, width)
ELSIF x = 0.0 THEN
DEC(width, 3 + MAX(p, 0));
WHILE width > 0 DO
Char(20X);
DEC(width)
END;
String(" 0.");
WHILE p > 0 DO
Char("0");
DEC(p)
END
ELSE
_FixReal(x, width, p)
END
END FixReal;
PROCEDURE Open*;
END Open;
END Out.