TP3/shell/tests/RtProbe.mod

MODULE RtProbe ;

(* Dump the assembled runtime: size, entry offsets, hex.  Kept separate from
   CompileTest so the library can be checked on its own, before the compiler
   is wired to it. *)

FROM Posix IMPORT write ;
FROM Runtime IMPORT RT_Build, RT_Size, RT_Byte, RT_Entry ;
FROM SYSTEM IMPORT ADR, BYTE ;

VAR
   c : CHAR ;

PROCEDURE PC (ch : CHAR ) ;
VAR n : LONGINT ;
BEGIN
   n := write (1, ADR (ch), 1)
END PC ;

PROCEDURE PS (s : ARRAY OF CHAR ) ;
VAR i : CARDINAL ; n : LONGINT ;
BEGIN
   i := 0 ;
   WHILE (i <= HIGH (s)) AND (s [i] # 0C) DO
      n := write (1, ADR (s [i]), 1) ;
      INC (i)
   END
END PS ;

PROCEDURE PCARD (n : CARDINAL ) ;
VAR d : ARRAY [0..9] OF CHAR ; i : CARDINAL ;
BEGIN
   IF n = 0 THEN
      PC ("0")
   ELSE
      i := 0 ;
      WHILE n > 0 DO
         d [i] := CHR (ORD ("0") + (n MOD 10)) ;
         n := n DIV 10 ;
         INC (i)
      END ;
      WHILE i > 0 DO
         DEC (i) ;
         PC (d [i])
      END
   END
END PCARD ;

PROCEDURE NL ; BEGIN PC (CHR (13)) ; PC (CHR (10)) END NL ;

PROCEDURE PHEX (b : CARDINAL ) ;
VAR d : CARDINAL ;
BEGIN
   d := b DIV 16 ;
   IF d < 10 THEN PC (CHR (ORD ("0") + d)) ELSE PC (CHR (ORD ("A") + d - 10)) END ;
   d := b MOD 16 ;
   IF d < 10 THEN PC (CHR (ORD ("0") + d)) ELSE PC (CHR (ORD ("A") + d - 10)) END
END PHEX ;

PROCEDURE PENT (i : CARDINAL ; name : ARRAY OF CHAR ) ;
BEGIN
   PS ("  entry ") ; PCARD (i) ; PS (" = ") ; PCARD (RT_Entry (i)) ;
   PS ("  (") ; PS (name) ; PS (")") ; NL
END PENT ;

PROCEDURE Main ;
VAR i, n : CARDINAL ;
    names : ARRAY [0..12] OF ARRAY [0..15] OF CHAR ;
BEGIN
   RT_Build () ;
   PCARD (RT_Size ()) ; PS (" bytes") ; NL ;
   i := 0 ;
   WHILE i <= 12 DO
      names [i] := "" ;
      INC (i)
   END ;
   names [0] := "initmem" ;  names [1] := "progend" ; names [2] := "stackchk" ;
   names [3] := "wrint" ;   names [4] := "wrchar" ;  names [5] := "wrbool" ;
   names [6] := "wrreal" ;  names [7] := "wrln" ;    names [8] := "rdint" ;
   names [9] := "rdchar" ;  names [10] := "rdbool" ; names [11] := "rdln" ;
   names [12] := "halt" ;
   i := 0 ;
   WHILE i <= 12 DO
      PENT (i, names [i]) ;
      INC (i)
   END ;
   PS ("  hex:") ; NL ;
   i := 0 ;
   WHILE i < RT_Size () DO
      PHEX ((i DIV 65536) MOD 16) ; PHEX ((i DIV 4096) MOD 16) ;
      PHEX ((i DIV 256) MOD 16) ; PHEX (i MOD 16) ;
      PS ("  ") ;
      n := 0 ;
      WHILE (n < 16) AND (i + n < RT_Size ()) DO
         PHEX (VAL (CARDINAL, RT_Byte (i + n))) ;
         PC (" ") ;
         INC (n)
      END ;
      NL ;
      i := i + 16
   END
END Main ;

BEGIN
   Main
END RtProbe.