*        704718   SIGMA 5/7         BPM M:RDL
MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         DEF      RDL,RDLSZ
RDL      EQU      %
*
         PAGE
         BOUND    8
K2       EQU      2
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K6       EQU      X'6'
KA       EQU      X'A'
KC       EQU      X'C'
K50      EQU      X'50'
KFFFF    EQU      X'FFFF'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
KN1      EQU      -X'1'
K40000   EQU      X'40000'
BARNR    EQU      4*RNR
         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
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
         PAGE
*
*        JIT REFS FOR MOVE CAL
*
         REF      J:JIT
         REF      J:DCBLINK
         REF      J:ASSIGN
         REF      J:JAC
         REF,1    JB:PNR
         REF      J:IDELTAT
         REF      J:DELTAT
         REF      J:OVHTIM
         REF      J:CTIME
         REF      ERO
         REF      ABO
         REF      JOVVP
*
*        FILE MANAGE REFS FOR MOVE CAL
*
         REF      PUSHALL
         REF      JHKBIT
         REF      JHKBIT3
         REF      ISEQUB
         REF      IOSFILE
         REF      WRITEL
         REF      MSRWRT
         REF      PULLALLEXIT
         REF      MAPBUFS
*
*        SCHEDULER REFS FOR MOVE CAL
*
         REF      S:CUN
         REF      S:HIR
         REF      SL:SQUAN
         REF      SL:QUAN
         REF      PLH:QN
         REF      E:QE
         REF      T:REG
*
*        MISCELLANEOUS REFS
*
         REF      UH:FLG
         REF      UH:FLG2
         REF      M2
         REF      Y4
         PAGE
         REF      Y0004
         REF      Y0008
         REF      Y000A
         REF      Y02
         REF      Y04
         REF      Y002
         REF      Y001
         REF      PULLEXIT
         REF      SETTYC
         REF      TRANSFERUB2
         REF      TAPEOP
         REF      GETTYC
         REF      IOSPIN
         REF      MSREXIT
         REF      SETBTDQ
         REF      GETCMD
         REF      PULLEXIT1
         REF      BATAPE,ANSFLGS
         REF      YFFFFFFFC
         REF      SETCMD1
         REF      PULLFOUR
         REF      GETDIR
         REF      CLRTRN
         REF      SETEOP
         REF      INITARS
         REF      KEYTRN
         REF      SAVBLK
         REF      TRANX
         REF      MSRRED,IOCHEK1
         REF      CHKANS0
KB       EQU      X'B'
Y22      DATA     X'22000000'
         PAGE
         REF      GETBBUF
         REF      BLKIN
         REF      CBB4
         REF      CBB5
         DEF      RDBLK
         DEF      TRNREC
         DEF      CLRBBUFL
         DEF      CHKTP
         DEF      ISEQICRL
         DEF      SETCMDL
         DEF      GTFL
         DEF      CHKTRN
         DEF      CLRTP
         DEF      SKRECR
         DEF      RDBLKX1
         DEF      RDBLKX3
         DEF      RDBLKX
         REF      GETAVR
         REF      AVRTBL
         REF      ARD2
         REF      ARD3
         REF      CHKEOF
         PAGE     LBLT DEFS
         DEF      READL
         REF      READLEND
         REF      QUEUE1
         PAGE
Y0014    DATA     X'140000'
         PAGE
READL    EQU      %
         BAL,R0   CHKANS0
         BAL,SR4  IOCHEK1           IF ANS,DO SPIN&POSTANS
         LW,R0    Y0008
         CW,R0    EOP,R6
         BAZ      RDL1
*                                   WRITE EOF
         OVERLAY  OPNTPSEG,RDCLS#
         REF      OPNTPSEG,RDCLS#
         LI,D1    0
         BAL,R0   SETEOP
*
RDL1     EQU      %
         LI,D1    0
         BAL,R0   SETTYC
         BAL,R0   CHKANS0
         B        MSRRED            DO DEVICE I/O IF ANS DCB
         LI,D3    K1FFFF
         AND,D3   KAD,R6
         BNEZ     ARD2
RDL2     EQU      %
         BAL,D2   GETDIR
         BANZ     ARD3
