*
*
*M*      IOD       IOSDEV - IO SERVICE M:DEVICE CAL PROCESSOR
*
*
*P*      NAME:     IOD
*,*
*,*      PURPOSE:            THE CAL PROCESSOR FOR ALL M:DEVICE
*,*           CAL1,1'S  AS FOLLOWS:
*,*
*,*      M:DEVICE  COUNT            (FPT CODE:   .24  )
*,*                DATA                          .23
*,*                FORM                          .21
*,*                HEADER                        .26
*,*                LINES                         .20
*,*                SIZE                          .22
*,*                TABS                          .28
*,*                SEQUENCE                      .27
*,*                SPACE                         .25
*,*                PAGE                          .04
*,*                VFC/NOVFC                     .05
*,*                DRC/NODRC/FBCD/ETC.           .0B
*,*                NLINES                        .2A
*,*                CORRES                        .2B
*,*
*,*
*,*      METHOD:             M:DEVICE TO M:OC IS IGNORED.  THE DCB
*,*           IS OPENED IF NECESSARY.  THE FPT IS PARSED.  VALUES ARE
*,*           MOVED TO THE DCB.  AN M:LDEV IS SIMULATED ON THE
*,*           COOP-CONTEXT-BLOCK IF NEXESSARY.  ANY IMPLIED OUTPUT
*,*           IS PRODUCED VIA WRTD.  IOD THEN EXITS DIRECTLY VIA SR4
*,*           OR THROUGH MSRWRTX AS APPROPRIATE.
*,*
*,*
         DEF      IOD:              PATCHING DEF
IOD:     RES
BITS     SET      1                 GET DEFINITIONS OF XN,YN,MN.
MONPROC  SET      1                 GET MONITOR-INTERNAL PROCS.
         SYSTEM   UTS
         PAGE
         BOUND    8
K11      EQU      X'11'
K200     EQU      X'200'
K7       EQU      X'7'
K0       EQU      X'0'
K3       EQU      X'3'
K6       EQU      X'6'
K4000    EQU      X'4000'
K100     EQU      X'100'
K8000    EQU      X'8000'
K10000   EQU      X'10000'
K1FFFF   EQU      X'1FFFF'
ENCRYPT  EQU      16                DCB LOC FOR ENCRYPT KEY ADDRESS
         PAGE
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     IOD DEFS
         DEF      IOSDEV            * MAIN ENTRY POINT FOR ALL
*,*                                 * M:DEVICE CAL1,1'S.
         PAGE     IOD REFS
         REF      GETASN            * GET DCB ASN FIELD ROUTINE
*,*                                 * ASN IS WORD 0 BITS 30 AND 31 (3=>DEVICE).
         REF      DOUBLEONE         * =X'1',X'1' DBLWRD DATA INPUT
         REF      GETDEV            * GET DEVICE ROUTINE(DECODES DCB WORD 1)
*,*                                 * DCB WORD 1 IS DEVF,L,TYPE,(DEV/OPLB)
         REF      MSRWRTX           * MONITOR SERVICE WRITE EXIT POINT.
*,*                                 * COMMON EXIT AFTER DEVICE WRITE.
         REF      SAVRSZ            * SET RSZ FIELD IN DCB ROUTINE.
         REF      OPNSEG            * MONITOR OVERLAY VALUE FOR GOING
*,*                                 * TO M:OPEN INTERNALLY.
         REF      PULLALLEXIT       * EXIT ROUTINE TO RESTORE PUSHALL ENVIRON.
*,*                * STACK IS REWOUND TO PUSHALL ENV. R5->SR4 PULLED,SR1,SR3 SET
         REF      DOUBLEZERO        * =0,0 DBLWRD OF ZEROES INPUT
         REF      PUSHALL           * R5-SR4 TO TSTACK AND A STACK MARKER,
*,*                                 * TO LOCATE FOR TSTACK REWIND.
         REF      INTCHR            * WRTD ROUTINE TO INTERPRET VFC AND
*,*                                 * DO PAGE COUNTING,ACCOUNTING AND HDRS.
         REF      TOFMESS           * =C'1   '  TOP-OF-FORM MESSAGE.
         REF      Y06               * =X'06000000' WRITE W/VFC FCN CODE.
         REF      MODEFRM           * ENCODE SR1 BYTE 0 FROM DCB BY
