diff --git a/src/runtime/Heap.Mod b/src/runtime/Heap.Mod index 6407f27d..ad9d6424 100644 --- a/src/runtime/Heap.Mod +++ b/src/runtime/Heap.Mod @@ -33,30 +33,31 @@ MODULE Heap; AddressZero = S.VAL(S.ADDRESS, 0); TYPE - ModuleName = ARRAY ModNameLen OF CHAR; - CmdName = ARRAY CmdNameLen OF CHAR; + ModuleName- = ARRAY ModNameLen OF CHAR; + CmdName- = ARRAY CmdNameLen OF CHAR; - Module = POINTER TO ModuleDesc; - Cmd = POINTER TO CmdDesc; + Module- = POINTER TO ModuleDesc; + Cmd- = POINTER TO CmdDesc; - EnumProc = PROCEDURE(P: PROCEDURE(p: S.PTR)); + EnumProc- = PROCEDURE(P: PROCEDURE(p: S.PTR)); - ModuleDesc = RECORD - next: Module; - name: ModuleName; - refcnt: LONGINT; - cmds: Cmd; - types: S.ADDRESS; - enumPtrs: EnumProc; - reserved1, reserved2: LONGINT + ModuleDesc- = RECORD + next-: Module; + name-: ModuleName; + refcnt-: LONGINT; + cmds-: Cmd; + types-: S.ADDRESS; + enumPtrs-: EnumProc; + reserved1, + reserved2: LONGINT END ; - Command = PROCEDURE; + Command- = PROCEDURE; - CmdDesc = RECORD - next: Cmd; - name: CmdName; - cmd: Command + CmdDesc- = RECORD + next-: Cmd; + name-: CmdName; + 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 diff --git a/src/runtime/Modules.Mod b/src/runtime/Modules.Mod index cfa4bd77..0b9f5fd0 100644 --- a/src/runtime/Modules.Mod +++ b/src/runtime/Modules.Mod @@ -9,27 +9,10 @@ MODULE Modules; (* jt 6.1.96 *) ModNameLen* = 20; TYPE - ModuleName* = ARRAY ModNameLen OF CHAR; - Module* = POINTER TO ModuleDesc; - Cmd* = POINTER TO CmdDesc; - ModuleDesc* = RECORD (* cf. SYSTEM.Mod *) - 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 ; - + ModuleName* = Heap.ModuleName; + Module* = Heap.Module; + Cmd* = Heap.Cmd; + Command* = Heap.Command; 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 -setmodules(m: Module) "Heap_modules = m"; + PROCEDURE -modules(): Module "(Heap_Module)Heap_modules"; + (*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 ; - IF (m # NIL) & (m.refcnt = 0) THEN - IF m = modules() THEN setmodules(m.next) - ELSE p.next := m.next - END ; + refcount := Heap.FreeModule(name); + IF refcount = 0 THEN res := 0 - ELSE res := 1; - IF m = NIL THEN resMsg := "module not found" + ELSE + 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. *) diff --git a/src/runtime/Out.Mod b/src/runtime/Out.Mod index 23d30be4..37c928a4 100644 --- a/src/runtime/Out.Mod +++ b/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); diff --git a/src/runtime/Texts.Mod b/src/runtime/Texts.Mod index ae7440a0..55ab429f 100644 --- a/src/runtime/Texts.Mod +++ b/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;