RDL5     EQU      %
         LI,D3    BUF1MSK
         AND,D3   BUFX,R6
         BEZ      RDL6
         LI,D3    BUFF1
         INT,D2   ORG,R6            IS EVC ON
         BCR,1    RDL3
         BAL,11   CHKCON
         REF      CHKCON
         DEF      RDL3
RDL6     EQU      %
         LW,D4    Y1                EVC
         STS,D3   ORG,R6            CLEAR EVC
         BAL,R0   CHKTRN
         B        RDL4
RDL3     EQU      %
         INT,R1   *D3
         CW,R1    BCDA,R6
         BLE      RDL4
         BAL,R0   TRNREC
         B        MSREXIT
RDL4     EQU      %
         BAL,R0   RDBLK
         B        MSREXIT
         B        RDL3
         PAGE
*
*
GTFL     EQU      %
*                                   GET FORWARD ENTRY
*
         PUSH     1,R0
         LI,D3    BUF1MSK
         AND,D3   BUFX,R6
         BNEZ     GTFL3
GTFL44   BAL,R0   RDBLK
         B        PULLEXIT
GTFL3    EQU      %
         LI,D3    BUFF1
         BAL,R0   GETCMD
         BAL,D2   ISEQICRL
         BAL,R0   PULLFOUR          GET SIZE
         AW,R3    D1
         BAL,D2   NXTWD
         BAL,R0   SETCMD1
*
         MTW,1    BCDA,R6
         LW,R1    BCDA,R6
         LI,R2    K1
         CH,R1    *D3,R2
         BL       PULLEXIT1
         CW,D1    Y04               UNBLOCKED RECORD
         BAZ      GTFL1             NO
         PUSH     1,D1
         BAL,SR2  CHKTP
*                                   SKIP RECORD
         BAL,SR2  SKREC
         BAL,0    CLRBBUFL          AVOID CONFUSION AS TO POS
         LI,3     X'FFFF'
         STW,3    CMD,6
         PULL     1,D1
*
GTFL1    EQU      %
         CW,D1    Y02
         BANZ     GTFL44
*
GTFL2    EQU      %                 DETERMINE WHETHER OR NOT TO CONTINUE
*                                   SKIP
         PULL     R0
         CI,R0    TRNRECXX
         BE       TRNRECX1
         PAGE
RDBLK    EQU      %
         PUSH     1,R0
         REF      Y3
         LW,1     Y3
         STS,0    FIL1,R6           CLR EIC/EVC
RDBLK1   EQU      %
         BAL,SR2  CHKTP
         BAL,R0   IOWTALT
         BE       RDBLKX
         CI,R3    K6
         BNE      RDBLKX4
         BAL,R3   GETAVR
         AI,1     1
         STD,0    AVRTBL,2
         BAL,R0   CLRBBUFL
         BAL,11   CHKEOF
         B        PULLEXIT
*                                   WAS VOL SUCCESSFULLY CLOSED         718
         LW,R3    Y002
         CW,R3    FCD,R6
         BAZ      RDBLKX1
         B        RDBLK1            INIT REQUEST
RDBLKX   EQU      %
         OBAL     BARB,ARDLSEG      YES
         REF      BARB
RDBLKX4  EQU      %
         DEF      RDBLKX4
         BAL,R0   SETCMDL
         LI,R0    K0
         STW,R0   BCDA,R6
         LI,D3    BUFF1
         LH,R0    *D3               PREV BLK SIZ
RDBLKX2  EQU      %
         LI,R1    HAPBD
         STH,R0   *R6,R1
         INT,R1   ORG,R6            IS EIC ON
         BCR,2    PULLEXIT1         NO.EXIT SKIPPPING
         OB       FSEG,ARDLSEG      YES. SEE IF 1ST RECORD IS CONTINUED
         REF      FSEG
RDBLKX1  EQU      %
         LI,D1    KA
RDBLKX3  EQU      %
         BAL,R0   SETTYC
         B        PULLEXIT
*
*
         PAGE
