***********************************************************************
*M*      P2COC    TO DECODE :COC CC AND BUILD M:COC, SG:INT & M:IOMOD
*                 & ROOTHAND (DUMMY LOAD MODULE)
************************************************************************
*
         SYSTEM  SIG7FDP
         SYSTEM  BPM
         REF      READSTRG,LLIST
         REF      SYNTAX,COREALLOC,MODGEN,WRITELM
         REF      COCS
         REF      M:TM
         REF      P2ABRT
         REF      M12LFT
         REF      ABNERR2
         REF      MPOOL,CPOOL
         REF      DCT1TEMP
         REF      DCT4TEMP
         REF      TCLSIZES
         REF      P2ERR
         REF      #RBTS
         REF      LORBIN
         REF      TPSZWID
         REF      FEDX#
         REF      INT#
         REF      COCFEX#
         REF      DCTSIZE
         REF      MCDEV
         REF      P2OVLOP
         REF      MINCOCFL
         REF      SCPUFLG
         REF      HAND2FLG
         REF      BIGLOC
         REF      LOGIT
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         DEF      COC
         PAGE
*
*        KEYWORDS
*
KWDTBL   EQU      %
KWD      COM,32,8,24  AF(1),AF(2),AF(3)
         KWD      'DEVI',3,DEVLOC       NDD
         KWD      'L6  ',7,DEVLOC    AND L6 IS EQUIVALENT TO A
*                                   (DEVICE,NDD) OPTION
         KWD      'COC ',0,COCLOC     NEWDYN
         KWD      'COCD',2,COCDIO   HEX
         KWD      'OUT ',2,OUTLOC       HEX
         KWD      'IN  ',2,INLOC        HEX
         KWD      'LINE',1,LINELOC      DEC
         KWD      'BUFF',1,BUFLOC       DEC
         KWD      'RING',1,RINGLOC      DEC
         KWD      'ECB ',1,ECBLOC       DEC
         KWD      'DEA ',X'41',2741TBL+6**16 BYTE FLAG IN DEC = 6
         KWD      'DES ',X'41',2741TBL+4**16 BYTE FLAG IN DEC = 4
         KWD      'DSA ',X'41',2741TBL+10**16 BYTE FLAG IN DEC = 10
         KWD      'DSS ',X'41',2741TBL+8**16 BYTE FLAG IN DEC = 8
         KWD      'DASC',X'41',NON2741T+18**16 BYTE FLAG IN DEC = 18
*                                              ACTUAL FLAG = 17
         KWD      'D33 ',X'41',NON2741T+1**16  BYTE FLAG IN DEC = 1
*                                              ACTUAL FLAG = 0
         KWD      'D35 ',X'41',NON2741T+2**16  BYTE FLAG IN DEC = 2
*                                              ACTUAL FLAG = 1
         KWD      'D37 ',X'41',NON2741T+3**16  BYTE FLAG  IN DEC = 3
*                                              ACTUAL FLAG = 2
         KWD      'D701',X'41',NON2741T+4**16  BYTE FLAG IN DEC = 4
*                                              ACTUAL FLAG = 3
         KWD      '2741',X'41',DYNTBL+4**16  BT-DEC
         KWD      'HARD',X'41',HRDTBL+1**16    BT-DEC
         KWD      'HD  ',X'41',HDTABL+1**16  BT-DEC
         KWD      'SS  ',0,4*FLGLOC+3+1**16
         KWD      'SA  ',0,4*FLGLOC+3+2**16
         KWD      'ES  ',0,4*FLGLOC+3+4**16
         KWD      'EA  ',0,4*FLGLOC+3+8**16
         GEN,32,16,16 'AUTO',1,(AUASCALL*4)+0
         GEN,32,16,16 'ASCI',1,(AUASCALL*4)+2
         GEN,32,16,16 'CALL',1,(AUASCALL*4)+3
         KWD      'RATE',9,RTBL+0**16   BT-DEC
         KWD      'TYPE',9,TYTBL+0**16  BT-DEC
         TEXT     'COUP'
         GEN,15,17 1,4*COUPLE+3
LKWDTBL  EQU      %-KWDTBL
         DATA     #DFLT             #KEYWORDS WITH DEFAULTS
KWDPTR   GEN,15,17 LKWDTBL,KWDTBL   POINTER FOR SYNTAX
DYN      CNAME
         PROC
LF       EQU      %-DYNAM
         GEN,1,15,16 AF(1),AF(2),AF(3)
         PEND
         PAGE
*
*        LIMITS AND DEFAULTS
*
DYNAM    EQU      %
COCDIO   DYN      1,0,0
COCLOC   DYN      0,0,0
OUTLOC   DYN      1,X'61',X'13F'
INLOC    DYN      1,X'60',X'13E'
LINELOC  DYN      1,8,0
BUFLOC   DYN      1,0,0
RINGLOC  DYN      1,0,0
#DFLT    EQU      %-DYNAM
ECBLOC   DYN      1,0,0
DEVLOC   DYN      1,0,X'FFFF'
FLGLOC   DYN      0,0,0
AUASCALL DYN      0,0,0
         PAGE
*******************************************************************
*
*       THE FOLLOWING ARE BYTE TABLES FOR UP TO 128 LINES
*
*******************************************************************
*
2741TBL  DYN      0,0,128           2741 RELATED ENTRIES
         DO1      32                128 BYTES = 32 WORDS IN LENGTH
         DATA     0
NON2741T DYN      0,0,128           NON-2741 RELATED ENTRIES
         DO1      32                128 BYTES = 32 WORDS IN LENGTH
         DATA     0
DYNTBL   DYN      0,0,128
         DO1      32
         DATA     0
HDTABL   DYN      0,0,128
         DO1      32
         DATA     0
HRDTBL   DYN      0,0,128
         DO1      32
         DATA     0
RTBL     DYN      0,0,128
         DO1      32
         DATA     0
TYTBL    DYN      0,0,128
         DO1      32
         DATA     -1
COUPLE   DYN      0,0,0
TOTLN    EQU      DYNTBL
CMND     EQU      FLGLOC
RINGE    EQU      INLOC
#DYNAM   EQU      %-DYNAM
         PAGE
*
*        OTHER DATA
*
PRIMSG   TEXTC    '*** COCX -- INTERRUPT LEVEL CONFLICT - COC ABORTED'
LINMSG   TEXTC    '*** COCX -- LINES > 64 - DEFAULT TAKEN'
BUFMSG   TEXTC    '*** WARNING:  BUFFERS < 3*LINES'
GRPMSGI  TEXTC    '*** COCX ''IN'' OR ''OUT'' LOCATION NOT IN',;
                  ' SAME INTERRUPT GROUP AS PREVIOUS ONES'
GRPMSGO  TEXTC    '*** COCX WARNING - ''OUT'' LOCATION NOT ''IN'' L',;
                  'OCATION +1'
RINGMSG  TEXTC    '*** COCX -- RING INADEQUATE - DEFAULT TAKEN'
RING2MSG TEXTC    '*** COCX -- RING > 255 - 255 USED'
DEVMSG   TEXTC    '*** COCX -- DEVICE OPTION MISSING - COC ABORTED'
DEVERR   TEXTC    '*** COCX -- DEVICE EITHER NOT DEFINED ON COC',;
                  ' COMMAND OR DEFINED ON COC BUT NOT DEVICE COMMAND',;
                  ' (PASS2 ABORT)'
TYPERR   TEXTC    '*** TYPE > 7 INVALID -- DEFAULTS USED'
ERRDIO   TEXTC    '*** ERROR IN COCDIO SPECIFICATION. IT MUST BE ',;
                  'GREATER THAN PREVIOUS. PASS2 OVERIDE USED.'
NO2741MG TEXTC    '***A LINE WAS TAGGED AS A 2741 TERMINAL TYPE ',;
                  'BUT WAS NOT DECLARED AS SUCH WITHIN A 2741 OPTION.'
2741MSG  TEXTC    '*** A LINE WAS DECLARED AS A 2741 BUT WAS TAGGED',;
                  ' AS A NON-2741 WITHIN A TERMINAL TYPE OPTION.'
FILENAME TEXTC    'M:COC'
FILENM   TEXTC    'M:IOMOD'
SGINTNM  TEXTC    'SG:INT'
ROOTHAND TEXTC    'ROOTHAND'
IOLOW    DATA     0
X1FFFE   DATA     X'1FFFE'
XFFFF    DATA     X'FFFF'
XF       DATA     X'F'
FEX#     DATA     0
COCDIOPL DATA     0                 TEMP STORAGE FOR CURRENT COCDIO
MODETBL  DATA     X'88888888',X'08000000'
MODE2TBL DATA     X'20202020',X'30000000'
MOD4DF   DATA     X'28282828',X'09000000'
RATERNGE DATA     10,15,30,60,120,240,X'FF'
NOPGSMSG TEXTC    '*** NOT ABLE TO GET WORK PAGES TO READ SPEC:HAND'
#RATES   EQU      %-RATERNGE
*
TYPFLG   DATA     0
LOWIN    DATA     0
LOWOUT   DATA     0
INGRP    DATA     0
OUTGRP   DATA     0
SPECSTART  DATA   0
SPECLGTH  DATA    0
WDAE     WD,5     X'1200'-4         ARM,ENABLE
STAT     WD,10    X'3000'
OUTRS    RD,7     X'3000'
RCVON    WD,7     X'3001'
RCVOFF   WD,7     X'3003'
OFF      WD,7     X'3002'
XSTAT    WD,7     X'3004'
XDATA    WD,6     X'3005'
XSTOP    WD,7     X'300E'
XPSDO    XPSD,8   0
XPSD0    XPSD,8   0
*
***** DO NOT SEPARATE NEXT 4 ITEMS ************************************
XPSDSTAT XPSD,0   0                 DEPOSITORY FOR XPSD NEEDED FOR L6
XPSDRCVO XPSD,0   0                 DITTO
XPSDRCVD XPSD,0   0                 DITTO
XPSDXDAT XPSD,0   0                 DITTO
*
***** DO NOT SEPARATE ABOVE 4 ITEMS ***********************************
EXTENDAD DATA     X'810000'         EXTENDED ADDRESSING BITS FOR BIG
*                                   SIG9
2741ERR  DATA     0                 FLAG WORD FOR 2741 INCONSISTENCY
NO2741ER DATA     0                 FLAG WORD FOR NO 2741 INCONSISTENCY
COB:SAV  DATA     0                 RESERVED FOR START OF TABLE POINTER
1STL6    DATA     0                 WILL POINT TO 1ST L6 ENTRY # IF ANY
#L6      DATA     0                 # OF L6'S ON THE SYSTEM (<3)
L6ONLY   DATA     0                 WILL BE NON-0 FOR AN ALL L6 SYSTEM
CURNTL6  DATA     0                 FLAG INDICATING IF WORKING ON 1ST L6
#COC     DATA     0                 # OF COC OPTIONS (INCLUDING :COC)
*                                   SPECIFIED ON :COC COMMAND
L6       DATA     X'D3F6'           = 'L6'
LCI3     DATA     X'02200030'
NOP      DATA     X'70000000'
L6LOGLN# DATA     0                 LOWEST LOGICAL LINE # FOR 1ST L6
         BOUND    8
CMNDDWD  EQU      %
         DATA     X'02000000'**-2    READ
         DATA     X'80000000'**-2   DATA CHAIN
         DATA     X'08000000'**1    TIC
         DATA     0
         BOUND    8
OUTPSD   DATA     2
OUTPSD1  DATA     X'17000010'       SKELETON INSTRUCTION FOR
OUTPSD2  LI,3     0                 OUTPUT INTERRUPT TABLE ENTRIES
         B        0
TTBLS    EQU      %-2
         TEXTC    'EAPL'
         TEXTC    'ESTD'
         TEXTC    'SAPL'
         TEXTC    'SSTD'
