*M*      LBLT     PROCESSES WRITE AND CVOL CALS FOR ANS AND LABEL TAPE.
*P*      NAME:    LBLT
*,*      PURPOSE  RECEIVES AND PERFORMS THE CVOL CAL FOR ALL TYPES OF
*,*               TAPE, AND RECEIVES THE WRITE CAL FOR LABEL AND ANS TAPE
*,*               AND PERFORMS THE WRITE FUNCTION FOR LABEL TAPE.
*,*               ALSO PERFORMS THE POST I/O OPERATIONS FOR ANS APPE////TAPE
*,*               READ AND WRITE.
*UPDATED 9/15/71 BH
*        704717   SIGMA 5/7   BPM  M:LBLT                               717
ANSPROC  SET      1
MONPROC  SET      1
         SYSTEM   UTS
         PAGE
*********************  DEF  *********************
*
**************ROUTINES***************
         DEF      CVOLA             MONITOR INITIATED CVOL
         DEF      CHKACS3           SKIP IF DCB:ACS NOT 3
         DEF      GETAVR            GET AVRX AND AVR ENTRY
         DEF      KEYTRN            MOVE KEY INTO BUFFER
         DEF      LBLT:             NAME FOR MODULE PATCHING
         DEF      SKFILE            MOVE TAPE FORWARD PAST TAPE MARK
         DEF      SKFILER           MOVE TAPE BACKWARDS OVER TAPE MARK
         DEF      TAPEOP1           DO TAPE OPERATION IN SR3
         DEF      WRITEL            WRITE ANS/XEROX LABEL TAPE
         SPACE    5
******************  REF  *****************************
*
****************CONSTANTS****************
         REF      ABO
         REF      DOUBLEZERO
         REF      NB31TO0
         REF      ERO
         REF      M24
         REF      M6
         REF      NBATAPE
         REF      OPNTPSEG
         REF      YFFFFFFFC
         REF      Y000C
         REF      Y0004
         REF      Y0008
         REF      Y001
         REF      Y002
         REF      Y004
         REF      Y02
         REF      Y04
         SPACE    2
**************VARIABLES***************:
         REF      ANSFLGS           INPUT;X'02'
         REF      AVRSID            INPUT;
         REF      AVRTBL            INPUT; OUTPUT;X'0000000000FFFFFF'
         REF      CJOB              INPUT;
         REF      J:JIT             INPUT;
         REF      TB:FLGS           INPUT;X'C0'
         SPACE    2
**************ROUTINES*****************
         REF      ANSSENT2          GIVE 4E 00       ERROR
         REF      AOPNL1#           OPEN OUTPUT TAPE DURING CVOL
         REF      BARB1             GIVE 41 03 ERROR
         REF      CHKANS0           SKIP IF DCB NOT ANS
         REF      CHKANS1           SKIP IS DCB ANS
         REF      CHKEOF            PROCESS EOF/EOV
         REF      CHKTP             ADJUST TAPE POS PER DCB:REV
         REF      CHKTRN            REREAD TRUNCATED BLOCK INTO BUFFER
         REF      CLRBBUF           FLUSH BLOCKING BUFFER
         REF      CLRMBG            CLEAR DCB:MBG
         REF      CLRTP             CLEAR DCB:REV
         REF      CLRTRN            CLEAR DCB:TRN
         REF      COMKEY            CHK ORDER OF OUTPUT KEYS
         REF      DONEWQ            DO I/O OPERATION
         REF      GETASN            GET DCB:ASN
         REF      GETBBUF           GET A BLOCKING BUFFER
         REF      GETBTD           GET DCB:BTD
         REF      GETCMD            GET DCB:CMD
         REF      GETFUN            GET DCB:FUN
         REF      GETKEYSB          MOVE KEY INTO BLOCKING BUFFER
         REF      GETTYC            GET DCB:TYC
         REF      INITARS           INITIALIZE ARS
         REF      IOCHEK1           DO ANS POST-PROCESSING
         REF      IOSPIN            WAIT FOR I/O COMPLETE
         REF      KEYER1            GIVE 18 00 ERROR
         REF      KEYER2            GIVE 16 00 ERROR
         REF      MOVECAL           TRANSFER VECTOR REFERENCE
         REF      MSRCLSLBL#        CLOSE ANS/XEROX LABEL TAPE IN CVOL
         REF      MSREXIT           NORMAL EXIT
         REF      MSRRED            REREAD ANS RECORD AFTER NOISE
         REF      MSRWRT            WRITE ANS RECORD
         REF      MSRWRTX           NORMAL EXIT
         REF      MSR01EXIT         ABN/ERR EXIT
         REF      OPNLBL#           OPEN ANS/XEROX LABEL TAPE IN CVOL
         REF      OPNT1#            OPEN DEVICE TAPE IN CVOL
         REF      PULLALLEXIT       MAJOR ROUTINE EXIT
         REF      PULLEXIT          EXIT *TSTACK
         REF      PULLEXIT1         EXIT C(TSTACK)+1
         REF      PUSHALL           SAVE ENVIRONMENT
         REF      QUEUE1            DO I/O OPERATION
         REF      RDSNT             READ TRAILER SENTINEL
         REF      READL             TRANSFER VECTOR REFERENCE
         REF      READLEND          DATA READ END ACTION ROUTINE
         REF      RECTRAN           TRANSFER DATA TO/FROM BUFFER
         REF      RELTP#            DISMOUNT TAPE DURING CVOL
         REF      RESBLK            RESTORE DCB:BLK, ETC
         REF      SAVBLK            SET DCB:BLK
         REF      SETBLK            SAVE DCB:BLK, ETC
         REF      SETBTDQ           SET DCB:HBTD FROM DCB:UBTD
         REF      SETCMDL           INITIALIZE CMD TO 4
         REF      SETCMD1           SET DCB:CMD
         REF      SETTYC            SET DCB:TYC
         REF      SKRECR            SKIP BACK OVER TAPE RECORD
         REF      TRANX             SET DCB:ARS AND EXIT
         REF      TRNTST            DETERMINE STATE OF DCB:TRN
         REF      3ER5
