m-code-64/mkdep.mod

MODULE mkdep ;

(* Synthetic two-module MC64 test for the Loader2 dep-chain :
   - STAK.MC4 : dependency-free sidecar.  proc0 = empty TOINIT,
     proc1 = writes a host string (proves an extern call reached
     the dependency's code via MTBL slot 0 + cross-module call/leave).
   - DEP.MC4  : main module, dcnt=1, dep name "STAK".  TOINIT
     extern-calls STAK.proc1, then end_program.
   Run : mkdep ; then  mcint DEP.MC4   from the dir holding STAK.MC4.
   Expect one line from the STAK proc, exit 0. *)

FROM FileIO IMPORT WriteFile ;
FROM Console IMPORT Fatal ;
FROM SYSTEM IMPORT ADR ;

CONST
  HeaderSize = 64 ;
  DescName = 264 ;
  DescChecksum = 288 ;
  DescFlags = 292 ;
  DescVarCount = 293 ;
  DescDepCount = 294 ;
  DescProcs = 296 ;
  ProcTable = 304 ;
  CodeOff = 312 ;
  BufSize = 2048 ;

TYPE
  Typ = (tStak, tDep) ;

VAR
  buf : ARRAY [0 .. BufSize - 1] OF CHAR ;
  pcimg : CARDINAL ;
  i, p0, p1, sum, pt : CARDINAL ;
  which : Typ ;

PROCEDURE Op (o : CARDINAL) ;
BEGIN
  buf [HeaderSize + pcimg] := CHR (o MOD 256) ;
  INC (pcimg) ;
END Op ;

PROCEDURE OpB (o, b : CARDINAL) ;
BEGIN
  Op (o) ;
  buf [HeaderSize + pcimg] := CHR (b MOD 256) ;
  INC (pcimg) ;
END OpB ;

PROCEDURE Put32 (off, v : CARDINAL) ;
BEGIN
  buf [off] := CHR (v MOD 256) ;
  buf [off + 1] := CHR ((v DIV 256) MOD 256) ;
  buf [off + 2] := CHR ((v DIV 65536) MOD 256) ;
  buf [off + 3] := CHR (v DIV 16777216) ;
END Put32 ;

PROCEDURE Put64 (off : CARDINAL ; v : LONGCARD) ;
VAR j : CARDINAL ;
BEGIN
  FOR j := 0 TO 7 DO
    buf [off + j] := CHR (VAL (CARDINAL, v MOD 256)) ;
    v := v DIV 256 ;
  END ;
END Put64 ;

PROCEDURE ImmB (b : CARDINAL) ;
BEGIN
  OpB (8DH, b) ;
END ImmB ;

PROCEDURE EStr (s : ARRAY OF CHAR) ;
VAR len, k : CARDINAL ;
BEGIN
  Op (8CH) ;
  len := LENGTH (s) + 1 ;
  buf [HeaderSize + pcimg] := CHR (len) ;
  INC (pcimg) ;
  FOR k := 0 TO LENGTH (s) - 1 DO
    buf [HeaderSize + pcimg + k] := s [k] ;
  END ;
  INC (pcimg, LENGTH (s)) ;
  buf [HeaderSize + pcimg] := 0C ;
  INC (pcimg) ;
END EStr ;

PROCEDURE PrintStr ;
BEGIN
  ImmB (1) ;
  Op (0C3H) ;
END PrintStr ;

PROCEDURE Stak ;  (* build STAK.MCD *)
VAR st, s1 : CARDINAL ;
BEGIN
  which := tStak ;
  FOR i := 0 TO BufSize - 1 DO
    buf [i] := 0C ;
  END ;
  buf [0] := 'M' ;
  buf [1] := 'C' ;
  buf [2] := '6' ;
  buf [3] := '4' ;
  buf [HeaderSize + DescName] := 'S' ;
  buf [HeaderSize + DescName + 1] := 'T' ;
  buf [HeaderSize + DescName + 2] := 'A' ;
  buf [HeaderSize + DescName + 3] := 'K' ;
  buf [HeaderSize + DescFlags] := CHR (4) ;
  buf [HeaderSize + DescVarCount] := CHR (0) ;
  buf [HeaderSize + DescDepCount] := CHR (0) ;

  pcimg := CodeOff ;

  (* proc0 : empty initializer *)
  p0 := pcimg ;
  Op (50H) ;

  (* proc1 : write "cross-module ok" via SYSTEM service 1 *)
  s1 := pcimg ;
  OpB (0D4H, 250) ;
  EStr ("cross-module ok") ;
  PrintStr ;
  OpB (85H, 0) ;

  pt := pcimg ;
  Put64 (HeaderSize + DescProcs, VAL (LONGCARD, pt)) ;
  Put64 (HeaderSize + pt, VAL (LONGCARD, p0) - VAL (LONGCARD, pt)) ;
  Put64 (HeaderSize + pt + 8,
         VAL (LONGCARD, s1) - VAL (LONGCARD, pt + 8)) ;
  INC (pcimg, 16) ;

  sum := 0 ;
  FOR i := HeaderSize TO HeaderSize + pcimg - 1 DO
    IF NOT ((i >= 352) AND (i <= 355)) THEN
      sum := sum + ORD (buf [i]) ;
    END ;
  END ;
  Put32 (HeaderSize + DescChecksum, sum) ;

  IF NOT WriteFile ("STAK.MC4", buf, HeaderSize + pcimg) THEN
    Fatal ("mkdep: cannot write STAK.MC4") ;
  END ;
END Stak ;

PROCEDURE Dep ;  (* build DEP.MC4 *)
VAR st0, dep : CARDINAL ;
BEGIN
  which := tDep ;
  FOR i := 0 TO BufSize - 1 DO
    buf [i] := 0C ;
  END ;
  buf [0] := 'M' ;
  buf [1] := 'C' ;
  buf [2] := '6' ;
  buf [3] := '4' ;
  buf [HeaderSize + DescName] := 'D' ;
  buf [HeaderSize + DescName + 1] := 'E' ;
  buf [HeaderSize + DescName + 2] := 'P' ;
  buf [HeaderSize + DescFlags] := CHR (4) ;
  buf [HeaderSize + DescVarCount] := CHR (0) ;
  buf [HeaderSize + DescDepCount] := CHR (1) ;

  pcimg := CodeOff ;

  (* proc0 : TOINIT -> extern call STAK.proc1, then end_program *)
  st0 := pcimg ;
  OpB (0EFH, 0) ; Op (1) ;   (* extern_call mod=0, proc=1 *)
  Op (50H) ;

  pt := pcimg ;
  Put64 (HeaderSize + DescProcs, VAL (LONGCARD, pt)) ;
  Put64 (HeaderSize + pt, VAL (LONGCARD, st0) - VAL (LONGCARD, pt)) ;
  INC (pcimg, 8) ;

  (* dependency name table at the image tail : "STAK" *)
  dep := pcimg ;
  buf [HeaderSize + dep] := 'S' ;
  buf [HeaderSize + dep + 1] := 'T' ;
  buf [HeaderSize + dep + 2] := 'A' ;
  buf [HeaderSize + dep + 3] := 'K' ;
  INC (pcimg, 8) ;

  sum := 0 ;
  FOR i := HeaderSize TO HeaderSize + pcimg - 1 DO
    IF NOT ((i >= 352) AND (i <= 355)) THEN
      sum := sum + ORD (buf [i]) ;
    END ;
  END ;
  Put32 (HeaderSize + DescChecksum, sum) ;

  IF NOT WriteFile ("DEP.MC4", buf, HeaderSize + pcimg) THEN
    Fatal ("mkdep: cannot write DEP.MC4") ;
  END ;
END Dep ;

BEGIN
  Stak ;
  Dep ;
END mkdep.