The code below makes the following NASTY assumption: RTThread.ProcessStacks calls its argument twice for each thread -- the first time for the stack, the second time for its registers.

UNSAFE MODULE RTHeapStats;

IMPORT RT0, RTCollector, RTModule, RTIO, RTHeapMap, RTHeapRep, RTMisc;
IMPORT RTOS, RTType, RTTypeSRC, RTProcedure, RTProcedureSRC, RTMachine;
IMPORT RTStack, RTThread, Word, Text;
FROM RTIO IMPORT PutInt, PutAddr, PutText;

TYPE
  Info = RECORD
    module    : RT0.ModulePtr;
    thread_id : INTEGER;
    location  : ADDRESS;
    ref       : ADDRESS;
    n_objects : INTEGER;
    n_bytes   : INTEGER;
  END;

TYPE
  InfoSet = RECORD
    count : INTEGER;
    info  : ARRAY [0..19] OF Info;
  END;

TYPE
  ThreadInfo = RECORD
    id          : INTEGER;
    stack_start : ADDRESS;
    stack_stop  : ADDRESS;
    reg_start   : ADDRESS;
    reg_stop    : ADDRESS;
    dump        : BOOLEAN;
  END;

TYPE
  VisitStack = ARRAY [0..10000] OF ADDRESS;

CONST
  MapGrain = 2 * BYTESIZE (RT0.RefHeader);  (* = 1 bit in the map *)
  MapBitsPerHeapPage = RTHeapRep.BytesPerPage DIV MapGrain;
  MapWordsPerHeapPage = MapBitsPerHeapPage DIV BITSIZE (Word.T);

VAR
  units       : InfoSet;
  unit_roots  : InfoSet;
  stacks      : InfoSet;
  stack_roots : InfoSet;
  stack_pages : InfoSet;
  map         : UNTRACED REF ARRAY OF Word.T;
  heap_min    : ADDRESS;
  heap_max    : ADDRESS;
  n_types     : INTEGER;
  visit       : Info;
  visit_stack : UNTRACED REF VisitStack;
  top_of_stack: INTEGER;
  n_overflows : INTEGER;
  last_alloc  : ADDRESS;
  outerVisitor: RTHeapMap.Visitor := NIL;
  innerVisitor: RTHeapMap.Visitor := NIL;
  rootVisitor : RTHeapMap.Visitor := NIL;
  self_id     : INTEGER;
  n_threads   : INTEGER;
  threads     : ARRAY [0..199] OF ThreadInfo;

PROCEDURE ReportReachable () =
  CONST MByte = 1024 * 1024;
  BEGIN
    (* allocate space for the stats *)
    outerVisitor := NEW (RTHeapMap.Visitor, apply := Visit);
    innerVisitor := NEW (RTHeapMap.Visitor, apply := InnerVisit);
    rootVisitor  := NEW (RTHeapMap.Visitor, apply := VisitRoot);
    visit_stack  := NEW (UNTRACED REF VisitStack);
    map := NEW (UNTRACED REF ARRAY OF Word.T,
                 (RTHeapRep.p1 - RTHeapRep.p0) * MapWordsPerHeapPage);

    (* initialize the globals *)
    units.count       := 0;
    unit_roots.count  := 0;
    stacks.count      := 0;
    stack_roots.count := 0;
    stack_pages.count := 0;
    top_of_stack      := 0;
    n_overflows       := 0;
    n_threads         := 0;

    (* freeze the world *)
    RTCollector.Disable ();
    RTOS.LockHeap (); (* freeze the heap *)
    RTThread.SuspendOthers ();

    (* capture the heap limits *)
    heap_min  := LOOPHOLE (RTHeapRep.p0 * RTHeapRep.BytesPerPage, ADDRESS);
    heap_max  := LOOPHOLE (RTHeapRep.p1 * RTHeapRep.BytesPerPage, ADDRESS);
    n_types   := RTType.MaxTypecode () + 1;

    PutText ("\nHEAP: ");
    PutAddr (heap_min);
    PutText (" .. ");
    PutAddr (heap_max);
    PutText (" => ");
    PutInt ((heap_max - heap_min) DIV MByte);
    PutText (".");
    PutInt ((heap_max - heap_min) * 10 DIV MByte MOD 10);
    PutText (" Mbytes\n");

    (* find the edge of the new space *)
    last_alloc := LOOPHOLE (NEW (REF INTEGER), ADDRESS);

    (* capture the thread info *)
    GetThreads ();

    FOR i := 0 TO RTModule.Count() - 1 DO GetUnitStats (i); END;
    FOR i := 0 TO RTModule.Count() - 1 DO GetUnitRootStats (i); END;
    FOR i := 0 TO n_threads-1          DO GetThreadStats (threads[i]); END;
    FOR i := 0 TO n_threads-1          DO GetThreadRootStats (threads[i]); END;
    FOR i := 0 TO n_threads-1          DO GetThreadPageStats (threads[i]); END;

    IF (n_overflows > 0) THEN
      PutText ("  ** warning: ");
      PutInt (n_overflows);
      PutText (" paths, longer than ");
      PutInt (NUMBER (VisitStack));
      PutText (" REFs, were truncated.\n");
    END;

    ReportUnits ();
    ReportUnitRoots ();

    ReportStacks ();
    ReportStackRoots ();
    ReportStackPages ();

    DumpStacks ();
    RTIO.Flush ();

    (* thaw the world *)
    DISPOSE (visit_stack);
    DISPOSE (map);
    RTThread.ResumeOthers ();
    RTOS.UnlockHeap (); (* unfreeze the heap *)
    RTCollector.Enable ();
  END ReportReachable;