CALLHAND TEXTC    'CALL360'         HANDLER IF CALL360 SPECIFIED
APLHAND  TEXTC    'AAPL'
*******NOTE DO NOT ALTER ORDER OR SEPARTE THE 6 FOLLOWING NAMES
XMINCOCU TEXTC    'MINCOCU'         MINI COC NAME FOR HANDLERS OR HANDLERS2
XREGCOCU TEXTC    'REGCOCU'         REG COC NAME FOR HANDLERS OR HANDLERS2
XTPCOCU  TEXTC    'TPCOCU'          TP COC NAME FOR HANDLERS OR HANDLERS2
XMINCOC  TEXTC    'MINCOCR'         MINI COC NAME FOR HANDLERS RECORD
XREGCOC  TEXTC    'REGCOCR'         REG COC NAME FOR HANDLERS RECORD
XTPCOC   TEXTC    'TPCOCR'          TP COC NAME FOR HANDLERS RECORD
******   ******   ******   ******   ******
SCHDSUB  TEXTC    'SCHDSUB'         HANDLER FOR NO MULTI-PROCESSING
MPNAMES  TEXTC    'MPSCHED'         MULTI-PROCESSOR HAND NAMES
*                                   DO NOT SEPARATE OR ALTER ORDER
         TEXTC    'MPSUB'
         TEXTC    'SMON'
         TEXTC    'SFAULT'
HAND2    TEXTC    'HANDLERS2'
HAND     TEXTC    'HANDLERS'
NOHMSG   TEXTC    '*** TROUBLE WITH SPEC:HAND - TRANSLATE TABLES LOST'
ORDERRMS TEXTC    '***PASS2 ABORT. EITHER A DEVICE OPTION HAS BEEN',;
                  ' OMMITTED OR 1 TOO MANY COC OPTIONS WERE GIVEN'
ERRMSGL6 TEXTC    '***ALL L6 OPTIONS MUST APPEAR LAST',;
                  ' THEY CANNOT BE INTERMIXED OR PRECEDE',;
                  ' DEVICE OPTIONS.'
ERRML6   TEXTC    '***ONLY 2 L6 OPTIONS PERMITTED ON THE :COC',;
                  ' COMMAND.'
         PAGE
*
*        SUBROUTINES
*
ERRLIST  AI,14    2                 PUT COCNO IN MESSAGE
         STB,15   *14
         CI,11    L3
         BLE      %+2
         MTB,-1   *14
         MTB,-8   *14
         MTB,-8   *14
         AI,14    -2
         PSW,SR4  *R0
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
         PLW,SR4  *R0
         B        *11
*
ORDERR   LI,D3    ORDERRMS       #29089
         BAL,SR4  LOGIT
         MTW,1    P2ABRT,R3         THIS IS AN ABORT CONDITION
         B        READNXT
*
NOH      EQU      %
         LW,14    L(X'00200000')
         AND,14   M:TM              IS DCB OPEN?
         BEZ      %+2               BRANCH IF DCB IS CLOSED
         M:CLOSE  M:TM,(SAVE)
         LI,D3    NOHMSG
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
         B        NOSPECH
ERR      LCI      5
         PLM,R4   *R0
         LW,D3    L(X'00200000')
         AND,D3   M:TM
         BEZ      ABNERR2        BRANCH IF DCB IS CLOSED
         M:CLOSE  M:TM,(REL)
         B        ABNERR2
*
COCGEN   PSW,1    *0
         LB,1     *11
         CI,1     X'F0'             INSTRUCTION OR TEXT
         BANZ     EXU
         CI,1     2          DEF OR DICTMOD
         BG       SKIP              DEF
         LW,10    *11
         LW,1     11
         STW,10   %+2
         BAL,10   MODGEN
         RES      1
         AI,1     1
         LW,11    1
         B        COCGEN+1
SKIP     AI,1     4
         SLS,1    -2
         AW,11    1
         B        COCGEN+1
EXU      PLW,1    *0
         LC       11
ACTEXU   EXU      *11            EXU INST. POINTED TO BY R11
         STCF     11
         AI,11    1
         B        COCGEN
         PAGE
*        THE FOLLOWING ROUTINES CONTROL GENERATION OF L6 CODE
*
L6ONLYA  BAL,SR3  MODGEN
         TEXTC    'L6INT23'         GENERATED REF TO L6 INT
         LI,SR3   ENDOUT            RETURN TO MAINLINE OF CODE
*
L6ONLYB  BAL,SR3  MODGEN
         TEXTC    'L6INT23'         GENERATE REF TO L6INT FOR PASS UNDER
         B        %+1               CONTROL OF REGISTER 11
         AI,SR4   3                 SKIP TO MAINLINE CODE
         B        ACTEXU
*
LCICODE  LW,D1    LCI3              GET LCI 3 AND STORE IT IN ENTRY
CHKPASS  CI,R3    1                 SEE IF UNDER CONTROL OF SR3 OR SR4
         BNE      SR4PASS1          BR. FOR SR4 PASS
         AI,SR3   2                 SR3 STILL POINTS TO MAINLINE CODE
         B        MODGEN
SR4PASS1 AI,SR4   2                 SR4 STILL POINTS TO MAINLINE CODE
         B        ACTEXU
*
NOPTABL  LW,D1    NOP               GET NOP AND STORE IT IN ENTRY
         B        CHKPASS
CHKR3EQ1 CI,R3    1                 IS THIS A NON-COC, ONLY L6 SYSTEM
         BNE      CHKR3EQ2          BRANCH IF NOT
         LI,D4    0                 D4 = DISP TO START OF 4-WORD ENTRIES
         LW,D3    SR3               SAVE THE EXECUTION CONTROL REGISTER
         B        L6ENTRY           GO GENERATE SET   OF L6 ENTRIES
CHKR3EQ2 CI,R3    2                 SEE IF THIS IS THE 1ST L6 IN A MIX OF
         BNE      R3EQ3             OF COC'S AND L6'S.  BRANCH IF NOT 1ST
         MTW,0    L6ONLY            CHK FOR AN L6 ONLY SYSTEM
         BNE      R3EQ3             FOR AN L6 ONLY SYSTEM THIS IS FOR
*                                   THE SECOND L6 SPECIFIED
         LI,D4    0                 D4 = DISP TO START OF 4-WORD ENTRIES
*                                   WHICH NOW MUST BE SR4
         B        %+2
R3EQ3    LI,D4    16                SET DISP TO POINT TO SECOND SET OF
         LW,D3    SR4               L6 ENTRIES AND SAVE EXECUTION REG.
L6ENTRY  AW,SR1   D4                ADD DISP INTO L6 ENTRIES
         LW,D1    OUTPSD1           LET D1 CONTAIN CURRENT VALUE OF PSD
         LI,SR2   X'1FFFF'          SR2 = ADDRESS MASK
         LW,D2    R1                R1 = CURRENT COC NDX - 1
         PAGE
*
*        FORMAT OF L6 OUTPUT INTERRUPT 4-WORD ENTRIES WITH
*        DIFFERENCES IN EACH ENTRY OCCURRING IN THE 3RD WORD
*
**************************************************************************
*                                     ********************************
*GENERATE:                            *              0               *
*                                     ********************************
*                                     *              0               *
* WHERE N = CURRENT                   ********************************
* COC NDX - 1                         *    N   *    L6STAT (PREF)    *
*                                     ********************************
*                                     *       OUTPSD                 *
*                                     ********************************
*
         SCS,D2   -8                PUT 'N' VALUE IN BYTE-0
         STS,SR1  XPSDSTAT          SAVE CURRENT VALUE OF SR1 IN XPSD WORD
         AI,SR1   2                 STEP TO 3RD WORD OF 4-WORD ENTRY
         STW,D2   *SR1              PUT 'N' PART OF WORD INTO ADDRESS
         BAL,SR3  MODGEN            POINTED TO BY SR1, AND THEN
         TEXTC    'L6STAT23'        SET 'L6STAT' PREF POINTER IN SAME PLACE
         AI,SR1   1                 SR1 NOW POINTS TO LAST WORD OF ENTRY
         STW,D1   *SR1              D1 CONTAINS APPROPRIATE PSD VALUE
         AI,SR1   1                 MOVE SR1 POINTER TO 1ST WORD OF NXT
         STS,SR1  XPSDRCVO          ENTRY AND SAVE SR1 IN XPSD WORD
         AI,SR1   2                 GENERATES 2 ZEROES AS IN ENTRY SHOWN
*                 HOWEVER, NOW THE 3RD WORD WILL LOOK AS FOLLOWS:
*
*                                     ********************************
*                                     * 1  * N  *   L6RCVON (PREF)   *
*                                     ********************************
*
         PAGE
         LW,D2    R1                 GET CUR. COC NDX. -1
         AI,D2    X'10'              SET UP THE '1' CONCATENATED
         SCS,D2   -8                 WITH THE N AND PUT IN BYTE-0
         STW,D2   *SR1               STORE IT IN WORD POINTED TO BY SR1
         TEXTC    'L6RCVON23'        ADD 'L6RCVON' PREF POINTER TO THAT
         AI,SR1   1                  ADDRESS, AND INCREASE SR1 TO POINT TO
         STW,D1   *SR1               TO OUTPSD WORD (WORD-4)
         AI,SR1   1                  MOVE POINTER TO NEXT ENTRY.
         STS,SR1  XPSDRCVD           SAVE CURRENT VALUE OF SR1 IN XPSD WWORD
         AI,SR1   2                  GENERATE THE 2 ZEROES FOR THE ENTRY
         SCS,D2   8                   RESTORE '1' AND 'N' FOR RCVON ENTRY
         AI,D2    X'10'              CHANGE THE 1 PART TO A 2
         SCS,D2   -8                 AND MOVE IT INTO BYTE-0
         STW,D2   *SR1               STORE IT INTO WORD POINTED BY SR1
         TEXTC    'L6RCVDOFF23'      AND GENERATE PREF TO L6RCVDOFF
*                 THIS 3RD WORD WILL NOW LOOK AS FOLLOWS:
*
*                                     ********************************
*                                     * 2  * N  *   L6RCVDOFF (PREF) *
*                                     ********************************
*
         AI,SR1   1                   SET POINTER TO 4TH WORD OF ENTRY
         STW,D1   *SR1                STORE OUTPSD VALUE IN IT
         AI,SR1   1                   POINT TO START OF FINAL 4-WORD ENTRY
         STS,SR1  XPSDXDAT            SAVE SR1 IN XPSD WORD
         AI,SR1   2                   GENERATE THE 2 WORDS OF ZEROES
         LW,D2    R1                  GET COC NDX - 1
         SCS,D2   -8                  PLACE IT IN BYTE-0
         STW,D2   *SR1
         TEXTC    'L6XDATA23'        SET UP A PREF POINTER TO L6XDATA
*                 THIS 3RD WORD WILL NOW LOOK AS FOLLOWS:
*
* WHERE N = CURRENT                   ********************************
* COC NDX - 1                         *    N   *    L6XDATA (PREF)   *
*                                     ********************************
*
         AI,SR1   1                  POINT SR1 TO LAST WORD OF LAST 4-WORD
         STW,D1   *SR1               AND PLACE OUTPSD VALUE IN IT
         AI,SR1   1                  SET SR1 READY FOR NEXT TABLE
         B        %+1                GET OUT OF MODGEN EXECUTION CONTROL
         CI,D4    16                IS THIS FOR THE 2ND SET OF L6 ENTRIES
         BE       SR4PASS           BRANCH IF SO
         LW,D2    #L6               SEE HOW MANY L6'S
         CI,D2    2                 SEE IF WE NEED TO SET ASIDE
         BNE      %+2               THE 2ND SET OF L6 4-WORD ENTRIES
         AI,SR1   16                GENERATE WINDOW
         CI,R3    1                  SEE IF IT IS AN L6-ONLY SYSTEM
         BNE      SR4PASS            MUST HAVE BEEN UNDER SR4 CONTROL
         LW,SR3   D3                 RESTORE SR3 TO WHERE IT FORMERLY
         AI,SR3   4                  WAS EXECUTING AND POINT IT TO %+4
         B        MODGEN             LOCATION FOR EXECUTION UNDER MODGEN
SR4PASS  LW,SR4   D3                 MUST HAVE BEEN UNDER SR4 EXECUTION
         AI,SR4   4                  CONTROL. RESTORE IT AND CONTINUE
         B        ACTEXU             EXECUTING UNDER COCGEN CODE AT %+4
