|
@@ -6,7 +6,7 @@ FROM FIO IMPORT OpenToRead, ReadNBytes, Close, IsNoError ;
|
|
|
FROM Memory IMPORT ArenaBase, LoadImage, ReadByte, ReadWord, ReadSlot,
|
|
FROM Memory IMPORT ArenaBase, LoadImage, ReadByte, ReadWord, ReadSlot,
|
|
|
FillBytes, ReadLong ;
|
|
FillBytes, ReadLong ;
|
|
|
FROM Global IMPORT SetModuleBase, SetModuleProcs, SetModuleFlag,
|
|
FROM Global IMPORT SetModuleBase, SetModuleProcs, SetModuleFlag,
|
|
|
- SetCurrentModule ;
|
|
|
|
|
|
|
+ SetCurrentModule, GetModuleBase, GetModuleFlag ;
|
|
|
FROM Local IMPORT Init, SetGP, SetIP ;
|
|
FROM Local IMPORT Init, SetGP, SetIP ;
|
|
|
FROM Instruction IMPORT ProcedureAddress ;
|
|
FROM Instruction IMPORT ProcedureAddress ;
|
|
|
FROM Interpreter IMPORT Run ;
|
|
FROM Interpreter IMPORT Run ;
|
|
@@ -25,12 +25,20 @@ CONST
|
|
|
DescPad = 295 ;
|
|
DescPad = 295 ;
|
|
|
DescProcs = 296 ;
|
|
DescProcs = 296 ;
|
|
|
DescVarSizes = 304 ;
|
|
DescVarSizes = 304 ;
|
|
|
|
|
+ MaxDeps = 32 ;
|
|
|
|
|
|
|
|
VAR
|
|
VAR
|
|
|
buf : ARRAY [0 .. 65535] OF CHAR ;
|
|
buf : ARRAY [0 .. 65535] OF CHAR ;
|
|
|
f : FIO.File ;
|
|
f : FIO.File ;
|
|
|
|
|
|
|
|
-PROCEDURE Call (name: ARRAY OF CHAR) ;
|
|
|
|
|
|
|
+(* Load one translated .MCD image into module `slot`. The image and its
|
|
|
|
|
+ zero-filled data window (plus globals) are placed at `next` and `next` is
|
|
|
|
|
+ advanced past them, so several modules share the arena without overlap
|
|
|
|
|
+ (multi-window arena). The requested module lives at MTBL slot `dcnt`,
|
|
|
|
|
+ its dependencies at slots 0..dcnt-1 (the 16-bit source references the
|
|
|
|
|
+ first import as mod 0). *)
|
|
|
|
|
+PROCEDURE LoadOne (slot: CARDINAL; name: ARRAY OF CHAR; VAR next: LONGCARD ;
|
|
|
|
|
+ allowDeps: BOOLEAN) ;
|
|
|
VAR
|
|
VAR
|
|
|
got : CARDINAL ;
|
|
got : CARDINAL ;
|
|
|
i : CARDINAL ;
|
|
i : CARDINAL ;
|
|
@@ -50,12 +58,12 @@ BEGIN
|
|
|
END ;
|
|
END ;
|
|
|
|
|
|
|
|
imgLen := VAL (LONGCARD, got) - HeaderSize ;
|
|
imgLen := VAL (LONGCARD, got) - HeaderSize ;
|
|
|
- desc := ArenaBase () ;
|
|
|
|
|
|
|
+ desc := next ;
|
|
|
LoadImage (buf, HeaderSize, desc, got - HeaderSize) ;
|
|
LoadImage (buf, HeaderSize, desc, got - HeaderSize) ;
|
|
|
|
|
|
|
|
dcnt := ReadByte (desc + VAL (LONGCARD, DescDepCount)) ;
|
|
dcnt := ReadByte (desc + VAL (LONGCARD, DescDepCount)) ;
|
|
|
- IF dcnt # 0 THEN
|
|
|
|
|
- Fatal ("loader: dependencies not supported yet") ;
|
|
|
|
|
|
|
+ IF (dcnt # 0) AND NOT allowDeps THEN
|
|
|
|
|
+ Fatal ("loader: nested dependencies not supported yet") ;
|
|
|
END ;
|
|
END ;
|
|
|
|
|
|
|
|
chk := ReadLong (desc + VAL (LONGCARD, DescChecksum)) ;
|
|
chk := ReadLong (desc + VAL (LONGCARD, DescChecksum)) ;
|
|
@@ -89,16 +97,90 @@ BEGIN
|
|
|
vnext := vnext + sz ;
|
|
vnext := vnext + sz ;
|
|
|
END ;
|
|
END ;
|
|
|
|
|
|
|
|
- SetModuleBase (0, dataWin) ;
|
|
|
|
|
- SetModuleProcs (0, procsAbs) ;
|
|
|
|
|
- SetModuleFlag (0, fl) ;
|
|
|
|
|
- SetCurrentModule (0) ;
|
|
|
|
|
|
|
+ SetModuleBase (slot, dataWin) ;
|
|
|
|
|
+ SetModuleProcs (slot, procsAbs) ;
|
|
|
|
|
+ SetModuleFlag (slot, fl) ;
|
|
|
|
|
+
|
|
|
|
|
+ next := vnext ;
|
|
|
|
|
+END LoadOne ;
|
|
|
|
|
+
|
|
|
|
|
+PROCEDURE Call (name: ARRAY OF CHAR) ;
|
|
|
|
|
+VAR
|
|
|
|
|
+ got : CARDINAL ;
|
|
|
|
|
+ imgLen, next : LONGCARD ;
|
|
|
|
|
+ dcnt : CARDINAL ;
|
|
|
|
|
+ j, k : CARDINAL ;
|
|
|
|
|
+ mainDataWin : LONGCARD ;
|
|
|
|
|
+ fl : CARDINAL ;
|
|
|
|
|
+ depName : ARRAY [0 .. MaxDeps - 1] OF ARRAY [0 .. 15] OF CHAR ;
|
|
|
|
|
+ fname : ARRAY [0 .. 255] OF CHAR ;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ f := OpenToRead (name) ;
|
|
|
|
|
+ IF NOT IsNoError (f) THEN
|
|
|
|
|
+ Fatal ("loader: cannot open module file") ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+ got := ReadNBytes (f, HIGH (buf) + 1, ADR (buf)) ;
|
|
|
|
|
+ Close (f) ;
|
|
|
|
|
+ IF got <= 64 THEN
|
|
|
|
|
+ Fatal ("loader: file too short") ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+
|
|
|
|
|
+ imgLen := VAL (LONGCARD, got) - HeaderSize ;
|
|
|
|
|
+ dcnt := ORD (buf [HeaderSize + DescDepCount]) ;
|
|
|
|
|
+ IF dcnt > MaxDeps THEN
|
|
|
|
|
+ Fatal ("loader: too many dependencies") ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+
|
|
|
|
|
+ (* dependency names are the last dcnt*8 bytes of the image (file tail) *)
|
|
|
|
|
+ FOR j := 1 TO dcnt DO
|
|
|
|
|
+ FOR k := 0 TO 7 DO
|
|
|
|
|
+ depName [j - 1] [k] :=
|
|
|
|
|
+ buf [got - dcnt * 8 + (j - 1) * 8 + k] ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+ depName [j - 1] [8] := 0C ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+
|
|
|
|
|
+ next := ArenaBase () ;
|
|
|
|
|
|
|
|
|
|
+ (* dependencies first (slots 0..dcnt-1), then the requested module
|
|
|
|
|
+ (slot dcnt). In the 16-bit source, extern references use mod 0 for
|
|
|
|
|
+ the first import, so MTBL slot 0 must be the first dependency. *)
|
|
|
|
|
+ FOR j := 1 TO dcnt DO
|
|
|
|
|
+ k := 0 ;
|
|
|
|
|
+ WHILE (k < 16) AND (depName [j - 1] [k] # 0C) DO
|
|
|
|
|
+ fname [k] := depName [j - 1] [k] ;
|
|
|
|
|
+ INC (k) ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+ fname [k] := '.' ;
|
|
|
|
|
+ fname [k + 1] := 'M' ;
|
|
|
|
|
+ fname [k + 2] := 'C' ;
|
|
|
|
|
+ fname [k + 3] := 'D' ;
|
|
|
|
|
+ fname [k + 4] := 0C ;
|
|
|
|
|
+ LoadOne (j - 1, fname, next, FALSE) ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+ LoadOne (dcnt, name, next, TRUE) ;
|
|
|
|
|
+
|
|
|
|
|
+ mainDataWin := GetModuleBase (dcnt) ;
|
|
|
|
|
+ fl := GetModuleFlag (dcnt) ;
|
|
|
|
|
+ SetCurrentModule (dcnt) ;
|
|
|
Init () ;
|
|
Init () ;
|
|
|
- SetGP (dataWin) ;
|
|
|
|
|
|
|
+ SetGP (mainDataWin) ;
|
|
|
|
|
|
|
|
|
|
+ (* initializers run dependency-first, the requested module last *)
|
|
|
|
|
+ FOR j := 1 TO dcnt DO
|
|
|
|
|
+ IF (GetModuleFlag (j - 1) DIV 4) MOD 2 # 0 THEN
|
|
|
|
|
+ Init () ;
|
|
|
|
|
+ SetGP (GetModuleBase (j - 1)) ;
|
|
|
|
|
+ SetCurrentModule (j - 1) ;
|
|
|
|
|
+ SetIP (ProcedureAddress (j - 1, 0)) ;
|
|
|
|
|
+ Run () ;
|
|
|
|
|
+ END ;
|
|
|
|
|
+ END ;
|
|
|
IF (fl DIV 4) MOD 2 # 0 THEN (* TOINIT : run the module initializer *)
|
|
IF (fl DIV 4) MOD 2 # 0 THEN (* TOINIT : run the module initializer *)
|
|
|
- SetIP (ProcedureAddress (0, 0)) ;
|
|
|
|
|
|
|
+ Init () ;
|
|
|
|
|
+ SetGP (mainDataWin) ;
|
|
|
|
|
+ SetCurrentModule (dcnt) ;
|
|
|
|
|
+ SetIP (ProcedureAddress (dcnt, 0)) ;
|
|
|
Run () ;
|
|
Run () ;
|
|
|
END ;
|
|
END ;
|
|
|
END Call ;
|
|
END Call ;
|