Oberon10.Scn.FntOberon10i.Scn.Fnt)2 -02  = ~;  0 t @, c& Oberon10b.Scn.FntUL C    T | } TmqlfZ & T;a$ "/([#  gOberon10m.Scn.FntC  %+   E   g)   @2! es3I 'z    !%7 _2 #& v" T    n   Y> C  Pl k6 ^ o l"$   ?  | 4"[ r [/@5 5    2%m  | XL$! cvWs_MODULE BootLinker; (* rc, js 4.7.96 *) (*---------------------------------------------------------* * Copyright (c) 1990-1996 ETH Zrich. All Rights Reserved. * Oberon is a trademark of Institut fr Computersysteme, ETH Zrich. *---------------------------------------------------------*) (*-- object model --*) IMPORT Texts, Oberon, Files, S := SYSTEM, Log; CONST OptionChar = "\"; OFext = ".obj"; (* object file extension *) OFtag = 037F9H; (* object file tag *) BootHeapSize = 1024*128; NofPtrFix = 10000; NofWordFix = 10000; NofProcFix = 10000; NofJalFix = 10000; NofMilliFix = 10000; NofMod = 100; (* Fix Types *) DataFix = 0; BranchFix = 1; MilliFix = 2; (* Power of 2 *) p5 = 20H; p11 = 800H; p14 = 4000H; p16 = 10000H; p21 = 200000H; p26 = 4000000H; VAR W: Texts.Writer; heapAdr, GCstart, dlsymAdr, bootEntry: LONGINT; modTag: LONGINT; littleEndian, crossEndian, showEntries: BOOLEAN; heap: S.PTR; ptrFix: ARRAY NofPtrFix OF LONGINT; wordFix: ARRAY NofWordFix OF LONGINT; procFix: ARRAY NofProcFix OF LONGINT; jalFix: ARRAY NofJalFix OF LONGINT; ptrFixx, wordFixx, procFixx, jalFixx: LONGINT; (* ----- Allocator (Kernel) declarations: ----- *) TYPE Tag = POINTER TO TypeDesc; TypeDesc = RECORD size: LONGINT; ptroff: LONGINT END; ADDRESS = LONGINT; FreePtr = POINTER TO FreeBlock; FreeBlock = RECORD (* off-4 *) tag: Tag; (* off0 *) size: LONGINT; (* field size aligned to 8-byte boundary, size MOD B = B-4 *) (* off4 *) next: ADDRESS END; InitPtr = POINTER TO RECORD tag: Tag; z0, z1, z2, z3, z4, z5, z6, z7: LONGINT END; CONST B = 32; (* must be a mutiple of 32 *) N = 9; nil = 0; free = 4; VAR A: ARRAY N+1 OF (*FreePtr*) ADDRESS; (* ----- Loader (Modules) declarations: ----- *) TYPE Name = ARRAY 32 OF CHAR; Command = PROCEDURE; 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 (* 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; 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; VAR modules: LONGINT; object: Name; objmode: Name; modeStr: ARRAY 9 OF Name; res: INTEGER; KernelRoutines: ARRAY 3 OF RECORD name: Name; adr: ADDRESS END; nOfMcEntries : LONGINT; milliTable : ARRAY 32 OF ADDRESS; lastMod: LONGINT; CONST ModSize = SIZE(ModuleDesc); (* on target machine!! *) 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; millicallError = 12; ExtTabWordSize = 16; Tag0WordOffset = -2; Mth0WordOffset = Tag0WordOffset - ExtTabWordSize; (*----- 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 Assemble21 (i : LONGINT) : LONGINT; BEGIN RETURN (i MOD 2) * 100000H + ((i DIV 2) MOD 800H) * 200H + ((i DIV 4000H) MOD 4) * 80H + ((i DIV 10000H) MOD 20H) * 4 + ((i DIV 1000H) MOD 4); END Assemble21; PROCEDURE LowSignExt14 (i : LONGINT) : LONGINT; BEGIN IF i MOD 2 = 0 THEN RETURN i DIV 2; ELSE RETURN (i DIV 2) - 2000H; END; END LowSignExt14; 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 ExtractTarget21 (instr : LONGINT) : LONGINT; BEGIN RETURN Assemble21 (instr MOD p21); END ExtractTarget21; PROCEDURE ExtractTarget14 (n : LONGINT) : LONGINT; BEGIN RETURN LowSignExt14 (n MOD p14); END ExtractTarget14; PROCEDURE ExtractInstrPattern14 (n : LONGINT) : LONGINT; BEGIN RETURN n - (n MOD 10000H); END ExtractInstrPattern14; (* ----- Allocator procedures ----- *) PROCEDURE NewBlock(size: LONGINT): InitPtr; (* size MOD B = 0 *) VAR i, rest: LONGINT; adr, AN: ADDRESS; ptr: InitPtr; restptr: FreePtr; BEGIN (*IF size < 0 (* NEW(p, MAX(LONGINT)) *) THEN HALT1 END; *) i := size DIV B; IF i > N THEN i := N END; adr := S.ADR(A[0]) + 4*i; AN := S.ADR(A[N]); (* constant register *) LOOP S.GET(adr, ptr); IF adr = AN THEN LOOP IF ptr = NIL THEN res := notEnoughSpace; Texts.WriteString(W, "Pseudo-heap too small"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); RETURN NIL END; IF ptr^.z0 + 4 >= size THEN EXIT END; adr := S.ADR(ptr^.z1); S.GET(adr, ptr) END; EXIT END; IF ptr # NIL THEN EXIT END; INC(adr, 4) END; (* ptr # NIL *) S.PUT(adr, ptr^.z1); rest := ptr^.z0 + 4 - size; restptr := S.VAL(FreePtr, S.VAL(ADDRESS, ptr) + size); IF rest > 0 THEN (* >= B >= 16 *) i := rest DIV B; IF i > N THEN i := N END; restptr^.tag := S.VAL(Tag, S.VAL(SET, S.ADR(restptr^.size)) + S.VAL(SET,free)); restptr^.size := rest - 4; restptr^.next := A[i]; A[i] := S.VAL(ADDRESS, restptr) END; RETURN ptr END NewBlock; PROCEDURE NewRec(tag: Tag; size: LONGINT): ADDRESS; (* implementation of NEW(ptr) *) VAR ptr, init: InitPtr; BEGIN (* tag^.size = rectyp^.size *) size := S.VAL(LONGINT, S.VAL(SET, size + (4 (*tag*) + B-1))-S.VAL(SET, B-1)); ptr := NewBlock(size); init := S.VAL(InitPtr, S.VAL(ADDRESS, ptr) + size - 32); init^.z0 := 0; init^.z1 := 0; init^.z2 := 0; init^.z3 := 0; init^.z4 := 0; init^.z5 := 0; init^.z6 := 0; WHILE init # ptr DO DEC(S.VAL(ADDRESS, init), 32); init^.z0 := 0; init^.z1 := 0; init^.z2 := 0; init^.z3 := 0; init^.z4 := 0; init^.z5 := 0; init^.z6 := 0; init^.z7 := 0 END; ptr^.tag := tag; RETURN S.VAL(ADDRESS, ptr) + 4 END NewRec; PROCEDURE NewSys(size: LONGINT): ADDRESS; (* implementation of S.NEW(ptr, size) *) VAR ptr, init: InitPtr; BEGIN size := S.VAL(LONGINT, S.VAL(SET, size + (28 + B-1))-S.VAL(SET, B-1)); ptr := NewBlock(size); init := S.VAL(InitPtr, S.VAL(ADDRESS, ptr) + size - 32); WHILE init # ptr DO init^.tag := NIL; init^.z0 := 0; init^.z1 := 0; init^.z2 := 0; init^.z3 := 0; init^.z4 := 0; init^.z5 := 0; init^.z6 := 0; DEC(S.VAL(ADDRESS, init), 32); END; ptr^.tag := S.VAL(Tag, S.ADR(ptr^.z0)); ptr^.z0 := size - 4; ptr^.z1 := -4; init^.z2 := 0; init^.z3 := 0; init^.z4 := 0; ptr^.z5 := S.ADR(ptr^.z0); init^.z6 := 0; RETURN S.VAL(ADDRESS, ptr) + 28 END NewSys; (* ----- Loader procedures ----- *) PROCEDURE InitKernel(m: Module); VAR i, refs, end, lastAdr, adr, k: LONGINT; ch: CHAR; name: Name; sk: SET; PROCEDURE RSet (VAR s: SET); VAR b: ARRAY 4 OF CHAR; s2: SET; i: LONGINT; BEGIN S.GET(refs, b[0]); INC(refs); S.GET(refs, b[1]); INC(refs); S.GET(refs, b[2]); INC(refs); S.GET(refs, b[3]); INC(refs); s2 := S.VAL(SET, LONG(ORD(b[0])) + LONG(ORD(b[1]))*100H + LONG(ORD(b[2]))*10000H +LONG(ORD(b[3]))*1000000H); i := 0; s := {}; WHILE i < 32 DO IF i IN s2 THEN INCL(s, 31-i) END; INC(i) END; END RSet; PROCEDURE RNum(VAR i: LONGINT); VAR n: LONGINT; shift: SHORTINT; x: CHAR; BEGIN shift := 0; n := 0; S.GET(refs, x); INC(refs); WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) MOD 128, shift)); INC(shift, 7); S.GET(refs, x); INC(refs); END; i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64*64, shift) END RNum; PROCEDURE ReadName(VAR n: ARRAY OF CHAR); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT S.GET(refs, ch); INC(refs); n[i] := ch; INC(i) UNTIL ch = 0X END ReadName; BEGIN (* find entries for KernelRoutines *) refs := S.ADR(m.refs[0]); end := refs + LEN(m.refs^); INC(refs); i := 0; lastAdr := 0; LOOP IF refs >= end THEN EXIT END; RNum(adr); RSet(sk); RSet(sk); RNum(k); RNum(k); (* saved.r, saved.f, frameSize, callArea *) ReadName(name); IF name = KernelRoutines[i].name THEN KernelRoutines[i].adr := S.ADR(m.code[lastAdr]); IF i = 2 THEN EXIT END; INC(i) END; LOOP IF refs >= end THEN EXIT END; S.GET(refs, ch); INC(refs); IF ch = 0F8X THEN EXIT END; (* S.GET(refs, ch); *) INC(refs); (* mode1 *) RNum(k); (* adr *) ReadName(name) END; lastAdr := adr END END InitKernel; PROCEDURE InitModules(m: Module); VAR i: LONGINT; td: TDescDesc; BEGIN bootEntry := S.ADR(m.code[0]); INC(m.refcnt); (* modules of boot file never unloaded *) (* find ModuleDesc tag *) i := LEN(m.tdescs^); REPEAT DEC(i); modTag := S.VAL(LONGINT, m.tdescs[i]); S.GET(modTag - 4, td) UNTIL td.name = "ModuleDesc"; (* patch all ModuleDesc tags *) m := S.VAL(Module, modules); WHILE m # NIL DO S.PUT(S.VAL(LONGINT, m) - 4, modTag); m := m.next END END InitModules; PROCEDURE RecordFix(class: SHORTINT; adr: LONGINT); BEGIN CASE class OF 0: (* Pointer Fix *) IF ptrFixx # -1 THEN IF ptrFixx < NofPtrFix THEN ptrFix[ptrFixx] := adr; INC(ptrFixx) ELSE ptrFixx := -1; res := notEnoughSpace; Texts.WriteString(W, "Too many ptr fixes"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END | 1: (* Word Fix *) IF wordFixx # -1 THEN IF wordFixx < NofWordFix THEN wordFix[wordFixx] := adr; INC(wordFixx) ELSE wordFixx := -1; res := notEnoughSpace; Texts.WriteString(W, "Too many word fixes"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END | 2: (* Double Fix *) HALT (109); | 3: (* Proc Fix *) IF procFixx # -1 THEN IF procFixx < NofProcFix THEN procFix[procFixx] := adr; INC(procFixx) ELSE procFixx := -1; res := notEnoughSpace; Texts.WriteString(W, "Too many proc fixes"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END | 4: (* External Call Fix *) IF jalFixx # -1 THEN IF jalFixx < NofJalFix THEN jalFix[jalFixx] := adr; INC(jalFixx) ELSE jalFixx := -1; res := notEnoughSpace; Texts.WriteString(W, "Too many branches fixes"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END END END END RecordFix; 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 *) RecordFix(1, S.ADR(m.code[L1])); m.code[L1] := 20000000H + baseReg * 200000H + Disass21 (Left(offset)); (* LDIL offsetHi, baseReg *) m.code[L2] := ExtractInstrPattern14(c) + LowSignRed14 (Right(offset)); ASSERT (ExtractTarget21 (m.code[L1]) * p11 + ExtractTarget14 (m.code[L2]) = offset, 111) 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)); RecordFix(3, S.ADR(m.code[L1])) 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); ASSERT (ExtractTarget21 (m.code[L1]) * p11 + ExtractTarget17 (m.code[L1+1])*4 = entry, 101); RecordFix(4, S.ADR(m.code[L1])); ELSE (* System call *) baseReg := (c DIV p21) MOD p5; IF baseReg >= 16 THEN (* Kernel *) target := KernelRoutines[baseReg-16].adr; IF target = 0 THEN res := millicallError; Texts.WriteString(W, "Kernel Call not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); ELSE m.code[L1] := 20400000H + Disass21 (Left(target)); (* LDIL target, R2 *) m.code[L1+1] := ExtractInstrPattern17(c1) + FormatTarget17 (Right(target) DIV 4); ASSERT (ExtractTarget21 (m.code[L1]) * p11 + ExtractTarget17 (m.code[L1+1])*4 = target, 102); RecordFix(4, S.ADR(m.code[L1])); END; ELSE (* Millicode *) target := milliTable[baseReg]; IF target = 0 THEN res := millicallError; Texts.WriteString(W, "Millicode not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); ELSE m.code[L1] := 23E00000H + Disass21 (Left(target)); (* LDIL target, R31 *) m.code[L1+1] := ExtractInstrPattern17(c1) + FormatTarget17 (Right(target) DIV 4); ASSERT (ExtractTarget21 (m.code[L1]) * p11 + ExtractTarget17 (m.code[L1+1])*4 = target, 103); RecordFix(4, S.ADR(m.code[L1])); END; END; END; END; UNTIL L = L1 END END Fixup; 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; 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, lm: Module; fixType: INTEGER; curexp, limexp: ExportPtr; 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 res := corruptedObjFile; Texts.WriteString(W, m.name); Texts.WriteString(W, " is corrupted"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 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 *)); *) tdb := S.VAL(TDescBlock, NewSys(tdsize - 24)); IF tdb = NIL THEN RETURN END; DEC(S.VAL(ADDRESS, tdb), 24); types[descnr].tdb := tdb; tdd := S.VAL(TDescDesc, tdb); RecordFix(0, S.ADR(tdd.tdsize) - 4); tdd.tdsize := tdsize; tdd.sentinel := -4; tdd.self := S.ADR(tdb.word[root]); RecordFix(0, S.ADR(tdd.self)); tdd.name := name; tdd.mdesc := m; RecordFix(0, S.ADR(tdd.mdesc)); 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; RecordFix(0, S.ADR(tdb.word[root + Mth0WordOffset - mthno])) END; tdb.word[root - 1] := S.ADR(tdb.word[0]); RecordFix(0, S.ADR(tdb.word[root - 1])); 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 IF name = "" THEN save := curtd ELSE save := 0 END; (* 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 (* 0 if named *) 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 save # 0 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 res := objNotFound; Texts.WriteString(W, m.name); Texts.WriteString(W, " imports type descriptor of "); Texts.WriteString(W, mb.name); Texts.Write(W, "."); Texts.WriteString(W, type.bname); Texts.WriteString(W, ", not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 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; RecordFix(0, S.ADR(tdb.word[root + Tag0WordOffset - k])); 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]); RecordFix(0, S.ADR(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]); RecordFix(0, S.ADR(tdb.word[root + Tag0WordOffset - k])); (* INC(k); WHILE k < ExtTabWordSize DO tdb.word[root + Tag0WordOffset - k] := 0; INC(k) END; *) END END InitType; PROCEDURE BuildModBlock; VAR t, gconSize: LONGINT; BEGIN S.GET(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.exports), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.exports)); arrPtr.len := nofexp; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofexp)*SIZE(Export) + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.tdescs), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.tdescs)); arrPtr.len := nofdesc; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofdesc)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.cmds), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.cmds)); arrPtr.len := nofcom; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofcom)*SIZE(Cmd) + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.ptrTab), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.ptrTab)); arrPtr.len := nofptr; INC(S.VAL(ADDRESS, arrPtr), ((LONG(nofptr)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.imports), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.imports)); arrPtr.len := nofimp+1; INC(S.VAL(ADDRESS, arrPtr), (((nofimp+1)*4 + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.data), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.data)); gconSize := consize + (-consize) MOD 8; m.sb := S.ADR(arrPtr.data) + gconSize; RecordFix(0, S.ADR(m.sb)); 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); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.code), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.code)); arrPtr.len := codesize DIV 4; INC(S.VAL(ADDRESS, arrPtr), ((codesize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(0, S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.refs), S.VAL(ADDRESS, arrPtr)); RecordFix(0, S.ADR(m.refs)); arrPtr.len := refsize END BuildModBlock; BEGIN res := done; (* IF Kernel.LargestAvailable() < SIZE(ModuleDesc) THEN importing := ""; res := notEnoughSpace; RETURN END; *) (* NEW(m); *) m := S.VAL(Module, NewRec(S.VAL(Tag, modTag), ModSize)); RecordFix(0, S.ADR(m^) - 4); IF m = NIL THEN RETURN END; lm := S.VAL(Module, lastMod); IF lm # NIL THEN lm.next := m; RecordFix(0, S.ADR(lm.next)) END; lastMod := S.VAL(LONGINT, m); IF modules = 0 THEN modules := lastMod END; 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); *) arrPtr := S.VAL(ArrPtr, NewSys(k)); RecordFix(0, S.ADR(arrPtr^) - 28); RecordFix(0, S.ADR(arrPtr^) - 4); IF arrPtr = NIL THEN RETURN END; 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 (* TDesc *) ReadType(m.tdescs[descnr]); RecordFix(0, S.ADR(m.tdescs[descnr])); INC(descnr); IF res # done THEN (* Delete(m); *) RETURN END ELSIF ch = 9X THEN (* LinkProc *) 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 (* EVar *) Files.ReadNum(R, entry); m.exports[expnr].adr := m.sb + entry; RecordFix(0, S.ADR(m.exports[expnr].adr)) ELSIF ch = 4X THEN (* EProc *) Files.ReadNum(R, entry); m.exports[expnr].adr := S.ADR(m.code[0]) + 4*entry; RecordFix(0, S.ADR(m.exports[expnr].adr)) ELSIF ch = 6X THEN (* EStruct *) 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); ASSERT (entry > 0); m.cmds[i].adr := t + 4*entry; RecordFix(0, S.ADR(m.cmds[i].adr)); INC(i) END; (* PtrBlk *) Block(84X); i := 0; t := m.sb; WHILE i < nofptr DO Files.ReadNum(R, k); m.ptrTab[i] := t + k; RecordFix(0, S.ADR(m.ptrTab[i])); 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); Fixup(m, m.sb, datalink, DataFix); (* recursive loading of imports *) m.imports[0] := S.ADR(m^); RecordFix(0, S.ADR(m.imports[0])); i := 0; IF res = done THEN LOOP IF i >= nofimp THEN EXIT END; (* Load(mods[i].name, m1); not recursive in BootLinker, modules are topologically sorted *) m1 := S.VAL(Module, modules); WHILE (m1 # NIL) & (mods[i].name # m1.name) DO m1 := m1.next END; IF m1 = NIL THEN res := modNotFound; Texts.WriteString(W, mods[i].name); Texts.WriteString(W, " must be loaded before "); Texts.WriteString(W, m.name); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END; IF res # done THEN EXIT END; INC(i); m.imports[i] := S.ADR(m1^); RecordFix(0, S.ADR(m.imports[i])); 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 IF res = fpMismatch THEN Texts.WriteString(W, m.name); Texts.WriteString(W, " imports "); Texts.WriteString(W, objmode); Texts.Write(W, " "); Texts.WriteString(W, m1.name); Texts.Write(W, "."); Texts.WriteString(W, object); Texts.WriteString(W, " with bad fingerprint") ELSE Texts.WriteString(W, objmode); Texts.Write(W, " "); Texts.WriteString(W, m1.name); Texts.Write(W, "."); IF object = "" THEN Texts.WriteString(W, "'anonymous'") ELSE Texts.WriteString(W, object) END; Texts.WriteString(W, " not found") END; Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 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; WHILE i < LEN(m.tdescs^) DO InitType(m.tdescs[i], types[i]); INC(i) END; (* execute body *) IF m.name = "Unix" THEN dlsymAdr := m.sb; ELSIF m.name = "Kernel" THEN InitKernel(m) ELSIF m.name = "Modules" THEN InitModules(m) END; (* body := S.VAL(Command, S.ADR(m.code[0])); *) m.init := TRUE; (* Chameleon: Kernel.FlushICache(S.ADR(m.code[0]), codesize); *) (* Unix.Cacheflush(S.ADR(m.code[0]), codesize, 1); *) (* body; *) END; IF res = done THEN 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; BEGIN m := S.VAL(Module, 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; f := Files.Old(fname); IF f = NIL THEN res := fileNotFound; Texts.WriteString(W, fname); Texts.WriteString(W, " not found"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); RETURN END; Files.Set(R, f, 0); Files.ReadInt(R, tag); IF tag = OFtag THEN LoadModule(R, m) ELSE res := notAnObjFile; Texts.WriteString(W, fname); Texts.WriteString(W, " not an object file"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END ELSIF ~m.init THEN res := cyclicImport (* not possible in bootlinker *) END END Load; PROCEDURE LoadMillicode(name : ARRAY OF CHAR; adr : LONGINT) : LONGINT; (* Returns size of millicode space *) VAR f: Files.File; R: Files.Rider; i, tag, version, codesize : LONGINT; x0, x1, x2, x3 : CHAR; x, milliStart : LONGINT; BEGIN f := Files.Old(name); Files.Set(R, f, 0); Files.ReadLInt(R, tag); Files.ReadLInt(R, version); Files.ReadLInt(R, codesize); Files.ReadLInt(R, nOfMcEntries); milliStart := adr + 32*4; i := 0; WHILE i < nOfMcEntries DO Files.ReadLInt(R, x); INC (x, milliStart); milliTable[i] := x; S.PUT(adr, x); INC(adr, 4); INC(i); END; x := 0; WHILE i < 32 DO milliTable[i] := x; S.PUT(adr, x); INC(adr, 4); INC(i) END; i := 0; WHILE i < codesize DO Files.Read (R, x0); Files.Read(R, x1); Files.Read (R, x2); Files.Read (R, x3); x := ((ORD(x0) * 256 + ORD(x1)) * 256 + ORD(x2)) * 256 + ORD(x3); S.PUT (adr, x); INC(adr, 4); INC (i); END; RETURN (32 + codesize) * 4; END LoadMillicode; PROCEDURE Init (millicodeFile : ARRAY OF CHAR); VAR a: ADDRESS; i, milliSize, size: LONGINT; rest: FreePtr; BEGIN KernelRoutines[0].name := "NewRec"; KernelRoutines[0].adr := 0; KernelRoutines[1].name := "NewSys"; KernelRoutines[1].adr := 0; KernelRoutines[2].name := "NewArr"; KernelRoutines[2].adr := 0; modules := 0; lastMod := 0; modTag := 0; ptrFixx := 0; wordFixx := 0; procFixx := 0; jalFixx := 0; i := 0; WHILE i < N DO A[i] := nil; INC(i) END; heapAdr := S.VAL(LONGINT, heap); heapAdr := heapAdr + (-heapAdr) MOD B; milliSize := LoadMillicode (millicodeFile, heapAdr); GCstart := heapAdr + milliSize; GCstart := GCstart + (-GCstart) MOD B; a := GCstart + B - 4; size := S.VAL(LONGINT, heap) + BootHeapSize - a; DEC(size, size MOD B); rest := S.VAL(FreePtr, a); rest^.tag := S.VAL(Tag, S.ADR(rest^.size)); rest^.size := size - 4; rest^.next := nil; A[N] := a END Init; PROCEDURE XWord(a: ADDRESS); VAR h0, h1, h2, h3: CHAR; BEGIN S.GET(a, h0); S.GET(a+1, h1); S.GET(a+2, h2); S.GET(a+3, h3); S.PUT(a, h3); S.PUT(a+1, h2); S.PUT(a+2, h1); S.PUT(a+3, h0) END XWord; PROCEDURE XName(VAR n: Name); VAR i: INTEGER; BEGIN i := 0; WHILE i < 32 DO XWord(S.ADR(n[i])); INC(i, 4) END END XName; PROCEDURE XExport(VAR e: Export); VAR a: ADDRESS; lo, hi: CHAR; i: LONGINT; BEGIN XName(e.name); a := S.ADR(e.mode); S.GET(a, lo); S.GET(a+1, hi); S.PUT(a+2, lo); S.PUT(a+3, hi); S.PUT(a, LONG(0)) END XExport; PROCEDURE XTDesc(a: ADDRESS); VAR td: TDescDesc; BEGIN S.GET(a - 4, td); td.ext.filler[2] := CHR(td.ext.extlev); td.ext.extlev := 0; XName(td.name) END XTDesc; PROCEDURE XModuleDesc(m: Module); VAR a: ADDRESS; b: CHAR; i, len: LONGINT; BEGIN XName(m.name); a := S.ADR(m.init); S.GET(a, b); S.PUT(a+3, b); S.PUT(a, 0); i := 0; len := LEN(m.exports^); WHILE i < len DO XExport(m.exports[i]); INC(i) END; i := 0; len := LEN(m.tdescs^); WHILE i < len DO XTDesc(m.tdescs[i]); INC(i) END; i := 0; len := LEN(m.cmds^); WHILE i < len DO XName(m.cmds[i].name); INC(i) END; i := S.ADR(m.data^); len := m.sb; WHILE i < len DO XWord(i); INC(i, 4) END; i := 0; len := LEN(m.refs^); WHILE i < len DO XWord(S.ADR(m.refs[i])); INC(i, 4) END END XModuleDesc; PROCEDURE Out(VAR bootName: ARRAY OF CHAR); TYPE ArrPtr = POINTER TO RECORD a, b, c, len: LONGINT END; VAR f: Files.File; R: Files.Rider; end, from, to, relocSize, skipx, i: LONGINT; m: Module; skipFrom, skipTo: ARRAY NofMod OF LONGINT; p: ArrPtr; buildTime, buildDate: LONGINT; BEGIN IF modTag = 0 THEN res := modNotFound; Texts.WriteString(W, "Modules not loaded"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); RETURN END; (* cut heap *) end := S.VAL(LONGINT, NewBlock(B*N)); IF res # done THEN RETURN END; (* find data blocks to be skipped *) skipx := 0; m := S.VAL(Module, modules); WHILE m # NIL DO IF showEntries THEN Texts.WriteLn(W); Texts.WriteString(W, " "); Texts.WriteString(W, m.name); Texts.WriteString(W, " body at "); Texts.WriteHex(W, S.ADR(m.code[0])); Texts.Write(W, "H"); Texts.WriteString(W, " size = "); Texts.WriteInt(W, LEN(m.code^),0); Texts.WriteString(W, " data size = "); Texts.WriteInt(W, LEN(m.data^),0); END; IF S.VAL(LONGINT, m.code)-4 - m.sb > 8 THEN skipFrom[skipx] := m.sb; skipTo[skipx] := S.VAL(LONGINT, m.code)-4; INC(skipx) END; IF crossEndian THEN XModuleDesc(m) END; m := m.next END; Texts.WriteLn(W); skipFrom[skipx] := MAX(LONGINT); (* sentinel *) (* output heap *) f := Files.New(bootName); Files.Set(R, f, 0); Files.WriteLInt(R, heapAdr); Files.WriteLInt(R, end - heapAdr); Files.WriteLInt(R, GCstart); Texts.WriteString(W, "+ heapAdr: "); Texts.WriteHex(W, heapAdr); Texts.WriteLn(W); Texts.WriteString(W, "+ heapSize: "); Texts.WriteHex(W, end - heapAdr); Texts.WriteLn(W); Texts.WriteString(W, "+ GCStart: "); Texts.WriteHex(W, GCstart); Texts.WriteLn(W); skipx := 0; from := heapAdr; LOOP to := skipFrom[skipx]; IF end < to THEN to := end END; Files.WriteLInt(R, from); Files.WriteLInt(R, to - from); WHILE from < to DO S.GET(from, i); Files.WriteLInt(R, i); INC(from, 4) END; IF to = end THEN EXIT END; from := skipTo[skipx]; INC(skipx) END; Files.WriteLInt(R, bootEntry); Files.WriteLInt(R, 0); (* output relocate information *) relocSize := Files.Pos(R); Files.WriteNum(R, ptrFixx); i := 0; WHILE i < ptrFixx DO Files.WriteNum(R, (ptrFix[i] - heapAdr) DIV 4); INC(i) END; Files.WriteNum(R, wordFixx); i := 0; WHILE i < wordFixx DO Files.WriteNum(R, (wordFix[i] - heapAdr) DIV 4); INC(i) END; Files.WriteNum(R, procFixx); i := 0; WHILE i < procFixx DO Files.WriteNum(R, (procFix[i] - heapAdr) DIV 4); INC(i) END; Files.WriteNum(R, jalFixx); i := 0; WHILE i < jalFixx DO Files.WriteNum(R, (jalFix[i] - heapAdr) DIV 4); INC(i) END; (* output millicode Table *) Files.WriteNum(R, nOfMcEntries); i := 0; WHILE i < nOfMcEntries DO Files.WriteNum(R, milliTable[i]); INC(i); END; Files.WriteNum(R, dlsymAdr); Texts.WriteString(W, "dlsymAdr: "); Texts.WriteHex(W, dlsymAdr); Texts.WriteLn(W); Oberon.GetClock(buildTime, buildDate); Files.WriteNum(R, buildTime); Files.WriteNum(R, buildDate); Texts.WriteString(W, "build date: "); Texts.WriteDate(W, buildTime, buildDate); Texts.WriteLn(W); relocSize := Files.Pos(R) - relocSize; Files.Register(f); IF littleEndian # crossEndian THEN Texts.WriteString(W, " little") ELSE Texts.WriteString(W, " big") END; Texts.WriteString(W, " endian heap: "); Texts.WriteInt(W, end - heapAdr, 0); Texts.WriteString(W, " reloc: "); Texts.WriteInt(W, relocSize,0); Texts.WriteString(W, " file: "); Texts.WriteInt(W, Files.Length(f),0); END Out; PROCEDURE GetArgs(VAR S: Texts.Scanner); VAR text: Texts.Text; beg, end, time: LONGINT; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.line # 0) OR (S.class # Texts.Name) & (S.class # Texts.Int) THEN Oberon.GetSelection(text, beg, end, time); IF time>=0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END END END GetArgs; PROCEDURE Link*; VAR bootName, millicodeFile: Name; s: Texts.Scanner; VAR m: Module; ch: CHAR; BEGIN GetArgs(s); IF s.class = Texts.Name THEN COPY(s.s, bootName); Texts.Scan(s) ELSE RETURN END; crossEndian := FALSE; showEntries := FALSE; IF (s.class = Texts.Char) & (s.c = OptionChar) THEN ch := s.nextCh; LOOP IF ch = " " THEN EXIT ELSIF ch = "c" THEN crossEndian := TRUE ELSIF ch = "e" THEN showEntries := TRUE ELSE Texts.WriteString(W, " unknown option"); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); RETURN END; Texts.Read(s, ch) END; s.nextCh := ch; Texts.Scan(s) END; IF (s.class = Texts.Char) & (s.c = ":") THEN Texts.Scan(s) ELSE RETURN END; IF (s.class = Texts.Char) & (s.c = "=") THEN Texts.Scan(s) ELSE RETURN END; IF s.class = Texts.Name THEN COPY (s.s, millicodeFile); Texts.Scan(s) ELSE RETURN END; IF showEntries THEN Texts.WriteString(W, "Pseudo heap at "); Texts.WriteHex(W, S.ADR(heap)); Texts.Write(W,"H"); Texts.WriteLn(W); END; IF s.class = Texts.Name THEN Texts.WriteString(W, "linking "); Texts.WriteString(W, bootName); Init (millicodeFile); Texts.WriteString(W, " with "); Texts.WriteString(W, millicodeFile); Texts.WriteString(W, " "); Texts.Append(Oberon.Log, W.buf); res := done; REPEAT Load(s.s, m); Texts.Scan(s) UNTIL (s.class # Texts.Name) OR (res # done); IF res = done THEN Out(bootName) END; Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); END END Link; PROCEDURE Init0; VAR test: INTEGER; lo: CHAR; BEGIN Texts.OpenWriter(W); S.NEW(heap, BootHeapSize); 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"; test := 1; S.GET(S.ADR(test), lo); littleEndian := lo = 1X END Init0; BEGIN Init0; Texts.WriteLn(W); Texts.WriteString(W, "HP 7xx Boot Linker. ETH Zrich"); Texts.WriteLn(W); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); END BootLinker. BootLinker.Link [heapAdr] bootFileName := modName0 modName1 ... ~ All module names must be listed and topologically sorted. If the optional heap address is present, no relocation information is generated. Boot File Format: heapAdr4 heapSize4 GCstart4 {adr4 len4 {int4}} (* len4/4 times int4 *) entryAdr4 0X 0X 0X 0X nofPtr {adr} (* nofPtr times adr, etc... *) nofWord {adr} nofProc {adr} nofBl {adr} nofMilli {adr} dlsymAdr buildTime (* Number *) buildDate (* Number *) All numbers in the relocate information part are in compact format. adr*4 is an offset from heapAdr4.