HArial10.Scn.FntArial10i.Scn.Fnt+Syntax10.Scn.FntZU;  M0/1*3.R l(qE'q& ^+ֽ8FoldElemsNew Syntax10.Scn.Fnt$Arial10.Scn.FntArial10i.Scn.Fnt'9&$z b=# !+rHZ(' 0Arial10b.Scn.Fnt  "_d>9 Syntax10i.Scn.Fnt v8FoldElemsNew#Syntax10.Scn.Fnthh None = 0; Set = 9; NoTyp = 12; Pointer = 13; Procedure = 14; Array = 15; Record = 16; DynArr = 17; 88<Syntax10i.Scn.FntSyntax10.Scn.Fnt Var = 1; VarPar = 2; 8 8<Syntax10i.Scn.FntSyntax10.Scn.Fnt%' ProcTag = 0F8X; RecordTag = 0F7X; 8DX # xN$0 ' 4   37> :\ '  @D *8#Syntax10.Scn.Fnt 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; 8B8#Syntax10.Scn.Fnt66 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; 88@8_Syntax10.Scn.FntSyntax10b.Scn.FntJb 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; 89%8#Syntax10.Scn.Fnt 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; 8.[8#Syntax10.Scn.Fnt VAR tag: SHORTINT; BEGIN S.GET(pos, tag); WHILE tag IN {Var, VarPar} DO INC(pos); SkipObj(pos, tag) END END SkipVariables; 8+j8#Syntax10.Scn.Fnttt VAR tag: SHORTINT; BEGIN S.GET(pos, tag); WHILE tag # 0 DO SkipObj(pos, tag) END ; INC(pos) END SkipFields; }4 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 ReadName; PROCEDURE OverReadTypes (VAR pos: LONGINT; VAR ch: CHAR); (* MK *) VAR n: LONGINT; ch2: CHAR; BEGIN S.GET (pos, ch); INC (pos); IF ch = CHR (ProcTyp) THEN ReadNum (pos, n) ELSIF ch = 0FX THEN ReadNum (pos, n); ReadNum (pos, n); OverReadTypes (pos, ch2) ELSIF ch = 10X THEN INC (pos); ReadNum (pos, n) ELSIF ch = 11X THEN ReadNum (pos, n); OverReadTypes (pos, ch2) ELSIF ch = CHR (Pointer) THEN OverReadTypes (pos, ch2) END END OverReadTypes; BEGIN INC(m.refcnt); (* Kernel never unloaded *) (* link to Windows and entry point: *) dlsymAdr := m.sb - 4; kernelBody := S.ADR(m.code[0]); (* find entries for KernelRoutines *) pos := S.ADR(m.refs[0]); refend := pos + LEN(m.refs^); i := 0; S.GET(pos, ch); INC(pos); WHILE (pos <= refend) & (ch = ProcRefTag) & (i < 3) DO ReadNum(pos, adr); ReadName(pos, name); IF name = KernelRoutines[i].name THEN KernelRoutines[i].adr := S.ADR(m.code[adr]); INC(i) END ; S.GET(pos, ch); INC(pos); WHILE (* (ch = VarTag) OR (ch = VarParTag)*) ch # 0F8X DO (* S.GET(pos, ch); INC(pos); (* form *) ReadNum(pos, adr);*) ReadName(pos, name); ReadNum (pos, adr); OverReadTypes (pos, ch2); S.GET(pos, ch); INC(pos); END ; END ; IF i # 3 THEN Str("Error: Only "); Int(i); Str(" of 3 Kernel routines found"); Ln; HALT(99) END ; (* 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 InitKernel; PROCEDURE RecordFix (adr: LONGINT); BEGIN IF ptrFixx # -1 THEN IF ptrFixx < NofPtrFix THEN ptrFix[ptrFixx] := adr; INC(ptrFixx) ELSE Error("", "Too many ptr fixes"); ptrFixx := -1; res := notEnoughSpace; END END END RecordFix; 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); RecordFix(codebase + dataLink[i].offset[j]); 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]); RecordFix(codebase + dataLink[i].offset[j]); 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)); RecordFix(m.sb + offs); 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)]); RecordFix(codebase + offs); offs := MSW(val); END ; | 253: (* Kernel.NewRec *) offs := link[i].link; WHILE offs # 0FFFFH DO ASSERT(KernelRoutines[0].adr # 0, "NewRec not found"); S.GET(codebase + offs, val); S.PUT(codebase + offs, KernelRoutines[0].adr - (codebase + offs + 4)); offs := MSW(val); END ; | 252: (* Kernel.NewSys *) offs := link[i].link; WHILE offs # 0FFFFH DO ASSERT(KernelRoutines[1].adr # 0, "NewSys not found"); S.GET(codebase + offs, val); S.PUT(codebase + offs, KernelRoutines[1].adr - (codebase + offs + 4)); offs := MSW(val); END ; | 251: (* Kernel.NewArr *) offs := link[i].link; WHILE offs # 0FFFFH DO ASSERT(KernelRoutines[2].adr # 0, "NewArr not found"); S.GET(codebase + offs, val); S.PUT(codebase + offs, KernelRoutines[2].adr - (codebase + offs + 4)); offs := MSW(val); END ; ELSE Error("Fixup error module 0", ""); 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]); RecordFix(codebase + offs); ELSE (* insert relative address *) disp := from.entries[entryNo] - (codebase + offs + 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 ; ArrPtr = POINTER TO RECORD a, b, c, len, data: LONGINT END ; VAR i, j: INTEGER; m1, lm: Module; e, k, t: LONGINT; name: Name; ch: CHAR; body: Command; head: Header; linkTab: LinkTab; dataLinks: DataLinkTab; types: ARRAY 128 OF RECORD tdesc: TDesc; root, nofMeth, nofInhMeth, baseMod, baseEntry: INTEGER END ; mods: ARRAY 32 OF RECORD key: LONGINT; name: Name END ; CONST (* object forms *)  (* object modes *)  (* tags *)  VAR pos, off, tdadr: LONGINT; tag: CHAR; nam: ARRAY 32 OF CHAR; PROCEDURE Expect (tag: CHAR; tagName: ARRAY OF CHAR); VAR ch: CHAR; BEGIN Files.Read(R, ch); IF ch # tag THEN res := invalidObjFile; Ln; Str(m.name); Str(" is corrupted (bad "); Str(tagName); Str(")."); END ; END Expect; PROCEDURE ReadTypes; VAR i, j, k, tdsize, recordSize: LONGINT; tdEntry, nofMethods, nofNewMeths, mthNo, nofPointers, root, entryNo: INTEGER; td: TDesc; name: Name; ch: CHAR; BEGIN i := 0; WHILE i < LEN(m.tdescs^) DO Files.ReadLInt(R, recordSize); Files.ReadInt(R, 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 LargestAvailable() < tdsize THEN res := notEnoughSpace; RETURN END ; *) (* S.NEW(td, tdsize - 24 (* overhead of SysBlk header *) ); *) td := S.VAL(TDesc, NewSys(tdsize - 24 (* overhead of SysBlk header *) )); IF td = NIL THEN RETURN END ; DEC(S.VAL(ADDRESS, td), 24); types[i].tdesc := td; RecordFix(S.ADR(td.word[0]) - 4); td.word[0] := tdsize; td.word[1] := -4; (* sentinel *) td.word[2] := S.ADR(td.word[root]) (* self *); RecordFix(S.ADR(td.word[2])); 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 *) RecordFix(S.ADR(td.word[12])); j := 0; WHILE j < nofNewMeths DO Files.ReadInt(R, mthNo); Files.ReadInt(R, entryNo); td.word[root + Mth0WordOffset - mthNo] := m.entries[entryNo]; RecordFix(S.ADR(td.word[root + Mth0WordOffset - mthNo])); INC(j); END ; td.word[root - 1] := S.ADR(td.word[0]); (* tag of subobj *) RecordFix(S.ADR(td.word[root - 1])); td.word[root] := recordSize; S.PUT(m.varEntries[tdEntry], S.ADR(td.word[root])); RecordFix(m.varEntries[tdEntry]); m.tdescs[i] := S.ADR(td.word[root]); RecordFix(S.ADR(m.tdescs[i])); 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 InitTypes; VAR i, k, baseType, tag, entry: LONGINT; root, baseModNo, n: INTEGER; td: TDesc; baseMod: Module; BEGIN i := 0; WHILE i < LEN(m.tdescs^) DO td := types[i].tdesc; baseModNo := types[i].baseMod; k := 0; root := types[i].root; IF baseModNo # -1 THEN (* 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 - k] := tag; RecordFix(S.ADR(td.word[root + Tag0WordOffset - k])); INC(k); S.GET(baseType + (Tag0WordOffset - k)*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]); RecordFix(S.ADR(td.word[root + Mth0WordOffset - n])) END ; END ; END ; td.word[3] := k; (* extlev *) td.word[root + Tag0WordOffset - k] := S.ADR(td.word[root]); (* own type tag *) RecordFix(S.ADR(td.word[root + Tag0WordOffset - k])); INC(i); END ; END InitTypes; PROCEDURE BuildModuleBlock (m: Module; head: Header); VAR t, size, gvarSize: LONGINT; arrPtr: ArrPtr; 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); arrPtr := S.VAL(ArrPtr, NewSys(size)); RecordFix(S.ADR(arrPtr^) - 28); RecordFix(S.ADR(arrPtr^) - 4); IF arrPtr = NIL THEN HALT(101) END ; S.GET(S.VAL(ADDRESS, arrPtr) - 4, t); S.PUT(S.ADR(m.varEntries), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.varEntries)); 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); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.entries), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.entries)); 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); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.cmds), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.cmds)); 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); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.ptrTab), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.ptrTab)); 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); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.tdescs), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.tdescs)); 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); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.imports), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.imports)); 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); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.data), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.data)); gvarSize := head.dataSize + (-head.dataSize) MOD 8; m.sb := S.ADR(arrPtr.data) + gvarSize; RecordFix(S.ADR(m.sb)); arrPtr.len := (gvarSize + head.constSize + 3); INC(S.VAL(ADDRESS, arrPtr), ((gvarSize + head.constSize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.code), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.code)); arrPtr.len := head.codeSize; INC(S.VAL(ADDRESS, arrPtr), ((head.codeSize + 35) DIV 16)*16); S.PUT(S.VAL(ADDRESS, arrPtr) - 4, t); RecordFix(S.VAL(ADDRESS, arrPtr) - 4); S.PUT(S.ADR(m.refs), S.VAL(ADDRESS, arrPtr) + ArrPtrAdj); RecordFix(S.ADR(m.refs)); arrPtr.len := head.refSize; END BuildModuleBlock; PROCEDURE GetInt (VAR adr, i: LONGINT);  PROCEDURE GetString (VAR adr: LONGINT; VAR str: ARRAY OF CHAR);  PROCEDURE SkipTyp (VAR pos: LONGINT; form: SHORTINT);  PROCEDURE SkipObj (VAR pos: LONGINT; VAR tag: SHORTINT);  PROCEDURE SkipVariables (VAR pos: LONGINT);  PROCEDURE SkipFields (VAR pos: LONGINT); 8^L*2   *oU_U H c3Syntax10i.Scn.Fnt#r0SOO,X1%Q!PP:Arial10b.Scn.Fnt^@MODULE BootLinker; (* Oberon for Windows bootlinker (MH) / based on MIPS bootlinker (RC) *) IMPORT Texts, Oberon, Files, S := SYSTEM; CONST Version = "MH/RC 29.7.93"; KernelName = "Kernel"; Pointer = 13; ProcTyp = 14; (* BootLinker runs on Oberon for Windows: *) ArrPtrAdj = 0; (* BootLinker runs on Ceres : ArrPtrAdj = 8; *) BootHeapSize = 1024*140; (* instead of 70 *) NofPtrFix = 2000; (* instead of 1200 *) VAR W: Texts.Writer; heapAdr, dlsymAdr, kernelBody: LONGINT; modTag: LONGINT; heap: S.PTR; ptrFix: ARRAY NofPtrFix OF LONGINT; ptrFixx: LONGINT; (* ------------ Allocator (Kernel) declarations: ------------ *) TYPE Name = ARRAY 32 OF CHAR; ADDRESS = LONGINT; Cmd = RECORD name: Name; adr: ADDRESS END ; Tag = POINTER TO TypeDesc; Module = POINTER TO ModuleDesc; ModuleDesc = RECORD next: Module; name: Name; init: BOOLEAN; key, refcnt, sb: LONGINT; varEntries: POINTER TO ARRAY OF ADDRESS; entries: POINTER TO ARRAY OF ADDRESS; cmds: POINTER TO ARRAY OF Cmd; ptrTab: POINTER TO ARRAY OF ADDRESS; tdescs: POINTER TO ARRAY OF (* Tag *) ADDRESS; imports: POINTER TO ARRAY OF (* Module *) ADDRESS; data, code: POINTER TO ARRAY OF CHAR; refs: POINTER TO ARRAY OF CHAR END ; VAR modules: LONGINT; TYPE TypeDesc = RECORD size: LONGINT; ptroff: LONGINT END ; FreeBlockPtr = 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; mark = {0}; array = {1}; VAR A: ARRAY N+1 OF (*FreeBlockPtr*) ADDRESS; (* ------------ Loader (Modules) declarations: ------------ *) TYPE Command = PROCEDURE; VAR res: INTEGER; KernelRoutines: ARRAY 3 OF RECORD name: Name; adr: ADDRESS END ; lastMod: LONGINT; CONST ModSize = SIZE(ModuleDesc); (* on target machine!! *) done = 0; cmdNotFound = 1; invalidObjFile = 2; keyMismatch = 3; corruptedObjFile = 4; (* not used *) fileNotFound = 5; moduleNotFound = 6; notEnoughSpace = 7; refCntNotZero = 8; cyclicImport = 9; ExtTabWordSize = 16; Tag0WordOffset = -2; Mth0WordOffset = Tag0WordOffset - ExtTabWordSize; TYPE 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 ; 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 ; (* ------------------- General procedures -------------------- *) PROCEDURE Str (s: ARRAY OF CHAR); BEGIN Texts.WriteString(W, s); Texts.Append(Oberon.Log, W.buf) END Str; PROCEDURE Int (i: LONGINT); BEGIN Texts.WriteInt(W, i, 0); Texts.Append(Oberon.Log, W.buf); END Int; PROCEDURE Hex (x: LONGINT); BEGIN Texts.WriteHex(W, x); Texts.Write(W, "H"); Texts.Append(Oberon.Log, W.buf); END Hex; PROCEDURE Ln; BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); END Ln; PROCEDURE Error (str1, str2: ARRAY OF CHAR); BEGIN Texts.WriteString(W, "Error: "); Texts.WriteString(W, str1); Texts.WriteString(W, str2); Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END Error; PROCEDURE ASSERT (b: BOOLEAN; err: ARRAY OF CHAR); BEGIN IF ~b THEN Error("", err); HALT(100) END ; END ASSERT; PROCEDURE ReadUnsigned (VAR R: Files.Rider; VAR u: LONGINT); (* read unsigned, 16 bit, little endian value *) VAR lowByte, highByte: CHAR; BEGIN Files.Read(R, lowByte); Files.Read(R, highByte); u := 256*LONG(ORD(highByte)) + ORD(lowByte) END ReadUnsigned; (* ------------------- Allocator procedures ------------------- *) PROCEDURE NewBlock (size: LONGINT): InitPtr; (* size MOD B = 0 *) VAR i, rest: LONGINT; adr, AN: ADDRESS; ptr: InitPtr; restptr: FreeBlockPtr; 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(FreeBlockPtr, 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.ADR(restptr^.size)); 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 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 InitKernel (m: Module); CONST ProcRefTag = 0F8X; VarTag = 1X; VarParTag = 3X; VAR i, pos, refend, adr: LONGINT; ch, ch2: CHAR; name: Name; td: POINTER TO RECORD filler: ARRAY 4 OF LONGINT; name: Name END ; PROCEDURE ReadNum (VAR pos: LONGINT; VAR i: LONGINT); VAR n: LONGINT; shift: SHORTINT; x: CHAR; BEGIN shift := 0; n := 0; S.GET(pos, x); INC(pos); WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) MOD 128, shift)); INC(shift, 7); S.GET(pos, x); INC(pos); END ; i := n + ASH(ORD(x) MOD 64 - ORD(x) DIV 64*64, shift) END ReadNum; PROCEDURE ReadName (VAR adr: LONGINT; VAR str: ARRAY OF CHAR);  BEGIN (* LoadModule *) res := done; m := S.VAL(Module, NewRec(S.VAL(Tag, modTag), ModSize)); RecordFix(S.ADR(m^) - 4); IF m = NIL THEN RETURN END ; lm := S.VAL(Module, lastMod); IF lm # NIL THEN lm.next := m; RecordFix(S.ADR(lm.next)) END ; lastMod := S.VAL(LONGINT, m); IF modules = 0 THEN modules := lastMod END ; m.init := FALSE; m.refcnt := 0; m.next := 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); (* VarEntries *) Expect(08CX, "VarEntryTag"); i := 0; t := m.sb; WHILE i < head.nofDataEntries DO Files.ReadLInt(R, e); m.varEntries[i] := t + e; RecordFix(S.ADR(m.varEntries[i])); INC(i); END ; (* EntryBlk *) Expect(082X, "EntryTag"); i := 0; t := S.ADR(m.code[0]); WHILE i < head.nofEntries DO ReadUnsigned(R, e); m.entries[i] := t + e; RecordFix(S.ADR(m.entries[i])); INC(i) END ; (* CmdBlk *) Expect(083X, "CommandTag"); i := 0; WHILE i < head.nofCommands DO Files.ReadString(R, m.cmds[i].name); ReadUnsigned(R, e); m.cmds[i].adr := t + e; RecordFix(S.ADR(m.cmds[i].adr)); INC(i) END ; (* PtrBlk *) Expect(084X, "PointerTag"); i := 0; t := m.sb; WHILE i < head.nofPointers DO Files.ReadLInt(R, k); m.ptrTab[i] := t + k; RecordFix(S.ADR(m.ptrTab[i])); INC(i) END ; (* Import Block *) Expect(085X, "ImportTag"); 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, "DataLinkTag"); 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, "LinkTag"); 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, "DataTag"); 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, "CodeTag"); i := 0; t := S.ADR(m.code[0]); WHILE i < head.codeSize DO Files.Read(R, ch); S.PUT(t, ch); INC(t); INC(i) END ; (* TypeBlk *) Expect(089X, "TypeTag"); ReadTypes; IF res # done THEN RETURN END ; (* Reference Block *) Expect(08BX, "ReferenceTag"); i := 0; t := S.ADR(m.refs[0]); WHILE i < head.refSize DO Files.Read(R, ch); S.PUT(t, ch); INC(t); INC(i) END ; m.imports[0] := S.ADR(m^); RecordFix(S.ADR(m.imports[0])); i := 0; IF res = done THEN LOOP IF i >= head.nofImports THEN EXIT END ; m1 := S.VAL(Module, modules); WHILE (m1 # NIL) & (mods[i].name # m1.name) DO m1 := m1.next END ; IF m1 = NIL THEN res := moduleNotFound; Str(mods[i].name); Str(" must be loaded before "); Str(m.name); Ln; RETURN END ; IF m1.key # mods[i].key THEN res := keyMismatch; Str("key mismatch in "); Str(m.name); Str(" importing "); Str(mods[i].name); Ln; RETURN END ; INC(i); m.imports[i] := S.ADR(m1^); RecordFix(S.ADR(m.imports[i])); INC(m1.refcnt); END ; END ; IF res = done THEN Str(" "); Str(m.name); Ln; 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, nam); 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, nam); SkipFields(pos); INC(i); S.GET(pos, tag) END ; IF m.name = KernelName THEN InitKernel(m) END ; m.init := TRUE; 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 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 ; 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 Error(fname, " not found"); 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 Error(fname, ": wrong object file version"); END ; ELSE Error(fname, " is not an object file"); res := invalidObjFile; END ELSIF ~m.init THEN Error("", "cyclic import not allowed"); res := cyclicImport; END END Load; PROCEDURE Init; VAR a: ADDRESS; i, size: LONGINT; rest: FreeBlockPtr; 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; i := 0; WHILE i < N DO A[i] := nil; INC(i) END ; heapAdr := S.VAL(LONGINT, heap); heapAdr := heapAdr + (-heapAdr) MOD B; a := heapAdr + B - 4; size := S.VAL(LONGINT, heap) + BootHeapSize - a; DEC(size, size MOD B); rest := S.VAL(FreeBlockPtr, a); rest^.tag := S.VAL(Tag, S.ADR(rest^.size)); rest^.size := size - 4; rest^.next := nil; A[N] := a; END Init; 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, i: LONGINT; m: Module; p: ArrPtr; BEGIN IF modTag = 0 THEN res := moduleNotFound; Error("Kernel not loaded", ""); RETURN END ; (* cut heap *) end := S.VAL(LONGINT, NewBlock(B*N)); IF res # done THEN RETURN END ; m := S.VAL(Module, modules); WHILE m # NIL DO IF ArrPtrAdj # 0 THEN DEC(S.VAL(ADDRESS, m.varEntries), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.entries), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.cmds), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.ptrTab), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.tdescs), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.imports), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.data), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.code), ArrPtrAdj); DEC(S.VAL(ADDRESS, m.refs), ArrPtrAdj) END ; m := m.next END ; (* output heap *) (* BootLinker runs on Ceres: f := Files.New(bootName); *) (* BootLinker runs on Windows: *) f := Files.New(bootName); Files.Set(R, f, 0); Files.WriteLInt(R, heapAdr); Files.WriteLInt(R, end - heapAdr); from := heapAdr + B - 4; Files.WriteLInt(R, from); Files.WriteLInt(R, end - from); WHILE from < end DO S.GET(from, i); Files.WriteLInt(R, i); INC(from, 4) END ; Files.WriteLInt(R, kernelBody); 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); INC(i); END ; Files.WriteLInt(R, dlsymAdr - heapAdr); relocSize := Files.Pos(R) - relocSize; Files.Register(f); Str("heap: "); Int(end - heapAdr); Str(" reloc: "); Int(relocSize); Str(" file: "); Int(Files.Length(f)); 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: Name; Sc: Texts.Scanner; VAR m: Module; BEGIN GetArgs(Sc); IF Sc.class = Texts.Name THEN COPY(Sc.s, bootName); Texts.Scan(Sc) ELSE RETURN END ; IF (Sc.class = Texts.Char) & (Sc.c = ":") THEN Texts.Scan(Sc) ELSE RETURN END ; IF (Sc.class = Texts.Char) & (Sc.c = "=") THEN Texts.Scan(Sc) ELSE RETURN END ; IF Sc.class = Texts.Name THEN Init; Str("linking "); Str(bootName); Ln; res := done; REPEAT Load(Sc.s, m); Texts.Scan(Sc) UNTIL (Sc.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; BEGIN Texts.OpenWriter(W); S.NEW(heap, BootHeapSize); Str("Oberon for Windows boot linker ("); Str(Version); Str(") "); Ln; END BootLinker. BootLinker.Link bootFileName := modName0 modName1 ... ~ All module names must be listed and topologically sorted. Boot File Format: heapAdr4 heapSize4 {adr4 len4 {byte1}} (* len4 times byte1 *) entryAdr4 0X 0X 0X 0X nofPtr {adr} (* nofPtr times adr *) dlsymAdr All numbers in the relocate information part are in compact format and relative to heapAdr.