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 ;
FROM Local IMPORT Init, SetGP, SetIP ;
FROM Instruction IMPORT ProcedureAddress ;
FROM Interpreter IMPORT Run ;
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 ;

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

PROCEDURE Call (name: ARRAY OF CHAR) ;
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 := ArenaBase () ;
  LoadImage (buf, HeaderSize, desc, got - HeaderSize) ;

  dcnt := ReadByte (desc + VAL (LONGCARD, DescDepCount)) ;
  IF dcnt # 0 THEN
    Fatal ("loader: 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 (0, dataWin) ;
  SetModuleProcs (0, procsAbs) ;
  SetModuleFlag (0, fl) ;
  SetCurrentModule (0) ;

  Init () ;
  SetGP (dataWin) ;

  IF (fl DIV 4) MOD 2 # 0 THEN  (* TOINIT : run the module initializer *)
    SetIP (ProcedureAddress (0, 0)) ;
    Run () ;
  END ;
END Call ;

END Loader2.