        
(*$T-,L-,C+*)     
 (********************************************************* 
  *                                                       * 
  *                                                       * 
  *     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.                                       * 
  *                                                       * 
  *     CONVERTED TO ISO 7185 PASCAL BY SCOTT A. MOORE    *
  *     [SAM] ON JAN 22, 2011.                            *
  *                                                       *
  *     VARIOUS CHANGES WERE MADE, ALL MARKED WITH MY     *
  *     INITIALS THUS [SAM]. THERE ARE COMMENTS FOR ALL   *
  *     CHANGES MADE. THE ONLY OTHERS WERE MINOR FORMAT   *
  *     GLITCHES, APPARENTLY DUE TO SEVERAL EOLS          *
  *     INSERTED AT VARIOUS PLACES INTO THE CODE.         *
  *                                                       * 
  *********************************************************)
        
        
PROGRAM PASCALCOMPILER(INPUT,OUTPUT,PRR);       
        
        
        
CONST DISPLIMIT = 20; MAXLEVEL = 10; MAXADDR = 8096;      
      INTSIZE = 1; REALSIZE = 2;      
      CHARSIZE = 1; BOOLSIZE = 1; SETSIZE =2; PTRSIZE = 1;
      STRGLGTH = 100; MAXINT = 32767; 
      { THE NUMBER FOR LCAFTERMARKSTACK WAS FOUND WRONG. THE FORUMLA BELOW AND
        THE MST CODE IN PASINT SHOW IT SHOULD BE 4. [SAM] }
      LCAFTERMARKSTACK = 4{5}; 
      (*  3*PTRSIZE+MAX OF STANDARD SCALAR SIZES AND PTRSIZE  *)    
      FILEBUFFER = 4;       
        
        
        
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 [1..STRGLGTH] OF CHAR);    
                         PSET: (PVAL: SET OF 0..58);      
                         STRG: (SLGTH: 0..STRGLGTH;       
                                SVAL: PACKED ARRAY [1..STRGLGTH] 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;      
     STRUCTFORM = (SCALAR,SUBRANGE,POINTER,POWER,ARRAYS,RECORDS,FILES,        
                   TAGFLD,VARIANT);   
     DECLKIND = (STANDARD,DECLARED);  
     STP = ^ STRUCTURE; CTP = ^ IDENTIFIER;     
        
     STRUCTURE = PACKED RECORD        
                   MARKED: BOOLEAN;   (*FOR TEST PHASE ONLY*)       
                   SIZE: ADDRRANGE;   
                   CASE FORM: STRUCTFORM OF     
                     SCALAR:   (CASE SCALKIND: DECLKIND OF          
                                  STANDARD: (); { ADDED EMPTY CASE PER ISO 7185
                                                  [SAM] }
                                  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 [1..8] OF CHAR;       
        
     IDENTIFIER = PACKED RECORD       
                   NAME: ALPHA; LLINK, RLINK: CTP;        
                   IDTYPE: STP; NEXT: CTP;      
                   CASE KLASS: IDCLASS OF       
                     TYPES: (); { ADDED EMPTY CASE PER ISO 7185 [SAM] }
                     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: INTEGER;    
                                          CASE PFKIND: IDKIND OF    
                                           ACTUAL: (FORWDECL, EXTERN:         
                                                    BOOLEAN);
                                           FORMAL: ())) { ADDED EMPTY CASE PER 
                                                          ISO 7185 [SAM] }
                   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);
                          INXD: ()); { ADDED EMPTY CASE PER ISO 7185 [SAM] }
                EXPR: () { ADDED EMPTY CASE PER ISO 7185 [SAM] }
              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;        

     MARKTYPE = ^ INTEGER; { ADDED TYPE FOR STACK MARKS [SAM] }
        
(*-------------------------------------------------------------------------*) 
        
        
VAR     
 (*PRD, PRR:                    TEXT; *)        
    PRR: TEXT;                      { DECLARES THE OUTPUT INTERMEDIATE FILE 
                                      [SAM] }

                                    (*RETURNED BY SOURCE PROGRAM SCANNER      
                                     INSYMBOL:  
                                     **********)          
        
    SY: SYMBOL;                     (*LAST SYMBOL*)       
    OP: OPERATOR;                   (*CLASSIFICATION OF LAST SYMBOL*)         
    VAL: VALU;                      (*VALUE OF LAST CONSTANT*)      
    LGTH: INTEGER;                  (*LENGTH OF LAST STRING CONSTANT*)        
    ID: ALPHA;                      (*LAST IDENTIFIER (POSSIBLY TRUNCATED)*)  
    KK: 1..8;                       (*NR OF CHARS IN LAST IDENTIFIER*)        
    CH: CHAR;                       (*LAST CHARACTER*)    
    EOL: BOOLEAN;                   (*END OF LINE FLAG*)  
        
        
                                    (*COUNTERS:*)         
                                    (***********)         
        
    CHCNT: 0..81;                   (*CHARACTER COUNTER*)           
    LC,IC: ADDRRANGE;               (*DATA LOCATION AND INSTRUCTION COUNTER*)           
    LINECOUNT: INTEGER;     
        
        
                                    (*SWITCHES:*)         
                                    (***********)         
        
    DP,                             (*DECLARATION PART*)  
    PRTERR,                     (*TO ALLOW FORWARD REFERENCES IN POINTER TYPE 
                                  DECLARATION BY SUPPRESSING ERROR MESSAGE*)  
    LIST,PRCODE,PRTABLES: BOOLEAN;  (*OUTPUT OPTIONS FOR            
                                        -- SOURCE PROGRAM LISTING   
                                        -- PRINTING SYMBOLIC CODE   
                                        -- DISPLAYING IDENT AND STRUCT TABLES           
                                        --> PROCEDURE OPTION*)      
        
        
                                    (*POINTERS:*)         
                                    (***********)         
    INTPTR,REALPTR,CHARPTR,           
    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*) 
        
        
                                    (*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*)   
            BLCK: (); { ADDED EMPTY CASE PER ISO 7185 [SAM] }
            CREC: (CLEV: LEVRANGE;  (*=VREC:   ID IS FIELD ID IN RECORD WITH*)          
                  CDSPL: ADDRRANGE);(*         VARIABLE ADDRESS*)   
            VREC: (VDSPL: ADDRRANGE);
            REC:  () { ADDED EMPTY CASE PER ISO 7185 [SAM] }
          END;                      (* --> PROCEDURE WITHSTATEMENT*)          
        
        
                                    (*ERROR MESSAGES:*)   
                                    (*****************)   
        
    ERRINX: 0..10;                  (*NR OF ERRORS IN CURRENT SOURCE LINE*)   
    ERRLIST:      
      ARRAY [1..10] OF      
        PACKED RECORD POS: 1..81;     
                      NMR: 1..400     
               END;         
        
        
        
        
                                    (*EXPRESSION COMPILATION:*)     
                                    (*************************)     
        
    GATTR: ATTR;                    (*DESCRIBES THE EXPR CURRENTLY COMPILED*)           
        
        
                                    (*STRUCTURED CONSTANTS:*)       
                                    (***********************)       
        
    CONSTBEGSYS,SIMPTYPEBEGSYS,TYPEBEGSYS,BLOCKBEGSYS,SELECTSYS,FACBEGSYS,    
    STATBEGSYS,TYPEDELS: SETOFSYS;    
    RW:  ARRAY [1..35(*NR. OF RES. WORDS*)] OF ALPHA;     
    FRW: ARRAY [1..9] OF 1..36(*NR. OF RES. WORDS + 1*);  
    RSY: ARRAY [1..35(*NR. OF RES. WORDS*)] OF SYMBOL;    
    { THIS DEFINITION IS CDC DEPENDENT, CHANGED TO ALL CHARACTERS [SAM] }
    SSY: ARRAY [CHAR {'+'..';'}] OF SYMBOL;
    ROP: ARRAY [1..35(*NR. OF RES. WORDS*)] OF OPERATOR;  
    { THIS DEFINITION IS CDC DEPENDENT, CHANGED TO ALL CHARACTERS [SAM] }
    SOP: ARRAY [CHAR {'+'..';'}] OF OPERATOR;          
    NA:  ARRAY [1..35] OF ALPHA;      
    MN:  ARRAY [0..57] OF PACKED ARRAY [1..4] OF CHAR;    
    SNA: ARRAY [1..23] OF PACKED ARRAY [1..4] OF CHAR;    
        
    INTLABEL,MXINT10,DIGMAX: INTEGER; 
        
(*-------------------------------------------------------------------------*) 

{ THESE ARE ADDED AS NO-OPS TO GET THINGS WORKING. THE RESULT IS LOSS OF
  STORAGE. [SAM] }        
PROCEDURE MARK(VAR P: MARKTYPE); BEGIN P := P (* SHUT UP *) END;
PROCEDURE RELEASE(P: MARKTYPE); BEGIN P := P (* SHUT UP *) END;
  