CHKPSD   LW,D1    XPSDSTAT,R2       GET CORRECT L6 XPSD WORD
*                                   FROM THE 4 WORD PSD TABLE FOR L6'S
         AW,SR1   R1                POINT SR1 TO TARGET WORD
         LW,SR2   SR3               SAVE SR3 IN CASE IT IS NEEDED
         BAL,SR3  MODGEN            NEED TO STORE XPSD WORD AND MAKE
         STW,D1   *SR1              IT RELOCATABLE
         TEXTC    '22'
         B        %+1               GET OUT OF MODGEN
         SW,SR1   R1                RESTORE SR1 TO WHAT IT WAS ON ENTRY
         LW,SR3   SR2               RESTORE SR3 TO ITS FORMER VALUE
         CI,R3    1                 SEE IF AN ALL-L6 SYSTEM
         BNE      SR4PSD            BRANCH IF MIX OF COC'S AND L6'S
         AI,SR3   3                 RETURN TO IN-LINE CODE + 3
         B        MODGEN            UNDER THE CONTROL OF MODGEN
SR4PSD   AI,SR4   3                 RETURN TO IN-LINE CODE + 3
         B        ACTEXU            UNDER THE CONTROL OF COCGEN
         PAGE
*      THIS CODE IS EXECUTED AFTER FIRST PASS AND ON ALL SUBSEQUENT
*      PASSES......................................................
CHK4TAU1 LI,R2    CONTINU1
         LW,SR3   TEXTRING+2
PROCESS  STW,SR3  TEXTAU
         CW,SR3   TEXTRING+2
         BNE      CHK4TAU3
         STD,D1   *SR1              COMMAND DW.
PROCESS1 LI,SR3   %+2
         B        MODGEN
         DATA     X'0AC3D67A'       GENERATE 'CO:RINGAX3'
         DATA     X'D9C9D5C7'
TEXTAU   RES      1
         LW,SR4   R2
         B        COCGEN
CHK4TAU2 LI,R2    CONTINU2A
         LW,SR3   TEXTCOR+2
         B        PROCESS
CHK4TAU3 LW,SR3   RBUFDSPE
         AW,SR3   RINGLOC,R5
         AW,SR1   R1
         STW,SR3  *SR1
         STW,SR3  RBUFDSPE
         B        PROCESS1
*
*        IN: 12 = INTERRUPT LOC
*        OUT:     12 = GROUP, 13 = WD BIT
*
WDLG     LI,13    X'8000'
         LI,2     X'F'
         AND,2    12
         LCW,2    2
         SLS,13   0,2
         SLS,12   -4
         B        *14
         B        READNXT           ABORT
GRPERRO  LI,14    GRPMSGI
         LW,15    COCLOC,5
         BAL,11   ERRLIST
         MTW,1    P2ABRT,3
         B        READNXT           ABORT
         PAGE
*
*        COC ROUTINE
*
COC      EQU      %
         LW,R1    FEDX#,R3
         BEZ      %+3
         SLS,R1   -16
         STW,R1   FEX#              = HIGHEST FECP # (FEX)S
         LI,2     DYNAM             SET
         LI,1     #DYNAM            PARAMETERS
         LW,4     KWDPTR            FOR SYNTAX
         BAL,11   SYNTAX
         LW,4     5                 SAVE START OF DATA
         MTW,0    COCS,R3           CHECK FOR A BATCH ONLY SYSTEM
         BNEZ     DEVCHK            THIS IS A SYSTEM WITH AT LEAST 1 COC
         LW,D1    DEVLOC,R5         IF NO COC SPECIFIED ON :DEVICE COMMAND
         CW,D1    L6                THIS MAY BE AN ALL-L6 SPECIFICATION
         BNEZ     NOCOC             BR. IF NO 7611 AND NO L6'S (BATCH ONLY)
         MTW,1    L6ONLY            SET L6ONLY FLAG
         B        COCGO             BRANCH FOR AN ALL-L6 SYSTEM
DEVCHK   MTW,0    DEVLOC,R5         CHK FOR COC/DEVICE OPTIONS OUT OF
         BLEZ     ORDERR            ORDER OR TABLES MESSED UP
COCGO    LW,D1    INLOC,R4          GET INTERRUPT FOR 1ST COC
         BLEZ     PRIERR
         STW,12   LOWIN
         LW,13    OUTLOC,4          GET COC0 OUT
         BLEZ     PRIERR
         STW,13   LOWOUT
         B        COSTBK
COST     LW,12    INLOC,4           GET HIGHEST PRIO.IN & OUT
         BLEZ     PRIERR
         LW,13    OUTLOC,4
         BLEZ     PRIERR
         SW,D2    D1                D2 = OUT INTERRUPT. D1 = IN INTERRUPT
         CI,D2    1                 CHECK IF 'OUT' INTERRUPT
         BE       COSTA             IS 'IN' + 1
         LI,D3    GRPMSGO           IF NOT IT'S AN ERROR
         LW,D4    COCLOC,R5
         BAL,SR4  ERRLIST
COSTA    LW,D2    OUTLOC,R4
         CW,13    LOWOUT
         BGE      %+2
         STW,13   LOWOUT
         CW,12    LOWIN
         BGE      %+2
         STW,12   LOWIN
COSTBK   AI,4     #DYNAM
         CW,4     *0
         BL       COST
         LW,4     5                 DO COC0
         LW,12    INLOC,4
         AI,12    -X'60'
         SLS,12   -4
         AI,12    2
         STW,12   INGRP             CALC IN GROUP
         LW,D2    OUTLOC,R4
         AI,D2    -X'60'
         SLS,D2   -4
         AI,D2    2                 CALCULATE OUT GROUP
         STW,D2   OUTGRP
         CW,D1    D2
         BNE      GRPERRO           IF 'IN' AND 'OUT' ARE NOT
*                                   IN SAME GROUP, IT'S AN ERROR
         LW,12    INLOC,4
         CW,12    OUTLOC,4
         BGE      PRIERR
         B        EL2
L1       LW,12    INLOC,4
         LW,14    12
         AI,14    -X'60'
         SLS,14   -4
         AI,14    2
         CW,14    INGRP
         BNE      GRPERRO
         LW,13    OUTLOC,4
         LW,14    13
         AI,14    -X'60'
         SLS,14   -4
         AI,14    2
         CW,14    OUTGRP
         BNE      GRPERRO
         CW,12    13
         BGE      PRIERR
         LW,2     5
         B        %+2
L2       AI,2     #DYNAM
         CW,2     *0
         BGE      EL2
         CW,2     4                 SAME ONE
         BLE      L2
         CW,12    INLOC,2
         BE       PRIERR
         CW,13    OUTLOC,2
         BE       PRIERR
         CW,13    INLOC,2
         BE       PRIERR
         CW,12    OUTLOC,2
         BNE      L2
PRIERR   LI,14    PRIMSG
         LW,15    COCLOC,5
         BAL,11   ERRLIST
         MTW,1    P2ABRT,3
         B        READNXT           ABORT
EL2      AI,4     #DYNAM
         MTW,1    COCLOC,5
         CW,4     *0
         BL       L1
         XW,5     4
         LW,15    COCLOC,4
         LI,14    0
         STW,14   TOTLN,4
DEFLT1   EQU      %
*                                START OF LOOP BASED ON # OF COC OPTION
*                                   SPECIFIED ON :COC COMMAND
L3       MTW,1    #COC              # OF COC OPTIONS ON :COC COMMAND
         AI,R5    -#DYNAM
         LW,12    LINELOC,5
         BLZ      DELN
         CI,D1    128               CHECK FOR MAX # OF LINES
         BLE      %+5
         LI,14    LINMSG            TOO LARGE
         BAL,11   ERRLIST
DELN     EQU      %
         LI,12    8
         STW,12   LINELOC,5         DEFAULT.
         AWM,12   TOTLN,4
         MTW,0    BUFLOC,5          IS BUFFERS SPECIFIED
         BGZ      DERN
         LW,13    12                NO,
         MI,13    3                 DEFAULT TO 3X LINES
         STW,13   BUFLOC,5
DERN     EQU      %                 YES
         INT,11   ECBLOC,5          ADD # ECB'S TO
         AWM,11   BUFLOC,5          # OF COC BUFFERS
         CI,12    30                CALCULATE
         BLE      %+2               DEFAULT
         LI,12    30                FOR
         AW,12    LINELOC,5         RING.
         AI,12    3
         SLS,12   -2
         LI,13    X'FF'
         MTW,0    RINGLOC,5         IS RING SPECIFIED
         BLEZ     DEFLT             NO
         CW,13    RINGLOC,5         IS RING <=255
         BGE      %+4               YES
         STW,13   RINGLOC,5         SET MAX
         LI,14    RING2MSG
         BAL,11   ERRLIST
         CW,12    RINGLOC,5         CHECK VALUE AGAINST IT
         BLE      %+4
         LI,14    RINGMSG           TOO SMALL
         BAL,11   ERRLIST
DEFLT    EQU      %
         STW,12   RINGLOC,5         USE DEFAULT
         MTW,0    DEVLOC,5          IS DEVICE SPECIFIED
         BGEZ     %+4
         LI,14    DEVMSG
         BAL,11   ERRLIST
         B        READNXT           ABORT
         LW,D2    DEVLOC,R5         GET DEVICE 'NDD'  VALUE OR 'L6'
         LW,D1    D2                GET TEMPORARILY INTO D1
         AND,D1   XFFFF
         CW,D1    L6                IS IT AN  L6 INSTEAD OF A DEVICE NDD
         BNE      CONTDEV           BRANCH IF NOT AN 'L6'
         MTW,1    #L6               THIS LOCATION KEEPS TRACK OF TOTAL L6'S
         LW,R7    COCLOC,R4         GET TOTAL # OF COC OPTIONS SPECIFIED
         SW,R7    #COC              SUBTRACT OFF # CURRENTLY BEING PROCESSED
         LW,D2    LINELOC,R5        GET CURRENT # OF LINES ASSOCIATED
         AWM,D2   L6LOGLN#          WITH THIS COC AND ADD IT TO L6LOGLN#
         LI,D2    0                 SET UP D2 TO ZERO OUT COH:DN ENTRY
         LI,D1    X'7F'             SET UP TO CHANGE CO:LNM BYTE FOR L6
         STB,D1   COLNMBYT,R7       STORE IT IN DATA TABLE
         LW,D1    R7                R7 CONTAINS CURRENT L6 NDX -1
         AI,D1    1                 SET D1 TO CORRECT NDX #
         STW,D1   1STL6             AND SAVE IT
         B        OUTDEVA
CONTDEV  LI,D1    COCS              DISP. TO INFO. SET UP BY UBCHAN
         AW,D1    R3                POINT TO DATA
         LH,R1    *D1               # OF COC'S GOES INTO R1
         BEZ      ERDEV
         LW,D3    DCT1TEMP,R3        DCT1 = DEVICE ADDRESS TABLE
DEFLT2   LH,R6    *D1,R1             GET COC NDX GENERATED BY UBCHAN
         LW,R7    R6
         LH,R6    *D3,R6             GET DEVICE ADDR. FROM DCT1 TBL
         AND,R6   XFFFF
         CW,D2    R6
         BE       OUTDEV
         BDR,R1   DEFLT2
ERDEV    LI,14    DEVERR
         BAL,11   ERRLIST
         B        READNXT           ABORT
OUTDEV   EQU      %
         LI,13    0
         STH,13   *12,1             ZERO OUT DEVICE SO CANT REDEFINE
         LW,D2    R7
         LW,R7    D4
         AI,R7    -1
         LI,D3    COCFEX#           CHECK FOR AN FECP FOR THIS COC
         AW,D3    R3
         LB,D3    *D3,R1
         BEZ      %+5
         STB,D3   COCFEXT,R7
         LB,D3    COLNMBYT,R7
         AI,D3    X'40'             SET BIT FOR FECP DEVICE FOR CO:LNM
         STB,D3   COLNMBYT,R7       TABLE
OUTDEVA  STH,D2   DEVXCOC,R7        SAVE FOR COH:DN ENTRIES
         LW,13    FLGLOC,5          COLLECT ALL XLATE TABLE FLAGS
         STS,13   FLGLOC,4
         LW,D2    AUASCALL,R5       COLLECT ALL ASCII/CALL & AUTO FLAGS
         STS,D2   AUASCALL,R4
         BDR,D4   L3                L3 TO HERE IS THE MAJOR LOOP FOR
*                                   PROCESSING COC-DEVICE OR COC-L6
*                                   OPTIONS DEPENDING ON HOW MANY
*                                   COC'S ON :COC COMMAND INCLUDING
*                                   :COC ITSELF
         LW,D4    #L6               GET # OF L6 OPTIONS SPECIFIED
         BEZ      CHKFECP           BRANCH IF NO L6'S
         CI,D4    2                 CANNOT BE MORE THAN 2-L6'S
         BLE      CHKORDR           BRANCH IF NOT MORE THAN 2
         LI,D3    ERRML6            PRINT AN ERROR MESSAGE
         BAL,SR4  LOGIT             ENTER IT IN T:P2SI
         B        CHKFECP
