Loader2.mod 2.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106
  1. IMPLEMENTATION MODULE Loader2 ;
  2. FROM SYSTEM IMPORT ADR ;
  3. IMPORT FIO ;
  4. FROM FIO IMPORT OpenToRead, ReadNBytes, Close, IsNoError ;
  5. FROM Memory IMPORT ArenaBase, LoadImage, ReadByte, ReadWord, ReadSlot,
  6. FillBytes, ReadLong ;
  7. FROM Global IMPORT SetModuleBase, SetModuleProcs, SetModuleFlag,
  8. SetCurrentModule ;
  9. FROM Local IMPORT Init, SetGP, SetIP ;
  10. FROM Instruction IMPORT ProcedureAddress ;
  11. FROM Interpreter IMPORT Run ;
  12. FROM Console IMPORT Fatal ;
  13. CONST
  14. HeaderSize = 64 ;
  15. DescDeps = 0 ;
  16. DescLink = 256 ;
  17. DescName = 264 ;
  18. DescLoadAddr = 280 ;
  19. DescChecksum = 288 ;
  20. DescFlags = 292 ;
  21. DescVarCount = 293 ;
  22. DescDepCount = 294 ;
  23. DescPad = 295 ;
  24. DescProcs = 296 ;
  25. DescVarSizes = 304 ;
  26. VAR
  27. buf : ARRAY [0 .. 65535] OF CHAR ;
  28. f : FIO.File ;
  29. PROCEDURE Call (name: ARRAY OF CHAR) ;
  30. VAR
  31. got : CARDINAL ;
  32. i : CARDINAL ;
  33. imgLen, desc, procsAbs, dataWin, vnext, sz : LONGCARD ;
  34. chk, sum : CARDINAL ;
  35. fl, vcnt, dcnt : CARDINAL ;
  36. j : CARDINAL ;
  37. BEGIN
  38. f := OpenToRead (name) ;
  39. IF NOT IsNoError (f) THEN
  40. Fatal ("loader: cannot open module file") ;
  41. END ;
  42. got := ReadNBytes (f, HIGH (buf) + 1, ADR (buf)) ;
  43. Close (f) ;
  44. IF got <= 64 THEN
  45. Fatal ("loader: file too short") ;
  46. END ;
  47. imgLen := VAL (LONGCARD, got) - HeaderSize ;
  48. desc := ArenaBase () ;
  49. LoadImage (buf, HeaderSize, desc, got - HeaderSize) ;
  50. dcnt := ReadByte (desc + VAL (LONGCARD, DescDepCount)) ;
  51. IF dcnt # 0 THEN
  52. Fatal ("loader: dependencies not supported yet") ;
  53. END ;
  54. chk := ReadLong (desc + VAL (LONGCARD, DescChecksum)) ;
  55. sum := 0 ;
  56. FOR i := HeaderSize TO got - 1 DO
  57. IF NOT ((i >= 352) AND (i <= 355)) THEN
  58. sum := sum + ORD (buf [i]) ;
  59. END ;
  60. END ;
  61. IF chk # sum THEN
  62. Fatal ("loader: checksum mismatch") ;
  63. END ;
  64. procsAbs := desc + ReadSlot (desc + VAL (LONGCARD, DescProcs)) ;
  65. fl := ReadByte (desc + VAL (LONGCARD, DescFlags)) ;
  66. vcnt := ReadByte (desc + VAL (LONGCARD, DescVarCount)) ;
  67. dataWin := desc + imgLen ;
  68. IF (dataWin MOD 8) # 0 THEN
  69. dataWin := dataWin + 8 - (dataWin MOD 8) ;
  70. END ;
  71. vnext := dataWin ;
  72. FOR j := 1 TO vcnt DO
  73. sz := ReadSlot (desc + (VAL (LONGCARD, DescVarSizes) +
  74. (VAL (LONGCARD, j) - 1) * 8)) ;
  75. IF (sz MOD 8) # 0 THEN
  76. sz := sz + 8 - (sz MOD 8) ;
  77. END ;
  78. FillBytes (vnext, sz, 0) ;
  79. vnext := vnext + sz ;
  80. END ;
  81. SetModuleBase (0, dataWin) ;
  82. SetModuleProcs (0, procsAbs) ;
  83. SetModuleFlag (0, fl) ;
  84. SetCurrentModule (0) ;
  85. Init () ;
  86. SetGP (dataWin) ;
  87. IF (fl DIV 4) MOD 2 # 0 THEN (* TOINIT : run the module initializer *)
  88. SetIP (ProcedureAddress (0, 0)) ;
  89. Run () ;
  90. END ;
  91. END Call ;
  92. END Loader2.