(* Tags: Pasta80, Pascal80 *)
COMPILER PASCALS $CN
(*  This is a Coco/R (Turbo Pascal) version of a Pascal-S compiler.

    Jul 4, 1996. Frankie Arzu <farzu@uvg.edu.gt> or <farzu@cs.tamu.edu>
    Nov 6, 1997. Slightly revised Pat Terry <cspt@cs.ru.ac.za>

    WARNING +++++++++++ Not entirely debugged yet!

    Original Pascal-S Code by:
    Author : N. Wirth, E.T.H. CH-8092 Zurich, 1.3.76
*)

USES TextFiles, Emulator, SymTab;

TYPE
  SYMBOL = (plus, minus, times, idiv, rdiv, imod, andsy, orsy,
            eql, neq, gtr, geq, lss, leq);

  CONREC =
    RECORD CASE TP : TYPES OF
       Ints, Chars, Bools : (I : INTEGER);
       Reals : (R : REAL)
    END;

VAR
  Id : ALFA;
  ProgName : ALFA;
  Level : INTEGER;
  Vm : PMachine;

FUNCTION ResultType (A, B : TYPES) : TYPES;
  BEGIN
    IF (A > Reals) OR (B > Reals)
      THEN BEGIN SemError(33); ResultType := NoTyp END
      ELSE
        IF (A = NoTyp) OR (B = NoTyp)
          THEN ResultType := NoTyp
          ELSE
            IF A = Ints
              THEN
                IF B = Ints
                  THEN ResultType := Ints
                  ELSE BEGIN ResultType := Reals; Vm^.Emit1(Vm_CVIF, 1) END
              ELSE
                BEGIN ResultType := Reals; IF B = Ints THEN Vm^.Emit1(Vm_CVIF, 0) END
  END;

PROCEDURE GetType (VAR Id : ALFA; VAR TP : TYPEREC);
  VAR
    X : INTEGER;
  BEGIN
    X := LocId(Id, Level);
    IF X <> 0 THEN
    WITH Tab[X] DO
      IF Obj <> Type1
        THEN SemError(29)
        ELSE
          BEGIN
            TP.TP := Typ; TP.Ref := Ref; TP.Size := Adr;
            IF TP.TP = NoTyp THEN SemError(30)
          END
  END;

PROCEDURE EmitArrayIndex (VAR V, X : ITEM);
  VAR
    A : INTEGER;
  BEGIN
    IF V.Typ <> Arrays
      THEN SemError(28)
      ELSE
        BEGIN
          A := V.Ref;
          IF Atab[A].InxTyp <> X.Typ
            THEN SemError(26)
            ELSE
             IF Atab[A].ElSize = 1
               THEN Vm^.Emit1(Vm_INDEX1, A)
               ELSE Vm^.Emit1(Vm_INDEX, A);
          V.Typ := Atab[A].eltyp; V.Ref := Atab[A].ElRef
        END
  END;

PROCEDURE EmitValParam (VAR X : ITEM; Cp : INTEGER);
  BEGIN
    IF X.Typ = Tab[Cp].Typ
      THEN
        BEGIN
          IF X.Ref <> Tab[Cp].Ref THEN SemError(36) ELSE
          IF X.Typ = Arrays THEN Vm^.Emit1(Vm_LDBLK, Atab[X.Ref].Size) ELSE
          IF X.Typ = Records THEN Vm^.Emit1(Vm_LDBLK, Btab[X.Ref].VSize)
        END
      ELSE
        IF (X.Typ = Ints) AND (Tab[Cp].Typ = Reals)
          THEN Vm^.Emit1(Vm_CVIF, 0)
          ELSE IF X.Typ <> NoTyp THEN SemError(36);
  END;

FUNCTION EmitRefParam (VAR X : ITEM; VAR Id : ALFA) : INTEGER;
  VAR
    K : INTEGER;
  BEGIN
    K := LocId(Id, Level);
    X.Typ := NoTyp;
    IF K <> 0 THEN
      BEGIN
        IF Tab[K].Obj <> Variable THEN SemError(37);
        X.Typ := Tab[K].Typ; X.Ref := Tab[K].Ref;
        IF Tab[K].Normal
          THEN Vm^.Emit2(Vm_LDA, Tab[K].Lev, Tab[K].Adr)
          ELSE Vm^.Emit2(Vm_LD, Tab[K].Lev, Tab[K].Adr);
      END;
    EmitRefParam := K;
  END;

