OPND:    EQU      %
         DEF      OPND:
         PCC      0
MONPROC  SET      1
         SYSTEM   UTS
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
         PAGE
         REF      ESTABBUF
         REF      Y004
         REF      DCT4
         REF      T:LDEV
         REF      DCT24
         REF      J:JIT
         REF      AVRTBLSIZ,BATAPE
         REF      M7
         REF      ANSFLGS
         REF      CHKANS0,MSRWRTX
         REF      MSR01EXIT
         REF      ERO,GETFUN
         PAGE
         REF      DCTSIZ,DCT1,DCT3
         REF      JB:PRIV
         REF      SNDDX,SSTAT,Y02,Y2
         REF      OPNSEG,RAT:DCT4
         REF      TYPMNSZ,OPNLD,OV:SIZ,TB:FLGS,OV:NMSZ,OH:NM
         REF      SV:RSIZ,SB:RTY,DHHIT,SPINS,JB:MAX,JB:CUR
         REF      INCGLOB,SETSPIN,OB:BTX,OB:GTX,OB:OTX,SB:LTY,XFF,M6
KA       EQU      X'A'
KB       EQU      X'B'
KF       EQU      X'F'
KFFFF    EQU      X'FFFF'
KF0      EQU      X'F0'
K0       EQU      0
K1       EQU      1
K1FFFF   EQU      X'1FFFF'
K10000   EQU      X'10000'
K2       EQU      2
K20200   EQU      X'20200'
K3       EQU      3
K8       EQU      8
K8000    EQU      X'8000'
OPENDEV  EQU      %
         DEF      OPENDEV
         LI,D1    0
         STW,D1   SND,R6
         STW,D1   NVA,R6            CLR REW INDICATOR
         LW,D2    Y2
         STS,D1   5,R6              ZERO DIAG CAL USE BIT
         LW,D1    DSI,R6
         CI,D1    K10000
         BANZ     OPD2              FIND OP LBL & SET UP TYPE & DEV
         CI,D1    X'8000'
         BAZ      OPD1              HAVE OP LBL INDEX, SO GET TYPE & DEV
         LI,R3    X'3F00'
         AND,R3   D1                TYPE CODE
         SLS,R3   -8
         CI,R3    TYPMNSZ-1         LEGAL TYPE CODE RANGE
         BG       OPNERAB           ERROR-TYPE CODE OUT OF RANGE
*                 USE DCTX IF CORRECT
         LW,R2    DSI,R6            DCTX
         AND,R2   XFF
         BEZ      KRD2
         CI,R2    DCTSIZ
         BG       KRD2
         CB,R3    DCT4,R2
         BNE      OPNERAB
         XW,R2    R3                2=TYPE  3=DCTX
         B        KRD12
OPD1     EQU      %
         LW,R1    Y004
         CW,R1    ASN,R6            FCI-DCB ALREADY CHECKED
         BANZ     OPNLD             YES-LATX PRESENT-COOP
         LC       J:JIT             IS THIS USER 'NON-COC'
         BCR,2    OPD11             NOPE
         LW,D1    M:UC+1            YES - GET PRIOR ASSIGNMENT OF M:UC
OPD11    LI,R3    X'FF'             MASK TO OBTAIN DEV INDEX
         AND,R3   D1                OP LABEL
         CI,R3    OV:SIZ            OP LABEL IN RANGE
         BG       OPNERAB           ERROR-OP LABEL OUT OF RANGE
         AI,R3    TYPMNSZ           MAKE OH:NM INDEX
         B        KRD2
OPD2     EQU      %
         CI,D1    X'8000'
         BAZ      OPD6              MUST BE DIAG OPEN
         CI,D1    X'4000'
         BANZ     OPD29
         B        OPNERAB
         PAGE
*
*        IF THE MC USER IS HERE - GIVE HIM THE CORRECT DCB SETUP
*
         SREF     RAS:DOL
OPN:RAS  EQU      %
         LW,R3    RAS:DOL           GET RAS DCTX
         AND,R3   XFF
         LB,R2    DCT4,R3           GET TYPE
         B        KRD12             GO GET EM
         PAGE