CHKORDR  LW,D1    1STL6             GET NDX OF FIRST L6 SPECIFIED
         LW,D3    #COC              GET TOTAL # OF COC OPTIONS SPECIFIED
         CI,D4    2                 SEE IF 2 L6'S
         BNE      CHKNDX            BR. IF ONLY 1 L6
         AI,D3    -1                IF 2 L6'S, 1ST MUST = #COC'S - 1
CHKNDX   CW,D3    D1                SEE IF L6'S ARE LAST DEVICES ON :COC
         BE       CHKFECP           COMMAND.  BRANCH IF SO.
         LI,D3    ERRMSGL6          GO OUTPUT ERROR
         BAL,SR4  LOGIT
CHKFECP  EQU      %
         MTW,0    FEX#              CHECK FOR ANY FECP SPECIFICATIONS
         BEZ      GET2PGS           BRANCH IF NOT
         LI,D3    INT#              GENERATE START OF INTERRUPT TABLE
         AW,D3    R3                CONSTRUCTED BY UBCHAN
         PSW,R4   *R0
         LI,R4    0
BEGLUP   LB,R1    COCFEXT,R4
         BEZ      ENDLUP
         LW,R2    R1
         AI,R2    -1                TO DISCARD 0TH ENTRY
         LW,D1    XF000             SELECT BITS FOR ALL 4 INTERRUPTS
         LW,D2    X1000             SELECT BIT FOR GO INTERRUPT
         LH,R6    *D3,R1            GET INTERRUPT FOR THIS FECP #
         STH,R6   FEINTTB,R2        SAVE FOR LATER CONSISTENCY CHKS
         AI,R6    -X'40'            FOR DETERMINING INTERRUPT GROUP
         SLD,R6   -4                ISOLATE INT. GROUP #
         STB,R6   FEINTGP,R2        SAVE FOR LATER CONSISTENCY CHECKS
         AWM,R6   FETRGR,R2         STORE GROUP # INTO TRIGGER TABLE
         AWM,R6   FEDSRM,R2                             DISARM TABLE
         AWM,R6   FEARM,R2                              ARM & ENABLE TBL
         LI,R6    0
         SLD,R6   4
         LCW,R6   R6                FOR RIGHT SHIFTING
         SLD,D1   0,R6              POSITION SELECT BITS FOR ALL 4 INTS.
         STH,D1   FEHALV,R2
         STH,D2   FEHGLV,R2
ENDLUP   AI,R4    1
         CW,R4    COCLOC,R5         ALL THRU FOR ALL COC'S
         BL       BEGLUP            BRANCH IF NOT
         PLW,R4   *R0
GET2PGS  EQU      %
         LW,SR1   BIGLOC,R3         NEED TO CHECK IF THIS IS A BIG
         BEZ      GET2PGS1          SYSTEM. BRANCH IF NOT
         CI,SR1   1
         BANZ     %+3               IS IT A 560
         LW,SR1   EXTENDAD          NO. IT'S A SIG 9
         B        %+2
         LI,SR1   4
         AWM,SR1  OUTPSD1           SET EXTENDED BITS IN OUT INTERRUPT
GET2PGS1 EQU      %                 GROUP FIELD
         CAL1,8   =X'08000002'
         BCS,8    NOH
         STW,9    SPECSTART
         SLS,8    11
         STW,8    SPECLGTH
         M:OPEN   M:TM,(FILE,'SPEC:HAND'),(KEYED),(INOUT),(SAVE),;
                  (ERR,NOH),(ABN,NOH)
         M:READ   M:TM,(BUF,*SPECSTART),(SIZE,*SPECLGTH),;
                  (KEY,HAND),(ERR,NOH),(ABN,NOH)
         LW,1     13+M:TM
         SLS,1    -3
CHKXLATE LI,R6    1
         LW,D1    FLGLOC,R4         GET TRANSLATE TABLES PRESENCE FLG
         BEZ      GOWRTHND          IF 0 SKIP CODE TO ADD THESES TABLES
         LI,2     4
IST      CI,D1    1
         BAZ      NOT
         LD,14    TTBLS,2
         LI,D2    GOWRTHND
MUVTOBEG LD,SR3   *SPECSTART,R6     THE TRANSLATE TABLE NAMES ARE TO BE
         STD,SR3  *SPECSTART,R1     MOVED TO THE BEGINNING OF THE SPEC:
         STD,D3   *SPECSTART,R6     HAND RECORD. THE REPLACED NAMES ARE
         AI,R6    1                 MOVED TO THE END OF THIS RECORD
         MTW,1    *SPECSTART
         AI,1     1
NOT      SLS,D1   -1
         BDR,2    IST
         B        *D2
GOWRTHND EQU      %
         LI,R2    0
CHKASCAL LW,SR2   AUASCALL,R4       GET FLAGS FOR ASCII & APL HANDLERS
         CI,SR2   1                 IS IT THE CALL360 HANDLER FLAG
         BAZ      CHKASCI           BRANCH IF NONE
         LD,D3    CALLHAND
ASCICALL BAL,D2   MUVTOBEG          MOVE THIS TRANSLATE TBL BEHIND OTHERS
CHKASCI  SLS,SR2  -8                IS ASCII FLAG SET
         CI,SR2   1
         BAZ      COCHAND           BRANCH IF NOT
         LD,D3    APLHAND
         B        ASCICALL
COCHAND  LI,SR2   XMINCOC           POINT SR2 TO START OF DATA TYPE
         BAL,D2   MUVCOCPR
         AI,R1    -1                COC HANDLER NEEDS TO BE
         LD,D3    *SPECSTART,R1     MOVED BEHIND TRANSLATE TABLES
         MTW,-1   *SPECSTART
         BAL,D2   MUVTOBEG
         MTW,0    HAND2FLG,R3       CHK FOR HANDLERS2 C.C.
         BNEZ     %+3               SKIP NEXT IF ONE WAS SPECIFIED
         LI,SR2   XMINCOCU          OTHERWISE NEED TO PLACE PROCEDURE
         BAL,D2   MUVCOCPR          PART OF HANDLER IN HANDLERS RECORD
         SLS,1    3
         M:WRITE  M:TM,(BUF,*SPECSTART),(SIZE,*1),(KEY,HAND);
                  ,(ERR,NOH),(ABN,NOH)
         M:CLOSE  M:TM,(SAVE)
         CAL1,8   =X'09000002'
NOSPECH  EQU      %
         LW,12    COCLOC,5
         LI,13    0
         B        %+3
         LW,14    BUFLOC,5
         AWM,14   BUFLOC,4          GET TOTAL BUFFERS
         AW,13    RINGLOC,5         SIZE
         AI,5     #DYNAM
         BDR,12   %-4
         LW,5     4
         LW,D1    COCLOC,R5         GET # OF COC'S SPECIFIED ON :COC
         LW,SR1   COCDIO,R5
         B        STKRNDIO
LUPDIO   LW,SR1   COCDIO,R5         CHECK FOR A USER SPECIFIED DIO
         BLEZ     CALCDIO           B IF NONE SPECIFIED
         CW,SR1   COCDIOPL          SEE IF ITS GREATER THAN LAST ONE
         BG       STKRNDIO          IF SO STORE THIS AS THE CURRENT 1
         LI,D3    ERRDIO            OTHERWISE IT'S AN ERROR.
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
CALCDIO  LW,SR1   COCDIOPL          GET VALUE OF LAST DIO
         AI,SR1   1                 MAKE THIS ONE, ONE GREATER
         STW,SR1  COCDIO,R5         STORE IT AS IF SPECIFIED BY
*                                   USER
STKRNDIO STW,SR1  COCDIOPL          SAVE AS CURRENT DIO VAL
         AI,R5    #DYNAM
         BDR,D1   LUPDIO
         LW,R5    R4
         LW,15    TOTLN,5           CHECK IF BUF >=
         MI,15    3                 3 * LINES
         CW,15    BUFLOC,5
         BLE      %+3
         LI,D3    BUFMSG
         BAL,SR4  LOGIT
         LI,15    12*2+14           12 DWDS,14 WDS/COC
         MW,15    COCLOC,5
         AI,15    -6                COC0 SHORT INPSD
         AW,13    15
         LW,15    COCLOC,5
         AI,15    1
         SLS,15   -1
         MI,15    6                 6 HWD TBLS
         AW,13    15
         LW,14    BUFLOC,5
         SLS,14   2                 4 WORD BUFFERS
         AI,14    2                 1 FOR LAST PTR, 1 FOR BND 8
         AW,13    14
         LW,15    TOTLN,5
         AI,15    1
         SLS,15   -1
         MI,15    9                 9 HWD TABLES
         AW,13    15
         LW,15    TOTLN,5
         AI,15    3
         SLS,15   -2
         STW,5    4
         LW,12    COCLOC,4
         MTW,0    COUPLE,4
         BNE      %+5
         AI,4     #DYNAM
         BDR,12   %-3
         MI,15    22
         B        %+3
         MI,15    23
         MTW,1    COUPLE,5
         AI,D2    2                 ADD 2 WORDS FOR L6 LIMS TABLE
         AW,D2    D4                ADD TOTAL RESERVED FOR TABLES SO FAR
         LW,D4    #L6               SEE IF ANY L6'S ON SYSTEM
         MI,D4    16                ALLOW FOR 4 4-WORD INTERRUPT ENTIES
         AW,D2    D4                D2 NOW HAS THE TOTAL WORD SIZE OF
*                                   CSECT0 FOR THE M:COC LMN
         LI,D1    -1                INDICATES UNKNOWN SIZE OF REF/DEF
         BAL,SR4  COREALLOC         AND EXPR STACKS FOR LMN
         B        %+2
         PZE      READNXT           ABORT RETURN FROM COREALLOC OR
*                                   MODGEN
         LW,R4    R5                COREALLOC CLOBBERS REG. 4
         PSW,R3   *R0               R3 WILL NOT BE USED IN ITS NORMAL WAY
         LW,R3    1STL6             IN THE LOOP STARTING AT LGEN BELOW
         LW,D1    R3                D1 WILL = NDX OF 1ST L6 IF ANY
         BEZ      NONL6             BRANCH IF NO L6'S ON SYSTEM
         CI,R3    1                 1STL6 = 1 IF NO DEVICE COC'S
         BE       %+2               LET R3 = 1 AS AN INDICATOR OF AN L6 PASS
         LI,R3    0                 SET L6 FLAG TO ZERO FOR 1ST PASS
         AI,D1    -1                SET D1 TO NDX - 1
         LW,D3    TOTLN,R4          GET TOTAL # OF LINES FOR ALL COC
         LW,D4    D3                OPTIONS
         SW,D3    L6LOGLN#          NEED TO CALCULATE LOWEST LOGICAL
*                                   LINE # FOR FIRST L6 DEVICE
         AI,D4    -1                2ND WORD OF TABLE GETS LNOL-1 VALUE
         B        LMNGEN
NONL6    LW,D1    COCLOC,R4         L6#FIRST WILL GET LCOC VALUE + 1
         LI,D3    1                 AND L6LIMS GETS 1,0 DOUBLE WORD VALUE
         LI,D4    0
LMNGEN   BAL,SR3  MODGEN            START CREATING M:COC LMN
         TEXTC    'L6#FIRST0'       GENERATE AN L6#FIRST VALUE DEF
         TEXTC    'L6LIMS1'         GENERATE A DEF FOR L6LIMS TABLE
         STD,D3   *SR1              L6LIMS CONTENTS
         AI,SR1   2                 STEP TO COD:LPC TABLE
         STW,8    6
         LW,12    COCLOC,5
         AI,12    -1
         TEXTC    'LCOC0'
         LI,1     0
         LI,14    0
         LI,15    -1
         TEXTC    'COD:LPC1'
LGEN     EQU      %
         AI,1     -1                1 IS COC INDEX
         AI,10    1                 SKIP NEXT INSTR FIRST TIME
         LD,14    *8,1              GET PREV VALUES
         AI,1     1
         LW,14    15
         AI,14    1
         AW,15    LINELOC,5
         STD,14   *8,1
         AW,8     COCLOC,4
         AW,8     COCLOC,4
         LW,12    INLOC,5
         BAL,14   WDLG
         AI,8     1
         SLS,8    -1
         SLS,8    1
         LI,11    NOT1ST-1
         TEXTC    'CO:IIL1'
         LW,12    INGRP
         TEXTC    'COA:IG0'
