CocoR/Test2/SimpleQP.mod

IMPLEMENTATION MODULE SimpleQP;

(* Parser generated by Coco/R - assuming ISO IO library will be available. *)

IMPORT SimpleQS, FileIO;

IMPORT SymTab, QbeGen;



CONST 
  maxT = 66;
  minErrDist  =  2;  (* minimal distance (good tokens) between two errors *)
  setsize     = 16;  (* sets are stored in 16 bits *)

TYPE
  SymbolSet = ARRAY [0 .. maxT DIV setsize] OF BITSET;

VAR
  symSet:  ARRAY [0 ..   4] OF SymbolSet; (*symSet[0] = allSyncSyms*)
  errDist: CARDINAL;   (* number of symbols recognized since last error *)
  sym:     CARDINAL;   (* current input symbol *)

PROCEDURE SemError (errNo: INTEGER);
  BEGIN
    IF errDist >= minErrDist THEN
      SimpleQS.Error(errNo, SimpleQS.line, SimpleQS.col, SimpleQS.pos);
    END;
    errDist := 0;
  END SemError;

PROCEDURE SynError (errNo: INTEGER);
  BEGIN
    IF errDist >= minErrDist THEN
      SimpleQS.Error(errNo, SimpleQS.nextLine, SimpleQS.nextCol, SimpleQS.nextPos);
    END;
    errDist := 0;
  END SynError;

PROCEDURE Get;
  VAR
    s: ARRAY [0 .. 31] OF CHAR;
  BEGIN
    REPEAT
      SimpleQS.Get(sym);
      IF sym <= maxT THEN
        INC(errDist);
      ELSE
        
      END;
    UNTIL sym <= maxT
  END Get;

PROCEDURE In (VAR s: SymbolSet; x: CARDINAL): BOOLEAN;
  BEGIN
    RETURN x MOD setsize IN s[x DIV setsize];
  END In;

PROCEDURE Expect (n: CARDINAL);
  BEGIN
    IF sym = n THEN Get ELSE SynError(n) END
  END Expect;

PROCEDURE ExpectWeak (n, follow: CARDINAL);
  BEGIN
    IF sym = n
      THEN Get
      ELSE SynError(n); WHILE ~ In(symSet[follow], sym) DO Get END
    END
  END ExpectWeak;

PROCEDURE WeakSeparator (n, syFol, repFol: CARDINAL): BOOLEAN;
  VAR
    s: SymbolSet;
    i: CARDINAL;
  BEGIN
    IF sym = n
      THEN Get; RETURN TRUE
      ELSIF In(symSet[repFol], sym) THEN RETURN FALSE
      ELSE
        i := 0;
        WHILE i <= maxT DIV setsize DO
          s[i] := symSet[0, i] + symSet[syFol, i] + symSet[repFol, i]; INC(i)
        END;
        SynError(n); WHILE ~ In(s, sym) DO Get END;
        RETURN In(symSet[syFol], sym)
    END
  END WeakSeparator;

PROCEDURE LexName (VAR Lex: ARRAY OF CHAR);
  BEGIN
    SimpleQS.GetName(SimpleQS.pos, SimpleQS.len, Lex)
  END LexName;

PROCEDURE LexString (VAR Lex: ARRAY OF CHAR);
  BEGIN
    SimpleQS.GetString(SimpleQS.pos, SimpleQS.len, Lex)
  END LexString;

PROCEDURE LookAheadName (VAR Lex: ARRAY OF CHAR);
  BEGIN
    SimpleQS.GetName(SimpleQS.nextPos, SimpleQS.nextLen, Lex)
  END LookAheadName;

PROCEDURE LookAheadString (VAR Lex: ARRAY OF CHAR);
  BEGIN
    SimpleQS.GetString(SimpleQS.nextPos, SimpleQS.nextLen, Lex)
  END LookAheadString;

PROCEDURE Successful (): BOOLEAN;
  BEGIN
    RETURN SimpleQS.errors = 0
  END Successful;