*  DIAGNOSTIC OPEN - FIELD IS DEVICE ADR
*  CONVERT TO TYPE & DCT INDEX
OPD6     EQU      %
         LB,4     JB:PRIV
         CI,4     X'A0'             DOES USER HAVE DIAG PRIV
         BGE      OPD22             YES
         LI,2     0                 NO - ERROR
         B        DIAGERR
OPD22    EQU      %
         CI,D1    X'4000'           OPLABLE SPECIFIED
         BAZ      OPD1              YES
         LI,3     DCTSIZ
         LI,D2    X'1FFF'           DEVICE ADDRESS FIELD
OPD23    EQU      %
         LH,D3    DCT1,3            FIND DEVICE ADR
         CS,D1    D3
         BE       OPD24             FOUND    3=DCT INDEX
         BDR,3    OPD23
         LI,2     1
         B        DIAGERR
OPD24    EQU      %
         LB,R2    DCT4,R3           TYPE CODE
         LB,D3    DCT24,3
         CI,D3    X'40'             IS DCT ALREADY DIAG(PREV.)
         BAZ      OPD25             NO
         LI,2     2                 YES - ERROR
         B        DIAGERR
OPD25    EQU      %
         MTW,0    BOOTFLG
         BNEZ     KRD12             DIAG OPEN O.K. FOR GHOST1
         REF      BOOTFLG
         LB,4     SNDDX             # OF SYMBIONT ENTRIES
         CB,3     SNDDX,4
         BE       OPD26             4=SYMB INDEX
         BDR,4    %-2
*    SINCE DEVICE IS NOT SYMBIONT THEN MUST BE MAG TAPE OR ERROR
         LC       TB:FLGS,R2        TAPE DEVICE
         BCR,8    %+2               ERROR-NOT TAPE
         BCR,4    OPD27             YES
         LI,2     1                 NOT SYMB OR TAPE - ERROR
         B        DIAGERR
OPD26    EQU      %
         LB,4     SSTAT,4
         CI,4     1                 IS SYMB STOLL ACTIVE
         BAZ      OPD27             NO
         LI,2     3                 YES - ERROR
         B        DIAGERR
OPD27    EQU      %
         AI,D3    X'40'             SET DIAG USE BIT (PREV.)
         STB,D3   DCT24,3             INTO DCT
         LW,D2    Y2
         STS,D2   5,6                 & INTO DCB
         B        KRD12
OPD29    EQU      %
         LI,D2    X'FFFF'
CNM      EQU      1                 TEMP CARD ****************
         DO       CNM
         REF      LNDEVCD,CNMLNDCB,CNMPROC9#,TQOV2SEG
         REF      MODE5,DCT23,T:IACU,INUSEL
         REF      ADR:LIST,ADR:LNID
         SREF     MOCIOP
         REF      ADDRMASK,OPNBIT,KILLIO
*
*
         LI,D3    LNDEVCD           GET OP LABEL CODE FOR CNM SLAVE LN
         CS,D1    D3                SEE IF WE ARE DEALING W/SLAVE LN
         BNE      OPD30             B, IF NOT; CK TEXT TABLES
         LW,R3    ADDRMASK
         AND,R3   ADR:LNID,R6       LOOK FOR LINE ID ADR SPECIFICATION
         BNEZ     %+3               WE BETTER HAVE ONE
LNIDERR  EQU      %
         LW,SR3   LNERR03           ELSE LOAD ERR CODE
         B        OERX              AND TAKE ERR EXIT
         OVERLAY  TQOV2SEG,CNMPROC9# CONVERT LINE ID TO DCTX OR LINE#
         LI,D2    X'FF00'           MASK FOR RNDEV STORE LATER
         LW,R3    S:CUN             GET CURRENT USER# FOR LATER
         LW,R2    D1                MOVE DCTX OR LN# TO INDEX REG
         BEZ      LNIDERR           SOMETHING WRONG W/LINE ID
         BLZ      SETRNDEV          (D1) NEG MEANS LN#
         LI,SR3   MOCIOP            CK FOR PRESENCE OF MOC I/O PREP CODE
         BNEZ     %+3               B, IF IT'S PRESENT
         LW,SR3   LNERR20           ELSE, LOAD ERROR CODE
         B        OERX              TAKE ERR EXIT
         LW,R7    ADDRMASK
         AND,R7   ADR:LIST,R6       LOOK FOR LIST ADR IN DCB
         BNEZ     %+3               B IF WE HAVE ONE