NOT1ST   STW,13   *8,1
         LI,11    MOREONE
         LW,14    COCLOC,4
         CI,14    1
         BG       MOREONE
         AI,8     1
         LW,12    OUTLOC,5
         BAL,14   WDLG
         STW,13   *8,1
         TEXTC    'CO:OIL1'
         AI,8     1
         LI,10    ENDIN+1
MOREONE  EQU      %
         BAL,10   MODGEN
         AW,8     COCLOC,4
         AI,8     1
         SLS,8    -1
         SLS,8    1
         LW,12    OUTLOC,5
         BAL,14   WDLG
         TEXTC    'CO:OIL1'
         STW,13   *8,1
         AW,8     COCLOC,4
         AI,8     1
         SLS,8    -1
         SLS,8    1
         LI,11    ENDIN
         AI,10    1
ENDIN    BAL,10   MODGEN
         AI,8     1
         SLS,8    -1
         SLS,8    1
         LCW,15   1
         MI,15    6
         SW,8     15
         LI,9     X'1FFFF'
         STS,8    XPSDO
         AI,8     2
         LD,12    OUTPSD
         STD,12   *8
         AWM,8    *8
         TEXTC    '22'
         AI,8     3
         AW,D4    SR1               POINT D4 TO LAST WORD OF OUTPUT
*                                   INTERRUPT 6-WORD ENTRY
         LD,D1    OUTPSD2           (LI,3 X AND B 0) SKELETON STORE IN
         AW,D1    R1                LAST 2 WORDS OF ENTRY X FOR LI,3
         STD,D1   *SR1              = N-1 NDX OF CURRENT COC OPTION
         LI,SR4   NOOUT             SKIP FOLLOWING ON SECOND AND
*                                   SUCCEEDING PASSES THRU THIS LOOP
         MTW,0    R3                SEE IF AN L6 ONLY SYSTEM
         BNEZ     L6ONLYA           BRANCH IF SO
         TEXTC    'COCOP23'         REF COCOP IN THE BRANCH INSTR. IN
NOOUT    LI,SR3   ENDOUT            IF 1ST PASS, SKIP TO ENDOUT
         MTW,0    R3                SEE IF L6 CODE SHOULD BE GENERATED
         BNEZ     L6ONLYB           BRANCH IF SO
         AWM,D4   *SR1              SET UP AS THE LAST WORD OF THIS ENTRY
*                                   A BRANCH BACK TO LAST WORD OF THE
*                                   FIRST OUTPUT INTERRUPT ENTRY.
ENDOUT   TEXTC    '22'
         AI,15    -5
         LW,8     15
         LW,15    COCLOC,4
         MI,15    6
         AW,8     15
         MTW,0    R3                CHECK FOR AN L6 PASS
         BNE      CHKR3EQ1          BRANCH IF IT IS
         LW,D4    #L6               SEE IF ANY L6'S ON SYSTEM
         MI,D4    16                LEAVE A SPACE FOR THEM
         AW,SR1   D4
         LW,15    1
         MI,15    4
         AW,8     15
         LD,12    CMNDDWD
         AW,13    RINGLOC,5
         SLS,13   2                 BYTE BUFF SIZE
         STD,12   *8
         STW,8    CMND,5
         LI,SR4   CHK4TAU1-1        DO THIS AFTER 1ST PASS THRU HERE
         STD,D1   *SR1              COMMAND DW.
TEXTRING TEXTC    'CO:RINGA03'      PREF RING BUFFER ADDRESS
*                                (A BYTE RESOLUTION ADDRESS)
CONTIN1  AI,SR3   1                 SKIP NEXT INSTR. ON 1ST PASS
         TEXTC    '02'
CONTINU1 LW,D1    CMNDDWD+2
         AW,12    8
         SLS,12   -1
         AI,SR1   2
         STW,12   *8
         TEXTC    '92'              DWD RIGHT HALF
         AI,8     -2
         SW,8     15
         LW,15    COCLOC,4
         MI,15    4
         AW,8     15
         AI,15    4
         SLS,15   -3                HWD TBL SIZE
         TEXTC    'COH:RBS1'
         LW,12    RINGLOC,5
         SLS,12   2
         STH,12   *8,1
         AW,8     15
         TEXTC    'COH:DN1'
         LH,D1    DEVXCOC,R1        GET COC DCT4 INDEX
         STH,12   *8,1
         AW,8     15
         TEXTC    'COH:II1'
         LW,12    INLOC,5
         STH,12   *8,1
         AW,8     15
         LW,12    OUTLOC,5
         TEXTC    'COH:IO1'
         STH,12   *8,1
         AW,8     15
         LB,D1    COCFEXT,R1
         AI,D4    1
         SLS,D4   -1
         TEXTC    'COB:FEX1'
         STB,D1   *SR1,R1
         AW,SR1   D4
         TEXTC    'CO:LNM1'
         LB,D1    COLNMBYT,R1
         AWM,D1   *SR1,R1
         AW,SR1   COCLOC,R4
         LW,D1    COCDIO,R5
         AND,D1   XF                ONLY 0 TO X'F' ALLOWED FOR
*                                   COCDIO VALUE FOR EACH COC
         SLS,12   4
         LI,13    X'FFF0F'
         TEXTC    'CO:STAT1'
         LI,R2    0                 R2 = NDX INTO TABLE OF PSD'S
         MTW,0    R3                SEE IF THIS IS AN L6 PASS
         BNE      CHKPSD            BRANCH IF SO
         LS,12    STAT
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:OUTRS1'
         MTW,0    R3                CHECK FOR L6 PASS
         BNEZ     NOPTABL            IF SO, GENERATE A NOP INSTRUCTION
         LS,12    OUTRS
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:RCVON1'
         AI,R2    1                 R2 = NDX INTO TABLE OF PSD'S
         MTW,0    R3                SEE IF THIS IS AN L6 PASS
         BNE      CHKPSD            BRANCH IF SO
         LS,12    RCVON
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:RCVDOFF1'
         AI,R2    1                 R2 = NDX INTO TABLE OF PSD'S
         MTW,0    R3                SEE IF THIS IS AN L6 PASS
         BNE      CHKPSD            BRANCH IF SO
         LS,12    RCVOFF
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:RCVOFF1'
         MTW,0    R3                CHECK FOR L6 PASS
         BNEZ     NOPTABL            IF SO, GENERATE A NOP INSTRUCTION
         LS,12    OFF
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:TSTAT1'
         MTW,0    R3                SEE IF NEED TO GENERATE LCI 3 FOR
         BNEZ     LCICODE           BRANCH FOR L6 PASS
         LS,D1    XSTAT
         STW,D1   *SR1,R1
         AW,SR1   COCLOC,R4
         TEXTC    'CO:XDATA1'
         AI,R2    1                 R2 = NDX INTO TABLE OF PSD'S
         MTW,0    R3                SEE IF THIS IS AN L6 PASS
         BNE      CHKPSD            BRANCH IF SO
         LS,12    XDATA
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:XSTOP1'
         MTW,0    R3                CHECK FOR L6 PASS
         BNEZ     NOPTABL            IF SO, GENERATE A NOP INSTRUCTION
         LS,12    XSTOP
         STW,12   *8,1
         AW,8     COCLOC,4
         LI,SR4   CHK4TAU2-1        DO THIS ON 2ND AND SUBSEQUENT
*                                   PASSES.
TEXTCOR  TEXTC    'CO:RINGA23'      PREF CO:RINGA FOR TAURUS
*                                (A WORD RESOLUTION ADDRESS)
         LW,D1    RINGLOC,R5        GET DISPLACEMENT FROM CO:RINGA
         STW,D1   *SR1
CONTIN2  STW,D1   RBUFDSPE          SAVE IN ACCUMULATOR CELL
         TEXTC    'CO:RINGE1'
         AW,8     1
CONTINU2A STW,SR1 RINGE,R5
         AW,8     COCLOC,4
         TEXTC    'CO:LST1'
         LCW,12   RINGLOC,5
         SLS,12   2
         STW,12   *8
         AW,8     COCLOC,4
         TEXTC    'CO:OUT1'
         LI,SR2   X'1FFFF'
         AND,9    XPSDO
         STW,9    *8
         TEXTC    '22'
         AW,8     COCLOC,4
         TEXTC    'CO:CMND1'
         LW,12    CMND,5
         SLS,12   -1
         STW,12   *8
         TEXTC    '92'
1STTM    AW,8     COCLOC,4
         TEXTC    'CO:XPSDO1'
         LW,12    XPSDO
         STW,12   *8
         TEXTC    '22'
         AW,SR1   COCLOC,R4         ADD TOTAL # OF COC OPTIONS ON :COC
         SW,SR1   R1                COMMAND, THEN SUBTRACT OFF N-1
*                                   VALUE OF  THE CURRENT ENTRY
         AI,R1    1
         CW,1     COCLOC,4
         BGE      LINETBLS
         LW,8     6                 BACK TO CSECT0 START
         AI,5     #DYNAM            TO NEXT COC
         B        %+1               EXIT FROM COCGEN
         LI,SR4   LGEN              GO BACK THRU CODE FOR NEXT COC
         LW,D1    1STL6             GET COC NDX OF L6 OPTION, IF ANY
         BEZ      COCGEN            BRANCH IF NONE SPECIFIED
         AI,D1    -1                REDUCE IT TO N-1
         CW,R1    D1                SEE IF IT MATCHES CURRENT N-1 COC.
         BL       COCGEN            NOT TO L6 COC YET THEN BRANCH
         MTW,0    CURNTL6           SEE IF THIS IS THE FIRST L6
         BNEZ     2NDL6             BRANCH IF IT'S THE 2ND
         MTW,1    CURNTL6           SET FLAG ON GETTING TO 1ST L6
         LI,R3    2                 R3 FOR FIRST PASS UNDER SR4
         B        COCGEN            EXECUTE LOOP UNDER CONTROL OF R11
2NDL6    LI,R3    3                 R3 FOR SECOND AND FINAL PASS UNDER SR4
         B        COCGEN            BUT NOW UNDER THE CONTROL
*                                   OF REGISTER 11
LINETBLS EQU      %
         PLW,R3   *R0               RESTORE R3 AFTER COMPLETING ABOVE LOOP
         BAL,10   MODGEN
         LW,5     4
         LW,D1    TOTLN,R5
         TEXTC    'LNOL0'
         AI,D1    1
         SLS,D1   -1                COCOC IS A 1/2 WORD TABLE
         TEXTC    'COCOC1'
         AW,SR1   D1
         AI,D1    1
         SLS,D1   -1                FOLLOWING ARE BYTE TABLES
         TEXTC    'LB:UN1'
         AW,8     12
         TEXTC    'RSZ1'
         AW,SR1   D1
         TEXTC    'MODE41'
         AW,8     12
         TEXTC    'MODE21'
         LW,9     8                 SAVE MODE2 ADDR
         AW,8     12
         TEXTC    'MODE1'
         LW,D2    SR1               SAVE MOD4INIT START ADDRESS
         AW,SR1   D1
         TEXTC    'MODE51'
         AW,SR1   D1
         TEXTC    'COCTERM1'
         AW,8     12
         TEXTC    'MODE4INIT1'
         STW,8    11                SAVE MODE4 START
         AW,SR1   D1
         TEXTC    'MODE61'
         STW,SR1  MODE6SAV
         AW,SR1   D1                GET TO START OF COB:CTI TABLE
         TEXTC    'COB:CTI1'        ENTER TABLE NAME FOR M:COC LMN
         STW,SR1  COB:SAV           SAVE START OF TABLE POINTER
         LW,15    8
         AW,8     12
         TEXTC    'E2'              INSURE ADEQUATE SPACE
         LW,8     15
         B        %+1
         LW,SR3   MODE6SAV
MODETERM LW,15    COCLOC,5
         LI,R1    HDTABL+1
         AW,R1    R5
         LCI      6
         PSM,R3   *R0               SAVE R3 THRU SR1 TEMPORARILTY
         LI,R3    X'80'             DEFAULT VALUE FOR COB:CTI TABLE
         LI,R7    2741TBL+1         DISPLACEMENT TO 2741 RELATED ENTRIES
