*M*      ARDL     LABEL TAPE READ KEYED AND REVERSE, MISC SUBROUTINES
*,*               AND LABEL AND ANS EOF PROCESSING.
ANSPROC SET       1
BITS     SET      1
MONPROC  SET      1
         SYSTEM   UTS
ARDL:    EQU      %
*
         PAGE
         BOUND    8
K7       EQU      X'7'
K0       EQU      X'0'
K1       EQU      X'1'
K4       EQU      X'4'
K6       EQU      X'6'
K8       EQU      X'8'
K10      EQU      X'10'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
KN1      EQU      -X'1'
KN2      EQU      -X'2'
         PAGE
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
         PAGE
KB       EQU      X'B'
Y62      DATA     X'62000000'
CEOV     TEXT     ':EOV'
TUTL1    TEXT     'UTL1'
TEOF2    TEXT     'EOF2'
TEOV2    TEXT     'EOV2'
         PAGE
*******************  DEF  *******************
*
************ROUTINES***********
         DEF      ANSSENT2          BLOCK COUNT ERROR EXIT
         DEF      ARDL:             MODULE NAME
         DEF      ARD2              KEYED READ ROUTINE
         DEF      ARD3              REVERSE READ ROUTINE
         DEF      BARB              PROCESS 41 ERROR ON TAPE
         DEF      BARB1             41 03 ERROR EXIT
         DEF      CHKCON            VALIDATE BLOCK READ FROM TAPE
         DEF      CHKEOF            EOV/EOF PROCESSING
         DEF      EVCR              41 02 ERROR EXIT
         DEF      FSEG              1ST SEGMENT ERROR CHECKS
         DEF      RDSNT             READ TRAILER SENTINELS
         DEF      TERR              FLAG ERROR BLOCK
         SPACE    5
********************  REF  *******************
*
***************CONSTANTS************
         REF      BATAPE
         REF      E:SL
         REF      YFFFE
         REF      YFFFFFFFC
         SPACE    2
*****************VARIABLES***********
         REF      AVRSID            OUTPUT;
         REF      AVRTBL            OUTPUT;X'000000000000FFFF'
         REF      S:CUN             INPUT;
         REF      U:MISC            OUTPUT;
         SPACE    2
**************ROUTINES**************
         REF      CBB4              READ DATA BLOCK
         REF      CHKANS0           SKIP IF DCB NOT ANS
         REF      CHKANS1           SKIP IS DCB ANS
         REF      CHKTRN            POSITION TAPE FOR READ
         REF      CLRBBUFL          BLOCKING BUFFER FLUSH
         REF      CLRTP             CLR DCB:REV
         REF      COMKEY            COMPARE KEYS
         REF      COMKEYA           COMPARE USER KEY WITH *KAD
         REF      CVOLA             DO AUTO CVOL
         REF      GETAVR            GETS AVRX &AVRTBL ENTRY
         REF      GETBBUF           GET BLOCKING BUFFER
         REF      GETCMD            GET DCB:CMD
         REF      GETTYC            GET DCB:TYC
         REF      GSBUF             GET FM BUFFER
         REF      GTFL              FIND START OF NEXT RECORD
         REF      IOSPIN            WAIT FOR I/O COMPLETE
         REF      ISEQICRL          STEP POINTER TO START OF DATA
         REF      KEYER3            ERROR 43 00 EXIT
         REF      KEYTRN            MOVE KEY TO BUFFER
         REF      MSREXIT           NORMAL EXIT
         REF      MSR01EXIT         ABN/ERR EXIT
         REF      PULLALLEXIT       MAJOR ROUTINE EXIT
         REF      PULLEXIT          EXIT *TSTACK
         REF      PULLEXIT1         EXIT TO C(TSTACK)+1
         REF      PUTSZBF           PUT SIZE AND BUF ADDR IN DCB
         REF      RDBLK             READ AND VERIFY DATA BLOCK
         REF      RDBLKX            DATA READ POST PROCESSING
         REF      RDBLKX1           TYC=A EXIT
         REF      RDBLKX3           SETTYC AND SBR EXIT
         REF      RDBLKX4           DATA READ POST PROCESSING
         REF      RDERX             JIT ABN/ERR EXIT
         REF      RDL3              TRANSFER RECORD AND EXIT
         REF      READLEND          DATA END ACTION ROUTINE
         REF      READTP            READ TAPE RECORD
         REF      RESBLK            RESTORE DCB:BLK, ETC
         REF      SETBLK            SAVE DCB:BLK, ETC
         REF      SETBTDZ           ZERO DCB:BTD
         REF      SETCMDL           SET DCB:CMD=4
         REF      SETTRN            SET DCB:TRN
         REF      SETTYC            SET DCB:TYC
         REF      SKFILE            SKIP FORWARD PAST NEXT TAPE MARK
         REF      SKFILER           SKIP BACKWARD PAST NEXT TAPE MARK
         REF      SKRECR            SKIP BACKWARDS PAST BLOCK
         REF      T:ABORTM          ABORT USER
         REF      T:RBUF            RELEASE BUFFER
         REF      T:REG             SLEEP A SECOND
         REF      TAPEOP1           SKIP PRECEDING  TAPE MARK
         REF      TPIOFA            READ DATA BLOCK
         REF      TRANX             SET BYTES TRANSFERRED
         REF      TRNREC            TRANSFER LOGICAL RECORD
         REF      3ER5              ENTER I/O CHECK ROUTINE
         PAGE
         SPACE    5
