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

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

IMPLEMENTATION MODULE MVCIO1;   (* P. Putfarken, EK *)
  (* $T- *)

  IMPORT SYSTEM, MVCompiler, MVCPublic, MVCErrors, MVCSFD, MVCR1,
         Storage, FileSystem, FileLookup, FileNames, Terminal;


  (* declarations from definition module 

  TYPE String14 = ARRAY [0 .. 13] OF CHAR;

  VAR sy : Symbol;
  val : Constval;
  length : CARDINAL;
  spix : Spellix;

  end of declarations *)

  VAR
    ch: CHAR;
    pos, line : CARDINAL;


    MODULE OutputSystem;

      FROM MVCompiler IMPORT Symbol, Spellix;
      FROM MVCPublic IMPORT InterOutFile, Compilerstatus, compstat;
      FROM MVCErrors IMPORT InsertError;
      FROM Storage IMPORT ALLOCATE, DEALLOCATE;
      FROM FileSystem IMPORT WriteWord;
      IMPORT sy, val, length, spix, pos, line;

      EXPORT PutS, PutSy, PutSyVal, PutIdent, Error,
             InitSave, StopSave, RestartSave, ReleaseSys,
             InitOutput, TermOutput;

      TYPE
        Syptr = POINTER TO Symb;
        Symb = RECORD
                 next: Syptr;
                 card: CARDINAL
               END;

      VAR
        savesys: BOOLEAN;
        first, last: Syptr;
        initline,stopline,restartline: CARDINAL;

      PROCEDURE PutSy(s : Symbol);

        VAR
          c: CARDINAL;

      BEGIN (* put symbol and pos into word *)
        c := ORD(s) * 400B;
        IF pos >= 400B THEN
          INC(c,377B)
        ELSE INC(c,pos)
        END;
        IF savesys THEN
          WITH last^ DO
            card := c;
            IF next = NIL THEN
              NEW(next);
              next^.next := NIL
            END;
            last := next
          END
        ELSE 
          WriteWord(InterOutFile,c);
        END
      END PutSy;

      PROCEDURE PutI(c : CARDINAL);

      BEGIN (* pack c in two bytes *)
        IF savesys THEN
          WITH last^ DO
            card := c;
            IF next = NIL THEN
              NEW(next);
              next^.next := NIL
            END;
            last := next
          END;
        ELSE 
          WriteWord(InterOutFile,c);
        END
      END PutI;

      PROCEDURE PutS;

      BEGIN
        PutSy(sy);
        CASE sy OF
          ident : PutI(spix) |
          intcon,cardcon,intcarcon,charcon,realcon : PutI(val.value) |
          stringcon : PutI(val.value);
            PutI(length) |
          eol : PutI(line)
        ELSE (* nothing *)
        END
      END PutS;

      PROCEDURE PutSyVal(sy: Symbol; val: CARDINAL);

      BEGIN
        PutSy(sy);
        PutI(val);
      END PutSyVal;

      PROCEDURE PutIdent(spix: Spellix);

      BEGIN
        PutSy(ident);
        PutI(spix);
      END PutIdent;

      PROCEDURE Error(n: CARDINAL);

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

      PROCEDURE InitSave;

      BEGIN
        savesys := TRUE;
        initline := line;
        restartline := line;
      END InitSave;

      PROCEDURE StopSave;

      BEGIN
        savesys := FALSE;
        IF restartline <> line THEN
          PutSyVal(eol,line)
        END;
        stopline := line;
      END StopSave;

      PROCEDURE RestartSave;

      BEGIN
        savesys := TRUE;
        IF stopline <> line THEN
          PutSyVal(eol,line)
        END;
        restartline := line;
      END RestartSave;

      PROCEDURE ReleaseSys;

        VAR
          p : Syptr;

      BEGIN
        savesys := FALSE;
        IF initline <> line THEN
          PutSyVal(eol, initline)
        END;
        p := first;
        WHILE p <> last DO
          WITH p^ DO
            PutI(card);
            p := next
          END;
        END;
        last := first;
        IF stopline <> line THEN
          PutSyVal(eol, line)
        END;
      END ReleaseSys;

      PROCEDURE InitOutput;

      BEGIN
        NEW(first);
        first^.next := NIL;
        initline := 0;
        stopline := 0;
        restartline := 0;
        last := first;
        savesys := FALSE;
      END InitOutput;

      PROCEDURE TermOutput;

      BEGIN
        WHILE first <> NIL DO
          last := first;
          first := first^.next;
          DISPOSE(last);
        END;
        PutSy(eop);
      END TermOutput;

    END OutputSystem;


    MODULE IdentSystem;

      FROM MVCompiler IMPORT spellmax, spelltab, Spellix, Symbol;
      FROM Storage IMPORT ALLOCATE, DEALLOCATE;
      FROM OutputSystem IMPORT Error;
      IMPORT sy, spix, ch, String14;

      EXPORT InSpelltab, OutSpelltab, TermSpelltab,
             GetDmId, EnterId, HashIdent, EnterResWord;

      CONST
        spellmaxplusone = spellmax + 1;
        maxspix = 37777B;
        htabmax = 1789; (* MUST BE A PRIME NUMBER *)
        rswlgth = 14;

      TYPE
        Htindex = [0..htabmax];

      VAR
        htab : POINTER TO ARRAY Htindex OF [0..spellmaxplusone];
        idbase, idtop, inaux, outaux: Spellix;
        dmid: CARDINAL;
        hsix : Htindex;

      PROCEDURE GetDmId;

      BEGIN
        INC(dmid);
        spix := dmid;
        outaux := 0;
      END GetDmId;

      PROCEDURE InSpelltab;

      BEGIN
        spelltab[inaux] := ch;
        IF inaux < spellmax THEN
          INC(inaux)
        END;
        hsix  :=  hsix MOD 257*ORD(ch)  +  1;
      END InSpelltab;

      PROCEDURE OutSpelltab;
        (* return character from Spelltab *)

      BEGIN
        ch := spelltab[outaux];
        INC(outaux);
      END OutSpelltab;


      PROCEDURE EnterId;

        VAR
          i, id, b1, b2: CARDINAL;
          h: Htindex;

      BEGIN
        spelltab[inaux] := ' '; (* separator *)
        IF inaux < spellmax THEN
          INC(inaux)
        END;
        sy := ident;
        h := hsix MOD htabmax;
        hsix := 1;
        IF inaux > spellmax THEN
          GetDmId;
          Error(7)
        ELSE 
          IF h = 0 THEN
            h := htabmax-1
          END;
          i := h;
          LOOP
            id := htab^[i];
            IF id > spellmax THEN
              (*--- a new identifier ---*)
              IF inaux+20 < spellmax THEN
                spix := idtop;
                htab^[i] := idtop;
                outaux := idtop;
                idtop := inaux;
              ELSE GetDmId;
                Error(7);
                inaux := idtop
              END;
              EXIT
            END;
            b1 := id;
            b2 := idtop; (* compare identifiers *)
            LOOP
              IF (spelltab[b1] <> spelltab[b2]) OR (b2 = inaux) THEN
                EXIT
              END;
              INC(b1);
              INC(b2)
            END;
            IF b2 = inaux THEN (* identifier found *)
              inaux := idtop;
              IF id < idbase THEN
                (*--- reserved word ---*)
                sy := VAL( Symbol, ORD(spelltab[b1]) );
              ELSE 
                (*--- old identifier ---*)
                outaux := id;
                spix := htab^[i];
              END;
              EXIT
            END;
            (* hash conflict *)
            i := (i+h) MOD htabmax;
            IF i = 0 THEN
              GetDmId;
              Error(8);
              EXIT
            END;
          END;
        END;
      END EnterId;

      PROCEDURE HashIdent(VAR str: String14);

        VAR
          l: [0..rswlgth];

      BEGIN
        l := 0;
        WHILE (l<rswlgth) AND (str[l]<>0C) DO
          ch := str[l];
          InSpelltab;
          INC(l);
        END;
        EnterId;
      END HashIdent;

      PROCEDURE EnterResWord(str: String14; s: Symbol);

      BEGIN
        HashIdent(str);
        spelltab[idtop] := CHR(ORD(s));
        INC(idtop);
        inaux := idtop;
        idbase := idtop;
      END EnterResWord;

      PROCEDURE TermSpelltab;

      BEGIN
        DISPOSE(htab);
      END TermSpelltab;

      VAR
        ix: Htindex;

    BEGIN (* initialisation *)
      idbase := 0;
      idtop := 0;
      inaux := 0;
      dmid := maxspix;
      hsix := 1;
      NEW(htab);
      FOR ix := 0 TO htabmax DO
        (* $T- *)
        htab^[ix] := Spellix(spellmaxplusone) (* $T= *)
      END;
    END IdentSystem;


    MODULE StringSystem;

      FROM MVCompiler IMPORT maxcard, Stringptr, Constval;
      FROM Storage IMPORT ALLOCATE, DEALLOCATE;
      FROM OutputSystem IMPORT Error;

      EXPORT QUALIFIED PutStrCh, InitString, TermString;

      CONST
        stringmax = 100;

      TYPE
        Bufptr = POINTER TO Stringbuffer;
        Stringbuffer = ARRAY [1 .. stringmax] OF CHAR;

      VAR
        string : Bufptr;
        strcount : CARDINAL;
        ix : CARDINAL;

      PROCEDURE PutStrCh(ch: CHAR);
        (* put character into stringbuffer *)

      BEGIN
        INC(strcount);
        IF strcount > stringmax THEN
          Error(6);
          strcount := stringmax;
        END;
        string^[strcount] := ch;
      END PutStrCh;

      PROCEDURE InitString;
        (* initalisation of string area *)

      BEGIN
        strcount := 0;
        NEW(string);
      END InitString;

      PROCEDURE TermString(VAR length: CARDINAL; VAR val: Constval);

        VAR
          buffp : Bufptr;
          ix : CARDINAL;
          sval : Stringptr;

      BEGIN
        length := strcount;
        PutStrCh(0C);
        IF ODD(strcount) THEN
          PutStrCh(0C)
        END;
        ALLOCATE(buffp,strcount);
        (* array-structure is overlayed to allocated area *)
        FOR ix := 1 TO strcount DO
          buffp^[ix] := string^[ix]
        END;
        DISPOSE(string);
        (* string value entry *)
        NEW(sval);
        WITH sval^ DO
          loadoffset := maxcard; (* initialisation *)
          valentry := CARDINAL(buffp);
          slink := NIL; (* initialisation *)
        END;
        val.svalue := sval;
      END TermString;

    END StringSystem;


    MODULE SymFileInput;

      FROM SYSTEM IMPORT BYTE;
      FROM MVCompiler IMPORT Symbol, Spellix;
      FROM MVCPublic IMPORT Compilerstatus, compstat, symfileextension;
      FROM MVCSFD IMPORT symFileKey, SymFileSymbols;
      FROM FileSystem IMPORT File, ReadByte, ReadWord, Close;
      FROM Terminal IMPORT WriteString, WriteLn;
      FROM FileLookup IMPORT LookupFile;
      FROM FileNames IMPORT FileName;
      FROM Storage IMPORT ALLOCATE;
      FROM OutputSystem IMPORT PutS, StopSave, RestartSave, Error;
      FROM IdentSystem IMPORT InSpelltab, OutSpelltab, EnterId;
      FROM StringSystem IMPORT InitString, PutStrCh, TermString;
      IMPORT sy, val, length, spix, ch;

      EXPORT InitSymFileInput, GetSeparateModule;

      CONST
        maxload = 20; (* maximal number of loaded symbolfiles *)

      VAR
        query : BOOLEAN; (* query for symbolfiles *)
        log : BOOLEAN;
        loadsym : ARRAY [1 .. maxload] OF CARDINAL;
        (* list of symbolfiles already loaded *)
        maxindex, index : CARDINAL;
        symfile: File;

      PROCEDURE ReadSym(VAR b: BYTE);

      BEGIN
        ReadByte(symfile,b);
      END ReadSym;

      PROCEDURE ReadCard(VAR c: CARDINAL);

      BEGIN
        ReadWord(symfile,c);
      END ReadCard;

      PROCEDURE SymGetSy;
        (* get symbol from symfile *)

        CONST
          rwordnum = 1; (* number of words for a real number *)

        VAR
          sym : SymFileSymbols;
          lch : CHAR;
          ix : CARDINAL;
          rconv : RECORD
                    CASE BOOLEAN OF
                      FALSE : ra : ARRAY [1..rwordnum] OF CARDINAL; |
                      TRUE : rc : REAL;
                    END;
                  END;

      BEGIN
        ReadSym(sym);
        (* convert symbols *)
        CASE sym OF
          endfileSS : sy := eop; |
          unitSS : sy := symbolsy; |
          endunitSS : sy := endblock; |
          importSS : sy := importsy; |
          exportSS : sy := qualifiedsy; |
          constSS : sy := constsy; |
          normalconstSS : 
            sy := cardcon;
            ReadCard(val.value); |
          realconstSS : 
            sy := realcon;
            FOR ix := 1 TO rwordnum DO
              ReadCard(rconv.ra[ix]);
            END;
            NEW(val.rvalue);
            val.rvalue^ := rconv.rc; |
          stringconstSS : 
            sy := stringcon;
            InitString;
            ReadSym(lch);
            REPEAT PutStrCh(lch);
              ReadSym(lch)
            UNTIL lch=0c;
            TermString(length,val); |
          typSS : sy := typesy; |
          arraytypSS : sy := arraysy; |
          recordtypSS : sy := recordsy; |
          settypSS : sy := setsy; |
          pointertypSS : sy := pointersy; |
          hiddentypSS : sy := hidden; |
          varSS : sy := varsy; |
          procSS, funcSS : sy := proceduresy; |
          identSS : 
            sy := ident;
            ReadSym(lch);
            WHILE lch <> 0c DO
              ch := lch;
              InSpelltab;
              ReadSym(lch);
            END;
            EnterId; |
          periodSS : sy := period; |
          colonSS : sy := colon; |
          rangeSS : sy := range; |
          lparentSS : sy := lparent; |
          rparentSS : sy := rparent; |
          lbracketSS : sy := lbrack; |
          rbracketSS : sy := rbrack; |
          caseSS : sy := casesy; |
          ofSS : sy := ofsy; |
          elseSS : sy := elsesy; |
          endSS : sy := endsy; |
          foreignSS : sy := foreignsy; |
          refSS : sy := refsy; |
          immedSS : sy := immedsy; |
          descrSS : sy := descrsy; |
          stdescrSS : sy := stdescrsy;
        END; (* CASE *)
      END SymGetSy;

      PROCEDURE SymFileOK(): BOOLEAN;

        VAR
          sym : SymFileSymbols;
          key : CARDINAL;

      BEGIN
        ReadSym(sym);
        IF sym = normalconstSS THEN
          ReadCard(key);
          RETURN key = symFileKey;
        ELSE 
          RETURN FALSE;
        END;
      END SymFileOK;

      PROCEDURE GetSeparateModule;

        CONST
          strmax = 31; (* *** RLA Used to by 24... *** *)

        VAR
          name : ARRAY [0 .. strmax-1] OF CHAR;
          resultname : FileName;
          lastinputspix : Spellix;
          lastinputch : CHAR;
          lastinputsy : Symbol;
          pos : CARDINAL;
          okfile : BOOLEAN;
          exitcond : BOOLEAN;

      BEGIN
        lastinputch := ch;
        lastinputspix := spix;
        lastinputsy := sy;
        (* test on already loaded symbolfile *)
        index := 1;
        WHILE (index <= maxindex) AND (loadsym[index] <> spix) DO
          INC(index);
        END;
        IF index > maxindex THEN (* new symbolfile *)
          IF maxindex < maxload THEN
            INC(maxindex);
            loadsym[maxindex] := spix;
          END;
          pos := 0;
          OutSpelltab;
          WHILE (pos < strmax) AND (ch <> ' ') DO
            name[pos] := ch;
            INC(pos);
            OutSpelltab;
          END;
          IF pos < strmax THEN
            name[pos] := 0C
          END;
          REPEAT
            exitcond := TRUE;
            LookupFile(name,             (* prompt & defaultFilename *)
                       symfileextension, (* more defaults *)
                       query,            (* option *)
                       log,              (* accept default or show *)
                       FALSE,            (* accept options *)
                       symfile,          (* File *)
                       resultname,       (* resultant filename *)
                       okfile);          (* success *)
            IF okfile THEN
              IF SymFileOK() THEN
                SymGetSy;
                SymGetSy;
                SymGetSy;
                IF (sy = ident) AND (spix = lastinputspix) THEN (* copy file *)
                  StopSave;
                  SymGetSy;
                  WHILE sy <> eop DO
                    PutS;
                    SymGetSy
                  END;
                  RestartSave;
                ELSE 
                  WriteString("  ---- incorrect module name");
                  WriteLn;
                  IF query THEN
                    exitcond := FALSE;
                  ELSE INCL(compstat,symerrs);
                  END;
                END;
              ELSE 
                WriteString("  ---- wrong symbol file: ");
                WriteString(resultname);
                WriteLn;
                IF query THEN
                  exitcond := FALSE;
                ELSE INCL(compstat,symerrs);
                END;
              END;
              Close(symfile);
            ELSE 
              INCL(compstat,symerrs); (*symbolfiles incomplete*)
            END;
          UNTIL exitcond;
        END;
        ch := lastinputch;
        sy := lastinputsy;
        spix := lastinputspix;
      END GetSeparateModule;

      PROCEDURE InitSymFileInput;

      BEGIN
        maxindex := 0; (* no symbolfile loaded *)
        query := querys IN compstat;
        log := query OR (logs IN compstat);
      END InitSymFileInput;

    END SymFileInput;


    MODULE Scanner;

      FROM MVCompiler IMPORT maxcard, maxint, maxchar, Symbol; 
      FROM MVCPublic IMPORT modFile, Compilerstatus, compstat;
      FROM MVCR1 IMPORT InitRealConst, ConvertToFraction, ConvertToExponent,
                        TermRealConst;
      FROM FileSystem IMPORT EOL, ReadChar, Eof;
      FROM Storage IMPORT ALLOCATE, DEALLOCATE;
      FROM OutputSystem IMPORT PutS, PutSyVal, Error;
      FROM IdentSystem IMPORT InSpelltab, EnterId;
      FROM StringSystem IMPORT InitString, PutStrCh, TermString;
      IMPORT sy, val, length, spix, ch, line, pos;

      EXPORT GetSy, InitInput, TermInput;

      TYPE
        Optptr = POINTER TO Opt;
        Opt = RECORD
                next: Optptr;
                s: Symbol
              END;

      CONST
        tabch = 11C; (* horizontal tab, tab stops assumed every 8 character *)
        rangeCh = 35C; (* means same as ".." *)
        eofch = 36C; (* character indicating end of file *)
        eolch = 37C; (* character indicating end of line *)
        zero = 60B; (* ORD('0') *)

      VAR
        optroot: ARRAY ['A'..'Z'] OF Optptr;
        cch, sch, och: CHAR;
        mustread : BOOLEAN;

      PROCEDURE NextCh;

      BEGIN
        IF mustread THEN
          ReadChar(modFile,ch);
          INC(pos);
        ELSE 
          ch := 0C;
        END;
        IF ch < 40C THEN
          IF ch = EOL THEN
            ch := eolch;
          ELSIF Eof(modFile) THEN
            ch := eofch;
            mustread := FALSE;
          ELSIF ch <> tabch THEN
            ch := ' ';
          END;
        END;
      END NextCh;

      PROCEDURE Comment;

        VAR
          clevel : CARDINAL;

        PROCEDURE Options;

          VAR
            op : Optptr;

        BEGIN
          LOOP
            WHILE ch = ' ' DO
                 NextCh
            END;
            IF ch<>'$' THEN
              EXIT
            END;
            NextCh;
            cch := CAP(ch);
            IF (cch<'A') OR ('Z'<cch) THEN
              EXIT
            END;
            NextCh;
            IF (ch = '+') OR (ch = '-') OR (ch = '=') THEN
              IF ch = '=' THEN
                IF optroot[cch] <> NIL THEN
                  op := optroot[cch];
                  optroot[cch] := optroot[cch]^.next;
                  DISPOSE(op)
                END;
                IF optroot[cch] = NIL THEN
                  sy := plus;
                ELSE sy := optroot[cch]^.s;
                END;
              ELSE 
                IF ch='+' THEN
                  sy := plus
                ELSE sy := minus
                END;
                NEW(op);
                WITH op^ DO
                  next := optroot[cch];
                  optroot[cch]:=op;
                  s := sy;
                END;
              END;
              PutSyVal(option, ORD(cch));
              PutS;
              NextCh;
            END;
            sy := eol; (* dummy symbol *)
            WHILE ch = ' ' DO
              NextCh
            END;
            IF ch<>',' THEN
              EXIT
            ELSE NextCh
            END
          END; (* LOOP *)
        END Options;

      BEGIN
        clevel := 1;
        Options;
        WHILE (clevel > 0) AND (ch <> eofch) DO
          och := ch;
          NextCh;
          IF (och='*') AND (ch=')') THEN
            DEC(clevel);
            NextCh;
          ELSIF (och='(') AND (ch='*') THEN
            INC(clevel);
            NextCh;
          ELSIF och=eolch THEN
            INC(line);
            pos := 0;
            PutS; (*sy=eol*)
          END;
        END;
        IF clevel > 0 THEN
          pos := 1;
          Error(3)
        END;
      END Comment;

      PROCEDURE GetSy;

        CONST
          dtest = maxcard DIV 10;
          otest = maxcard DIV 10B;
          htest = maxcard DIV 10H;
          drest = maxcard MOD 10;

        VAR
          i,
          dval, oval, hval: CARDINAL;
          dok, ook, hok, rok: BOOLEAN;

      BEGIN
        sy := eol; (* eol is never returned from GetSy *)
        REPEAT och := ch;
          NextCh;
          CASE och OF
            eofch: sy := eop |
            eolch: INC(line);
              pos := 0;
              PutS |
            tabch: pos := (pos+7) DIV 8 * 8; |
            ' ' : WHILE ch = ' ' DO
                    NextCh
                  END |
            'A'..'Z','a'..'z','_': (* identifier or reserved word *)
              cch := ch;
              ch := och;
              InSpelltab;
              ch := cch;
              cch := CAP(ch);
              WHILE ('A'<=cch) AND (cch<='Z') OR ('0'<=ch) AND (ch<='9')
                    OR ('$'=ch) OR ('_'=ch) DO
                InSpelltab;
                NextCh;
                cch := CAP(ch)
              END;
              EnterId |
            '%':
              cch := ch;
              ch := och;
              InSpelltab;
              ch := cch;
              cch := CAP(ch);
              WHILE ('A'<=cch) AND (cch<='Z') DO
                InSpelltab;
                NextCh;
                cch := CAP(ch);
              END;
              EnterId;
              IF sy = ident THEN
                Error(1);
              END; |
            '0'..'9': (* constant *)
              InitRealConst;
              dval := ORD(och) - zero;
              dok := TRUE;
              oval := dval;
              ook := dval < 8;
              hval := dval;
              hok := TRUE;
              ConvertToFraction(och);
              rok := TRUE;
              och := ' '; (* for test on octal numbers or characters *)
              cch := CAP(ch);
              WHILE ('0'<=ch) AND (ch<='9') OR ('A'<=cch) AND (cch<='F') DO
                IF ch <= '9' THEN (* digits *)
                  i := ORD(ch) - ORD('0');
                  IF och <> ' ' THEN
                    och := 'H'
                  END;
                ELSE (* letters 'A' to 'F' *)
                  i := ORD(cch) - ORD('A') + 10;
                  IF (och = ' ') AND ook THEN
                    och := cch
                  ELSE och := 'H'
                  END;
                END;
                dok := dok AND ((dval<=dtest) AND (i<10) OR (dval=dtest) AND
                                (i<=drest));
                ook := ook AND (oval <= otest) AND (i < 8);
                hok := hok AND (hval <= htest);
                rok := rok AND (i < 10);
                IF dok THEN
                  dval := 10 * dval + i
                END;
                IF ook THEN
                  oval := 10B * oval + i
                END;
                IF hok THEN
                  hval := 10H * hval + i
                END;
                IF rok THEN
                  ConvertToFraction(ch)
                END;
                NextCh;
                cch := CAP(ch);
              END;
              sy := intcarcon;
              IF cch = 'H' THEN (* hexadecimal number *)
                NextCh;
                dval := hval;
                dok := hok;
              ELSIF och = 'B' THEN (* octal constant *)
                dval := oval;
                dok := TRUE;
              ELSIF och = 'C' THEN (* character constant *)
                sy := charcon;
                dval := oval;
                dok := oval <= maxchar; 
              ELSIF ch = '.' THEN
                NextCh;
                IF ch = '.' THEN
                  ch := rangeCh;
                ELSE (* real number *)
                  ConvertToFraction('.');
                  sy := realcon;
                  WHILE ('0' <= ch) AND (ch <='9') DO
                    IF rok THEN
                      ConvertToFraction(ch)
                    END;
                    NextCh;
                  END;
                  IF CAP(ch) = 'E' THEN
                    NextCh;
                    IF (ch = '-') OR (ch = '+') THEN
                      IF ch = '-' THEN
                        ConvertToExponent(ch)
                      END;
                      NextCh;
                    END;
                    IF ('0' <= ch) AND (ch <= '9') THEN
                      REPEAT
                        IF rok THEN
                          ConvertToExponent(ch)
                        END;
                        NextCh;
                      UNTIL (ch < '0') OR ('9' < ch);
                    ELSE rok := FALSE;
                    END;
                  END;
                END;
              END;
              IF sy = realcon THEN
                IF rok THEN
                  TermRealConst(val,rok);
                  rok := NOT rok; (* inverse error flag *)
                ELSE val.rvalue := NIL;
                END;
                IF NOT rok THEN
                  Error(2)
                END;
              ELSIF dok THEN
                IF (sy = intcarcon) AND (dval > maxint) THEN
                  sy := cardcon;
                END;
                val.value := dval;
              ELSE 
                val.value := 0;
                Error(2);
              END |
            ':' : IF ch = '=' THEN
                    NextCh;
                    sy := becomes
                  ELSE sy := colon
                  END |
            '<' : IF ch = '=' THEN
                    NextCh;
                    sy := leq
                  ELSIF ch='>' THEN
                    NextCh;
                    sy := neq
                  ELSE sy := lss
                  END |
            '>' : IF ch='=' THEN
                    NextCh;
                    sy := geq
                  ELSE sy := grt
                  END |
            '"',"'": 
              i := 0;
              sy := stringcon;
              LOOP
                IF ch<' ' THEN
                  Error(4);
                  EXIT
                END;
                IF ch=och THEN
                  NextCh;
                  EXIT
                END;
                INC(i);
                IF i = 1 THEN
                  sch := ch
                ELSE 
                  IF i = 2 THEN
                    InitString;
                    PutStrCh(sch)
                  END;
                  PutStrCh(ch);
                END;
                NextCh
              END;
              IF i = 1 THEN
                sy := charcon;
                val.value := ORD(sch)
              ELSE 
                IF i = 0 THEN (* empty string *)
                  InitString;
                  PutStrCh(0C);
                END;
                TermString(length,val);
              END |
            rangeCh : sy := range |
            '.' : IF ch='.' THEN
                    NextCh;
                    sy := range
                  ELSE sy := period
                  END |
            '(' : IF ch='*' THEN
                    NextCh;
                    Comment
                  ELSE sy := lparent
                  END |
            '*' : sy := times |
            '/' : sy := slash |
            '+' : sy := plus |
            '-' : sy := minus |
            '=' : sy := eql |
            ')' : sy := rparent |
            ',' : sy := comma |
            ';' : sy := semicolon |
            '[' : sy := lbrack |
            ']' : sy := rbrack |
            '^' : sy := arrow |
            '|' : sy := variant |
            '#' : sy := neq |
            '&' : sy := andsy |
            '{' : sy := lconbr |
            '}' : sy := rconbr
          ELSE Error(0)
          END;
        UNTIL sy<>eol;
      END GetSy;

      PROCEDURE InitInput;

        VAR
          ch : CHAR;

      BEGIN
        line := 1;
        pos := 0;
        mustread := NOT Eof(modFile); 
        FOR ch := 'A' TO 'Z' DO
          optroot[ch] := NIL
        END;
        PutSyVal(eol,1);
        NextCh;
      END InitInput;

      PROCEDURE TermInput;

        VAR
          ch : CHAR;
          op : Optptr;

      BEGIN
        FOR ch := 'A' TO 'Z' DO
          WHILE optroot[ch] <> NIL DO
            op := optroot[ch];
            optroot[ch] := optroot[ch]^.next;
            DISPOSE(op);
          END;
        END;
      END TermInput;

    END Scanner;

  PROCEDURE InitInOut;

  BEGIN
    InitOutput;
    InitInput;
    InitSymFileInput;
  END InitInOut;

  PROCEDURE TermInOut;

  BEGIN
    TermInput;
    TermOutput;
    TermSpelltab;
  END TermInOut;

END MVCIO1.