LBLT:    EQU      %
         LW,1     0
         B        %+1,1
         B        READL
         B        WRITEL
         B        CVOL
         B        CVOLA
         B        CHKEOF
         B        POSCHKEOF
         B        MOVECAL
         B        POSTANS
         PAGE
         BOUND    8
K2       EQU      2
K7       EQU      X'7'
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K5       EQU      X'5'
K8       EQU      X'8'
KA       EQU      X'A'
KB       EQU      X'B'
K10      EQU      X'10'
K20      EQU      X'20'
K56      EQU      X'56'
K7F      EQU      X'7F'
K7FFC    EQU      X'7FFC'
K8000    EQU      X'8000'
K1FFFF   EQU      X'1FFFF'
K20000   EQU      X'20000'
K40000   EQU      X'40000'
KN1      EQU      -X'1'
KN4      EQU      -X'4'
Y26      DATA     X'26000000'
MASKCLS  DATA     X'0060F700'
Y1FFFFFFF DATA X'1FFFFFFF'
XFFF7FFFF EQU     NB31TO0+20
         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     LBLT REFS
GETAVR   EQU      %
         LI,R2    BADSI             IS TAPE BUSY
         LB,R2    *R6,R2
         AI,R2    NBATAPE
         LD,R0    AVRTBL,R2
         B        0,R3
PLBSR4   RES      0
         PULL     1,SR4
         OBSR4
*                                      ENTERED FROM CVOL
SETFUN   EQU      %
         LI,D2    K7F
         SLD,D1   17
         STS,D1   FUN,R6
         B        *R0
         SPACE    2
CHKACS3  EQU      %
*D*      NAME:    CHKACS3
*,*      DESCRIPTION EXITS SKIPPING IF DCB:ACS NOT EQUAL 3
         PUSH     R0
         LI,R0    X'F'
         AND,R0   ACS,R6
         CI,R0    3
         BNE      PULLEXIT1
         B        PULLEXIT
         PAGE     CVOL
*                                   CLOSE VOLUMNE AND GO TO NEXT TAPE
*
*
CVOL     EQU      %
*F*      NAME:    CVOL
*,*      PURPOSE  RECEIVES CVOL CAL AND PERFORMS FUNCTION.
*,*      DESCRIPTION CALLS TCHK FOR DEVICE TAPE VOLUME SWITCH, OR
*,*               CALLS CVOLAA FOR ANS AND LABEL TAPE VOLUME SWITCH.
         SPACE    2
*D*      NAME:    CVOL
*,*      ENTRY    CVOLA
*,*      REGISTERS ALL VOLATILE EXCEPT R5-SR4
*,*      CALL     BAL,SR4 CVOLA  OR  OVERLAY LTAPESEG,3
*,*               BAL,SR4 CVOL  OR  OVERLAY LTAPESEG,2
*,*      INTERFACE PUSHALL, MSRWRTX, IOSPIN, GETASN, RELTP, OPNT1,
*,*               GETFUN, SETFUN, MSRCLSLBL, OPNLBL, AOPNL1, SETBLK,
*,*               RESBLK, SETTYC
*,*      DESCRIPTION ENTRY AT CVOLA IS FOR AUTOMATIC CVOLS, AND SAVES
*,*               JIT ABN/ERR ADDRESSES, CALLS CVOL, AND RESTORES THE
*,*               JIT ADDRESSES. CVOL CHECKS DEVICE TYPE AND IF NOT TAPE,
*,*               EXITS. OTHERWISE, IF DEVICE TAPE THE VOLUME IS DISMOUNTED
*,*               VIA RELTP, DCB:COS IS BUMPED, AND THE NEXT VOLUME IS
*,*               MOUNTED VIA OPNT1. IF NOT DEVICE TAPE, THE DCB:FUN IS
*,*               SAVED AND RESET TO IN, INOUT, OR OUTIN TO REFLECT
*,*               WHETHER LABELS ARE TO BE WRITTEN(OUTIN)AND WHETHER
*,*               A WRITE RING IS NEEDED IN THE NEW VOLUME
*,*               (INOUT OR OUTIN). THE OLD VOLUME IS THEN CLOSED AND
*,*               REMOVED VIA MSRCLSLBL, AND THE THE NEXT VOLUME IS
*,*               MOUNTED BY EITHER OPNLBL(IN OR INOUT) OR AOPNL1(OUTIN)
*,*               THE DCB IS HOUSEKEPT AND THE EXIT IS TO MSRWRTX IF
*,*               NO ERRORS OCCURRED DURING CVOL, OR VIA MSRCLSX2A
*,*               WITH DCB:TYC SET TO X'A' IF AN ERROR.
*                                   DCB MUST BE OPEN
         BAL,R1   PUSHALL
*
         LW,D2    Y002
         AND,D2   FCD,R6
         BEZ      MSRWRTX
         BAL,SR4  IOSPIN
*
*
         BAL,R0   GETASN
         CI,D2    K2
         BE       CVOLAA
         CI,D2    K3
         BNE      MSRWRTX
*
TCHK     LI,3     BADEVTP
         LB,3     *6,3
         AND,3    M6
         LC       TB:FLGS,3
         BCR,8    MSRWRTX
         BCS,4    MSRWRTX
*                                   CLOSE VOLUMNE ON UNLABELED TAPE
*
         OVERLAY  OPNTPSEG,RELTP#   CLRSCR,SAVAVR,CLRAVR
         LI,R1    BACIS
         MTB,1    *R6,R1
         LI,SR4   CVOL6
         REMEMBER
         BAL,R1   PUSHALL
         OVERTO   OPNTPSEG,OPNT1#
*
*
*
CVOLA    EQU      %
*F*      NAME:    CVOLA
*,*      PURPOSE  RECEIVES MONITOR INITIATED CVOL REQUESTS.
*,*      DESCRIPTION SAVES AND RESTORES ABN/ERR ADDRESSES AND CALLS
*,*               CVOL TO PERFORM VOLUME SWITCH.
*                                   ENTRY POINT FOR MONITOR CLOSE VOL
         LI,R5    J:JIT
         LCI      K3
         LM,D1    ERO,R5
         PSM,SR4  TSTACK
         BAL,11   CVOL
         PULL     1,D1
         LI,D2    K1FFFF
         STS,D1   ABO,R5
         PULL     1,D1
         STS,D1   ERO,R5
         SLS,SR3  -17               REPOSITION ERROR CODE
         SCS,SR3  -7                AAND SUBCODE
         B        PLBSR4
CVOLAA   EQU      %
         BAL,D2   GETFUN
         LW,D2    KAD,R6           SAVE KEY ADDRESS
         LW,R1    VSETID,R6         SAVE ANS SET ID FOR OPEN
         STW,R1   SETID,R6
SETID    EQU      19
         PUSH     2,D1
         CI,D1    K1
         BE       CVOL5
         LI,D1    K8
         LW,R1    Y0008
         CW,R1    EOP,R6
         BANZ     %+2
         LI,D1    K4
         BAL,R0   SETFUN
CVOL5    EQU      %
         OVERLAY  OPNTPSEG,MSRCLSLBL#
         LW,D3    KBUF,R6
         LW,D3    *D3
         PUSH     1,D3
         BAL,0    SETBLK
         LI,SR1   0                 NO FILE EXTENSION POSSIBLE HERE
         LI,11    CVOL2
         REMEMBER
         BAL,R1   PUSHALL
         BAL,D2   GETFUN                                                717
         CI,D1    KA                                                    717
         BANZ     CVOL7
         OVERTO   OPNTPSEG,OPNLBL#
CVOL7    EQU      %
         OVERTO   OPNTPSEG,AOPNL1#
CVOL2    EQU      %
         BAL,0    RESBLK
         PULL     1,R0
         LW,D3    KBUF,R6
         STW,R0   *D3
         PULL     1,D3
         LI,D4    K1FFFF
         STS,D3   KAD,R6
         PULL     1,D1
         BAL,R0   SETFUN
