(****************************************
*                                       *
*     MODULA-2 Multi-Pass Compiler      *
*     ****************************      *
*                                       *
*     Implementation for Lilith         *
*                                       *
*                                       *
*     MCP1IO:                           *
*                                       * 
*     input / output handling in Pass 1 *
*                                       * 
*     Version C18 of 28.08.81           *
*                                       *
*     Institut fuer Informatik          *
*     ETH-Zuerich                       *
*     CH-8092 Zuerich                   *
*                                       *
****************************************)

IMPLEMENTATION MODULE MCP1IO;      (* LG *)
  (* $T- *)

  IMPORT
    MCImpl, NewStreams, WriteStrings, Storage,
    MCBase, MCPublic, MCP1Reals,
    P1IOOut, P1IOId,  P1IOStr, P1IOSym;

  FROM MCBase IMPORT Symbol, Spellix;
  FROM MCP1IOPV IMPORT line, pos, ch;
  FROM P1IOId IMPORT TermIdTab;

  (* MODULE OutputSystem; - now in P1IOOut *)

    PROCEDURE PutS;
    BEGIN P1IOOut.PutS;
    END PutS;

    PROCEDURE PutSy(sy: Symbol);
    BEGIN P1IOOut.PutSy(sy);
    END PutSy;

    PROCEDURE PutSyVal(sy: Symbol; val: CARDINAL);
    BEGIN P1IOOut.PutSyVal(sy, val);
    END PutSyVal;

    PROCEDURE PutIdent(spix: Spellix);
    BEGIN P1IOOut.PutIdent(spix);
    END PutIdent;

    PROCEDURE Error(n: CARDINAL);
    BEGIN P1IOOut.Error(n);
    END Error;

    PROCEDURE InitSave;
    BEGIN P1IOOut.InitSave;
    END InitSave;

    PROCEDURE StopSave;
    BEGIN P1IOOut.StopSave;
    END StopSave;

    PROCEDURE RestartSave;
    BEGIN P1IOOut.RestartSave;
    END RestartSave;

    PROCEDURE ReleaseSys;
    BEGIN P1IOOut.ReleaseSys;
    END ReleaseSys;

    PROCEDURE InitOutput;
    BEGIN P1IOOut.InitOutput;
    END InitOutput;

    PROCEDURE TermOutput;
    BEGIN P1IOOut.TermOutput;
    END TermOutput;

  (* END OutputSystem; *)


  (* MODULE IdentSystem; - now in P1IOId *)

  PROCEDURE GetDmId;
  BEGIN P1IOId.GetDmId;
  END GetDmId;

  PROCEDURE HashIdent(VAR str: String14);
  BEGIN P1IOId.HashIdent(str);
  END HashIdent;

  PROCEDURE EnterResWord(str: String14; sy: Symbol);
  BEGIN P1IOId.EnterResWord(str, sy);
  END EnterResWord;

  (* END IdentSystem; *)


  (* MODULE StringSystem; - now in P1IOStr *)
  (* END StringSystem; *)  

  (* MODULE SymFileInput; - now in P1IOSym *)

  PROCEDURE GetSeparateModule;
  BEGIN P1IOSym.GetSeparateModule;
  END GetSeparateModule;

  (* END SymFileInput; *)

  MODULE Scanner;

    FROM MCImpl IMPORT MaxInt, MinInt, MaxCard;
    FROM NewStreams IMPORT
      STREAM, eolc, Connect, Reset, ReadChar, EOS, Disconnect;
    FROM Storage IMPORT ALLOCATE, DEALLOCATE;
    FROM MCBase IMPORT Symbol;
    FROM MCPublic IMPORT modFile;
    FROM MCP1Reals IMPORT
      InitRealConst, ConvertToFraction, ConvertToExponent,
      TermRealConst;
    FROM P1IOOut IMPORT PutS, PutSyVal, Error;
    FROM P1IOId IMPORT InIdTab, EnterId;
    FROM P1IOStr 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 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;
        dval, oval, hval: CARDINAL;
        dok, ook, hok, rok: BOOLEAN;
        input : STREAM;
        mustread : BOOLEAN;
        safecard, safeoct, safehex, lastcarddigit: CARDINAL;

    PROCEDURE NextCh;
    BEGIN
      IF mustread THEN
        ReadChar(input,ch);
        INC(pos);
      ELSE
        ch := 0C;
      END;
      IF ch < 40C THEN
        IF ch = eolc THEN ch := eolch;
        ELSIF ch = 0C THEN ch := eofch; mustread := FALSE;
        ELSE 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;
      VAR   i: CARDINAL;
      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 |
            ' ' : WHILE ch = ' ' DO NextCh END | 
            'A'..'Z','a'..'z': (* identifier or reserved word *)
                  cch := ch; ch := och; InIdTab; ch := cch; cch := CAP(ch);
                  WHILE ('A'<=cch) AND (cch<='Z') OR ('0'<=ch) AND (ch<='9') DO 
                    InIdTab; NextCh; cch := CAP(ch) END;
                  EnterId |
            '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<safecard) AND (i<10) OR 
                           (dval=safecard) AND (i<=lastcarddigit));
                    ook := ook AND (oval < safeoct) AND (i < 8);
                    hok := hok AND (hval < safehex);
                    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 < 200B;
                  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>CARDINAL(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
      Connect(input,modFile,FALSE); Reset(input);
      line := 1; pos := 0;
      mustread := TRUE;
      lastcarddigit := MaxCard MOD 10;
      safecard := MaxCard DIV 10;
      safeoct := CARDINAL(MinInt) DIV 4;
      safehex := CARDINAL(MinInt) DIV 8;
      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;
      Disconnect(input,FALSE);
    END TermInput;

  END Scanner;

  PROCEDURE InitInOut;
  BEGIN
    InitOutput;
    InitInput;
  END InitInOut;

  PROCEDURE TermInOut;
  BEGIN
    TermInput;
    TermOutput;
    TermIdTab;
  END TermInOut;

END MCP1IO.