LISTERR  EQU      %
         LW,SR3   LNERR04           IT'S AN ERROR IF WE DON'T
         B        OERX              SO TAKE ERROR EXIT
         SCS,R7   -9                ADJUST FOR INPUT; SAVE PG OFFSET
         BAL,SR4  T:IACU            GET PG#'S ACCESS CODE
         BCS,2    LISTERR           ERR, IF AC=2 OR 3
         BCR,1    LISTERR           ERR, IF AC=0; IE., IT MUST = 1
         SCS,R7   9                 REUNITE PG# & PG OFFSET
         LW,D4    INUSEL            GET POL/SEL LIST'S IN USE BIT MASK
         CS,D4    0,R7              SEE IF THIS LINE IS ALREADY IN USE
         BNE      %+3               B, IF NOT
         LW,SR3   LNERR08           IT'S AN ERROR IF IT IS
         B        OERX              SO TAKE ERR EXIT
         LH,D3    DCT23,R2          GET CNM LN SWITCHES
         LI,R4    2
         CB,R3    D3,R4             CK IF USER OWNS THIS MULTI-PNT LN
         BNE      LNCNFLCT          IT'S AN ERROR IF HE DOESN'T
         OR,D3    OPNBIT            SET DCB OPEN BIT
         STH,D3   DCT23,R2          RESTORE CNM LN SWITCHES
         LI,D1    0                 SET RNDEV = 0 FOR MOC LN
         STS,D1   RNDEV,R6          TO DISTINGUISH FROM LN#(+1)
         STS,D4   0,R7              SET POL/SEL LIST'S IN USE FLAG
         B        SETLNBIT          GO SET CNM SLAVE LN BIT IN DCB
SETRNDEV EQU      %
         AI,R2    -1                CNMPROC9 ADDED 1 TO INSURE NON-0
         CB,R3    LB:UN,R2          DOES USER OWN THIS BI-PNT LN
         BE       %+3               B, IF HE DOES
LNCNFLCT EQU      %
         LW,SR3   LNERR01           IT'S AN ERROR IF HE DOESN'T
         B        OERX
         BAL,SR4  KILLIO            CLEAN UP LINE'S BUFFERS
         SLS,D1   8                 ADJUST LINE#+1 VALUE FOR RNDEV STORE
         STS,D1   RNDEV,R6          SAVE LINE#+1 FOR COC SLAVE LN HANDLER
         LB,D1    MODE5,R2          GET CNM LN SWITCHES
         OR,D1    OPNBIT            SET DCB OPEN BIT
         STB,D1   MODE5,R2          RESTORE CNM LN SWITCHES
         AI,R2    X'1000'           ****TEMP CARD; HARD CODE COC TYPE CODE
*
SETLNBIT EQU      %
         LI,D1    3                 SET FUN = IN & OUT
         LW,R3    CNMLNDCB          GET MASK FOR CNM LINE DCB
         STS,R3   0,R6              SET BIT TO INDICATE SLAVE LINE
         AI,R2    X'8000'           SET DEVF BIT IN DCB
         LI,R3    X'FFFF'
         STS,R2   DSI,R6            SET TYPE & DEV FIELDS
         B        SETFUN            GO SET DCB'S FUN BITS
LNERR01  DATA     X'0C000032'       ATTEMPT TO OPEN UNOWNED LINE
LNERR03  DATA     X'0A000032'       UNABLE TO INIT LINE; BAD LN ID
LNERR04  DATA     X'08000032'       BAD LIST ADDRESS
LNERR08  DATA     X'06000032'       POL/SEL LIST ALREADY IN USE
LNERR20  DATA     X'12000032'       MOCIOP MODULE NOT IN THIS SYSTEM
         FIN
*
*
OPD30    EQU      %
         LI,R3    OV:NMSZ           #ENTRIES IN OH:NM+SH:OPNM+SH:LNM
KRD1     LH,D3    OH:NM,R3          TEXT NAME
         CS,D1    D3                VALID TEXT NAME
         BE       KRD6              YES
         AI,R3    -1
         BGEZ     KRD1              SEARCH ENTIRE NAME TABLE
         B        OPNERAB           ERROR-TEXT NAME NOT FOUND
