 TITLE 'TELEFILE ASSEMBLY PROGRAM - APCNC'
         PCC      0
         SPACE    6
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
*   %%%%%     MODULE NAME:     APCNC                   %%%%%
*   %%%%%     LAST UPDATED:    MAR 07, 1984            %%%%%
*   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
         SPACE    2
         SPACE    12
*        T E L E F I L E    P R O P R I E T A R Y    P R O D U C T
         SPACE    2
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
*        COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
*        THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
         PAGE
         SPACE    12
*        T E L E F I L E    P R O P R I E T A R Y    P R O D U C T
         SPACE    2
*        THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED
*        PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION,
*        DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART,
*        TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT
*        SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE
*        COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF
*        THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN,
*        PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN.
         PAGE
*
CNCP     CSECT    1                 PROCEDURE
*
         SYSTEM   AP%IL
*
         DEF      CNCP
         DEF      CONCORD
         DEF      CONCEND
         REF      LOWCORE,ENDCORE
         REF      SEGMENT#          AP OVERLAY SEGMENT
         REF      NXSYMB
         REF      DC%FLAG
         REF      HWX1SIZE
         REF      LSTBF
         REF      OPENX5,CLOSEX5,READX5,WRITEX5
         REF      PGLINES
         REF      READX1
         REF      READX3
         REF      REWX1
         REF      REWX3
         REF      WRITELO
         REF      X1BUF
         REF      ROOTRTN
*   33  ENCITEM  ITEM
*   34  T        FIELD    16,3
*   35  CT       FIELD    5
*   36  L        FIELD    8
*   37  V        FIELD    19,13
*   38  SYSTYPE  FIELD    19,3
*   39  NAME     ITEM
*   40  CCT      FIELD    16,8
*   41  C1       FIELD    8
*   42           ITEM
*   43  HW       SVECTOR  0,16
*   44  BYTE     VECTOR   0,8
*   45  CTRLP1   ITEM     1
*   46  SPCT     FIELD    32
*   47  CTRLP2   ITEM     1
*   48  SPACE    FIELD    14
*   49  LOC      FIELD    18
*   50  LOC1     FIELD    14,18,1
*   51  CF1DICT  ITEM     1
*   52  OSN      FIELD    16
*   53  OPTR     FIELD    16
*   54           ITEM
*   55  LB       FIELD    16,1
*   56  SL       FIELD    1
*   57  DIR      FIELD    1
*   58  CN       FIELD    13
*   59  LN       SFIELD   16,16,1
*   60  ENCTFLD  MASK     T(X)
ENCTFLD  EQU      X'E000'
*   61  VALFLD   MASK     V(X)
VALFLD   EQU      X'1FFF'
*   64  CNFLD    MASK     CN(X)
CNFLD    EQU      X'1FFF'
         PAGE
*
*   MISCELLANEOUS PARAMETERIZATION
*
COMMENT# EQU      0                 COMMENT 'SYMBOL' NUMBER
SYSTEM#  EQU      4                 SYMBOL NUMBER OF SYSTEM DIRECTIVE
END#     EQU      7                 SYMBOL NUMBER OF END DIRECTIVE
L#       EQU      X'4F'             SYMBOL NUMBER OF LITERAL FUNCTION
*
ENCSSYM  EQU      X'8000'           ENCODED SUBSCRIPTED SYMBOL TYPE
ENCSYM   EQU      X'4000'           ENCODED (GLOBAL) SYMBOL TYPE
ENCTLOB  EQU      2+16              ENCODED TYPE FIELD LOB
LFLD     EQU      X'00FF'           HALF-WORD COUNT FOR LARGE INTEGER
MULTINT  EQU      X'E000'           ENCODED LARGE INTEGER CONTROL
*
ASTFLG   EQU      X'8'              INDIRECT OPERATOR
BEGINEXP EQU      X'7'              BEGIN EXPRESSION
BEGLIST  EQU      X'6'              BEGIN LIST
ENDDIR   EQU      ENCSYM+END#       ENCODED END DIRECTIVE
ENDEXP   EQU      4                 END EXPRESSION
ENDLINE  EQU      0                 ENCODED END OF LINE
ENDLIST  EQU      2                 ENCODED END LIST
ENDSBSYM EQU      3                 END OF SUBSCRIPTED SYMBOL
LSSYM    EQU      ENCSSYM+L#        LITERAL INTRINSIC FUNCTION
SYSTEMDIR   EQU   ENCSYM+SYSTEM#    ENCODED SYSTEM DIRECTIVE
*
CLEANCN  EQU      X'1FFFF'          BASIC DC%FLAG FIELDS
LOCFLD   EQU      X'1FFFF'          CTRLTBL (PASS 2) REFTBL LOCATION
OPTRFLD  EQU      X'FFFF'           OP-CODE POINTER MASK
RTFLD    EQU      X'6000'           MASK FOR RT FIELD
RTLOB    EQU      2+16              LOW-ORDER BIT OF RT FIELD
CR       EQU      1**(31-RTLOB)     COMMAND ITEM REFERENCE
IR       EQU      3**(31-RTLOB)     INDIRECT (AF(1)) REFERENCE
LR       EQU      2**(31-RTLOB)     LABEL ITEM REFERENCE
NR       EQU      0**(31-RTLOB)     NORMAL ITEM REFERENCE
SLFLD    EQU      X'8000'           SUBLINE FLAG IN REFERENCE ITEM
SPACELOB EQU      13                CTRLTBL (PASS 2) SPACE COUNT LOB
32BM1    EQU      X'FFFFFFFF'       MINUS ONE IN 32 BITS
*
CFPTRSYM EQU      X'80000000'       CF1PTR (PASS 2) 'USE SYMBOL REF' BIT
CNFLGFLD EQU      X'00F80000'       ALL INTERESTING CN FLAGS
CNIOFLG  EQU      X'00800000'       .IO
CNIOFLG1 EQU      X'00400000'       .IO NAME-LIST
CNSSFLG  EQU      X'00200000'       .SS
CNSSFLG1 EQU      X'00100000'       .SS NAME-LIST
CNOSFLG  EQU      X'00080000'       .OS
CTBLC    EQU      X'20000000'       IDENTIFIES THIS AS CN CONTROL SYM
CTBLCC   EQU      X'00020000'       CTRLTBL (PASS 2) 'CHECK CF1PTR' BIT
CTBLFLGS EQU      X'C0000000'       PASS1 CTRLTBL FLAG FIELD
CTBLFLOB EQU      1                 PASS 1 CTRLTBL FLAG FIELD LOB
CTBLIO   EQU      X'40000000'       PASS 1 CTRLTBL IO FLAG (1 = INCLUDE)
CTBLSS   EQU      X'80000000'       PASS 1 CTRLTBL SS FLAG (1 = SUPPRESS)
MOFLG    EQU      X'2000'           MULT-OCCUR FLG IN EBCDIC SYM CTRL
*   68  *
*   69  *  REGISTERS
*   70  *
XW       EQU      1                 INDEX TO INBUF
XT       EQU      2                 TEMP (EVEN)
XT1      EQU      3                 TEMP (ODD)
MIDX     EQU      4
TABX     EQU      4
OUTX     EQU      5
ARG      EQU      6                 ARGUMENT REGISTER
XT2      EQU      6
RL       EQU      7                 SUBROUTINE LINK REG
RL1      EQU      14                ALTERNATE SUBROUTINE LINK REGISTER
RL2      EQU      RL1+1
CHARS    EQU      RL2
RADHW    EQU      12                REQ'D RAD HALF-WORD FROM REFTBL
TOT      EQU      13                TOTAL SPACE (HALF-WORDS) REQ'D
IOADD    EQU      8                 I/O BUFFER ADDRESS
IOSIZE   EQU      9                 I/O BUFFER SIZE (IN BYTES)
IORL     EQU      10                I/O RETURN LINK
LISTCT   EQU      11
T1       EQU      8
T2       EQU      9                 TEMP REGISTER (ODD)
*   87  *
*   88  *  STORAGE
*   89  *
XAPDATA  DSECT    0
PATCH    RES      32                PATCH AREA
CFIX     RES      1
CF1PTR   RES      1                 ORIGIN OF COMMAND POINTER TABLE
CF1SYM   RES      1                 ORIGIN OF COMMAND SYMBOL TABLE
CLOC     RES      1
CMND     RES      1                 COMMAND
CNCLNUM  RES      1                 LINE NUMBER OF CN CONTROL
CNERRXIT RES      1                 EXIT CELL FOR 'CNERR' ROUTINE
CONTIN   RES      1                 LAST LINE CONTINUATION FLAG
COREBLOCK   RES   1                 RAD BUFFER BLOCK NUMBER
CT       RES      1                 TEMP IN STORLN
CTRLTBL  RES      1                 ORIGIN OF REFTBL CONTROL TABLE
CURRLINE RES      3                 TEMP IN STORLN
ENDX     RES      1
LINESP   RES      1                 HALFWORDS REQ'D FOR CURR. LINE NO.
LASTCOREHW   RES  1                 LAST REFTBL HALF-WORD IN RAD BUFFER
LASTREF  RES      1                 INDEX OF LAST REFERENCE ITEM (PASS2)
LINUMXIT RES      1
MAJLINE  RES      1                 MAJOR PART OF LINE NUMBER
MAPCXIT  RES      1                 RETURN CELL FOR 'MAPCTRL'
NEXTOP   RES      1                 NO. OF ENTRIES IN CF1PTR TABLE
NUMRECX3 RES      1                 NUMBER OF CN CONTROL RECORDS ON X3
NXTSTXIT RES      1
OPREFS   RES      1                 -1 = NONE, 0 = SOME, 1 = ALL
ORGX     RES      1
RADBUFFER    RES  1                 ORIGIN OF RAD OVERFLOW BUFFER
RADOVTRIG    RES  1                 NON-ZERO AFTER CORE OVERFLOW TO RAD
RTYP     RES      1                 ITEM REFERENCE TYPE CODE
STOREREFXIT  RES  1                 EXIT FROM STOREREF ROUTINE
1STRADHW     RES  1                 FIRST REFTBL HALF-WORD ON RAD
1STCOREHW    RES  1                 FIRST REFTBL HALF-WORD IN RAD BUFFER
RESIDUE  RES      1
RFO      RES      1                 ORIGIN OF REFERENCE LINE TABLE
SKIPSXIT RES      1
STOPCODE RES      1                 USED FOR PASS 2 AF(1) BYPASS
STORLXIT RES      1
SUBLINE  RES      1                 MINOR PART OF LINE NUMBER
SYMREFS  RES      1                 -1 = NONE, 0 = SOME, 1 = ALL
SYSCOUNT RES      1                 LABEL FLAG. 'ON' WHEN IN LABEL
TEMP     RES      1
FOUND    RES      1                 FLAG FOR SRCHCF1.  0=NOT FOUND
INBUF    EQU      X1BUF             ENCODED TEXT BUFFER
XWBASE   RES      1                 POINTER TO ENCODED TEXT BUFFER
1STAFREF RES      1                 FLAG/HW-PTR TO 1ST AF SYMB REF ITEM
         PAGE
*
*   STATIC DATA
*
         USECT    CNCP
*
SPILLMSG RES      0
         TEXT     ' CONCORDANCE SPILL TO RAD STORAGE'
SPILLSIZE  EQU    WA(%)-WA(SPILLMSG)
REQDMSG  RES      0
         TEXT     ' TOTAL SPACE REQUIRED IS    '
REQDVAL  TEXT     '     WORDS'
REQDSIZE   EQU    WA(%)-WA(REQDMSG)
CNERRMSG TEXT     ' ** ERROR IN CN CONTROL #   '
CNERRSIZE   EQU   WA(%)-WA(CNERRMSG)
AVAILMSG RES      0
         TEXT     ' TOTAL SPACE AVAILABLE IS  '
AVAILVAL TEXT     '     WORDS'
AVAILSIZE  EQU    WA(%)-WA(AVAILMSG)
*
*  EQUATES FOR ENCODED TEXT ITEMS
*
*  127  BLANKEXP EQUALS   5
*  128  SYMB     EQUALS   2
*  129  LOCSYM   EQUALS   3
*  130  BEGLIST  EQUALS   8
*  131  ENDLIST  EQUALS   2
*  132  SSYMB    EQUALS   4
*  133  DIRECTV  EQUALS   1
*  134  SLOCSYMB EQUALS   5
*  135  MULTINT  EQUALS   7
*  136  ENDLINE  EQUALS   0
ENCTINT  EQU      X'C000'
ENDBUFF  EQU      X'20FF'
         PAGE
*
*  149  CONCORD  SUBR     (ROOTRTN)
CONCORD  STW,10   ROOTRTN
         LI,XT    5
         STW,XT   SEGMENT#
         LI,XT    X1BUF
         STW,XT   XWBASE            PRESET POINTER TO ENC. TEXT BUFFER
         LW,9     LOWCORE
         STW,9    CTRLTBL
*               CLEAR (NEXTOP) CLEAR (TOT)
         LI,TOT   0
         STW,TOT  NEXTOP
         STW,TOT  RADOVTRIG
         STW,TOT  COREBLOCK
         STW,TOT  PGLINES
         STW,TOT  CNCLNUM
*
*   START OF PASS 1.
*        USE DC%FLAG TO SET OVERALL ENVIRONMENT SWITCHES.
*
         LI,XT    -1
         STW,XT   OPREFS            SET FOR NO OP-CODE REFS (-1)
         LI,XT    1
         STW,XT   SYMREFS           SET FOR ALL SYMBOL REFS (1)
         LW,XT    DC%FLAG
         IF,ANZ   CNFLGFLD,XT       ANYTHING TO CHANGE OUR MIND?
         IF,ANZ   CNIOFLG,XT
         MTW,+1   OPREFS            SOME OPS IF .IO (0)
         IF,AZ    CNIOFLG1,XT
         MTW,+1   OPREFS            ALL OPS IF ONLY .IO (1)
         AI,TOT   1                 START BY INCLUDE ALL
         FI
         FI
         IF,ANZ   CNSSFLG|CNOSFLG,XT
         MTW,-1   SYMREFS           SOME SYMS IF .SS OR .OS (0)
         AI,TOT   2                 START BY SUPPRESSING ALL
         IF,AZ    CNOSFLG,XT        HAVE SOME FORM OF .SS
         IF,AZ    CNSSFLG1,XT
         MTW,-1   SYMREFS           NO SYM REFS IF ONLY .SS (-1)
         ELS                        HAVE .SS NAME LIST
         AI,TOT   -2                GO BACK TO INCLUDE ALL
         FI
         FI
         FI
         SCS,TOT  -2                MOVE CODE TO HI-ORDER BITS
         FI
*  153  PASS1    CALL PASSINIT
PASS1    BAL,RL1  PASSINIT
*  155           MOVE (NXSYMB) PLUS 1 TO (XT)
         LW,8     NXSYMB
         AI,8     1
         STW,8    2
*  156           MOVE (CTRLTBL) TO (ARG)
         LW,6     CTRLTBL
*      INITCTBL MOVE (TOT) TO ((ARG))
INITCTBL STW,TOT  0,ARG
*  159           ADD 1 TO (ARG)  ADD -1 TO (XT)
         AI,6     1
*  160           IF (XT) NE 0  GOTO INITCTBL
         BDR,XT   INITCTBL
*  161           MOVE (ARG) TO (CF1PTR)
         STW,6    CF1PTR
*
*   LINE PROCESSING
*
LINE     RES      0
         CALL     LINENUM           PREP
*
*        PROCESS THE LABEL FIELD
*
         NXTENC
*  164           IF (XT)  EQ BLANKEXP  GOTO COMP1
         CI,2     5
         BE       COMP1
*  165           IF T(XT) EQ SYMB  GOTO LN1
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'4000'
         BE       LN1
*  166           IF T(XT) EQ LOCSYM GOTO COMP1
         CI,8     X'6000'
         BE       COMP1
*  167           CLEAR (LISTCT)
         LI,LISTCT 0
*  168  LN2      IF (XT) NE BEGLIST  GOTO LN3
LN2      RES      0
         IF,EQ    BEGLIST,XT
*  169           ADD 1 TO (LISTCT)
         AI,LISTCT  1
*  170  CONC10   NXTENC
CONC10   RES      0
         NXTENC                     BYPASS LIST HEADER
*  171           GOTO LN2
         B        LN2
*  172  LN1      CALL CTSPACE  GOTO COMP1
LN1      RES      0
         CALL     CTSPACE
         B        COMP1
         FI
*  173  LN3      IF (XT) EQ ENDLIST GOTO LN4
LN3      CI,2     2
         BE       LN4
*  174           IF T(XT) EQ SYMB  GOTO  LN5
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'4000'
         BE       LN5
*  175           IF T(XT) EQ SSYMB  GOTO LN5
         CI,8     X'8000'
         BE       LN5
*  176           IF T(XT) EQ MULTINT ADD L(XT) TO (XW)
         CI,8     X'E000'
         BNE      #100
         LW,8     2
         AND,8    =X'FF'
         AW,1     8
#100     RES      0
*  177           GOTO  CONC10
         B        CONC10
*  178  LN4      ADD -1 TO (LISTCT)
LN4      RES      0
         AI,LISTCT  -1
*  179           IF (LISTCT) EQ 0 GOTO COMP1
         BE       COMP1
*  180           GOTO CONC10
         B        CONC10
*  181  LN5      CALL CTSPACE  GOTO CONC10
LN5      RES      0
         CALL     CTSPACE
         B        CONC10
*
*        PROCESS THE COMMAND FIELD.  ENTER THE OP-CODE IN THE
*        'CF1PTR' TABLE IF IT IS NOT ALREADY THERE.
*
COMP1    RES      0
         NXTENC                     GET FIRST COMMAND FIELD THING
         CV,XT    BEGLIST
         BE       COMP1
*
         STW,XT   CMND              SAVE OP-CODE
         LV,T1    ENCTFLD
         AND,T1   XT                EXTRACT TYPE FIELD
         IF,EQ    ENCSYM,T1         *** SUPERSTITION CODING ***
         CALL     SRCHCF1           LOOK UP OP-CODE
         MTW,0    FOUND
         IF,EZ                      ENTER OP-CODE WHEN FIRST SEEN
         CALL     INSRTCF1
         LW,XT2   LINESP
         AWM,XT2  *ENDX             TALLY FIRST OCCURRENCE
         ELS
         LW,XT    ENDX
         LW,XT2   LINESP
         AWM,XT2  *CF1PTR,XT        TALLY SUBSEQUENT OCCURRENCES
         FI
         LW,XT    CMND
         IF,EQ    SYSTEMDIR,XT      SYSTEM SYMBOL REF'S NOT CONCORDED
         CALL     SKIPSYS
         B        LINE
         FI
         FI
*
*        PROCESS THE REST OF THE LINE (REMAINDER OF COMMAND
*           FIELD AND ARGUMENT FIELD).
*
LN7      RES      0
         NXTENC
*  197           IF T(XT) EQ SYMB GOTO LN8
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'4000'
         BE       LN8
*  198           IF T(XT) NE SSYMB  GOTO LN9
         CI,8     X'8000'
         BNE      LN9
*  199  LN8      CALL CTSPACE  GOTO LN7
LN8      RES      0
         CALL     CTSPACE
         B        LN7
*  200  LN9      IF (XT) EQ ENDLINE GOTO  LN10
LN9      CI,2     0
         BE       LN10
*  201           IF T(XT) EQ MULTINT ADD L(XT) TO (XW)
         CI,8     X'E000'
         BNE      LN7
         AND,XT   =X'FF'
         AW,XW    XT
*  202           GOTO LN7
         B        LN7
*  203  LN10     IF (CMND) NE ENDDIR GOTO LINE
LN10     RES      0
         LW,XT    CMND
         CV,XT    ENDDIR
         BNE      LINE
*
*   END OF PASS 1.
*
         LB,XT    DC%FLAG
         STW,XT   NUMRECX3          GET COUNT OF X3 CN CONTROL RECORDS
         BEZ      CONC20
*
*        READ AND PROCESS THE CONCORDANCE CONTROL FILE
*
CNTBASE  RES      0
*
         BAL,IORL REWX3
CNCF10   RES      0
         CALL     NXTCNREC          GET NEXT FILE RECORD
         MTW,-1   NUMRECX3
CNCF20   RES      0
         NXTENC   ,NOINC
         CV,XT    ENDBUFF
         BE       CNCF40
*
         CALL     LINENUM           BYPASS LINE NUMBER
         MTW,+1   CNCLNUM           (FOR DIAGNOSTICS)
CNCF30   RES      0
         NXTENC                     NEXT CN CONTROL ITEM
         LV,XT1   ENCTFLD
         AND,XT1  XT
         AND,XT   L(VALFLD)
         SHIFT,XT1   ENCTLOB,31
         LB,XT1   CNTJMP,XT1
         B        CNTBASE,XT1