*,*                                 * CHECKING MODE,DRC,VFC ETC FLAGS.
         REF      X1FFFF            * =X'0001FFFF' STANDARD 17 BIT ADDRESS MASK.
         REF      MSRRDWT1          * MONITOR SERVICE READ-WRITE ROUTINE,
*,*                                 * SPECIAL  ENTRY POINT.
         REF      J:USCDX           * VIRTUAL CNTXT   POINTER IN JIT
*,*                                 * ALSO INDICATES COOP PAGES ARE THERE.
         REF      J:BASE            * CAL PROCESSING TEMP AREA
*,*                                 * (SEE WRTD FOR DESCRIPTION).
         REF      MULSEG            * MONITOR OVERLAY VALUE FOR PATH
*,*                                 * TO OPNLD ROUTINES.
         REF      MSRTYPR           * ROUTINE USED FOR FAKE INTERNAL M:KEYIN.
         REF      COPOLDI           * SPECIAL ROUTINE FOR INTERNAL OPEN
*,*                                 * OF CLOSED CNTXT W/OPEN DCB.
         REF      J:ASSIGN          * Y4 BIT SAYS DONT CHK BUFFERS.
         REF      IOGETBF           * GET AN MPOOL BUFFER ROUTINE.
*,*                                 * IN WRTD TO CENTRALIZE CAL MPOOL USAGE.
         REF      RMB               * RELEASE AN MPOOL ROUTINE(R14 IS MPOOL ADDR
         REF      BLANK             * =C'    ' FOR BLANK PADDING VIA AN MBS.
         REF      SCMAXR            * STREAM MAX REC SIZE CNTXT DISP
         REF      SCMINR            * CNTXT DISP STREAM LINES PER PAGE
         REF      SCLINES           * CNTXT DISP STREAM LINE COUNT
         REF      SCDEVTYP          * CNTXT DISP STREAM TYPE & FLAGS
         REF      SCFORM            * CNTXT DISP TO FORM NAME CELL.
         REF      SCFFORM           * CNTXT DISP TO FUTURE FORM CELL.
*,*                                 * FFORM IS ONLY USED FOR M:DEVICE FORM OLD.
         REF      SH:LNM            * TABLE OF STREAM NAMES INDEXED BY
*,*                                 * CNTXT NUMBER USED FOR FAKE INTERNAL M:LDEV
         REF      MSRLP78           * PATH THRU WRTD TO COOP FOR TOP.
BASCFLG2 EQU      SCDEVTYP+SCDEVTYP+SCDEVTYP+SCDEVTYP+2
         REF      MISOVSEG          * MONITOR VALUE FOR PATH TO MISOV MODULE.
         REF      MSRKEY#           * ENTRY INDEX USED FOR PATH TO
*,*                                 * M:KEYIN(INTERNAL FAKE USAGE).
         REF      YF                * =X'F0000000'
         REF      S:CUN             * CURRENT USER NUMBER(CELL INPUT)
         REF      UH:FLG            * USER FLAGS
         PAGE     IOSDEV
*                                   THIS ROUTINE SETS UP DEVICE DEPENDNT
*                                   OPTIONS
*                                   R6 = DCB ADDRESS
*                                   R7 = PARAMETER LIST POINTER
*                                   SR1 =OPCODE
*                                   CALLING SEQUENCE--BAL,SR4  IOSDEV
IOSDEV   EQU      %
*                                   ANALYZE OPCODE
*                                   DCB MUST NOT BE ASSIGNED TO FILE
         CI,SR1   K6                ALWYS PERFORM SETDCB OPTION
         BE       SETDCB
         LI,R1    KNDEVOP           NUMBER OF DEVICE OPTIONS
IOSDEV2  CB,SR1   IOTBL,R1          FIND OPCODE
         BE       TSTDEV1
         BDR,R1   IOSDEV2
         B        IOSDEVX           COUNDNT FIND--OUT
*
IOTBL    DATA     X'00242321',X'26202228',X'27250405',X'0B2A2B00'
KNDEVOP  EQU      14
TOFCHAR  EQU      X'F1'
BLNK     EQU      X'40'
SGV      EQU      5
SIG      EQU      5
*
IOTBL1   EQU      %-1
         B        IOCOUNT
         B        IODATA
         B        IOFORM
         B        IOHEAD
         B        IOLINE
         B        IOMODE
         B        IOTAB
         B        IOSEQUENCE
         B        IOSPACE
         B        IOPAGE
         B        IOVFC
         B        IOSPDIR
         B        IONLINES          NO. LINES REMAINING
         B        IOCORRES          DCB CORRESPONDENCE
*
IOCOUNT  EQU      %                 HANDLE COUNT OPTION
         LI,R2    K0                CLEAR COUNT
         LI,R3    K1FFFF
         STS,R2   CVA,R6
         LI,R3    BACSC
IOSDEVX1 EQU      %
         BAL,R1   JHKBIT1
         STB,R2   *R6,R3
         B        IOSDEVX
*
IODATA   EQU      %                 HANDLE DATA OPTION
         LI,R3    BADSC
         B        IOSDEVX1
*
*
IOFORM   EQU      %                 HANDLE CHANGE FORM OPTION.
         BAL,SR2  TESTOPN             OPEN DCB & STREAM IF NECESSARY.
         B        MSRWRTX           --->NON-DEVICE DCB. FORGET IT.
         B        MSRWRTX           --->NON-SYMBIONT DCB. FORGET IT.
         LI,R1    BASCFLG2          * DISP TO TYPE INFO
         LC       *J:BASE+3,R1      * CC = TYP,TYP,IN,OUT
         BCS,8    MSRWRTX           * NOT UNIT RECORD
         BCR,1    MSRWRTX           * OUTPUT ILLEGAL
         LW,D4    SCFFORM,R5
         BNEZ     IOFRM2            USE IT FOR FORM NAME
         LW,D4    Y4                IS FORM OPTION
         CW,D4    1,R7              PRESENT IN FPT
         BAZ      IOFRM1            NO: ASK OPERATOR
         BAL,R1   JHKBIT1           YES: SKIP MESSAGE OPTN
         B        %+1               IF PRESENT
         LW,D4    0,R7              FETCH FORM NAME
         B        IOFRM2
*
*        SINCE FFORM IN CNTXT BLK NULL & FORM OPTN NOT SPECIFIED,
*        SEND FORMS MESSAGE TO OPERATOR & USE HIS RESPONSE
*        FOR NEW FORM NAME.
*
IOFRM1   BAL,SR4  FKYIN
         AI,15    0                 NO OP RESPONSE
         BNEZ     IOFRM2            WAS ONE SET FORM
         LW,5     J:BASE+3          GET CXT
         CW,15    SCFORM,5          ALREADY DEFAULT
         BE       MSRWRTX           YES DONT SCLS
*
*        FORM FOR NEW STREAM IN D4 AT THIS POINT...
*        USE IT IN FAKE LDEV CAL TO CLOSE CURRENT
*        STREAM WITH ASAVE.
*
IOFRM2   LW,R5    J:BASE+3          RETRIEVE CNTXT BLK BASE
         LW,R2    0,R5              AND LDEV INDEX
         LH,D3    SH:LNM,R2         STREAM ID
         AND,D3   M16
         LW,D2    LDVPLST1          PARAM. PRESENCE FLGS
         LW,R7    TSTACK
         AI,R7    1                 ADDR OF PLIST+1
         PUSH     3,13
         LI,D4    0
         STW,D4   SCFFORM,R5
         OVERLAY  MULSEG,4
*
*        WE NOW HAVE A NEW STREAM WITH ATTRIBUTES THE
*        SAME AS BEFORE EXCEPT FOR FORM & FFORM(NULL)
         PULL     3,13              STRAIGHTEN STACK
         B        MSRWRTX           AND LEAVE
*
*        SERVICE CAL FOR NON-SYMBIONT DEVICE...
*        ISSUE KEYIN, GET OPERATOR RESPONSE AND CONTINUE...
*
         BAL,SR4  FKYIN
         B        MSRWRTX
*
*
*  ROUTINE TO HANDLE FAKE M:KEYIN FOR DEVICE(FORMS)
*
FKYIN    EQU      %
         LW,D4    Y8                DOES PLIST CONTAIN
         CW,D4    1,R7              FORMS MESSAGE
         BAZ      MSRWRTX           N0: NOP THIS CAL
         PUSH     SR4
         AI,R7    1                 POINT TO PLIST+1
         LI,SR1   2
         BAL,SR4  MSRTYPR           TYPE MESSAGE
         BAL,SR4  IOGETBF           GET MONBUF(ADDR IN D3)
FKYINR   EQU      %
         LD,R0    FRMMSG
         STD,R0   *D3
         LW,R2    S:CUN
         LH,R3    UH:FLG,R2         SAVE USER FLAGS
         PUSH     R3
         OR,R3    BT31TO0+13        SET SPEC. JIT ACCESS
         STH,R3   UH:FLG,R2         TO SKIP BUFFER CHECKS
         LW,SR3   YF                *SR3=PARAM PRESENCE BITS
         LW,SR4   D3                *SR4=MESSAGE ADDR
         LW,D1    D3
         AI,D1    3                 *D1 = REPLY ADDR
         AI,D3    2                 *D3 =ECB ADDRESS
         SLS,D2   1
         STW,D2   *D3                SET BIT 0 IN ECB
         LI,D2    5                 *D2 =MAX BYTE COUNT OF REPLY
         LW,R7    TSTACK
         AI,R7    1                 *R7 =PLIST+1
         PUSH     5,SR3
         OVERLAY  MISOVSEG,MSRKEY#
         PULL     6,R3
         LW,R2    S:CUN
         STH,R3   UH:FLG,R2         RESTORE USER FLAGS
         MTB,0    *SR1              WAIT TIL ECB IS POSTED
         BNEZ     %-1
         LW,D3    R5                SAVE BUF ADDR FOR RMB
         LI,R0    X'40'
         LB,D4    *R6
         BEZ      FKYINR
         AI,15    -1                GET RID OF CR
         BGZ      %+3               IF THAT WAS ALL OR NOTHING
         LI,15    0                 SET FORM NAME TO ZERO
         B        FKYINN            AND SKIP MOVE
         CI,D4    4
         BLE      %+2
         LI,D4    4
         LI,R7    15                MOVE
         SLD,R6   2                 REPLY
         AI,R6    1
         STB,D4   R7                TO
         LW,D4    BLANK             BLANK-FILLED
         MBS,6    0                 REGISTER 15
FKYINN   EQU      %
         BAL,SR4  RMB               RELEASE MBUF
         PULL     SR4
         B        *SR4
         BOUND    8
FRMMSG   TEXTC    'FORM: '
LDVPLST1 DATA     X'80100010'
*
IOHEAD   EQU      %                 HANDLE HEADER OPTION
         BAL,R1   JHKBIT3
         STS,R2   HLC,R6
         LI,R3    BAHSC
         LI,R1    1                 DEFAULT TAB IS 1
         STB,R1   *R6,R3
         REF      JHKBIT            * HELPER ROUTINE FOR PARSING FPT'S
*,*                                 * GETS NEXT PARAM OR SKIPS IF EMPTY.
         REF      JHKBIT1           * 1ST TIME ENTRY TO FPT PARSE HELPER.
         REF      JHKBIT3           * NUTHER ENTRY TO FPT PARSE HELPER.
         LI,R1    IOSDEVX1+1
         B        JHKBIT
*
IOLINE   EQU      %                 SET NUMBER OF LINES PER PAGE
         BAL,R1   JHKBIT3
         SLD,R2   17
         STS,R2   LVA,R6
         B        IOSDEVX
*
IOMODE   EQU      %
         LW,R2    1,R7              SET MODE BIT
         LI,R3    16
         SLD,R2   13
         STS,R2   MOD,R6
         SLS,R2   -4                FORTRAN CONVERSION
         LI,R3    K4000
         STS,R2   FCON,R6
*
         SLS,R2   -6
         LI,R3    K200
         EOR,R2   %-1               DEFAULT IS PACKED
         STS,R2   PCK,R6
IOMODE1  EQU      %
         BAL,R1   JHKBIT1
         B        %+2
         B        IOSDEVX
         LI,R0    IOSDEVX
         LW,D1    R2
         B        SAVRSZ
         PAGE
IOPAGE   EQU      %                 HANDLE PAGE EJECT OPTION.
         LI,SR1   X'1FFFF'
         AND,SR1  R6                SR1= DCB ADDRESS.
         BAL,SR2  TESTOPN             OPEN DCB & STREAM IF NECESSARY.
         B        IOPGE2            --->NON-DEVICE DCB. D2=ASN.
         B        IOPGE19           --->NON-SYMBIONT DCB. R5=0.
         OR,SR1   Y06                 SYMBIONT DCB.  SET WRITE & VFC.
         LI,R1    BASCFLG2          * DEVICE TYPE DESCRIPTION:
         LC       *R5,R1            * CC = TYP,TYP,IN,OUT.
         BCR,12   IOPGE2A           ---> NOT TDL(TAPE/DISC/LIST)
         BCR,8    IOPGE1            ---> L(LISTING DEVICE)
         EOR,SR1  Y02                 TURN OFF VFC BIT.
IOPGE09  EQU      %                 * COC REJOINS
         BAL,SR4  MODEFRM                                               716
         B        %+1                                                   716
IOPGE1   EQU      %
         LW,D3    SCLINES,R5        * STREAM CURR LINE COUNT
         LI,R1    K10000
         CI,D3    1
         BG       %+3
*
         CW,R1    TOF,R6
         BANZ     MSRWRTX
         STS,R1   TOF,R6
         LI,D3    TOFCHAR
         BAL,R4   INTCHR
         CI,D3    BLNK
         BNE      IOPGE18           * INTCHR PASSED ON TOP OR TOF
*
         MTW,-1   SCLINES,R5        * ONE LESS LINE THIS PAGE
         B        MSRWRTX
IOPGE18  EQU      %                 *
         LW,D4    D3                * SAVE VFC CHAR TO USE
         BAL,SR4  IOGETBF           * GET A BUFFER FOR THE LINE
         STB,D4   *D3               * PLANT THE VFC
         LI,R2    1                 * (BYTE COUNT IS 1 OF COURSE)
         B        MSRLP78           * GO DOIT.........
*
*        NOT STREAM BUT IS IT TAPE COC OR OTHER
IOPGE19  EQU      %                 *
         LI,R2    BADEVTP           * DISP TO DCB DEV TYPE BYTE
         LB,R2    *R6,R2            * FETCH IT UP
         OR,SR1   Y04               *  (SET VFC -BY THE WAY)
         CI,R2    X'90'             * IS IT 'METYPE'(X'10'+DEVF X'80')
         BE       IOPGE09           * YES, REJOIN.
         BAL,D4   GETDEV            * NO, BUT IS IT 'NO'?
         BEZ      MSRWRTX           * YES. QUIT NOW.
         BAL,SR4  IOGETBF           * NO.  GET A BUFFER.
         LW,R0    TOFMESS           *
         STW,R0   *D3               * PUT IN TOF LINE.
         LI,SR4   1                 *
         LI,R2    CLK+CLK           * LINE COUNT SHOULD BE RESET
         STH,SR4  *R6,R2            * TO 1.
         LI,R2    4                 *  (SIZE OF TOFMESS)
         B        MSRLP78           * GO PRINT IT.
*
*  NOT-DEVICE DCB.  D2=ASN.
IOPGE2   EQU      %
         CI,D2    4
         BE       MSRWRTX           --->JRNL DCB. DO NOTHING.
IOPGE2A  EQU      %                   PUNCH SYMBIONT MERGES HERE.
         LI,R7    TOFPLIST-1        R7 =>FPT. (WRITE '1   ')
         LI,SR1   X'11'             SR1= FPT CODE (M:WRITE)
         LW,R1    Y4
         STS,R1   J:ASSIGN            <DON'T CHECK BUFFER>
         B        MSRRDWT1          ---> GO WRITE TOF LINE.
*                                                                       716
*                                                                       716
TOFPLIST EQU      %                                                     716
         GEN,8,24  X'34',0                                              716
         DATA     TOFMESS                                               716
         DATA     4                                                     716
         DATA     0                                                     716
IOSEQUENCE  EQU   %
         LW,R3    Y08               SET SEQUENCE OPTION
         STS,R3   SGV,R6
         LI,R2    K0                CLEAR CURRENT SEQUENCE
         LI,R3    K1FFFF
         STS,R2   SQS,R6
         LW,R2    1,R7
         SLS,R2   -5
         LW,R3    Y04
         STS,R2   SIG,R6            SAVE POSSIBLE SEQUENCE ID
         LW,R3    2,R7
         STW,R3   SID,R6
         B        IOSDEVX
*
*
IOSPACE  EQU      %                 HANDLE SPACE AND FIRST OPTIONS
         LI,R3    X'7F'
         BAL,R1   JHKBIT1
         B        %+1
         SLD,R2   17
         STS,R2   SVA,R6
         BAL,R1   JHKBIT
         B        %+2
         B        IOSDEVX
         SLS,R2   17
         STS,R2   FVA,R6
         B        IOSDEVX
*
IOTAB    EQU      %                 SET TABS--FIRST BYTE OF TABS = NO.
*                                   OF TABS  (BETWEEN 1 AND 16)
         AI,7     2
         LW,1     0,7
         BGEZ     IOTAB3
         CI,1     X'1FFF0'
         BANZ     IOTAB2
         AW,1     J:BASE
*                 CAL1 CONVENIENTLY PLANTED REGISTER ADDRESS
IOTAB2   LW,7     1
IOTAB3   RES      0
         LI,R2    K0
         LB,R1    *R7
         BEZ      IOSDEVX
         LI,R5    X'FF'             * STREAM NUM WIDTH
         AND,R5   CLK,R6            * STREAM NUMBER
         BEZ      IOTAB4            * ASSUMED MAX
         BAL,R3   CNTXTCHK          GO CHECK CONTEXT
         LW,R5    SCMAXR,R5         * STREAM MAX REC. SIZE
         B        IOTAB4+1          * SKIP DEFAULTING
IOTAB4   LI,R5    GMBSIZ+GMBSIZ+GMBSIZ+GMBSIZ   MPOOL BYT SIZ
         REF      GMBSIZ            * MPOOL BUFFER SIZE(WORDS TO CLEAR)
         CI,R1    16
         BLE      %+2
         LI,R1    16
         LI,R3    (4*TAB1)-1
IOTAB1   EQU      %
         AD,R2    DOUBLEONE
         LB,D1    *R7,R2
         CW,D1    R5                * EXCEEDS MAX WIDTH
         BG       IOSDEVX           * YEP, NO MORE.
         STB,D1   *R6,R3
         BDR,R1   IOTAB1
         B        IOSDEVX
*
*
IOVFC    EQU      %                 SET VFC BIT
         LW,R2    1,R7
         SLS,R2   4
         LI,R3    K100
         B        1A1
*
IOSPDIR  EQU      %                 SET DIRECT BIT
         LW,R2    1,R7
         SLS,R2   11
         LI,R3    K8000
1A1      LW,8     Y002
         CW,8     FCD,6
         BAZ      1A2
         LI,8     7
         AND,8    0,6
         CI,8     3
         BNE      IOSDEVX
1A2      RES      0
         STS,R2   FRM,R6
*
IOSDEVX  EQU      %
         CLEAR                      CLEAR STATUS INDICATORS
         B        *SR4
*
* IF APPLICABLE, RETURN NO.LINES REMAINING TO USER IN SR1, ELSE =0
IONLINES LI,SR1   0
         LW,R1    TSTACK
         STW,SR1  -7,R1
         LW,R3    LVA,R6
         SLS,R3   -17
         LI,R5    3                 *NOTE:CLK OF FILE DCB MIGHT BE NON-0
         AND,R5   ASN,R6            *PROB. SC7E-40 IF ATTEMPT TO
         CI,R5    3                 **ASSOCIATE CNTXT BLOCK
         BNE      IOSDEVX           THEREFORE,NOT APPLCBLE IF NOT DEVICEE
         LI,R5    X'FF'
         AND,R5   CLK,R6
         BNEZ     NLLD
         LI,R1    CLK+CLK
         SH,R3    *R6,R1
         B        NL1
NLLD     EQU      %
         PSW,R3   TSTACK
         BAL,R3   CNTXTCHK
         PLW,R3   TSTACK
         AI,R3    0
         BE       NL2               * NONE THERE USE STREAM
NL0      EQU      %                 * USE WHICHEVER LPP
         SW,R3    SCLINES,R5        **STREAM LINES REMAINING
*                                   * USING HIS LVA.
NL1      RES      0
         LW,R1    TSTACK
         STW,R3   -7,R1
         B        IOSDEVX
NL2      LW,R3    SCMINR,R5         * MINR=LINES PRE PAGE(LISTING).
         B        NL0               * REJOIN
*
*
* CHECK IF PLIST'S DCBS (I.E., DCB1 AND DCB2) ARE EQUAL IN ASSIGNMENT
* IF YES, SR1=1, ELSE = 0
* R6 = PLIST WORD - 1 (DCB1 ADDRESS)
* R7 = ADDRESS OF PLIST WORD - 2 (DCB2 ADDRESS)
IOCORRES LI,SR1   0
         LW,R2    TSTACK
         STW,SR1  -7,R2
         LW,R7    1,R7
         BGEZ     %+2
         LW,R7    0,R7
         AND,R7   X1FFFF
         AND,R6   X1FFFF
         BAL,D4   GETDEV            GET DCB1'S ASSIGNMENT
         XW,R6    R7
         STW,R3   R2                SAVE DCB1'S ASN
         BAL,D4   GETDEV            GET DCB2'S ASSIGNMENT
         XW,R6    R7
         CW,R3    R2
         BNE      IOSDEVX           ASSIGNMENT DIFFERENT
         LI,3     1
         B        NL1
*
*
SETDCB   EQU      %
         BAL,1    JHKBIT3
         STS,2    ERA,R6
         BAL,1    JHKBIT
         STS,2    ABA,R6
         LI,R1    X'E'              CHK FOR
         CW,R1    ASN,R6             FILE DCB
         BANZ     IOSDEVX           SKIP IF NOT A FILE
         BAL,R1   JHKBIT            IS ENCRYPTION SPECIFIED
         STS,R2   ENCRYPT,R6        SET IT TO DCB
         B        IOSDEVX
*
TESTOPN  EQU      %
         BAL,R1   PUSHALL
         LW,D2    Y002
         AND,D2   FCD,R6            IS DCB ALREADY OPEN...
         BNEZ     TSTOPX            ---> YES.
         LW,R5    J:BASE            REMEMBER POINTER TO USER'S R0.
         LI,R7    DOUBLEZERO+1      R7 => PARAMETERLESS FPT.
         OVERLAY  OPNSEG,0          GO OPEN DCB.
         STW,R5   J:BASE            RESTORE POINTER TO USER'S R0.
         LW,R1    Y002
         CW,R1    FCD,R6            DID DCB GET OPENED...
         BAZ      PULLALLEXIT       ---> NO. GO REPORT ERROR.
         LW,R1    TSTACK            YES.
         LCI      7                 RESTORE REGISTERS.
         LM,R5    -7,R1
TSTOPX   BAL,R0   GETASN            D2 <- DCB:ASN (3 BITS).
         CI,D2    3
         BNE      *SR2              ---> RETURN +0 IF NOT DEVICE.
         AI,SR2   1
         LI,R5    X'FF'
         AND,R5   CLK,R6              IS IT SYMBIONT...
         BEZ      TSTOPX2           --->NO.
         BAL,R3   CNTXTCHK            YES. OPEN STREAM IF NECESSARY.
         AI,SR2   1
TSTOPX2  STW,R5   J:BASE+3            SET C.B. OR 0 FOR COOP.
         B        *SR2              --->RETURN +1 OR +2.
*                                                                       716
TSTDEV1  AI,1     -9
         BGZ      IOTBL1+9,R1
         AI,1     IOTBL1+9
*                                                                       716
         LI,R0    K7                                                    716
         AND,R0   ASN,R6                                                716
         BEZ      %+2
         CI,R0    K3                                                    716
         BE       0,R1
         CI,SR1   X'22'
         BE       IOMODE1           --->BUT ALLOW (SIZE) FOR FILES.
         B        IOSDEVX                                               716
*FOR A LOGICAL STREAM, RETURN THE ADDRESS OF THE ASSOC. CONTEXT
*
*CNTXT BLK AT THIS TIME MIGHT NOT BE MEANINGFUL(E.G. AFTER SUPCLS)
*THEREFORE,SHOULD INTERFACE WITH DEFAULT DEVICE CHAR. ASSOC. WITH STRM
*  RATHER THAN ANY RESIDUE INFO.
CNTXTCHK EQU      %
         LW,R5    *J:USCDX,R5
         CW,R5    Y2
         BANZ     *R3               IT'S ALL GOOD
         B        COPOLDI           INTERNAL OPEN ,RETURNS ON R3
         END

