Syntax10.Scn.FntSyntax10b.Scn.Fnt   + S +     Syntax10i.Scn.Fnt MarkElemsAlloc#'q&i0#!rHZ((!. "> 8FoldElemsNewh888 8%8q # xL 'H'   O !+F#R ^88B86888J8988.88+8t8mA   x> 2 =`8 #J p x<;VMODULE Modules; (* Oberon for Windows Module Loader; RC/MH 10.12.93 / 3.2.94 / 25.5.94 *) IMPORT Kernel, Files, S := SYSTEM, C := Console; CONST ModNameLen* = 32; TYPE Command* = PROCEDURE; Module* = Kernel.Module; ModuleDesc* = Kernel.ModuleDesc; Cmd* = Kernel.Cmd; ModuleName* = Kernel.Name; ADDRESS = LONGINT; VAR imported*, importing*: ModuleName; res*: INTEGER; KernelRoutines: ARRAY 3 OF ADDRESS; loop: Command; Debug: BOOLEAN; MayUnload*: PROCEDURE (m: Module): BOOLEAN; CONST done* = 0; fileNotFound* = 1; invalidObjFile* = 2; keyMismatch* = 3; notEnoughMemory* = 4; modNotFound* = 5; cmdNotFound* = 6; refCntNotZero* = 7; cyclicImport* = 8; corruptedObjFile* = 9; codeReferenced* = 10; ExtTabWordSize = 16; Tag0WordOffset = -2; Mth0WordOffset = Tag0WordOffset - ExtTabWordSize; TYPE Header = RECORD (* data in object file header *) nofDataEntries: INTEGER; nofEntries: INTEGER; nofCommands: INTEGER; nofPointers: INTEGER; nofTypes: INTEGER; nofImports: INTEGER; nofLinks: INTEGER; nofDataLinks: INTEGER; codeSize, dataSize, refSize: LONGINT; constSize: INTEGER; END ; LinkTab = ARRAY 256 OF RECORD mod, entry: CHAR; link: LONGINT END ; DataLinkTab = ARRAY 64 OF RECORD mod: CHAR; entry: INTEGER; nofFixups: INTEGER; offset: POINTER TO ARRAY OF LONGINT; END ; (* PROCEDURE CheckPtr (s: ARRAY OF CHAR; p: LONGINT); VAR pval, tag: LONGINT; BEGIN p := p DIV 4 * 4; IF (p < Kernel.heapAdr) OR (p > Kernel.heapAdr + Kernel.heapSize) THEN C.Ln; C.Str(s); C.Str("Pointer not in heap: "); C.Int(p); ShowError.CallStack(TRUE) ELSE S.GET(p - 4, tag); tag := tag DIV 4 * 4; IF (tag < Kernel.heapAdr) OR (tag > Kernel.heapAdr + Kernel.heapSize) THEN C.Ln; C.Str(s); C.Str("Tag of pointer "); C.Int(p); C.Str(" not in heap "); C.Int(tag); ShowError.CallStack(TRUE) ELSE S.GET(p, tag); IF p + 4 = tag THEN C.Ln; C.Str(s); C.Str("Freeblock"); ShowError.CallStack(TRUE) END END END END CheckPtr; PROCEDURE DumpFreeList; VAR adr, start, i, size: LONGINT; m: Kernel.Module; BEGIN m := Kernel.modules; WHILE (m # NIL) & (m.name # "Kernel") DO m := m.next END ; IF m # NIL THEN start := m.sb - 240; FOR i := 0 TO 9 DO C.Ln; C.Int(i); C.Str(": "); S.GET(start, adr); WHILE adr # 0 DO S.GET(adr + 4, size); C.Int(adr); C.Ch("-"); C.Int(adr + size + 4); C.Ch(" "); IF (td >= adr) & (td < adr + size + 4) THEN C.Str("tdesc in freelist") END ; S.GET(adr + 8, adr) END ; INC(start, 4) END END END DumpFreeList; PROCEDURE Check; VAR m: Kernel.Module; BEGIN m := Kernel.modules; WHILE (m # NIL) & (m.name # "KeplerElems") DO m := m.next END ; IF m # NIL THEN CheckPtr("first tdesc of KeplerElems ", m.tdescs[0]); td := m.tdescs[0]; DumpFreeList END END Check; *) PROCEDURE LSW (x: LONGINT): LONGINT; BEGIN (* least significant word (unsigned) *) RETURN S.VAL(LONGINT, S.VAL(SET, x) * S.VAL(SET, 0FFFFH)) END LSW; PROCEDURE MSW (x: LONGINT): LONGINT; BEGIN (* most significant word (unsigned) *) RETURN S.LSH(x, -16); RETURN x END MSW; PROCEDURE ReadUnsigned (VAR R: Files.Rider; VAR u: LONGINT); (* read unsigned, 16 bit, little endian value *) VAR low, high: CHAR; BEGIN Files.Read(R, low); Files.Read(R, high); u := 256*LONG(ORD(high)) + ORD(low); END ReadUnsigned; PROCEDURE Find (VAR modname: ARRAY OF CHAR; VAR m: Module); BEGIN m := Kernel.modules; WHILE m # NIL DO IF m.name = modname THEN RETURN END ; m := m.next; END ; END Find; PROCEDURE Fixup (m: Module; VAR head: Header; VAR dataLink: DataLinkTab; VAR link: LinkTab); VAR i, j, val, offs, disp: LONGINT; modNo, entryNo, nofFixups: INTEGER; codebase: ADDRESS; from: Module; BEGIN (* global and imported variables *) i := 0; codebase := S.ADR(m.code[0]); WHILE i < head.nofDataLinks DO modNo := ORD(dataLink[i].mod); nofFixups := dataLink[i].nofFixups; IF modNo = 0 THEN (* global variable *) j := 0; WHILE j < nofFixups DO S.GET(codebase + dataLink[i].offset[j], val); S.PUT(codebase + dataLink[i].offset[j], val + m.sb); INC(j); END ; ELSE (* imported variable from module from *) from := S.VAL(Module, m.imports[modNo]); entryNo := dataLink[i].entry; j :=0; WHILE j < nofFixups DO S.GET(codebase + dataLink[i].offset[j], val); S.PUT(codebase + dataLink[i].offset[j], val + from.varEntries[entryNo]); INC(j); END ; END ; INC(i) END ; (* Kernel.NewRec, Kernel.NewSys, Kernel.NewArr, local Procedure assignments, case table and imported procedures *) i := 0; WHILE i < head.nofLinks DO IF ORD(link[i].mod) = 0 THEN (* Kernel.NewRec, Kernel.NewSys, Kernel.NewArr, local Procedure assignments, case table *) CASE ORD(link[i].entry) OF 255: (* case table fixup in constant area *) offs := link[i].link; WHILE offs # 0FFFFH DO S.GET(m.sb + offs, val); S.PUT(m.sb + offs, codebase + LSW(val)); offs := MSW(val); END ; | 254: (* local procedure assignment *) offs := link[i].link; WHILE offs # 0FFFFH DO S.GET(codebase + offs, val); S.PUT(codebase + offs, m.entries[LSW(val)]); offs := MSW(val); END ; | 253: (* Kernel.NewRec *) (*offs := 12345678;*) offs := link[i].link; WHILE offs # 0FFFFH DO S.GET(codebase + offs, val); S.PUT(codebase + offs, KernelRoutines[0] - (codebase + offs + 4)); offs := MSW(val); END ; | 252: (* Kernel.NewSys *) offs := link[i].link; WHILE offs # 0FFFFH DO S.GET(codebase + offs, val); S.PUT(codebase + offs, KernelRoutines[1] - (codebase + offs + 4)); offs := MSW(val); END ; | 251: (* Kernel.NewArr *) offs := link[i].link; WHILE offs # 0FFFFH DO S.GET(codebase + offs, val); S.PUT(codebase + offs, KernelRoutines[2] - (codebase + offs + 4)); offs := MSW(val); END ; ELSE HALT(100); END ; ELSE (* imported procedure from module from *) from := S.VAL(Module, m.imports[ORD(link[i].mod)]); entryNo := ORD(link[i].entry); offs := link[i].link; WHILE offs # 0FFFFH DO S.GET(codebase + offs, val); IF LSW(val) = 0FFFFH THEN (* insert absolute address *) S.PUT(codebase + offs, from.entries[entryNo]); ELSE (* insert relative address *) disp := from.entries[entryNo] - (offs + codebase + 4); S.PUT(codebase + offs, disp); END ; offs := MSW(val); END ; END ; INC(i); END ; END Fixup; PROCEDURE ^Load (name: ARRAY OF CHAR; VAR m: Module); PROCEDURE LoadModule (VAR R: Files.Rider; VAR m: Module); TYPE TDesc = POINTER TO RECORD word: ARRAY 32000 OF LONGINT END ; VAR i, j: LONGINT; m1: Module; head: Header; linkTab: LinkTab; dataLinks: DataLinkTab; e, k, t: LONGINT; ch: CHAR; body: Command; types: ARRAY 128 OF RECORD initialized: BOOLEAN; tdesc: TDesc; entry, root, nofMeth, nofInhMeth, baseMod, baseEntry: INTEGER; END ; mods: ARRAY 32 OF RECORD key: LONGINT; name: ModuleName; END ; arrPtr: POINTER TO RECORD a, b, c, len, data: LONGINT END ; CONST (* object forms *)  None = 0; Set = 9; NoTyp = 12; Pointer = 13; Procedure = 14; Array = 15; Record = 16; DynArr = 17;  (* object modes *)  Var = 1; VarPar = 2;  (* tags *)  ProcTag = 0F8X; RecordTag = 0F7X;  VAR pos, off, tdadr: LONGINT; tag: CHAR; name: ARRAY 32 OF CHAR; PROCEDURE Expect (tag: CHAR); VAR ch: CHAR; BEGIN Files.Read(R, ch); IF ch # tag THEN res := corruptedObjFile END ; END Expect; PROCEDURE ReadTypes (VAR R: Files.Rider); VAR i, j, k, tdsize, recordSize: LONGINT; tdEntry, nofMethods, nofNewMeths, mthNo, nofPointers, root, entryNo: INTEGER; td: TDesc; name: ModuleName; ch: CHAR; BEGIN i := 0; WHILE i < LEN(m.tdescs^) DO types[i].initialized := FALSE; Files.ReadLInt(R, recordSize); Files.ReadInt(R, tdEntry); types[i].entry := tdEntry; Files.ReadInt(R, types[i].baseMod); Files.ReadInt(R, types[i].baseEntry); Files.ReadInt(R, nofMethods); types[i].nofMeth := nofMethods; Files.ReadInt(R, types[i].nofInhMeth); Files.ReadInt(R, nofNewMeths); Files.ReadInt(R, nofPointers); Files.ReadString(R, name); root := 13 (* fields tdsize..mdesc *) + nofMethods + ExtTabWordSize + 1 (* tag *); INC(root, (-root+2) MOD 4); (* ADR(td.word[root]) MOD 16 = 8 ! *) types[i].root := root; tdsize := (root + 1 (* recsize *) + nofPointers + 1 (* sentinel *) )*4; IF Kernel.LargestAvailable() < tdsize THEN res := notEnoughMemory; RETURN END ; S.NEW(td, tdsize - 24 (* overhead of SysBlk header *) ); IF td = NIL THEN RETURN END ; DEC(S.VAL(ADDRESS, td), 24); (* overhead of SysBlk header *) types[i].tdesc := td; td.word[0] := tdsize; td.word[1] := -4; (* sentinel *) td.word[2] := S.ADR(td.word[root]) (* self *); td.word[3] := 0; (* extlev *) k := S.ADR(td.word[4]); j := 0; REPEAT ch := name[j]; S.PUT(k, ch); INC(j); INC(k) UNTIL ch = 0X; td.word[12] := S.ADR(m^); (* mdesc *) j := 0; WHILE j < nofNewMeths DO Files.ReadInt(R, mthNo); Files.ReadInt(R, entryNo); td.word[root + Mth0WordOffset - mthNo] := m.entries[entryNo]; INC(j); END ; td.word[root - 1] := S.ADR(td.word[0]); (* tag of subobj *) td.word[root] := recordSize; S.PUT(m.varEntries[tdEntry], S.ADR(td.word[root])); m.tdescs[i] := S.ADR(td.word[root]); j := 0; WHILE j < nofPointers DO Files.ReadLInt(R, td.word[root+1+j]); INC(j) END ; td.word[root+1+nofPointers] := -(nofPointers+1)*4; (* sentinel *) INC(i); END ; END ReadTypes; PROCEDURE InitType (i: LONGINT); VAR t, baseType, tag, entry: LONGINT; extlev, n, root, baseModNo: INTEGER; td: TDesc; baseMod: Module; BEGIN IF ~types[i].initialized THEN td := types[i].tdesc; baseModNo := types[i].baseMod; extlev := 0; root := types[i].root; IF baseModNo # -1 THEN (* extended type *) IF baseModNo = 0 THEN (* base type in this module, initialize first! *) t := 0; WHILE (t < LEN(m^.tdescs^)) & (types[t].entry # types[i].baseEntry) DO INC(t) END ; InitType(t); END ; (* copy base type tags *) baseMod := S.VAL(Module, m.imports[baseModNo]); S.GET(baseMod.varEntries[types[i].baseEntry], baseType); S.GET(baseType + Tag0WordOffset*4, tag); WHILE tag # 0 DO td.word[root + Tag0WordOffset - extlev] := tag; INC(extlev); S.GET(baseType + (Tag0WordOffset - extlev)*4, tag); END ; (* copy non-overwritten base methods *) n := types[i].nofInhMeth; WHILE n > 0 DO DEC(n); entry := td.word[root + Mth0WordOffset - n]; IF entry = 0 THEN S.GET(baseType + (Mth0WordOffset - n)*4, td.word[root + Mth0WordOffset - n]); END END END ; td.word[3] := extlev; td.word[root + Tag0WordOffset - extlev] := S.ADR(td.word[root]); (* own type tag *) types[i].initialized := TRUE; END END InitType; PROCEDURE InitTypes; VAR i: LONGINT; BEGIN i := 0; WHILE i < LEN(m.tdescs^) DO InitType(i); INC(i) END END InitTypes; PROCEDURE BuildModuleBlock (m: Module; VAR head: Header); VAR t, size, gvarSize: LONGINT; arrPtr: POINTER TO RECORD a, b, c, len, data: LONGINT END ; BEGIN size := 16 * ((head.nofDataEntries*4 + 35) DIV 16 + (head.nofEntries*4 + 35) DIV 16 + (head.nofCommands*SIZE(Cmd) + 35) DIV 16 + (head.nofPointers*4 + 35) DIV 16 + (head.nofTypes*4 + 35) DIV 16 + ((head.nofImports+1)*4 + 35) DIV 16 + (head.dataSize + (-head.dataSize) MOD 8 + head.constSize + 35) DIV 16 + (head.codeSize + 35) DIV 16 + (head.refSize + 35) DIV 16); IF Kernel.LargestAvailable() < size + 24 THEN importing := m.name; res := notEnoughMemory; RETURN END ; S.NEW(arrPtr, size); S.GET(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.varEntries), arrPtr); arrPtr.len := head.nofDataEntries; INC(S.VAL(ADDRESS, arrPtr), ((LONG(head.nofDataEntries)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.entries), arrPtr); arrPtr.len := head.nofEntries; INC(S.VAL(ADDRESS, arrPtr), ((LONG(head.nofEntries)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.cmds), arrPtr); arrPtr.len := head.nofCommands; INC(S.VAL(ADDRESS, arrPtr), ((LONG(head.nofCommands)*SIZE(Cmd) + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.ptrTab), arrPtr); arrPtr.len := head.nofPointers; INC(S.VAL(ADDRESS, arrPtr), ((LONG(head.nofPointers)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.tdescs), arrPtr); arrPtr.len := head.nofTypes; INC(S.VAL(ADDRESS, arrPtr), ((LONG(head.nofTypes)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.imports), arrPtr); arrPtr.len := head.nofImports+1; INC(S.VAL(ADDRESS, arrPtr), (((LONG(head.nofImports)+1)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.data), arrPtr); gvarSize := head.dataSize + (-head.dataSize) MOD 8; m.sb := S.ADR(arrPtr.data) + gvarSize; arrPtr.len := (gvarSize + head.constSize + 3); (* >> +3 noetig ?? *) INC(S.VAL(ADDRESS, arrPtr), ((gvarSize + head.constSize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.code), arrPtr); arrPtr.len := head.codeSize; INC(S.VAL(ADDRESS, arrPtr), ((head.codeSize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.refs), arrPtr); arrPtr.len := head.refSize; END BuildModuleBlock; PROCEDURE GetInt (VAR adr, i: LONGINT);  VAR n: LONGINT; s: SHORTINT; x: CHAR; BEGIN s := 0; n := 0; S.GET(adr, x); INC(adr); WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) - 128, s)); INC(s, 7); S.GET(adr, x); INC(adr) END ; i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64 * 64, s) END GetInt;  PROCEDURE GetString (VAR adr: LONGINT; VAR str: ARRAY OF CHAR);  VAR i: INTEGER; ch: CHAR; len: LONGINT; BEGIN i := 0; len := LEN(str); S.GET(adr, ch); WHILE (ch > 2X) & (i < len - 1) DO str[i] := ch; INC(adr); INC(i); S.GET(adr, ch) END ; str[i] := 0X; IF ch > 2X THEN WHILE ch > 2X DO INC(adr); S.GET(adr, ch) END END ; INC(adr) END GetString;  PROCEDURE SkipTyp (VAR pos: LONGINT; form: SHORTINT);  VAR h: LONGINT; BEGIN LOOP CASE form OF DynArr: GetInt(pos, h); S.GET(pos, form); INC(pos) | Array: GetInt(pos, h); GetInt(pos, h); S.GET(pos, form); INC(pos) | Record: INC(pos); GetInt(pos, h); EXIT | Pointer: S.GET(pos, form); INC(pos) | Procedure: GetInt(pos, h); EXIT | NoTyp, None..Set: EXIT END END END SkipTyp;  PROCEDURE SkipObj (VAR pos: LONGINT; VAR tag: SHORTINT);  VAR h: LONGINT; name: ARRAY 32 OF CHAR; form: SHORTINT; BEGIN GetString(pos, name); GetInt(pos, h); S.GET(pos, form); INC(pos); SkipTyp(pos, form); S.GET(pos, tag) END SkipObj;  PROCEDURE SkipVariables (VAR pos: LONGINT);  VAR tag: SHORTINT; BEGIN S.GET(pos, tag); WHILE tag IN {Var, VarPar} DO INC(pos); SkipObj(pos, tag) END END SkipVariables;  PROCEDURE SkipFields (VAR pos: LONGINT);  VAR tag: SHORTINT; BEGIN S.GET(pos, tag); WHILE tag # 0 DO SkipObj(pos, tag) END ; INC(pos) END SkipFields;  BEGIN (* LoadModule *) res := done; IF Kernel.LargestAvailable() < SIZE(ModuleDesc) THEN importing := ""; res := notEnoughMemory; RETURN END ; NEW(m); m.init := FALSE; m.refcnt := 0; m.term := NIL; (* HeaderBlk *) Files.ReadLInt(R, head.refSize); Files.ReadInt(R, head.nofDataEntries); Files.ReadInt(R, head.nofEntries); Files.ReadInt(R, head.nofCommands); Files.ReadInt(R, head.nofPointers); Files.ReadInt(R, head.nofTypes); Files.ReadInt(R, head.nofImports); Files.ReadInt(R, head.nofDataLinks); Files.ReadInt(R, head.nofLinks); Files.ReadLInt(R, head.dataSize); Files.ReadInt(R, head.constSize); ReadUnsigned(R, head.codeSize); Files.ReadLInt(R, m.key); Files.ReadString(R, m.name); BuildModuleBlock(m, head); IF res # done THEN m := NIL; RETURN END ; (* VarEntries *) Expect(08CX); i := 0; t := m.sb; WHILE i < head.nofDataEntries DO Files.ReadLInt(R, e); m.varEntries[i] := t + e; INC(i); END ; (* EntryBlk *) Expect(082X); i := 0; t := S.ADR(m.code[0]); WHILE i < head.nofEntries DO ReadUnsigned(R, e); m.entries[i] := t + e; INC(i) END ; (* CmdBlk *) Expect(083X); i := 0; WHILE i < head.nofCommands DO Files.ReadString(R, m.cmds[i].name); ReadUnsigned(R, e); m.cmds[i].adr := t + e; INC(i) END ; (* PtrBlk *) Expect(084X); i := 0; t := m.sb; WHILE i < head.nofPointers DO Files.ReadLInt(R, k); m.ptrTab[i] := t + k; INC(i) END ; (* Import Block *) Expect(085X); i := 0; WHILE i < head.nofImports DO Files.ReadLInt(R, mods[i].key); Files.ReadString(R, mods[i].name); INC(i) END ; (* Data Link Block *) Expect(08DX); i := 0; WHILE i < head.nofDataLinks DO Files.Read(R, dataLinks[i].mod); Files.ReadInt(R, dataLinks[i].entry); Files.ReadInt(R, dataLinks[i].nofFixups); IF dataLinks[i].nofFixups > 0 THEN NEW(dataLinks[i].offset , dataLinks[i].nofFixups); j := 0; WHILE j < dataLinks[i].nofFixups DO ReadUnsigned(R, dataLinks[i].offset[j]); INC(j); END ; ELSE dataLinks[i].offset := NIL; END ; INC(i) END ; (* Link Block *) Expect(086X); i := 0; WHILE i < head.nofLinks DO Files.Read(R, linkTab[i].mod); Files.Read(R, linkTab[i].entry); ReadUnsigned(R, linkTab[i].link); INC(i) END ; (* Const Block *) Expect(087X); i := 0; t := m.sb; WHILE i < head.constSize DO Files.Read(R, ch); S.PUT(t, ch); INC(t); INC(i) END ; (* Code Block *) Expect(088X); Files.ReadBytes(R, m.code^, head.codeSize); (* TypeBlk *) Expect(089X); ReadTypes(R); IF res # done THEN RETURN END ; (* Reference Block *) Expect(08BX); Files.ReadBytes(R, m.refs^, head.refSize); (* load imported modules *) m.imports[0] := S.ADR(m^); i := 0; IF res = done THEN LOOP IF i >= head.nofImports THEN EXIT END ; Load(mods[i].name, m1); IF res # done THEN EXIT END ; IF m1.key # mods[i].key THEN res := keyMismatch; importing := m.name; imported := mods[i].name; C.Str(imported); C.Str(" imported with bad key from "); C.Str(importing); C.Ln; EXIT END ; INC(i); m.imports[i] := S.ADR(m1^); END ; END ; IF res = done THEN Find(m.name, m1); IF m1 # NIL THEN (* cyclic load, we're done *) m := m1; RETURN END ; WHILE i > 0 DO m1 := S.VAL(Module, m.imports[i]); INC(m1.refcnt); DEC(i) END ; Fixup(m, head, dataLinks, linkTab); InitTypes; pos := S.ADR(m.refs^); REPEAT S.GET(pos, tag); IF tag = ProcTag THEN INC(pos); GetInt(pos, off); GetString(pos, name); SkipVariables(pos) END UNTIL tag # ProcTag; i := 0; WHILE tag = RecordTag DO types[i].tdesc.word[3] := types[i].tdesc.word[3] + (pos - S.ADR(m.refs^)) * 256; (* position after tag in bytes 1 and 2 *) INC(pos); GetInt(pos, tdadr); GetString(pos, name); SkipFields(pos); INC(i); S.GET(pos, tag) END ; m.next := Kernel.modules; Kernel.modules := m; m.init := TRUE; S.PUT(S.ADR(body), S.ADR(m.code[0])); body; ELSE m := NIL; END END LoadModule; PROCEDURE Load (name: ARRAY OF CHAR; VAR m: Module); VAR f: Files.File; R: Files.Rider; i: INTEGER; fname: ARRAY 64 OF CHAR; tag: CHAR; BEGIN importing := ""; imported := ""; Find(name, m); res := done; IF m = NIL THEN COPY(name, fname); i := 0; WHILE fname[i] # 0X DO INC(i) END ; fname[i] := "."; fname[i+1] := "O"; fname[i+2] := "b"; fname[i+3] := "j"; fname[i+4] := 0X; f := Files.Old(fname); IF f = NIL THEN IF Debug THEN C.Str(fname); C.Str(" not found"); C.Ln END ; COPY(name, importing); res := fileNotFound; RETURN END ; Files.Set(R, f, 0); Files.Read(R, tag); IF tag = 0F8X THEN Files.Read(R, tag); IF tag = 036X THEN LoadModule(R, m) ELSE C.Str(fname); C.Str(": wrong object file version"); C.Ln; res := invalidObjFile; END ; ELSE C.Str(fname); C.Str(" is not an object file"); C.Ln; res := invalidObjFile; END ELSIF ~m.init THEN C.Str("cyclic import not allowed"); res := cyclicImport; END ; END Load; PROCEDURE ThisMod* (name: ARRAY OF CHAR): Module; VAR mod: Module; BEGIN Load(name, mod); RETURN mod END ThisMod; PROCEDURE ThisCommand* (mod: Module; name: ARRAY OF CHAR): Command; VAR i: LONGINT; BEGIN i := LEN(mod.cmds^); WHILE i > 0 DO DEC(i); IF mod.cmds[i].name = name THEN res := done; RETURN S.VAL(Command, mod.cmds[i].adr) END END ; COPY(name, importing); res := cmdNotFound; RETURN NIL END ThisCommand; PROCEDURE Delete (m: Module); VAR m1: Module; BEGIN m1 := Kernel.modules; IF m = m1 THEN Kernel.modules := m.next; ELSE WHILE m1.next # m DO m1 := m1.next END ; m1.next := m.next; END END Delete; PROCEDURE Free* (name: ARRAY OF CHAR; all: BOOLEAN); VAR m, m1: Module; i: LONGINT; h: Kernel.TerminationHandler; BEGIN res := done; Find(name, m); IF m = NIL THEN COPY(name, importing); res := modNotFound ELSIF m.refcnt # 0 THEN importing := m.name; res := refCntNotZero ELSE IF (MayUnload = NIL) OR MayUnload(m) THEN IF m.term # NIL THEN h := m.term; m.term := NIL; h END ; i := LEN(m.imports^); WHILE i > 1 DO DEC(i); m1 := S.VAL(Module, m.imports[i]); DEC(m1.refcnt) END ; IF all THEN i := LEN(m.imports^); WHILE i > 1 DO DEC(i); m1 := S.VAL(Module, m.imports[i]); Free(m1.name, TRUE) END ; res := done; END ; Delete(m) ;IF res = done THEN C.Ln; C.Str("Freed "); C.Str(name) END ELSE res := codeReferenced END END END Free; PROCEDURE Init; VAR modPtr, cmdPtr: POINTER TO RECORD name: ARRAY 32 OF CHAR END ; newRec: PROCEDURE(tag: Kernel.Tag; VAR p: ADDRESS); newSys: PROCEDURE(size: LONGINT; VAR p: ADDRESS); newArr: PROCEDURE(nofdim, nofelem: LONGINT; eltag: Kernel.Tag; VAR p: ADDRESS); deb: LONGINT; BEGIN Kernel.GetAdr(0, "debugOn", deb); Debug := deb # 0; newRec := Kernel.NewRec; newSys := Kernel.NewSys; newArr := Kernel.NewArr; KernelRoutines[0] := S.VAL(ADDRESS, newRec); KernelRoutines[1] := S.VAL(ADDRESS, newSys); KernelRoutines[2] := S.VAL(ADDRESS, newArr); MayUnload := NIL; (* init loop only if Modules is last module in boot file: *) Kernel.GetAdr(0, "modPtr", S.VAL(LONGINT, modPtr)); Kernel.GetAdr(0, "cmdPtr", S.VAL(LONGINT, cmdPtr)); loop := ThisCommand(ThisMod(modPtr.name), cmdPtr.name); END Init; BEGIN Init; loop; (* call loop only if Modules is last module in boot file *) END Modules.