         SYSTEM  SIG7FDP
         SYSTEM  BPM
         REF      READSTRG,LLIST
         REF      SYNTAX,COREALLOC,MODGEN,WRITELM
         REF      COCS
         REF      M:TM
         REF      P2ABRT
         REF      M12LFT
         REF      ABNERR2
         REF      TEXTAUK
         REF      P2ERR
         REF      RBSIZ
         REF      DCTSIZE
         REF      MCDEV
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      '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
         KWD      '33  ',X'41',DYNTBL+0**16  BT-DEC
         KWD      '35  ',X'41',DYNTBL+1**16  BT-DEC
         KWD      '37  ',X'41',DYNTBL+2**16  BT-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      '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
         KWD      'RATE',9,RTBL+0**16   BT-DEC
         KWD      'TYPE',9,TYTBL+0**16  BT-DEC
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      %
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
DYNTBL   DYN      0,0,64            #ENTRIES
         DO1      16
         DATA     0
HRDTBL   DYN      0,0,64
         DO1      16
         DATA     0
RTBL     DYN      0,0,64
         DO1      16
         DATA     0
TYTBL    DYN      0,0,64
         DO1      16
         DATA     -1
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 NOT DEFINED -',;
                  ' COC ABORTED'
TYPERR   TEXTC    '*** TYPE > 7 INVALID -- DEFAULTS USED'
FILENAME TEXTC    'M:COC'
FILENM   TEXTC    'M:IOMOD'
IOLOW    DATA     0
X1FFFE   DATA     X'1FFFE'
XFFFF    DATA     X'FFFF'
XF       DATA     X'F'
MODETBL  DATA     X'88888888',X'08000000'
MODE2TBL DATA     X'20202020',X'30000000'
MOD4DF   DATA     X'28282828',X'09000000'
RATERNGE DATA     10,15,30,60,X'FF'
#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'3007'
XDATA    WD,6     X'3005'
XSTOP    WD,7     X'300E'
XPSDO    XPSD,8   0
         BOUND    8
CMNDDWD EQU %
 DATA X'02000000'**-2 READ
 DATA X'80000000'**-2 DATA CHAIN
 DATA X'08000000'**1 TIC
 DATA 0
         BOUND    8
INPSD    DATA     2
         DATA     X'17000010'       RP=1
         LW,5     0
         WD,5     X'1700'-4
         DATA     X'0EB00000'-6     LPSD,11  %-6
         RES      1
         BOUND    8
OUTPSD   DATA     2
         DATA     X'17000010'
         LI,3     0
         B        0
TTBLS    EQU      %-2
         TEXTC    'EAPL'
         TEXTC    'ESTD'
         TEXTC    'SAPL'
         TEXTC    'SSTD'
HAND     TEXTC    'HANDLERS'
TAUFLGS  DATA     X'0C800000'       FLAGS REQ. FOR CMND DW FOR TAURUS
NOHMSG   TEXTC    '*** TROUBLE WITH SPEC:HAND - TRANSLATE TABLES LOST'
         PZE      WRITE+1           ABORT RETURN FROM COREALLOC OR MODGEN
         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
         MTW,1    P2ERR,R3
         CAL1,2   LLIST
         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
         MTW,1    P2ERR,R3
         CAL1,2   LLIST
         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
         OR,D2    TAUFLGS           TAURUS NEEDS ICE/HTE FLAGS SET IN
         STD,D1   *SR1              COMMAND DW.
PROCESS1 LI,SR3   %+2
         B        MODGEN
         DATA     X'0AC3D67A'         GENERATE 'CO:RINGX23'
         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      %
         LI,2     DYNAM             SET
         LI,1     #DYNAM            PARAMETERS
         LW,4     KWDPTR            FOR SYNTAX
         BAL,11   SYNTAX
         LW,4     5                 SAVE START OF DATA
         LW,12    INLOC,4           GET COCO IN
         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
         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
         LI,D1    BUF               ADDRESS OF TEMP AREA FOR COC DEVICE
         STW,D1   DEVXCOC           ADDRESS OR INDEX (IF TAURUS)
         LCI      5
         PSM,R4   *R0
         LW,R6    DCTSIZE,R3
         AI,R6    3
         SLS,R6   -2
         LW,R5    R6                # OF WORDS IN EACH REC. OF TAURTMP
         SLS,R5   1                 FILE.
         STW,R5   BUFINCR
         SLS,R6   +3
         LI,R4    TEXTAUK
         MTW,-4   *R4
         LI,R7    4
         LI,SR1   BUF
         M:OPEN   M:TM,(FILE,'TAURTMP'),(IN),(KEYED),(REL),(DIRECT),;
                  (ABN,ERR),(ERR,ERR)