*
CNTJMP   RES      0
         BYTE,CNTBASE   CNCF20    0 END OF LINE
         BYTE     CNCF40          1 END OF BUFFER
         BYTE     CNCF50          2 ERROR IN CN CONTROL COMMAND
         BYTE     CNCF60          3 .IO SYMBOL
         BYTE     CNCF70          4 .SS SYMBOL
         BYTE     CNCF80          5 .OS SYMBOL
         BOUND    4
*
CNCF40   RES      0                 END OF BUFFER
         MTW,0    NUMRECX3
         BG       CNCF10
*
         B        CONC20
*
CNCF50   RES      0                 ERROR IN CN CONTROL COMMAND
         CALL     CNERR             DIAGNOSE
         B        CNCF30
*
CNCF60   RES      0                 .IO SYMBOL
         LV,XT1   CTBLIO|CTBLC
         STS,XT1  *CTRLTBL,XT       SET IO FLAG IN CTRLTBL
         B        CNCF30
*
CNCF70   RES      0                 .SS SYMBOL
         LV,XT1   CTBLSS|CTBLC
         STS,XT1  *CTRLTBL,XT       SET SS FLAG IN CTRLTBL
         B        CNCF30
*
CNCF80   RES      0                 .OS SYMBOL
         LV,XT1   CTBLSS||32BM1
         AND,XT1  *CTRLTBL,XT
         OR,XT1   L(CTBLC)
         STW,XT1  *CTRLTBL,XT       CLEAR SS FLAG IN CTRLTBL
         B        CNCF30
*  204  *
*  205  *  READ THE FIRST RECORD OF THE SYMBOL TABLE
*  206  *
*  207  CONC20   CALL NXTRECRD
CONC20   BAL,RL1  NXTRECRD
*  208           CLEAR (CFIX)
         LI,8     0
         STW,8    CFIX
*  209           MOVE (CF1PTR) PLUS (NEXTOP) TO (CF1SYM)
         LW,8     CF1PTR
         AW,8     NEXTOP
         STW,8    CF1SYM
*
*        MOVE A DUMMY '***' ENTRY TO THE CF1SYM TABLE, IF NECESSARY
*
         LI,XT    0
         CALL     SRCHCF1
         MTW,0    FOUND
         IF,NZ                      WE NEED IT
         LW,T1    CFIX              (IS 0)
         LV,T1|1  OPTRFLD
         LW,XT    ENDX
         STS,T1   *CF1PTR,XT        SET INDEX TO CF1SYM TABLE
         LV,T1    ' ***'            (1ST CHAR IS 12-9-3 PUNCH)
         STW,T1   *CF1SYM
         MTW,+2   CFIX              ADVANCE OVER THE TWO HALFWORDS
         FI
         LI,XT    0                 CLEAR 'MAPCTRL' FLAGS
         STW,XT   CT
         STW,XT   TEMP
*  210  CONC25   CALL NXTSTWD
CONC25   BAL,RL1  NXTSTWD
         STW,XT   CMND
         CI,2     0
         IF,L                       HAVE DUMMY LAST ENTRY
*  212           MOVE (CFIX) PLUS 1 OVER 2 PLUS (CF1SYM) TO (RFO)  GOTO TESTS
         LW,8     CFIX
         AI,8     1
         SAS,8    -1
         AW,8     CF1SYM
         STW,8    RFO
         LI,XT    0
         STW,XT   CMND
         CALL     MAPCTRL           PROCESS ANY PENDING CHAINS
         ELS                        PROCESS NEXT EBCDIC ENTRY
         CALL     MAPCTRL
*  214           CALL NXTSTWD
         BAL,RL1  NXTSTWD
*  215          MOVE CCT(XT) OVER 2 PLUS 1 TO (XT1)
         LW,3     2
         SLS,3    -9
         AI,3     1
*  216           ON FOUND GOTO SAVEOP
         LW,10    FOUND
         BNEZ     SAVEOP
*  217           IF (XW) PLUS (XT1) GE HWX1SIZE GOTO LN13
         LW,8     1
         AW,8     3
         CI,8     HWX1SIZE
         BGE      LN13
*  218           ADD            (XT1) MINUS 1 TO (XW)  GOTO CONC25
         AW,XW    XT1
         AI,XW    -1
         B        CONC25
*  219  LN13     ADD -1 TO (XT1)
LN13     AI,3     -1
*  220           IF (XT1) EQ 0 GOTO CONC25
         BE       CONC25
*  221           CALL NXTSTWD  GOTO LN13
         BAL,RL1  NXTSTWD
         B        LN13
*  222  SAVEOP   MOVE (CFIX) TO OPTR((CF1PTR,ENDX))
SAVEOP   LW,8     CFIX
         LW,7     ENDX
         LI,9     X'FFFF'
         STS,8    *CF1PTR,7
*  223  LN12     MOVE (XT) TO HW((CF1SYM,CFIX))
LN12     LW,7     CFIX
         STH,XT   *CF1SYM,7
*  224           ADD 1 TO (CFIX)  ADD -1 TO (XT1)
         MTW,1    CFIX
         AI,3     -1
*  225           IF (XT1) EQ 0  GOTO CONC25
         BE       CONC25
*  226           CALL NXTSTWD GOTO LN12
         BAL,RL1  NXTSTWD
         B        LN12
*
         FI
*
*        ALL SPACE COUNTS HAVE BEEN UPDATED TO REFLECT WHETHER
*        THEY WERE USED OR NOT.  ALSO, FOR THOSE USED, FLAGS ARE SET
*        TO INDICATE HOW (OP/OPERAND) THEY ARE TO BE USED.  AT THIS
*        POINT, LOOP THROUGH THE CTRLTBL ENTRIES, SETTING UP
*        OFFSET POINTERS TO THE REFERENCE LINE TABLE FOR EACH ENTRY.
*
         LI,XT    0                 OFFSET POINTER
         LV,XT1   X'FFFDFFFF'       0 TO LEFT - PTR TO RIGHT
         LW,XT2   CTRLTBL
LN14     RES      0
         LW,T1    0,XT2
         AND,T1   L(X'FFFF')        HW COUNT FOR THIS SYM
         STS,XT   0,XT2             MERGE OFFSET TO REFTBL
         SLS,XT   1
         AW,XT    T1
         AI,XT    1
         SLS,XT   -1
         AI,XT2   1                 TO NEXT CTRLTBL ENTRY
         CW,XT2   CF1PTR
         BL       LN14
*
         STW,XT   TOT               SAVE WORD COUNT
         SLS,TOT  1                 CONVERT TO HALFWORDS
         AW,XT    RFO
*  228           IF (XT) LT (ENDCORE) GOTO TEST1
         CW,2     ENDCORE
         IF,GE                      NEED MORE ROOM
         SW,XT    CTRLTBL           XT CONTAIN TOTAL SPACE REQUIRED
         STW,XT   TEMP
         BAL,RL1  CLRLSTBF
         LI,XT    SPILLMSG
         LI,XT1   SPILLSIZE
         BAL,RL1  MOVEMSG
         BAL,RL1  PRINT             OUTPUT SPILL MESSAGE
         BAL,RL1  CLRLSTBF
         LI,XW    3
         BAL,RL1  PRINT             BLANK LINES BEFORE REQUIRED MESSAGE
         BDR,XW   %-1
         LI,XT    REQDMSG
         LI,XT1   REQDSIZE
         BAL,RL1  MOVEMSG
         LW,RL2   TEMP
         LI,XT2   4*(REQDVAL-REQDMSG)+3
         BAL,RL   CNVT
         BAL,RL1  PRINT             OUTPUT SPACE REQUIRED MESSAGE
         BAL,RL1  CLRLSTBF
         LI,XT    AVAILMSG
         LI,XT1   AVAILSIZE
         BAL,RL1  MOVEMSG
         LW,RL2   ENDCORE
         SW,RL2   CTRLTBL
         LI,XT2   4*(AVAILVAL-AVAILMSG)+3
         BAL,RL   CNVT
         BAL,RL1  PRINT
         BAL,RL1  CLRLSTBF
         LI,XW    5
         BAL,RL1  PRINT             BLANK LINES AFTER AVAILABLE MESSAGE
         BDR,XW   %-1
         MTW,1    RADOVTRIG         SET RAD OVERFLOW TRIGGER
         LW,XT    ENDCORE
         AI,XT    -512
         STW,XT   RADBUFFER
         SW,XT    RFO
         SLS,XT   1
         STW,XT   1STRADHW
         BAL,IORL OPENX5            OPEN THE RAD OVERFLOW FILE
* WRITE A RECORD FOR EACH CORE BLOCK REQUIRED FOR RAD OVERFLOW
         SW,TOT   1STRADHW          TOTAL NUMBER HALFWORDS TO SPILL
TEST4    RES      0
         LW,IOADD RADBUFFER         WRITE A 512 WORD
         LW,IOSIZE  COREBLOCK         RECORD
         BAL,IORL WRITEX5             FOR THE NEXT CORE BLOCK
         MTW,1    COREBLOCK         BUMP BLOCK COUNT
         AI,TOT   -1024             DECREASE HALFWORDS REMAINING
         BGZ      TEST4               AND RETURN IF NOT DONE
         MTW,-1   COREBLOCK         CONVERT NO. BLOCKS TO BLOCK NUMBER
         LW,XT    COREBLOCK         COMPUTE FIRST
         SLS,XT   10                  AND
         AW,XT    1STRADHW            LAST
         STW,XT   1STCOREHW           HALFWORD NUMBER
         AI,XT    1024                IN THE LAST
         STW,XT   LASTCOREHW          RAD RECORD
*
         FI
*  236  TEST3    CALL PASSINIT
TEST3    BAL,RL1  PASSINIT
*  237  LINE2    CALL LINENUM
LINE2    RES      0
         CALL     LINENUM
*  239           CLEAR (LISTCT) CLEAR (ARG)
         LI,LISTCT  0
         LI,6     0
*  240           NXTENC
         LH,XT    INBUF,XW
         AI,XW    1
*  241           IF (XT) EQ BLANKEXP GOTO COMP2
         CI,2     5
         BE       COMP2
*  242           IF T(XT) EQ LOCSYM GOTO COMP2
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'6000'
         BE       COMP2
*  243           IF T(XT) NE SYMB GOTO LN20
         CI,8     X'4000'
         BNE      LN20
