Oberon/V2/Modules
< Oberon
MODULE Modules; (*NW 16.2.86 / 7.4.91*)
IMPORT SYSTEM, Kernel, FileDir, Files;
CONST ModNameLen* = 20; ObjMark = 0F8X;
TYPE Module* = POINTER TO ModDesc;
Command* = PROCEDURE;
ModuleName* = ARRAY ModNameLen OF CHAR;
ModDesc* = RECORD SB*, LB*, PB*, BB*, CB*, RB*, IB*, size*, key*: LONGINT;
name*: ModuleName;
refcnt*: LONGINT;
link*: Module
END ;
VAR res*: INTEGER;
importing*, imported*: ModuleName;
loop: Command;
PROCEDURE ReadName(VAR R: Files.Rider; VAR s: ARRAY OF CHAR; n: INTEGER);
VAR ch: CHAR; i: INTEGER;
BEGIN i := 0;
REPEAT Files.Read(R, ch); s[i] := ch; INC(i)
UNTIL ch = 0X;
WHILE i < n DO Files.Read(R, ch); s[i] := 0X; INC(i) END
END ReadName;
PROCEDURE OpenFile(VAR F: Files.File; VAR name: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
Fname: ARRAY 32 OF CHAR;
BEGIN i := 0; ch := name[0]; (*make file name*)
WHILE ch > 0X DO Fname[i] := ch; INC(i); ch := name[i] END ;
Fname[i] := "."; Fname[i+1] := "O"; Fname[i+2] := "b"; Fname[i+3] := "j"; Fname[i+4] := 0X;
F := Files.Old(Fname)
END OpenFile;
PROCEDURE PD(mod: Module; pc: LONGINT): LONGINT;
BEGIN (*procedure descriptor*)
RETURN ASH(pc, 16) + SYSTEM.VAL(LONGINT, mod)
END PD;
PROCEDURE ThisMod*(name: ARRAY OF CHAR): Module;
(*search module in list; if not found, load module*)
VAR
mod, impmod, md: Module;
ch: CHAR; mno, pno: SHORTINT;
i, j: INTEGER;
nofentries, nofimps, nofptrs, comsize, noflinks, constsize, codesize: INTEGER;
varsize, size, key, impkey, k, p, q, pos1, pos2: LONGINT;
init: Command;
F: Files.File; R: Files.Rider;
modname, impname: ModuleName;
Fname: ARRAY FileDir.FnLength OF CHAR;
import: ARRAY 16 OF Module;
PROCEDURE err(n: INTEGER);
BEGIN
IF res = 0 THEN res := n; COPY(name, imported) END
END err;
BEGIN res := 0; mod := SYSTEM.VAL(Module, Kernel.ModList);
LOOP
IF name = mod.name THEN EXIT END ;
mod := mod.link;
IF mod = NIL THEN EXIT END
END ;
IF mod = NIL THEN (*load*)
OpenFile(F, name);
IF F # NIL THEN
Files.Set(R, F, 0); Files.Read(R, ch); (*header*)
IF ch # ObjMark THEN err(2); RETURN NIL END ;
Files.Read(R, ch);
IF ch # "6" THEN err(2); RETURN NIL END ;
Files.ReadBytes(R, k, 4); (*skip*)
Files.ReadBytes(R, nofentries, 2); Files.ReadBytes(R, comsize, 2);
Files.ReadBytes(R, nofptrs, 2); Files.ReadBytes(R, nofimps, 2);
Files.ReadBytes(R, noflinks, 2); Files.ReadBytes(R, varsize, 4);
Files.ReadBytes(R, constsize, 2); Files.ReadBytes(R, codesize, 2);
Files.ReadBytes(R, key, 4); ReadName(R, modname, ModNameLen);
i := (nofentries + nofptrs)*2 + comsize;
pos1 := Files.Pos(R); Files.Set(R, F, pos1 + i + 3);
INC(i, nofimps*2); k := (i MOD 4) + i;
(*imports*) Files.Read(R, ch);
IF ch # 85X THEN err(4); RETURN NIL END ;
res := 0; i := 0;
WHILE (i < nofimps) & (res = 0) DO
Files.ReadBytes(R, impkey, 4); ReadName(R, impname, 0); Files.Read(R, ch);
impmod := ThisMod(impname);
IF res = 0 THEN
IF impmod.key = impkey THEN import[i] := impmod; INC(i); INC(impmod.refcnt)
ELSE res := 3; imported := impname; importing := modname
END
END
END ;
IF res # 0 THEN
WHILE i > 0 DO DEC(i); DEC(import[i].refcnt) END ;
RETURN NIL
END ;
pos2 := Files.Pos(R);
size := k + noflinks*4 + constsize + codesize + varsize;
Kernel.AllocBlock(q, p, size); mod := SYSTEM.VAL(Module, q);
mod.size := size;
mod.BB := p;
mod.CB := nofentries*2 + p;
mod.RB := comsize + mod.CB;
mod.IB := nofptrs*2 + mod.RB;
mod.LB := k + p;
mod.SB := (noflinks*4 + varsize) + mod.LB;
mod.PB := constsize + mod.SB;
mod.refcnt := 0;
mod.key := key;
mod.name := modname;
(*entries*) q := mod.CB; Files.Set(R, F, pos1); Files.Read(R, ch);
IF ch # 82X THEN err(4); RETURN NIL END ;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END ;
(*commands*) q := mod.RB; Files.Read(R, ch);
IF ch # 83X THEN err(4); RETURN NIL END ;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END ;
(*pointer references*) q := mod.IB; Files.Read(R, ch);
IF ch # 84X THEN err(4); RETURN NIL END ;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END ;
i := 0;
WHILE i < nofimps DO SYSTEM.PUT(p, import[i]); INC(p, 2); INC(i) END ;
(*links*) Files.Set(R, F, pos2+1); p := mod.LB; q := noflinks*4 + p;
WHILE p < q DO
Files.Read(R, pno); Files.Read(R, mno);
IF mno > 0 THEN md := import[mno-1] ELSE md := mod END ;
IF pno = -1 THEN SYSTEM.PUT(p, md.SB) (*data segment entry*)
ELSE SYSTEM.GET(pno*2 + md.BB, i);
SYSTEM.PUT(p, PD(md, i)) (*procedure entry*)
END ;
INC(p, 4)
END ;
(*variables*) q := mod.SB;
WHILE p < q DO SYSTEM.PUT(p, 0); INC(p) END ;
(*constants*) q := mod.PB; Files.Read(R, ch);
IF ch # 87X THEN err(4); RETURN NIL END ;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END ;
(*code*) q := p + codesize; Files.Read(R, ch);
IF ch # 88X THEN err(4); RETURN NIL END ;
WHILE p < q DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) END ;
(*type descriptors*) Files.Read(R, ch);
IF ch # 89X THEN err(4); RETURN NIL END ;
LOOP Files.ReadBytes(R, i, 2);
IF R.eof OR (i MOD 100H = 8AH) THEN EXIT END ;
Files.ReadBytes(R, j, 2); (*adr*)
SYSTEM.NEW(md, i);
p := SYSTEM.VAL(LONGINT, md); q := p + i;
REPEAT Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p) UNTIL p = q;
SYSTEM.PUT(mod.SB + j, md)
END ;
init := SYSTEM.VAL(Command, mod); init;
ELSE COPY(name, imported); err(1)
END
END ;
RETURN mod
END ThisMod;
PROCEDURE ThisCommand*(mod: Module; name: ARRAY OF CHAR): Command;
VAR i: INTEGER; ch: CHAR;
comadr: LONGINT; com: Command;
BEGIN com := NIL;
IF mod # NIL THEN
comadr := mod.CB; res := 5;
LOOP SYSTEM.GET(comadr, ch); INC(comadr);
IF ch = 0X THEN (*not found*) EXIT END ;
i := 0;
LOOP
IF ch # name[i] THEN EXIT END ;
INC(i);
IF ch = 0X THEN res := 0; EXIT END ;
SYSTEM.GET(comadr, ch); INC(comadr)
END ;
IF res = 0 THEN (*match*)
SYSTEM.GET(comadr, i); com := SYSTEM.VAL(Command, PD(mod, i)); EXIT
ELSE
WHILE ch > 0X DO SYSTEM.GET(comadr, ch); INC(comadr) END ;
INC(comadr, 2)
END
END
END ;
RETURN com
END ThisCommand;
PROCEDURE unload(mod: Module; all: BOOLEAN);
VAR p: LONGINT; k: INTEGER;
imp: Module;
BEGIN p := mod.IB;
WHILE p < mod.LB DO (*scan imports*)
SYSTEM.GET(p, k); imp := SYSTEM.VAL(Module, LONG(k));
IF imp # NIL THEN
DEC(imp.refcnt);
IF all & (imp.refcnt = 0) THEN unload(imp, all) END
END ;
INC(p, 2)
END ;
Kernel.FreeBlock(SYSTEM.VAL(LONGINT, mod))
END unload;
PROCEDURE Free*(name: ARRAY OF CHAR; all: BOOLEAN);
VAR mod: Module;
BEGIN mod := SYSTEM.VAL(Module, Kernel.ModList);
LOOP
IF mod = NIL THEN res := 1; EXIT END ;
IF name = mod.name THEN
IF mod.refcnt = 0 THEN unload(mod, all); res := 0 ELSE res := 2 END ;
EXIT
END ;
mod := mod.link
END
END Free;
BEGIN
IF Kernel.err = 0 THEN loop := ThisCommand(ThisMod("Oberon"), "Loop") END ;
loop
END Modules.