*                                   (DEA,DES,DSA,DSS)
         LI,SR1   NON2741T+1        DISP. TO NON-2741 RELATED ENTRIES
*                                   (DASC,D33,D35,D37,D701)
         AW,SR1   R5                STARTING ADDRESS FOR NON-2741 ENTRIES
         AW,R7    R5                STARTING ADDRESS FOR 2741 TYPE ENTRIES
         LI,2     DYNTBL+1
         AW,2     5
         LI,R4    0                 R4 WILL MAINTAIN LINE NDX ACROSS
*                                   TOTAL # OF LINES FOR ALL COC'S
L4       LI,R5    0                 R5 MAINTAINS LINE NDX WITHIN EACH
*                                   COC. IT'S RESET TO 0 AFTER INFO FOR
*                                   CURRENT COC HAS BEEN GENERATED
         LB,R6    *R2,R5            GET FLAG BYTE FOR 2741 IF ANY
*                                   R6 WILL = 0 OR 4
         LB,D3    MODETBL,R6        MODE VALUE
         STB,D3   *D2,R4            PUT LINE CODE INTO MODE LINE # SLOT
         LB,D3    MODE2TBL,R6       GET CORRESPONDING MODE2 VALUE
         STB,D3   *SR2,R4           PUT MODE2 VALUE IN MODE2 TABLE
         LB,D3    MOD4DF,R6         GET CORRESPONDING MODE4INIT VAL.
         STB,D3   *SR4,R4           STORE MODE4INIT VAL IN MODE4INIT
*                                   TABLE
         LB,D3    *R1,R5            GET HD LINE # FLAG
         SLS,D3   7                 D3 WILL = 0 OR X'80'
         STB,D3   *SR3,R4           STORE IT IN MODE6 TABLE
         LB,D3    *R7,R5            GET 2741 LINE # FLAGS
         BNEZ     CH2741            BRANCH IF THERE IS ONE
         LB,D3    *SR1,R5           GET NON-2741 LINE # FLAGS
         BNEZ     CH2741NO          BRANCH IF THERE IS ONE
         STB,R3   *COB:SAV,R4       IF NONE OF THE ABOVE,  SET DEFAULT
         B        INCRER4
CH2741   MTW,0    R6                CHECK IF THERE IS AN INCONSISTENCY
         BNEZ     STBD3             BRANCH IF O.K.
         MTW,1    NO2741ER          INCREMENT ERROR COUNT
         B        STBD3
CH2741NO MTW,0    R6                CHECK FOR A NON-2741 INCONSISTENCY
         BEZ      %+2
         MTW,1    2741ERR           INCREMENT ERROR COUNT
         AI,D3    -1                FLAG IS ONE GREATER THAN NEEDED
*                                   FOR NON-2741 TYPE TERMINALS
STBD3    STB,D3   *COB:SAV,R4       SET FLAG VALUE IN COB:CTI TABLE
INCRER4  AI,R4    1                 STEP UP ENTRY DISPLACEMENT
         AI,R5    1                 STEP UP LINE DISP WITHIN COC
         CW,R5    LINELOC-DYNTBL-1,R2   CHK IF ALL THRU WITH THIS COC
         BL       L4+1
         AI,2     #DYNAM
         AI,R1    #DYNAM
         AI,R7    #DYNAM            STEP UP DISP TO NEXT SET OF COC
         AI,SR1   #DYNAM            LINE # FLAGS
         BDR,15   L4
         LCI      6
         PLM,R3   *R0               RESTORE R3 THRU SR1
MODE4DO  LW,15    COCLOC,5
         LI,1     0                 LINE# INDEX
         LI,13    RTBL+1
         AW,13    5
         LI,14    TYTBL+1
         AW,14    5
         LI,6     RATERNGE+#RATES
R44      LI,R2    0
         LI,4     -#RATES
         LB,9     *13,2
         BNEZ   %+4
       LB,4     *11,1
       AND,4     =X'7'
       B         DOTYP
         CW,9     *6,4
         BLE      %+2
         BIR,4    %-2
         AI,4     #RATES            GET TRUE RATE VALUE
DOTYP   LB,9    *14,2
       CI,9     X'FF'
        BE       %+4
         CI,9     7                 GET TYPE BYTE <= 7
         BLE      %+5
         MTW,1    TYPFLG
         LB,9     *11,1
         AND,9    =X'38'
         B        %+2
         SLS,9    3                 POSITION
         OR,9     4
         STB,9    *11,1
         AI,1     1                 INCRE LINE#
         AI,2     1                 INCRE INDEX THRU TABLES
         STW,13   4
         CW,2     LINELOC-RTBL-1,4
         BL       R44+1
         AI,13    #DYNAM
         AI,14    #DYNAM
         BDR,D4   R44
         MTW,0    TYPFLG
         BEZ      %+3
         LI,D3    TYPERR
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
         AW,8     12
         BAL,10   MODGEN
         TEXTC    'MODE31'
         AW,8     12
         TEXTC    'ARSZ1'
         AW,8     12
         TEXTC    'CPOS1'
         LW,9     8                 SAVE CPOS ADD.
         AW,8     12
         TEXTC    'E2'              INSURE ADEQUATE SPACE
         B        %+1
         LI,11    1
         LW,4     TOTLN,5
         AI,4     -1
         STB,11   *9,4
         BDR,4    %-1
         STB,11   *9
         MTW,0    COUPLE,5
         BEZ      NOCOUP
         BAL,10   MODGEN
         TEXTC    'TIE1'
         LW,9     8
         AW,8     12
         TEXTC    'E2'
         B        %+1
         LW,4     TOTLN,5
         AI,4     -1
         STB,4    *9,4
         BDR,4    %-1
         STB,4    *9
NOCOUP   EQU      %
         BAL,10   MODGEN
         TEXTC    'CPI1'
         AW,8     12
         TEXTC    'BUFCNT1'
         AW,8     12
         LW,12    TOTLN,5           GET
         AI,12    1                 HALFWORD TABLE
         SLS,12   -1                SIZE
         TEXTC    'TL1'
         LW,9     8
         AW,8     12
         TEXTC    'E2'              INSURE ADEQUATE SPACE
         B        %+1
         LW,4     TOTLN,5
         AI,4     -1
         LI,11    X'8000'
         STH,11   *9,4
         BDR,4    %-1
         STH,11   *9
         BAL,10   MODGEN
         TEXTC    'COCOI1'
         AW,8     12
         TEXTC    'COCOR1'
         AW,8     12
         TEXTC    'COCII1'
         AW,8     12
         TEXTC    'COCIR1'
         AW,8     12
         TEXTC    'EOMTIME1'
         AW,8     12
         TEXTC    'COC:ECB1'
         AW,8     12
         AI,8     1
         SLS,8    -1                BOUND 8 FOR NEXT TABLE
         SLS,8    1
         B        %+1
         XW,SR2   SR1
         LW,SR1   MODE6SAV          GET PTR TO MODE6 TABLE
         LW,15    COCLOC,5
         LI,2     HRDTBL+1
         AW,2     5
         LI,D3    1
         LI,R4    0                 R4 KEEPS NDX OVER ALL LINES FOR
*                                   ALL COC'S
         LI,R1    0                 R1 KEEPS TRACK OF LINES WITHIN EACH COC
LHRD     EQU      %
         MTB,0    *R2,R1            SEE IF THERE'S A HARDWIRE FLAG
*                                   FOR THIS LINE
         BEZ      %+2
         STB,D3   *SR1,R4           SET 7TH BIT OF BYTE
         AI,4     1
         AI,R1    1
         CW,R1    LINELOC-HRDTBL-1,R2  CHK IF ALL THRU WITH THIS COC
         BL       LHRD
         AI,2     #DYNAM
         BDR,15   LHRD-1
         XW,SR2   SR1               RESTORE SR1 PT5
         LW,4     5
         LW,14    COCLOC,5
WDRING   EQU      %
         LW,15    CMND,5
         LW,12    *15
         AW,12    8
         SLS,12   2                 BYTE ADDRESS
         AND,D1   M12LFT            THIS IS A PREF FOR TAURUS
         LW,SR3   RBUFDSPA          GET BUFFER DISPLACEMENT
         AW,D1    SR3
         LW,R1    RINGLOC,R5        GET CURRENT SIZE OF RING BUFFER
         SLS,R1   2                 SHIFT TO BYTE DISPLACEMENT
         AW,SR3   R1                AND SAVE FOR NEXT COC (IF ANY)
         STW,SR3  RBUFDSPA
         STW,D1   *D4
         AI,5     #DYNAM
         BDR,14   WDRING
         LW,5     4
         BAL,10   MODGEN
         AI,8     1                 BOUND 8
         SLS,8    -1
         SLS,8    1
         AI,8     -4                BACK UP TO BUF0 (UNUSED)
         TEXTC    'COCBUF1'
         STW,8    13
         LW,12    BUFLOC,5
         SLS,12   2
         AW,8     12
         TEXTC    'E2'              INSURE ADEQUATE SPACE
         LW,8     13
         LW,12    BUFLOC,5
         TEXTC    'COCNB0'
         B        %+1
         AI,8     4
HRBA     LI,13    4                 GENERATE
         AI,12    -1                LINKS
         BLEZ     %+5               IN
         AI,13    4                 COCBUF.
         STW,13   *8
         AI,8     4
         BDR,12   %-3
         LW,12    13                SET VALUE FOR HRBA
         AI,8     4
         MTW,4    *8                COCHPB
         BAL,10   MODGEN
         TEXTC    'HRBA0'
         TEXTC    'COCHPB1'
         LW,D1    MINCOCFL,R3       WILL = 1 IF MINICOC SPECIFIED ON
         TEXTC    'MINCOC0'         :MON CONTROL COMMAND
         LW,D2    D1
         LW,D1    P2OVLOP,R3
         LB,D1    D1                WILL = 1 IF TP SPECIFIED ON
         TEXTC    'TPCOC0'          :MON CONTROL COMMAND
         OR,D1    D2
         EOR,D1   =1
         TEXTC    'REGCOC0'
         LW,D1    AUASCALL,R4       GET FLAG WORD
         LB,D1    D1                SEE IF AUTO SPECIFIED ON :COC C.C.
         BEZ      CHKFEX
         TEXTC    'COC:AUTO0'
CHKFEX   EQU      %
         MTW,0    FEX#              CHK FOR ANY FECP SPECIFICATIONS
         BEZ      WRTM:COC
         B        %+1
         AI,SR1   2
         AND,SR1  X1FFFE            INSURE D.W. BOUND
         STW,SR1  TEMP
         BAL,SR3  MODGEN
         TEXTC    'FE:IP1'
         AI,SR1   2
         LD,D1    FEXPSD
         STD,D1   *SR1
         TEXTC    'FEINT23'
         AI,SR1   2
         LW,SR2   SR1
         LI,R2    0
         LW,R1    FEX#
         AI,R1    1
         LW,R6    R1
         AI,R6    1
         SLS,R6   -1                CONVERT TO H.W. TABLE SIZE
         LI,R4    1
         TEXTC    'FE:TRGR1'
INTLUP   LI,D1    FETRGR
         LW,D2    *D1,R2            GET TRIGGER WORD INDEXED BY FECP #-1
         STW,D2   *SR1,R4
         AW,SR1   R1
         TEXTC    'FE:DSRM1'
         LI,D1    FEDSRM
         LW,D2    *D1,R2            GET DISARM WORD INDEXED BY FECP #-1
         STW,D2   *SR1,R4
         AW,SR1   R1
         TEXTC    'FE:ARM1'         GET ARM & ENABLE WORD INDEXED BY FECP#-1
         LI,D1    FEARM
         LW,D2    *D1,R2
         STW,D2   *SR1,R4
         AW,SR1   R1
         TEXTC    'FEH:GLV1'
         LI,D1    FEHGLV
         LH,D2    *D1,R2
         STH,D2   *SR1,R4
         AW,SR1   R6
         TEXTC    'FEH:ALV1'
         LI,D1    FEHALV
         LH,D2    *D1,R2
         STH,D2   *SR1,R4
         AW,SR1   R6
         AI,R2    1
         CW,R2    FEX#
         BGE      BLKHLP
         AI,R4    1
         LI,SR4   INTLUP
         LW,SR1   SR2
         B        COCGEN