*  244           MOVE (XT) TO HW(INBUF)
         STH,XT   INBUF
*  245           MOVE 1 TO (ARG)  GOTO COMP2
         LI,6     1
         B        COMP2
*  246  CONC30   NXTENC
CONC30   LH,XT    INBUF,XW
         AI,XW    1
*  247  LN20     IF (XT) EQ BEGLIST GOTO LN21
LN20     RES      0
         IF,NE    BEGLIST,XT
*  248           IF (XT) EQ ENDLIST GOTO LN22
         CI,2     2
         BE       LN22
*  249           IF T(XT) EQ SYMB GOTO LN23
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'4000'
         BE       LN23
*  250           IF T(XT) EQ SSYMB GOTO LN23
         CI,8     X'8000'
         BE       LN23
*  251           IF T(XT) EQ MULTINT ADD L(XT) TO (XW)
         CI,8     X'E000'
         BNE      CONC30
         AND,XT   =X'FF'
         AW,XW    XT
*  252           GOTO CONC30
         B        CONC30
         FI
*  253  LN21     ADD 1 TO (LISTCT) GOTO CONC30
LN21     RES      0
         AI,LISTCT  1
         B        CONC30
*  254  LN22     ADD -1 TO (LISTCT)
LN22     RES      0
         AI,LISTCT  -1
*  255           IF (LISTCT) GT 0 GOTO CONC30
         BG       CONC30
*  256           GOTO COMP2
         B        COMP2
*  257  LN23     MOVE (XT) TO HW(INBUF,ARG)
LN23     STH,XT   INBUF,ARG
*  258           ADD 1 TO (ARG) GOTO CONC30
         AI,6     1
         B        CONC30
