*DECK CRFLST
USETEXT   TSOURCE 
USETEXT   TSYMCNS 
USETEXT   TCEXECQ 
USETEXT   TCEXEC
      PROC CRFLST;
      BEGIN 
#----------------------------------------------------------------------#
#        P R O C   C R F L S T                                         #
#                                                                      #
#----------------------------------------------------------------------#
  
*CALL COMEX 
*CALL COM99A
  
      DEF  CRF$ARRAY  #XREF ARRAY ACRF  S(1)#;
  
*CALL COM19A
      XREF PROC PTLST;
      XREF PROC FIND; 
      XREF PROC GTCRF;
      XREF ITEM CRFPART C(10);
      XREF PROC BINDEC; 
  
      DEF  NONULLS  #B<59 - "N">OPTION EQ 0 #;
      DEF  LBIT     #54#;          # FIRST BIT OF LAST BYTE            #
      DEF  ZEROW    #"0000000000"#; 
      DEF  HZERO    #O"33"#;       # DISPLAY CODE FOR ZERO             #
      DEF  HAST     #O"47"#;       # DISPLAY CODE FOR ASTERISK         #
      DEF  CRFSZ    #ECRF#; 
      DEF  ESCP     #127#;         # SCOPE TABLE SIZE                  #
      DEF  ECXR     #12#;          # LINE BUFFER SIZE                  #
      DEF  WCXR     #5#;           # REF CARD WORD                     #
      DEF  BCXR     #42#;          # REF BIT                           #
      DEF  CCXR     #3#;           # CLEAR CRF                         #
      DEF  DEFPARM  # 4 #;         # DEF PARAM HAS ? IN 4TH CHAR       #
      DEF  HAH      #1#;           # DISPLAY CODE FOR LETTER A         #
      DEF  DEFWORD  # 3 #;         # WORD NO. OF DEF IN PRINT$LINE     #
      DEF  DEFBIT   # 24 #;        # BIT NO. OF DEF IN PRINT$LINE      #
      DEF  MAXTXTM1 # 63 #;        # MAX NO. OF TEXTS - 1              #
  
      $BEGIN
      DEF  D$STDUMP #23#;          # *=X DUMPS SYMBOL TABLE            #
      DEF  D$CRFDMP #58#;          # *=< DUMPS CRF FILE                #
      DEF  D$CRFTRC #57#;          # *=? PRINTS TRACE OF EXECUTION     #
      $END
  
#     CLASS LABELS IN THE PRINT LINE                                   #
      DEF  PLCDT    #" ITEM     "#; 
      DEF  PLCTB    #" ARRAY    "#; 
      DEF  PLCLB    #" LABEL    "#; 
      DEF  PLCPC    #" PROC     "#; 
      DEF  PLCFC    #" FUNC     "#; 
      DEF  PLCCL    #" CLOSE    "#; 
      DEF  PLCSW    #" SWITCH   "#; 
      DEF  PLCDM    #" *UNDEC   "#; 
      DEF  PLCPG    #" PROGRM   "#; 
      DEF  PLCDF    #" DEFINE   "#; 
      DEF  PLCFP    #" FORPAR   "#; 
      DEF  PLCCM    #" COMMON   "#; 
      DEF  PLCST    #" STSLST   "#; 
      DEF  PLCSC    #" STSCON   "#; 
      DEF  PLCTI    #" ARYITM   "#; 
      DEF  PLCSG    #" STRING   "#; 
      DEF  PLCFI    #" FILE     "#; 
      DEF  PLCAR    #" ARRAY    "#; 
      DEF  PLCBA    #" B.ARRY   "#; 
  
      ITEM CRFX I;                 # INDEX TO ENTRY IN CRF TABLE       #
      ITEM CRFN I;                 # CRF BLOCK COUNT                   #
      ITEM CRFB B = FALSE;         # CRF END FLAG                      #
      ITEM NUMPARTS I = 1;         # NBR OF PARTIAL XREF LISTS         #
      ITEM CXRB B = FALSE;         #  LINE FLAG                        #
      ITEM LSTUNREFD B = FALSE;    # LISTING UNREFERENCED NAMES OPTION #
      ITEM ICT  I =1;              # CURRENT ENTRY                     #
      ITEM IC I;
      ITEM INAM0 I; 
      ITEM NTEXTS        I;        # NUMBER OF STEXTS USED             #
      ITEM FTXTNTRE      I;        # STP OF FIRST ENTRY OF FIRST TEXT  #
      ITEM LTXTNTRE      I;        # STP OF LAST ENTRY OF LAST TEXT    #
  
  
      $BEGIN
      ITEM  DBUG$LIST1   B;        # SYMBOL TABLE + SCOPE TABLE        #
      ITEM  DBUG$LIST2   B;        # CRF DUMPS                         #
      ITEM  DBUG$LIST3   B;        # CRFLST PROCESSING                 #
      $END
  
      BASED ARRAY BCRBUF [0:0] S(1);;  # USED TO READ IN CRF FILE      #
  
      ARRAY MASKIT [0:9];          # PREPARES NAME FOR PRINTING        #
      BEGIN 
        ITEM MASK55 = [ 
            O"55000000000000000000"  ,
              O"550000000000000000"  ,
                O"5500000000000000"  ,
                  O"55000000000000"  ,
                    O"550000000000"  ,
                      O"5500000000"  ,
                        O"55000000"  ,
                          O"550000"  ,
                            O"5500"  ,
                              O"55"  ] ;
      END 
  
      ARRAY PRINT$LINE [0:ECXR] S(1);  # LINEBUF SENT TO PTLST         #
        BEGIN 
        ITEM PL$WORD      I(00,00,WBITS);  # FULL WORD ACCESS          #
        ITEM PL$FILL      C(00,00,10)=[WLIN(BLKW)];  # PRESET          #
        ITEM PL$NAME      C(00,42,10);  # NAME FIELD                   #
        ITEM PL$CLAS      C(01,42,10);  # CLASS (LISTED AS TYPE)       #
        ITEM PL$TYPE      I(02,36,06);  # TYPE (LISTED AS MODE)        #
        ITEM PL$DEFN      C(02,48,07);  # DEFINITION TXTNAME OR LINE   #
        ITEM PL$BASE      I(03,36,18);  # INDICATES COMMON OR EXTERNAL #
        ITEM PL$BASE0     I(03,36,12);  # FIRST DIGIT OF COMMON        #
        ITEM PL$BASE1     I(03,48,06);  # SECOND DIGIT OF COMMON       #
        ITEM PL$SCOP      I(04,00,WBITS); 
        END 
  
