***********************************************************************
*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      '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      '7015',X'41',DYNTBL+3**16       BT-DEC
         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
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.'
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
EXTENDAD DATA     X'810000'         EXTENDED ADDRESSING BITS FOR BIG
*                                   SIG9
         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
         DATA     X'17000010'
         LI,3     0
         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'
         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
*
NOH      EQU      %
         LW,14    L(X'00200000')
         AND,14   M:TM              IS DCB OPEN?
         BAZ      %+2               NO
         M:CLOSE  M:TM,(SAVE)
         LI,D3    NOHMSG
         BAL,SR4  LOGIT             ENTER MESSAGE IN T:P2SI
         B        NOSPECH
ERR      LCI      5
         PLM,R4   *R0
         EXU      NOH
         BAZ      ABNERR2
         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
         EXU      *11
         STCF     11
         AI,11    1
         B        COCGEN
*      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    DEVLOC,R5         CHK IF THIS IS A BATCH ONLY SYSTEM
         BLEZ     NOCOC             BRANCH IF A NO-COC SYSTEM
         LW,D1    INLOC,R4          GET IN 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      %
L3       AI,5     -#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,13    DEVLOC,5
         LI,12    COCS
         AW,12    3
         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
         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,15   L3
         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  OUTPSD+1          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
         AW,13    15
         LI,12    -1                USE REST OF CORE FOR RFDF/EXPR
         BAL,11   COREALLOC
         B        %+2
         PZE      READNXT           ABORT RETURN FROM COREALLOC OR
*                                   MODGEN
         LW,R4    R5                COREALLOC CLOBBERS REG. 4
         BAL,10   MODGEN
         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,15    8                 FIRST B COCOP
         LD,12    OUTPSD+2
         AW,12    1
         STD,12   *8
         LI,11    NOOUT             SKIP REF EXCEPT COC0
         TEXTC    'COCOP23'
NOOUT    LI,10    ENDOUT            SKIP B FIRST FIRST TIME
         AWM,15   *8
ENDOUT   TEXTC    '22'
         AI,15    -5
         LW,8     15
         LW,15    COCLOC,4
         MI,15    6
         AW,8     15
         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'
         LS,12    STAT
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:OUTRS1'
         LS,12    OUTRS
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:RCVON1'
         LS,12    RCVON
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:RCVDOFF1'
         LS,12    RCVOFF
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:RCVOFF1'
         LS,12    OFF
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:TSTAT1'
         LS,D1    XSTAT
         STW,D1   *SR1,R1
         AW,SR1   COCLOC,R4
         TEXTC    'CO:XDATA1'
         LS,12    XDATA
         STW,12   *8,1
         AW,8     COCLOC,4
         TEXTC    'CO:XSTOP1'
         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'
         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,8     COCLOC,4
         SW,8     1
         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
         B        COCGEN            BUT NOW UNDER THE CONTROL
*                                   OF REGISTER 11
LINETBLS EQU      %
         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,13    8                 SAVE MODE 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
         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
         PSW,R3   *R0
         LI,R3    0
         LI,2     DYNTBL+1
         AW,2     5
L4       LI,4     0
         LB,6     *2,4              PICK UP LINE# CODE
         LB,14    MODETBL,6         MODE VALUE
         STB,D3   *D2,R3            STORE LINE CODE INTO LINE# SLOT
         LB,D3    MODE2TBL,R6       GET CORRESPONDING MODE2 VALUE
         STB,D3   *SR2,R3
         LB,D3    MOD4DF,R6         GET CORRESPONDING MODE4INIT VAL.
         STB,D3   *SR4,R3
         LB,R6    *R1,R4
         SLS,R6   7                 R6 = EITHER 0 OR X'80'
         STB,R6   *SR3,R3           DEPENDING ON PRESENCE OF HD LINE #
         AI,R3    1
         AI,4     1
         CW,4     LINELOC-DYNTBL-1,2
         BL       L4+1
         AI,2     #DYNAM
         AI,R1    #DYNAM
         BDR,15   L4
         PLW,R3   *R0
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,1     0
         LI,2     HRDTBL+1
         AW,2     5
         LI,4     0
LHRD     EQU      %
         MTB,0    *2,4
         BEZ      %+2
         MTB,1    *SR1,R1           SET 7TH BIT OF BYTE
         AI,R1    1
         AI,4     1
         CW,4     LINELOC-HRDTBL-1,2
         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
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
         BAZ      %+2               BRANCH IF 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

