Remove duplocate ModuleDesc in Modules. Add type descriptor dumping.

src/runtime/Heap.Mod

@@ -33,30 +33,31 @@ MODULE Heap;
     AddressZero = S.VAL(S.ADDRESS, 0);
 
   TYPE
-    ModuleName = ARRAY ModNameLen OF CHAR;
+    ModuleName- = ARRAY ModNameLen OF CHAR;
-    CmdName    = ARRAY CmdNameLen OF CHAR;
+    CmdName-    = ARRAY CmdNameLen OF CHAR;
 
-    Module = POINTER TO ModuleDesc;
+    Module- = POINTER TO ModuleDesc;
-    Cmd    = POINTER TO CmdDesc;
+    Cmd-    = POINTER TO CmdDesc;
 
-    EnumProc   = PROCEDURE(P: PROCEDURE(p: S.PTR));
+    EnumProc-   = PROCEDURE(P: PROCEDURE(p: S.PTR));
 
-    ModuleDesc = RECORD
+    ModuleDesc- = RECORD
-      next:     Module;
+      next-:     Module;
-      name:     ModuleName;
+      name-:     ModuleName;
-      refcnt:   LONGINT;
+      refcnt-:   LONGINT;
-      cmds:     Cmd;
+      cmds-:     Cmd;
-      types:    S.ADDRESS;
+      types-:    S.ADDRESS;
-      enumPtrs: EnumProc;
+      enumPtrs-: EnumProc;
-      reserved1, reserved2: LONGINT
+      reserved1,
+      reserved2: LONGINT
     END ;
 
-    Command = PROCEDURE;
+    Command- = PROCEDURE;
 
-    CmdDesc = RECORD
+    CmdDesc- = RECORD
-      next: Cmd;
+      next-: Cmd;
-      name: CmdName;
+      name-: CmdName;
-      cmd:  Command
+      cmd-:  Command
     END ;
 
     Finalizer = PROCEDURE(obj: S.PTR);
@@ -71,7 +72,7 @@ MODULE Heap;
 
   VAR
     (* the list of loaded (=initialization started) modules *)
-    modules*: S.PTR;
+    modules-:   S.PTR; (*POINTER [1] TO ModuleDesc;*)
 
     freeList:   ARRAY nofLists + 1 OF S.ADDRESS;  (* dummy, 16, 32, 48, 64, 80, 96, 112, 128, sentinel *)
     bigBlocks:  S.ADDRESS;
@@ -141,6 +142,22 @@ MODULE Heap;
     RETURN m
   END REGMOD;
 
