*DECK             PF12
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TSYMC5Q 
USETEXT   TCOM37Q 
USETEXT   TSTABLE 
USETEXT   TTARGET 
USETEXT   TCEXEC
USETEXT   TSYMC5
      PROC PF12;
      BEGIN 
#**********************************************************************#
#                                                                      #
#     PF12 - SYMPL SCAN 2 PRAGMATIC FUNCTIONS                          #
#                                                                      #
#**********************************************************************#
  
  
  
  
#     COMDECKS                                                         #
  
*CALL COMEX 
  
*CALL SPFSW2
  
  
  
  
#     XREFS                                                            #
  
XREF BEGIN
     PROC ABORT;
     PROC SYMABT;                                                        PF12 
     PROC CSAV; 
     PROC DEBUG;
     PROC DEFEXP; 
     PROC DUMP; 
     PROC DIAG;                                                          PF12 
     PROC DIAG0;                                                         PF12 
     PROC ENDSAV; 
     PROC FIND; 
     PROC FPLINK; 
     PROC GENCOP; 
     PROC GENLAB; 
     PROC GTSRC;                   # GETS A SOURCE LINE                #
     PROC HATCHK; 
     PROC HATEND; 
     PROC OPERND; 
     PROC OPRNDV; 
     PROC OSAV; 
     PROC PCONS;
     PROC PNAM; 
     PROC POPN; 
     PROC POPR; 
     PROC POST; 
     PROC POSTNN; 
     PROC POW;
      PROC  PTPST;
     PROC RESTR;                   # CODE, RESTORES A CODE BUFFER      #
     PROC SCPIN;
     PROC SCPOUT; 
     PROC SOVER;
     PROC SPOST;
     PROC SRCH; 
     PROC S$EMI;                   # PF1SUB, SEMICOLON PROCESSING      #
     PROC T$ERM;
     PROC VALID;
     PROC XCHAIN; 
     PROC XATT;                    # XRDEF, ENTER ATTRIBUTE IN CRF     #
     PROC XRATRB; 
     PROC XRDEF;
     PROC XRFCLS;                  # XRDEF, CLOSE CRF FILE             #
     PROC XRUSE;
     PROC XUSE; 
     ITEM GENTXTF;                 # GENTEXT ACTIVATOR (IN CONTROL)    #
  
     ITEM PREREAD      I;          # GTSRC, IF LT 0 GET BACK OLD CARD  #
     ITEM SPQR         I;          # DEFINED IN SPRECG                 #
     ITEM SYSTEMN;                 # SYSTEM NAME (IN CONTROL)          #
                                   #   2 = SCOPE 2                     #
                                   #   4 = NOS OR NOS/BE               #
     END
  
  
  
  
      STATUS QIDECT                # ITEM DECLARATION TYPE             #
             SIMPLE,
             XDEF,
             XREF,
             COMMON;
  
      STATUS QFDECT                # FUNCTION DECLARATION TYPE         #
             SIMPLE,
             XDEF,
             XREF,
             ALONE, 
             ENTRY; 
  
  
#     DEFS                                                             #
  
      DEF CSRF$ #CSRF[POZN] = CSRF[BLNK[POZN]];#; 
      DEF D005   #  5#;      #DIAGNOSTIC 005#                            DON/D
      DEF D010   # 10#;      #DIAGNOSTIC 010# 
      DEF D013   # 13#;      #DIAGNOSTIC 013#                            DON/D
      DEF D014   # 14#;      #DIAGNOSTIC 014#                            DON/D
      DEF D015   # 15#;      #DIAGNOSTIC 015#                            DON/D
      DEF D017   # 17#;      #DIAGNOSTIC 017#                            DON/D
      DEF D018   # 18#;      #DIAGNOSTIC 018#                            DON/D
      DEF D019   # 19#;      #DIAGNOSTIC 019#                            DON/D
      DEF D020   # 20#;      #DIAGNOSTIC 020#                            DON/D
      DEF D021   # 21#;      #DIAGNOSTIC 021#                            DON/D
      DEF D022   # 22#;      #DIAGNOSTIC 022#                            DON/D
      DEF D024   # 24#;      #DIAGNOSTIC 024#                            DON/D
      DEF D025   # 25#;      #DIAGNOSTIC 025#                            DON/D
      DEF D026   # 26#;      #DIAGNOSTIC 026#                            DON/D
      DEF D027   # 27#;      #DIAGNOSTIC 027#                            DON/D
      DEF D029   # 29#;      #DIAGNOSTIC 029#                            DON/D
      DEF D030   # 30#;      #DIAGNOSTIC 030#                            DON/D
      DEF D031   # 31#;      #DIAGNOSTIC 031#                            DON/D
      DEF D032   # 32#;      #DIAGNOSTIC 032#                            DON/D
      DEF D033   # 33#;      #DIAGNOSTIC 033#                            DON/D
      DEF D034   # 34#;      #DIAGNOSTIC 034#                            DON/D
      DEF D035   # 35#;      #DIAGNOSTIC 035#                            DON/D
      DEF D036   # 36#;      #DIAGNOSTIC 036#                            DON/D
      DEF D037   # 37#;      #DIAGNOSTIC 037#                            DON/D
      DEF D038   # 38#;      #DIAGNOSTIC 038#                            DON/D
      DEF D039   # 39#;      #DIAGNOSTIC 039#                            DON/D
      DEF D040   # 40#;      #DIAGNOSTIC 040#                            DON/D
      DEF D041   # 41#;      #DIAGNOSTIC 041#                            DON/D
      DEF D042   # 42#;      #DIAGNOSTIC 042#                            DON/D
      DEF D043   # 43#;      #DIAGNOSTIC 043#                            DON/D
      DEF D044   # 44#;      #DIAGNOSTIC 044#                            DON/D
      DEF D046   # 46#;      #DIAGNOSTIC 046#                            DON/D
      DEF D048   # 48#;      #DIAGNOSTIC 048#                            DON/D
      DEF D049   # 49#;      #DIAGNOSTIC 049#                            DON/D
      DEF D050   # 50#;      #DIAGNOSTIC 050#                            DON/D
      DEF D051   # 51#;      #DIAGNOSTIC 051#                            DON/D
      DEF D052   # 52#;      #DIAGNOSTIC 052#                            DON/D
      DEF D053   # 53#;      #DIAGNOSTIC 053#                            DON/D
      DEF D054   # 54#;      #DIAGNOSTIC 054#                            DON/D
      DEF D056   # 56#;      #DIAGNOSTIC 056#                            DON/D
      DEF D059   # 59#;      #DIAGNOSTIC 059#                            DON/D
      DEF D061   # 61#;      #DIAGNOSTIC 061#                            DON/D
      DEF D062   # 62#;      #DIAGNOSTIC 062#                            DON/D
      DEF D063   # 63#;      #DIAGNOSTIC 063#                            DON/D
      DEF D064   #064#;      #DIAGNOSTIC 064#                            PF12 
      DEF D065   # 65#;      #DIAGNOSTIC 065#                            DON/D
      DEF D066   #066#;      #DIAGNOSTIC 066#                            PF12 
      DEF D071   # 71#;      #DIAGNOSTIC 071#                            DON/D
      DEF D072   # 72#;      #DIAGNOSTIC 072#                            DON/D
      DEF D078   # 78#;      #DIAGNOSTIC 078#                            DON/D
      DEF D079   # 79#;      #DIAGNOSTIC 079#                            DON/D
      DEF D080   # 80#;      #DIAGNOSTIC 080#                            DON/D
      DEF D081   # 81#;      #DIAGNOSTIC 081#                            DON/D
      DEF D082   # 82#;      #DIAGNOSTIC 082#                            DON/D
      DEF D086   # 86#;      #DIAGNOSTIC 086#                            DON/D
      DEF D098   # 98#;      #DIAGNOSTIC 098#                            DON/D
      DEF D099   # 99#;      #DIAGNOSTIC 099#                            DON/D
      DEF D107   #107#;      #DIAGNOSTIC 107#                            DON/D
      DEF D109   #109#;      #DIAGNOSTIC 109#                            DON/D
      DEF D110   #110#;      #DIAGNOSTIC 110#                            DON/D
      DEF D113   #113#;      #DIAGNOSTIC 113#                            DON/D
      DEF D114   #114#;      #DIAGNOSTIC 114#                            DON/D
      DEF D115   #115#;      #DIAGNOSTIC 115#                            DON/D
      DEF D116   #116#;      #DIAGNOSTIC 116#                            DON/D
      DEF D117   #117#;      #DIAGNOSTIC 117#                            DON/D
      DEF D118   #118#;      #DIAGNOSTIC 118#                            DON/D
      DEF D119   #119#;      #DIAGNOSTIC 119#                            DON/D
      DEF D121   #121#;      #DIAGNOSTIC 121#                            DON/D
      DEF D122   #122#;      #DIAGNOSTIC 122#                            DON/D
      DEF D133   #133#;      #DIAGNOSTIC 133#                            DON/D
      DEF D135   #135#;      #DIAGNOSTIC 135#                            DON/D
      DEF D137   #137#;      #DIAGNOSTIC 137#                            DON/D
      DEF D139   #139#;      #DIAGNOSTIC 139#                            DON/D
      DEF D140   #140#;      #DIAGNOSTIC 140#                            DON/D
      DEF D141   #141#;      #DIAGNOSTIC 141#                            DON/D
      DEF D142   #142#;      #DIAGNOSTIC 142#                            DON/D
      DEF D144   #144#;      #DIAGNOSTIC 144#                            DON/D
      DEF D147   #147#;      #DIAGNOSTIC 147#                            DON/D
      DEF D149   #149#;      #DIAGNOSTIC 149#                            DON/D
      DEF D150   #150#;      #DIAGNOSTIC 150#                            DON/D
      DEF D151   #151#;      #DIAGNOSTIC 151#                            DON/D
      DEF D152   #152#;      #DIAGNOSTIC 152#                            DON/D
      DEF D153   #153#;      #DIAGNOSTIC 153#                            DON/D
      DEF D154   #154#;      #DIAGNOSTIC 154#                            DON/D
      DEF D155   #155#;      #DIAGNOSTIC 155#                            DON/D
      DEF D157   #157#;      #DIAGNOSTIC 157#                            DON/D
      DEF D159   #159#;      #DIAGNOSTIC 159#                            DON/D
      DEF D165   #165#;      #DIAGNOSTIC 165#                            DON/D
      DEF D169   #169#;      #DIAGNOSTIC 169#                            DON/D
      DEF D170   #170#;      #DIAGNOSTIC 170#                            DON/D
      DEF D171   #171#;      #DIAGNOSTIC 171#                            DON/D
      DEF D172   #172#;      #DIAGNOSTIC 172#                            DON/D
      DEF D174   #174#;      #DIAGNOSTIC 174#                            DON/D
      DEF D175   #175#;      #DIAGNOSTIC 175#                            DON/D
      DEF D178   #178#;      #DIAGNOSTIC 178#                            PF12 
      DEF D179   #179#;      #DIAGNOSTIC 179# 
      DEF D180   #180#;      #DIAGNOSTIC 180# 
      DEF D183   #183#;      #DIAGNOSTIC 183#                            PF12C
      DEF D184   #184#;      #DIAGNOSTIC 184#                            PF12C
      DEF D185   #185#;      #DIAGNOSTIC 185#                            PF12C
      DEF D186   #186#;      #DIAGNOSTIC 186#                            PF12C
      DEF D187   #187#;      #DIAGNOSTIC 187#                            PF12C
      DEF D188   #188#;      #DIAGNOSTIC 188#                            PF12C
      DEF D197   #197#;      #DIAGNOSTIC 197# 
      DEF D199   #199#;      #DIAGNOSTIC 199#                            PF12C
      DEF D201   #201#;      #DIAGNOSTIC 201#                            MIS
      DEF D202   #202#;      #DIAGNOSTIC 202#                            MIS
      DEF D203   #203#;      #DIAGNOSTIC 203#                            MIS
      DEF D204   #204#;      #DIAGNOSTIC 204#                            MIS
      DEF D205   #205#;      #DIAGNOSTIC 205#                            MIS
      DEF D206   #206#;      #DIAGNOSTIC 206#                            MIS
      DEF D207   #207#;      #DIAGNOSTIC 207#                            MIS
      DEF D208   #208#;      #DIAGNOSTIC 208#                            MIS
      DEF D209   #209#;      #DIAGNOSTIC 209#                            MIS
      DEF D210   #210#;      #DIAGNOSTIC 210#                            MIS
      DEF D211   #211#;      #DIAGNOSTIC 211#                            MIS
      DEF D212   #212#;      #DIAGNOSTIC 212#                            MIS
      DEF D213   #213#;      #DIAGNOSTIC 213#                            MIS
      DEF D214   #214#;      #DIAGNOSTIC 214#                            MIS
      DEF D215   #215#;      #DIAGNOSTIC 215#                            MIS
      DEF D216   #216#;      #DIAGNOSTIC 216#                            AIDD 
      DEF D224   #224#;      #DIAGNOSTIC 224# 
                                                                         MIS
                                                                         MIS
      DEF J819 #819#;        # SYMABT DIAGNOSTIC 819                   # PF12 
      DEF J820 #820#;        # SYMABT DIAGNOSTIC 820                   # PF12 
      DEF J821 #821#;        # SYMABT DIAGNOSTIC 821                   # PF12 
       DEF  PRSOUT  # PTPST($PRB$,PRBSIZ);  PRBSIZ=0 #    ; 
      DEF OPTIONC #B<59-"C">OPTION NQ 0#; 
  
#     LOCAL SIMPLE ITEMS                                               #
  
      ITEM AERFLG       I;         # ARRAY ERROR FLAG                  #
      ITEM AIBLVL       I;         # ARRAY ITEM PRESET PAREN COUNT     #
      ITEM AIPLVL       I;         # ARRAY ITEM PRESET BRACKET COUNT   #
      ITEM ARDBCT       I;         # BOUNDS CORR. CONST FOR 0 OFFSET   #
      ITEM ARDHBI       I;         # TEMP FOR HB                       #
      ITEM ARDHBS       I;         # TEMP FOR HB SIGN                  #
      ITEM ARDLBI       I;         # TEMP FOR LB                       #
      ITEM ARDLBS       I;         # TEMP FOR LB SIGN                  #
      ITEM ARRLOC       I;         # STP TO CLAS"TABL" OF CURR. ARRAY  #
      ITEM ATSPEC       S:QATTRIBUTE;  # ATTR FROM CONTROL STMT        #
      ITEM BFLAG        B;         # TRUE FOR BLANK COMMON DECL        #
      ITEM CBAERR       I;         # 1 IF ERROR IN COMMON BASED ARRAY  #
      ITEM COMLER       I;         # 1 IF LIST CRUD ALREADY DIAGNOSED  #
      ITEM BASERR       I;         # 1 IF ERROR IN BASED ARRAY DEC     #
      ITEM BASFLG       I;         # BASED ARRAY DECL FLAG             #
      ITEM CCOUNT       I;         # ARRAY ITEM PRESET PAREN NEST CNT  #
      ITEM COND         S:CND;     # TYPE OF CONTROL IF                #
      ITEM DEFLOC       I;         # SYMTAB PTR TO DEF ENTRY           #
      ITEM DMENS        I;         # NUM. DIMENSIONS FOR A. I. PRESET  #
      ITEM DFLTAISPEC   B;         # TRUE WHEN ARRAY ITEM DEFAULTED    #
      ITEM FDECTP       S:QFDECT;  # FUNCTION DEC TYPE                 #
      ITEM FIRSTAT      B;         # TRUE IF FIRST NAME OF ATTR SPEC   #
      ITEM FORMLTP      S:QFPRI;   # FORMAL TYPE                       #
      ITEM IDECTP       S:QIDECT;  # ITEM DECLARATION TYPE             #
      ITEM INSCPL       I;         # SAVE FOR SCOPE IN ENTRY DECS      #
      ITEM ITMLNG       I;         # WORD LENGTH OF ITEM FOR PRESETS   #
      ITEM ITMPSS       I;         # NEGATIVE IF SIGN OF PRESET MINUS  #
      ITEM LCNDT        S:QTYPE;   # TYPE OF CONTROL IF LEFT OPERAND   #
      ITEM LISTYP       I;         # 0 IF FUNC, 1 IF PROC              #
      ITEM LHCOND       I;         # STP TO CONTROL IF LEFT OPERAND    #
      ITEM NOCOMPS      B;         # TRUE IF IN COMMON AND NOT PRESET  #
      ITEM RHCOND       I;         # STP TO CONTROL IF RIGHT OPERAND   #
      ITEM PWINX        I;         # ARRAY ITEM SPEC INDEX INTO PWSPEC #
      ITEM STLLOC       I;         # SYMTAB PTR TO STATUS LIST         #
      ITEM STLVAL       I;         # VALUE OF STATUS CONS IN LIST DEC  #
      ITEM SWIGNL       I;         # PTR TO GENERATED LABEL ENTRY      #
      ITEM SWIHI        I;         # PTR TO HIGHEST SWITCH POINT       #
      ITEM SWILAB       I;         # SYMTAB PTR TO LABEL               #
      ITEM SWILOC       I;         # SYMTAB PTR TO SWITCH ENTRY        #
      ITEM SWITBUF      I = 0;     # POINTS TO SWITCH CODE BUFFER      #
      ITEM TEMPA1       I;         # GENERAL TEMP                      #
      ITEM TEMPA2       I;         # GENERAL TEMP                      #
      ITEM TYPA         I;         # TEMP IN EIGHTY-SIXING             #
      ITEM WAIPEF       I;         # ARRAY ITEM PRESET ERROR           #
      ITEM XARFLG       I;         # EXTERNAL DECL FLAG                #
      ITEM XDCERR       I;         # 1 IF ERROR IN EXTERNAL DECL       #
      ITEM XLBFLG       S:QXTRN;   # EXTERNALNESS OF LABELS, SWITCHES  #
  
#     LOCAL ARRAYS                                                     #
  
      ARRAY LVAL$ [0:100] P(1);    # PARENTHESIS LEVEL TABLE           #
        BEGIN 
        ITEM LVALUE       I (00,00,WL);  # REP FACTOR AT THIS LEVEL    #
        END 
  
      ARRAY WAI15$ [0:2] P(1);
        BEGIN 
        ITEM PWSPEC       I (00,00,WL);  # ARRAY ITEM SPEC VALUE       #
        END 
  
      ARRAY WAP$ [0:NDIMAX] P(2);  # ARRAY PRESET CONTROL TABLE        #
        BEGIN 
        ITEM EXTENT       I (00,00,WL);  # EXTENT OF DIMENSION         #
        ITEM NBRGRP       I (01,00,WL);  # REP FACTOR AT THIS LEVEL    #
        END 
      CONTROL EJECT;
  
      PROC POSTPAR (T); 
  
      BEGIN 
  
  
#----------------------------------------------------------------------#
#                                                                      #
#     P R O C   P O S T P A R                                          #
#                                                                      #
#     POST DEF PARAMETER NAME INTO THE SYMBOL TABLE.  DEF PARAMETER    #
#     NAMES ARE MANUFACTURED BY THE COMPILER AND CONFORM TO THE        #
#     SEQUENCE  AAAA?,AAAB?,.....,AABA?,AABB?,.....,9999?.             #
#                                                                      #
#     CALLS PNAM.                                                      #
#                                                                      #
#     OUTPUT PARAMETER                                                 #
#       T = SYMBOL TABLE INDEX OF NEW DEF PARAM S"NAME" ENTRY.         #
#                                                                      #
#----------------------------------------------------------------------#
  
  
  
      ITEM ITEMP I;                # TEMP                              #
      ITEM T     I;                # OUTPUT PARAMETER                  #
  
  
      PNAM (NADPN,L$DPN,T);        # POST NEXT AVAIL DEF PARAM NAME    #
  
      FOR ITEMP = 3 STEP -1        # INCREMENT NADPN                   #
        UNTIL 0 
      DO
        BEGIN 
        IF B<ITEMP*6,6>NADPN EQ CHNINE
        THEN
          BEGIN 
          B<ITEMP*6,6>NADPN = "A";
          END 
        ELSE
          BEGIN 
          B<ITEMP*6,6>NADPN = B<ITEMP*6,6>NADPN + 1;
          RETURN; 
          END 
        END 
  
  
      END 
      CONTROL EJECT;
  
      $BEGIN
      IF DMPFLG EQ 1               # *=0 DEBUG COMPILER OPTION         #
      THEN
        BEGIN 
        PRINTLABEL2;               # PRAGMATIC FUNCTION LABEL TRACE    #
        END 
      $END
  
      GOTO SWDF12 [DEFN - SWOF12];  # PRAGMATIC FUNCTIONS SWITCH       #
  
#----------------------------------------------------------------------#
#                           SCAN TWO                                   #
#                     PRAGMATIC FUNCTIONS                              #
#----------------------------------------------------------------------#
DFER:                                                                    PF12 
      SYMABT (J819, "NO PRAGMATIC FUNCTION (PF12)", 28);
  
WCOD45:   #    (COMDLT)==(NULL)    #
WXDC37:   #    (XDECLT)  ==   (NULL)         #
WBAS34:   #    BASDLT)==(NULL)          # 
WAI39:    #    (AIBAD)  == (NULL)       # 
WAD19:    #    (ABAD)   == (NULL)       # 
WPRG34:   #    (PDBODY) == (NULL)       # 
WBAD14:   #    (BAD)    == (NULL)       # 
WFNC49:   #    (FBAD)   == (NULL)       # 
WID14:    #    (IBAD)==(NULL) # 
          DIAG0(D005);                                                   PF12 
          T$ERM;
          PREREAD = 1;                                                   L414 
          GTSRC ;      # LIST LAST CARD  #                               L414 
          HATEND;                  # REORDER ILFAT                     #
          RETURN; 
  
#    NAME HANDLING  # 
WSLN:                                                                    DON/D
          DIAG(D013,CSRF[POZN]);                                         PF12 
          RETURN;                                                        DON/D
WCON:                                                                    DON/D
          DIAG(D014,CSRF[POZN]);                                         PF12 
          RETURN;                                                        DON/D
  
  
     #CONTROL STATEMENT PROCESSING# 
  
WCNT1:    #    RULE(CONTR2)     # 
          DCXFLG=1;      #DEFINING CONTEXT FLAG#
          SCXFLG=2;      #SHUTS OFF RESERVED WORD RECOGNITION#
          RETURN; 
  
WCNT2:    #(CONTR2)==(NULL)#
          ILKEY("CONTROL",7); #DIAGNOSE ILLEGAL APPEARANCE OF -CONTROL-#
  
WCNT3:    #    RULE(CONSHD)   # 
WCNT14:      #       (CONDAD)(SEMI2)  == (CDEC)   DOWN  # 
          DCXFLG=0;      #TURN OFF DECLARATIVE CONTEZT# 
          SCXFLG=0; 
          RETURN; 
  
SWITCH    WCNT4S:CNTRL        #SWITCH FOR WCNT4, ON CONTROL WORD# 
          WCN4FT:FTNCALL, 
          WCN4EJ:EJECT, 
          WCN4LI:LIST,
          WCN4NL:NOLIST,
          WCN4TR:TRACEBACK, 
          WCN4PA:PACK,
          WCN4PR:PRESET,
          WCN4OB:OBJLIST, 
          WCN4FI:FI,
          WCN4FI:ENDIF, 
          WCN4FS:FASTLOOP,
          WCN4SL:SLOWLOOP,
          WCN4ST:STEXT; 
  
  