(* ----- FORWARD not needed in multipass compilers

PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
PROCEDURE SetLit (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE MulOp (VAR op: INTEGER); FORWARD;
PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
PROCEDURE AddOp (VAR op: INTEGER); FORWARD;
PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
PROCEDURE Rel (VAR op: INTEGER); FORWARD;
PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
PROCEDURE Labels (sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal); FORWARD;
PROCEDURE LabelList (sel: SymTab.TypeIndex; sq: QbeGen.QVal;
                      VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal); FORWARD;
PROCEDURE Case (sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal); FORWARD;
PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                   VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN); FORWARD;
PROCEDURE WithStat; FORWARD;
PROCEDURE ForStat; FORWARD;
PROCEDURE LoopStat; FORWARD;
PROCEDURE RepeatStat; FORWARD;
PROCEDURE WhileStat; FORWARD;
PROCEDURE CaseStat; FORWARD;
PROCEDURE IfStat; FORWARD;
PROCEDURE Assign; FORWARD;
PROCEDURE Stat; FORWARD;
PROCEDURE FieldIdents (rt: SymTab.TypeIndex); FORWARD;
PROCEDURE Field (rt: SymTab.TypeIndex); FORWARD;
PROCEDURE FieldSeq (rt: SymTab.TypeIndex); FORWARD;
PROCEDURE Enum (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE PointerType (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE SetType (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE RecordType (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE ArrayType (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE SimpleType (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE QualIdent (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE VarIdents; FORWARD;
PROCEDURE Type (VAR t: SymTab.TypeIndex); FORWARD;
PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal); FORWARD;
PROCEDURE VarDecl; FORWARD;
PROCEDURE TypeDecl; FORWARD;
PROCEDURE ConstDecl; FORWARD;
PROCEDURE StatSeq; FORWARD;
PROCEDURE Declaration; FORWARD;
PROCEDURE ImportList; FORWARD;
PROCEDURE Block; FORWARD;
PROCEDURE Import; FORWARD;
PROCEDURE GetIdent (VAR n: SymTab.Name); FORWARD;
PROCEDURE SimpleQ; FORWARD;

----- *)

PROCEDURE Elem (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  VAR t2: SymTab.TypeIndex;
    q2: QbeGen.QVal;
  BEGIN
    Expr(t, q);
    IF (sym = 19) THEN
      Get;
      Expr(t2, q2);
      IF ~SymTab.SetElemCheck(t, t2) THEN
      SemError(222) END;;
    END;
  END Elem;

PROCEDURE SetLit (VAR t: SymTab.TypeIndex);
  VAR first, et: SymTab.TypeIndex;
    qe: QbeGen.QVal;
  BEGIN
    Expect(64);
    t := SymTab.SetFor(SymTab.IntType());;
    IF In(symSet[1], sym) THEN
      Elem(et, qe);
      first := et; t := SymTab.SetFor(et);;
      WHILE (sym = 10) DO
        Get;
        Elem(et, qe);
        IF ~SymTab.SetElemCheck(first, et) THEN
        SemError(222) END;;
      END;
    END;
    Expect(65);
  END SetLit;

PROCEDURE MulOp (VAR op: INTEGER);
  BEGIN
    CASE sym OF
      56 :
        Get;
        op := SymTab.OpTimes;;
    | 57 :
        Get;
        op := SymTab.OpSlash;;
    | 58 :
        Get;
        op := SymTab.OpDiv;;
    | 59 :
        Get;
        op := SymTab.OpMod;;
    | 60 :
        Get;
        op := SymTab.OpAnd;;
    | 61 :
        Get;
        op := SymTab.OpAnd;;
    ELSE SynError(67);
    END;
  END MulOp;

PROCEDURE Fact (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  VAR s: ARRAY [0 .. 255] OF CHAR;
    t2, et, dt, st: SymTab.TypeIndex;
    dk: INTEGER;
    qd, q2: QbeGen.QVal;
    qnF: SymTab.Name;
    sfxF: BOOLEAN;
  BEGIN
    CASE sym OF
      2 :
        Get;
        LexString(s);
        QbeGen.NormInt(s, q);
        t := SymTab.IntType();;
    | 3 :
        Get;
        LexString(s);
        QbeGen.NormReal(s, q);
        t := SymTab.RealType();;
    | 4 :
        Get;
        LexString(s);
        IF SymTab.StrLen(s) <= 3 THEN
          t := SymTab.CharType();
          QbeGen.IntStr(
            QbeGen.CharVal(s), q)
        ELSE t := SymTab.NewStr();
          SemError(230);
          QbeGen.CopyOp("0", q)
        END;;
    | 1 :
        Design(dt, dk, qd, qnF, sfxF);
        t := dt;
        QbeGen.CopyOp(qd, q);;
    | 21 :
        Get;
        Expr(et, q);
        Expect(22);
        t := et;;
    | 62, 63 :
        IF (sym = 62) THEN
          Get;
        ELSE
          Get;
        END;
        Fact(t2, q2);
        IF SymTab.BoolCheck(t2) THEN
          t := SymTab.BoolType()
        ELSE SemError(212);
          t := SymTab.InvalidType END;
        IF t # SymTab.InvalidType THEN
          QbeGen.NotQ(q2, q)
        ELSE QbeGen.CopyOp("0", q)
        END;;
    | 64 :
        SetLit(st);
        t := st;
        SemError(230);
        QbeGen.CopyOp("0", q);;
    ELSE SynError(68);
    END;
  END Fact;

PROCEDURE AddOp (VAR op: INTEGER);
  BEGIN
    IF (sym = 53) THEN
      Get;
      op := SymTab.OpAdd;;
    ELSIF (sym = 54) THEN
      Get;
      op := SymTab.OpSub;;
    ELSIF (sym = 55) THEN
      Get;
      op := SymTab.OpOr;;
    ELSE SynError(69);
    END;
  END AddOp;

PROCEDURE Term (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  VAR t2, res2: SymTab.TypeIndex;
    op: INTEGER;
    q2, qt: QbeGen.QVal;
    isR: BOOLEAN;
  BEGIN
    Fact(t, q);
    WHILE In(symSet[2], sym) DO
      MulOp(op);
      Fact(t2, q2);
      IF op = SymTab.OpAnd THEN
        IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
          t := SymTab.BoolType()
        ELSE SemError(212); t := SymTab.InvalidType END;
        IF t # SymTab.InvalidType THEN
          QbeGen.NewTemp(qt);
          QbeGen.Op3("and", qt, q, q2, FALSE);
          QbeGen.CopyOp(qt, q)
        ELSE QbeGen.CopyOp("0", q)
        END
      ELSE
        IF SymTab.ArithCheck(t, t2,
             (op = SymTab.OpDiv) OR (op = SymTab.OpMod),
             res2) THEN t := res2
        ELSE SemError(211); t := SymTab.InvalidType END;
        IF t # SymTab.InvalidType THEN
          isR := SymTab.ClassOf(t) = SymTab.ClReal;
          QbeGen.NewTemp(qt);
          IF op = SymTab.OpTimes THEN
            QbeGen.Op3("mul", qt, q, q2, isR)
          ELSIF op = SymTab.OpSlash THEN
            QbeGen.Op3("div", qt, q, q2, isR)
          ELSIF op = SymTab.OpDiv THEN
            QbeGen.Op3("div", qt, q, q2, FALSE)
          ELSE
            QbeGen.Op3("rem", qt, q, q2, FALSE)
          END;
          QbeGen.CopyOp(qt, q)
        ELSE QbeGen.CopyOp("0", q)
        END
      END;;
    END;
  END Term;

PROCEDURE Rel (VAR op: INTEGER);
  BEGIN
    CASE sym OF
      16 :
        Get;
        op := SymTab.OpEq;;
    | 46 :
        Get;
        op := SymTab.OpNeq1;;
    | 47 :
        Get;
        op := SymTab.OpNeq2;;
    | 48 :
        Get;
        op := SymTab.OpLt;;
    | 49 :
        Get;
        op := SymTab.OpLe;;
    | 50 :
        Get;
        op := SymTab.OpGt;;
    | 51 :
        Get;
        op := SymTab.OpGe;;
    | 52 :
        Get;
        op := SymTab.OpIn;;
    ELSE SynError(70);
    END;
  END Rel;

PROCEDURE SimExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  VAR t2, res2: SymTab.TypeIndex;
    op: INTEGER;
    q2, qt: QbeGen.QVal;
    neg, isR: BOOLEAN;
  BEGIN
    neg := FALSE;;
    IF (sym = 53) OR (sym = 54) THEN
      IF (sym = 53) THEN
        Get;
      ELSE
        Get;
        neg := TRUE;;
      END;
    END;
    Term(t, q);
    IF neg THEN
    IF QbeGen.IsImm(q) THEN
      QbeGen.NegFold(q, q)
    ELSE QbeGen.NewTemp(qt);
      QbeGen.NegQ(q, qt,
        SymTab.ClassOf(t)
        = SymTab.ClReal);
      QbeGen.CopyOp(qt, q)
    END
    END;;
    WHILE (sym = 53) OR (sym = 54) OR (sym = 55) DO
      AddOp(op);
      Term(t2, q2);
      IF op = SymTab.OpOr THEN
        IF SymTab.BoolCheck(t) & SymTab.BoolCheck(t2) THEN
          t := SymTab.BoolType()
        ELSE SemError(212); t := SymTab.InvalidType END;
        IF t # SymTab.InvalidType THEN
          QbeGen.NewTemp(qt);
          QbeGen.Op3("or", qt, q, q2, FALSE);
          QbeGen.CopyOp(qt, q)
        ELSE QbeGen.CopyOp("0", q)
        END
      ELSE
        IF SymTab.ArithCheck(t, t2, FALSE, res2) THEN t := res2
        ELSE SemError(211); t := SymTab.InvalidType END;
        IF t # SymTab.InvalidType THEN
          isR := SymTab.ClassOf(t) = SymTab.ClReal;
          QbeGen.NewTemp(qt);
          IF op = SymTab.OpAdd THEN
            QbeGen.Op3("add", qt, q, q2, isR)
          ELSE
            QbeGen.Op3("sub", qt, q, q2, isR)
          END;
          QbeGen.CopyOp(qt, q)
        ELSE QbeGen.CopyOp("0", q)
        END
      END;;
    END;
  END SimExpr;

PROCEDURE Labels (sel: SymTab.TypeIndex; sq: QbeGen.QVal; lB: QbeGen.QVal);
  VAR t, t2: SymTab.TypeIndex;
    q, q2, qk, qg, ql, qb: QbeGen.QVal;
    lC: QbeGen.QVal;
    r, hasRange: BOOLEAN;
  BEGIN
    ConstExpr(t, q);
    IF ~SymTab.EqCheck(t, sel) THEN
    SemError(213) END;
    r := (SymTab.ClassOf(sel)
          = SymTab.ClReal)
         & (SymTab.ClassOf(t)
            = SymTab.ClReal);
    hasRange := FALSE;;
    IF (sym = 19) THEN
      Get;
      ConstExpr(t2, q2);
      IF ~SymTab.EqCheck(t2, sel) THEN
      SemError(213) END;
      hasRange := TRUE;;
    END;
    IF hasRange THEN
      QbeGen.Cmp(SymTab.OpGe,
        sq, q, qg, r);
      QbeGen.Cmp(SymTab.OpLe,
        sq, q2, ql, r);
      QbeGen.NewTemp(qb);
      QbeGen.Op3("and", qb, qg, ql,
        FALSE)
    ELSE
      QbeGen.Cmp(SymTab.OpEq,
        sq, q, qb, r)
    END;
    QbeGen.NewLabel(lC);
    QbeGen.Jnz(qb, lB, lC);
    QbeGen.EmitLabel(lC);;
  END Labels;

PROCEDURE LabelList (sel: SymTab.TypeIndex; sq: QbeGen.QVal;
                      VAR lB: QbeGen.QVal; VAR lN: QbeGen.QVal);
  BEGIN
    QbeGen.NewLabel(lB);
    QbeGen.NewLabel(lN);;
    Labels(sel, sq, lB);
    WHILE (sym = 10) DO
      Get;
      Labels(sel, sq, lB);
    END;
    QbeGen.Jmp(lN);;
  END LabelList;

PROCEDURE Case (sel: SymTab.TypeIndex; sq: QbeGen.QVal; endL: QbeGen.QVal);
  VAR lB, lN: QbeGen.QVal;
  BEGIN
    IF In(symSet[1], sym) THEN
      LabelList(sel, sq, lB, lN);
      Expect(17);
      QbeGen.EmitLabel(lB);;
      StatSeq;
      QbeGen.Jmp(endL);
      QbeGen.EmitLabel(lN);;
    END;
  END Case;

PROCEDURE Design (VAR t: SymTab.TypeIndex; VAR k: INTEGER;
                   VAR q: QbeGen.QVal; VAR qn: SymTab.Name; VAR sfx: BOOLEAN);
  VAR n, m: SymTab.Name;
    it: SymTab.TypeIndex;
    qr: QbeGen.QVal;
    cls: INTEGER;
  BEGIN
    GetIdent(n);
    QbeGen.CopyOp(n, qn);
    sfx := FALSE;
    IF ~SymTab.Lookup(n) THEN
      SemError(201);
      t := SymTab.InvalidType; k := -1;
      QbeGen.CopyOp("0", q)
    ELSE
      t := SymTab.SymType(n);
      k := SymTab.SymKind(n);
      IF k = SymTab.KindConst THEN
        IF SymTab.Equal(n, "TRUE") THEN
          t := SymTab.BoolType();
          QbeGen.CopyOp("1", q)
        ELSIF SymTab.Equal(n,
                "FALSE") THEN
          t := SymTab.BoolType();
          QbeGen.CopyOp("0", q)
        ELSE
          cls :=
            SymTab.ClassOf(t);
          IF (t #
              SymTab.InvalidType)
             & (cls # SymTab.ClStr)
             & ((cls = SymTab.ClInt)
             OR (cls = SymTab.ClReal)
             OR (cls = SymTab.ClBool)
             OR (cls = SymTab.ClChar)
             OR (cls
                 = SymTab.ClEnum)) THEN
            QbeGen.LoadVar(n,
              cls = SymTab.ClReal, q)
          ELSE
            QbeGen.CopyOp("0", q)
          END
        END
      ELSIF k = SymTab.KindVar THEN
        cls := SymTab.ClassOf(t);
        IF (cls = SymTab.ClInt)
           OR (cls = SymTab.ClReal)
           OR (cls = SymTab.ClBool)
           OR (cls = SymTab.ClChar)
           OR (cls
               = SymTab.ClEnum) THEN
          QbeGen.LoadVar(n,
            cls = SymTab.ClReal, q)
        ELSE SemError(230);
          QbeGen.CopyOp("0", q)
        END
      ELSE QbeGen.CopyOp("0", q);
        IF k = SymTab.KindField THEN
          IF ~QbeGen.NoQbe() THEN
            SemError(230)
          END
        ELSIF k
              = SymTab.KindImport THEN
          SemError(230)
        END
      END
    END;;
    WHILE (sym = 7) OR (sym = 18) OR (sym = 45) DO
      IF (sym = 7) THEN
        Get;
        sfx := TRUE;;
        GetIdent(m);
        IF t = SymTab.InvalidType THEN
        ELSIF SymTab.ClassOf(t) #
              SymTab.ClRecord THEN
          SemError(215);
          t := SymTab.InvalidType
        ELSIF ~SymTab.FieldExists(t, m) THEN
          SemError(216);
          t := SymTab.InvalidType
        ELSE t := SymTab.FieldType(t, m);
          SemError(230)
        END;
        QbeGen.CopyOp("0", q);;
      ELSIF (sym = 18) THEN
        Get;
        sfx := TRUE;;
        Expr(it, qr);
        IF t = SymTab.InvalidType THEN
        ELSIF SymTab.ClassOf(t) #
              SymTab.ClArray THEN
          SemError(217);
          t := SymTab.InvalidType
        ELSIF (it #
               SymTab.InvalidType)
          & ~SymTab.IsIntFamily(it) THEN
          SemError(218);
          t := SymTab.InvalidType
        ELSE t :=
          SymTab.ArrayElem(t);
          SemError(230)
        END;
        QbeGen.CopyOp("0", q);;
        WHILE (sym = 10) DO
          Get;
          Expr(it, qr);
          IF (it # SymTab.InvalidType)
          & ~SymTab.IsIntFamily(it) THEN
          SemError(218) END;;
        END;
        Expect(20);
      ELSE
        Get;
        sfx := TRUE;
        IF t = SymTab.InvalidType THEN
        ELSIF SymTab.ClassOf(t) #
              SymTab.ClPtr THEN
          SemError(219);
          t := SymTab.InvalidType
        ELSE t := SymTab.PtrBase(t);
          SemError(230)
        END;
        QbeGen.CopyOp("0", q);;
      END;
    END;
  END Design;

PROCEDURE WithStat;
  VAR dt: SymTab.TypeIndex;
    dk: INTEGER;
    dq: QbeGen.QVal;
    qn: SymTab.Name;
    sfx: BOOLEAN;
    pushed: BOOLEAN;
  BEGIN
    Expect(44);
    Design(dt, dk, dq, qn, sfx);
    pushed := FALSE;
    IF dt # SymTab.InvalidType THEN
      pushed :=
        SymTab.PushRecord(dt);
      IF ~pushed THEN
        SemError(215)
      END
    END;
    IF pushed THEN
      QbeGen.NoQbeEnter;
      SemError(230)
    END;;
    Expect(38);
    StatSeq;
    Expect(12);
    IF pushed THEN
      SymTab.PopScope;
      QbeGen.NoQbeExit
    END;;
  END WithStat;

PROCEDURE ForStat;
  VAR n, lv: SymTab.Name;
    lo, hi, by: SymTab.TypeIndex;
    qlo, qhi, qby, hiS, byS: QbeGen.QVal;
    qt, qk: QbeGen.QVal;
    lTop, lChk, lEnd: QbeGen.QVal;
    neg: BOOLEAN;
  BEGIN
    Expect(42);
    GetIdent(n);
    IF ~SymTab.Lookup(n) THEN
     SemError(201)
    ELSIF (SymTab.SymKind(n) #
          SymTab.KindVar)
     & (SymTab.SymKind(n) #
        SymTab.KindField) THEN
     SemError(220)
    ELSIF (SymTab.SymType(n) #
          SymTab.InvalidType)
     & ~SymTab.IsIntFamily(
         SymTab.SymType(n)) THEN
     SemError(220) END;
     QbeGen.CopyOp(n, lv);;
    Expect(30);
    Expr(lo, qlo);
    IF (lo # SymTab.InvalidType)
    & ~SymTab.IsIntFamily(lo) THEN
    SemError(220) END;
    IF (lo # SymTab.InvalidType)
       & SymTab.IsIntFamily(lo) THEN
      QbeGen.StoreVar(lv, qlo, FALSE)
    ELSE
      QbeGen.StoreVar(lv, "0", FALSE)
    END;;
    Expect(28);
    Expr(hi, qhi);
    IF (hi # SymTab.InvalidType)
    & ~SymTab.IsIntFamily(hi) THEN
    SemError(220) END;
    QbeGen.CopyOp(qhi, hiS);
    QbeGen.CopyOp("1", byS);
    neg := FALSE;
    by := SymTab.IntType();;
    IF (sym = 43) THEN
      Get;
      ConstExpr(by, qby);
      IF (by # SymTab.InvalidType)
      & ~SymTab.IsIntFamily(by) THEN
      SemError(220) END;
      IF QbeGen.IsImm(qby) THEN
        QbeGen.CopyOp(qby, byS);
        neg := QbeGen.IsNeg(qby)
      ELSE SemError(230);
        QbeGen.CopyOp("1", byS);
        neg := FALSE
      END;;
    END;
    Expect(38);
    QbeGen.NewLabel(lTop);
    QbeGen.NewLabel(lChk);
    QbeGen.NewLabel(lEnd);
    QbeGen.Jmp(lChk);
    QbeGen.EmitLabel(lTop);;
    StatSeq;
    Expect(12);
    QbeGen.LoadVar(lv, FALSE, qt);
    QbeGen.NewTemp(qk);
    QbeGen.Op3("add", qk, qt, byS,
      FALSE);
    QbeGen.StoreVar(lv, qk, FALSE);
    QbeGen.EmitLabel(lChk);
    QbeGen.LoadVar(lv, FALSE, qt);
    QbeGen.NewTemp(qk);
    IF neg THEN
      QbeGen.Op3("csgew", qk, qt, hiS,
        FALSE)
    ELSE
      QbeGen.Op3("cslew", qk, qt, hiS,
        FALSE)
    END;
    QbeGen.Jnz(qk, lTop, lEnd);
    QbeGen.EmitLabel(lEnd);;
  END ForStat;

PROCEDURE LoopStat;
  VAR lTop, lE: QbeGen.QVal;
  BEGIN
    Expect(41);
    QbeGen.NewLabel(lTop);
    QbeGen.NewLabel(lE);
    QbeGen.EmitLabel(lTop);
    QbeGen.PushLoop(lE);;
    StatSeq;
    Expect(12);
    QbeGen.Jmp(lTop);
    QbeGen.EmitLabel(lE);
    QbeGen.PopLoop;;
  END LoopStat;

PROCEDURE RepeatStat;
  VAR t: SymTab.TypeIndex;
    q: QbeGen.QVal;
    lTop, lE: QbeGen.QVal;
  BEGIN
    Expect(39);
    QbeGen.NewLabel(lTop);
    QbeGen.NewLabel(lE);
    QbeGen.EmitLabel(lTop);;
    StatSeq;
    Expect(40);
    Expr(t, q);
    IF ~SymTab.BoolCheck(t) THEN
    SemError(214) END;
    QbeGen.Jnz(q, lE, lTop);
    QbeGen.EmitLabel(lE);;
  END RepeatStat;

PROCEDURE WhileStat;
  VAR t: SymTab.TypeIndex;
    q: QbeGen.QVal;
    lC, lB, lE: QbeGen.QVal;
  BEGIN
    Expect(37);
    QbeGen.NewLabel(lC);
    QbeGen.NewLabel(lB);
    QbeGen.NewLabel(lE);
    QbeGen.EmitLabel(lC);;
    Expr(t, q);
    IF ~SymTab.BoolCheck(t) THEN
    SemError(214) END;
    QbeGen.Jnz(q, lB, lE);
    QbeGen.EmitLabel(lB);;
    Expect(38);
    StatSeq;
    Expect(12);
    QbeGen.Jmp(lC);
    QbeGen.EmitLabel(lE);;
  END WhileStat;

PROCEDURE CaseStat;
  VAR st: SymTab.TypeIndex;
    sq: QbeGen.QVal;
    lEnd: QbeGen.QVal;
  BEGIN
    Expect(35);
    Expr(st, sq);
    Expect(24);
    QbeGen.NewLabel(lEnd);;
    Case(st, sq, lEnd);
    WHILE (sym = 36) DO
      Get;
      Case(st, sq, lEnd);
    END;
    IF (sym = 34) THEN
      Get;
      StatSeq;
    END;
    Expect(12);
    QbeGen.EmitLabel(lEnd);;
  END CaseStat;

PROCEDURE IfStat;
  VAR t: SymTab.TypeIndex;
    q: QbeGen.QVal;
    lThen, lElse, lEnd: QbeGen.QVal;
    hasElse: BOOLEAN;
  BEGIN
    Expect(31);
    Expr(t, q);
    IF ~SymTab.BoolCheck(t) THEN
    SemError(214) END;
    QbeGen.NewLabel(lThen);
    QbeGen.NewLabel(lElse);
    QbeGen.NewLabel(lEnd);
    QbeGen.Jnz(q, lThen, lElse);
    QbeGen.EmitLabel(lThen);
    hasElse := FALSE;;
    Expect(32);
    StatSeq;
    WHILE (sym = 33) DO
      Get;
      QbeGen.Jmp(lEnd);
      QbeGen.EmitLabel(lElse);;
      Expr(t, q);
      IF ~SymTab.BoolCheck(t) THEN
      SemError(214) END;
      QbeGen.NewLabel(lThen);
      QbeGen.NewLabel(lElse);
      QbeGen.Jnz(q, lThen, lElse);
      QbeGen.EmitLabel(lThen);;
      Expect(32);
      StatSeq;
    END;
    IF (sym = 34) THEN
      Get;
      QbeGen.Jmp(lEnd);
      QbeGen.EmitLabel(lElse);
      hasElse := TRUE;;
      StatSeq;
    END;
    Expect(12);
    IF ~hasElse THEN
    QbeGen.EmitLabel(lElse)
    END;
    QbeGen.EmitLabel(lEnd);;
  END IfStat;

PROCEDURE Assign;
  VAR dt, et: SymTab.TypeIndex;
    dk: INTEGER;
    qd, qe, qt: QbeGen.QVal;
    qn: SymTab.Name;
    sfx: BOOLEAN;
    isR, conv: BOOLEAN;
  BEGIN
    Design(dt, dk, qd, qn, sfx);
    Expect(30);
    Expr(et, qe);
    IF (dt # SymTab.InvalidType)
    & (dk # SymTab.KindVar)
    & (dk # SymTab.KindField)
    & (dk # SymTab.KindImport) THEN
    SemError(210)
    ELSIF ~SymTab.Assignable(et, dt) THEN
    SemError(210) END;
    IF dk = SymTab.KindImport THEN
    SemError(230)
    END;
    isR := (dt # SymTab.InvalidType)
         & (SymTab.ClassOf(dt)
            = SymTab.ClReal);
    conv := isR
          & SymTab.IsIntFamily(et);
    IF ~sfx
     & (dk = SymTab.KindVar) THEN
    IF conv THEN
      QbeGen.ConvIR(qe, qt);
      QbeGen.StoreVar(qn, qt, TRUE)
    ELSE
      QbeGen.StoreVar(qn, qe, isR)
    END
    END;;
  END Assign;

PROCEDURE Stat;
  VAR lx: QbeGen.QVal;
  BEGIN
    IF In(symSet[3], sym) THEN
      CASE sym OF
        1 :
          Assign;
      | 31 :
          IfStat;
      | 35 :
          CaseStat;
      | 37 :
          WhileStat;
      | 39 :
          RepeatStat;
      | 41 :
          LoopStat;
      | 42 :
          ForStat;
      | 44 :
          WithStat;
      | 29 :
          Get;
          IF QbeGen.TopLoop(lx) THEN
            QbeGen.Jmp(lx)
          ELSE SemError(230) END;;
      END;
    END;
  END Stat;

PROCEDURE FieldIdents (rt: SymTab.TypeIndex);
  VAR n: SymTab.Name;
  BEGIN
    GetIdent(n);
    IF ~SymTab.FieldPending(rt, n)
    THEN SemError(200) END;
    WHILE (sym = 10) DO
      Get;
      GetIdent(n);
      IF ~SymTab.FieldPending(rt, n)
      THEN SemError(200) END;
    END;
  END FieldIdents;

PROCEDURE Field (rt: SymTab.TypeIndex);
  VAR et: SymTab.TypeIndex;
  BEGIN
    IF (sym = 1) THEN
      FieldIdents(rt);
      Expect(17);
      Type(et);
      SymTab.FixPendingF(rt, et);;
    END;
  END Field;

PROCEDURE FieldSeq (rt: SymTab.TypeIndex);
  BEGIN
    Field(rt);
    WHILE (sym = 6) DO
      Get;
      Field(rt);
    END;
  END FieldSeq;

PROCEDURE Enum (VAR t: SymTab.TypeIndex);
  VAR n: SymTab.Name;
    qs: QbeGen.QVal;
    ord: INTEGER;
  BEGIN
    Expect(21);
    t := SymTab.NewEnum();
    ord := 0;;
    GetIdent(n);
    IF ~SymTab.Enter(n,
      SymTab.KindConst)
    THEN SemError(200) END;
    SymTab.SetSymType(n, t);
    QbeGen.IntStr(ord, qs);
    QbeGen.DeclConst(n, qs, t);
    INC(ord);;
    WHILE (sym = 10) DO
      Get;
      GetIdent(n);
      IF ~SymTab.Enter(n,
        SymTab.KindConst)
      THEN SemError(200) END;
      SymTab.SetSymType(n, t);
      QbeGen.IntStr(ord, qs);
      QbeGen.DeclConst(n, qs, t);
      INC(ord);;
    END;
    Expect(22);
  END Enum;

PROCEDURE PointerType (VAR t: SymTab.TypeIndex);
  VAR b: SymTab.TypeIndex;
  BEGIN
    Expect(27);
    Expect(28);
    Type(b);
    t := SymTab.NewPtr(b);;
  END PointerType;

PROCEDURE SetType (VAR t: SymTab.TypeIndex);
  VAR s: SymTab.TypeIndex;
  BEGIN
    Expect(26);
    Expect(24);
    SimpleType(s);
    IF (s # SymTab.InvalidType)
     & (SymTab.ClassOf(s) #
        SymTab.ClInt)
     & (SymTab.ClassOf(s) #
        SymTab.ClChar)
     & (SymTab.ClassOf(s) #
        SymTab.ClEnum) THEN
     SemError(224) END;
    t := SymTab.NewSet(s);;
  END SetType;

PROCEDURE RecordType (VAR t: SymTab.TypeIndex);
  BEGIN
    Expect(25);
    t := SymTab.NewRecord();;
    FieldSeq(t);
    Expect(12);
  END RecordType;

PROCEDURE ArrayType (VAR t: SymTab.TypeIndex);
  VAR s, s2, e: SymTab.TypeIndex;
    qs: QbeGen.QVal;
  BEGIN
    Expect(23);
    SimpleType(s);
    IF (s # SymTab.InvalidType)
     & (SymTab.ClassOf(s) #
        SymTab.ClInt)
     & (SymTab.ClassOf(s) #
        SymTab.ClChar)
     & (SymTab.ClassOf(s) #
        SymTab.ClEnum) THEN
     SemError(224) END;;
    WHILE (sym = 10) DO
      Get;
      SimpleType(s2);
      IF (s2 # SymTab.InvalidType)
       & (SymTab.ClassOf(s2) #
          SymTab.ClInt)
       & (SymTab.ClassOf(s2) #
          SymTab.ClChar)
       & (SymTab.ClassOf(s2) #
          SymTab.ClEnum) THEN
       SemError(224) END;;
    END;
    Expect(24);
    Type(e);
    t := SymTab.NewArray(e);;
  END ArrayType;

PROCEDURE SimpleType (VAR t: SymTab.TypeIndex);
  VAR t1, t2: SymTab.TypeIndex;
    q1, q2: QbeGen.QVal;
  BEGIN
    IF (sym = 1) THEN
      QualIdent(t);
      IF (sym = 18) THEN
        Get;
        ConstExpr(t1, q1);
        IF (t1 # SymTab.InvalidType)
        & (SymTab.ClassOf(t1) #
           SymTab.ClInt)
        & (SymTab.ClassOf(t1) #
           SymTab.ClChar)
        & (SymTab.ClassOf(t1) #
           SymTab.ClEnum) THEN
        SemError(224) END;;
        Expect(19);
        ConstExpr(t2, q2);
        IF (t2 # SymTab.InvalidType)
        & (SymTab.ClassOf(t2) #
           SymTab.ClInt)
        & (SymTab.ClassOf(t2) #
           SymTab.ClChar)
        & (SymTab.ClassOf(t2) #
           SymTab.ClEnum) THEN
        SemError(224) END;;
        Expect(20);
        t := SymTab.NewSub(t1);;
      END;
    ELSIF (sym = 18) THEN
      Get;
      ConstExpr(t1, q1);
      IF (t1 # SymTab.InvalidType)
      & (SymTab.ClassOf(t1) #
         SymTab.ClInt)
      & (SymTab.ClassOf(t1) #
         SymTab.ClChar)
      & (SymTab.ClassOf(t1) #
         SymTab.ClEnum) THEN
      SemError(224) END;;
      Expect(19);
      ConstExpr(t2, q2);
      IF (t2 # SymTab.InvalidType)
      & (SymTab.ClassOf(t2) #
         SymTab.ClInt)
      & (SymTab.ClassOf(t2) #
         SymTab.ClChar)
      & (SymTab.ClassOf(t2) #
         SymTab.ClEnum) THEN
      SemError(224) END;;
      Expect(20);
      t := SymTab.NewSub(t1);;
    ELSIF (sym = 21) THEN
      Enum(t);
    ELSE SynError(71);
    END;
  END SimpleType;

PROCEDURE QualIdent (VAR t: SymTab.TypeIndex);
  VAR n, m: SymTab.Name;
  BEGIN
    GetIdent(n);
    IF ~SymTab.Lookup(n) THEN
      SemError(201);
      t := SymTab.InvalidType
    ELSIF (SymTab.SymKind(n) #
           SymTab.KindType)
      & (SymTab.SymKind(n) #
         SymTab.KindPredef)
      & (SymTab.SymKind(n) #
         SymTab.KindImport) THEN
      SemError(221);
      t := SymTab.InvalidType
    ELSE t := SymTab.SymType(n) END;;
    WHILE (sym = 7) DO
      Get;
      GetIdent(m);
      t := SymTab.InvalidType;;
    END;
  END QualIdent;

PROCEDURE VarIdents;
  VAR n: SymTab.Name;
  BEGIN
    GetIdent(n);
    IF ~SymTab.EnterPending(n,
      SymTab.KindVar)
    THEN SemError(200) END;
    WHILE (sym = 10) DO
      Get;
      GetIdent(n);
      IF ~SymTab.EnterPending(n,
        SymTab.KindVar)
      THEN SemError(200) END;
    END;
  END VarIdents;

PROCEDURE Type (VAR t: SymTab.TypeIndex);
  BEGIN
    IF (sym = 1) OR (sym = 18) OR (sym = 21) THEN
      SimpleType(t);
    ELSIF (sym = 23) THEN
      ArrayType(t);
    ELSIF (sym = 25) THEN
      RecordType(t);
    ELSIF (sym = 26) THEN
      SetType(t);
    ELSIF (sym = 27) THEN
      PointerType(t);
    ELSE SynError(72);
    END;
  END Type;

PROCEDURE Expr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  VAR t2: SymTab.TypeIndex;
    tc, op: INTEGER;
    q2, qk: QbeGen.QVal;
    r: BOOLEAN;
  BEGIN
    SimExpr(t, q);
    IF In(symSet[4], sym) THEN
      Rel(op);
      SimExpr(t2, q2);
      IF op = SymTab.OpIn THEN
        IF SymTab.InCheck(t, t2) THEN
          t := SymTab.BoolType();
          SemError(230)
        ELSE SemError(222);
          t := SymTab.InvalidType
        END;
        QbeGen.CopyOp("0", q)
      ELSE
        tc := SymTab.ClassOf(t);
        IF SymTab.RelCheck(t, t2, op) THEN
          t := SymTab.BoolType()
        ELSE SemError(213); t := SymTab.InvalidType END;
        IF t # SymTab.InvalidType THEN
          r := tc = SymTab.ClReal;
          QbeGen.Cmp(op, q, q2, qk, r);
          QbeGen.CopyOp(qk, q)
        ELSE QbeGen.CopyOp("0", q)
        END
      END;;
    END;
  END Expr;

PROCEDURE ConstExpr (VAR t: SymTab.TypeIndex; VAR q: QbeGen.QVal);
  BEGIN
    Expr(t, q);
  END ConstExpr;

PROCEDURE VarDecl;
  VAR t: SymTab.TypeIndex;
    i: CARDINAL;
    nm: SymTab.Name;
    cls: INTEGER;
  BEGIN
    VarIdents;
    Expect(17);
    Type(t);
    cls := SymTab.ClassOf(t);
    IF (cls # SymTab.ClInt)
       & (cls # SymTab.ClReal)
       & (cls # SymTab.ClBool)
       & (cls # SymTab.ClChar)
       & (cls # SymTab.ClEnum) THEN
      SemError(230)
    END;
    i := 0;
    WHILE i < SymTab.PendCount() DO
      SymTab.PendName(i, nm);
      QbeGen.DeclVar(nm, t);
      INC(i)
    END;
    SymTab.FixPending(t);;
  END VarDecl;

PROCEDURE TypeDecl;
  VAR n: SymTab.Name;
    t0, t1: SymTab.TypeIndex;
  BEGIN
    GetIdent(n);
    IF ~SymTab.Enter(n, SymTab.KindType)
    THEN SemError(200) END;
    t0 := SymTab.NewAlias();
    SymTab.SetSymType(n, t0);;
    Expect(16);
    Type(t1);
    IF t1 = t0 THEN SemError(223);
      SymTab.SetTarget(t0,
        SymTab.InvalidType)
    ELSE SymTab.SetTarget(t0, t1) END;;
  END TypeDecl;

PROCEDURE ConstDecl;
  VAR n: SymTab.Name;
    t: SymTab.TypeIndex;
    qv: QbeGen.QVal;
    cls: INTEGER;
  BEGIN
    GetIdent(n);
    IF ~SymTab.Enter(n, SymTab.KindConst)
    THEN SemError(200) END;
    Expect(16);
    ConstExpr(t, qv);
    SymTab.SetSymType(n, t);
    cls := SymTab.ClassOf(t);
    IF cls = SymTab.ClStr THEN
      SemError(230)
    ELSIF ~QbeGen.IsImm(qv) THEN
      SemError(230)
    END;
    QbeGen.DeclConst(n, qv, t);;
  END ConstDecl;

PROCEDURE StatSeq;
  BEGIN
    Stat;
    WHILE (sym = 6) DO
      Get;
      Stat;
    END;
  END StatSeq;

PROCEDURE Declaration;
  BEGIN
    IF (sym = 13) THEN
      Get;
      WHILE (sym = 1) DO
        ConstDecl;
        Expect(6);
      END;
    ELSIF (sym = 14) THEN
      Get;
      WHILE (sym = 1) DO
        TypeDecl;
        Expect(6);
      END;
    ELSIF (sym = 15) THEN
      Get;
      WHILE (sym = 1) DO
        VarDecl;
        Expect(6);
      END;
    ELSE SynError(73);
    END;
  END Declaration;

PROCEDURE ImportList;
  VAR n: SymTab.Name;
  BEGIN
    GetIdent(n);
    IF ~SymTab.Enter(n, SymTab.KindImport)
    THEN SemError(200) END;
    WHILE (sym = 10) DO
      Get;
      GetIdent(n);
      IF ~SymTab.Enter(n, SymTab.KindImport)
      THEN SemError(200) END;
    END;
  END ImportList;

PROCEDURE Block;
  BEGIN
    WHILE (sym = 13) OR (sym = 14) OR (sym = 15) DO
      Declaration;
    END;
    IF (sym = 11) THEN
      Get;
      QbeGen.BeginBody;;
      StatSeq;
    END;
    Expect(12);
  END Block;

PROCEDURE Import;
  VAR n: SymTab.Name;
  BEGIN
    IF (sym = 8) THEN
      Get;
      GetIdent(n);
      IF ~SymTab.Enter(n, SymTab.KindImport)
      THEN SemError(200) END;
      Expect(9);
      ImportList;
      Expect(6);
    ELSIF (sym = 9) THEN
      Get;
      ImportList;
      Expect(6);
    ELSE SynError(74);
    END;
  END Import;

PROCEDURE GetIdent (VAR n: SymTab.Name);
  BEGIN
    Expect(1);
    LexName(n);;
  END GetIdent;

PROCEDURE SimpleQ;
  VAR m1, m2: SymTab.Name;
  BEGIN
    Expect(5);
    GetIdent(m1);
    SymTab.Init; QbeGen.OpenModule(m1);
    IF ~SymTab.Enter(m1, SymTab.KindModule)
    THEN SemError(200) END;
    Expect(6);
    WHILE (sym = 8) OR (sym = 9) DO
      Import;
    END;
    Block;
    GetIdent(m2);
    IF ~SymTab.Equal(m1, m2)
    THEN SemError(202) END;
    Expect(7);
    QbeGen.EndModule;
    SymTab.PrintTable;;
  END SimpleQ;



PROCEDURE Parse;
  BEGIN
    SimpleQS.Reset; Get;
    SimpleQ;

  END Parse;

BEGIN
  errDist := minErrDist;
  symSet[ 0, 0] := BITSET{0};
  symSet[ 0, 1] := BITSET{};
  symSet[ 0, 2] := BITSET{};
  symSet[ 0, 3] := BITSET{};
  symSet[ 0, 4] := BITSET{};
  symSet[ 1, 0] := BITSET{1, 2, 3, 4};
  symSet[ 1, 1] := BITSET{5};
  symSet[ 1, 2] := BITSET{};
  symSet[ 1, 3] := BITSET{5, 6, 14, 15};
  symSet[ 1, 4] := BITSET{0};
  symSet[ 2, 0] := BITSET{};
  symSet[ 2, 1] := BITSET{};
  symSet[ 2, 2] := BITSET{};
  symSet[ 2, 3] := BITSET{8, 9, 10, 11, 12, 13};
  symSet[ 2, 4] := BITSET{};
  symSet[ 3, 0] := BITSET{1};
  symSet[ 3, 1] := BITSET{13, 15};
  symSet[ 3, 2] := BITSET{3, 5, 7, 9, 10, 12};
  symSet[ 3, 3] := BITSET{};
  symSet[ 3, 4] := BITSET{};
  symSet[ 4, 0] := BITSET{};
  symSet[ 4, 1] := BITSET{0};
  symSet[ 4, 2] := BITSET{14, 15};
  symSet[ 4, 3] := BITSET{0, 1, 2, 3, 4};
  symSet[ 4, 4] := BITSET{};
END SimpleQP.