PROCEDURE ENDOFLINE;        
    VAR LASTPOS,FREEPOS,CURRPOS,CURRNMR,F,K: INTEGER;     
  BEGIN           
    IF ERRINX > 0 THEN   (*OUTPUT ERROR MESSAGES*)        
      BEGIN WRITE(OUTPUT,' ****  ':15);         
        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  
      END;        
    IF LIST THEN  
      BEGIN LINECOUNT := LINECOUNT + 1; WRITE(OUTPUT,LINECOUNT:6,'  ':2);     
        IF DP THEN WRITE(OUTPUT,LC:7) ELSE WRITE(OUTPUT,IC:7);      
        WRITE(OUTPUT,' ')   
      END;        
    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      
  END (*ERROR*) ;           
        
  PROCEDURE INSYMBOL;       
    (*READ NEXT BASIC SYMBOL OF SOURCE PROGRAM AND RETURN ITS       
    DESCRIPTION IN THE GLOBAL VARIABLES SY, OP, ID, VAL AND LGTH*)            
    LABEL 1,2,3;  
    VAR I,K: INTEGER;       
        DIGIT: PACKED ARRAY [1..STRGLGTH] OF CHAR;        
        STRING: PACKED ARRAY [1..STRGLGTH] OF CHAR;       
        LVP: CSP;TEST: BOOLEAN;
        
    PROCEDURE NEXTCH;       
    BEGIN IF EOL THEN       
      BEGIN IF LIST THEN WRITELN(OUTPUT); ENDOFLINE       
      END;        
      IF NOT EOF(INPUT) THEN
       BEGIN EOL := EOLN(INPUT); READ(INPUT,CH);
        IF LIST THEN WRITE(OUTPUT,CH);
        CHCNT := CHCNT + 1  
       END        
      ELSE WRITELN(OUTPUT,'EOF ENCOUNTERED')    
    END;          
        
    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 = '+'; 
                  IF NOT LIST THEN WRITELN(OUTPUT)        
                END         
              ELSE
                IF CH = 'C' THEN      
                  BEGIN NEXTCH; PRCODE := CH = '+' END;   
            NEXTCH
          END     
      UNTIL CH <> ','       
    END (*OPTIONS*) ; 

  { THIS CODE WAS MOVED HERE TO REFACTOR THE INSYMBOL CODE AND REMOVE THE
    NEED TO JUMP INTO AN INNER BLOCK. [SAM] }
  PROCEDURE CVTINT;
  VAR K: INTEGER;
  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(DIGIT[K])-ORD('0'))
               ELSE BEGIN ERROR(203); IVAL := 0 END        
             END;  
           SY := INTCONST    
        END        
  END;
        
  BEGIN (*INSYMBOL*)        
  1:    
    REPEAT WHILE (CH = ' ') AND NOT EOL DO NEXTCH;        
      TEST := EOL;
      IF TEST THEN NEXTCH   
    UNTIL NOT TEST;
    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;       
          REPEAT  
            IF K < 8 THEN   
             BEGIN K := K + 1; ID[K] := CH END ;          
            NEXTCH          
          { REPLACED CDC SPECIFIC CHARACTER TEST }
          UNTIL NOT (CH IN ['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', '1', '2', '3', '4',
                            '5', '6', '7', '8', '9'])
                {(ORD(CH)<ORD('A')) OR (ORD(CH)>ORD('9'))}; 
          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 DIGIT[I] := CH; NEXTCH
          UNTIL (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9')); 
          IF (CH = '.') OR (CH = 'E') THEN      
            BEGIN 
                  K := I;   
                  IF CH = '.' THEN    
                    BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;       
                      NEXTCH; IF CH = '.' THEN BEGIN CH := ':'; CVTINT; GOTO 3 
                                               END;   
                      IF (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9')) THEN        
                        ERROR(201)    
                      ELSE  
                        REPEAT K := K + 1;      
                          IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH
                        UNTIL (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9'))        
                    END;    
                  IF CH = 'E' THEN    
                    BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;       
                      NEXTCH;         
                      IF (CH = '+') OR (CH ='-') THEN     
                        BEGIN K := K+1; IF K <= DIGMAX THEN DIGIT[K] := CH;   
                          NEXTCH      
                        END;
                      IF (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9')) THEN        
                        ERROR(201)    
                      ELSE  
                        REPEAT K := K+1;        
                          IF K <= DIGMAX THEN DIGIT[K] := CH; NEXTCH
                        UNTIL (ORD(CH)<ORD('0')) OR (ORD(CH)>ORD('9'))        
                     END;   
                   NEW(LVP,REEL); SY:= REALCONST; LVP^.CCLASS := REEL;        
                   WITH LVP^ DO       
                     BEGIN FOR I := 1 TO STRGLGTH DO RVAL[I] := ' ';
                       IF K <= DIGMAX THEN      
                         FOR I := 2 TO K + 1 DO RVAL[I] := DIGIT[I-1]         
                       ELSE BEGIN ERROR(203); RVAL[2] := '0';       
                              RVAL[3] := '.'; RVAL[4] := '0'        
                            END       
                     END;   
                   VAL.VALP := LVP;
  3:        END   
          ELSE    
  {3:}      BEGIN 
              { MOVED TO REFACTOR [SAM] }
              CVTINT
              {
              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(DIGIT[K])-ORD('0'))
                        ELSE BEGIN ERROR(203); IVAL := 0 END        
                      END;  
                    SY := INTCONST    
                 END        
              }
            END   
        END;      
      '''':       
        BEGIN LGTH := 0; SY := STRINGCONST;  OP := NOOP;  
          REPEAT  
            REPEAT NEXTCH; LGTH := LGTH + 1;    
                   IF LGTH <= STRGLGTH THEN STRING[LGTH] := CH      
            UNTIL (EOL) OR (CH = '''');         
            IF EOL THEN ERROR(202) ELSE NEXTCH  
          UNTIL CH <> '''';           
          LGTH := LGTH - 1;   (*NOW LGTH = NR OF CHARS IN STRING*)  
          IF LGTH = 1 THEN VAL.IVAL := ORD(STRING[1])     
          ELSE    
            BEGIN NEW(LVP,STRG); LVP^.CCLASS:=STRG;       
              IF LGTH > STRGLGTH THEN 
                BEGIN ERROR(399); LGTH := STRGLGTH END;   
              WITH LVP^ DO  
                BEGIN SLGTH := LGTH;  
                  FOR I := 1 TO LGTH DO SVAL[I] := STRING[I]        
                END;        
              VAL.VALP := LVP         
            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;   
         SY := LPARENT; OP := NOOP    
       END;       
      '*','+','-',          
      '=','/',')',          
      '[',']',',',';','^','$':        
        BEGIN SY := SSY[CH]; OP := SOP[CH];     
          NEXTCH  
        END;      
      { THIS SECTION FILLS OUT THE CASE FOR THE ENTIRE CHARACTER SET. I CHANGED
        IT TO USE THE ISO 8859-1 (ASCII) CHARACTER SET FROM THE ORIGINAL CDC 
        CHARACTER SET. THE CHARACTERS ARE ALL THOSE THAT ARE NOT USED IN THE 
        LANGUAGE, AND THEY APPEAR IN ISO 8859-1 ORDERING. [SAM] }
      '!','"','#','%', '&','?','@','\','_','`','{','|','~',' ':          
        BEGIN SY := OTHERSY; OP := NOOP; ERROR(399) 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;           
        { THIS NEEDED TO BE LOCAL [SAM] }
        DISXL: DISPRANGE; (*LEVEL OF LAST ID SEARCHED BY SEARCHID*)           
  BEGIN           
    FOR DISXL := TOP DOWNTO 0 DO       
      { BECAUSE THE ORIGINAL PROGRAM RELIES ON USING THE EARLY OUT VALUE OF 
        DISX, WE SIMULATE THIS BEHAVIOR BY ASSIGNING THE LOCAL DISXL (LOCAL
        DISX, AS ISO 7185 REQUIRES) TO THE GLOBAL DISX ON EACH LOOP. }
      BEGIN DISX := DISXL; LCP := DISPLAY[DISXL].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 := 63      
          ELSE    
            IF 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*);           
        
    { THE ORIGINAL COMPILER USED ORD() TO ACT AS A UNIVERSAL TYPE ESCAPE.
      THIS WAS CHANGED TO USE A MORE GENERALLY AVAILABLE METHOD WITH 
      UNDISCRIMINATED VARIANTS. LOOK FOR THESE NEW DEFINITIONS IN THE ROUTINES
      FOLLOWSTP AND FOLLOWCTP BELOW. [SAM] }
    FUNCTION ORDSTP(P: STP): INTEGER;
    VAR TCR: RECORD CASE BOOLEAN OF TRUE: (A: STP); FALSE: (B: INTEGER) END;
    BEGIN TCR.A := P; ORDSTP := TCR.B END;
    FUNCTION ORDCTP(P: CTP): INTEGER;
    VAR TCR: RECORD CASE BOOLEAN OF TRUE: (A: CTP); FALSE: (B: INTEGER) END;
    BEGIN TCR.A := P; ORDCTP := TCR.B END;

    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,ORDSTP(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,' ':4,ORDCTP(FCONST):6);         
                          WRITELN(OUTPUT)       
                        END;          
              SUBRANGE:BEGIN          
                        WRITE(OUTPUT,'SUBRANGE':10,' ':4,ORDSTP(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,ORDSTP(ELTYPE):6);     
              POWER:    BEGIN WRITELN(OUTPUT,'SET':10,' ':4,ORDSTP(ELSET):6);    
                            FOLLOWSTP(ELSET)    
                          END;        
              ARRAYS:   BEGIN         
                         WRITELN(OUTPUT,'ARRAY':10,' ':4,ORDSTP(AELTYPE):6,' ':4,
                            ORDSTP(INXTYPE):6);    
                            FOLLOWSTP(AELTYPE); FOLLOWSTP(INXTYPE)  
                          END;        
              RECORDS:  BEGIN         
                        WRITELN(OUTPUT,'RECORD':10,' ':4,ORDCTP(FSTFLD):6,' ':4, 
                            ORDSTP(RECVAR):6); FOLLOWCTP(FSTFLD);      
                            FOLLOWSTP(RECVAR)   
                          END;        
              FILES:    BEGIN WRITE(OUTPUT,'FILE':10,' ':4,ORDSTP(FILTYPE):6);   
                            FOLLOWSTP(FILTYPE)  
                          END;        
              TAGFLD:   BEGIN WRITELN(OUTPUT,'TAGFLD':10,' ':4,ORDCTP(TAGFIELDP):6,        
                            ' ':4,ORDSTP(FSTVAR):6);         
                            FOLLOWSTP(FSTVAR)   
                          END;        
              VARIANT:  BEGIN WRITELN(OUTPUT,'VARIANT':10,' ':4,ORDSTP(NXTVAR):6,
                            ' ':4,ORDSTP(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,ORDCTP(FP):6,' ',NAME:9,' ':4,ORDCTP(LLINK):6,   
            ' ':4,ORDCTP(RLINK):6,' ':4,ORDSTP(IDTYPE):6);      
            CASE KLASS OF   
              TYPES: WRITE(OUTPUT,'TYPE':10);   
              KONST: BEGIN WRITE(OUTPUT,'CONSTANT':10,' ':4,ORDCTP(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 SLGTH 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,ORDCTP(NEXT):6,VLEV,' ':4,VADDR:6 );  
                      END;  
              FIELD: WRITE(OUTPUT,'FIELD':10,' ':4,ORDCTP(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,' ':4,ORDCTP(NEXT):6);
                            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;   
        
    PROCEDURE SKIP(FSYS: SETOFSYS);   
      (*SKIP INPUT STRING UNTIL RELEVANT SYMBOL FOUND*)   
    BEGIN WHILE NOT(SY IN FSYS) DO INSYMBOL     
    END (*SKIP*) ;          
        
    PROCEDURE CONSTANT(FSYS: SETOFSYS; VAR FSP: STP; VAR FVALU: VALU);        
      VAR LSP: STP; LCP: CTP; SIGN: (NONE,POS,NEG);       
          LVP: CSP; I: 2..STRGLGTH;   
    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     
          { STRINGCONSTSY CHANGED TO STRINGCONST. THE MISTAKE SURVIVED ONLY
            BECAUSE THE ORIGINAL IMPLEMENTATIONS RECOGNIZED 8 CHARACTERS ONLY.
            [SAM] }
          IF SY = STRINGCONST THEN  
            BEGIN           
              IF LGTH = 1 THEN LSP := CHARPTR   
              ELSE          
                BEGIN       
                  NEW(LSP,ARRAYS);    
                  WITH LSP^ DO        
                    BEGIN AELTYPE := CHARPTR; INXTYPE := NIL;       
                       SIZE := LGTH*CHARSIZE; FORM := ARRAYS        
                    END     
                END;        
              FVALU := VAL; 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[1] = '-' THEN     
                                LVP^.RVAL[1] := '+'       
                              ELSE LVP^.RVAL[1] := '-';   
                              FOR I := 2 TO STRGLGTH 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 := VAL; INSYMBOL           
                  END       
                ELSE        
                  IF SY = REALCONST THEN        
                    BEGIN IF SIGN = NEG THEN VAL.VALP^.RVAL[1] := '-';        
                      LSP := REALPTR; FVALU := VAL; 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    
          IF COMPTYPES(FSP^.AELTYPE,CHARPTR) THEN STRING := TRUE    
    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 := INTSIZE
                          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 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(399)      
                        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 [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]) THEN        
                  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 := DISPL         
                  END;      
                ENTERID(LCP);         
                INSYMBOL;   
                IF SY = COLON THEN INSYMBOL ELSE ERROR(5);          
                IF SY = IDENT THEN    
                  BEGIN SEARCHID([TYPES],LCP1);           
                    LSP1 := LCP1^.IDTYPE;       
                    IF LSP1 <> NIL THEN         
                      BEGIN DISPL := DISPL + LSP1^.SIZE;  
                        IF (LSP1^.FORM <= SUBRANGE) OR STRING(LSP1) THEN      
                          BEGIN IF COMPTYPES(REALPTR,LSP1) THEN ERROR(109)    
                            ELSE IF STRING(LSP1) THEN ERROR(399);   
                            LCP^.IDTYPE := LSP1; LSP^.TAGFIELDP := LCP;       
                          END         
                        ELSE ERROR(110);        
                    END;    
                    INSYMBOL;         
                  END       
                ELSE BEGIN ERROR(2); SKIP(FSYS + [OFSY,LPARENT]) 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        
                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);      
                      LSP1^.SIZE := 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(399);SKIP(FSYS);FSP:= NIL 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: INTEGER;      
    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;       
    BEGIN NXT := NIL;       
      REPEAT      
        REPEAT    
          IF SY = IDENT THEN          
            BEGIN NEW(LCP,VARS);      
              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);     
        WHILE NXT <> NIL DO           
          WITH  NXT^ DO     
            BEGIN IDTYPE := LSP; VADDR := LC;   
              LC := LC + LSIZE; 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: INTEGER; 
          MARKP: MARKTYPE; { CHANGED TO USE THE MARK TYPE FOR ROUTINES. [SAM] }
        
      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;    
        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(399);   
                    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(399); 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);          
                                LSP := LCP^.IDTYPE;       
                                IF LSP <> NIL THEN        
                                  IF (LKIND=ACTUAL)AND(LSP^.FORM=FILES) THEN  
                                    ERROR(121);           
                                LCP3 := LCP2;   
                                IF (LKIND=ACTUAL) AND (LSP^.SIZE<=PTRSIZE)    
                                THEN LEN := LSP^.SIZE     
                                ELSE LEN := PTRSIZE;      
                                LC := LC+COUNT*LEN;       
                                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;    
            (*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^.SIZE > PTRSIZE) THEN   
                        BEGIN VADDR := LC; LC := LC + IDTYPE^.SIZE  
                        END;          
                  LCP3 := LCP1; LCP1 := LCP2    
                END;        
            FPAR := LCP3    
          END     
            ELSE FPAR := NIL          
    END (*PARAMETERLIST*) ;           
        
    BEGIN (*PROCDECLARATION*)         
      LLC := LC; LC := LCAFTERMARKSTACK;        
      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; GENLABEL(LBNAME);
                  PFDECKIND := DECLARED; PFKIND := ACTUAL; PFNAME := LBNAME;  
                  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;           
      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 LCP^.NEXT := LCP1    
        END       
      ELSE        
        BEGIN PARAMETERLIST([SEMICOLON,COLON],LCP1);      
          IF NOT FORW THEN LCP^.NEXT := LCP1;   
          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  
                    IF NOT (LSP^.FORM IN [SCALAR,SUBRANGE,POINTER]) THEN      
                      BEGIN ERROR(120); LCP^.IDTYPE := NIL END;     
                  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;          
    END (*PROCDECLARATION*) ;         
        
    PROCEDURE BODY(FSYS: SETOFSYS);   
      CONST CSTOCCMAX = 60; CIXMAX = 1000;      
      TYPE OPRANGE = 0..63; 
      VAR         
          LLCP:CTP; SAVEID:ALPHA;     
          CSTPTR: ARRAY [1..CSTOCCMAX] OF CSP;  
          CSTPTRIX: 0..CSTOCCMAX;     
          (*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*)       
          I, ENTNAME, SEGSIZE: INTEGER;         
          LCMAX,LLC1: ADDRRANGE; LCP: CTP;      
          LLP: LBP;         
        
        
      PROCEDURE PUTIC;      
      BEGIN IF IC MOD 10 = 0 THEN WRITELN(PRR,'I',IC:5) END;        
        
        
      PROCEDURE GEN0(FOP: OPRANGE);   
      BEGIN       
        IF PRCODE THEN BEGIN PUTIC; WRITELN(PRR,MN[FOP]:4) 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);    
            IF FOP = 30 THEN WRITELN(PRR,SNA[FP2]:12)     
            ELSE IF FOP = 38 THEN     
                   BEGIN WRITE(PRR,'''');       
                     WITH CSTPTR[FP2]^ DO       
                       FOR K := 1 TO SLGTH DO WRITE(PRR,SVAL[K]:1); 
                     WRITELN(PRR,'''')
                   END      
                 ELSE IF FOP = 42 THEN WRITELN(PRR,CHR(FP2))        
                      ELSE WRITELN(PRR,FP2:12)  
          END;    
        IC := IC + 1        
      END (*GEN1*) ;        
        
      PROCEDURE GEN2(FOP: OPRANGE; FP1,FP2: INTEGER);     
        VAR K : INTEGER;    
      BEGIN       
        IF PRCODE THEN      
          BEGIN PUTIC; WRITE(PRR,MN[FOP]:4);    
            CASE FOP OF     
              45,50,54,56:  
                WRITELN(PRR,' ',FP1:3,FP2:8);   
              47,48,49,52,53,55:      
                BEGIN WRITE(PRR,CHR(FP1));      
                  IF CHR(FP1) = 'M' THEN WRITE(PRR,FP2:11);         
                  WRITELN(PRR)        
                END;        
              51: 
                CASE FP1 OF 
                  1: WRITELN(PRR,'I ',FP2);     
                  2: BEGIN WRITE(PRR,'R ');     
                       WITH CSTPTR[FP2]^ DO     
                         FOR K := 1 TO STRGLGTH DO WRITE(PRR,RVAL[K]);        
                       WRITELN(PRR)   
                     END;   
                  3: WRITELN(PRR,'B ',FP2);     
                  4: WRITELN(PRR,'N');
                  5: BEGIN WRITE(PRR,'(');      
                       WITH CSTPTR[FP2]^ DO     
                         FOR K := 0 TO 58 DO    
                           IF K IN PVAL THEN WRITE(PRR,K:3);        
                       WRITELN(PRR,')')         
                     END    
                END         
            END;  
          END;    
          IC := IC + 1      
      END (*GEN2*) ;        
        
      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 GEN2(51(*LDC*),1,CVAL.IVAL)           
                       ELSE           
                         IF TYPTR = NILPTR THEN GEN2(51(*LDC*),4,0)           
                         ELSE         
                           IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254)           
                           ELSE       
                             BEGIN CSTPTRIX := CSTPTRIX + 1;        
                               CSTPTR[CSTPTRIX] := CVAL.VALP;       
                               IF TYPTR = REALPTR THEN    
                                 GEN2(51(*LDC*),2,CSTPTRIX)         
                               ELSE   
                                  GEN2(51(*LDC*),5,CSTPTRIX)        
                             END;     
                VARBL: CASE ACCESS OF           
                         DRCT:   IF VLEVEL <= 1 THEN GEN1(39(*LDO*),DPLMT)    
                                 ELSE GEN2(54(*LOD*),LEVEL-VLEVEL,DPLMT);     
                         INDRCT: GEN1(35(*IND*),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:   IF VLEVEL <= 1 THEN GEN1(43(*SRO*),DPLMT)     
                      ELSE GEN2(56(*STR*),LEVEL-VLEVEL,DPLMT);      
              INDRCT: IF IDPLMT <> 0 THEN ERROR(400)      
                      ELSE GEN0(26(*STO*));     
              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    
                         IF CSTPTRIX >= CSTOCCMAX THEN ERROR(254)   
                         ELSE         
                           BEGIN CSTPTRIX := CSTPTRIX + 1;          
                             CSTPTR[CSTPTRIX] := CVAL.VALP;         
                             GEN1(38(*LCA*),CSTPTRIX)     
                           END        
                       ELSE ERROR(400);         
                VARBL: CASE ACCESS OF           
                         DRCT:   IF VLEVEL <= 1 THEN GEN1(37(*LAO*),DPLMT)    
                                 ELSE GEN2(50(*LDA*),LEVEL-VLEVEL,DPLMT);     
                         INDRCT: IF IDPLMT <> 0 THEN GEN1(34(*INC*),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,' L':8,FADDR:4) END; 
        IC := IC + 1        
      END (*GENFJP*) ;      
        
      PROCEDURE GENUJPENT(FOP: OPRANGE; FP2: INTEGER);    
     BEGIN      
       IF PRCODE THEN       
          BEGIN PUTIC; WRITELN(PRR, MN[FOP]:4, ' L':8,FP2:4) END;   
        IC := IC + 1        
      END (*GENUJPENT*);    
        
        
      PROCEDURE GENCUP(FP1, FP2: INTEGER);      
     BEGIN        
       IF PRCODE THEN       
          BEGIN PUTIC; WRITELN(PRR, MN[46]:4, FP1:4, ' L':4, FP2:4) END;      
        IC := IC + 1        
      END (*GENCUP*);       
        
        
      PROCEDURE PUTLABEL(LABNAME: INTEGER);     
      BEGIN IF PRCODE THEN WRITELN(PRR, 'L', LABNAME:4)   
      END (*PUTLABEL*);     
        
      PROCEDURE STATEMENT(FSYS: SETOFSYS);      
        LABEL 1;  
        VAR LCP: CTP; LLP: LBP;       
        
        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 GEN2(54(*LOD*),LEVEL-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           
                        IF LEVEL = 1 THEN GEN1(39(*LDO*),VDSPL)     
                        ELSE GEN2(54(*LOD*),0,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  
                        BEGIN ACCESS := DRCT; VLEVEL := PFLEV + 1;  
                          DPLMT := 0   (*IMPL. 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 LMIN > 0 THEN GEN1(31(*DEC*),LMIN)       
                                  ELSE IF LMIN < 0 THEN GEN1(34(*INC*),-LMIN)           
                                  (*OR SIMPLY GEN1(31,LMIN)*)       
                                END   
                            END       
                          ELSE ERROR(139);      
                          WITH GATTR DO         
                            BEGIN TYPTR := AELTYPE; KIND := VARBL;  
                              ACCESS := INDRCT; IDPLMT := 0         
                            END;      
                          IF GATTR.TYPTR <> NIL THEN      
                            GEN1(36(*IXA*),GATTR.TYPTR^.SIZE)       
                        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 TYPTR := ELTYPE; LOAD;    
                            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;  
        
          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 GETPUTRESETREWRITE;         
          BEGIN VARIABLE(FSYS + [RPARENT]); LOADADDRESS;  
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(116);        
            IF LKEY <= 2 THEN GEN1(30(*CSP*),LKEY(*GET,PUT*))       
            ELSE ERROR(399)           
          END (*GETPUTRESETREWRITE*) ;          
        
          PROCEDURE READ;   
            VAR LCP:CTP; LLEV:LEVRANGE; LADDR:ADDRRANGE;  
          BEGIN   
            IF SY = IDENT THEN        
              BEGIN SEARCHID([VARS],LCP);       
                IF LCP <> NIL THEN    
                  IF LCP^.IDTYPE^.FORM = FILES THEN       
                    WITH LCP^ DO      
                      BEGIN 
                        IF IDTYPE^.FILTYPE = CHARPTR THEN 
                          BEGIN LLEV := VLEV; LADDR := VADDR END    
                        ELSE ERROR(399);        
                        INSYMBOL;     
                        IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20)         
                      END   
                  ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK END         
                ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK END 
              END 
            ELSE BEGIN ERROR(2); LLEV := 1; LADDR := LCAFTERMARKSTACK;        
                   INSYMBOL 
                 END;       
           IF SY = COMMA THEN INSYMBOL;         
           IF SY = IDENT THEN         
           BEGIN  
            REPEAT VARIABLE(FSYS + [COMMA,RPARENT]); LOADADDRESS;   
              GEN2(50(*LDA*),LEVEL-LLEV,LADDR); 
              IF GATTR.TYPTR <> NIL THEN        
                IF GATTR.TYPTR^.FORM <= SUBRANGE THEN     
                  IF COMPTYPES(INTPTR,GATTR.TYPTR) THEN   
                    GEN1(30(*CSP*),3(*RDI*))    
                  ELSE      
                    IF COMPTYPES(REALPTR,GATTR.TYPTR) THEN          
                      GEN1(30(*CSP*),4(*RDR*))  
                    ELSE    
                      IF COMPTYPES(CHARPTR,GATTR.TYPTR) THEN        
                        GEN1(30(*CSP*),5(*RDC*))          
                      ELSE ERROR(399)           
                ELSE ERROR(116);      
              TEST := SY <> COMMA;    
              IF NOT TEST THEN INSYMBOL         
            UNTIL TEST      
           END;   
           IF LKEY = 11 THEN
             BEGIN GEN2(50(*LDA*),LEVEL - LLEV, LADDR);   
               GEN1(30(*CSP*),21(*RLN*))        
             END  
          END (*READ*) ;    
        
          PROCEDURE WRITE;  
            VAR LSP: STP; DEFAULT : BOOLEAN; LLKEY: 1..15;
                LCP:CTP; LLEV:LEVRANGE; LADDR,LEN:ADDRRANGE;        
          BEGIN LLKEY := LKEY;        
            IF SY = IDENT THEN        
              BEGIN SEARCHID([VARS],LCP);       
                IF LCP <> NIL THEN    
                  IF LCP^.IDTYPE^.FORM = FILES THEN       
                    WITH LCP^ DO      
                      BEGIN 
                        IF IDTYPE^.FILTYPE = CHARPTR THEN 
                          BEGIN LLEV := VLEV; LADDR := VADDR END    
                        ELSE ERROR(399);        
                        INSYMBOL;     
                        IF NOT (SY IN [COMMA,RPARENT]) THEN ERROR(20)         
                      END   
                  ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK+CHARSIZE    
                       END  
                ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK+CHARSIZE END  
              END 
            ELSE BEGIN LLEV := 1; LADDR := LCAFTERMARKSTACK+CHARSIZE END;     
           IF SY = COMMA THEN INSYMBOL;         
           IF SY IN FACBEGSYS THEN    
           BEGIN  
            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(399);   
                END         
              ELSE          
                IF LSP = INTPTR THEN  
                  BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,10);       
                    GEN2(50(*LDA*),LEVEL-LLEV,LADDR);     
                    GEN1(30(*CSP*),6(*WRI*))    
                  END       
                ELSE        
                  IF LSP = REALPTR THEN         
                    BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,20);     
                      GEN2(50(*LDA*),LEVEL-LLEV,LADDR);   
                      GEN1(30(*CSP*),8(*WRR*))  
                    END     
                  ELSE      
                    IF LSP = CHARPTR THEN       
                      BEGIN IF DEFAULT THEN GEN2(51(*LDC*),1,1);    
                        GEN2(50(*LDA*),LEVEL-LLEV,LADDR); 
                        GEN1(30(*CSP*),9(*WRC*))          
                      END   
                    ELSE    
                      IF LSP <> NIL THEN        
                        BEGIN         
                          IF LSP^.FORM = SCALAR THEN ERROR(399)     
                          ELSE        
                            IF STRING(LSP) THEN           
                              BEGIN LEN := LSP^.SIZE DIV CHARSIZE;  
                                IF DEFAULT THEN 
                                      GEN2(51(*LDC*),1,LEN);        
                                GEN2(51(*LDC*),1,LEN);    
                                GEN2(50(*LDA*),LEVEL-LLEV,LADDR);   
                                GEN1(30(*CSP*),10(*WRS*))           
                              END     
                            ELSE ERROR(116)     
                        END;          
              TEST := SY <> COMMA;    
              IF NOT TEST THEN INSYMBOL         
            UNTIL TEST;     
           END;   
            IF LLKEY = 12 THEN (*WRITELN*)      
              BEGIN GEN2(50(*LDA*),LEVEL-LLEV,LADDR);     
                GEN1(30(*CSP*),22(*WLN*))       
              END 
          END (*WRITE*) ;   
        
          PROCEDURE PACK;   
            VAR LSP,LSP1: STP;        
          BEGIN ERROR(399); 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 UNPACK;           
            VAR LSP,LSP1: STP;        
          BEGIN ERROR(399); 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 NEW;    
            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*) ;         
            GEN2(51(*LDC*),1,LSIZE);  
            GEN1(30(*CSP*),12(*NEW*));
          END (*NEW*) ;     
        
          PROCEDURE MARK;   
          BEGIN VARIABLE(FSYS+[RPARENT]);       
             IF GATTR.TYPTR <> NIL THEN         
               IF GATTR.TYPTR^.FORM = POINTER THEN        
                 BEGIN LOADADDRESS; GEN1(30(*CSP*),23(*SAV*)) END   
               ELSE ERROR(125)        
          END(*MARK*);      
        
          PROCEDURE RELEASE;
          BEGIN VARIABLE(FSYS+[RPARENT]);       
                IF GATTR.TYPTR <> NIL THEN      
                   IF GATTR.TYPTR^.FORM = POINTER THEN    
                      BEGIN LOAD; GEN1(30(*CSP*),13(*RST*)) END     
                   ELSE ERROR(125)    
          END (*RELEASE*);  
        
        
        
          PROCEDURE ABS;    
          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 SQR;    
          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 TRUNC;  
          BEGIN   
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR <> REALPTR THEN ERROR(125);  
            GEN0(27(*TRC*));          
            GATTR.TYPTR := INTPTR     
          END (*TRUNC*) ;   
        
          PROCEDURE ODD;    
          BEGIN   
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR <> INTPTR THEN ERROR(125);   
            GEN0(20(*ODD*));          
            GATTR.TYPTR := BOOLPTR    
          END (*ODD*) ;     
        
          PROCEDURE ORD;    
          BEGIN   
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR^.FORM >= POWER THEN ERROR(125);        
            GATTR.TYPTR := INTPTR     
          END (*ORD*) ;     
        
          PROCEDURE CHR;    
          BEGIN   
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR <> INTPTR THEN ERROR(125);   
            GATTR.TYPTR := CHARPTR    
          END (*CHR*) ;     
        
        
        
          PROCEDURE PREDSUCC;         
          BEGIN ERROR(399);           
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR^.FORM <> SCALAR THEN ERROR(125);       
          END (*PREDSUCC*) ;          
        
          PROCEDURE EOF;    
          BEGIN   
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR^.FORM <> FILES THEN ERROR(125);        
            IF LKEY = 9 THEN GEN0(8(*EOF*)) ELSE GEN1(30(*CSP*),14(*ELN*));   
              GATTR.TYPTR := BOOLPTR  
          END (*EOF*) ;     
        
          PROCEDURE CALLNONSTANDARD;  
            VAR NXT,LCP: CTP; LSP: STP; LKIND: IDKIND; LB: BOOLEAN;           
                LOCPAR, LLC: ADDRRANGE;         
          BEGIN LOCPAR := 0;
            WITH FCP^ DO    
              BEGIN NXT := NEXT; LKIND := PFKIND;         
                IF NOT EXTERN THEN GEN1(41(*MST*),LEVEL-PFLEV)      
              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(399);        
                  (*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(399); 
                      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^.SIZE <= PTRSIZE THEN  
                                      BEGIN LOAD;         
                                        IF COMPTYPES(REALPTR,LSP)   
                                           AND (GATTR.TYPTR = INTPTR) THEN    
                                          BEGIN GEN0(10(*FLT*));    
                                            GATTR.TYPTR := REALPTR  
                                          END;  
                                        LOCPAR := LOCPAR + LSP^.SIZE
                                      END       
                                      ELSE      
                                      BEGIN     
                                        IF (GATTR.KIND = EXPR)      
                                         OR (GATTR.KIND = CST) THEN 
                                        BEGIN LOAD;       
                                          IF COMPTYPES(REALPTR,LSP) 
                                             AND (GATTR.TYPTR = INTPTR) THEN  
                                            BEGIN GEN0(10(*FLT*));  
                                              GATTR.TYPTR := REALPTR
                                            END;
                                          GEN2(56(*STR*),0,LC);     
                                          GEN2(50(*LDA*),0,LC);     
                                          LC := LC + GATTR.TYPTR^.SIZE;       
                                          IF LCMAX < LC THEN LCMAX := LC      
                                        END     
                                        ELSE    
                                          IF COMPTYPES(REALPTR,LSP) 
                                           AND (GATTR.TYPTR = INTPTR) THEN    
                                          BEGIN LOAD;     
                                            GEN0(10(*FLT*));        
                                            GEN2(56(*STR*),0,LC);   
                                            GEN2(50(*LDA*),0,LC);   
                                            LC := LC + GATTR.TYPTR^.SIZE;     
                                            IF LCMAX < LC THEN LCMAX := LC    
                                          END   
                                          ELSE LOADADDRESS;         
                                        LOCPAR := LOCPAR + PTRSIZE  
                                      END       
                                    ELSE        
                                      IF GATTR.KIND = VARBL THEN    
                                        BEGIN LOADADDRESS; LOCPAR := LOCPAR + PTRSIZE   
                                        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*);       
            IF LKIND = ACTUAL THEN    
              BEGIN IF NXT <> NIL THEN ERROR(126);        
                WITH FCP^ DO          
                  BEGIN     
                    IF EXTERN THEN GEN1(30(*CSP*),PFNAME) 
                    ELSE GENCUP(LOCPAR, PFNAME);
                  END       
              END;          
            GATTR.TYPTR := FCP^.IDTYPE          
          END (*CALLNONSTANDARD*) ;   
        
        BEGIN (*CALL*)      
          IF FCP^.PFDECKIND = STANDARD THEN     
            BEGIN IF SY = LPARENT THEN INSYMBOL ELSE ERROR(9);      
              LKEY := FCP^.KEY;       
              IF FCP^.KLASS = PROC THEN         
                CASE LKEY OF          
                  1,2,      
                  3,4:  GETPUTRESETREWRITE;     
                  5,11:    READ;      
                  6,12:    WRITE;     
                  7:    PACK;         
                  8:    UNPACK;       
                  9:    NEW;
                  10:   RELEASE;      
                  13:   MARK
                END         
              ELSE          
                BEGIN EXPRESSION(FSYS + [RPARENT]);       
                      IF LKEY <= 8 THEN LOAD ELSE LOADADDRESS;      
                  CASE LKEY OF        
                    1:    ABS;        
                    2:    SQR;        
                    3:    TRUNC;      
                    4:    ODD;        
                    5:    ORD;        
                    6:    CHR;        
                    7,8:  PREDSUCC;   
                    9,10:    EOF      
                  END       
                END;        
              IF SY = RPARENT THEN INSYMBOL ELSE 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..58; LSP: STP;      
              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); GATTR.KIND := EXPR 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       
                            END;      
                          INSYMBOL    
                        END;          
                      REALCONST:      
                        BEGIN         
                          WITH GATTR DO         
                            BEGIN TYPTR := REALPTR; KIND := CST;    
                              CVAL := VAL       
                            END;      
                          INSYMBOL    
                        END;          
                      STRINGCONST:    
                        BEGIN         
                          WITH GATTR DO         
                            BEGIN     
                              IF LGTH = 1 THEN TYPTR := CHARPTR     
                              ELSE    
                                BEGIN NEW(LSP,ARRAYS);    
                                  WITH LSP^ DO  
                                    BEGIN AELTYPE := CHARPTR; FORM:=ARRAYS;   
                                      INXTYPE := NIL; SIZE := LGTH*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,RBRACK]);       
                                IF GATTR.TYPTR <> NIL THEN          
                                  IF GATTR.TYPTR^.FORM <> SCALAR THEN         
                                    BEGIN ERROR(136); GATTR.TYPTR := NIL END  
                                  ELSE          
                                    IF COMPTYPES(LSP^.ELSET,GATTR.TYPTR) THEN           
                                      BEGIN     
                                        IF GATTR.KIND = CST THEN    
                                          CSTPART := CSTPART+[GATTR.CVAL.IVAL]          
                                        ELSE    
                                          BEGIN LOAD; GEN0(23(*SGS*));        
                                            IF VARPART THEN GEN0(28(*UNI*))   
                                            ELSE VARPART := TRUE    
                                          END;  
                                        LSP^.ELSET := GATTR.TYPTR;  
                                        GATTR.TYPTR := LSP          
                                      END       
                                    ELSE ERROR(137);      
                                TEST := SY <> COMMA;      
                                IF NOT TEST THEN INSYMBOL 
                              UNTIL TEST;       
                              IF SY = RBRACK THEN INSYMBOL ELSE ERROR(12)     
                            END;      
                          IF VARPART THEN       
                            BEGIN     
                              IF CSTPART <> [ ] THEN      
                                BEGIN NEW(LVP,PSET); LVP^.PVAL := CSTPART;    
                                  LVP^.CCLASS := PSET;    
                                  IF CSTPTRIX = CSTOCCMAX THEN ERROR(254)     
                                  ELSE          
                                    BEGIN CSTPTRIX := CSTPTRIX + 1;           
                                      CSTPTR[CSTPTRIX] := LVP;      
                                      GEN2(51(*LDC*),5,CSTPTRIX);   
                                      GEN0(28(*UNI*)); GATTR.KIND := EXPR     
                                    END         
                                END   
                            END       
                          ELSE        
                            BEGIN NEW(LVP,PSET); LVP^.PVAL := CSTPART;        
                              LVP^.CCLASS := PSET;        
                              GATTR.CVAL.VALP := LVP      
                            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 LATTR.TYPTR = INTPTR THEN        
                                  BEGIN GEN0(9(*FLO*));   
                                    LATTR.TYPTR := REALPTR          
                                  END           
                                ELSE  
                                  IF GATTR.TYPTR = INTPTR THEN      
                                    BEGIN GEN0(10(*FLT*));          
                                      GATTR.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 LATTR.TYPTR = INTPTR THEN          
                                BEGIN GEN0(9(*FLO*));     
                                  LATTR.TYPTR := REALPTR  
                                END;  
                              IF GATTR.TYPTR = INTPTR THEN          
                                  BEGIN GEN0(10(*FLT*));  
                                  GATTR.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 LATTR.TYPTR = INTPTR THEN    
                            BEGIN GEN0(9(*FLO*));         
                              LATTR.TYPTR := REALPTR      
                            END       
                          ELSE        
                            IF GATTR.TYPTR = INTPTR THEN  
                              BEGIN GEN0(10(*FLT*));      
                                GATTR.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 LATTR.TYPTR = INTPTR THEN    
                            BEGIN GEN0(9(*FLO*));         
                              LATTR.TYPTR := REALPTR      
                            END       
                          ELSE        
                            IF GATTR.TYPTR = INTPTR THEN  
                            BEGIN GEN0(10(*FLT*));        
                                GATTR.TYPTR := REALPTR    
                              END;    
                          IF (LATTR.TYPTR = REALPTR)AND(GATTR.TYPTR = REALPTR)          
                            THEN GEN0(22(*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;      
              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           
                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 LATTR.TYPTR = INTPTR THEN        
                        BEGIN GEN0(9(*FLO*));   
                          LATTR.TYPTR := REALPTR          
                        END           
                      ELSE  
                        IF GATTR.TYPTR = INTPTR THEN      
                          BEGIN GEN0(10(*FLT*));          
                            GATTR.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 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           
              IF GATTR.TYPTR <> NIL THEN        
                IF (GATTR.ACCESS<>DRCT) OR (GATTR.TYPTR^.FORM>POWER) THEN     
                  LOADADDRESS;        
              LATTR := GATTR;         
              INSYMBOL; EXPRESSION(FSYS);       
              IF GATTR.TYPTR <> NIL THEN        
                IF GATTR.TYPTR^.FORM <= POWER THEN LOAD   
                ELSE LOADADDRESS;     
              IF (LATTR.TYPTR <> NIL) AND (GATTR.TYPTR <> NIL) THEN           
                BEGIN       
                  IF COMPTYPES(REALPTR,LATTR.TYPTR)AND(GATTR.TYPTR=INTPTR)THEN
                    BEGIN GEN0(10(*FLT*));      
                      GATTR.TYPTR := REALPTR    
                    END;    
                  IF COMPTYPES(LATTR.TYPTR,GATTR.TYPTR) THEN        
                    CASE LATTR.TYPTR^.FORM OF   
                      SCALAR,         
                      SUBRANGE,       
                      POINTER,        
                      POWER:   STORE(LATTR);    
                      ARRAYS,         
                      RECORDS: GEN1(40(*MOV*),LATTR.TYPTR^.SIZE);   
                      FILES: ERROR(146)         
                    END     
                  ELSE ERROR(129)     
                END         
            END (*SY = BECOMES*)      
          ELSE ERROR(51)    
        END (*ASSIGNMENT*) ;          
        
        PROCEDURE GOTOSTATEMENT;      
          VAR LLP: LBP; FOUND: BOOLEAN; TTOP,TTOP1: DISPRANGE;      
        BEGIN     
          IF SY = INTCONST THEN       
            BEGIN 
              FOUND := FALSE;         
              TTOP := TOP;  
              REPEAT        
                WHILE DISPLAY[TTOP].OCCUR <> BLCK DO TTOP := TTOP - 1;        
                TTOP1 := TTOP; 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    
                          GENUJPENT(57(*UJP*),LABNAME)    
                        ELSE (*GOTO LEADS OUT OF PROCEDURE*) ERROR(399)       
                      END   
                    ELSE LLP := NEXTLAB;        
                TTOP := TTOP - 1      
              UNTIL FOUND OR (TTOP = 0);        
              IF NOT FOUND THEN ERROR(167);     
              INSYMBOL      
            END   
          ELSE ERROR(15)    
        END (*GOTOSTATEMENT*) ;       
        
        PROCEDURE COMPOUNDSTATEMENT;  
        BEGIN     
          REPEAT  
            REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])    
            UNTIL NOT (SY IN STATBEGSYS);       
            TEST := SY <> SEMICOLON;  
            IF NOT TEST THEN INSYMBOL 
          UNTIL TEST;       
          IF SY = ENDSY THEN 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); GENUJPENT(57(*UJP*),LCIX2);      
              PUTLABEL(LCIX1);        
              INSYMBOL; STATEMENT(FSYS);        
              PUTLABEL(LCIX2)         
            END   
          ELSE PUTLABEL(LCIX1)        
        END (*IFSTATEMENT*) ;         
        
        PROCEDURE CASESTATEMENT;      
          LABEL 1;          
          TYPE CIP = ^CASEINFO;       
               CASEINFO = PACKED      
                          RECORD NEXT: CIP;     
                            CSSTART: INTEGER;   
                            CSLAB: INTEGER      
                          END;        
          VAR LSP,LSP1: STP; FSTPTR,LPT1,LPT2,LPT3: CIP; LVAL: VALU;          
              LADDR, LCIX, LCIX1, LMIN, LMAX: INTEGER;    
        BEGIN EXPRESSION(FSYS + [OFSY,COMMA,COLON]);      
          LOAD; GENLABEL(LCIX); GENUJPENT(57(*UJP*),LCIX);
          LSP := GATTR.TYPTR;         
          IF LSP <> NIL THEN          
            IF (LSP^.FORM <> SCALAR) OR (LSP = REALPTR) THEN        
              BEGIN ERROR(144); LSP := NIL END;           
          IF SY = OFSY THEN INSYMBOL ELSE ERROR(8);       
          FSTPTR := NIL; GENLABEL(LADDR);       
          REPEAT  
            LPT3 := NIL; GENLABEL(LCIX1);       
            REPEAT CONSTANT(FSYS + [COMMA,COLON],LSP1,LVAL);        
              IF LSP <> NIL THEN      
                IF COMPTYPES(LSP,LSP1) THEN     
                  BEGIN LPT1 := FSTPTR; LPT2 := NIL;      
                    WHILE LPT1 <> NIL DO        
                      WITH LPT1^ DO   
                        BEGIN         
                          IF CSLAB <= LVAL.IVAL THEN      
                            BEGIN IF CSLAB = LVAL.IVAL THEN ERROR(156);       
                              GOTO 1  
                            END;      
                          LPT2 := LPT1; LPT1 := NEXT      
                        END;          
        1:          NEW(LPT3);        
                    WITH LPT3^ DO     
                      BEGIN NEXT := LPT1; CSLAB := LVAL.IVAL;       
                        CSSTART := LCIX1        
                      END;  
                    IF LPT2 = NIL THEN FSTPTR := LPT3     
                    ELSE LPT2^.NEXT := LPT3     
                  END       
                ELSE ERROR(147);      
              TEST := SY <> COMMA;    
              IF NOT TEST THEN INSYMBOL         
            UNTIL TEST;     
            IF SY = COLON THEN INSYMBOL ELSE ERROR(5);    
            PUTLABEL(LCIX1);
            REPEAT STATEMENT(FSYS + [SEMICOLON])          
            UNTIL NOT (SY IN STATBEGSYS);       
            IF LPT3 <> NIL THEN       
              GENUJPENT(57(*UJP*),LADDR);       
            TEST := SY <> SEMICOLON;  
            IF NOT TEST THEN INSYMBOL 
          UNTIL TEST;       
          PUTLABEL(LCIX);   
          IF FSTPTR <> NIL THEN       
            BEGIN LMAX := FSTPTR^.CSLAB;        
              (*REVERSE POINTERS*)    
              LPT1 := FSTPTR; FSTPTR := NIL;    
              REPEAT LPT2 := LPT1^.NEXT; LPT1^.NEXT := FSTPTR;      
                FSTPTR := LPT1; LPT1 := LPT2    
              UNTIL LPT1 = NIL;       
              LMIN := FSTPTR^.CSLAB;  
              IF LMAX - LMIN < CIXMAX THEN      
                BEGIN IF LC+INTSIZE > LCMAX THEN LCMAX := LC + INTSIZE;       
                  GEN2(56(*STR*),0,LC); GEN2(54(*LOD*),0,LC);       
                  GEN2(51(*LDC*),1,LMIN); GEN2(48(*GEQ*),ORD('I'),0);         
                  GENUJPENT(33(*FJP*),LADDR); GEN2(54(*LOD*),0,LC); 
                  GEN2(51(*LDC*),1,LMAX); GEN2(52(*LEQI*),ORD('I'),0);        
                  GENUJPENT(33(*FJP*),LADDR); GEN2(54(*LOD*),0,LC); 
                  GEN2(51(*LDC*),1,LMIN); GEN0(21(*SBI*)); GENLABEL(LCIX);    
                  GENUJPENT(44(*XJP*),LCIX); PUTLABEL(LCIX);        
                  REPEAT    
                    WITH FSTPTR^ DO   
                      BEGIN           
                        WHILE CSLAB > LMIN DO   
                          BEGIN GENUJPENT(57(*UJP*),LADDR); LMIN:=LMIN+1 END; 
                        GENUJPENT(57(*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); GENUJPENT(57(*UJP*),LADDR); PUTLABEL(LCIX)         
        END (*WHILESTATEMENT*) ;      
        
        PROCEDURE FORSTATEMENT;       
          VAR LATTR: ATTR; {LSP: STP;}  LSY: SYMBOL;        
              LCIX, LADDR: INTEGER;   
        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; 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; GEN2(56(*STR*),0,LC);     
                      GENLABEL(LADDR); PUTLABEL(LADDR);   
                      GATTR := LATTR; LOAD; GEN2(54(*LOD*),0,LC);   
                      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(LCIX); GENUJPENT(33(*FJP*),LCIX);      
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);      
          STATEMENT(FSYS);  
          GATTR := LATTR; LOAD;       
          IF LSY = TOSY THEN GEN1(34(*INC*),1) ELSE GEN1(31(*DEC*),1);        
          STORE(LATTR); GENUJPENT(57(*UJP*),LADDR); PUTLABEL(LCIX); 
          LC := LC - INTSIZE
        END (*FORSTATEMENT*) ;        
        
        
        PROCEDURE WITHSTATEMENT;      
          VAR LCP: CTP; LCNT1,LCNT2: DISPRANGE; 
        BEGIN LCNT1 := 0; LCNT2 := 0;           
          REPEAT  
            IF SY = IDENT THEN        
              BEGIN SEARCHID([VARS,FIELD],LCP); INSYMBOL END        
            ELSE BEGIN ERROR(2); LCP := UVARPTR END;      
            SELECTOR(FSYS + [COMMA,DOSY],LCP);  
            IF GATTR.TYPTR <> NIL THEN          
              IF GATTR.TYPTR^.FORM = RECORDS THEN         
                IF TOP < DISPLIMIT THEN         
                  BEGIN TOP := TOP + 1; LCNT1 := LCNT1 + 1;         
                    WITH DISPLAY[TOP] DO        
                      BEGIN FNAME := GATTR.TYPTR^.FSTFLD; 
                        FLABEL := NIL 
                      END;  
                    IF GATTR.ACCESS = DRCT THEN           
                      WITH DISPLAY[TOP] DO      
                        BEGIN OCCUR := CREC; CLEV := GATTR.VLEVEL;  
                          CDSPL := GATTR.DPLMT  
                        END           
                    ELSE    
                      BEGIN LOADADDRESS; GEN2(56(*STR*),0,LC);      
                        WITH DISPLAY[TOP] DO    
                          BEGIN OCCUR := VREC; VDSPL := LC END;     
                        LC := LC + PTRSIZE; LCNT2 := LCNT2 + PTRSIZE;         
                        IF LC > LCMAX THEN LCMAX := LC    
                      END   
                  END       
                ELSE ERROR(250)       
              ELSE ERROR(140);        
            TEST := SY <> COMMA;      
            IF NOT TEST THEN INSYMBOL 
          UNTIL TEST;       
          IF SY = DOSY THEN INSYMBOL ELSE ERROR(54);      
          STATEMENT(FSYS);  
          TOP := TOP - LCNT1; LC := LC - LCNT2;           
        END (*WITHSTATEMENT*) ;       
        
      BEGIN (*STATEMENT*)   
        IF SY = INTCONST THEN (*LABEL*)         
          BEGIN LLP := DISPLAY[TOP].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 ENTNAME := FPROCP^.PFNAME     
      ELSE GENLABEL(ENTNAME);         
      CSTPTRIX := 0;        
      PUTLABEL(ENTNAME); GENLABEL(SEGSIZE);     
      GENUJPENT(32(*ENT*),SEGSIZE);   
      IF FPROCP <> NIL THEN (*COPY MULTIPLE VALUES INTO LOACAL CELLS*)        
        BEGIN LLC1 := LCAFTERMARKSTACK;         
          LCP := FPROCP^.NEXT;        
          WHILE LCP <> NIL DO         
            WITH LCP^ DO    
              BEGIN         
                IF KLASS = VARS THEN  
                  IF IDTYPE <> NIL THEN         
                    IF (VKIND = ACTUAL) AND (IDTYPE^.SIZE > PTRSIZE) THEN     
                      BEGIN           
                        GEN2(50(*LDA*),0,VADDR);          
                        GEN2(54(*LOD*),0,LLC1);           
                        GEN1(40(*MOV*),IDTYPE^.SIZE);     
                        LLC1 := LLC1 + PTRSIZE  
                      END   
                    ELSE LLC1 := LLC1 + IDTYPE^.SIZE;     
                LCP := LCP^.NEXT;     
              END;          
        END;      
      LCMAX := LC;          
      REPEAT      
        REPEAT STATEMENT(FSYS + [SEMICOLON,ENDSY])        
        UNTIL NOT (SY IN STATBEGSYS);           
        TEST := SY <> SEMICOLON;      
        IF NOT TEST THEN INSYMBOL     
      UNTIL TEST; 
      IF SY = ENDSY THEN 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 ERROR(168);       
                WRITELN(OUTPUT); WRITELN(OUTPUT,' LABEL ',LABVAL);  
                WRITE(OUTPUT,' ':CHCNT+16)       
              END;          
            LLP := NEXTLAB  
          END;    
      IF FPROCP <> NIL THEN           
        BEGIN     
          IF FPROCP^.IDTYPE = NIL THEN GEN1(42(*RET*),ORD('P'))     
          ELSE    
            WITH FPROCP^ DO 
              IF IDTYPE = REALPTR THEN GEN1(42(*RET*),ORD('R'))     
              ELSE IF IDTYPE = BOOLPTR THEN GEN1(42(*RET*),ORD('B'))
                   ELSE IF IDTYPE^.FORM = POINTER THEN    
                          GEN1(42(*RET*),ORD('A'))        
                        ELSE IF (IDTYPE = CHARPTR)        
                                OR ((IDTYPE^.FORM = SUBRANGE)       
                                    AND (IDTYPE^.RANGETYPE = CHARPTR)) THEN   
                               GEN1(42(*RET*),ORD('C'))   
                             ELSE GEN1(42(*RET*),ORD('I'));         
          IF PRCODE THEN WRITELN(PRR,'L',SEGSIZE:4,'=',LCMAX)       
        END       
      ELSE        
        BEGIN GEN1(42(*RET*),ORD('P')); LCMAX := LCMAX - 1;         
          IF PRCODE THEN WRITELN(PRR,'L',SEGSIZE:4,'=',LCMAX);      
          IF PRCODE THEN    
            BEGIN  WRITELN(PRR) (*SIMULATES EOR*) END;    
          IC := 0;
          (*GENERATE CALL OF MAIN PROGRAM; NOTE THAT THIS CALL MUST BE LOADED 
           AT ABSOLUTE ADDRESS ZERO*) 
          GEN1(41(*MST*),0); GENCUP(0,ENTNAME); GEN0(29(*STP*));    
          IF PRCODE THEN    
            BEGIN  WRITELN(PRR) (*SIMULATES EOR*) END;    
          SAVEID := ID;     
          WHILE FEXTFILEP <> NIL DO   
            BEGIN 
              WITH FEXTFILEP^ DO      
                IF NOT ((FILENAME = 'INPUT   ') OR (FILENAME = 'OUTPUT  ') OR 
                        (FILENAME = 'PRD     ') OR (FILENAME = 'PRR     '))   
                THEN BEGIN ID := FILENAME;      
                       SEARCHID([VARS],LLCP);   
                       IF LLCP <> NIL THEN      
                         IF LLCP^.IDTYPE^.FORM <> FILES THEN        
                           LLCP := NIL;         
                       IF LLCP = NIL THEN       
                         BEGIN WRITELN(OUTPUT); 
                           WRITELN(OUTPUT,' ':8,'UNDECLARED ','EXTERNAL FILE',
                                     FEXTFILEP^.FILENAME:8);        
                           WRITE(OUTPUT,' ':CHCNT+16)     
                         END
                     END;   
                FEXTFILEP := FEXTFILEP^.NEXTFILE
            END;  
          ID := SAVEID;     
          IF LIST THEN      
            WRITELN(OUTPUT);
          IF PRTABLES THEN PRINTTABLES(TRUE)    
        END;      
    END (*BODY*) ;          
        
  BEGIN (*BLOCK*)           
    DP := TRUE;   
    REPEAT        
      IF SY = LABELSY THEN  
        BEGIN INSYMBOL; LABELDECLARATION END;   
      IF SY = CONSTSY THEN  
        BEGIN INSYMBOL; CONSTDECLARATION END;   
      IF SY = TYPESY THEN   
        BEGIN INSYMBOL; TYPEDECLARATION END;    
      IF SY = VARSY THEN    
        BEGIN INSYMBOL; VARDECLARATION END;     
      WHILE SY IN [PROCSY,FUNCSY] DO  
        BEGIN LSY := SY; INSYMBOL; PROCDECLARATION(LSY) END;        
      IF SY <> BEGINSY THEN           
        BEGIN ERROR(18); SKIP(FSYS) END         
    UNTIL SY IN STATBEGSYS;           
    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);    
  END (*BLOCK*) ;           
        
  PROCEDURE PROGRAMME(FSYS:SETOFSYS); 
    VAR EXTFP:EXTFILEP;     
  BEGIN 
    IF SY = PROGSY THEN     
      BEGIN INSYMBOL; IF SY <> IDENT THEN ERROR(2); INSYMBOL;       
        IF NOT (SY IN [LPARENT,SEMICOLON]) THEN ERROR(14);
        IF SY = LPARENT  THEN         
          BEGIN   
            REPEAT INSYMBOL;
              IF SY = IDENT THEN      
                BEGIN NEW(EXTFP);     
                  WITH EXTFP^ DO      
                    BEGIN FILENAME := ID; NEXTFILE := FEXTFILEP 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       
  END (*PROGRAMME*) ;       
        
        
  PROCEDURE STDNAMES;       
  BEGIN           
    NA[ 1] := 'FALSE   '; NA[ 2] := 'TRUE    '; NA[ 3] := 'INPUT   ';         
    NA[ 4] := 'OUTPUT  '; NA[ 5] := 'GET     '; NA[ 6] := 'PUT     ';         
    NA[ 7] := 'RESET   '; NA[ 8] := 'REWRITE '; NA[ 9] := 'READ    ';         
    NA[10] := 'WRITE   '; NA[11] := 'PACK    '; NA[12] := 'UNPACK  ';         
    NA[13] := 'NEW     '; NA[14] := 'RELEASE '; NA[15] := 'READLN  ';         
    NA[16] := 'WRITELN ';   
    NA[17] := 'ABS     '; NA[18] := 'SQR     '; NA[19] := 'TRUNC   ';         
    NA[20] := 'ODD     '; NA[21] := 'ORD     '; NA[22] := 'CHR     ';         
    NA[23] := 'PRED    '; NA[24] := 'SUCC    '; NA[25] := 'EOF     ';         
    NA[26] := 'EOLN    ';   
    NA[27] := 'SIN     '; NA[28] := 'COS     '; NA[29] := 'EXP     ';         
    NA[30] := 'SQRT    '; NA[31] := 'LN      '; NA[32] := 'ARCTAN  ';         
    NA[33] := 'PRD     '; NA[34] := 'PRR     '; NA[35] := 'MARK    ';         
  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 := REALSIZE; FORM := SCALAR; SCALKIND := STANDARD END;       
    NEW(CHARPTR,SCALAR,STANDARD);                             (*CHAR*)        
    WITH CHARPTR^ DO        
      BEGIN SIZE := CHARSIZE; FORM := SCALAR; SCALKIND := STANDARD END;       
    NEW(BOOLPTR,SCALAR,DECLARED);                             (*BOOLEAN*)     
    WITH BOOLPTR^ DO        
      BEGIN SIZE := BOOLSIZE; FORM := SCALAR; SCALKIND := DECLARED END;       
    NEW(NILPTR,POINTER);                                      (*NIL*)         
    WITH NILPTR^ DO         
      BEGIN ELTYPE := NIL; SIZE := PTRSIZE; FORM := POINTER END;    
    NEW(TEXTPTR,FILES);                                       (*TEXT*)        
    WITH TEXTPTR^ DO        
      BEGIN FILTYPE := CHARPTR; SIZE := CHARSIZE; FORM := FILES END 
  END (*ENTERSTDTYPES*) ;   
        
  PROCEDURE ENTSTDNAMES;    
    VAR CP,CP1: CTP; I: INTEGER;      
  BEGIN                                                       (*NAME:*)       
                                                              (*******)       
        
    NEW(CP,TYPES);                                            (*INTEGER*)     
    WITH CP^ DO   
      BEGIN NAME := 'INTEGER '; IDTYPE := INTPTR; KLASS := TYPES END;         
    ENTERID(CP);  
    NEW(CP,TYPES);                                            (*REAL*)        
    WITH CP^ DO   
      BEGIN NAME := 'REAL    '; IDTYPE := REALPTR; KLASS := TYPES END;        
    ENTERID(CP);  
    NEW(CP,TYPES);                                            (*CHAR*)        
    WITH CP^ DO   
      BEGIN NAME := 'CHAR    '; IDTYPE := CHARPTR; KLASS := TYPES END;        
    ENTERID(CP);  
    NEW(CP,TYPES);                                            (*BOOLEAN*)     
    WITH CP^ DO   
      BEGIN NAME := 'BOOLEAN '; IDTYPE := BOOLPTR; KLASS := TYPES END;        
    ENTERID(CP);  
    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 := 3 TO 4 DO      
      BEGIN NEW(CP,VARS);                                     (*INPUT,OUTPUT*)          
        WITH CP^ DO         
          BEGIN NAME := NA[I]; IDTYPE := TEXTPTR; KLASS := VARS;    
            VKIND := ACTUAL; NEXT := NIL; VLEV := 1;      
            VADDR := LCAFTERMARKSTACK + (I-3)*CHARSIZE
          END;    
        ENTERID(CP)         
      END;        
    FOR I:=33 TO 34 DO
      BEGIN NEW(CP,VARS);                                     (*PRD,PRR FILES*)         
         WITH CP^ DO        
           BEGIN NAME := NA[I]; IDTYPE := TEXTPTR; KLASS := VARS;   
              VKIND := ACTUAL; NEXT := NIL; VLEV := 1;    
              VADDR := LCAFTERMARKSTACK + (I-31)*CHARSIZE 
           END;   
         ENTERID(CP)        
      END;        
    FOR I := 5 TO 16 DO     
      BEGIN NEW(CP,PROC,STANDARD);                         (*GET,PUT,RESET*)  
        WITH CP^ DO                                           (*REWRITE,READ*)          
          BEGIN NAME := NA[I]; IDTYPE := NIL;                 (*WRITE,PACK*)  
            NEXT := NIL; KEY := I - 4;                        (*UNPACK,PACK*)           
            KLASS := PROC; PFDECKIND := STANDARD
          END;    
        ENTERID(CP)         
      END;        
    NEW(CP,PROC,STANDARD);  
    WITH CP^ DO   
        BEGIN NAME:=NA[35]; IDTYPE:=NIL;        
              NEXT:= NIL; KEY:=13;    
              KLASS:=PROC; PFDECKIND:= STANDARD 
        END; ENTERID(CP);   
    FOR I := 17 TO 26 DO    
      BEGIN NEW(CP,FUNC,STANDARD);                         (*ABS,SQR,TRUNC*)  
        WITH CP^ DO                                           (*ODD,ORD,CHR*)           
          BEGIN NAME := NA[I]; IDTYPE := NIL;              (*PRED,SUCC,EOF*)  
            NEXT := NIL; KEY := I - 16;         
            KLASS := FUNC; PFDECKIND := STANDARD
          END;    
        ENTERID(CP)         
      END;        
    NEW(CP,VARS);                      (*PARAMETER OF PREDECLARED FUNCTIONS*) 
    WITH CP^ DO   
      BEGIN NAME := '        '; IDTYPE := REALPTR; KLASS := VARS;   
        VKIND := ACTUAL; NEXT := NIL; VLEV := 1; VADDR := 0         
      END;        
    FOR I := 27 TO 32 DO    
      BEGIN NEW(CP1,FUNC,DECLARED,ACTUAL);                    (*SIN,COS,EXP*)           
        WITH CP1^ DO                                       (*SQRT,LN,ARCTAN*) 
          BEGIN NAME := NA[I]; IDTYPE := REALPTR; NEXT := CP;       
            FORWDECL := FALSE; EXTERN := TRUE; PFLEV := 0; PFNAME := I - 12;  
            KLASS := FUNC; PFDECKIND := DECLARED; PFKIND := ACTUAL  
          END;    
        ENTERID(CP1)        
      END         
  END (*ENTSTDNAMES*) ;     
        
  PROCEDURE ENTERUNDECL;    
  BEGIN           
    NEW(UTYPPTR,TYPES);     
    WITH UTYPPTR^ DO        
      BEGIN NAME := '        '; IDTYPE := NIL; KLASS := TYPES END;  
    NEW(UCSTPTR,KONST);     
    WITH UCSTPTR^ DO        
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL;         
        VALUES.IVAL := 0; KLASS := KONST        
      END;        
    NEW(UVARPTR,VARS);      
    WITH UVARPTR^ DO        
      BEGIN NAME := '        '; IDTYPE := NIL; VKIND := ACTUAL;     
        NEXT := NIL; VLEV := 0; VADDR := 0; KLASS := VARS 
      END;        
    NEW(UFLDPTR,FIELD);     
    WITH UFLDPTR^ DO        
      BEGIN NAME := '        '; IDTYPE := NIL; NEXT := NIL; FLDADDR := 0;     
        KLASS := FIELD      
      END;        
    NEW(UPRCPTR,PROC,DECLARED,ACTUAL);          
    WITH UPRCPTR^ DO        
      BEGIN NAME := '        '; IDTYPE := NIL; FORWDECL := FALSE;   
        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 := '        '; 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;       
    { TURN OUTPUT CODE BACK ON. [SAM] }
    PRTABLES := FALSE; LIST := TRUE; PRCODE := TRUE {FALSE};     
    DP := TRUE; PRTERR := TRUE; ERRINX := 0;    
    INTLABEL := 0; KK := 8; FEXTFILEP := NIL;   
    LC := LCAFTERMARKSTACK + FILEBUFFER*CHARSIZE;         
    (* NOTE IN THE ABOVE RESERVATION OF BUFFER STORE FOR 2 TEXT FILES *)      
    IC := 3; EOL := TRUE; LINECOUNT := 0;       
    CH := ' '; CHCNT := 0;  
    GLOBTESTP := NIL;       
    MXINT10 := MAXINT DIV 10; DIGMAX := STRGLGTH - 1;     
        
  END (*INITSCALARS*) ;     
        
  PROCEDURE INITSETS;       
  BEGIN           
    CONSTBEGSYS := [ADDOP,INTCONST,REALCONST,STRINGCONST,IDENT];    
    SIMPTYPEBEGSYS := [LPARENT] + CONSTBEGSYS;  
    TYPEBEGSYS:=[ARROW,PACKEDSY,ARRAYSY,RECORDSY,SETSY,FILESY]+SIMPTYPEBEGSYS;
    TYPEDELS := [ARRAYSY,RECORDSY,SETSY,FILESY];          
    BLOCKBEGSYS := [LABELSY,CONSTSY,TYPESY,VARSY,PROCSY,FUNCSY,     
                    BEGINSY];         
    SELECTSYS := [ARROW,PERIOD,LBRACK];         
    FACBEGSYS := [INTCONST,REALCONST,STRINGCONST,IDENT,LPARENT,LBRACK,NOTSY];           
    STATBEGSYS := [BEGINSY,GOTOSY,IFSY,WHILESY,REPEATSY,FORSY,WITHSY,         
                   CASESY];           
  END (*INITSETS*) ;        
        
  PROCEDURE INITTABLES;     
    PROCEDURE RESWORDS;     
    BEGIN         
      RW[ 1] := 'IF      '; RW[ 2] := 'DO      '; RW[ 3] := 'OF      ';       
      RW[ 4] := 'TO      '; RW[ 5] := 'IN      '; RW[ 6] := 'OR      ';       
      RW[ 7] := 'END     '; RW[ 8] := 'FOR     '; RW[ 9] := 'VAR     ';       
      RW[10] := 'DIV     '; RW[11] := 'MOD     '; RW[12] := 'SET     ';       
      RW[13] := 'AND     '; RW[14] := 'NOT     '; RW[15] := 'THEN    ';       
      RW[16] := 'ELSE    '; RW[17] := 'WITH    '; RW[18] := 'GOTO    ';       
      RW[19] := 'CASE    '; RW[20] := 'TYPE    ';         
      RW[21] := 'FILE    '; RW[22] := 'BEGIN   ';         
      RW[23] := 'UNTIL   '; RW[24] := 'WHILE   '; RW[25] := 'ARRAY   ';       
      RW[26] := 'CONST   '; RW[27] := 'LABEL   ';         
      RW[28] := 'REPEAT  '; RW[29] := 'RECORD  '; RW[30] := 'DOWNTO  ';       
      RW[31] := 'PACKED  '; RW[32] := '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;       
    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['^'] := ARROW;    
      SSY['<'] := RELOP; SSY['>'] := RELOP;     
      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;       
    END (*RATORS*) ;        
        
    PROCEDURE PROCMNEMONICS;          
    BEGIN         
      SNA[ 1] :=' GET'; SNA[ 2] :=' PUT'; SNA[ 3] :=' RDI'; SNA[ 4] :=' RDR'; 
      SNA[ 5] :=' RDC'; SNA[ 6] :=' WRI'; SNA[ 7] :=' WRO'; SNA[ 8] :=' WRR'; 
      SNA[ 9] :=' WRC'; SNA[10] :=' WRS'; SNA[11] :=' PAK'; SNA[12] :=' NEW'; 
      SNA[13] :=' RST'; SNA[14] :=' ELN'; SNA[15] :=' SIN'; SNA[16] :=' COS'; 
      SNA[17] :=' EXP'; SNA[18] :=' SQT'; SNA[19] :=' LOG'; SNA[20] :=' ATN'; 
      SNA[21] :=' RLN'; SNA[22] :=' WLN'; SNA[23] :=' SAV';         
    END (*PROCMNEMONICS*) ;           
        
    PROCEDURE INSTRMNEMONICS;         
    BEGIN         
      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] :=' EOF'; 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] :=' SBR'; MN[23] :=' SGS';     
      MN[24] :=' SQI'; MN[25] :=' SQR'; MN[26] :=' STO'; MN[27] :=' TRC';     
      MN[28] :=' UNI'; MN[29] :=' STP'; MN[30] :=' CSP'; MN[31] :=' DEC';     
      MN[32] :=' ENT'; MN[33] :=' FJP'; MN[34] :=' INC'; MN[35] :=' IND';     
      MN[36] :=' IXA'; MN[37] :=' LAO'; MN[38] :=' LCA'; MN[39] :=' LDO';     
      MN[40] :=' MOV'; MN[41] :=' MST'; MN[42] :=' RET'; MN[43] :=' SRO';     
      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] :=' UJP';         
    END (*INSTRMNEMONICS*) ;          
        
  BEGIN (*INITTABLES*)      
    RESWORDS; SYMBOLS; RATORS;        
    INSTRMNEMONICS; PROCMNEMONICS;    
  END (*INITTABLES*) ;      
        
BEGIN   
  (*INITIALIZE*)  
  (************)  
  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; 
        
        
  (*COMPILE:*)    
  (**********)    
        
  REWRITE(PRR); (* REQUIRED FOR ISO 7185 [SAM] *)
  INSYMBOL;       
  PROGRAMME(BLOCKBEGSYS+STATBEGSYS-[CASESY]);   
        
END.    