#     THIS IS A TABLE OF TEXT NAME AND POINTERS INTO THE SYMBOL TABLE  #
#     IT IS BUILT BY THE INITIALIZATION.                               #
      ARRAY  STEXT$TABLE [0:MAXTXTM1] P(2); 
        BEGIN 
        ITEM  ST$FIRST    I(00,00,18);  # FIRST ENTRY FROM TEXT        #
        ITEM  ST$LAST     I(00,42,18);  # LAST ENTRY + 1 FROM TEXT     #
        ITEM  ST$NAME     C(01,00,07);  # TEXT NAME                    #
        END 
  
      ARRAY  [0:0] S(1);           # ALLOW INT OR CHAR ACCESS TO NAME  #
        BEGIN 
        ITEM I$NAME       I(00,00,60);
        ITEM C$NAME       C(00,00,10);
        END 
  
  
#     THIS SWITCH IS FOR THE CLASS OF THE ENTRY.  THE NOES AND YESES   #
#     INDICATE WHETHER OR NOT THE CLASS IS CROSS-REFERENCED.  THE      #
#     CLASS IS CALLED THE "TYPE" IN THE LISTING HEADER.                #
      SWITCH SWCLSC:QCLAS      #CRF#
             CRF50 :NULL,      #NO #
             CRF60 :NAME,      #NO #
             CRF2DT:DATA,      #YES#
             CRF2TB:TABL,      #YES#
             CRF50 :CONS,      #NO #
             CRF50 :TEMP,      #NO #
             CRF2LB:LABL,      #YES#
             CRF2PC:PROC,      #YES#
             CRF2FC:FUNC,      #YES#
             CRF2CL:CLOS,      #YES#
             CRF2SW:SWCH,      #YES#
             CRF50 :MON ,      #NO #
             CRF2DM:DUMY,      #YES#
             CRF2PG:PROG,      #YES#
             CRF2DF:DEF ,      #YES#
             CRF50 :SLC ,      #NO #
             CRF50 :INSC,      #NO #
             CRF2FP:FPAR,      #YES#
             CRF50 :BPAR,      #NO #
             CRF2CM:COMM,      #YES#
             CRF2ST:STSL,      #YES#
             CRF2SC:SCON,      #YES#
             CRF2TI:TITM,      #YES#
             CRF2SG:STRG,      #YES#
             CRF50 :OVER,      #NO #
             CRF2FI:FILE,      #YES#
             CRF2AR:ARRY,      #YES#
             CRF60:DTXT , 
             CRF50 :QCLAS$;    #NO #
  
#     THIS SWITCH IS FOR THE TYPE OF THE ENTRY.  THE TYPE IS CALLED    #
#     THE MODE IN THE LISTING HEADER.  NOT ALL CLASSES HAVE AN         #
#     ASSOCIATED TYPE.                                                 #
      SWITCH SWTYPC:QTYPE 
             CRF3NL:NULL ,
             CRF3OC:OCT , 
             CRF3FX:FIX , 
             CRF3IG:IGR  ,
             CRF3UN:USI  ,
             CRF3RL:REAL ,
             CRF3DB:DBL  ,
             CRF3BL:BOOL ,
             CRF3ST:STTS ,
             CRF3PR:RSLT ,
             CRF3SR:ADR  ,
             CRF3BS:QTYPE$, 
             CRF3BC:EBCD ,
             CRF3HL:HLTH ,
             CRF3TR:TRAN ;
  