KRD6     CI,R3    TYPMNSZ+OV:SIZ    LOGICAL RESOURCE INDICATED
         BLE      KRD2              NO
         AI,R3    -TYPMNSZ-OV:SIZ-1 CHANGE TO A LATX
KRD4     LB,R2    SB:LTY,R3         DEVICE TYPE
         AI,R3    DCTSIZ+1+SV:RSIZ+1 MAKE BIG LATX
         B        KRD9
KRD2     LB,R1    J:JIT
         SLS,R1   -6                0=BATCH,1=GHOST,2=ONLINE
         EXU      XTX,R1            DCTX,RATX,LATX
         CI,R3    DCTSIZ            DCT INDEX
         BG       KRD11             NO-RATX OR LATX
         LB,R2    DCT4,R3           YES-GET TYPE CODE
         B        KRD12
KRD11    AI,3     -DCTSIZ-1
         CI,R3    SV:RSIZ           RATX OBTAINED
         BLE      KRD3              YES
         AI,3     -SV:RSIZ-1
         B        KRD4
KRD3     LB,R2    SB:RTY,R3         DEVICE TYPE
         LI,3     0                 RAT=0
KRD12    AI,3     X'8000'
KRD9     LB,R1    TB:FLGS,R2        DEVICE TYPE FLAGS
         SLS,R2   8
         AW,R2    R3                TYPE,DCTX/0=RATX/LATX
         SLS,R1   -6
         CI,R1    1                 LISTING TYPE DEVICE
         BNE      %+3               NO
         AI,R2    X'4000'           YES-SET 'L' BIT
         B        KRD8
         LI,R3    X'1BFFF'          DO NOT CHANGE 'L' BIT
         CI,D1    X'10000'          'L' BIT PRESENT
         BAZ      %+2               YES
KRD8     LI,R3    X'1FFFF'          NO
         STS,R2   DSI,R6            INTO DCB
         LW,R3    Y004
         STS,R3   ASN,R6            SET FCI BIT DCB HAS BEEN USED
*                                   R1-RATX
*                                   R2-DCTX
*                                   R3-TYPE CODE
         LI,R3    BADSI
         LB,R1    *R6,R3            RATX/LATX PRESENT
         CI,R2    X'8000'           RATX PRESENT
         BAZ      OPNLD             LAT
*   DSI=0-RAT,NOT ZERO=DCT   R1=DSI
         AND,R2   XFF               DCTX
         LI,3     BADEVTP
         LB,3     *6,3
         AND,R3   M6                TYPE CODE
         BEZ      NONTAPE           B/'NO' DEVICE SET MODE BITS
         LC       TB:FLGS,3
         BCR,3    OPNERAB           ---NOT ALLOCATABLE
         BCR,8    NOTT              NOT TAPE
*                 ALLOW DEVICE PACK   ALSO
         LB,2     JB:PRIV
         CI,2     X'C0'
         BCS,4    OPNERAB
         OVERTO   OPNTPSEG,OPNT#
         REF      OPNTPSEG,OPNT#
NOTT     AI,1     0
         BNEZ     NONTAPE           DCT SPECIVIED
* TRY TO ALLOCATE IT
         LI,12    0                 PARTITIONED FLAG
         LI,R2    DCTSIZ
NXTY     CB,R3    DCT4,R2           DEVELOP DCTX BY MATCHING TYPE
         BE       NXTYC             DCTX FOUND IN R2
NXTYL    BDR,2    NXTY
         LW,1     13                RESTORE RESOURCE INDEX
         LW,2     12                RESTORE DCT INDEX
         BNEZ     KRD5X       YES-- FIND A PART.DEVICE
         B        KRD10       NO---
KRD10X   EQU      %
         CI,12    0
         BNEZ     *11         YES-- RETURN, PART.DEV.FOUND
*                             NO---
KRD10    LW,SR3   =X'02000049'
OERX     EQU      %
         DEF      OERX
         LI,11    MSR01EXIT
         B        T:SELFDESTRUCT
NXTYC    BAL,SR4  DHHIT             DOES HE HAVE IT    (0,4)
         BANZ     SETDSI            YES - SET DSI
         BAL,11   SPINS             CAN HE HAVE IT (0 FROM DHHIT)
         BANZ     NXTYL             NO
