NWIO     SET      1
S69PROC  SET      1
MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         DEF      IORT
CNM      EQU      1                 TEMP CARD**************
CJASN    EQU      4                 ASN=4 FOR COMMON JOURNAL
         DEF      CHKWAT,CALLCK1A
         REF      REGMASK,WAARS,ADDRMASK,J:RWECB
         REF      M16,COMJRNL,ECBPOST,ECBFBLK,ECBINIT,ECBCHCK1
IORT     EQU      %
K2       EQU      2
K7FFF    EQU      X'7FFF'
K7       EQU      X'7'
KD       EQU      X'D'
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K5       EQU      X'5'
K8       EQU      X'8'
KC       EQU      X'C'
K22      EQU      X'22'
K26      EQU      X'26'
K30      EQU      X'30'
K40      EQU      X'40'
K4000    EQU      X'4000'
K42      EQU      X'42'
K44      EQU      X'44'
K5A      EQU     X'5A'
K78      EQU      X'78'
K7F      EQU      X'7F'
KC0      EQU      X'C0'
K400     EQU      X'400'
K482     EQU      X'482'
K1000    EQU      X'1000'
K2000    EQU      X'00002000'
K8000    EQU      X'8000'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
K600     EQU      X'600'
         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
R12      EQU      12
R13      EQU      13
         PAGE     ROOT REFS
         REF      J:JIT
         REF      :BIG
         REF      DCT4
         REF      RCVPSD
         REF      T:MBUF
         REF      DLTSEG
         DEF      FCONCOM
         REF      CIC
         REF      IOSFILE
         REF      ISEQUB
         REF      MSRWRT
         REF      CJOB
         REF      E:NQW,E:NQR
         REF      NEWQNW
         REF      T:REG
         REF      X0
         REF      X1FFFF
          REF      XFF
         REF      Y0004,Y000C
         REF      Y8
         REF      Y01
         REF      Y02
         REF      Y0C
         REF      Y001
         REF      Y002
         REF      Y008
         REF      Y0002
         REF      Y0038
         REF      Y00FE
         REF      Y00FF
         REF      M17
         REF      OV:NMSZ,OH:NM,TYPMNSZ,OB:BTX,OB:GTX
         REF      OB:OTX,DCTSIZ,SV:RSIZ
Y54      DATA     X'54000000'
         REF      Y006
YFC      DATA     X'FC000000'
         DEF      YFC
XBF      DATA     X'BF'
METXT    DATA     X'FFFFD4C5'
DEOD     TEXT     '!EOD'
TOFMESS  TEXT     '1   '
         DEF      WRTELEND,READLEND
         REF      ERO,ABO,CCBEF,PUF,RNST
         REF      BAABC
       REF     Y004
       REF     M7
         REF      OPNSEG
         REF      Y3
         REF      S:CUN,UH:FLG
         REF      OPNCLSUS
         REF      OPNCLSTK
         REF      Y4,J:ASSIGN
         REF      LBLTSEG
         DEF      MSRRED,CODE
         REF      S:BUFMCW
         REF      JXBUFVP
         REF      ENBSR4
         PAGE ROOT DEFS
         REF      T:AMRDWT#,STEPOVRSEG
         DEF      CHKBIT,CHKBIT1
         DEF      CLRMBG
         DEF      DEVCHK
         DEF      GETASN
         DEF      GETBTD
         DEF      GETDEV
         DEF      GETTDEV
         DEF      GETFUN
         DEF      GETTYC
         DEF      INRRWS
         DEF      IOCHEK
         DEF      IOCHEK1
         DEF      IOQUEUE,IOQUEUE1
         DEF      IOSPIN
         DEF      MAPBUFS
         DEF      MERC
         DEF      MSREXIT
         DEF      MSROTHR
         DEF      MSRRDWT
         DEF      MSRRDWT1                                              715
         DEF      MSRWRTX
         DEF      MSR01EXIT
         DEF      PULLALLEXIT
         DEF      PULLEXIT,PULLEXIT1
         DEF      PUTSZBF,PUTSZBF1
         DEF      PUSHALL
         DEF      READTP
         DEF      RECTRAN
         DEF      RESBTD
         DEF      SAVBLK
         DEF      SAVRSZ
         DEF      SETBTDQ,SETBTDZ,SETBTDQ1
         DEF      SETTYC
         DEF      TAPEOP
         DEF      WRTTPE
         DEF      DEOD
         DEF      TOFMESS
         REF      COOP
         DEF      MODEFRM
         DEF      T:UBLKOCU
         DEF      YFFFFFFFC
YFFFFFFFC   DATA  X'FFFFFFFC'
         PAGE
         REF      SB:HQ
         REF      T:RUE
         REF      E:NOCR
         PAGE     TAPEOP
WRTTPE   EQU      %
         LI,SR3   K26               WRITE PACKED
         B        TAPEOP
*
*
DEVCHK   EQU      %
         BAL,R0   GETASN
         CI,D2    K3
         BNE      0,R1
         BAL,D4   GETDEV            GET DEVICE
         LB,R0    DCT4,R3
         B        ONE,R1            MT RETURN
*
GETFUN   EQU      %                 GET FUNCTION
         LW,D1    FUN,R6
         SCS,D1   15
         AND,D1   M4                ONLY 4 BITS USED
         REF      M4
         B        *D2
SAVBLK   EQU      %
         LI,D2    K7FFF
         SLD,D1   17
         STS,D1   BLK,R6
         B        *R0
SAVRSZ   EQU      %                 SAVE RSZ
         LI,R5    RSZ
         B        SAV
SAVARS   EQU      %                 SAVE ACTUAL RECORD SIZE
         LI,R5    ARS
SAV      EQU      %
         LI,D2    K7FFF
         SLD,D1   17
         STS,D1   *R5,R6
         B        *R0
GETASN   EQU      %
         LI,D2    K7
         AND,D2   ASN,R6
         B        *R0
         PAGE     MSRRDWT
         DEF      CAL11N7
CAL11N7  RES      0
*********  FAST CAL PATH  *********
* ENTER HERE FROM CALPROC.
* FROM CURRENT MEASURED CAL RATES, EVERY 60 MICROSECOND
* ADDITION ON THE FAST CAL PATH RESULTS IN A 1 PERCENT
* REDUCTION IN EFFECTIVE CPU THROUGHPUT.
* THE STACK HAS BEEN OPENED BY 8 WORDS FOR A PUSHALL.
* MOST OF THE CODE FROM HERE TO THE END OF THE BUFFER
* CHECKING ROUTINES AT SYMBOLIC LOC 1Z8E IS ON THE FAST CAL PATH.
CAL11N8  EQU      %
         LW,D2    Y002
         CI,SR1   X'2E'
         AND,D2   FCD,R6
         BNEZ     CL11NW
         BANZ     CL11              ASSIGN/MERGE
* THE DCB IS NOT OPEN AND THIS IS NOT ASSIGN/MERGE
* SO WE MUST PERFORM A DEFAULT OPN.
*
         LI,14    -8
         MSP,14   TSTACK
         REMEMBER
         BAL,R1   PUSHALL
         B        MSRRDWTA          SKIP MAPPING OF BUFFERS
         SPACE    2
*        MSRRDWT  ANALYZES PARAMETERS ON THE READ AND WRITE STATEMENTS
*        IT THEN BRANCHES TO THE APPROPRIATE ROUTINE FOR DISK FILES,
*        TAPE FILES, OR STANDARD DEVICES
*        R5 = JIT ADDRESS
*        R6 = DCB ADDRESS
*        R7 = PARAMETER LIST
*        CALLING SEQUENCE--BAL,SR4  MSRRDWT
*        SR1 = OPERATION CODE
*
*
MSRRDWT  EQU      %
         REMEMBER
         BAL,R1   PUSHALL
         BAL,R0   MAPBUFS           MAP BUF1 AND BUF2
         LW,R1    TSTACK
         LCI      5
         LM,R6    -6,R1             RESTORE REGISTERS
*
MSRRDWTA EQU      %
         LW,D2    Y002              SEE IF DCB IS OPEN
         AND,D2   FCD,R6
         BNEZ     MSRRDWT1
         LI,R7    X0+1
* J:BASE HAS A POINTER TO THE USER REGISTER SAVE
* LOCATION IN TSTACK
         LW,SR4   J:BASE
         PUSH     1,SR4
         LI,SR4   MSRRDWT1A
         OVERTO   OPNSEG,0
MSRRDWT1A EQU     %
         PULL     1,SR4
         STW,SR4  J:BASE
         LW,R1    Y002
         CW,R1    FCD,R6
         BANZ     1C1
         SLS,SR3  1                 ALIGN FOR SUBCODE
         AND,SR3  YFF
         REF      YFF
* DEFAULT OPEN FAILS;  REPORT 46 FOR READ OR 47 FOR WRITE
* WITH THE ERROR CODE FROM OPEN AS THE SUBCODE.
         AI,SR3   X'36'
         LW,R1    TSTACK
         AW,SR3   -4,R1
         B        MSR01EXIT
1C1      LW,R1    TSTACK
         LCI      7
         LM,R5    -7,R1
         B        1Z8A
CL11NW   RES      0
         BAZ      CL11
* ASSIGN/MERGE  OPERATION REQUIRES A CLOSED DCB, REPORT A 2E.
         LW,12    TSTACK
         AI,12    -1
         LI,1     -7
         LCI      8
         STM,5    *TSTACK,1
         LI,SR3   X'2E'
         B        MSR01EXIT
         REF      CAL1PSD
CL11     RES      0
*********   FAST CAL PATH  **********
         LI,R1    X'1FFFF'
         AND,R1   CAL1PSD           GET ADDRESS OF CAL
         AI,R1    -J:JIT            CHECK FOR CAL IN MONITOR
         BGZ      CL11NW1           BRANCH IF NOT MONITOR
         REMEMBER
CL11NW1  RES      0
         LW,12    TSTACK
         AI,12    -1
         LI,1     -7
         LCI      8
         STM,5   *TSTACK,1
MSRRDWT1 EQU      %
1Z8A     RES      0
         REF      CLRBFUB,CLRBBUF
* PERFORM SETUP FOR SHARED KEYED FILE OPERATIONS.
         LI,R1    X'20000'          DCB SHARE BIT
SHARE    EQU      7
         CW,R1    SHARE,R6
         BAZ      1Z8H              NOT SHARED
         LW,1     0,R6
         CW,1     Y002
         BAZ      1Z8H              ASSIGN MERGE
         CI,1     14
         BANZ     1Z8H              NOT FILE
         LW,1     CFU,R6
         LW,2     0,1
         CI,2     X'4A00'           RAN OUTIN OUT
         BANZ     1Z8H              NOT APPLICABLE
         LI,2     X'FFFF'
         AND,2    SCFU,1
         BEZ      1Z8H              ONLY 1 CFU
         LI,D1    X'100'            FIND IN CFU
         CW,D1    0,R2
         BAZ      %+2               ALREADY IN R1
         LW,R1    R2
         LW,D1    COUNTS,R1
COUNTS   EQU      GAVAL
         LW,D2    YFF
         LW,R2    TSTACK
         STS,D1   -2,R2             SAVE IN R10 OF PUSHALL
         REF      M24
         LW,D2    M24
         CS,D1    CLK,R6
         BE       1Z8H              NO WRITES SO DON'T TRUNC
         STS,D1   CLK,R6
1Z8HM1   BAL,SR4  TRUNK             TRUNC BUF1 & BUF2
1Z8H     RES      0
*********  FAST CAL PATH  *********
* DECODE THE FPT FOR THE CAL.
*
*****      ERROR ADDRESS
         BAL,1    JHKBIT3
         STS,2    ERO+J:JIT         ERROR
*****      ABNORMAL ADDRESS
         BAL,1    JHKBIT
         STS,2    ABO+J:JIT         ABNORMAL
*****      BUFFER ADDRESS
         BAL,1    JHKBIT
         STS,2    BUF,6             BUFFER ADDRESS
*****      BUFFER SIZE
         BAL,1    JHKBIT
         B        JOSZE             BUFFER SIZE IS SPECIFIED
         LW,R2    RSZ,R6            DEFAULT RECORD SIZE
         SLS,R2   -17               RIGHT JUSTIFY
JOSZE    LI,3     X'FFFF'
         STW,R2   RWS,R6
         SLD,R2   17
         STS,R2   BLK,R6
JOSZE1   RES      0
         CI,SR1   X'2D'
         BL       JOSZE3
*  ASSIGN/MERGE
         OVERTO   STEPOVRSEG,T:AMRDWT#
JOSZE3   RES      0
         LI,R4    7                 ASN MASK; INCLUDE CJRNL
         AND,R4   ASN,R6
         BNEZ     %,R4
         B        JFILE
         B        JFILE
         B        CKCNMASN          CK FOR CNM SLV LN DCB
         B        CJ:ASN            B, IF COMMON JOURNAL; SKIP P5
CKCNMASN EQU      %
         DO       CNM
         REF      CNMLNDCB,VAL:INDX
         LW,R1    CNMLNDCB          GET MASK FOR CNM LINE DCB
         CS,R1    0,R6              SEE IF THIS IS A CNM LINE DCB
         BNE      DEV:ASN           B, IF NOT; SKIP P5
         BAL,R1   JHKBIT            ELSE, CK FOR POL/SEL INDX SPECIFIED
         B        %+2               B, IF WE HAVE ONE
         LI,R2    0                 ELSE, REINITIALIZE DCB'S INDX SLOT
         STW,R2   VAL:INDX,R6       SET UP DCB'S INDX SLOT APPROPRIATELY
         B        CHKBTD1           GO LOOK FOR BTD SPECIFICATION
         FIN
CJ:ASN   EQU      %
DEV:ASN  EQU      %
         SLS,D3   1                 SKIP P5 BIT
         BEV      CHKBTD
         BIR,R7   CHKBTD
*
         DEF      JHKBIT,JHKBIT1,JHKBIT3
JHKBIT3  RES      0
         LI,3     X'1FFFF'
JHKBIT1  RES      0
         LW,D3    1,7               PRESENCE BITS & FLAGS
         AI,7     X'80002'          FOR BIR BELOW
JHKBIT   SLS,D3   1
         BEV      1,R1              NO PRESENCE BIT
         LW,R2    0,R7
         BGEZ     JHKBIT2
         CI,R2    X'1FFF0'
         BAZ      %+3               REGISTER
* INDIRECT, BUT NOT THROUGH A REGISTER
         LW,R2    0,R2
         BIR,R7   0,R1
* INDIRECT THROUGH A REGISTER
         LW,R2   *J:BASE,R2
JHKBIT2  BIR,R7   0,R1
         REF      J:BASE,J:JAC
*
JFILE    RES      0
         LI,D2    X'30'
         AND,D2   ORG,R6
         LI,R3    X'1FFFF'
*****      KEY ADDRESS
         BAL,R1   JHKBIT
         BNEZ     JFILE1            KEY SPECIFIED
JFILE21  LI,R2    0                 NO KEY
JFILE22  RES      0
         STS,R2   KAD,R6
         BEZ      CHKBTD            NO KEY TO CHECK
         LB,2     *2
         BEZ      1A4               NO NULL KEYS
         LI,1     BASCR
         CB,2     *6,1
         BL       CHKBTD
1A4      RES      0
         LI,SR3   K42               KEY LENGTH ERROR
         B        MSR01EXIT
CHKBTD   CI,SR1   KD
         BNE      CHKBTD1
* M:DELREC CAL
         OVERTO   DLTSEG,5
JFILE1   EQU      %
         CI,D2    X'10'
         BCS,5    JFILE21  ONLY MERGE KEY PARAM IF KEYED FILE
         B        JFILE22           RESET KEY ADDRESS
*****      BYTE DISPLACEMENT(BTD)
CHKBTD1  BAL,R1   JHKBIT
         B        SETBTD
         B        NOBTD
SETBTD   LI,R3    X'30'
         SLS,R2   4
         STS,R2   BTD,R6
NOBTD    RES      0
         LI,R2    0                 INITIALIZE R2
         BAL,R1   JHKBIT            CK FOR ECB SPECIFICATION (P7)
         B        %+2               B, IF WE HAVE ONE
         B        SETRWECB          ELSE, GO SET J:RWECB = 0
         LI,SR2   0                 INITIALIZE ECB W/0
         LW,SR3   R2                MOVE ECB ADR TO INPUT REG
         LW,R3    R2                SAVE ECB ADR ACROSS CALL, TOO
         BAL,SR4  ECBINIT           ATTEMPT TO INITIALIZE THE ECB
         LI,R1    %+3
         EXU      *SR3,R1           RETURNED (SR3) TELLS US WHAT TO DO
         B        MSR01EXIT         IF WE GET HERE, WE'VE GOT AN ERROR
         B        GETBLK            B, IF INITIALIZATION SUCCESSFUL
         LW,SR3   ECBERR1           ERR; ECBI BIT ALREADY SET
         LW,SR3   ECBERR1           ERR; ECBW BIT SET
         LW,SR3   ECBERR4           ERR; WRONG ACCESS CODE FOR ECB ADR
GETBLK   EQU      %
         BAL,D4   CALLGBLK          GET A 4-WORD BLOCK
         STW,R3   1,R2              SAVE ECB ADDRESS IN 4-WORD BLOCK
         LW,SR3   S:CUN             GET CURRENT USER#
         STW,SR3  3,R2              SAVE THAT TOO IN 4-WORD BLOCK
         LW,SR3   X4000
         AND,SR3  D3                SEE IF AUTO READ SPECIFIED
         BEZ      %+2               B, IF NOT
         STW,SR3  0,R2              ELSE, TELL MOCIOP ABOUT IT
SETRWECB EQU      %
         LW,R3    ADDRMASK          ADDRESS MASK IN R3
         STS,R2   J:RWECB           SET 4-WORD BLK ADR OR 0 IN JIT
         AI,D2    -X'30'            TEST ORG FLAG
         BNEZ     SKIPBLK           B, IF ORG NOT=RANDOM
         LW,R3    KBUF,R6           ELSE, GET ADR OF BUFF TO HOLD BLK#
*****      BLOCK NUMBER
         BAL,R1   JHKBIT
         STW,R2   0,R3
         STW,D2   1,R3
         STW,D2   2,R3
         SLS,D3   8
         B        %+2
SKIPBLK  EQU      %
         SLS,D3   9                 ADJUST FPT'S FLAGS
         LW,D4    Y001004
*****      WAT
         STS,D3   WAT,R6
         LW,D2    FUN,R6
         CI,SR1   16
         BE       JCHKM             BRANCH IF READ
         CI,R4    3
         BE       JOSZE2            IT'S A DEVICE
         SLS,D3   7
         LW,D4    Y3
*****      NEWKEY & ONEWKEY
         STS,D3   ONWK,R6
         B        JOSZE2
1Z8F     AND,D2   Y001C
         BNEZ     %+3,R4
WRTERR   LI,SR3   K44
         B        MSR01EXIT
         B        IOSFILE
         B        IOSFILE
         B        WLBT
         B        MSRWRT
         B        COMJRNL           ENTER COMMON JOURNAL HANDLING CODE
Y001C    DATA     X'001C0000'
Y001A    DATA     X'001A0000'
Y001004  DATA     X'00100400'
JCHKM    SLS,D3   -11
         LI,D4   K400
*****      DIRECTION(FORWARD OR REVERSE)
         STS,D3   DIR,R6
         CI,4     2
         BNE      JOSZE2            NOT LBLT
         SLS,D3   19
         LW,D4    Y08
         STS,D3   ORG,6             SET ULBL
*****      ULBL
         REF      Y08
JOSZE2   RES      0
* CHECK VALIDITY OF BUFFER ADDRESS.
         LW,D4    RWS,6
         BGZ      %+3
         BEZ      1Z8B
         BLZ      CHKLMER           NO NEGS
         LI,D4    0
         LI,D3    X'1FFFF'
         AND,D3   BUF,R6
         SLD,D3   -9
         SCS,D4   11
         LI,R2    X'30'
         AND,R2   BTD,R6
         SLS,2    -4
         AW,D4    RWS,R6
         AW,D4    R2
         AI,D4    2047
         SLS,D4   -11
         CI,D3    JOVVP
         REF      JOVVP,M2
*****      FIRST PAGE OF BUFFER IN D3
*****      NUMBER OF PAGES IN THE BUFFER IN D4
         BGE      MEMLP1            FIRST PAGE NOT IN ROOT
RRCHK    RES      0
         LC       J:ASSIGN
         BCS,4    1Z8G
         LW,R3    S:CUN
         LH,R3    UH:FLG,R3
         CI,R3    SJAC              SPECIAL JIT ACCESS
         BAZ      CHKLMER           NOT SET - ERROR
1Z8G     CI,8     X'11'
         BE       1Z8D              WRITE - ALLOW IT
         CI,D3    X'20'
         BL       1Z8D              IN THE ROOT - ALLOW IT
         CI,D3    JOVVP
         BL       CHKLMER
         LW,3     D3
         LOAD,3   JX:CMAP,3
         CI,3     X'22'
         BG       1Z8D
         B        CHKLMER
         REF      JX:CMAP
MEMLP    AI,D3    1
MEMLP1   LW,R3    D3                MOVE CURRENT PAGE
         SCD,R2   -4
         SCS,R2   5
         LW,R3    J:JAC,R3
         SLD,R2   2,2
         AND,R2   M2
         BEZ      1Z8D
         CI,8     X'11'             IS THIS A WRITE
         BNE      RRCHK             BR IF READ
         LB,2     M2,2              YES, OK FROM 01,02
         BNEZ     RRCHK
         LI,R3    3
         CS,R3    0,R6
         BNE      1Z8D              NOT A DEVICE
         LI,R3    X'4000'           CHK FBCD
         CW,R3    0,R6
         BANZ     RRCHK             BAD NEWS
1Z8D     RES      0
         BDR,D4   MEMLP
         CI,D3    X'FF'
         BLE      1Z8C              OK - NOT PAST END OF VIRTUAL CORE
CHKLMER  LI,SR3   X'4A'             ABORT - ILLEGAL BUFFER ADDRESS
         B        MSR01EXIT
1Z8C     LW,R3    Y4
         STS,R2   J:ASSIGN          RESET PRIVLEGE BIT
1Z8B     RES      0
         CI,SR1   X'11'
         BE       1Z8F              WRITE
1Z8E     RES      0
         AND,D2   Y001A
         BNEZ     RVEC,4
READERR  LI,SR3   K40
MSR01EXIT LI,R1   PULLALLEXIT
         LW,R4    R6                DCB
         LI,D2    ABA               ASSUME ABNORMAL
         CI,SR3   KC0               CHK ASSUMPTION
         BAZ      MSR012            OK
         BDR,D2   MSR012            EET'S AN ERROR
RVEC     EQU      %
         B        ISEQUB
         B        ISEQUB
         B        RLBT
         B        MSRRED
WLBT     LI,0     1                 ENTRY #
         LI,2     LBLTSEG           SEGMENT #
         B        T:OVER
RLBT     LI,0     0                 ENTRY #
         B        WLBT+1
         PAGE
WRTELEND EQU      %
         DO       NWIO
         REF      WRTXEND
         LW,1     11                SAVE RETURN
         BAL,SR4  WRTXEND           LINK BUFFER TO FREE POOL CHAIN
         LW,11    1                 RESTORE RETURN ADDRESS
         FIN
READLEND EQU      %
WLEND    LW,R7    SR1
         LW,D1    TYC,R7
         SCS,D1   15
         AND,D1   M7
         CI,D1    K5
         BNE      LBLEND
         LW,D2    Y00FE
         STS,D1   TYC,R7
         LI,D1    X'40000'
LBLEND   EQU      %
         LI,D2    X'40000'
         STS,D1   BFL,R7
         B        *11
         SPACE    3
PRECEA   EQU      %                 PRECORD E.A.
         LH,2     14                AVRX
         STW,12   AVRSID,R2         TYC,,RRC  8,8,16
*
TAPEA    EQU      %                 TAPE SPACING EA ROUTINE
         DEF      PRECEA,TAPEA
*                    END ACTION FOR TAPES,R14=AVRSID,USER#
*                      R11=LINK
         PUSH     11
         LH,2     14                CLR REW
         MTH,-1   AVRNOU,2
         BG       TAPEAX            DONT WAKE, MORE I/O TO CPLT
         LB,5     AVRFLGS,2
         AND,5    XCF
         REF      XCF
         STB,5    AVRFLGS,2
         INT,5    14                GET USER #
         LB,2     UB:US,5
         CI,2     SQR
         BE       %+3
         CI,2     SQRO
         BNE      TAPEAX            NOT WAITING
         LW,2     U:MISC,5
         LB,2     2
         CI,2     R:NQW
         BNE      TAPEAX            NOT WAITING FOR TAPE OP
         LI,6     E:NQR
         BAL,SR4  T:RUE             WAKE HIM(OR HER)
*
TAPEAX   PULL     11
         B        *11
         REF      R:NQW,SQR,SQRO
         REF      UB:US,U:MISC
         REF      AVRFLGS,AVRSID,AVRNOU
*                                   THIS ROUTINE HANDLES MONITOR AND
*                                   USER READS
*                                   READING FROM THE C-DEVICE INVOLVES
*                                   SPECIAL CHECKS
MSRRED   EQU      %
*
*
         LW,R0    Y0004
         LW,R1    Y000C
         STS,R0   EOP,R6
*
         LI,SR1   K1FFFF
         AND,SR1  R6
         DO       CNM
         LW,D4    CNMLNDCB          GET CNM SLAVE LINE DCB MASK
         CS,D4    0,R6              SEE IF THIS IS A SLAVE LINE
         BE       MODEFRMA          B, IF SO; FINISHED HERE
         FIN
         BAL,D4   GETDEV            GET POINTER INTO DEVICE TABLE
         BEZ      REDCDEV3
         LI,R5    J:JIT
         CI,R3    DCTSIZ+1+SV:RSIZ+1+1 'C' (CONTROL) DEVICE
         BNE      MODEFRMA
         REF      Y2
         LW,2     5,6
         AND,2    Y2
         BNEZ     MODEFRMA
*
*
         LI,R2    K78               PUT MONITOR BUFFER AND SIZE INTO DCB
         LI,D3    J:CCBUF
         REF      J:CCBUF
         BAL,SR4  PUTSZBF
       LW,D4   CCBEF,R5            IS CONTROL COMMAND BUFFER FULL
*
       CW,D4   Y004
         BANZ     2C1
      CW,D4   Y008
       BANZ    REDCDEV1
         LI,R2    X'20000'
         AWM,R2   CIC,R5
         BAL,SR4  IOQUEUE
         BAL,SR4  IOCHEK1           WAIT FOR READ TO COMPLETE
*
         BAL,R1   CHKWAT
         BNEZ     %+2
         BAL,R0   SETTYC1
*                                   CHECK FORTRAN CONVERT OPTION
         LI,R2    K4000
         CW,R2    FCON,R6
         BAZ      RED3              DONT CONVERT
         BAL,R1   FCONCOM-1
RED3     EQU      %
*                                   SR3 CONTAINS RESULT OF READ
         LB,R1    SR3               IS IT END OF FILE
         BNEZ     USRMOV
*                                   CHECK FOR ! IN BIN OR EBCDIC
         LW,D3    QBUF,R6
         LH,D1    *D3
         SLS,D1   -4
         LW,D2    MOD,R6
         CW,D2    Y0002
         BAZ      BCDTST
         CI,D1    K482
         BNE      USRMOV
*                                   SET MODE BACK TO BCD
         B        MONTEST
BCDTST   EQU      %
         SLS,D1   -4
         CI,D1    K5A
         BNE      USRMOV
MONTEST  EQU      %
         LW,R1    Y0038             SEE WHO IS RUNNING
         AND,R1   PUF,R5
         BEZ      REDCDEV3
         LW,R1    Y008              SET CCBEF TO FULL
         STS,R1   CCBEF,R5
         LI,R1    K2000             SET AGV FLAG
REDCDEV2 EQU      %
         STS,R1   AGV,R6            SET AGV FLAG
REDCDEV3 EQU      %
         LI,D1    K7                END OF PHYSICAL DATA
REDCDEV31  EQU    %
         LI,R0    MSREXIT
SETTYC   LI,D2    K7F
         SLD,D1   17
         STS,D1   TYC,R6
SETTYC1  LI,D2    K1000
SETTYC2  RES      0
         DEF      SETTYC2
         STS,D1   EGV,R6            CLEAR TYC FLAG
         B        *R0
*
2C1      EOR,D4   Y004
         STW,D4   CCBEF,R5
         LI,D1    X'50'
         BAL,R0   SAVARS
         CLEAR
USRMOV   EQU      %                 TRANSFER DATA FROM MONITOR TO
*                                   USER BUFFER
         BAL,SR4  INRRWS
         LW,R3    R4
         LW,D3    BUF,R6            GET USERS BUFFER ADDRESS
         LI,D4    K1FFFF
         CS,D3    QBUF,R6
         BE       PULLALLEXIT
         LW,D4    QBUF,R6           MONITOR BUFFER ADDRESS
         LI,R4    K0                MONITOR BTD
         LW,R1    ARS,R6            GET SIZE OF RECORD
         SLS,R1   -17
         LW,R2    RWS,R6            GET SIZE OF USERS BUFFER
         BAL,SR4  RECTRAN           TRANSFER RECORD
         CW,R4    R1                DID ALL OF RECORD GET TRANSFERRED
       BGE     PULLALLEXIT
*                                   NO--RESET ARS
         LW,D1    R4                SET ACTUAL RECORD SIZE
         BAL,R0   SAVARS
         LB,R1    SR3               NORMAL READ
         BNEZ     PULLALLEXIT
         LI,D1    K2                LDT CODE
         B        REDCDEV31
         PAGE     MSROTHR
         NOP
REDX     LW,R2    RWS,R6
         BNEZ     MSROTHR
         LI,R2    K1
         LI,D3    K0
         BAL,SR4  PUTSZBF
MSROTHR1 EQU      %
         BAL,D4   SETBTDQ
         LI,D4    MSR2
CLRMBG   LI,R0    0
         B        SETMBG1
MSR2     RES      0
         BAL,SR4  IOQUEUE1
*                   *** FBCD CONVERSION (INPUT) ***
*                        MUST BE DONE AT I/O COMPLETE <MT/PR/CR>
         ANSBAL,R0 CHKANS1
         B        NOPAF
         LW,D2    Y0008             ANS--SET PAF
         STS,D2   BFL,R6
         REF      Y0008
NOPAF    EQU      %
         LI,SR4   K4000
         CW,SR4   FCON,R6
         BANZ     FCONIV            YES, CONVERT
         BAL,R3   GETAVR
         BGE      NOTAPF            NOT TAPE
         CW,1     Y00FF
         BAZ      NOTAPF            NOT OPEN IF NO USERS
         CI,1     X'FFFF'           MAKE TPOS NON-ZERO TO SHOW NOT AT LP
         BANZ     NOTAPF
         AI,1     1
         STD,0    AVRTBL,2
NOTAPF   EQU      %
         REF      NBATAPE,AVRTBL
*
*                                   NO, CONTINUE
**********   FAST CAL PATH  ***********
*  MOST CALS BEGIN THEIR EXIT AT THIS POINT.
MSREXIT  EQU      %
*
6W1      RES      0
*
         LI,R1    MSREXIT1-1
CHKWAT   LI,R5    J:JIT
         LW,D1    ERO+J:JIT
         OR,D1    ABO+J:JIT
         AND,D1   X1FFFF
         LW,D2    Y001
         LS,D1    WAT,R6
         B        0,R1
         BEZ      MSRWRTX           NO
MSREXIT1 EQU      %
         LI,SR4   PULLALLEXIT
IOCHEK1  PUSH     1,SR4
         REF      Y7F
         LW,1     Y7F
         AND,1    FCN,R6
         BEZ      %+2
         BAL,SR4  IOSPIN            FINISH IO
CKEGV    EQU      %
         CLEAR                      NO ERRORS
         BAL,R0   CHKANS1
         B        NOPRT             POSTANS ONLY IF ANS
         OVERLAY  LBLTSEG,7         POSTANS
NOPRT    EQU      %
         LI,R3    K1000
         CW,R3    EGV,R6
         BANZ     PULLEXIT          TYC HAS BEEN CHKD
         STS,R3   EGV,R6
         LI,R4    3ER5
GETTYC   LW,R3    Y00FE
         AND,R3   TYC,R6
         SCS,R3   15
         B        0,R4
3ER5     EQU      %
         DO       CNM
         SREF     LNERRTBL          *****SREF*****
*
         LW,R1    CNMLNDCB          GET MASK FOR CNM LINE DCB
         CS,R1    0,R6              SEE IF THIS IS A CNM LN DCB
         BNE      GETREGCD          B, IF NOT & GET REGULAR CODE
         LI,R1    BARNDEV           GET DCB:RNDEV OFFSET
         LB,R1    *R6,R1            CK BI-PNT VS. MULTI-PNT
         BNEZ     GETREGCD          B, IF BI-PNT & GET REGULAR CODE
         LH,SR3   LNERRTBL,R3       ELSE, GET MULTI-PNT LINE CODE
         BEZ      PULLEXIT          OK, IF=0
         SCS,SR3  -8                ELSE, ADJUST CODE, SUB-CODE
         B        CNMCKERX          GO CK CODE FOR ERR VS ABN
*
GETREGCD EQU      %
         FIN
         LB,SR3   CODE,R3           PICK UP REGULAR ERR/ABN CODE
         BEZ      PULLEXIT          NO ERR OR ABN
*
CNMCKERX EQU      %
RDERX    EQU    %
         DEF      RDERX
         LI,D2    ABO               ASSUME ABNORMAL
         CI,SR3   KC0
         BAZ      IOCHEK3
         LI,D2    ERO               IT'S AN ERROR
IOCHEK3  LI,R4    J:JIT
         PULL     1,R1              GET EXIT
MSR012   EQU      %
         LI,SR1   X'F'              FORM ASN MASK
         AND,SR1  ASN,R6            ISOLATE ASN FIELD
         CI,SR1   CJASN             IS IT COMMON JOURNAL
         BNE      %+3               NO
         LI,SR1   2                 YES, APPEND SUBCODE
         STB,SR1  SR3               OF 1 TO ERROR CODE
         SCS,SR3  -8                CODE TO BYTE 0
         AND,R6   M17               MERGE
         OR,SR3   R6                 DCB
         LI,SR1   K1FFFF
         AND,SR1  *D2,R4
         BNEZ     0,1
         BAL,11   MERC
         B        0,R1
*                   *** FBCD CONVERSION (INPUT) ***
FCONIV   EQU      %
         CW,SR1   Y0C               SENSE READ/WRITE & TAPOP BIT IN FCN
         BANZ     MSREXIT           IF WRITE, DON'T CONVERT NOW
         BAL,R0   GETASN
         AI,D2    -3
         BNE      MSREXIT           NO, DON'T CONVERT
         BAL,SR4  IOSPIN            WAIT FOR I/O COMPLETE
         LI,R1    6W1
         LI,D3    XEBCTB
         REF      XEBCTB
*                   *** FBCD CONVERSION (COMMON)
FCONCOM  LW,R2    QBUF,R6           BUF ADDR
         SLS,R2   2
         BAL,D4   GETBTD
         AW,R2    R4                + BTD
         LW,R3    BLK,R6            BYTE COUNT
         SLS,R3   -17
         B        EBCTOBCD
         REF      EBCTOBCD
         PAGE
* CHKANS0 & CHKANS1 CHECK FOR ANS DCB ASSIGNMENTS
* CHKANS0=NORMAL RETURN IF ANS; RETURN+1 OF NOT
* CHKANS1=NORMAL RETURN IF NOT ANS; RETURN+1 IF ANS
*
         DEF      CHKANS0
CHKANS0  EQU      %
         PUSH     R0
         LI,R0    X'F'
         AND,R0   ASN,R6
         CI,R0    ANSASN
         BE       PULLEXIT          YES
         B        PULLEXIT1
*
         DEF      CHKANS1
CHKANS1  EQU      %
         PUSH     R0
         LI,R0    X'F'
         AND,R0   ASN,R6
         CI,R0    ANSASN
         BE       PULLEXIT1
PULLEXIT PULL     1,R0
         B        *R0
GETAVR   EQU      %
*                    GETS AVR ENTRY AND SETS R2=AVRX IF DCT=TAPE
         LI,2     X'FF'
         AND,2    DSI,6             IF TAPE, MARK AS OFF LOAD POINT
         AI,2     NBATAPE
         BLZ      GETAVR1
         LD,0     AVRTBL,2
         REF      AVRTBLSIZ
         CI,2     AVRTBLSIZ
         B        0,3
GETAVR1  LCI      2
         B        0,3
         PAGE     EXITS AND ENTRANCES
MSRWRTX  RES      0
*********   FAST CAL PATH  ***********
*  CALS WITH NO ERROR SITUATION EXIT FROM HERE
         CLEAR
PULLALLEXIT  EQU    %
         LW,R2    ADDRMASK
         AND,R2   J:RWECB           SEE IF ECB WAS SPECIFIED
         BEZ      CLRSTK2           B, IF NOT; CLEAN UP STACK
         LI,R0    0
         LW,R1    ADDRMASK
         STS,R0   J:RWECB           REINITIALIZE J:RWECB
         DISABLE                    *****INHIBIT INTERRUPTS*****
         LB,R1    *R2               CHECK ECB'S I/O COUNT
         BNEZ     CLRSTK1           B, IF NOT 0; IOQ WILL POST ECB
         ENABLE                     *****UNINHIBIT INTERRUPTS*****
         PUSH     3,SR1             SAVE SR1, SR3
         LW,SR1   S:CUN             MOVE USER# TO INPUT REG
         LW,SR2   2,R2              MOVE COMPLETION CODE TO   POST REG
         LW,SR3   1,R2              MOVE ECB ADR TO INPUT REG
         BAL,SR4  ECBPOST           POST THE ECB
         BAL,R1   ECBFBLK           RELEASE THE 4-WORD BLOCK
         PULL     3,SR1             RETRIEVE REGS
         B        CLRSTK2           GO CLEAN UP STACK
*
CLRSTK1  EQU      %
         LW,R1    Y8
         STS,R1   3,R2              SET 'CAL COMPLETE' FLAG FOR IOQ
         ENABLE                     *****UNINHIBIT INTERRUPTS*****
*
CLRSTK2  EQU      %
         PULL     1,R2              CLEAN UP THE STACK
         CW,R2    TSTACK
         BE       1Z8I
         CI,R2    X'91827'          SHRED UPDATE FLAG
         BNE      CLRSTK2
         PULL     1,R2              GET STACK MARKER
         CW,R2    TSTACK
         BNE      CLRSTK2
         STW,SR3  -1,R2             UPDATES
         STW,SR1  -3,R2
         LW,R3    CFU,R6
         LW,R1    0,R3
         AND,R1   NB31TO0+14  TURN OF SHARED UPDATE BIT IN CFU
         STW,R1   0,R3
*  TRUNC BUF1 & BUF2
         LI,SR4   1Z8I1             SET RETURN
*  FALL INTO TRUNK
         SPACE    3
TRUNK    PUSH     SR4
         BAL,R0   CLRBFUB
         BAL,R0   CLRBBUF
         LI,SR2   2
         LW,SR3   BUFX,R6
TRUNK1   LI,D3    X'1F'
         AND,D3   SR3
         BEZ      %+3
         LI,R5    0
         BAL,R2   T:RBUF
         REF      T:RBUF
         SLS,SR3  -5
         BDR,SR2  TRUNK1
         SLS,SR3  10
         STW,SR3  BUFX,R6
         B        PULLEXIT
         SPACE    2
1Z8I     RES      0
         STW,SR3  -1,R2             UPDATES
         STW,SR1  -3,R2
1Z8I1    RES      0
         LI,R0    K0
         LI,R1    K1FFFF
         LI,R3    X'1FF80'
         CW,R3    ERO+J:JIT
         BAZ      %+2               DON'T CLEAR ERROR CODE
         STS,R0   ERO+J:JIT
         STS,R0   ABO+J:JIT
         LW,1     OPNCLSUS
         BEZ      1Z8               NO OPN OR CLS USER
         CW,1     S:CUN
         BNE      1Z8
         CW,R2    OPNCLSTK
         BNE      1Z8
1Z80     RES      0
         STW,0    OPNCLSUS
         REF      R:OCR,SB:RQ
         LW,6     S:CUN
         LH,4     UH:FLG,6
         AND,4    NB31TO0+4         RESET OPNCLSUSR BIT
         STH,4    UH:FLG,6
         LI,4     R:OCR
         DISABLE
         LB,5     SB:RQ,4           TEST FOR ANYBODY WAITING
         BEZ      1Z8
         LI,6     E:NOCR
         BAL,11   T:RUE
1Z8      RES      0
         ENABLE
         PULL     7,R5
         B        *11
*
T:UBLKOCU EQU     %
         PUSH     7,R5
         B        1Z80
*
PUSHALL  EQU      %
         PUSH     7,R5
         LW,R0    TSTACK
         PUSH     1,R0
         B        0,R1
PULLEXIT1   EQU   %
         PULL     1,R0
         AI,R0    K1
         B        *R0
         PAGE     IOCHEK
*                                   IOCHEK WAITS FOR ALL IO ON THE DCB
*                                   TO BE COMPLETED--THEN IT CHECKS
*                                   THE TYPE OF COMPLETE ON THE LAST
*                                   OPERATION
*                                   R5 = JIT ADDRESS
*                                   R6 = DCB ADDRESS
*                                   R7 = PLIST
*                                   SR1 = OPCODE
*                                   CALLING SEQUENCE---BAL,SR4  IOCHEK
*
*                                   ON RETURNING -- SR3 = ERR/ABN CODE
*                                                         AND DCB ADDR
*                                                    SR1 = USERS ADDRESS
IOCHEK   EQU      %
         LW,12    TSTACK            PUSHALL FUNCTION
         AI,12    -1
         LI,1     -7
         LCI      8
         STM,5    *TSTACK,1
         LW,D2    Y002
         AND,D2   FCD,R6            CK IF DCB IS OPEN
         BEZ      MSRWRTX           GET OUT IF NOT OPEN
         BAL,1    JHKBIT3
         STS,2    ERO+J:JIT
         BAL,1    JHKBIT
         STS,2    ABO+J:JIT
         BAL,R1   JHKBIT            CHECK FOR ECB SPECIFICATION
         B        CALLCK1           B, IF THERE & WAIT 'TIL POSTED
         DO       CNM
         LW,R1    CNMLNDCB          GET MASK FOR CNM LINE DCB
         CS,R1    0,R6              SEE IF THIS IS A CNM LN DCB
         BNE      MSREXIT1          B, IF NOT; NO PROBLEM
         LW,SR3   ECBERR6           BUT NO ECB ON LN I/O CK IS AN ERROR
*
CKECBERR EQU      %
         LI,SR4   PULLALLEXIT       LOAD APPROPRIATE EXIT ADR
         PUSH     1,SR4             SAVE IT
         LI,R5    J:JIT             RESTORE JIT ADR TO R5
         B        CNMCKERX          *****EXIT I/O CHECK W/ ERROR*****
         ELSE
         B        MSREXIT1          BEGIN EXIT
         FIN
*
CALLCK1  EQU      %
         LW,R5    R2                MOVE ECB ADR TO INPUT REG
*
CALLCK1A EQU      %
         BAL,SR4  ECBCHCK1          WAIT FOR ECB TO BE POSTED
         LB,R1    R5                GET RETURNED CC'S FOR ERROR CK
         BEZ      CKPOST            B, IF ALL ZEROS;REQUEST ACCEPTED
         SLS,R1   -28               ELSE, USE CC'S AS INDEX INTO ERR TBL
         LW,SR3   ECBERRTBL-2,R1    PICK UP APPROPRIATE ERR/ABN CODE
         B        CKECBERR          *****TAKE ERROR EXIT*****
*
CKPOST   EQU      %
         LW,R3    CNMLNDCB          GET MASK FOR CNM LINE DCB
         CS,R3    0,R6              SEE IF THIS IS A CNM LINE DCB
         BNE      MSREXIT1          B, IF NOT; TYC IN DCB IS OK
         LW,R4    1,R5              GET COMPLETION CODE IN ECB
         MTB,1    R4                CK FOR ERR/ABN CODE VS TYC/ARS
         BEZ      SAVEXIT           B, IF CODE, SKIP TYC, ARS, INDX CKS
         LB,D1    R4                ELSE, GET TYC FROM POSTED ECB
         AI,D1    -1                MAKE THE TYC RIGHT AGAIN
         BAL,R0   SETTYC            STORE TYC IN DCB & SET EGV=1
         BAL,R1   JHKBIT            CHECK FOR INDX SPECIFICATION
         B        %+2               PROCESS IF THERE
         B        SETARS            ELSE, SET UP ARS IN DCB
         CW,R2    REGMASK           SEE IF ADR IS A REG
         BANZ     %+2               B, IF NOT
         AW,R2    J:BASE            ELSE, POINT TO USER'S REG VALUE
         LI,R3    1
         LB,R3    R4,R3             PICK UP INDEX VALUE
         STW,R3   0,R2              STORE IN USER'S INDX ADR
*
SETARS   EQU      %
         LI,R3    BARNDEV           GET DCB'S RNDEV OFFSET
         LB,R3    *R6,R3            CK RNDEV BYTE
         BNEZ     SAVEXIT           B, IF BI-PNT LN; ARS ALREADY SET
         LI,R5    X'E0000'          MASK FOR BLK & ARS DCB FIELDS
         SLS,R4   17                ADJUST ARS
         STS,R4   WAARS,R6          STORE IN DCB
*
SAVEXIT  EQU      %
         LI,SR4   PULLALLEXIT       LOAD CORRECT EXIT ADR
         PUSH     1,SR4             SAVE IT
         LI,R5    J:JIT             RESTORE JIT ADR TO R5
         B        CKEGV             CONVERT TYC CODE
CODE     RES      0
         DATA,1   0                 TYC=0 NORMAL-NO DEVICE I/O
         DATA,1   0                 TYC=1 NORMAL-DEVICE I/O
         DATA,1   7                 TYC=2 LOST DATA
         DATA,1   X'1D'             TYC=3 BEGINNING-OF-TAPE
         DATA,1   4                 TYC=4 BEGINNING-OF-FILE
         DATA,1   X'1C'             TYC=5 END-OF-REEL
         DATA,1   5                 TYC=6 END-OF-DATA
         DATA,1   6                 TYC=7 END-OF-FILE
         DATA,1   X'41'             TYC=8 READ ERROR
         DATA,1   X'45'             TYC=9 WRITE ERROR
         DATA,1   X'57'             TYC=A PUB DEV/PRIV SET SATURATED
         DATA,1   0                 TYC=B SLIDES=255
         DATA,1   0                 TYC=C PARTIAL HIGHER LEVEL INDEX BUILT
         DATA,1   X'33'             TYC=D; PURGE CAL ENDED RD/WRT
         DATA,1   X'5B'             TYC=E; LN HUNG UP W/RD PENDING
         DATA,1   X'5C'             TYC=F; LN HUNG UP; INCOMPLETE WRT
         DATA,1   0                 TYC=10 UNUSED
         DATA,1   0                 TYC=11 UNUSED
         DATA,1   0                 TYC=12 UNUSED
         DATA,1   X'4F'             TYC=13 WRITE ERROR AFTER END-OF-TAPE
         BOUND    4
         PAGE
         SPACE    2
*
*  PURPOSE:  WAIT FOR ALL I/O FOR A DCB TO COMPLETE
*
*  INPUT:  R6 = DCB ADDRESS
*
*  CALL:   BAL,SR4    IOSPIN
*
*  REGISTERS DESTROYED:  R1
*
IOSPIN   LW,1     Y7F
         CW,1     FCN,R6
         BAZ      BSR4              EXIT IF NO I/O IN PROGRESS
         DISABLE
         AND,1    FCN,R6
         BEZ      ENBSR4            COMPLETED - EXIT
         XPSD,0   REGIPSD
         LW,1     S:CUN             GET CURRENT USER NO
         LB,1     UB:MF,1           AND GET HIS FUNCTION COUNT
         BEZ      ENBSR4            ALL I/O IS DONE - GET OUT
         ENABLE
         B        IOSPIN
         REF      UB:MF
         REF      REGIPSD
         PAGE
         DEF      GETKEYSB,RECT2
GETKEYSB LI,R1    BASCR
         LB,R1    *R6,R1
         LW,D4    KBUF,R6
RECT2    LI,R4    0
RECT1    LI,R2    X'FFFF'
*   FALL INTO RECTRAN
*  RECTRAN FOR SIGMA7 USING MBS INSTRUCTION
*       R1 = USER BUFFER SIZE
*       R2 = MONITOR BUFFER SIZE
*       R3 = MONITOR BYTE DISP (IS INCREMENTED)
*       R4 = USER BYTE DISP    (IS INCREMENTED)
*       D3(R14) = MONITOR BUFFER ADDRESS (WA)
*       D4(R15) = USER BUFFER ADDRESS (WA)
*
*       BYTES MOVED FROM USER BUFFER
*       TO MONITOR BUFFER
*
RECTRAN  EQU      %
         LCI      5
         PSM,14   TSTACK
         ANLZ,5   2B1
         ANLZ,15  2B1+1
         LW,14    5
         SW,1     4                 GET # BYTES TO MOVE
         SW,2     3                 INTO R2
         CW,2     1
         BLE      REC5
         LW,2     1
REC5     EQU      %
         AW,3     2                 FIX R3 & R4 FOR RETURN
         AW,4     2
         AI,2     -256
         BLZ      REC1              1 MOVE
REC3     OR,15    YFC               COUNT = 252
         MBS,14   0
         AI,2     -252
         BGEZ     REC3
REC1     STB,2    15
         MBS,14   0
         LCI      5
         PLM,14   TSTACK
BSR4     B        *SR4
*
*
2B1      LB,5    *15,4
         STB,5    *14,3
*
MODEFRMA EQU      %
         LI,SR4   REDX-1
MODEFRM  EQU      %
         LW,R0    MOD,R6                                                715
         LI,R1    K20000                                                715
         SLD,R0   8                                                     715
         STS,R0   SR1
         LI,R2    K600
         AND,R2   PCK,R6
         SLS,R2   20
         OR,SR1   R2
*
*                                   FORTRAN CONVERSION
         CW,R0    Y004
         BAZ    %+2
         OR,SR1   Y1
         REF      Y1
         CW,R0    Y008
         BAZ      *SR4
         OR,SR1   Y01
PLX1SR4  RES      0
         DEF      PLX1SR4
         AI,SR4   K1
         B        *SR4
GETDEV   EQU      %
         LW,R3    Y006
         AND,R3   0,R6
         BEZ      GETDEV1
GETTDEV  EQU      %
         LI,3     6
         LB,3     *6,3
         AND,3    XBF
         CI,3     X'90'             USER TELETYPE
         BNE      GETTDEV1
         LW,3     METXT
         PUSH     2
         B        JD1
GETTDEV1 EQU      %
*
*
*                 DEVICE PACK IS THE NO DEVICE
         REF      M6,TB:FLGS
*
*
         AND,3    M6                DEVICE TYPE
         LC       TB:FLGS,3         FLAGS
         BCR,8    NOPK
         BCR,4    NOPK
         LI,3     0                 FORCE TO NO
         B        *D4               ***
NOPK     RES      0
         LW,3     DSI,6
         AND,R3   XFF
         B        *D4
GETDEV1  EQU      %                 NEVER BEEN OPEN
         PUSH     R2
         LI,R3    DSI+2
         LH,R3    *R6,R3
         CI,R3    K8000
         BAZ      GETDEV2
JD1      RES      0
         LI,R2    OV:NMSZ           SIZE OF NAME TABLE
         CH,R3    OH:NM,R2
         BE       %+2               FIND TEXT IN NAME TABLE
         BDR,R2   %-2               SEARCH ALL OF NAME TABLE
         LW,R3    R2                IF ZERO 'NO' DEVICE
KRD1     CI,3     OV:NMSZ-SV:LSIZ
         BGE      KRD2
         REF      SV:LSIZ
         LB,2     J:JIT             JOB TYPE
         SLS,R2   -6                0=BATCH,1=GHOST,2=ONLINE
         EXU      TX,R2             R3=DCTX/RATX/LATX
         CLM,R3   RATRANGE          CHECK FOR RATX
         BCS,9    KRD2              NO-SET CC & RETURN
         LI,R3    0                 SET RATX TO ZERO
KRD2     PULL     2
KRDA     AI,R3    0                 SET CC
         B        *D4               RETURN
GETDEV2  EQU      %                 OP LABEL INDEX
         AND,R3   XFF               GET OP LABEL INDEX
         AI,R3    TYPMNSZ           CONVERT TO TABLE INDEX
         B        KRD1
*
JTX      EQU      %                 USED BY OPN
         DEF      JTX
TX       LB,R3    OB:BTX,R3         BATCH
         LB,R3    OB:GTX,R3         GHOST
         LB,R3    OB:OTX,R3         ONLINE
         BOUND    8
RATRANGE DATA     DCTSIZ+1
         DATA     DCTSIZ+1+SV:RSIZ+1-1
*
MSROTHR  LI,SR4   MSROTHR1
*
PUTSZBF1 EQU      %                 PUT USER BUFFER ADR AND SIZE INTO
         LW,R2    RWS,R6            ENTRIES FOR QUEUE
         LW,D3    BUF,R6
*
PUTSZBF  EQU      %                 PUT BUFFER AND SIZE IN DCB
         LI,R3    X'7FFF'
         SLD,R2   17
         STS,R2   BLK,R6
         LI,D4    K1FFFF
         STS,D3   QBUF,R6
         SCS,R2   15
         B        *SR4
*
INRRWS   LI,D4    INRRWS1
*
GETBTD   EQU      %                 GET BYTE DISPLACEMENT FROM DCB
         LI,R4    K30
         AND,R4   BTD,R6
         SLS,R4   -4
         B        *D4
*
*
CHKREW   EQU      %                 SLEEPS USER IF REW IN PROGRESS
         LW,SR2   SR4               SAVE LINK
         BAL,R3   GETAVR
         BGE      *12               NOT A TAPE
CHKREW1  EQU      %
         DISABLE
         LC       AVRFLGS,R2
         BCR,3    CHKREWX           NOT IN REW
         BCS,2    CHKREW2           IN REW, SO PUT TO SLEEP
         CI,12    IOQUEUE12         IS THIS REW CHK ONLY
         BNE      CHKREWX           YES
CHKREW2  EQU      %
         PUSH     R6
         LI,R6    E:NQW
         BAL,SR4  T:REG             SLEEP TILL REW CPLT
         LW,SR4   SR2
         PULL     R6
CHKREWX  ENABLE
         AI,12    1
         B        *12
*
*
READTP   LI,SR3   K22
TAPEOP   LI,SR1   K1FFFF
         AND,SR1  R6
         STB,SR3  SR1
         LW,SR4   SR2
IOQUEUE1 EQU      %
         BAL,12   CHKREW
         B        IOQUEUE19         NOT TAPE
         CI,SR3   X'C'
         BLZ      IOQUEUE18         NOT FSF,BSF,REW
         CI,SR3   X'F'
         BGE      IOQUEUE18
         LW,1     SR3
         LB,SR3   OLDNEW,1          CONVERT TO NEWQ CODE
DONEWQ   EQU      %                 SETS UP CALL TO NEWQNWM
         LI,15    0
DONEWQM  LI,0     TAPEA             END-ACTION FOR TAPE SPACING
DONEWQP  EQU      %                 PRECORD ENTRY POINT
         DEF      DONEWQP,DONEWQM
         BAL,12   CHKREW1
         NOP      0
         LW,1     S:CUN
         STH,R2   1                 AVRX,USER #
         MTH,1    AVRNOU,2          COUNT OUTSTANDING ASYNC I/OS
         LB,12    AVRFLGS,2
         CI,SR3   8                 REW
         BNE      %+2
         OR,12    BT31TO0+6         REW FLAG
         OR,12    BT31TO0+5         ASYNC TAPE SPACE FLAG
         STB,12   AVRFLGS,2
         DEF      DONEWQ
         LW,12    1,6
         STB,12   13                SAVE DCTX
         LB,12    12                NRT
         SLD,12   8                 ,,NRT,DCTX
         LB,13    CJOB
         STH,13   12                ,PRI,NRT,DCTX
         STB,SR3  12                FUNCTION,PRI,NRT,DCTX
*
         LI,13    0
         LI,14    0
         BAL,11   NEWQNW
         NOP
         B        *SR2
OLDNEW   EQU      %-1
         DATA,1   4,5,0,0           BSR,FSR,,
         DATA     0
         DATA,1   7,6,8,3           FSF,BSF,REW,WEF
IOQUEUE18 EQU     %
         LC       AVRFLGS,2
         BCR,1    IOQUEUE19         NO ASYNC TAPE OPS TO WAIT FOR
         BAL,12   CHKREW            SLEEP FOR TAPE OPS CPLT
IOQUEUE12 EQU     %
         NOP      0
IOQUEUE19 EQU     %
         LI,R1    BAFCN
         LB,R0    *R6,R1
         BNEZ     IOQUEUE3          STILL SOME OUTSTANDING FUNCTIONS
         LI,R3    K1000             HAS THE TYC BEEN CHECKED
         AND,R3   EGV,R6
         BNEZ     IOQUEUE3          YES
         BAL,R4   GETTYC            NO--WAS IT AN ERROR--R3 = TYC
         CI,R3    K8
         BL       IOQUEUE3
         CI,R3    X'B'
         BNE      IOQUEUE4
IOQUEUE3 EQU      %
         DO       CNM
         LW,R3    CNMLNDCB          GET MASK FOR CNM LINE DCB
         CS,R3    0,R6              SEE IF THIS IS A CNM LN DCB
         BE       CNMLNCD           B, IF SO; FURTHER PROCESSING NEEDED
         FIN
         MTB,1    *R6,R1
         B        COOP
IOQUEUE4 EQU      %
         LC       J:JIT
         BCS,4    IOQUEUE6          DONT ABORT GHOSTS
         LW,R1    Y02
         STS,R1   J:RNST
         REF      J:RNST
IOQUEUE6 EQU      %
         LB,R3    CODE,R3           READ/WRITE ERROR
         LI,R1    BAABC             SET ABORT CODE
         STB,R3   J:JIT,R1
         LI,R1    BAFCN
         B        IOQUEUE3
*
*
IOQUEUE2 LI,D4    IOQUEUE1
*
*SETBTDZ -SETS BYTE DISPLACEMENT IN DCB POINTED BY R6  TO ZERO
*LINKED  BY D4   USES R0 AND R1
*
SETBTDZ  LI,R0    K0                LOAD ZEROS
SETBTDQ1 EQU      %
         LI,R1    KC0
         STS,R0   BTD,R6            SET BITE DISPL EQUAL TO ZERO
         B        *D4               RETURN
SETBTDQ  EQU      %
         LW,R0    BTD,R6
         SLS,R0   2
         B        SETBTDQ1
*
RESBTD   EQU      %
         SLS,D1   4
         LI,D2    K30
         DO       BTD=EGV
         B        SETTYC1+1
         ELSE
         STS,D1   BTD,R6
         B        *R0
         FIN
IOQUEUE  LI,D4    IOQUEUE2
*
SETMBG   EQU      %                 SET MONITOR BUFFER FLAG
         LW,R0    Y008
SETMBG1  EQU      %
         LW,R1    Y008
         DO       MBG=BTD
         B        SETBTDQ1+1
         ELSE
         STS,R0   MBG,R6
         B        *D4
         FIN
INRRWS1  RES      0
         AWM,R4   RWS,R6
         B        *SR4              RETURN
*
         DEF      CHKBIT0
CHKBIT0  LI,D2    K1FFFF
CHKBIT1  EQU      %
         LW,D3    0,R7
         LI,R1    X'80001'
CHKBIT   EQU      %
         SLS,D3   1                 IS IT PRESENT
         BEV      ONE,R2
         LW,D1    *R7,R1
         BGEZ     CHKBIT2           INDIRECT BIT NOT SET
         CI,D1    X'1FFF0'
         BANZ     %+2
         AW,D1    J:BASE
         LW,D1    *D1
CHKBIT2  EQU      %
         BIR,R1   0,R2
         PAGE     MERC DESC
REDCDEV1 LI,R1    K2000             HAS USER TRIED TO READ
         CW,R1    AGV,R6            FROM THIS DEVICE BEFORE
         BAZ      REDCDEV2          NO
         LW,SR3   Y54
         LI,SR4   PULLALLEXIT
* MERC  - CALLING SEQUENCE = BAL,SR4  MERC
*        INPUT--(SR3),BYTE 0 = ERR OR ABN CODE
*             --(SR3),BYTE 1-3 = DCB ADR
*        OUTPUT--(SR1) = 0
*        RUN STATUS IS SET TO I/O ERROR
MERC     EQU      %
         LI,R5    J:JIT
         LC       SR3
         BCR,KC   MERC1             AN ABNORMAL CODE
         LI,R2    BAABC
         STW,D1   J:BASE
         LW,D1    SR3
         SCS,D1   8
         STB,D1   J:JIT,R2
         SLS,D1   -25
         LI,D2    X'1FFFF'
         STS,D1   ERO+J:JIT
         LW,D1    J:BASE
         LW,D2    Y02
         LC       SR3
         BCR,8    %+2
         LW,D2    Y01
         STS,D2   RNST+J:JIT
MERC1    EQU      %
         AI,SR1   0
         BE       MERC2
         LW,SR1   TSTACK+5+8
MERC2    EQU      %
         B        *SR4
         PAGE
         SPACE    2
*
*  PURPOSE:  MAP BUF1 AND BUF2 FOR A DCB
*
*  INPUT:  R6 = DCB ADDRESS
*
*  CALL:   BAL,R0    MAPBUFS
*
*  ALL REGISTERS VOLATILE
*
MAPBUFS  EQU      %
         LI,R5    X'F'
         AND,R5   ASN,R6
         CI,R5    2
         BG       *R0               NOT DISC OR LABELLED TAPE
         LI,R1    BUFF1**-9         INDEX TO CMAP FOR BUFF1
         LI,R2    X'1F'             MASK TO EXTRACT BUFF1
         AND,R2   BUFX,R6           GET IT
         BEZ      MB17              NONE
         AI,R2    JXBUFVP-1         CONVERT TO CMAP INDEX
         LOAD,R12 JX:CMAP,R2        GET PHYS PAGE NUMBER OF BUFFER
         STORE,R12 JX:CMAP,R1       AND PLACE IN BUFF1 WINDOW
MB17     LI,R2    X'1F'**5          MASK TO EXTRACT BUFF2
         AND,R2   BUFX,R6           GET IT
         BEZ      MB19              NONE
         SLS,R2   -5                RIGHT ALIGN
         AI,R2    JXBUFVP-1         CONVERT TO CMAP INDEX
         LI,R1    BUFF2**-9         INDEX TO CMAP FOR BUFF2
         LOAD,R12 JX:CMAP,R2        GET PAGE NUMBER FOR BUFF2
MB18     STORE,R12 JX:CMAP,R1       AND MOVE TO WINDOW FOR BUFF2
MB19     ANLZ,R12 MB18              GET ADDRESS OF WINDOW
         SLS,R12  :BIG-2            WORD ADDRESS
         LW,R13   S:BUFMCW          COUNT AND START PAGE NUMBER
         LDMAP,R12 0                RELOAD THE WINDOW
         B        *R0
         PAGE
         SPACE    1
         DEF      RAT:DCT4,GETRAT
         DEF      DHHIT,DHHIT1
         DEF      SC31
         REF      SB:RTY,J:ASPIN
         PAGE
*           GET   RESOURCE INDEX  IN  1
RAT:DCT4 RES      0                 PICK UP 4 FROM DCT4
         LB,4     DCT4,2
*        FALL THROUGH
*           4=TYPE
*           BAL,11
*              NOT THERE
*        OK
GETRAT   RES      0
         LI,1     SV:RSIZ
         CB,4     SB:RTY,1
         BE       PLX1SR4         A FIND
         BDR,1    %-2
         B        *11             NO FIND
         PAGE
SC31     RES      0
         SUA      X'31'
         PAGE
* DOES HE HAVE IT?
*        BAL,11   DHHIT
*        BANZ     YES
DHHIT    RES      0
         LW,4     2
DHHIT1   RES      0
         SCS,4    -5
         LB,0     4
         SLS,0    -3
         AI,0     BT31TO0+1
         LW,0     *0                PICK UP BIT
         CW,0     J:ASPIN,4         CHECK AGAINST JIT
         B        *11
         PAGE
         DO       CNM
         DEF      CNMERRX1
         SREF     MOCIOP            *****SREF*****
         REF      ADR:ECB,QUEUE,MODE,Y04
*
CNMLNCD  EQU      %
         LI,R2    0                 INITIALIZE R2
         LW,R3    ADDRMASK
         LS,R2    J:RWECB           SEE IF ECB WAS SPECIFIED
         BNEZ     %+3               B, IF IT WAS
         LW,SR3   ECBERR5           IT'S AN ERROR IF IT WASN'T
         B        CNMERRX0          *****TAKE ERROR EXIT*****
         LW,D2    R2                SAVE 4-WD BLOCK ADR
         LW,D4    ADDRMASK
         LI,D3    0                 SET J:RWECB=0; ECB WILL BE POSTED
         STS,D3   J:RWECB           BY CNM SLV LINE ROUTINES
         LW,D3    1,R2              GET ECB ADR FROM 4-WD BLOCK
         STS,D3   ADR:ECB,R6        SAVE ECB ADR FOR CNM SLV LN COC CODE
         LI,R4    BARNDEV           BYTE OFFSET OF RNDEV
         LB,R5    *R6,R4            GET VALUE OF RNDEV BYTE
         BEZ      MOCIOP            0 MEANS MULTI-PNT LN
         CW,SR1   Y04               CK IF THIS IS A WRITE OPERATION
         BANZ     CALLIOQ           B, IF SO
         LW,SR3   LNERR02           ANTICIPATE TROUBLE
         AI,R5    -1                CNMPROC9 ADDED 1 TO INSURE NON-0
         LC       MODE,R5           SEE IF READ PENDING
         BCS,1    CNMERRX1          *****B, IF SO; IT'S AN ERROR*****
*
CALLIOQ  EQU      %
         MTB,1    *R6,R1            INCREMENT #I/O OPS NOT COMPLETED
         BAL,R1   ECBFBLK           RELEASE THE 4-WORD BLOCK
         B        QUEUE             QUEUE THE REQUEST
*
LNERR02  DATA     X'00000059'       BI-PNT RD W/RD OUTSTANDING
*
CNMERRX1 EQU      %
         LW,R1    ADDRMASK
         LI,R0    0
         STS,R0   ADR:ECB,R6        REINITIALIZE DCB'S ECB ADR SLOT
         LW,R0    D2                GET POINTER TO 1ST 4-WORD BLOCK
         STS,R0   J:RWECB           RESTORE TO JIT FOR PULLALLEXIT
         LI,R1    2                 COMPLETION CODE OFFSET IN BLK
         LW,R5    SR3               MOVE ERR/ABN CODE TO WORK REG
         SCS,R5   8                 ADJUST CODE, SUBCODE IN RT HALF-WD
         OR,R5    YFF               DISTINGUISH BYTE 0 FROM A TYC
         STW,R5   *D2,R1            USE ERR/ABN CODE FOR PRE-I/O ERR
         LI,R5    J:JIT             RESTORE JIT ADR TO R5
*
CNMERRX0 EQU      %
         LI,R7    K1000             GET MASK FOR DCB'S EGV BIT
         STS,R7   EGV,R6            INDICATE THIS 'TYC' HAS BEEN CK'ED
         B        MSR01EXIT         *****TAKE ERROR EXIT*******
         FIN
         PAGE
*
*
CALLGBLK EQU      %
         DEF      CALLGBLK
         REF      E:CFB,ECBGBLK
*
         PUSH     1,R6              SAVE DCB PNTR
         BAL,R1   ECBGBLK           REQUEST A 4-WORD BLOCK
         BNEZ     %+4               B IF GOT
         LI,R6    E:CFB             ELSE WAIT FOR ONE TO BE FREED
         BAL,SR4  T:REG
         B        %-4               TRY AGAIN
         PULL     1,R6              RETRIEVE DCB PNTR
         LI,R1    0
         STW,R1   0,R2              INITIALIZE WD0; ECBGBLK DID 1-3
         B        *D4               *****EXIT CALLGBLK*****
*
*
ECBERRTBL EQU     %
ECBERR1  DATA     X'0400004A'       ECB IN WRONG STATE; ECBW=1 OR ECBI=0
ECBERR2  DATA     X'0600004A'       INFINITE WAIT CONDITION ON CK ECB
ECBERR3  DATA     X'0800004A'       NO MONITOR WORK SPACE  FOR CK ECB
ECBERR4  DATA     X'0A00004A'       WRONG ACCESS CODE FOR ECB
ECBERR5  DATA     X'0000005A'       NO ECB ADR GIVEN ON CNM LN I/O REQUEST
ECBERR6  DATA     X'0200005A'       NO ECB ADR GIVEN ON CNM LN CK ECB
         END