CHKEOF   EQU      %
         SPACE    1
*F*      NAME:    CHKEOF
*,*      PURPOSE  UPON FORWARD READ OF A TAPE MARK, ROUTINE IS USED TO
*,*               DETERMINE WHETHER EOF OR EOV IS PRESENT /, AND
*,*               PROCESS SAME FOR BOTH LABEL AND ANS TAPE.
*,*      DESCRIPTION THE LABEL IS READ AND SAVED FOR LATER REFERENCE
*,*               IF ANS, THE BLOCK COUNT IS VERIFIED, USER LABEL IS
*,*               PASSED IF PRESENT AND REQUESTED. IF EOV AND USER LABEL
*,*               NOT REQUESTED, CVOL IS PERFORMED. OTHERWISE THE
*,*               APPROPRIATE ABNORMAL IS PASSED.
         SPACE    2
*D*      NAME:    CHKEOF
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     BAL,SR4 CHKEOF
*,*               B       ERROR
*,*               B       OK
*,*      INTERFACE CALLS RDSNT, T:ABORTM, TPIOFA, TAPEOP1, SKFILER,
*,*               SETTYC, CVOLA, MSR01EXIT,
*,*      INPUT    R6=DCB ADDRESS
*,*      OUTPUT   SR3 SET IF ABN/ERR DETECTED
*,*      DESCRIPTION RDSNT IS CALLED TO READ AND ANALYZE THE LABEL.
*,*               IF ANS AND NOT A PFIL ENTRY, THE BLOCK COUNT IS CHECKED
*,*               AND PROCESSED. IF ANS AND A PFIL ENTRY, BLOCK COUNT IS
*,*               SET IN THE DCB. IN ANY EVENT OTHER THAN A BLOCK COUNT
*,*               ABORT, IF THE USER REQUESTED A USER LABEL, HAS
*,*               SUFFICIENT ROOM FOR IT, AND THERE IS A USER LABEL ON THE
*,*               TAPE, IT IS READ INTO THE USERS BUFFER. AFTER USER LABEL
*,*               PROCESSING, IF ANY, THE TAPE IS REPOSITIONED TO THE
*,*               END OF THE DATA AREA. IF THE LABEL IS EOV(:EOV OR EOV1)
*,*               AND USER LABEL WAS REQUESTED, AN END-OF-TAPE ABN
*,*               IS RETURNED, OTHERWISE A CVOL IS DONE, RETURNING AN
*,*               ERROR IF THE CVOL FAILS FOR ANY REASON. IF THE LABEL IS
*,*               NOT EOV AND THE TAPE IS ANS, IF CONCAT IS GREATER THAN
*,*               1, CONCATENATION IS DONE, TREATING THE VOLUME AS THOUGH
*,*               IT WERE EOV INSTEAD OF EOF. IF NOT ANS OR IF NOT
*,*               CONCATENATION, AN END-OF-FILE ABN IS RETURNED.
         PUSH     1,SR4
         BAL,R7   RDSNT                                                 966
         BAL,R0   CHKANS1
         B        GETULBL
         LI,D3    K1FFFF            ITS ANS.
         AND,D3   BUF,R6
         LW,R7    BLKCNT,R6
         AND,R7   M24
         BEZ      ANSBLK            NO CHECK IF PFIL ENTRY
         CW,R2    R7                ARE BLOCK COUNTS SAME
         BE       GETULBL           YES
         STW,R2   *D3               GIVE USER BAD COUNT
         LI,R7    X'100'            BLOCK COUNT ERROR FLAG
         STS,R7   0,R6
         B        GETULBL
ANSBLK   EQU      %
         PUSH     R3
         LW,R3    M24               SET BLOCK COUNT
         STS,R2   BLKCNT,R6
         PULL     R3
GETULBL  EQU      %
         PUSH     1,R1              IOWT CLOBBERS R1. SAVE SENTINEL
         LI,R7    BASEQ
BASEQ    EQU      20
         LB,R7    *R6,R7            GET ULBL
         CI,R7    8
         BAZ      NOULBL
*
*   PREPARE TO READ POSSIBLE TRAILER LABEL
*
         LI,D3    K1FFFF
         AND,D3   BUF,R6