*                                   RESTORE DCB ITEMS--SAVE SERIAL NOS
CVOL6    AI,SR3   0                 DID
         BEZ      MSRWRTX
*                                   RELEASE SCRATCH TAPES
PLER     RES      0
         LI,D1    X'A'              BAD CVOL
         BAL,R0   SETTYC
         LI,SR3   K56
*E*      ERROR:   56 - 00  CANNOT COMPLETE CVOL EITHER BECAUSE
*,*                        NO NEXT VOLUME OR ERROR OPENING IT
         B        MSRCLSX2A
         PAGE     WRITEL
*                                   EXIT TO WAIT ONLY IF LARGE BLK.
LBLTEX   LW,R0    RWS,R6
         CI,R0    BUFSIZ
         BGE      MSREXIT
         LW,R1    Y001
         STS,R0   WAT,R6
         B        MSREXIT
*                                   WRITE LABELED TAPE
*
*
*
WRITEL   EQU      %
*F*      NAME:    WRITEL
*,*      PURPOSE  RECEIVES ANS AND LABEL TAPE WRITE CALS AND PERFORMS
*,*               LABEL TAPE WRITES.
*,*      DESCRIPTION IF THE EOT FLAG IS SET IN THE DCB, IT IS PROCESSED.
*,*               IF THERE WAS NO EXIT DUE TO EOT HANDLING, ANS WRITES
*,*               TRANSFER TO MSRWRT IN WRTD. LABEL TAPE WRITES PROCEED.
*,*               A BUFFER IS OBTAINED IF NECESSARY, THE RECORD IS MOVED
*,*               INTO THE BUFFER, THE BUFFER IS WRITTEN TO TAPE IF FULL
*,*               OR THE RECORD, OR SEGMENT THEREOF, IS WRITTEN
*,*               DIRECTLY TO TAPE WITH A THREE WORD HEADER.
         SPACE    2
*D*      NAME:    WRITEL
*,*      CALL     OVERTO LTAPESEG,1
*,*      INTERFACE CHKANS0, IOCHEK1, IOSPIN, GETTYC, SETTYC, MSREXIT,
*,*               CVOLA, PULLALLEXIT, CLRMBG, CHKANS1, INITARS, KEYTRN,
*,*               CLRTRN, CHKTRN, SKRECR, GETCMD, BARB1, CLRTP, GETCMD,
*,*               GETKEYSB, SETCMD1, GETBTD, RECTRAN, COMPFIX, CLRBBUF,
*,*               TRANX, INITBLK, COMPFIX, SETBTDQ, QUEUE1, READLEND,
*,*               COMKEY, TRNTST, KEYER1, KEYER2, SETCONSEC
*,*      DESCRIPTION IF THE EOT FLAG IS SET IN THE DCB, IT IS PROCESSED.
*,*               IF THERE WAS NO EXIT DUE TO EOT HANDLING, ANS WRITES
*,*               TRANSFER TO MSRWRT IN WRTD. LABEL TAPE WRITES PROCEED.
*,*               A BUFFER IS OBTAINED IF NECESSARY, THE RECORD IS MOVED
*,*               INTO THE BUFFER, THE BUFFER IS WRITTEN TO TAPE IF FULL
*,*               OR THE RECORD, OR SEGMENT THEREOF, IS WRITTEN
*,*               DIRECTLY TO TAPE WITH A THREE WORD HEADER.
         BAL,R0   CHKANS0
         BAL,SR4  IOCHEK1           IF ANS, SPIN AND POSTANS
         LI,D2    K40000
         CW,D2    BFL,R6
         BAZ      WRTEL1
         BAL,SR4  IOSPIN
*********        EOT PROCEDURE
         BAL,R4   GETTYC            TO R3
         CI,R3    5                 IS IT SECOND WRITE AFTER EOT
         BE       EOT2              YES
         LI,R3    K1FFFF            NO. FIRST WRITE
         AND,R3   ABO,R5            IS THERE ABN IN FPT
         BEZ      EOT1              NO
         LI,D1    5                 YES
         BAL,R0   SETTYC            D1 TO TYC
         B        MSREXIT
WRTBLOCK  RES     0
*                    EXIT FOR XEROX U ORG AND ANS
         LI,R0    18                MINIMUM BLOCK SIZE
         CW,R0    RWS,R6
         BLE      %+2
         STW,R0   RWS,R6
         B        MSRWRT
*
EOT2     EQU      %
         LI,D1    0
         BAL,R0   SETTYC            D1 TO TYC
EOT1     EQU      %                 CHANGE VOLUME
         BAL,11   CVOLA
         AI,SR3   0
         BNEZ     PULLALLEXIT       CVOL ERR, GET OUT
WRTEL1   EQU      %
         BAL,D4   CLRMBG
         LI,D1    K0
         BAL,R0   SETTYC
         BAL,R0   CHKACS3
         B        WRTBLOCK          HANDLE XEROX U ORG AND ANS
WRTEL12  LI,R0    LBLTEX
         PUSH     1,R0
         BAL,SR4  INITARS
         LW,R0    KBUF,R6
         LW,R0    *R0
         BNEZ     WRTL10
         LI,R2    X'20'
         CW,R2    ORG,R6            ORGTEST
         BANZ     WRTL13
         LW,D2    SKEY
         BAL,R0   SETCONSEC
WRTL13   EQU      %
*
*
         LI,R3    K0
         LW,D3    KAD,R6
         BAL,R0   KEYTRN
         BAL,D2   CLRTRN
         LW,D4    EOP,R6            REMEMBER EOP
*                                   SEE IF BLOCK IS IN
WRTELA   EQU      %
         LI,D3    BUFF1
         LI,R0    BUF1MSK
         AND,R0   BUFX,R6
         BNEZ     WRTL4
*
*
         BAL,R0   CHKTRN
         B        WRTL1             DIDNT TRUNCATE
*
*
*                                   ADD RECORD TO BLOCK
WRTL4    EQU      %
         CW,D4    Y0008             WAS LAST OP A WRITE
         BANZ     WRTL4A
         LI,R0    X'FFFF'
         AND,R0   *D3
         CW,R0    BCDA,R6
         BL       WRTL14
         LW,R0    Y002              REV CHNGD FOR B00
         CW,R0    BFL,R6
         BANZ     WRTL4C
         BAL,SR2  SKRECR
         LI,D3    BUFF1
WRTL4C   EQU      %
         BAL,R0   GETCMD            CHK FOR ROOM LEFT IN BUFFER
         BAL,SR4  COMPFIX
         AW,R1    R3
         CI,R1    BUFSIZ
         BG       WRTL14            NO, START A NEW ONE
WRTL4A   EQU      %
         BAL,R0   CLRTP
         LI,R1    K1
         MTW,1    BCDA,R6                                               717
         LW,R0    BCDA,R6                                               717
         STH,R0   *D3,R1                                                717
WRTL4B   EQU      %
         LW,D1    Y0008
         LW,D2    Y000C
         STS,D1   EOP,R6            SET LAST OP TO WRITE
         LW,R1    Y004              SET BUFFER UPDATE FLAG              717
         STS,R1   BFL,R6                                                717
         BAL,R0   GETCMD
         BAL,SR4  GETKEYSB
         AI,R3    K7
         AND,R3   YFFFFFFFC
         BAL,R0   SETCMD1
         LI,R2    BUFSIZ            BUFFER SIZE
         BAL,D4   GETBTD
         LW,D4    QBUF,R6
         LW,R1    RWS,R6
         AW,R1    R4
         BAL,SR4  RECTRAN
         LW,R2    R3
         LI,R5    HACMD             COMPUTE SIZE IN BUFFER
         SH,R2    *R6,R5
         BAL,SR4  SVSIZ
*
         LH,R4    *R6,R5
         AI,R4    KN4
         SLS,R4   -2
         STW,R2   *D3,R4
*                                   SEE IF BLOCK SHOULD BE WRITTEN OUT
         AI,R3    K3
         AND,R3   YFFFFFFFC
         BAL,R0   SETCMD1
         BAL,SR4  COMPFIX
         AW,R1    R3
         CI,R1    BUFSIZ
         BL       WRTLX
         BAL,R0   CLRBBUF                                               717
WRTLX0   RES
         LI,R0    0                 CLEAR TBT BECAUSE WE DIDNT MEAN IT
         LW,R1    Y001
         STS,R0   BFL,R6
*
WRTLX    EQU      %
*
         LW,D1    BLK,R6
         SLS,D1   -17
         AWM,D1   *TSTACK           ARS
         SLS,D1   -2
         AWM,D1   QBUF,R6
*
*                                   SET ARS
         LW,D1    RWS,R6
         BNEZ     WRTELA
         B        TRANX
*
*
WRTL1    EQU      %
*
         BAL,R0   INITBLK
         BAL,SR4  COMPFIX
         AW,R1    RWS,R6
         CI,R1    BUFSIZ
         BLE      WRTL4B
*  BLOCK ALL TAPE RECORDS IF ANSLFLGS=2
         LI,R2    BADSI             GET AVRIX IN R2
         LB,R2    *R6,R2
         AI,R2    NBATAPE
         LB,R2    ANSFLGS,R2        IF ANSFLGS
         CI,R2    2                 =2,  THEN
         BE       WRTL4B            WRITE IT BLOCKED
*
*
*                                   SET UP RECORD WITH KEY AND SIZE
         LW,D1    Y0008
         LW,D2    Y000C
         STS,D1   EOP,R6            SET LAST OP TO WRITE
         BAL,SR4  GETKEYSB
         AI,R3    K3
         SLS,R3   -2
*                                   SAVE RECORD SIZE
         LW,R2    RWS,R6
         CI,R2    K7FFC
         BLE      %+2
         LI,R2    K7FFC
         BAL,SR4  SVSIZ
         OR,R2    Y04
         STW,R2   *D3,R3
         AI,R3    K1
         SLS,R3   K2
*                                   WRITE OUT CONTROL RECORD
         BAL,R0   SETCMD1
         LW,R1    Y004                                                  717
         STS,R1   BFL,R6                                                717
         BAL,R0   CLRBBUF                                               717
         LI,R3    X'FFFF'
         STW,R3   CMD,R6
         BAL,D4   SETBTDQ
* WRITE UNBLOCKED DATA RECORD WITH END ACTION
         LW,SR1   Y26               WRITE CODE
         OR,SR1   R6                MERGE WITH DCB
         LI,SR2   READLEND          END ACTION ADR (IN IORT)
         LI,SR4   K1FFFF
         LS,SR3   CJOB              JIT ADDRESS
         LI,R1    BAFCN
         MTB,1    *R6,R1            BUMP FUNCTIONS COUNT
         BAL,SR4  QUEUE1
         B        WRTLX0            CLEAR TBT
WRTL10   EQU      %
         LW,R2    ORG,R6
         CI,R2    X'20'             IS IT KEYED
         BAZ      WRTL12
         CI,R2    2                 IS THIS DIRECT ACCESS
         BANZ     WRTL13            YES, ANY ORDER IS OK
         BAL,1    COMKEY            KEYS MUST BE IN ORDER
         BL       WRTL11
         BG       WRTL13
         BAL,D2   TRNTST
         BANZ     WRTL13
         B        WRTL11A
WRTL11   LI,0     KEYER1
         B        %+2
WRTL11A  LI,0     KEYER2
         LI,1     -1
         STW,0    *TSTACK,1
         B        TRANX
WRTL12   EQU      %
         LW,D4    KBUF,R6           INCREASE SEQUENTIAL KEY
         LW,D2    *D4
         LW,D1    5,R6
         CW,D1    Y02
         BANZ     %+2
         AI,D2    1
         BAL,R0   SETCONSEC
         B        WRTL13
*
*
WRTL14   EQU      %
         LW,R0    CMD,R6
         LH,R0    R0
         STW,R0   PBD,R6
         BAL,SR2  CHKTP
         B        WRTL1
         SPACE    3
KEYTRN   LW,5     KBUF,6
         SLS,5    2
         LI,1     BASCR
         LB,1     *6,1
         STB,1    5
         ANLZ,4   1A1
         AW,3     1
         MBS,4    0
         B        *0
1A1      LB,1     *14,3
         PAGE
SKFILER  EQU      %
         LI,SR3   6
         BAL,R3   GETAVR
         CI,R1    X'FFFF'
         BAZ      %+2               NEVER GO NEGATIVE
         AI,R1    KN1               DECR TPOS
         B        TAPEOP
SKFILE   EQU      %
         LI,SR3   7
         BAL,R3   GETAVR
         AI,1     1
         B        TAPEOP
TAPEOP   EQU      %
TAPEOP1  EQU      TAPEOP            ENTRY FROM ARDL***SAME NAME
*D*      NAME:    TAPEOP1
*,*      ENTRY    SKFILER, SKFILE
*,*      CALL     BAL,SR2 SKFILE
*,*               BAL,SR2 SKFILER
*,*               BAL,SR2 TAPEOP1
*,*      INTERFACE GETAVR, DONEWQ
*,*      INPUT    R6=DCBADDRESS
*,*               SR3=TAPE OPERATION CODE
*,*      DESCRIPTION ENTRY AT SKFILE OR SKFILER SETS THE CODE TO FORWARD
*,*               SPACE FILE OR BACK SPACE FILE, RESPECTIVELLY, AND
*,*               ADJUSTS THE TPOS PORTION OF AVRTBL APPROPRIATELLY,
*,*               AND GOES TO TAPEOP1. TAPEOP1 STORES THE MODIFIED ENTRY
*,*               INTO AVRTBL AND PASSES THE REQUEST TO DONEWQ FOR
*,*               EXECUTION.
         STD,R0   AVRTBL,R2
         B        DONEWQ
MSRCLSX2 EQU      %
         CLEAR
