498da3221e
git-svn-id: svn://kolibrios.org@8859 a494cfbc-eb01-0410-851d-a64ba20cac60
273 lines
4.2 KiB
Plaintext
273 lines
4.2 KiB
Plaintext
(*
|
|
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. |