mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 23:22:25 +00:00
Remove duplocate ModuleDesc in Modules. Add type descriptor dumping.
This commit is contained in:
David Brown
parent
80512b6ecc
commit
4444d06e4e
4 changed files with 105 additions and 52 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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. *)
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue