         DEF      IOD
MONPROC  SET      1
         SYSTEM   UTS
IOD      EQU      %
         PAGE
         BOUND    8
K11      EQU      X'11'
K200     EQU      X'200'
K7FFF    EQU      X'7FFF'
K7       EQU      X'7'
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K6       EQU      X'6'
KF       EQU      X'F'
K4000    EQU      X'4000'
K50      EQU      X'50'
K100     EQU      X'100'
K8000    EQU      X'8000'
K10000   EQU      X'10000'
K1FFFF   EQU      X'1FFFF'
         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
         PAGE     IOD REFS
         REF     CLRMBG
         REF      GETASN
         REF      DOUBLEONE
         REF      GETDEV
         REF      MSREXIT
         REF      MSRWRTX
         REF      SAVRSZ
         REF      OPNSEG
         REF      PULLALLEXIT
         REF      Y002
         REF      DOUBLEZERO
         REF      PUSHALL
         REF      PUTSZBF
         REF      SETBTDQ1
         REF      IOQUEUE1
         REF      Y04
         REF      Y08
         REF      INTCHR,MSRLP7
         REF      TOFMESS
         REF      M:OC
         REF      Y06
         REF      MODEFRM
         REF      X1FFFF                                                716
         REF      MSRRDWT1                                              716
         REF      J:USCDX           *CNTXT POINTER
         REF      J:BASE            * CAL PROCESSING TEMP AREA
         REF      M16,Y8,Y008
         REF      MULSEG
         REF      MSRTYPR
         REF      COPOLDI,Y2
         REF      IOGETBF,RMB
         REF      M:UC
         REF      QUEUE
         REF      IOSPIN
         REF      BLANK
         REF      SCMAXR            * STREAM MAX REC SIZE
         REF      SCMINR            * STREAM LINES PER PAGE
         REF      SCLINES           * STREAM LINE COUNT
         REF      SCDEVTYP          * STREAM TYPE & FLAGS
         REF      SCFORM
         REF      SCFFORM
         REF      SH:LNM
BASCFLG2 EQU      SCDEVTYP+SCDEVTYP+SCDEVTYP+SCDEVTYP+2
         REF      J:JIT
         REF      M:XX
         REF      MISOVSEG,MSRKEY#
         REF      YF
         REF      S:CUN             * CURRENT USER NUMBER
         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
         CI,R6    M:OC
         BE       IOSDEVX                                               716
         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 CHANGLE FORM
         BAL,SR1  TESTOPN
         BAL,R0   GETASN
         AI,D2    -3                IF NOT DEVICE TYPE DCB,
         BNEZ     MSRWRTX           NOP
         LI,R5    X'FF'             * STREAM NUM WIDTH
         AND,R5   CLK,R6            * DCBS STREAM NUMBER
         BEZ      MSRWRTX           * NO STREAM, NOP
         BAL,R3   CNTXTCHK          GO CHECK
         STW,R5   J:BASE+3          * SAVE FOR COOP
         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...
*
IOFRM3   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,JHKBIT1,JHKBIT3
         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
         BAL,R1   JHKBIT1
         B        %+2
         B        IOSDEVX
         LI,R0    IOSDEVX
         LW,D1    R2
         B        SAVRSZ
*
IOPAGE   EQU      %                 HANDLE PAGE EJECT
         BAL,SR1  TESTOPN                                               716
         BAL,D4   GETDEV
         BEZ      MSREXIT           'NO' DEVICE
         LI,R7    TOFPLIST-1
         LI,SR1   K1FFFF            * 17 BIT DCB ARG
         AND,SR1  R6                * EXTRACTED
         BAL,R0   GETASN            CHECK ASN FIELD OF DCB
         AI,D2    -3                IF NOT DEVICE DCB,
         BNEZ     IOPGE2            SKIP STREAM PROCESSING
IOPGE01  EQU      %                 * FROM INTERNAL COP OPN BELOW
         LI,R5    X'FF'             **STREAM NUM WIDTH
         AND,R5   CLK,R6            **FETCH IT FROM DCB
         BEZ      IOPGE19           * NON-STREAM (MAYBE TAPE OR COC)
         BAL,R3   CNTXTCHK
         STW,R5   J:BASE+3          * SAVE FOR COOP
         OR,SR1   Y06                                                   716
         LI,R1    BASCFLG2          * DEV TYPE DESCRIPTION
         LC       *R5,R1            * CC= TYP,TYP,IN,OUT
         BCR,12   IOPGE2            * NOT TAPE(10),LISTING(01),OR DISC(11)
         BCR,8    IOPGE1            * IS LISTING TYPE(01)
         EOR,SR1  Y02
         REF      Y02
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      MSRLP7
*
         MTW,-1   SCLINES,R5        * ONE LESS LINE THIS PAGE
         B        MSRWRTX
*
*        NOT STREAM BUT IS IT TAPE COC OR OTHER
IOPGE19  EQU      %                 *
         STW,R1   J:BASE+3          * SET NON-STREAM(DIRECT)
         LI,R5    BADEVTP           * DCB DEV TYPE BYTE
         LB,R5    *R6,R5            * FETCHED UP
         OR,SR1   Y04               * SET WRITE FCN CODE
         CI,R5    X'90'             * IS IT ME(X'10') + DEVF(X'80')
         BNE      MSRLP7            * NOPE ITS OTHER
         B        IOPGE09           *AND REJOIN
*
*
IOPGE2   EQU      %
         CI,D2    4-3
         BE       PULLALLEXIT       JRNL
         LI,SR1   K11               * SET WRITE FPT CODE INTERNAL
         LI,R1    0
         STW,R1   J:BASE+3          * CLEAR FOR COOP
         LW,R1    Y4                * MSRRDWT: DONT CHECK MY
         STS,R1   J:ASSIGN          * BUFFER(EETS OK)
         REF      Y4,J:ASSIGN
         REF      JOVVPA
         B        MSRRDWT1
*                                                                       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
         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
         B        IOSDEVX
*
TESTOPN  EQU      %
         BAL,R1   PUSHALL
         LW,D2    Y002
         CW,D2    FCD,R6
         BANZ     *SR1
*                                   OPEN DCB
         LI,R7    DOUBLEZERO+1
         OVERLAY  OPNSEG,0
         LW,SR3   SR3
         BNEZ     PULLALLEXIT
         PULL     8,R5
         BAL,R1   PUSHALL
         B        *SR1
*                                                                       716
TSTDEV1  AI,1     -9
         BGZ      IOTBL1+9,R1
         AI,1     IOTBL1+9
*                                                                       716
TSTDEV   EQU      %                                                     716
         LI,R0    K7                                                    716
         AND,R0   ASN,R6                                                716
         BEZ      %+2
         CI,R0    K3                                                    716
         BE       0,R1
         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
*                                   *R3-SR4 UNTOUCHED
IODSZ    EQU      %-IOD
         END

