ANSPROC SET       1
MONPROC  SET      1
         SYSTEM   UTS
         DEF      ARDL,ARDLSZ
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'
         REF      MSREXIT
         REF      TRNREC
         REF      TRANX
         REF      COMKEYA
         REF      GETCMD
         REF      KEYER3
         REF      KEYTRN
         REF      SETTRN
         REF      COMKEY
         REF      SETBLK
         REF      PUTSZBF
         REF      SETBTDZ
         REF      READTP
         REF      IOSPIN
         REF      RESBLK
         REF      PULLEXIT
         REF      PULLEXIT1
         REF      SETTYC
         REF      Y002
         DEF      CHKEOF
         PAGE
         REF      YFFFFFFFC
         REF      CLRTP
         REF      SKRECR
         REF      GETBBUF
         REF      RDBLKX
         REF      SKFILE
         REF      CLRBBUFL
         REF      RDBLKX3
         REF      RDBLKX1
         REF      READLEND
         REF      CBB4
         REF      ISEQICRL
         REF      SETCMDL
         REF      RDBLK
         REF      GTFL
         REF      CHKTRN
         REF      CVOLA
         DEF      ARD2
         DEF      ARD3
         REF      E:SL,U:MISC,T:REG,GMB,RMB,S:CUN
         REF      M24
         REF      MSR01EXIT
         REF      T:ABORTM
         REF      CHKANS0,CHKANS1
         REF      AVRSID
         REF      TAPEOP1
         REF      AVRTBL
         REF      BATAPE
         PAGE
IOWT     BAL,SR4  IOSPIN
         BAL,R4   GETTYC
         REF      GETTYC
         CI,R3    K6
         B        *SR3
CHKEOF   EQU      %
         PUSH     1,SR4
         BAL,R7   RDSNT                                                 966
         BAL,R0   CHKANS1
         B        GETULBL
         LI,D3    K1FFFF            ITS ANS.
         AND,D3   BUF,R6
         BEZ      ANSBLK            BRANCH IF PFIL ENTRY
         LI,D3    X'400'
         CW,D3    DIR,R6            IF REVERSE, SET BLKCNT
         BANZ     ANSBLK
         LW,R7    BLKCNT,R6
         AND,R7   M24
         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
         LI,D1    8
         BAL,R0   SETTYC
         STS,D2   EGV,R6
         LI,R7    X'800'            NO. WE EITHER ABORT OR GIVE
         CW,R7    ABCERR,R6         AN ABNORMAL DEPENDING ON ABCERR.
         BANZ     GETULBL           IGNORE THE ERROR
         LI,14    X'4E'             ANS BLOCK COUNT ERROR
         B        T:ABORTM
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      %
         REF      TPIOFA
         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
         BG       ALAB              BRANCH IF YES
         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
         LI,R1    BADSI
         LB,R1    *R6,R1            DCTX
         AI,R1    -BATAPE           RELATIVE TO AVR TABLES
         STW,D1   AVRSID,R1         CLEAR SET ID
         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      %
         LI,11    X'400'
         CW,11    DIR,R6            DONT CVOL IF READ REVERSE
         BANZ     CHKEOF3
         BAL,11   CVOLA             CLOSE VOLUME
CHKEOF3  EQU      %
         PULL     1,SR4
         AI,SR4   K1
         B        *SR4
         REF      SKFILER
*                                                                       966
ANSSENT  EQU      %
         PULL     SR4
         LI,R1    X'100'            BLOCK COUUNT ERROR FLAG
         CW,R1    0,R6
         BANZ     ANSSENT1
         BAL,R0   SETTYC
         B        GETTYC-1
ANSSENT1 EQU      %
         LI,R0    0
         STS,R0   0,R6              CLEAR FLAG
ANSSENT2 EQU      %
         DEF      ANSSENT2
         LI,10    X'4E'
         SCS,D1   -7
         OR,SR3   D1
         DESTRUCT MSR01EXIT
*                                                                       966
RDSNT    EQU      %                                                     966
         BAL,R0   SETBLK                                                966
         PUSH     2,R0
         BAL,R0   CHKANS1
         B        RDSENT1
TRYGMB   BAL,SR4  GMB               MONITOR BUFFER
         BNEZ     GOTMB             GOT ONE
         PUSH     R6
         LI,R6    1                 SLEEP 1 UNIT
         LW,R2    S:CUN             CURRENT USER
         STW,R6   U:MISC,R2
         LI,R6    E:SL
         BAL,SR4  T:REG
         PULL     R6
         B        TRYGMB
GOTMB    EQU      %
         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
         REF        Y1,Y2
         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      %
         LW,D3    QBUF,R6
         BAL,SR4  RMB               GIVE BUFFER BACK
RDSENT4  EQU      %
         PULL     2,R1                                                  966
         BAL,R0   RESBLK                                                966
         STW,R2   CMD,R6                                                966
         B        0,R7
         PAGE
ARD2     EQU      %                 KEY REDA
         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
         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
*                                   READ REVERSE
ARD3     EQU      %
         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
         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      %
         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      %
         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
         REF      RDBLKX4
         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
BARB     EQU      %
         DEF      BARB
         LI,SR3   X'4100'
         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
BARB1    EQU      %
         DEF      BARB1
         LI,SR3   X'4106'
         STW,SR3  BCDA,R6           CAUSE NEW BLOCK TO BE READ ON NEXT R
BARB00   SCS,SR3  -8
ERREX    EQU      %
         LI,R0    PULLALLEXIT
         REF      PULLALLEXIT
         PUSH     1,R0
         B        RDERX
         REF      RDERX
BARB2    BAL,R2   FIXEIC
         OR,R0    X10               SET EVC
         OBSR4
CHKCON1  EQU      %
         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
FSEG     EQU      %
         DEF      FSEG
         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
         SCS,SR3  -8
       B          ERREX
XDF      DATA     X'DF'
XEF      DATA     X'EF'
EICEVC   EQU      %
         DATA     X'20',X'10'       EIC,EVC
EVCR     EQU      %
         DEF      EVCR
         BAL,R2   FIXEIC
         AND,R0   XEF               CLEAR EVC
         LI,SR3   X'4104'
         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
TERR     EQU      %
         DEF      TERR
         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
         DEF      CHKCON
         LI,SR4   RDL3
         REF      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
FIXEIC   EQU      %
         LI,R1    BAEIC
BAEIC    EQU      20
         LB,R0    *R6,R1
         EXU      0,R2
         STB,R0   *R6,R1
         B        1,R2
         REF      GETAVR
ARDLSZ   EQU      %-ARDL
         END