WCNT7:             # TEST (CONSHD) (DECNAM)  ==  (CONDHD)              #
      ATSPEC = 0; 
      COND = 0; 
      TEMPA1 = NRCNTR - 1;
      TEMPA2 = CSRF [POZN]; 
  
      FOR TPYA = 0 STEP 1          # CHECK IF IT IS A CONTROL WORD     #
        UNTIL TEMPA1
      DO
        BEGIN 
        IF TEMPA2 EQ CNTLNK [TPYA]
        THEN
          BEGIN 
          GOTO WCNT4S [TPYA]; 
          END 
        END 
  
      FOR TPYA = 1 STEP 1          # CHECK IF IT IS A CONDITIONAL WORD #
        UNTIL CND"IFNQ" 
      DO
        BEGIN 
        IF CSRF [ POZN] EQ CNDLNK [TPYA]
        THEN
          BEGIN 
          COND = TPYA;             # NAME LINK OF THE CONDITIONAL WORD #
          RPLI = 1;                # PERFORM THE REPLACEMENT           #
          RETURN; 
          END 
        END 
  
      FOR TPYA = 1 STEP 1          # CHECK IF IT IS AN ATTRIBUTE WORD  #
        UNTIL QATTRIBUTE"LEV3"
      DO
        BEGIN 
        IF CSRF [POZN] EQ ATTRLNK [TPYA]
        THEN
          BEGIN 
          ATSPEC = TPYA;           # NAME LINK OF THE ATTRIBUTE WORD   #
          RETURN; 
          END 
        END 
  
  
WCNT5:                             # (CONSHD)==(NULL)                  #
      DIAG0 (D137);                # CONTROL STATEMENT SYNTAX ERROR    #
      RETURN; 
  
WCN4FT: 
      B<59 - "F">OPTION = 1;
      RETURN; 
  
WCN4EJ: 
      IF B<59 - "L">OPTION EQ 0 
      THEN
        BEGIN 
        RETURN; 
        END 
      IF NOLIST EQ 0
      THEN
        BEGIN 
        EJECTP; 
        END 
      RETURN; 
  
WCN4LI: 
      NOLIST = 0; 
      RETURN; 
  
WCN4NL: 
      IF B<59 - "H">OPTION EQ 1 
      THEN
        BEGIN 
        RETURN; 
        END 
      NOLIST = -1;
      RETURN; 
  
WCN4TR: 
      B<2>OPTION = 1; 
      RETURN; 
  
WCN4PA: 
      B<59 - "D">OPTION = 1;
      RETURN; 
  
WCN4PR: 
      B<59 - "P">OPTION = 1;
      COMPRS = TRUE;
      RETURN; 
  
WCN4OB: 
      B<59 - "O">OPTION = 1;
      RETURN; 
  
WCN4FI: 
      RETURN;                      # NO ACTION FOR FI OR ENDIF         #
  
WCN4FS: 
      FASTLOOP = TRUE;
      DIAG0 (D187); 
      RETURN; 
  
WCN4SL: 
      FASTLOOP = FALSE; 
      DIAG0 (D188); 
      RETURN; 
  
WCN4ST: 
      GENTXTF = 1;                 # SET GENTEXT ACTIVATOR (IN CONTROL)#
      B<59 - "N">OPTION = 1;       # TEXT GENERATION FORCES N OPTION   #
      RETURN; 
  
WCDH21:                      #MISSING SEMI AFTER CONDITONAL#             NEWFEAT
WCNT6:    #    (CONTST)==(NULL)    DOWN # 
          DIAG0(D026);             # MISSIMG SEMICOLON                 # PF12 
          RETURN; 
  
                 #CONDITIONAL COMPILATION DIRECTIVES#                    NEWFEAT
  
WCDH10:      #      (CONSHD)(DICON)  == (CONDHB) #                       NEWFEAT
WCDH11:      #      (CONSHD)(CONST)  == (CONDHB) #                       NEWFEAT
          LHCOND = CSRF[POZN];     # SYMBOL TABLE PTR TO LEFT OPERAND  #
          LCNDT  = TYPE[LHCOND];   # TYPE OF LEFT OPERAND              #
          RETURN;                                                        NEWFEAT
WCDH12:      #      (CONDHD)  == (BAD)  #                                NEWFEAT
WCDH32:      #      (CONDHC)  == (BAD)  #                                NEWFEAT
          DIAG0(D151);                                                   PF12 
          RETURN;                                                        NEWFEAT
WCDH30:      #      (CONDHC)(DICON)  == (CONDST) #                       NEWFEAT
WCDH31:      #      (CONDHC)(CONST)  == (CONDST) #                       NEWFEAT
          RHCOND = CSRF[POZN];     # SYMBOL TABLE PTR TO RIGHT OPERAND #
                         RETURN;                                         NEWFEAT
WCDH42:      #              (CONDST) == (CDEC)     #                     NEWFEAT
          DIAG0(D151);                                                   PF12 
          GOTO WCDH40;                                                   NEWFEAT
                                                                         NEWFEAT
WCDH20:      # TEST (CONDHB)(SEMI2)  == (CDEC) DOWN#
                     RHCOND = ZERO$  ;                                   NEWFEAT
                                                                         NEWFEAT
WCDH40:      # TEST (CONDST)(SEMI2)  == (CDEC) DOWN #                    NEWFEAT
          IF LCNDT NQ TYPE[RHCOND] THEN BEGIN                            NEWFEAT
          DIAG0(D149);                                                   PF12 
                                        RPLI = 1 ;                       NEWFEAT
                                        RETURN;                          NEWFEAT
                                        END                              NEWFEAT
                                  ELSE                                   NEWFEAT
          IF LCNDT EQ QTYPE"EBCD" THEN  BEGIN                            NEWFEAT
                        # CHARACTER STRING#                              NEWFEAT
                 IF COND NQ CND"IFEQ" AND COND NQ CND"IFNQ" THEN         NEWFEAT
          DIAG0(D150);                                                   PF12 
                                                            ELSE         NEWFEAT
                     IF LHCOND EQ RHCOND THEN TPYA =1;                   NEWFEAT
                                         ELSE TPYA =6;                   NEWFEAT
                                         END  #CHARACTERS#               NEWFEAT
                                  ELSE   BEGIN                           NEWFEAT
                        # INTEGER,REAL,BOOLEAN#                          NEWFEAT
                 FIND(LHCOND,TPYA);   LHCOND = CONS[TPYA];               NEWFEAT
                 FIND(RHCOND,TPYA);   RHCOND = CONS[TPYA];               NEWFEAT
                 IF LHCOND EQ RHCOND THEN         TPYA = 1 ;             NEWFEAT
                                     ELSE                                NEWFEAT
                     IF LHCOND LS RHCOND THEN     TPYA = 2 ;             NEWFEAT
                                         ELSE     TPYA = 4 ;             NEWFEAT
                                       # TPYA IS A BIT MASK #            NEWFEAT
                                         END                             NEWFEAT
         SETCNTL = FALSE ;                                               NEWFEAT
         AWAITSEMI = FALSE;                                              NEWFEAT
         CONDPTH = 0 ;                                                   NEWFEAT
          IF (COND LAN TPYA) NQ 0 THEN RPLI = 1; #REPLACE IF CONIT.TRUE# NEWFEAT
  
                SPQR =0;
          RETURN;                                                        NEWFEAT
WCDH41:     #   (CONDST)(SEMI2)   == (CONDSK) DOWN)   # 
         PGIX =10;     #SPRECG MODE FOR SKIPPING #
         RETURN;
#         ATTRIBUTE SPECIFICATION PROCESSING      # 
  
WCNT8:       #  TEST (CONSHD)(DECNAM) == (CONDAT) DOWN  # 
          IF ATSPEC EQ 0 THEN RETURN;   #WASNT AN ATTRIBUTE  #
          FIRSTAT = TRUE;               #MARK FIRST VARIABLE #
  
          DCXFLG =1;                    # COLLECT AS FOR DEFINITION  #
  
          RPLI = 1  ; 
  
          RETURN; 
  
WCNT15:      #       (CONDAD)(COMMA2) == (CONDAT) DOWN  # 
          DCXFLG = 1;        #DEFINING CONTEXT #
  
WCAT2:       #  RULE (CONDAT)                     # 
WCNT13:      #  RULE (CONDAD)                     # 
  
          FIRSTAT = FALSE;
          RETURN; 
  
  
WCNT12:      #       (CONDAT)(SEMI2)  == (CDEC)   DOWN  # 
  
          DCXFLG =0;     # CLEAR DECLARATIVE CONTEXT  # 
  
          IF NOT FIRSTAT THEN 
            BEGIN 
          DIAG0(D172);             # BAD LIST SPEC                     # PF12 
            RETURN; 
            END 
  
          IF ATSPEC GR S"INERT"  THEN 
            BEGIN 
          DIAG0(D174);                                                   PF12 
            RETURN; 
            END 
  
  
      SWITCH SWATT:QATTRIBUTE 
             WCABB: BADLYBEHAVED ,
             WCAWB: WELLBEHAVED  ,
             WCAIN: INERT        ,
             WCARE: REACTIVE     ;
  
  
      GOTO SWATT[ATSPEC] ;
  
WCABB:WELLB = FALSE ; 
      B<1>OPTION = 1;                                                    LARRY-H
      RETURN; 
  
WCAWB:WELLB = TRUE  ; 
      B<1>OPTION = 1;                                                    LARRY-H
      RETURN; 
  
WCAIN:INERT = TRUE  ; 
      B<1>OPTION = 1;                                                    LARRY-H
      RETURN; 
  
WCARE:INERT = FALSE  ;
      B<1>OPTION = 1;                                                    LARRY-H
      RETURN; 
  
  
WCNT9:    #          (CONDAT)(DECNAM) == (CONDAD) DOWN  # 
  
          # SET ATTRIBUTE IN ATSPEC INTO VARIABLE IN PVDF # 
  
          IF PVDF EQ 0 THEN 
            BEGIN 
                  #WE DONT KNOW OF THIS VARIABLE   #
          DIAG(D169,CSRF[POZN]);                                         DON/D
            RETURN; 
            END 
      SWITCH SWATT2: QATTRIBUTE 
             WC2BB: BADLYBEHAVED ,
             WC2WB: WELLBEHAVED , 
             WC2IN: INERT,
             WC2RE: REACTIVE ,
             WC2WE: WEAK ,
             WC2LV: LEV1 ,
             WC2LV: LEV2 ,
             WC2LV: LEV3
                        ; 
  
  
            CSRF[POZN] = PVDF;    # SET S.T. INDEX FOR X-REF     #
            XATT ( 0 ) ;     # MARK CROSS REF FILE   #
  
            GOTO SWATT2 [ATSPEC] ;
  
WC2BB:    WELB[PVDF] = FALSE ;           #OVERLAP # 
          GOTO WC2WBA;
  
WC2WB:    WELB[PVDF] = TRUE  ;           #DISJOINT #
WC2WBA: 
          IF CLAS[PVDF] NQ S"DATA"
          AND CLAS[PVDF] NQ S"TABL"  THEN 
          DIAG(D171,PVDF);                                               DON/D
          B<1>OPTION = 1;                #NOT UNBEHAVED#
          RETURN; 
  
WC2RE:    INRT[PVDF] = FALSE ;           #REACTIVE #
          GOTO  WC2INA ;
  
WC2IN:    INRT[PVDF] = TRUE  ;           #INERT  #
WC2INA:   IF CLAS[PVDF] NQ S"TABL"  THEN
          DIAG(D170,PVDF);                                               DON/D
          B<1>OPTION = 1;                #NOT UNBEHAVED#
            RETURN; 
  
  
  
  
#     PROCESSING FOR WEAK ATTRIBUTE                                    #
#     IF SYMBOL IS AN EXTERNAL (OR HAS PREVIOUSLY BEEN DECLARED WEAK)  #
#     SET XTRN FIELD- OTHERWISE DIAGNOSE                               #
#     NOTICE THAT XTRN OF A TITM BELONGING TO AN ARRAY WHICH HAS BEEN  #
#     DECLARED EXTERNAL = S"EXT".  THUS WE EXCLUDE TITMS SINCE IT IS   #
#     ILLEGAL TO DECLARE A TITM WEAK                                   #
  
WC2WE:  
      IF (XTRN[PVDF] EQ S"EXT" AND CLAS[PVDF] NQ S"TITM") OR
         XTRN[PVDF] EQ S"WEAK"  THEN
          XTRN[PVDF] = S"WEAK"; 
      ELSE
          DIAG(D178,PVDF);                                               PF12 
      RETURN; 
  
WC2LV:                                   #LEVEL  #
          IF CLAS[PVDF] NQ S"COMM" THEN 
            IF CLAS[PVDF] NQ S"TABL"
            AND TTYP[PVDF] NQ S"BASED" THEN 
           IF CLAS[PVDF] NQ S"TABL"                                      LARRY-R
           OR TTYP[PVDF] EQ S"BASED"                                     LARRY-R
           OR FPRI[PVDF] NQ S"NAMC"     THEN                             LARRY-R
             BEGIN                                                       LARRY-R
              # TRAP ALL BUT COMMON , FORMAL ARRAYS AND BASED ARRAYS  #  LARRY-R
          DIAG(D175,PVDF);                                               DON/D
             RETURN;                                                     LARRY-R
             END                                                         LARRY-R
                                                                         LARRY-R
              IF CLAS[PVDF] EQ S"TABL"                                   LARRY-R
              AND BABY[PVDF] EQ 0 THEN                                   LARRY-R
                POSTTITM ( PVDF );   # POST IT A BABY  #                 LARRY-R
              BEGIN                                                      LARRY-R
                IF SYSTEMN NQ 2                                          LARRY-R
                AND ATSPEC EQ QATTRIBUTE"LEV2"  THEN   # LEVEL 2 ON NOS# LARRY-R
                  ATSPEC = QATTRIBUTE"LEV1";                             LARRY-R
              TMP1 = BABY[PVDF];       # 1ST ITEM IN COMMON OR TITM   #  LARRY-R
              IF CLAS[PVDF] EQ S"COMM" THEN                              LARRY-R
                TMP1 = BABY[ASEQ[PVDF]];    # 1ST COMM ENTRY VIA SLC  #  LARRY-R
NEXTCITM:                                                                LARRY-R
              IF TMP1 NQ  0  THEN                                        LARRY-R
                BEGIN                                                    LARRY-R
                IF CLAS[TMP1] EQ S"TABL"                                 LARRY-R
                AND TTYP[TMP1] NQ S"BASED"    THEN                       LARRY-R
                  BEGIN                                                  LARRY-R
                  IF BABY[TMP1] EQ 0 THEN                                LARRY-R
                    POSTTITM (TMP1);                                     LARRY-R
                  TMP2 =  BABY[TMP1] ;                                   LARRY-R
NEXTSTITM:                                                               LARRY-R
                  IF TMP2 NQ 0  THEN                                     LARRY-R
                    BEGIN                                                LARRY-R
                    LEVL[TMP2] =  ATSPEC - QATTRIBUTE"LEV1";             LARRY-R
                    TMP2 = ASEQ[TMP2] ;                                  LARRY-R
                    GOTO  NEXTSTITM;                                     LARRY-R
                    END                                                  LARRY-R
                  END                                                    LARRY-R
                LEVL[TMP1] = ATSPEC - QATTRIBUTE"LEV1";                  LARRY-R
                TMP1 = ASEQ[TMP1] ;                                      LARRY-R
                GOTO  NEXTCITM;                                          LARRY-R
                END                                                      LARRY-R
              END                                                        LARRY-R
                                                                         LARRY-R
          PROC POSTTITM (I);                                             LARRY-R
           # LEVEL 2 VARS MUST HAVE AT LEAST ON BABY   #                 LARRY-R
            BEGIN                                                        LARRY-R
            ITEM I,J;                                                    LARRY-R
            POST ( NONAM , TITM$W , J);                                  LARRY-R
            CLAS[J] = S"TITM";                                           LARRY-R
            BABY[I] = J;                                                 LARRY-R
            MAMA[J] = I;                                                 LARRY-R
            END   # POSTTITM  #                                          LARRY-R
                                                                         LARRY-R
          RETURN; 
  
WCNT10:   #         (CONDAT)        ==  (BAD)         # 
WCNT11:   #         (CONDAD)        ==  (BAD)         # 
          DIAG0(D172);                                                   PF12 
          RETURN; 
  
  
#DECLARATIONS#
  
  
PROC LENGTH;
          BEGIN          #SETS ITEM LENGTH--FOR PRESET SECTION# 
          SWITCH    S:QTYPE 
                    L1:IGR,   #ONE WORD CONSTANTS#
                    L1:REAL,  #ONE WORD CONSTANTS#
                    L1:USI,   #ONE WORD CONSTANTS#
                    L1:STTS,  #ONE WORD CONSTANTS#
                    L1:BOOL,  #ONE WORD CONSTANTS#
                    LV:EBCD;       #VARIABLE LENGTH CONSTANTS#
          GOTO S[TYPE[ITMLOC]]; 
L1:       ITMLNG=1; 
          RETURN; 
LV:       ITMLNG=(NBYT[ITMLOC]+CMPR12-1)/CMPR12;  #WORD LEN#
          END 
WDEC10:   #    RULE(DEC) #
          IF AORU                  #IF THE STRUCT IS MACHINE-INDEP.    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            IF MISEP GR WENTMAX                                          MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              DIAG (D179, ARRLOC);      #ARRAY ENTRY-SIZE TOO LARGE    # MIS
              WENT [ARRLOC] = WENTMAX;  #SET IT TO MAXIMUM ALLOWABLE   # MIS
              END                                                        MIS
                                                                         MIS
            ELSE                                                         MIS
              BEGIN                                                      MIS
              IF MISFBIT NQ 0                                            MIS
                OR MISEP EQ 0                                            MIS
              THEN                                                       MIS
                BEGIN                                                    MIS
                WENT [ARRLOC] = MISEP + 1;                               MIS
                END                                                      MIS
                                                                         MIS
              ELSE                                                       MIS
                BEGIN                                                    MIS
                WENT [ARRLOC] = MISEP;                                   MIS
                END                                                      MIS
              END                                                        MIS
                                                                         MIS
            PCONS (WENT[ARRLOC],CMPR12,QTYPE"IGR");   #POST ENTRY-SIZE # MIS
            MCNS [ARRLOC] = CSRF [POZN];  #POINTS TO QCLAS"CONS" ENTRY # MIS
            END                           #FOR ARRAY ENTRY-SIZE        # MIS
                                                                         MIS
          PRSFLG=0; 
          CSRF$;      #PRESERVE STHEAD TYPE#
          RETURN; 
  
  
  
#         ILLEGAL APPEARANCE OF RESERVED WORD#
  
PROC ILKEY(STR,LEN);
     BEGIN
     ITEM STR,LEN,TLINK;                          #STR IS REALLY
                                                  CH+RS-BUT WHO KNOWS#
          PNAM(STR,LEN,TLINK);                    #FIND SYMO LOC# 
          DIAG(D017,TLINK);                                              DON/D
          GOTO ILNOUT;                            #RETURN TO ANALYZER#
     END
ILNOUT: 
      RETURN;                #RETURN TO ANALYSIS (FOR INNER PROCS)     #
  
WLOC4:    #    (LOC)     ==   (NULL)    # 
          ILKEY("LOC",3); 
WABS1:    #    (AFUNC)==(NULL)     #
          ILKEY("ABS",3); 
  
#    DUPLICATE DEFINITION CHECK--ENTERED ONLY FOR NAME USAGES 
          OF NON-FORMAL PARAMETER TYPES#
      DEF DUPCHK#IF PVDF NQ 0 AND SBEG[PVDF] EQ SCOPE THEN DIAG(D019,    DON/D
          PVDF)#; 
  
  
# FORMAL PARAMETER CHECKER# 
  
PROC PARCHK;
     BEGIN
          FPRI[DSEC]=S"NULL";                     #DEFAULT CASE#
          IF PVDF EQ 0 THEN RETURN;               #[O PRIOR DEC#
          IF SBEG[PVDF] NQ SCOPE THEN RETURN;     #EXTERIOR SCOPE#
          IF CLAS[PVDF] EQ S"FPAR" THEN 
               FPLINK(PVDF,DSEC); 
          ELSE DUPCHK;                            #DUPLICATE DEFN#
     END
  
  
#THE FOLLOWIND ENTRANCES ARE ALL TO SET DCXFLG# 
WPRG12:   #    (PRGM2)==(PDH)      #
WFLB31:   #    (LBDB)(COMMA2)==(LBDH)   # 
WFPD11:   #    (STHEAD)(FPRC2)==(STHEAD)(FPDH)    # 
WFNC10:   #    RULE(FUNC2)    # 
WFNC71:   #    (FPART)(COMMA2)==(FPARLH)     #
WPRD10:   #    RULE(PROC2)    # 
WPRD31:   #    (PDECTP)(SPAREN)==(FPARLH)    #
WID66:    #    (IDECSG)(COMMA2)==(IDECHD)         # 
WAD78:    #    (ARRDEC)(ITEM2)==(AIDHD)      #
WAI32:    #    (AIBODY)(COMMA2)==(AIDHD)          # 
WCOD11:   #    (STHEAD)(COMMO2)==(STHEAD)(COMDHD)      #
WSTD11:   #    (STHEAD)(STATU2)==(STHEAD)(SDECHD)      #
WDFD11:   #    (STHEAD)(DEF2)==(STHEAD)(DDECHD)        #
WSWD91:   #   (SWITDB)(COMMA2)  == (SWITDH) DOWN #                       NEWFEAT
  
#ITEM DECLARATIONS# 
WID1:     #    RULE (ITEM2)   # 
          DCXFLG=1;                               #SET DECLARATIVE CNTXT
                                                  FLAG# 
          RETURN; 
  
WID2:     #    (STHEAD)(ITEM2)==(STHEAD)(IDECHD)  # 
          IDECTP=S"SIMPLE";                       #THIS DEC NOT IN LIST#
          RETURN; 
  
WID4:     #    (XDECLH)(ITEM2)==(XDECLH)(IDECHD)  # 
          IF CSRF[BLNK[POZN]] EQ QXTRN"EXT" THEN
               IDECTP=S"XREF";
          ELSE                                    #XDEF#
               IDECTP=S"XDEF";
          RETURN; 
  
WID5:     #    (COMDLH)(ITEM2)==(COMDLH)(IDECHD)  # 
          IDECTP=S"COMMON"; 
          RETURN; 
  
WDFD51:      #           (DPARLH) == (BAD)  #                            NEWFEAT
WDFD62:      #           (DPART)  == (BAD)  #                            NEWFEAT
          DIAG(D159,0);                                                  DON/D
          RETURN;                                                        NEWFEAT
WID6:     #    (ITEM2)==(NULL)     #
          ILKEY("ITEM",4);
  
  
WID13:    #    (IBAD)(ANY)==(IBAD) #
WAD18:    #    (ABAD)(ANY)==(ABAD) #
WAI38:    #    (AIBAD)(ANY)==(AIBAD)    # 
WBAD13:   #    (BAD)(ANY)==(BAD)   #
WFNC48:   #    (FBAD)(ANY)==(FBAD)      # 
          # THIS TEMPORARY ROUTINE IS NECESSARY TO CIRCUMVENT A SHORT-
            COMING OF GENESIS.  WHEN SCAN TWO WANTS TO COLLECT TO ITS 
            RIGHT, IT IS IN DANGER OF SUCKING IN A COMMENT-STARTING 
            QUOTE MARK, WITH DISASTROUS RESULTS, IF SUCH  A MARK IS 
           ENCOUTERED IMMEDIATELY FOLOOWING A RESERVED WORD WHICH 
            CAUSED AN "UP" FROM SCAN ONE.  #
          IF CSNR[POZN] EQ CLIST"QUOTE" THEN PGIX=3;
          RETURN; 
  
# FOR WID100,101,11,12--SEE WAI351,352,36,37 RESPECTIVELY#
  