TRNREC   EQU      %                 TRANSFER RECORD TO USER
         PUSH     1,R0
         BAL,D2   CLRTRN
         LW,D1    Y0004
         BAL,R0   SETEOP
*                                   SET UP ARS
         BAL,SR4  INITARS
*
TRNREC1  EQU      %
         LI,D3    BUFF1
         BAL,R0   GETCMD
         BAL,R0   KEYTRN
         AI,R3    3
         SLS,R3   -2
         LW,D1    *D3,R3
         SLS,R3   2
         AI,R3    4
         LB,R7    D1
         LI,R2    KFFFF
         AND,R2   D1
         BEZ      TRNRECX
         BAL,R0   SAVBLK
         LW,D1    RWS,R6
         BNEZ     %+3
         MTW,-1   RWS,R6
         B        TRNRECXX
         SW,D1    R2
         BLZ      TRNREC2
         BEZ      TRNREC2A
         AWM,R2   *TSTACK           ARS
         STW,D1   RWS,R6
TRNREC2B EQU      %
         CI,R7    K4
         BANZ     TRNREC3           UNBLOCKED
         BAL,R0   TRNLBL
         CI,R7    K2
         BANZ     TRNREC4
*                                   NOT CONTINUED
TRNRECX  EQU      %
         BAL,R0   GTFL
TRNRECXX   EQU    %
         BAL,0    GTFL
         NOP
TRNRECX1 EQU      %
         INT,R1   RNR,R6            IS RNR ON
         BCR,4    TRNRX1
         LW,R2    YC                YES
         REF      YC
         AWM,R2   RNR,R6            CLEAR RNR
         B        TRNRX
TRNRX1   EQU      %
         INT,R1   ORG,R6            IS EVC ON
         BCR,1    TRNRX
         OB       EVCR,ARDLSEG      YES. GIVE USER 4102
         REF      EVCR
TRNRX    EQU      %
         LW,D1    RWS,R6
         BGEZ     TRANX
         BAL,SR4  IOSPIN
         B        TRANSFERUB2
*                                   FIX ARS
TRNREC3  PUSH     1,R7              READ WITH ENDAC
         BAL,R0   CLRBBUFL
         BAL,SR2  CHKTP
         LI,R0    X'FFFF'
         STW,R0   CMD,R6
         BAL,D4   SETBTDQ
         LW,SR1   Y22              FUNCTYION CODE
         OR,SR1   R6                DCB
         LI,SR2   READLEND          END ACTION ADR
         LI,R7    BAFCN             FCN
         MTB,1    *R6,R7
         BAL,SR4  QUEUE1            END ACTION ENTRY
         PULL     1,R7
         CI,R7    K2
         BAZ      TRNRECX1
TRNREC4  EQU      %
*                                   NEXT PART OF RECORD
         LW,D1    RWS,R6
         BGZ      TRNREC5
         INT,R1   ORG,R6            IS EVC ON
         BCS,1    TRNRECX           YES. DONT SET RNR
         LI,R1    BARNR             BARNR = X'40'
         STB,R1   *R6,R1            TURN IT ON
         B        TRNRECX
TRNREC5  EQU      %
         BAL,R0   RDBLK
         B        TRNRECX1
         LW,D1    BLK,R6
         SLS,D1   -19
         AWM,D1   QBUF,R6
         B        TRNREC1
*
TRNREC2A CI,R7    K2
         BAZ      TRNREC2
         LI,D1    KN1
TRNREC2  EQU      %
         XW,D1    RWS,R6
         AWM,D1   *TSTACK           ARS
         LW,R2    D1
         BAL,R0   SAVBLK
         B        TRNREC2B
*
TRNLBL   EQU      %
         LW,D1    BLK,R6            CHECK THAT RECORD IS WHOLLY
         SLS,D1   -17                CONTAINED IN BUFFER
         AW,D1    R3
         CI,D1    BUFSIZ
         BG       BARB1             KILL BUFFER, GIVE 41-03
         REF      BARB1             IN ARDL
         PUSH     8,D1
         B        BLKIN
         PAGE
CLRBBUFL EQU      %                 WRITE OUT BUFFER
*
         PUSH     8,D1
         B        CBB5
*
IOWTALT  PUSH     1,R0
         BAL,R0   GETBBUF
         BAL,R0   TPIO
         BAL,SR4  IOSPIN
         BAL,R4   GETTYC
         PULL     1,R4
         CI,R3    8
         B        0,R4
*
CHKTRN   EQU      %
         PUSH     1,R0
         LW,R0    BFL,R6
         CW,R0    Y001
         BAZ      PULLEXIT
         EOR,R0   Y001
         STW,R0   BFL,R6
         CW,R0    Y002              REV CHNGD FOR B00
         BANZ     %+2
         BAL,SR2  SKRECR
         BAL,R0   IOWTALT
         BNE      CHKTRNX           NO
         OBAL     TERR,ARDLSEG
         REF      TERR
CHKTRNX  EQU      %
         B        PULLEXIT1
*
ISEQICRL EQU      %
         LI,R2    BASCR
         LB,R2    *R6,R2
         AW,R3    R2
NXTWD    RES      0
         AI,R3    K3
         AND,R3   YFFFFFFFC
         B        *D2
CHKTP    LW,D1    Y002              REV CHNGD FOR B00
         CW,D1    BFL,R6
         BAZ      *SR2
         BAL,R0   CLRTP
SKREC    EQU      %
         LI,SR3   KA
SKREC1   EQU      %
         LI,R1    K1
        DEF SKREC     *** USED BY ANSTP IN POS ***
         STW,R1   CDA,R6
         INT,R0   RNR,R6            CLEAR R0 BYTE 0, RNR TO CC2
         LW,R1      Y2              EIC. LW DOES NOT DISTURB CC2
         BCR,4      %+2             TEST CC2. IS RNR ON
         AW,R1      Y1              YES. MERGE EVC.
         STS,R0     ORG,R6          CLEAR EIC &, IF RNR ON EVC TOO
         REF        Y1,Y2
         B        TAPEOP
SKRECR   EQU      %
         LI,SR3   KB
         B        SKREC1
SETCMDL  EQU      %
         LI,R3    K4
         B        SETCMD1
TPIO     EQU      %
TPIOF    EQU      %
         DEF      TPIOF
         PUSH     8,D1
         LI,R2    BUFSIZ
TPIOFA   EQU      %
         DEF      TPIOFA
         LW,SR1   Y22
         LI,SR2   READLEND
         LI,R0    CBB4
CLRTP    EQU      %
         LI,D1    K0
         LW,D2    Y002              REV CHNGD FOR B00
         STS,D1   BFL,R6
         B        *R0
         PAGE
*MOVECAL ENTERED FROM CALPROC
MOVECAL  EQU      %
         DEF      MOVECAL
         BAL,R1   PUSHALL
*EXTRACT ERO AND ABO FROM FPT AND STORE IN JIT
         BUMP     4,R3
         LW,4     TSTACK
         AI,7     -1                SET UP FOR JHKBIT
         BAL,R1   JHKBIT3
         STS,R2   J:JIT+ERO
         STS,2    -3,4              SAVE ERO
         BCS,8    %+3               CC1 SET => ERO WAS THERE
NOEROABO LI,10    0
         B        ERROR
         BAL,1    JHKBIT
         STS,R2   J:JIT+ABO         SAVE ABO
         STS,2    -2,4              ABO WASN'T REALLY THERE
         BEV      NOEROABO
         BAL,R1   JHKBIT
         LW,5     2                 SAVE DCB2
         BEZ      NODCB2
         BAL,1    JHKBIT            GET THE BUFFER ADDRESS
         STS,2    BUF,6
         BAL,1    JHKBIT
         STW,2    RWS,6             SIZE INTO INPUT DCB
*
*        FIND AND SAVE HIS CORE QUANTUM
*
         LB,12    J:JIT
         BNEZ     NOTBAT
         LI,2     JB:PNR
         LB,2     0,2
         LH,2     PLH:QN,5
         B        %+2
NOTBAT   LW,2     SL:QUAN
         STW,2    -1,4              SAVE HIS QUAN