+  PROCEDURE FreeModule*(name: ARRAY OF CHAR): LONGINT;
+  (* Returns 0 if freed, -1 if not found, refcount if found and refcount > 0. *)
+    VAR m, p: Module;
+  BEGIN m := S.VAL(Module, modules);
+    WHILE (m # NIL) & (m.name # name) DO p := m; m := m.next END;
+    IF (m # NIL) & (m.refcnt = 0) THEN
+      IF m = S.VAL(Module, modules) THEN modules := m.next
+      ELSE p.next := m.next
+      END;
+      RETURN 0
+    ELSE
+      IF m = NIL THEN RETURN -1 ELSE RETURN m.refcnt END
+    END
+  END FreeModule;
+
+
   PROCEDURE REGCMD*(m: Module; VAR name: CmdName; cmd: Command);
     VAR c: Cmd;
   BEGIN

src/runtime/Modules.Mod

@@ -9,27 +9,10 @@ MODULE Modules;  (* jt 6.1.96 *)
     ModNameLen* = 20;
 
   TYPE
-    ModuleName* = ARRAY ModNameLen OF CHAR;
+    ModuleName* = Heap.ModuleName;
-    Module* = POINTER TO ModuleDesc;
+    Module*     = Heap.Module;
-    Cmd* = POINTER TO CmdDesc;
+    Cmd*        = Heap.Cmd;
-    ModuleDesc* = RECORD  (* cf. SYSTEM.Mod *)
+    Command*    = Heap.Command;
-      next-: Module;
-      name-: ModuleName;
-      refcnt-: LONGINT;
-      cmds-: Cmd;
-      types-: LONGINT;
-      enumPtrs-: PROCEDURE (P: PROCEDURE(p: LONGINT));
-      reserved1, reserved2: LONGINT;
-    END ;
-
-    Command* = PROCEDURE;
-
-    CmdDesc* = RECORD
-      next-: Cmd;
-      name-: ARRAY 24 OF CHAR;
-      cmd-: Command
-    END ;
-
   VAR
     res*:       INTEGER;
     resMsg*:    ARRAY 256 OF CHAR;
@@ -236,8 +219,8 @@ MODULE Modules;  (* jt 6.1.96 *)
 
 (* Module and command lookup by name *)
 
-  PROCEDURE -modules(): Module     "(Modules_Module)Heap_modules";
+  PROCEDURE -modules(): Module     "(Heap_Module)Heap_modules";
-  PROCEDURE -setmodules(m: Module) "Heap_modules = m";
+  (*PROCEDURE -setmodules(m: Module) "Heap_modules = m";*)
 
   PROCEDURE ThisMod* (name: ARRAY OF CHAR): Module;
     VAR m: Module; bodyname: ARRAY 64 OF CHAR; body: Command;
@@ -262,26 +245,25 @@ MODULE Modules;  (* jt 6.1.96 *)
   END ThisCommand;
 
   PROCEDURE Free*(name: ARRAY OF CHAR; all: BOOLEAN);
-    VAR m, p: Module;
+    VAR m, p: Module; refcount: LONGINT;
   BEGIN m := modules();
     IF all THEN
       res := 1; resMsg := 'unloading "all" not yet supported'
     ELSE
-      WHILE (m # NIL) & (m.name # name) DO p := m; m := m.next END ;
+      refcount := Heap.FreeModule(name);
-      IF (m # NIL) & (m.refcnt = 0) THEN
+      IF refcount = 0 THEN
-        IF m = modules() THEN setmodules(m.next)
-        ELSE p.next := m.next
-        END ;
         res := 0
-      ELSE res := 1;
+      ELSE
-        IF m = NIL THEN resMsg := "module not found"
+        IF refcount < 0 THEN resMsg := "module not found"
         ELSE resMsg := "clients of this module exist"
-        END
+        END;
+        res := 1
       END
     END
   END Free;
 
 
+
   (* Run time error reporting. *)
 
   PROCEDURE errch(c: CHAR);  (* Here we favour simplicity over efficiency, so no buffering. *)

src/runtime/Out.Mod

@@ -1,6 +1,6 @@
 MODULE Out; (* DCW Brown. 2016-09-27 *)
 
-IMPORT SYSTEM, Platform;
+IMPORT SYSTEM, Platform, Heap;
 
 VAR
   IsConsole-: BOOLEAN;
@@ -114,6 +114,59 @@ PROCEDURE HexDump*(VAR m: ARRAY OF SYSTEM.BYTE);
 BEGIN HexDumpAdr(SYSTEM.ADR(m), 0, LEN(m))
 END HexDump;
 
+
+PROCEDURE DumpModule(m: Heap.Module);
+BEGIN
+  String("  next:     "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, m.next),1); Ln;
+  String("  name:     "); String(m.name); Ln;
+  String("  refcnt:   "); Hex(m.refcnt,1); Ln;
+  String("  cmds:     "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, m.cmds),1); Ln;
+  String("  types:    "); Hex(m.types,1); Ln;
+  String("  enumPtrs: "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, m.enumPtrs),1); Ln;
+END DumpModule;
+
+PROCEDURE DumpType*(VAR o: ARRAY OF SYSTEM.BYTE);
+TYPE
+  typedesc = RECORD
+    (* Array of type bound procedure addresses preceeds this. *)
+    tag:      SYSTEM.ADDRESS;
+    next:     SYSTEM.ADDRESS;
+    level:    SYSTEM.ADDRESS;
+    module:   SYSTEM.ADDRESS;
+    name:     ARRAY 24 OF CHAR;
+    bases:    ARRAY 16 OF SYSTEM.ADDRESS;
+    reserved: SYSTEM.ADDRESS;
+    blksz:    SYSTEM.ADDRESS;
+    ptr0:     SYSTEM.ADDRESS;  (* Offset of first pointer. Others follow this. *)
+  END;
+  tag = POINTER [1] TO typedesc;
+VAR
+  addr: SYSTEM.ADDRESS;
+  desc: tag;
+  i: INTEGER;
+BEGIN
+  SYSTEM.GET(SYSTEM.ADR(o) - SIZE(SYSTEM.ADDRESS), addr);
+  String("obj tag:  "); Hex(addr,1); Ln;
+  desc := SYSTEM.VAL(tag, addr - (21*SIZE(SYSTEM.ADDRESS) + 24));
+  String("desc at:  "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, desc),1); Ln;
+  String("desc contains:"); Ln;
+  String("tag:      "); Hex(desc.tag,      1); Ln;
+  String("next:     "); Hex(desc.next,     1); Ln;
+  String("level:    "); Hex(desc.level,    1); Ln;
+  String("module:   "); Hex(desc.module,   1); Ln;
+  DumpModule(SYSTEM.VAL(Heap.Module, desc.module));
+  String("name:     "); String(desc.name); Ln;
+  String("bases:    ");
+  i := 0; WHILE i < 16 DO
+    Hex(desc.bases[i], SIZE(SYSTEM.ADDRESS) * 2);
+    IF i MOD 4 = 3 THEN Ln; String("          ") ELSE Char(" ") END;
+    INC(i)
+  END; Ln;
+  String("reserved: "); Hex(desc.reserved, 1); Ln;
+  String("blksz:    "); Hex(desc.blksz,    1); Ln;
+  String("ptr0:     "); Hex(desc.ptr0,     1); Ln;
+END DumpType;
+
 (* Real and Longreal display *)
 
 PROCEDURE digit(n: HUGEINT; VAR s: ARRAY OF CHAR; VAR i: INTEGER);

src/runtime/Texts.Mod

@@ -180,6 +180,7 @@ MODULE Texts;  (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
         ELSE                       DumpRun(re.run)
         END
       END;
+    Out.DumpType(re.run^);
   END DumpReader;