m-code-64/Loader2.mod

IMPLEMENTATION MODULE Loader2 ;

FROM SYSTEM IMPORT ADR ;
IMPORT FIO ;
FROM FIO IMPORT OpenToRead, ReadNBytes, Close, IsNoError ;
FROM Memory IMPORT ArenaBase, LoadImage, ReadByte, ReadWord, ReadSlot,
  FillBytes, ReadLong ;
FROM Global IMPORT SetModuleBase, SetModuleProcs, SetModuleFlag,
  SetCurrentModule, GetModuleBase, GetModuleFlag ;
FROM Local IMPORT Init, SetGP, SetIP ;
FROM Instruction IMPORT ProcedureAddress ;
FROM Interpreter IMPORT Run ;
FROM Extended IMPORT SetHeapBase ;
FROM Console IMPORT Fatal ;

CONST
  HeaderSize = 64 ;
  DescDeps = 0 ;
  DescLink = 256 ;
  DescName = 264 ;
  DescLoadAddr = 280 ;
  DescChecksum = 288 ;
  DescFlags = 292 ;
  DescVarCount = 293 ;
  DescDepCount = 294 ;
  DescPad = 295 ;
  DescProcs = 296 ;
  DescVarSizes = 304 ;
  MaxDeps = 32 ;

VAR
  buf : ARRAY [0 .. 65535] OF CHAR ;
  f : FIO.File ;

(* Load one translated .MC4 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
  got : CARDINAL ;
  i : CARDINAL ;
  imgLen, desc, procsAbs, dataWin, vnext, sz : LONGCARD ;
  chk, sum : CARDINAL ;
  fl, vcnt, dcnt : CARDINAL ;
  j : CARDINAL ;
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 ;
  desc := next ;
  LoadImage (buf, HeaderSize, desc, got - HeaderSize) ;

  dcnt := ReadByte (desc + VAL (LONGCARD, DescDepCount)) ;
  IF (dcnt # 0) AND NOT allowDeps THEN
    Fatal ("loader: nested dependencies not supported yet") ;
  END ;

  chk := ReadLong (desc + VAL (LONGCARD, DescChecksum)) ;
  sum := 0 ;
  FOR i := HeaderSize TO got - 1 DO
    IF NOT ((i >= 352) AND (i <= 355)) THEN
      sum := sum + ORD (buf [i]) ;
    END ;
  END ;
  IF chk # sum THEN
    Fatal ("loader: checksum mismatch") ;
  END ;

  procsAbs := desc + ReadSlot (desc + VAL (LONGCARD, DescProcs)) ;
  fl := ReadByte (desc + VAL (LONGCARD, DescFlags)) ;
  vcnt := ReadByte (desc + VAL (LONGCARD, DescVarCount)) ;

  dataWin := desc + imgLen ;
  IF (dataWin MOD 8) # 0 THEN
    dataWin := dataWin + 8 - (dataWin MOD 8) ;
  END ;

  vnext := dataWin ;
  FOR j := 1 TO vcnt DO
    sz := ReadSlot (desc + (VAL (LONGCARD, DescVarSizes) +
                            (VAL (LONGCARD, j) - 1) * 8)) ;
    IF (sz MOD 8) # 0 THEN
      sz := sz + 8 - (sz MOD 8) ;
    END ;
    FillBytes (vnext, sz, 0) ;
    vnext := vnext + sz ;
  END ;

  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] := '4' ;
    fname [k + 4] := 0C ;
    LoadOne (j - 1, fname, next, FALSE) ;
  END ;
  LoadOne (dcnt, name, next, TRUE) ;

  SetHeapBase (next) ;
  mainDataWin := GetModuleBase (dcnt) ;
  fl := GetModuleFlag (dcnt) ;
  SetCurrentModule (dcnt) ;
  Init () ;
  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 *)
    Init () ;
    SetGP (mainDataWin) ;
    SetCurrentModule (dcnt) ;
    SetIP (ProcedureAddress (dcnt, 0)) ;
    Run () ;
  END ;
END Call ;

END Loader2.