FUNCTION LValue (VAR Id : ALFA; VAR X : ITEM) : INTEGER;
  VAR
    I, F : INTEGER;
  BEGIN
    I := LocId(Id, Level); LValue := I;
    X.Typ := Tab[I].Typ; X.Ref := Tab[I].Ref;
    IF Tab[I].Normal THEN F := Vm_LDA ELSE F := Vm_LD;
    CASE Tab[I].Obj OF
      Konstant, Type1 :
        SemError(45);
      Variable :
        Vm^.Emit2(F, Tab[I].Lev, Tab[I].Adr);
      Prozedure :
        (* IF Tab[I].Lev = 0 THEN StandProc(Tab[I].Adr) *);
      Funktion:
        IF Tab[I].Ref = Display[Level]
          THEN Vm^.Emit2(F, Tab[I].Lev + 1, 0);
          ELSE SemError(45)
    END
  END;

FUNCTION RValue (VAR X : ITEM; VAR Id : ALFA) : INTEGER;
   VAR
     I, F : INTEGER;
   BEGIN
     I := LocId(Id, Level); RValue := I;
     WITH Tab[I] DO
       CASE Obj OF
         Konstant :
           BEGIN
             X.Typ := Typ; X.Ref := 0;
             IF X.Typ = Reals
               THEN Vm^.Emit1(Vm_F_LIT, Adr)
               ELSE Vm^.Emit1(Vm_I_LIT, Adr)
           END;
         Variable :
           BEGIN
             X.Typ := Typ; X.Ref := Ref;
             IF X.Typ IN StanTyps
               THEN
                 IF Normal THEN F := Vm_LD ELSE F := Vm_LDI
               ELSE
                 IF Normal THEN F := Vm_LDA ELSE F := Vm_LD;
             Vm^.Emit2(F, Lev, Adr)
           END;
        Type1, Prozedure :
          SemError(44);
        Funktion :
          BEGIN X.Typ := Typ; Vm^.Emit1(Vm_MARK, I) END
      END { CASE, WITH }
  END;

PROCEDURE IndSelector (I : INTEGER; VAR X : ITEM);
  BEGIN
    WITH Tab[I] DO
      CASE Obj OF
        Variable : BEGIN IF X.Typ IN StanTyps THEN Vm^.Emit(Vm_IND) END
      END { CASE, WITH }
  END;

PROCEDURE IndVar (I : INTEGER; VAR X : ITEM);
  VAR
    F : INTEGER;
  BEGIN
    WITH Tab[I] DO
      CASE Obj OF
        Variable :
          BEGIN
            X.Typ := Typ; X.Ref := Ref;
            IF X.Typ IN StanTyps
              THEN IF Normal THEN F := Vm_LD ELSE F := Vm_LDI
              ELSE IF Normal THEN F := Vm_LDA ELSE F := Vm_LD;
            Vm^.Emit2(F, Lev, Adr)
          END;
        Type1, Prozedure :
          SemError(44);
        Funktion :
          BEGIN
            X.Typ := Typ; (*Vm^.Emit1(Vm_MARK, I);*)
            Vm^.Emit1(Vm_CALL, Btab[Tab[I].Ref].PSize - 1);
            IF Tab[I].Lev < Level THEN Vm^.Emit2(Vm_DISP, Tab[I].Lev, Level);
          END
      END
    END;

PROCEDURE AssignType (VAR X, Y : ITEM);
  BEGIN
    IF X.Typ = Y.Typ
      THEN
        IF X.Typ IN StanTyps
          THEN Vm^.Emit(Vm_STO)
          ELSE
            IF X.Ref <> Y.Ref
              THEN SemError(46)
              ELSE
                IF X.Typ = Arrays
                  THEN Vm^.Emit1(Vm_STOBLK, Atab[X.Ref].Size)
                  ELSE Vm^.Emit1(Vm_STOBLK, Btab[X.Ref].VSize)
      ELSE
        IF (X.Typ = Reals) AND (Y.Typ = Ints)
          THEN BEGIN Vm^.Emit1(Vm_CVIF, 0); Vm^.Emit(Vm_STO) END
          ELSE IF (X.Typ <> NoTyp) AND (Y.Typ <> NoTyp) THEN SemError(46)
  END;

