Oberon10.Scn.FntOberon10i.Scn.FntO*0.w R& Oberon10b.Scn.FntUL C  T | } Tmq\,  R7 z%   !  O7U>$q! eMVI e * !%7  f&L"g % g H?  q|  (" H 8]L HH  !Oberon10m.Scn.Fnt < D )0;;hmMODULE Modules; (* rc, js 5.7.96 *) (*---------------------------------------------------------* * Copyright (c) 1990-1996 ETH Zrich. All Rights Reserved. * Oberon is a trademark of Institut fr Computersysteme, ETH Zrich. *---------------------------------------------------------*) (*-- object model --*) IMPORT Unix, Kernel, Files, S := SYSTEM, Console; CONST OFext = ".obj"; (* object file extension *) OFtag = 037F9H; (* object file tag *) ModNameLen* = 32; stubSize = 18H; (* Fix Types *) DataFix = 0; BranchFix = 1; MilliFix = 2; (* Power of 2 *) p5 = 20H; p11 = 800H; p16 = 10000H; p21 = 200000H; p26 = 4000000H; TYPE Name* = ARRAY ModNameLen OF CHAR; ModuleName* = Name; Command* = PROCEDURE; ADDRESS = LONGINT; Export* = RECORD name*: Name; fprint*: LONGINT; adr*: ADDRESS; mode*: INTEGER END; Cmd* = RECORD name*: Name; adr*: ADDRESS END; Module* = POINTER TO ModuleDesc; ModuleDesc* = RECORD next*: Module; name*: Name; init*: BOOLEAN; refcnt*, sb*: LONGINT; exports*: POINTER TO ARRAY OF Export; tdescs*: POINTER TO ARRAY OF (* Kernel.Tag *) ADDRESS; cmds*: POINTER TO ARRAY OF Cmd; ptrTab*: POINTER TO ARRAY OF ADDRESS; imports*: POINTER TO ARRAY OF (* Module *) ADDRESS; data*, code*: POINTER TO ARRAY OF LONGINT; refs*: POINTER TO ARRAY OF CHAR END; VAR firstModule*, modules*: Module; imported*: Name; importing*: Name; object*: Name; objmode*: Name; res*: INTEGER; CONST done = 0; fileNotFound = 1; notAnObjFile = 2; fpMismatch = 3; corruptedObjFile = 4; cmdNotFound = 5; modNotFound = 6; notEnoughSpace = 7; refCntNotZero = 8; cyclicImport = 9; (* not detected any more *) objNotFound = 10; tooManyFiles = 11; millicallError = 12; ExtTabWordSize = 16; Tag0WordOffset = -2; Mth0WordOffset = Tag0WordOffset - ExtTabWordSize; VAR KernelRoutines: ARRAY 3 OF RECORD name: Name; adr: ADDRESS END; milliTable : ARRAY 32 OF ADDRESS; lastMod: Module; loop: Command; modeStr: ARRAY 9 OF Name; (*----- Immediate operations -----*) PROCEDURE Left (n : LONGINT) : LONGINT; BEGIN RETURN (n DIV p11) MOD p21 END Left; PROCEDURE Right (n : LONGINT) : LONGINT; BEGIN RETURN n MOD p11 END Right; PROCEDURE Assemble17 (n : LONGINT) : LONGINT; (* pattern -> integer*) VAR x, y, z : LONGINT; BEGIN x := (n DIV 10000H) MOD 20H; y := (n DIV 4H) MOD 800H; z := n MOD 2H; RETURN z * 10000H + x * 800H + (y MOD 2) * 400H + y DIV 2; END Assemble17; PROCEDURE Disass17 (n : LONGINT): LONGINT; (* integer -> pattern *) VAR x, y, z : LONGINT; BEGIN z := (n DIV 10000H) MOD 2H; x := (n DIV 800H) MOD 20H; y := (n MOD 400H) * 2H + (n DIV 400H) MOD 2; RETURN x * 10000H + y * 4H + z; END Disass17; PROCEDURE Disass21 (n : LONGINT) : LONGINT; (* integer -> pattern *) BEGIN RETURN ((n DIV 4H) MOD 20H) * 10000H + (* Bit 14..18 *) ((n DIV 80H) MOD 4H) * 4000H + (* Bit 12..13 *) (n MOD 4H) * 1000H + (* Bit 19..20 *) ((n DIV 200H) MOD 800H) * 2H + (* Bit 1..11 *) ((n DIV 100000H) MOD 2H); (* Bit 0 *) END Disass21; PROCEDURE LowSignRed14 (n : LONGINT) : LONGINT; BEGIN ASSERT ((-8192 <= n) & (n < 8192)); IF n < 0 THEN RETURN (n + 8192) * 2 + 1; ELSE RETURN n * 2; END; END LowSignRed14; PROCEDURE SignRed16 (n : LONGINT) : LONGINT; BEGIN RETURN n MOD 10000H; END SignRed16; PROCEDURE SignExt16 (n : LONGINT) : LONGINT; BEGIN IF n DIV 8000H = 0 THEN RETURN n ELSE RETURN n - 10000H END; END SignExt16; PROCEDURE SignExt17 (n : LONGINT) : LONGINT; BEGIN IF n DIV 10000H = 0 THEN RETURN n ELSE RETURN n - 20000H END; END SignExt17; PROCEDURE SignRed17 (n : LONGINT) : LONGINT; BEGIN RETURN n MOD 20000H; END SignRed17; PROCEDURE ExtractInstrPattern17 (instr : LONGINT) : LONGINT; VAR tPat : LONGINT; BEGIN tPat := ((instr DIV 10000H) MOD 20H) * 10000H + ((instr DIV 4H) MOD 800H) * 4H + (instr MOD 2H); RETURN instr - tPat; END ExtractInstrPattern17; PROCEDURE ExtractTarget17 (target : LONGINT) : LONGINT; VAR x: LONGINT; BEGIN RETURN SignExt17(Assemble17(target)); END ExtractTarget17; PROCEDURE FormatTarget17 (target : LONGINT) : LONGINT; BEGIN RETURN Disass17(SignRed17(target)); END FormatTarget17; PROCEDURE ExtractInstrPattern21 (instr : LONGINT) : LONGINT; BEGIN RETURN instr - instr MOD 200000H; END ExtractInstrPattern21; PROCEDURE ExtractInstrPattern14 (n : LONGINT) : LONGINT; BEGIN RETURN n - (n MOD 10000H); END ExtractInstrPattern14; (*----- Garbage Collector Procedures -----*) PROCEDURE FindRoots; VAR m: Module; i, p, ptradr: LONGINT; ptr: Kernel.Ptr; BEGIN m := modules; (* ModuleDesc and ModuleBlock are marked via modules *) WHILE m # NIL DO i := LEN(m.ptrTab^); ptradr := S.ADR(m.ptrTab[0]); WHILE i > 0 DO S.GET(ptradr, p); S.GET(p, ptr); IF ptr # NIL THEN Kernel.Mark(ptr) END; DEC(i); INC(ptradr, 4) END; i := LEN(m.tdescs^); ptradr := S.ADR(m.tdescs[0]); WHILE i > 0 DO S.GET(ptradr, ptr); Kernel.Mark(ptr); DEC(i); INC(ptradr, 4) END; m := m^.next END END FindRoots; PROCEDURE FindAmbRoots; VAR i, p, sp: LONGINT; ctxt: Unix.SigContextPtr; BEGIN S.GETREG(30, sp); IF Kernel.TrapHandlingLevel > 0 THEN (* running on system stack *) WHILE sp < Kernel.sysStackBot DO (* system stack *) S.GET(sp, p); Kernel.Candidate(p); INC(sp, 4) END; S.GETREG (30, Kernel.userStackLimit); ctxt := S.VAL(Unix.SigContextPtr, Kernel.curSigCtxt); i := 1; WHILE i < 26 DO p := ctxt.sl.ss.grs[i]; Kernel.Candidate(p); INC(i) END; sp := ctxt.sl.ss.grs[30]; IF (sp >= Kernel.sysStackTop) & (sp < Kernel.sysStackBot) THEN (* interrupted on system stack, cannot GC user stack *) sp := Kernel.userStackLimit END END; WHILE sp > Kernel.userStackLimit DO (* user stack *) S.GET(sp, p); Kernel.Candidate(p); DEC(sp, 4) END; (* callee-saved general registers *) S.GETREG(3, p); Kernel.Candidate(p); S.GETREG(4, p); Kernel.Candidate(p); S.GETREG(5, p); Kernel.Candidate(p); S.GETREG(6, p); Kernel.Candidate(p); S.GETREG(7, p); Kernel.Candidate(p); S.GETREG(8, p); Kernel.Candidate(p); S.GETREG(9, p); Kernel.Candidate(p); S.GETREG(10, p); Kernel.Candidate(p); S.GETREG(11, p); Kernel.Candidate(p); S.GETREG(12, p); Kernel.Candidate(p); S.GETREG(13, p); Kernel.Candidate(p); S.GETREG(14, p); Kernel.Candidate(p); S.GETREG(15, p); Kernel.Candidate(p); S.GETREG(16, p); Kernel.Candidate(p); S.GETREG(17, p); Kernel.Candidate(p); END FindAmbRoots; PROCEDURE Fixup(m: Module; entry, L: LONGINT; type : INTEGER); VAR L1, L2, c, c1, offset, target, link, baseReg: LONGINT; BEGIN IF L # 0 THEN REPEAT L1 := L; L2 := L1+1; c := m.code[L1]; c1 := m.code[L2]; IF type = DataFix THEN link := SignExt16 (c MOD p16); L := L1 + link + 2; baseReg := (c DIV 200000H) MOD 20H; offset := m.code[L2] + entry; ASSERT (L # L1 -1); (* No 8-byte access *) m.code[L1] := 20000000H + baseReg * 200000H + Disass21 (Left(offset)); (* LDIL offsetHi, baseReg *) m.code[L2] := ExtractInstrPattern14(c) + LowSignRed14 (Right(offset)); ELSE (* procedure or millicode *) link := ExtractTarget17 (c); L := L1 + link + 2; IF ((c DIV p26) MOD 40H = 08H) & ((c1 DIV p26) MOD 40H = 0DH) THEN (* proc var *) m.code[L1] := ExtractInstrPattern21(c) + Disass21(Left(entry+1)); m.code[L1+1] := ExtractInstrPattern14(c1) + LowSignRed14 (Right(entry+1)); ELSIF type = BranchFix THEN (* external call *) m.code[L1] := ExtractInstrPattern21(c) + Disass21 (Left(entry)); m.code[L1+1] := ExtractInstrPattern17(c1) + FormatTarget17 (Right(entry) DIV 4); ELSE (* System call *) baseReg := (c DIV p21) MOD p5; IF baseReg >= 16 THEN (* Kernel *) target := KernelRoutines[baseReg-16].adr; ASSERT (target # 0); m.code[L1] := 20400000H + Disass21 (Left(target)); (* LDIL target, R2 *) m.code[L1+1] := ExtractInstrPattern17(c1) + FormatTarget17 (Right(target) DIV 4); ELSE (* Millicode *) target := milliTable[baseReg]; IF target = 0 THEN Console.Str ("Bad millicode : baseReg = "); Console.Int (baseReg); Console.Ln; END; ASSERT (target # 0, 52); m.code[L1] := 23E00000H + Disass21 (Left(target)); (* LDIL target, R31 *) m.code[L1+1] := ExtractInstrPattern17(c1) + FormatTarget17 (Right(target) DIV 4); END; END; END; UNTIL L = L1 END END Fixup; PROCEDURE Delete(m: Module); VAR m1: Module; BEGIN m1 := modules; WHILE m1.next # m DO m1 := m1.next END; m1.next := m1.next.next; IF lastMod = m THEN lastMod := m1 END END Delete; PROCEDURE ^Load(name: ARRAY OF CHAR; VAR m: Module); PROCEDURE LoadModule(VAR R: Files.Rider; VAR m: Module); TYPE TDescBlock = POINTER TO RECORD word: ARRAY 32000 OF LONGINT END; TDescDesc = POINTER TO RECORD tdsize, sentinel, self: LONGINT; ext: RECORD extlev: SHORTINT; filler: ARRAY 3 OF CHAR END; name: Name; mdesc: Module; pvfprint: LONGINT END; Type = RECORD tdb: TDescBlock; link, root, nofmeth, nofinhmeth, bmno, bpvfp: LONGINT; bname: Name END; ExportPtr = POINTER TO Export; ArrPtr = POINTER TO RECORD a, b, c, len, data: LONGINT END; VAR i, entry, link, fprint, k, t, curtd, limtd: LONGINT; m1: Module; curexp, limexp: ExportPtr; fixType : INTEGER; refsize, nofimp, syslink, datalink, datasize, consize, codesize: LONGINT; nofexp, nofdesc, nofcom, nofptr, linknr, expnr, descnr: INTEGER; name: Name; ch: CHAR; body: Command; links: ARRAY 256 OF RECORD entry, link: LONGINT END; types: ARRAY 128 OF Type; mods: ARRAY 32 OF RECORD name: Name; END; arrPtr: ArrPtr; PROCEDURE Block(tag: CHAR); VAR ch: CHAR; BEGIN Files.Read(R, ch); IF ch # tag THEN importing := m.name; res := corruptedObjFile END END Block; PROCEDURE ReadType(VAR tdesc: ADDRESS); VAR tdb: TDescBlock; tdd: TDescDesc; i, k, tdsize, recsize, pvfp, link, bmno: LONGINT; nofmeth, nofnewmeth, mthno, nofptr, root, entry: LONGINT; name: Name; ch: CHAR; BEGIN Files.ReadString(R, name); IF name = "" THEN Files.ReadNum(R, pvfp) ELSE pvfp := 0 END; Files.ReadNum(R, types[descnr].link); Files.ReadNum(R, recsize); Files.ReadNum(R, bmno); types[descnr].bmno := bmno; IF bmno >= 0 THEN Files.ReadString(R, types[descnr].bname); IF types[descnr].bname = "" THEN Files.ReadNum(R, types[descnr].bpvfp) END END; Files.ReadNum(R, nofmeth); types[descnr].nofmeth := nofmeth; Files.ReadNum(R, types[descnr].nofinhmeth); Files.ReadNum(R, nofnewmeth); Files.ReadNum(R, nofptr); root := 14 (* tdsize..pvfp *) + nofmeth + ExtTabWordSize + 1 (* tag *); INC(root, (-root+2) MOD 4); (* ADR(tdesc.a[root]) MOD 16 = 8 ! *) types[descnr].root := root; tdsize := (root + 1 (* recsize *) + nofptr + 1 (* sentinel *))*4; IF Kernel.LargestAvailable() < tdsize THEN importing := name; res := notEnoughSpace; RETURN END; S.NEW(tdb, tdsize - 24 (* SysBlk header *)); DEC(S.VAL(ADDRESS, tdb), 24); types[descnr].tdb := tdb; tdd := S.VAL(TDescDesc, tdb); tdd.tdsize := tdsize; tdd.sentinel := -4; tdd.self := S.ADR(tdb.word[root]); tdd.name := name; tdd.mdesc := m; tdd.pvfprint := pvfp; i := 0; WHILE i < nofnewmeth DO Files.ReadNum(R, mthno); Files.ReadNum(R, entry); INC(i); tdb.word[root + Mth0WordOffset - mthno] := S.ADR(m.code[0]) + 4*entry END; tdb.word[root - 1] := S.ADR(tdb.word[0]); tdb.word[root] := recsize; i := 0; WHILE i < nofptr DO Files.ReadNum(R, tdb.word[root+1+i]); INC(i) END; tdb.word[root+1+nofptr] := -(nofptr+1)*4; tdesc := S.ADR(tdb.word[root]) END ReadType; PROCEDURE FindExp(mode: INTEGER; VAR name: Name; fprint: LONGINT; VAR adr: LONGINT); BEGIN LOOP IF curexp = limexp THEN res := objNotFound; object := name; objmode := modeStr[mode]; EXIT END; IF (curexp.name = name) & (curexp.mode = mode) THEN IF curexp.fprint # fprint THEN res := fpMismatch; object := name; objmode := modeStr[mode] END; adr := curexp.adr; INC(S.VAL(LONGINT, curexp), SIZE(Export)); EXIT END; INC(S.VAL(LONGINT, curexp), SIZE(Export)) END END FindExp; PROCEDURE FindTDesc(VAR name: Name; fprint: LONGINT; VAR adr: LONGINT); VAR save, td: LONGINT; tdd: TDescDesc; BEGIN save := curtd; (* anonymous tdescs are unsorted *) LOOP IF curtd = limtd THEN res := objNotFound; object := name; objmode := modeStr[8]; EXIT END ; S.GET(curtd, td); S.GET(td - 4, tdd); IF tdd.name = name THEN IF (tdd.pvfprint = fprint) OR (fprint = 0) THEN adr := td; INC(curtd, 4); EXIT END ; IF name # "" THEN res := fpMismatch; object := name; objmode := modeStr[8]; EXIT END END ; INC(curtd, 4) END ; IF name = "" THEN curtd := save END END FindTDesc; PROCEDURE InitType(tdesc: ADDRESS; VAR type: Type); VAR tdb: TDescBlock; tdd: TDescDesc; l, r, t, k, base, tag, root, n, entry, pvfp: LONGINT; mb: Module; BEGIN tdb := type.tdb; IF tdb # NIL THEN (* not done yet *) type.tdb := NIL; Fixup(m, tdesc, type.link, DataFix); k := 0; root := type.root; base := type.bmno; IF base # -1 THEN mb := S.VAL(Module, m.imports[base]); IF type.bname = "" THEN pvfp := type.bpvfp; t := -1; REPEAT (* tdesc always present since local *) INC(t); S.GET(mb.tdescs[t] - 4, tdd) UNTIL tdd.pvfprint = pvfp ELSE l := 0; r := LEN(mb.tdescs^) - 1; LOOP IF l > r THEN EXIT END; t := (l + r) DIV 2; S.GET(mb.tdescs[t] - 4, tdd); IF type.bname < tdd.name THEN r := t - 1 ELSIF type.bname > tdd.name THEN l := t + 1 ELSE EXIT END END; IF l > r THEN importing := m.name; imported := mb.name; object := type.bname; objmode := modeStr[8]; res := objNotFound; RETURN END END; IF base = 0 THEN InitType(mb.tdescs[t], types[t]) (* res always 0 here *) END; base := mb.tdescs[t]; S.GET(base + Tag0WordOffset*4, tag); WHILE tag # 0 DO tdb.word[root + Tag0WordOffset - k] := tag; INC(k); S.GET(base + (Tag0WordOffset - k)*4, tag) END; n := type.nofinhmeth; WHILE n > 0 DO DEC(n); entry := tdb.word[root + Mth0WordOffset - n]; IF entry = 0 THEN S.GET(base + (Mth0WordOffset - n)*4, tdb.word[root + Mth0WordOffset - n]) END END END; S.PUT(S.ADR(tdb.word[3]), SHORT(SHORT(k))); (* ok for little and big endian *) tdb.word[root + Tag0WordOffset - k] := S.ADR(tdb.word[root]); END END InitType; PROCEDURE BuildModBlock; VAR t, gconSize: LONGINT; BEGIN S.GET(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.exports), arrPtr); arrPtr.len := nofexp; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofexp)*SIZE(Export) + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.tdescs), arrPtr); arrPtr.len := nofdesc; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofdesc)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.cmds), arrPtr); arrPtr.len := nofcom; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofcom)*SIZE(Cmd) + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.ptrTab), arrPtr); arrPtr.len := nofptr; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofptr)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.imports), arrPtr); arrPtr.len := nofimp+1; INC(S.VAL(ADDRESS, arrPtr), (((nofimp+1)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.data), arrPtr); gconSize := consize + (-consize) MOD 8; m.sb := S.ADR(arrPtr.data) + gconSize; arrPtr.len := (gconSize + datasize + 3) DIV 4; INC(S.VAL(ADDRESS, arrPtr), ((gconSize + datasize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.code), arrPtr); arrPtr.len := codesize DIV 4; INC(S.VAL(ADDRESS, arrPtr), ((codesize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.refs), arrPtr); arrPtr.len := refsize END BuildModBlock; BEGIN res := done; IF Kernel.LargestAvailable() < SIZE(ModuleDesc) THEN importing := ""; res := notEnoughSpace; RETURN END; NEW(m); (*lastMod # NIL*) lastMod.next := m; lastMod := m; m.init := FALSE; m.refcnt := 0; (* HeaderBlk *) Files.ReadLInt(R, refsize); Files.ReadInt(R, nofexp); Files.ReadInt(R, nofdesc); Files.ReadInt(R, nofcom); Files.ReadInt(R, nofptr); Files.ReadNum(R, nofimp); Files.ReadNum(R, syslink); Files.ReadNum(R, datalink); Files.ReadNum(R, datasize); Files.ReadNum(R, consize); Files.ReadNum(R, codesize); Files.ReadString(R, m.name); codesize := 4*codesize; k := ((LONG(nofexp)*SIZE(Export) + 35) DIV 16 + (LONG(nofdesc)*4 + 35) DIV 16 + (LONG(nofcom)*SIZE(Cmd) + 35) DIV 16 + (LONG(nofptr)*4 + 35) DIV 16 + ((nofimp+1)*4 + 35) DIV 16 + (datasize + (-datasize) MOD 8 + consize + 35) DIV 16 + (codesize + 35) DIV 16 + (refsize + 35) DIV 16)*16; IF Kernel.LargestAvailable() < k + 24 THEN importing := m.name; Delete(m); res := notEnoughSpace; RETURN END; S.NEW(arrPtr, k); BuildModBlock; (* ImpBlk *) Block(81X); i := 0; WHILE i < nofimp DO Files.ReadString(R, mods[i].name); INC(i) END; (* ExpBlk *) Block(82X); linknr := 0; expnr := 0; descnr := 0; Files.Read(R, ch); WHILE ch # 0X DO IF ch = 8X THEN ReadType(m.tdescs[descnr]); INC(descnr); IF res # done THEN Delete(m); RETURN END ELSIF ch = 9X THEN Files.ReadNum(R, entry); links[linknr].entry := S.ADR(m.code[0]) + 4*entry; Files.ReadNum(R, links[linknr].link); INC(linknr) ELSE Files.ReadString(R, m.exports[expnr].name); Files.ReadNum(R, m.exports[expnr].fprint); m.exports[expnr].mode := ORD(ch); IF ch = 3X THEN Files.ReadNum(R, entry); m.exports[expnr].adr := m.sb + entry ELSIF ch = 4X THEN Files.ReadNum(R, entry); m.exports[expnr].adr := S.ADR(m.code[0]) + 4*entry ELSIF ch = 6X THEN INC(expnr); m.exports[expnr].mode := 7; m.exports[expnr].name := m.exports[expnr-1].name; Files.ReadNum(R, m.exports[expnr].fprint); (* pvfprint *) END; INC(expnr) END; Files.Read(R, ch) END; (* CmdBlk *) Block(83X); i := 0; t := S.ADR(m.code[0]); WHILE i < nofcom DO Files.ReadString(R, m.cmds[i].name); Files.ReadNum(R, entry); m.cmds[i].adr := t + 4*entry; INC(i) END; (* PtrBlk *) Block(84X); i := 0; t := m.sb; WHILE i < nofptr DO Files.ReadNum(R, k); m.ptrTab[i] := t + k; INC(i) END; (* ConstBlk *) Block(87X); i := 0; t := S.ADR(m.data[0]); WHILE i < consize DO Files.Read(R, ch); S.PUT(t, ch); INC(t); INC(i) END; (* CodeBlk *) Block(88X); i := 0; t := S.ADR(m.code[0]); WHILE i < codesize DO Files.ReadLInt(R, k); S.PUT(t, k); INC(t, 4); INC(i, 4) END; WHILE linknr > 0 DO DEC(linknr); Fixup(m, links[linknr].entry, links[linknr].link, BranchFix) END; Fixup(m, -1, syslink, MilliFix); (* Kernel already loaded *) Fixup(m, m.sb, datalink, DataFix); (* recursive loading of imports *) m.imports[0] := S.ADR(m^); i := 0; IF res = done THEN LOOP IF i >= nofimp THEN EXIT END; Load(mods[i].name, m1); IF res # done THEN EXIT END; INC(i); m.imports[i] := S.ADR(m1^); INC(m1.refcnt) END END; (* UseBlk *) IF res = done THEN Block(89X); i := 0; LOOP IF i >= nofimp THEN EXIT END; m1 := S.VAL(Module, m.imports[i+1]); curexp := S.VAL(ExportPtr, S.ADR(m1.exports^)); limexp := S.VAL(ExportPtr, S.VAL(ADDRESS, curexp) + LEN(m1.exports^)*SIZE(Export)); curtd := S.ADR(m1.tdescs^); limtd := curtd + LEN(m1.tdescs^)*4; Files.Read(R, ch); WHILE ch # 0X DO Files.ReadString(R, name); Files.ReadNum(R, fprint); CASE ch OF | 1X, 2X, 5X, 6X, 7X: FindExp(ORD(ch), name, fprint, entry); link := -1 | 3X, 4X: FindExp(ORD(ch), name, fprint, entry); Files.ReadNum(R, link); IF ch = 3X THEN fixType := DataFix ELSE fixType := BranchFix END; | 8X: IF name = "" THEN Files.ReadNum(R, link) ELSE link := fprint; fprint := 0 END; FindTDesc(name, fprint, entry); fixType := DataFix END; IF res # done THEN importing := m.name; imported := m1.name; IF res = fpMismatch THEN Console.Str(m.name); Console.Str(" imports "); Console.Str(objmode); Console.Ch(" "); Console.Str(m1.name); Console.Ch("."); Console.Str(object); Console.Str(" with bad fingerprint") ELSE Console.Str(objmode); Console.Ch(" "); Console.Str(m1.name); Console.Ch("."); IF object = "" THEN Console.Str("'anonymous'") ELSE Console.Str(object) END; Console.Str(" not found. Imported from "); Console.Str(m.name); END; Console.Ln; i := SHORT(nofimp); EXIT END; IF link # -1 THEN Fixup(m, entry, link, fixType) END; Files.Read(R, ch) END; INC(i) END END; (* RefBlk *) IF res = done THEN Block(8AX); i := 0; t := S.ADR(m.refs[0]); WHILE i < refsize DO Files.Read(R, ch); S.PUT(t, ch); INC(t); INC(i) END; (* init types *) i := 0; LOOP IF i = LEN(m.tdescs^) THEN EXIT END; InitType(m.tdescs[i], types[i]); IF res # done THEN i := SHORT(nofimp); EXIT END; INC(i) END END; (* execute body *) IF res = done THEN body := S.VAL(Command, S.ADR(m.code[0]) + stubSize); m.init := TRUE; Unix.Cacheflush(S.ADR(m.code[0]), codesize); body; res := done ELSE WHILE i > 0 DO m1 := S.VAL(Module, m.imports[i]); DEC(m1.refcnt); DEC(i) END; Delete(m); m := NIL END END LoadModule; PROCEDURE Load(name: ARRAY OF CHAR; VAR m: Module); VAR f: Files.File; R: Files.Rider; i, j: INTEGER; fname, fext: ARRAY 64 OF CHAR; tag: INTEGER; state: BOOLEAN; BEGIN m := modules; res := done; WHILE (m # NIL) & (name # m.name) DO m := m.next END; IF m = NIL THEN COPY(name, fname); i := 0; WHILE fname[i] # 0X DO INC(i) END; fext := OFext; j := 0; WHILE fext[j] # 0X DO fname[i] := fext[j]; INC(j); INC(i) END; fname[i] := 0X; IF Kernel.nofiles >= Files.fileTabSize - 4 THEN state := Kernel.GCenabled; Kernel.GCenabled := TRUE; Kernel.GC(TRUE); Kernel.GCenabled := state END; IF Kernel.nofiles >= Files.fileTabSize - 4 THEN importing := ""; res := tooManyFiles; RETURN END; f := Files.Old(fname); IF f = NIL THEN COPY(fname, importing); res := fileNotFound; RETURN END; Files.Set(R, f, 0); Files.ReadInt(R, tag); IF tag = OFtag THEN LoadModule(R, m) ELSE COPY(fname, importing); res := notAnObjFile END END END Load; PROCEDURE ThisMod* (name: ARRAY OF CHAR): Module; VAR mod: Module; state: BOOLEAN; BEGIN Kernel.GC(TRUE); (* Kernel.GCenabled = FALSE at boot time or when ThisMod called in bodies *) state := Kernel.GCenabled; Kernel.GCenabled := FALSE; Load(name, mod); Kernel.GCenabled := state; RETURN mod END ThisMod; PROCEDURE ThisCommand* (mod: Module; name: ARRAY OF CHAR): Command; VAR cmd: Command; 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 Free* (name: ARRAY OF CHAR; all: BOOLEAN); VAR m, m1: Module; i: LONGINT; BEGIN res := done; m := modules; WHILE (m # NIL) & (name # m.name) DO m := m.next END; IF m = NIL THEN COPY(name, importing); res := modNotFound ELSIF m.refcnt # 0 THEN importing := m.name; res := refCntNotZero ELSE Kernel.UnregisterAllObjects(S.ADR(m.code[0]), S.ADR(m.refs[0])); 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) END END Free; (*--- Proposal ---* PROCEDURE TranslateError*(name: ARRAY OF CHAR; res: INTEGER; VAR msg: ARRAY OF CHAR); VAR i: INTEGER; PROCEDURE Append(str: ARRAY OF CHAR); VAR j: INTEGER; BEGIN j := 0; WHILE (str[j] # 0X) & (i < LEN(msg)-1) DO msg[i] := str[j]; INC(i); INC(j) END; END Append; BEGIN IF res > 0 THEN i := 0; Append("Call error: "); Append(importing); IF res = 1 THEN Append(" not found") ELSIF res = 2 THEN Append(" not an obj-file") ELSIF res = 3 THEN Append(" imports "); Append(objmode); Append(" "); Append(imported); Append("."); Append(object); Append(" with bad fingerprint") ELSIF res = 4 THEN Append(" corrupted obj file") ELSIF res = 5 THEN Append(" command not found") ELSIF res = 6 THEN Append(" has too many imports") ELSIF res = 7 THEN Append(" not enough space") ELSIF res = 10 THEN (* << Object *) Append(" imports "); Append(objmode); Append(" "); Append(imported); Append("."); Append(object); Append(", not found") ELSIF res = 11 THEN Append(" too many open files") END ELSIF res < 0 THEN Append (name); Append(" not found") END; msg[i] := 0X; END TranslateError; *--- End of proposal --- *) PROCEDURE Init; VAR modPtr, cmdPtr: POINTER TO RECORD name: Name END; newRec: PROCEDURE(tag: Kernel.Tag): ADDRESS; newSys: PROCEDURE(size: LONGINT): ADDRESS; newArr: PROCEDURE(eltag: Kernel.Tag; nofelem, nofdim: LONGINT): ADDRESS; mcAdr, mcSize, i : LONGINT; BEGIN modeStr[1] := "constant"; modeStr[2] := "type"; modeStr[3] := "variable"; modeStr[4] := "procedure"; modeStr[5] := "code procedure"; modeStr[6] := "public structure of"; modeStr[7] := "private structure of"; modeStr[8] := "type descriptor of"; Kernel.FindRoots := FindRoots; Kernel.FindAmbRoots := FindAmbRoots; newRec := Kernel.NewRec; newSys := Kernel.NewSys; newArr := Kernel.NewArr; KernelRoutines[0].name := "NewRec"; KernelRoutines[0].adr := S.VAL(ADDRESS, newRec); KernelRoutines[1].name := "NewSys"; KernelRoutines[1].adr := S.VAL(ADDRESS, newSys); KernelRoutines[2].name := "NewArr"; KernelRoutines[2].adr := S.VAL(ADDRESS, newArr); Unix.dlsym(0, "millicodeTable", mcAdr); S.GET(mcAdr, mcSize); INC(mcAdr, 4); i := 0; WHILE i < mcSize DO S.GET (mcAdr, milliTable[i]); INC(i); INC(mcAdr, 4); END; WHILE i < 32 DO milliTable[i]:=0; INC(i) END; lastMod := modules; IF lastMod # NIL THEN WHILE lastMod.next # NIL DO lastMod := lastMod.next END END; (* init loop only if Modules is last module in boot file: *) Unix.dlsym(0, "modPtr", S.VAL(LONGINT, modPtr)); Unix.dlsym(0, "cmdPtr", S.VAL(LONGINT, cmdPtr)); loop := ThisCommand(ThisMod(modPtr.name), cmdPtr.name); END Init; PROCEDURE DisplayAdr; VAR m, last: Module; td: POINTER TO RECORD filler: ARRAY 4 OF LONGINT; name: Name END; BEGIN modules := S.VAL(Module, Kernel.firstBlock + 4); last := modules; WHILE last.next # NIL DO last := last.next END; m := modules; LOOP IF m = last THEN EXIT END; m := m.next END END DisplayAdr; PROCEDURE CallBodies; TYPE Body = PROCEDURE; VAR m, last: Module; body: Body; i, t: LONGINT; td: POINTER TO RECORD filler: ARRAY 4 OF LONGINT; name: Name END; BEGIN modules := S.VAL(Module, Kernel.firstBlock + 4); last := modules; WHILE last.next # NIL DO last := last.next END; m := modules; LOOP IF m.name = "Modules" THEN DisplayAdr; Init ELSE IF m.name = "Kernel" THEN i := LEN(m.tdescs^); REPEAT DEC(i); t := m.tdescs[i]; S.GET(t - 4, td) UNTIL td.name = "PtrElemDesc"; Kernel.ptrElemTag := t; END; body := S.VAL(Body, S.ADR(m.code[0])); body END; IF m = last THEN EXIT END; m := m.next END END CallBodies; BEGIN (* entry of boot file, must not return *) Kernel.Boot; CallBodies; DisplayAdr; loop; (* call loop only if Modules is last module in boot file *) Console.Str ("Back from loop"); Console.Ln; END Modules.