#     THIS SWITCH IS FOR THE KIND OF ENTRY, DEF, SET, REFERENCED       #
#     OR ATTRIBUTE.                                                    #
      SWITCH SWCRF :QCRFTYP 
             CRF42:DEF, 
             CRF43:ATRB , 
             CRF44:REF, 
             CRF45:SET; 
      CONTROL EJECT;
      $BEGIN
      PROC DUMP$CRF;               # DUMP THE CRF BUFFER               #
      BEGIN 
      ITEM  IND          I;        # INDEX                             #
      ITEM  NAM          I; 
  
      IF  NOT DBUG$LIST2
      THEN
        BEGIN 
        RETURN; 
        END 
  
      PRINT("(///, 9H CRF DUMP    ,/,6H INDEX ,4X,3HSTP  ,8X, 
        4HNAME ,10X,4HTYPE  ,10X, 4HLINE  )");
      ENDL; 
  
      FOR  IND = 1 STEP  1
        UNTIL ICT 
      DO
        BEGIN 
        PRINT("(3X,I5,2X,O6,4X,A10,4X,A10,2X,I5)"); 
        LIST(IND);
        LIST(CRLNK[IND]); 
        FIND( CRLNK[IND], NAM );
        LIST( NAME[NAM] );
        LIST(CRTYP$NAME[CRTYP[IND]]); 
        LIST(CRLIN[IND]); 
        ENDL; 
        END 
  
      RETURN; 
      END 
      $END
      CONTROL EJECT;
      PROC  GETSCOP;
      BEGIN 
  
#----------------------------------------------------------------------#
#     P R O C   G E T S C O P                                          #
#     THIS PROCEDURE STORES THE SCOPE OF THE IDENTIFIER, WHOSE NAME    #
#     TABLE INDEX IS IJ, INTO PL$SCOP.   SCOPE FOR A STATUS CONSTANT   #
#     IS THE STATUS LIST POINTED TO BY SMOM.                           #
#----------------------------------------------------------------------#
  
  
      IF  CLAS[ IJ ] EQ S"SCON" 
      THEN
        BEGIN 
        IL = 0;                    # RL NUMBER NOT APPLICABLE          #
        FIND( SMOM[ IJ ], IJK );
        PL$SCOP[ 0 ] = NAME[ IJK ]; 
        IF  NCHR[ IJK ] LQ 9
        THEN
          BEGIN 
          PL$SCOP[0] = PL$SCOP[0] + MASK55[ NCHR[ IJK ]]; 
          END 
        ELSE
          BEGIN 
          END 
        END 
  
      ELSE                         # NOT A STATUS CONSTANT             #
        BEGIN 
        PL$SCOP[ 0 ]=NAME[ SCPN[ SBEG[ IK ]]];
        IF NCHR[ SCPN[ SBEG[ IK ]]] LQ 9
        THEN
          BEGIN 
          PL$SCOP[0] = PL$SCOP[0] + MASK55[ NCHR[ SCPN[ SBEG[ IK ]]]] ; 
          END 
        END 
      END 
      CONTROL EJECT;
      PROC PCVTD(XW,XB);
  
#----------------------------------------------------------------------#
#          P R O C   P C V T D                                         #
#     A SUBROUTINE INTERNAL TO CRFLST WHICH IS USED TO CONVERT LINE    #
#     NUMBERS INTO DECIMAL DISPLAY CHARSCTERS AND TO STORE THE         #
#     RESULT INTO THE LINE BUFFER.  PCVTD( XW,XB) WHERE XW AND XB      #
#     ARE, RESPECTIVELY, THE WORD AND BIT INDICES DENOTING THE         #
#     CHARACTER POSITION OF THE  RIGHTMOST DIGIT IN THE LINE.          #
#                                                                      #
#----------------------------------------------------------------------#
  
  
      BEGIN                  #PCVTD#
      ITEM KB  I; 
      ITEM KW  I; 
      ITEM N   I;                  # LOCAL TEMPS                       #
      ITEM Q   I; 
      ITEM XB  I; 
      ITEM XW  I; 
  
      KW = XW;
      KB = XB;
      N = CRLIN[IJK];               # SOURCE LINE NUMBER               #
      IF N EQ 0 
      THEN
        BEGIN                #ZERO# 
        B<KB,6>PL$WORD[KW] = HZERO; 
        RETURN; 
        END                  #ZERO# 
  
PCVTD2: 
      Q = N/10; 
      B<KB,6>PL$WORD[KW] = (N - Q*10) + HZERO;
      IF Q EQ 0 
      THEN
        BEGIN 
        RETURN;                    # COMPLETE                          #
        END 
                                   # ELSE NOT COMPLETE                 #
      N = Q;
      IF KB EQ 0 THEN 
        BEGIN                #E-O-WORD# 
        KB = LBIT;                 #INIT BIT INDEX                     #
        KW = KW-1;                 #DECR WRD INDEX                     #
        END                  #E-O-WORD# 
      ELSE
        BEGIN 
        KB = KB-6;                 #DECR BIT INDEX# 
  
        END 
      GOTO PCVTD2;
  
      END                    #PCVTD#
      CONTROL EJECT;