SWITCH WID21S:QIDECT     WID21L:SIMPLE, 
                         WID21D:XDEF, 
                         WID21R:XREF, 
                         WID21C:COMMON; 
WID21:    #    (IDECHD)(DECNAM)==(IDECPT)    #
          AIRFLG=0;                               #ERROR COUNT# 
          PRSFLG=1;  #PREPARE FOR CONSTANT# 
          ITMTYP=S"IGR";        #DEFAULT TYPE#
          TLD1=CSRF[POZN];  POW(TLD1,DATWDS,QCLAS"DATA",CLIST"ITMNAM"); 
          WELB[DSEC]  = WELLB;     #GIVE CURRENT GLOBAL VALUE OF BADLY/ 
                                    WELL BEHAVIOR                      #
          XRDEF(DSEC,CRNO[POZN]); 
          GOTO WID21S[IDECTP];
WID21L:   PARCHK;                  #LOCAL ITEMS#
          XTRN[DSEC]=S"LOC";
WID21Z:   ASEQ[LENT[DPLC]]=DSEC;
          LENT[DPLC]=DSEC;                   #ADD TO DATA CHAIN#
          GOTO WID21A;
WID21R:   DUPCHK;             #EXTERNS# 
          XTRN[DSEC]=S"EXT";
          XCHAIN(DSEC);            #PUT IN XTRN CHAIN#
          GOTO WID21A;
WID21D:   DUPCHK;        #ENTRIES#
          XTRN[DSEC]=S"ENT";
          GOTO WID21Z;
WID21C:   DUPCHK;        #COMMON ITEMS# 
          XTRN[DSEC]=S"COMMON"; 
          IF BABY[COMLOC] EQ 0     THEN BABY[COMLOC]=DSEC;
                                   ELSE ASEQ[LENT[COMLOC]]=DSEC;
          LENT[COMLOC]=DSEC;            #ADD INTO COMMON CHAIN# 
WID21A: 
          ITMLOC=DSEC;                            #SAVE THROUGHOUT DEC# 
          DESFLG=1;                               #TYPE LETTER EXPECTED#
          RETURN; 
  
WID22:    #    (IDECHD)==(IBAD)    #
          DIAG0(D020);             # ITEM DEC NAME ERROR               # PF12 
          RETURN; 
  
SWITCH WID26S:QTYPE WID26X:IGR, 
                    WID26X:REAL,
                    WID26X:BOOL,
                    WID26X:USI, 
                    WID26Y:STTS,
                    WID26Y:EBCD;
  
  
WFNC26:   #    TEST(FHSEG)(DESCR)==(FHD)     #
WID26:    #    TEST (IDECPT)(DESCR)==(IDECD)      # 
          ITMTYP=CSRF[POZN];
          GOTO WID26S[ITMTYP];
WID26X:   #SUCCESS--FOR ALL TYPES BUT STATUS ANC CHARACTER# 
          RPLI=1; 
WID26Y:   RETURN; 
  
  
WAI7:     #    TEST(AIDTOP)(DESCR)==(AIDS)        # 
WFNC27:   #    TEST(FHSEG)(DESCR)==(FHDS)    #
WID27:    #    TEST(IDECPT)(DESCR)==(IDECS)       # 
          IF ITMTYP EQ QTYPE"STTS" THEN RPLI=1; 
          RETURN; 
  
WFNC28:   #    TEST(FHSEG)(DESCR)==(FHDC)    #
WID28:    #    TEST(IDECPT)(DESCR)==(IDECC)       # 
          RPLI=1; 
          IF ITMTYP EQ QTYPE"EBCD" THEN RETURN; 
          SYMABT(J820,"C-TYPE ITEM ERR(PF12)",21);                       PF12 
  
WAI8:     #    (AIDTOP)==(ADDD)         # 
WFNC29:   #    (FHSEG)==(FHD) # 
WID29:    #    (IDECPT)==(IDECD)        # 
          ITMTYP=QTYPE"IGR";                      #DEFAULT TYPE#
          DESFLG=0;                               #RESET FLAG#
          RETURN; 
  
WFNC31:   #    (FHDS)(COLON)(STLNAM)==(FHD)  #
WAI11:    #    (AIDS)(COLON)(STLNAM)==(AIDD) #
WID36:    #    (IDECS)(COLON)(STLNAM)==(IDECD)         #
          SLLK[ITMLOC]=CSRF[POZN];                #STATUS LIST POINTER# 
          XUSE(0);
          RETURN; 
  
WID39:    #    (IDECC)(LPARE2)==(IDECCL)    # 
          PRSFLG=0; 
          RETURN; 
  
WID37:    #    (IDECS)==(IBAD)     #
WID42:    #    (IDECCL)==(IBAD)         # 
          DIAG(D022,ITMLOC); #TYPE ERR-ASSUME I#                         DON/D
          TYPE[ITMLOC]=S"IGR";
          RETURN; 
  
WFNC35:   #    (FHDC)==(FHD)  # 
WID40:    #    (IDECC)==(IDECD)    #
          DIAG(D121,ITMLOC);                                             DON/D
          NBYT[ITMLOC] = 1;        # SET DEFAULT LENGTH AS PROMISED    #
          RETURN; 
  
WID41:    #   (IDECCL)  (DICON)   (RPARE2)  ==   (IDECD)               #
          PRSFLG = 1;              # PREPARE FOR CONSTANT              #
  
WFNC36:   #  (FDDCL)   (DICON)   (RPARE2)  ==   (FHD)                  #
          TLD1 = CSRF[BLNK[POZN]]; # PTR TO CONS ENTRY                 #
          FIND( TLD1, TPYA);       # GET VALUE                         #
          TLD1 = CONS[TPYA];       # ASSUME LENGTH SPECIFICATION IS OK #
          IF  TLD1 LQ 0 
          THEN
            BEGIN 
            DIAG(D121, ITMLOC); 
            TLD1 = 1;              # SET DEFAULT CHAR LENGTH FOR BAD   #
            END 
          ELSE
            BEGIN 
            IF  TLD1 GR CHRLEN
            THEN
              BEGIN 
              DIAG(D144, ITMLOC);  # CHAR LENGTH GR THAN MAX           #
              TLD1 = CHRLEN;
              END 
            END 
          NBYT[ITMLOC] = TLD1;     # STORE CHAR LENGTH                 #
          RETURN; 
  
  
SWITCH ITYPE:QTYPE  WID45I:IGR, 
                    WID45U:USI, 
                    WID45R:REAL,
                    WID45B:BOOL,
                    WID45C:EBCD,
                    WID45S:STTS;
WFNC40:   #    RULE(FHD) #
WID45:    #     RULE (IDECD)       #
          TYPE[ITMLOC]=ITMTYP;
          GOTO ITYPE[ITMTYP]; 
WID45I:                                           #INTEGER TYPE#
          SIGN[ITMLOC]=TRUE;
          NBIT[ITMLOC]=IGRLEN;
          RETURN; 
WID45R:                                           #REAL TYPE# 
          SIGN[ITMLOC]=TRUE;
          NBIT[ITMLOC]=RELLEN;
          RETURN; 
WID45B:                                           #TYPE BOOLEAN#
WID45S:                                           #STATUS#
WID45U:                                           #UNSIGNED INTEGER#
          SIGN[ITMLOC]=FALSE; 
          NBIT[ITMLOC]=IGRLEN;
          RETURN; 
WID45C:                                           #TYPE CHAR# 
          SIGN[ITMLOC]=FALSE; 
          RETURN; 
  
SWITCH    WID50S:   QIDECT
                    WID50O:SIMPLE,
                    WID50O:XDEF,
                    WID50X:XREF,
                    WID50C:COMMON;
  
WID50:    #    RULE(IDECPH)        #
          ITMPSS=1;                               #DEFAULT PLUS SIGN# 
          ITMVPI=1;           #VALID PRESET FLAG# 
          IF FPRI[ITMLOC] NQ 0 THEN 
               BEGIN
          DIAG(D139,ITMLOC); #PARAMETER PRESET NO GOOD#                  DON/D
WID50Y:        ITMVPI=0;      #UNVALIDATE PRESET# 
WID50O:        RETURN;
               END
          GOTO WID50S[IDECTP];     #SPLIT BY TYPE#
WID50X:   #XREF ITEMS#
          DIAG(D140,ITMLOC); #ILLEGAL#                                   DON/D
          GOTO WID50Y;
WID50C:   #COMMON DECLARED ITEMS--OK UNLESS BLANK COMMON# 
          IF COMLOC EQ ASEQ[BLKCOM] THEN# BLANK COMMON# 
               BEGIN
          DIAG(D141,ITMLOC);                                             DON/D
               GOTO WID50Y; 
               END
          RETURN; 
  
WID51:    #    (IDECPH)(SIGN)==(SIDECP)      #
          IF SIGN[ITMLOC] THEN
               #SIGN IS LEGITIMATE HERE#
               BEGIN
               IF CSRF[POZN] EQ 1 THEN ITMPSS=-1; #OTHERWISE LEAVE +  # 
               END
          ELSE DIAG(D024,ITMLOC);  #SIGN NG--IGNORED#                    DON/D
          RETURN; 
  
WID56:    #    (SIDECP)(DICON)==(IDECSG)     #
WID57:    #    (SIDECP)(CONST)==(IDECSG)     #
               IF ITMVPI EQ 0 THEN RETURN;
      IF XTRN[ITMLOC] EQ S"COMMON" AND NOT COMPRS THEN RETURN;
               LENGTH;        #FIND ITEM LENGTH IN WORDS# 
               PETY[0]=S"SIMPLE";       #PROTOCOL--IS ALWAYS 0# 
               PELN[0]=ITMLOC;          #ITEM LIND# 
               IF ITMPSS LS 0 THEN PCCON[0]=-PCCON[0];
               FOR TLD1=1 STEP 1 UNTIL ITMLNG DO
                    PEWD[TLD1]=PCCON[TLD1-1];          #MOVE CONST# 
               PRBSIZ=ITMLNG+1;    #INCLUDE CONS AND CONTROL WD#
               PRSOUT;        #FLUSH BUFFER#
               SIND[ITMLOC]=TRUE;       #PRESET FLAG# 
               RETURN;
  
WID65:    #    RULE(IDECSG)   # 
WID65C:   RETURN; 
  
  
#   FOR WID66--SEE WID1  #
  
WID68:    #    (IDECSG)==(DEC)     #
          DIAG0(D026);             # MISSING SEMICOLON                 # PF12 
          RETURN; 
  
WID59:    #    (SIDECP)==(IBAD)         # 
          DIAG(D027,ITMLOC); #PRESET ERROR#                              DON/D
          RETURN; 
  
  
#   ARRAY DECLARATIONS   #
  
WAD1:     #    RULE (ARRAY2)  # 
          DCXFLG=1;                               #SET DECLARE CONTXT#
          BASFLG=0;                               #INITIALIZE#
          AORU = FALSE;            #DEFAULT IS MACHINE-DEPENDENT STRUCT# MIS
          XARFLG=QXTRN"LOC";
          RETURN; 
  
WAD3:     #    (XDECLH)(ARRAY2)==(XDECLH)(ADECHD)      #
          XARFLG=CSRF[BLNK[POZN]];
          RETURN; 
  
WAD4:     #    (COMDLH)(ARRAY2)(==(COMDLH)(ADECHD)     #
          XARFLG=QXTRN"COMMON"; 
          RETURN; 
  
WAD5:     #    (BASDLH)(ARRAY2)==(BASDLH)(ADECHD)      #
          BASFLG=1; 
          RETURN; 
  
WAD6:     #    (ARRAY2)==(NULL)         # 
          ILKEY("ARRAY",5); 
  
WAD10:    #    RULE (ADECHD)       #
          DCXFLG=0;                               #IN CASE NO NAME# 
          DESFLG=2;                               #IN CASE NO BOUNDS# 
          AERFLG=0; 
          ARAYPS=0;      #PRESET FLAG#
          RETURN; 
  
SWITCH    WAD11S:QXTRN   WAD11L:LOC,
                         WAD11D:ENT,
                         WAD11R:EXT,
                         WAD11C:COMMON; 
  
WAD11:    #    (ADECHD)(DECNAM)==(ADTOP)          # 
          TLD1=CSRF[POZN];  POST(TLD1,ARRWDS,DSEC); 
          WELB[DSEC]  = WELLB;     #GIVE CURRENT GLOBAL VALUE OF BADLY/ 
                                    WELL BEHAVIOR                      #
          INRT[DSEC]  = INERT;     # SIM. FOR INERT/REACTIVE           #
          XRDEF(DSEC,CRNO[POZN]); 
WAD11A: 
          IF BASFLG EQ 0 THEN 
               BEGIN                         #ORDINARY ARRAYS    #
               CSTR[DSEC]=S"ARRNAM";         #(ARRNAM)           #
               TTYP[DSEC]=S"SYMD";           #TYPE=SYMPL,DEFINED STRUCT#
               END
          ELSE BEGIN                         #BASED ARRAYS# 
               CSTR[DSEC]=S"BARNAM";         #(BARNAM)# 
               TTYP[DSEC]=S"BASED";          #THIS TTYP CAUSES ALLOCTR# 
               END                           #TO CREATE POINTER VAR#
          SBEG[DSEC]=SCOPE; 
          CLAS[DSEC]=S"TABL"; 
          XTRN[DSEC]=XARFLG;
          ARRLOC=DSEC;
          TENT[DSEC]=1; 
          WENT[DSEC]=1; 
          IF  NAUPWD NQ 1 
          THEN
            BEGIN 
            MCNS[DSEC] = NAUP$;    # NUMBER ADDRESSING UNITS PER WORD  #
            END 
  
          NDIM[DSEC]=1; 
          PORS[DSEC]=FALSE;                  #PARALLEL# 
          GOTO WAD11S[XTRN[DSEC]];
WAD11L:   PARCHK; 
          IF FPRI[DSEC] EQ S"VALU" THEN DIAG(D153,TLD1);                 DON/D
WAD11Z:   ASEQ[LENT[DPLC]]=DSEC;             #ADD TO DATA CHAIN#
          LENT[DPLC]=DSEC;
          RETURN; 
WAD11R:   DUPCHK; 
          XCHAIN(DSEC);            #ADD TO EXTERN CHAIN#
          RETURN; 
WAD11D:   DUPCHK; 
          GOTO WAD11Z;        #ADD TO LOCAL CHAIN#
WAD11C:   IF BABY[COMLOC] EQ 0     THEN BABY[COMLOC]=DSEC;
                                   ELSE ASEQ[LENT[COMLOC]]=DSEC;
          LENT[COMLOC]=DSEC;
          DUPCHK;        #DUPLICATE DEFINITION CHECK# 
          RETURN; 
  
WAD12:    #    (ADECHD)==(ADTOP)--NO NAME    #
          POSTNN(ARRWDS,DSEC);
          PVDF=0; 
          IF BASFLG NQ 0 AND XARFLG EQ QXTRN"LOC" THEN GOTO WAD12A ;     NEWFEAT
          IF XARFLG EQ QXTRN"LOC" THEN GOTO WAD11A; 
          IF XARFLG EQ QXTRN"COMMON" THEN GOTO WAD11A;
WAD12A:                                           #THIS TYPE SHOULD HAVE
                                                  HAD A NAME# 
          DIAG0(D029);                                                   PF12 
          GOTO WAD11A;
  
  
WAD15:    #    RULE (ABAD)         #
          IF AERFLG EQ 0 THEN 
               BEGIN
               AERFLG=1;
          DIAG(D133,ARRLOC);                                             DON/D
               END
          RETURN; 
  
#WAD19--SEE OXC6--ABNORMAL END# 
  
WAD36:    #    (ADTOP)(LSQUAR)==(ADBLHD)          # 
          DESFLG=0;                               #THERE ARE BOUNDS#
          NDIM[ARRLOC]=0;                         #ERASE DEFAULT 1# 
          ARDBCT=0;       #CLEAR OFFSET CORRECTION CONSTANT#
          RETURN; 
  
WAD37:    #    (ADTOP)==(ADBND)    NO BOUNDS #
          DESFLG=0; 
          POSTNN(BPRWDS,TPYA);
          CLAS[TPYA]=S"BPAR"; 
          SBSC[ARRLOC]=TPYA;
          DDEL[TPYA]=1;          #DEFAULT--ONE ENTRY# 
          RETURN; 
  
WAD40:    #    RULE (ADBLHD)   READY FOR SIGN       # 
          ARDLBS=1;                               #DEFAULT PLUS#
          ARDHBS=1;                               #DEFAULT PLUS#
          ARDLBI=0;                               #DEFAULT 0 LB#
          RETURN; 
  
WAD41:    #    (ADBLHD)(SIGN)==(SABLH)       #
          IF CSRF[POZN] NQ 0 THEN ARDLBS=-1;      #SIGN WAS MINUS#
          RETURN; 
  
WAD46:    #    (SABLH)(DICON)(COLON)(SIGN)(DICON)==(BP)          #
          ARDLBI=CSRF[BLNK[BLNK[BLNK[POZN]]]];    #ISNT TH+T +BSURD#
          IF CSRF[BLNK[POZN]] NQ 0 THEN ARDHBS=-1;#NEG UPPER BOUND# 
          GOTO WAD48X;
  
WAD47:    #    (SABLH)(DICON)(COLON)(DECON)==(BP)      #
          ARDLBI=CSRF[BLNK[BLNK[POZN]]];          #ALMOST AS BAD# 
          GOTO WAD48X;
WAD48:    #    (SABLH)(DICON)==(BP)          #    #DEFAULT LOW BOUND# 
          ARDHBS=ARDLBS;
          ARDLBS=0; 
WAD48X: 
          ARDHBI=CSRF[POZN];
          IF ARDLBI NQ 0 THEN 
               BEGIN
               FIND(ARDLBI,TPYA); 
               ARDLBI=INAM[TPYA]*ARDLBS;
               END
          FIND(ARDHBI,TPYA);
          ARDHBI=INAM[TPYA]*ARDHBS; 
WAD48A:   TPYA=ARDHBI-ARDLBI+1; 
          IF TPYA LS 1 THEN 
               BEGIN
          DIAG(D032,ARRLOC); #BAD BOUND VALUES#                          DON/D
               ARDLBI=0;
               ARDHBI=0;
               GOTO WAD48A; 
               END
          TPYC=TENT[ARRLOC];                      #SAVE OLD SIZE# 
          TPYB=TPYC*TPYA; 
          IF TPYB GR TNTMAX THEN
          DIAG(D037,ARRLOC);                                             DON/D
          ELSE TENT[ARRLOC]=TPYB; 
          POSTNN(BPRWDS,TPYA);
          CLAS[TPYA]=S"BPAR"; 
          TPYB=SBSC[ARRLOC];                      #HEAD OF BP CHAIN#
          IF TPYB EQ 0 THEN SBSC[ARRLOC]=TPYA;
          ELSE BEGIN
WAD48B:        IF BPLK[TPYB] EQ 0 THEN BPLK[TPYB]=TPYA; 
               ELSE BEGIN 
                    TPYB=BPLK[TPYB];
                    GOTO WAD48B;
                    END 
               END
          DDEL[TPYA]=ARDHBI-ARDLBI+1;        #EXTENT OF THIS DIMENSION# 
          ARDBCT=ARDBCT+TPYC*ARDLBI;    #CORRECTION CONST FOR OFFSET# 
          PCONS(TPYC,CMPR12,QTYPE"IGR");
          DMPY[TPYA]=CSRF[POZN];
          LBND[TPYA] = ARDLBI ;   # SAVE LOWER BOUND  #                  JUNK 
              IF NDIM[ARRLOC] EQ 0 THEN DMPY[TPYA] = 0 ;  #FIRST DIM# 
  
#     DIAGNOSE DIMENSION TOO LARGE                                     #
  
      IF NDIM[ARRLOC] GQ NDMAX THEN 
          DIAG(D180,ARRLOC);
      ELSE
          NDIM[ARRLOC]=NDIM[ARRLOC]+1;
          RETURN; 
  
WAD499:   #    TEST(SABLH)(POSLB2)(COLO)==(SABLH) DOWN #
          #THIS TERRIBLE CASE ARISES WHEN A DEF NAME IS USED
          AS A LOW BOUND      # 
          IF PVDF EQ 0 THEN RETURN; 
          IF CLAS[PVDF] NQ S"DEF" THEN RETURN;
          RPLI=1; 
          TPYA=":"; 
          TPYB=PVDF;
          MACRO = FALSE;
         TPYC =12;
          DEFEXP; 
          RETURN; 
  
WAD49:    #    (SABLH)==(ABAD)     FORMAT ERROR   # 
WAD58:  
WAD47A: 
          DIAG(D033,ARRLOC);                                             DON/D
          RETURN; 
  
WAD57:    #    (BP)(RSQUAR)==(ADBND)         #
          IF ARDBCT NQ 0 THEN #NONZRO OFFSET CORRECTION#
               BEGIN
               PCONS(ARDBCT,CMPR12,QTYPE"IGR");#POST CONST# 
               BCOR[SBSC[ARRLOC]]=CSRF[POZN];     #POINT TO IT# 
               END
          DESFLG = 2;              #READY FOR LAYOUT LETTER (P,S,A,U)  # MIS
          RETURN; 
  
WAD60:    #    RULENADBND)         #
          DESFLG=0; 
          RETURN; 
  
WAD61:    #    (ADBND)(DESCR)==(LAYOUT)      #
          IF AORU                  #A OR U DESCRIPTOR LETTER           # MIS
            OR ( CSRF [POZN] EQ QTYPE"STTS" )  #S DESCRIPTOR LETTER    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            PORS[ARRLOC] = TRUE;   #THE ARRAY IS SERIAL                # MIS
            END                                                          MIS
                                                                         MIS
          RETURN; 
                                                                         MIS
                                                                         MIS
WAD63:    #    TEST (LAYOUT) (LPARE2)  ==  (ABAD)                      # MIS
          RPLI = 0;                #DEFAULT, DO NOT PERFORM REPLACEMENT# MIS
          IF AORU                  #IF THE STRUCTURE IS TYPE A OR U    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RPLI = 1;              #PERFORM REPLACEMENT                # MIS
            DIAG0 (D207);          #SPEC. OF ENTRY-SIZE ILL FOR A,U ARY# MIS
            AERFLG = 1;            #PREVENT SPURIOUS DIAGNOSTICS       # MIS
            BRKLEV = 0;            #RPAREN SUCKED UP IN RULE (ABAD)    # MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                  #IN EITHER CASE                     # MIS
  
WAD66:    #    (LAYOUL)(DICON)(RAPRE2)==(ADECSG)  # 
          TLD1=CSRF[BLNK[POZN]];
          FIND(TLD1,TPYA);
  
#     DIAGNOSE TOO LARGE ENTRY-SIZE                                    #
  
      IF INAM[TPYA] GR WENTMAX THEN 
          BEGIN 
          DIAG(D179,ARRLOC);
          WENT[ARRLOC] = WENTMAX; 
          END 
      ELSE
  
          WENT[ARRLOC]=INAM[TPYA];
          IF NOT PORS[ARRLOC] THEN RETURN; #DONE,FOR PARALLEL#
          #FOR SERIAL ARRAYS, COMPUTE MFAC# 
          IF WENT[ARRLOC]*NAUPWD EQ 1 THEN RETURN;
          PCONS(WENT[ARRLOC]*NAUPWD,CMPR12,QTYPE"IGR"); 
          MCNS[ARRLOC]=CSRF[POZN];
          RETURN; 
  
WAD67:    #    (LAYOUL)==(ABAD)    #
          DIAG(D122,ARRLOC);                                             DON/D
          RETURN; 
  
WAD79:    #    (ARRDEC)==(DEC)     #
WAD72:    #    (ADECSG)==(ABAD)         # 
          DIAG(D015,ARRLOC);                                             DON/D
          RETURN; 
  
  