RDMORE   EQU      %
         LI,0     RDMOREA
         PUSH     8,D1
         LW,2     RWS,6
         B TPIOFA                   READ RWS BYTES INTO *D3
RDMOREA  EQU      %
         BAL,SR3  IOWT              IS IT TM                   R7D3 UNDS
         BE       TM                YES. COULDNT HAVE BEEN LABEL
         LI,SR2   X'F'              NO. IT MUST HAVE BEEN LABEL
         AND,SR2  ASN,R6            IF LABELED TAPE.
         CI,SR2   X'A'
         BNE      NOULBL
         LW,SR2   TUTL1             ITS ANS.
         CW,SR2   *D3               IF FIRST WORD NOT EQUAL TO UTL1
         BNE      RDMORE            IT WAS NOT LABEL. GO READ NEXT.
*                                   FORMAT USER TRAILOR LABELINTO TEXTC
         LI,1     80                IS THERE ROOM FOR 81 BYTES
         CW,1     RWS,R6
         BL       ALAB              CAN FIT ALL OF LABEL IF SO.
         LW,1     RWS,R6            NO.  MOVE RWS BYTES
         AI,1     -1
ALAB     EQU      %
         LW,0     1                 SAVE BYTE COUNT.
         AI,1     -1
ALAB1    EQU      %
         LB,SR2   *D3,1
         AI,1     1
         STB,SR2  *D3,1
         AI,1     -2
         BGEZ     ALAB1
         AI,0     1
         STB,R0   *D3
         B        NOULBL
TM       EQU      %
         LI,R0    0                 YES. COULDNT HAVE BEEN LABEL
         STB,R0   *D3               0 TO BYTE 0 OF USERS BUF
         BAL,R3   GETAVR
         LI,SR3   6                 SKIP REVERSE, TM PRECEEDING
         BAL,SR2  TAPEOP1             SENTINEL
*                                   DO NOT DISTURB TPOS
NOULBL   EQU      %
         BAL,SR2  SKFILER           SKIP TM PRECEDING SENTINEL IN REV
         PULL     1,R1              GET BACK SENTINEL
         CW,R1    CEOV
         BE       CHKEOF1
         BAL,R0   CHKANS1
         B        ITSEOF            IF NOT ANS, MUST BE EOF.
         LI,R1    BACONCAT
         MTB,0    *R6,R1
         BEZ      ITSEOF            CONCATENATION IS DONE.
         MTB,-1   *6,1              CONCAT IS ONE MORE THAN TO DO
         BEZ      ITSEOF
         LI,D1    0
         STW,D1   VSETID,R6         CLEAR THE SETID
         LI,R1    BACVI              CLEAR VOLUME SEQUENCE NUMBER.
         STB,D1   *R6,R1
         B        CHKEOF1           TREAT AS EOV. (VOLUME SWITCH)
ITSEOF   EQU      %
         LI,D1    K7
REPSENT  EQU      %
         BAL,R0   CHKANS0
         B        ANSSENT
         PULL     R0
         B        SETTYC
CHKEOF1  EQU      %
         LI,7     BASEQ
         LB,7     *6,7
         CI,R7    8                 IS ULBL
         BAZ      CHKEOF2
         LI,D1    5                 YES.GIVE USER END OF TAPE
         B        REPSENT
CHKEOF2  EQU      %
*
         BAL,11   CVOLA             CLOSE VOLUME
*
         PULL     1,SR4
         CI,SR3   0
         BNE      %+2               NON-SKIPPING RETURN IF ERROR
         AI,SR4   K1
         B        *SR4
*                                                                       966
ANSSENT  EQU      %
         PULL     SR4
         LI,R1    X'800'
         CW,R1    ABCERR,R6
         BANZ     %+4
         LI,R1    X'100'            BLOCK COUUNT ERROR FLAG
         CW,R1    0,R6
         BANZ     ANSSENT1
         BAL,R0   SETTYC
         B        3ER5
ANSSENT1 EQU      %
         LI,R0    0
         STS,R0   0,R6              CLEAR FLAG
ANSSENT2 EQU      %
*E*      ERROR:  4E - 05  ANS BLOCK COUNT ERROR AT END OF TAPE
*,*              4E - 07  ANS BLOCK COUNT ERROR AT END OF FILE
         LI,10    X'4E'
         SCS,D1   -7
         OR,SR3   D1
         DESTRUCT MSR01EXIT
         PAGE
RDSNT    EQU      %                                                     966
*D*      NAME:    RDSNT
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     BAL,R7 RDSNT
*,*      INTERFACE GMB, T:REG, PUTSZBF, READTP, IOSPIN, SKRECR, RESBLK
*,*      INPUT    R6=DCB ADDRESS
*,*      OUTPUT   R1=LABEL TYPE IN XEROX FORMAT(:EOV/:EOF)
*,*               R2=IF ANS, BLOCK COUNT, IN BINARY, FROM LABEL,
*,*                  OTHERWISE NOT SIGNIFICANT.
*,*      DESCRIPTION THE DCB IS SET UP TO READ THE LABEL INTO TSTACK IF
*,*               XEROX LABEL OR INTO A FM BUFFER IF ANS.  AFTER
*,*               READING, THE LABEL IS PUT INTO XEROX FORMAT IF ANS
*,*               AND THE BLOCK COUNT IS CONVERTED TO BINARY AND SAVED IN
*,*               TSTACK ALONG WITH THE LABEL TYPE. THE TAPE IS THEN
*,*               POSITIONED AFTER THE SECOND LABEL, IF PRESENT, READY
*,*               TO READ THE USER LABEL, IF ANY.
*,*               THE BUFFER IS THAN RELEASED AND THE EXIT PARAMETRS
*,*               PULLED INTO R1-R2 FROM TSTACK AND THE ROUTINE EXITS.
         PUSH     R7
         PUSH     2,R0
         BAL,R0   CHKANS1
         B        RDSENT1
*
         BAL,SR4  GSBUF             GET FM BUFFER.
         LI,R2    80                D3= BUFFER, R2= SIZE
         B        RDSENT2
RDSENT1  EQU      %
         LI,R2    K8                                                    966
         LW,14    TSTACK
         AI,D3    KN1                                                   966
RDSENT2  EQU      %
         BAL,SR4  PUTSZBF                                               966
         BAL,D4   SETBTDZ                                               966
         BAL,SR2  READTP                                                966
         BAL,SR4  IOSPIN                                                966
         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 T
         BAL,R0   CHKANS1
         B        RDSENT4
         LW,R2    TSTACK
         LI,R0    ':'
         LW,D3    QBUF,R6
         LW,R1    *D3
         SLD,R0   24
         STW,R0   -1,R2             SAVE SENTINEL TYPE
         LW,R3    D3
         LW,R0    13,R3             GET EBCDIC BLOCK COUNT
         LW,R1    14,R3             FROM SENTINEL
         SLD,R0   16
         LI,3     0                 CONVERT TO BINARY
CNVBIN0  LB,4     0
         BEZ      CNVBIN1
         AI,4     -'0'
         MI,3     10
         AW,3     4
         SLD,0    8
         B        CNVBIN0
CNVBIN1  STW,3    0,2
         BAL,SR2  READTP            READ NEXT RECORD
         BAL,SR4  IOSPIN
         LW,D3    QBUF,R6
         LW,R0    *D3
         CW,R0    TEOF2
         BE       RDSENT3
         CW,R0    TEOV2
         BE       RDSENT3
         BAL,SR2  SKRECR            NOT EOF2 OR EOV2. BACKSP RECORD.
         BAL,SR4  IOSPIN
RDSENT3  EQU      %
RLSBF    EQU      %
         LW,SR4   YFFFE             RELEASE BUFFER.
         AND,SR4  QBUF,R6
         XW,SR4   QBUF,R6
         AND,SR4  M17
         BEZ      %+3
         LI,R5    0
         BAL,R2   T:RBUF
RDSENT4  EQU      %
         PULL     2,R1                                                  966
         PULL     R7
         AND,R2   M16               CLEAR CMD BUT NOT PBD
         STW,R2   CMD,R6                                                966
         B        0,R7
         PAGE
ARD2     EQU      %                 KEY REDA
*F*      NAME:    ARD2
*,*      DESCRIPTION THE BEGINNING OF THE RECORD OF THE SPECIFIED KEY IS
*,*               FOUND THEN TRANSFERRED TO THE USERS BUFFER.
         SPACE    2
*D*      NAME:    ARD2
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     B ARD2
*,*      INTERFACE CHKTRN, GETCMD, COMKEYA, GTFL, KEYTRN, SETTRN, TRNREC,
*,*               MSREXIT, COMKEY, KEYER3
*,*      DESCRIPTION IF NECESSARY, A BUFFER IS OBTAINED AND THE DATA
*,*               BLOCK IS READ INTO THE BUFFER. KEYS FORM THE TAPE ARE
*,*               COMPARED WITH THE REQUESTED KEY AND DEPENDING ON
*,*               GREATER OR LESS RESULTS THE ROUTINE MOVES FORWARD OR
*,*               BACK IN THE FILE. IF THE EXACT MATCH FOR THE KEY IS FOUND,
*,*                THE RECORD IS TRANSFERRED. IF THE PRECEDING  KEY WAS
*,*               SMALLER AND THE CURRENT KEY IS GREATER THAN THE OBJECT
*,*               KEY, IT IS KNOWN THAT THE REQUESTED KEY DOES NOT EXIST.
*,*               THEREFORE, THE LARGER KEY IS TRANSFERRED TO THE KEY
*,*               BUFFER AND AN ERROR 43 IS RETURNED.
         LI,D3    BUF1MSK
         AND,D3   BUFX,R6
         BNEZ     ARD21
         BAL,R0   CHKTRN
         B        ARD22
ARD21    EQU      %
*                                   LOCATE KEY
         LI,D3    BUFF1
         LI,R1    X'FFFF'
         AND,R1   *D3
         CW,R1    BCDA,R6
         BLE      ARD22
         BAL,R0   GETCMD
         LI,1     ARD25M2
ARD25M   RES      0
         LW,D2    D3
         B        COMKEYA
ARD25M2  RES      0
         BE       ARD23
         BL       ARD24
         BAL,R0   GTFL
*E*      ERROR:  43 - 00  NO SUCH KEY ON LABELED TAPE
         B        KEYER3
ARD27    EQU      %
         BAL,1    ARD25M
         BGE      ARD25M2
         B        ARD26             DIDNT FIND
ARD24    EQU      %
         BAL,R0   GTPL
         B        KEYER3
         BAL,1    ARD25M
         BLE      ARD25M2
         BAL,R0   GTFL
         B        KEYER3
ARD26    EQU      %
         BAL,R0   GETCMD
         BAL,R0   KEYTRN
         BAL,D2   SETTRN
         B        KEYER3
ARD23    EQU      %
         BAL,R0   TRNREC
         B        MSREXIT
ARD22    EQU      %
         BAL,1    COMKEY
         BLE      ARD24
         BAL,R0   RDBLK
         B        ARD28
         B        ARD27
*
*
ARD28    EQU      %
         LW,R0    Y002
         CW,R0    FCD,R6
         BAZ      KEYER3
         B        ARD24
         PAGE
*                                   READ REVERSE
ARD3     EQU      %
*F*      NAME:    ARD3
*,*      PURPOSE  READ REVERSE OF A LABEL TAPE RECORD
*,*      DESCRIPTION THE BEGINNING OF THE RECORD PRECEDING  CURRENT
*,*               POSITION IS FOUND, THE RECORD IS THEN TRANSFERRED TO
*,*               THE USERS BUFFER IN A FORWARD MANNER, AND THE
*,*               BEGINNING OF THE RECORD IS FOUND AGAIN TO REFLECT THE
*,*               NEW CURRENT POSITION.
         SPACE    2
*D*      NAME:    ARD3
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     B ARD3
*,*      INTERFACE CHKCON1, GTPL, MSREXIT, KEYTRN, SETTYC, SETTRN, TRNREC
*,*      DESCRIPTION IF NECESSARY, A BUFFER IS OBTAINED AND A DATA BLOCK
*,*               READ.  GTPL IS USED TO FIND THE BEGINNING OF THE
*,*               PRECEDING  RECORD. IF ZERO BYTES WAS REQUESTED, THE
*,*               KEY IS TRANSFERRED TO THE KEY BUFFER, DCB:TRN IS SET
*,*               TO INDICATE POSITION BEFORE THE RECORD, AND THE ROUTINE
*,*               EXITS. IF NON-ZERO BYTES REQUESTED, TRNREC IS USED TO
*,*               TRANSFER THE DATA TO THE USERS BUFFER, GTPL IS CALLED
*,*               TO RE-FIND THE BEGINNING OF THE RECORD, DCB:TRN IS SET,
*,*               AND THE ROUTINE EXITS. IF ANY ABNORMAL OR ERROR
*,*               CONDITION IS DETECTED THE APPROPRIATE ABN/ERR RETURN
*,*               IS GIVEN.
         LI,D3    BUF1MSK
         AND,D3   BUFX,R6
         BEZ      RESEVC            NO BB. RSSET EVC
         LI,D3    BUFF1
         INT,R2   ORG,R6            GOT BB. IS EVC ON
         BCR,1    ARD31             NO. BLOCK WAS READ CORRECTLY
         BAL,D4   CHKCON1           YES. IS CONTROL OK IN BLOCK
         B        ARD31             YES. EVC IS ALREADY ON
         B        CHKCON3           NO.SET EIC,CLEAR EVC,GIVE 4103
RESEVC   EQU      %
         BAL,R2   FIXEIC
         AND,R0   XEF
         BAL,R0   CHKTRN
         B        %+1
ARD31    EQU      %
         BAL,R0   GTPL
         B        MSREXIT
         LW,R0    RWS,R6            SPEED UP BACKSPACE
         BNEZ     1A1
         BAL,0    KEYTRN
         AI,3     3
         SLS,3    -2
         LI,0     X'FFFF'
         AND,0    *D3,3
         BEZ      %+3
         LI,D1    2
         BAL,0    SETTYC
         LI,D2    MSREXIT
         B        SETTRN
1A1      RES      0
         BAL,R0   TRNREC
         BAL,D2   SETTRN
         BAL,R0   GTPL
         B        MSREXIT
         B        MSREXIT
         PAGE
GTPL     EQU      %                 GET PREVIOUS ENTRY
*D*      NAME:    GTPL
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     BAL,R0 GTPL
*,*      INTERFACE SETCMDL, RDBLKR, ISEQICRL, GETCMD
*,*      OUTPUT   D3=BUFFER ADDRESS
*,*               R3-BYTE DISPLACEMENT
*,*      DESCRIPTION IF NECESSARY, A BUFFER IS OBTAINED AND THE PRECEDING
*,*               DATA BLOCK IS READ FROM TAPE. THE START OF THE
*,*               PRECEDING  RECORD IS THEN FOUND, READING SUCCESSIVELY
*,*               PRECEDING  BLOCKS AS NECESSARY TO LOCATE IT. D3 IS
*,*               SET WITH THE ADDRESS OF THE BUFFER CONTAINING THE
*,*               RECORD AND R3 IS SET WITH THE BYTE DISPLACEMENT TO THE
*,*               BEGINNING OF THE CONTROL FOR THE RECORD.
         PUSH     1,R0
         LI,D3    BUF1MSK
         AND,D3   BUFX,R6
         BEZ      GTPL1
         LI,D3    BUFF1
         LW,R5    BCDA,R6
         BEZ      GTPL1             AT BEG OF BLOCK
*
GTPL5    EQU      %
         BAL,R0   SETCMDL
         LI,R0    K0
         STW,R0   BCDA,R6
GTPL3    EQU      %
         AI,R5    -1
         BEZ      GTPL4             SEE IF BEG OF RECORD
         PUSH     1,R5
         BAL,R0   GTFL
         B        %+1
         PULL     1,R5
         B        GTPL3
GTPL1    EQU      %                 GET TO PREV BLOCK
*                                   READ BLOCK REVERSE
         BAL,R0   RDBLKR
         B        PULLEXIT
         INT,R5   *D3               GET NO OF ENT
         B        GTPL5
GTPL4    EQU      %
         BAL,D2   ISEQICRL
         LB,R0    *D3,R3
         CI,R0    K1
         BAZ      GTPL1
         BAL,R0   GETCMD
         B        PULLEXIT1
*
*
         PAGE
RDBLKR   EQU      %
*D*      NAME:    RDBLKR
*,*      REGISTERS ALL VOLATILE EXCEPT R6
*,*      CALL     BAL,R0 RDBLKR
*,*      INTERFACE GETBBUF, GETCMD, SKRECR, COMPFIX, TPIO, IOWT, GETAVR,
*,*               CLRTP, SKFILE, IOSPIN, CLRBBUFL, CVOLA, RDSNT
*,*      DESCRIPTION A BLOCKING BUFFER IS OBTAINED AND THE TAPE IS
*,*               POSITIONED TO READ THE PRECEDING  DATA BLOCK OR UNBLOCKED
*,*               DATA HEADER. IF NECESSARY, DCB:CIS IS ADJUSTED AND
*,*               CVOLA IS CALLED TO GET THE PRECEDING  VOLUME, AND
*,*               THE TAPE IS POSITIONED TO THE END OF DATA IN THAT FILE
*,*               IN ORDER TO READ THE PRECEDING  DATA BLOCK. ANY ABN
*,*               ENCOUNTERED IS RETURNED(BOF,ETC.).
         PUSH     1,R0
RDBLKR4  EQU      %
         BAL,R0   GETBBUF
         BAL,R0   GETCMD
         BEZ      RDBLKR2
         LW,R0    Y002              REV CHNGD FOR B00
         CW,R0    BFL,R6
         BANZ     RDBLKR2
         BAL,SR2  SKRECR
RDBLKR2  EQU      %
         LI,R2    HAPBD             PREV SIZE
         LH,R2    *R6,R2
         BGEZ     RDBLKR3
         BAL,SR2  SKRECR
         BAL,SR4  COMPFIX
         LW,R2    R1
RDBLKR3  EQU      %
         CI,R2    X'7FF'            DONT READ PAST END OF BUFFER
         BAZ      %+2
         BLE      %+2
         LI,R2    X'800'
         BAL,R0   TPIO
         BAL,SR3  IOWT
         BNE      RDBLKRX
         BAL,R3   GETAVR
         AI,R1    KN1
         STD,0    AVRTBL,R2
         BAL,R0   CLRTP
         STW,D1   CMD,R6
         LW,R0    KBUF,R6
         STW,D1   *R0
         BAL,SR2  SKFILE
         BAL,SR4  IOSPIN
         BAL,R0   CLRBBUFL
         LI,D1    K4
         LI,R1    BACVO             AT BEG OF FILE
         LB,R1    *R6,R1
         AI,R1    KN1
         BEZ      RDBLKX3
*                                   GET PREV VOL
         LI,R1    BACIS
         LB,R0    *R6,R1
         CI,R0    K1
         BE       RDBLKX1
*
         AI,R0    KN2
         STB,R0   *R6,R1
         BAL,11   CVOLA
         LW,R3    Y002
         CW,R3    FCD,R6
         BAZ      RDBLKX1
*                                   GET TO EOV
         BAL,SR2  SKFILE
         BAL,R7   RDSNT                                                 966
         BAL,SR2  SKFILER
         B        RDBLKR4
RDBLKRX  EQU      %
         CI,R3    2                 CHECK FOR LATE DATA
         BE       RDBLKR3
         LW,R1    Y002              REV CHNGD FOR B00
         STS,R1   BFL,R6
         CI,R3    8
         BNE      RDBLKX4
         B        RDBLKX
         PAGE
*
COMPFIX  EQU      %
         LI,R1    BASCR
         LB,R1    *R6,R1
         AI,R1    KB
         AND,R1   YFFFFFFFC
         B        *SR4
TPIO     EQU      %
         LI,D3    BUFF1
         PUSH     8,D1
         LW,SR1   Y62
         LI,SR2   READLEND
         B        CBB4
IOWT     BAL,SR4  IOSPIN
         BAL,R4   GETTYC
         CI,R3    X'6'
         B        *SR3
         PAGE
BARB     EQU      %
*D*      NAME:    BARB
*,*      CALL     BAL,SR4 BARB
*,*      DESCRIPTION EXAMINES THE DATA BLOCK THAT WAS READ WITH AN I/O
*,*               ERROR TO CHECK THE BLOCKING CONTROLS FOR CONSISTENCY.
*,*               RETURNS A 41 00 ERR IF A KEYED READ. RETURNS A 41 03
*,*               ERR IF CONSISTENCY ERRORS DETECTED. OTHERWISE SETS
*,*               DCB:EVC AND EXITS.
         LI,SR3   X'4100'
*E*      ERROR:  41 - 00  I/O ERROR ENCOUNTERED ON KEYED READ
*,*                       OF XEROX LABELED TAPE
*
         LI,R1    K1FFFF
         AND,R1   KAD,R6            IS KEYED
         BNEZ     BARB00            YES.
         INT,R1   RNR,R6            NO. IS RNR ON
         BCS,4    BARB2             YES
         BAL,D4   CHKCON1
         B        BARB2
         BAL,R2   FIXEIC
         OR,R0    X20               SET EIC
         SPACE    2
BARB1    EQU      %
*D*      NAME:    BARB1
*,*      DESCRIPTION RETURNS 41 03 ERROR.
         LI,SR3   X'4106'
*E*      ERROR:  41 - 03  CONSISTENCY ERRORS DETECTED ON BLOCK
*,*                       OF TAPE READ WITH AN I/O ERROR
         STW,SR3  BCDA,R6           CAUSE NEW BLOCK TO BE READ ON NEXT R
BARB00   SCS,SR3  -8
ERREX    EQU      %
         LI,R0    PULLALLEXIT
         PUSH     1,R0
         B        RDERX
BARB2    BAL,R2   FIXEIC
         OR,R0    X10               SET EVC
         OBSR4
         PAGE
CHKCON1  EQU      %
*D*      NAME:    CHKCON1
*,*      DESCRIPTION PERFORMS CONSISTENCY CHECKS ON BLOCKED DATA READ
*,*               READ FROM TAPE. RETURNS NORMALLY IF NO ERRORS AND
*,*               RETURNS SKIPPING IF ERRORS DETECTED.
         PUSH     5,R1              EXIT SKIPPING IF BAD
         LI,R2    -1                PBS LO LIM
         LI,R3    2048              PBS HI LIM
         LH,R4    *D3               PBS
         CLR,R2   R4                IS PBS OK
         BCS,6    INVAL             NO
         LI,R2    1                 NKY LO LIM
         LI,R3    170               NKY HI LIM
         LH,R4    *D3,R2            NKY
         CLR,R2   R4                IS NKY OK
         BCS,6    INVAL             NO
         LW,R3    D3                BUF ADR
         SLS,R3   2                 BYTE DISPL OF BUF
         AI,R3    4                 TO FIRST KEY LENGTH BYTE
P3P2P1   EQU      %                 BYTE DISPL=KEY LENGTH BYTE
         BAL,D2   ISEQICRL          GET R3 PAST KEY. R0,R2 CLOBBERED
         LB,R5    0,R3              P3P2P1
         CI,R5    8                 IS CONTROL GT 7
         BGE      INVAL             YES
         CI,R5    2                 NO. IS THIS ILLEGAL
         BE       INVAL             YES
         CI,R5    4
         BL       CKRWS             CONTROL BYTE 0,1 OR 3
         CI,R4    1
         BNE      INVAL
CKRWS    EQU      %                 BYTE DISPL=CONTROL BYTE
         LW,R5    R3                P3P2P1 BYTE DISPL
         SLS,R5   -2                WA(CONTROL WORD)
         INT,R5   *R5               GET RWS
         CI,R5    2036              GREATER THAN 2036
         BG       INVAL             YES
         AW,R3    R5                NO. ADD RECORD SIZE TO ACCUMUL TOTAL
         AI,R3    7                 TO NEXT KEY WORD
         AND,R3   YFFFFFFFC         TO BYTE 0 (KEY LENGTH)
         BDR,R4   P3P2P1
         SLS,R3   -2                CURRENT DISPL TO WA
         SW,R3    D3                WA DIFF BETW START & FIN
         CI,R3    512
         BLE      INVAL+1           CONTROL CHECK OK
INVAL    EQU      %
         AI,D4    1
         PULL     5,R1
         B        *D4
         PAGE
FSEG     EQU      %
*D*      NAME:    FSEG
*,*      DESCRIPTION PROCESSES TAPE ERROR BY CHECKING FOR 1ST SEGMENT,
*,*               RETURNING IF 1ST. OTHERWISE RETURNS A 41 04 ERROR.
         BAL,R2   FIXEIC            CLEAR EIC
         AND,R0   XDF
         BAL,D2   ISEQICRL          GET PAST KEY
         LB,D2    *D3,R3            GET CONTROL BYTE
         CI,D2    1                 IS IT 1ST SEG
         BANZ     PULLEXIT1         YES
         LI,SR3   X'4108'           NO. CONTINUED AND EIC
*E*      ERROR:  41 - 04  PARTIAL RECORD TRANSFERRED TO USER
*,*                       FOLLOWING A 41-03 ERROR
         SCS,SR3  -8
       B          ERREX
XDF      DATA     X'DF'
XEF      DATA     X'EF'
EICEVC   EQU      %
         DATA     X'20',X'10'       EIC,EVC
         SPACE    3
EVCR     EQU      %
*D*      NAME:    EVCR
*,*      DESCRIPTION  PERFORMS ASSOCIATED GENERAL HOUSEKEEPING AND
*,*               RETURNS A 41 02 ERROR.
         BAL,R2   FIXEIC
         AND,R0   XEF               CLEAR EVC
         LI,SR3   X'4104'
*E*      ERROR:   41 - 02 I/O ERROR DETECTED ON BLOCK CONTAINING
*,*                       DESIRED RECORD ; RECORD TRANSFERRED AND
*,*                       SIZE RETURNED IN BYTE 0 OF R8 TO USER
         SCS,SR3  -8
         LI,R1    -27               17+8+2
         AW,R1    TSTACK            LOCATION OF PSD
         LD,R2    *R1               FIRST WORD NEEDED
         LW,SR1   *D3               GIVE USER RECORD COUNT
         STB,SR1  R2                RECORD COUNT TO HI BYTE
         STD,R2   *R1               BYTE 0 CONTAINS RECORD COUNT
         LI,R0    PULLALLEXIT
         PULL     2,R1
         LI,R1    RDERX
         PUSH     3,R0
         B        TRANX
         SPACE    3
TERR     EQU      %
*D*      NAME:    TERR
*,*      DESCRIPTION DOES CONSISTENCY CHECK OF DATA BLOCK THAT HAD READ
*,*               ERROR, SETTING DCB:EVC IF OK OR DCB:EIC IF NOT.
         BAL,D4   CHKCON1
         AI,R3    1                 CONTROL OK. R3=9
         BAL,R2   FIXEIC
         OR,R0    EICEVC-8,R3       R3=8 OR 9
         B        *SR4
CHKCON   EQU      %                 OBAL CHKCON.D3 MUST CONTAIN BUF ADR
         SPACE    3
*D*      NAME:    CHKCON
*,*      DESCRIPTION DOES CONSISTENCY CHECK OF DATA BLOCK THAT HAD READ
*,*               ERROR, RETURNING IF OK, GIVING 41 03 ERROR IF NG.
         LI,SR4   RDL3
         BAL,D4   CHKCON1
         B        *SR4
CHKCON3  EQU      %
         BAL,R2   FIXEIC            NO
         AI,R0    K10               SET EIC, CLEAR EVC
         B        BARB1             GIVE USER IMMEDIATE 4103
         SPACE    2
FIXEIC   EQU      %
         LI,R1    BAEIC
BAEIC    EQU      20
         LB,R0    *R6,R1
         EXU      0,R2
         STB,R0   *R6,R1
         B        1,R2
         END

