143 lines
4.5 KiB
Plaintext
143 lines
4.5 KiB
Plaintext
MODULE out; (* formatted output to stdout *)
|
|
(* Wim Niemann, Jan Tuitman 06-OCT-2016 *)
|
|
|
|
IMPORT SYSTEM, _unix;
|
|
|
|
(* example: IMPORT o:=out;
|
|
o.str("Hello, World!");o.nl;
|
|
o.formatInt("n = %", 3);o.nl;
|
|
*)
|
|
|
|
(*
|
|
The output functions buffer the characters in buf. This buffer is flushed when out.nl is
|
|
called and also when the buffer is full.
|
|
|
|
Calling flush once per line is far more efficient then one system call per
|
|
character, but this is noticable only at very long outputs.
|
|
*)
|
|
|
|
CONST MAX = 63; (* last position in buf *)
|
|
|
|
VAR len :INTEGER; (* string length in buf *)
|
|
buf :ARRAY MAX+1 OF BYTE;
|
|
|
|
PROCEDURE exit* (n :INTEGER);
|
|
(* prevent IMPORT unix for many programs *)
|
|
BEGIN _unix._exit(n) END exit;
|
|
|
|
PROCEDURE writeChars;
|
|
(* write buf to the output function and set to empty string *)
|
|
VAR ri :INTEGER;
|
|
BEGIN
|
|
IF len > 0 THEN
|
|
(* buf[len] := 0X; *)
|
|
ri := _unix._write (1, SYSTEM.ADR(buf), len); ASSERT (ri = len); (* stdout *)
|
|
len := 0
|
|
END
|
|
END writeChars;
|
|
|
|
PROCEDURE nl*; (* append a newline to buf and flush *)
|
|
BEGIN
|
|
IF len = MAX THEN writeChars END;
|
|
buf[len] := 0AH; INC(len);
|
|
(* unix: 0AX; Oberon: 0DX;
|
|
Windows: IF len >= MAX-1 THEN 0DX 0AX; *)
|
|
writeChars;
|
|
END nl;
|
|
|
|
PROCEDURE char* (c :CHAR);
|
|
(* append char to the end of buf *)
|
|
BEGIN
|
|
IF len = MAX THEN writeChars END;
|
|
buf[len] := ORD(c); INC(len)
|
|
END char;
|
|
|
|
PROCEDURE str* (t :ARRAY OF CHAR);
|
|
(* append t to buf *)
|
|
VAR j :INTEGER;
|
|
BEGIN
|
|
j := 0; WHILE t[j] # 0X DO char(t[j]); INC(j) END
|
|
END str;
|
|
|
|
PROCEDURE int* (n :INTEGER);
|
|
(* append integer; append n to d, return TRUE on overflow of d *)
|
|
VAR j :INTEGER;
|
|
sign :BOOLEAN;
|
|
dig :ARRAY 11 OF CHAR; (* assume 32 bit INTEGER *)
|
|
BEGIN
|
|
sign := FALSE; IF n < 0 THEN sign := TRUE; n := -n END;
|
|
IF n < 0 THEN
|
|
str ("-2147483648");
|
|
ELSE
|
|
j := 0;
|
|
REPEAT dig[j] := CHR (n MOD 10 + 30H); n := n DIV 10; INC(j) UNTIL n = 0;
|
|
IF sign THEN char ("-") END;
|
|
REPEAT DEC(j); char(dig[j]) UNTIL j = 0;
|
|
END
|
|
END int;
|
|
|
|
PROCEDURE formatInt* (t :ARRAY OF CHAR; n :INTEGER);
|
|
(* append formatted string t. Replace the first % by n *)
|
|
VAR j :INTEGER;
|
|
BEGIN
|
|
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
|
|
IF t[j] = "%" THEN
|
|
int(n); INC(j);
|
|
WHILE t[j] # 0X DO char(t[j]); INC(j) END
|
|
END
|
|
END formatInt;
|
|
|
|
PROCEDURE formatInt2* (t:ARRAY OF CHAR; n1, n2 :INTEGER);
|
|
(* append formatted string t. Replace the first two % by n1 and n2 *)
|
|
VAR j :INTEGER;
|
|
BEGIN
|
|
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
|
|
IF t[j] = "%" THEN
|
|
int(n1); INC(j);
|
|
WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
|
|
IF t[j] = "%" THEN
|
|
int(n2); INC(j);
|
|
WHILE t[j] # 0X DO char(t[j]); INC(j) END
|
|
END
|
|
END
|
|
END formatInt2;
|
|
|
|
PROCEDURE formatStr* (t, u :ARRAY OF CHAR);
|
|
(* append formatted string. Replace the first % in t by u *)
|
|
VAR j, k :INTEGER;
|
|
BEGIN
|
|
j := 0; WHILE (t[j] # 0X) & (t[j] # "%") DO char(t[j]); INC(j) END;
|
|
IF t[j] = "%" THEN
|
|
k := 0; WHILE u[k] # 0X DO char(u[k]); INC(k) END;
|
|
INC(j); WHILE t[j] # 0X DO char(t[j]); INC(j) END
|
|
END
|
|
END formatStr;
|
|
|
|
PROCEDURE hex* (n, width :INTEGER);
|
|
(* print width positions of n as hex string. If necessary, prefix with leading zeroes *)
|
|
(* note: if n needs more positions than width, the first hex digits are not printed *)
|
|
VAR j :INTEGER;
|
|
dig :ARRAY 9 OF CHAR;
|
|
BEGIN
|
|
ASSERT(width > 0);
|
|
ASSERT (width <= 8);
|
|
dig[width] := 0X;
|
|
REPEAT
|
|
j := n MOD 16; n := n DIV 16;
|
|
IF j < 10 THEN j := ORD("0") + j ELSE j := ORD("A") + j - 10 END;
|
|
DEC(width); dig[width] := CHR(j)
|
|
UNTIL width = 0;
|
|
str (dig);
|
|
END hex;
|
|
|
|
PROCEDURE flush*;
|
|
(* this routine comes at the end. It won't hardly ever be called
|
|
because nl also flushes. It is present only in case you
|
|
want to write a flushed string which does not end with nl. *)
|
|
BEGIN writeChars END flush;
|
|
|
|
(* note: global variable 'len' must be 0 on init. Within the core, bodies of imported modules
|
|
are not executed, so rely on zero initialisation by Modules.Load *)
|
|
END out.
|
|
|