#ARRAY ITEM DECLARATIONS #
  
#         FOR WAD78--SEE WID1      #
  
WAI1:     #    RULE(AIDHD)         #
          AIRFLG=0;                               #ERROR FLAG#
          FILLER = FALSE;          #DEFAULT IS NO FILLER ITEM          # MIS
          RETURN; 
  
WAI2:     #    (AIDHD)(DECNAM)==(AIDTOP)          # 
          PRSFLG=0;         # CLEAR "IN PRESET" FLAG# 
          POW(CSRF[POZN],SDTWDS,SUICLS,CLIST"AITNAM");#EITHER CLAS
                    DATA OR CLAS TITM--CLAS DATA ONLY FOR 360 VERSION#
          XRDEF(DSEC,CRNO[POZN]); 
          MAMA[DSEC]=ARRLOC;
          DUPCHK;                                 # UP DEF CHECK# 
          XTRN[DSEC]=XTRN[ARRLOC];
          ASEQ[DSEC]=BABY[ARRLOC];
          FPRI[DSEC]=FPRI[ARRLOC];
          BABY[ARRLOC]=DSEC;
          GOTO WID21A;                            #FIN LIKE SIMP ITM# 
                                                                         MIS
                                                                         MIS
WAI2A:    #    TEST (AIDHD)  ==  (AIDD)                                # MIS
          RPLI = 0;                #DEFAULT, DO NOT PERFORM REPLACEMENT# MIS
          IF AORU                  #IF THE STRUCTURE IS TYPE A OR U    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RPLI = 1;              #PERFORM REPLACEMENT                # MIS
            PRSFLG = 0;                                                  MIS
            FILLER = TRUE;         #FILLER ITEM SEEN                   # MIS
            DCXFLG = 0;            #WE WILL NEVER SEE AN ITEM NOW...   # MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                                                        MIS
  
WAI33:    #    (AIBODY)==(AIBAD)        # 
WAI3:     #    (AIDHD)==(AIBAD)         # 
          DIAG(D030,ARRLOC);                                             DON/D
          RETURN; 
  
WAI5:     #    RULE(AIDTOP)        #
          DESFLG=0;                               #RESET DESCR CONT#
          RETURN; 
  
WAI6:     #    TEST(AIDTOP)(DESCR)==(AIDD)        # 
          ITMTYP=CSRF[POZN];
          IF ITMTYP EQ QTYPE"EBCD" THEN RPLI=1; 
          GOTO WID26S[ITMTYP];
  
  
# FOR WAI27--SEE WID27   #
#  FOR WAI8--SEE WID20  # 
#    FOR WAI11---SEE WID36         #
  
  
WAI12:    #    (AIDS)==(AIBAD)          # 
          DIAG(D031,ITMLOC);                                             DON/D
          TYPE[ITMLOC]=S"IGR";
          RETURN; 
                                                                         MIS
                                                                         MIS
WAI14:    #    TEST (AIDD) (LPOINT)  ==  (AIDAU)                       # MIS
          RPLI = 0;                #DEFAULT, DO NOT PERFORM REPLACEMENT# MIS
          IF AORU                  #IF THE STRUCTURE IS TYPE A OR U    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RPLI = 1;              #PERFORM REPLACEMENT                # MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
WAI141:   #    TEST (AIDD)  ==  (AIBAD)                                # MIS
          RPLI = 0;                #DEFAULT, DO NOT PERFORM REPLACEMENT# MIS
          IF FILLER                #IF WE ARE PROCESSING A FILLER ITEM # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RPLI = 1;              #PERFORM REPLACEMENT                # MIS
            DIAG0 (D206);          #FILLER VALID ONLY IN OVERLAY DECS. # MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
WAI142:   #    (AIDD) (LPOINT)  ==  (AIBAD)                            # AIDD 
          DIAG0 (D216);            #LEFT PARENTHESIS EXPECTED          # AIDD 
          RETURN;                                                        AIDD 
                                                                         AIDD 
                                                                         AIDD 
  
WAI15:    #    RULE(AIDD)          #
SWITCH AITYPE:QTYPE WAI15I:IGR, 
                    WAI15R:REAL,
                    WAI15B:BOOL,
                    WAI15C:EBCD,
                    WAI15S:STTS,
                    WAI15U:USI; 
  
          IF FILLER                #IF WE ARE PROCESSING A FILLER ITEM # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RETURN;                #NO S.T. FIELDS FOR FILLERS         # MIS
            END                                                          MIS
                                                                         MIS
          TYPE[ITMLOC]=ITMTYP;
          GOTO AITYPE[ITMTYP];
  
WAI15I:                                           #INTEGER# 
          NBIT[ITMLOC]=IGRLEN;
WAI15X:   SIGN[ITMLOC]=TRUE;
          RETURN; 
WAI15R:                                           #REAL#
          NBIT[ITMLOC]=RELLEN;
          GOTO WAI15X;
WAI15B:                                           #BOOLEAN# 
          NBIT[ITMLOC]=1; 
WAI15Y:   SIGN[ITMLOC]=FALSE; 
          RETURN; 
WAI15C:                                           #CHARACTER# 
          NBYT[ITMLOC]=1; 
          GOTO WAI15Y;
WAI15S:                                           #STATUS#
WAI15U:                                           #UNSIGNED INTEGER#
          NBIT[ITMLOC]=IGRLEN;
          GOTO WAI15Y;
  
  
SWITCH AIFBIT:QTYPE WAI16I:IGR, 
                    WAI16R:REAL,
                    WAI16U:USI, 
                    WAI16B:BOOL,
                    WAI16C:EBCD,
                    WAI16S:STTS;
          #REAL AND DOUBLE MUST START ON A WORD#
WAI16D: 
WAI16R:   IF TPYA EQ 0 THEN GOTO WAI16X;
WAI16E:                                                                  DON/D
          DIAG(D035,ITMLOC); #ERROR#                                     DON/D
          GOTO WAI22A;
WAI16C:   #CHARACTERS MUST BE BYTE-ALIGNED# 
          IF TPYA-BYTSIZ*(TPYA/BYTSIZ) NQ 0 THEN GOTO WAI16E; 
          TPYB= 239*6 ;   # LAST BYTE POSN  # 
          GOTO WAI16Y;
WAI16U: 
WAI16I: 
WAI16B: 
WAI16S: 
          TPYB = 59;         # LAST VALID BIT POSN  # 
WAI16Y: 
          IF TPYA GR TPYB THEN
            GOTO WAI16E;
WAI16X:   FBIT[ITMLOC]=TPYA;
          GOTO WAI22A;
  
SWITCH AISIZE:QTYPE WAI21I:IGR, 
                    WAI21R:REAL,
                    WAI21C:EBCD,
                    WAI21B:BOOL,
                    WAI21S:STTS,
                    WAI21U:USI; 
          #I,R,B,S MUST BE WITHIN A WORD# 
          #ALSO U#
WAI21R:                                                                  MIS
          IF TPYA NQ RELLEN        #SIZE OF A REAL MUST BE ONE WORD    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            DIAG0 (D210);          #LENGTH(REAL ITEM) FORCED TO FULL WD# MIS
            NBIT [ITMLOC] = RELLEN;                                      MIS
            END 
                                                                         MIS
          IF AORU                  # IF STRUCTURE IS TYPE A OR U       #
          THEN
            BEGIN 
            RETURN; 
            END 
  
          IF FBIT [ITMLOC] NQ 0    # ONLY TEST FOR NON-MIS STRUCTURES  #
          THEN
            BEGIN 
            DIAG (D036,ITMLOC);    # ILL ARRAY ITEM BNDRY-DEFAULT TAKEN#
            FBIT [ITMLOC] = 0;     # REAL MUST START ON A WORD BOUNDARY#
            END 
  
          GOTO WAI22B;             # CHECK FOR CROSS OF WORD BOUNDARY  #
                                                                         MIS
WAI21U: 
WAI21I: 
WAI21B: 
WAI21S: 
          IF FBIT[ITMLOC]+TPYA LQ IGRLEN THEN GOTO WAI21X;   #OK# 
WAI21E:                                                                  DON/D
          DIAG(D036,ITMLOC);                                             DON/D
          FBIT[ITMLOC]=0; 
          NBIT[ITMLOC]=IGRLEN;
          GOTO WAI22B;             # AFTER FBIT IS BEING ASSIGNED,     #
                                   # CHECK FOR CROSS OF WORD BOUNDARY. #
WAI21X:   NBIT[ITMLOC]=TPYA;
          GOTO WAI22B;             # AFTER NBIT IS BEING ASSIGNED,     #
                                   # CHECK FOR CROSS OF WORD BOUNDARY. #
WAI21C:   #CHARACTER ITEMS CAN BE ANY LENGTH# 
               # OH NO THEY CANNT - 240 IS THE LIMIT   #
           IF TPYA GR CHRLEN THEN 
             BEGIN
             DIAG (D213, ITMLOC);  #ITEM LENGTH EXCEEDS MAX-DEFAULT TKN# MIS
             TPYA =1; 
             END
          NBYT[ITMLOC]=TPYA;
          GOTO WAI22B;             # AFTER NBYT IS BEING ASSIGNED,     #
                                   # CHECK FOR CROSS OF WORD BOUNDARY. #
  
WAI16:    #    TEST (AIDD) (LPARE2)  ==  (AIPWT)  DOWN                 # AIDD 
          RPLI = 0;                #DEFAULT, DO NOT PERFORM REPLACEMENT# AIDD 
          IF NOT AORU              #IF STRUCTURE IS NOT TYPE A OR U    # AIDD 
          THEN                                                           AIDD 
            BEGIN                                                        AIDD 
            PWINX = 0;                                                   AIDD 
            RPLI = 1;              #PERFORM REPLACEMENT                # AIDD 
            END                                                          AIDD 
                                                                         AIDD 
          RETURN;                                                        AIDD 
                                                                         AIDD 
                                                                         AIDD 
WAI162:   #    (AIDD) (LPARE2)  ==  (AIBAD)                            # AIDD 
          DIAG0 (D214);            #LEFT ANGLE BRACKET EXPECTED        # AIDD 
          RETURN;                                                        AIDD 
                                                                         AIDD 
                                                                         AIDD 
                                                                         MIS
WAI161:   #    (AIDD)  ==  (AIDSEG)                                    # MIS
          IF NOT AORU              #IF STRUCTURE IS NOT TYPE A OR U    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          PLUSOK = FALSE;          #A + TYPE DEC CANNOT FOLLOW THIS DEC# MIS
                                                                         MIS
          IF MISFBIT NQ 0                                                MIS
            AND ( ALOC EQ S"ALIGN"                                       MIS
              OR TYPE [ITMLOC] EQ S"REAL" )                              MIS
            OR MISFBIT EQ TWL                                            MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            MISEP = MISEP + 1;     #NEXT WORD TO ALLOCATE              # MIS
            MISFBIT = 0;           #NEXT BIT POSITION TO ALLOCATE      # MIS
            END                                                          MIS
                                                                         MIS
          ELSE                                                           MIS
            BEGIN                                                        MIS
            IF ALOC EQ S"UNALIGN"                                        MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              IF TYPE[ITMLOC] EQ S"EBCD"  #IF IT IS A CHARACTER ITEM   # MIS
              THEN                                                       MIS
                BEGIN                                                    MIS
                MISFBIT = ((MISFBIT + TCL - 1) / TCL) * TCL;  #MOD TCL # MIS
                                                                         MIS
                IF MISFBIT EQ TWL                                        MIS
                THEN                                                     MIS
                  BEGIN                                                  MIS
                  MISEP = MISEP + 1;   #NEXT WORD TO ALLOCATE          # MIS
                  MISFBIT = 0;         #NEXT BIT POSITION TO ALLOCATE  # MIS
                  END                                                    MIS
                END                                                      MIS
                                                                         MIS
              ELSE                 #IF IT IS A NON-CHARACTER ITEM      # MIS
                BEGIN                                                    MIS
                IF NBIT[ITMLOC] GR (TWL - MISFBIT)  #IF IT DOES NOT FIT# MIS
                THEN                                                     MIS
                  BEGIN                                                  MIS
                  MISEP = MISEP + 1;   #NEXT WORD TO ALLOCATE          # MIS
                  MISFBIT = 0;         #NEXT BIT POSITION TO ALLOCATE  # MIS
                  END                                                    MIS
                END                                                      MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          FBIT[ITMLOC] = MISFBIT;                                        MIS
          WDEN[ITMLOC] = MISEP;                                          MIS
                                                                         MIS
          IF TYPE[ITMLOC] EQ S"EBCD"  #IF IT IS A CHARACTER ITEM       # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            TPYC = MISFBIT + ( NBYT [ITMLOC] * TCL );                    MIS
            MISEP = MISEP + TPYC / TWL;                                  MIS
            MISFBIT = TPYC - ( TPYC / TWL ) * TWL;                       MIS
            END                                                          MIS
                                                                         MIS
          ELSE                     #IF IT IS A NON-CHARACTER ITEM      # MIS
            BEGIN                                                        MIS
            MISFBIT = MISFBIT + NBIT[ITMLOC];                            MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI18:    #    (AIPWT)==(AIPWTD)   --DEFAULT 0    # 
          PCONS(0,CMPR12,QTYPE"IGR"); 
          DFLTAISPEC = TRUE;       # ONE OR MORE SPECS DEFAULT         #
  
WAI17:    #    (AIPWT)(DICON)==(AIPWTD)                                #
          IF  PWINX LQ 2           # NOT TOO MANY SPECS                #
          THEN
            BEGIN 
            FIND( CSRF[POZN], TPYA );  # PTR TO CONSTANT IN TPYA       #
            PWSPEC[PWINX] = CONS[TPYA];  # STORE VALUE IN SPEC ARRAY   #
            IF  PWINX EQ 2         # CHECK THAT NBIT/NBYTE NOT ZERO    #
              AND  PWSPEC[PWINX] EQ 0 
              AND  NOT DFLTAISPEC 
            THEN
              BEGIN 
              DIAG(D034,ITMLOC);
              PWINX = 1;           # IGNORE IT AND LET SIZE DEFAULT    #
              END 
  
            DFLTAISPEC = FALSE; 
            END 
  
          ELSE
            BEGIN 
            IF  PWINX EQ 3         # TOO MANY ARRAY SPECS              #
            THEN
              BEGIN 
              DIAG(D098,ITMLOC);
              END 
            END 
  
          PWINX=PWINX+1;
          RETURN; 
  
WAI22:    #    (AIPWTD)(RPARE2)==(AIDSEG)    #
          IF PWINX NQ 0 THEN WDEN[ITMLOC]=PWSPEC[0];
          IF PWINX GR 1 THEN
               BEGIN
               TPYA=PWSPEC[1];                    #F BIT# 
               GOTO AIFBIT[ITMTYP]; 
               END
WAI22A: 
      IF PWINX GQ 3 
      THEN
        BEGIN 
        TPYA = PWSPEC[2]; 
        GOTO AISIZE[ITMTYP];       # NBYT OR NBIT WILL BE ASSIGNED.    #
        END 
WAI22B: 
  
#       THIS BLOCK WILL CHECK FOR ANY CROSS OF WORD BOUNDARY.          #
#       IF ARRAY ITEM IS CHARACTER, NUMBER OF BITS WILL BE COMPUTED    #
#       TO CHECK IF WORD SIZE PER ENTRY IS EXCEEDED.  OTHERWISE ONLY   #
#       THE WORD NUMBER OF THE ITEM IS CONSIDERED.                     #
  
  
         IF AORU                   # IF MIS, THEN RETURN.              #
         THEN 
           BEGIN
           RETURN;
           END
  
        IF ITMTYP EQ QTYPE"EBCD"
        THEN
          BEGIN 
          TPYB = (WDEN[ITMLOC]*TWL + FBIT[ITMLOC] + NBYT[ITMLOC]*TCL
            +(TWL-1))/TWL;
          END 
        ELSE
          BEGIN 
          TPYB = WDEN[ITMLOC] + 1; # WORD NUMBER STARTS AT 0.          #
          END 
  
        IF TPYB GR WENT[ARRLOC] 
        THEN
          BEGIN 
          DIAG(0199,ITMLOC);
          END 
        RETURN; 
  
WAI23:    #    (AIDP)==(AIBAD)          # 
          IF AORU                  #IF STRUCTURE IS TYPE A OR U        # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          DIAG(D034,ITMLOC);                                             DON/D
          RETURN; 
  
#ARRAY ITEM PRESET# 
  
                                                                         MIS
WAI251:   #    TEST (AIDSEG) (EQUALS)  ==  (AIBAD)                     # MIS
          RPLI = 0;                #DEFAULT, DO NOT PERFORM REPLACEMENT# MIS
          IF FILLER                #IF WE ARE PROCESSING A FILLER ITEM # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RPLI = 1;              #PERFORM REPLACEMENT                # MIS
            DIAG0 (D215);          #FILLER ITEMS CANNOT BE PRESET      # MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                                                        MIS
WAI26:    #    (AIDSEG)(EQUALS)==(AIPSET)         # 
                      #INITIALIZE PRESETS#
          SIND[ITMLOC]=TRUE;
          IF XTRN[ITMLOC]EQ S"COMMON"THEN SIND[ITMLOC]=COMPRS;
          PRSFLG=1; 
          AIPLVL=0;                               #BRACKET LEVEL# 
          WAIPEF=0;                               #MASTER ERR FLAG# 
          TPYA=SBSC[ARRLOC];
          DMENS=NDIM[ARRLOC]; 
          FOR TPYB=DMENS-1 STEP -1 UNTIL 0 DO     #INITIALIZE EXTENT
                                                  SO THAT THE SIZE OF 
                                                  THE KTH DIMENSION S IN
                                                  THE DMENS-KTH SLOT# 
               BEGIN
               EXTENT[TPYB]=DDEL[TPYA];      #SIZE OF THIS DIMENSION# 
               NBRGRP[TPYB]=0;
               TPYA=BPLK[TPYA]; 
               END
          IF ARAYPS EQ 0 THEN 
               BEGIN
          NOCOMPS=XTRN[ITMLOC] EQ S"COMMON" AND NOT COMPRS; 
               PELN[0]=ARRLOC;     #POINT TO ARRAY# 
               PRSNTR(QPETY"BEGIN");    #FIRST ENTRY THIS ARRAY#
               ARAYPS=1;      #FIRST TIME SWITCH# 
               END
          PELN[PRBSIZ]=ITMLOC;          #POINT TO ITEM# 
          PRSNTR(QPETY"ITEM");     #PUT OUT "ITEM" CONTROL WD#
          IF BASFLG NQ 0 THEN 
               BEGIN     #YOU CANT DO THAT TO BASED ARRAYS# 
          DIAG(D142,ITMLOC);                                             DON/D
               GOTO AIPIR;
               END
          IF FPRI[ARRLOC] NQ 0 THEN 
               BEGIN
          DIAG(D139,ITMLOC); #PRESETS OF PARS ARE NO GOOD#               DON/D
               GOTO AIPIR;
  
               SWITCH AIPISW:QXTRN      AIPO:LOC, 
                                   AIPX:EXT,
                                   AIPO:ENT,
                                   AIPC:COMMON; 
               END
          GOTO AIPISW[XTRN[ARRLOC]];
AIPX:     #XREF PRESETS ARE LIKEWISE FROWNED UPON#
          DIAG(D140,ITMLOC);                                             DON/D
          GOTO AIPIR; 
AIPC:     #COMMON PRESETS ARE OK UNLESS IT IS BLAN K COMMON#
          IF COMLOC NQ ASEQ[BLKCOM] THEN RETURN;
          # BLANK COMMON--ILLEGAL#
          DIAG(D141,ITMLOC);                                             DON/D
AIPIR:    SIND[ITMLOC]=FALSE;    #SPOIL PRESET# 
AIPO: 
          RETURN; 
  
#         FOR WAI32--SEE WID1      #
  
                                                                         MIS
                                                                         MIS
