MODULE mkread ;

(* Generates readtest.MC4, a single-module MC64 image that reads two lines
   from the host standard input via SYSTEM service 2 and echoes both back:

     reserve 128 bytes  ; store_global 1        ; input buffer
     load_global 1 ; id 2 ; system              ; read line 1 (pushes count)
     drop                                        ; ignore the count here
     "you said: " ; write string ; echo buffer ; CRLF
     load_global 1 ; id 2 ; system              ; read line 2
     drop
     "again: " ; write string ; echo buffer ; CRLF
     end_program                                ; service 0x50 *)

FROM FileIO IMPORT WriteFile ;
FROM Console IMPORT Fatal ;

CONST
  HeaderSize = 64 ;
  DescName = 264 ;
  DescChecksum = 288 ;
  DescFlags = 292 ;
  DescDepCount = 294 ;
  DescProcs = 296 ;
  BufSize = 512 ;

VAR
  buf : ARRAY [0 .. BufSize - 1] OF CHAR ;
  i, sum : CARDINAL ;
  pc, ilen : CARDINAL ;

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 Op (o : CARDINAL) ;
BEGIN
  buf [HeaderSize + pc] := CHR (o MOD 256) ;
  INC (pc) ;
END Op ;

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

PROCEDURE EStr (s : ARRAY OF CHAR ; nl : BOOLEAN) ;
VAR len, i2 : CARDINAL ;
BEGIN
  Op (8CH) ;
  IF nl THEN
    len := LENGTH (s) + 3 ;
  ELSE
    len := LENGTH (s) + 1 ;
  END ;
  buf [HeaderSize + pc] := CHR (len) ;
  INC (pc) ;
  IF LENGTH (s) > 0 THEN
    FOR i2 := 0 TO LENGTH (s) - 1 DO
      buf [HeaderSize + pc + i2] := s [i2] ;
    END ;
  END ;
  INC (pc, LENGTH (s)) ;
  IF nl THEN
    buf [HeaderSize + pc] := CHR (13) ;
    buf [HeaderSize + pc + 1] := CHR (10) ;
    INC (pc, 2) ;
  END ;
  buf [HeaderSize + pc] := 0C ;
  INC (pc) ;
END EStr ;

PROCEDURE PrintStr ;
BEGIN
  OpB (8DH, 1) ;           (* id = write string *)
  Op (0C3H) ;              (* system *)
END PrintStr ;

PROCEDURE ReadEcho (s : ARRAY OF CHAR) ;
BEGIN
  OpB (2DH, 1) ; OpB (8DH, 2) ; Op (0C3H) ;  (* read line into GP[1] *)
  Op (40H) ; Op (00H) ;                       (* drop the byte count *)
  EStr (s, FALSE) ; PrintStr ;
  OpB (2DH, 1) ; PrintStr ;                   (* echo the line *)
  EStr ("", TRUE) ; PrintStr ;                (* CRLF *)
END ReadEcho ;

BEGIN
  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] := 'r' ;
  buf [HeaderSize + DescName + 1] := 'e' ;
  buf [HeaderSize + DescName + 2] := 'a' ;
  buf [HeaderSize + DescName + 3] := 'd' ;
  buf [HeaderSize + DescFlags] := CHR (4) ;
  buf [HeaderSize + DescDepCount] := CHR (0) ;
  Put64 (HeaderSize + DescProcs, 304) ;

  pc := 312 ;

  OpB (0D4H, 255) ;          (* enter : no locals *)
  OpB (8DH, 128) ; Op (0D2H) ; OpB (3DH, 1) ;   (* GP[1] := reserve 128 *)

  ReadEcho ("you said: ") ;
  ReadEcho ("again: ") ;

  Op (50H) ;                                  (* end_program *)

  ilen := pc ;
  Put64 (HeaderSize + 304, 8) ;               (* proc0 at image 312 *)

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

  IF NOT WriteFile ("readtest.MC4", buf, HeaderSize + ilen) THEN
    Fatal ("mkread: cannot write readtest.MC4") ;
  END ;
END mkread.