*CHECK VALIDITY OF DCB2  (IN R5)
         LI,2     J:DCBLINK-1       DCB TABLE ADDRESS
         LI,3     X'E0000'          COMPLEMENT ADDRESS MASK
         B        VERI4+3           ENTER TABLE SEARCH
VERI1    CW,3     2,2               ASSUME SECOND WORD OF NAME
         BANZ     VERI2             BRANCH IF TRUE
         BDR,2    VERI3             BACK UP A WORD; ITS A DCB LOC
         AI,2     1                 IT'S A LONG NAME
VERI2    CW,3     3,2               AN ADDRESS IS EXPECTED
         BAZ      VERI3             BRANCH IF IT IS
         B        %-3               MOVE AHEAD ONE WORD
VERI3    CW,5     3,2               CHECK THIS ENTRY
         BNE      VERI4             BRANCH IF NO MATCH
         B        DCBINOUT          GOT HIM. LET'S GO
VERI4    AI,2     3                 STEP TO NEXT ENTRY
         CW,3     1,2               ASSUME 1ST WORD OF DCB NAME
         BANZ     VERI1             BRANCH IF IT IS
         LW,2     1,2               IS THER A LINK
         BNEZ     VERI1             BRANCH IF THERE IS
NODCB2   LI,10    1
*
*
*        ALL ERRORS (EXCEPT FROM READS AND WRITES)
*
*        INPUT:  R10 CONTAINS ERROR CODE
*                 R10=0 => NO ERROR OR ABNORMAL SPECIFIED
*                 R10=1 => SECOND DCB IS MISSING
*                 R10=2 => DCBS ARE NOT OPEN
*                 R10=3 => DCB1 NOT OPEN IN OR DCB2 NOT OUT
*
*
ERROR    EQU      %
         SLS,10   25
         LI,7     X'1A'
         OR,10    7                 MERGE IN ABORT CODE
         BUMP     -4,3              CLEAR THE STACK
         DESTRUCT MSR01EXIT
         REF      MSR01EXIT
*
*CHECK THAT DCB1 OPEN IN AND DCB2 OPEN OUT
*     R6=>DCB1      R5=>DCB2
*
DCBINOUT EQU      %
         LW,7     Y002
         AND,7    0,6               IS DCB1 OPEN
         BNEZ     %+3
DCBCLS   LI,10    2                 YES,PROCEED
         B        ERROR             NO,ERROR
         AND,7    0,5
         BNEZ     %+3
         LW,6     5                 6 HAS THE BAD DCB
         B        DCBCLS
         LW,R7    Y000A
         AND,R7   FUN,R6            DCB1 MUST BE OPEN
         BNEZ     %+3                IN OR INOUT.
2NOTOUT  LI,R10   3
         B        ERROR
         LW,R7    Y0014
         AND,R7   FUN,R5            DCB2 MUST BE OPEN
         BNEZ     SETBUF             OUT OR OUTIN
         XW,R5    R6                  OR BE RANDOM FILE INOUT.
         BAL,R4   CHKASN
         CI,R3    1                 IF NOT A FILE DCB,
         BNE      2NOTOUT            CAN'T BE RANDOM.
         BAL,R4   CHKORG
         CI,R3    3
         BNE      2NOTOUT           FILE MUST BE RANDOM
         LW,R7    Y0008
         AND,R7   FUN,R6             AND INOUT.
         BEZ      2NOTOUT
         XW,R5    R6                R6<=DCB1,R5<=DCB2
*
*SET UP THE DCBS TO HAVE THE
*SAME SIZE AND BUFFER.
*
SETBUF   RES      0
         LI,1     X'1FFFF'
         LW,0     RWS,6
         BNEZ     %+4
         LW,0     RSZ,6
         SLS,0    -17               DEFAULT RSZ=>RWS
         STW,0    RWS,6
         STW,0    RWS,5
         STW,0    *TSTACK           SAVE DEFAULT RWS
         LW,0     BUF,6
         STS,0    BUF,5
*
*        CHECK TO SEE THAT THE BUFFER BELONGS TO THE GUY
*
BUFCHK   EQU      %
         LW,15    RWS,6
         BGZ      BUFCHK01
         BEZ      READ              0 SIZE READ OK