WAI801:   #    (AIDAU) (RPOINT)  ==  (AIDSEG)                          # MIS
          IF FILLER                #WE ARE PROCESSING A FILLER ITEM    # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            DIAG0 (D206);          #FILLER VALID ONLY IN OVERLAY DECS. # MIS
            END                                                          MIS
                                                                         MIS
          GOTO WAI161;             #UPDATE THE NECESSARY FIELDS        # MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI802:   #    (AIDAU) (DICON)  ==  (AIDAUD)                           # MIS
          FIND (CSRF[POZN], TPYA); #GET LOC(NUMBER OF BITS OR BYTES)   # MIS
          TPYA = INAM [TPYA];      #GET NUMBER OF BITS OR BYTES        # MIS
          SIZE$AU = TPYA;          #STORE IT FOR LATER USE             # MIS
          IF FILLER                #IF A FILLER ITEM IS BEING PROCESSED# MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          IF  TPYA EQ 0 
          THEN
            BEGIN 
            IF  TYPE[ITMLOC] EQ S"EBCD" 
              OR  TYPE[ITMLOC] EQ S"BOOL" 
            THEN
              BEGIN 
              SIZE$AU = 1;         # SET SIZE TO ONE BYTE OR BIT       #
              END 
  
            ELSE
              BEGIN 
              SIZE$AU = IGRLEN; 
              END 
  
            DIAG(D034,ITMLOC);
            END 
  
          IF OVLAY [TYPE [ITMLOC]] NQ S"BIT"                             MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            GOTO AISIZE [ITMTYP];  #SET NBIT FIELD                     # MIS
            END                                                          MIS
                                                                         MIS
          IF SIZE$AU GR IGRLEN                                           MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            DIAG0 (D213);          #ITEM LENGTH EXCEEDS MAX-DEFAULT TKN# MIS
            SIZE$AU = IGRLEN;                                            MIS
            END                                                          MIS
                                                                         MIS
          NBIT [ITMLOC] = SIZE$AU; #SET NBIT FOR QOVLAY"BIT" ITEMS     # MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI803:   #    (AIDAU) (RPARE2)  ==  (AIBAD)                           # MIS
          DIAG0 (D205);            #CLOSING ANGLE BRACKET EXPECTED     # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI804:   #    (AIDAU)  ==  (AIBAD)                                    # MIS
          DIAG0 (D203);            #SIZE MUST BE A CONSTANT            # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI812:   #    (AIDAUD) (RPOINT)  ==  (AIDSEG)                         # MIS
          IF FILLER                #IF WE ARE PROCESSING A FILLER ITEM # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            DIAG0 (D206);          #FILLER VALID ONLY IN OVERLAY DECS. # MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          GOTO WAI161;             #UPDATE THE NECESSARY FIELDS        # MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI813:   #    (AIDAUD) (RPARE2)  ==  (AIBAD)                          # MIS
          DIAG0 (D205);            #CLOSING ANGLE BRACKET EXPECTED     # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI814:   #    (AIDAUD)  ==  (AIBAD)                                   # MIS
          DIAG0 (D205);            #CLOSING ANGLE BRACKET EXPECTED     # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI821:   #    (AIDAUF) (AITNAM)  ==  (AIDAUG)                         # MIS
                                                                         MIS
          OVLOC = DSEC;            #LOC(ITEM ON WHICH WE"RE OVERLAYING)# MIS
                                                                         MIS
          IF MAMA[OVLOC] NQ ARRLOC                                       MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            DIAG0 (D208);          #OVERLAYEE NOT DEFINED IN THIS STRUC# MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          BADOVL = FALSE;          #ALL DECS ARE ASSUMED GOOD AT ONSET # MIS
                                                                         MIS
          IF NOT FILLER            #FILLERS HAVE TYPE OF PRECEDING ITEM# MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            IF OVLAY [TYPE [ITMLOC]] NQ OVLAY [TYPE [OVLOC]]             MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              DIAG0 (D209);        #INCOMPATIBLE OVERLAY CLASSES       # MIS
              RETURN;                                                    MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          IF OVLAY [TYPE [OVLOC]] EQ S"BIT"                              MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            IF SIZE$AU GR NBIT [OVLOC]                                   MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              DIAG0 (D211);        #LENGTH(SUBFIELD)>LENGTH(ORIG FIELD)# MIS
              BADOVL = TRUE;       #ALL SUBSEQ OVERLAID ITEMS ARE WRONG# MIS
              IF NOT FILLER                                              MIS
              THEN                                                       MIS
                BEGIN                                                    MIS
                NBIT [ITMLOC] = 0; #THIS ITEM WILL NOT BE ALLOCATED    # MIS
                END                                                      MIS
                                                                         MIS
              RETURN;                                                    MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          ELSE                                                           MIS
            BEGIN                                                        MIS
            IF OVLAY [TYPE [OVLOC]] EQ S"BYTE"                           MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              IF SIZE$AU GR NBYT [OVLOC]                                 MIS
              THEN                                                       MIS
                BEGIN                                                    MIS
                DIAG0 (D211);      #LENGTH(SUBFIELD)>LENGTH(ORIG FIELD)# MIS
                BADOVL = TRUE;     #ALL SUBSEQ OVERLAID ITEMS ARE WRONG# MIS
                IF NOT FILLER                                            MIS
                THEN                                                     MIS
                  BEGIN                                                  MIS
                  NBYT [ITMLOC] = 0;  #THIS ITEM WILL NOT BE ALLOCATED # MIS
                  END                                                    MIS
                RETURN;                                                  MIS
                END                                                      MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          IF NOT FILLER                                                  MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            FBIT [ITMLOC] = FBIT [OVLOC];                                MIS
            WDEN [ITMLOC] = WDEN [OVLOC];                                MIS
            END                                                          MIS
                                                                         MIS
          IF OVLAY [TYPE [OVLOC]] EQ S"BYTE"   #UPDATE IMISEP, IMISFBIT# MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            TPYC = FBIT [OVLOC] + ( SIZE$AU * TCL );                     MIS
            IMISEP = WDEN [OVLOC] + TPYC / TWL; 
            IMISFBIT = TPYC - ( TPYC / TWL ) * TWL;                      MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          IMISFBIT = FBIT [OVLOC] + SIZE$AU;                             MIS
          IMISEP = WDEN [OVLOC];                                         MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI822:   #    (AIDAUF) (SIGN)  ==  (AIDAUG)                           # MIS
          RPLI = 1;                #PERFORM REPLACEMENT                # MIS
          IF CSRF [POZN] NQ 0      #A MINUS IS NO GOOD, BUT A PLUS IS  # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            RPLI = 0;              #DO NOT PERFORM REPLACEMENT         # MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          IF NOT PLUSOK            #IF THE SEMANTICS ARE INCORRECT     # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            DIAG0 (D212);          #PREV DEC DID NOT SPECIFY + OR OVRLY# MIS
            RETURN;                                                      MIS
            END                                                          MIS
                                                                         MIS
          IF NOT FILLER            #FILLERS HAVE TYPE OF PRECEDING ITEM# MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            IF OVLAY [TYPE [ITMLOC]] NQ OVLAY [TYPE [OVLOC]]             MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              DIAG0 (D209);        #INCOMPATIBLE OVERLAY CLASSES       # MIS
              RETURN;                                                    MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          IF OVLAY [TYPE [OVLOC]] EQ S"BIT"                              MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            IF (SIZE$AU + IMISFBIT) GR (NBIT [OVLOC] + FBIT [OVLOC])
              OR IMISEP NQ WDEN [OVLOC]  # NOT IN SAME WORDS           #
              OR BADOVL                                                  MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              DIAG0 (D211);        #LENGTH(SUBFIELD)>LENGTH(ORIG FIELD)# MIS
              BADOVL = TRUE;       #ALL SUBSEQ OVERLAID ITEMS ARE WRONG# MIS
              IF NOT FILLER                                              MIS
              THEN                                                       MIS
                BEGIN                                                    MIS
                NBIT [ITMLOC] = 0; #THIS ITEM WILL NOT BE ALLOCATED    # MIS
                END                                                      MIS
                                                                         MIS
              RETURN;                                                    MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          ELSE                                                           MIS
            BEGIN                                                        MIS
            IF OVLAY [TYPE [OVLOC]] EQ S"BYTE"                           MIS
            THEN                                                         MIS
              BEGIN                                                      MIS
              IF SIZE$AU GR (NBYT[OVLOC] + (FBIT[OVLOC]-IMISFBIT) / 6 )  MIS
                OR BADOVL                                                MIS
              THEN                                                       MIS
                BEGIN                                                    MIS
                DIAG0 (D211);      #LENGTH(SUBFIELD)>LENGTH(ORIG FIELD)# MIS
                BADOVL = TRUE;     #ALL SUBSEQ OVERLAID ITEMS ARE WRONG# MIS
                IF NOT FILLER                                            MIS
                THEN                                                     MIS
                  BEGIN                                                  MIS
                  NBYT [ITMLOC] = 0;  #THIS ITEM WILL NOT BE ALLOCATED # MIS
                  END                                                    MIS
                RETURN;                                                  MIS
                END                                                      MIS
              END                                                        MIS
            END                                                          MIS
                                                                         MIS
          IF NOT FILLER                                                  MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            FBIT [ITMLOC] = IMISFBIT;                                    MIS
            WDEN [ITMLOC] = IMISEP;                                      MIS
            END                                                          MIS
                                                                         MIS
          IF OVLAY [TYPE [OVLOC]] EQ S"BYTE"   #UPDATE IMISEP, IMISFBIT# MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            TPYC = IMISFBIT + ( SIZE$AU * TCL );                         MIS
            IMISEP = IMISEP + TPYC / TWL;                                MIS
            IMISFBIT = TPYC - ( TPYC / TWL ) * TWL;                      MIS
            RETURN;                                                      MIS
                                                                         MIS
            END                                                          MIS
                                                                         MIS
          IMISFBIT = IMISFBIT + SIZE$AU;   #UPDATE IMISFBIT FOR NON-CHR# MIS
          RETURN;                                                        MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI823:   #    (AIDAUF) (DICON)  ==  (AIDAUG)                          # MIS
          DIAG0 (D201);            #MIS OVERLAY CANNOT BE A CONSTANT   # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI824:   #    (AIDAUF)  ==  (AIBAD)                                   # MIS
          DIAG0 (D204);            #ERROR IN SECOND SPECIFICATION      # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI831:   #    (AIDAUG) (RPOINT)  ==  (AIDSEG)                         # MIS
          PLUSOK = TRUE;           #A PLUS-TYPE DEC CAN FOLLOW THIS ONE# MIS
                                                                         MIS
          IF IMISFBIT EQ TWL       #IF WE ARE AT THE END OF THE WORD   # MIS
          THEN                                                           MIS
            BEGIN                                                        MIS
            IMISEP = IMISEP + 1;   #NEXT WORD TO ALLOCATE              # MIS
            IMISFBIT = 0;          #NEXT BIT POSITION TO ALLOCATE      # MIS
            END                                                          MIS
                                                                         MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI832:   #    (AIDAUG) (RPARE2)  ==  (AIBAD)                          # MIS
          DIAG0 (D205);            #CLOSING ANGLE BRACKET EXPECTED     # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI833:   #    (AIDAUG) (COMMA2)  ==  (AIBAD)                          # MIS
          DIAG0 (D202);            #TOO MANY SPECS. IN ITEM DEC.       # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WAI834:   #    (AIDAUG)  ==  (AIBAD)                                   # MIS
          DIAG0 (D204);            #ERROR IN SECOND SPECIFICATION      # MIS
          RETURN;                                                        MIS
                                                                         MIS
                                                                         MIS
                                                                         MIS
WID100:   #    TEST(IBAD) (COMMA2)==(IDECSG)(COMMA2)   #
WID101:   #    TEST(IBAD) (COMMA) ==(IDECSG)(COMMA)    #
WAI351:   #    TEST((AIBAD)COMMA2)==(AIBODY)(COMMA2)   #
WAI352:   #    TEST (AIBAD)COMMA) ==(AIBODY)(COMMA)    #
          IF BRKLEV NQ 0 THEN RETURN;             #ONLY RECOVER AT 0 LV#
          AIRFLG=AIRFLG+1;
          IF AIRFLG GR NRAIRR THEN RETURN;
          DIAG0(D099);             # COMMA RECOVERY                    # PF12 
          RPLI=1; 
          DCXFLG=1; 
          RETURN; 
  
WAI36:    #    (AIBAD)   (SEMI2)   ==   (AIDEC)        #
WAI37:    #    (AIBAD)   (SEMI)    ==   (AIDEC)        #
WID11:    #    (IBAD)    (SEMI2)   ==   (DEC)          #
WID12:    #    (IBAD)    (SEMI)    ==   (DEC)          #
          DIAG0(D021);             # RECOVERY AT SEMI                  # PF12 
          RETURN; 
  
  
  
PROC PRSNTR(NT);         #PUTS CONTROL WD OF GIVEN TYPE INTO FILE#
BEGIN 
ITEM NT;
      IF NOCOMPS THEN RETURN; 
          PETY[PRBSIZ]=NT;         #PUT IN WORD TYPE# 
          IF NT EQ QPETY"CONST"         #SET FLAG AND PREPARE CONST#
          THEN BEGIN
               PRCSTR=PRBSIZ;           #SAVE CONSTANT LOCATION#
               PELN[PRBSIZ]=0;          #CLEAR LINK#
               END
          ELSE PRCSTR=-1;               #NO CO STANT FLAG#
          PRBSIZ=PRBSIZ+1;         #BUFFER CONTROL# 
          IF PRBSIZ GQ PRBUP THEN BEGIN PRSOUT; END #FLUSH BUFFER#
END 
  
PROC EMPTY;              #PUTS NULL PRESET INTO FILE# 
BEGIN 
      IF NOCOMPS THEN RETURN; 
          IF PRBSIZ EQ 0 THEN GOTO NEWMPT;   #NO OLD NULL TO ADD TO#
          IF PETY[PRBSIZ-1] NQ S"EMPTY" THEN
NEWMPT:        BEGIN
               PEVL[PRBSIZ]=1;          #NEW EMPTY# 
               PRSNTR(QPETY"EMPTY");
               END
          ELSE #ADD TO OLD COUNT# 
               PEVL[PRBSIZ-1]=PEVL[PRBSIZ-1]+1; 
END 
  
DEF NEWGRP (LEVEL,NBR) # IF NBRGRP[LEVEL-1]+NBR GR EXTENT[LEVEL-1] THEN 
          GOTO WAIPER # ; 
  
WAI405:   #    TEST(AIPSET)(LSQUAR)==(AIPBOT)          #
          IF AIPLVL NQ DMENS-1 THEN RETURN; 
  
WAI41:    #    TEST)AIPSET)(LSQUAR)==(AIPSET)          #
          IF WAIPEF EQ 1 THEN RETURN;             #ERROR# 
          TPYA=1;                                 #ONE GROUP# 
          IF AIPLVL EQ 0 THEN 
               BEGIN
WAI40H:        RPLI=1;
               AIBLVL=0;                          #INITIALIZE PAREN CT# 
               CCOUNT=1;
               NBRGRP[AIPLVL]=0;
               AIPLVL=AIPLVL+1; 
               PEVL[PRBSIZ]=TPYA;        #NUMBER OF BRACKETS# 
               PRSNTR(QPETY"LBRACK");   #PUT OUT [ WORD#
               RETURN;
               END
WAIPT:    NEWGRP(AIPLVL,TPYA);                    #CHECK NUMBER#
          NBRGRP[AIPLVL-1]=NBRGRP[AIPLVL-1]+TPYA; 
          GOTO WAI40H;
  
WAIPER:                                                                  DON/D
          DIAG(D038,ITMLOC);                                             DON/D
          SIND[ITMLOC]=FALSE;    #SPOIL PRESET# 
          WAIPEF=1; 
          RETURN; 
  
WAI415:   #    TEST(AIPSET)(DICON)(LSQUAR)==(AIPBOT)        # 
          IF AIPLVL NQ DMENS-1 THEN RETURN; 
WAI42:    #    TEST(AIPSET)(DICON)(LSQUAR)==(AIPSET)        # 
          IF WAIPEF EQ 1 THEN RETURN;             #DONT PROCESS IF NG#
          IF AIPLVL EQ 0 THEN GOTO WAIPER;
           TPYA = REPLFAC;                                               L420 
          GOTO WAIPT; 
  
WAI44:    #    TEST(AIPSET)(RSQUAR)==(AIBODY)          #
          PRSNTR(QPETY"RBRACK");        #PUT OUT ] WORD#
          IF AIPLVL NQ 1 THEN RETURN; 
          IF WAIPEF EQ 1 THEN RETURN; 
          RPLI=1; 
          RETURN; 
  
WAI45:    #    (AIPSET)(RSQUAR)==(AIPSET)         # 
          AIPLVL=AIPLVL-1;
          RETURN; 
  
WAI64:  
WAI47:  
WAI74:  
          DIAG(D039,ITMLOC);                                             DON/D
          SIND[ITMLOC]=FALSE;    #SPOIL PRESET# 
          RETURN; 
  
WAI51:    #    (AIPBOT)(DICON)(LP+RE2)==(+IPBOT)       #
          IF WAIPEF EQ 1 THEN RETURN; 
           TPYA = REPLFAC;                                               L420 
          LVALUE[AIBLVL]=TPYA;
          AIBLVL=AIBLVL+1;
          CCOUNT=CCOUNT*TPYA; 
          PEVL[PRBSIZ]=TPYA;       #ENTRY COUNT#
          PRSNTR(QPETY"LPAREN");
          RETURN; 
  
WAI53:    #    (AIPBOT)(COMMA2)==(AIPBOT)         # 
          EMPTY;         #NULL ENTRY# 
WAI60:    #    RULE(PSETS)         #
          IF WAIPEF EQ 1 THEN RETURN; 
          NEWGRP(AIPLVL,CCOUNT);                  #REPRESENTS MANY #
          RETURN;                                 #IF OK# 
  
WAI55:    #    (AIPBOT)(SIGN)==(PSETS)  # 
          IF NOT SIGN[ITMLOC] THEN
               BEGIN
          DIAG0(D024);                                                   PF12 
               RETURN;    #SIGN NOT ACCEPTABLE# 
               END
          IF CSRF[POZN] NQ 0 THEN PCCON[0]=-PCCON[0];  #NEGATE# 
          RETURN; 
  
WAI61:    #    (PSETS)(DICON)==(PSETV)       #
WAI63:    #    (PSETS)(CONST)==(PSETV)       #
      IF NOCOMPS THEN RETURN; 
          LENGTH;   #MOVE ITEM LENGTH IN WORDS TO ITMLNG# 
               IF PRCSTR NQ -1 THEN 
                    BEGIN     #ADD IF POSSIBLE TO OLD STRING OF CONST#
                    IF PRBSIZ+ITMLNG GQ PRBUP THEN GOTO WAI63A; #FLUSH# 
WAI63B:             PEVL[PRCSTR]=PEVL[PRCSTR]+1;  #ADD TO OLD COUNT#
          PELN[PRCSTR]=PELN[PRCSTR]+ITMLNG;  #TOTAL BLOCK LENGTH# 
                    FOR TLD1=0 STEP 1 UNTIL ITMLNG-1 DO #MOVE CONST#
                         PEWD[PRBSIZ+TLD1]=PCCON[TLD1];     #TO FILE# 
                    PRBSIZ=PRBSIZ+ITMLNG;    #ADD CONST LENGTH TO BUF L#
                    RETURN; 
                    END 
               IF PRBSIZ+ITMLNG+1 GQ PRBUP THEN #FLUSH FIRST# 
WAI63A:             BEGIN PRSOUT; END #EMPTY BUFFER#
               PEVL[PRBSIZ]=0;          #CLEAR COUNT FOR CONST ENTRY# 
               PRSNTR(QPETY"CONST");    #START NEW CONST STRING#
               GOTO WAI63B;             #ADD AS IF OLD# 
  
WAI53A:   #    (AIPBOT)(RPARE2)==(PSETV)     #
          #NULL ENTRY REQUIRED AT END OF PARENTHETICAL GROUP# 
          EMPTY;         #PUT OUT NULL ENTRY# 
          NEWGRP(AIPLVL,CCOUNT);
WAI72:    #    (PSETV)(RPARE2)==(PSETV)           # 
          AIBLVL=AIBLVL-1;
          IF  AIBLVL LS 0 
          THEN
            BEGIN 
            WAIPEF = 1;            # SET ARRAY ITEM PRESET ERROR FLAG  #
            END 
  
          ELSE
            BEGIN 
            IF  LVALUE[AIBLVL] NQ 0 
            THEN
              BEGIN 
              CCOUNT = CCOUNT/LVALUE[AIBLVL]; 
              END 
            END 
  
          PRSNTR( QPETY"RPAREN" ); # RIGHT PAREN ENTRY                 #
          RETURN; 
  
  
WAD88:    #    (ARIDLT)==(DEC)    # 
          DIAG(D018,ARRLOC); #MISSING END#                               DON/D
  
WAD86:    #    (ARIDLT)(END2)==(DEC)         #
WAD91:    #    (AIDEC)==(DEC)      #
          IF ARAYPS EQ 0 THEN RETURN; 
      IF NOCOMPS THEN BEGIN 
          PRBSIZ=0; RETURN; END 
          #MUST NOW CLOSE THIS ARRAY"S SECTION OF THE FILE# 
          PRSNTR(QPETY"END"); 
          IF PRBSIZ NQ 0 THEN PRSOUT; 
          RETURN; 
#SWITCH DECLARATIONS          # 
  
WSWD11:     #       (STHEAD)(SWITC2) == (STHEAD)(SWDECH)     #           NEWFEAT
          XLBFLG = S"LOC" ;                                              NEWFEAT
          GOTO WID1;                                                     NEWFEAT
WSWD80:     #       (SWITDH)(DECNAM) == (SWITDB)             #           NEWFEAT
                    # I.E. XREF      SWITCH LIST #                       NEWFEAT
          IF (PVDF NQ 0) AND (SBEG[PVDF] EQ SCOPE) THEN                  NEWFEAT
          BEGIN                                                          NEWFEAT
             IF CLAS[PVDF] NQ S"SWCH" THEN DIAG(D019,PVDF);              DON/D
                                        ELSE                             NEWFEAT
                 IF XTRN[PVDF] EQ S"EXT" THEN RETURN; #IGNORE DUPLICATE# NEWFEAT
                                                      #  XREFS#          NEWFEAT
          DIAG(D019,PVDF);   #AND DROP THROUGH#                          DON/D
          END                                                            NEWFEAT
          # COME HERE IF FIRST MENTION IN SCOPE#                         NEWFEAT
          TPYA = QCLAS"SWCH" ;                                           NEWFEAT
          TPYB = CLIST"SWINAM";                                          NEWFEAT
          TPYC = SWCWDS;                                                 NEWFEAT
          TLD1 = CSRF[POZN];                                             NEWFEAT
          # NOW WE POST AN XREF SWITCH ENTRY AND PUT IT ON XCHAIN #      NEWFEAT
          # GO JOIN LABEL PROCESSING CODE#                               NEWFEAT
          GOTO WFL21B;                                                   NEWFEAT
WSWD81:   #        (SWITDH) == (BAD)    #                                NEWFEAT
WSWD92:   #        (SWITDB) == (DEC)    #                                NEWFEAT
          DIAG0(D157);                                                   PF12 
          RETURN;                                                        NEWFEAT
WSWD12:   #    (SWITC2)==(NULL)         # 
WSWD22: 
          ILKEY("SWITCH",6);
  
WSWD21:   #    (SWDECH)(DECNAM)==(SWDECN)    #
          TLD1=CSRF[POZN];
          POW(TLD1,SWCWDS,QCLAS"SWCH",CLIST"SWINAM"); 
          IF XLBFLG EQ S"LOC" THEN XTRN[DSEC] = S"LOC" ;                 NEWFEAT
                                 ELSE  XTRN[DSEC] = S"ENT" ;             NEWFEAT
          SWILOC=DSEC;
         IF SWITBUF NQ 0 THEN   # SOMETHING WENT WRONG WITH LAST SWITCH#
           BEGIN
          STERF =1;    # INHIBIT CODE FROM BAD BUFFERS  # 
           OSAV ( SWITBUF );
           ENDSAV;
           RESTR( SWITBUF );
           END
         CSAV ( SWITBUF );     # OPEN SWITCH BUFFER  #
         VALID ( SWITBUF ) ;
           STERF =0  ;
      IF OPTIONC THEN BEGIN 
          GENLAB(SWIGNL);          #GENERATE LABEL# 
          POPN(SWIGNL);       #PUT OUT GOTO LABEL#
          POPR(QILOP"GOTO");
      END 
          POPR(QILOP"PAUS");
          OPRNDV(CRDN); 
          XRDEF(DSEC,CRNO[POZN]); 
          POPN(DSEC); 
          POPR(QILOP"SWCH");
          DUPCHK; 
         ENDSAV;
          GOTO WLB11K;
  
WSWD31:   #    (SWTOP)(LABNAM)==(SWPART)          # 
         OSAV ( SWITBUF );
          XUSE(0);
          OPERND(CSRF[POZN]); 
          TPYB = CSRF[POZN];
          LREF[TPYB] = LREF[TPYB] + 1; # INCREMENT REFERENCE COUNT     #
          IF SBEG[TPYB] NQ SCOPE       # CHECK FOR BACKWARD REFERENCE  #
          THEN
            BEGIN 
            DIAG(D197, TPYB);          # OUT OF SCOPE SW LABL--BACKWARD#
            END 
          IF FPRI[CSRF[POZN]] EQ 0 THEN POPR(QILOP"SWPT");
                                   ELSE POPR(QILOP"GSWP");
         ENDSAV ; 
          RETURN; 
##
  
WSWD32:   #    (SWTOP)==(SWPART)        # 
         OSAV ( SWITBUF ) ; 
          POPR(QILOP"NULL");
          POPR(QILOP"SWPT");
         ENDSAV;
          RETURN; 
  
WSWD40:   #    RULE(SWPART)   # 
          RETURN; 
  
WSWD43:   #    (SWPART)==(BAD)          # 
          DIAG(D026,SWILOC);       # MISSING SEMICOLON                 # PF12 
WSWD41:   #    (SWPART)(SEMI2)==(DEC)   # 
##
         OSAV ( SWITBUF ) ; 
WSWD41A:  
          POPR(QILOP"ENDS");
          STERF=0;
      IF OPTIONC THEN BEGIN 
          POPN(SWIGNL); 
          POPR(QILOP"LABL");
      END 
          POPR(QILOP"PAUS");
          OPRNDV(CRDN); 
         ENDSAV;
         RESTR ( SWITBUF ); 
         SWITBUF = 0; 
          RETURN; 
  
WSWD51:   #    (SSDH)(STLANM)==(SSDT)   # 
          ITMTYP=CSRF[POZN];
          SWIHI=0;       #INITIALIZE HIGHEST POINT GADGET#
          FOR TPYA=0 STEP 1 UNTIL NSSWPT DO SSP[TPYA]=0;
          XUSE(0);
          RETURN; 
  
WSWD52:                                                                  DON/D
          DIAG(D078,SWILOC); #MISSING STLNAME#                           DON/D
          RETURN; 
  