#----------------------------------------------------------------------#
#     START OF MAIN PROC CRFLST.  SOME INITIALIZATIONS.                #
#----------------------------------------------------------------------#
  
      LSTUNREFD =  NOT NONULLS; 
      $BEGIN
      DBUG$LIST1 =  B< D$STDUMP >INTOPS EQ 1; 
      DBUG$LIST2 =  B< D$CRFDMP >INTOPS EQ 1; 
      DBUG$LIST3 =  B< D$CRFTRC >INTOPS EQ 1; 
      $END
  
      $BEGIN
      IF  DBUG$LIST1
      THEN
        BEGIN 
        SDUMP( O"7777" );          # DUMP ALL FIELDS                   #
        PRINT( "(/////,12H SCOPE TABLE  ,/, 
          27H   INDEX,SBEG,NAM PTR, NAME      ,//)"); 
        ENDL; 
        END 
      $END
  
      FOR I = 0  STEP 1 
        UNTIL ESCP
      DO
        BEGIN                  #I#
        IJ = SCPN[I]; 
        IF IJ NQ 0
        THEN
          BEGIN 
          FIND( IJ, NP );          # GET PTR TO NAME                   #
          $BEGIN
          IF DBUG$LIST1 
          THEN
            BEGIN 
            PRINT("(5X,I5,5X,2(O6,3X),A10)"); 
            LIST(I);
            LIST(SCPN[I]);
            LIST(NP); 
            LIST(NAME[NP]); 
            ENDL; 
            END 
          $END
  
          SCPN[I] = NP; 
          END 
        END                    #I#
      CONTROL  EJECT; 
  
#----------------------------------------------------------------------#
#     BUILD THE STEXT TABLE.  USED TO DETERMINE THE TEXT FROM WHENCE   #
#     A DEFINITION CAME.                                               #
#----------------------------------------------------------------------#
  
      I = 0;
      IJ = STLC;
  
      $BEGIN
      IF  DBUG$LIST1
      THEN
        BEGIN 
        PRINT("(12H0STEXT TABLE)"); 
        ENDL; 
        PRINT("(30H IJ      NAME     FIRST   LAST)"); 
        ENDL; 
        END 
      $END
  
  
      FOR  K=K
        WHILE  IJ NQ 0
      DO
        BEGIN 
        ST$NAME[I] = TNAM[IJ];
        ST$FIRST[I] = FTXT[IJ]; 
        ST$LAST[I] = LTXT[IJ];
  
        $BEGIN
        IF  DBUG$LIST1
        THEN
          BEGIN 
          PRINT("(1X,O6,1X,A7,1X,O6,1X,O6)"); 
          LIST( IJ ); 
          LIST( ST$NAME[I] ); 
          LIST( ST$FIRST[I] );
          LIST( ST$LAST[I] ); 
          ENDL; 
          END 
        $END
  
        I = I + 1;
        IJ = TLNK[ IJ ];
        END 
  
      NTEXTS = I; 
      LTXTNTRE = ST$LAST[ NTEXTS - 1 ]; 
      FTXTNTRE = ST$FIRST[0]; 
#----------------------------------------------------------------------#
      CONTROL EJECT;
  
CRF10:  
  
#----------------------------------------------------------------------#
#     READ IN THE CRF FILE GENERATED BY XRDEF. GTCRF STORES A BLOCK IN #
#     BCRBUF, PUTS NUMBER OF ENTRIES IN CRFN, AND JUMPS TO CRF12 IF    #
#     THE END OF FILE IS REACHED.  THIS CONTINUES UNTIL THE CRF BUFFER #
#     IS FILLED. ICT ENDS UP POINTING TO THE END OF THE BUFFER         #
#----------------------------------------------------------------------#
  
      CONTROL FASTLOOP; 
      FOR  IJ = IJ
        WHILE  (CRFSZ - ICT) GR ECRFB 
      DO
        BEGIN 
        P<BCRBUF> = LOC(CRBUFWORD[ ICT ]);
        GTCRF( BCRBUF, CRFN, CRF12 ); 
        ICT = ICT + CRFN; 
        END 
      CONTROL  SLOWLOOP;
  
#     THIS GETS EXECUTED IF CRF BUFFER GETS FILLED BEFORE EOF OF       #
#     THE CRF FILE.                                                    #
  
      CRFB = TRUE;
      LSTUNREFD = TRUE; 
      CRFPART = " *PART 1* "; 
  
CRF12:                             # COME HERE AFTER CRF FILE READ     #
      IF ICT LQ 1                  # CRF FILE EMPTY                    #
      THEN
        BEGIN 
        RETURN; 
        END 
  
      IF  NUMPARTS GR 1 
      THEN
        BEGIN 
        BINDEC( CRFPART, 7, NUMPARTS, 1 );
        END 
  
     CRBUFWORD[ ICT ] = 0;         # TERMINATOR                        #
      ICT = ICT - 1;               # ICT HOLDS NUMBER OF CRF ENTRIES   #
  
      $BEGIN
      DUMP$CRF; 
      $END
      CONTROL EJECT;
  
  
      IF  IDUM NQ 0                # MAPCRF SETS IDUM TO INDICATE DUMY #
      THEN                         # ENTRIES IN THE SYMBOL TABLE.      #
        BEGIN 
        FOR  I = ICT  STEP -1 
          UNTIL 1 
        DO
          BEGIN 
          FOR  IJ = IJ
            WHILE  CLAS[ CRLNK[ I ]] EQ S"DUMY" 
              AND  RLNK[ CRLNK[I]] NQ 0 
          DO
            BEGIN 
            CRLNK[I] = RLNK[ CRLNK[I]]; 
            END 
          END 
        END 
  
  
#     SHELL SORT OF LINE REFERENCES                                    #
      FOR J= ICT/2  STEP -((J+1)/2) 
        UNTIL  1
      DO
        BEGIN      #J#
        IJ = ICT -J;
        FOR   I = 1  STEP 1 
          UNTIL IJ
        DO
          BEGIN    #I#
          IJK = I - 1;
CRF14:  
          IKK = IJK + J;
          IF CRF1[ IJK ] GR CRF1[ IKK ] 
          THEN
            BEGIN 
            CRF1[ IJK ] == CRF1[ IKK ]; 
            IJK = IJK - J;
            IF  IJK GQ 0
            THEN
              BEGIN 
              GOTO  CRF14;
  
              END 
            END 
          END    #I#
        END    #J#
  
      $BEGIN
      DUMP$CRF; 
      $END
  
      CONTROL EJECT;
  
#----------------------------------------------------------------------#
#     NOW SET UP XRFL LINKS.  XRFL[IJ] WILL CONTAIN A POINTER TO THE   #
#     LAST ENTRY OF THE NAME[ IJ ] IN CRLNK.                           #
#----------------------------------------------------------------------#
  
      IJ = 0;                      # INDEX INTO NAME TABLE             #
      FOR  I = 1  STEP  1 
        UNTIL  ICT
      DO
        BEGIN 
        IF  CRLNK[I] NQ IJ
        THEN
          BEGIN 
          IJ = CRLNK[ I ];
          XRFL[ IJ ] = I; 
          END 
        END 
  
#----------------------------------------------------------------------#
#     THIS IS THE MAIN LOOP OF CRFLST.  J IS THE NAME TABLE INDEX      #
#     EACH ITERATION IS ONE ENTRY IN THE SORTED NAME TABLE PRODUCED    #
#     BY MAPCRF.                                                       #
#----------------------------------------------------------------------#
  
      FOR  J = 0  STEP 1
        WHILE  STB[ J ] NQ 0
      DO
        BEGIN                      # INDEX THRU NAME TABLE WITH J      #
        NP = STB[ J ];             # NAME POINTER                      #
  
#----------------------------------------------------------------------#
#     FOR EVERY ENTRY IN THE NAME TABLE, THERE IS AN NLNK CHAIN.       #
#     THIS LOOP TRACES THE NLNK CHAIN, PUTTING OUT A CRF LISTING       #
#     FOR EACH VALID NAME.                                             #
#----------------------------------------------------------------------#
  
        C$NAME[0] = NAME[ NP ];    # FIRST 10 CHARS OF IDENTIFIER      #
        IF  NCHR[ NP ] LQ 9 
        THEN
          BEGIN 
          I$NAME[0] = I$NAME[0] + MASK55[ NCHR[ NP ]];
          END 
  
        IJ = NLNK[ NP ];           # IJ IS POINTER ALONG NLNK          #
        FOR  K=K
          WHILE IJ NQ NP           # IJ MOVED AT END OF LOOP           #
        DO
          BEGIN                    # MOVE ALONG NLNK CHAIN             #
  
          $BEGIN
CRF22:  
          IF  DBUG$LIST3
          THEN
            BEGIN 
            PRINT("(2X,6HCRF22  ,4(O6,4X),A10)"); 
            LIST(J);
            LIST(IJ); 
            LIST(XRFL[IJ]); 
            LIST(CLAS[IJ]); 
            LIST( I$NAME[0] );
            ENDL; 
            END 
          $END
  
#----------------------------------------------------------------------#
#     IF XRFL IS 0, THEN THE NAME IS NOT REFERENCE OR DEFINED BY THE   #
#     PROGRAM, A COMPILER GENERATED NAME, E.G. A CONSTANT.  IF THE     #
#     FIFTH CHARACTER OF THE NAME IS A "?" THEN THE NAME IS A DEF      #
#     PARAM.  IN EITHER CASE, THE NAME SHOULD NOT BE LISTED.           #
#     XRFL IS ALSO 0 IF THE NAME HAS ALREADY BEEN CROSS-REFERENCED.    #
#----------------------------------------------------------------------#
  
          IF  XRFL[ IJ ] EQ 0 
            OR  C< DEFPARM >C$NAME[0] EQ "?"
          THEN
            BEGIN 
            GOTO  CRF50;
            END 
  
          PL$NAME[0] = C$NAME[0];  # STORE NAME IN PRINT LINE BUFFER   #
          IK = IJ;                 # SYMBOL TABLE POINTER              #
          IJK = CLAS[IJ]; 
          CONTROL EJECT;
  
#----------------------------------------------------------------------#
#     THIS IS THE SWITCH FOR THE CLASS OF THE ENTRY.  BRANCH IS TO     #
#     CRF50 OR CRF60 IF THE NAME SHOULD NOT APPEAR IN THE CRF.  OTHER- #
#     WISE, BRANCH IS TO ONE OF THE LABELS BELOW, WHERE THE CLASS OF   #
#     THE NAME IS STORED AN THE PRINT LANE.  EXIT IS TO CRF30 OR CRF33 #
#     TO OBTAIN THE SCOPE.  BRANCH IS TO CRF33 IF THERE IS NO TYPE     #
#     ASSOCIATED WITH THE CLASS.                                       #
#----------------------------------------------------------------------#
  
          GOTO  SWCLSC [ IJK ];    # CLASS SWITCH                      #
  
#**********************************************************************#
  
CRF2TB: 
          PL$CLAS[0]   =  PLCTB;   # CLASS TABL, LABELED ARRAY         #
          GOTO  CRF30;
  
CRF2LB: 
          PL$CLAS[0]   =  PLCLB;   # CLASS LABL, LABEL                 #
          GOTO  CRF30;
  
CRF2PC: 
          PL$CLAS[0]   =  PLCPC;   # CLASS PROC                        #
          GOTO  CRF30;
  
CRF2FC: 
          PL$CLAS[0]   =  PLCFC;   # CLASS FUNC                        #
          GOTO  CRF30;
  
CRF2CL: 
          PL$CLAS[0]   =  PLCCL;   # JOVIAL CLASS                      #
          GOTO CRF30; 
  
CRF2SW: 
          PL$CLAS[0]   =  PLCSW;   # CLASS SWCH, SWITCH                #
          GOTO  CRF33;
  
CRF2DM: 
          PL$CLAS[0]   =  PLCDM;   # DUMY,LISTED AS *UNDEC             #
          GOTO  CRF30;
  
CRF2PG: 
          PL$CLAS[0]   =  PLCPG;   # CLASS PROG, PROGRAM               #
          GOTO  CRF30;
  
CRF2DF: 
          PL$CLAS[0]   =  PLCDF;   # CLASS DEF                         #
          IL = 0;                  # RL NO.                            #
          GOTO CRF33; 
  
CRF2FP: 
          PL$CLAS[0]   =  PLCFP;   # FPAR, LISTED ONY WITH N OPTION    #
          IK = NFPR[IJ];           # LINK TO ATTRIBUTE ENTRY           #
          GOTO  CRF30;
  
CRF2CM: 
          PL$CLAS[0]   =  PLCCM;   # CLASS COMMON                      #
          GOTO  CRF30;
  
CRF2ST: 
          PL$CLAS[0]   =  PLCST;   # CLASS STSL, STATUS LIST           #
          IL = 0;                  # RL NO.                            #
          GOTO CRF33; 
  
CRF2SC: 
          PL$CLAS[0]   =  PLCSC;   # CLASS SCON, STATUS CONSTANT       #
          IL = 0;                  # RL NO.                            #
          GOTO CRF33; 
  
CRF2TI: 
          PL$CLAS[0]   =  PLCTI;   # CLASS TITM, ARRAY ITEM            #
          GOTO  CRF30;
  
CRF2SG: 
          PL$CLAS[0]   =  PLCSG;   # JOVIAL CLASS                      #
          GOTO CRF30; 
  
CRF2FI: 
          PL$CLAS[0]   =  PLCFI;   # JOVIAL CLASS                      #
          GOTO  CRF30;
  
  
CRF2AR: 
          PL$CLAS[0]   =  PLCAR;   # JOVIAL CLASS                      #
          GOTO  CRF30;
  
CRF2DT: 
          PL$CLAS[0]   =  PLCDT;   # CLASS DATA, ITEM                  #
#**********************************************************************#
  
CRF30:  
          IL = RLNO[IK];
          GETSCOP;
  
          $BEGIN
CRF32:  
          IF  DBUG$LIST3
          THEN
            BEGIN 
            PRINT("(2X,6HCRF32  ,3(O6,4X),A10)"); 
            LIST(IK); 
            LIST(IL); 
            LIST( TYPE[ IK ]);
            LIST( PL$SCOP[0]);
            ENDL; 
            END 
          $END
  
          CONTROL EJECT;
#----------------------------------------------------------------------#
#     THIS IS THE SWITCH FOR THE TYPE OF THE IDENTIFIER.  TYPE MAY BE  #
#     R, I, B, ETC. FOR ITEMS, WEAK OR NOT FOR XTERNALS, BASED OR NOT  #
#     AND SERIAL OR PARALLEL FOR ARRAYS. NOTE THAT SERIAL OR PARALLEL  #
#     IS NOT INDICATED BY THE TYPE FIELD BUT BY THE PORS FIELD AND     #
#     THAT BASED ARRAYS ARE INDICATED IN THE CLASS FIELD.              #
#----------------------------------------------------------------------#
  
          GOTO  SWTYPC[ TYPE[ IK ]]; # TYPE SWITCH                     #
  
CRF33:  
          GETSCOP;
          GOTO CRF41; 
  
CRF3NL: 
          IF  IL NQ RLX 
          THEN
            BEGIN 
            GOTO  CRF40;           # NOT AN EXTERNAL                   #
            END 
          ELSE
            BEGIN 
            IF  XTRN[ IK ] EQ S"WEAK" 
            THEN
              BEGIN 
              PL$TYPE[ 0 ] = PLTWK; 
              END 
            ELSE
              BEGIN 
              PL$TYPE[ 0 ] = PLTXT; 
              END 
            GOTO  CRF41;
            END 
  
CRF3OC: 
          PL$TYPE [0] =   PLTOC;   # JOVIAL TYPE                       #
          GOTO CRF40; 
  
CRF3RL: 
          PL$TYPE [0] =   PLTRL;   # TYPE REAL                         #
          GOTO CRF40; 
  
CRF3DB: 
          PL$TYPE [0] =   PLTDB;   # JOVIAL TYPE                       #
          GOTO CRF40; 
  
CRF3BL: 
          PL$TYPE [0] =   PLTBL;   # TYPE BOOLEAN                      #
          GOTO CRF40; 
  
CRF3ST: 
          PL$TYPE [0] =   PLTST;   # TYPE STATUS ITEM                  #
          GOTO CRF40; 
  
CRF3PR: 
          PL$TYPE [0] =   PLTPR;
          GOTO CRF40; 
  
CRF3SR: 
          PL$TYPE [0] =   PLTSR;
          GOTO CRF40; 
  
CRF3BS: 
          PL$CLAS[0] = PLCBA; 
          IF  PORS[ IK ]
          THEN
            BEGIN 
            GOTO  CRF3SR;          # SERIAL ARRAY                      #
            END 
          ELSE
            BEGIN 
            GOTO  CRF3PR;          # PARALLEL ARRAY                    #
            END 
  
CRF3BC: 
          PL$TYPE[0] = O"03";      # TYPE CHARACTER                    #
          GOTO CRF40; 
  
CRF3UN: 
          PL$TYPE [0] =   PLTUN;   # TYPE UNSIGNED INTEGER             #
          GOTO CRF40; 
  
CRF3HL: 
          PL$TYPE[0] = O"03";      # JOVIAL TYPE                       #
          GOTO CRF40; 
  
CRF3TR: 
          PL$TYPE[0] = O"03";      # JOVIAL TYPE                       #
          GOTO CRF40; 
  
CRF3FX: 
          PL$TYPE [0] =   PLTFX;   # JOVIAL TYPE                       #
          GOTO CRF40; 
  
CRF3IG: 
          PL$TYPE [0] =   PLTIG;   # TYPE INTEGER                      #
#----------------------------------------------------------------------#
      CONTROL EJECT;
CRF40:  
  
#----------------------------------------------------------------------#
#     HERE IS THE PROCESSING FOR THE BASE FIELD.  IF THE NAME IS AN    #
#     EXTERNAL, IT IS FLAGGED AS WEAK OR STRONG.  IF THE NAME IS A     #
#     LOCATION IN COMMON, THE RLNO STORED IN IL WHICH REPRESENTS THE   #
#     COMMON BLOCK IS OUTPUT.                                          #
#----------------------------------------------------------------------#
  
          IF  IL EQ RLX 
          THEN
            BEGIN 
            IF   XTRN[IK] EQ S"WEAK"
              OR  (CLAS[IK] EQ S"TITM"
                AND  XTRN[ MAMA[ IK]] EQ S"WEAK") 
            THEN
              BEGIN 
              PL$BASE[0] = "Y  ";  #      Y - WEAK EXTERNAL            #
              END 
            ELSE
              BEGIN 
              PL$BASE[0] = "X  ";  #      X - EXTERNAL                 #
              END 
            END 
          ELSE
            BEGIN 
            IF  IL GR RLX 
            THEN
              BEGIN 
              IF  IL LS 10
              THEN
                BEGIN 
                PL$BASE0[0] = IL + O"03 33";
                END 
              ELSE
                BEGIN 
                IK = IL/10; 
                PL$BASE0[0] = IK + O"03 33";
                PL$BASE1[0] = IL - IK*10 + HZERO; 
                END 
              END 
            END 
  
CRF41:  
          IK = XRFL[ IJ ];         # SAVE IT FOR THE LOOP              #
          XRFL[IJ] = 0;            # LOWER CRF FLAG                    #
          KW = WCXR;               # INIT REF WORD,BIT INDICES         #
          KB = BCXR;
          CXRB=LSTUNREFD; 
  
          CONTROL EJECT;
  
          IF  NTEXTS GR 0 
            AND  IJ GQ FTXTNTRE 
            AND  IJ LS LTXTNTRE 
          THEN                     # IJ IS IN A TEXT                   #
            BEGIN 
            FOR  I= 0  STEP 1 
              UNTIL  NTEXTS - 1 
            DO                     # SEARCH THE STEXT TABLE            #
              BEGIN 
              IF   IJ GQ ST$FIRST[I]
                AND  IJ LS ST$LAST[I] 
              THEN                 # FOUND THE TEXT                    #
                BEGIN 
                PL$DEFN[0] = ST$NAME[I];
                END 
              END 
            END 
  
  
  
          FOR  IJK = IK  STEP 1 
            WHILE  CRLNK[ IJK ] EQ IJ 
          DO
            BEGIN                  # LOOP OF LINE REFERENCES           #
            $BEGIN
            IF  DBUG$LIST3
            THEN
              BEGIN 
              PRINT("(2X,6HCRF44 ,2(I3,2X))");
              LIST( IJK );
              LIST( CRTYP[ IJK ]);
              ENDL; 
              END 
            $END
  
#----------------------------------------------------------------------#
#     THIS IS THE SWITCH FOR THE KIND OF REFERENCE MADE.               #
#----------------------------------------------------------------------#
  
          GOTO  SWCRF[ CRTYP[ IJK ]]; 
  
CRF42:                             #  ----DEFINED----                  #
            PCVTD( DEFWORD, DEFBIT ); 
            GOTO  CRF46;
  
  
CRF43:                             #  ----ATTRIBUTE----                #
            B<KB,6>PL$WORD[KW] = HAH;  # LETTER A IS SUFFIX            #
            GOTO  CRF45;
  
  
CRF44:                             #  ----REFERENCED----               #
            B<KB,6>PL$WORD[KW] = HAST; # ASTERISK IS SUFFIX TO LINE NO #
            GOTO  CRF45;
  
CRF45:                             #  ----SET----                      #
#     ALSO CODE COMMON TO REF AND ATTRIBUTE USAGES WHICH OUTPUTS       #
#     THE LINE NUMBER AND DOES THE BOOKKEEPING                         #
  
            IF KB EQ 0
            THEN
              BEGIN                # PREVIOUS WORD                     #
              KW = KW-1;           # SET WORD,BIT INDEX                #
              KB = LBIT;
              END                  # PREVIOUS WORD                     #
            ELSE
              BEGIN 
              KB = KB-6;           # INCR BIT INDEX                    #
              END 
            PCVTD(KW,KB);          # PUT REF CARD                      #
            KB = KB+48;            # INCR BIT INDEX                    #
  
            IF KB GQ  WBITS 
            THEN
              BEGIN                # END OF WORD                       #
              KW = KW+1;           # INCR WORD INDEX                   #
              IF KW EQ ECXR 
              THEN
                BEGIN              # END OF LINE                       #
                PTLST(PRINT$LINE); #       PUT LINE                    #
                FOR I = 0  STEP 1 
                  UNTIL  ECXR 
                DO
                  BEGIN 
                  PL$WORD[I] = BLKW; # CLEAR LINE                      #
                  END 
                CXRB = FALSE;      # LOWER LINE FLAG                   #
                KW = WCXR;         # INIT WORD,BIT INDICES             #
                KB = BCXR;
                END                # END OF LINE                       #
              ELSE
                BEGIN 
                KB = KB-WBITS;     # DECR BIT INDEX                    #
                CXRB = TRUE;
                END 
              END                  # END OF WORD                       #
            ELSE
              BEGIN 
              CXRB = TRUE;
              END 
  
CRF46:  
            IF  ICT EQ 1
            THEN
              BEGIN 
              GOTO  CRF70;         # CLEAN UP AND REFILL BUFFER        #
              END 
  
            ICT = ICT - 1;
            END                    # LOOP OF LINE REFERENCES           #
  
  
  CRF48:  
          IF CXRB 
          THEN
            BEGIN                  #LINE# 
            PTLST(PRINT$LINE);     #       PUT LINE                    #
             FOR  I= 0 STEP 1 
              UNTIL  ECXR 
            DO
              BEGIN 
              PL$WORD[I] = BLKW;
              END 
            CXRB = FALSE;          # LOWER LINE FLAG                   #
            END                    #LINE# 
          ELSE
            BEGIN 
            PL$WORD[CCXR] = BLKW;  # CLEAR DEF LINE NO.                #
            END 
#**********************************************************************#
  
CRF50:  
          IJ = NLNK[ IJ ];         # NEXT LINK IN NLNK CHAIN           #
          END                      # MOVE ALONG NLNK CHAIN             #
  
#**********************************************************************#
  
CRF60:                             # JUMP TAKEN TO THIS LABEL IF CLAS  #
                                   # IS NAME OR DTXT                   #
        END                        # INDEX THRU NAME TABLE WITH J      #
#**********************************************************************#
CRF70:  
      IF CXRB 
      THEN
        BEGIN 
        PTLST( PRINT$LINE );       #       OUTPUT LINE                 #
        CXRB = FALSE;              # LOWER LINE FLAG                   #
         FOR  I= 0  STEP 1
          UNTIL  ECXR 
        DO
          BEGIN 
          PL$WORD[I] = BLKW;       # BLANK LINE BUFFER                 #
          END 
  
        END 
  
      IF  NOT CRFB
      THEN
        BEGIN 
        CRFPART = " ";
        RETURN;                    #  E X I T                          #
        END 
  
      ICT = 1;
      CRFB = FALSE; 
      NUMPARTS = NUMPARTS + 1;
      GOTO  CRF10;                 # GET MORE CRF ENTRIES              #
  
      END      # CRFLST # 
      TERM