BUFERR   LI,10    X'4A'
         B        ERROR
BUFCHK01 LI,15    0
         LI,14    X'1FFFF'
         AND,14   BUF,6             GET THE BUFFER ADDRESS
         SLD,14   -9                PAGE NUMBER OF BOTTOM=>R14
         SCS,15   11                BYTE OFFSET OF BUFFER
         LI,2     X'30'
         AND,2    BTD,6
         SLS,2    -4                BYTE DISPLACEMENT, IF ANY
         AW,15    RWS,6             ADD RWS
         AW,15    2                 ADD BTD
         AI,15    2047              ADD A PAGE
         SLS,15   -11               R15<=TOP PAGE OF BUFFER
BUFCHK1  CI,14    JOVVP             BUFFER BELOW 8000
         BGE      CHKPT+1            NO, SKIP THIS STUFF
BUFCHK2  LC       J:ASSIGN          READ IN WRITE PROTECT MEM
         BCS,4    CHKPT2               (RWPM)
         LW,4     S:CUN
         LH,4     UH:FLG,4          SPECIAL JIT ACCESS (SJAC)
         CI,4     X'1000'            SKIP BUFF CHKS FOR EITHER
         BANZ     READ              ERROR: CAN'T READ INTO MONITOR
         B        BUFERR
*
*        CHECK THE PROTECTION TYPE OF EACH
*         PAGE IN THE BUFFER
*
CHKPT    AI,14    1
         LW,3     14
         SCD,2    -4
         SCS,2    5
         LW,3     J:JAC,3
         SLD,2    2,2
         AND,2    M2
         BEZ      CHKPT1
         B        BUFERR
         B        ERROR
CHKPT1   BDR,15   CHKPT
CHKPT2   LW,3     Y4
         STS,2    J:ASSIGN
*
*        BRANCH TO THE PROPER READ ROUTINE
*
READ     EQU      %
         BAL,4    CHKASN
         LW,7     3                 ASN DCB1 => R7
         XW,6     5                 NOW CHECK DCB2
         BAL,4    CHKASN
         LW,9     3                 ASN DCB2 => R9
*
*        IF OUTPUT DCB IS LABEL TAPE, CHECK FOR FORCED
*        BLOCKING (PAGE SIZE) OF ALL RECORDS
*
         CI,3     2
         BNE      NOTLABEL
         LI,R2    -9
         LW,R2    *TSTACK,R2        GET FLAG WORD POINTER
*                                    FROM FIRST PUSHALL (R7)
         LI,R1    1
         AND,R1   *2                BIT 31 OF FLAG WORD IS KEY:
*                                    0 => NORMAL BLOCKING
*                                    1 => PAGE SIZE BLOCKS
         SLS,R1   1                 BIT TO STORE IN ANSFLAG
         INT,R3   1,R6              GET DCT INDEX OF TAPE
         CI,R3    X'8000'
         BAZ      NOTLABEL          DONT FOOL WITH OPLABELS
         LI,2     X'FF'
         AND,2    3
         AI,2     -BATAPE           R2 <= INDEX INTO ANSFLAG
         STB,R1   ANSFLGS,R2        BIT SET HERE LOOKED AT BY
*                                    LABEL TAPE PROCESSING LATER
NOTLABEL RES      0
         BAL,4    CHKORG
         CI,3     2
         BL       SETKBUF
         BE       SETNWK            KEYED FILE
*                                   FILE IS RANDOM
         CI,R9    2                 IS FILE ON LABEL TAPE?
         BNE      SETKBUF           NO, PROCEED NORMALLY
         LI,R3    X'20'
         EOR,R3   ORG,R6            YES, FORCE CONSECUTIVE
         STW,R3   ORG,R6             ORGANIZATION TO TAPE.
         B        SETKBUF
SETNWK   RES      0
         LI,3     1                 KEYED OUTPUT;
         SLS,3    28                 SET NWK IN
         STS,3    NWK,R6              DCB2.