WSWD58:   #    (SSDTLP)(LABNAM)(COLON)==(SSDTLC)       #
WSWD55:   #    (SSDT)(LABNAM)(COLON)==(SSDTLC  #
          CSRF[POZN]=ITMTYP;
          SWILAB=CSRF[BLNK[POZN]];
          IF FPRI[ITMTYP] EQ S"VALU" THEN DIAG(D152,SWILAB);             DON/D
          SCXFLG=1; 
          XUSE(1);
          RETURN; 
  
WSWD56:                                                                  DON/D
          DIAG(D079,SWILOC); #BAD LABEL STUFF#                           DON/D
          RETURN; 
  
WSWD61:                                                                  DON/D
          DIAG(D082,SWILAB); #BAD STATUS PART#                           DON/D
          RETURN; 
  
WSWD60:   #    (SSDTLC)(SWPT)==(SSDTSN)      #
          IF CSRF[POZN]EQ -1 THEN RETURN;         #BAD CONSTANT#
          IF CSRF[POZN]GR NSSWPT THEN 
               BEGIN
          DIAG(D080,SWILAB); #TOO LARGE#                                 DON/D
               RETURN;
               END
          TPYA=CSRF[POZN];
          IF SSP[TPYA] NQ 0 THEN DIAG(D081,SWILAB);  #DUPLICATE ENTRY#   DON/D
          SSP[TPYA]=SWILAB;        #USE LATEST IN ANY CASE# 
          IF TPYA GR SWIHI THEN SWIHI=TPYA;       #AFTER ALL THIS 
               NONSENSE IS DONE, THE TABLE CONTAINS A LIST OF 
               THE LABELS WHICH ARE THE WITTCH POINTS,
               IN ORDER AND IN PLACE.  SWIHI GIVES THE HIGHEST# 
          RETURN; 
  
WSWD71:                            # (SSDTSN)(SEMI2)==(DEC)            #
#         TIME TO PUT OUT THE STATUS SWITCH FROM THE TABLE.            #
          OSAV(SWITBUF);
          FOR TPYA = 0 STEP 1 
            UNTIL SWIHI 
          DO
            BEGIN 
            TPYB = SSP[TPYA]; 
            IF TPYB EQ 0
            THEN                   # NULL SWITCH POINT                 #
              BEGIN 
              POPR(QILOP"NULL");
              POPR(QILOP"SWPT");
              END 
            ELSE
              BEGIN 
              OPERND(TPYB);        # PUT OUT LABEL                     #
              LREF[TPYB] = LREF[TPYB] + 1;
              IF SBEG[TPYB] NQ SCOPE
              THEN
                BEGIN 
                DIAG(D197,TPYB);   # LABEL OUT OF SCOPE                #
                END 
              IF FPRI[SSP[TPYA]] EQ 0 
              THEN                 # PUT OUT FORMAL PARAMETER          #
                BEGIN 
                POPR(QILOP"SWPT");
                END 
              ELSE
                BEGIN 
                POPR(QILOP"GSWP");
                END 
              END 
            END 
          GOTO WSWD41A;            # OUTPUT ENDS OPERATOR AND EXIT     #
  
WSWD72:                                                                  DON/D
          DIAG(D026,SWILOC);                                             DON/D
          RETURN; 
  
  
#COMMON DECLARATIONS# 
  
# FOR WCOD11--SEE WID1    # 
  
WCOD12:   #    (COMMO2)==(NULL)         # 
          ILKEY("COMMON",6);
  
WCOD16:   #    (COMDHD)(DECNAM)==(COMDSG)         # 
          BFLAG=FALSE;
          TLD1=CSRF[POZN];
          IF PVDF NQ 0 THEN 
               BEGIN
               IF CLAS[PVDF] EQ S"COMM" THEN      #REUSE OF OLD COMMON# 
                    BEGIN 
                    TLD2=PVDF;          #CLAS"COMM" ENTRY#
                    DSEC=ASEQ[TLD2];    #CLAS"SLC" ENTRY# 
                    GOTO WCO16B;
                    END 
               DUPCHK;        #DUPLICATE DEFINITION CHECK#
               END
WCO16A:   POST(TLD1,SLCWDS,DSEC); 
          CLAS[DSEC]=S"SLC";
          ESDC[DSEC]=S"COMM"; 
          ASEQ[ESPLC]=DSEC; 
          ESPLC=DSEC; 
          POST(TLD1,COMWDS,TLD2);  #POST CLAS"COMM" ENTRY#
          CLAS[TLD2]=S"COMM"; 
          CSTR[TLD2]=CLIST"COMNAM"; 
          SBEG[TLD2]=SCOPE;        #POW WON"T WORK--IT RUINS DSEC#
          ASEQ[TLD2]=DSEC;         #LINK TO SLC ENTRY#
          IF BFLAG THEN BLKCOM=TLD2;    #POINTER TO COMM ENTRY# 
WCO16B: 
          IF SCOPE NQ 2 THEN DIAG(D040,DSEC);    #ONLY OK OUTSIDE#       DON/D
          COMLOC=DSEC;
          XRDEF(TLD2,CRNO[POZN]);  #CROSSREFERENCE ONLY COMM ENTRY# 
          RETURN; 
  
WCOD17:   #    (COMDHD)==(COMDSG)       BLANK COMMON        # 
          DCXFLG=0; 
          BFLAG=TRUE; 
          PNAM(" ",CMPR12,TLD1);
          IF BLKCOM EQ 0 THEN GOTO WCO16A;
          TLD2=BLKCOM;        #BLNK COMMON--LOC OF CLAS"COMM" ENTRY#
          DSEC=ASEQ[TLD2];         #LOC OF SLC ENTRY# 
          GOTO WCO16B;
  
WCOD22:   #    (COMDSG)==(COMDEC)             MISSING SEMICOLON#
          IF BFLAG THEN RETURN; 
          DIAG0(D026);             # MISSING SEMICOLON                 # PF12 
          RETURN; 
  
WCOD32:   #    (COMDEC)(ITME2)==(IDECHD)          # 
          IDECTP=S"COMMON"         ;
          GOTO WID1;                              #SET CONTEXT# 
  
WCOD33:   #    (COMDEC)(ARRAY2)==(ADECHD)         # 
          BASFLG=0; 
          XARFLG=QXTRN"COMMON"; 
          AORU = FALSE; 
          GOTO WID1;                              #SET CONTEXT# 
WCOD35:         #    (COMDEC)(BASED2) == (CXBDEC) DOWN   #               NEWFEAT
WBAS13:         #    (COMDLH)(BASED2) == (COMDLH)(CXBDEC) DOWN #         NEWFEAT
          CSRF[POZN] = QXTRN"COMMON" ;                                   NEWFEAT
          RETURN;                                                        NEWFEAT
  
WCOD34:   #    (COMDEC)==(NULL)         # 
          DIAG(D041,COMLOC);                                             DON/D
          RETURN; 
  
WCOD31:   #    (COMDEC)(BEGIN2)==(COMDLT)    #
          COMLER=0; 
          RETURN; 
  
WCOD42:   #    (COMDLT)(BEGIN2)==(DEC)(BEGIN2)    # 
          DIAG(D113,COMLOC);                                             DON/D
          RETURN; 
  
WCOD44:   #    (COMDLT)(ANY)==(COMDLT)  # 
          IF COMLER EQ 0 THEN 
               BEGIN
               COMLER=1;
          DIAG(D116,COMLOC);                                             DON/D
               END
          GOTO WID13; 
  
WCOD40:   #    (COMDLT)(ARRAY2)==(COMDLH)(ARRAY2)      #
WCOD41:   #    (COMDLT)(ITEM2)==(COMDLH)(ITEM2)        #
WCOD46:         #    (COMDLT)(BASED2) == (COMDLH)(BASED2)     #          NEWFEAT
          IF COMLER EQ 0 THEN RETURN; 
          COMLER=0; 
          DIAG(D046,COMLOC);                                             DON/D
          RETURN; 
  
WCOD43:   #    (COMDLT)(END2)==(DEC)         #
          IF COMLER EQ 0 THEN RETURN; 
          DIAG(D048,COMLOC);                                             DON/D
          RETURN; 
  
  
#BASED DECLARATIONS      #
  
WBAS12:   #    (BASED2)==(NULL)         # 
          ILKEY("BASED",5); 
  
WBAS22:   #    (BASDEC)(ARRAYI)==(ADECHD)         # 
          BASFLG=1; 
          XARFLG=QXTRN"LOC";
          GOTO WID1;                              #SET CONTEXT# 
          AORU = FALSE; 
  
WBAS23:   #    (BASDEC)==(NULL)         # 
          DIAG0(D043);                                                   PF12 
          RETURN; 
  
  
WBAS21:   #    (BASDEC)(BEGIN2)==(BASDLT)    #
          BASERR=0; 
          RETURN; 
  
WBAS30:   #    (BASDLT)(ARRAY2)==(BASDLH)(ARRAY2) # 
          IF BASERR EQ 0 THEN RETURN; 
          DIAG0(D118);                                                   PF12 
          BASERR=0; 
          RETURN; 
  
WBAS31:   #    (BASDLT)(BEGIN2)==(DIC)(BEGIN2)    # 
          DIAG0(D114);                                                   PF12 
          RETURN; 
  
WBAS32:   #    (BASDLT)(END2)==(DIC)         #
          IF BASERR EQ 0 THEN RETURN; 
          DIAG0(D119);                                                   PF12 
          RETURN; 
  
WBAS33:   #    (BASDLT)(ANY)==(BASDLT)       #
          IF BASERR EQ 1 THEN GOTO WID13; 
          BASERR=1; 
          DIAG0(D117);                                                   PF12 
          RETURN; 
  
# COMMON BASED ARRAYS#                                                   NEWFEAT
WXBD10:         #    (CXBDEC)(BEGIN2) == (CXBDLT) DOWN    #              NEWFEAT
          CBAERR = 0;                                                    NEWFEAT
            CSRF[POZN] = CSRF[BLNK[POZN]];          # SAVE XREF/COMMON   L428 
                                                       FLAG  #           L428 
          RETURN;                                                        NEWFEAT
WXBD11:         #    (CXBDEC)(ARRAY2) == (ADECHD) DOWN    #              NEWFEAT
WAD7:           #    (CXBDLH)(ARRAY2) == (CXBDLH)(ADECHD) DOWN  #        NEWFEAT
          DCXFLG = 1;        #SET CONTEXT#                               NEWFEAT
          BASFLG = 1;                                                    NEWFEAT
          XARFLG = CSRF[BLNK[ POZN ] ]    ;     #COPY RESIDENCE#         NEWFEAT
          AORU = FALSE; 
          RETURN;                                                        NEWFEAT
WXBD12:         #            (CXBDEC) == (NULL)           #              NEWFEAT
WXBD22:         #    (CXBDLT)(BEGIN2) == (DEC)(BEGIN2)    #              NEWFEAT
WXBD24:         #            (CXBDLT) == (NULL)           #              NEWFEAT
          DIAG0(D155);                                                   PF12 
          RETURN; 
WXBD20:         #    (CXBDLT)(ARRAY2) == (CXBDLH)(ARRAY2) #              NEWFEAT
WXBD21:         #    (CXBDLT)(END2)   == (DEC) DOWN       #              NEWFEAT
          IF CBAERR EQ 0 THEN RETURN;                                    NEWFEAT
          DIAG0(D155);                                                   PF12 
          RETURN;                                                        NEWFEAT
WXBD23:         #    (CXBDLT)(ANY)    == (CXBDLT)         #              NEWFEAT
          IF CBAERR EQ 1 THEN GOTO WID13;                                NEWFEAT
          CBAERR = 1;                                                    NEWFEAT
          DIAG0(D157);                                                   PF12 
          RETURN;                                                        NEWFEAT
# EXTERNAL DECLARATIONS#
  
WXDC12:   #    (XDEC)==(NULL)      #
          TPYA="XDEF";
          IF CSRF[POZN]EQ QXTRN"EXT"    THEN ILKEY("XREF",4); 
                                        ELSE ILKEY("XDEF",4); 
  
WXDC15:   #    RULE(XDECD)    # 
          RETURN; 
  
WXDC16:   #    (XDECD)(BEGIN2)==(XDECLT)          # 
          XDCERR=0; 
          CSRF$;
          RETURN; 
  
WXDC17:   #    (XDECD)(ITEM2)==(IDECHD)      #
          IDECTP=S"XDEF"        ; 
          IF CSRF[BLNK[POZN]] EQ QXTRN"EXT" THEN IDECTP=S"XREF";
          GOTO WID1;                              #SET CONTEXT# 
  
WXDC18:   #    (XDECD)(ARRAY2)==(ADECHD)          # 
          XARFLG=CSRF[BLNK[POZN]];
          BASFLG=0; 
          AORU = FALSE; 
          GOTO WID1;                              #SET CONTEXT# 
  
#FOR WXDC19 AND 20--SEE WPRD12     #
  
WXDC21:   #    (XDECD)==(NULL)          # 
          DIAG0(D042);                                                   PF12 
          RETURN; 
  
WXDC34:   #    (XDECLT)(PROC2)==(XDECLH)(PROC2)        #
          IF CSRF[BLNK[POZN]] EQ QXTRN"ENT"                              PF12C
          THEN                     # XDEF PROC                         # PF12C
            BEGIN  # ISSUE DIAG #                                        PF12C
            DIAG0(D185);                                                 PF12C
            GOTO WXDC30;                                                 PF12C
            END  # ISSUE DIAG #                                          PF12C
WXDC35:   #    (XDECLT)(FUNC2)==(XDECLT)(FUNC2)        #
          IF CSRF[BLNK[POZN]] EQ QXTRN"ENT"                              PF12C
          THEN                     # XDEF FUNC                         # PF12C
            BEGIN  # ISSUE DIAG #                                        PF12C
            DIAG0(D186);                                                 PF12C
            END  # ISSUE DIAG #                                          PF12C
WXDC30:   #     (XDECLT)(ARRAY2)==(XDECLH)(ARRAY2)      #                PF12C
WXDC31:   #     (XDECLT)(ITEM2)==(XDECLH)(ITEM2)      #                  PF12C
          IF XDCERR EQ 0 THEN RETURN; 
          DIAG0(D054);                                                   PF12 
          XDCERR=0; 
          RETURN; 
  
WXDC39:   #     (XDECLT)(RABEL2) == (XDECLH)(LABEL2)   #                 NEWFEAT
WXDC40:   #     (XDECLT)(SWITC2) == (XDECLH)(SWITC2)   #                 NEWFEAT
WXDC38:   #     (XDECLT)(BASED2)==(XDECLH)(BASED2)   #                   PF12C
WXDC22:   #     (XDECD)(BASED2) == (CXBDEC) DOWN       #                 NEWFEAT
WBAS14:   #    (XDECLH)(BASED2) == (XDECLH)(CXBDEC) DOWN #               NEWFEAT
          CSRF[POZN] = CSRF[BLNK[POZN]] ;                                NEWFEAT
          RETURN;                                                        NEWFEAT
WXDC32:   #    (XDECLT)(BEGIN2)==(DEC)(BEGIN2)         #
          DIAG0(D115);                                                   PF12 
          RETURN; 
  
WXDC33:   #    (XDECLT)(END2)==(DEC)         #
          IF XDCERR EQ 0 THEN RETURN; 
          DIAG0(D056);                                                   PF12 
          RETURN; 
  
WXDC36:   #    (XDECLT)(ANY)==(XDECLT)       #
          CSRF$;
          IF XDCERR EQ 1 THEN GOTO WID13; 
          DIAG0(D044);                                                   PF12 
          XDCERR=1; 
          RETURN; 
  
  
#STATUS DECLARATIONS               #
  
# FOR WSTD11--SEE WID1        # 
WSTD12:   #    (STATU2)==(NULL)         # 
WSTD22: 
          ILKEY("STATUS",6);
  
WSTD20:   #    RULE(SDECHD)        #
          DCXFLG=0; 
          RETURN; 
  
WSTD21:   #    (SDECHD)(DECNAM)==(SDECPT)         # 
          POW(CSRF[POZN],STLWDS,QCLAS"STSL",CLIST"STLNAM"); 
          DUPCHK; 
          STLLOC=DSEC;
          STLVAL=0; 
          XRDEF(DSEC,CRNO[POZN]); 
  
WSTD42:   #    (SDECSG)(COMMA2)==(SDECPT)    #
WST21A:   SCXFLG=2;                               #ST NAME DEF CNTXT# 
          DCXFLG=1; 
          RETURN; 
  
WSTD30:   #    RULE(SDECPT)        #
          SCXFLG=0; 
          RETURN; 
  
WSTD31:   #    (SDECPT)(DECNAM)==(SDECSG)         # 
          TLD1=CSRF[POZN];
          SPOST(TLD1,SCNWDS,FOUND,DSEC);#POST STATUS CONSTANT#
WST31S:   IF FOUND THEN 
               BEGIN
               IF CLAS[DSEC] EQ S"SCON" THEN      #POSSIBLE MATCH#
                    BEGIN 
                    IF SMOM[DSEC] EQ STLLOC THEN #DUPLICATE#
                         BEGIN
          DIAG(D135,DSEC);   #DUPL NAME#                                 DON/D
                         RETURN;
                         END
                    END 
               SOVER(DSEC); 
               GOTO WST31S; 
               END
          XRDEF(DSEC,CRNO[POZN]); 
          CLAS[DSEC]=S"SCON";           #TRUNCATED STATUS CONST CLASS#
          SMOM[DSEC]=STLLOC;       #LIST NAME#
          SYSV[DSEC]=STLVAL;       #VALUE#
  
WSTD32:   #    (SDECPT)==(SDECSG)       NULL POINT# 
          STLVAL=STLVAL+1;
          RETURN; 
  
WSTD43:   #    (SDECSG)==(BAD)          # 
          DIAG(D026,STLLOC);                                             DON/D
          RETURN; 
  
  
# DEF DECLARATIONS# 
  
  
#FOR WDFD11--SEE WID1         # 
WDFD12:   #    (DEF2)==(NULL)      #
WDFD22: 
          ILKEY("DEF",3); 
  
WDFD20:   #    RULE(DDECHD)        #
          DCXFLG=0; 
          RETURN; 
  
WDFD21:   #    (DDECHD)(DECNAM)==(DDECSG)         # 
          POW(CSRF[POZN],DEFWDS,QCLAS"DEF",CLIST"DEFNAM");
          XRDEF(DSEC,CRNO[POZN]); 
          DUPCHK; 
          DEFLOC=DSEC;
          RETURN; 
  
  
WDFD31:   #    (DDECSG)(DSTR)==(DDECB)       #
WDFD70:      #    (DMACSG)(DSTR)   == (DDECB)#                           NEWFEAT
          SPTR[DEFLOC]=CSRF[POZN];
          RETURN; 
WDFD33:      #   (DDECSG)(LPARE2) == (DPARLH) DOWN #                     NEWFEAT
          CSTR[DEFLOC] = CLIST "DEFMAC" ;  #THISIS A PARAMETERIZED DEF#  NEWFEAT
          NPAR = 0;                                                      NEWFEAT
          TPYA = NCAR;                                                   NEWFEAT
          CURPAR = DEFLOC ;                                              NEWFEAT
          DCXFLG =1;                                                     NEWFEAT
          RETURN;                                                        NEWFEAT
  
WDFD32:   #    (DDECSG)==(BAD)          # 
WDFD71:      #           (DMACSG) == (BAD)  #                            NEWFEAT
          DIAG(D049,DEFLOC);                                             DON/D
          RETURN; 
WDFD42:   #    (DDECB)==(BAD)      #
          DIAG(D026,DEFLOC);                                             DON/D
          RETURN; 
  
WDFD50:      #   (DPARLH)(DECNAM) == (DPART) #                           NEWFEAT
          NPAR = NPAR + 1;                                               NEWFEAT
          IF NPAR GR NPMAX THEN RETURN;  #DIAGNOSTIC LATER#              NEWFEAT
          POSTPAR (TLD1) ;  #POST ARTIFICAL NAME AT TLD1#                NEWFEAT
          DPGEN[NPAR] = TLD1;                                            NEWFEAT
          DPNAM[NPAR] = CSRF[POZN];                                      NEWFEAT
                 #POST ACTUAL AND GENERATED NAMES AT NPAR POSITION OF  # NEWFEAT
          POW (TLD1,DEFWDS,QCLAS"DEF",CLIST"DEFNAM");      #ARRAY#       NEWFEAT
          PARLNK[CURPAR] = DSEC;                                         NEWFEAT
          CURPAR = DSEC;                                                 NEWFEAT
          RETURN;                                                        NEWFEAT
WDFD60:      #   (DPART)(COMMA2) == (DPARLH)#                            NEWFEAT
          DCXFLG = 1;                                                    NEWFEAT
WDFD61:      #   (DPART)(RPARE2) == (DMACSG)#                            NEWFEAT
          IF NPAR GR NPMAX                                               PF12 
          THEN                                                           PF12 
            BEGIN                                                        PF12 
            DIAG0(D150);                                                 PF12 
            NPAR = NPMAX;                                                PF12 
            END                                                          PF12 
        NPMC[DEFLOC] = NPAR;                                             NEWFEAT
          RETURN ;                                                       NEWFEAT
  
  
#PROGRAM DECLARATIONS#
  
WPRG10:   #    RULE(PRGM2)    # 
          SCPN[0]=0;               #PROGRAM NAME# 
          SCPN[2]=0;
          AERFLG=0; 
          TPYA=0; 
          SCPIN;
          RETURN; 
  
WPRG11:   #    (ANY)(PRGM2)==(PRGM2)    # 
          IF TPYA EQ 0 THEN 
               BEGIN
               TPYA=1;
          DIAG0(D051);                                                   PF12 
               END
          RETURN; 
  
#WPRG12---SEE WID1       #
  
WPRG21:   #    (PDH)(DECNAM)==(PDBODY)       #
          SCPN[0]=CSRF[POZN];     #PROGR AM NAME--USE NAME POINTER# 
          POST(CSRF[POZN],PRGWDS,DSEC); 
WPR22X:   CLAS[DSEC]=S"PROG"; 
          ASEQ[LENT[CPLC]]=DSEC;
          LENT[CPLC]=DSEC;
          MPRC[DSEC]=TRUE;
          XTRN[DSEC]=S"ENT";
          SCPN[2]=DSEC;       #MAIN SCOPE NAME# 
          HATCHK;        #MARK IL FILE# 
          STERF=0;            #GUARANTEE CODE#
          POPN(DSEC);                             #PUT OUTPROGRAM NAME# 
          POPR(QILOP"PRGM");
          RETURN; 
  
WPRG22:   #    (PDH)==(PDBODY)          # 
          DIAG0(D052);                                                   PF12 
          POSTNN(PRGWDS,DSEC);               #NO LEGAL PROGRAM NAME#
    SCPN [0] = NONAM; 
          GOTO WPR22X;
  
WPRG33:   #    (PDBODY)(ANY)==(PDBODY)       #
          IF AERFLG EQ 0 THEN 
               BEGIN
               AERFLG=1;
          DIAG0(D053);                                                   PF12 
               END
          GOTO WID13; 
  
#WPRG34--SEE OXC6   # 
  
  
#LABEL DECLARATIONS#
  
WLBD11:   #    (STHEAD)(POSLB2)(COLON)==(STHEAD)(DEC)       # 
          IF PVDF EQ 0 THEN                       #NO COMPLICATIONS#
               BEGIN
               #POST NEW LABEL ENTRY# 
WLB11A:        POW(CSRF[BLNK[POZN]],LABWDS,QCLAS"LABL",CLIST"LABNAM");
        XTRN[DSEC] = S"LOC" ;                                            NEWFEAT