BLKHLP   B        %+1
         AI,SR1   1
         AND,SR1  X1FFFE            INSURE D.W. BOUND
         BAL,SR3  MODGEN
         TEXTC    'BLKHLP1'
         LI,R2    1
BLKHLP1  TEXTC    'FEHLP23'
         STB,R2   *SR1
         AI,SR1   1
         LW,D1    XPSD0
         AW,D1    TEMP              TEMP CONTAINS ADDRESS OF FE:IP TBL
         STW,D1   *SR1
         TEXTC    '22'              CHANGE RELOCATION DICTIONARY
         LW,SR2   SR1
         AI,SR1   3
         STW,SR2  *SR1              IN EFFECT   %-3
         TEXTC    '22'              CHANGE RELOC DICT
         LW,D1    FEXPSD2
         AI,SR1   1
         STW,D1   *SR1
         AI,SR1   1
         CW,R2    FEX#
         BGE      BLKHIO
         AI,R2    1
         LI,SR3   BLKHLP1-1
BLKHIO   BAL,SR3  MODGEN
         TEXTC    'BLKHIOI1'
         LI,R2    1
BLKHIO1  TEXTC    'FEHIOI23'
         STB,R2   *SR1
         AI,SR1   1
         LW,D1    XPSD0
         AW,D1    TEMP              TEMP CONTAINS ADDRESS OF FE:IP TBL
         STW,D1   *SR1
         TEXTC    '22'              CHANGE RELOCATION DICTIONARY
         LW,SR2   SR1
         AI,SR1   3
         STW,SR2  *SR1              IN EFFECT   %-3
         TEXTC    '22'              CHANGE RELOC DICT
         LW,D1    FEXPSD2
         AI,SR1   1
         STW,D1   *SR1
         AI,SR1   1
         CW,R2    FEX#
         BGE      BLKGO
         AI,R2    1
         LI,SR3   BLKHIO1-1
BLKGO    BAL,SR3  MODGEN
         TEXTC    'BLKGO1'
         LI,R2    1
BLKGO1   TEXTC    'FEGOI23'
         STB,R2   *SR1
         AI,SR1   1
         LW,D1    XPSD0
         AW,D1    TEMP              TEMP CONTAINS ADDRESS OF FE:IP TBL
         STW,D1   *SR1
         TEXTC    '22'              CHANGE RELOCATION DICTIONARY
         LW,SR2   SR1
         AI,SR1   3
         STW,SR2  *SR1              IN EFFECT   %-3
         TEXTC    '22'              CHANGE RELOC DICT
         LW,D1    FEXPSD2
         AI,SR1   1
         STW,D1   *SR1
         AI,SR1   1
         CW,R2    FEX#
         BGE      GENFROG
         AI,R2    1
         LI,SR3   BLKGO1-1
GENFROG  BAL,SR3  MODGEN
         TEXTC    'S:FROGF1'
         B        %+1
WRTM:COC LI,D3    FILENAME
         BAL,11   WRITELM
         MTW,0    NO2741ER          SEE IF AN INCONSISTENDY ERROR
         BEZ      CHKMORE           EXISTS, BRANCH TO A FURTHER CHECK
         LI,D3    NO2741MG          GET ERROR MESSAGE
         BAL,SR4  LOGIT
CHKMORE  MTW,0    2741ERR           SEE IF AN INCONSISTENCY ERROR
         BEZ      NOCOC             EXISTS, BRANCH IF NOT
         LI,D3    2741MSG           GET ERROR MESSAGE
         BAL,SR4  LOGIT
NOCOC    CAL1,8   =X'08000002'      GET 2 PAGES FOR SPEC:HAND FILE
         BCS,8    NOROOM
         LI,R7    3
         LI,D1    HAND              GET HANDLERS NAME
         STW,SR2  SPECSTART
         SLS,SR1  11
         STW,SR1  SPECLGTH
OPENSPEC EQU      %
         M:OPEN   M:TM,(FILE,'SPEC:HAND'),(KEYED),(INOUT),(SAVE),;
                       (ERR,NOHERR),(ABN,NOHERR)
         M:READ   M:TM,(BUF,*SPECSTART),(SIZE,*SPECLGTH),;
                  (KEY,*D1),(ERR,NOHERR),(ABN,NOHERR)
         LW,R1    13+M:TM           GET ACTUAL RECORD SIZE
         SLS,R1   -3
         MTW,0    SCPUFLG,R3
         BNEZ     MPNMLUP
         CI,D1    HAND
         BNE      CHKCOC
         LD,SR3   SCHDSUB
         LI,R7    0
         B        %+2
MPNMLUP  LD,SR3   MPNAMES,R7        MOVE MULTI-PROCESSOR HANDLER NAMES
         STD,SR3  *SPECSTART,R1     INTO SPEC:HAND FILE
         AI,R1    1
         MTW,1    *SPECSTART        INCREMENT HANDLER NAME COUNT
         BDR,R7   MPNMLUP
         MTW,0    HAND2FLG,R3       WAS HANDLERS2 CC SPECIFIED
         BNEZ     CHKHAND2          SKIP NEXT IF SO
CHMORMPS CI,R7    0
         BEZ      MPNMLUP
         B        R1EQBYTE
CHKHAND2 CI,D1    HAND2
         BNE      R1EQBYTE
CHKCOC   MTW,0    DEVLOC,R5
         BLEZ     R1EQBYTE          SKIP FOLLOWING IF NOCOC SPECIFIED
         LI,SR2   XMINCOCU          POINT TO START OF PROCEDURE TYPE
*                                   HANDLER NAMES
         BAL,D2   MUVCOCPR
R1EQBYTE SLS,R1   3
         M:WRITE  M:TM,(BUF,*SPECSTART),(SIZE,*R1),(KEY,*D1),;
                       (ERR,NOHERR),(ABN,NOHERR)
         M:CLOSE  M:TM,(SAVE)
         CI,D1    HAND
         BNE      RELPGS            BR. IF NOT JUST DONE WITH HANDLERS
         MTW,0    HAND2FLG,R3       CHECK FOR HANDLERS2 CC
         BEZ      RELPGS            BR IF NO HANDLERS2 C.C.
         LI,R7    0
         LI,D1    HAND2             NEED TO PUT MPSHED NAME IN
         B        OPENSPEC          HANDLERS2 REC. OR SPEC:HAND FILE
MUVCOCPR EQU      %
         MTW,0    MINCOCFL,R3       NEED TO PICK UP SECOND PART OF
         BEZ      %+3               COC HANDLER NAMES (PRCOEDURE)
         LD,SR3   *SR2
         B        STORCOCU
         AI,SR2   2
         LD,SR3   *SR2              OTHERWISE ADD EITHER REGCOCU OR
         LW,R2    P2OVLOP,R3        TPCOCU NAME TO HANDLERS RECORD
         LH,R2    R2                DEPENDING ON PRESENCE OR ABSENCE
         BEZ      %+3
         AI,SR2   2
         LD,SR3   *SR2              OF 'TP' OPTION ON :MON COMMAND
STORCOCU STD,SR3  *SPECSTART,R1
         AI,R1    1
         MTW,1    *SPECSTART
         B        *D2
NOROOM   LI,D3    NOPGSMSG
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
         B        STM:IOMOD
NOHERR   LW,D3    L(X'00200000')
         AND,D3   M:TM              IS DCB OPEN
         BEZ      %+2               BRANCH IF DCB IS CLOSED
         M:CLOSE  M:TM,(SAVE)
         LI,D3    26
         STB,D3   NOHMSG            ONLY PRINT 'TROUBLE WITH SPEC:HAND'
         LI,D3    NOHMSG
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
RELPGS   CAL1,8   =X'09000002'      RELEASE WORK PAGES
*
*     THE FOLLOWING CODE GENERATES THE M:IOMOD LOAD MODULE
*
STM:IOMOD EQU     %
         LW,R7    MPOOL,R3          GET MPOOL VAL ON :MON CC
         STW,R7   POOLINFO
         LW,R7    CPOOL,R3
         STW,R7   POOLINFO+2
         LI,D2    -1
         LI,D1    -1
         BAL,SR4  COREALLOC
         B        %+1
         BAL,SR3  MODGEN
         STW,SR1  IOLOW
         TEXTC    'IOLOW1'
         TEXTC    'MPOOL1'          STARRT OF MPOOL BUFFERS
         LI,R2    0
         LI,R1    POOLINFO          GET MPOOL AND CPOOL TBL ADDR.
         B        %+1
         LI,SR3   CPOOLGEN-1
BUFGEN   PSW,SR3  *R0
         PSW,SR1  *R0
         LW,D2    *R1,R2            GET MPOOL VAL 1ST TIME.  THEN CPOOL
         AI,R2    1                 VALUE NEXT TIME.
         LW,D4    *R1,R2            GET SIZE
         AW,SR1   D4
         BAL,SR3  MODGEN
         TEXTC    'E2'
         PLW,SR1  *R0
         PLW,D4   *R0
         LW,SR2   SR1
         AI,SR2   2
         AND,SR2  X1FFFE
         B        %+1
BG1      BAL,SR3  MODGEN
         TEXTC    '22'
         STW,SR2  *SR1
         LW,SR1   SR2
         AW,SR2   *R1,R2
         BDR,D2   BG1
         LW,SR1   SR2
         LW,SR3   D4
CPOOLGEN TEXTC    'CPOOL1'          START OF CPOOL BUFFERS
         AI,R2    1
         B        BUFGEN
         AI,SR1   -1
         TEXTC    'CPOOLEND1'
         AI,SR1   1
         MTW,0    #RBTS,R3
         BEZ      CLISTGEN
         LW,R1    LORBIN,R3
         LW,R2    R1
         AW,R1    #RBTS,R3          R1=LORBIN+#RBTS
         SLS,R2   -1                TO BUMP ADD. BACK BY LORGIN/2
         SW,SR1   R2                SR1=SR1-LORBIN/2
         TEXTC    'RBH:ACK1'        RBT TABLE FOR NO WRITE RESTRICITION
         B        %+1
         AI,R1    1
         SLS,R1   -1                SIZE OF RBH:ACK H.W. TABLE
         AW,SR1   R1
CLISTGEN AI,SR1   1
         AND,SR1  X1FFFE            INSURE DOUBLE WORD BOUND
         BAL,SR3  MODGEN
         TEXTC    'CLISTS1'
         B        %+1
         LCI      15                ****THIS SECTION GENERATES CLISTS******
         PSM,R1   *R0
         LW,D2    TCLSIZES,R3       GET CLIST INFO GENERATED BY UBCHAN
         LW,D3    TPSZWID,R3        GET PAPER WIDTH AND SIZE GENERATED
*                                   BY UBCHAN
         LW,D4    DCT4TEMP,R3       GET DCT4 TABLE GENERATED BY UBCHAN
         LI,R3    1
         LI,R4    1
         LB,R1    *D2               GET LENGTH OF CLIST SIZE DATA
         LW,R2    *D3               GET SIZE OF SPECIAL CLIST DATA
         AI,R2    1                 ZERO OUT LEFT HALF OF 1ST SPEC CLIST
         STW,R2   *D3,R2            INFO+1 TO FAIL ON %+2 AFTER LAST 1.
CLISTLUP LW,SR2   *D3,R3            GET CURRENT SPECIAL CLIST INFO
         LB,R6    *D2,R4            GET CURRENT SIZE OF CLIST DATA
         CB,R4    SR2               IF EQUAL THEN CURRENT CLIST IS:-
         BNE      %+2
         BAL,SR4  SPECLIST             TY,LP,XP,RB OR CP
         AW,SR1   R6                TIME THRU CLISTLUP
         AI,R4    1
         CW,R4    R1
         BG       ENDCLIST          BRANCH WHEN ALL DONE
         B        CLISTLUP
SPECLIST LB,R5    *D4,R4            GET DCT4X
         CI,R5    5                 IS IT THE CARD PUNCH
         BE       CPCLIST
         AI,SR1   4
         SLS,SR2  16
         LB,R6    SR2               GET PAPER SIZE
         STW,R6   *SR1
         AI,SR1   1
         SLS,SR2  8
         LB,R6    SR2               GET PAPER WIDTH
         AI,R3    1                 MOVE PTR UP FOR NEXT SPEC. CLIST ITEM
         STW,R6   *SR1
         LB,R6    *D2,R4            RESTORE R6 WITH CLIST SIZE
         AI,SR1   -5                RESTORE SR1
         CI,R5    14                IST THIS ENTRY FOR AN RB DEVICE
         BNE      *SR4
         AI,SR1   6
         LW,R5    L(X'16161616')    WORD-6 OF RB CLIST
         STW,R5   *SR1
         AI,SR1   1
         LW,R5    L(X'1000200')     WORD-7 OF RB CLIST
         STW,R5   *SR1
         AI,SR1   -7                RESTORE SR1
         B        *SR4