*                                   AUTHORIZED
         BAL,SR4  RAT:DCT4          GET RATX IN (R1) (4)
         B        KRD10             ERROR-CANT MATCH DCT4
         LB,SR4   JB:MAX,R1         MAX JOB CAN HAVE
         BEZ      KRD7              NOT  AUTH  -ERR
         CB,SR4   JB:CUR,R1         CAN JOB HAVE ONE MORE
         BG       KRD5              YES
KRD7     LW,SR3   =X'04000049'      NO-EXCEEDED MAX AUTH.
         B        OERX              ABN 49 SUB 02
KRD5     EQU      %
         LB,11    DCT3,R2
         CI,11    X'20'
         BAZ      KRD5X       NO--- DEVICE PARTITIONED
         CI,12    0           YES--
         BNE      NXTYL       YES-- FOUND PART.DEV.ALREADY
         LW,13    1           NO--- SAVE RESOURCE INDEX
         LW,12    2                 SAVE DCT INDEX
         B        NXTYL
KRD5X    EQU      %
         BAL,SR4  INCGLOB           INCREMENT GLOBAL 0,8
         BAL,11   KRD10X            OVER ALLOCATED-(GHOST/ON-LINE)
*                                   OK
         MTB,1    JB:CUR,1          INC USE COUNT
         BAL,11   SETSPIN           SET J:ASPIN (R0,R4,D3,D4) AND ASPIN
*                                   STORE TYPE AND DCTX
SETDSI   RES      0
         LI,1     BADSI
         STB,2    *6,1              DCTX TO DSI
NONTAPE  RES      0
         LB,D1    DCT3,R2
         REF      YFF
         LW,D2    YFF
         STS,D1   COS,R6            CLR COS TO INDICATE NOT-TAPE
         SLS,D1   -6
SETFUN   EQU      %
         LI,D2    X'F'
         SLD,D1   17
         STS,D1   FUN,R6            SET FUNCTION IN DCB
*
*        LOGIC TO SET LINE # INTO M:UC DCB
*
         SREF     LNOL,LB:UN
         REF      S:CUN,M:UC
         LC       J:JIT
         BCR,8    NOTOL             NOT ON LINE
         BCS,2    NOTOL             NOT A COC USER AT ALL....
         CI,6     M:UC
         BNE      NOTOL             NOT M:UC DCB
         LW,12    S:CUN
         LI,2     LNOL-1
LINLOOP  CB,12    LB:UN,2
         BE       %+2
         BDR,2    LINLOOP
         LI,3     7
         STB,2    *6,3
NOTOL    EQU      %
NODEV    B        SETOPNA
*
XTX      LB,R3    OB:BTX,R3         BATCH
         LB,R3    OB:GTX,R3         GHOST
         LB,R3    OB:OTX,R3         ONLINE
OPNERAB  EQU      %
         LW,SR3   =X'0A000014'
         B        OERX
DIAGERR  EQU      %
         LI,3     X'FF'
         STS,2    J:JIT+ERO         SET SUB CODE
         LW,SR3   2
         SCS,SR3  -7
         AI,SR3   X'09'
         B        OERX
                  PAGE
         SPACE    3
SETOPNA  BAL,R0   SETOPN            SET OPEN,RESET TYC
         LI,D2    X'F0000'
         STS,D1   20,R6             CLR CMD
         LW,D2    Y02               RESET
         STS,D1   TRN,R6             TRN BIT
         LI,D2    K10000
         CW,D2    EXT,R6
         BAZ      OPNX
         REF      PEOF#,MISOVSEG
         OVERTO   MISOVSEG,PEOF#
         SPACE    3
OPNX     EQU      %
         DEF      OPNX
         LI,R1    BADSI
         LB,R1    *R6,R1
         AI,R1    -BATAPE
         BLZ      OPNX1
         CI,R1    AVRTBLSIZ
         BGE      OPNX1
         LB,R4    ANSFLGS,R1
         AND,R4   M7
         BAL,R0   CHKANS0
         AI,R4    X'80'
         STB,R4   ANSFLGS,R1
OPNX1    EQU      %
         LI,11    MSRWRTX
         B        T:SELFDESTRUCT
SETOPN   LW,D1    Y002
         LW,D2    Y002C3
         STS,D1   FCD,R6
         B        SETTYC
Y002C3   DATA     X'002C3000'
         REF      SETTYC,Y002
*
         END

