Created
March 20, 2021 19:04
-
-
Save X547/9875c6bff005a58f8db4f6a81560ca88 to your computer and use it in GitHub Desktop.
Oberon system Blackbox dynamic module loader
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
MODULE StdLoader; | |
(** | |
project = "BlackBox" | |
organization = "www.oberon.ch" | |
contributors = "Oberon microsystems" | |
version = "System/Rsrc/About" | |
copyright = "System/Rsrc/About" | |
license = "Docu/BB-License" | |
changes = "" | |
issues = "" | |
**) | |
IMPORT S := SYSTEM, Kernel, Files; | |
CONST | |
done = Kernel.done; | |
fileNotFound = Kernel.fileNotFound; | |
syntaxError = Kernel.syntaxError; | |
objNotFound = Kernel.objNotFound; | |
illegalFPrint = Kernel.illegalFPrint; | |
cyclicImport = Kernel.cyclicImport; | |
noMem = Kernel.noMem; | |
descNotFound = -1; | |
OFdir = "Code"; | |
SYSdir = "System"; | |
initMod = "Init"; | |
OFtag = 6F4F4346H; | |
(* meta interface consts *) | |
mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5; | |
mBool = 1; mChar = 2; mLChar = 3; mSInt = 4; mInt = 5; mLInt = 6; | |
mReal = 7; mLReal = 8; mSet = 9; mString = 10; mLString = 11; | |
mRecord = 1; mArray = 2; mPointer = 3; mProctyp = 4; | |
mInternal = 1; mReadonly = 2; mPrivate = 3; mExported = 4; | |
(* fixup types *) | |
absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; deref = 105; halfword = 106; | |
TYPE | |
Name = Kernel.Name; | |
ModSpec = POINTER TO RECORD | |
next, link, imp: ModSpec; | |
name: Name; | |
file: Files.File; | |
mod: Kernel.Module; | |
hs, ms, ds, cs, vs: INTEGER; (* headSize, metaSize, descSize, codeSize, dataSize *) | |
mad, dad: INTEGER (* modAdr, descAdr *) | |
END; | |
Hook = POINTER TO RECORD (Kernel.LoaderHook) END; | |
VAR | |
res-: INTEGER; | |
importing-, imported-, object-: Name; | |
inp: Files.Reader; | |
m: Kernel.Module; | |
PROCEDURE Error (r: INTEGER; impd, impg: ModSpec); | |
BEGIN | |
res := r; imported := impd.name$; | |
IF impg # NIL THEN importing := impg.name$ END; | |
END Error; | |
PROCEDURE Append (VAR s: ARRAY OF CHAR; t: ARRAY OF CHAR); | |
VAR len, i, j: INTEGER; ch: CHAR; | |
BEGIN | |
len := LEN(s); | |
i := 0; WHILE s[i] # 0X DO INC(i) END; | |
j := 0; REPEAT ch := t[j]; s[i] := ch; INC(j); INC(i) UNTIL (ch = 0X) OR (i = len); | |
s[len - 1] := 0X | |
END Append; | |
PROCEDURE ThisObjFile (VAR name: ARRAY OF CHAR): Files.File; | |
VAR f: Files.File; loc: Files.Locator; dir, fname: Files.Name; | |
BEGIN | |
Kernel.SplitName(name, dir, fname); | |
Kernel.MakeFileName(fname, Kernel.objType); | |
loc := Files.dir.This(dir); loc := loc.This(OFdir); | |
f := Files.dir.Old(loc, fname, TRUE); | |
IF (f = NIL) & (dir = "") THEN | |
loc := Files.dir.This(SYSdir); loc := loc.This(OFdir); | |
f := Files.dir.Old(loc, fname, TRUE) | |
END; | |
RETURN f | |
END ThisObjFile; | |
PROCEDURE RWord (VAR x: INTEGER); | |
VAR b: BYTE; y: INTEGER; | |
BEGIN | |
inp.ReadByte(b); y := b MOD 256; | |
inp.ReadByte(b); y := y + 100H * (b MOD 256); | |
inp.ReadByte(b); y := y + 10000H * (b MOD 256); | |
inp.ReadByte(b); x := y + 1000000H * b | |
END RWord; | |
PROCEDURE RNum (VAR x: INTEGER); | |
VAR b: BYTE; s, y: INTEGER; | |
BEGIN | |
s := 0; y := 0; inp.ReadByte(b); | |
WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); inp.ReadByte(b) END; | |
x := ASH((b + 64) MOD 128 - 64, s) + y | |
END RNum; | |
PROCEDURE RName (VAR name: ARRAY OF CHAR); | |
VAR b: BYTE; i, n, res: INTEGER; s: Kernel.Utf8Name; | |
BEGIN | |
i := 0; n := LEN(name) - 1; inp.ReadByte(b); | |
WHILE (i < n) & (b # 0) DO s[i] := SHORT(CHR(b MOD 256)); INC(i); inp.ReadByte(b) END; | |
WHILE b # 0 DO inp.ReadByte(b) END; | |
s[i] := 0X; | |
Kernel.Utf8ToString(s, name, res); ASSERT(res = 0) | |
END RName; | |
PROCEDURE Fixup (adr: INTEGER; mod: ModSpec); | |
VAR link, offset, linkadr, t, n, x, low, hi: INTEGER; | |
BEGIN | |
RNum(link); | |
WHILE link # 0 DO | |
RNum(offset); | |
WHILE link # 0 DO | |
IF link > 0 THEN linkadr := mod.mad + mod.ms + link | |
ELSE link := -link; | |
IF link < mod.ms THEN linkadr := mod.mad + link | |
ELSE linkadr := mod.dad + link - mod.ms | |
END | |
END; | |
S.GET(linkadr, x); t := x DIV 1000000H; | |
n := (x + 800000H) MOD 1000000H - 800000H; | |
IF t = absolute THEN x := adr + offset | |
ELSIF t = relative THEN x := adr + offset - linkadr - 4 | |
ELSIF t = copy THEN S.GET(adr + offset, x) | |
ELSIF t = table THEN x := adr + n; n := link + 4 | |
ELSIF t = tableend THEN x := adr + n; n := 0 | |
ELSIF t = deref THEN S.GET(adr+2, x); INC(x, offset); | |
ELSIF t = halfword THEN | |
x := adr + offset; | |
low := (x + 8000H) MOD 10000H - 8000H; | |
hi := (x - low) DIV 10000H; | |
S.GET(linkadr + 4, x); | |
S.PUT(linkadr + 4, x DIV 10000H * 10000H + low MOD 10000H); | |
x := x * 10000H + hi MOD 10000H | |
ELSE Error(syntaxError, mod, NIL) | |
END; | |
S.PUT(linkadr, x); link := n | |
END; | |
RNum(link) | |
END | |
END Fixup; | |
PROCEDURE ReadHeader (mod: ModSpec); | |
VAR n, p: INTEGER; name: Name; imp, last: ModSpec; | |
BEGIN | |
mod.file := ThisObjFile(mod.name); | |
IF (mod.file = NIL) & (mod.link # NIL) THEN (* try closing importing obj file *) | |
mod.link.file.Close; mod.link.file := NIL; | |
mod.file := ThisObjFile(mod.name) | |
END; | |
IF mod.file # NIL THEN | |
inp := mod.file.NewReader(inp); | |
IF inp # NIL THEN | |
inp.SetPos(0); RWord(n); RWord(p); | |
IF (n = OFtag) & (p = Kernel.processor) THEN | |
RWord(mod.hs); RWord(mod.ms); RWord(mod.ds); RWord(mod.cs); RWord(mod.vs); | |
RNum(n); RName(name); | |
IF name = mod.name THEN | |
mod.imp := NIL; last := NIL; | |
WHILE n > 0 DO | |
NEW(imp); RName(imp.name); | |
IF last = NIL THEN mod.imp := imp ELSE last.next := imp END; | |
last := imp; imp.next := NIL; DEC(n) | |
END | |
ELSE Error(fileNotFound, mod, NIL) | |
END | |
ELSE Error(syntaxError, mod, NIL) | |
END | |
ELSE Error(noMem, mod, NIL) | |
END | |
ELSE Error(fileNotFound, mod, NIL) | |
END | |
END ReadHeader; | |
PROCEDURE ReadModule (mod: ModSpec); | |
TYPE BlockPtr = POINTER TO ARRAY [untagged] 1000000H OF BYTE; | |
VAR imptab, x, fp, ofp, opt, a: INTEGER; | |
name: Name; dp, mp: BlockPtr; imp: ModSpec; obj: Kernel.Object; | |
BEGIN | |
IF mod.file = NIL THEN mod.file := ThisObjFile(mod.name) END; | |
inp := mod.file.NewReader(inp); | |
IF inp # NIL THEN | |
inp.SetPos(mod.hs); | |
Kernel.AllocModMem(mod.ds, mod.ms + mod.cs + mod.vs, mod.dad, mod.mad); | |
IF (mod.dad # 0) & (mod.mad # 0) THEN | |
dp := S.VAL(BlockPtr, mod.dad); mp := S.VAL(BlockPtr, mod.mad); | |
inp.ReadBytes(mp^, 0, mod.ms); | |
inp.ReadBytes(dp^, 0, mod.ds); | |
inp.ReadBytes(mp^, mod.ms, mod.cs); | |
mod.mod := S.VAL(Kernel.Module, mod.dad); | |
Fixup(S.ADR(Kernel.NewRec), mod); | |
Fixup(S.ADR(Kernel.NewArr), mod); | |
Fixup(mod.mad, mod); | |
Fixup(mod.dad, mod); | |
Fixup(mod.mad + mod.ms, mod); | |
Fixup(mod.mad + mod.ms + mod.cs, mod); | |
imp := mod.imp; imptab := S.VAL(INTEGER, mod.mod.imports); | |
WHILE (res = done) & (imp # NIL) DO | |
RNum(x); | |
WHILE (res <= done) & (x # 0) DO | |
RName(name); RNum(fp); opt := 0; | |
IF imp.mod # NIL THEN | |
IF name = "" THEN obj := Kernel.ThisDesc(imp.mod, fp) | |
ELSE | |
obj := Kernel.ThisObject(imp.mod, name) | |
END; | |
IF (obj # NIL) & (obj.id MOD 16 = x) THEN | |
ofp := obj.fprint; | |
IF x = mTyp THEN | |
RNum(opt); | |
IF ODD(opt) THEN ofp := obj.offs END; | |
IF (opt > 1) & (obj.id DIV 16 MOD 16 # mExported) THEN | |
Error(objNotFound, imp, mod); object := name$ | |
END; | |
Fixup(S.VAL(INTEGER, obj.struct), mod) | |
ELSIF x = mVar THEN | |
Fixup(imp.mod.varBase + obj.offs, mod) | |
ELSIF x = mProc THEN | |
Fixup(imp.mod.procBase + obj.offs, mod) | |
END; | |
IF ofp # fp THEN Error(illegalFPrint, imp, mod); object := name$ END | |
ELSIF name # "" THEN | |
Error(objNotFound, imp, mod); object := name$ | |
ELSE | |
Error(descNotFound, imp, mod); (* proceed to find failing named object *) | |
RNum(opt); Fixup(0, mod) | |
END | |
ELSE (* imp is dll *) | |
IF x IN {mVar, mProc} THEN | |
a := Kernel.ThisDllObj(x, fp, imp.name, name); | |
IF a # 0 THEN Fixup(a, mod) | |
ELSE Error(objNotFound, imp, mod); object := name$ | |
END | |
ELSIF x = mTyp THEN | |
RNum(opt); RNum(x); | |
IF x # 0 THEN Error(objNotFound, imp, mod); object := name$ END | |
END | |
END; | |
RNum(x) | |
END; | |
S.PUT(imptab, imp.mod); INC(imptab, 4); imp := imp.next | |
END; | |
IF res # done THEN | |
Kernel.DeallocModMem(mod.ds, mod.ms + mod.cs + mod.vs, mod.dad, mod.mad); mod.mod := NIL | |
END | |
ELSE Error(noMem, mod, NIL) | |
END | |
ELSE Error(noMem, mod, NIL) | |
END; | |
mod.file.Close; mod.file := NIL | |
END ReadModule; | |
PROCEDURE LoadMod (mod: ModSpec); | |
VAR i: ModSpec; ok: BOOLEAN; j: INTEGER; | |
BEGIN | |
importing := ""; imported := ""; object := ""; i := mod; | |
WHILE (i.link # NIL) & (i.link.name # mod.name) DO i := i.link END; | |
IF i.link = NIL THEN ReadHeader(mod) | |
ELSE Error(cyclicImport, i, i.link) | |
END; | |
i := mod.imp; | |
WHILE (res = done) & (i # NIL) DO (* get imported module *) | |
IF i.name = "$$" THEN i.name := "Kernel" END; | |
IF i.name[0] = "$" THEN (* dll *) | |
j := 1; | |
WHILE i.name[j] # 0X DO i.name[j - 1] := i.name[j]; INC(j) END; | |
i.name[j - 1] := 0X; | |
Kernel.LoadDll(i.name, ok); | |
IF ~ok THEN Error(fileNotFound, i, NIL) END | |
ELSE | |
i.mod := Kernel.ThisLoadedMod(i.name); (* loaded module *) | |
IF i.mod = NIL THEN i.link := mod; LoadMod(i) END (* new module *) | |
END; | |
i := i.next | |
END; | |
IF res = done THEN | |
mod.mod := Kernel.ThisLoadedMod(mod.name); (* guaranties uniqueness *) | |
IF mod.mod = NIL THEN | |
ReadModule(mod); | |
IF res = done THEN | |
Kernel.RegisterMod(mod.mod); | |
res := done | |
END | |
END | |
END; | |
IF res = descNotFound THEN res := objNotFound; object := "<TypeDesc>" END; | |
IF object # "" THEN Append(imported, "."); Append(imported, object); object := "" END | |
END LoadMod; | |
PROCEDURE (h: Hook) ThisMod (IN name: ARRAY OF CHAR): Kernel.Module; | |
VAR m: Kernel.Module; ms: ModSpec; | |
BEGIN | |
res := done; | |
m := Kernel.ThisLoadedMod(name); | |
IF m = NIL THEN | |
NEW(ms); ms.link := NIL; ms.name := name$; | |
LoadMod(ms); | |
m := ms.mod; | |
inp := NIL (* free last file *) | |
END; | |
h.res := res; | |
h.importing := importing$; | |
h.imported := imported$; | |
h.object := object$; | |
RETURN m | |
END ThisMod; | |
PROCEDURE Init; | |
VAR h: Hook; | |
BEGIN | |
NEW(h); Kernel.SetLoaderHook(h) | |
END Init; | |
BEGIN | |
Init; | |
m := Kernel.ThisMod("Init"); | |
IF res # 0 THEN | |
CASE res OF | |
| fileNotFound: Append(imported, ": code file not found") | |
| syntaxError: Append(imported, ": corrupted code file") | |
| objNotFound: Append(imported, " not found") | |
| illegalFPrint: Append(imported, ": wrong fingerprint") | |
| cyclicImport: Append(imported, ": cyclic import") | |
| noMem: Append(imported, ": not enough memory") | |
ELSE Append(imported, ": loader error") | |
END; | |
IF res IN {objNotFound, illegalFPrint, cyclicImport} THEN | |
Append(imported, " (imported from "); Append(imported, importing); Append(imported, ")") | |
END; | |
Kernel.FatalError(res, imported) | |
END | |
END StdLoader. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment