*M*      RDL      HANDLES LABEL AND ANS READ CAL AND HANDLES MOVE CAL.
*P*      NAME:    RDL
*,*      PURPOSE  CONTAINS THE READL ROUTINE TO HANDLE THE READ CAL FOR
*,*               LABEL AND ANS TAPE, AND CONTAINS THE MOVECAL ROUTINE
*,*               WHICH PERFORMS THE THE MOVE CAL.
*        704718   SIGMA 5/7         BPM M:RDL
MONPROC  SET      1
ANSPROC  SET      1
         SYSTEM   UTS
         DEF      RDL:              PATCHING DEF
RDL:     RES
*
         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'
KB       EQU      X'B'
KFFFF    EQU      X'FFFF'
K1FFFF   EQU      X'1FFFF'
KN1      EQU      -X'1'
BARNR    EQU      4*RNR
KMAX     EQU      12
         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
*****************  DEF  **************************
*
************ROUTINES***********
         DEF      CHKTP             ADJUST TAPE POSITION PER DCB:REV
         DEF      CHKTRN            RESTORE RECORD TO BUFFER IF TRUNCATED
         DEF      CLRBBUFL          FLUSH BLOCKING BUFFER
         DEF      CLRTP             CLEAR DCB:REV
         DEF      GTFL              FIND NEXT RECORD
         DEF      ISEQICRL          ADJUST POINTER TO START OF DATA
         DEF      MOVECAL           HANDLE M:MOVE
         DEF      RDBLK             READ NEXT DATA BLOCK INTO BUFFER
         DEF      RDBLKX            CHECKOUT BLOCK READ FROM TAPE
         DEF      RDBLKX1           SET DCB:TYC=A
         DEF      RDBLKX3           SET DCB:TYC AND EXIT *TSTACK
         DEF      RDBLKX4           INITIALIZE DCB FOR NEW DATA BLOCK
         DEF      RDL3              TRANSFER BLOCKED RECORD
         DEF      READL             DO M:READ FOR ANS/XEROX LABEL TAPE
         DEF      SETCMDL           INITIALIZE DCB:CMD(=4)
         DEF      SKREC             SKIP OVER NEXT TAPE RECORD
         DEF      SKRECR            SKIP BACK OVER PRECEEDING RECORD
         DEF      TPIOF             READ PAGE SIZE DATA INTO BUFFER
         DEF      TPIOFA            READ DATA INTO BUFFER
         DEF      TRNREC            TRANSFER DATA RECORD INTO USERS BUF
         SPACE    5
**********************  REF  *********************
*
**************CONSTANTS****************
         REF      ABO
         REF      BATAPE
         REF      E:QE
         REF      ERO
         REF      JOVVP
         REF      M2
         REF      NB31TO0
         REF      OPNTPSEG
         REF      YC
         REF      YFFFFFFFC
         REF      Y000A
         REF      Y0004
         REF      Y0008
         REF      Y001
         REF      Y002
         REF      Y02
         REF      Y04
         REF      Y1
         REF      Y2
         REF      Y3
         REF      Y4
         SPACE    2
*************VARIABLES****************
         REF      ANSFLGS           OUTPUT;
         REF      AVRTBL            OUTPUT;BITS48-63
         REF      J:ASSIGN          INPUT;BIT1 OUTPUT;BIT1
         REF      J:CTIME           INPUT;
         REF      J:DCBLINK         INPUT;
         REF      J:DELTAT          INPUT;
         REF      J:IDELTAT         INPUT;
         REF      J:JAC             INPUT;
         REF      J:JIT             OUTPUT;
         REF      J:OVHTIM          INPUT;
         REF      S:CUN             INPUT;
         REF      S:HIR             INPUT;
         REF      SL:SQUAN          INPUT;
         REF      UH:DL             INPUT;
         REF      UH:FLG            INPUT;BIT3
         REF      UH:FLG2           OUTPUT;BIT12
         SPACE    2
*************ROUTINES************
         REF      ARD2              HANDLE TAPE KEYED READ
         REF      ARD3              HANDLE TAPE READ REVERSE
         REF      BARB              PROCESS 41 ERROR ON TAPE
         REF      BARB1             GIVE 41 03 ERROR
         REF      BLKIN             MOVE DATA SEGMENT TO USERS BUF
         REF      CBB4              READ DATA BLOCK
         REF      CBB5              RELEASE BLOCKING BUFFER
         REF      CLRBBUF           TRUNCATE BBUF
         REF      GETORG            CHECK ORG
         REF      CHKACS3           SKIP IF DCB:ACS NOT 3
         REF      CHKCON            VALIDATE BLOCK READ FROM TAPE
         REF      CHKEOF            DO EOD(EOF/EOV) PROCESSING
         REF      CLRTRN            CLEAR DCB:TRN
         REF      EVCR              GIVE 41 02 ERROR
         REF      FSEG              DO 1ST SEGMENT ERROR CHECKS
         REF      GETAVR            GET AVRX AND AVR ENTRY
         REF      GETBBUF           GET BLOCKING BUFFER
         REF      GETCMD            GET DCB:CMD
         REF      GETDIR            GET DCB:DIR
         REF      GETTYC            GET DCB:TYC
         REF      INITARS           INITIALIZE ARS
         REF      IOCHEK1           DO ANS POST PROCESSING
         REF      IOSFILE           WRITE RECORD TO FILE FOR M:MOVE
         REF      IOSPIN            WAIT FOR I/O COMPLETE
         REF      ISEQUB            READ RECORD FROM FILE FOR M:MOVE
         REF      JHKBIT            GET NEXT PARAMETER FROM FPT
         REF      JHKBIT3           GET FIRST PARAMETER FROM FPT
         REF      KEYTRN            MOVE KEY TO BUFFER
         REF      MAPBUFS           MAP BUFFERS FOR RIGHT DCB
         REF      MSREXIT           GENERAL EXIT
         REF      MSRRED            READ ANS TAPE DATA RECORD
         REF      MSRWRT            WRITE ANS TAPE DATA RECORD
         REF      MSR01EXIT         ABN/ERR EXIT
         REF      PULLALLEXIT       GENERAL NORMAL EXIT
         REF      PULLEXIT          EXIT *TSTACK
         REF      PULLEXIT1         EXIT C(TSTACK)+1
         REF      PULLFOUR          GET RECORD SEGMENT SIZE FROM BUFFER
         REF      PUSHALL           GENERAL ENVIRONMENT SAVE
         REF      QUEUE1            READ UNBLOCKED RECORD SEGMENT
         REF      RDCLS#            WRITE TRAILER LABELS BEFORE READ
         REF      READLEND          READ END ACTION ROUTINE
         REF      SAVBLK            SET BLK FOR READ
         REF      SETBTDQ           SET DCB:HBTD
         REF      SETCMD1           SET DCB:CMD
         REF      SETEOP            REF SET DCB:EOP
         REF      SETTYC            SET DCB:TYC
         REF      T:REG             END QUANTUM
         REF      TAPEOP            DO DCB I/O
         REF      TERR              FLAG ERROR ON DATA BLOCK
         REF      TRANSFERUB2       POST DATA TRANSFER PROCESSING
         REF      TRANX             SET DCB:ARS AND EXIT
         REF      WRITEL            WRITE XEROX LABEL TAPE RECORD
         PAGE
Y22      DATA     X'22000000'
Y0014    DATA     X'140000'
         PAGE
READL    EQU      %
*F*      NAME:    READL
*,*      PURPOSE  RECEIVES THE READ CAL FOR LABEL TAPE AND ANS TAPE.
*,*               ALSO, PROCESSED THE READ FOR LABEL TAPE.
*,*      DESCRIPTION IF THE DCB IS NOT OPEN, OPENTPSEG IS CALLED TO
*,*               DO THE OPEN. IF THE TAPE IS ANS, MSRRED IN IORT IS CALLED
*,*               TO PERFORM THE READ. IF A KEYED READ OR READ REVERSE,
*,*               THE ARD2 OR ARD3 ROUTINE, RESPECTIVELY, IS CALLED IN
*,*               ARDL TO PROCESS THE READ. OTHERWISE, A BUFFER IS OBTAINED
*,*               AND/OR RELOADED IF NECESSARY, AND THE CURRENT RECORD
*,*               IS MOVED INTO THE USERS BUFFER, DOING ANY ADDITIONAL
*,*               READS NECESSARY FOR SPLIT RECORD, UNBLOCKED SEGMENTS,
*,*               ETC.
         SPACE    2
*D*      NAME:    READL
*,*      ENTRY    RDL3
*,*      CALL     OVERTO LBLTSEG,READL#
*,*      INTERFACE CHKANS0, IOCHEK1, RDCLS, SETEOP, SETTYC, MSRRED,
*,*               GETDIR, CHKCON, CHKTRN, TRNREC, MSREXIT, RDBLK
*,*               ARD2, ARD3
*,*      DESCRIPTION IF THE DCB IS NOT OPEN, OPENTPSEG IS CALLED TO
*,*               DO THE OPEN. IF THE TAPE IS ANS, MSRRED IN IORT IS CALLED
*,*               TO PERFORM THE READ. IF A KEYED READ OR READ REVERSE,
*,*               THE ARD2 OR ARD3 ROUTINE, RESPECTIVELY, IS CALLED IN
*,*               ARDL TO PROCESS THE READ. OTHERWISE, A BUFFER IS OBTAINED
*,*               AND/OR RELOADED IF NECESSARY, AND THE CURRENT RECORD
*,*               IS MOVED INTO THE USERS BUFFER, DOING ANY ADDITIONAL
*,*               READS NECESSARY FOR SPLIT RECORD, UNBLOCKED SEGMENTS,
*,*               ETC.
         BAL,R0   CHKACS3
         BAL,SR4  IOCHEK1           IF BLOCK DO SPIN AND POSTANS
         LW,R0    Y0008
         CW,R0    EOP,R6
         BAZ      RDL1
*                                   WRITE EOF
         OVERLAY  OPNTPSEG,RDCLS#
         LI,D1    0
         BAL,R0   SETEOP
*
RDL1     EQU      %
         LI,D1    0
         BAL,R0   SETTYC
         BAL,R0   CHKACS3
         B        MSRRED            DO DEVICE I/O IF BLOCK ACS
         BAL,R0   GETORG            IF CONSEC, IGNOR KAD
         BL       RDL2
         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
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      %
*D*      NAME:    GTFL
*,*      REGISTERS ALL VOLATILE
*,*      CALL     BAL,R0 GTFL
*,*      INTERFACE RDBLK, GETCMD, ISEQICRL, PULLFOUR, SETCMD1, CHKTP, SKREC,
*,*               CLRBBUFL
*,*      DESCRIPTION IF NO BLOCKING BUFFER EXISTS, ONE IS OBTAINED, THE
*,*               NEXT BLOCK READ, AND THE ROUTINE EXITS. OTHERWISE,
*,*               CURRENT POSITION IS FOUND, AND THEN STEPPED TO THE BEGINNING
*,*               OF THE NEXT RECORD. NECESSARY ADJUSTMENTS OF TAPE
*,*               POSITION, READING OF ADDITIONAL BLOCKS, ETC. ARE DONE
*,*               AS NEEDED.
         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      %
*D*      NAME:    RDBLK
*,*      ENTRY    RDBLKX, RDBLKX4, RDBLKX1, RDBLKX3
*,*      REGISTERS ALL VOLATILE
*,*      CALL     BAL,R0 RDBLK OR PUSH RETURN ADDRESS AND B NAME
*,*      INTERFACE CHKTP, GETAVR, CLRBBUFL, CHKEOF, BARB, FSEG,SETTYC
*,*      DESCRIPTION THE TAPE IS REPOSITIONED, IF NECESSARY, AND THE
*,*               NEXT DATA BLOCK IS READ INTO THE BLOCKING BUFFER.
*,*               IF AN I/O ERROR IS DETECTED, THE ROUTINE GOES TO
*,*               RDBLKX WHERE THE BLOCK IS CHECKED FOR CONSISTENCY,
*,*               A KEYED READ CAUSING AN ERROR 41 03, OTHERWISE
*,*               CONTINUING TO RDBLKX4 WITH EIC/EVC SET TO INDICATE
*,*               THE STATE OF THE BLOCK READ. THEN, AT RDBLKX4, THE
*,*               DCB IS INITIALIZED FOR THE BLOCK READ AND IF NO ERRORS
*,*               THE ROUTINE EXITS, OTHERWISE THE CONDITIONS ARE
*,*               CHECKED FOR INCONSISTENCY/1ST SEGMENT AND THE APPROPRIATE
*,*               ERROR RETURN IS MADE. IF A TAPE MARK WAS DETECTED,
*,*               CHKEOF IS CALLED AND IF AN ERR/ABN WAS DETECTED AN
*,*               EXITS IS MADE, OTHERWISE, I.E., AFTER A SUCCESSFUL
*,*               CVOL, THE NEXT BLOCK IS READ INTO THE BLOCKING BUFFER
*,*               AND THE ROUTINE CONTINUES AS ABOVE. HOWEVER, IF NO
*,*               ERROR WAS INDICATED BUT THE DCB WAS CLOSED, AT RDBLKX1
*,*               A TYC VALUE OF X'A' IS SET UP AND AT RDBLKX3 THE
*,*               DCB:TYC IS SET, AFTER WHICH THE ROUTINE EXITS.
         PUSH     1,R0
         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
RDBLKX4  EQU      %
         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
RDBLKX1  EQU      %
         LI,D1    KA
RDBLKX3  EQU      %
         BAL,R0   SETTYC
         B        PULLEXIT
*
*
         PAGE
TRNREC   EQU      %                 TRANSFER RECORD TO USER
*D*      NAME:    TRNREC
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     BAL,R0 TRNREC
*,*      INTERFACE CLRTRN, SETEOP, INITARS, GETCMD, KEYTRN, SAVBLK, TRNLBL,
*,*               GTFL, EVCR, IOSPIN, CLRBBUFL, CHKTP, SETBTDQ, READLEND,
*,*               RDBLK, BARB1
*,*      DESCRIPTION TRANSFERS THE LOGICAL RECORD, IN THE FORWARD
*,*               DIRECTION, TO THE USERS BUFFER, TRANSFERRING THE
*,*               LESSER OF THE ACTUAL RECORD SIZE OR NUMBER OF BYTES
*,*               REQUESTED. IF ADDITIONAL BLOCKS ARE INVOLVED THEY ARE
*,*               READ AS NEEDED, INCLUDING ANY NEEDED CHECKS OF
*,*               CONSISTENCY, ETC. IF A RECORD SEGMENT IS FOUND THE
*,*               EXTENDS BEYOND THE END OF THE BLOCKING BUFFER, AN ERROR
*,*               IS RETURNED. DCB:ARS IS CALCULATED AND SET INTO THE DCB
*,*               IF 0 BYTES WERE REQUESTED, THE ROUTINE MERELY SKIPS TO
*,*               THE NEXT LOGICAL RECORD.
         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,D1    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
         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
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
         LW,D1    R7                SAVE FLAGS
         PUSH     8,D1
         B        BLKIN
         PAGE
CLRBBUFL EQU      %                 WRITE OUT BUFFER
*D*      NAME:    CLRBBUFL
*,*      REGISTERS R4-SR4 VOLATILE
*,*      CALL     BAL,R0 CLRBBUFL
*,*      DESCRIPTION IF PRESENT AND MODIFIED, WRITES THE CONTENTS
*,*               OF THE BLOCKING BUFFER TO TAPE.
*
         PUSH     8,D1
         B        CBB5
*
IOWTALT  PUSH     1,R0
         BAL,R0   GETBBUF
         BAL,R0   TPIO
         BAL,SR4  IOSPIN
         BAL,R4   GETTYC
         LI,SR4   X'1000'           SET EGV TOO
         STS,SR4  EGV,R6
         PULL     1,R4
         CI,R3    8
         B        0,R4
*
CHKTRN   EQU      %
*D*      NAME:    CHKTRN
*,*      REGISTERS ALL VOLATILE
*,*      DESCRIPTION REPOSITIONS TAPE IF NECESSARY FOR DIRECTION, AND
*,*               READS DATA BLOCK INTO BLOCKING BUFFER. ALSO CHECKS OUT
*,*               ANY ERRORS.
         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
CHKTRNX  EQU      %
         LI,R1    HAPBD             SET PBD FROM JUST READ BLOCK
         LH,R0    BUFF1
         STH,R0   *R6,R1
         B        PULLEXIT1
*
ISEQICRL EQU      %
*D*      NAME:    ISEQICRL
*,*      REGISTERS R2 VOLATILE
*,*      DESCRIPTION ADJUSTS R3 TO POINT PAST THE KEY FOR THE CURRENT
*,*      RECORD.
         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
*D*      NAME:    CHKTP
*,*      DESCRIPTION IF DCB:REV IS SET, CLEARS IT AND REPOSITIONS TAPE
*,*               BY SKIPPING FORWARD ONE BLOCK.
         CW,D1    BFL,R6
         BAZ      *SR2
         BAL,R0   CLRTP
SKREC    EQU      %
*D*      NAME:    SKREC
*,*      ENTRY    SKRECR
*,*      DESCRIPTION DOES A SKIP RECORD FORWARD(SKREC) OR REVERSE(SKRECR).
         LI,SR3   KA
SKREC1   EQU      %
         LI,R1    K1
         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
         B        TAPEOP
SKRECR   EQU      %
         LI,SR3   KB
         B        SKREC1
SETCMDL  EQU      %
*D*      NAME:    SETCMDL
*,*      DESCRIPTION SETS DCB:CMD TO INITIALIZED VALUE(4).
         LI,R3    K4
         B        SETCMD1
TPIO     EQU      %
TPIOF    EQU      %
*D*      NAME:    TPIOF
*,*      ENTRY    TPIOFA
*,*      DESCRIPTION READS DATA BLOCK INTO BUFFER FOR SIZE ONE PAGE
*,*               (TPIOF) OR SIZE SPECIFIED IN R2(TPIOFA).
         PUSH     8,D1
         LI,R2    BUFSIZ
TPIOFA   EQU      %
         LW,SR1   Y22
         LI,SR2   READLEND
         LI,R0    CBB4
CLRTP    EQU      %
*D*      NAME:    CLRTP
*,*      DESCRIPTION CLEARS DCB:REV.
         LI,D1    K0
         LW,D2    Y002              REV CHNGD FOR B00
         STS,D1   BFL,R6
         B        *R0
         PAGE
*MOVECAL ENTERED FROM CALPROC
MOVECAL  EQU      %
*F*      NAME:    MOVECAL
*,*      PURPOSE  HANDLE THE MOVE CAL
*,*      DESCRIPTION VARIOUS ELEMENTS OF THE FPT ARE VERIFIED,
*,*               INCLUDING THE SECONDARY DCB ADDRESS AND THE BUFFER
*,*               ADDRESSES. THEN THE APPROPRIATE READ AND WRITE ROUTINES
*,*               ARE CALLED TO PERFORM THE COPY UNTIL AN ABNORMAL OR
*,*               ERROR IS DETECTED ON EITHER DEB, AT WHICH TIME THE
*,*               PROCESS IS TERMINATED AND THE ABN/ERR IS RETURNED TO
*,*               THE CALLING PROGRAM.
         SPACE    2
*D*      NAME:    MOVECAL
*,*      CALL     OVERTO LBLTSEG,MOVECAL#
*,*      INTERFACE JHKBIT3, JHKBIT, MSR01EXIT, ISEQUB, READL, MSRRED,
*,*               IOSFILE, WRITEL, MSRWRT
*,*      DESCRIPTION VARIOUS ELEMENTS OF THE FPT ARE VERIFIED,
*,*               INCLUDING THE SECONDARY DCB ADDRESS AND THE BUFFER
*,*               ADDRESSES. THEN THE APPROPRIATE READ AND WRITE ROUTINES
*,*               ARE CALLED TO PERFORM THE COPY UNTIL AN ABNORMAL OR
*,*               ERROR IS DETECTED ON EITHER DEB, AT WHICH TIME THE
*,*               PROCESS IS TERMINATED AND THE ABN/ERR IS RETURNED TO
*,*               THE CALLING PROGRAM.
         BAL,R1   PUSHALL
*EXTRACT ERO AND ABO FROM FPT AND STORE IN JIT
         BUMP     3,R3
         LW,4     TSTACK
         AI,7     -1                SET UP FOR JHKBIT
         BAL,R1   JHKBIT3
         STS,R2   J:JIT+ERO
         STS,R2   -2,R4             SAVE ERO IN TSTACK
         BCS,8    %+3               CC1 SET => ERO WAS THERE
NOEROABO LI,10    0
*
*E*      ERROR:   1A - 00  NO ERROR OR ABNORMAL ADDRESS WAS
*,*                        SPECIFIED IN THE M:MOVE FPT
*
         B        ERROR
         BAL,1    JHKBIT
         STS,R2   J:JIT+ABO         SAVE ABO
         STS,R2   -1,R4             SAVE ABO IN TSTACK
         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
*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
*
*E*      ERROR:   1A - 01  THE OUTPUT DCB IS MISSING
*
*
*
*        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     -3,R3             CLEAR THE STACK
         DESTRUCT 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
*
*E*      ERROR:   1A - 02  ONE OR THE OTHER OF THE M:MOVE DCBS
*,*                        ARE CLOSED
*
         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
*
*E*      ERROR:   1A - 03  ONE OF THE OTHER OF THE M:MOVE DCBS
*,*                        IS NOT OPENED IN THE RIGHT MODE
*
         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
*
*E*      ERROR:   1A - 4A  SPECIFIED BUFFER IN M:MOVE ISN'T LEGAL
*
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
CHKPT1   BDR,15   CHKPT
         CI,14    255
         BG       BUFERR
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    -8
         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
         LW,R2    KMAX,R5           VERIFY THAT KMAX OF OUTPUT
         LW,R3    KMAX,R6           DCB IS >= INPUT DCB KMAX
         SLS,R2   -24
         SLS,R3   -24
         CW,R2    R3
         BLE      SETNEWK1          ALL COOL, CONTINUE
*
*E*      ERROR:   1A-42
*E*      MESSAGE: KMAX OF OUTPUT DCB LESS THAN INPUT DCB KMAX
*
         LI,R10   X'42'             REPORT ERROR TO USER
         B        ERROR
SETNEWK1 EQU      %
         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
*
*        CLEAR TYC FOR BOTH DCBS BEFORE USING THEM
*
         LI,D1    0
         BAL,R0   SETTYC
         XW,R6    R5
         BAL,R0   SETTYC
         XW,R6    R5                PUT DCBS BACK IN PROPER ORDER
*
*        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'
         AND,R11  R3                CLEAR OV # OUT OF R11
         LW,R2    -2,R4
         STS,2    J:JIT+ERO
         LW,R2    -1,R4
         STS,2    J:JIT+ABO
         AI,10    0
         BNEZ     OUT
         LW,R2    S:CUN
         LH,R2    UH:DL,R2
         LC       R2
         BCS,15   ERR1A05           BREAK, CTRL-Y, OPERATOR ABORT
*
*        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
         BGZ      TIMSUP
         AW,R14   J:IDELTAT         IS HIS QUANTUM UP?
         BGEZ     TIMSUP            YES, QUANTUM END HIM.
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
*
ERR1A05  LW,10    =X'1A0A0000'      ABORTED BY BREAK, CTRL-Y, OP ABORT
*E*      ERROR:   1A-05
*E*      MESSAGE:  ABORTED BY BREAK, CONTROL-Y OR OPERATOR ABORT
OUT      EQU      %
         LI,R3    -2
         LC       10
         BCS,X'C' %+2               ERROR
         BIR,3    %+1               ABNORMAL
         LW,8     *TSTACK,3         SET UP R8 FOR RETURN
*                                    TO USERS ADDRESS.
         BUMP     -3,R3             RESET THE STACK
         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
*
*E*      ERROR:   1A - 04  ONE OR THE OTHER OF THE DCBS IN M:MOVE
*,*                        IS EITHER A DEVICE OR ANS
*
         B        ERROR
         END