PROCEDURE EmitOp (Op : SYMBOL; VAR X, Y : ITEM);
  BEGIN
    CASE Op OF
       times :
         BEGIN
           X.Typ := ResultType(X.Typ, Y.Typ);
           CASE X.Typ OF
             NoTyp : ;
             Ints  : Vm^.Emit(Vm_I_MUL);
             Reals : Vm^.Emit(Vm_F_MUL);
           END
         END;
       rdiv :
         BEGIN
           IF X.Typ = Ints THEN
             BEGIN Vm^.Emit1(Vm_CVIF, 1); X.Typ := Reals END;
           IF Y.Typ = Ints THEN
             BEGIN Vm^.Emit1(Vm_CVIF, 0); Y.Typ := Reals END;
             IF (X.Typ = Reals) AND (Y.Typ = Reals)
               THEN Vm^.Emit(Vm_F_DIV)
               ELSE
                 BEGIN
                   IF (X.Typ <> NoTyp) AND (Y.Typ <> NoTyp) THEN SemError(33);
                   X.Typ := NoTyp
                 END
         END;
       andsy:
         BEGIN
           IF (X.Typ = Bools) AND (Y.Typ = Bools)
             THEN Vm^.Emit(Vm_B_AND)
             ELSE
               BEGIN
                 IF (X.Typ <> NoTyp) AND (Y.Typ <> NoTyp) THEN SemError(32);
                 X.Typ := NoTyp
               END
         END;
       idiv, imod :
         BEGIN
           IF (X.Typ = Ints) AND (Y.Typ = Ints)
             THEN
               IF Op = idiv THEN Vm^.Emit(Vm_I_DIV) ELSE Vm^.Emit(Vm_I_MOD)
             ELSE
               BEGIN
                 IF (X.Typ <> NoTyp) AND (Y.Typ <> NoTyp) THEN SemError(34);
                 X.Typ := NoTyp
               END
         END;
       orsy :
         BEGIN
           IF (X.Typ = Bools) AND (Y.Typ = Bools)
             THEN Vm^.Emit(Vm_B_OR)
             ELSE
               BEGIN
                 IF (X.Typ <> NoTyp) AND (Y.Typ <> NoTyp) THEN SemError(32);
                 X.Typ := NoTyp
               END;
         END;
       plus :
         BEGIN
           X.Typ := ResultType(X.Typ, Y.Typ);
           IF (X.Typ = Ints)  THEN Vm^.Emit(Vm_I_ADD);
           IF (X.Typ = Reals) THEN Vm^.Emit(Vm_F_ADD);
         END;
       minus :
         BEGIN
           X.Typ := ResultType(X.Typ, Y.Typ);
           IF (X.Typ = Ints)  THEN Vm^.Emit(Vm_I_SUB);
           IF (X.Typ = Reals) THEN Vm^.Emit(Vm_F_SUB);
         END;
       eql, neq, lss, leq, gtr, geq :
         BEGIN
           IF (X.Typ IN [NoTyp, Ints, Bools, Chars]) AND (X.Typ = Y.Typ)
             THEN
               CASE Op OF
                 eql : Vm^.Emit(Vm_I_EQ);
                 neq : Vm^.Emit(Vm_I_NE);
                 lss : Vm^.Emit(Vm_I_LT);
                 leq : Vm^.Emit(Vm_I_LE);
                 gtr : Vm^.Emit(Vm_I_GT);
                 geq : Vm^.Emit(Vm_I_GE);
               END
             ELSE
               BEGIN
                 IF X.Typ = Ints
                   THEN BEGIN X.Typ := Reals; Vm^.Emit1(Vm_CVIF, 1) END
                   ELSE
                     IF Y.Typ = Ints THEN
                       BEGIN Y.Typ := Reals; Vm^.Emit1(Vm_CVIF, 0) END;
                 IF (X.Typ = Reals) AND (Y.Typ = Reals)
                   THEN
                     CASE Op OF
                       eql : Vm^.Emit(Vm_F_EQ);
                       neq : Vm^.Emit(Vm_F_NE);
                       lss : Vm^.Emit(Vm_F_LT);
                       leq : Vm^.Emit(Vm_F_LE);
                       gtr : Vm^.Emit(Vm_F_GT);
                       geq : Vm^.Emit(Vm_F_GE);
                     END
                   ELSE SemError(35)
                 END;
                 X.Typ := Bools
               END
         END
   END;