READCLST M:READ   M:TM,(BUF,*SR1),(SIZE,*R6),(KEY,*R4),(WAIT),;
                  (ABN,ERR),(ERR,ERR)
         AW,SR1   R5
         MTW,1    *R4
         BDR,R7   READCLST
         STW,SR1  POOLINFO
         LI,R6    16
         EXU      READCLST
         M:CLOSE  M:TM,(REL)        =+*#"!=<>CHANGE TO RELEASE********
         LW,R6    M:TM+4            GET ACTUAL RECORD SIZE
         SLS,R6   -19               AND CONVERT TO WORDS
         AW,SR1   R6                SR1 PTS TO END OF TEMP INFO FROM
         STW,SR1  DEVXCOC           TAURTMP FILE
         LI,R6    0
         LI,R5    BUF
         AW,R5    BUFINCR
         LH,R7    *R5               ADD UP ALL CLIST SIZES TO GET
         AH,R6    *R5,R7            TO GET TOTAL # NEEDED FOR CLIST INFOO
         BDR,R7   %-1
         STW,R6   CLISTOT
         LCI      5
         PLM,R4   *R0
DEFLT1   EQU      %
L3       AI,5     -#DYNAM
         LW,12    LINELOC,5
         BLZ      DELN
         CI,12    64                CHECK MAX VALUE
         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,1     *12
         BEZ      ERDEV
DEFLT2   LH,R6    *D1,R1
         LW,R7    R6
         LH,R6    BUF,R6
         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    R1
         AI,R7    -1
         STH,D2   *DEVXCOC,R7       SAVE FOR COH:DN VALUES
         LW,13    FLGLOC,5          COLLECT ALL XLATE TABLE FLAGS
         STS,13   FLGLOC,4
         BDR,15   L3
         LW,13    FLGLOC,4
         BEZ      NOSPECH           NO XLATE TBLS
         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
         LI,2     4
         LI,R6    1
IST      CI,13    1
         BAZ      NOT
         LD,14    TTBLS,2
         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,13   -1
         BDR,2    IST
         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,15    TOTLN,5           CHECK IF BUF >=
         MI,15    3                 3 * LINES
         CW,15    BUFLOC,5
         BLE      %+2
         M:PRINT  (MESS,BUFMSG)
         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
         MI,15    22                22 BYTE TABLES
         AW,13    15
         LI,12    -1                USE REST OF CORE FOR RFDF/EXPR
         BAL,11   COREALLOC
         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
         LI,9     X'1FFFF'
         STS,8    INPSD+2
         AWM,12   INPSD+3
         TEXTC    'CO:IIL1'
         LW,12    INGRP
         TEXTC    'COA:IGO0'
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
         OR,D2    TAUFLGS           TAURUS NEEDS ICE/HTE FLAGS SET IN
         STD,D1   *SR1              COMMAND DW.
TEXTRING TEXTC    'CO:RINGA03'      PREF RING BUFFER 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
         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
         LW,12    1
         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:TRNDOFF1'
         LS,12    OFF
         STW,12   *8,1
         AW,8     COCLOC,4
         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
         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,12    3
         SLS,12   -2
         TEXTC    'COCOC1'          COCOC EQU CODE
         AW,8     12
         TEXTC    'LB:UN1'
         AW,8     12
         TEXTC    'RSZ1'
         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    'MODE41'
         STW,8    11                SAVE MODE4 START
         LW,15    8
         AW,8     12
         TEXTC    'E2'              INSURE ADEQUATE SPACE
         LW,8     15
         B        %+1
MODETERM LW,15    COCLOC,5
         LI,1     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,14   *13,1
         LB,14    MODE2TBL,6        MODE2 VALUE
         STB,14   *9,1
         LB,14    MOD4DF,6          SET UP DEFAULT MODE4
         STB,14   *11,1
         AI,1     1
         AI,4     1
         CW,4     LINELOC-DYNTBL-1,2
         BL       L4+1
         AI,2     #DYNAM
         BDR,15   L4
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      %+2
         M:PRINT  (MESS,TYPERR)
         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
         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
         TEXTC    'COD:HWL1'
         STW,8    1
         LW,15    COCLOC,5
         SLS,15   1
         AW,8     15
         TEXTC    'E2'              INSURE ADEQUATE SPACE
         LW,8     1
         B        %+1
         LW,15    COCLOC,5
         LI,1     0
         LI,2     HRDTBL+1
         AW,2     5
         LI,6     LINELOC
         AW,6     5
         LI,4     0
