Trurl-based/Std/Mod/Loader.txt

   1 MODULE StdLoader;
   2
   3         (* THIS IS TEXT COPY OF BlackBox 1.6-rc6 Std/Mod/Loader.odc *)
   4         (* DO NOT EDIT *)
   5
   6         IMPORT S := SYSTEM, Kernel, Files;
   7
   8         CONST
   9                 done = Kernel.done;
  10                 fileNotFound = Kernel.fileNotFound;
  11                 syntaxError = Kernel.syntaxError;
  12                 objNotFound = Kernel.objNotFound;
  13                 illegalFPrint = Kernel.illegalFPrint;
  14                 cyclicImport = Kernel.cyclicImport;
  15                 noMem = Kernel.noMem;
  16                 commNotFound = Kernel.commNotFound;
  17                 commSyntaxError = Kernel.commSyntaxError;
  18                 descNotFound = -1;
  19
  20                 OFdir = "Code";
  21                 SYSdir = "System";
  22                 initMod = "Init";
  23                 OFtag = 6F4F4346H;
  24
  25                 (* meta interface consts *)
  26                 mConst = 1; mTyp = 2; mVar = 3; mProc = 4; mField = 5;
  27                 mBool = 1; mChar = 2; mLChar = 3; mSInt = 4; mInt = 5; mLInt = 6;
  28                 mReal = 7; mLReal = 8; mSet = 9; mString = 10; mLString = 11;
  29                 mRecord = 1; mArray = 2; mPointer = 3; mProctyp = 4;
  30                 mInternal = 1; mReadonly = 2; mPrivate = 3; mExported = 4;
  31
  32                 (* fixup types *)
  33                 absolute = 100; relative = 101; copy = 102; table = 103; tableend = 104; deref = 105; halfword = 106;
  34
  35         TYPE
  36                 Name = ARRAY 256 OF CHAR;
  37                 ModSpec = POINTER TO RECORD
  38                         next, link, imp: ModSpec;
  39                         name: Name;
  40                         file: Files.File;
  41                         mod: Kernel.Module;
  42                         hs, ms, ds, cs, vs, mad, dad: INTEGER
  43                 END;
  44
  45                 Hook = POINTER TO RECORD (Kernel.LoaderHook) END;
  46
  47         VAR
  48                 res-: INTEGER;
  49                 importing-, imported-, object-: Name;
  50                 inp: Files.Reader;
  51                 m: Kernel.Module;
  52
  53         PROCEDURE Error (r: INTEGER; impd, impg: ModSpec);
  54         BEGIN
  55                 res := r; imported := impd.name$;
  56                 IF impg # NIL THEN importing := impg.name$ END;
  57         END Error;
  58
  59         PROCEDURE Append (VAR s: ARRAY OF CHAR; t: ARRAY OF CHAR);
  60                 VAR len, i, j: INTEGER; ch: CHAR;
  61         BEGIN
  62                 len := LEN(s);
  63                 i := 0; WHILE s[i] # 0X DO INC(i) END;
  64                 j := 0; REPEAT ch := t[j]; s[i] := ch; INC(j); INC(i) UNTIL (ch = 0X) OR (i = len);
  65                 s[len - 1] := 0X
  66         END Append;
  67
  68         PROCEDURE ThisObjFile (VAR name: ARRAY OF CHAR): Files.File;
  69                 VAR f: Files.File; loc: Files.Locator; dir, fname: Files.Name;
  70         BEGIN
  71                 Kernel.SplitName(name, dir, fname);
  72                 Kernel.MakeFileName(fname, Kernel.objType);
  73                 loc := Files.dir.This(dir); loc := loc.This(OFdir);
  74                 f := Files.dir.Old(loc, fname, TRUE);
  75                 IF (f = NIL) & (dir = "") THEN
  76                         loc := Files.dir.This(SYSdir); loc := loc.This(OFdir);
  77                         f := Files.dir.Old(loc, fname, TRUE)
  78                 END;
  79                 RETURN f
  80         END ThisObjFile;
  81
  82         PROCEDURE RWord (VAR x: INTEGER);
  83                 VAR b: BYTE; y: INTEGER;
  84         BEGIN
  85                 inp.ReadByte(b); y := b MOD 256;
  86                 inp.ReadByte(b); y := y + 100H * (b MOD 256);
  87                 inp.ReadByte(b); y := y + 10000H * (b MOD 256);
  88                 inp.ReadByte(b); x := y + 1000000H * b
  89         END RWord;
  90
  91         PROCEDURE RNum (VAR x: INTEGER);
  92                 VAR b: BYTE; s, y: INTEGER;
  93         BEGIN
  94                 s := 0; y := 0; inp.ReadByte(b);
  95                 WHILE b < 0 DO INC(y, ASH(b + 128, s)); INC(s, 7); inp.ReadByte(b) END;
  96                 x := ASH((b + 64) MOD 128 - 64, s) + y
  97         END RNum;
  98
  99         PROCEDURE RName (VAR name: ARRAY OF CHAR);
 100                 VAR b: BYTE; i, n: INTEGER;
 101         BEGIN
 102                 i := 0; n := LEN(name) - 1; inp.ReadByte(b);
 103                 WHILE (i < n) & (b # 0) DO name[i] := CHR(b MOD 256); INC(i); inp.ReadByte(b) END;
 104                 WHILE b # 0 DO inp.ReadByte(b) END;
 105                 name[i] := 0X
 106         END RName;
 107
 108         PROCEDURE Fixup (adr: INTEGER; mod: ModSpec);
 109                 VAR link, offset, linkadr, t, n, x, low, hi: INTEGER;
 110         BEGIN
 111                 RNum(link);
 112                 WHILE link # 0 DO
 113                         RNum(offset);
 114                         WHILE link # 0 DO
 115                                 IF link > 0 THEN linkadr := mod.mad + mod.ms + link
 116                                 ELSE link := -link;
 117                                         IF link < mod.ms THEN linkadr := mod.mad + link
 118                                         ELSE linkadr := mod.dad + link - mod.ms
 119                                         END
 120                                 END;
 121                                 S.GET(linkadr, x); t := x DIV 1000000H;
 122                                 n := (x + 800000H) MOD 1000000H - 800000H;
 123                                 IF t = absolute THEN x := adr + offset
 124                                 ELSIF t = relative THEN x := adr + offset - linkadr - 4
 125                                 ELSIF t = copy THEN S.GET(adr + offset, x)
 126                                 ELSIF t = table THEN x := adr + n; n := link + 4
 127                                 ELSIF t = tableend THEN x := adr + n; n := 0
 128                                 ELSIF t = deref THEN S.GET(adr+2, x); INC(x, offset);
 129                                 ELSIF t = halfword THEN
 130                                         x := adr + offset;
 131                                         low := (x + 8000H) MOD 10000H - 8000H;
 132                                         hi := (x - low) DIV 10000H;
 133                                         S.GET(linkadr + 4, x);
 134                                         S.PUT(linkadr + 4, x DIV 10000H * 10000H + low MOD 10000H);
 135                                         x := x * 10000H + hi MOD 10000H
 136                                 ELSE Error(syntaxError, mod, NIL)
 137                                 END;
 138                                 S.PUT(linkadr, x); link := n
 139                         END;
 140                         RNum(link)
 141                 END
 142         END Fixup;
 143
 144         PROCEDURE ReadHeader (mod: ModSpec);
 145                 VAR n, p: INTEGER; name: Name; imp, last: ModSpec;
 146         BEGIN
 147                 mod.file := ThisObjFile(mod.name);
 148                 IF (mod.file = NIL) & (mod.link # NIL) THEN     (* try closing importing obj file *)
 149                         mod.link.file.Close; mod.link.file := NIL;
 150                         mod.file := ThisObjFile(mod.name)
 151                 END;
 152                 IF mod.file # NIL THEN
 153                         inp := mod.file.NewReader(inp);
 154                         IF inp # NIL THEN
 155                                 inp.SetPos(0); RWord(n); RWord(p);
 156                                 IF (n = OFtag) & (p = Kernel.processor) THEN
 157                                         RWord(mod.hs); RWord(mod.ms); RWord(mod.ds); RWord(mod.cs); RWord(mod.vs);
 158                                         RNum(n); RName(name);
 159                                         IF name = mod.name THEN
 160                                                 mod.imp := NIL; last := NIL;
 161                                                 WHILE n > 0 DO
 162                                                         NEW(imp); RName(imp.name);
 163                                                         IF last = NIL THEN mod.imp := imp ELSE last.next := imp END;
 164                                                         last := imp; imp.next := NIL; DEC(n)
 165                                                 END
 166                                         ELSE Error(fileNotFound, mod, NIL)
 167                                         END
 168                                 ELSE Error(syntaxError, mod, NIL)
 169                                 END
 170                         ELSE Error(noMem, mod, NIL)
 171                         END
 172                 ELSE Error(fileNotFound, mod, NIL)
 173                 END
 174         END ReadHeader;
 175
 176         PROCEDURE ReadModule (mod: ModSpec);
 177                 TYPE BlockPtr = POINTER TO ARRAY [1] 1000000H OF BYTE;
 178                 VAR imptab, x, fp, ofp, opt, a: INTEGER;
 179                         name: Name; dp, mp: BlockPtr; imp: ModSpec; obj: Kernel.Object; in, n: Kernel.Name;
 180         BEGIN
 181                 IF mod.file = NIL THEN mod.file := ThisObjFile(mod.name) END;
 182                 inp := mod.file.NewReader(inp);
 183                 IF inp # NIL THEN
 184                         inp.SetPos(mod.hs);
 185                         Kernel.AllocModMem(mod.ds, mod.ms + mod.cs + mod.vs, mod.dad, mod.mad);
 186                         IF (mod.dad # 0) & (mod.mad # 0) THEN
 187                                 dp := S.VAL(BlockPtr, mod.dad); mp := S.VAL(BlockPtr, mod.mad);
 188                                 inp.ReadBytes(mp^, 0, mod.ms);
 189                                 inp.ReadBytes(dp^, 0, mod.ds);
 190                                 inp.ReadBytes(mp^, mod.ms, mod.cs);
 191                                 mod.mod := S.VAL(Kernel.Module, mod.dad);
 192                                 Fixup(S.ADR(Kernel.NewRec), mod);
 193                                 Fixup(S.ADR(Kernel.NewArr), mod);
 194                                 Fixup(mod.mad, mod);
 195                                 Fixup(mod.dad, mod);
 196                                 Fixup(mod.mad + mod.ms, mod);
 197                                 Fixup(mod.mad + mod.ms + mod.cs, mod);
 198                                 imp := mod.imp; imptab := S.VAL(INTEGER, mod.mod.imports);
 199                                 WHILE (res = done) & (imp # NIL) DO
 200                                         RNum(x);
 201                                         WHILE (res <= done) & (x # 0) DO
 202                                                 RName(name); RNum(fp); opt := 0;
 203                                                 IF imp.mod # NIL THEN
 204                                                         IF name = "" THEN obj := Kernel.ThisDesc(imp.mod, fp)
 205                                                         ELSE n := SHORT(name$); obj := Kernel.ThisObject(imp.mod, n)
 206                                                         END;
 207                                                         IF (obj # NIL) & (obj.id MOD 16 = x) THEN
 208                                                                 ofp := obj.fprint;
 209                                                                 IF x = mTyp THEN
 210                                                                         RNum(opt);
 211                                                                         IF ODD(opt) THEN ofp := obj.offs END;
 212                                                                         IF (opt > 1) & (obj.id DIV 16 MOD 16 # mExported) THEN
 213                                                                                 Error(objNotFound, imp, mod); object := name$
 214                                                                         END;
 215                                                                         Fixup(S.VAL(INTEGER, obj.struct), mod)
 216                                                                 ELSIF x = mVar THEN
 217                                                                         Fixup(imp.mod.varBase + obj.offs, mod)
 218                                                                 ELSIF x = mProc THEN
 219                                                                         Fixup(imp.mod.procBase + obj.offs, mod)
 220                                                                 END;
 221                                                                 IF ofp # fp THEN Error(illegalFPrint, imp, mod); object := name$ END
 222                                                         ELSIF name # "" THEN
 223                                                                 Error(objNotFound, imp, mod); object := name$
 224                                                         ELSE
 225                                                                 Error(descNotFound, imp, mod);  (* proceed to find failing named object *)
 226                                                                 RNum(opt); Fixup(0, mod)
 227                                                         END
 228                                                 ELSE    (* imp is dll *)
 229                                                         IF x IN {mVar, mProc} THEN
 230                                                                 in := SHORT(imp.name$); n := SHORT(name$);
 231                                                                 a := Kernel.ThisDllObj(x, fp, in, n);
 232                                                                 IF a # 0 THEN Fixup(a, mod)
 233                                                                 ELSE Error(objNotFound, imp, mod); object := name$
 234                                                                 END
 235                                                         ELSIF x = mTyp THEN
 236                                                                 RNum(opt); RNum(x);
 237                                                                 IF x # 0 THEN Error(objNotFound, imp, mod); object := name$ END
 238                                                         END
 239                                                 END;
 240                                                 RNum(x)
 241                                         END;
 242                                         S.PUT(imptab, imp.mod); INC(imptab, 4); imp := imp.next
 243                                 END;
 244                                 IF res # done THEN
 245                                         Kernel.DeallocModMem(mod.ds, mod.ms + mod.cs + mod.vs, mod.dad, mod.mad); mod.mod := NIL
 246                                 END
 247                         ELSE Error(noMem, mod, NIL)
 248                         END
 249                 ELSE Error(noMem, mod, NIL)
 250                 END;
 251                 mod.file.Close; mod.file := NIL
 252         END ReadModule;
 253
 254         PROCEDURE LoadMod (mod: ModSpec);
 255                 VAR i: ModSpec; ok: BOOLEAN; j: INTEGER; n: Kernel.Name;
 256         BEGIN
 257                 importing := ""; imported := ""; object := ""; i := mod;
 258                 WHILE (i.link # NIL) & (i.link.name # mod.name) DO i := i.link END;
 259                 IF i.link = NIL THEN ReadHeader(mod)
 260                 ELSE Error(cyclicImport, i, i.link)
 261                 END;
 262                 i := mod.imp;
 263                 WHILE (res = done) & (i # NIL) DO       (* get imported module *)
 264                         IF i.name = "$$" THEN i.name := "Kernel" END;
 265                         IF i.name[0] = "$" THEN (* dll *)
 266                                 j := 1;
 267                                 WHILE i.name[j] # 0X DO i.name[j - 1] := i.name[j]; INC(j) END;
 268                                 i.name[j - 1] := 0X; n := SHORT(i.name$);
 269                                 Kernel.LoadDll(n, ok);
 270                                 IF ~ok THEN Error(fileNotFound, i, NIL) END
 271                         ELSE
 272                                 n := SHORT(i.name$);
 273                                 i.mod := Kernel.ThisLoadedMod(n);       (* loaded module *)
 274                                 IF i.mod = NIL THEN i.link := mod; LoadMod(i) END       (* new module *)
 275                         END;
 276                         i := i.next
 277                 END;
 278                 IF res = done THEN
 279                         n := SHORT(mod.name$);
 280                         mod.mod := Kernel.ThisLoadedMod(n);     (* guaranties uniqueness *)
 281                         IF mod.mod = NIL THEN
 282                                 ReadModule(mod);
 283                                 IF res = done THEN
 284                                         Kernel.RegisterMod(mod.mod);
 285                                         res := done
 286                                 END
 287                         END
 288                 END;
 289                 IF res = descNotFound THEN res := objNotFound; object := "<TypeDesc>" END;
 290                 IF object # "" THEN Append(imported, "."); Append(imported, object); object := "" END
 291         END LoadMod;
 292
 293         PROCEDURE (h: Hook) ThisMod (IN name: ARRAY OF SHORTCHAR): Kernel.Module;
 294                 VAR m: Kernel.Module; ms: ModSpec;
 295         BEGIN
 296                 res := done;
 297                 m := Kernel.ThisLoadedMod(name);
 298                 IF m = NIL THEN
 299                         NEW(ms); ms.link := NIL; ms.name := name$;
 300                         LoadMod(ms);
 301                         m := ms.mod;
 302                         inp := NIL      (* free last file *)
 303                 END;
 304                 h.res := res;
 305                 h.importing := importing$;
 306                 h.imported := imported$;
 307                 h.object := object$;
 308                 RETURN m
 309         END ThisMod;
 310
 311         PROCEDURE Init;
 312                 VAR h: Hook;
 313         BEGIN
 314                 NEW(h); Kernel.SetLoaderHook(h)
 315         END Init;
 316
 317 BEGIN
 318         Init;
 319         m := Kernel.ThisMod("Init");
 320         IF res # 0 THEN
 321                 CASE res OF
 322                 | fileNotFound: Append(imported, ": code file not found")
 323                 | syntaxError: Append(imported, ": corrupted code file")
 324                 | objNotFound: Append(imported, " not found")
 325                 | illegalFPrint: Append(imported, ": wrong fingerprint")
 326                 | cyclicImport: Append(imported, ": cyclic import")
 327                 | noMem: Append(imported, ": not enough memory")
 328                 ELSE Append(imported, ": loader error")
 329                 END;
 330                 IF res IN {objNotFound, illegalFPrint, cyclicImport} THEN
 331                         Append(imported, " (imported from "); Append(imported, importing); Append(imported, ")")
 332                  END;
 333                 Kernel.FatalError(res, imported)
 334         END
 335 END StdLoader.
 336