IGNORE CASE
IGNORE CHR(1) .. CHR(31)
COMMENTS FROM "(*" TO "*)"
COMMENTS FROM "{" TO "}"

CHARACTERS
  digit  = "0123456789".
  letter = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".
  instrn  = ANY - "'" - CHR(13).

TOKENS
  ident    = letter { letter | digit } .
  IntNum   = digit { digit } | digit { digit } CONTEXT ("..") .
  RealNum1 = digit { digit } "." digit { digit } .
  RealNum2 = digit { digit } "." digit { digit } "E" ["+"|"-"] digit { digit } .
  string   = "'" { instrn | "'" "'" } "'" .

PRODUCTIONS
  PASCALS
    =                             (. SymTab.ErrorProc := SemError;
                                     Vm := NEW(PMachine, Init);
                                     Level := 1 .)
      "PROGRAM" Ident<ProgName>
      [ "(" ident {"," ident }
        ")"
      ]
      Block<GetTabPos, FALSE>
      SYNC "."                    (. Vm^.Emit(Vm_HALT);
                                     IF Btab[2].VSize > StackSize THEN SemError(49);
                                     IF ProgName = 'TEST0     ' THEN
                                       BEGIN
                                         PrintTables(ErrorFile);
                                         Vm^.DumpCode(ErrorFile)
                                       END;
                                     Close(ErrorFile);
                                     IF Successful THEN Vm^.Interpret .)
     .

  Block <Prt : INTEGER; IsFun : BOOLEAN>
                                  (. VAR DX, Prb, X : INTEGER; .)
    =                             (. DX := 5;
                                     IF Level > LMax THEN Fatal(5);
                                     Prb := EnterBlock;
                                     NewDisplay(Prt, Level) .)
      [ "(" ParameterList<DX>
         ")" ]                    (. SetProcParams(Prb, GetTabPos, DX) .)
      [ ":" Ident<Id>             (. IF IsFun THEN
                                       BEGIN
                                         X := LocId(Id, Level);
                                         SetProcType(Prt, X);
                                       END .)
      ]
      ";"
      {   ConstDecl
        | TypeDecl
        | VarDecl<DX>
        | ProcDecl
      }                           (. SetProcVarSize(Prb, DX) .)
      SYNC
      "BEGIN"                     (. SetProcAddr(Prt, Vm^.LC) .)
         Statement
         { ";" Statement }
      "END"
      .

  Statement
    =   AssignCallStat
      | CompStat
      | IfStat
      | WhileStat
      | RepeatStat
      | ForStat
      | StandardProc
      .

  AssignCallStat                  (. VAR
                                       X, Y : ITEM;
                                       I : INTEGER; .)
    =
      Ident<Id>                   (. I := LValue(Id, X) .)
      { Selector<X> }
      ( ":=" Expression<Y, TRUE>  (. AssignType(X, Y) .)
        |                         (. Vm^.Emit1(Vm_MARK, I) .)
          [ ActualParams<I, Btab[Tab[I].Ref].LastPar> ]
                                  (. Vm^.Emit1(Vm_CALL, Btab[Tab[I].Ref].PSize - 1);
                                     IF Tab[I].Lev < Level THEN
                                       Vm^.Emit2(Vm_DISP, Tab[I].Lev, Level) .)
      )
      .

  CompStat
    = "BEGIN" Statement { ";" Statement } "END" .

  IfStat                          (. VAR
                                       X : ITEM;
                                       LC1, LC2 : INTEGER; .)
    = "IF" Expression<X, TRUE>    (. IF NOT (X.Typ IN [Bools, NoTyp]) THEN
                                     SemError(17);
                                     LC1 := Vm^.LC; Vm^.Emit(Vm_CJMP) .)
      "THEN" Statement
      ( "ELSE"                    (. LC2 := Vm^.LC; Vm^.Emit(Vm_JMP);
                                     Vm^.Code[LC1].Y := Vm^.LC .)
        Statement                 (. Vm^.Code[LC2].Y := Vm^.LC .)
      | (* empty *)               (. Vm^.Code[LC1].Y := Vm^.LC .)
      )
      .

  RepeatStat                      (. VAR
                                       X : ITEM;
                                       LC1 : INTEGER; .)
    = "REPEAT"                    (. LC1 := Vm^.LC .)
        Statement { "," Statement }
      "UNTIL"
      Expression<X, TRUE>         (. IF NOT (X.Typ IN [Bools, NoTyp]) THEN
                                       SemError(17);
                                     Vm^.Emit1(Vm_CJMP, LC1) .)
      .

  WhileStat                       (. VAR
                                       X : ITEM;
                                       LC1, LC2 : INTEGER; .)
    = "WHILE"                     (. LC1 := Vm^.LC .)
      Expression<X, TRUE>         (. IF NOT (X.Typ IN [Bools, NoTyp]) THEN
                                       SemError(17);
                                     LC2 := Vm^.LC; Vm^.Emit(Vm_CJMP) .)
      "DO"
      Statement                   (. Vm^.Emit1(Vm_JMP, LC1);
                                     Vm^.Code[LC2].Y := Vm^.LC .)
      .

  ForStat                         (. VAR
                                       Cvt : TYPES;
                                       X : ITEM;
                                       I, F, LC1, LC2 : INTEGER; .)
    = "FOR" Ident<Id>             (. I := LocId(Id, Level);
                                     IF I = 0 THEN Cvt := Ints ELSE
                                     IF Tab[I].Obj = Variable THEN
                                         BEGIN
                                           Cvt := Tab[I].Typ;
                                           IF NOT Tab[I].Normal
                                             THEN SemError(37)
                                             ELSE Vm^.Emit2(Vm_LDA, Tab[I].Lev, Tab[I].Adr);
                                           IF NOT (Cvt IN [NoTyp, Ints, Bools, Chars]) THEN SemError(18)
                                         END
                                       ELSE
                                         BEGIN SemError(37); Cvt := Ints END .)
      ":=" Expression<X, TRUE>    (. IF X.Typ <> Cvt THEN SemError(19) .)
      ( "TO"                      (. F := Vm_FOR1U .)
      | "DOWNTO"                  (. F := Vm_FOR1D .)
      )
      Expression<X, TRUE>         (. IF X.Typ <> Cvt THEN SemError(19);
                                     LC1 := Vm^.LC; Vm^.Emit(F) .)
      "DO"                        (. LC2 := Vm^.LC .)
      Statement                   (. Vm^.Emit1(F + 1, LC2); Vm^.Code[LC1].Y := Vm^.LC .)
      .

  StandardProc
    =   "READ"    "(" ReadArg {"," ReadArg} ")"
      | "READLN"  "(" ReadArg {"," ReadArg} ")"
                                  (. Vm^.Emit(Vm_READLN) .)
      | "WRITE"   "(" WriteArg {"," WriteArg} ")"
      | "WRITELN" "(" WriteArg {"," WriteArg} ")"
                                  (. Vm^.Emit(Vm_WRITELN) .)
      .

  ReadArg                         (. VAR
                                      I : INTEGER;
                                      X : ITEM; .)
    = Ident<Id>                   (. I := EmitRefParam(X, Id) .)
      { Selector<X> }             (. IF X.Typ IN [Ints, Reals, Chars, NoTyp]
                                       THEN Vm^.Emit1(Vm_READ, ORD(X.Typ))
                                       ELSE SemError(41) .)
      .

  WriteArg                        (. VAR
                                      I, SLen : INTEGER;
                                      X, Y : ITEM;
                                      S : STRING; .)
    =    StrConst<S>              (. I := EnterString(S);
                                     SLen := Length(S) - 2;
                                     Vm^.Emit1(Vm_I_LIT, SLen);
                                     Vm^.Emit1(Vm_S_WRITE, I) .)
      |  Expression<X, TRUE>      (. IF NOT (X.Typ IN StanTyps)
                                     THEN SemError(41) .)
         ( ":"
           Expression<Y, TRUE>    (. IF Y.Typ <> Ints THEN SemError(43) .)
           ( ":"                  (. IF X.Typ <> Reals THEN SemError(42) .)
             Expression<Y, TRUE>  (. IF Y.Typ <> Ints THEN SemError(43);
                                     Vm^.Emit(Vm_WRITE3) .)
             | (* Empty *)        (. Vm^.Emit1(Vm_WRITE2, ORD(X.Typ)) .)
           )
           | (* Empty *)          (. Vm^.Emit1(Vm_WRITE1, ORD(X.Typ)) .)
         )
      .

  Selector <VAR V : ITEM>         (. VAR
                                       X : ITEM;
                                       A, J : INTEGER; .)
    = "." Ident<Id>               (. A := GetFieldOfs(V, Id);
                                     IF A <> 0 THEN Vm^.Emit1(Vm_OFS, A) .)
      | "["
         Expression<X, TRUE>      (. EmitArrayIndex(V, X) .)
         { ","
           Expression<X, TRUE>    (. EmitArrayIndex(V, X) .)
         }
        "]"
      .

  ActualParams <Cp, LastP : INTEGER>
                                  (. VAR
                                      X : ITEM;
                                  .)
    = "("                         (. IF Cp >= LastP THEN SemError(39); INC(Cp) .)
      Expression<X, Tab[Cp].Normal>
                                  (. IF Tab[Cp].Normal
                                      THEN EmitValParam(X, Cp)
                                      ELSE
                                        IF (X.Typ <> Tab[Cp].Typ) OR (X.Ref <> Tab[Cp].Ref) THEN SemError(36) .)
      { ","                       (. IF Cp >= LastP THEN SemError(39); INC(Cp) .)
        Expression<X, Tab[Cp].Normal>
                                  (. IF Tab[Cp].Normal
                                       THEN EmitValParam(X, Cp)
                                       ELSE
                                         IF (X.Typ <> Tab[Cp].Typ) OR (X.Ref <> Tab[Cp].Ref) THEN SemError(36) .)
      }
      ")"
      .

  Expression <VAR X : ITEM; Normal : BOOLEAN>
                                  (. VAR
                                       Y : ITEM;
                                       Op : SYMBOL; .)
    = SimpExpr<X, Normal>
      {  RelOp<Op>
         SimpExpr<Y, Normal>      (. EmitOp(Op, X, Y) .)
      }
      .

  SimpExpr <VAR X : ITEM; Normal : BOOLEAN>
                                  (. VAR
                                       Y : ITEM;
                                       Op : SYMBOL;
                                       Neg : BOOLEAN; .)
      =                           (. Neg := FALSE .)
      [  "+" | "-"                (. Neg := TRUE .)
      ]
      Term<X, Normal>             (. IF Neg THEN
                                     IF X.Typ > Reals
                                       THEN SemError(33)
                                       ELSE Vm^.Emit(Vm_NEG) .)
      {  AddOp<Op>
         Term<Y, Normal>          (. EmitOp(Op, X, Y) .)
      }
      .

  Term <VAR X : ITEM; Normal : BOOLEAN>
                                  (. VAR
                                       Y : ITEM;
                                       Op : SYMBOL; .)
    = Factor<X, Normal>
      { MultOp<Op>
        Factor<Y, Normal>         (. EmitOp(Op, X, Y) .)
      }
      .

  Factor <VAR X : ITEM; Normal : BOOLEAN>
                                  (. VAR
                                       CH   : CHAR;
                                       I    : INTEGER;
                                       RNum : REAL;
                                       INum : INTEGER;
                                  .)
      =                           (. X.Typ := NoTyp; X.Ref := 0 .)
         Ident<Id>                (. IF NOT Normal
                                       THEN I :=  EmitRefParam(X, Id)
                                       ELSE I := RValue(X, Id) .)

         ( Selector<X>            (. IF Normal THEN IndSelector(I, X) .)
           { Selector<X>          (. IF Normal THEN IndSelector(I, X) .)
           }
          | ActualParams<I, Btab[Tab[I].Ref].LastPar>
                                  (. Vm^.Emit1(Vm_CALL, Btab[Tab[I].Ref].PSize - 1);
                                     IF Tab[I].Lev < Level THEN
                                       Vm^.Emit2(Vm_DISP, Tab[I].Lev, Level);
                                  .)
          | (*empty bug fix pdt   (. IF Normal THEN IndVar(I, X) .) *)
         )

      |  RealConst<RNum>          (. X.Typ := Reals; X.Ref := 0;
                                     I := EnterReal(RNum);
                                     Vm^.Emit1(Vm_F_LIT, I) .)
      |  IntConst<INum>           (. X.Typ := Ints; X.Ref := 0;
                                    Vm^.Emit1(Vm_I_LIT, INum) .)
      |  ChrConst<CH>             (. X.Typ := Chars; X.Ref := 0;
                                     Vm^.Emit1(Vm_I_LIT, ORD(CH)) .)
      | "(" Expression<X, Normal> ")"
      | "NOT" Factor<X, Normal>   (. IF X.Typ = Bools
                                       THEN Vm^.Emit(Vm_NOT)
                                       ELSE IF X.Typ <> NoTyp THEN SemError(Vm_EXITP) .)
      .

  RelOp <VAR Op : SYMBOL>
      =  "="                      (. Op := eql .)
      |  "<>"                     (. Op := neq .)
      |  "<"                      (. Op := lss .)
      |  "<="                     (. Op := leq .)
      |  ">"                      (. Op := gtr .)
      |  ">="                     (. Op := geq .)
      .

  AddOp <VAR Op : SYMBOL>
      =  "+"                      (. Op := plus .)
      |  "-"                      (. Op := minus .)
      |  "OR"                     (. Op := orsy .)
      .

  MultOp <VAR Op : SYMBOL>
      =  "DIV"                    (. Op := idiv .)
      |  "MOD"                    (. Op := imod .)
      |  "AND"                    (. Op := andsy .)
      |  "/"                      (. Op := rdiv .)
      |  "*"                      (. Op := times .)
      .

  ProcDecl                        (. VAR
                                      T0 : INTEGER;
                                      IsFun : BOOLEAN;
                                      OldLevel : INTEGER; .)
    = (
        "PROCEDURE" Ident<Id>     (. T0 := EnterId(Id, Prozedure, Level); IsFun := FALSE .)
      | "FUNCTION"  Ident<Id>     (. T0 := EnterId(Id, Funktion, Level); IsFun := TRUE .)
      )                           (. Tab[T0].Normal := TRUE;
                                     OldLevel := Level; Level := Level + 1 .)
      Block<T0, IsFun>            (. Level := OldLevel .)
      ";"                         (. Vm^.Emit(Vm_EXITP + ORD(IsFun)) .)
      .

  VarDecl <VAR DX : INTEGER>
                                  (. VAR
                                       T0, T1 : INTEGER;
                                       TP : TYPEREC; .)
    = "VAR"
      {
         Ident<Id>                (. T0 := EnterId(Id, Variable, Level); T1 := T0 .)
         { "," Ident<Id>          (. T1 := EnterId(Id, Variable, Level) .)
         }
         ":" Typ<TP>              (. FixTab(T0, T1, TP, TRUE, DX) .)
         ";"
      }
      .

  ArrayTyp <VAR AType : TYPEREC>  (. VAR
                                       ElType : TYPEREC;
                                       Low, High : CONREC; .)
    =                             (. AType.TP := Arrays .)
      Const<Low>                  (. IF Low.TP = Reals THEN
                                       BEGIN
                                         SemError(27);
                                         Low.TP := Ints; Low.I := 0
                                       END .)
      ".." Const<High>            (. IF High.TP = Reals THEN
                                       BEGIN
                                         SemError(27);
                                         High.TP := Ints; High.I := 0
                                       END;
                                     AType.Ref := EnterArray(Low.TP, Low.I, High.I) .)
      (   "," ArrayTyp<ElType>
        | "]" "OF" Typ<ElType>
      )                           (. FixArray(AType, ElType) .)
      .

  Typ <VAR TP : TYPEREC>          (. VAR
                                       X : INTEGER;
                                       ElType : TYPEREC;
                                       Offset, T0, T1 : INTEGER; .)
    =                             (. TP.TP := NoTyp; TP.Ref := 0; TP.Size := 0 .)
         Ident<Id>                (. GetType(Id, TP) .)
      |  "ARRAY" "[" ArrayTyp<TP>
      |  "RECORD"                 (. TP.Ref := EnterBlock; TP.TP := Records;
                                     IF Level = LMax THEN Fatal(5);
                                     Level := Level + 1;
                                     Display[Level] := TP.Ref; Offset := 0 .)
         {
           Ident<Id>              (. T0 := EnterId(Id, Variable, Level); T1 := T0 .)
           { "," Ident<Id>        (. T1 := EnterId(Id, Variable, Level) .)
           }
           ":" Typ<ElType>        (. FixTab(T0, T1, ElType, TRUE, Offset) .)
           ";"
         }
         "END"                    (. Btab[TP.Ref].VSize := Offset;
                                     TP.Size := Offset;
                                     Btab[TP.Ref].PSize := 0;
                                     Level := Level - 1 .)
      .

  ParameterList <VAR DX : INTEGER>
    = ParameterItem<DX>
      { ";" ParameterItem<DX> }
      .

  ParameterItem <VAR DX : INTEGER> (. VAR
                                        TP : TYPEREC;
                                        X, T0, T1 : INTEGER;
                                        ValPar : BOOLEAN; .)
      =
        ("VAR"                    (. ValPar := FALSE .)
         |                        (. ValPar := TRUE .)
        )
        Ident<Id>                 (. T0 := EnterId(Id, Variable, Level); T1 := T0 .)
        { "," Ident<Id>           (. T1 := EnterId(Id, Variable, Level) .)
        }
        ":"
        Ident<Id>                 (. GetType(Id, TP);
                                     IF NOT ValPar THEN TP.Size := 1;
                                     FixParam(T0, T1, TP, ValPar, Level, DX) .)
      .

  ConstDecl                       (. VAR
                                       T1 : INTEGER;
                                       C : CONREC;
                                       C1 : INTEGER; .)
    = "CONST"
      { Ident<Id>                 (. T1 := EnterId(Id, Konstant, Level) .)
        "="
        Const<C>                  (. IF C.TP = Reals
                                       THEN C1 := EnterReal(C.R)
                                       ELSE C1 := C.I;
                                     WITH Tab[T1] DO
                                       BEGIN
                                         Typ := C.TP; Ref := 0; Adr := C1
                                       END .)
        ";"
      }
      .

  TypeDecl                        (. VAR
                                       T1 : INTEGER;
                                       TP : TYPEREC; .)
    = "TYPE"
      { Ident<Id>                 (. T1 := EnterId(Id, Type1, Level) .)
        "="
        Typ<TP>                   (. WITH Tab[T1] DO
                                       BEGIN
                                         Typ := TP.TP; Ref := TP.Ref; Adr := TP.Size
                                       END .)
        ";"
      }
      .

  Const <VAR C : CONREC>          (. VAR
                                       X, Sign : INTEGER;
                                       CH : CHAR;
                                       INum : INTEGER;
                                       RNum : REAL; .)
    =                             (. C.TP := NoTyp; C.I := 0; Sign := 1 .)
      (
          ChrConst<CH>            (. C.TP := Chars; C.I := ORD(CH) .)
        | [  "+" | "-"            (. Sign := -1 .)
          ]
          (   Ident<Id>           (. X := LocId(Id, Level);
                                     IF X <> 0 THEN
                                       IF Tab[X].Obj <> Konstant
                                         THEN SemError(25)
                                         ELSE
                                           BEGIN
                                             C.TP := Tab[X].Typ;
                                             IF C.TP = Reals
                                               THEN C.R := Sign * RConst[Tab[X].Adr]
                                               ELSE C.I := Sign * Tab[X].Adr
                                           END .)
            | IntConst<INum>        (. C.TP := Ints; C.I := Sign * INum .)
            | RealConst<RNum>       (. C.TP := Reals; C.R := Sign * RNum .)
          )
      )
      .

  Ident <VAR Id : ALFA>           (. VAR S : STRING; .)
    = ident                       (. LexName(S); FillChar(Id, Alng, ' ');
                                     Move(S[1], Id, ORD(S[0])) .)
      .

  IntConst <VAR N : INTEGER>      (. VAR
                                       S : STRING;
                                       C : INTEGER; .)
    = IntNum                      (. LexString(S); Val(S, N, C) .)
      .

  RealConst <VAR N : REAL>        (. VAR
                                       S : STRING;
                                       C : INTEGER; .)
    =     RealNum1                (. LexString(S); Val(S, N, C) .)
        | RealNum2                (. LexString(S); Val(S, N, C) .)
      .

  StrConst <VAR S : STRING>
    = string                      (. LexString(S) .)
      .

  ChrConst <VAR CH : CHAR>        (. VAR S : STRING; .)
    = string                      (. LexString(S); CH := S[2] .)
      .

END PASCALS.