WLB11B:        DECL[DSEC]=S"REAL";
               STERF=0;       #GUARANTEE LABELS EVEN IN ERROR CASES#
               IF PSTLS EQ 0 THEN  #NO LABELS STACKED YET#
                    BEGIN          #OPEN NEW LABEL STACK BUFFER#
                    CSAV(PSTLS);
                    VALID(PSTLS);       #EXEMPT FROM SCAN ONE CLEAR#
                    END 
               ELSE OSAV(PSTLS);   #USE OLD LABEL STACKER#
                                                                         DON/D
#     WE PUT OUT A LABEL HERE IF TRACEBACK CODE IS BEING GENERATED.    # DON/D
#     OTHERWISE IT ISN"T IMPORTANT                                     # DON/D
                                                                         DON/D
      IF B<2>OPTION NQ 0 THEN                                            DON/D
          BEGIN                                                          DON/D
          POPR(QILOP"PAUS");                                             DON/D
          OPRNDV(CRDN);                                                  DON/D
          END                                                            DON/D
               POPN(DSEC);
               POPR(QILOP"LABL"); 
               XRDEF(DSEC,CRNO[BLNK[POZN]]);
               ENDSAV;        #CLOSE LABEL STACK BUFFER#
               APNM[DSEC]=SCPN[SCOPE];       #PUT SCOPE NAME IN LBL#
WLB11K:        ASEQ[LENT[CPLC]]=DSEC; 
               LENT[CPLC]=DSEC; 
               RETURN;
               END
          IF SBEG[PVDF]NQ SCOPE THEN GOTO WLB11A; #INSIDE DEC CONTROLS# 
          IF CLAS[PVDF]EQ S"FPAR" THEN
               BEGIN
WLB11C:                                                                  DON/D
          DIAG(D050,PVDF);   #IMPROPER PAR USE#                          DON/D
               GOTO WLB11A; 
               END
          IF CLAS[PVDF]EQ S"DUMY" THEN
               BEGIN
               IF FPRI[PVDF] EQ S"NAMC" THEN GOTO WLB11C; 
               POW(CSRF[BLNK[POZN]],LABWDS,QCLAS"LABL",CLIST"LABNAM");
               LREF[DSEC] = LREF[PVDF];        #COPY LREF FROM DUMY    #
               RLNK[PVDF]=DSEC;                   #RESOLVE OLD DUMMY
                                                  BY POINTING TO NEW
                                                  ENTRY#
       IF XTRN[PVDF] EQ S"ENT" THEN XTRN[DSEC] = S"ENT" ;                NEWFEAT
                               ELSE XTRN[DSEC] = S"LOC" ;                NEWFEAT
               GOTO WLB11B; 
               END
          IF CLAS[PVDF]NQ S"LABL" THEN
               BEGIN                              #DUPLICATE ERROR# 
WLB11D:                                                                  DON/D
          DIAG(D019,PVDF);                                               DON/D
               GOTO WLB11A; 
               END
          IF DECL[PVDF]EQ S"REAL"THEN GOTO WLB11D;     #DUPLICATE#
          IF FPRI[PVDF] EQ S"NAMC"
            THEN
            GOTO WLB11C;   # WHAT DO YOU THINK THIS LABEL IS #
          DSEC=PVDF;                              #USE THE OLD ENTRY--
                                                  IT WAS A FORWARD REF
                                                  TO A LABEL WHICH WE 
                                                  HAVE JUST DISCOVERED# 
          GOTO WLB11B;
  
  
#FORMAL LABEL DECLARATIONS# 
  
WFLB11:   # (STHEAD)(LABEL2) == (LBDH) #                                 NEWFEAT
         XLBFLG = S"LOC" ;  DCXFLG = 1;  RETURN  ;                       NEWFEAT
WXDC23:     # (XDECD)(LABEL2)  == (LBDH) #                               NEWFEAT
WFLB13:     # (XDECLH)(LABEL2) == (XDECLH)(LBDH) #                       NEWFEAT
          DIAG0 (D183);            # XREF/XDEF LABEL NOT OK IN SYMPL 2 #
          XLBFLG = CSRF[BLNK[POZN]] ;  # EXT OR ENT #                    NEWFEAT
          DCXFLG = 1;                                                    NEWFEAT
          RETURN;                                                        NEWFEAT
WSWD13:     # (XDECLH)(SWITC2) == (XDECLH)(SWITDH)    TEST   #           NEWFEAT
WXDC24:     # (XDECD)(SWITC2)  == (SWITDH)     TEST #                    NEWFEAT
          DIAG0 (D184);            # XREF/XDEF SWITCH NOT OK IN SYMPL 2#
          XLBFLG = CSRF [BLNK [ POZN ] ]     ;       #EXT OR ENT#        NEWFEAT
          DCXFLG = 1;                                                    NEWFEAT
          IF XLBFLG EQ S"EXT" THEN RPLI = 1;    #REPLACE XREF ONLY#      NEWFEAT
          RETURN;                                                        NEWFEAT
  
WFLB12:   #    (LABEL2)==(NULL)         # 
          ILKEY("LABEL",5); 
  
WFLB21:   #    (LBDBH(DECNAM)==(LBDB)   # 
          TPYA=QCLAS"LABL"; 
          TPYB=CLIST"LABNAM"; 
          TPYC=LABWDS;
          TLD1=CSRF[POZN];
        IF XLBFLG NQ S"LOC" THEN GOTO WFL21A;                            NEWFEAT
                          #THIS IS AN XREF/XDEF LIST #                   NEWFEAT
#NOW THE ROUTINE WILL DO FORMAL LABEL POSTING.  IT IS ALSO
 INVOKED FROM ELSEWHERE TO DO FORMAL PROC DECLARATIONS# 
  
WFL21X:   AERFLG=0; 
          IF PVDF EQ 0 THEN GOTO WFL21Y;          #BRAND NEW NAME:POST# 
          IF SBEG[PVDF] NQ SCOPE THEN GOTO WFL21Y;#LIKEWISE#
          IF CLAS[PVDF] EQ TPYA THEN              #THIS IS A FORMAL 
                                                   PROTECTIVE DEC FOR A 
                                                   LABEL OR PROC TO 
                                                   WHICH REFERENCE HAS
                                                   ALREADY BEEN MADE #
               BEGIN
               IF DECL[PVDF] EQ S"NONE" THEN GOTO WFL21Z; 
                                                  #IN THIS CASE THE OLD 
                                                   ENTRY IS ALREADY IN
                                                   THE FLCH CHAIN#
          IF DECL[PVDF]EQ S"REAL"  THEN DIAG(D109,PVDF);                 DON/D
                                   ELSE DIAG(D110,PVDF);                 DON/D
               RETURN;
               END
          IF CLAS[PVDF] EQ S"DUMY" THEN 
               BEGIN                              #RESOLUTION BY PROT-
                                                   ECTIVE DEC OF FORWARD
                                                   REF WHICH WAS AMBIG# 
               AERFLG=2;                          #FOR POST-POST SWITCH#
               GOTO WFL21Y; 
               END
          IF CLAS[PVDF] EQ S"FPAR" THEN BEGIN                            NEWFEAT
          IF FPRI[PVDF] EQ S"VALU"  THEN DIAG(D154,TLD1);                DON/D
                         AERFLG = 3;    END                              NEWFEAT
                                       # THIS IS A PROTECTI-             NEWFEAT
                                                                         NEWFEAT
                                                   TIVE FORMAL DEC FOR A
                                                   FORMAL PARAMTEER#
          ELSE AERFLG=1;      #DUPLICATE DEFINITION#
WFL21Y:   POW(TLD1,TPYC,TPYA,TPYB); 
          IF FLCH[DSEC] EQ 0 THEN BEGIN  #DONT DARE LOOP FLCH CHAIN#     NEWFEAT
          FLCH[DSEC]=FLCHED[SCOPE];               #ALL FORMAL DECS MUST 
                                                   APPEAR IN THE CHAIN# 
          FLCHED[SCOPE]=DSEC; 
          END                                                            NEWFEAT
WFL21Z:   DECL[DSEC]=S"FORMAL"; 
          #WHEN THE SCOPE GETS SHUT OFF, ANY OF THESE GUYS STILL
               NOT REDECLARED WILL BE DIAGNOSED, UNLESS THEY ARE PARAMS#
  
SWITCH WFL10S  WFL10A,WFL10B,WFL10C,WFL10D;       GOTO WFL10S[AERFLG];
  
WFL10D:   #FORMAL PARAMETER--LINK FPAR SECTIONS TO FORMAL DEC AND SET 
           FPRI--THE ENTIRE BATCH OF FPARS IS LINKED WITH 1 CALL# 
          FPLINK(PVDF,DSEC);
WFL10E:   ASEQ[LENT[DPLC]]=DSEC;             #ADD TO DATA CHAIN#
          LENT[DPLC]=DSEC;
          GOTO WFL10A;             # POST REFERENCE/DEFINITION AND RTN #
  
WFL10C:   #LINK DUMMY SECTION TO NEW FORMAL DEC#
          RLNK[PVDF]=DSEC;
          LREF[DSEC] = LREF[PVDF];             #COPY LREF FROM DUMY    #
          FPRI[DSEC]=FPRI[PVDF];                  #IN CASE IT WAS ON# 
          IF FPRI[DSEC] NQ 0 THEN GOTO WFL10E;    #ADD TO DATA CHAIN# 
          GOTO WFL10A;             # POST REFERENCE (ATTRIBUTE)        #
  
WFL10B:   #DUPLICATE DEFINITION#
          DIAG(D019,DSEC);                                               DON/D
 WFL10A:  
          IF FPRI[DSEC] EQ S"NAMC" # IS IT A FORMAL PROC FPRC OR NO    #
          THEN
            BEGIN 
            XRDEF(DSEC,CRNO[POZN]);   # ITS A FORMAL PROC DEFN         #
            END 
          ELSE
            BEGIN 
            XRATRB(DSEC,CRNO[POZN]);  # ITS ONLY AN ATTRIBUTE          #
            END 
          RETURN; 
WFL21A:     #WELCOME TO XREF/XDEF LABELS#                                NEWFEAT
          IF PVDF NQ 0 THEN BEGIN                                        NEWFEAT
                   #THIS NAME HAVE BEEN PREVIOUSLY REFERENCED#           NEWFEAT
                    IF SBEG[PVDF] NQ SCOPE THEN GOTO WFL21B;             NEWFEAT
                                       #THAT WAS OUTER SCOPE REFERENCE#  NEWFEAT
                    IF CLAS[PVDF] EQ S"LABL" THEN BEGIN                  NEWFEAT
                     #WE KNOW THAT IT IS A LABEL IN THIS SCOPE ALREADY#  NEWFEAT
                           DSEC = PVDF;                                  NEWFEAT
                           IF DECL[PVDF] EQ S"NONE" THEN                 NEWFEAT
                                       #JUST A PRIOR FORWARD REFERENCE#  NEWFEAT
                                                         GOTO WFL21C;    NEWFEAT
                           IF DECL[PVDF] EQ S"FORMAL" THEN               NEWFEAT
                           IF FPRI[PVDF] EQ S"NAMC" THEN                 NEWFEAT
                           #THIS SPECIFIED A FORMAL LABEL - CANNT XREF   NEWFEAT
                                       OR XDEF A FORMAL#                 NEWFEAT
          DIAG(D050,PVDF);                                               DON/D
                                                    ELSE  GOTO WFL21C;   NEWFEAT
                                       #PROTECTIVE DECS ARE O.K.#        NEWFEAT
                           IF DECL[PVDF] EQ S"REAL" THEN                 NEWFEAT
                           #LABEL FULLY DECLARED#                        NEWFEAT
                           BEGIN IF XLBFLG EQ S"EXT" THEN  #ITS XREF#    NEWFEAT
                                 BEGIN IF XTRN[PVDF] NQ S"EXT" THEN      NEWFEAT
          DIAG(D019,PVDF);                                               DON/D
                                       GOTO WFL21B;                      NEWFEAT
                                 END                                     NEWFEAT
                                                    ELSE  #XDEF TEST#    NEWFEAT
                                 IF XTRN[PVDF] EQ S"EXT" THEN            NEWFEAT
          DIAG(D107,PVDF);                                               DON/D
                                   ELSE #XDEF FOLLOWS THE LABEL#         NEWFEAT
                                                XTRN[PVDF] = S"ENT";     NEWFEAT
                           END #REAL#                                    NEWFEAT
                                                  END #PREVIOUS LABEL    NEWFEAT
                                                       KNOWLEDGE#        NEWFEAT
                                                                         NEWFEAT
                                             ELSE                        NEWFEAT
                    IF CLAS[PVDF] EQ S"FPAR" THEN #CANNOT XREF/XDEF#     NEWFEAT
          DIAG(D050,PVDF);                                               DON/D
                                           ELSE                          NEWFEAT
                    IF CLAS[PVDF] EQ S"DUMY" THEN                        NEWFEAT
                       BEGIN #LAST ENCOUNTER WAS AS AN ACTUAL PARAMETER# NEWFEAT
          IF FPRI[PVDF] EQ S"NAMC" THEN DIAG(D050,PVDF);                 DON/D
                                   #IN FACT IT WAS A FORMAL PARAMETER#   NEWFEAT
                                                ELSE GOTO WFL21B;        NEWFEAT
                                    #OTHERWISE POST A NEW LABEL#         NEWFEAT
                       END                                               NEWFEAT
                                                                         NEWFEAT
                                             ELSE                        NEWFEAT
                       BEGIN   #NO OTHER CLAS CAN BE XREF/XDEF LABEL#    NEWFEAT
          DIAG(D019,PVDF);                                               DON/D
                       GOTO WFL21B;                                      NEWFEAT
                       END                                               NEWFEAT
                    RETURN;                                              NEWFEAT
                    END #ALL LEGAL PVDF CASES HAVE JUMPED TO WFL21B / C# NEWFEAT
                                                                         NEWFEAT
                                                                         NEWFEAT
          # ALL HAIL  WFL21B#                                            NEWFEAT
WFL21B:   POW(TLD1,TPYC,TPYA,TPYB);                                      NEWFEAT
          IF TPYA EQ QCLAS"LABL" THEN 
            APNM[DSEC] = SCPN[SCOPE]; 
          IF  XLBFLG EQ S"ENT"     # XDEF DECL                         #
          THEN
            BEGIN 
            IF FLCH[DSEC] EQ 0
            THEN
              BEGIN                # DONT DARE TO OVERWRITE FLCH CHAIN #
              FLCH[DSEC] = FLCHED[SCOPE]; 
              FLCHED[SCOPE] = DSEC;  # THIS ENSURES SUBSQ REAL DECL    #
              END 
            END 
                                                                         NEWFEAT
WFL21C:   #WELCOME TO PRIOR FORWARD REFERENCES TO LABELS#                NEWFEAT
          XTRN [DSEC] = XLBFLG;  #XDEF/XREF#                             NEWFEAT
          IF  XLBFLG EQ S"EXT"     # XREF DEC                          #
          THEN
            BEGIN 
            DECL[DSEC] = S"REAL"; 
            XCHAIN(DSEC); 
            XRDEF(DSEC,CRNO[POZN]);  # PUT DEFIN. ENTRY IN XREF        #
            END 
          ELSE   # XDEF            #
            BEGIN 
            DECL[DSEC] = S"FORMAL"; 
            XRATRB(DSEC,CRNO[POZN]);  # PUT ATRIB. ENTRY IN XREF       #
            END  # WE HAVE FINALLY RESOLVED AN AMBIGUOUS USE           #
                                                                         NEWFEAT
          IF PVDF NQ 0 AND CLAS[PVDF] EQ S"DUMY" THEN                    NEWFEAT
                    #PREVIOUSLY USED AS AN ACTUAL PARAMETER#             NEWFEAT
                    RLNK[PVDF] = DSEC;  #RESOLVE DUMMY#                  NEWFEAT
                    LREF[DSEC] = LREF[DSEC] + LREF[PVDF]; 
          RETURN;                                                        NEWFEAT
  
  
WFLB22:   #    (LBDH)==(BAD)       #
          DIAG0(D054);                                                   PF12 
          RETURN; 
  
#WFLB31--SEE WID1--SET DECLARATIVE CONTEXT# 
  
WFLB32:   #    (LBDB)==(BAD)       #
          DIAG(D026,NSEC);                                               DON/D
          RETURN; 
  
  
#FORMAL PROCEDURE DECLARATIONS# 
  
#WFPD11--SEE WID1--SET DECLARATIVE CONTEXT# 
  
WFPD12:   #    (FPRC2)==(NULL)          # 
WFPD22: 
          ILKEY("FPRC",4);
  
WFPD21:   #    (FPDH)(DECNAM)==(FPDB)        #
          TPYA=QCLAS"PROC"; 
          TPYB=CLIST"PRCNAM"; 
          TPYC=PRCWDS;
          TLD1=CSRF[POZN];
          GOTO WFL21X;                            #USES FORMAL LBL STUF#
  
WFPD32:   #    (FPDB)==(BAD)       #
          DIAG0(D026);                                                   PF12 
          RETURN; 
  
  
#COLLECTION OF BAD DECLARATIONS TO SEMICOLON# 
  
WBAD11:   #    (BAD)(SEMI2)==(BAD)      # 
WBAD12:   #    (BAD)(SEMI) ==(BAD)      # 
          DIAG0(D021);                                                   PF12 
          RETURN; 
  
#WBAD14--SEE OXC6--ABNORMAL END#
  
  
#FUNCTION DECLARATIONS--EXTERNAL,STANDALONE,FORMAL,WHATHAVEYOU# 
  
  
  
PROC CCHAIN;             #ENTER PROC OR FUNC INTO CODE CHAIN# 
     BEGIN
          IF FDECTP EQ S"XREF" THEN XCHAIN(DSEC);   #USE XTRN CHAIN # 
          ELSE IF FDECTP NQ S"XDEF" THEN     #DON"T CHAIN IF XDEF#
                    BEGIN 
                    ASEQ[LENT[CPLC]]=DSEC;        #ADD TO CHAIN#
                    LENT[CPLC]=DSEC;              #NEXT ON CHAIN# 
                    END 
     END
  
  
  
#WFNC10--RULE(FUNC2)--SEE WID1--SET DECLARATIVE CONTEXT#
#WFNC11--SEE WPRD11--SET FDECTP TO SIMPLE#
#WFNC12--SEE WPRD12--SET FDECTP FOR EXTERNAL DEC# 
  
WFNC19:   #    (FDECHD)(ANY)==(FBAD)(ANY)                              #
          SCPIN;
          DIAG0 (D010); 
WFNC99:   #    (ANY)(FUNC2)==(NULL) DOWN                               #
WFNC18:   #    (FDECHD)==(NULL)                                        #
          ILKEY("FUNC",4);
  
#WFNC13--SEE WPRD13--SET FDECTP TO ALONE# 
  
WFNC15:   #    RULE(FDECHD)        #
          DESFLG=1;                               #IN CASE NO PARS# 
          RETURN; 
  
SWITCH WFN16S:QFDECT          #SWITCH FOR FUNC DECS, ON DEC TYPE# 
          WFN161:SIMPLE,
          WFN162:ALONE, 
          WFN163:XDEF,
          WFN164:XREF,
          WFN165:ENTRY; 
  
WFN162:   MPRC[DSEC]=TRUE;
WFN161: 
WFN165:   IF FPRI[DSEC] EQ S"NULL" THEN 
WFN166:   RPLI=1; 
WFN167:   DECL[DSEC]=S"REAL"; 
          RETURN; 
WFN164:   XTRN[DSEC]=S"EXT";
          GOTO WFN167;
WFN163:   XTRN[DSEC]=S"ENT";
          DECL[DSEC]=S"FORMAL";         #XDEF FUNCS ARE MARKED WITH 
                                        DECL=S"FORMAL", SO THAT AT
                                        END OF SCOPE THEY CAN BE
                                        DIAGNOSED IF NOT FULFILLED# 
          IF FLCH[DSEC]EQ 0 THEN
               BEGIN                         #PUT ON FLCH UNLESS THERE
                                             ALREADY# 
               FLCH[DSEC]=FLCHED[SCOPE];
               FLCHED[SCOPE]=DSEC;
               END
          RETURN; 
WFNC16:   #    TEST(FDECHD)(DECNAM)==(FDECTP)     # 
          #THIS TEST SEPARATES THOSE FUNCTION DECS WHICH MAY HAVE FORMAL
          PARAMETERS FROM THOSE WHICH MAY NOT.  THE TEST SUCCEEDS FOR 
          THOSE OF THE FORMER TYPE #
  
          IF PVDF EQ 0 THEN 
               BEGIN               #ORDINARY UNCOMPLICATED CASE#
WFN16A:        POW(CSRF[POZN],FNCWDS,QCLAS"FUNC",CLIST"FNCNAM");
               XTRN[DSEC]=S"LOC";       #DEFAULT VALUE# 
WFN16B: 
               CCHAIN;   #ADD TO CODE CHAIN IF APPROPRIATE# 
               IF  FDECTP NQ S"XDEF"
               THEN 
                 BEGIN
                 XRDEF(DSEC,CRNO[POZN]);     # ACTUAL DEFINITION ONLY  #
                 END
               ELSE                # OUTPUT ATRIBUTE ENTRY             #
                 BEGIN
                 XRATRB(DSEC,CRNO[POZN]); 
                 END
               MPRC[DSEC]=FALSE;
               ITMLOC=DSEC;        #LOCATION OF FUNC# 
               GOTO WFN16S[FDECTP]; 
               END
          #CHECK TO SEE IF THE PREVIOUS DEC IS THIS SCOPE#
          IF SBEG[PVDF]NQ SCOPE THEN GOTO WFN16A; 
          #WE NOW KNOW THERE WAS ALREADY A DEC THIS NAME THIS SCOPE#
          IF CLAS[PVDF]EQ S"FPAR" THEN
               #LEGAL FORMAL DEC FOR PARAMETER IF SIMPLE FUNC DEC#
               BEGIN
               IF FDECTP NQ S"SIMPLE" THEN
                    BEGIN 
WFN16C:                                                                  DON/D
          DIAG(D050,PVDF);   #HELLUVAWAY TO TREAT A PARAMETR#            DON/D
                    GOTO WFN16A;
                    END 
               POW(CSRF[POZN],FNCWDS,QCLAS"FUNC",CLIST"FNCNAM");
               XRDEF(DSEC,CRNO[POZN]);       #DEF TYPE CROSSREF#
               FPLINK(PVDF,DSEC);            #FIX UP THE PARAMETERS#
               ITMLOC=DSEC; 
               GOTO WFL10E;        #ADD TO DATA CHAIN#
               END
          #THE DEC BETTER BE AN XDEF FUNC, OR ELSE# 
          IF CLAS[PVDF]NQ S"FUNC" THEN
WFN16D:        BEGIN
          DIAG(D019,PVDF);   #DUPLICATE#                                 DON/D
               GOTO WFN16A;                       #POST NEW ONE#
               END
          IF FPRI[PVDF] EQ S"NAMC" THEN GOTO WFN16C;
          #IF THE OLD ONE WAS REAL AND THIS ONE XDEF, THATS OK--IF VICE 
          VERSA, THATS OK TOO, ANY OTHER COMBINATION IS WRONG#
          IF DECL[PVDF]EQ S"REAL" THEN
               BEGIN
               XRATRB(DSEC,CRNO[POZN]);   # POST ATRIBUTE IN XREF      #
               XTRN[PVDF]=S"ENT"; 
               ITMLOC=PVDF; 
               RETURN;
               END
          IF FDECTP EQ S"XDEF"OR FDECTP EQ S"XREF"THEN
               BEGIN
          DIAG(D107,PVDF);                                               DON/D
               ITMLOC=PVDF; 
               RETURN;
               END
          DSEC=PVDF;                              #USE OLD ONE# 
          GOTO WFN16B;
  
