(*$L-   ZPAS7, SEPT 22, 78 *)
 (******************************************************************
  *                                                                *
  *                                                                *
  *    STEP-WISE DEVELOPMENT OF A PASCAL COMPILER                  *
  *    ******************************************                  *
  *                                                                *
  *                                                                *
  *    STEP 5:   SYNTAX ANALYSIS INCLUDING ERROR                   *
  *              HANDLING; CHECKS BASED ON DECLARA-                *
  *    10/7/73   TIONS; ADDRESS AND CODE GENERATION                *
  *              FOR A HYPOTHETICAL STACK COMPUTER                 *
  *                                                                *
  *                                                                *
  *    AUTHOR:   URS AMMANN                                        *
  *              FACHGRUPPE COMPUTERWISSENSCHAFTEN                 *
  *              EIDG. TECHNISCHE HOCHSCHULE                       *
  *              CH-8006 ZUERICH                                   *
  *                                                                *
  *                                                                *
  *    MODIFICATION OF STEP 5 OF PASCAL COMPILER                   *
  *    *****************************************                   *
  *                                                                *
  *    THE COMPILER IS NOW WRITTEN IN A SUBSET OF                  *
  *    STANDARD PASCAL  -  AS DEFINED IN THE NEW                   *
  *    MANUAL BY K. JENSEN AND N. WIRTH  - AND IT                  *
  *    PROCESSES EXACTLY THIS SUBSET.                              *
  *                                                                *
  *    AUTHOR OF CHANGES:   KESAV NORI                             *
  *                         COMPUTER GROUP                         *
  *                         T.I.F.R.                               *
  *                         HOMI BHABHA ROAD                       *
  *                         BOMBAY - 400005                        *
  *                         INDIA                                  *
  *                                                                *
  *    THESE CHANGES WERE COMPLETED AT ETH, ZURICH                 *
  *    ON 20/5/74.                                                 *
  *                                                                *
  *                                                                *
  *    +++++++++++++++++++++++++++++++++++++++++++                 *
  *                                                                *
  *                                                                *
  *                                                                *
  *    THE COMPILER IS NOW CHANGED TO:                             *
  *    *******************************                             *
  *                                                                *
  *                                                                *
  *      -PRODUCE  THE  INTERMEDIATE  CODE  IN  AN   ASSEMBLER     *
  *      READABLE  FORM  WITH  NO EXTRA SPACES BETWEEN VARIOUS     *
  *      FIELDS, 15-NOV-75                                         *
  *                                                                *
  *      -PRESERVE PROCEDURE NAMES AND THEIR STATIC LEVELS  AT     *
  *      THE  OBJECT  LEVEL,  THUS ALLOWING A SET OF 'DISPLAY'     *
  *      REGISTERS  TO  BE  USED   IN   ACCESSING   NON_LOCAL,     *
  *      NON_GLOBAL  VARIABLES  (INSTEAD  OF  GOING  THROUGH A     *
  *      CHAIN OF POINTERS), 10-DEC-75.                            *
  *                                                                *
  *      -INCLUDE  THE   TYPE   OF   THE   OPERANDS   IN   THE     *
  *      P_INSTRUCTIONS AS FOLLOWS:                                *
  *                                                                *
  *           A : ADDRESS (POINTER) OPERAND                        *
  *           B : BOOLEAN              "                           *
  *           C : CHARACTER            "                           *
  *           I : INTEGER              "                           *
  *           R : REAL                 "                           *
  *           S : SET                  "                           *
  *                                                                *
  *      THE  P_INSTRUCTION  NOW  LOOKS  LIKE:   (LAB)  OPCODE     *
  *      (TYPE),(OPERANDS)   A   NEW    PROCEDURE    'EXIT(RC:     *
  *      INTEGER)'  IS ADDED TO THE SET OF STANDARD PROCEDURES     *
  *      TO FACILITATE TERMINATING A PROGRAM AT ANY POINT  AND     *
  *      RETURNING  A  'RETURN  CODE' TO THE OPERATING SYSTEM,     *
  *      26-JAN-76.                                                *
  *                                                                *
  *      -TREAT THE INPUT AS A TEXT FILE WITH LINES  (RECORDS)     *
  *      OF LINELGTH CHAR.  EACH, THIS ALLOWS A MORE EFFICIENT     *
  *      STRING ORIENTED INPUT, 20-MAR-76.                         *
  *                                                                *
  *      -'READ' OF 'STRING' VARIABLES (I.E.  ARRAY  OF  CHAR)     *
  *      IS  NOW  IMPLEMENTED  AND  IT  IS  TO  COMPLEMENT THE     *
  *      SIMILAR  'WRITE'   FUNCTION.    ALSO   THE   STANDARD     *
  *      PROCEDURE:   TRAP(I:   INTEGER; VAR V:  [ANY TYPE] );     *
  *      IS  ADDED  TO  THE  SET  OF  STANDARD  PROCEDURES  TO     *
  *      FACILITATE COMMUNICATION WITH THE  OUT-  SIDE  WORLD,     *
  *      10-SEP-76.                                                *
  *                                                                *
  *      -RELEVENT INFORMATION  ON/ABOUT  PROCEDURES  ARE  NOW     *
  *      SENT  TO  'QRD' FILE.  THIS INCLUDES SUCH INFORMATION     *
  *      AS THE SIZE OF THE PROCE- DURE AS WELL  AS  ITS  DATA     *
  *      AREA,  LIST  OF  THE  PROCEDURES  CALLED AND THE # OF     *
  *      CALLS,  THE  LEVEL  OF  THE  HIGHEST_LEVEL  PROCEDURE     *
  *      CALLED ETC.  THIS INFORMATION IS MAINLY INTENDED  FOR     *
  *      INTER_PROCEDURAL  ANALYSIS, BUT IT IS ALSO USEFUL FOR     *
  *      MORE EFFICIENT PROCEDURE ENTRY/EXIT CODE, 22-MAR-77.      *
  *                                                                *
  *      -THE COMPILER  IS  NOW  SET  UP  TO  GENERATE  P_CODE     *
  *      SUITABLE FOR A MICRO_PROCESSOR  IMPLEMENTATION.   THE     *
  *      LENGTH (IN # OF BYTES) OF BASIC DATA TYPES AS WELL AS     *
  *      THE FORMAT OF THE OUTPUT IS (SLIGHTLY) DIFFERENT FROM     *
  *      THAT OF THE 370 VERSION.  ERROR NO.  "260" IS USED TO     *
  *      FLAG  DECLARATION  OF  LARGE  DIMENSIONED  ARRAYS, OR     *
  *      OTHER DATA STRUCTURES, WHICH RESULT  IN  OUT-OF-RANGE     *
  *      ADDRESSES, 11-FEB-78.                                     *
  *                                                                *
  *      -TO BE COMPATIBLE WITH THE PASCAL-6000 THE FILE  NAME     *
  *      AS  WELL  AS  THE  ARGUMENT  LIST  MAY BE OMITTED FOR     *
  *      CERTAIN I/O RELATED OPERATIONS,  IN  WHICH  CASE  THE     *
  *      APPROPRIATE  DEFAULT  FILE  WILL  BE  USED  FOR  THAT     *
  *      OPERATION.  FOR EXAMPLE STATEMENTS SUCH AS "WRITELN",     *
  *      "WRITELN()"  OR  "WRITELN(OUTPUT)"  WILL HAVE SIMILAR     *
  *      EFFECT.  LIKEWISE "EOF(INPUT)", "EOF()" OR "EOF" WILL     *
  *      TRANSLATE INTO IDENTICAL EXPRESSIONS, 23-MAY-78.          *
  *                                                                *
  *                                                                *
  *                                                                *
  *                                                                *
  *                         S. HAZEGHI                             *
  *                                                                *
  *                         COMPUTATION RESEARCH GROUP             *
  *                         STANFORD LINEAR ACCELERATOR CENTER     *
  *                         STANFORD, CA. 94305.                   *
  *                                                                *
  *                                                                *
  *                                                                *
  ******************************************************************)


PROGRAM PASCALCOMPILER(INPUT,OUTPUT);