ENDCLIST LW,R1    FEX#
         BEZ      ENDFECP
         BAL,SR3  MODGEN
         TEXTC    'FEH:BUF1'
         STW,SR1  TEMP
         AI,R1    2                 ADJUST INDEX FOR H.W. TABLE LOOP
         SLS,R1   -1
         AI,SR3   1
RELFEH:B BAL,SR3  MODGEN
         TEXTC    'A2'              CHANGE RELOCATION DICTIONARY TO
         AI,SR1   1                 D.W. ADDRESS IN BOTH HALVES OF WORD
         AI,R1    -1                FOR FEH:BUF TABLE
         BNEZ     RELFEH:B
         AI,SR1   1
         AND,SR1  X1FFFE            BOUND 8 FOR THE 8 WORD BUF BLOCK
         SLS,SR1  -1                CHANGE SR1 ADDRESS TO D.W. ADDRESS
         LI,R2    1                 R2 = H.W. DISP. INTO FEH:BUF TABLE
         LW,R1    FEX#
         LW,D1    TEMP              GET ADDRESS OF START OF FEH:BUF
         STH,SR1  *D1,R2            SET D.W. BLOCK ADDRESS INTO H.W. OF
         AI,R2    1                 FEH:BUF
         AI,SR1   4                 ADD EQUIVALENT OF 8 WORDS
         BDR,R1   %-3
         B        %+1               GET OUT OF MODGEN IF STILL IN IT
         SLS,SR1  1                 ***CAUTION CO:RINGA TABLE MUST BE
ENDFECP  STW,SR1  TEMP              SAVE R8 FOR AFTER THE FOLLOWING PULL
*                                   D.W. BOUND (APPLIES TO INSERTS HERE)
         LCI      15
         PLM,R1   *R0
         LW,SR1   TEMP
         BAL,SR3  MODGEN
         MTW,0    DEVLOC,R5         CHK IF THIS IS A BATCH ONLY SYSTEM
         BLEZ     NOCOC1
         TEXTC    'CO:RINGA1'
         LW,D1    COCLOC,R5          GET NO. OF COC'S SPECIFIED
         LW,R4    R5
WRITLOOP AW,SR1   RINGLOC,R5
         LCW,R1   RINGLOC,R5
         LI,D4    -1                STORE -1 INTO RING BUFFER L
         STW,D4   *SR1,R1
         BIR,R1   %-1
ADDYN    AI,R5    #DYNAM
         BDR,D1   WRITLOOP
         B        %+1
NOCOC1   EQU      %
         LW,D3    MCDEV,R3          CHK FOR MC DEVICE
         BEZ      DOKYINB
         AI,SR1   1
         AND,SR1  X1FFFE            DOUBLE WORD BOUND IT
         BAL,SR3  MODGEN
         TEXTC    'RAS:DOL1'        FOLLOWING RAS CODE IS INCLUDED
         LI,D4    X'F007'           FOR MC DEVICE BUFFER REQUIREMENTS
         STH,D4   *SR1
         AWM,D3   *SR1              RAS:DOL = F0070000+DCTX OF MC
         AI,SR1   1
         TEXTC    'T:RESCNCT23'     PREF THIS
         AI,SR1   1
         LW,D3    L(X'154C0000')
         STW,D3   *SR1
         AI,SR1   1
         TEXTC    'RAS:CBP1'
         AI,SR3   1
DOKYINB  BAL,SR3  MODGEN
         AI,SR1   1
         AND,SR1  X1FFFE            DOUBLE WORD BOUND
         TEXTC    'KEYINBUF1'
         AI,SR1   17
         TEXTC    'IOHIGH1'
         B        %+1
         LI,D3    FILENM
         BAL,SR4  WRITELM           WRITE M:IOMOD
         MTW,0    HAND2FLG,R3
         BEZ      SGINT
         LI,D1    50                MUST GENERATE A DUMMY ROOTHAND
         LI,D2    50                MODULE TO SATISFY MONITOR LOCCT
         BAL,SR4  COREALLOC         ALLOW 50 DATA AND REF/DEF WORDS
         BAL,SR3  MODGEN            GO GENERATE A EQU TYPE DEF
         LI,D1    1
         TEXTC    'NOROOTHA0'       THIS DEF SAYS THAT ROOTHAND MODULE
         B        %+1               IS A DUMMY
         LI,D3    ROOTHAND          WRITE ROOTHAND DUMMY LOAD MODULE
         BAL,SR4  WRITELM
SGINT    LI,D2    -1                PROCESS SG:INT MODULE
         LI,D1    -1
         BAL,SR4  COREALLOC
         LW,R1    FEX#
         BEZ      GENSGINT          SKIP FOLLOWING IF NO FECP
         LI,R2    0
         MI,R1    4
         LW,D1    R1
         BAL,SR3  MODGEN
         TEXTC    'INT#0'
         TEXTC    'INTLOC1'
         LI,D2    FEINTTB
         LI,R4    1
MORINTL  LH,D1    *D2,R2
         LI,R6    4
         STB,D1   *SR1,R4
         AI,D1    1
         AI,R4    1
         BDR,R6   %-3
         AI,R2    1
         CW,R2    FEX#
         BL       MORINTL
         AI,R1    4
         SLS,R1   -2
         AW,SR1   R1
         BAL,SR3  MODGEN
         TEXTC    'INTCONT1'
         AI,SR1   1                 LEAVE A 0TH ENTRY
         LI,R2    1
         LW,D1    XPSD0
         LI,R6    2
INTCLUP  STW,D1   *SR1
         AWM,R6   *SR1              R6 = DISP +2 INTO BLKHLP TBL
*                                   FOR THE CURRENT FEX #
         TEXTC    'BLKHLP23'
         AI,SR1   1
         LW,SR2   SR1
         AI,SR1   1
         STW,D1   *SR1
         AWM,R6   *SR1
         TEXTC    'BLKHIOI23'
         AI,SR1   1
         STW,D1   *SR1
         AWM,R6   *SR1
         TEXTC    'BLKGO23'
         LW,D2    MTB1
         AW,D2    R2                ADD DISPLACEMENT BY FEX#
         XW,SR1   SR2
         STW,D2   *SR1
         TEXTC    'FE:CRD23'
         XW,SR1   SR2
         AI,SR1   1
         AI,R2    1
         CW,R2    FEX#
         BG       WRTSGINT
         AI,R6    6                 SIZE OF BLK TABLES
         LI,SR3   INTCLUP-1
WRTSGINT AI,SR1   -1
         LI,D3    SGINTNM
         BAL,SR4  WRITELM
READNXT  EQU      %
         LI,D1    -#DYNAM
         MSP,D1   *R0
         CW,R5    *R0
         BL       %-2
         B        READSTRG
GENSGINT BAL,SR3  MODGEN
         LI,D1    0
         TEXTC    'INT#0'
         B        WRTSGINT+1
CPCLIST  EQU      %
         PSW,D2   *R0
         STW,SR1  TEMP
         LI,R2    0
CPCLIST1 LW,D2    CPCLISDAT,R2      MOVE CP CLIST TO DESTINATION
         SLS,D2   -20
         AND,D2   XF                GET TYPE OF DISPLACEMENT
         BEZ      CPCLIST2          THERE IS NONE
         SLS,SR1  -1
         MW,D2    SR1
         SLS,SR1  1
         AW,D2    CPCLISDAT,R2
         B        %+2
CPCLIST2 LW,D2    CPCLISDAT,R2
         STW,D2   *SR1,R2
         AI,R2    1
         CI,R2    CPSIZE
         BL       CPCLIST1
         LW,R5    SR1
         AI,R5    CPSIZE
RDICLIST1 LI,R2   0
         LW,D2    XF
         LW,D1    *SR1              DETERMINE IF THIS WORD
         SCS,D1   12                CONTAINS A POINTER TO A
         STS,D1   R2                WORK AREA WHICH MUST BE
         SLS,D1   -4                RELOCATED
         SCS,D1   -8                REMOVE FLAG FROM CLIST WORD
         STW,D1   *SR1
         CI,R2    0
         BE       RDICLIST2
         AI,R2    -1                DICT. CHANGE REQUIRED
         LB,D1    RELDICNO,R2       GET DICT VALUE
         SLD,D1   16
         STS,D1   CHGDICT
         BAL,SR3  MODGEN
CHGDICT  TEXTC    '02'
RDICLIST2 AI,SR1  1
         CW,SR1   R5
         BLE      RDICLIST1
         B        %+1
         AI,R3    1                 MOVE PTR UP FOR NEXT SPEC. CLIST ITEM
         LW,SR1   TEMP
         PLW,D2   *R0
         LB,R6    *D2,R4            RESTORE R6 WITH CLIST SIZE
         B        *SR4
RELDICNO DATA     X'03020001',0      USED TO CHANGE RELDICT FOR CP CLIST
********
         BOUND    8
CPCLISDAT EQU     %                 SPECIAL CP CLIST DATA
ABS      ASECT
         ORG      CPCLISDAT
         LOC      ABS
CPLIST   EQU      %
         DATA     1                 0
         DATA     X'13'             0
         GEN,8,4,1,19  9,8,0,BA(%+6)         1
         DATA     X'2E000078'                1
         GEN,8,4,1,19  8,1,0,DA(%-2)         2
         DATA     0                          2
         DATA     X'80000000'       3
         DATA     0                 3
         DO       30                4-->18
         DATA     0
         FIN
         GEN,8,4,1,19  9,8,0,BA(%+6)         19
         DATA     X'2E000078'                19
         GEN,8,4,1,19  8,1,0,DA(%-2)         20
         DATA     0                          20
         DATA     X'80000000'       21
         DATA     0                 21
         DO       30                22-->36
         DATA     0
         FIN
CPSIZE   EQU      %-CPLIST          SPECIAL CP CLIST SIZE
         ORG      CPCLISDAT+CPSIZE
**********
TRANS    DATA,1   0,8,9,10,11,12,13,16    TAURUS TRANSLATE TABLE
RBUFDSPA DATA     0                 FOR TAURUS 'CO:RINGA' REF + DISP.
RBUFDSPE DATA     0                 FOR TAURUS 'CO:RINGE' REF DISP
BUFINCR  DATA     0
DEVXCOC  EQU      %                 TABLE FOR COC'S DCT4 INDEX
         DO1      8                 ONLY 8 COC'S PERMISSIBLE
         DATA     0
FEINTGP  DATA     0                 BYTE TABLE OF FECP INT GROUPS
FEINTTB  DO1      2                 H.W. TABLE OF FECP INT. NOS.
         DATA     0
FEHGLV   DO1      2                 H.W. TABLE OF GO BITS FOR INT LEV.
         DATA     0
FEHALV   DO1      2                 H.W. TABLE OF BITS FOR 4 INT LEV.
         DATA     0
FETRGR   DO1      4                 WORD TABLE OF TRIGGER INTERRUPTS.
         WD,12    X'1700'
FEDSRM   DO1      4                 WORD TABLE OF DISARM  INTERRUPTS.
         WD,12    X'1100'
FEARM    DO1      4                 WORD TABLE OF ARM & ENABLE INTERRUPTS.
         WD,12    X'1200'
COCFEXT  DO1      2
         DATA     0
COLNMBYT DO1      2
         DATA     X'3F3F3F3F'       DEFAULT SETTINGS FOR NON-FECP COC'S
MODE6SAV DATA     0
XF000    DATA     X'F000'
X1000    DATA     X'1000'
TEMP     DATA     0
         BOUND    8
FEXPSD   DATA     X'60000000'
FEXPSD2  DATA     X'17000000'
MTB1     DATA     X'73100000'
POOLINFO EQU      %
         DATA     0                 FOR MPOOL VAL FROM :MON CC
MPSIZE   DATA     34
         DATA     0                 FOR CPOOL VAL FROM :MON CC
CPLSIZE  DATA     40
PATCH    EQU      %
         LIST     0
         DO1      50
         DATA     0
         LIST     1
         END