*
*        HERE TO PROCESS THE COMMAND FIELD
*
COMP2    RES      0
         LV,XT    CR
         STW,XT   RTYP              ANY SUBSEQUENT REF'S ARE 'COMMANDS'
         LI,LISTCT   0              SO WE CAN START AFRESH ON ARG FIELD
         NXTENC
         IF,EQ    BEGLIST,XT        (ASSUME LW,R IS LIKELY CANDIDATE)
         AI,LISTCT   +1             TALLY LIST HEADER
         NXTENC                     BYPASS LIST HEADER
         FI
         LV,T1    ENCTFLD
         AND,T1   XT                EXTRACT ENCODED TYPE FIELD
         IF,NE    ENCSYM,T1         MUST BE SYMBOL
         LI,XT    COMMENT#          USE 'COMMENT' FOR ANYTHING ELSE
         FI
         STW,XT   CMND              SAVE COMMAND SYMBOL
         CALL     SRCHCF1           FIND THE OP-CODE EBCDIC POINTER
         LW,XT    ENDX
         LW,XT    *CF1PTR,XT
         AND,XT   L(OPTRFLD)
         STW,XT   CLOC              SAVE EBCDIC OP PTR FOR ALL REFS
         LW,XT    CMND                                         /27326/*D-CNC
         BAL,RL1  CF1REF            CONCORD OP IF REQUIRED     /27326/*D-CNC
         LW,XT    CMND
         IF,EQ    SYSTEMDIR,XT
         CALL     SKIPSYS           SYSTEM REFS NOT CONCORDED
         AI,XW    -1
         FI
         LV,XT    LR
         STW,XT   RTYP              ANY SUBSEQUENT REF'S ARE 'LABELS'
LN31     RES      0
         AI,ARG   -1
         IF,GEZ                     DOIF SAVED LABEL SYMBOLS REMAIN
         LH,XT    INBUF,ARG
         BAL,RL1  STOREREF
         B        LN31
*
         FI
*
*        HAVE FINISHED WITH CF(1) - COMPLETE CONCORDANCE OF COMMAND
*           FIELD SO THAT WE CAN GO ON TO ARGUMENT.
*
         LV,XT    NR
         STW,XT   RTYP              ALL CF(2)-CF(N) REF'S ARE 'NORMAL'
LN32     RES      0
         IF,G     0,LISTCT          DOIF MORE THINGS LEFT
LN33     RES      0
         NXTENC
         LV,T1    ENCTFLD
         AND,T1   XT
         IF,EQ    ENCSYM,T1         CONCORD ALL GLOBAL SYMBOLS
         BAL,RL1  STOREREF
         B        LN33
*
         FI
         IF,EQ    ENCSSYM,T1        CONCORD GLOBAL SUBSCRIPTED SYMBOLS
         BAL,RL1  STOREREF
         B        LN33
*
         FI
         CV,XT    ENDLINE           DONE IF END OF LINE
         BE       LN36
*
         IF,EQ    MULTINT,T1        CHECK FOR MULTI-UNIT INTEGER
         AND,XT   L(LFLD)
         AW,XW    XT
         B        LN33
*
         FI
         IF,EQ    ENDLIST,XT        DOWN ONE IF END OF LIST
         AI,LISTCT   -1
         B        LN32
*
         FI
         IF,EQ    BEGLIST,XT        UP ONE IF HEAD OF LIST
         AI,LISTCT   +1
         FI
         B        LN32
*
         FI
*
*        HERE TO SPECIAL-CASE AF(1), CHECKING TO SEE IF THE
*           INDIRECT FLAG IS SET.
*
         LI,LISTCT   0
         STW,LISTCT   STOPCODE
         STW,LISTCT  1STAFREF       FLAG/PTR FOR 1ST AF(1) SYMBOL
LN34     RES      0
         NXTENC
         CV,XT    ENDLINE           DONE IF END OF LINE
         BE       LN36
*
         LV,T1    ENCTFLD
         AND,T1   XT
         IF,EQ    ENCSYM,T1
         BAL,RL1  STOREREF          ENTER GLOBAL SYMBOL REF
         MTW,0    1STAFREF
         IF,EZ                      ONLY RECORD 1ST SUCH REF (IN AF(1))
         LW,XT    LASTREF
         IF,NZ
         MTB,+1   XT                SET FLAG IN BYTE ONE
         STW,XT   1STAFREF
         FI
         FI
         ELSF,EQ  ENCSSYM,T1
         IF,NE    LSSYM,XT
         BAL,RL1  STOREREF          ENTER GLOBAL SYMBOL REF
         MTW,0    1STAFREF
         IF,EZ                      ONLY RECORD 1ST SUCH REF (IN AF(1))
         LW,XT    LASTREF
         IF,NZ
         MTB,+1   XT                SET FLAG IN BYTE ONE
         STW,XT   1STAFREF
         FI
         FI
         FI
         LW,XT    STOPCODE
         IF,EZ                      SET TO SKIP SUB-SYM IF NOT SKIPPING
         LV,XT    ENDSBSYM
         STW,XT   STOPCODE
         LI,LISTCT   1
         ELSF,EQ  ENDSBSYM,XT       TALLY NEW LEVEL IF SKIPPING SUB-SYM
         AI,LISTCT   +1
         FI
         ELSF,EQ  BEGINEXP,XT
         LW,XT    STOPCODE
         IF,EZ                      SET TO SKIP EXPR. IF NOT SKIPPING
         LV,XT    ENDEXP
         STW,XT   STOPCODE
         LI,LISTCT   1
         ELSF,EQ  ENDEXP,XT         TALLY NEW LEVEL IF SKIPPING EXPR.
         AI,LISTCT   +1
         FI
         ELSF,EQ  BEGLIST,XT
         LW,XT    STOPCODE
         IF,EZ                      SET TO SKIP LIST IF NOT SKIPPING
         LV,XT    ENDLIST
         STW,XT   STOPCODE
         LI,LISTCT   1
         ELSF,EQ  ENDLIST,XT        TALLY NEW LEVEL IF SKIPPING LIST
         AI,LISTCT   +1
         FI
         ELS
         CW,XT    STOPCODE
         IF,EQ
         AI,LISTCT   -1             DROP A LEVEL ON END-THING CONTROL
         ELSF,EQ  MULTINT,T1        CHECK FOR MULTI-UNIT INTEGER
         AND,XT   L(LFLD)
         AW,XW    XT
         FI
         FI
         CI,LISTCT   0
         BG       LN34              GO BACK IF IN MIDDLE OF SOMETHING
*
*        AT THIS POINT, AF(1) HAS BEEN BYPASSED.  IF THE ARG WAS
*           INDIRECT, THE NEXT THING IN THE BUFFER WILL BE THE
*           '*' CONTROL.  IF '*', AND THERE WERE REFERENCE ITEMS
*           CREATED, CHANGE 'RT' OF THE FIRST SUCH TO SHOW INDIRECT.
*
         NXTENC   ,NOINC
         IF,EQ    ASTFLG,XT         DOIF '*'
         AI,XW    +1                BYPASS '*'
         LW,XT    1STAFREF
         IF,NZ                      DOIF REF ENTERED IN AF(1)
         AND,XT   L(LOCFLD)
         MTW,0    RADOVTRIG
         IF,NZ
         LW,RADHW XT                GET RIGHT BLOCK IF NOT IN
         BAL,RL1  WRITERADRCD
         FI
         LH,T1    *RFO,XT
         AND,T1   L(~RTFLD)
         AV,T1    IR
         STH,T1   *RFO,XT           UPDATE REF ITEM TO SHOW INDIRECT
         FI
         FI
*  279  CONC35   NXTENC
CONC35   LH,XT    INBUF,XW
         AI,XW    1
*  280           IF T(XT) EQ SYMB GOTO LN35
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'4000'
         BE       LN35
*  281           IF T(XT) EQ SSYMB GOTO LN35
         CI,8     X'8000'
         BE       LN35
*  282           IF (XT) EQ ENDLINE GOTO LN36
         CI,2     0
         BE       LN36
*  283           IF T(XT) EQ MULTINT ADD L(XT) TO (XW)
         CI,8     X'E000'
         BNE      CONC35
         AND,XT   =X'FF'
         AW,XW    XT
*  284           GOTO CONC35
         B        CONC35
*  285  LN35     CALL STOREREF GOTO CONC35
LN35     BAL,RL1  STOREREF
         B        CONC35
*  286  LN36     IF (CMND) NE ENDDIR GOTO LINE2
LN36     RES      0
         LW,T1    CMND
         CV,T1    ENDDIR
         BNE      LINE2
*  IF (RADOVTRIG) EQ 0 GOTO CONC40
         LW,XT    RADOVTRIG
         BEZ      CONC40
*  WRITE THE RAD RECORD CURRENTLY IN CORE
         LW,IOSIZE  COREBLOCK
         LW,IOADD RADBUFFER
         BAL,IORL WRITEX5           WRITE THE 512 WORD BLOCK
*  287  CONC40   CALL NXTRECRD
CONC40   BAL,RL1  NXTRECRD
*  288  CONC50   CALL NXTSTWD
CONC50   BAL,RL1  NXTSTWD
*  289           IF (XT) LT 0 GOTO CONCTERM
         CI,2     0
         BL       CONCTERM          BRANCH AT END OF CONCORDANCE
*  290           MOVE (CTRLTBL) PLUS V(XT) TO (MIDX)
         LW,MIDX  CTRLTBL
         AND,XT   =X'1FFF'
         AW,MIDX  XT
*  291           MOVE LOC((MIDX)) TO (ORGX)
         LW,8     0,4
         SLS,T1   1                 WORD OFFSET TO HW OFFSET
         AND,8    =X'3FFFF'
         STW,8    ORGX
*  292           MOVE LOC1((MIDX)) TO (ENDX)
         LW,8     1,4
         SLS,T1   1                 WORD OFFSET TO HW OFFSET
         AND,8    =X'3FFFF'
         STW,8    ENDX
*  293           IF (ENDX) EQ (ORGX)  GOTO NOREFS
         CW,8     ORGX
         BE       NOREFS
*  294           CALL CLRLSTBF  CALL NXTSTWD
         BAL,RL1  CLRLSTBF
         BAL,RL1  NXTSTWD
*  295           MOVE CCT(XT) PLUS 4 TO (OUTX)
         LW,OUTX  XT
         AI,OUTX  X'400'
         SLS,OUTX -8
*  296           MOVE 1 TO  (TABX) MOVE 2 TO (X)
         LI,TABX  1
         LI,6     2
*  297           MOVE CCT(XT) OVER 2 PLUS 1 TO (XT1)
         LW,XT1   XT
         SLS,XT1  -9
         AI,XT1   1
*  298           MOVE C1(XT) TO BYTE(LSTBF:3)
        LI,7      3
         STB,2    LSTBF,7
*  299  LN40     ADD -1 TO (XT1)
LN40     AI,3     -1
*  300           IF (XT1) EQ 0 GOTO LN45
         BE       LN45
*  301           CALL NXTSTWD MOVE (XT) TO HW(LSTBF,X)
         BAL,RL1  NXTSTWD
         STH,XT   LSTBF,6
*  302           ADD 1 TO (X) GOTO LN40
         AI,6     1
         B        LN40
*  303  NOREFS   CALL NXTSTWD
NOREFS   BAL,RL1  NXTSTWD
*  304           MOVE CCT(XT) OVER 2 PLUS 1 TO (XT1)
         LW,XT1   XT
         SLS,XT1  -9
         AI,XT1   1
*  305  LN42     ADD -1 TO (XT1)
LN42     AI,3     -1
*  306           IF (XT1) EQ 0 GOTO CONC50
         BE       CONC50
*  307           CALL NXTSTWD  GOTO LN42
         BAL,RL1  NXTSTWD
         B        LN42
*  309  LN45     CALL STORLN
LN45     BAL,RL1  STORLN
*  310           IF (ORGX) PLUS 1 LT (ENDX) GOTO LN45
         LW,8     ORGX
         AI,T1    1
         CW,8     ENDX
         BL       LN45
*
*  311           CALL PRINT  GOTO CONC50
         BAL,RL1  PRINT
         B        CONC50
*  CLOSE THE X5 FILE IF IT'S OPEN.  THEN RETURN TO THE ROOT
CONCTERM  RES     0
         LW,XT    DC%FLAG
         AND,XT   L(CLEANCN)
         STW,XT   DC%FLAG           SCRUB SUB-OPTION FLAGS & RECORD COUNT
         LW,XT    RADOVTRIG         X5 IS OPEN IF RADOVTRIG IS ON
         BEZ      *ROOTRTN
         BAL,IORL CLOSEX5
         B        *ROOTRTN
         PAGE
*  312  *
*  313  *   S K I P S Y S
*  314  *        SKIP PAST THE END OF THE 'SYSTEM' DIRECTIVE
*  315  *
*  316  SKIPSYS  SUBR (SKIPSXIT)
*
         LOCAL    %30,%40,%50
*
SKIPSYS  RES      0
         STW,RL   SKIPSXIT
*  317           CLEAR (SYSCOUNT)
         LI,8     0
         STW,8    SYSCOUNT
*       SYSCODE NXTENC
SYSCODE  LH,XT    INBUF,XW
         AI,XW    1
*  319           IF SYSTYPE(XT) GE 2 ADD 1 TO (SYSCOUNT)
         LW,8     2
         AND,8    =X'1C00'
         CI,8     X'800'
         BL       #105
         MTW,1    SYSCOUNT
#105     RES      0
*  320  SKIPS1   NXTENC
SKIPS1   LH,XT    INBUF,XW
         AI,XW    1
*  321           IF (XT) EQ ENDLINE  GOTO SKIPS2
         IF,EQ    ENDLINE,XT
         MTW,0    SYSCOUNT
         BLEZ     *SKIPSXIT         DONE
*
*        SKIP THE LINE NUMBER AND LABEL FIELD SO THAT THE
*        COMMAND SYMBOL CAN BE INSPECTED.
*
%30      RES      0
         NXTENC
         IF,EQ    ENDBUFF,XT
         BAL,RL1  NXTRECRD
         B        %30
*
         FI
*
*        SKIP THE LINE NUMBER
*
         LI,XT1   ENCTFLD
         CS,XT    L(ENCTINT)
         IF,NE                      ASSUME LARGE INTEGER
         AI,XW    1
         FI
%40      RES      0
         NXTENC   ,NOINC
         CS,XT    L(ENCTINT)
         IF,GE
         AI,XW    1
         CS,XT    L(ENCTINT)
         IF,G                       IS LARGE INTEGER
         AI,XW    1
         FI
         B        %40
*
         FI
         LI,LISTCT   0              (THIS MUST BE 0 ON EXIT)
%50      RES      0
         NXTENC                     NEXT ITEM
         IF,EQ    BEGLIST,XT
         AI,LISTCT   1
         ELSF,EQ  ENDLIST,XT
         AI,LISTCT   -1
         ELS
         LV,T1    ENCTFLD
         AND,T1   XT
         IF,EQ    MULTINT,T1
         AND,XT   L(LFLD)
         AW,XW    XT
         FI
         FI
         CV,LISTCT   0
         BG       %50
*
         NXTENC
         IF,EQ    BEGLIST,XT
         NXTENC
         FI
*               IF (XT) EQ SYSTDIR GOTO SYSCODE
         CV,XT    SYSTEMDIR
         BE       SYSCODE
*  324           IF (XT) EQ ENDDIR  ADD -1 TO (SYSCOUNT)
         CV,XT    ENDDIR
         BNE      #106
         MTW,-1   SYSCOUNT
#106     RES      0
         FI
*  323           IF T(XT) EQ MULTINT ADD L(XT) TO (XW)
         LW,8     2
         AND,8    =X'E000'
         CI,8     X'E000'
         BNE      #107
         LW,8     2
         AND,8    =X'FF'
         AW,1     8
#107     RES      0
*  324           IF (XT) EQ ENDBUFF CALL NXTRECRD  GOTO SKIPS1
         CI,2     ENDBUFF
         BNE      #108
         BAL,RL1  NXTRECRD
#108     RES      0
         B        SKIPS1
         PAGE
*  329  *
*  330  *   C L R L S T B F
*  331  *        BLANK THE LISTING PRINT BUFFER
*  332  *
CLRLSTBF RES      0
         LW,XT1   ='    '
         LI,XT    -14
         STD,XT1  LSTBF+28,XT
         BIR,XT   %-1
         B        *RL1
         PAGE
*
*   C N E R R
*        SOMETHING IS WRONG WITH A CONCORDANCE CONTROL COMMAND -
*        DIAGNOSE.
CNERR    RES      0
         STW,RL   CNERRXIT
         BAL,RL1  CLRLSTBF          CLEAR LISTING BUFFER
         LI,XT    CNERRMSG
         LI,XT1   CNERRSIZE
         BAL,RL1  MOVEMSG           MOVE DIAGNOSTIC TO MESSAGE
         LW,RL2   CNCLNUM
         LI,XT2   4*CNERRSIZE-1
         CALL     CNVT              EDIT COMMAND (NOT LINE) NUMBER
         BAL,RL1  PRINT
         BAL,RL1  CLRLSTBF
         BAL,RL1  PRINT
         B        *CNERRXIT
         PAGE
*  340  *
*  341  *   C N V T
*  342  *        CONVERT A LINE NUMBER TO EBCDIC AND STORE IT IN LSTBF
*  343  *
CNVT     RES      0
         LI,RL1   0
         DW,RL1   =10
         AI,RL1   '0'
         STB,RL1  LSTBF,XT2
         AI,XT2   -1
         CI,RL2   0
         BG       CNVT
         B        0,RL
         PAGE
*  354  *
*  355  *   C T C H R S
*  356  *        COUNT THE NUMBER OF DIGITS IN A LINE NUMBER
*  357  *
CTCHRS   RES      0
         LI,XT    0
CTCHR1   RES      0
         AI,XT    1
         CW,XT2   DECTBL-1,XT
         BGE      CTCHR1
         B        0,RL
DECTBL   RES      0
         DATA     10,100,1000,10000,100000
         PAGE
*
*   M O V E M S G
*        MOVE A MESSAGE TO LSTBF
*                 XT CONTAINS ORIGIN OF MESSAGE
*                 XT1 CONTAINS NUMBER OF WORDS TO MOVE
*
MOVEMSG  RES      0
         AI,XT    -1                SUBT 1 FROM BASE ADDRESS
MOVEMSG1 LW,RL    *XT,XT1
         STW,RL   LSTBF-1,XT1
         BDR,XT1  MOVEMSG1
         B        *RL1
         PAGE
*
*   R D R A D R C D
*        READ A RECORD FROM RAD INTO THE RAD BUFFER IF THAT RECORD
*          IS NOT ALREADY THERE.
*
*        INPUT: RADHW CONTAINS THE HALF-WORD REQUIRED TO BE IN CORE.
*               1STCOREHW CONTAINS FIRST HALF-WORD CURRENTLY IN CORE.
*               LASTCOREHW CONTAINS LAST HALF-WORD CURRENTLY IN CORE.
*
*       OUTPUT: THE REQUIRED HALF-WORD IS IN CORE.
*               1STCOREHW AND LASTCOREHW UPDATED AS REQUIRED.
*               XT CONTAINS THE HALF-WORD INDEX TO RADBUFFER.
*
RDRADRCD RES      0
         LW,XT    RADHW             EXIT IF REQUIRED HALFWORD
         CW,XT    1STRADHW            IS BELOW THE RAD OVERFLOW
         BL       *RL1                BUFFER
         CW,RADHW 1STCOREHW         IS THE REQUIRED
         BL       RDRAD1              HALF-WORD
         CW,RADHW LASTCOREHW          IN THE
         BL       RDRAD2              CORE BUFFER
RDRAD1   RES      0
         SW,XT    1STRADHW
         SLS,XT   -10
         STW,XT   COREBLOCK         STORE NEW CORE BLOCK NUMBER
         LW,IOADD COREBLOCK
         SLS,IOADD 10
         AW,IOADD 1STRADHW
         STW,IOADD  1STCOREHW       NEW CORE LOWER LIMIT
         AI,IOADD 1024
         STW,IOADD LASTCOREHW       NEW CORE UPPER LIMIT
         LW,IOADD   RADBUFFER
         LW,IOSIZE  COREBLOCK
         BAL,IORL READX5            READ THE RECORD FROM RAD TO CORE
         LW,XT    RADHW             COMPUTE HALF-WORD OFFSET FROM
RDRAD2   RES      0
         SW,XT    1STCOREHW           REFTBL
         AW,XT    1STRADHW            ORIGIN
         B        *RL1
         PAGE
*
*   W R I T E R A D R C D
*        WRITE THE CURRENT RAD RECORD AND READ IN THE REQUIRED ONE
*
*        INPUT: RADHW CONTAINS THE HALF-WORD REQUIRED TO BE IN CORE.
*               1STCOREHW CONTAINS THE FIRST HALF-WORD CURRENTLY IN CORE
*               LASTCOREHW CONTAINS THE LAST HALF-WORD CURRENTLY IN CORE
*
*       OUTPUT: THE REQUIRED HALF-WORD IS IN CORE.
*               1STCOREHW AND LASTCOREHW UPDATED AS REQUIRED.
*               XT CONTAINS THE HALF-WORD INDEX TO RADBUFFER
*
WRITERADRCD  RES  0
         LW,XT    RADHW             EXIT IF THE REQUIRED HALFWORD
         CW,XT    1STRADHW            IS BELOW THE RAD OVERFLOW
         BL       *RL1                BUFFER
         CW,RADHW 1STCOREHW         IS THE REQUIRED
         BL       WTRAD1              HALF-WORD
         CW,RADHW LASTCOREHW          IN THE
         BL       RDRAD2              CORE BUFFER
* HERE TO WRITE THE CURRENT CORE BUFFER AND READ A NEW ONE
WTRAD1   RES      0
         LW,IOSIZE  COREBLOCK
         LW,IOADD RADBUFFER         WRITE THE CURRENT RAD RECORD
         BAL,IORL WRITEX5
         B        RDRAD1
         PAGE
*  368  *
*  369  *   P R I N T
*  370  *        PRINT A LINE
*  371  *
PRINT    RES      0
         LI,IOADD LSTBF
         LI,IOSIZE  108
         BAL,IORL WRITELO
         B        *RL1
         PAGE
*  376  *
*  377  *   P A S S I N I T
*  378  *        INITIALIZE FOR THE NEXT PASS
*  379  *
PASSINIT RES      0
         LI,XT    0
         STW,XT   CONTIN
         STW,XT   RESIDUE
         STW,XT   MAJLINE
         STW,XT   SUBLINE
         BAL,IORL REWX1
*  384  *   FALL THROUGH TO NXTRECRD
*  385  *
*  386  *   N X T R E C R D
*  387  *        GET THE NEXT ENCODED TEXT RECORD
*  388  *
NXTRECRD RES      0
         BAL,IORL READX1
         LI,XW    0
         B        *RL1
*
*   N X T C N R E C
*        GET THE NEXT CONCORDANCE CONTROL FILE RECORD
*
NXTCNREC RES      0
         LI,IOADD INBUF
         BAL,IORL READX3
         LI,XW    0
         EXIT
         PAGE
*  394  *
*  395  *   N X T S T W D
*  396  *        GET THE NEXT SYMBOL TABLE HALFWORD
*  397  *
NXTSTWD  RES      0
         STW,RL1  NXTSTXIT
         CI,XW    HWX1SIZE
         BL       NXSTWD1
         BAL,RL1  NXTRECRD
NXSTWD1  RES      0
         LH,XT    INBUF,XW
         AI,XW    1
         B        *NXTSTXIT
         PAGE
*  408  *
*  409  *   L I N E N U M
*  410  *        PROCESS THE LINE NUMBER OF THE CURRENT LINE
*  411  *
LINENUM  RES      0
         STW,RL   LINUMXIT
         LW,XT    CONTIN            IF PREVIOUS LINE WAS CONTINUED,
         BEZ      LINENUM1            SAVE MAJOR AND SUB-LINE NUMBERS
         STW,XT   MAJLINE
         LI,XT    0
         STW,XT   CONTIN
         XW,XT    RESIDUE
         AWM,XT   SUBLINE
LINENUM1 RES      0
         LH,XT    INBUF,XW          NEXT ENCODED ENTRY
         AI,XW    1
         CI,XT    ENDBUFF
         BNE      LINENUM2
         BAL,RL1  NXTRECRD          READ NEXT ENCODED RECORD
         B        LINENUM1
LINENUM2 RES      0
         LI,XT1   ENCTFLD           MASK FOR TYPE FIELD COMPARISONS
         CS,XT    =ENCTINT          TEST FOR SMALL INTEGER
         BE       LINENUM3            YES.
         LH,XT    INBUF,XW
         AI,XW    1
         B        LINENUM4
LINENUM3 RES      0
         AND,XT   =VALFLD           IF INTEGER = 0, IT'S A SUB-LINE
         BNEZ     LINENUM4            NOT A SUB-LINE NUMBER
         MTW,1    SUBLINE
         LI,XT    3
         B        LINENUM6
LINENUM4 RES      0
         STW,XT   MAJLINE
         LI,XT    0                 CLEAR SUB-LINE NUMBER
         STW,XT   SUBLINE
         LI,XT    2                 AMT. OF SPACE = 2
LINENUM6 RES      0
         STW,XT   LINESP            SPACE REQ'D FOR A REFERENCE LINE NO.
LINENUM5 RES      0
         LH,XT    INBUF,XW          IS THE NEXT ENCODED ITEM
         CS,XT    =ENCTINT            AN INTEGER
         BL       *LINUMXIT           NO.  EXIT
         AI,XW    1                 BUMP XW
         LW,ARG   MAJLINE           SAVE MAJOR LINE NUMBER
         STW,ARG  CONTIN
         CS,XT    =ENCTINT          TEST FOR SMALL INTEGER
         BNE      LINENUM7            NO.  LARGE INTEGER
         AND,XT   =VALFLD           IF 0, THIS IS A SUB-LINE
         BNEZ     LINENUM8            NOT A SUB-LINE
         MTW,1    RESIDUE
         B        LINENUM5
LINENUM7 RES      0
         LH,XT    INBUF,XW          NEXT HALFWORD CONTAINS LINE NUMBER
         AI,XW    1
LINENUM8 RES      0
         STW,XT   CONTIN            MAJOR CONTINUATION LINE NUMBER
         LI,XT    0                 CLEAR CONTINUATION SUB-LINE NUMBER
         STW,XT   RESIDUE
         B        LINENUM5
         PAGE
*  470  *
*  471  *   S T O R L N
*  472  *        CONVERT AND STORE A REFERENCE LINE NUMBER IN THE NEXT
*  473  *          AVAILABLE FIELD OF THE LISTING IMAGE
*  474  *
*  475  *        INPUT: ORGX CONTAINS THE HALFWORD INDEX TO THE REFTBL ENTRY
*  476  *               TABX CONTAINS THE NEXT TAB POSITION IN LSTBF
*  477  *               OUTX CONTAINS THE NEXT AVAILABLE PRINT POSITION IN LSTBF
*  478  *
*  479  *       OUTPUT: TABX,OUTX, AND ORGX ARE BUMPED
*  480  *               THE LINE NUMBER IS CONVERTED AND STORED IN LSTBF
*  481  *               THE PREVIOUS LINE IS PRINTED IF FULL
*  482  *
STORLN   RES      0
         STW,RL1  STORLXIT
         LW,RL    ORGX
         LI,XT    -3
         LW,XT1   RADOVTRIG         ARE WE IN RAD SPILL MODE
         BEZ      STLN1               NO
         LW,RADHW ORGX
         BAL,RL1  RDRADRCD          ASSURE THE REQ'D HW IS IN CORE
         LH,RL2   *RFO,XT           MOVE FLAGS AND OPCODE
         STW,RL2  CURRLINE            TO CURRLINE
         AI,RADHW 1
         BAL,RL1  RDRADRCD          ASSURE MAJOR LINE NO. IS IN CORE
         LH,XT1   *RFO,XT           MAJOR LINE NUMBER
         STW,XT1  CURRLINE+1
         CI,RL2   SLFLD             IS THERE A SUBLINE NUMBER
         BAZ      STLN9               NO
         AI,RADHW 1
         BAL,RL1  RDRADRCD          ASSURE SUBLINE NUMBER IS IN CORE
         LH,XT1   *RFO,XT           MOVE SUBLINE NUMBER
         STW,XT1  CURRLINE+2
         B        STLN9
*  487  * MOVE 3 HALFWORDS FROM REFTBL TO CURRLINE
STLN1    RES      0
         LH,XT1   *RFO,RL
         STW,XT1  CURRLINE+3,XT
         AI,RL    1
         BIR,XT   STLN1
STLN9    RES      0
         LW,XT2   CURRLINE+1        COUNT CHARACTERS IN THE MAJOR
         BAL,RL   CTCHRS              LINE NUMBER
         STW,XT   CT
         LW,XT    CURRLINE          IS THERE A SUB-LINE NUMBER
         CI,XT    SLFLD
         BAZ      STLN2             NO SUB-LINE NUMBER
         LW,XT2   CURRLINE+2        COUNT CHARACTERS IN THE
         BAL,RL   CTCHRS              SUB-LINE NUMBER
         AI,XT    1                 ADD 1 FOR THE
         AWM,XT   CT                  DECIMAL POINT
         MTW,1    ORGX
STLN2    RES      0
         MTW,2    ORGX
STLN3    RES      0
         CI,TABX  8                 IS THERE ROOM ON THE CURRENT LINE
         BL       STLN4               YES.
*  509  * NO ROOM.  PRINT THE CURRENT LINE, CLEAR THE LINE IMAGE, RESET POINTERS
STLN10   RES      0
         BAL,RL1  PRINT
         BAL,RL1  CLRLSTBF
         LI,TABX  0
         LI,OUTX  0
*  515  * IS THERE ROOM BETWEEN THE LAST TAB POSITION AND THE NEXT ONE
STLN4    RES      0
         LB,XT    TABTBL,TABX
         SW,XT    CT
         CW,XT    OUTX
         BG       STLN5             YES, THERE'S ROOM
         AI,TABX  1                 NO ROOM. BUMP TAB POSITION, RETRY
         B        STLN3
*  523  * DETERMINE WHETHER THE COMMAND WILL ALSO FIT ON THIS LINE
STLN5    RES      0
         LI,XT1   0
         LW,XT    CURRLINE
         AND,XT   L(RTFLD)
         IF,NE    CR,XT
         IF,EQ    IR,XT             INDIRECT FLAG WILL TAKE 1 BYTE
         AI,XT    1
         FI
         LW,XT    CURRLINE
         AND,XT   =CNFLD
         AW,XT    CF1SYM
         AW,XT    CF1SYM
         LH,CHARS 0,XT
         LW,XT2   CHARS
         SLS,XT2  -8                GET COUNT BYTE
         AW,XT1   XT2
         FI
         LB,OUTX  TABTBL,TABX
         AW,OUTX  XT1
         CI,OUTX  106
         BG       STLN10            TOO BIG. PRINT THE LINE AND RETRY
         LB,OUTX  TABTBL,TABX       GET TAB POSITION
         LW,XT2   OUTX
         AI,XT2   -1
         AI,TABX  1
         LW,RL    CURRLINE          SET REFERENCE TYPE CODE SEPARATOR
         AND,RL   L(RTFLD)
         SHIFT,RL RTLOB,31
         LB,RL1   L('/%-/'),RL
         STB,RL1  LSTBF,OUTX        LABEL/NON-LABEL INDICATOR
         AI,OUTX  1
         IF,NE    CR**(RTLOB-31),RL COMMAND REFERENCE HAS NO COMMAND
*  554  * STORE THE COMMAND CHARACTERS IN THE PRINT IMAGE
STLN30   RES      0
         STB,CHARS LSTBF,OUTX
         AI,OUTX  1
         AI,XT1   -1
         IF,NZ
         AI,XT    1
         LH,CHARS 0,XT              NEXT HALFWORD OF COMMAND CHARACTERS
         SLS,CHARS -8
         STB,CHARS  LSTBF,OUTX
         LH,CHARS 0,XT
         AI,OUTX  1
         BDR,XT1  STLN30
*
         FI
*
*        CHECK TO SEE IF THIS WAS AN INDIRECT REFERENCE
*
         IF,EQ    IR**(RTLOB-31),RL
         LI,T1    '*'
         STB,T1   LSTBF,OUTX
         AI,OUTX  1
         FI
         FI
         LW,T1    CURRLINE
         CI,T1    SLFLD             IS THERE A SUB-LINE NUMBER
         BAZ      STLN32              NO.
         LW,RL2   CURRLINE+2        CONVERT AND STORE
         BAL,RL   CNVT                SUB-LINE NUMBER
         LI,T1    '.'               INSERT DECIMAL POINT
         STB,T1   LSTBF,XT2
         AI,XT2   -1
STLN32   RES      0
         LW,RL2   CURRLINE+1        CONVERT AND STORE
         BAL,RL   CNVT                MAJOR LINE NUMBER
         B        *STORLXIT
TABTBL   RES      0
         DATA,1   10,23,36,49,62,75,88,101
         BOUND    4
         PAGE
*
*   C F 1 R E F
*        ENTER CF(1) REF IF INDICATED
*
*        OUTPUT:  LASTREF IS INDEX TO REFTBL, IF ENTERED (ELSE IS 0).
*
CF1REF   RES      0
         LI,T1    0
         STW,T1   LASTREF
         AND,XT   L(VALFLD)
         LW,XT1   *CTRLTBL,XT
         MTW,0    OPREFS
         EXIT,LZ  RL1               GET OUT IF ALL OPS SUPRESSED
         IF,EZ                      MUST LOOK-UP
         IF,AZ    CTBLCC,XT1
         EXIT     RL1               OP-CODE NOT INCLUDED
*
         FI
         FI
         B        STORREFU          GO TO STORE REFERENCE
         PAGE
*  646  *
*  647  *   S T O R E R E F
*  648  *        STORE A REFERENCE LINE NUMBER IN REFTBL
*
*        OUTPUT:  LASTREF IS INDEX TO REFTBL, IF ENTERED (ELSE IS 0).
*
STOREREF RES      0
         LI,T1    0
         STW,T1   LASTREF
         AND,XT   L(VALFLD)
         LW,XT1   *CTRLTBL,XT
         MTW,0    SYMREFS
         IF,LEZ
         EXIT,LZ  RL1               JUST LEAVE IF ALL SYMS SUPPRESSED
*
         IF,ANZ   CTBLCC,XT1        DOIF MUST TEST 'SYM' BIT IN CF1 TAB
         STW,XT   TEMP
         CALL     SRCHCF1
         LW,XT    ENDX
         LW,XT1   *CF1PTR,XT
         IF,AZ    CFPTRSYM,XT1
         EXIT     RL1               SYM NOT INCLUDED
         FI
         LW,XT    TEMP              RESTORE STUFF
         LW,XT1   *CTRLTBL,XT
         FI
         FI
         IF,EQ    L#+1,XT           DON'T CONCORD '=' OPERATOR
         EXIT     RL1
*
         FI
*
*   ENTRY TO UNCONDITIONALLY ENTER REF
*        XT IS (CLEAN) SYMBOL NUMBER
*        XT1 IS CTRLTBL ENTRY
*
STORREFU RES      0
         AW,XT    CTRLTBL
         AND,XT1  L(LOCFLD)
         LW,T1    1,XT
         AND,T1   L(LOCFLD)
         SW,T1    XT1
         EXIT,LEZ RL1               EXIT IF NO ROOM FOR REF'S
*
         LW,XT1   LINESP
         SHIFT,XT1   31,SPACELOB
         AW,XT1   0,XT
         XW,XT1   0,XT
         SLS,XT1  SPACELOB-31       CURRENT HW OFFSET INTO THIS SLOT
         LW,T1    0,XT
         SLS,T1   1                 HW OFFSET OF THIS SLOT IN REFTBL
         AW,XT1   T1
         AND,XT1  L(X'3FFFF')
         STW,XT1  LASTREF           SAVE INDEX TO THIS REFERENCE ITEM
         LW,RL    CLOC
         AW,RL    RTYP              MERGE REFERENCE TYPE
         LW,RL2   MAJLINE
         LW,XT    RADOVTRIG         ARE WE IN RAD SPILL MODE
         BEZ      STORERF1            NO
         STW,RL1  STOREREFXIT       SAVE EXIT
         LW,RL1   SUBLINE           IS THERE A SUBLINE NUMBER
         BEZ      %+2                 NO
         AI,RL    SLFLD             ADD SUBLINE INDICATOR
         LW,RADHW XT1
         BAL,RL1  WRITERADRCD       ASSURE REQ'D HW IS IN CORE
         STH,RL   *RFO,XT
         AI,RADHW 1
         BAL,RL1  WRITERADRCD
         STH,RL2  *RFO,XT           STORE MAJOR LINE NUMBER
         LW,RL2   SUBLINE           EXIT IF THERE'S NO
         BEZ      *STOREREFXIT        SUBLINE NUMBER
         AI,RADHW 1
         BAL,RL1  WRITERADRCD
         STH,RL2  *RFO,XT           STORE SUBLINE NUMBER
         B        *STOREREFXIT
STORERF1 RES      0
         LW,XT    SUBLINE
         BEZ      STORERF2
         AI,RL    SLFLD
         STH,RL   *RFO,XT1
         AI,XT1   1
         STH,RL2  *RFO,XT1
         AI,XT1   1
         STH,XT   *RFO,XT1
         B        *RL1
STORERF2 RES      0
         STH,RL   *RFO,XT1
         AI,XT1   1
         STH,RL2  *RFO,XT1
         B        *RL1
         PAGE
*  679  *
*  680  *   C T S P A C E
*  681  *        COUNT THE NUMBER OF HALFWORDS REQUIRED FOR THIS REFERENCE
*  682  *
*  683  *
CTSPACE  RES      0
         CV,XT    LSSYM+1           (DON'T CONCORD '=' OPERATOR)
         EXIT,EQ
*
         LI,XT1   VALFLD            ISOLATE SYMBOL NUMBER
         AND,XT1  XT                  IN REG XT1
         LW,ARG   LINESP            ADD NUMBER OF HALFWORDS TO SPCT
         AWM,ARG  *CTRLTBL,XT1        FIELD FOR THIS SYMBOL
         EXIT
         PAGE
*
*   M A P C T R L
*        CONTROL THE CHAINING AND MODIFICATIONS TO SPACE COUNTS INDUCED
*        BY CONCORDANCE CONTROLS.
*
         LOCAL    %10,%20,%30
*
MAPCTRL  RES      0
         STW,RL   MAPCXIT           SAVE RETURN
         LW,XT    CMND
         MTB,0    DC%FLAG
         IF,EZ                      THERE WERE NO NAME-LISTS ON CN
         CALL     SRCHCF1
         LV,XT    VALFLD
         AND,XT   CMND
         LW,XT1   *CTRLTBL,XT
         BAL,RL1  CNVCTRL           JUST DO THE CONVERSION
         B        *MAPCXIT          EXIT
*
         FI
         IF,AZ    MOFLG,XT
*
*        CURRENT SYMBOL IS NOT MULTIPLY-OCCURRING; JUST PROCESS IT.
*        IF THERE IS A PENDING CHAIN (AWAITING A CN CONTROL WHICH
*        WE DIDN'T GET), PROCESS THE CHAIN FIRST.
*
%10      RES      0
         LH,XT    TEMP              GET CURRENT CHAIN LINK
         AND,XT   L(VALFLD)
         IF,NZ                      DOIF ANY MORE REMAIN
         CALL     SRCHCF1
         LH,XT    TEMP
         AND,XT   L(VALFLD)
         LW,XT1   *CTRLTBL,XT
         STW,XT1  TEMP
         BAL,RL1  CNVCTRL
         B        %10
*
         FI
         LW,XT    CMND              HERE TO DO SYMBOL IN HAND
         BEZ      *MAPCXIT          EXIT
*
         CALL     SRCHCF1
         LW,XT    CMND
         AND,XT   L(VALFLD)
         LW,XT1   *CTRLTBL,XT
         BAL,RL1  CNVCTRL
         LI,XT    0
         STW,XT   CT
         STW,XT   TEMP
         B        *MAPCXIT          EXIT
*
         FI
*
*        CURRENT SYMBOL IS MULTIPLY OCCURING.  IF IT IS A CN CONTROL
*        AND THERE IS A PENDING CHAIN, USE CURRENT FLAGS TO PROCESS
*        CHAIN.  PROCESS THIS SYMBOL, AND SET CN FLAGS FOR ANY
*        SUBSEQUENT OCCURRENCES OF THIS SYMBOL.
*
         AND,XT   L(VALFLD)
         LW,XT1   *CTRLTBL,XT
         IF,ANZ   CTBLC,XT          DOIF CN CONTROL
         AND,XT1  L(CTBLFLGS)
         AI,XT1   1
         STW,XT1  CT                SET CN CONTROL FLAGS
%20      RES      0
         LH,XT    TEMP              GET CURRENT CHAIN LINK
         AND,XT   L(VALFLD)
         IF,NZ                      DOIF ANY MORE REMAIN
         CALL     SRCHCF1
         LH,XT    TEMP
         AND,XT   L(VALFLD)
         LW,XT1   *CTRLTBL,XT
         STW,XT1  TEMP
         LW,XT1   CT                NEW FLAGS
         BAL,RL1  CNVCTRL
         B        %20
*
         FI
         LW,XT    CMND              HERE TO DO SYMBOL IN HAND
         CALL     SRCHCF1
         LW,XT    CMND
         AND,XT   L(VALFLD)
         LW,XT1   CT
         BAL,RL1  CNVCTRL
         LI,XT    0
         STW,XT   TEMP
         B        *MAPCXIT          EXIT
*
         FI
*
*        CURRENT SYMBOL IS MULTIPLY-OCCURRING, BUT IS NOT A CN
*        CONTROL.  IF THERE WAS A PRIOR CN CONTROL IN THIS CHAIN,
*        USE ITS FLAGS.  OTHERWISE, ENTER THIS SYMBOL IN CHAIN IN
*        CASE A CN CONTROL POPS UP LATER.
*
         LW,XT    CMND
         CALL     SRCHCF1
         MTW,0    CT
         IF,NZ                      DOIF PREVIOUS CONTROL FOR THIS SYM
         LW,XT    CMND
         AND,XT   L(VALFLD)
         LW,XT1   CT
         BAL,RL1  CNVCTRL
         ELS                        ENTER CURRENT SYMBOL IN CHAIN
         LI,XT    TEMP
         SW,XT    CTRLTBL
%30      RES      0
         LW,XT1   XT
         LW,T1    *CTRLTBL,XT1
         LH,XT    T1
         AND,XT   L(VALFLD)
         BNEZ     %30               BRIF NOT OPEN ENTRY
*
         LW,XT    CMND              ENTER
         AND,XT   L(VALFLD)
         SLS,XT   16
         OR,T1    XT
         STW,T1   *CTRLTBL,XT1
         FI
         B        *MAPCXIT          EXIT
         PAGE
*
*   C N V C T R L
*        USE THE CTRLTBL SS & IO FLAGS TO COMPUTE WHICH SPACE COUNTS
*        WILL BE USED BY PASS 2.
*
*        INPUT:   SYMBOL # IS (CLEAN) IN XT
*                 IF FOUND NE 0, ENDX IS INDEX TO CF1PTR TABLE
*                 CTBLFLGS (SS & IO) ARE IN XT1 (DIRTY)
*
*        CALL:    BAL,RL1  CNVCTRL
*
         LOCAL    %10
*
CNVCTRL  RES      0
         LW,T1    *CTRLTBL,XT
         AND,T1   L(CTBLCC||32BM1)  CLEAR  'CHECK CF1PTR' BIT
         IF,AZ    CTBLIO,XT1        NO OP-CODE REFS TO BE USED
%10      RES      0
         IF,ANZ   CTBLSS,XT1        NO SYMBOL REF'S, EITHER
         AND,T1   L(LOCFLD||32BM1)  SET SPACE COUNT TO ZERO
         FI
         ELS                        HAVE OP-CODE REFS INDICATED
         MTW,0    FOUND
         BEZ      %10               BUT ONLY IF USED AS AN OP-CODE
*
         OR,T1    L(CTBLCC)         SET 'CHECK CF1PTR' FLAG
         LW,XT2   ENDX
         LW,T2    *CF1PTR,XT2       GET CF1PTR ENTRY (HAS SPACE COUNT)
         IF,AZ    CTBLSS,XT1
         OR,T2    L(CFPTRSYM)       SET TO CONCORD BOTH SYM & OPS
         STW,T2   *CF1PTR,XT2
         ELS
         AND,T1   L(LOCFLD||32BM1)  JUST OPS - CLEAR OPERAND SPACE COUNT
         FI
         AND,T2   L(OPTRFLD)
         AW,T1    T2                ADD OP SPACE COUNT TO CTRLTBL ITEM
         FI
         STW,T1   *CTRLTBL,XT       SAVE NEW CTRLTBL ITEM
         EXIT     RL1
         PAGE
*  692  *
*  693  *  S R C H C F 1
*  694  *
*  695  *        SEARCH THE OP CODE TABLE FOR THE SYMBOL NUMBER CONTAINED IN XT.
*  696  *          THE OP CODE TABLE -(CF1PTR)- IS IN (ASCENDING) SEQUENCE
*  697  *          BY SYMBOL NUMBER.
*  698  *
*  699  *        INPUT: XT CONTAINS THE SEARCH ARGUMENT IN THE LOW 13 BITS.
*  700  *               NEXTOP CONTAINS THE NUMBER OF ENTRIES IN THE CF1PTR TBL.
*  701  *
*  702  *       OUTPUT: IF THE ARGUMENT IS FOUND, THE INDEX TO THE OP CODE
*  703  *               TABLE IS IN ENDX, AND THE ROUTINE EXITS
*  704  *               WITH FOUND = ONE   ; OTHERWISE THE ROUTINE EXITS
*  705  *               WITH FOUND = ZERO
*  706  *
*  707  *       FORMAT OF THE OP CODE TABLE: 1 WD/UNIQUE CF1 SYMBOL.
*  708  *               16 BITS FOR SYMBOL NUMBER - OSN FIELD
*  709  *               16 BITS - PASS 1: OCCURRENCE COUNT - PASS 2:
*  710  *               (HW) INDEX TO EBCDIC OP-CODE TABLE (CF1SYM).
*  711  *
*  712  *       REGISTERS USED: XT (MUST BE EVEN) ; XT1 (MUST BE XT+1) ; MIDX
*  713  *
SRCHCF1  RES      0
         AND,XT   =X'1FFF'          CLEAR TYPE BITS
         LI,XT1   X'1FFF'
         SLD,XT   16
         LW,MIDX  NEXTOP            INDEX TO NEXT AVAILABLE CF1TBL ADDR.
         STW,MIDX ENDX
         STW,MIDX ORGX
         LI,MIDX  0
         STW,MIDX FOUND
SRCH1    XW,MIDX  ORGX              DELETE LOWER HALF OF TABLE
SRCH3    CW,MIDX  ORGX              NOT FOUND IF ORGX = OLD ORGX
         EXIT,EQ                    NOT-FOUND RETURN
*
         LW,MIDX  ENDX              COMPUTE THE (HALF-WORD)
         AW,MIDX  ORGX                INDEX TO THE NEW
         SLS,MIDX -1                  MID-POINT OF THE TABLE
         CS,XT    *CF1PTR,MIDX      COMPARE
         BG       SRCH1             BRANCH IF ARGUMENT GT MIDPOINT ENTRY
         STW,MIDX ENDX              IF ARG LT MIDPOINT ENTRY,
         BL       SRCH3                DELETE UPPER HALF OF TABLE
         MTW,1    FOUND             EXIT FOR FOUND. MIDX HAS FOUND INDEX
         EXIT                       FOUND - MIDX HAS FOUND INDEX
         PAGE
*  738  *
*  739  *   I N S R T C F 1
*  740  *
*  741  *        INSERT AN OPCODE SYMBOL NUMBER IN THE CF1PTR TABLE.
*  742  *          SINCE THE TABLE IS IN ASCENDING SEQUENCE, THIS ROUTINE
*  743  *          PRECESSES ALL WORDS FROM ENDX TO THE END OF CF1PTR ONE WORD.
*  744  *
*  745  *        INPUT: XT CONTAINS THE CLEAN ARGUMENT (IN BITS 3-15)
*  746  *               ENDX CONTAINS THE INDEX TO CF1PTR TABLE WHERE THE
*  747  *               ARGUMENT GOES.
*  748  *               NEXTOP CONTAINS THE NUMBER OF ENTRIES IN CF1PTR
*  749  *
*  750  *       OUTPUT: ARGUMENT INSERTED IN CF1PTR, WITH END OF TABLE PRECESSED
*  751  *               NEXTOP IS BUMPED BY 1.
*  752  *
*  753  *       REGISTERS USED: XT ; MIDX ; XT1
INSRTCF1 RES      0
         LCW,MIDX ENDX
         LW,XT1   ENDX
         AW,XT1   CF1PTR
         STW,XT1  ENDX              DESTINATION ADDRESS FOR MOVE
         AI,XT1   -1
         STW,XT1  ORGX              ORIGIN ADDRESS FOR MOVE
         AW,MIDX  NEXTOP            COMPUTE NUMBER OF WORDS TO MOVE
         BEZ      INSRT2
INSRT1   RES      0
         LW,XT1   *ORGX,MIDX        PRECESS THE CF1PTR
         STW,XT1  *ENDX,MIDX          TABLE BY ONE WORD
         BDR,MIDX INSRT1
INSRT2   RES      0
         STW,XT   *ENDX             INSERT THE ARGUMENT IN CF1PTR TABLE
         MTW,1    NEXTOP            BUMP OP CODE COUNT
         EXIT
*
CONCEND  END
