[Oberon] trace prints

[Wim Niemann]

Hello,

There have been remarks about reporting from the inner core. My approach was to use print statements; here I present the source text.

With help of Jan Tuitman I have written out.mod to enable print statements everywhere, also in the inner core.
The only dependency is 'write a zero terminated ARRAY OF CHAR', e.g. to serial port or stdout.

As a minimum, string and integer suffice. I added a small buffer and formatted strings. As guideline to keep it small enough, each procedure should be frequently used.

The result serves me well. The source below is suited to my personal preferences and differs from the Project Oberon style, so to become useful to others, it probably will change. This module was compiled in a version of Peter de Wachter's Norebo just before Kernel.mod, FileDir.mod, etc.

Wim Niemann



MODULE out;    (* formatted output to stdout *)
(* Wim Niemann, Jan Tuitman 06-OCT-2016 *)

IMPORT SYSTEM, Norebo;

(* 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 CHAR;

PROCEDURE writeChars;
	(* write buf to the output function and set to empty string *)
BEGIN
	IF len > 0 THEN
		buf[len] := 0X;
		Norebo.SysReq (Norebo.noreboPrint, SYSTEM.ADR(buf), 0, 0);
		len := 0
	END
END writeChars;

PROCEDURE nl*;	(* append a newline to buf and flush *)
BEGIN
	IF len = MAX THEN writeChars END;
	buf[len] := 0DX; 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] := 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.