PROCEDURE ASSIGNMENT(FCP: CTP);
          VAR LATTR: ATTR;
        BEGIN SELECTOR(FSYS + [BECOMES],FCP);
          IF SY = BECOMES THEN
            BEGIN
              IF GATTR.TYPTR <> NIL THEN
                IF (GATTR.ACCESS=INDRCT) OR (GATTR.TYPTR^.FORM>POWER) THEN
                  LOADADDRESS;
              LATTR := GATTR;
              INSYMBOL; EXPRESSION(FSYS);
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR^.FORM <= POWER THEN LOAD
                ELSE LOADADDRESS;
              IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                BEGIN
                  IF COMPTYPES(REALPTR,LATTR.TYPTR) AND
                     COMPTYPES(GATTR.TYPTR,INTPTR) THEN
                    BEGIN GEN0(10(*FLT*));
                      GATTR.TYPTR := REALPTR
                    END;
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                    CASE LATTR.TYPTR^.FORM OF
                      SCALAR,
                      SUBRANGE: BEGIN
                                  IF CHECKNEEDED(LATTR.TYPTR,GATTR.TYPTR)
                                    THEN CHECKBNDS(LATTR.TYPTR);
                                  STORE(LATTR)
                                END;
                      POINTER: BEGIN
                                 IF PTRCHECKS AND INITCHECKS THEN
                                   GEN2T(45(*CHK*),0,MAXADDR,NILPTR);
                                 STORE(LATTR)
                               END;
                      POWER:   STORE(LATTR);
                      ARRAYS,
                      RECORDS: GEN1(40(*MOV*),LATTR.TYPTR^.SIZE);
                      FILES: ERROR(146)
                    END
                  ELSE ERROR(129)
                END
            END (*SY = BECOMES*)
          ELSE ERROR(51)
        END (*ASSIGNMENT*) ;

        PROCEDURE GOTOSTATEMENT;
          VAR LLP: LBP; FOUND: BOOLEAN; TTOP,TTOP1: DISPRANGE; LLAB: INTEGER;
        BEGIN
          IF SY = INTCONST THEN
            BEGIN
              FOUND := FALSE;
              TTOP := TOP;
            WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP - 1;  (*PUG*)
            TTOP1 := TTOP;           (*PUG*)
              REPEAT
                 LLP := DISPLAY[TTOP].FLABEL;     (*PUG*)
                WHILE (LLP <> NIL) AND NOT FOUND DO
                  WITH LLP^ DO
                    IF LABVAL = VAL.IVAL THEN
                      BEGIN FOUND := TRUE;
                        IF TTOP = TTOP1 THEN BEGIN
                          GENUJPXJP(57(*UJP*),LABNAME); GENLABEL(LLAB);
                          PUTLABEL (LLAB) END
                        ELSE (*GOTO LEADS OUT OF PROCEDURE*) ERROR(399)
                      END
                    ELSE LLP := NEXTLAB;
                TTOP := TTOP - 1
              UNTIL FOUND OR (TTOP <= 0);
              IF NOT FOUND THEN ERROR(167);
              INSYMBOL
            END
          ELSE ERROR(15)
        END (*GOTOSTATEMENT*) ;

        PROCEDURE COMPOUNDSTATEMENT;
        BEGIN
          REPEAT
            REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
            UNTIL NOT (SY IN STATBEGSYS);
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          IF SY = ENDSY THEN BEGIN
             BEGINLEVEL := BEGINLEVEL - 1; INSYMBOL END
          ELSE ERROR (13);
        END (*COMPOUNDSTATEMENET*) ;

        PROCEDURE IFSTATEMENT;
          VAR LCIX1,LCIX2: INTEGER;
        BEGIN EXPRESSION(FSYS + [THENSY]);
          GENLABEL(LCIX1); GENFJP(LCIX1);
          IF SY = THENSY THEN INSYMBOL ELSE ERROR(52);
          STATEMENT(FSYS + [ELSESY]);
          IF SY = ELSESY THEN
            BEGIN GENLABEL(LCIX2); GENUJPXJP(57(*UJP*),LCIX2);
              PUTLABEL(LCIX1);
              INSYMBOL; STATEMENT(FSYS);
              PUTLABEL(LCIX2)
            END
          ELSE PUTLABEL(LCIX1)
        END (*IFSTATEMENT*) ;

        PROCEDURE CASESTATEMENT;
          LABEL 1;
          TYPE CIP = ^CASEINFO;
               CASEINFO = PACKED
                          RECORD NEXT: CIP;
                            CSSTART: INTEGER;
                            CSLAB: INTEGER
                          END;
          VAR LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU;
              LADDR, LCIX, LCIX1, LMIN, LMAX: INTEGER;
        BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]);
          LOAD;
          LSP := GATTR.TYPTR;
          IF LSP <> NIL THEN
            IF (LSP^.FORM > SUBRANGE) OR (LSP = REALPTR) THEN
             BEGIN ERROR(144); LSP := NIL END;
           GENLABEL(LCIX);
           GENUJPXJP(57(*UJP*),LCIX);
          IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
          FSTPTR := NIL; GENLABEL(LADDR);
          REPEAT
            LPT3 := NIL; GENLABEL(LCIX1);
            IF NOT(SY IN [SEMICOLON,ENDSY]) THEN
            BEGIN
            REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL);
              IF LSP <> NIL THEN
                IF COMPTYPES(LSP,LSP1) THEN
                  BEGIN LPT1 := FSTPTR; LPT2 := NIL;
                    WHILE LPT1 <> NIL DO
                      WITH LPT1^ DO
                        BEGIN
                          IF CSLAB <= LVAL.IVAL THEN
                            BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156);
                              GOTO 1
                            END;
                          LPT2 := LPT1; LPT1 := NEXT
                        END;
        1:          NEW(LPT3);
                    WITH LPT3^ DO
                      BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL;
                        CSSTART := LCIX1
                      END;
                    IF LPT2 = NIL THEN FSTPTR := LPT3
                    ELSE LPT2^.NEXT := LPT3
                  END
                ELSE ERROR(147);
              TEST := SY <> COMMA;
              IF NOT TEST THEN INSYMBOL
            UNTIL TEST;
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
            PUTLABEL(LCIX1);
            REPEAT STATEMENT(FSYS + [SEMICOLON])
            UNTIL NOT (SY IN STATBEGSYS);
            IF LPT3 <> NIL THEN
              GENUJPXJP(57(*UJP*),LADDR);
            END;
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          PUTLABEL(LCIX);
          IF FSTPTR <> NIL THEN
            BEGIN LMAX := FSTPTR^.CSLAB;
              (*REVERSE POINTERS*)
              LPT1 := FSTPTR; FSTPTR := NIL;
              REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR;
                FSTPTR := LPT1; LPT1 := LPT2
              UNTIL LPT1 = NIL;
              LMIN := FSTPTR^.CSLAB;
              IF LMAX - LMIN < CIXMAX THEN
                BEGIN
                  GEN2T(45(*CHK*),LMIN,LMAX,INTPTR);
                  GEN1T(51(*LDC*),LMIN,INTPTR); GEN0(21(*SBI*)); GENLABEL(LCIX);
                  GENUJPXJP(44(*XJP*),LCIX); PUTLABEL(LCIX);
                  REPEAT
                    WITH FSTPTR^ DO
                      BEGIN
                       IF PRCODE THEN BEGIN
                        WHILE CSLAB > LMIN DO
                           BEGIN GENLABEL(LCIX);
                                WRITELN(PRR,LCIX:5,' GOTO 99998');
                             LMIN := LMIN+1; IC := IC + 1
                           END;
                        GENLABEL(LCIX);
                        WRITELN (PRR, LCIX:5, ' GOTO ', CSSTART:1);
                       LMIN := LMIN + 1; IC := IC + 1 END;
                        FSTPTR := NEXT
                      END
                  UNTIL FSTPTR = NIL;
                  PUTLABEL(LADDR)
                END
              ELSE ERROR(157)
            END;
            IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
        END (*CASESTATEMENT*) ;

        PROCEDURE PUTLINENO;

        (* Prints the line numbers of corresponding source code *)
        (* lines preceding blocks of Fortran code generated. *)

        BEGIN
        IF LASTLINENO <> LINECOUNT THEN BEGIN
           WRITELN (PRR, ' ':6, 'LINENO = ', LINECOUNT:1);
           IC := IC + 1;
           LASTLINENO := LINECOUNT;
           END
        END (* PUTLINENO *);

        PROCEDURE REPEATSTATEMENT;
          VAR LADDR: INTEGER;
        BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
          REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]);
            IF SY IN STATBEGSYS THEN ERROR(14)
          UNTIL NOT(SY IN STATBEGSYS);
          WHILE SY = SEMICOLON DO
            BEGIN INSYMBOL;
              REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY]);
                IF SY IN STATBEGSYS THEN ERROR(14)
              UNTIL NOT (SY IN STATBEGSYS);
            END;
          IF SY = UNTILSY THEN
            BEGIN INSYMBOL;
            PUTLINENO;
            EXPRESSION(FSYS); GENFJP(LADDR)
            END
          ELSE ERROR(53)
        END (*REPEATSTATEMENT*) ;

        PROCEDURE WHILESTATEMENT;
          VAR LADDR, LCIX: INTEGER;
        BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
          WRITELN (PRR, ' ':6, 'LINENO = ', LINECOUNT:1); IC := IC + 1;
          EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX);
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS); GENUJPXJP(57(*UJP*),LADDR); PUTLABEL(LCIX)
        END (*WHILESTATEMENT*) ;

        PROCEDURE FORSTATEMENT;
          VAR LATTR: ATTR; LSP: STP;  LSY: SYMBOL;
              LCIX, LADDR: INTEGER;
                    LLC: ADDRRANGE;
        BEGIN LLC := LC;
          WITH LATTR DO
            BEGIN TYPTR := NIL; KIND := VARBL;
              ACCESS := DRCT; VLEVEL := LEVEL; DPLMT := 0
            END;
          IF SY = IDENT THEN
            BEGIN SEARCHID([VARS],LCP);
              WITH LCP^, LATTR DO
                BEGIN TYPTR := IDTYPE; KIND := VARBL;
                  IF VKIND = ACTUAL THEN
                    BEGIN ACCESS := DRCT; VLEVEL := VLEV;
                      DPLMT := VADDR
                    END
                  ELSE BEGIN ERROR(155); TYPTR := NIL END
                END;
              IF LATTR.TYPTR <> NIL THEN
                IF (LATTR.TYPTR^.FORM > SUBRANGE)
                   OR COMPTYPES(REALPTR,LATTR.TYPTR) THEN
                  BEGIN ERROR(143); LATTR.TYPTR := NIL END;
              INSYMBOL
            END
          ELSE
            BEGIN ERROR(2); SKIP(FSYS + [BECOMES,TOSY,DOWNTOSY,DOSY]) END;
          IF SY = BECOMES THEN
            BEGIN INSYMBOL; EXPRESSION(FSYS + [TOSY,DOWNTOSY,DOSY]);
              IF GATTR.TYPTR <> NIL THEN
                  IF GATTR.TYPTR^.FORM > SUBRANGE THEN ERROR(144)
                  ELSE
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                      BEGIN LOAD; STORE(LATTR) END
                    ELSE ERROR(145)
            END
          ELSE
            BEGIN ERROR(51); SKIP(FSYS + [TOSY,DOWNTOSY,DOSY]) END;
          IF SY IN [TOSY,DOWNTOSY] THEN
            BEGIN LSY := SY; INSYMBOL; EXPRESSION(FSYS + [DOSY]);
              IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM > SUBRANGE THEN ERROR(144)
                ELSE
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                    BEGIN LOAD;
                      GEN2T(56(*STR*),0,LC,GATTR.TYPTR);
                      GENLABEL(LADDR); PUTLABEL(LADDR);
                      GATTR := LATTR; LOAD;
                      GEN2T(54(*LOD*),0,LC,GATTR.TYPTR);
                      LC := LC + GATTR.TYPTR^.SIZE;
                      IF LC > LCMAX THEN LCMAX := LC;
                      IF LSY = TOSY THEN GEN1 (52 (*LEQ*), 1)
                      ELSE GEN1 (48 (*GEQ*), 1);
                    END
                  ELSE ERROR(145)
            END
          ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END;
          GENLABEL(LCIX); GENUJPXJP(33(*FJP*),LCIX);
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS);
          GATTR := LATTR; LOAD;
          IF LSY=TOSY THEN GEN1T(34(*INC*),1,GATTR.TYPTR)
          ELSE  GEN1T(31(*DEC*),1,GATTR.TYPTR);
          STORE(LATTR); GENUJPXJP(57(*UJP*),LADDR); PUTLABEL(LCIX);
          LC := LLC;
        END (*FORSTATEMENT*) ;


        PROCEDURE WITHSTATEMENT;
          VAR LCP: CTP; LCNT1: DISPRANGE; LLC: ADDRRANGE;
        BEGIN LCNT1 := 0; LLC := LC;
          REPEAT
            IF SY = IDENT THEN
              BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END
            ELSE BEGIN ERROR(2); LCP := UVARPTR END;
            SELECTOR(FSYS + [COMMA,DOSY],LCP);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR^.FORM = RECORDS THEN
                IF TOP < DISPLIMIT THEN
                  BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1;
                    WITH DISPLAY[TOP] DO
                      BEGIN FNAME := GATTR.TYPTR^.FSTFLD;
                        FLABEL := NIL
                      END;
                    IF GATTR.ACCESS = DRCT THEN
                      WITH DISPLAY[TOP] DO
                        BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL;
                          CDSPL := GATTR.DPLMT
                        END
                    ELSE
                      BEGIN LOADADDRESS;
                        ALIGN(NILPTR,LC);
                        GEN2T(56(*STR*),0,LC,NILPTR);
                        WITH DISPLAY[TOP] DO
                          BEGIN OCCUR := VREC; VDSPL := LC END;
                        LC := LC+PTRSIZE;
                        IF LC > LCMAX THEN LCMAX := LC
                      END
                  END
                ELSE ERROR(250)
              ELSE ERROR(140);
            TEST := SY <> COMMA;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS);
          TOP := TOP-LCNT1; LC := LLC;
        END (*WITHSTATEMENT*) ;

      BEGIN (*STATEMENT*)
        FILELOAD := TRUE; (* indicates file address has been loaded *)
        (* this value is set to FALSE initially by those procedures *)
        (* which require the use of a file variable.  It is used to *)
        (* tell procedure SELECTOR whether the address of a file    *)
        (* variable must be loaded onto the stack at that time.     *)
        IF SY = INTCONST THEN (*LABEL*)
          BEGIN LLP := DISPLAY[LEVEL].FLABEL;     (*PUG*)
            WHILE LLP <> NIL DO
              WITH LLP^ DO
                IF LABVAL = VAL.IVAL THEN
                  BEGIN IF DEFINED THEN ERROR(165);
                    PUTLABEL(LABNAME); DEFINED := TRUE;
                    GOTO 1
                  END
                ELSE LLP := NEXTLAB;
            ERROR(167);
      1:    INSYMBOL;
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5)
          END;
        IF NOT (SY IN FSYS + [IDENT]) THEN
          BEGIN ERROR(6); SKIP(FSYS) END;
        IF SY IN STATBEGSYS + [IDENT] THEN
          BEGIN
            PUTLINENO;
            CASE SY OF
              IDENT:    BEGIN SEARCHID([VARS,FIELD,FUNC,PROC],LCP); INSYMBOL;
                          IF LCP^.KLASS = PROC THEN CALL(FSYS,LCP)
                          ELSE ASSIGNMENT(LCP)
                        END;
              BEGINSY:  BEGIN BEGINLEVEL := BEGINLEVEL + 1;
                 INSYMBOL; COMPOUNDSTATEMENT END;
              GOTOSY:   BEGIN INSYMBOL; GOTOSTATEMENT END;
              IFSY:     BEGIN INSYMBOL; IFSTATEMENT END;
              CASESY:   BEGIN INSYMBOL; CASESTATEMENT END;
              WHILESY:  BEGIN INSYMBOL; WHILESTATEMENT END;
              REPEATSY: BEGIN INSYMBOL; REPEATSTATEMENT END;
              FORSY:    BEGIN INSYMBOL; FORSTATEMENT END;
              WITHSY:   BEGIN INSYMBOL; WITHSTATEMENT END
            END;
            IF NOT (SY IN [SEMICOLON,ENDSY,ELSESY,UNTILSY]) THEN
              BEGIN ERROR(6); SKIP(FSYS) END
          END
      END (*STATEMENT*) ;

    BEGIN (*BODY*)
      IF FPROCP <> NIL THEN BEGIN   (* generate code for subroutine *)
         ENTNAME := FPROCP^.PFNAME;
         IF PRCODE THEN BEGIN
            WRITELN (PRR);
            WRITELN (PRR, ' ':6, 'SUBROUTINE P', ENTNAME:1);
            IC := IC + 2
            END
         END
      ELSE BEGIN                    (* generate code for MAIN program *)
         GENLABEL (ENTNAME);
         IF PRCODE THEN BEGIN
            WRITELN (PRR);
            WRITELN (PRR, ' ':6, 'SUBROUTINE P$MAI', 'N');
            IC := IC + 2
            END
         END;
      IF FORTFUNC <> NIL THEN       (* look for fortran functions at *)
                                      (* this level *)
        WHILE ((FORTFUNC <> NIL) AND (FORTFUNC^.PFLEV = LEVEL)) DO
          BEGIN
          IF PRCODE THEN
            BEGIN
            IF FORTFUNC^.IDTYPE = INTPTR THEN
              WRITELN (PRR, ' ':6, 'INTEGER*4 ', FORTFUNC^.NAME:6)
            ELSE IF FORTFUNC^.IDTYPE = REALPTR THEN
              WRITELN (PRR, ' ':6, 'REAL ', FORTFUNC^.NAME:6);
            IC := IC + 1
            END;
          FORTFUNC := FORTFUNC^.NEXTFFUNC
          END;
      IF PRCODE THEN GENCREG;       (* generate definitions (creg) *)
      TOPNEW := 5; TOPMAX := 5;
      GENLABEL(SEGSIZE); GENLABEL(STACKTOP);
     IF PRCODE THEN BEGIN
        IF TRACEOPT THEN BEGIN
           WRITE (PRR, ' ':6, 'CALL T$TRAC(1,''');
           IF FPROCP <> NIL THEN
              WRITE (PRR, FPROCP^.NAME:8)
           ELSE
              WRITE (PRR, 'OUTER BLOCK');
           WRITELN (PRR, '.'')'); IC := IC + 1
           END;
        WRITELN(PRR,' ':6, 'GOTO ',SEGSIZE:1);
        WRITELN (PRR, '99998 CALL P$UJC'); IC := IC + 2 END;
     PUTLABEL(STACKTOP);
     IF PRCODE THEN BEGIN WRITELN(PRR,' ':6, 'CALL',' P$ENT(1,SG1SIZ)');
        WRITELN(PRR,' ':6, 'CALL',' P$ENT(2,SG2SIZ)'); IC := IC + 2 END;
     TMPTR := DISPLAY[TOP].FFILE;
     WHILE TMPTR <> NIL DO (* initialize all files for this level *)
       BEGIN IC := IC + 2;
       IF TMPTR^.FLEV <= 1 THEN GEN1(37(*LAO*),TMPTR^.FADDR)
       ELSE GEN2(50(*LDA*),LEVEL-TMPTR^.FLEV,TMPTR^.FADDR);
       GEN0(65(*INF*));
       TMPTR := TMPTR^.LNK
       END;
     IF FPROCP <> NIL THEN (*COPY MULTIPLE VALUES INTO LOACAL CELLS*)
        BEGIN LLC1 := LCAFTERMARKSTACK;
          LCP := FPROCP^.NEXT;
          WHILE LCP <> NIL DO
            WITH LCP^ DO
              BEGIN
                IF KLASS = VARS THEN
                  IF IDTYPE <> NIL THEN
                    IF (VKIND=ACTUAL) AND (IDTYPE^.FORM>POWER) THEN
                      BEGIN
                        GEN2(50(*LDA*),0,VADDR);
                        GEN2T(54(*LOD*),0,LLC1,NILPTR);
                        GEN1(40(*MOV*),IDTYPE^.SIZE);
                        LLC1 := LLC1 + PTRSIZE
                      END
                    ELSE LLC1 := LLC1 + IDTYPE^.SIZE;
                LCP := LCP^.NEXT;
              END;
        END;
      LCMAX := LC;
      REPEAT
        REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])
        UNTIL NOT (SY IN STATBEGSYS);
        TEST := SY <> SEMICOLON;
        IF NOT TEST THEN INSYMBOL
      UNTIL TEST;
      IF SY = ENDSY THEN BEGIN
         BEGINLEVEL := BEGINLEVEL - 1; INSYMBOL END
      ELSE ERROR (13);
      LLP := DISPLAY[TOP].FLABEL; (*TEST FOR UNDEFINED LABELS*)
      WHILE LLP <> NIL DO
        WITH LLP^ DO
          BEGIN
            IF NOT DEFINED THEN
              BEGIN ERROR(168);
                WRITELN(OUTPUT); WRITELN(OUTPUT,' LABEL ',LABVAL);
               WRITE(OUTPUT,' ':CHCNT+20)
              END;
            LLP := NEXTLAB
          END;
      TMPTR := DISPLAY[TOP].FFILE;
      WHILE TMPTR <> NIL DO
      (* go down open-file list, producing code to close each file *)
        BEGIN
        IF TMPTR^.FLEV <= 1 THEN GEN1(37(*LAO*),TMPTR^.FADDR)
        ELSE GEN2(50(*LDA*),LEVEL-TMPTR^.FLEV,TMPTR^.FADDR);
        IF TMPTR^.TYP THEN GEN0(63(*P$CLS*))
        ELSE BEGIN IC := IC + 1;
          WRITE(PRR, ' ':6, 'CALL', MN[64], '(', TMPTR^.AFLG:1, ',''');
          FOR I := 1 TO 8 DO WRITE(PRR, TMPTR^.FNAME[I]);
          WRITELN(PRR, ';'')')
          END;
        TMPTR := TMPTR^.LNK
        END;
      DISPLAY[TOP].FFILE := NIL;
      IF FPROCP <> NIL THEN       (* generate return from routine *)
        BEGIN
          IF FPROCP^.IDTYPE = NIL THEN GEN1(42(*RET*),0)
              ELSE GEN1(42(*RET*), 1);
          ALIGN(PARMPTR,LCMAX);
          IF PRCODE THEN BEGIN
              IF TRACEOPT THEN BEGIN
                 WRITELN (PRR, ' ':6, 'CALL T$TRAC(2,0)');
                 IC := IC + 1
                 END;
              WRITELN (PRR, ' ':6, 'RETURN');
              PUTLABEL(SEGSIZE);
              WRITELN(PRR,' ':6, 'SG1SIZ = ',LCMAX:1);
              WRITELN(PRR,' ':6, 'SG2SIZ = ',TOPMAX:1);
              WRITELN(PRR,' ':6, 'GOTO ',STACKTOP:1);
              WRITELN (PRR, ' ':6, 'END'); IC := IC + 5
            END
        END
      ELSE
        BEGIN GEN1(42(*RET*),0);
          ALIGN(PARMPTR,LCMAX);
          IF PRCODE THEN
            BEGIN
              IF TRACEOPT THEN BEGIN
                WRITELN (PRR, ' ':6, 'CALL T$TRAC(2,0)');
                IC := IC + 1
                END;
              WRITELN (PRR, ' ':6, 'RETURN');
              PUTLABEL(SEGSIZE);
              WRITELN(PRR,' ':6, 'SG1SIZ = ',LCMAX:1);
              WRITELN(PRR,' ':6, 'SG2SIZ = ',TOPMAX:1);
              WRITELN(PRR,' ':6, 'GOTO ',STACKTOP:1);
              WRITELN(PRR,' ':6, 'END'); IC := IC + 5
            END;
          SAVEID := ID;
          WHILE FEXTFILEP <> NIL DO
            BEGIN FILDEC := TRUE;
              WITH FEXTFILEP^ DO
                BEGIN ID := FILENAME; PRTERR := FALSE;
                SEARCHID([VARS],LLCP);
                IF LLCP = NIL THEN FILDEC := FALSE
                ELSE IF LLCP^.IDTYPE = NIL THEN FILDEC := FALSE
                ELSE IF LLCP^.IDTYPE^.FORM <> FILES THEN FILDEC := FALSE;
                IF NOT FILDEC THEN
                  BEGIN WRITELN(OUTPUT);
                  WRITELN(OUTPUT,' *****  ','UNDECLARED ','EXTERNAL ',
                       'FILE',FEXTFILEP^.FILENAME:9);
                  WRITE(OUTPUT,' ':CHCNT+20)
                  END
                END;
              FEXTFILEP := FEXTFILEP^.NEXTFILE
            END;
          ID := SAVEID
        END;
    END (*BODY*) ;

  BEGIN (*BLOCK*)
    DP := TRUE;
    REPEAT
      IF SY = LABELSY THEN
        BEGIN INSYMBOL; LABELDECLARATION END;
      IF SY = CONSTSY THEN
        BEGIN INSYMBOL; CONSTDECLARATION END;
      IF SY = TYPESY THEN
        BEGIN INSYMBOL; TYPEDECLARATION END;
      IF SY = VARSY THEN
        BEGIN INSYMBOL; VARDECLARATION END;
      WHILE SY IN [PROCSY,FUNCSY] DO
        BEGIN LSY := SY; INSYMBOL; PROCDECLARATION(LSY) END;
      IF SY <> BEGINSY THEN

        BEGIN ERROR (18); SKIP (FSYS) END
    UNTIL (SY IN STATBEGSYS) OR EOF(INPUT);
    DP := FALSE;
    IF SY = BEGINSY THEN BEGIN
       BEGINLEVEL := BEGINLEVEL + 1; INSYMBOL END
    ELSE ERROR (17);
    REPEAT BODY(FSYS + [CASESY]);
      IF SY <> FSY THEN
        BEGIN ERROR(6); SKIP(FSYS) END
    UNTIL ((SY = FSY) OR (SY IN BLOCKBEGSYS)) OR EOF(INPUT);
  END (*BLOCK*) ;

  PROCEDURE PROGRAMME(FSYS:SETOFSYS);
    (* parses program heading, calls BLOCK repeatedly *)
    VAR EXTFP:EXTFILEP;
  BEGIN
    IF SY = PROGSY THEN
      BEGIN INSYMBOL; IF SY <> IDENT THEN ERROR(2); INSYMBOL;
        IF NOT (SY IN [LPARENT,SEMICOLON]) THEN ERROR(14);
        IF SY = LPARENT  THEN
          BEGIN
            REPEAT INSYMBOL;
              IF SY = IDENT THEN
                BEGIN
                  IF ID = 'INPUT   ' THEN INPFLG := TRUE
                  ELSE IF ID = 'OUTPUT  ' THEN OUTFLG := TRUE
                  ELSE IF ID = 'PRR     ' THEN PRRFLG := TRUE
                  ELSE IF ID = 'KEYBOARD' THEN KBDFLG := TRUE
                  ELSE BEGIN NEW(EXTFP);
                    EXTFP^.FILENAME := ID;
                    EXTFP^.NEXTFILE := FEXTFILEP;
                    FEXTFILEP := EXTFP
                    END;
                  INSYMBOL;
                  IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20)
                END
              ELSE ERROR(2)
            UNTIL SY <> COMMA;
            IF SY <> RPARENT THEN ERROR(4);
            INSYMBOL
          END;
        IF SY <> SEMICOLON THEN ERROR(14)
        ELSE INSYMBOL;
      END;
    REPEAT BLOCK(FSYS,PERIOD,NIL);
      IF SY <> PERIOD THEN ERROR(21)
    UNTIL (SY = PERIOD) OR EOF(INPUT);
    IF LIST THEN WRITELN(OUTPUT);      (*PUG*)
    IF ERRINX > 0 THEN                 (*PUG*)
     BEGIN LIST := FALSE; ENDOFLINE END    (*PUG*)
  END (*PROGRAMME*) ;


  PROCEDURE STDNAMES;
  BEGIN
    NA[ 1] := 'FALSE   '; NA[ 2] := 'TRUE    '; NA[ 3] := 'INPUT   ';
    NA[ 4] := 'OUTPUT  '; NA[ 5] := 'GET     '; NA[ 6] := 'PUT     ';
    NA[ 7] := 'RESET   '; NA[ 8] := 'REWRITE '; NA[ 9] := 'READ    ';
    NA[10] := 'WRITE   '; NA[11] := 'PACK    '; NA[12] := 'UNPACK  ';
    NA[13] := 'NEW     '; NA[14] := 'RELEASE '; NA[15] := 'READLN  ';
    NA[16] := 'WRITELN '; NA[17] := 'PAGE    '; NA[18] := 'ABS     ';
    NA[19] := 'SQR     '; NA[20] := 'TRUNC   '; NA[21] := 'ODD     ';
    NA[22] := 'ORD     '; NA[23] := 'CHR     '; NA[24] := 'PRED    ';
    NA[25] := 'SUCC    '; NA[26] := 'EOF     '; NA[27] := 'EOLN    ';
    NA[28] := 'SIN     '; NA[29] := 'COS     '; NA[30] := 'EXP     ';
    NA[31] := 'SQRT    '; NA[32] := 'LN      '; NA[33] := 'ARCTAN  ';
    NA[34] := 'KEYBOARD'; NA[35] := 'PRR     '; NA[36] := 'MARK    ';
    NA[37] := 'TIME    '; NA[38] := 'DATE    ';
  END (*STDNAMES*) ;

  PROCEDURE ENTERSTDTYPES;
    (* allocates a STRUCTURE node which details structure form *)
    (* for each standard type *)
    VAR SP: STP;
  BEGIN                                                  (*TYPE UNDERLIEING:*)
                                                         (*******************)

    NEW(INTPTR,SCALAR,STANDARD);                              (*INTEGER*)
    WITH INTPTR^ DO
      BEGIN SIZE := INTSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(REALPTR,SCALAR,STANDARD);                             (*REAL*)
    WITH REALPTR^ DO
      BEGIN SIZE := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(CHARPTR,SCALAR,STANDARD);                             (*CHAR*)
    WITH CHARPTR^ DO
      BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END;
    NEW(BOOLPTR,SCALAR,DECLARED);                             (*BOOLEAN*)
    WITH BOOLPTR^ DO
      BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END;
    NEW(NILPTR,POINTER);                                      (*NIL*)
    WITH NILPTR^ DO
      BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END;
    NEW(PARMPTR,SCALAR,STANDARD); (*FOR ALIGNMENT OF PARAMETERS*)
    WITH PARMPTR^ DO
      BEGIN SIZE := PARMSIZE; FORM := SCALAR; SCALKIND := STANDARD END ;
    NEW(TEXTPTR,FILES);                                       (*TEXT*)
    WITH TEXTPTR^ DO
      BEGIN FILTYPE := CHARPTR; SIZE := CHARSIZE+1; FORM := FILES END
  END (*ENTERSTDTYPES*) ;

  PROCEDURE ENTSTDNAMES;
    VAR CP,CP1: CTP; I: INTEGER;
  BEGIN                                                       (*NAME:*)
                                                              (*******)

    NEW(CP,TYPES);                                            (*INTEGER*)
    WITH CP^ DO
      BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*REAL*)
    WITH CP^ DO
      BEGIN NAME := 'REAL    '; IDTYPE := REALPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*CHAR*)
    WITH CP^ DO
      BEGIN NAME := 'CHAR    '; IDTYPE := CHARPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*BOOLEAN*)
    WITH CP^ DO
      BEGIN NAME := 'BOOLEAN '; IDTYPE := BOOLPTR; KLASS := TYPES END;
    ENTERID(CP);
    NEW(CP,TYPES);                                            (*TEXT*)
    WITH CP^ DO
      BEGIN NAME := 'TEXT    '; IDTYPE := TEXTPTR; KLASS := TYPES END;
    ENTERID(CP);
    CP1 := NIL;
    FOR I := 1 TO 2 DO
      BEGIN NEW(CP,KONST);                                    (*FALSE,TRUE*)
        WITH CP^ DO
          BEGIN NAME := NA[I]; IDTYPE := BOOLPTR;
            NEXT := CP1; VALUES.IVAL := I - 1; KLASS := KONST
          END;
        ENTERID(CP); CP1 := CP
      END;
    BOOLPTR^.FCONST := CP;
    NEW(CP,KONST);                                             (*NIL*)
    WITH CP^ DO
      BEGIN NAME := 'NIL     '; IDTYPE := NILPTR;
        NEXT := NIL; VALUES.IVAL := 0; KLASS := KONST
      END;
    ENTERID(CP);
    NEW(CP,KONST);                                             (*MAXINT*)
    WITH CP^ DO
      BEGIN NAME := 'MAXINT  '; IDTYPE := INTPTR; KLASS := KONST;
        VALUES.IVAL := MAXINT; NEXT := NIL
      END;
    ENTERID(CP);
    FOR I := 3 TO 4 DO
      BEGIN NEW(CP,VARS);                                     (*INPUT,OUTPUT*)
        WITH CP^ DO
          BEGIN NAME := NA[I]; IDTYPE := TEXTPTR; KLASS := VARS;
            VKIND := ACTUAL; NEXT := NIL; VLEV := 1;
            VADDR := LCAFTERMARKSTACK+(I-3)*CHARMAX*2;
   (* note that two locations are reserved for each textfile *)
          END;
        ENTERID(CP)
      END;
    FOR I := 34 TO 35 DO
      BEGIN NEW(CP,VARS);                                     (*KEYBOARD,PRR FILES*)
         WITH CP^ DO
           BEGIN NAME := NA[I]; IDTYPE := TEXTPTR; KLASS := VARS;
              VKIND := ACTUAL; NEXT := NIL; VLEV := 1;
              VADDR := LCAFTERMARKSTACK+(I-32)*CHARMAX*2;
           END;
         ENTERID(CP)
      END;
    FOR I := 37 TO 38 DO                                      (*TIME,DATE*)
      BEGIN NEW(CP,PROC,STANDARD);
        WITH CP^ DO
          BEGIN NAME := NA[I]; IDTYPE := NIL;
          NEXT := NIL; KEY := I - 22; KLASS := PROC;
          PFDECKIND := STANDARD
          END;
        ENTERID(CP)
      END;
    FOR I := 5 TO 17 DO
      BEGIN NEW(CP,PROC,STANDARD);                         (*GET,PUT,RESET*)
        WITH CP^ DO                                           (*REWRITE,READ*)
          BEGIN NAME := NA[I]; IDTYPE := NIL;                 (*WRITE,PACK*)
            NEXT := NIL; KEY := I - 4;                        (*UNPACK,PACK*)
            KLASS := PROC; PFDECKIND := STANDARD             (*WRITELN,READLN*)
          END;                                                   (*PAGE*)
        ENTERID(CP)
      END;
    NEW(CP,PROC,STANDARD);
    WITH CP^ DO
        BEGIN NAME:=NA[36]; IDTYPE:=NIL;
              NEXT:= NIL; KEY:=14;
              KLASS:=PROC; PFDECKIND:= STANDARD
        END; ENTERID(CP);
    FOR I := 18 TO 27 DO
      BEGIN NEW(CP,FUNC,STANDARD);                         (*ABS,SQR,TRUNC*)
        WITH CP^ DO                                           (*ODD,ORD,CHR*)
          BEGIN NAME := NA[I]; IDTYPE := NIL;              (*PRED,SUCC,EOF*)
            NEXT := NIL; KEY := I - 17;
            KLASS := FUNC; PFDECKIND := STANDARD
          END;
        ENTERID(CP)
      END;
    NEW(CP,VARS);                      (*PARAMETER OF PREDECLARED FUNCTIONS*)
    WITH CP^ DO
      BEGIN NAME := '        '; IDTYPE := REALPTR; KLASS := VARS;
        VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 0
      END;
    FOR I := 28 TO 33 DO
      BEGIN NEW(CP1,FUNC,DECLARED,ACTUAL);                    (*SIN,COS,EXP*)
        WITH CP1^ DO                                       (*SQRT,LN,ARCTAN*)
          BEGIN NAME := NA[I]; IDTYPE := REALPTR; NEXT := CP;
            FORWDECL := FALSE; EXTDECL := TRUE; PFLEV := 0; PFNAME := I - 13;
            FORTDECL := FALSE;
            KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
          END;
        ENTERID(CP1)
      END
  END (*ENTSTDNAMES*) ;

  PROCEDURE ENTERUNDECL;
  BEGIN
    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; KLASS := TYPES END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
        VALUES.IVAL := 0; KLASS := KONST
      END;
    NEW(UVARPTR,VARS);
    WITH UVARPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; VKIND := ACTUAL;
        NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS
      END;
    NEW(UFLDPTR,FIELD);
    WITH UFLDPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;
        KLASS := FIELD
      END;
    NEW(UPRCPTR,PROC,DECLARED,ACTUAL);
    WITH UPRCPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; FORWDECL := FALSE;
        FORTDECL := FALSE;
        NEXT := NIL; EXTDECL := FALSE; PFLEV := 0; GENLABEL(PFNAME);
        KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END;
    NEW(UFCTPTR,FUNC,DECLARED,ACTUAL);
    WITH UFCTPTR^ DO
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;
        FORTDECL := FALSE;
        FORWDECL := FALSE; EXTDECL := FALSE; PFLEV := 0; GENLABEL(PFNAME);
        KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END
  END (*ENTERUNDECL*) ;

   PROCEDURE INITSCALARS;
     VAR  I: INTEGER;
   BEGIN
      TRACEOPT := FALSE;              (* compiler options defaults *)
      PRTABLES := FALSE;
      LIST := TRUE;
      PRCODE := TRUE;
      COMPCODE := FALSE;
      RANGECHECKS := TRUE;
      INITCHECKS := FALSE;
      PTRCHECKS := TRUE;
      INPFLG := FALSE; OUTFLG := FALSE; (* file flags *)
      KBDFLG := FALSE; PRRFLG := FALSE;
      STRGINDEX := 0;
      SETINDEX  := 0;
      BEGINLEVEL := 0; LINENUMBER := 0; PAGENUMBER := 0;
      LASTLINENO := 0;
      DP := TRUE; PRTERR := TRUE; ERRINX := 0;
      FWPTR := NIL;
      INTLABEL := 0; FEXTFILEP := NIL;
      LC := LCAFTERMARKSTACK+FILEBUFFER*CHARMAX;
      (* NOTE IN THE ABOVE RESERVATION OF BUFFER STORE FOR 4 TEXT FILES *)
      IC := 1; EOL := TRUE; LINECOUNT := 0;
      CH := ' '; CHCNT := 0;
      ERRSET1 := [ ];
      ERRSET2 := [ ];
      ERRLASTLIN := 0;
      GLOBTESTP := NIL;
      FORTFUNC := NIL;  LASTFFUNC := NIL;
      FOR I := 1 TO 8 DO
        BEGIN THEDATE[I] := ' '; THETIME[I] := ' ' END;
      DATE(THEDATE); TIME(THETIME)
   END; (*INITSCALARS*)


  PROCEDURE INITSETS;
  BEGIN
    CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];
    SIMPTYPEBEGSYS := [LPARENT] + CONSTBEGSYS;
    TYPEBEGSYS:=[ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY]+SIMPTYPEBEGSYS;
    TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];
    BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY,
                    BEGINSY];
    SELECTSYS := [ARROW,PERIOD,LBRACK];
    FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];
    STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,
                   CASESY];
  END (*INITSETS*) ;

  PROCEDURE INITTABLES;

    PROCEDURE RESWORDS;
    BEGIN
      RW[ 1] := 'IF      '; RW[ 2] := 'DO      '; RW[ 3] := 'OF      ';
      RW[ 4] := 'TO      '; RW[ 5] := 'IN      '; RW[ 6] := 'OR      ';
      RW[ 7] := 'END     '; RW[ 8] := 'FOR     '; RW[ 9] := 'VAR     ';
      RW[10] := 'DIV     '; RW[11] := 'MOD     '; RW[12] := 'SET     ';
      RW[13] := 'AND     '; RW[14] := 'NOT     '; RW[15] := 'THEN    ';
      RW[16] := 'ELSE    '; RW[17] := 'WITH    '; RW[18] := 'GOTO    ';
      RW[19] := 'CASE    '; RW[20] := 'TYPE    ';
      RW[21] := 'FILE    '; RW[22] := 'BEGIN   ';
      RW[23] := 'UNTIL   '; RW[24] := 'WHILE   '; RW[25] := 'ARRAY   ';
      RW[26] := 'CONST   '; RW[27] := 'LABEL   ';
      RW[28] := 'REPEAT  '; RW[29] := 'RECORD  '; RW[30] := 'DOWNTO  ';
      RW[31] := 'PACKED  '; RW[32] := 'EXTERN  '; RW[33] := 'FORWARD ';
      RW[34] := 'PROGRAM '; RW[35] := 'FORTRAN ';
      RW[36] := 'FUNCTION'; RW[37] := 'PROCEDUR';
      FRW[1] :=  1; FRW[2] :=  1; FRW[3] :=  7; FRW[4] := 15; FRW[5] := 22;
      FRW[6] := 28; FRW[7] := 33; FRW[8] := 36; FRW[9] := 38;
    END (*RESWORDS*) ;

    PROCEDURE ERRMSGS;
      VAR I : 1..400;

    BEGIN
      FOR I := 1 TO 400 DO
        EM[I] := '                                                  ';
      EM[1] := 'error in simple type                              ';
      EM[2] := 'identifier expected                               ';
      EM[3] := '''program'' expected                                ';
      EM[4] := ''')'' expected                                      ';
      EM[5] := ''':'' expected                                      ';
      EM[6] := 'illegal symbol                                    ';
      EM[7] := 'error in parameter list                           ';
      EM[8] := '''of'' expected                                     ';
      EM[9] := '''('' expected                                      ';
      EM[10] := 'error in type                                     ';
      EM[11] := '''['' expected                                      ';
      EM[12] := ''']'' expected                                      ';
      EM[13] := '''end'' expected                                    ';
      EM[14] := ''';'' expected                                      ';
      EM[15] := 'integer expected                                  ';
      EM[16] := '''='' expected                                      ';
      EM[17] := '''begin'' expected                                  ';
      EM[18] := 'error in declaration part                         ';
      EM[19] := 'error in field-list                               ';
      EM[20] := ''','' expected                                      ';
      EM[21] := '''*'' expected                                      ';
      EM[50] := 'error in constant                                 ';
      EM[51] := ''':='' expected                                     ';
      EM[52] := '''then'' expected                                   ';
      EM[53] := '''until'' expected                                  ';
      EM[54] := '''do'' expected                                     ';
      EM[55] := '''to''/''downto'' expected                            ';
      EM[56] := '''if'' expected                                     ';
      EM[57] := '''file'' expected                                   ';
      EM[58] := 'error in factor                                   ';
      EM[59] := 'error in variable                                 ';
      EM[60] := ''':'' or ''/'' expected                               ';
      EM[101] := 'identifier declared twice                         ';
      EM[102] := 'low bound exceeds highbound                       ';
      EM[103] := 'identifier is not of appropriate class            ';
      EM[104] := 'identifier not declared                           ';
      EM[105] := 'sign not allowed                                  ';
      EM[106] := 'number expected                                   ';
      EM[107] := 'incompatible subrange types                       ';
      EM[108] := 'file not allowed here                             ';
      EM[109] := 'type must not be real                             ';
      EM[110] := 'tagfield type must be scalar or subrange          ';
      EM[111] := 'incompatible with tagfield type                   ';
      EM[112] := 'index type must not be real                       ';
      EM[113] := 'index type must be scalar or subrange             ';
      EM[114] := 'base type must not be real                        ';
      EM[115] := 'base type must be scalar or subrange              ';
      EM[116] := 'error in type of standard procedure parameter     ';
      EM[117] := 'unsatisfied forward reference                     ';
      EM[118] := 'forward reference type id in variable decln       ';
      EM[119] := 'fwd declared; repetition of param list illegal    ';
      EM[120] := 'func result type must be scalar, subrange or ptr  ';
      EM[121] := 'file value parameter not allowed                  ';
      EM[122] := 'fwd declared function; cannot repeat result type  ';
      EM[123] := 'missing result type in function declaration       ';
      EM[124] := 'F-format for real only                            ';
      EM[125] := 'error in type of standard function parameter      ';
      EM[126] := 'number of params does not agree with declaration  ';
      EM[127] := 'illegal parameter substitution                    ';
      EM[128] := 'result type of param func does not agree with decl';
      EM[129] := 'type conflict of operands                         ';
      EM[130] := 'expression is not of set type                     ';
      EM[131] := 'tests on equality allowed only                    ';
      EM[132] := 'strict inclusion not allowed                      ';
      EM[133] := 'file comparison not allowed                       ';
      EM[134] := 'illegal type of operand(s)                        ';
      EM[135] := 'type of operand must be Boolean                   ';
      EM[136] := 'set element type must be scalar or subrange       ';
      EM[137] := 'set element types not compatible                  ';
      EM[138] := 'type of variable is not array                     ';
      EM[139] := 'index type is not compatible with declaration     ';
      EM[140] := 'type of variable is not record                    ';
      EM[141] := 'type of variable must be file or pointer          ';
      EM[142] := 'illegal parameter substitution                    ';
      EM[143] := 'illegal type of loop control variable             ';
      EM[144] := 'illegal type of expression                        ';
      EM[145] := 'type conflict                                     ';
      EM[146] := 'assignment of files not allowed                   ';
      EM[147] := 'label type incompatible with selecting expr       ';
      EM[148] := 'subrange bounds must be scalar                    ';
      EM[149] := 'index type must not be integer                    ';
      EM[150] := 'assignment to standard function is not allowed    ';
      EM[151] := 'assignment to formal function is not allowed      ';
      EM[152] := 'no such field in this record                      ';
      EM[153] := 'type error in read                                ';
      EM[154] := 'actual parameter must be a variable               ';
      EM[155] := 'control variable can''t be formal or non local     ';
      EM[156] := 'multidefined case label                           ';
      EM[157] := 'too many cases in case statement                  ';
      EM[158] := 'missing corresponding variant declaration         ';
      EM[159] := 'real or string tagfields not allowed              ';
      EM[160] := 'previous declaration was not forward              ';
      EM[161] := 'again forward declared                            ';
      EM[162] := 'parameter size must be constant                   ';
      EM[163] := 'missing variant in declaration                    ';
      EM[164] := 'substitution of standard proc/func not allowed    ';
      EM[165] := 'multidefined label                                ';
      EM[166] := 'multideclared label                               ';
      EM[167] := 'undeclared label                                  ';
      EM[168] := 'undefined label                                   ';
      EM[169] := 'error in base set                                 ';
      EM[170] := 'value parameter expected                          ';
      EM[171] := 'standard file was redeclared                      ';
      EM[172] := 'undeclared external file                          ';
      EM[173] := 'Fortran procedure or function expected            ';
      EM[174] := 'Pascal procedure or function expected             ';
      EM[175] := 'missing file ''input'' in program heading           ';
      EM[176] := 'missing file ''output'' in program heading          ';
      EM[177] := 'assgt to function identifier not allowed here     ';
      EM[178] := 'multidefined record variant                       ';
      EM[179] := 'X-opt of actual proc/func does not match decl     ';
      EM[180] := 'control variable must not be formal               ';
      EM[181] := 'constant part of address out of range             ';
      EM[182] := 'file must be file of char                         ';
      EM[183] := 'pathname linkage not allowed for temporary files  ';
      EM[201] := 'error in real constant: digit expected            ';
      EM[202] := 'string constant must not exceed source line       ';
      EM[203] := 'integer constant exceeds range                    ';
      EM[204] := '8 or 9 in octal number                            ';
      EM[205] := 'string constant length must not be zero           ';
      EM[206] := 'integer part of real constant exceeds range       ';
      EM[250] := 'too many nested scopes of identifiers             ';
      EM[251] := 'too many nested procedures and/or functions       ';
      EM[252] := 'too many forward references of procedure entries  ';
      EM[253] := 'procedure too long                                ';
      EM[254] := 'too many long constants in this procedure         ';
      EM[255] := 'too many errors on this source line               ';
      EM[256] := 'too many external references                      ';
      EM[257] := 'too many externals                                ';
      EM[258] := 'too many local files                              ';
      EM[259] := 'expression too complicated                        ';
      EM[260] := 'too many exit labels                              ';
      EM[261] := 'pathname too long                                 ';
      EM[300] := 'division by zero                                  ';
      EM[301] := 'no case provided for this value                   ';
      EM[302] := 'index expression out of bounds                    ';
      EM[303] := 'value to be assigned is out of bounds             ';
      EM[304] := 'element expression out of range                   ';
      EM[350] := 'unknown -- see procedure selector                 ';
      EM[351] := 'unknown -- see recog of string const in insymbol  ';
      EM[352] := 'unknown -- see procedure gentypindicator          ';
      EM[353] := 'unknown -- see procedure store                    ';
      EM[354] := 'reading of packed arrays not implemented          ';
      EM[355] := 'unknown -- see procedure loadaddress              ';
      EM[356] := 'unknown -- see procedure loadaddress              ';
      EM[397] := 'fortran func result type must be integer or real  ';
      EM[398] := 'implementation restriction                        ';
      EM[399] := 'miscellaneous                                     ';
      EM[400] := 'not implemented in this version                   '
    END;   (* error messages *)

    PROCEDURE SYMBOLS;
    BEGIN
      RSY[1] := IFSY; RSY[2] := DOSY; RSY[3] := OFSY; RSY[4] := TOSY;
      RSY[5] := RELOP; RSY[6] := ADDOP; RSY[7] := ENDSY; RSY[8] := FORSY;
      RSY[9] := VARSY; RSY[10] := MULOP; RSY[11] := MULOP; RSY[12] := SETSY;
      RSY[13] := MULOP; RSY[14] := NOTSY; RSY[15] := THENSY;
      RSY[16] := ELSESY; RSY[17] := WITHSY; RSY[18] := GOTOSY;
      RSY[19] := CASESY; RSY[20] := TYPESY;
      RSY[21] := FILESY; RSY[22] := BEGINSY;
      RSY[23] := UNTILSY; RSY[24] := WHILESY; RSY[25] := ARRAYSY;
      RSY[26] := CONSTSY; RSY[27] := LABELSY;
      RSY[28] := REPEATSY; RSY[29] := RECORDSY; RSY[30] := DOWNTOSY;
      RSY[31] := PACKEDSY; RSY[32] := EXTERNSY; RSY[33] := FORWARDSY;
      RSY[34] := PROGSY; RSY[35] := FORTRANSY;
      RSY[36] := FUNCSY; RSY[37] := PROCSY;
      SSY['+'] := ADDOP; SSY['-'] := ADDOP; SSY['*'] := MULOP;
      SSY['/'] := MULOP; SSY['('] := LPARENT; SSY[')'] := RPARENT;
      SSY['$'] := OTHERSY; SSY['='] := RELOP; SSY[' '] := OTHERSY;
      SSY[','] := COMMA; SSY['.'] := PERIOD; SSY[''''] := OTHERSY;
      SSY['['] := LBRACK; SSY[']'] := RBRACK; SSY[':'] := COLON;
      SSY['^'] := ARROW; SSY['{'] := LCURBRK; SSY['}'] := RCURBRK;
      SSY['<'] := RELOP; SSY['>'] := RELOP; SSY['"'] := DQUOTE;
      SSY[';'] := SEMICOLON;
    END (*SYMBOLS*) ;

    PROCEDURE RATORS;
      VAR I: INTEGER; CH: CHAR;
    BEGIN
      FOR I := 1 TO 37 (*NR OF RES WORDS*) DO ROP[I] := NOOP;
      ROP[5] := INOP; ROP[10] := IDIV; ROP[11] := IMOD;
      ROP[6] := OROP; ROP[13] := ANDOP;
      FOR CH := CHR(ORDMINCHAR) TO CHR(ORDMAXCHAR) DO SOP[CH] := NOOP;
      SOP['+'] := PLUS; SOP['-'] := MINUS; SOP['*'] := MUL; SOP['/'] := RDIV;
      SOP['='] := EQOP;
      SOP['<'] := LTOP; SOP['>'] := GTOP;
    END (*RATORS*) ;

    PROCEDURE PROCMNEMONICS;

    (* Standard procedure names *)

    BEGIN
      SNA[ 1]:=' P$GET';SNA[ 2]:=' P$PUT';SNA[ 3]:=' P$RDI';SNA[ 4]:=' P$RDR';
      SNA[ 5]:=' P$RDC';SNA[ 6]:=' P$WRI';SNA[ 7]:=' P$WRO';SNA[ 8]:=' P$WRR';
      SNA[ 9]:=' P$WRC';SNA[10]:=' P$WRS';SNA[11]:=' P$PAK';SNA[12]:=' P$NEW';
      SNA[13]:=' P$RST';SNA[14]:=' P$ELN';SNA[15]:=' P$SIN';SNA[16]:=' P$COS';
      SNA[17]:=' P$EXP';SNA[18]:=' P$SQT';SNA[19]:=' P$LOG';SNA[20]:=' P$ATN';
      SNA[21]:=' P$RLN';SNA[22]:=' P$WLN';SNA[23]:=' P$SAV';SNA[24]:=' P$RES';
      SNA[25]:=' P$RWR';SNA[26]:=' P$PAG';SNA[27]:=' P$BRD';SNA[28]:=' P$BWR';
      SNA[29]:=' P$DAT'
    END (*PROCMNEMONICS*) ;

    PROCEDURE INSTRMNEMONICS;

    (* Interpreter instruction mnemonics (calls) *)

    BEGIN
      MN[0] :=' P$ABI'; MN[1] :=' P$ABR'; MN[2] :=' P$ADI'; MN[3] :=' P$ADR';
      MN[4] :=' P$AND'; MN[5] :=' P$DIF'; MN[6] :=' P$DVI'; MN[7] :=' P$DVR';
      MN[8] :=' P$EOF'; MN[9] :=' P$FLO'; MN[10]:=' P$FLT'; MN[11]:=' P$INN';
      MN[12]:=' P$INT'; MN[13]:=' P$IOR'; MN[14]:=' P$MOD'; MN[15]:=' P$MPI';
      MN[16]:=' P$MPR'; MN[17]:=' P$NGI'; MN[18]:=' P$NGR'; MN[19]:=' P$NOT';
      MN[20]:=' P$ODD'; MN[21]:=' P$SBI'; MN[22]:=' P$SBR'; MN[23]:=' P$SGS';
      MN[24]:=' P$SQI'; MN[25]:=' P$SQR'; MN[26]:=' P$STO'; MN[27]:=' P$TRC';
      MN[28]:=' P$UNI'; MN[29]:=' P$STP'; MN[30]:=' P$CSP'; MN[31]:=' P$DEC';
      MN[32]:=' P$ENT'; MN[33]:=' P$FJP'; MN[34]:=' P$INC'; MN[35]:=' P$IND';
      MN[36]:=' P$IXA'; MN[37]:=' P$LAO'; MN[38]:=' P$LCA'; MN[39]:=' P$LDO';
      MN[40]:=' P$MOV'; MN[41]:=' P$MST'; MN[42]:=' P$RET'; MN[43]:=' P$SRO';
      MN[44]:=' P$XJP'; MN[45]:=' P$CHK'; MN[46]:=' P$CUP'; MN[47]:=' P$EQU';
      MN[48]:=' P$GEQ'; MN[49]:=' P$GRT'; MN[50]:=' P$LDA'; MN[51]:=' P$LDC';
      MN[52]:=' P$LEQ'; MN[53]:=' P$LES'; MN[54]:=' P$LOD'; MN[55]:=' P$NEQ';
      MN[56]:=' P$STR'; MN[57]:=' P$UJP'; MN[58]:='      '; MN[59]:=' P$MTS';
      MN[60]:=' P$UJC'; MN[61]:=' P$LPC'; MN[62]:=' P$SPC'; MN[63]:=' P$CLS';
      MN[64]:=' P$REM'; MN[65]:=' P$INF';
    END (*INSTRMNEMONICS*) ;


     PROCEDURE CHARTYPES;
     VAR C : CHAR;
     BEGIN
       FOR C := CHR (ORDMINCHAR) TO CHR (ORDMAXCHAR) DO CHARTP[C] := ILLEGAL;
       FOR C := 'A' TO 'Z' DO CHARTP [C] := LETTER;
       FOR C := 'a' TO 'z' DO CHARTP [C] := LETTER;
       FOR C := '0' TO '9' DO CHARTP [C] := NUMBER;
       CHARTP['_'] := LETTER ; CHARTP['+'] := SPECIAL;
       CHARTP['-'] := SPECIAL; CHARTP['*'] := SPECIAL;
       CHARTP['/'] := SPECIAL; CHARTP['('] := SPECIAL;
       CHARTP[')'] := SPECIAL; CHARTP['$'] := SPECIAL;
       CHARTP['='] := SPECIAL; CHARTP[' '] := SPECIAL;
       CHARTP[','] := SPECIAL; CHARTP['.'] := SPECIAL;
       CHARTP['''']:= SPECIAL; CHARTP['['] := SPECIAL;
       CHARTP[']'] := SPECIAL; CHARTP[':'] := SPECIAL;
       CHARTP['^'] := SPECIAL; CHARTP[';'] := SPECIAL;
       CHARTP['<'] := SPECIAL; CHARTP['>'] := SPECIAL;
       CHARTP['{'] := SPECIAL; CHARTP['}'] := SPECIAL;
       CHARTP['"'] := SPECIAL;

       ORDINT['0'] := 0; ORDINT['1'] := 1; ORDINT['2'] := 2;
       ORDINT['3'] := 3;
       ORDINT['4'] := 4; ORDINT['5'] := 5; ORDINT['6'] := 6;
       ORDINT['7'] := 7; ORDINT['8'] := 8; ORDINT['9'] := 9

     END;

    PROCEDURE INITDX;
    BEGIN
      CDX[ 0] :=  0; CDX[ 1] :=  0; CDX[ 2] := -1; CDX[ 3] := -1;
      CDX[ 4] := -1; CDX[ 5] := -8; CDX[ 6] := -1; CDX[ 7] := -1;
      CDX[ 8] :=  0; CDX[ 9] :=  0; CDX[10] :=  0; CDX[11] := -8;
      CDX[12] := -8; CDX[13] := -1; CDX[14] := -1; CDX[15] := -1;
      CDX[16] := -1; CDX[17] :=  0; CDX[18] :=  0; CDX[19] :=  0;
      CDX[20] :=  0; CDX[21] := -1; CDX[22] := -1; CDX[23] := +7;
      CDX[24] :=  0; CDX[25] :=  0; CDX[26] := -2; CDX[27] :=  0;
      CDX[28] := -8; CDX[29] :=  0; CDX[30] :=  0; CDX[31] :=  0;
      CDX[32] :=  0; CDX[33] := -1; CDX[34] :=  0; CDX[35] :=  0;
      CDX[36] := -1; CDX[37] := +1; CDX[38] := +1; CDX[39] := +1;
      CDX[40] := -2; CDX[41] :=  0; CDX[42] :=  0; CDX[43] := -1;
      CDX[44] := -1; CDX[45] :=  0; CDX[46] :=  0; CDX[47] := -1;
      CDX[48] := -1; CDX[49] := -1; CDX[50] := +1; CDX[51] := +1;
      CDX[52] := -1; CDX[53] := -1; CDX[54] := +1; CDX[55] := -1;
      CDX[56] := -1; CDX[57] :=  0; CDX[58] :=  0; CDX[59] := +6;
      CDX[60] :=  0; CDX[61] := -1; CDX[62] := -3; CDX[63] := -1;
      CDX[64] := -1; CDX[65] := -1;
      PDX[ 1] := -1; PDX[ 2] := -1; PDX[ 3] := -1; PDX[ 4] := -1;
      PDX[ 5] := -1; PDX[ 6] := -2; PDX[ 7] := -3; PDX[ 8] := -3;
      PDX[ 9] := -2; PDX[10] := -3; PDX[11] :=  0; PDX[12] := -2;
      PDX[13] := -1; PDX[14] :=  0; PDX[15] :=  0; PDX[16] :=  0;
      PDX[17] :=  0; PDX[18] :=  0; PDX[19] :=  0; PDX[20] :=  0;
      PDX[21] := -1; PDX[22] := -1; PDX[23] := -1; PDX[24] := -1;
      PDX[25] := -1; PDX[26] := -1; PDX[27] := -1; PDX[28] := -1;
      PDX[29] := -2;
    END;

   BEGIN (*INITTABLES*)
     RESWORDS; SYMBOLS; RATORS;
     INSTRMNEMONICS; PROCMNEMONICS;
     CHARTYPES; INITDX;
     ERRMSGS
   END (*INITTABLES*) ;

 BEGIN   (* main body of compiler *)
   (*INITIALIZE*)
   (************)
   INITSCALARS; INITSETS; INITTABLES;


   (*ENTER STANDARD NAMES AND STANDARD TYPES:*)
   (******************************************)

   LEVEL := 0; TOP := 0;
   (* level 0 contains the standard names and standard types *)
   (* in the symbol table *)
   IF PRCODE THEN BEGIN
      WRITELN (PRR, ' ':6, 'CALL MAIN');
      WRITELN (PRR, ' ':6, 'END');
      IC := IC + 2
      END;

   WITH DISPLAY [0] DO BEGIN
      FNAME := NIL; FLABEL := NIL; OCCUR := BLCK
      END;

   ENTERSTDTYPES; STDNAMES; ENTSTDNAMES; ENTERUNDECL;

   (* initialize for first level of user symbol table entries *)
   TOP := 1; LEVEL := 1;
   WITH DISPLAY [1] DO BEGIN
      FNAME := NIL; FLABEL := NIL; FFILE := NIL; OCCUR := BLCK
      END;


   (* COMPILE *)
   (***********)

   INSYMBOL;
   PROGRAMME (BLOCKBEGSYS + STATBEGSYS - [CASESY]);
   PRINTERRMSGS;

   IF PRCODE THEN BEGIN
      WRITELN (PRR, ' ':6, 'SUBROUTINE MAIN');
      WRITELN (PRR, ' ':6, 'INTEGER*4 STRGS (',
                   ((MAXSTRGINDEX+1) DIV 4):4, '), SETS (400)');
      PUTCOMDEFS;
      IF SETINDEX > 0 THEN BEGIN
         WRITELN(PRR);
         WRITELN(PRR,' ':6, 'DATA SETS /');
         FOR I := 0 TO SETINDEX-1 DO BEGIN
            WRITE(PRR,'     +:');
            IF 31 IN SETTABLE [I] THEN K := 2 ELSE K := 0;
            IF 30 IN SETTABLE [I] THEN K := K + 1;
            WRITE(PRR,K:1);
            J := 29;
            WHILE J > -1 DO BEGIN
               K := 0;
               IF J IN SETTABLE[I] THEN K := K + 4;
               IF (J-1) IN SETTABLE[I] THEN K := K + 2;
               IF (J-2) IN SETTABLE[I] THEN K := K + 1;
               WRITE(PRR,K:1);
               J := J - 3
               END;
            WRITELN(PRR,',')
            END;
         IF (MAXSETINDEX - SETINDEX + 1) > 0 THEN
            WRITELN (PRR, ' ':5, '+', (MAXSETINDEX-SETINDEX+1):1, '*0/')
         END;

      IF STRGINDEX > 0 THEN BEGIN
         WRITELN(PRR);
         WRITELN(PRR,' ':6, 'DATA STRGS /');
         K := STRGINDEX - 32; I := 0;
         WHILE I < K DO BEGIN
            WRITE (PRR, ' ':5, '+32H');
            FOR J := I TO I + 31 DO
               WRITE (PRR, STRGTABLE [J]);
            I := I + 32; WRITELN (PRR, ',')
            END;
         IF (STRGINDEX - I) > 0 THEN BEGIN
            WRITE (PRR, ' ':5, '+', (STRGINDEX - I):1, 'H');
            FOR J := I TO STRGINDEX - 1 DO
               WRITE (PRR, STRGTABLE [J])
            END;
         IF (MAXSTRGINDEX - STRGINDEX + 1) > 0 THEN
            WRITE (PRR, ',', ((MAXSTRGINDEX-STRGINDEX+1) DIV 4):1, '*0');
         WRITELN (PRR, '/')
         END;
      WRITELN (PRR);
      WRITELN (PRR, ' ':6, 'CALL MOVE2S(LOC(STRGS), LOC(STRTBL), ',
               STRGINDEX DIV 2:1, ')');
      WRITELN (PRR, ' ':6, 'CALL MOVE2S(LOC(SETS), LOC(SETTBL), ',
               SETINDEX * 2:1, ')');
      IF INPFLG THEN K := 1 ELSE K := 0;
      WRITELN (PRR, ' ':6, 'CALL P$INIT(', K:1, ')');
      WRITELN (PRR, ' ':6, 'CALL P$MST(0)');
      WRITELN (PRR, ' ':6, 'CALL P$CUP(0)');
      WRITELN (PRR, ' ':6, 'CALL P$MAIN');
      IF COMPCODE THEN
        BEGIN
        ID := 'ERRKTR  ';
        SEARCHID([VARS],LCP);
        WRITELN(PRR, ' ':6, 'CALL P$LAO(', LCP^.VADDR:1, ')');
        WRITELN(PRR, ' ':6, 'CALL P$FMS('' errors in pascal program.'')')
        END;
      WRITELN (PRR, ' ':6, 'CALL P$STP');
      WRITELN (PRR, ' ':6, 'END');
      END
END.