(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*       VAX/VMS Implementation          *
*                                       *
*                                       *
*     MVCIO3:                           *
*                                       * 
*     Input / output handling in Pass 3 *
*                                       * 
*                                       *
*     Version 3.1 of  1-FEB-1983        *
*                                       *
*                                       *
*                                       *
*     Based on PDP11 Implementation     *
*     Version M22 of 06.01.81           *
*                                       *
*     Institut fuer Informatik          *
*     ETH-Zuerich                       *
*     CH-8092 Zuerich                   *
*                                       *
****************************************)

(****************************************
* Updates:                              *
****************************************)

IMPLEMENTATION MODULE MVCIO3;    (* PDP11: LG *)
                                 (* VAX:   M. Mall *)

  IMPORT SYSTEM, MVCompiler, MVCPublic, MVCErrors, FileSystem, Storage;

  (* declarations in definition module

  TYPE Savepos = RECORD low, high: CARDINAL;
  END;

  VAR sy : Symbol;
  val : CARDINAL;    (* value *)
  length : CARDINAL; (* string length *)
  line : CARDINAL;   (* current line no. *)
  spix : Spellix;    (* spelling index of identifier *)
  nptr : Idptr;      (* pointer to referenced name *)

  end declarations *)

  VAR
    pos, lpos, lline : CARDINAL;

    MODULE OutputSystem;

      FROM SYSTEM IMPORT WORD;
      FROM MVCompiler IMPORT Symbol;
      FROM MVCPublic IMPORT InterOutFile;
      FROM Storage IMPORT ALLOCATE, DEALLOCATE;
      FROM FileSystem IMPORT WriteWord, GetPos, SetPos;
      IMPORT pos, line, Savepos;

      EXPORT PutSy, PutWord, TermOutput,
             InitSave, ResetSave, ReleaseSave;

      TYPE
        Symptr = POINTER TO Symrec;
        Symrec = RECORD
                   next : Symptr;
                   elem : WORD;
                 END;
        Remptr = POINTER TO Remrec;
        Remrec = RECORD
                   next : Remptr;
                   sympos : Symptr;
                   save : Savepos;
                 END;

      VAR
        symhead, symtail : Symptr;
        remhead, remtail : Remptr;
        savelevel : CARDINAL;
        remcnt : CARDINAL;
        saving : BOOLEAN;
        remaining : BOOLEAN;

      PROCEDURE SaveWord(w: WORD);

      BEGIN
        WITH symtail^ DO
          elem := w;
          IF next = NIL THEN
            NEW(next);
            next^.next := NIL
          END;
          symtail := next;
        END;
        DEC(remcnt);
        IF remcnt = 0 THEN
          remaining := FALSE
        END;
      END SaveWord;

      PROCEDURE PutSy(sy: Symbol);
        (* put symbol sy on interpass output file *)

        VAR
          w : WORD;

      BEGIN
        w := WORD(ORD(sy) * 400B + pos);
        IF saving THEN
          CASE sy OF
            eol, errorsy : remcnt := 2; |
            option : remcnt := 3;
          ELSE remcnt := 0;
          END;
          remaining := remcnt > 0;
          IF remaining THEN
            SetRemaining;
            SaveWord(w)
          END;
        END;
        WriteWord(InterOutFile,w);
      END PutSy;

      PROCEDURE PutWord(w: WORD);
        (* put word w on interpass output file *)

      BEGIN
        IF remaining THEN
          SaveWord(w)
        END;
        WriteWord(InterOutFile,w);
      END PutWord;

      PROCEDURE SetRemaining;

      BEGIN
        WITH remtail^ DO
          sympos := symtail;
          WITH save DO
            GetPos( InterOutFile, high, low )
          END;
          IF next = NIL THEN
            NEW(next);
            next^.next := NIL
          END;
          remtail := next;
        END;
      END SetRemaining;

      PROCEDURE ResetRemainings(s : Savepos);

        VAR
          sym : Symptr;
          r: Remptr;
          sy : Symbol;
          dummy : CARDINAL;
          cnt : CARDINAL;

      BEGIN
        r := remhead;
        WHILE (r <> remtail) AND
              ((r^.save.low < s.low) OR
               (r^.save.low = s.low) AND
               (r^.save.high MOD 10000H < s.high MOD 10000H)) DO
          r := r^.next
        END;
        WHILE r <> remtail DO
          WITH r^ DO
            sym := sympos;
            WITH save DO
              GetPos( InterOutFile, high, low )
            END;
            r := next;
          END;
          sy := VAL( Symbol, CARDINAL(sym^.elem) DIV 400B );
          IF sy = option THEN
            cnt := 3
          ELSE cnt := 2
          END;
          WHILE cnt > 0 DO
            PutWord(sym^.elem);
            DEC(cnt);
            sym := sym^.next;
          END;
        END;
      END ResetRemainings;

      PROCEDURE InitSave(VAR s: Savepos);

        VAR
          dummy : CARDINAL;

      BEGIN
        IF saving THEN
          INC(savelevel);
        ELSE 
          saving := TRUE;
          symtail := symhead;
          remtail := remhead;
          savelevel := 0;
        END;
        WITH s DO
          GetPos( InterOutFile, high, low );
        END;
      END InitSave;

      PROCEDURE ResetSave(s: Savepos);

      BEGIN
        WITH s DO
          SetPos( InterOutFile, high, low )
        END;
        ResetRemainings(s);
      END ResetSave;

      PROCEDURE ReleaseSave(s: Savepos);

      BEGIN
        IF savelevel = 0 THEN
          saving := FALSE;
        ELSE DEC(savelevel);
        END;
      END ReleaseSave;

      PROCEDURE TermOutput;

      BEGIN
        WHILE symhead <> NIL DO
          symtail := symhead;
          symhead := symhead^.next;
          DISPOSE(symtail);
        END;
        WHILE remhead <> NIL DO
          remtail := remhead;
          remhead := remhead^.next;
          DISPOSE(remtail);
        END;
        PutSy(eop);
      END TermOutput;

    BEGIN
      NEW(symhead);
      symhead^.next := NIL;
      NEW(remhead);
      remhead^.next := NIL;
      saving := FALSE;
      remaining := FALSE;
    END OutputSystem;




    MODULE ErrorSystem;

      FROM MVCErrors IMPORT InsertError;
      IMPORT line, pos, lline, lpos;

      EXPORT Error,ErrorLS;

      PROCEDURE Error(n : CARDINAL);

      BEGIN
        InsertError(line,pos,n);
      END Error;

      PROCEDURE ErrorLS(n : CARDINAL);

      BEGIN
        InsertError(lline,lpos,n);
      END ErrorLS;

    END ErrorSystem;



    MODULE Scanner;

      FROM SYSTEM IMPORT BYTE, SHORTWORD;
      FROM MVCompiler IMPORT Idptr, Spellix, Symbol;
      FROM MVCPublic IMPORT InterInFile;
      FROM FileSystem IMPORT ReadByte, ReadShortWord, ReadWord, WriteWord;
      FROM OutputSystem IMPORT PutSy, PutWord;
      IMPORT sy, val, length, spix, nptr,
             pos, line, lpos, lline;

      EXPORT GetSy, PutGetSy, TermInput;

      VAR
        card : CARDINAL;
        issy : BOOLEAN;
        lbyte: BYTE;
        lshort: SHORTWORD;

      PROCEDURE GetSy;

      BEGIN (* get next symbol *)
        lpos := pos;
        lline := line;
        REPEAT
          issy := TRUE;
          ReadByte( InterInFile, lbyte );
          pos := CARDINAL(lbyte);
          ReadByte( InterInFile, sy );
          ReadShortWord( InterInFile, lshort );
          CASE sy OF
            ident: ReadWord( InterInFile, spix ); |
            namesy,proceduresy,modulesy,symbolsy,definitionsy: 
              ReadWord( InterInFile, nptr ); |
            intcon,cardcon,intcarcon,charcon,realcon: ReadWord(InterInFile,val); |
            stringcon: ReadWord(InterInFile,val);
              ReadWord(InterInFile,length); |
            option: 
              ReadWord(InterInFile,val);
              ReadWord(InterInFile,card);
              PutSy(sy);
              PutWord(val);
              PutWord(card);
              issy := FALSE; |
            errorsy,eol: 
              ReadWord(InterInFile,val);
              IF sy = eol THEN
                line := val
              END;
              PutSy(sy);
              PutWord(val);
              issy := FALSE;
          ELSE (* no activity *)
          END; (* CASE *)
        UNTIL issy;
      END GetSy;

      PROCEDURE PutGetSy;

      BEGIN (* put last Symbol, get next Symbol *)
        PutSy(sy);
        CASE sy OF
          ident: PutWord(spix); |
          namesy,proceduresy,modulesy: PutWord(nptr); |
          intcon,cardcon,intcarcon: PutWord(val);
        ELSE (* no activity *)
        END; (* CASE *)
        GetSy;
      END PutGetSy;

      PROCEDURE TermInput;

      BEGIN
      END TermInput;

    BEGIN
      line := 1;
    END Scanner;

  PROCEDURE TermInOut;

  BEGIN
    TermInput;
    TermOutput;
  END TermInOut;

END MVCIO3.