MSRCLSX2A   EQU   %
         ANSBAL,0 CHKANS1
         B        MSRCLSX2B         NONANS
         LI,0     0
         LI,1     X'40000'
         STS,0    16,6              CLEAR EOT FLAG
         B        MSRCLSX2C
MSRCLSX2B RES     0
*
*                                   CLEAR DEVICE OPTIONS
         LD,R0    DOUBLEZERO
         LD,R2    DOUBLEZERO
         LCI      4
         STM,R0   TAB1,R6
         STW,R0    ACD,R6
         STW,R0   DSC,R6
         LW,R1    Y04              CLEAR SEQU FLAG
         STS,R0   SEQ,R6
MSRCLSX2C EQU     %
         LW,R0    Y004
         LW,R1    MASKCLS
         STS,R0   TTL,R6
         LW,SR3   SR3
         BEZ      PULLALLEXIT
         LI,R1    BACIS
         STB,R0   *R6,R1
         B        MSR01EXIT
         PAGE
POSTANS  EQU      %
*D*      NAME:    POSTANS
*,*      REGISTERS ALL VOLATILE
*,*      CALL     OVERLAY LTAPESEG,POSTANS#
*,*      INTERFACE GETTYC, SETTYC, CVOLA, SKFILE, SKFILER, GETAVR,
*,*               TAPEOP1, CHKEOF, MSR01EXIT, MSRRED
*,*      DESCRIPTION ROUTINE RESETS DCB:APF AND EXITS IF IT WAS NOT SET
*,*               OR IF DCB:EOP INDICATES NEITHER READ NOR WRITE.
*,*               IF WRITE, DCB:BLKCNT IS INCREMENTED AND ROUTINE EXITS IF
*,*               TAPE MARK NOT ENCOUNTERED. IF TAPE MARK, DCB:TYC IS
*,*               RESET TO 1 AND DCB:EOT IS SET. IF A READ, IF AN ERROR
*,*               OCCURRED ROUTINE EXITS, AND IF EOT IS INDICATED DCB:TYC
*,*               IS RESET TO 1(NORMAL). IF TAPE MARK INDICATED,
*,*               DEPENDING ON FORWARD OR BACKWARD READ, EITHER CHKEOF IS
*,*               CALLED TO PROCESS THE LABELS OR THE BLOCK COUNT IS
*,*               CHECKED FOR ZERO AND EITHER A BOF IS RETURNED OR A
*,*               REVERSE CVOL IS PERFORMED, DEPENDING OF DCB:CVI BEING
*,*               1 OR GREATER THAN 1. IN ANY EVENT, AFTER PROCESSING THE
*,*               TAPE MARK THE NEXT(PRECEEDING) RECORD IS REREAD OR
*,*               AN APPROPRIATE ABNORMAL IS RETURNED. IF A NORMAL READ,
*,*               BLOCK COUNT IS ADJUSTED IN THE DCB, ACCORDING TO
*,*               DIRECTION OF THE READ, AND THE ROUTINE EXITS.
         LW,D1    XFFF7FFFF
         AND,D1   BFL,R6
         XW,D1    BFL,R6
         CW,D1    BFL,R6
         BE       *SR4
         LW,SR3   Y000C
         AND,SR3  EOP,R6
         CW,SR3   Y0004             READ
         BE       POSTRD
         CW,SR3   Y0008             WRITE
         BNE      *SR4              NEITHER
POSTWRT  EQU      %
         MTW,1    BLKCNT,R6         INCREMENT BLOCK COUNT
         BAL,R4   GETTYC
         CI,R3    5
         BNE      *SR4
         LI,D1    1                 IF END OF TAPE, SET BFL AND TYC=1.
         BAL,R0   SETTYC
         LI,R3    X'40000'
         STS,R3   BFL,R6
         B        *SR4
POSTRD   EQU      %
         BAL,R4   GETTYC
         CI,R3    6
         BE       DIRTST
         CI,R3    8
         BE       *SR4              RETURN IF TAPE ERROR
         CI,R3    5                 IGNORE EOT ON DATA READ
         BNE      POSTRD1
         LI,D1    1
         BAL,R0   SETTYC
POSTRD1  EQU      %
*                                   CHECK FOR NOISE.  RECORD MUST
         LW,R3    ARS,R6            BE 0 OR GREATER THAN 17
         SLS,R3   -17
         CI,R3    18
         BGE      BC
         CW,R3    RWS,R6            IF = REQUEST, OK--ELSE NOISE
         BL       RERED             ORIF LESS, MUST BE RWS=0, ARS=1(SKIP)
         MTW,0    RWS,R6
         BNE      BC
         LI,D1    1                 WAS READ 0(SKIP) SO CLR 'LOST DATA'
         BAL,R0   SETTYC