#THE PROCESSING OF TYPE FOR A FUNCTION DEC IS EXACTLY LIKE THAT FOR A 
 SIMPLE ITEM DEC.  HENCE, THE FOLLOWING DEFINITIONS ARE PROCESSED 
 DIRECTLY BY THOSE SECTIONS FO THE ITEM PROCESSOR WHICH ARE THEIR 
 RESPECTIVE COUNTERPARTS: 
          WFNC26: 
          WFNC27: 
          WFNC28: 
          WFNC29
          WFNC31
          WFNC36: 
          WFNC40: 
          # 
  
WFNC37:   #    (FHDCL)==(FBAD)     #
WFNC32:   #    (FHDS)==(FBAD) # 
          DIAG(D059,ITMLOC);                                             DON/D
          TYPE[ITMLOC]=S"IGR";                    #DEFAULT FOR ERROR# 
          RETURN; 
  
WFNC42:   #    (FHD)==(FBAD)  # 
          DIAG(D026,ITMLOC);                                             DON/D
          RETURN; 
  
WFNC45:   #    (FBAD)(BEGIN2)==(FHEAD)(BEGIN2)    # 
          DIAG0(D025);             # RESTART SCAN AT BEGIN             # PF12 
          RETURN; 
  
WFNC46:   #    (FBAD)(SEMI2)==(FHEAD)        #
WFNC47:   #    (FBAD)(SEMI) ==(FHEAD)        #
          DIAG0(D061);                                                   PF12 
          RETURN; 
  
#WFNC49--SEE OXC6--ABNORMAL END#
  
WFNC52:   #    (FHEAD)==(SPTOP)    #
WPRD52:   #    (PHEAD)==(SPTOP)    #
          CSRF[POZN]=ITMLOC;       #SAVE SUBR LOCATION# 
          RETURN; 
  
WFNC51:   #    TEST(FHEAD)==(DEC)       # 
     #THIS TEST SEPARATES THOSE FUNCTION LINES WHICH ARE THE TOPS OF
          COMPLETE FUNCTION DECLARATIONS WITH A BODY, FORM THOSE
          FOR WHICH THERE IS NO MORE.    THE LATTER TYPE SUCCEED# 
          IF FDECTP EQ S"SIMPLE" THEN 
               BEGIN                              #SEE IF FORMAL DEC# 
               IF FPRI[ITMLOC] EQ S"NAMC" 
               THEN 
                 BEGIN
                 RPLI = 1 ; 
                 END
  
               IF FPRI[ITMLOC] EQ S"VALU" 
               THEN 
                 BEGIN
                 RPLI = 1;
                 DIAG(0154,ITMLOC); 
                 FPRI[ITMLOC] = S"NAMC";
                 END
  
               RETURN;
               END
          IF FDECTP EQ S"ALONE" THEN
               BEGIN          #SET XTRN TO KEEP CODGEN HAPPY# 
               XTRN[ITMLOC]=S"ENT"; 
               RETURN;
               END
          RPLI=1;                                 #HITS FOR XTRNLS# 
                                                  #ALSO FOR ENTRY DECS# 
          IF FDECTP EQ S"ENTRY" AND SBEG[ITMLOC]EQ 1 THEN 
               XTRN[ITMLOC]=S"ENT"; 
          GOTO WPR51A;
  
#CODE TO PICK UP PARAMETER LIST AND POST FPARS# 
  
WFNC60:   #    RULE(FDECTP)        #
                                                  #THE NAME IS OUTSIDE, 
                                                   THE PARS INSIDE# 
          LISTYP=0;                               #TO DISTINGUISH FROM
                                                   PROC DECS AT END # 
          GOTO WPR30A;
  
WFNC61:   #    (FDECTP)(SPARE2)==(FPARLH)         # 
          DESFLG=0;                               #ONLY NEEDED IF FUNC# 
          DCXFLG=1;                               #SET DECLARE CONTXT#
          RETURN; 
WFNC81:       #       (FVLPRH) == (FBAD) DOWN #                          NEWFEAT
WFNC90:       #       (FVLPRT) == (FBAD) DOWN #                          NEWFEAT
          DIAG0(D165);                                                   PF12 
          RETURN;                                                        NEWFEAT
                                                                         NEWFEAT
WFNC80:        #  (FVLPRH)(DECNAM) ==  (FVLPRT) DOWN  #                  NEWFEAT
               FORMLTP = S"VALU" ;                                       NEWFEAT
               GOTO WFN66B;                                              NEWFEAT
                                                                         NEWFEAT
  
WFNC66:   #    (FPARLH)(DECNAM)==(FPART)          # 
               FORMLTP  = S"NAMC" ;                                      NEWFEAT
WFN66B:                                                                  NEWFEAT
          TLD1=CSRF[POZN];
          POW(TLD1,FPRWDS,QCLAS"FPAR",CLIST"UND");
          XRDEF(DSEC,CRNO[POZN]); 
               FPRI[DSEC] = FORMLTP;                                     NEWFEAT
          FIND(ITMLOC,TPYA);       # FIND NAME ENTRY FOR FUNCTION.     #
          FIND(DSEC,TPYB);         # FIND NAME ENTRY FOR FORMAL PARM.  #
          IF TPYA EQ TPYB          # IF SAME NAME, THEN ERROR.         #
          THEN
            BEGIN 
            DIAG(D224,DSEC);
            END 
  
#FIRST--LINK THE NEW FPAR INTO THE FPLN--NFPR CHAIN#
          IF FPLN[ITMLOC] EQ 0 THEN FPLN[ITMLOC]=DSEC;  #DONE#
          ELSE BEGIN                              #NOT SO EASY# 
               TPYA=FPLN[ITMLOC];                 #PREVIOUS FPAR# 
WFN66A:        IF PVDF EQ TPYA THEN 
                    # ODD ERROR--TWO PARAMETERS IN SAME LIST WITH 
                    SAME NAME---# 
                    BEGIN 
          DIAG(D062,TLD1);                                               DON/D
                    PVDF=0;                       #FORGET THE FIRST#
                    END 
               IF NFPR[TPYA]EQ 0 THEN NFPR[TPYA]=DSEC;  #DONE#
               ELSE BEGIN 
                    #LINK TO NEXT PARAMETER AND GO AROUND AGAIN#
                    TPYA=NFPR[TPYA];
                    GOTO WFN66A;
                    END 
               END
#NOW CHAIN THE NEW PARAMETER INTO THE FLCH CHAIN# 
          IF FLCH[DSEC] EQ 0 THEN BEGIN  #DONT DARE LOOP FLCH CHAIN#     NEWFEAT
          FLCH[DSEC]=FLCHED[SCOPE]; 
          FLCHED[SCOPE]=DSEC; 
          END                                                            NEWFEAT
#NOW INSPECT ANY PRIOR USES OF THE SAME NAME THIS SCOPE#
          IF PVDF EQ 0 THEN RETURN;               #NONE#
          IF SBEG[PVDF] NQ SCOPE THEN RETURN;     #NONE THIS SCOPE# 
          #SEVERAL FPARS TO SAME PROC MUST BE LINKED TOGETHER, SO THAT
          WHEN A FORMAL DEC FINALLY OCCURS, ALL FPARS CAN POINT TO IT.
          THIS FPAR LINKING IS DONE WITH FDFP, THE SAME LINK WHICH
          IS EVENTUALLY USED TO POINT TO THE FORMALLY DECLARING 
          ENTITY.  THIS HAS THE EFFECT THAT IF NO DECLARATION IS EVER 
          RECEIVED FOR THESE PARAMETERS, ONLY ONE OF THEM (THE FIRST) 
          WILL GET A DIAGNOSTIC, SINCE THE TEST AT END OF SCOPE IS
          FOR NONZERO FDFP.  THIS SUITS ME JUST FINE# 
   IF CLAS[PVDF] EQ  S"FPAR" THEN BEGIN                                  NEWFEAT
                                  FDFP[DSEC] = PVDF;                     NEWFEAT
          IF FPRI[PVDF] NQ FPRI[DSEC] THEN DIAG(D152,DSEC);              DON/D
                                  END                                    NEWFEAT
          ELSE
               IF FPRI[PVDF] EQ S"NULL" THEN
                    #ERROR CASE-- A LOCAL VARIABLE TO A PROC OR FUNC
                    HAS BEEN NAMED AS A PARAMETER ON AN ENTRY LINE# 
          DIAG(D063,TLD1);                                               DON/D
               ELSE BEGIN     #THIS IS A PROPER BUT ANNOYING SITUATION. 
                    IT ARISES WHEN A PARAMETER TO THE CURRENT PROC
                    IS BEING RENAMED ON AN ENTRY LINE, HAVING BEEN
                    ALREADY FORMALLY DEFINED.  IT IS ANNOYING SINCE 
                    IN ORDER THAT FUTURE REFERENCES TO THE ANME GET TO
                    THE FORMAL DECLARATION INSTEAD OF THIS NEW FPAR,
                    THIS ENTRY MUST BE ARTIFICIALLY NLNK CHAINED ON 
                    THE REAR SIDE OF THE OLD FORMAL DEC.  THIS IS TRICKY
                    SINCE WHOLE SCOPE LEVELS MAY HAVE INTERVENED, WITH
                    USES OF THE SAME NAME.  CONSIDER THE FOLLOWING CASE:  
                         PROC P(A)
                         BEGIN
                         ITEM A 
                              PROC Q(A) 
                                   (LOTS OF STUFF)
                              END 
                         ENTRY PROC X(A)
                    UGH.
                    # 
                    FDFP[DSEC]=PVDF;              #ALREADY FORMALLY IN# 
                    NLNK[TLD1]=NLNK[DSEC];        #LINK AROUND NEW FPAR#
                                                  #TLD1 POINTS TO NAME# 
                    NLNK[DSEC]=NLNK[PVDF];        #POINT FPR TO DESIRABL
                                                   PLACE JUST PAST OLD
                                                   DEC# 
                    NLNK[PVDF]=DSEC;              #HOO HAH# 
                      IF FPRI[PVDF] NQ FPRI[DSEC] THEN DIAG(152,DSEC);   NEWFEAT
                    END 
          RETURN; 
  
WFNC74:   #    (FPART)==(FBAD)          # 
WFNC67:   #    (FPARLH)==(FBAD)         # 
          DIAG(D064,ITMLOC);                                             PF12 
          RETURN; 
  
#WFNC71--SEE WID1--SET DECLARATIVE CONTEXT# 
  
WFNC72:   #    TEST(FPART)(RPARE2)==(FHSEG)  #
          IF LISTYP EQ 1 THEN RETURN;             #PROC#
          RPLI=1;                                 #FUNC SECCEEDS TEST#
          DESFLG=1;                               #PREPARE FOR TYPE#
          RETURN; 
  
  
#PROC DECLARATIONS# 
  
#WPRD10--SEE WID1--SET CONTEXT# 
  
WFNC11:   #    (STHEAD)(FUNC2)==(STHEAD)(FDECHD)  # 
WPRD11:   #    (STHEAD)(PROC2)==(STHEAD)(PDECHD)  # 
          FDECTP=S"SIMPLE"; 
          RETURN; 
  
WPRD12:   #    (XDECLH)(PROC2)==(XDECLH)(PHTOP)        #
WXDC19:   #    (XDECD)(PROC2)==(PHTOP)       #
WXDC20:   #    (XDECD)(FUNC2)==(FDECHD)      #
WFNC12:   #    (XDECLH)(FUNC2)==(XDECLH)(FDECHD)       #
          DCXFLG=1; 
          FDECTP=S"XDEF"; 
          IF CSRF[BLNK[POZN]] EQ QXTRN"EXT" THEN FDECTP=S"XREF";
          RETURN; 
  
WFNC13:   #    (FUNC2)==(FDECHD)        # 
WPRD13:   #    (PROC2)==(PDECHD)        # 
          FDECTP=S"ALONE";
          RETURN; 
WPRD23:   #    (PDECHD)(ANY)==(FBAD)(ANY)                              #
          SCPIN;
         DIAG0 (D010);
WPRD22:   #    (PDECHD)==(NULL)                                        #
WPRD99:   #    (ANY)(PROC2)==(NULL) DOWN                               #
          ILKEY("PROC",4);
  
WPRD61:   #    (PHTOP)(DECNAM)==(PHSEG)      #
WPRD21:   #    (PDECHD)(DECNAM)==(PDECTP)         # 
          IF PVDF EQ 0 THEN 
               #UNCOMPLICATED CASE--NO PRIOR DEC EXISTS--POST AND BE
                DONE WITH IT# 
               BEGIN
WPR21A:        POW(CSRF[POZN],PRCWDS,QCLAS"PROC",CLIST"PRCNAM");
               XTRN[DSEC]=S"LOC"; 
WPR21K:        CCHAIN;        #ADD TO CODE CHAIN IF APPROPRIATE#
               ITMLOC=DSEC; 
               IF  FDECTP NQ S"XDEF"    # HANDLE -XDEF PROC- ENTRIES   #
               THEN 
                 BEGIN
                 XRDEF(DSEC,CRNO[POZN]);    # POST DEFIN. IN XREF FILE #
                 END
               ELSE 
                 BEGIN
                 XRATRB(DSEC,CRNO[POZN]);   # POST ATRIBUTE IN XREF    #
                 END
               DECL[DSEC]=S"REAL";
               IF FDECTP EQ S"XDEF" THEN
                    BEGIN 
                    DECL[DSEC]=S"FORMAL"; 
                    IF FLCH[DSEC]EQ 0 THEN
                         #THE EXTERNAL DEC MUST BE PUT ON FLCH FOR
                         CHECKING AT THE END OF SCOPE--HOWEVER, IF IT 
                         IS ALREADY THERE, WHICH IT WILL BE IF A FORMAL 
                         PROTECTIVE DEC OCCURS BEFORE THE XDEF, THEN
                         PUTTING IT ON AGAIN WOULD LOOP THE CHAIN,
                         CAUSING COMPILATION TO BE SLOWER THAN USUAL# 
                         BEGIN
                         FLCH[DSEC]=FLCHED[SCOPE];
                         FLCHED[SCOPE]=DSEC;
                         END
                    END 
               RETURN;
               END
          #OUTER SCOPES DONT AFFECT INNER ONES# 
          IF SBEG[PVDF]NQ SCOPE THEN GOTO WPR21A; 
          IF CLAS[PVDF]EQ S"FPAR" THEN
               #THIS IS NEVER LEGAL--FORMAL DECS FOR PROC PARS USE FPRC#
               BEGIN
WPR21C:                                                                  PF12 
          DIAG(D050,PVDF);                                               PF12 
               GOTO WPR21A;                       #TOO BAD, PARAMETER#
               END
          #CHECK FOR PRIOR DUMMY# 
          IF CLAS[PVDF]EQ S"DUMY" THEN
               #WE HAVE NOW RESOLVED THE OLD DUMMY.  THIS IS ALRIGHT
               UNLESS IT WAS SATISFYING A FORMAL PAR, IN WHICH CASE 
               THE PARAMETER HAS BEEN MISHANDLED# 
               BEGIN
               IF FPRI[PVDF] EQ S"NAMC" THEN GOTO WPR21C; 
               POW(CSRF[POZN],PRCWDS,QCLAS"PROC",CLIST"PRCNAM");
               XRDEF(DSEC,CRNO[POZN]);
               RLNK[PVDF]=DSEC;                   #POINT DUMMY HERE#
               GOTO WPR21K; 
               END
          # AT THIS POINT, SINCE THE PRIOR DEC IS NEITHER A DUMMY OR
          AN FPAR, IT IS A DUPLICATE DEF IF NOT A PRIOR MENTION OF THE
               SAME PROC# 
          IF CLAS[PVDF]NQ S"PROC" THEN
               BEGIN
WPR21D:                                                                  PF12 
          DIAG(D019,PVDF);                                               PF12 
               GOTO WPR21A; 
               END
          #OLD PROC ORDINARY, THIS DEC XDEF---OK. 
          OLD PROC XDEF  THIS DEC ORDINARY---OK.
          OLD PROC FORMAL OR FORWARD REFERENCE, THIS ONE REAL OR XDEF-OK
                    VARIOUS OTHER COMBINATIONS INVALID# 
          IF DECL[PVDF] EQ S"REAL" THEN 
               BEGIN
               IF FDECTP NQ S"XDEF" THEN GOTO WPR21D; 
WPR21E:                                                                  PF12 
               IF XTRN[PVDF] NQ S"LOC"                                   PF12 
               THEN                                                      PF12 
                 BEGIN                                                   PF12 
                 DIAG(D107,PVDF);  # DBL XDEF                          # PF12 
                 END                                                     PF12 
               ITMLOC=PVDF; 
               ASEQ[LENT[CPLC]]=PVDF; 
               XRATRB(DSEC,CRNO[POZN]);    # POST ATRIBUTE IN XREF     #
               RETURN;
               END
          IF DECL[PVDF]EQ S"FORMAL" THEN
               BEGIN
               IF FDECTP EQ S"XDEF" THEN
                    BEGIN 
                    IF FPRI[PVDF] EQ S"NAMC"                             PF12 
                    THEN                                                 PF12 
                      BEGIN                                              PF12 
                      DIAG(D050,PVDF);                                   PF12 
                      END                                                PF12 
                    GOTO WPR21E;
                    END 
               END
          DSEC=PVDF;                              #USE OLD ONE# 
          GOTO WPR21K;
  
WPRD62:   #    (PHTOP) ==(BAD)          # 
          DIAG0(D065);                                                   PF12 
          RETURN; 
  
WPRD30:   #    RULE(PDECTP)        #
          LISTYP=1;                               #AS DIFF FROM FUNCS#
          ITMLOC=DSEC;
          IF FDECTP EQ S"ALONE" THEN MPRC[DSEC]=TRUE; 
                                ELSE MPRC[DSEC]=FALSE;
WPR30A:   IF FDECTP EQ S"ENTRY" THEN
               BEGIN
               SCOPE=INSCPL;
               SCPLEV=SCPLEV+1;         #RESTORE SCOPE LEVEL# 
               ENDM[SCOPE]=FALSE; 
               RETURN;
               END
          IF FDECTP EQ S"ALONE" THEN    #SET UP PROGRAM NAME# 
               BEGIN
               FIND(ITMLOC,TPYA);     #GET POINTER TO NAME SECTION# 
               SCPN[0]=TPYA;     #SET INOT SCOPE TABLE# 
               END
          SCPIN;
          SCPN[NXTBN]=ITMLOC ;          #SCOPE NAME,THIS SCOPE# 
          RETURN; 
  
#WPRD31--SEE WID1--SET DECLARATIVE CONTEXT# 
  
WPRD40:   #    RULE (PHSEG)   # 
          IF FDECTP EQ S"XDEF" THEN XTRN[ITMLOC]=S"ENT";
          IF FDECTP EQ S"XREF" THEN XTRN[ITMLOC]=S"EXT";
          IF FDECTP EQ S"ENTRY" AND SBEG[ITMLOC] EQ 1 THEN
               XTRN[ITMLOC]=S"ENT"; 
          IF MPRC[ITMLOC]THEN XTRN[ITMLOC]=S"ENT";
          RETURN; 
  
WPRD42:                                                                  PF12 
          DIAG(D066,ITMLOC);                                             PF12 
          RETURN; 
  
WPRD51:   #    TEST(PHEAD)==(DEC)       # 
          #THIS TEST SEPARATES REAL PROCEDURE DECLARATIONS FROM THE 
          ABBREVIATED PROCEDURE LINES FOUND IN XDEF AND XREF DECS.
          FORMAL PROCEDURE DECS ARE PRECESSED BY AN ENTIRELY
          SEPARATE SECTION.  THE TEST SHOULD SUCCEED ONLY FOR XTRNL DEC-
          LARATIONS AND ENTRY DECS# 
          IF FDECTP EQ S"ALONE" THEN RETURN;
          RPLI=FDECTP;
WPR51A:   IF FDECTP EQ S"ENTRY" THEN
               BEGIN
               IF PSTLS EQ 0 THEN  #NO BUFFER YET#
                    BEGIN 
                    CSAV(PSTLS);   #OPEN LABEL BUFFER#
                    VALID(PSTLS); 
                    END 
               ELSE OSAV(PSTLS);   #REOPEN OLD ONE# 
               POPN(ITMLOC);                 #ENTRY NAME# 
               POPR(QILOP"ENTR"); 
               ENDSAV;
               END
          RETURN; 
  
  
#ENTRY DECLARATIONS#
#ENTRY DECLARATION PROCESSING IS HIGHLY INVOLVED# 
WENT18: 
WENT12:   ILKEY("ENTRY",5); 
WENT16:   #    (ENTDEC)(PROC2)==PHTOP)  # 
WENT17:   #    (ENTDEC)(FUNC2)==(FDECHD)     #
          INSCPL=SCOPE; 
          SCPOUT; 
          FDECTP=S"ENTRY";
        IF SCOPE EQ 1 AND CLAS[SCPN[2]] EQ S"PROG"
          THEN DIAG0(D147);                                              PF12 
          DCXFLG=1; 
          RETURN; 
  
  
#    EXPRESSION STUFF--SCANS TWO AND THREE        # 
  
WSCD10:   #    (SEMI2)==(SEMI3)    UP        #
WSCD11:   #    (DO2)==(DO3)   UP   #
WSCD12:   #    (THEN2)==(THEN3)    UP   # 
WSCD13:   #    (BEGIN2)  ==   (BEGIN3)  # 
WSCD14:   #    (TERM2)==(TERM3)    UP   # 
WSCD15:   #    (ELSE2)==(ELSI3)    UP   # 
WSCD16:   #    (END2)==(END3) UP   #
          CSAV(TPYA);              #OPEN CRUD BUFFER# 
          RETURN; 
  
  
WEXP99:   CSRF[POZN]=OP; RETURN;
  
WEXP20:   #    (SIGN)==(AOP)       #
          IF CSRF[POZN] EQ 1 THEN OP=S"MINUS";
                             ELSE OP=S"PLUS";     GOTO WEXP99;
WEXP21:   OP=S"EXP" ; GOTO WEXP99;
WEXP22:   OP=S"LNO" ; GOTO WEXP99;
WEXP23:   OP=S"LOR" ; GOTO WEXP99;
WEXP24:   OP=S"LAN" ; GOTO WEXP99;
WEXP25:   OP=S"LIM" ; GOTO WEXP99;
WEXP26:   OP=S"LXR" ; GOTO WEXP99;
WEXP27:   OP=S"LQV" ; GOTO WEXP99;
WEXP28:   OP=S"STAR"; GOTO WEXP99;
WEXP29:   OP=S"SLASH";GOTO WEXP99;
WEXP50:   OP=S"EQ"   ;GOTO WEXP99;
WEXP51:   OP=S"NQ"   ;GOTO WEXP99;
WEXP52:   OP=S"GR"   ;GOTO WEXP99;
WEXP53:   OP=S"GQ"   ;GOTO WEXP99;
WEXP54:   OP=S"LS"   ;GOTO WEXP99;
WEXP55:   OP=S"LQ"   ;GOTO WEXP99;
  
#**********    END OF PROG         #
      WCSP9: IF CSRF[BLNK[POZN]] NQ 1 THEN
               BEGIN
          DIAG0(D086);                                                   PF12 
               CSRF[BLNK[POZN]]=1;
  S$EMI;
    CSAV(TYPA);  # OPEN CRUD BUFFERS# 
   ENDSAV;
   #PRINT THE JUNK LINE#
    T$ERM;  #INSERT TERM #
    XRFCLS; #TIDY UP PROG#
    HATEND;                        # REORDER ILFAT                     #
   #NOW SKIP REST OF GARBAGE# 
           END
            CSRF$;
          PGIX=5; 
          RETURN; 
WDEC15: 
          SYMABT(J821,"COMPOUND STATEMENT COLLECTION ERR(PF12)",39);     PF12 
END 
TERM