CONST
      DISPLIMIT    = 16;     MAXLEVEL   = 8;    MAXADDR     = 32000 ;
      INTSIZE      = 2;    (* REALSIZE   = 8; *)
      CHARSIZE     = 2;  (*  BOOLSIZE   = 2; *)  SETSIZE    =8;    PTRSIZE = 2;
   (* LCAFTMST     =  0;     FPSAVEAREA = 0 ;    RUNCHKAREA  = 0 ;
   (* DSPLYAREA    = 0 ;     FNCRSLT    = 0 ;   LCAFTFNCRSLT = 8 ;
   (* FIRSTFILEBUF = 0 ;     (* = LCAFTMST+RUNCHKAREA+DSPLYAREA *)
      LASTFILBUF   =  8 ;    (* LAST FILE BUFFER / FIRST PROG. VARIABLE *)
      STRGLNGTH    = 48;     MAXINT      = 32767 ;  ORDMAXCHAR = 63 ;
      REALLNGTH    = 11 ;    (* SHOULD BE LESS THAN STRGLGTH *)
      DIGMAX       = 10 ;    (* REALLNGHT-1*)
   (* IDLNGTH      =  8 ; *)
      SETRANGE     = 63 ;
## ## LINELGTH     = 81 ;
   (* MAXPROC      = 99 ;  *)
      BLANKID      = '        ' ;



TYPE                                                        (*DESCRIBING:*)
                                                            (*************)


                                                            (*BASIC SYMBOLS*)
                                                            (***************)

     SYMBOL = (IDENT,INTCONST,REALCONST,STRINGCONST,NOTSY,MULOP,ADDOP,RELOP,
               LPARENT,RPARENT,LBRACK,RBRACK,COMMA,SEMICOLON,PERIOD,ARROW,
               COLON,BECOMES,LABELSY,CONSTSY,TYPESY,VARSY,FUNCSY,PROGSY,
               PROCSY,SETSY,PACKEDSY,ARRAYSY,RECORDSY,FILESY,FORWARDSY,
               BEGINSY,IFSY,CASESY,REPEATSY,WHILESY,FORSY,WITHSY,
               GOTOSY,ENDSY,ELSESY,UNTILSY,OFSY,DOSY,TOSY,DOWNTOSY,
               THENSY,OTHERSY);
     OPERATOR = (MUL,RDIV,ANDOP,IDIV,IMOD,PLUS,MINUS,OROP,LTOP,LEOP,GEOP,GTOP,
                 NEOP,EQOP,INOP,NOOP);
     SETOFSYS = SET OF SYMBOL;


                                                            (*CONSTANTS*)
                                                            (***********)

     CSTCLASS = (REEL,PSET,STRG);
     CSP = @ CONSTANT;
     CONSTANT = RECORD CASE "CCLASS:" CSTCLASS OF
                         REEL: (RVAL: PACKED ARRAY [0..REALLNGTH] OF CHAR);
                         PSET: (PVAL: SET OF 0..SETRANGE);
                         STRG: (SLNGTH: 0..STRGLNGTH;
                                SVAL: PACKED ARRAY [1..STRGLNGTH] OF CHAR)
                       END;

     VALU = RECORD CASE "INTVAL:" BOOLEAN OF  (*INTVAL NEVER SET NORE TESTED*)
                     TRUE:  (IVAL: INTEGER);
                     FALSE: (VALP: CSP)
                   END;

                                                           (*DATA STRUCTURES*)
                                                           (*****************)
     LEVRANGE = 0..MAXLEVEL; ADDRRANGE = 0..MAXADDR;
   " ALNRNG = 1..8 ;" LABELRNG = 0..1000 ;
     STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES,
                   TAGFLD,VARIANT);
     DECLKIND = (STANDARD,DECLARED);
     STP = @ STRUCTURE; CTP = @ IDENTIFIER;

     STRUCTURE = PACKED RECORD
                (* MARKED: BOOLEAN;  TO BE USED WITH 'T+', FOR TEST PHASE ONLY*)
                   SIZE: ADDRRANGE;
                   CASE FORM: STRUCTFORM OF
                     SCALAR:   (CASE SCALKIND: DECLKIND OF
                                  DECLARED: (FCONST: CTP));
                     SUBRANGE: (RANGETYPE: STP; MIN,MAX: VALU);
                     POINTER:  (ELTYPE: STP);
                     POWER:    (ELSET: STP);
                     ARRAYS:   (AELTYPE,INXTYPE: STP);
                     RECORDS:  (FSTFLD: CTP; RECVAR: STP);
                     FILES:    (FILTYPE: STP);
                     TAGFLD:   (TAGFIELDP: CTP; FSTVAR: STP);
                     VARIANT:  (NXTVAR,SUBVAR: STP; VARVAL: VALU)
                   END;

                                                            (*NAMES*)
                                                            (*******)

     IDCLASS = (TYPES,KONST,VARS,FIELD,PROC,FUNC);
     SETOFIDS = SET OF IDCLASS;
     IDKIND = (ACTUAL,FORMAL);
     ALPHA = PACKED ARRAY [0..7] OF CHAR;

     IDENTIFIER = PACKED RECORD
                   NAME: ALPHA; LLINK, RLINK: CTP;
                   IDTYPE: STP; NEXT: CTP;
                   CASE KLASS: IDCLASS OF
                     KONST: (VALUES: VALU);
                     VARS:  (VKIND: IDKIND;
                             VLEV: LEVRANGE; VADDR: ADDRRANGE);
                     FIELD: (FLDADDR: ADDRRANGE);
                     PROC,
                     FUNC:  (CASE PFDECKIND: DECLKIND OF
                              STANDARD: (KEY: 1..15);
                              DECLARED: (PFLEV: LEVRANGE; PFNAME: LABELRNG;
                                         PLEN : 0..250 ;
                                          CASE PFKIND: IDKIND OF
                                           ACTUAL: (FORWDECL, EXTERN:
                                                    BOOLEAN)))
                   END;


     DISPRANGE = 0..DISPLIMIT;
     WHERE = (BLCK,CREC,VREC,REC);

                                                            (*EXPRESSIONS*)
                                                            (*************)
     ATTRKIND = (CST,VARBL,EXPR);
     VACCESS = (DRCT,INDRCT,INXD);

     ATTR = RECORD TYPTR : STP;
              CASE KIND: ATTRKIND OF
                CST:   (CVAL: VALU);
                VARBL: (CASE ACCESS: VACCESS OF
                          DRCT: (VLEVEL: LEVRANGE; DPLMT: ADDRRANGE);
                          INDRCT: (IDPLMT: ADDRRANGE))
              END;

     TESTP = @ TESTPOINTER;
     TESTPOINTER = PACKED RECORD
                     ELT1,ELT2 : STP;
                     LASTTESTP : TESTP
                   END;

                                                                 (*LABELS*)
                                                                 (********)
     LBP = @ LABL;
     LABL = RECORD NEXTLAB: LBP; DEFINED: BOOLEAN;
                   LABVAL, LABNAME: INTEGER
            END;

     EXTFILEP = @FILEREC;
     FILEREC = RECORD FILENAME:ALPHA; NEXTFILE:EXTFILEP;  END;

(*-------------------------------------------------------------------------*)


VAR
 (*PRD, PRR:                    TEXT; *)


                                    (*RETURNED BY SOURCE PROGRAM SCANNER
                                     INSYMBOL:
                                     **********)

    SY: SYMBOL;                     (*LAST SYMBOL*)
    OP: OPERATOR;                   (*CLASSIFICATION OF LAST SYMBOL*)
  " KK: 1..IDLNGTH;  "              (*NR OF CHARS IN LAST IDENTIFIER*)
    CH: CHAR;                       (*LAST CHARACTER READ*)
    EOL: BOOLEAN;                   (*END OF LINE FLAG*)


                                    (*COUNTERS:*)
                                    (***********)

    CHCNT: -1..LINELGTH;            (*CHARACTER COUNTER*)
    LC,IC,OLDIC: ADDRRANGE ;        (*DATA LOCATION AND INSTRUCTION COUNTER*)
    LINECNT (* ,MXDATASZE *) : INTEGER;

    ERRORCOUNT",CTIME":INTEGER ;    (*TOTAL ERROR COUNT*)

    GATTR: ATTR;                    (*DESCRIBES THE EXPR CURRENTLY COMPILED*)
    VAL: VALU;                      (*VALUE OF LAST CONSTANT*)
    LNGTH: INTEGER;                 (*LENGTH OF LAST STRING CONSTANT*)
    ID:  ALPHA ;                    (*LAST IDENTIFIER (POSSIBLY TRUNCATED)*)

                                    (*SWITCHES:*)
                                    (***********)

    DP,                             (*DECLARATION PART*)
    PRTERR,                         (*TO ALLOW FORWARD REF. IN PTR. VARIABLES *)
    ASSIGN,                         (*DECLARATION BY SUPPRESSING ERROR MSG*)
    LIST,PRCODE, (* PRTABLES,PRTIC, *)
 (* MARGIN, *) DEBUG,PACKSTRNG          : BOOLEAN ;      (*OUTPUT OPTIONS FOR
                                        -- SOURCE PROGRAM LISTING
                                        -- PRINTING SYMBOLIC CODE
                                        -- DISPLAYING IDENT AND STRUCT TABLES
                                        --> SET INPUT MARGIN AT 72 COLS.
                                        --> PRINT INST_CNTR, PROCEDURE OPTION*)


                                    (*POINTERS:*)
                                    (***********)
    INTPTR,REALPTR,CHARPTR,ALFAPTR,
    BOOLPTR,NILPTR,TEXTPTR: STP;    (*POINTERS TO ENTRIES OF STANDARD IDS*)
    UTYPPTR,UCSTPTR,UVARPTR,
    UFLDPTR,UPRCPTR,UFCTPTR,        (*POINTERS TO ENTRIES FOR UNDECLARED IDS*)
    FWPTR: CTP;                     (*HEAD OF CHAIN OF FORW DECL TYPE IDS*)
    FEXTFILEP: EXTFILEP;            (*HEAD OF CHAIN OF EXTERNAL FILES*)
    GLOBTESTP: TESTP;               (*LAST TESTPOINTER*)
    CNSTVALPTR : CSP ;              (* POINTERS TO CURRENT STRING/REAL CNST *)


                                    (*BOOKKEEPING OF DECLARATION LEVELS:*)
                                    (************************************)

    LEVEL: LEVRANGE;                (*CURRENT STATIC LEVEL*)
    DISX,                           (*LEVEL OF LAST ID SEARCHED BY SEARCHID*)
    TOP: DISPRANGE;                 (*TOP OF DISPLAY*)

    DISPLAY:                        (*WHERE:   MEANS:*)
      ARRAY [DISPRANGE] OF
        PACKED RECORD               (*=BLCK:   ID IS VARIABLE ID*)
          FNAME: CTP; FLABEL: LBP;  (*=CREC:   ID IS FIELD ID IN RECORD WITH*)
          CASE OCCUR: WHERE OF      (*         CONSTANT ADDRESS*)
            CREC: (CLEV: LEVRANGE;  (*=VREC:   ID IS FIELD ID IN RECORD WITH*)
                  CDSPL: ADDRRANGE);(*         VARIABLE ADDRESS*)
            VREC: (VDSPL: ADDRRANGE)
          END;                      (* --> PROCEDURE WITHSTATEMENT*)


                                    (*ERROR MESSAGES:*)
                                    (*****************)

    ERRINX: 0..10;                  (*NR OF ERRORS IN CURRENT SOURCE LINE*)
    ERRLIST:
      ARRAY [1..10] OF
        PACKED RECORD POS: 0..LINELGTH;
                      NMR: 1..400
               END;




                                    (*EXPRESSION COMPILATION:*)
                                    (*************************)



                                    (*STRUCTURED CONSTANTS:*)
                                    (***********************)

   "NUMERIC,"
    ALPHANUMERIC : SET OF CHAR ;    (*VALID ALPHA-NUMERICS*)
    LINEBUF: ARRAY[0..LINELGTH] OF CHAR ; (*CURRENT LINE BUFFER*)
   "STOPCH:  CHAR ; "               (*TO FLAG END OF LINEBUF*)
 (* SEQFLD: ARRAY [0..7] OF CHAR ; (*SEQUENCE FIELD OF INPUT LINE, $M+ ONLY*)

    CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS,
    STATBEGSYS,TYPEDELS: SETOFSYS;
    NXTFILBUF : ADDRRANGE ;
    RW:  ARRAY [0..35(*NR. OF RES. WORDS*)] OF ALPHA;
    FRW: ARRAY [0..9] OF 1..36 (*NR. OF RES. WORDS + 1*);
    RSY: ARRAY [0..35(*NR. OF RES. WORDS*)] OF SYMBOL;
    SSY: ARRAY [CHAR] OF SYMBOL;
    ROP: ARRAY [0..35(*NR. OF RES. WORDS*)] OF OPERATOR;
    SOP: ARRAY [CHAR] OF OPERATOR;
    NA:  ARRAY [0..42] OF ALPHA;
 "  MN:  ARRAY [0..63] OF PACKED ARRAY [0..2] OF CHAR;
    SNA: ARRAY [0..30] OF PACKED ARRAY [0..2] OF CHAR; "
    CALL_CNT : ARRAY[0.. 99 (* MAXPROC *) ] OF INTEGER ;

    INTLABEL,PROCLAB: LABELRNG ;  MXINT10: INTEGER;
   " ASCII :  ARRAY [CHAR] OF 32..95  ;  "

(*-------------------------------------------------------------------------*)


PROCEDURE PRINTERROR ;
    VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER;
  BEGIN
    IF NOT LIST THEN
      BEGIN   WRITELN(OUTPUT) ;
      WRITELN(OUTPUT,LINECNT:4, ' ':11, LINEBUF:CHCNT) ;
      END ;
    (*OUTPUT ERROR MESSAGES*)
    WRITE(OUTPUT,'****', ' ':11) ;
    LASTPOS :=  0; FREEPOS := 1;
    FOR K := 1 TO ERRINX DO
      BEGIN
        WITH ERRLIST[K] DO
          BEGIN CURRPOS := POS; CURRNMR := NMR END;
        IF CURRPOS = LASTPOS THEN WRITE(OUTPUT,',')
        ELSE
          BEGIN
            WHILE FREEPOS < CURRPOS DO
              BEGIN WRITE(OUTPUT,' '); FREEPOS := FREEPOS + 1 END;
            WRITE(OUTPUT,'@');
            LASTPOS := CURRPOS
          END;
        IF CURRNMR < 10 THEN F := 1
        ELSE IF CURRNMR < 100 THEN F := 2
          ELSE F := 3;
        WRITE(OUTPUT,CURRNMR:F);
        FREEPOS := FREEPOS + F + 1
      END;
    WRITELN(OUTPUT);  ERRINX := 0 ;  PRCODE := FALSE ;
  END (*PRINTERROR*) ;

PROCEDURE ENDOFLINE ;
  VAR I: 0..7 ;
  BEGIN
    LINECNT := LINECNT+1 ;
    IF LIST THEN
      BEGIN
        WRITE(OUTPUT,LINECNT: 4) ;
        IF DP THEN WRITE(OUTPUT,LC:6) ELSE WRITE(OUTPUT,IC:6);
        WRITE(OUTPUT,LEVEL:3,') ') ;
        WRITELN(OUTPUT, LINEBUF:"80"CHCNT) ;
      END
    ELSE
      BEGIN   WRITE(OUTPUT,'+') ;
      IF (LINECNT MOD 25) = 0 THEN
        BEGIN  WRITE(OUTPUT, LINECNT:4) ;
        IF (LINECNT MOD 50) = 0 THEN  WRITELN(OUTPUT) ;
        END ;
      END ;

    IF ERRINX > 0 THEN PRINTERROR ;
    CHCNT := 0 ;
  END  (*ENDOFLINE*) ;

  PROCEDURE ERROR(FERRNR: INTEGER);
  BEGIN
    IF ERRINX >= 9 THEN
      BEGIN ERRLIST[10].NMR := 255; ERRINX := 10 END
    ELSE
      BEGIN ERRINX := ERRINX + 1;
        ERRLIST[ERRINX].NMR := FERRNR
      END;
    ERRLIST[ERRINX].POS := CHCNT ;
    ERRORCOUNT := ERRORCOUNT+1 ;
  END (*ERROR*) ;

  PROCEDURE INSYMBOL;
    (*READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS
    DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LNGTH*)
    LABEL 1,2,3,4;
    VAR I,K: INTEGER;
        "LVP: CSP;"  TEST: BOOLEAN;
        DIGITS: PACKED ARRAY [0..REALLNGTH] OF CHAR;
        "STRING: PACKED ARRAY [0..STRGLNGTH] OF CHAR;"


    PROCEDURE SKIPBLNK;
    (* SKIP BLANKS, ENDOFLINE, AND (OPTIONAL) MARGIN, SKIPS AT LEAST ONE CHAR *)

      BEGIN
        REPEAT
        IF EOL THEN
          BEGIN
          IF EOF(INPUT)  THEN
            BEGIN  WRITELN(OUTPUT,'**** EOF ENCOUNTERED') ;
            EXIT(ERRORCOUNT+1) ;
            END ;
          ENDOFLINE ;  READ(INPUT,LINEBUF) ;
          END ;
       CHCNT := CHCNT-1 ;
       REPEAT CHCNT := CHCNT+1 ;  UNTIL LINEBUF[CHCNT] <> ' ' ;
       (* NOTE THAT LINEBUF[ENDOFLINE] <> ' ' *)
     " IF MARGIN THEN  EOL := CHCNT >= 72
       ELSE  EOL := CHCNT >= 80 ;   "
       EOL := (ORD(LINEBUF[CHCNT]) > 127) "OR (CHCNT >= LINELGTH)" ;
       UNTIL NOT EOL ;
     CH := LINEBUF[CHCNT] ;  CHCNT := CHCNT+1 ;
     END (*SKIPBLNK*) ;


    PROCEDURE NEXTCH;
      BEGIN
          IF EOL THEN
            BEGIN
              IF EOF(INPUT)  THEN
              BEGIN  WRITELN(OUTPUT,'**** EOF ENCOUNTERED') ;
                EXIT(ERRORCOUNT+1) ;
              END ;
              ENDOFLINE ;    READ(INPUT, LINEBUF) ;
## ##  "      LINEBUF[LINELGTH] := CHR(64) ; "
            END ;
          CH := LINEBUF[CHCNT] ;
          CHCNT := CHCNT+1 ;
          EOL := (ORD(LINEBUF[CHCNT]) > 127) "OR (CHCNT >= LINELGTH) ";
      END (*NEXTCH*) ;

    PROCEDURE OPTIONS;
    BEGIN
      REPEAT NEXTCH;
        IF CH <> '*' THEN
          BEGIN
          " IF CH = 'T' THEN
              BEGIN NEXTCH; (* PRTABLES := CH = '+' *)  END
            ELSE   "
              IF CH = 'L' THEN
                BEGIN NEXTCH; LIST := CH = '+';
                END
              ELSE
                IF CH = 'C' THEN
                  BEGIN NEXTCH; PRCODE := CH = '+' END
                ELSE
                    " IF CH='M' THEN
                        BEGIN  NEXTCH ;  (* MARGIN := CH <> '-' *) END
                      ELSE  "
                            IF CH = 'D' THEN
                              BEGIN  NEXTCH ;  DEBUG := CH <> '-' END ;
            NEXTCH
          END
      UNTIL CH <> ','
    END (*OPTIONS*) ;

  BEGIN (*INSYMBOL*)
  1:
  " REPEAT WHILE (CH = ' ') AND NOT EOL DO NEXTCH;
      TEST := EOL;
      IF TEST THEN NEXTCH
    UNTIL NOT TEST; "
    IF CH = ' ' THEN SKIPBLNK ;
## #IF ORD(CH) > 63 THEN GOTO 4;
    CASE CH OF
      'A','B','C','D','E','F','G','H','I',
      'J','K','L','M','N','O','P','Q','R',
      'S','T','U','V','W','X','Y','Z':
        BEGIN  K := 0 ;  ID := BLANKID ;
          REPEAT
            IF K < 8 (* IDLNGTH *) THEN
              BEGIN ID[K] := CH; K := K+1  END ;
            NEXTCH
          UNTIL NOT(CH IN ALPHANUMERIC) ;
         "IF K >= KK THEN KK := K
          ELSE
            REPEAT ID[KK] := ' '; KK := KK - 1
            UNTIL KK = K; "
          FOR I := FRW[K] TO FRW[K+1] - 1 DO
            IF RW[I] = ID THEN
              BEGIN SY := RSY[I]; OP := ROP[I]; GOTO 2 END;
            SY := IDENT; OP := NOOP;
  2:    END;
      '0','1','2','3','4','5','6','7','8','9':
        BEGIN OP := NOOP; I := 0;
          REPEAT I := I+1; IF I <= DIGMAX THEN DIGITS[I] := CH; NEXTCH
          UNTIL (CH < '0') OR (CH > '9') ;
          IF (CH = '.') OR (CH = 'E') THEN
            BEGIN
               K := I;
               IF CH = '.' THEN
                 BEGIN K := K+1; IF K <= DIGMAX THEN DIGITS[K] := CH;
                   NEXTCH; IF CH = '.' THEN BEGIN CH := ':'; GOTO 3 END;
                   IF (CH < '0') OR (CH > '9') THEN
                     ERROR(201)
                   ELSE
                     REPEAT K := K + 1;
                       IF K <= DIGMAX THEN DIGITS[K] := CH; NEXTCH
                     UNTIL (CH < '0') OR (CH > '9')
                 END;
               IF CH = 'E' THEN
                 BEGIN K := K+1; IF K <= DIGMAX THEN DIGITS[K] := CH;
                   NEXTCH;
                   IF (CH = '+') OR (CH ='-') THEN
                     BEGIN K := K+1; IF K <= DIGMAX THEN DIGITS[K] := CH;
                       NEXTCH
                     END;
                   IF (CH < '0') OR (CH > '9') THEN
                     ERROR(201)
                   ELSE
                     REPEAT K := K+1;
                       IF K <= DIGMAX THEN DIGITS[K] := CH; NEXTCH
                     UNTIL (CH < '0') OR (CH > '9')
                  END;
               "NEW(LVP,REEL);" SY:= REALCONST; "LVP@.CCLASS := REEL;"
                WITH "LVP@" CNSTVALPTR@ DO
                  BEGIN "FOR I := 1 TO REALLNGTH DO RVAL[I] := ' ';"
                    IF K <= DIGMAX THEN
                      BEGIN   DIGITS[0] := '+' ; RVAL := DIGITS ;
                      FOR I := K+1 TO REALLNGTH DO  RVAL[I] := ' ' ;
                 "    FOR I := 2 TO K+1 DO  RVAL[I] := DIGITS[I-1]  "
                      END
                    ELSE BEGIN  ERROR(203);
                           RVAL[1] := '0' ;  RVAL[2] := '.';  RVAL[3] := '0'
                         END
                  END;
               VAL.VALP := "LVP"  CNSTVALPTR
            END
          ELSE
  3:        BEGIN
              IF I > DIGMAX THEN BEGIN ERROR(203); VAL.IVAL := 0 END
              ELSE
                WITH VAL DO
                  BEGIN IVAL := 0;
                    FOR K := 1 TO I DO
                      BEGIN
                        IF IVAL <= MXINT10 THEN
                          IVAL := IVAL*10 + (ORD(DIGITS[K])-ORD('0'))
                        ELSE BEGIN ERROR(203); IVAL := 0 END
                      END;
                    SY := INTCONST
                 END
            END
        END;
      '''':
        WITH CNSTVALPTR@ DO
          BEGIN  LNGTH := 0; SY := STRINGCONST;  OP := NOOP;
            REPEAT
              REPEAT NEXTCH; LNGTH := LNGTH + 1;
                     IF LNGTH <= STRGLNGTH THEN SVAL[LNGTH] := CH
              UNTIL (EOL) OR (CH = '''');
              IF EOL THEN ERROR(202) ELSE NEXTCH
            UNTIL CH <> '''';
            LNGTH := LNGTH - 1;   (*NOW LNGTH = NR OF CHARS IN STRING*)
            IF LNGTH = 1 THEN VAL.IVAL := ORD(SVAL[1])
            ELSE
              BEGIN "NEW(LVP,STRG);" "LVP@.CCLASS:=STRG;"
                IF LNGTH > STRGLNGTH THEN
                  BEGIN ERROR(398); LNGTH := STRGLNGTH END;
              " WITH LVP@ DO
                  BEGIN SLNGTH := LNGTH;
                    FOR I := 1 TO LNGTH DO SVAL[I] := STRING[I]
                  END;   "
                VAL.VALP := "LVP" CNSTVALPTR ;  SLNGTH := LNGTH ;
              END
          END;
      ':':
        BEGIN OP := NOOP; NEXTCH;
          IF CH = '=' THEN
            BEGIN SY := BECOMES; NEXTCH END
          ELSE SY := COLON
        END;
      '.':
        BEGIN OP := NOOP; NEXTCH;
          IF CH = '.' THEN
            BEGIN SY := COLON; NEXTCH END
          ELSE SY := PERIOD
        END;
      '<':
        BEGIN NEXTCH; SY := RELOP;
          IF CH = '=' THEN
            BEGIN OP := LEOP; NEXTCH END
          ELSE
            IF CH = '>' THEN
              BEGIN OP := NEOP; NEXTCH END
            ELSE OP := LTOP
        END;
      '>':
        BEGIN NEXTCH; SY := RELOP;
          IF CH = '=' THEN
            BEGIN OP := GEOP; NEXTCH END
          ELSE OP := GTOP
        END;
      '(':
       BEGIN NEXTCH;
         IF CH = '*' THEN
           BEGIN NEXTCH;
             IF CH = '$' THEN OPTIONS;
             REPEAT
               WHILE CH <> '*'  DO NEXTCH;
               NEXTCH
             UNTIL CH = ')';
             NEXTCH; GOTO 1
           END ;
         IF CH = '/' THEN
           BEGIN   SY := LBRACK ;  OP := NOOP ;
           NEXTCH
           END
         ELSE  BEGIN  SY := LPARENT; OP := NOOP  END
       END;
      '*','+','-',
      '=','/',')','&',
      '[',']',',',';','@'    :
        BEGIN SY := SSY[CH]; OP := SOP[CH];
          IF CH = '/' THEN
            BEGIN  NEXTCH ;
              IF CH =')' THEN
                BEGIN  SY := RBRACK ;  OP := NOOP ;
                  NEXTCH ;
                END
            END
          ELSE  NEXTCH
        END;
      '"':
        BEGIN   REPEAT NEXTCH UNTIL CH = '"' ;
          NEXTCH ;   GOTO 1 ;
        END ;
      ' ','#':
        BEGIN  NEXTCH ;  GOTO 1  END ;
## ## '$','_','%'",'!','?','|','^'":

   4:   BEGIN SY := OTHERSY; OP := NOOP; ERROR(6 "398") ; NEXTCH END
    END (*CASE*)
  END (*INSYMBOL*) ;

  PROCEDURE ENTERID(FCP: CTP);
    (*ENTER ID POINTED AT BY FCP INTO THE NAME-TABLE,
     WHICH ON EACH DECLARATION LEVEL IS ORGANISED AS
     AN UNBALANCED BINARY TREE*)
    VAR NAM: ALPHA; LCP, LCP1: CTP; LLEFT: BOOLEAN;
  BEGIN NAM := FCP@.NAME;
    LCP := DISPLAY[TOP].FNAME;
    IF LCP = NIL THEN
      DISPLAY[TOP].FNAME := FCP
    ELSE
      BEGIN
        REPEAT LCP1 := LCP;
          IF LCP@.NAME = NAM THEN   (*NAME CONFLICT, FOLLOW RIGHT LINK*)
            BEGIN ERROR(101); LCP := LCP@.RLINK; LLEFT := FALSE END
          ELSE
            IF LCP@.NAME < NAM THEN
              BEGIN LCP := LCP@.RLINK; LLEFT := FALSE END
            ELSE BEGIN LCP := LCP@.LLINK; LLEFT := TRUE END
        UNTIL LCP = NIL;
        IF LLEFT THEN LCP1@.LLINK := FCP ELSE LCP1@.RLINK := FCP
      END;
    FCP@.LLINK := NIL; FCP@.RLINK := NIL
  END (*ENTERID*) ;

  PROCEDURE SEARCHSECTION(FCP: CTP; VAR FCP1: CTP);
    (*TO FIND RECORD FIELDS AND FORWARD DECLARED PROCEDURE ID'S
     --> PROCEDURE PROCEDUREDECLARATION
     --> PROCEDURE SELECTOR*)
     LABEL 1;
  BEGIN
    WHILE FCP <> NIL DO
      IF FCP@.NAME = ID THEN GOTO 1
      ELSE IF FCP@.NAME < ID THEN FCP := FCP@.RLINK
        ELSE FCP := FCP@.LLINK;
1:  FCP1 := FCP
  END (*SEARCHSECTION*) ;

  PROCEDURE SEARCHID(FIDCLS: SETOFIDS; VAR FCP: CTP);
    LABEL 1;
    VAR LCP: CTP;
  BEGIN
    FOR DISX := TOP DOWNTO 0 DO
      BEGIN LCP := DISPLAY[DISX].FNAME;
        WHILE LCP <> NIL DO
          IF LCP@.NAME = ID THEN
            IF LCP@.KLASS IN FIDCLS THEN GOTO 1
            ELSE
              BEGIN IF PRTERR THEN ERROR(103);
                LCP := LCP@.RLINK
              END
          ELSE
            IF LCP@.NAME < ID THEN
              LCP := LCP@.RLINK
            ELSE LCP := LCP@.LLINK
      END;
    (*SEARCH NOT SUCCSESSFUL; SUPPRESS ERROR MESSAGE IN CASE
     OF FORWARD REFERENCED TYPE ID IN POINTER TYPE DEFINITION
     --> PROCEDURE SIMPLETYPE*)
    IF PRTERR THEN
      BEGIN ERROR(104);
        (*TO AVOID RETURNING NIL, REFERENCE AN ENTRY
         FOR AN UNDECLARED ID OF APPROPRIATE CLASS
         --> PROCEDURE ENTERUNDECL*)
        IF TYPES IN FIDCLS THEN LCP := UTYPPTR
        ELSE
          IF VARS IN FIDCLS THEN LCP := UVARPTR
          ELSE
            IF FIELD IN FIDCLS THEN LCP := UFLDPTR
            ELSE
              IF KONST IN FIDCLS THEN LCP := UCSTPTR
              ELSE
                IF PROC IN FIDCLS THEN LCP := UPRCPTR
                ELSE LCP := UFCTPTR;
      END;
1:  FCP := LCP
  END (*SEARCHID*) ;

  PROCEDURE GETBOUNDS(FSP: STP; VAR FMIN,FMAX: INTEGER);
    (*GET INTERNAL BOUNDS OF SUBRANGE OR SCALAR TYPE*)
    (*ASSUME (FSP <> NIL) AND (FSP@.FORM <= SUBRANGE) AND (FSP <> INTPTR)
     AND NOT COMPTYPES(REALPTR,FSP)*)
  BEGIN
    WITH FSP@ DO
      IF FORM = SUBRANGE THEN
        BEGIN FMIN := MIN.IVAL; FMAX := MAX.IVAL END
      ELSE
        BEGIN FMIN := 0;
          IF FSP = CHARPTR THEN FMAX := ORDMAXCHAR
          ELSE
            IF (FORM = SCALAR) AND ("FSP@."FCONST <> NIL) THEN
              FMAX := FSP@.FCONST@.VALUES.IVAL
            ELSE FMAX := 0
        END
  END (*GETBOUNDS*) ;

"""PROCEDURE PRINTTABLES(FB: BOOLEAN);
    (*PRINT DATA STRUCTURE AND NAME TABLE*)
    VAR I, LIM: DISPRANGE;

    PROCEDURE MARKER;
      (*MARK DATA STRUCTURE ENTRIES TO AVOID MULTIPLE PRINTOUT*)
      VAR I: INTEGER;

      PROCEDURE MARKCTP(FP: CTP); FORWARD;

      PROCEDURE MARKSTP(FP: STP);
        (*MARK DATA STRUCTURES, PREVENT CYCLES*)
      BEGIN
        IF FP <> NIL THEN
          WITH FP@ DO
            BEGIN MARKED := TRUE;
              CASE FORM OF
              SCALAR:   ;
              SUBRANGE: MARKSTP(RANGETYPE);
              POINTER:  (*DON'T MARK ELTYPE: CYCLE POSSIBLE; WILL BE MARKED
                        ANYWAY, IF FP = TRUE*) ;
              POWER:    MARKSTP(ELSET) ;
              ARRAYS:   BEGIN MARKSTP(AELTYPE); MARKSTP(INXTYPE) END;
              RECORDS:  BEGIN MARKCTP(FSTFLD); MARKSTP(RECVAR) END;
              FILES:    MARKSTP(FILTYPE);
              TAGFLD:   MARKSTP(FSTVAR);
              VARIANT:  BEGIN MARKSTP(NXTVAR); MARKSTP(SUBVAR) END
              END (*CASE*)
            END (*WITH*)
      END (*MARKSTP*);

      PROCEDURE MARKCTP;
      BEGIN
        IF FP <> NIL THEN
          WITH FP@ DO
            BEGIN MARKCTP(LLINK); MARKCTP(RLINK);
              MARKSTP(IDTYPE)
            END
      END (*MARKCTP*);

    BEGIN (*MARK*)
      FOR I := TOP DOWNTO LIM DO
        MARKCTP(DISPLAY[I].FNAME)
    END (*MARK*);

    PROCEDURE FOLLOWCTP(FP: CTP); FORWARD;

    PROCEDURE FOLLOWSTP(FP: STP);
    BEGIN
      IF FP <> NIL THEN
        WITH FP@ DO
          IF MARKED THEN
            BEGIN MARKED := FALSE; WRITE(OUTPUT,' ':4,ORD(FP):6,SIZE:10);
              CASE FORM OF
              SCALAR:   BEGIN WRITE(OUTPUT,'SCALAR':10);
                          IF SCALKIND = STANDARD THEN
                           WRITE(OUTPUT,'STANDARD    ':10)
                          ELSE WRITE(OUTPUT,'DECLARED    ':10, ORD(FCONST):8);
                          WRITELN(OUTPUT)
                        END;
              SUBRANGE:BEGIN
                        WRITE(OUTPUT,'SUBRANGE    ':10,' ':4,ORD(RANGETYPE):6);
                            IF RANGETYPE <> REALPTR THEN
                              WRITE(OUTPUT,MIN.IVAL,MAX.IVAL)
                            ELSE
                              IF (MIN.VALP <> NIL) AND (MAX.VALP <> NIL) THEN
                                WRITE(OUTPUT,' ',MIN.VALP@.RVAL:9,
                                      ' ',MAX.VALP@.RVAL:9);
                            WRITELN(OUTPUT); FOLLOWSTP(RANGETYPE);
                          END;
              POINTER:  WRITELN(OUTPUT,'POINTER':10,' ':4,ORD(ELTYPE):6);
              POWER:    BEGIN WRITELN(OUTPUT,'SET':10,' ':4,ORD(ELSET):6);
                            FOLLOWSTP(ELSET)
                          END;
              ARRAYS:   BEGIN
                         WRITELN(OUTPUT,'ARRAY':10,' ':4,ORD(AELTYPE):6,' ':4,
                            ORD(INXTYPE):6);
                            FOLLOWSTP(AELTYPE); FOLLOWSTP(INXTYPE)
                          END;
              RECORDS:  BEGIN
                        WRITELN(OUTPUT,'RECORD':10,' ':4,ORD(FSTFLD):6,' ':4,
                            ORD(RECVAR):6); FOLLOWCTP(FSTFLD);
                            FOLLOWSTP(RECVAR)
                          END;
              FILES:    BEGIN WRITE(OUTPUT,'FILE':10,' ':4,ORD(FILTYPE):6);
                            FOLLOWSTP(FILTYPE)
                          END;
              TAGFLD:   BEGIN WRITELN(OUTPUT,'TAGFLD':10,' ':4,ORD(TAGFIELDP):6,
                            ' ':4,ORD(FSTVAR):6);
                            FOLLOWSTP(FSTVAR)
                          END;
              VARIANT:  BEGIN WRITELN(OUTPUT,'VARIANT':10,' ':4,ORD(NXTVAR):6,
                            ' ':4,ORD(SUBVAR):6,VARVAL.IVAL);
                            FOLLOWSTP(NXTVAR); FOLLOWSTP(SUBVAR)
                          END
              END (*CASE*)
            END (*IF MARKED*)
    END (*FOLLOWSTP*);

    PROCEDURE FOLLOWCTP;
      VAR I: INTEGER;
    BEGIN
      IF FP <> NIL THEN
        WITH FP@ DO
          BEGIN WRITE(OUTPUT,' ':4,ORD(FP):6,' ',NAME:9,' ':4,ORD(LLINK):6,
            ' ':4,ORD(RLINK):6,' ':4,ORD(IDTYPE):6);
            CASE KLASS OF
              TYPES: WRITE(OUTPUT,'TYPE':10);
              KONST: BEGIN WRITE(OUTPUT,'CONSTANT    ':10,' ':4,ORD(NEXT):6);
                     IF IDTYPE <> NIL THEN
                         IF IDTYPE = REALPTR THEN
                           BEGIN
                             IF VALUES.VALP <> NIL THEN
                               WRITE(OUTPUT,' ',VALUES.VALP@.RVAL:9)
                           END
                         ELSE
                           IF IDTYPE@.FORM = ARRAYS THEN  (*STRINGCONST*)
                             BEGIN
                               IF VALUES.VALP <> NIL THEN
                                 BEGIN WRITE(OUTPUT,' ');
                                   WITH VALUES.VALP@ DO
                                     FOR I := 1 TO SLNGTH DO
                                      WRITE(OUTPUT,SVAL[I])
                                 END
                             END
                           ELSE WRITE(OUTPUT,VALUES.IVAL)
                       END;
              VARS:  BEGIN WRITE(OUTPUT,'VARIABLE    ':10);
                        IF VKIND = ACTUAL THEN WRITE(OUTPUT,'ACTUAL':10)
                        ELSE WRITE(OUTPUT,'FORMAL':10);
                        WRITE(OUTPUT,' ':4,ORD(NEXT):6,VLEV,' ':4,VADDR:6 );
                      END;
              FIELD: WRITE(OUTPUT,'FIELD':10,' ':4,ORD(NEXT):6,' ':4,FLDADDR:6);
              PROC,
              FUNC:  BEGIN
                        IF KLASS = PROC THEN WRITE(OUTPUT,'PROCEDURE':10)
                        ELSE WRITE(OUTPUT,'FUNCTION    ':10);
                        IF PFDECKIND = STANDARD THEN
                         WRITE(OUTPUT,'STANDARD    ':10,
                          KEY:10)
                        ELSE
                          BEGIN WRITE(OUTPUT,'DECLARED    ':10, ORD(NEXT):8);
                            WRITE(OUTPUT,PFLEV,' ':4,PFNAME:6);
                            IF PFKIND = ACTUAL THEN
                              BEGIN WRITE(OUTPUT,'ACTUAL':10);
                                IF FORWDECL THEN WRITE(OUTPUT,'FORWARD':10)
                                ELSE WRITE(OUTPUT,'NOTFORWARD':10);
                                IF EXTERN THEN WRITE(OUTPUT,'EXTERN':10)
                                ELSE WRITE(OUTPUT,'NOT EXTERN':10);
                              END
                            ELSE WRITE(OUTPUT,'FORMAL':10)
                          END
                     END
            END (*CASE*);
            WRITELN(OUTPUT); FOLLOWCTP(LLINK); FOLLOWCTP(RLINK);
            FOLLOWSTP(IDTYPE)
          END (*WITH*)
    END (*FOLLOWCTP*);

  BEGIN (*PRINTTABLES*)
    WRITELN(OUTPUT); WRITELN(OUTPUT); WRITELN(OUTPUT);
    IF FB THEN LIM := 0
    ELSE BEGIN LIM := TOP; WRITE(OUTPUT,' LOCAL') END;
    WRITELN(OUTPUT,' TABLES     '); WRITELN(OUTPUT);
    MARKER;
    FOR I := TOP DOWNTO LIM DO
      FOLLOWCTP(DISPLAY[I].FNAME);
      WRITELN(OUTPUT);
      IF NOT EOL THEN WRITE(OUTPUT,' ':CHCNT+16)
  END (*PRINTTABLES*); """

  PROCEDURE GENLABEL(VAR NXTLAB: INTEGER);
  BEGIN INTLABEL := INTLABEL + 1;
    NXTLAB := INTLABEL
  END (*GENLABEL*);

  PROCEDURE BLOCK(FSYS: SETOFSYS; FSY: SYMBOL; FPROCP: CTP);
    VAR LSY: SYMBOL; TEST: BOOLEAN; SEGSIZE, PARMLEN: INTEGER ;

    PROCEDURE SKIP(FSYS: SETOFSYS);
      (*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*)
    BEGIN
    WHILE NOT(SY IN FSYS) DO
      BEGIN
      INSYMBOL
      END ;
    END (*SKIP*) ;

    PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);
      VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG);
          LVP: CSP; I: 0..REALLNGTH;
    BEGIN LSP := NIL; FVALU.IVAL := 0;
      IF NOT(SY IN CONSTBEGSYS) THEN
        BEGIN ERROR(50); SKIP(FSYS+CONSTBEGSYS) END;
      IF SY IN CONSTBEGSYS THEN
        BEGIN
          IF SY = STRINGCONST THEN
            BEGIN
              IF LNGTH = 1 THEN LSP := CHARPTR
              ELSE
                BEGIN
                  NEW(LSP,ARRAYS);
                  WITH LSP@ DO
                    BEGIN AELTYPE := CHARPTR; INXTYPE := NIL;
                       SIZE := LNGTH*CHARSIZE; FORM := ARRAYS
                    END ;
                  LVP := VAL.VALP ;
                  NEW(VAL.VALP, STRG) ;
                  VAL.VALP@ := LVP@ ;      (* COPY STRING CONST TO HEAP AREA *)
                END;
              FVALU".VALP" := VAL".VALP" ; INSYMBOL
            END
          ELSE
            BEGIN
              SIGN := NONE;
              IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN
                BEGIN IF OP = PLUS THEN SIGN := POS ELSE SIGN := NEG;
                  INSYMBOL
                END;
              IF SY = IDENT THEN
                BEGIN SEARCHID([KONST],LCP);
                  WITH LCP@ DO
                    BEGIN LSP := IDTYPE; FVALU := VALUES END;
                  IF SIGN <> NONE THEN
                    IF LSP = INTPTR THEN
                      BEGIN IF SIGN = NEG THEN FVALU.IVAL := -FVALU.IVAL END
                    ELSE
                      IF LSP = REALPTR THEN
                        BEGIN
                          IF SIGN = NEG THEN
                            BEGIN NEW(LVP,REEL);
                              IF FVALU.VALP@.RVAL[0] = '-' THEN
                                LVP@.RVAL[0] := '+'
                              ELSE LVP@.RVAL[0] := '-';
                              FOR I := 1 TO REALLNGTH DO
                                LVP@.RVAL[I] := FVALU.VALP@.RVAL[I];
                              FVALU.VALP := LVP;
                            END
                          END
                        ELSE ERROR(105);
                  INSYMBOL;
                END
              ELSE
                IF SY = INTCONST THEN
                  BEGIN IF SIGN = NEG THEN VAL.IVAL := -VAL.IVAL;
                    LSP := INTPTR; FVALU.IVAL := VAL.IVAL; INSYMBOL
                  END
                ELSE
                  IF SY = REALCONST THEN
                    BEGIN
                      WITH VAL.VALP@ DO
                        IF SIGN = NEG THEN RVAL[0] := '-' ELSE RVAL[0] := '+' ;
                      LVP := VAL.VALP ;
                      NEW(VAL.VALP, REEL) ;
                      VAL.VALP@.RVAL := LVP@.RVAL ;
                      LSP := REALPTR; FVALU.VALP := VAL.VALP; INSYMBOL
                    END
                  ELSE
                    BEGIN ERROR(106); SKIP(FSYS) END
            END;
          IF NOT (SY IN FSYS) THEN
            BEGIN ERROR(6); SKIP(FSYS) END
          END;
      FSP := LSP
    END (*CONSTANT*) ;

    FUNCTION COMPTYPES(FSP1,FSP2: STP) : BOOLEAN;
      (*DECIDE WHETHER STRUCTURES POINTED AT BY FSP1 AND FSP2 ARE COMPATIBLE*)
      VAR NXT1,NXT2: CTP; COMP: BOOLEAN;
        LTESTP1,LTESTP2 : TESTP;
    BEGIN
      IF FSP1 = FSP2 THEN COMPTYPES := TRUE
      ELSE
        IF (FSP1 <> NIL) AND (FSP2 <> NIL) THEN
          IF FSP1@.FORM = FSP2@.FORM THEN
            CASE FSP1@.FORM OF
              SCALAR:
                COMPTYPES := FALSE;
                (* IDENTICAL SCALARS DECLARED ON DIFFERENT LEVELS ARE
                 NOT RECOGNIZED TO BE COMPATIBLE*)
              SUBRANGE:
                COMPTYPES := COMPTYPES(FSP1@.RANGETYPE,FSP2@.RANGETYPE);
              POINTER:
                  BEGIN
                    COMP := FALSE; LTESTP1 := GLOBTESTP;
                    LTESTP2 := GLOBTESTP;
                    WHILE LTESTP1 <> NIL DO
                      WITH LTESTP1@ DO
                        BEGIN
                          IF (ELT1 = FSP1@.ELTYPE) AND
                            (ELT2 = FSP2@.ELTYPE) THEN COMP := TRUE;
                          LTESTP1 := LASTTESTP
                        END;
                    IF NOT COMP THEN
                      BEGIN NEW(LTESTP1);
                        WITH LTESTP1@ DO
                          BEGIN ELT1 := FSP1@.ELTYPE;
                            ELT2 := FSP2@.ELTYPE;
                            LASTTESTP := GLOBTESTP
                          END;
                        GLOBTESTP := LTESTP1;
                        COMP := COMPTYPES(FSP1@.ELTYPE,FSP2@.ELTYPE)
                      END;
                    COMPTYPES := COMP; GLOBTESTP := LTESTP2
                  END;
              POWER:
                COMPTYPES := COMPTYPES(FSP1@.ELSET,FSP2@.ELSET);
              ARRAYS:
                COMPTYPES := COMPTYPES(FSP1@.AELTYPE,FSP2@.AELTYPE)
                             AND (FSP1@.SIZE = FSP2@.SIZE);
                (*ALTERNATIVES: -- ADD A THIRD BOOLEAN TERM: INDEXTYPE MUST
                                  BE COMPATIBLE.
                               -- ADD A FOURTH BOOLEAN TERM: LOWBOUNDS MUST
                                  BE THE SAME*)
              RECORDS:
                BEGIN NXT1 := FSP1@.FSTFLD; NXT2 := FSP2@.FSTFLD; COMP:=TRUE;
                  WHILE (NXT1 <> NIL) AND (NXT2 <> NIL) DO
                    BEGIN COMP:=COMP AND COMPTYPES(NXT1@.IDTYPE,NXT2@.IDTYPE);
                      NXT1 := NXT1@.NEXT; NXT2 := NXT2@.NEXT
                    END;
                  COMPTYPES := COMP AND (NXT1 = NIL) AND (NXT2 = NIL)
                              AND(FSP1@.RECVAR = NIL)AND(FSP2@.RECVAR = NIL)
                END;
                (*IDENTICAL RECORDS ARE RECOGNIZED TO BE COMPATIBLE
                 IFF NO VARIANTS OCCUR*)
              FILES:
                COMPTYPES := COMPTYPES(FSP1@.FILTYPE,FSP2@.FILTYPE)
            END (*CASE*)
          ELSE (*FSP1@.FORM <> FSP2@.FORM*)
            IF FSP1@.FORM = SUBRANGE THEN
              COMPTYPES := COMPTYPES(FSP1@.RANGETYPE,FSP2)
            ELSE
              IF FSP2@.FORM = SUBRANGE THEN
                COMPTYPES := COMPTYPES(FSP1,FSP2@.RANGETYPE)
              ELSE COMPTYPES := FALSE
        ELSE COMPTYPES := TRUE
    END (*COMPTYPES*) ;

    FUNCTION STRING(FSP: STP) : BOOLEAN;
    BEGIN STRING := FALSE;
      IF FSP <> NIL THEN
        IF FSP@.FORM = ARRAYS THEN
          STRING := COMPTYPES(FSP@.AELTYPE,CHARPTR)
    END (*STRING*) ;

    PROCEDURE TYP(FSYS: SETOFSYS; VAR FSP: STP; VAR FSIZE: ADDRRANGE);
      VAR LSP,LSP1,LSP2: STP; OLDTOP: DISPRANGE; LCP: CTP;
          LSIZE,DISPL: ADDRRANGE; LMIN,LMAX: INTEGER;

      PROCEDURE SIMPLETYPE(FSYS:SETOFSYS; VAR FSP:STP"; VAR FSIZE:ADDRRANGE");
        VAR LSP,LSP1: STP; LCP,LCP1: CTP; TTOP: DISPRANGE;
            LCNT: INTEGER; LVALU: VALU;
      BEGIN FSIZE := 1;
        IF NOT (SY IN SIMPTYPEBEGSYS) THEN
          BEGIN ERROR(1); SKIP(FSYS + SIMPTYPEBEGSYS) END;
        IF SY IN SIMPTYPEBEGSYS THEN
          BEGIN
            IF SY = LPARENT THEN
              BEGIN TTOP := TOP;   (*DECL. CONSTS LOCAL TO INNERMOST BLOCK*)
                WHILE DISPLAY[TOP].OCCUR <> BLCK DO TOP := TOP - 1;
                NEW(LSP,SCALAR,DECLARED);
                WITH LSP@ DO
                  BEGIN SIZE := INTSIZE; FORM := SCALAR;
                    SCALKIND := DECLARED
                  END;
                LCP1 := NIL; LCNT := 0;
                REPEAT INSYMBOL;
                  IF SY = IDENT THEN
                    BEGIN NEW(LCP,KONST);
                      WITH LCP@ DO
                        BEGIN NAME := ID; IDTYPE := LSP; NEXT := LCP1;
                          VALUES.IVAL := LCNT; KLASS := KONST
                        END;
                      ENTERID(LCP);
                      LCNT := LCNT + 1;
                      LCP1 := LCP; INSYMBOL
                    END
                  ELSE ERROR(2);
                  IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
                    BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END
                UNTIL SY <> COMMA;
                LSP@.FCONST := LCP1; TOP := TTOP;
                IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
              END
            ELSE
              BEGIN
                IF SY = IDENT THEN
                  BEGIN SEARCHID([TYPES,KONST],LCP);
                    INSYMBOL;
                    IF LCP@.KLASS = KONST THEN
                      BEGIN NEW(LSP,SUBRANGE);
                        WITH LSP@, LCP@ DO
                          BEGIN RANGETYPE := IDTYPE; FORM := SUBRANGE;
                            IF STRING(RANGETYPE) THEN
                              BEGIN ERROR(148); RANGETYPE := NIL END;
                            MIN := VALUES; SIZE := IDTYPE@.SIZE
                          END;
                        IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                        CONSTANT(FSYS,LSP1,LVALU);
                        LSP@.MAX := LVALU;
                        IF LSP@.RANGETYPE <> LSP1 THEN ERROR(107)
                      END
                    ELSE
                      BEGIN LSP := LCP@.IDTYPE;
                      " IF LSP <> NIL THEN FSIZE := LSP@.SIZE  "
                      END
                  END (*SY = IDENT*)
                ELSE
                  BEGIN NEW(LSP,SUBRANGE); LSP@.FORM := SUBRANGE;
                    CONSTANT(FSYS + [COLON],LSP1,LVALU);
                    IF STRING(LSP1) THEN
                      BEGIN ERROR(148); LSP1 := NIL END;
                    WITH LSP@ DO
                      BEGIN RANGETYPE:=LSP1; MIN:=LVALU; SIZE:=INTSIZE;
                      IF LSP1 <> NIL THEN SIZE := LSP1@.SIZE ;
                      END;
                    IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                    CONSTANT(FSYS,LSP1,LVALU);
                    LSP@.MAX := LVALU;
                    IF LSP@.RANGETYPE <> LSP1 THEN ERROR(107)
                  END;
                IF LSP <> NIL THEN
                  WITH LSP@ DO
                    IF FORM = SUBRANGE THEN
                      IF RANGETYPE <> NIL THEN
                        IF RANGETYPE = REALPTR THEN ERROR(398)
                        ELSE
                          IF MIN.IVAL > MAX.IVAL THEN ERROR(102)
              END;
            FSP := LSP;
            IF NOT (SY IN FSYS) THEN
              BEGIN ERROR(6); SKIP(FSYS) END
          END
            ELSE FSP := NIL
      END (*SIMPLETYPE*) ;

      PROCEDURE FIELDLIST(FSYS: SETOFSYS; VAR FRECVAR: STP);
        VAR LCP,LCP1,NXT,NXT1: CTP; LSP,LSP1,LSP2,LSP3,LSP4: STP;
            MINSIZE,MAXSIZE,LSIZE: ADDRRANGE; LVALU: VALU;
      BEGIN NXT1 := NIL; LSP := NIL;
        IF NOT (SY IN FSYS+[IDENT,CASESY]) THEN
          BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END;
        WHILE SY = IDENT DO
          BEGIN NXT := NXT1;
            REPEAT
              IF SY = IDENT THEN
                BEGIN NEW(LCP,FIELD);
                  WITH LCP@ DO
                    BEGIN NAME := ID; IDTYPE := NIL; NEXT := NXT;
                      KLASS := FIELD
                    END;
                  NXT := LCP;
                  ENTERID(LCP);
                  INSYMBOL
                END
              ELSE ERROR(2);
              IF NOT (SY IN [COMMA,COLON]) THEN
                BEGIN ERROR(6); SKIP(FSYS + [COMMA,COLON,SEMICOLON,CASESY])
                END;
            TEST := SY <> COMMA;
              IF NOT TEST  THEN INSYMBOL
            UNTIL TEST;
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
            TYP(FSYS + [CASESY,SEMICOLON],LSP,LSIZE);
            WHILE NXT <> NXT1 DO
              WITH NXT@ DO
                BEGIN  IDTYPE := LSP;   FLDADDR := DISPL;
                  NXT := NEXT;  DISPL := DISPL + LSIZE
                END;
            NXT1 := LCP;
            IF SY = SEMICOLON THEN
              BEGIN INSYMBOL;
                IF NOT (SY IN [IDENT,CASESY,ENDSY]) THEN     (* IGNOR EXTRA ; *)
                  BEGIN ERROR(19); SKIP(FSYS + [IDENT,CASESY]) END
              END
          END (*WHILE*);
        NXT := NIL;
        WHILE NXT1 <> NIL DO
          WITH NXT1@ DO
            BEGIN LCP := NEXT; NEXT := NXT; NXT := NXT1; NXT1 := LCP END;
        IF SY = CASESY THEN
          BEGIN NEW(LSP,TAGFLD);
            WITH LSP@ DO
              BEGIN TAGFIELDP := NIL; FSTVAR := NIL; FORM:=TAGFLD END;
            FRECVAR := LSP;
            INSYMBOL;
            IF SY = IDENT THEN
              BEGIN NEW(LCP,FIELD);
                WITH LCP@ DO
                  BEGIN NAME := ID; IDTYPE := NIL; KLASS:=FIELD;
                    NEXT := NIL ; (*FLDADDR WILL BE SET WHEN TYPE IS KNOWN*)
                  END;
                PRTERR := FALSE ;  SEARCHID([TYPES],LCP1) ;  PRTERR := TRUE ;
                IF LCP1 = NIL THEN  BEGIN  (*EXPLICIT TAG FIELD *)
                ENTERID(LCP);  INSYMBOL ;
                IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
                IF SY <> IDENT THEN
                  BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END
             ;  END (* IF LCP1 = NIL *)
                ELSE (* NO EXPLICT TAG FIELD  *)
                  LCP@.NAME := BLANKID ;
                  BEGIN SEARCHID([TYPES],LCP1);
                    LSP1 := LCP1@.IDTYPE;
                    IF LSP1 <> NIL THEN
                      WITH LSP1@ DO
                        BEGIN
                        IF LCP@.NAME <> BLANKID THEN  BEGIN
                        LCP@.FLDADDR := DISPL ;  DISPL := DISPL + SIZE;
                        END (* LCP@.NAME <> '            ' *) ;
                        IF (FORM <= SUBRANGE) OR STRING(LSP1) THEN
                          BEGIN IF COMPTYPES(REALPTR,LSP1) THEN ERROR(109)
                            ELSE IF STRING(LSP1) THEN ERROR(398);
                            LCP@.IDTYPE := LSP1; LSP@.TAGFIELDP := LCP;
                          END
                        ELSE ERROR(110);
                        END (* WITH LSP1@ DO *) ;
                    INSYMBOL;
                  END
              END
            ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) END;
            LSP@.SIZE := DISPL;
            IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
            LSP1 := NIL; MINSIZE := DISPL; MAXSIZE := DISPL;
            REPEAT LSP2 := NIL;
              REPEAT CONSTANT(FSYS + [COMMA,COLON,LPARENT],LSP3,LVALU);
                IF LSP@.TAGFIELDP <> NIL THEN
                 IF NOT COMPTYPES(LSP@.TAGFIELDP@.IDTYPE,LSP3)THEN ERROR(111);
                NEW(LSP3,VARIANT);
                WITH LSP3@ DO
                  BEGIN NXTVAR := LSP1; SUBVAR := LSP2; VARVAL := LVALU;
                    FORM := VARIANT
                  END;
                LSP1 := LSP3; LSP2 := LSP3;
                TEST := SY <> COMMA;
                IF NOT TEST THEN INSYMBOL
              UNTIL TEST;
              IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
              IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);
              FIELDLIST(FSYS + [RPARENT,SEMICOLON],LSP2);
              IF DISPL > MAXSIZE THEN MAXSIZE := DISPL;
              WHILE LSP3 <> NIL DO
                BEGIN LSP4 := LSP3@.SUBVAR; LSP3@.SUBVAR := LSP2;
                  LSP3@.SIZE := DISPL;
                  LSP3 := LSP4
                END;
              IF SY = RPARENT THEN
                BEGIN INSYMBOL;
                  IF NOT (SY IN FSYS + [SEMICOLON]) THEN
                    BEGIN ERROR(6); SKIP(FSYS + [SEMICOLON]) END
                END
              ELSE ERROR(4);
              TEST := SY <> SEMICOLON;
              IF NOT TEST THEN
                BEGIN DISPL := MINSIZE;
                   INSYMBOL ;  TEST := SY = ENDSY ;          (* IGNORE EXTRA ;*)
                END
            UNTIL TEST;
            DISPL := MAXSIZE;
            LSP@.FSTVAR := LSP1;
          END
        ELSE FRECVAR := NIL
      END (*FIELDLIST*) ;

    BEGIN (*TYP*)
      IF NOT (SY IN TYPEBEGSYS) THEN
         BEGIN ERROR(10); SKIP(FSYS + TYPEBEGSYS) END;
      IF SY IN TYPEBEGSYS THEN
        BEGIN
          IF SY IN SIMPTYPEBEGSYS THEN SIMPLETYPE(FSYS,FSP",FSIZE")
          ELSE
    (*@*)     IF SY = ARROW THEN
              BEGIN NEW(LSP,POINTER); FSP := LSP;
                WITH LSP@ DO
                  BEGIN ELTYPE := NIL;
                  SIZE := PTRSIZE;  FORM:=POINTER
                  END;
                INSYMBOL;
                IF SY = IDENT THEN
                  BEGIN PRTERR := FALSE; (*NO ERROR IF SEARCH NOT SUCCESSFUL*)
                    SEARCHID([TYPES],LCP); PRTERR := TRUE;
                    IF LCP = NIL THEN   (*FORWARD REFERENCED TYPE ID*)
                      BEGIN NEW(LCP,TYPES);
                        WITH LCP@ DO
                          BEGIN NAME := ID; IDTYPE := LSP;
                            NEXT := FWPTR; KLASS := TYPES
                          END;
                        FWPTR := LCP
                      END
                    ELSE
                      BEGIN
                        IF LCP@.IDTYPE <> NIL THEN
                          IF LCP@.IDTYPE@.FORM = FILES THEN ERROR(108)
                          ELSE LSP@.ELTYPE := LCP@.IDTYPE
                      END;
                    INSYMBOL;
                  END
                ELSE ERROR(2);
              END
            ELSE
              BEGIN
                IF SY = PACKEDSY THEN
                  BEGIN INSYMBOL;
                    IF NOT (SY IN TYPEDELS) THEN
                      BEGIN
                        ERROR(10); SKIP(FSYS + TYPEDELS)
                      END
                  END;
    (*ARRAY*)     IF SY = ARRAYSY THEN
                  BEGIN INSYMBOL;
                    IF SY = LBRACK THEN INSYMBOL ELSE ERROR(11);
                    LSP1 := NIL;
                    REPEAT NEW(LSP,ARRAYS);
                      WITH LSP@ DO
                        BEGIN AELTYPE := LSP1; INXTYPE := NIL; FORM:=ARRAYS END;
                      LSP1 := LSP;
                      SIMPLETYPE(FSYS + [COMMA,RBRACK,OFSY],LSP2",LSIZE");
                      IF LSP2 <> NIL THEN
                        IF LSP2@.FORM <= SUBRANGE THEN
                          BEGIN
                            IF LSP2 = REALPTR THEN
                              BEGIN ERROR(109); LSP2 := NIL END
                            ELSE
                              IF LSP2 = INTPTR THEN
                                BEGIN ERROR(149); LSP2 := NIL END;
                            LSP@.INXTYPE := LSP2
                          END
                        ELSE BEGIN ERROR(113); LSP2 := NIL END;
                      TEST := SY <> COMMA;
                      IF NOT TEST THEN INSYMBOL
                    UNTIL TEST;
                    IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12);
                    IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
                    TYP(FSYS,LSP,LSIZE);
                    REPEAT
                      WITH LSP1@ DO
                        BEGIN LSP2 := AELTYPE; AELTYPE := LSP;
                          IF INXTYPE <> NIL THEN
                            BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                              LSIZE := LSIZE*(LMAX - LMIN + 1);
                              SIZE := LSIZE ;
                            END
                        END;
                      LSP := LSP1; LSP1 := LSP2
                    UNTIL LSP1 = NIL
                  END
                ELSE
    (*RECORD*)      IF SY = RECORDSY THEN
                    BEGIN INSYMBOL;
                      OLDTOP := TOP;
                      IF TOP < DISPLIMIT THEN
                        BEGIN TOP := TOP + 1;
                          WITH DISPLAY[TOP] DO
                            BEGIN FNAME := NIL;
                              FLABEL := NIL;
                                  OCCUR := REC
                            END
                        END
                      ELSE ERROR(250);
                      DISPL := 0;
                      FIELDLIST(FSYS-[SEMICOLON]+[ENDSY],LSP1);
                      NEW(LSP,RECORDS);
                      WITH LSP@ DO
                        BEGIN FSTFLD := DISPLAY[TOP].FNAME;
                          RECVAR := LSP1; SIZE := DISPL;
                          FORM := RECORDS ;
                        END;
                      TOP := OLDTOP;
                      IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
                    END
                  ELSE
    (*SET*)           IF SY = SETSY THEN
                      BEGIN INSYMBOL;
                        IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
                        SIMPLETYPE(FSYS,LSP1",LSIZE");
                        IF LSP1 <> NIL THEN
                          IF LSP1@.FORM > SUBRANGE THEN
                            BEGIN ERROR(115); LSP1 := NIL END
                          ELSE
                            IF LSP1 = REALPTR THEN ERROR(114);
                        NEW(LSP,POWER);
                        WITH LSP@ DO
                          BEGIN ELSET:=LSP1;
                          SIZE:=SETSIZE;  FORM:=POWER
                          END;
                      END
                    ELSE
    (*FILE*)            IF SY = FILESY THEN
                       "BEGIN ERROR(398); INSYMBOL ; SKIP(FSYS); LSP:= NIL END;"
                        BEGIN  INSYMBOL ;
                        IF SY = OFSY THEN INSYMBOL  ELSE  ERROR(8) ;
                        SIMPLETYPE(FSYS,LSP1",LSIZE") ;
                        IF LSP1 = NIL THEN  ERROR(398)
                        ELSE  IF LSP1 <> CHARPTR THEN ERROR(398) ;
                        LSP := TEXTPTR ;
                        END ;
                FSP := LSP
              END;
          IF NOT (SY IN FSYS) THEN
            BEGIN ERROR(6); SKIP(FSYS) END
        END
      ELSE FSP := NIL;
      IF FSP = NIL THEN FSIZE := 1 ELSE FSIZE := FSP@.SIZE
    END (*TYP*) ;

    PROCEDURE LABELDECLARATION;
      VAR LLP: LBP; REDEF: BOOLEAN; LBNAME: LABELRNG ;
    BEGIN
      REPEAT
        IF SY = INTCONST THEN
          WITH DISPLAY[TOP] DO
            BEGIN LLP := FLABEL; REDEF := FALSE;
              WHILE (LLP <> NIL) AND NOT REDEF DO
                IF LLP@.LABVAL <> VAL.IVAL THEN
                  LLP := LLP@.NEXTLAB
                ELSE BEGIN REDEF := TRUE; ERROR(166) END;
              IF NOT REDEF THEN
                BEGIN NEW(LLP);
                  WITH LLP@ DO
                    BEGIN LABVAL := VAL.IVAL; GENLABEL(LBNAME);
                      DEFINED := FALSE; NEXTLAB := FLABEL; LABNAME := LBNAME
                    END;
                  FLABEL := LLP
                END;
              INSYMBOL
            END
        ELSE ERROR(15);
        IF NOT ( SY IN FSYS + [COMMA, SEMICOLON] ) THEN
          BEGIN ERROR(6); SKIP(FSYS+[COMMA,SEMICOLON]) END;
        TEST := SY <> COMMA;
        IF NOT TEST THEN INSYMBOL
      UNTIL TEST;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14)
    END (* LABELDECLARATION *) ;

    PROCEDURE CONSTDECLARATION;
      VAR LCP: CTP; LSP: STP; LVALU: VALU;
    BEGIN
      IF SY <> IDENT THEN
        BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
      WHILE SY = IDENT DO
        BEGIN NEW(LCP,KONST);
          WITH LCP@ DO
            BEGIN NAME := ID; IDTYPE := NIL; NEXT := NIL; KLASS:=KONST END;
          INSYMBOL;
          IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
          CONSTANT(FSYS + [SEMICOLON],LSP,LVALU);
          ENTERID(LCP);
          LCP@.IDTYPE := LSP; LCP@.VALUES := LVALU;
          IF SY = SEMICOLON THEN
            BEGIN INSYMBOL;
              IF NOT (SY IN FSYS + [IDENT]) THEN
                BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
            END
          ELSE ERROR(14)
        END
    END (*CONSTDECLARATION*) ;

    PROCEDURE TYPEDECLARATION;
      VAR LCP,LCP1,LCP2: CTP; LSP: STP; LSIZE: ADDRRANGE;
    BEGIN
      IF SY <> IDENT THEN
        BEGIN ERROR(2); SKIP(FSYS + [IDENT]) END;
      WHILE SY = IDENT DO
        BEGIN NEW(LCP,TYPES);
          WITH LCP@ DO
            BEGIN NAME := ID; IDTYPE := NIL; KLASS := TYPES END;
          INSYMBOL;
          IF (SY = RELOP) AND (OP = EQOP) THEN INSYMBOL ELSE ERROR(16);
          TYP(FSYS + [SEMICOLON],LSP,LSIZE);
          ENTERID(LCP);
          LCP@.IDTYPE := LSP;
          (*HAS ANY FORWARD REFERENCE BEEN SATISFIED:*)
          LCP1 := FWPTR;
          WHILE LCP1 <> NIL DO
            BEGIN
              IF LCP1@.NAME = LCP@.NAME THEN
                BEGIN LCP1@.IDTYPE@.ELTYPE := LCP@.IDTYPE;
                  IF LCP1 <> FWPTR THEN
                    LCP2@.NEXT := LCP1@.NEXT
                  ELSE FWPTR := LCP1@.NEXT;
                END;
              LCP2 := LCP1; LCP1 := LCP1@.NEXT
            END;
          IF SY = SEMICOLON THEN
            BEGIN INSYMBOL;
              IF NOT (SY IN FSYS + [IDENT]) THEN
                BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
            END
          ELSE ERROR(14)
        END;
      IF FWPTR <> NIL THEN
        BEGIN ERROR(117); WRITELN(OUTPUT);
          REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR@.NAME);
            FWPTR := FWPTR@.NEXT
          UNTIL FWPTR = NIL;
          IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16)
        END
    END (*TYPEDECLARATION*) ;

    PROCEDURE VARDECLARATION;
      VAR LCP,NXT: CTP; LSP: STP; LSIZE: ADDRRANGE; COUNT: 0..100 ;
    BEGIN NXT := NIL;
      REPEAT   COUNT := 0 ;
        REPEAT
          IF SY = IDENT THEN
            BEGIN NEW(LCP,VARS);    COUNT := COUNT+1 ;
              WITH LCP@ DO
               BEGIN NAME := ID; NEXT := NXT; KLASS := VARS;
                  IDTYPE := NIL; VKIND := ACTUAL; VLEV := LEVEL
                END;
              ENTERID(LCP);
              NXT := LCP;
              INSYMBOL;
            END
          ELSE ERROR(2);
          IF NOT (SY IN FSYS + [COMMA,COLON] + TYPEDELS) THEN
            BEGIN ERROR(6); SKIP(FSYS+[COMMA,COLON,SEMICOLON]+TYPEDELS) END;
          TEST := SY <> COMMA;
          IF NOT TEST THEN INSYMBOL
        UNTIL TEST;
        IF SY = COLON THEN INSYMBOL ELSE ERROR(5);
        TYP(FSYS + [SEMICOLON] + TYPEDELS,LSP,LSIZE);
        IF LSP = TEXTPTR THEN
          BEGIN
          NXTFILBUF := NXTFILBUF+COUNT ;   COUNT := 1 ;
          IF NXTFILBUF > LASTFILBUF THEN  ERROR(258) ;
          END ;

        WHILE NXT <> NIL DO
          WITH  NXT@ DO
            BEGIN   IDTYPE := LSP;
              IF  LSP = TEXTPTR THEN  (* TEXT FILE DECLARATION *)
                BEGIN
                VADDR := NXTFILBUF-COUNT  ;  VLEV := 1 ;  COUNT := COUNT+1 ;
                END
              ELSE  (* OTHER VARIABLE DECLARATION *)
                BEGIN  VADDR := LC ;  LC := LC+LSIZE   END ;
              IF (LC > MAXADDR) OR (LC <= 0) THEN
                 BEGIN  ERROR(260) ; (* LOCAL DATA AREA TOO LARGE *)
                 LC :=  0 ;
                 END ;
              NXT := NEXT ;
            END;

        IF SY = SEMICOLON THEN
          BEGIN INSYMBOL;
            IF NOT (SY IN FSYS + [IDENT]) THEN
              BEGIN ERROR(6); SKIP(FSYS + [IDENT]) END
          END
        ELSE ERROR(14)
      UNTIL (SY <> IDENT) AND NOT (SY IN TYPEDELS);
      IF FWPTR <> NIL THEN
        BEGIN ERROR(117); WRITELN(OUTPUT);
          REPEAT WRITELN(OUTPUT,' TYPE-ID ',FWPTR@.NAME);
            FWPTR := FWPTR@.NEXT
          UNTIL FWPTR = NIL;
          IF NOT EOL THEN WRITE(OUTPUT,' ': CHCNT+16)
        END
    END (*VARDECLARATION*) ;

    PROCEDURE PROCDECLARATION(FSY: SYMBOL);
      VAR OLDLEV: 0..MAXLEVEL; LSY: SYMBOL; LCP,LCP1: CTP; LSP: STP;
          FORW: BOOLEAN; OLDTOP: DISPRANGE; PARCNT: INTEGER;
          LLC,LCM: ADDRRANGE; LBNAME, OLDLABEL: INTEGER; MARKP: @INTEGER;

      PROCEDURE PARAMETERLIST(FSY: SETOFSYS; VAR FPAR: CTP);
        VAR LCP,LCP1,LCP2,LCP3: CTP; LSP: STP; LKIND: IDKIND;
          LLC,LEN : ADDRRANGE; COUNT : INTEGER;
      BEGIN   LCP1 := NIL;    PARMLEN := LC ;
        IF NOT (SY IN FSY + [LPARENT]) THEN
          BEGIN ERROR(7); SKIP(FSYS + FSY + [LPARENT]) END;
        IF SY = LPARENT THEN
          BEGIN IF FORW THEN ERROR(119);
            INSYMBOL;
            IF NOT (SY IN [IDENT,VARSY,PROCSY,FUNCSY]) THEN
              BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END;
            WHILE SY IN [IDENT,VARSY,PROCSY,FUNCSY] DO
              BEGIN
                IF SY = PROCSY THEN
                  BEGIN ERROR(398);
                    REPEAT INSYMBOL;
                      IF SY = IDENT THEN
                      BEGIN NEW(LCP,PROC,DECLARED,FORMAL);
                          WITH LCP@ DO
                            BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP1;
                              PFLEV := LEVEL (*BEWARE OF PARAMETER PROCEDURES*);
                              KLASS:=PROC;PFDECKIND:=DECLARED;PFKIND:=FORMAL
                            END;
                          ENTERID(LCP);
                          LCP1 := LCP; LC := LC + PTRSIZE;
                          INSYMBOL
                        END
                      ELSE ERROR(2);
                      IF NOT (SY IN FSYS + [COMMA,SEMICOLON,RPARENT]) THEN
                        BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])END
                    UNTIL SY <> COMMA
                  END
                ELSE
                  BEGIN
                    IF SY = FUNCSY THEN
                      BEGIN ERROR(398); LCP2 := NIL;
                        REPEAT INSYMBOL;
                          IF SY = IDENT THEN
                            BEGIN NEW(LCP,FUNC,DECLARED,FORMAL);
                              WITH LCP@ DO
                                BEGIN NAME := ID; IDTYPE := NIL; NEXT := LCP2;
                                  PFLEV := LEVEL (*BEWARE PARAM FUNCS*);
                                  KLASS:=FUNC;PFDECKIND:=DECLARED;
                                  PFKIND:=FORMAL
                                END;
                              ENTERID(LCP);
                              LCP2 := LCP; LC := LC + PTRSIZE;
                              INSYMBOL;
                            END;
                          IF NOT (SY IN [COMMA,COLON] + FSYS) THEN
                           BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])
                            END
                        UNTIL SY <> COMMA;
                        IF SY = COLON THEN
                          BEGIN INSYMBOL;
                            IF SY = IDENT THEN
                              BEGIN SEARCHID([TYPES],LCP);
                                LSP := LCP@.IDTYPE;
                                IF LSP <> NIL THEN
                                 IF NOT(LSP@.FORM IN[SCALAR,SUBRANGE,POINTER])
                                    THEN BEGIN ERROR(120); LSP := NIL END;
                                LCP3 := LCP2;
                                WHILE LCP2 <> NIL DO
                                  BEGIN LCP2@.IDTYPE := LSP; LCP := LCP2;
                                    LCP2 := LCP2@.NEXT
                                  END;
                                LCP@.NEXT := LCP1; LCP1 := LCP3;
                                INSYMBOL
                              END
                            ELSE ERROR(2);
                            IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN
                              BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END
                          END
                        ELSE ERROR(5)
                      END
                    ELSE
                      BEGIN
                        IF SY = VARSY THEN
                          BEGIN LKIND := FORMAL; INSYMBOL END
                        ELSE LKIND := ACTUAL;
                        LCP2 := NIL;
                        COUNT := 0;
                        REPEAT
                          IF SY = IDENT THEN
                            BEGIN NEW(LCP,VARS);
                              WITH LCP@ DO
                                BEGIN NAME:=ID; IDTYPE:=NIL; KLASS:=VARS;
                                  VKIND := LKIND; NEXT := LCP2; VLEV := LEVEL;
                                END;
                              ENTERID(LCP);
                              LCP2 := LCP; COUNT := COUNT+1;
                              INSYMBOL;
                            END;
                          IF NOT (SY IN [COMMA,COLON] + FSYS) THEN
                           BEGIN ERROR(7);SKIP(FSYS+[COMMA,SEMICOLON,RPARENT])
                            END;
                          TEST := SY <> COMMA;
                          IF NOT TEST THEN INSYMBOL
                        UNTIL TEST;
                        IF SY = COLON THEN
                          BEGIN INSYMBOL;
                            IF SY = IDENT THEN
                              BEGIN  SEARCHID([TYPES],LCP); LEN := PTRSIZE ;
                                LSP := LCP@.IDTYPE;
                                IF LSP <> NIL THEN
                                  IF (LKIND=ACTUAL) THEN
                                    IF LSP@.FORM <= POWER THEN LEN := LSP@.SIZE
                                    ELSE IF LSP@.FORM = FILES THEN ERROR(121)  ;
                                LC := LC+COUNT*LEN ; LCP3 := LCP2 ;  LLC := LC ;
                                WHILE LCP2 <> NIL DO
                                  BEGIN LCP := LCP2;
                                    WITH LCP2@ DO
                                      BEGIN IDTYPE := LSP; LLC := LLC-LEN;
                                        VADDR := LLC;
                                      END;
                                    LCP2 := LCP2@.NEXT
                                  END;
                                LCP@.NEXT := LCP1; LCP1 := LCP3;
                                INSYMBOL
                              END
                            ELSE ERROR(2);
                            IF NOT (SY IN FSYS + [SEMICOLON,RPARENT]) THEN
                              BEGIN ERROR(7);SKIP(FSYS+[SEMICOLON,RPARENT])END
                          END
                        ELSE ERROR(5);
                      END;
                  END;
                IF SY = SEMICOLON THEN
                  BEGIN INSYMBOL;
                    IF NOT (SY IN FSYS + [IDENT,VARSY,PROCSY,FUNCSY]) THEN
                      BEGIN ERROR(7); SKIP(FSYS + [IDENT,RPARENT]) END
                  END
              END (*WHILE*) ;
            IF SY = RPARENT THEN
              BEGIN INSYMBOL;
                IF NOT (SY IN FSY + FSYS) THEN
                  BEGIN ERROR(6); SKIP(FSY + FSYS) END
              END
            ELSE ERROR(4);
            LCP3 := NIL;
            PARMLEN := LC ;     (* SET PARM AREA LEN FOR THE Z VERSION *)
            (*REVERSE POINTERS AND RESERVE LOCAL CELLS FOR COPIES OF MULTIPLE
             VALUES*)
            WHILE LCP1 <> NIL DO
              WITH LCP1@ DO
                BEGIN LCP2 := NEXT; NEXT := LCP3;
                  IF KLASS = VARS THEN
                    IF IDTYPE <> NIL THEN
                      IF (VKIND = ACTUAL) AND (IDTYPE@.FORM > POWER) THEN
                      "  (IDTYPE@.FORM > POWER)) THEN   "
                        BEGIN
                        VADDR := LC; LC := LC + IDTYPE@.SIZE
                        END;
                  LCP3 := LCP1; LCP1 := LCP2
                END;
            FPAR := LCP3
          END     (* IF SY = LPAREN *)
        ELSE FPAR := NIL  ;
    END (*PARAMETERLIST*) ;

    BEGIN (*PROCDECLARATION*)
      LLC := LC;
      IF FSY = PROCSY THEN  LC := 0 (* LCAFTMST (* ADR. OF THE FIRST VARIABLE *)
      ELSE  (* FSY = FUNCSY *)  LC := 8 (* LCAFTFNCRSLT *) ;
      LCP := UPRCPTR ;            (* TO INITIALIZE LCP IN CASE [ *)
      IF SY = IDENT THEN
        BEGIN SEARCHSECTION(DISPLAY[TOP].FNAME,LCP); (*DECIDE WHETHER FORW.*)
          IF LCP <> NIL THEN
          BEGIN
            IF LCP@.KLASS = PROC THEN
              FORW := LCP@.FORWDECL AND(FSY = PROCSY)AND(LCP@.PFKIND = ACTUAL)
            ELSE
              IF LCP@.KLASS = FUNC THEN
                FORW:=LCP@.FORWDECL AND(FSY=FUNCSY)AND(LCP@.PFKIND=ACTUAL)
              ELSE FORW := FALSE;
            IF NOT FORW THEN ERROR(160)
          END
          ELSE FORW := FALSE;
          IF NOT FORW THEN
            BEGIN
              IF FSY = PROCSY THEN NEW(LCP,PROC,DECLARED,ACTUAL)
              ELSE NEW(LCP,FUNC,DECLARED,ACTUAL);
              WITH LCP@ DO
                BEGIN   NAME := ID ;  IDTYPE := NIL;
                  EXTERN := FALSE; PFLEV := LEVEL; PROCLAB := PROCLAB+1 ;
                  PFDECKIND := DECLARED; PFKIND := ACTUAL; PFNAME := PROCLAB ;
                  IF FSY = PROCSY THEN KLASS := PROC
                  ELSE KLASS := FUNC
                END;
              ENTERID(LCP)
            END
          ELSE
            BEGIN LCP1 := LCP@.NEXT;
              WHILE LCP1 <> NIL DO
                BEGIN
                  WITH LCP1@ DO
                    IF KLASS = VARS THEN
                      IF IDTYPE <> NIL THEN
                        BEGIN LCM := VADDR + IDTYPE@.SIZE;
                          IF LCM > LC THEN LC := LCM
                        END;
                  LCP1 := LCP1@.NEXT
                END
              END;
          INSYMBOL
        END
      ELSE ERROR(2);
      OLDLEV := LEVEL; OLDTOP := TOP;  OLDLABEL := INTLABEL ;  INTLABEL := 0 ;
      IF LEVEL < MAXLEVEL THEN LEVEL := LEVEL + 1 ELSE ERROR(251);
      IF TOP < DISPLIMIT THEN
        BEGIN TOP := TOP + 1;
          WITH DISPLAY[TOP] DO
            BEGIN
              IF FORW THEN FNAME := LCP@.NEXT
              ELSE FNAME := NIL;
              FLABEL := NIL;
              OCCUR := BLCK
            END
        END
      ELSE ERROR(250);
      IF FSY = PROCSY THEN
        BEGIN PARAMETERLIST([SEMICOLON],LCP1);
          IF NOT FORW THEN BEGIN  LCP@.NEXT := LCP1; LCP@.PLEN := PARMLEN  END ;
        END
      ELSE
        BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1);
          IF NOT FORW THEN BEGIN  LCP@.NEXT := LCP1; LCP@.PLEN := PARMLEN  END ;
          IF SY = COLON THEN
            BEGIN INSYMBOL;
              IF SY = IDENT THEN
                BEGIN IF FORW THEN ERROR(122);
                  SEARCHID([TYPES],LCP1);
                  LSP := LCP1@.IDTYPE;
                  LCP@.IDTYPE := LSP;
                  IF LSP <> NIL THEN
                    BEGIN
                    IF NOT (LSP@.FORM IN [SCALAR,SUBRANGE,POINTER,POWER]) THEN
                      BEGIN  ERROR(120);  LCP@.IDTYPE := NIL END;
                    END (* WITH LSP@ DO *) ;
                  INSYMBOL
                END
              ELSE BEGIN ERROR(2); SKIP(FSYS + [SEMICOLON]) END
            END
          ELSE
            IF NOT FORW THEN ERROR(123)
        END;
      IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
      IF SY = FORWARDSY THEN
        BEGIN
          IF FORW THEN ERROR(161)
          ELSE LCP@.FORWDECL := TRUE;
          INSYMBOL;
          IF SY = SEMICOLON THEN INSYMBOL ELSE ERROR(14);
          IF NOT (SY IN FSYS) THEN
            BEGIN ERROR(6); SKIP(FSYS) END
        END
      ELSE
        BEGIN LCP@.FORWDECL := FALSE; MARK(MARKP); (* MARK HEAP *)
          REPEAT BLOCK(FSYS,SEMICOLON,LCP);
            IF SY = SEMICOLON THEN
              BEGIN "IF PRTABLES THEN PRINTTABLES(FALSE);" INSYMBOL;
                IF NOT (SY IN [BEGINSY,PROCSY,FUNCSY]) THEN
                  BEGIN ERROR(6); SKIP(FSYS) END
              END
            ELSE ERROR(14)
          UNTIL SY IN [BEGINSY,PROCSY,FUNCSY];
          RELEASE(MARKP); (* RETURN LOCAL ENTRIES ON RUNTIME HEAP *)
        END;
      LEVEL := OLDLEV; TOP := OLDTOP; LC := LLC; INTLABEL := OLDLABEL ;
    END (*PROCDECLARATION*) ;

    PROCEDURE BODY(FSYS: SETOFSYS);
   (* CONST   CIXMAX = 1000; *)
      TYPE OPRANGE = 0..63;

    VAR

          LLCP:CTP; SAVEID:ALPHA;
          CSTPTR:  CSP;
          (*ALLOWS REFERENCING OF NONINTEGER CONSTANTS BY AN INDEX
           (INSTEAD OF A POINTER), WHICH CAN BE STORED IN THE P2-FIELD
           OF THE INSTRUCTION RECORD UNTIL WRITEOUT.
           --> PROCEDURE LOAD, PROCEDURE WRITEOUT*)  (*NOT NEEDED IN P_COMP.*)
          I, ENTNAME : INTEGER;
          LCMAX,LLC1: ADDRRANGE; LCP: CTP;
          LLP: LBP;  PROCNAME : ALPHA ;

      PROCEDURE PUTIC;
      BEGIN
      IF (IC MOD 20 = 0) THEN
        "IF PRTIC THEN " WRITELN(PRR,"MN[31]:4"CHR(31):2, ' ', IC:1) ;
      END;


    " FUNCTION FLDW(NUM : INTEGER) : INTEGER ;
        VAR FW: 0..20 ;
      BEGIN
        FW := 0 ;  IF NUM < 0 THEN FW := 1 ;
        NUM := ABS(NUM) ;
        REPEAT
          NUM := NUM DIV 10 ;  FW := FW+1 ;
        UNTIL NUM = 0 ;
        FLDW := FW
      END (*FLDW*);  "

      FUNCTION GETTYPE(OPERAND: STP): INTEGER ;
        BEGIN   GETTYPE := ORD('I') ;  (* ASSUME INTEGER TYPE *)
          IF OPERAND = NIL THEN  BEGIN IF ERRORCOUNT = 0 THEN ERROR(500) END
          ELSE
            IF OPERAND@.FORM > POWER THEN GETTYPE := ORD('A')
            ELSE
              IF OPERAND@.FORM = POWER THEN GETTYPE := ORD('S')
              ELSE
                IF OPERAND@.FORM = POINTER THEN GETTYPE := ORD('A')
                ELSE
                    IF OPERAND = REALPTR THEN GETTYPE := ORD('R')
                    ELSE
                      IF OPERAND = BOOLPTR THEN GETTYPE := ORD('B')
                    " ELSE
                        BEGIN
                        IF OPERAND@.SIZE = CHARSIZE THEN GETTYPE := ORD('C')
                        END  "
        END (*GETTYPE*) ;

      FUNCTION PROCTYPE(FPROCP: CTP): INTEGER ;

      BEGIN   PROCTYPE := ORD('P') ;
        IF FPROCP <> NIL THEN
          IF FPROCP@.IDTYPE <> NIL THEN
            WITH FPROCP@ DO
              BEGIN
              IF IDTYPE@.FORM = POWER THEN  PROCTYPE := ORD('S')
              ELSE  IF IDTYPE = REALPTR THEN  PROCTYPE := ORD('R')
                ELSE IF IDTYPE = BOOLPTR THEN  PROCTYPE := ORD('B')
                  ELSE IF IDTYPE@.FORM = POINTER THEN
                    PROCTYPE := ORD('A')
                 "  ELSE  IF (IDTYPE = CHARPTR) OR ((IDTYPE@.FORM = SUBRANGE)
                            AND (IDTYPE@.RANGETYPE = CHARPTR))
                            IDTYPE@.SIZE = 1 THEN PROCTYPE := ORD('C')  "
                       ELSE  PROCTYPE := ORD('I') ;
             END
      END (*PROCTYPE*) ;

      PROCEDURE GEN0(FOP: OPRANGE);
      BEGIN
        IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,"MN[FOP]:4"CHR(FOP):2) END;
        IC := IC + 1
      END (*GEN0*) ;

      PROCEDURE GEN1(FOP: OPRANGE; FP2: INTEGER);
        VAR K: INTEGER;
      BEGIN
        IF PRCODE THEN
          BEGIN PUTIC; WRITE(PRR,"MN[FOP]:4"CHR(FOP):2);
            IF FOP = 30 THEN  (*CSP*)  WRITELN(PRR,"SNA[FP2]:4"CHR(FP2):2)
            ELSE IF (FOP = 38) OR (FOP = 37) THEN  (*LCA*) (*LSA*)
                   BEGIN WRITE(PRR,'''':2);
                     WITH CSTPTR@  DO
                       FOR K := 1 TO SLNGTH DO
                         BEGIN  WRITE(PRR,SVAL[K]);
                         IF SVAL[K] = '''' THEN WRITE(PRR,'''')
                         END ;
                     WRITELN(PRR,'''')
                   END
                 ELSE IF FOP IN [26, 41, 42]  THEN  (*STO,RET,MST*)
                        WRITELN(PRR,CHR(FP2):2)
                      ELSE WRITELN(PRR, ' ', FP2:1"5")
          END;
        IC := IC + 1
      END (*GEN1*) ;

      PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER);
        VAR I, J, K : INTEGER;  "FIRSTMEM : BOOLEAN ;"
      BEGIN
        IF PRCODE THEN
          BEGIN PUTIC; WRITE(PRR,"MN[FOP]:4"CHR(FOP):2,' ');
            CASE FOP OF
              22,23,35,39,43: (*DEC,INC,IND,LDO,SRO*)
                WRITELN(PRR,CHR(FP1),',',FP2:1"6#FW(FP2)") ;
             50: (*LDA*)
                WRITELN(PRR,FP1:1"#FW(FP1)",',',FP2:1"6#FW(FP2)");
              47,48,49,52,53,55: (*EQU..NEQ*)
                BEGIN WRITE(PRR,CHR(FP1));
                  IF FP1 = ORD('M') THEN WRITE(PRR,',',FP2:1"6#FW(FP2)");
                  WRITELN(PRR)
                END;
              51: (*LDC*)
                CASE FP1 OF
                  0: WRITELN(PRR,'C,''',CHR(FP2)":1,''''") ;
                  1: WRITELN(PRR,'I,',FP2:1"6#FW(FP2)");
                  2: BEGIN WRITELN(PRR,'R,',CSTPTR@.RVAL);
                     " WITH CSTPTR@  DO
                         FOR K := 1 TO REALLNGTH DO
                           IF RVAL[K] <> ' ' THEN WRITE(PRR,RVAL[K]);
                       WRITELN(PRR) "
                     END;
                  3: WRITELN(PRR,'B,',FP2:1);
                  4: WRITELN(PRR,'N');
                  5: BEGIN WRITE(PRR,'S,(');

                       WITH CSTPTR@ DO
                         FOR I := 0 TO 7 DO
                           BEGIN  J := 0 ;  K := SETRANGE-I*8 ;
                           FOR K := K DOWNTO K-7 DO
                             BEGIN  J := J*2 ;
                             IF K IN PVAL THEN J := J+1 ;
                             END ;
                           IF I > 0 THEN  WRITE(PRR,',') ;
                           WRITE(PRR, J: 1"4#FW(J)" ) ;
                           END (* FOR I := 0 TO 7 *) ;
                       WRITELN(PRR,')') ;
                     END
                END
            END;
          END;
          IC := IC + 1
      END (*GEN2*) ;

      PROCEDURE GEN3(FOP: OPRANGE; FP0,FP1,FP2: INTEGER);
      BEGIN
        IF PRCODE THEN
          BEGIN PUTIC;
          WRITELN(PRR, "MN[FOP]:4"CHR(FOP):2, CHR(FP0):2,',',FP1:1"6,#FW(FP1)",
                    ',',FP2:1"6,#FW(FP2)") ;
          END;
          IC := IC + 1
      END (*GEN3*) ;

      PROCEDURE LOAD;
      BEGIN
        WITH GATTR DO
          IF TYPTR <> NIL THEN
            BEGIN
              CASE KIND OF
                CST:   IF (TYPTR@.FORM = SCALAR) AND (TYPTR <> REALPTR) THEN
                         IF TYPTR = BOOLPTR THEN GEN2(51(*LDC*),3,CVAL.IVAL)
                         ELSE
                          IF TYPTR = CHARPTR THEN GEN2(51(*LDC*),0,CVAL.IVAL)
                           ELSE GEN2(51(*LDC*),1,CVAL.IVAL)  (*INTEGER*)
                       ELSE
                         IF TYPTR = NILPTR THEN GEN2(51(*LDC*),4,0)
                         ELSE
                             BEGIN
                               CSTPTR  := CVAL.VALP;
                               IF TYPTR = REALPTR THEN
                                 GEN2(51(*LDC*),2,0)
                               ELSE
                                  GEN2(51(*LDC*),5,0)
                             END;
                VARBL: CASE ACCESS OF
                         DRCT:    GEN3(54(*LOD*),GETTYPE(TYPTR),
                                         " LEVEL-" VLEVEL,DPLMT);
                         INDRCT: GEN2(35(*IND*),GETTYPE(TYPTR),IDPLMT);
                         INXD:   ERROR(400)
                       END;
                EXPR:
              END;
              KIND := EXPR
            END
      END (*LOAD*) ;

      PROCEDURE STORE(VAR FATTR: ATTR);
      BEGIN
        WITH FATTR DO
          IF TYPTR <> NIL THEN
            CASE ACCESS OF
              DRCT:   GEN3(56(*STR*),GETTYPE(TYPTR),VLEVEL,DPLMT);
              INDRCT: IF IDPLMT <> 0 THEN ERROR(400)
                      ELSE GEN1(26(*STO*),GETTYPE(TYPTR));
              INXD:   ERROR(400)
            END
      END (*STORE*) ;

      PROCEDURE LOADADDRESS;
      BEGIN
        WITH GATTR DO
          IF TYPTR <> NIL THEN
            BEGIN
              CASE KIND OF
                CST:   IF STRING(TYPTR) THEN
                         BEGIN
                         CSTPTR := CVAL.VALP ;
                         IF PACKSTRNG THEN  GEN1(37 (*LSA*),0)
                         ELSE GEN1(38(*LCA*),0) ;
                         END
                       ELSE ERROR(400);
                VARBL: CASE ACCESS OF
                         DRCT:   GEN2(50(*LDA*),VLEVEL,DPLMT);
                         INDRCT: IF IDPLMT <> 0 THEN
                                    GEN2(23(*INC*),ORD('A'),IDPLMT);
                         INXD:   ERROR(400)
                       END;
                EXPR:  ERROR(400)
              END;
              KIND := VARBL; ACCESS := INDRCT; IDPLMT := 0
            END
      END (*LOADADDRESS*) ;


      PROCEDURE GENFJP(FADDR: INTEGER);
      BEGIN LOAD;
        IF GATTR.TYPTR <> NIL THEN
          IF GATTR.TYPTR <> BOOLPTR THEN ERROR(144);
        IF PRCODE THEN BEGIN PUTIC;
          WRITELN(PRR,"MN[33]:4"CHR(33):2,' L',FADDR:1"3#FW(FADDR)") END;
        IC := IC + 1
      END (*GENFJP*) ;

      PROCEDURE GENUJPFJP(FOP: OPRANGE; FP2: INTEGER);
      BEGIN
        IF PRCODE THEN
          BEGIN PUTIC;
          WRITELN(PRR,"MN[FOP]:4"CHR(FOP):2,' L',FP2:1"3#FW(FP2)")
          END;
        IC := IC + 1
      END (*GENUJPFJP*);


     "  PROCEDURE MKNAME(VAR ALB: ALPHA; NLB: INTEGER ) ;
          VAR I, J: INTEGER ;

        BEGIN
          I := 0 ;
          WHILE (I < 5) AND (ALB[I] <> ' ') DO
            BEGIN  IF ALB[I] = '_' THEN  ALB[I] := '$' ;  I := I+1  END ;
          FOR J := 7 DOWNTO I DO
            BEGIN
            ALB[J] := CHR( ORD('0')+ NLB MOD 10 ) ;
            NLB := NLB DIV 10 ;
            END ;
        END (*MKNAME*) ;   "

      PROCEDURE GENCUP(FP0,FP1,FP2: INTEGER);


      BEGIN (*GENCUP*)
        IF PRCODE THEN
          BEGIN  PUTIC ;

          CALL_CNT[FP2] := CALL_CNT[FP2]+1 ;
          WRITELN(PRR,"MN[46]:4"CHR(46):2,CHR(FP0):2,',',FP1:1"2#FW(FP1)",
                      ',$',FP2:1"3#FW(FP2)" "TEMPNAME:8,PROCNAME:10");
          END ;
        IC := IC + 1
      END (*GENCUP*);

      PROCEDURE GENENT(FP0,FP1,FP2: INTEGER;PROCNAME: ALPHA);
        VAR "TEMPNAME : ALPHA ;" TEMPLEN :  0..99 ;

      BEGIN (*GENENT*)
        IF PRCODE THEN
          BEGIN  PUTIC ;
          IF FPROCP <> NIL THEN
             BEGIN "MKNAME(TEMPNAME,FP2) ;" TEMPLEN := FPROCP@.PLEN   END
          ELSE  TEMPLEN := LASTFILBUF ;
          WRITELN(PRR, '$'"TEMPNAME:8",FP2:3"#FW(FP2)", "MN[32]:4"CHR(32):2,
                       CHR(FP0):2,',',LEVEL:1"#FW(LEVEL)", ',L',
                       FP1:1"3#FW(FP1)", ',', TEMPLEN:2, PROCNAME:10,
                       DEBUG:2) ;
          END ;
        IC := IC + 1
      END (*GENENT*);

      PROCEDURE GENDEF(L1, L2: ADDRRANGE ) ;
        BEGIN
        IF PRCODE THEN
          WRITELN(PRR, 'L', L1:1"3#FW(L1)", "MN[63(*DEF*)]:4"CHR(63):2, L2:6);
        END (*GENDEF*) ;



      PROCEDURE CHKBNDS(FSP: STP);
        VAR LMIN,LMAX: INTEGER;
      BEGIN
        IF FSP <> NIL THEN
          IF FSP <> BOOLPTR THEN
            IF FSP <> INTPTR THEN
              IF FSP <> REALPTR THEN
                IF FSP@.FORM <= POINTER THEN
                  BEGIN
                    GETBOUNDS(FSP,LMIN,LMAX);
                    IF LMAX-LMIN <= 0 THEN
                      IF ASSIGN THEN  GEN3(45(*CHK*),ORD('A'),-1,0)
                      ELSE (* ACCESS *)  GEN3(45(*CHK*),ORD('A'),0,0)
                    ELSE GEN3(45(*CHK*),ORD('I'),LMIN,LMAX) ;
                  END
      END (*CHKBNDS*);

      PROCEDURE PUTLABEL(LABNAME: INTEGER);
      BEGIN
      IF PRCODE THEN WRITELN(PRR, 'L', LABNAME:1"3#FW(LABNAME)","' LAB'"'L':2)
      END (*PUTLABEL*);

      PROCEDURE STATEMENT(FSYS: SETOFSYS);
        LABEL 1;
        VAR LCP: CTP; LLP: LBP; TTOP : DISPRANGE ;

        PROCEDURE EXPRESSION(FSYS: SETOFSYS); FORWARD;

        PROCEDURE SELECTOR(FSYS: SETOFSYS; FCP: CTP);
          VAR LATTR: ATTR; LCP: CTP; LMIN,LMAX: INTEGER;
        BEGIN
          WITH FCP@, GATTR DO
            BEGIN TYPTR := IDTYPE; KIND := VARBL;
              CASE KLASS OF
                VARS:
                  IF VKIND = ACTUAL THEN
                    BEGIN ACCESS := DRCT; VLEVEL := VLEV;
                      DPLMT := VADDR
                    END
                  ELSE
                    BEGIN
                      GEN3(54(*LOD*),ORD('A'),VLEV,VADDR);
                      ACCESS := INDRCT; IDPLMT := 0
                    END;
                FIELD:
                  WITH DISPLAY[DISX] DO
                    IF OCCUR = CREC THEN
                      BEGIN ACCESS := DRCT; VLEVEL := CLEV;
                        DPLMT := CDSPL + FLDADDR
                      END
                    ELSE
                      BEGIN
                        GEN3(54(*LOD*),ORD('A'), LEVEL,VDSPL)  ;
                        ACCESS := INDRCT; IDPLMT := FLDADDR
                      END;
                FUNC:
                  IF PFDECKIND = STANDARD THEN ERROR(150)
                  ELSE
                    IF PFLEV = 0 THEN ERROR(150)   (*EXTERNAL FCT*)
                    ELSE
                      IF PFKIND = FORMAL THEN ERROR(151)
                      ELSE
                        IF (FPROCP <> FCP) THEN  ERROR(177)
                        ELSE
                          BEGIN ACCESS := DRCT; VLEVEL := PFLEV + 1;
                            DPLMT := 0 ;(* FNCRSLT RELAT. ADDR. OF FCT. RESULT*)
                          END
              END (*CASE*) ;
            END (*WITH*);
          IF NOT (SY IN SELECTSYS + FSYS) THEN
            BEGIN ERROR(59); SKIP(SELECTSYS + FSYS) END;
          WHILE SY IN SELECTSYS DO
            BEGIN
        (*[*)   IF SY = LBRACK THEN
                BEGIN
                  REPEAT LATTR := GATTR;
                    WITH LATTR DO
                      IF TYPTR <> NIL THEN
                        IF TYPTR@.FORM <> ARRAYS THEN
                          BEGIN ERROR(138); TYPTR := NIL END;
                    LOADADDRESS;
                    INSYMBOL; EXPRESSION(FSYS + [COMMA,RBRACK]);
                    LOAD;
                    IF GATTR.TYPTR <> NIL THEN
                      IF GATTR.TYPTR@.FORM <> SCALAR THEN ERROR(113);
                    IF LATTR.TYPTR <> NIL THEN
                      WITH LATTR.TYPTR@ DO
                        BEGIN
                          IF COMPTYPES(INXTYPE,GATTR.TYPTR) THEN
                            BEGIN
                              IF INXTYPE <> NIL THEN
                                BEGIN GETBOUNDS(INXTYPE,LMIN,LMAX);
                                  IF DEBUG THEN
                                    GEN3(45(*CHK*),ORD('J'),LMIN,LMAX) ;
                                  IF LMIN > 0 THEN
                                    GEN2(22(*DEC*),GETTYPE(GATTR.TYPTR),LMIN)
                                  ELSE IF LMIN < 0 THEN
                                     GEN2(23(*INC*),GETTYPE(GATTR.TYPTR),-LMIN)
                                  (*OR SIMPLY GEN1(31,LMIN)*)
                                END
                            END
                          ELSE ERROR(139);
                          WITH GATTR DO
                            BEGIN TYPTR := AELTYPE; KIND := VARBL;
                              ACCESS := INDRCT; IDPLMT := 0 ;
                              IF GATTR.TYPTR <> NIL THEN
                                BEGIN  LMIN := TYPTR@.SIZE ;
                                GEN1(36(*IXA*),LMIN)
                                END (*TYPTR <> NIL*) ;
                            END (*WITH GATTR DO*) ;
                        END
                  UNTIL SY <> COMMA;
                  IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
                END (*IF SY = LBRACK*)
              ELSE
        (*.*)     IF SY = PERIOD THEN
                  BEGIN
                    WITH GATTR DO
                      BEGIN
                        IF TYPTR <> NIL THEN
                          IF TYPTR@.FORM <> RECORDS THEN
                            BEGIN ERROR(140); TYPTR := NIL END;
                        INSYMBOL;
                        IF SY = IDENT THEN
                          BEGIN
                            IF TYPTR <> NIL THEN
                              BEGIN SEARCHSECTION(TYPTR@.FSTFLD,LCP);
                                IF LCP = NIL THEN
                                  BEGIN ERROR(152); TYPTR := NIL END
                                ELSE
                                  WITH LCP@ DO
                                    BEGIN TYPTR := IDTYPE;
                                      CASE ACCESS OF
                                        DRCT:   DPLMT := DPLMT + FLDADDR;
                                        INDRCT: IDPLMT := IDPLMT + FLDADDR;
                                        INXD:   ERROR(400)
                                      END
                                    END
                              END;
                            INSYMBOL
                          END (*SY = IDENT*)
                        ELSE ERROR(2)
                      END (*WITH GATTR*)
                  END (*IF SY = PERIOD*)
                ELSE
        (*@*)       BEGIN
                    IF GATTR.TYPTR <> NIL THEN
                      WITH GATTR,TYPTR@ DO
                        IF FORM = POINTER THEN
                          BEGIN
                          LOAD ;
                          IF DEBUG THEN  CHKBNDS(GATTR.TYPTR) ;
                          TYPTR := ELTYPE ;
                            WITH GATTR DO
                              BEGIN KIND := VARBL; ACCESS := INDRCT;
                                IDPLMT := 0
                              END
                          END
                        ELSE
                          IF FORM = FILES THEN TYPTR := FILTYPE
                          ELSE ERROR(141);
                    INSYMBOL
                  END;
              IF NOT (SY IN FSYS + SELECTSYS) THEN
                BEGIN ERROR(6); SKIP(FSYS + SELECTSYS) END ;
            END (*WHILE*) ;
        END (*SELECTOR*) ;

        PROCEDURE CALL(FSYS: SETOFSYS; FCP: CTP);
          VAR LKEY: 1..15;  MATCHPAR : BOOLEAN ;

          PROCEDURE VARIABLE(FSYS: SETOFSYS);
            VAR LCP: CTP;
          BEGIN
            IF SY = IDENT THEN
              BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END
            ELSE BEGIN ERROR(2); LCP := UVARPTR END;
            SELECTOR(FSYS,LCP)
          END (*VARIABLE*) ;


        PROCEDURE  RWSETUP(DFILE: ALPHA) ;
        (* TO SET UP FILE ADDRESS PARAMETER FOR READ/WRITE *)

          VAR  LCP : CTP ;  SAVED : BOOLEAN ; TEMPID : ALPHA ; TEMPSY : SYMBOL ;

          BEGIN  SAVED := TRUE ;

          IF SY = IDENT THEN
            BEGIN  SEARCHID([VARS,FIELD,FUNC,KONST],LCP) ;
            IF LCP@.IDTYPE <> NIL THEN
              WITH LCP@.IDTYPE@ DO
                IF FORM = FILES THEN
                  IF FILTYPE = CHARPTR THEN SAVED := FALSE
                  ELSE  ERROR(398) ;
            END (* SY = IDENT *) ;

          IF SAVED THEN (* USE IMPLIED FILE NAME *)
            BEGIN   TEMPSY := SY ;  TEMPID := ID ;  SY := COMMA ;  ID := DFILE ;
            SEARCHID([VARS],LCP) ;
            END (* IF SAVED *)
          ELSE  INSYMBOL ;

          SELECTOR(FSYS+[COMMA,RPARENT],LCP) ;  LOADADDRESS ; (* GET FILE ADR *)
        " GEN1(30(*CSP*),29(*SIO*)) ; "
          IF SAVED THEN  BEGIN  ID := TEMPID ;  SY := TEMPSY  END ;
          END (*RWSETUP*) ;


          PROCEDURE GETPUTRESETREWRITE;
          BEGIN "VARIABLE(FSYS + [RPARENT]); LOADADDRESS;  "
          IF ODD(LKEY) (*GET, RESET*)  THEN  RWSETUP(NA[37] (*INPUT*))
          ELSE (*PUT, REWRITE*)  RWSETUP(NA[38] (*OUTPUT*) ) ;
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR@.FORM <> FILES THEN ERROR(116);
              GEN1(30(*CSP*),LKEY(*GET,PUT,RES,REW*)) ;
              GEN1(30(*CSP*),30(*EIO*)) ;
          END (*GETPUTRESETREWRITE*) ;

          PROCEDURE READ1;
          " VAR LCP:CTP; LLEV:LEVRANGE; LADDR:ADDRRANGE; "
          BEGIN (* LLEV := 1 ;  LADDR := FIRSTFILEBUF ; (*ASSUME 'INPUT'*)
        "   IF SY = IDENT THEN " RWSETUP(NA[37] (*'INPUT'*)) ;
        "   ELSE  BEGIN  ERROR(2) ;  INSYMBOL  END ;  "
            IF SY = COMMA THEN  INSYMBOL;
            IF LKEY = 5 (*READ*) THEN  IF SY <> IDENT THEN ERROR(2) ;
            IF SY = IDENT THEN
              REPEAT  VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
                IF GATTR.TYPTR <> NIL THEN
                  IF STRING(GATTR.TYPTR) THEN
                    BEGIN
                    GEN2(51(*LDC*),1,GATTR.TYPTR@.SIZE DIV CHARSIZE) ;
                    GEN1(30(*CSP*),27(*RDS*))
                    END
                  ELSE
                    BEGIN
                    IF COMPTYPES(INTPTR,GATTR.TYPTR) THEN
                      GEN1(30(*CSP*),24(*RDI*))
                    ELSE
                      IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN
                        GEN1(30(*CSP*),14(*RDR*))
                      ELSE
                        IF COMPTYPES(CHARPTR,GATTR.TYPTR) THEN
                          GEN1(30(*CSP*),5(*RDC*))
                        ELSE
                          IF COMPTYPES(BOOLPTR,GATTR.TYPTR) THEN
                            GEN1(30(*CSP*),"12(*RDB*)" 24(*RDI*))
                          ELSE  ERROR(116) ;
                    END ;
                TEST := SY <> COMMA;
                IF NOT TEST THEN INSYMBOL
              UNTIL TEST ;
            IF LKEY = 11 THEN
              BEGIN
                GEN1(30(*CSP*),23(*RLN*))
              END ;
            GEN1(30(*CSP*),30(*EIO*)) ;
          END (*READ*) ;

          PROCEDURE WRITE1;
            VAR LSP: STP; DEFAULT : BOOLEAN; LLKEY: 1..15;
              LEN:ADDRRANGE;
          BEGIN LLKEY := LKEY;  TEST := FALSE ;  PACKSTRNG := TRUE ;
            RWSETUP(NA[38] (*'OUTPUT  '*) ) ;
    "       IF SY = RPARENT THEN
              BEGIN  TEST := TRUE ;  IF LLKEY = 6 THEN ERROR(116) ; END ;
            IF SY = COMMA THEN  INSYMBOL ;
            IF NOT TEST THEN "
            IF SY = COMMA THEN
              BEGIN  INSYMBOL;  IF NOT (SY IN CONSTBEGSYS) THEN ERROR(6)  END ;
            IF SY IN CONSTBEGSYS THEN
              REPEAT  EXPRESSION(FSYS+[COMMA,COLON,RPARENT]) ;
                LSP := GATTR.TYPTR;
                IF LSP <> NIL THEN
                  IF LSP@.FORM <= SUBRANGE THEN LOAD ELSE LOADADDRESS;
                IF SY = COLON THEN
                  BEGIN INSYMBOL; EXPRESSION(FSYS + [COMMA,COLON,RPARENT]);
                    IF GATTR.TYPTR <> NIL THEN
                      IF GATTR.TYPTR <> INTPTR THEN ERROR(116);
                    LOAD; DEFAULT := FALSE
                  END
                ELSE DEFAULT := TRUE;
                IF SY = COLON THEN
                  BEGIN  INSYMBOL;  EXPRESSION(FSYS + [COMMA,RPARENT]);
                    IF GATTR.TYPTR <> NIL THEN
                      IF GATTR.TYPTR <> INTPTR THEN ERROR(116);
                    IF LSP <> REALPTR THEN ERROR(124);
                    LOAD; ERROR(398);
                  END
                ELSE
                  IF LSP = INTPTR THEN
                    BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,12);
                      GEN1(30(*CSP*),6(*WRI*))
                    END
                  ELSE
                    IF LSP = REALPTR THEN
                      BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,14);
                        GEN1(30(*CSP*),8(*WRR*))
                      END
                    ELSE
                      IF LSP = CHARPTR THEN
                        BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,1);
                          GEN1(30(*CSP*),9(*WRC*))
                        END
                      ELSE
                      IF LSP = BOOLPTR THEN
                        BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,5);
                          GEN1(30(*CSP*),"13(*WRB*)" 6(*WRI*))
                        END
                      ELSE
                        IF LSP <> NIL THEN
                          BEGIN
                            IF LSP@.FORM = SCALAR THEN ERROR(398)
                            ELSE
                              IF STRING(LSP) THEN
                                BEGIN LEN := LSP@.SIZE DIV CHARSIZE;
                                  IF DEFAULT THEN
                                        GEN2(51(*LDC*),1,LEN);
                                  GEN2(51(*LDC*),1,LEN);
                                  GEN1(30(*CSP*),10(*WRS*))
                                END
                              ELSE ERROR(116)
                          END;
                TEST := SY <> COMMA;
                IF NOT TEST THEN   INSYMBOL ;
              UNTIL TEST;

            IF LLKEY = 12 THEN (*WRITELN*)
              BEGIN
                GEN1(30(*CSP*),22(*WLN*))
              END ;
            GEN1(30(*CSP*),30(*EIO*)) ;
            PACKSTRNG := FALSE ;
          END (*WRITE1*) ;

          PROCEDURE PACK1;
            VAR LSP,LSP1: STP;
          BEGIN ERROR(398); VARIABLE(FSYS + [COMMA,RPARENT]);
            LSP := NIL; LSP1 := NIL;
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR@ DO
                IF FORM = ARRAYS THEN
                  BEGIN LSP := INXTYPE; LSP1 := AELTYPE END
                ELSE ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            EXPRESSION(FSYS + [COMMA,RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR@.FORM <> SCALAR THEN ERROR(116)
              ELSE
                IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            VARIABLE(FSYS + [RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR@ DO
                IF FORM = ARRAYS THEN
                  BEGIN
                    IF NOT COMPTYPES(AELTYPE,LSP1)
                      OR NOT COMPTYPES(INXTYPE,LSP) THEN
                      ERROR(116)
                  END
                ELSE ERROR(116)
          END (*PACK*) ;

          PROCEDURE UNPACK1;
            VAR LSP,LSP1: STP;
          BEGIN ERROR(398); VARIABLE(FSYS + [COMMA,RPARENT]);
            LSP := NIL; LSP1 := NIL;
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR@ DO
                IF FORM = ARRAYS THEN
                  BEGIN LSP := INXTYPE; LSP1 := AELTYPE END
                ELSE ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            VARIABLE(FSYS + [COMMA,RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR@ DO
                IF FORM = ARRAYS THEN
                  BEGIN
                    IF NOT COMPTYPES(AELTYPE,LSP1)
                      OR NOT COMPTYPES(INXTYPE,LSP) THEN
                      ERROR(116)
                  END
                ELSE ERROR(116);
            IF SY = COMMA THEN INSYMBOL ELSE ERROR(20);
            EXPRESSION(FSYS + [RPARENT]);
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR@.FORM <> SCALAR THEN ERROR(116)
              ELSE
                IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN ERROR(116);
          END (*UNPACK*) ;

          PROCEDURE NEW1;
            LABEL 1;
            VAR LSP,LSP1: STP; VARTS,LMIN,LMAX: INTEGER;
                LSIZE,LSZ: ADDRRANGE; LVAL: VALU;
          BEGIN VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;
            LSP := NIL; VARTS := 0; LSIZE := 0;
            IF GATTR.TYPTR <> NIL THEN
              WITH GATTR.TYPTR@ DO
                IF FORM = POINTER THEN
                  BEGIN
                    IF ELTYPE <> NIL THEN
                      BEGIN LSIZE := ELTYPE@.SIZE;
                        IF ELTYPE@.FORM = RECORDS THEN LSP := ELTYPE@.RECVAR
                      END
                  END
                ELSE ERROR(116);
            WHILE SY = COMMA DO
              BEGIN INSYMBOL;CONSTANT(FSYS + [COMMA,RPARENT],LSP1,LVAL);
                VARTS := VARTS + 1;
                (*CHECK TO INSERT HERE: IS CONSTANT IN TAGFIELDTYPE RANGE*)
                IF LSP = NIL THEN ERROR(158)
                ELSE
                  IF LSP@.FORM <> TAGFLD THEN ERROR(162)
                  ELSE
                    IF LSP@.TAGFIELDP <> NIL THEN
                      IF STRING(LSP1) OR (LSP1 = REALPTR) THEN ERROR(159)
                      ELSE
                        IF COMPTYPES(LSP@.TAGFIELDP@.IDTYPE,LSP1) THEN
                          BEGIN
                            LSP1 := LSP@.FSTVAR;
                            WHILE LSP1 <> NIL DO
                              WITH LSP1@ DO
                                IF VARVAL.IVAL = LVAL.IVAL THEN
                                  BEGIN LSIZE := SIZE; LSP := SUBVAR;
                                    GOTO 1
                                  END
                                ELSE LSP1 := NXTVAR;
                            LSIZE := LSP@.SIZE; LSP := NIL;
                          END
                        ELSE ERROR(116);
          1:  END (*WHILE*) ;
            GEN1(58(*NEW*),LSIZE);
          END (*NEW*) ;

          PROCEDURE MARK1;
          BEGIN VARIABLE(FSYS+[RPARENT]);
             IF GATTR.TYPTR <> NIL THEN
               IF GATTR.TYPTR@.FORM = POINTER THEN
                 BEGIN LOADADDRESS; GEN0(59(*SAV*)) END
               ELSE ERROR(125)
          END(*MARK*);

          PROCEDURE RELEASE1;
          BEGIN  VARIABLE(FSYS+[RPARENT]);
                IF GATTR.TYPTR <> NIL THEN
                   IF GATTR.TYPTR@.FORM = POINTER THEN
                      BEGIN   LOAD;  GEN0(60(*RST*))  END
                   ELSE ERROR(125)
          END (*RELEASE*);

          PROCEDURE TRAPEXIT ;

          (*THIS PROCEDURE IS TO FACILITATE COMMUNICATION WITH THE OUTSIDE WORLD
          (* AND PROVIDE BREAK POINTS IN THE PASCAL PROGRAM.
          (* 'TRAP(I, R)'  RETURNS THE INTEGER CONSTANT I AS WELL AS A POINTER
          (* TO THE SECOND PARAMETER 'R' (I.E. ADDRESS OF R) TO THE OPERATING
          (* SYSTEM. THE FIRST PARAMETER IS INTENDED TO BE USED AS A
          (* 'FUNCTION NUMBER' AND THE SECOND ONE AS THE 'VAR' TYPE ARGUMENT
          (* WHICH MAY BE INSPECTED AND MODIFIED, TO THAT FUNCTION            *)

            BEGIN  " EXPRESSION(FSYS+[RPARENT,COMMA]) ;  "
            IF GATTR.TYPTR <> INTPTR THEN  ERROR(116) ;
            IF LKEY = 14 THEN (*TRAP*)
              BEGIN
              IF SY <> COMMA THEN  ERROR(6)
              ELSE
                BEGIN  INSYMBOL ;
                EXPRESSION(FSYS+[RPARENT]) ;
                WITH GATTR DO
                  IF TYPTR <> NIL THEN
                    BEGIN
                    IF KIND <> VARBL THEN
                      IF TYPTR@.FORM <= POWER THEN
                        BEGIN  LOAD ;
                        KIND := VARBL ;  ACCESS := DRCT ;  VLEVEL := LEVEL ;
                        DPLMT := LC ;   STORE(GATTR) ;
                        END ;
                    LOADADDRESS ;
                    END ;
                END (*WITH*) ;
        "     GEN1(30(*CSP*),28(*TRP*)) ;  "
              END ;
            GEN1(30(*CSP*),LKEY+14 (*TRAP*) (*XIT*)) ;
            END (* TRAPEXIT *) ;

          PROCEDURE ABS1;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR = INTPTR THEN GEN0(0(*ABI*))
              ELSE
                IF GATTR.TYPTR = REALPTR THEN GEN0(1(*ABR*))
                ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END
          END (*ABS*) ;

          PROCEDURE SQR1;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR = INTPTR THEN GEN0(24(*SQI*))
              ELSE
                IF GATTR.TYPTR = REALPTR THEN GEN0(25(*SQR*))
                ELSE BEGIN ERROR(125); GATTR.TYPTR := INTPTR END
          END (*SQR*) ;

          PROCEDURE TRUNC1;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR <> REALPTR THEN ERROR(125);
            GEN0(27(*TRC*));
            GATTR.TYPTR := INTPTR
          END (*TRUNC*) ;

          PROCEDURE ODD1;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
            GEN0(20(*ODD*));
            GATTR.TYPTR := BOOLPTR
          END (*ODD*) ;

          PROCEDURE ORD1;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR@.FORM >= POWER THEN ERROR(125);
          " GEN0(61(*ORD*)) ; "
            GATTR.TYPTR := INTPTR
          END (*ORD1*) ;

          PROCEDURE CHR1;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR <> INTPTR THEN ERROR(125);
          " GEN0(62(*CHR*)) ; "
            GATTR.TYPTR := CHARPTR
          END (*CHR*) ;

          PROCEDURE PREDSUCCTIM;
          BEGIN (*ERROR(398);*) (*TRANSLATES INTO 'DEC' AND 'INC'*)
            IF GATTR.TYPTR <> NIL THEN
               IF LKEY = 24  THEN
                  BEGIN  IF GATTR.TYPTR <> INTPTR THEN  ERROR(116) ;
                  GEN1(30(*CSP*),21(*CLK*)) ;
                  END
               ELSE
                IF (GATTR.TYPTR = REALPTR) OR (GATTR.TYPTR@.FORM <> SCALAR) THEN
                   ERROR(125)
                ELSE  GEN2(LKEY(*DEC,INC*),ORD('I'),1) ;
                (* LKEY HAPPENS TO BE THE OPCODE AS WELL *)
          END (*PREDSUCCTIM*) ;

          PROCEDURE EOFEOLN;
          BEGIN
            RWSETUP(NA[37] (*'INPUT       '*) ) ;
         "  GEN1(30(*CSP*),29(*SIO*)) ;  "
            (* LKEY HAPPENS TO BE THE CSP NUMBER AS WELL ! *)
            GEN1(30(*CSP*), LKEY(*EOF*)(*ELN*)) ;
            GEN1(30(*CSP*),30(*EIO*)) ;
            GATTR.TYPTR := BOOLPTR
          END (*EOFEOLN*) ;

          PROCEDURE MATH;
          BEGIN
            IF GATTR.TYPTR <> NIL THEN
              IF GATTR.TYPTR = INTPTR  THEN
                BEGIN  GEN0(10(*FLT*)) ;
                GATTR.TYPTR := REALPTR ;
              END ;
              IF GATTR.TYPTR <> REALPTR THEN ERROR(116)
              ELSE   GEN1(30(*CSP*), LKEY-12(*SIN..ATAN*)) ;
          END (*MATH*) ;

          PROCEDURE CALLNONSTANDARD;
            VAR NXT,LCP: CTP; LSP: STP; LKIND: IDKIND; LB, SAVEPFLG: BOOLEAN;
                LOCPAR, LLC: ADDRRANGE;
          BEGIN  LOCPAR := 0;  SAVEPFLG := PACKSTRNG ;  PACKSTRNG := FALSE ;
            WITH FCP@ DO
              BEGIN NXT := NEXT; LKIND := PFKIND;
                IF NOT EXTERN THEN GEN1( 41(*MST*),PROCTYPE(FCP) ) ;
              END;
            IF SY = LPARENT THEN
              BEGIN LLC := LC;
                REPEAT LB := FALSE; (*DECIDE WHETHER PROC/FUNC MUST BE PASSED*)
                  IF LKIND = ACTUAL THEN
                    BEGIN
                      IF NXT = NIL THEN ERROR(126)
                      ELSE LB := NXT@.KLASS IN [PROC,FUNC]
                    END ELSE ERROR(398);
                  (*FOR FORMAL PROC/FUNC LB IS FALSE AND EXPRESSION
                   WILL BE CALLED, WHICH WILL ALLWAYS INTERPRET A PROC/FUNC ID
                  AT ITS BEGINNING AS A CALL RATHER THAN A PARAMETER PASSING.
                  IN THIS IMPLEMENTATION, PARAMETER PROCEDURES/FUNCTIONS
                  ARE THEREFORE NOT ALLOWED TO HAVE PROCEDURE/FUNCTION
                  PARAMETERS*)
                  INSYMBOL;
                  IF LB THEN   (*PASS FUNCTION OR PROCEDURE*)
                    BEGIN ERROR(398);
                      IF SY <> IDENT THEN
                        BEGIN ERROR(2); SKIP(FSYS + [COMMA,RPARENT]) END
                      ELSE
                        BEGIN
                          IF NXT@.KLASS = PROC THEN SEARCHID([PROC],LCP)
                          ELSE
                            BEGIN SEARCHID([FUNC],LCP);
                              IF NOT COMPTYPES(LCP@.IDTYPE,NXT@.IDTYPE) THEN
                                ERROR(128)
                            END;
                          INSYMBOL;
                          IF NOT (SY IN FSYS + [COMMA,RPARENT]) THEN
                            BEGIN ERROR(6); SKIP(FSYS + [COMMA,RPARENT]) END
                        END
                    END (*IF LB*)
                  ELSE
                    BEGIN EXPRESSION(FSYS + [COMMA,RPARENT]);
                      IF GATTR.TYPTR <> NIL THEN
                        IF LKIND = ACTUAL THEN
                          BEGIN
                            IF NXT <> NIL THEN
                              BEGIN LSP := NXT@.IDTYPE;
                                IF LSP <> NIL THEN
                                  BEGIN
                                    IF (NXT@.VKIND = ACTUAL) THEN
                                      IF LSP@.FORM <= POWER THEN
                                        BEGIN LOAD;
                                        IF DEBUG THEN
                                          BEGIN  ASSIGN := TRUE ;
                                          CHKBNDS(LSP) ;  ASSIGN := FALSE ;
                                          END ;
                                        IF COMPTYPES(REALPTR,LSP)
                                           AND (GATTR.TYPTR = INTPTR) THEN
                                          BEGIN GEN0(10(*FLT*));
                                            GATTR.TYPTR := REALPTR
                                          END;
                                        LOCPAR := LOCPAR+ 1 (*LSP@.SIZE*) ;
                                        END
                                      ELSE
                                        BEGIN
                                        LOADADDRESS;
                                        LOCPAR := LOCPAR+ 1 (*PTRSIZE*);
                                        END
                                    ELSE
                                      IF GATTR.KIND = VARBL THEN
                                        BEGIN LOADADDRESS;
                                        LOCPAR := LOCPAR + 1 (*PTRSIZE*);
                                        IF GATTR.TYPTR@.SIZE <> LSP@.SIZE THEN
                                          ERROR(142) ;
                                        END
                                      ELSE ERROR(154);
                                    IF NOT COMPTYPES(LSP,GATTR.TYPTR) THEN
                                      ERROR(142)
                                  END
                              END
                          END
                      ELSE (*LKIND = FORMAL*)
                        BEGIN (*PASS FORMAL PARAM*)
                        END
                    END;
                  IF (LKIND = ACTUAL) AND (NXT <> NIL) THEN NXT := NXT@.NEXT
                UNTIL SY <> COMMA;
                LC := LLC;
              IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
            END (*IF LPARENT*);
            LOCPAR := LOCPAR*2 ;
            IF LKIND = ACTUAL THEN
              BEGIN IF NXT <> NIL THEN ERROR(126);
                WITH FCP@ DO
           "      IF EXTERN THEN GEN1(30(*CSP*),PFNAME)
                  ELSE  "
                    BEGIN
                    GENCUP((*CUP*)PROCTYPE(FCP),LOCPAR,PFNAME",NAME");
                    END ;
              END;
            GATTR.TYPTR := FCP@.IDTYPE ;
            PACKSTRNG := SAVEPFLG ;
          END (*CALLNONSTANDARD*) ;

        BEGIN (*CALL*)
          IF FCP@.PFDECKIND = STANDARD THEN
            BEGIN "IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);"

              LKEY := FCP@.KEY;
              IF SY = LPARENT THEN
                BEGIN  INSYMBOL ;  MATCHPAR := TRUE ;
                IF SY = RPARENT THEN
                  IF NOT (LKEY IN [1,2,3,4,11,12,25,26]) THEN ERROR(7) ;
                         (*GET,PUT,RESET,REWRITE,RDLN,WRITELN,EOF,ELN*)
                END
              ELSE
                BEGIN  IF NOT (LKEY IN [1,2,3,4,11,12,25,26]) THEN ERROR(6) ;
                              (*GET,PUT,RESET,REWRITE,RDLN,WRITELN,EOF,ELN*)
               "IF SY =RPARENT THEN ERROR(6) ;"  MATCHPAR := FALSE ;
                END ;

          "   IF FCP@.KLASS = PROC THEN  "

              IF LKEY IN [14..24, 27..32 (*TRAP,EXIT,ABS..MATH*)] THEN
                BEGIN  EXPRESSION(FSYS+[RPARENT]) ;  LOAD  END  ;

                CASE LKEY OF
                  1,2,
                  3,4:  GETPUTRESETREWRITE;
                  5,11: READ1;
                  6,12: WRITE1;
                  7:    PACK1;
                  8:    UNPACK1;
                  9:    NEW1;
                  10:   RELEASE1;
                  13:   MARK1;
               14,15:   TRAPEXIT  ;
"               END
              ELSE
                BEGIN EXPRESSION(FSYS + [RPARENT]);
                      IF LKEY <= 9 THEN LOAD ELSE LOADADDRESS;
                  CASE LKEY OF  "
                   16:    ABS1;
                   17:    SQR1;
                   18:    TRUNC1;
                   19:    ODD1;
                   20:    ORD1;
                   21:    CHR1;
                22,23,24 :PREDSUCCTIM;
                  25,26  :EOFEOLN ;
            27,28,29,
            30,31,32    :MATH ;
                  END (*CASE LKEY OF*) ;
            " IF LKEY IN [16..24, 27..32] THEN GATTR.BTYPE := GATTR.TYPTR ; "
              IF MATCHPAR THEN
                IF SY = RPARENT THEN INSYMBOL
                ELSE " IF NOT (LKEY IN [1,2,3,4,11,12,25,26]) THEN " ERROR(4) ;
            END (*STANDARD PROCEDURES AND FUNCTIONS*)
          ELSE CALLNONSTANDARD
        END (*CALL*) ;

        PROCEDURE EXPRESSION;
          VAR LATTR: ATTR; LOP: OPERATOR; TYPIND: CHAR; LSIZE: ADDRRANGE;

          PROCEDURE SIMPLEEXPRESSION(FSYS: SETOFSYS);
            VAR LATTR: ATTR; LOP: OPERATOR; SIGNED: BOOLEAN;

            PROCEDURE TERM(FSYS: SETOFSYS);
              VAR LATTR: ATTR; LOP: OPERATOR;

              PROCEDURE FACTOR(FSYS: SETOFSYS);
                VAR LCP: CTP; LVP: CSP; VARPART: BOOLEAN;
                    CSTPART: SET OF 0..SETRANGE; LSP: STP;   I: 0..64 ;
              BEGIN
                IF NOT (SY IN FACBEGSYS) THEN
                  BEGIN ERROR(58); SKIP(FSYS + FACBEGSYS);
                    GATTR.TYPTR := NIL
                  END;
                WHILE SY IN FACBEGSYS DO
                  BEGIN
                    CASE SY OF
              (*ID*)    IDENT:
                        BEGIN SEARCHID([KONST,VARS,FIELD,FUNC],LCP);
                          INSYMBOL;
                          IF LCP@.KLASS = FUNC THEN
                            BEGIN CALL(FSYS,LCP);
                              WITH GATTR DO
                                BEGIN KIND := EXPR;
                                  IF TYPTR <> NIL THEN
                                    IF TYPTR@.FORM=SUBRANGE THEN
                                      TYPTR := TYPTR@.RANGETYPE
                                END
                            END
                          ELSE
                            IF LCP@.KLASS = KONST THEN
                              WITH GATTR, LCP@ DO
                                BEGIN TYPTR := IDTYPE; KIND := CST;
                                  CVAL := VALUES
                                END
                            ELSE
                              BEGIN SELECTOR(FSYS,LCP);
                                IF GATTR.TYPTR<>NIL THEN(*ELIM.SUBR.TYPES TO*)
                                  WITH GATTR,TYPTR@ DO(*SIMPLIFY LATER TESTS*)
                                    IF FORM = SUBRANGE THEN
                                      TYPTR := RANGETYPE
                              END
                        END;
              (*CST*)   INTCONST:
                        BEGIN
                          WITH GATTR DO
                            BEGIN TYPTR := INTPTR; KIND := CST;
                              "CVAL := VAL ;" CVAL.IVAL := VAL.IVAL
                            END;
                          INSYMBOL
                        END;
                      REALCONST:
                        BEGIN
                          WITH GATTR DO
                            BEGIN TYPTR := REALPTR; KIND := CST;
                            " CVAL := VAL ;"  CVAL.VALP := VAL.VALP ;
                            END;
                          INSYMBOL
                        END;
             (*STRG*) STRINGCONST:
                        BEGIN
                          WITH GATTR DO
                            BEGIN
                              IF LNGTH = 1 THEN TYPTR := CHARPTR
                              ELSE
                                BEGIN NEW(LSP,ARRAYS);
                                  WITH LSP@ DO
                                    BEGIN AELTYPE := CHARPTR; FORM:=ARRAYS;
                                      INXTYPE := NIL; SIZE := LNGTH*CHARSIZE
                                    END;
                                  TYPTR := LSP
                                END;
                              KIND := CST ;  CVAL := VAL ;
                            END;
                          INSYMBOL
                        END;
              (*(*)     LPARENT:
                        BEGIN INSYMBOL; EXPRESSION(FSYS + [RPARENT]);
                          IF SY = RPARENT THEN INSYMBOL ELSE ERROR(4)
                        END;
              (*NOT*)   NOTSY:
                        BEGIN INSYMBOL; FACTOR(FSYS);
                          LOAD; GEN0(19(*NOT*));
                          IF GATTR.TYPTR <> NIL THEN
                            IF GATTR.TYPTR <> BOOLPTR THEN
                              BEGIN ERROR(135); GATTR.TYPTR := NIL END;
                        END;
              (*[*)     LBRACK:
                        BEGIN INSYMBOL; CSTPART := [ ]; VARPART := FALSE;
                          NEW(LSP,POWER);
                          WITH LSP@ DO
                            BEGIN ELSET:=NIL;SIZE:=SETSIZE;FORM:=POWER END;
                          IF SY = RBRACK THEN
                            BEGIN
                              WITH GATTR DO
                                BEGIN TYPTR := LSP; KIND := CST END;
                              INSYMBOL
                            END
                          ELSE
                            BEGIN
                              REPEAT EXPRESSION(FSYS + [COMMA,COLON,RBRACK]);
                                WITH GATTR DO
                                  BEGIN
                                  IF TYPTR <> NIL THEN
                                    IF TYPTR@.FORM <> SCALAR THEN
                                      BEGIN ERROR(136); TYPTR := NIL END
                                    ELSE
                                      IF COMPTYPES(LSP@.ELSET,TYPTR) THEN
                                        BEGIN
                                          IF KIND = CST THEN
                                            BEGIN
                                            IF (CVAL.IVAL < 0)  THEN
                                              ERROR(304)
                                            ELSE
                            "                 IF TYPTR = CHARPTR THEN
                                                CSTPART := CSTPART+
                                                     [ASCII[CHR(CVAL.IVAL)]-32]
                                              ELSE "
                                                CSTPART :=CSTPART+[CVAL.IVAL];
                                            IF SY = COLON THEN   (*RANGE GIVEN*)
                                              BEGIN INSYMBOL ;  LATTR := GATTR ;
                                              EXPRESSION(FSYS+[COMMA,RBRACK]) ;
                                              IF TYPTR <> LATTR.TYPTR THEN
                                                ERROR(137)
                                              ELSE
                                                FOR I := LATTR.CVAL.IVAL TO
                                                         CVAL.IVAL DO
                                            "     IF TYPTR = CHARPTR THEN
                                                    CSTPART := CSTPART+
                                                      [ASCII[CHR(I)]-32]
                                                  ELSE "
                                                    CSTPART := CSTPART+[I] ;
                                              END (* IF SY = COLON *) ;
                                            IF CVAL.IVAL > SETRANGE THEN
                                              ERROR(304) ;
                                            END  (* KIND = CST *)
                                          ELSE
                                            BEGIN LOAD;
                                         "  IF NOT COMPTYPES(TYPTR,INTPTR)
                                              THEN GEN0(61(*ORD*)); "
                                            IF DEBUG THEN
                                              GEN3(45(*CHK*),ORD('S'),0,
                                                   SETRANGE);
                                            GEN0(29(*SGS*));
                                            IF VARPART THEN GEN0(28(*UNI*))
                                            ELSE VARPART := TRUE
                                            END;
                                          LSP@.ELSET := TYPTR;
                                          TYPTR := LSP
                                        END
                                      ELSE ERROR(137);
                                  TEST := SY <> COMMA;
                                  IF NOT TEST THEN INSYMBOL
                                END (* WITH GATTR DO *) ;
                              UNTIL TEST;
                              IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)
                            END;

                          CNSTVALPTR@.PVAL := CSTPART ;
                          IF VARPART THEN
                            BEGIN
                              IF CSTPART <> [ ] THEN
                                BEGIN "NEW(LVP,PSET); LVP@.PVAL := CSTPART;"
                                  CSTPTR := "LVP"  CNSTVALPTR ;
                                  GEN2(51(*LDC*),5,0);
                                  GEN0(28(*UNI*)); GATTR.KIND := EXPR
                                END
                            END
                          ELSE
                            BEGIN "NEW(LVP,PSET); LVP@.PVAL := CSTPART; "
                             "LVP@.CCLASS := PSET;"
                              GATTR.CVAL.VALP := "LVP" CNSTVALPTR ;
                            END
                        END
                    END (*CASE*) ;
                    IF NOT (SY IN FSYS) THEN
                      BEGIN ERROR(6); SKIP(FSYS + FACBEGSYS) END
                  END (*WHILE*)
              END (*FACTOR*) ;

            BEGIN (*TERM*)
              FACTOR(FSYS + [MULOP]);
              WHILE SY = MULOP DO
                      BEGIN LOAD; LATTR := GATTR; LOP := OP;
                  INSYMBOL; FACTOR(FSYS + [MULOP]); LOAD;
                  IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                    CASE LOP OF
            (***)       MUL:  IF (LATTR.TYPTR=INTPTR)AND(GATTR.TYPTR=INTPTR)
                              THEN GEN0(15(*MPI*))
                            ELSE
                              BEGIN
                                IF GATTR.TYPTR = INTPTR THEN
                                  BEGIN GEN0(10(*FLT*));
                                    GATTR.TYPTR := REALPTR
                                  END
                                ELSE
                                  IF LATTR.TYPTR = INTPTR THEN
                                    BEGIN GEN0(9(*FLO*));
                                      LATTR.TYPTR := REALPTR
                                    END;
                                IF (LATTR.TYPTR = REALPTR)
                                  AND(GATTR.TYPTR=REALPTR)THEN GEN0(16(*MPR*))
                                ELSE
                                  IF(LATTR.TYPTR@.FORM=POWER)
                                    AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR)THEN
                                    GEN0(12(*INT*))
                                  ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END
                              END;
            (*/*)       RDIV: BEGIN
                              IF GATTR.TYPTR = INTPTR THEN
                                BEGIN GEN0(10(*FLT*));
                                  GATTR.TYPTR := REALPTR
                                END;
                              IF LATTR.TYPTR = INTPTR THEN
                                BEGIN GEN0(9(*FLO*));
                                  LATTR.TYPTR := REALPTR
                                END;
                              IF (LATTR.TYPTR = REALPTR)
                                AND (GATTR.TYPTR=REALPTR)THEN GEN0(7(*DVR*))
                              ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                            END;
            (*DIV*)     IDIV: IF (LATTR.TYPTR = INTPTR)
                              AND (GATTR.TYPTR = INTPTR) THEN GEN0(6(*DVI*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END;
            (*MOD*)     IMOD: IF (LATTR.TYPTR = INTPTR)
                              AND (GATTR.TYPTR = INTPTR) THEN GEN0(14(*MOD*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END;
            (*AND*)     ANDOP:IF (LATTR.TYPTR = BOOLPTR)
                              AND (GATTR.TYPTR = BOOLPTR) THEN GEN0(4(*AND*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                    END (*CASE*)
                  ELSE GATTR.TYPTR := NIL
                END (*WHILE*)
            END (*TERM*) ;

          BEGIN (*SIMPLEEXPRESSION*)
            SIGNED := FALSE;
            IF (SY = ADDOP) AND (OP IN [PLUS,MINUS]) THEN
              BEGIN SIGNED := OP = MINUS; INSYMBOL END;
            TERM(FSYS + [ADDOP]);
            IF SIGNED THEN
              BEGIN LOAD;
                IF GATTR.TYPTR = INTPTR THEN GEN0(17(*NGI*))
                ELSE
                  IF GATTR.TYPTR = REALPTR THEN GEN0(18(*NGR*))
                  ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
              END;
            WHILE SY = ADDOP DO
              BEGIN LOAD; LATTR := GATTR; LOP := OP;
                INSYMBOL; TERM(FSYS + [ADDOP]); LOAD;
                IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
                  CASE LOP OF
          (*+*)       PLUS:
                      IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN
                        GEN0(2(*ADI*))
                      ELSE
                        BEGIN
                          IF GATTR.TYPTR = INTPTR THEN
                            BEGIN GEN0(10(*FLT*));
                              GATTR.TYPTR := REALPTR
                            END
                          ELSE
                            IF LATTR.TYPTR = INTPTR THEN
                              BEGIN GEN0(9(*FLO*));
                                LATTR.TYPTR := REALPTR
                              END;
                          IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR)
                            THEN GEN0(3(*ADR*))
                          ELSE IF(LATTR.TYPTR@.FORM=POWER)
                                 AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                                 GEN0(28(*UNI*))
                               ELSE BEGIN ERROR(134);GATTR.TYPTR:=NIL END
                        END;
          (*-*)       MINUS:
                      IF (LATTR.TYPTR = INTPTR)AND(GATTR.TYPTR = INTPTR) THEN
                        GEN0(21(*SBI*))
                      ELSE
                        BEGIN
                          IF GATTR.TYPTR = INTPTR THEN
                            BEGIN GEN0(10(*FLT*));
                              GATTR.TYPTR := REALPTR
                            END
                          ELSE
                            IF LATTR.TYPTR = INTPTR THEN
                              BEGIN GEN0(9(*FLO*));
                                LATTR.TYPTR := REALPTR
                              END;
                          IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR)
                            THEN GEN0(8(*SBR*))
                          ELSE
                            IF (LATTR.TYPTR@.FORM = POWER)
                              AND COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                              GEN0(5(*DIF*))
                            ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                        END;
          (*OR*)      OROP:
                      IF(LATTR.TYPTR=BOOLPTR)AND(GATTR.TYPTR=BOOLPTR)THEN
                        GEN0(13(*IOR*))
                      ELSE BEGIN ERROR(134); GATTR.TYPTR := NIL END
                  END (*CASE*)
                ELSE GATTR.TYPTR := NIL
              END (*WHILE*)
          END (*SIMPLEEXPRESSION*) ;

        BEGIN (*EXPRESSION*)
          SIMPLEEXPRESSION(FSYS + [RELOP]);
          IF SY = RELOP THEN
            BEGIN
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR@.FORM <= POWER THEN LOAD
                ELSE LOADADDRESS;
              LATTR := GATTR; LOP := OP;
              IF LOP = INOP THEN
                BEGIN
             "  IF NOT COMPTYPES(GATTR.TYPTR,INTPTR) THEN  GEN0(61(*ORD*)) ;"
                IF DEBUG THEN GEN3(45(*CHK*),ORD('S'),0,SETRANGE) ;
                END ;
              INSYMBOL; SIMPLEEXPRESSION(FSYS);
              IF GATTR.TYPTR <> NIL THEN
                IF GATTR.TYPTR@.FORM <= POWER THEN LOAD
                ELSE LOADADDRESS;
              IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN
    (*IN*)      IF LOP = INOP THEN
                  IF GATTR.TYPTR@.FORM = POWER THEN
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR@.ELSET) THEN
                      GEN0(11(*INN*))
                    ELSE BEGIN ERROR(129); GATTR.TYPTR := NIL END
                  ELSE BEGIN ERROR(130); GATTR.TYPTR := NIL END
                ELSE
                  BEGIN
                    IF LATTR.TYPTR <> GATTR.TYPTR THEN
                      IF GATTR.TYPTR = INTPTR THEN
                        BEGIN GEN0(10(*FLT*));
                          GATTR.TYPTR := REALPTR
                        END
                      ELSE
                        IF LATTR.TYPTR = INTPTR THEN
                          BEGIN GEN0(9(*FLO*));
                            LATTR.TYPTR := REALPTR
                          END;
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                      BEGIN LSIZE := LATTR.TYPTR@.SIZE;
                        CASE LATTR.TYPTR@.FORM OF
                          SCALAR:
                            IF LATTR.TYPTR = REALPTR THEN TYPIND := 'R'
                            ELSE
                              IF LATTR.TYPTR = BOOLPTR THEN TYPIND := 'B'
                              ELSE
                                IF LATTR.TYPTR = CHARPTR THEN TYPIND := 'C'
                                ELSE TYPIND := 'I' ;
                          POINTER:
                            BEGIN
                              IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131);
                              TYPIND := 'A'
                            END;
                          POWER:
                            BEGIN IF LOP IN [LTOP,GTOP] THEN ERROR(132);
                              TYPIND := 'S'
                          END;
                          ARRAYS:
                            BEGIN
                              IF NOT STRING(LATTR.TYPTR)
                              AND(LOP IN[LTOP,LEOP,GTOP,GEOP])THEN ERROR(131);
                              TYPIND := 'M'
                            END;
                          RECORDS:
                            BEGIN
                              IF LOP IN [LTOP,LEOP,GTOP,GEOP] THEN ERROR(131);
                              TYPIND := 'M'
                            END;
                          FILES:
                            BEGIN ERROR(133); TYPIND := 'F' END
                        END;
                        CASE LOP OF
    (*< *)                LTOP: GEN2(53(*LES*),ORD(TYPIND),LSIZE);
    (*<=*)                LEOP: GEN2(52(*LEQ*),ORD(TYPIND),LSIZE);
    (*> *)                GTOP: GEN2(49(*GRT*),ORD(TYPIND),LSIZE);
    (*>=*)                GEOP: GEN2(48(*GEQ*),ORD(TYPIND),LSIZE);
    (*<>*)                NEOP: GEN2(55(*NEQ*),ORD(TYPIND),LSIZE);
    (*= *)                EQOP: GEN2(47(*EQU*),ORD(TYPIND),LSIZE)
                        END
                      END
                    ELSE ERROR(129)
                  END;
              GATTR.TYPTR := BOOLPTR; GATTR.KIND := EXPR
            END (*SY = RELOP*)
        END (*EXPRESSION*) ;

        PROCEDURE ASSIGNMENT(FCP: CTP);
          VAR LATTR: ATTR;
        BEGIN
          SELECTOR(FSYS+[BECOMES], FCP) ;
          IF SY = BECOMES THEN
            BEGIN
            WITH GATTR DO
                IF TYPTR <> NIL THEN
                  IF (ACCESS<>DRCT) OR (TYPTR@.FORM>POWER) THEN
                    BEGIN
                    LOADADDRESS ;  PACKSTRNG := STRING(TYPTR) ;
                    END ;
              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(GATTR.TYPTR=INTPTR)THEN
                    BEGIN GEN0(10(*FLT*));
                      GATTR.TYPTR := REALPTR
                    END;
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                    BEGIN

                      IF DEBUG THEN
                        BEGIN
                        ASSIGN := TRUE ;  CHKBNDS(LATTR.TYPTR);  ASSIGN := FALSE
                        END ;

                      CASE LATTR.TYPTR@.FORM OF
                        SCALAR,
                        SUBRANGE,
                        POINTER,
                        POWER:   STORE(LATTR);
                        ARRAYS,
                        RECORDS: BEGIN  GEN1(40(*MOV*),LATTR.TYPTR@.SIZE);
                                 PACKSTRNG := FALSE ;
                                 END ;
                        FILES: ERROR(146)
                      END  (*CASE LATTR...*)
                    END
                  ELSE ERROR(129)
                END
            END (*SY = BECOMES*)
          ELSE ERROR(51)
        END (*ASSIGNMENT*) ;

        PROCEDURE GOTOSTATEMENT;
          VAR LLP: LBP; FOUND: BOOLEAN; TTOP,TTOP1: DISPRANGE;
        BEGIN
          IF SY = INTCONST THEN
            BEGIN
              FOUND := FALSE;  TTOP := TOP;
              WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP - 1;
              TTOP1 := TTOP;
              REPEAT
                LLP := DISPLAY[TTOP].FLABEL;
                WHILE (LLP <> NIL) AND NOT FOUND DO
                  WITH LLP@ DO
                    IF LABVAL = VAL.IVAL THEN
                      BEGIN FOUND := TRUE;
                        IF TTOP = TTOP1 THEN
                          GENUJPFJP(34(*UJP*),LABNAME)
                        ELSE (*GOTO LEADS OUT OF PROCEDURE*) ERROR(398)
                      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 INSYMBOL 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); GENUJPFJP(34(*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, UBND, LBND: ADDRRANGE ;
        BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]);
          LOAD ;
          LSP := GATTR.TYPTR;
          IF LSP <> NIL THEN
            IF (LSP@.FORM <> SCALAR) OR (LSP = REALPTR) THEN
              BEGIN  ERROR(144); LSP := NIL END
          " ELSE  IF NOT COMPTYPES(LSP,INTPTR) THEN  GEN0(61(*ORD*))" ;
          IF DEBUG THEN  CHKBNDS(GATTR.TYPTR) ;
          IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);
          FSTPTR := NIL ;  GENLABEL(LBND) ;  GENLABEL(UBND) ;
          GENLABEL(LCIX) ;  GENLABEL(LADDR);
          (* WE SHOULD HAVE:  LADDR = LCIX+1 = UBND+2 = LBND+3   HERE *)
          GENUJPFJP(44 (*XJP*), LBND) ;
          REPEAT
            LPT3 := NIL; GENLABEL(LCIX1);
            IF NOT(SY IN [SEMICOLON,ENDSY]) THEN
            BEGIN
              REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL);
                IF LSP <> NIL THEN
                  BEGIN
            "     IF LSP = CHARPTR THEN  LVAL.IVAL := ASCII[CHR(LVAL.IVAL)]-32;"
                  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);
                  END (* LSP <> NIL *) ;
                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
                GENUJPFJP(34(*UJP*),LADDR);
            END ;
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          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;
              GENDEF(LBND,LMIN) ;  GENDEF(UBND,LMAX-LMIN) ;  PUTLABEL(LCIX) ;
              IF LMAX - LMIN <  250  (* CIXMAX *) THEN
                BEGIN
                  REPEAT
                    WITH FSTPTR@ DO
                      BEGIN
                        WHILE CSLAB > LMIN DO
                          BEGIN GENUJPFJP(34(*UJP*),LADDR); LMIN:=LMIN+1 END;
                        GENUJPFJP(34(*UJP*),CSSTART);
                        FSTPTR := NEXT; LMIN := LMIN + 1
                      END
                  UNTIL FSTPTR = NIL;
                  PUTLABEL(LADDR) ;
                END
              ELSE ERROR(157)
            END;
            IF SY = ENDSY THEN INSYMBOL ELSE ERROR(13)
        END (*CASESTATEMENT*) ;

        PROCEDURE REPEATSTATEMENT;
          VAR LADDR: INTEGER;
        BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
          REPEAT
            REPEAT STATEMENT(FSYS + [SEMICOLON,UNTILSY])
            UNTIL NOT (SY IN STATBEGSYS);
            TEST := SY <> SEMICOLON;
            IF NOT TEST THEN INSYMBOL
          UNTIL TEST;
          IF SY = UNTILSY THEN
            BEGIN INSYMBOL; EXPRESSION(FSYS); GENFJP(LADDR)
            END
          ELSE ERROR(53)
        END (*REPEATSTATEMENT*) ;

        PROCEDURE WHILESTATEMENT;
          VAR LADDR, LCIX: INTEGER;
        BEGIN GENLABEL(LADDR); PUTLABEL(LADDR);
          EXPRESSION(FSYS + [DOSY]); GENLABEL(LCIX); GENFJP(LCIX);
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS); GENUJPFJP(34(*UJP*),LADDR); PUTLABEL(LCIX)
        END (*WHILESTATEMENT*) ;

        PROCEDURE FORSTATEMENT;
          VAR LATTR: ATTR; LSP: STP;  LSY: SYMBOL;
              LCIX, LADDR: LABELRNG ;  LLC : ADDRRANGE ;
        BEGIN
          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 <> SCALAR THEN ERROR(144)
                  ELSE
                    IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                      BEGIN LOAD;
                      IF DEBUG THEN CHKBNDS(LATTR.TYPTR) ;  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 <> SCALAR THEN ERROR(144)
                ELSE
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN
                    BEGIN  LOAD;  IF DEBUG THEN  CHKBNDS(LATTR.TYPTR) ;
                      LLC := LC ;
                      GEN3(56(*STR*),ORD('I'),LEVEL,LLC);
                      GATTR := LATTR; LOAD;
                      GEN3(54(*LOD*),ORD('I'),LEVEL,LLC);
                      LC := LC + INTSIZE;
                      IF LC > LCMAX THEN LCMAX := LC;
                      IF LSY = TOSY THEN GEN2(52(*LEQ*),ORD('I'),1)
                      ELSE GEN2(48(*GEQ*),ORD('I'),1);
                    END
                  ELSE ERROR(145)
            END
          ELSE BEGIN ERROR(55); SKIP(FSYS + [DOSY]) END;
          GENLABEL(LADDR) ;  GENLABEL(LCIX);  GENUJPFJP(33(*FJP*),LCIX);
          PUTLABEL(LADDR) ;  (*BEGINNING OF THE FOR 'LOOP'*)
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);
          STATEMENT(FSYS);
          GATTR := LATTR ;  LOAD ;
          GEN3(54(*LOD*),ORD('I'),LEVEL,LLC) ;
          GEN2(55(*NEQ*),ORD('I'),1) ;  GENUJPFJP(33(*FJP*),LCIX) ;
          GATTR := LATTR; LOAD;
          IF LSY = TOSY THEN  GEN2(23(*INC*),GETTYPE(GATTR.TYPTR),1)
          ELSE  GEN2(22(*DEC*),GETTYPE(GATTR.TYPTR),1);
          IF DEBUG THEN CHKBNDS(LATTR.TYPTR) ;
          STORE(LATTR); GENUJPFJP(34(*UJP*),LADDR); PUTLABEL(LCIX);
          LC := LLC ;
        END (*FORSTATEMENT*) ;

        PROCEDURE WITHSTATEMENT;
          VAR LCP: CTP; LCNT: DISPRANGE; LLC: ADDRRANGE;
        BEGIN LCNT := TOP ; 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;
                    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;
                      GEN3(56(*STR*),ORD('A'),LEVEL,LC);(*=GETTYPE(GAT.TYP)*)
                        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 :=  LCNT ; LC := LLC ;
        END (*WITHSTATEMENT*) ;

      BEGIN (*STATEMENT*)
        IF SY = INTCONST THEN (*LABEL*)
          BEGIN  TTOP := TOP ;
          WHILE DISPLAY[TTOP].OCCUR <> BLCK DO  TTOP := TTOP-1 ;
          LLP := DISPLAY[TTOP].FLABEL;
            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
            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 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  ENTNAME := FPROCP@.PFNAME ;  PROCNAME := FPROCP@.NAME ; END
      ELSE
        BEGIN PROCNAME := '$MAINBLK' ;  ENTNAME := 0 ;  END ;
      GENENT((*ENT*)PROCTYPE(FPROCP),SEGSIZE,ENTNAME,PROCNAME) ;

      IF FPROCP = NIL THEN  (* ENTERING MAIN BLOCK *)
        BEGIN
        SAVEID := ID;
        WHILE FEXTFILEP <> NIL DO
          BEGIN
            WITH FEXTFILEP@ DO
                     BEGIN  ID := FILENAME;
                     PRTERR := FALSE ;  SEARCHID([VARS],LLCP); PRTERR := TRUE ;
                     IF LLCP <> NIL THEN
                       IF LLCP@.IDTYPE@.FORM <> FILES THEN
                         LLCP := NIL;
                     IF LLCP = NIL THEN
                       BEGIN
                         WRITELN('**** UNDECLARED EXTERNAL FILE:':40, ID:10);
                         ERROR(398) ;
                       END
                     ELSE (* OPEN THE FILES REQUESTED ABOVE *)
                       WITH LLCP@ DO
                         BEGIN
                         GEN2(50(*LDA*),1,VADDR) ;
                         IF ODD(VADDR DIV CHARSIZE) THEN
                            GEN1(30(*CSP*),4(*REW*))
                         ELSE  GEN1(30(*CSP*),3(*RES*)) ;
                         GEN1(30(*CSP*),30(*EIO*)) ;
                         END ;
                     END;
              FEXTFILEP := FEXTFILEP@.NEXTFILE
          END;
        ID := SAVEID;
        END (* PROCESSING MAIN BLOCK *)
      ELSE (* FPROCP <> NIL ==> COPY MULTIPLE VALUES INTO LOACAL CELLS*)
        BEGIN  LLC1 := 0 (* LCAFTMST *) ;
        IF FPROCP@.IDTYPE <> NIL THEN LLC1 := 8 (*LCAFTFNCRSLT *) ;
          LCP := FPROCP@.NEXT;
          WHILE LCP <> NIL DO
            WITH LCP@ DO
              BEGIN
                IF KLASS = VARS THEN
                  IF IDTYPE <> NIL THEN
                    IF VKIND = FORMAL THEN  (* VAR PARAMETER *)
                      BEGIN
                      LLC1 := LLC1+PTRSIZE ;
                      END
                    ELSE  (* VKIND = ACTUAL *)
                      IF IDTYPE@.FORM > POWER THEN
                        BEGIN
                        GEN2(50(*LDA*),LEVEL,VADDR);
                        GEN3(54(*LOD*),ORD('A'),LEVEL,LLC1);
                        GEN1(40(*MOV*),IDTYPE@.SIZE);
                        LLC1 := LLC1 + PTRSIZE
                        END
                      ELSE  (* FORM <= POWER *)
                        BEGIN
                        LLC1 := LLC1 + IDTYPE@.SIZE ;
                        END ;
                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 INSYMBOL ELSE ERROR(13);
      LLP := DISPLAY[TOP].FLABEL; (*TEST FOR UNDEFINED LABELS*)
      WHILE LLP <> NIL DO
        WITH LLP@ DO
          BEGIN
            IF NOT DEFINED THEN
              BEGIN
                WRITELN(OUTPUT,'**** UNDEF. LABEL:':28,LABVAL); ERROR(168) ;
              END;
            LLP := NEXTLAB
          END;
      GEN1(42(*RET*),PROCTYPE(FPROCP));  (* PRTIC := FALSE ;  *)
      IF PRCODE THEN
        BEGIN  GENDEF(SEGSIZE,LCMAX) ;
        END ;

      IF FPROCP = NIL THEN  "GEN0(43(*STP*))" WRITELN(PRR, CHR(43):2 (*STP*) ) ;
      OLDIC := OLDIC+ IC ;  IC := 0 ;  (* RESET IC FOR NEXT PROC *)
    END (*BODY*) ;

  BEGIN (*BLOCK*)
  " DP := TRUE;" GENLABEL(SEGSIZE) ;
    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;
    DP := FALSE;
    IF SY = BEGINSY THEN INSYMBOL ELSE ERROR(17);
    REPEAT BODY(FSYS + [CASESY]);
      IF SY <> FSY THEN
        BEGIN ERROR(6); SKIP(FSYS + [FSY]) END
    UNTIL (SY = FSY) OR (SY IN BLOCKBEGSYS);
    DP := TRUE ;
  END (*BLOCK*) ;

  PROCEDURE PROGRAMME(FSYS:SETOFSYS);
    VAR EXTFP, TPTR: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  TPTR := NIL ;
            REPEAT INSYMBOL;
              IF SY = IDENT THEN
                BEGIN NEW(EXTFP);
                  WITH EXTFP@ DO
                    BEGIN FILENAME := ID; NEXTFILE := NIL ;
                    IF TPTR = NIL THEN  FEXTFILEP := EXTFP
                    ELSE  TPTR@.NEXTFILE := EXTFP ;
                    TPTR := EXTFP ;
                    END;
          "       FEXTFILEP := EXTFP;  "
                  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 ;
    ENDOFLINE ; IF ERRINX > 0 THEN  PRINTERROR ;
  END (*PROGRAMME*) ;


  PROCEDURE STDNAMES;
  BEGIN
    NA[ 1] := 'FALSE   '; NA[ 2] := 'TRUE    ';
                              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] := 'MARK    '; NA[18]:= 'TRAP    ';
    NA[19] := 'EXIT    ';
    NA[20] := 'ABS     '; NA[21] := 'SQR     '; NA[22]:= 'TRUNC   ';
    NA[23] := 'ODD     '; NA[24] := 'ORD     '; NA[25]:= 'CHR     ';
    NA[26] := 'PRED    '; NA[27] := 'SUCC    '; NA[28]:= 'CLOCK   ';
    NA[29] := 'EOF     '; NA[30] := 'EOLN    ';
    NA[31] := 'SIN     '; NA[32] := 'COS     '; NA[33]:= 'EXP     ';
    NA[34] := 'SQRT    '; NA[35] := 'LN      '; NA[36]:= 'ARCTAN  ';
    NA[37] := 'INPUT   '; NA[38] := 'OUTPUT  '; NA[39]:= 'PRD     ';
    NA[40] := 'PRR     '; NA[41] := 'QRD     '; NA[42]:= 'QRR     ';
  END (*STDNAMES*) ;

  PROCEDURE ENTERSTDTYPES;
    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 := SETSIZE (* 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 := CHARSIZE (* BOOLSIZE *) ;
            FORM := SCALAR; SCALKIND := DECLARED END;
    NEW(NILPTR,POINTER);                                      (*NIL*)
    WITH NILPTR@ DO
      BEGIN ELTYPE := NIL; SIZE := PTRSIZE;
            FORM := POINTER END;
    NEW(TEXTPTR,FILES);                                       (*TEXT*)
    WITH TEXTPTR@ DO
      BEGIN FILTYPE := CHARPTR; SIZE := CHARSIZE;
            FORM := FILES END ;

    NEW(ALFAPTR,ARRAYS);                                      (*ALFA*)
    WITH ALFAPTR@ DO
      BEGIN  AELTYPE := CHARPTR; SIZE := 8 ;
            FORM := ARRAYS ;
            NEW(INXTYPE,SUBRANGE) ;
            INXTYPE@.RANGETYPE := INTPTR;
            INXTYPE@.MIN.IVAL := 1; INXTYPE@.MAX.IVAL := 8;
            (* OTHER FIELDS ARE IRRELEVENT !!! *)
      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);
    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);
    FOR I := 37 TO 42 DO
      BEGIN NEW(CP,VARS);                                     (*INPUT,OUTPUT*)
        WITH CP@ DO                                           (*PRD,PRR*)
          BEGIN NAME := NA[I]; IDTYPE := TEXTPTR;             (*QRD,QRR*)
            KLASS := VARS; VKIND := ACTUAL; NEXT := NIL; VLEV := 1;
            VADDR := (* FIRSTFILEBUF+ *) (I-37)*CHARSIZE  ;
          END;
        ENTERID(CP)
      END;
    FOR I := 5 TO 36 DO  (*GET...ATAN*)
      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*)
            IF I <= 19 THEN KLASS := PROC ELSE KLASS := FUNC  ;
            PFDECKIND := STANDARD             (*READLN,WRITELN*)
          END;                                             (*MARK,RELEASE*)
        ENTERID(CP)                                        (*TRAP*)
      END;
  END (*ENTSTDNAMES*) ;

  PROCEDURE ENTERUNDECL;
  BEGIN
    NEW(UTYPPTR,TYPES);
    WITH UTYPPTR@ DO
      BEGIN "NAME := BLANKID;" IDTYPE := NIL; KLASS := TYPES END;
    NEW(UCSTPTR,KONST);
    WITH UCSTPTR@ DO
      BEGIN "NAME := BLANKID;" IDTYPE := NIL; NEXT := NIL;
        VALUES.IVAL := 0; KLASS := KONST
      END;
    NEW(UVARPTR,VARS);
    WITH UVARPTR@ DO
      BEGIN "NAME := BLANKID;" IDTYPE := NIL; VKIND := ACTUAL;
        NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS
      END;
    NEW(UFLDPTR,FIELD);
    WITH UFLDPTR@ DO
      BEGIN "NAME := BLANKID; "IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;
        KLASS := FIELD
      END;
    NEW(UPRCPTR,PROC,DECLARED,ACTUAL);
    WITH UPRCPTR@ DO
      BEGIN "NAME := BLANKID;" IDTYPE := NIL; FORWDECL := FALSE;
        NEXT := NIL; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME);
        KLASS := PROC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END;
    NEW(UFCTPTR,FUNC,DECLARED,ACTUAL);
    WITH UFCTPTR@ DO
      BEGIN "NAME := BLANKID;" IDTYPE := NIL; NEXT := NIL;
        FORWDECL := FALSE; EXTERN := FALSE; PFLEV := 0; GENLABEL(PFNAME);
        KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL
      END
  END (*ENTERUNDECL*) ;

  PROCEDURE INITSCALARS;
  BEGIN  FWPTR := NIL;  NEW(CNSTVALPTR,STRG) ;
 (* PRTABLES := FALSE; *) LIST := FALSE; PRCODE := TRUE;
    DP := TRUE; PRTERR := TRUE; ERRINX := 0;
    INTLABEL := 0; "KK := IDLNGTH;" FEXTFILEP := NIL;
    LC := LASTFILBUF ;  (*ADR. OF THE FIRST VARIABLE OF 'MAIN BLOCK'*)
    (* NOTE IN THE ABOVE RESERVATION OF BUFFER STORE FOR TEXT FILES *)
    OLDIC := 0; IC := 0 ;  EOL := TRUE; LINECNT := 0;
    CH := ' ';  CHCNT := 1;  LINEBUF[0] := ' ' ;
    GLOBTESTP := NIL;
    MXINT10 := MAXINT DIV 10; "DIGMAX := REALLNGTH - 1;"
    PROCLAB := 0;  ERRORCOUNT :=0 ;
 (* MARGIN := FALSE ; *)  PACKSTRNG := FALSE ;
    DEBUG := FALSE ;    ASSIGN  :=  FALSE  ;
    NXTFILBUF := (* FIRSTFILEBUF+ *) 6 ;
  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];

""" NUMERIC := ['0'..'9'] ;
    ALPHANUMERIC := NUMERIC + ['A'..'Z', '$', '_']    ; """
   "NUMERIC := ['0','1','2','3','4','5','6','7','8','9'] ;"
    ALPHANUMERIC := ['A','B','C','D','E','F','G','H','I','J','K','L','M','N',
                     'O','P','Q','R','S','T','U','V','W','X','Y','Z','$','_',
                     '0','1','2','3','4','5','6','7','8','9'] ;

  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]:= 'FORWARD '; RW[33]:= 'PROGRAM ';
      RW[34]:= 'FUNCTION'; RW[35]:= 'PROCEDUR';
      FRW[1] :=  1; FRW[2] :=  1; FRW[3] :=  7; FRW[4] := 15; FRW[5] := 22;
      FRW[6] := 28; FRW[7] := 32; FRW[8] := 34; FRW[9] := 36;
     "FRW[10] := 36 ; FRW[11] := 36;  FRW[12] := 36; FRW[13] := 36 ; "
     "SEQFLD[9] := ' ';  SEQFLD[10] := ' '; "  (*CLEAR EXTRA CHARS IN SEQ. FLD*)
    END (*RESWORDS*) ;

    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] := FORWARDSY; RSY[33] := PROGSY;
      RSY[34] := FUNCSY; RSY[35] := 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['&'] := MULOP ;
      SSY['@'] := ARROW; SSY['<'] := RELOP; SSY['>'] := RELOP;
      SSY['~'] := NOTSY ; SSY[';'] := SEMICOLON;
    END (*SYMBOLS*) ;

    PROCEDURE RATORS;
      VAR I: INTEGER; CH: CHAR;
    BEGIN
      FOR I := 1 TO 35 (*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 := ' ' TO '_' DO SOP[CH] := NOOP;
      SOP['+'] := PLUS; SOP['-'] := MINUS; SOP['*'] := MUL; SOP['/'] := RDIV;
      SOP['='] := EQOP;
      SOP['<'] := LTOP; SOP['>'] := GTOP;
      SOP['|'] := OROP ;  SOP['&'] := ANDOP ;
    END (*RATORS*) ;

 (* PROCEDURE PROCMNEMONICS;
    BEGIN
      SNA[ 1] :='GET'; SNA[ 2] :='PUT'; SNA[ 3] :='RES'; SNA[ 4] :='REW';
      SNA[ 5] :='RDC'; SNA[ 6] :='WRI'; SNA[ 7] :='WRO'; SNA[ 8] :='WRR';
      SNA[ 9] :='WRC'; SNA[10] :='WRS'; SNA[11] :='PAK'; SNA[12] :='RDB';
      SNA[13] :='WRB'; SNA[14] :='RDR'; SNA[15] :='SIN'; SNA[16] :='COS';
      SNA[17] :='EXP'; SNA[18] :='SQT'; SNA[19] :='LOG'; SNA[20] :='ATN';
      SNA[21] :='CLK'; SNA[22] :='WLN'; SNA[23] :='RLN'; SNA[24] :='RDI';
      SNA[25] :='EOF'; SNA[26] :='ELN'; SNA[27] :='RDS'; SNA[28] :='TRP';
      SNA[29] :='XIT'; SNA[30] :='EIO';
    END ; (*PROCMNEMONICS*)

(*  PROCEDURE INSTRMNEMONICS;
    BEGIN  " BGN = 31,  TON = 39,  TOF = 57"
      MN[ 0] :='ABI'; MN[ 1] :='ABR'; MN[ 2] :='ADI'; MN[ 3] :='ADR';
      MN[ 4] :='AND'; MN[ 5] :='DIF'; MN[ 6] :='DVI'; MN[ 7] :='DVR';
      MN[ 8] :='SBR'; MN[ 9] :='FLO'; MN[10] :='FLT'; MN[11] :='INN';
      MN[12] :='INT'; MN[13] :='IOR'; MN[14] :='MOD'; MN[15] :='MPI';
      MN[16] :='MPR'; MN[17] :='NGI'; MN[18] :='NGR'; MN[19] :='NOT';
      MN[20] :='ODD'; MN[21] :='SBI'; MN[22] :='DEC'; MN[23] :='INC';
      MN[24] :='SQI'; MN[25] :='SQR'; MN[26] :='STO'; MN[27] :='TRC';
      MN[28] :='UNI'; MN[29] :='SGS'; MN[30] :='CSP'; MN[31] :='LOC';
      MN[32] :='ENT'; MN[33] :='FJP'; MN[34] :='UJP'; MN[35] :='IND';
      MN[36] :='IXA'; MN[37] :='LSA'; MN[38] :='LCA';"MN[39] :='   ';"
      MN[40] :='MOV'; MN[41] :='MST'; MN[42] :='RET'; MN[43] :='STP';
      MN[44] :='XJP'; MN[45] :='CHK'; MN[46] :='CUP'; MN[47] :='EQU';
      MN[48] :='GEQ'; MN[49] :='GRT'; MN[50] :='LDA'; MN[51] :='LDC';
      MN[52] :='LEQ'; MN[53] :='LES'; MN[54] :='LOD'; MN[55] :='NEQ';
      MN[56] :='STR';"MN[57] :='   ';"MN[58] :='NEW'; MN[59] :='SAV';
      MN[60] :='RST'; MN[61] :='ORD'; MN[62] :='CHR'; MN[63] :='DEF';
    END ; (*INSTRMNEMONICS*)

   (* "PROCEDURE INITASCII;
    VAR C : CHAR ;
    BEGIN

      FOR C := '0' TO '9' DO  ASCII[C] := (ORD(C)-ORD('0'))+48 ;

      FOR C := 'A' TO 'Z' DO  ASCII[C] := ORD(C)-ORD('A')+64+1 ;

      ASCII[' ']  := 32 ;
      ASCII['[']  := 33 ;
      ASCII['"']  := 34 ;
      ASCII[' ']  := 35 ;
      ASCII['$']  := 36 ;
      ASCII['%']  := 37 ;
      ASCII['&']  := 38 ;
      ASCII[''''] := 39 ;
      ASCII['(']  := 40 ;
      ASCII[')']  := 41 ;
      ASCII['*']  := 42 ;
      ASCII['+']  := 43 ;
      ASCII[',']  := 44 ;
      ASCII['-']  := 45 ;
      ASCII['.']  := 46 ;
      ASCII['/']  := 47 ;
      ASCII[':']  := 58 ;
      ASCII[';']  := 59 ;
      ASCII['<']  := 60 ;
      ASCII['=']  := 61 ;
      ASCII['>']  := 62 ;
      ASCII[']']  := 63 ;
      ASCII['@']  := 64 ;
      ASCII['[']  := 91 ;
      ASCII['|']  := 92 ;    " IN FACT BACK/SLASH "
      ASCII[']']  := 93 ;
      ASCII['~']  := 94 ;
      ASCII['_']  := 95 ;
    " ASCII[' ']  := 92 ;
      ASCII['|']  := 124 ;
      ASCII['~']  := 126 ;  "

    END (*INITASCII* ) ;  " *)

  BEGIN (*INITTABLES*)
    RESWORDS; SYMBOLS; RATORS;
  " INSTRMNEMONICS;  PROCMNEMONICS; "
   "INITASCII ;  "
  END (*INITTABLES*) ;

BEGIN  (*PASCALCOMPILER*)
  (*INITIALIZE*)
  (************)

      FOR IC := 0 TO 99 (* MAXPROC *) DO CALL_CNT[IC] := 0 ;
  INITSCALARS; INITSETS; INITTABLES;


  (*ENTER STANDARD NAMES AND STANDARD TYPES:*)
  (******************************************)

  LEVEL := 0; TOP := 0;
  WITH DISPLAY[0] DO
    BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END;
  ENTERSTDTYPES;   STDNAMES; ENTSTDNAMES;   ENTERUNDECL;
  TOP := 1; LEVEL := 1;
  WITH DISPLAY[1] DO
    BEGIN FNAME := NIL; FLABEL := NIL; OCCUR := BLCK END;

    REWRITE(PRD)  (* PROC_TABLE FILE *) ;   REWRITE(PRR) (* PCODE FILE *) ;

  (*COMPILE:*)
  (**********)

  WRITELN(OUTPUT) ;
  WRITELN(OUTPUT, 'LINE  P_LC  LVL ', '< STANFORD MICRO_PASCAL COMPILER',
                  ', VERSION OF MAY/22/78 >' ) ;
  WRITELN(OUTPUT) ; " CTIME := CLOCK(1) ; "

  INSYMBOL;
  PROGRAMME(BLOCKBEGSYS+STATBEGSYS-[CASESY]);
 "CTIME := (CLOCK(1)-CTIME) DIV 10 ;" WRITELN(OUTPUT) ;  WRITELN(OUTPUT) ;
  IF ERRORCOUNT = 0 THEN WRITE(OUTPUT,'****  NO')
  ELSE WRITE(OUTPUT, '****', ERRORCOUNT:5) ;
  WRITELN(OUTPUT, ' SYNTAX ERROR(S) DETECTED.') ;  WRITELN(OUTPUT) ;
  WRITELN(OUTPUT, '****', LINECNT:6,' LINE(S) READ, ',PROCLAB:4,
          ' PROCEDURE(S) COMPILED,');  WRITELN() ;
  WRITELN('****', OLDIC:6,' P_INSTRUCTIONS GENERATED.'
                " CTIME DIV 100 :4, '.', CTIME:2, ' SECONDS IN COMPILATION.'") ;

  (* REWRITE(PRD) ;   (* OPEN CALL_CNT FILE *)
       FOR IC := 0 TO PROCLAB DO  WRITELN(PRD, CALL_CNT[IC] ) ;

  EXIT(ERRORCOUNT) ;

  END. (*PASCALCOMPILER*)