*
*        SET UP READ KBUF AS WRITE KAD
*
SETKBUF  RES      0
         XW,6     5                 R6<=DCB1,R5<=DCB2
         LW,R2    0,R6
         AND,R2   NB31TO0+11        ZAP THE '400' BIT SO ALL
         STW,R2   0,R6               READS ARE FORWARD
         LI,R10   0                 ERROR FLAG FOR I/O RETURN
         LW,2     KBUF,6
         LI,3     X'1FFFF'
         STS,2    KAD,5
*
*        ALL SUBSEQUENT READS START HERE
*
READ1    LI,8     X'10'
         LW,11    *TSTACK
         STW,11   RWS,R6            MUST USE INITIAL RWS
         LI,11    RRTN
         REMEMBER
         BAL,1    PUSHALL
         BAL,R0   MAPBUFS           GET BUFFERS MAPPED IN
         LW,R1    TSTACK
         LCI      7                 RESTORE REGS WHICH
         LM,R5    -7,R1              MAPBUFS DESTROYED
         B        %+1,7
         B        ISEQUB
         B        ISEQUB
         B        READL
         B        MSRRED
*
*        ROUTINE TO HANDLE RETURN FROM READ OR WRITE
*
RRTN     NOP
WRTN     LW,R4    TSTACK
         LI,3     X'1FFFF'
         LW,2     -3,4
         STS,2    J:JIT+ERO
         LW,2     -2,4
         STS,2    J:JIT+ABO
         AI,10    0
         BNEZ     OUT
*
*        CHECK FOR HIR USERS OR EXPIRED CORE QUAN
*
         LW,1     S:CUN
         LW,14    J:DELTAT
         SW,14    J:IDELTAT
         AW,14    J:OVHTIM
         AW,14    J:CTIME
         CW,14    SL:SQUAN
         BL       GO
         LW,15    S:HIR
         BNEZ     TIMSUP
         CW,14    -1,4
         BGE      TIMSUP
GO       EQU      %
         XW,6     5
         XW,7     9
         CI,11    WRTN
         BE       READ1
*
*        ROUTINE TO WRITE THE RECORD
*
WRITE1   LI,8     X'11'
         LW,1     RWS,R5            R5=DCB1 AT THIS POINT
         STW,1    RWS,R6            WRITE AS BIG AS READ
         LI,11    WRTN
         REMEMBER
         BAL,1    PUSHALL
         BAL,R0   MAPBUFS           GET BUFFERS MAPPED IN
         LW,R1    TSTACK
         LCI      7                 RESTORE REGS WHICH
         LM,R5    -7,R1              MAPBUFS DESTROYED
         B        %+1,7
         B        IOSFILE
         B        IOSFILE
         B        WRITEL
         B        MSRWRT
*
*        RETURN TO THE USER
*
OUT      EQU      %
         LI,3     -3
         LC       10
         BCS,X'C' %+2               ERROR
         BIR,3    %+1               ABNORMAL
         LW,8     *TSTACK,3         SET UP R8 FOR RETURN
*                                    TO USERS ADDRESS.
         BUMP     -4,3
         DESTRUCT PULLALLEXIT
*
*        REPORT E:QE AND GIVE UP
*
TIMSUP   EQU      %
         LW,R4    S:CUN
         LI,R1    X'FFF7'
         DISABLE
         LH,R2    UH:FLG2,R4
         AND,R2   R1
         STH,R2   UH:FLG2,R4
         ENABLE
         PUSH     6
         PUSH     11
         LI,6     E:QE
         BAL,11   T:REG
         PULL     11
         PULL     6
         B        GO
         PAGE
*
*        BAL,4    CHKORG
*        INPUT:   R6 = DCB ADDRESS
*        OUTPUT:  R3 = ORG OF DCB
*
CHKORG   LI,R3    X'30'
         AND,R3   ORG,R6
         SLS,R3   -4
         B        0,4
*
*        BAL,4    CHKASN
*        INPUT:   R6 = DCB ADDRESS
*        OUTPUT:  B TO ERROR IF DEVICE OR ANS DCB
*                 R3 = ASN OTHERWISE
*
CHKASN   LI,R3    X'F'
         AND,R3   ASN,R6
         CI,R3    2
         BLE      0,4
         LI,10    4
         B        ERROR
RDLSZ    EQU      %-RDL
         END