PROCEDURE ResetVisitCounts () =
  BEGIN
    visit.n_objects := 0;
    visit.n_bytes   := 0;
    top_of_stack    := 0;
    RTMisc.Zero (ADR (map[0]), BYTESIZE (map^));
  END ResetVisitCounts;

PROCEDURE AddVisit (VAR s: InfoSet) =
  VAR n: INTEGER;
  BEGIN
    (* if the set isn't full, make room for this visit *)
    IF (s.count < NUMBER (s.info)) THEN
      s.info[s.count].n_bytes := -1;
      INC (s.count);
    END;

    (* find where to insert this visit *)
    n := s.count-1;
    WHILE (n >= 0) AND (s.info[n].n_bytes < visit.n_bytes) DO
      IF (n < LAST(s.info)) THEN s.info[n+1] := s.info[n]; END;
      DEC (n);
    END;
    INC (n);

    (* insert the new root *)
    IF (n < s.count) THEN  s.info[n] := visit;  END;
  END AddVisit;

PROCEDURE Visit (<*UNUSED*> self: RTHeapMap.Visitor;  loc: ADDRESS) =
  BEGIN
    InnerVisit (NIL, loc);
    WHILE (top_of_stack > 0) DO
      DEC (top_of_stack);
      RTHeapMap.WalkRef (visit_stack[top_of_stack], innerVisitor);
    END;
  END Visit;

PROCEDURE InnerVisit (<*UNUSED*> self: RTHeapMap.Visitor;  loc: ADDRESS) =
  CONST Mask = ADRSIZE (RT0.RefHeader) - 1; (* assume it's 2^k-1 for some k *)
  VAR ptr : UNTRACED REF ADDRESS := loc;
  VAR ref : ADDRESS := ptr^;
  VAR header: RTHeapMap.ObjectPtr;
  VAR cell, word, bit, mask, typecode: INTEGER;
  BEGIN
    header := ref - ADRSIZE (RT0.RefHeader);
    IF (heap_min <= ref) AND (ref < heap_max)
      AND (Word.And (LOOPHOLE(ref, INTEGER), Mask) = 0) THEN
      typecode := header.typecode;
      IF (0 < typecode) AND (typecode < n_types) THEN
        cell := (ref - heap_min) DIV MapGrain;
        word := cell DIV BITSIZE (Word.T);
        bit  := cell - word * BITSIZE (Word.T);
        mask := Word.LeftShift (1, bit);
        IF (Word.And (mask, map[word]) = 0) THEN
          (* this is a new ref... *)
          map[word] := Word.Or (mask, map[word]);
          INC (visit.n_objects);
          INC (visit.n_bytes,
               RTHeapRep.ReferentSize(header) + BYTESIZE (RT0.RefHeader));
          IF (top_of_stack < NUMBER (VisitStack)) THEN
            visit_stack [top_of_stack] := header;
            INC (top_of_stack);
          ELSE
            INC (n_overflows);
          END;
        END;
      END;
    END;
  END InnerVisit;

PROCEDURE TypeName (ref: ADDRESS): TEXT =
  CONST Mask = ADRSIZE (RT0.RefHeader) - 1; (* assume it's 2^k-1 for some k *)
  VAR header: RTHeapMap.ObjectPtr;
  VAR typecode: INTEGER;
  BEGIN
    header := ref - ADRSIZE (RT0.RefHeader);
    IF (Word.And (LOOPHOLE (header, INTEGER), Mask) = 0) (* => aligned *)
      AND (heap_min <= ref) AND (ref < heap_max) THEN
      typecode := header.typecode;
      IF (0 < typecode) AND (typecode <= n_types) THEN
        RETURN RTTypeSRC.TypecodeName (typecode);
      END;
    END;
    RETURN "?";
  END TypeName;

PROCEDURE GetUnitStats (n: CARDINAL) =
  BEGIN
    visit.module     := RTModule.Get (n);
    visit.thread_id  := -1;
    visit.location   := NIL;
    visit.ref        := NIL;
    ResetVisitCounts ();
    RTHeapMap.WalkModuleGlobals (outerVisitor, n);
    AddVisit (units);
  END GetUnitStats;

PROCEDURE GetUnitRootStats (n: CARDINAL) =
  BEGIN
    visit.module     := RTModule.Get (n);
    visit.thread_id  := -1;
    visit.location   := NIL;
    visit.ref        := NIL;
    RTHeapMap.WalkModuleGlobals (rootVisitor, n);
  END GetUnitRootStats;

PROCEDURE VisitRoot (<*UNUSED*> self: RTHeapMap.Visitor;  root: ADDRESS) =
  VAR p: UNTRACED REF ADDRESS := root;
  BEGIN
    visit.location := root;
    visit.ref      := p^;
    ResetVisitCounts ();
    Visit (NIL, root);
    AddVisit (unit_roots);
  END VisitRoot;

VAR is_registers: BOOLEAN := FALSE;
    mark_addr: ADDRESS;

PROCEDURE GetThreads () =
  VAR i: INTEGER;
  BEGIN
    self_id := -1;
    mark_addr := ADR (i);
    RTThread.ProcessStacks (GetThread);
    RTIO.PutText ("Threads: ");
    RTIO.PutInt (n_threads);
    IF (n_threads > NUMBER (threads)) THEN
      RTIO.PutText ("  (");
      RTIO.PutInt (n_threads - NUMBER (threads));
      RTIO.PutText (" ignored)");
      n_threads := NUMBER (threads);
    END;
    RTIO.PutChar ('\n');
  END GetThreads;

PROCEDURE GetThread (start, stop: ADDRESS) =
  BEGIN
    IF (start <= mark_addr) AND (mark_addr <= stop) THEN
      self_id := n_threads;
    END;
    IF (n_threads < NUMBER (threads)) THEN
      WITH z = threads[n_threads] DO
        z.id := n_threads;
        z.dump := FALSE;
        IF is_registers
          THEN z.reg_start   := start;  z.reg_stop   := stop;
          ELSE z.stack_start := start;  z.stack_stop := stop;
        END;
      END;
    END;
    IF (is_registers) THEN INC (n_threads); END;
    is_registers := NOT is_registers;
  END GetThread;

PROCEDURE GetThreadStats (READONLY ti: ThreadInfo) =
  BEGIN
    visit.module     := NIL;
    visit.thread_id  := ti.id;
    visit.location   := NIL;
    visit.ref        := NIL;

    ResetVisitCounts ();
    ScanPages (ti.stack_start, ti.stack_stop);
    ScanPages (ti.reg_start,   ti.reg_stop);
    AddVisit (stacks);
  END GetThreadStats;

PROCEDURE ScanPages (start, stop: ADDRESS) =
  VAR fp: UNTRACED REF ADDRESS := start;
  BEGIN
    (* scan the stack or registers *)
    WHILE fp < stop DO
      WITH page = RTHeapRep.AddressToPage(fp^), d = page.desc DO
        IF page # NIL AND d.space = RTHeapRep.Space.Current THEN
          VisitPage(page);
        END;
      END;
      INC(fp, RTMachine.PointerAlignment);
    END;
  END ScanPages;

PROCEDURE GetThreadRootStats (READONLY ti: ThreadInfo) =
  BEGIN
    visit.module     := NIL;
    visit.thread_id  := ti.id;
    visit.location   := NIL;
    visit.ref        := NIL;
    ScanThreadRoots (ti.stack_start, ti.stack_stop, on_stack := TRUE);
    ScanThreadRoots (ti.reg_start,   ti.reg_stop,   on_stack := FALSE);
  END GetThreadRootStats;

PROCEDURE ScanThreadRoots (start, stop: ADDRESS;  on_stack: BOOLEAN) =
  VAR fp: UNTRACED REF ADDRESS := start;
  BEGIN
    WHILE fp <= stop DO
      WITH page = RTHeapRep.AddressToPage(fp^), d = page.desc DO
        IF page # NIL AND d.space = RTHeapRep.Space.Current THEN
          IF on_stack
            THEN visit.location := fp;
            ELSE visit.location := NIL;
          END;
          visit.ref := fp^;
          ResetVisitCounts ();
          Visit (NIL, fp);
          AddVisit (stack_roots);
        END;
      END;
      INC(fp, RTMachine.PointerAlignment);
    END;
  END ScanThreadRoots;

PROCEDURE GetThreadPageStats (READONLY ti: ThreadInfo) =
  BEGIN
    visit.module     := NIL;
    visit.thread_id  := ti.id;
    visit.location   := NIL;
    visit.ref        := NIL;
    ScanThreadPageRoots (ti.stack_start, ti.stack_stop, on_stack := TRUE);
    ScanThreadPageRoots (ti.reg_start,   ti.reg_stop,   on_stack := FALSE);
  END GetThreadPageStats;

PROCEDURE ScanThreadPageRoots (start, stop: ADDRESS;  on_stack: BOOLEAN) =
  VAR fp: UNTRACED REF ADDRESS := start;
  BEGIN
    WHILE fp <= stop DO
      WITH page = RTHeapRep.AddressToPage(fp^), d = page.desc DO
        IF page # NIL AND d.space = RTHeapRep.Space.Current THEN
          IF on_stack
            THEN visit.location := fp;
            ELSE visit.location := NIL;
          END;
          visit.ref := fp^;
          ResetVisitCounts ();
          VisitPage (page);
          AddVisit (stack_pages);
        END;
      END;
      INC(fp, RTMachine.PointerAlignment);
    END;
  END ScanThreadPageRoots;

PROCEDURE VisitPage (page: RTHeapRep.RefPage) =
  VAR
    h : RTHeapRep.RefHeader := page + ADRSIZE(RTHeapRep.PageHdr);
    he: RTHeapRep.RefHeader := page + RTHeapRep.BytesPerPage;
    ref: ADDRESS;
  BEGIN
    (* visit each object on the page *)
    WHILE h < he DO
      ref := h + ADRSIZE (RTHeapRep.Header);
      Visit (NIL, ADR (ref));
      INC (h, ADRSIZE(RTHeapRep.Header) + RTHeapRep.ReferentSize (h));
    END;
  END VisitPage;

PROCEDURE ReportUnits () =
  BEGIN
    PutText ("\nModule globals:\n");
    PutText (" # objects   # bytes  unit\n");
    PutText (" ---------  --------  -----------------\n");
    FOR i := 0 TO units.count-1 DO
      WITH m = units.info[i] DO
        IF (m.n_bytes > 0) THEN
          PutInt (m.n_objects, 10);
          PutInt (m.n_bytes, 10);
          PutText ("  ");
          PutStr  (PathTail (m.module.file));
          PutText ("\n");
        END;
      END;
    END;
  END ReportUnits;

PROCEDURE ReportUnitRoots () =
  BEGIN
    PutText ("\nGlobal variable roots:\n");
    PutText (" # objects   # bytes         ref type                location\n");
    PutText (" ---------  --------  ---------- -----------------   ------------------------\n");
    FOR i := 0 TO unit_roots.count-1 DO
      WITH r = unit_roots.info[i] DO
        IF (r.n_bytes > 0) THEN
          PutInt  (r.n_objects, 10);
          PutInt  (r.n_bytes, 10);
          PutText ("  ");
          PutAddr (r.ref);
          PutText (" ");
          PadText (TypeName (r.ref), 18);
          PutText ("  ");
          PutStr  (PathTail (r.module.file));
          PutText (" + ");
          PutInt (r.location - r.module);
          PutText ("\n");
        END;
      END;
    END;
  END ReportUnitRoots;

PROCEDURE ReportStacks () =
  BEGIN
    PutText ("\nThread stacks (conservative page scan):\n");
    PutText (" # objects   # bytes  thread  [stack bounds]\n");
    PutText (" ---------  --------  -------------------------------\n");
    FOR i := 0 TO stacks.count-1 DO
      WITH t = stacks.info[i] DO
        IF (t.n_bytes > 0) THEN
          PutInt (t.n_objects, 10);
          PutInt (t.n_bytes, 10);
          PutText ("  T.");
          PutInt (t.thread_id, 1);
          PutText ("  [");
          PutAddr (threads[t.thread_id].stack_start);
          PutText (" .. ");
          PutAddr (threads[t.thread_id].stack_stop);
          PutText ("]\n");
          threads[t.thread_id].dump := TRUE;
        END;
      END;
    END;
  END ReportStacks;

PROCEDURE ReportStackRoots () =
  BEGIN
    PutText ("\nThread stack roots (optimistic):\n");
    ReportStackInfo (stack_roots);
  END ReportStackRoots;

PROCEDURE ReportStackPages () =
  BEGIN
    PutText ("\nThread stack roots (conservative page scan):\n");
    ReportStackInfo (stack_pages);
  END ReportStackPages;

PROCEDURE ReportStackInfo (READONLY s: InfoSet) =
  BEGIN
    PutText (" # objects   # bytes         ref type                location\n");
    PutText (" ---------  --------  ---------- -----------------   ------------------------\n");
    FOR i := 0 TO s.count-1 DO
      WITH r = s.info[i] DO
        IF (r.n_bytes > 0) THEN
          PutInt  (r.n_objects, 10);
          PutInt  (r.n_bytes, 10);
          PutText ("  ");
          PutAddr (r.ref);
          PutText (" ");
          PadText (TypeName (r.ref), 18);
          PutText ("  ");
          IF (r.location # NIL) THEN
            PutText ("sp+");
            PutInt  (r.location - threads[r.thread_id].stack_start);
          ELSE
            PutText ("register");
          END;
          PutText (" in T.");
          PutInt  (r.thread_id);
          PutText ("\n");
          threads[r.thread_id].dump := TRUE;
        END;
      END;
    END;
  END ReportStackInfo;

VAR
  conservative_cutoff : INTEGER;
  optimistic_cutoff   : INTEGER;

PROCEDURE DumpStacks () =
  BEGIN
    conservative_cutoff := MAX (MinInfoBytes (stack_pages) DIV 2, 1024);
    optimistic_cutoff   := MAX (MinInfoBytes (stack_roots) DIV 2, 1024);
    PutText ("\n-------------------------------------------------------\n");
    PutText ("Thread stack dumps with references that reach\nat least:\n");
    PutInt  (optimistic_cutoff, 10);
    PutText (" bytes under the optimistic scan or\n");
    PutInt  (conservative_cutoff, 10);
    PutText (" bytes under the conservative scan.\n\n");

    FOR i := 0 TO n_threads-1 DO
      IF threads[i].dump THEN DumpStack (threads[i]); END;
    END;
  END DumpStacks;

PROCEDURE MinInfoBytes (READONLY s: InfoSet): INTEGER =
  VAR x := LAST (INTEGER);
  BEGIN
    FOR i := 0 TO s.count-1 DO
      x := MIN (x, s.info[i].n_bytes);
    END;
    RETURN x;
  END MinInfoBytes;

PROCEDURE DumpStack (READONLY ti: ThreadInfo) =
  CONST Max_proc = 4096;  (* good enough for 99% of the procedures *)
  VAR
    fp: UNTRACED REF ADDRESS; p: ADDRESS;
    cons_cnt, cons_bytes : INTEGER;
    opt_cnt, opt_bytes   : INTEGER;
    have_frames : BOOLEAN;
    cur, prev: RTStack.Frame;
    proc_start: RTProcedure.Proc;
    file, proc_name: RTProcedureSRC.Name;
  BEGIN
    have_frames := RTStack.Has_walker;
    IF RTStack.Has_walker THEN
      IF (ti.id = self_id) THEN
        RTStack.CurrentFrame (cur);
      ELSE
        RTStack.GetThreadFrame (cur, ti.reg_start, ti.reg_stop - ti.reg_start);
      END;
      IF cur.pc = NIL THEN have_frames := FALSE; END;
    END;

    PutText ("-------------------------------------------------\n");
    PutText ("Thread T.");
    PutInt  (ti.id, 1);
    PutText ("  stack [");
    PutAddr (ti.stack_start);
    PutText (" .. ");
    PutAddr (ti.stack_stop);
    PutText ("]\n\n");
    PutText (" stack    optimistic    conservative\n");
    PutText ("offset  #objs # bytes  #objs # bytes  ref\n");
    PutText ("------  ----- -------  ----- -------  ------------\n");
    fp := ti.stack_start;
    WHILE (fp <= ti.stack_stop) DO

      IF have_frames THEN
        WHILE (cur.sp <= fp) AND (cur.pc # NIL) DO
          RTProcedureSRC.FromPC (cur.pc, proc_start, file, proc_name);
          IF (proc_start # NIL) AND (cur.pc - proc_start < Max_proc) THEN
            PutInt  (cur.sp - ti.stack_start, 5);
            PutText ("                                 --> ");
            PutStr  (proc_name);
            IF (cur.pc # proc_start) THEN
              PutText (" + ");
              PutInt (cur.pc - proc_start);
            END;
            IF (file # NIL) THEN
              PutText (" in ");
              PutStr (PathTail (file));
            END;
            PutText ("\n");
          END;
          RTStack.PreviousFrame (cur, prev);
          cur := prev;
        END;
      END;

      p := fp^;
      WITH page = RTHeapRep.AddressToPage(p), d = page.desc DO
        IF page # NIL AND d.space = RTHeapRep.Space.Current THEN
          IF d.space = RTHeapRep.Space.Current THEN
            visit.location := fp;
            visit.ref := p;

            (* make the conservative scan *)
            ResetVisitCounts ();
            VisitPage (page);
            cons_bytes := visit.n_bytes;
            cons_cnt   := visit.n_objects;

            (* make the optimistic scan *)
            ResetVisitCounts ();
            Visit (NIL, fp);
            opt_bytes := visit.n_bytes;
            opt_cnt   := visit.n_objects;

            IF (cons_bytes >= conservative_cutoff)
              OR (opt_bytes >= optimistic_cutoff) THEN
              (* report this ref! *)
              PutInt  (fp - ti.stack_start, 5);
              PutInt  (opt_cnt, 8);
              PutInt  (opt_bytes, 8);
              PutInt  (cons_cnt, 7);
              PutInt  (cons_bytes, 8);
              PutText ("  ");
              PutAddr (p);
              PutText (" ");
              PutText (TypeName (p));
              PutText ("\n");
            END;
          END;
        END;
      END;

      IF NOT have_frames THEN
        (* maybe this stack element is a PC we should print *)
        RTProcedureSRC.FromPC (p, proc_start, file, proc_name);
        IF (proc_start # NIL) AND (p - proc_start < Max_proc) THEN
          PutInt  (fp - ti.stack_start, 5);
          PutText ("                                 [PC ");
          PutAddr (p);
          PutText ("] ");
          PutStr  (proc_name);
          IF (p # proc_start) THEN
            PutText (" + ");
            PutInt (p - proc_start);
          END;
          IF (file # NIL) THEN
            PutText (" in ");
            PutStr (PathTail (file));
          END;
          PutText ("\n");
        END;
      END;

      INC (fp, RTMachine.PointerAlignment);
    END;
  END DumpStack;

PROCEDURE PathTail (a: ADDRESS): ADDRESS =
  VAR p0 : UNTRACED REF CHAR := a;  p := p0;
  BEGIN
    IF (p0 = NIL) THEN RETURN NIL END;
    WHILE (p^ # '\000') DO
      IF (p^ = '/') THEN p0 := p + ADRSIZE (p^); END;
      INC (p, ADRSIZE (p^));
    END;
    RETURN p0;
  END PathTail;

PROCEDURE PutStr (s: ADDRESS) =
  BEGIN
    IF (s = NIL) THEN RETURN END;
    RTIO.PutString (s);
  END PutStr;

PROCEDURE PadText (t: TEXT;  width := 0) =
  VAR len := Text.Length (t);
  BEGIN
    RTIO.PutText (t);
    WHILE (len < width) DO
      RTIO.PutChar (' ');
      INC (len);
    END;
  END PadText;

BEGIN
END RTHeapStats.