*
BC       EQU      %                 MODIFY BLOCK COUNT
         LI,R2    1
         LW,R3    DIR,R6              +1 IF FORWARD
         CI,R3    X'400'              -1 IF REVERSE
         BAZ      MBC
         LI,R2    -1
MBC      EQU      %
         AWM,R2   BLKCNT,R6
         B        *SR4
DIRTST   LI,R3    X'400'            CHK DIRECTION
         CW,R3    DIR,R6
         BAZ      FORWARD
*                    AT HDR1--BLKCNT MUST BE ZERO
         LI,D1    4                 BOF SUB-C0DE IN CASE BC ERR
         LW,R3    BLKCNT,R6
         AND,R3   M24
         BNEZ     ANSSENT2          BLKCNT ERROR
*                      IF NOT 1ST VOL, DO REVERSE CVOL
         LI,2     BACVI
         LB,SR4   *6,2
         CI,SR4   1
         BLE      BOF
*                    DO REVERSE CVOL
         MTB,-2   *6,2
         LI,2     BACIS
         MTB,-2   *6,2              FAKE OUT CVOL FOR REVERSE
*
         BAL,SR4  CVOLA             GET PRECEEDING VOLUME
*                    POS TO EOV AND FIX BLKCNT
         BAL,SR2  SKFILE
*
*                         FIX BLKCNT
         BAL,R7   RDSNT
         LW,R3    M24
         STS,R2   BLKCNT,R6
         BAL,SR2  SKFILER
         LI,D1    0
         BAL,R0   SETTYC
         LI,R1    X'400'
         STS,R1   DIR,R6            RESTORE 'REV'
*                    THEN GO REREAD DATA BLOCK
         B        RERED
BOF      EQU      %
         LI,SR3   7
         BAL,R3   GETAVR            SET R2 FOR TAPEOP
         BAL,SR2  TAPEOP            SKIP TM TO GET IN DATA AREA
         LI,D1    4                 SET BOF
         BAL,R0   SETTYC
         B        3ER5
FORWARD  EQU      %
         BAL,R3   GETAVR
         AI,R1    1                 COUNT TM JUST READ
         STD,R0   AVRTBL,R2
         BAL,SR4  CHKEOF
FORWARDX EQU      %
         B        MSR01EXIT
RERED    PULL     SR4
         B        MSRRED
         PAGE
*
*
SVSIZ    EQU      %
         LW,D1    RWS,R6
         SW,D1    R2
         BEZ      %+2
         OR,R2    Y02
         STW,D1   RWS,R6
         LW,D1    R2
         BAL,R0   SAVBLK
*
         OPEN     NLR
NLR      EQU      16
         LI,R1    X'20000'          FETCH NLR
         AND,R1   NLR,R6
         STS,R0   NLR,R6            CLR NLR IF SET
         SLS,1    7                 POSITION FOR TAPE RECORD
         OR,R2    R1                OR AS FIRST SEGMENT FLAG
         CLOSE    NLR
         B        *SR4
*
INITBLK  EQU      %
         PUSH     1,R0
         BAL,R0   GETBBUF
         BAL,R0   SETCMDL
         LW,R0    PBD,R6
         STH,R0   *D3
         LI,R1    K1
         STH,R1   *D3,R1
         STW,R1   BCDA,R6                                               717
*                                   SET NO OF ENTRIES
         B        PULLEXIT
*
*
*
SKEY     DATA     X'03000000'
*
*
SETCONSEC   EQU   %
         LW,D1    RWS,R6
         BEZ      TRANX
         LI,D1    1
         AW,D1    KBUF,R6
         STW,D2   *D1
         LI,D2    K1FFFF
         STS,D1   KAD,R6
         B        *R0
COMPFIX  EQU      %
         LI,R1    BASCR
         LB,R1    *R6,R1
         AI,R1    KB
         AND,R1   YFFFFFFFC
         B        *SR4
         PAGE
POSCHKEOF EQU     %
*D*      NAME:    POSCHKEOF
*,*      CALL     OVERLAY LTAPESEG,POSCHKEOF#
*,*      INTERFACE CHKEOF
*,*      DESCRIPTION PROVIDES ACCESS TO CHKEOF ROUTINE FOR USERS NOT IN
*,*               THE LTAPE OVERLAY. WHEREAS CHKEOF USES SKIPPING EXITS
*,*               TO INDICATE ERROR/NONERROR RETURN, POSCHKEOF CONVERTS
*,*               THIS TO AN SR2 PARAMETER OF 0 FOR ERROR AND -1 FOR
*,*               NO ERROR.
         PUSH     SR4
         BAL,SR4  CHKEOF
         B        EOFEOT
         LI,9     -1
         B        PULLEXIT
EOFEOT   EQU      %
         LI,9     0
         B        PULLEXIT
         END