LHRD     LW,9     L(X'80000000')
         MTB,0    *2,4
         BEZ      %+2
         STS,9    *8,1
         SLS,9    -1
         AI,4     1
         CW,4     LINELOC-HRDTBL-1,2
         BGE      %+5
         CI,4     32
         BNE      LHRD+1
         AI,1     1
         B        LHRD
         AI,1     1
         CI,1     1
         BAZ      %+2
         AI,1     1
         AI,1     -2                TEMP ADJUST TO GET LST ENTRY
         SLS,1    -1                CONVERT TO DW
         LW,4     *6                GET #LINES FOR THIS COC
         LD,10    *8,1              GET COD:HWL ENTRY
         SLD,10   -64,4             R SHIFT INDEX BY R4
         STD,10   *8,1              STORE COD:HWL ENTRY
         AI,6     #DYNAM
         SLS,1    1                 RESTORE TO WRDS
         AI,1     2                 SET TO NXT ENTRY
         AI,2     #DYNAM
         BDR,15   LHRD-1
         LW,9     COCLOC,5
         SLS,9    1
         AW,8     9
         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'
WRITE    AI,8     1
         LI,14    FILENAME
         BAL,11   WRITELM
         LW,D1    COCLOC,R5
         LI,D2    0
         LW,R4    R5
         AW,D2    RINGLOC,R5
         AI,R5    #DYNAM
         BDR,D1   %-2
         LW,R5    R4
         LI,R1    2
         LW,R6    POOLINFO          CALCULATE MPOOL AND CPOOL BUF SIZES
CALCBUFS LW,R7    *R6
         AI,R6    1
         MW,R7    *R6
         AI,R6    1
         AW,D2    R7
         BDR,R1   CALCBUFS
         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
         LW,R1    POOLINFO
         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'
         B        %+1
         AI,SR1   2
         AND,SR1  X1FFFE            INSURE DOUBLE WORD BOUND
         LCI      15                ****THIS SECTION GENERATES CLISTS******
         PSM,R1   *R0
         LI,R3    1
         LI,R4    1
         LW,D2    BUFINCR
         AI,D2    BUF               D2 NOW PTS TO CLIST-SIZE DATA
         LW,D3    D2
         AW,D3    BUFINCR           D3 NOW PTS TO SPECIAL CLIST DATA
         LW,D4    D3
         AW,D4    BUFINCR           D4 NOW PTS TO DCT4 TABLE
         LH,R1    *D2               GET LENGTH OF CLIST-SIZE DATA
         LW,R2    *D3               GET SIZE OF SPECIAL CLIST DATA
         AI,R2    1                 ZERO OUT LAST WORD OF 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
         LH,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
         BAL,SR3  MODGEN
TEXTCL#  TEXTC    'CL#011'          INITIAL VALUE GETS CHANGED EACH
         AW,SR1   R6                TIME THRU CLISTLUP
         B        %+1
         AI,R4    1
         CW,R4    R1
         BG       ENDCLIST          BRANCH WHEN ALL DONE
         LW,R6    R4
         PSW,R7   *R0               THIS SECTION COMPUTES THE EBCDIC
         LI,R5    1                 # FOR GENERATING THE CL#XX DEFS
         LI,R7    0
         SLD,R6   -4
         SCS,R7   4
CONVEBCD CI,R6    9
         BG       %+3
         AI,R6    X'F0'
         B        %+3
         AI,R6    -9
         AI,R6    X'C0'
         AI,R5    -1
         BNEZ     %+3
         XW,R6    R7
         B        CONVEBCD
         SLS,R7   8
         AW,R7    R6
         LI,R6    X'FFFF'
         AND,R6   TEXTCL#+1         UPDATE CL# DEF BY 1
         SLS,R7   16
         AW,R7    R6
         STW,R7   TEXTCL#+1
         PLW,R7   *R0
         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
         LH,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 AI,SR1   1
         AND,SR1  X1FFFE            DOUBLE WORD BOUND IT
         STW,SR1  TEMP
         LCI      15
         PLM,R1   *R0
         LW,SR1   TEMP
         BAL,SR3  MODGEN
         TEXTC    'CO:RINGA1'
         LW,D1    COCLOC,R5          GET NO. OF COC'S SPECIFIED
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
         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   2
         TEXTC    'RAS:CBP1'
         AI,SR3   1
DOKYINB  BAL,SR3  MODGEN
         AI,SR1   1
         AND,SR1  X1FFFE            DOUBLE WORD BOUND
         TEXTC    'KEYINBUF1'
         AI,8     19
         TEXTC    'IOHIGH1'
         LI,D3    FILENM
         BAL,SR4  WRITELM           WRITE M:IOMOD
READNXT  EQU      %
         LI,D1    -#DYNAM
         MSP,D1   *R0
         CW,R5    *R0
         BL       %-2
         B        READSTRG
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
         LH,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  DATA     0
TEMP     DATA     0
BUF      EQU      %
         RES      400
POOLINFO DATA     0
CLISTOT  DATA     0                 TOTAL SIZE OF CLIST INFO.
         END

