*M*      CLSTP    CONTAINS THE ROUTINES FOR CLOSING A TAPE DCB AND VOLUME.
*P*      NAME:    CLSTP
*P*      PURPOSE  TO CLOSE ALL TYPE OF TAPE DCBS AND VOLUMES.
*P*      DESCRIPTION FOR OUTPUT TAPES, ANY NEEDED TRAILER LABELS OR MARKS
*P*               ARE WRITTEN TO THE TAPE., AND THE TAPE IS REPOSITIONED
*P*               FOR POSSIBLE FILE EXTENSION. THE OPTIONS OF THE CLOSE
*P*               FPT ARE HONORED AND , IF APPROPRIATE, SAVE/DISMOUNT
*P*               MESSAGES ARE OUTPUT AND THE TAPE DESCRIPTION IS
*P*               DELETED FROM THE AVR TABLE. THE DCB IS HOUSEKEPT AND
*P*               MARKED CLOSED.
MONPROC  SET      1
ANSPROC  SET      1
BITS     SET      1
         SYSTEM   UTS
CLSTP:   EQU      %
         BOUND    8
K2       EQU      2
K0       EQU      X'0'
K1       EQU      X'1'
K3       EQU      X'3'
K4       EQU      X'4'
K5       EQU      X'5'
K10      EQU      X'10'
K20      EQU      X'20'
K56      EQU      X'56'
K7F      EQU      X'7F'
K8000    EQU      X'8000'
KN1      EQU      -X'1'
         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
*********************  DEF  ******************************
*
************ROUTINES************
         DEF      CLSLBL            CLOSE ANS/XEROX LABEL TAPE
         DEF      CLSTP             CLOSE DEVICE TAPE
         DEF      CLSTP:            MODULE NAME
         DEF      MSRCLSLBL         CVOL OPEN ANS/XEROX LABEL TAPE
         DEF      RDCLS             WRITE TRAILERS UPON READ OF OUTPUT
         DEF      RELTP             RELEASE TAPE...DISMOUNT, DEALLOCATE
         SPACE    5
*******************  REF  *******************************
*
**************CONSTANTS*************
         REF      BATAPE
         REF      CEOF
         REF      CEOR
         REF      CEOV
         REF      DOUBLEZERO
         REF      TEOF1
         REF      TEOV1
         REF      Y000C
         REF      Y06
         REF      Y6
         REF      80UTL1
         SPACE    2
****************VARIABLES****************
         REF      AVRID             OUTPUT;
         REF      AVRTBL            OUTPUT;
         REF      AVRNOU            CHECK LAST DCB FOR DEVICE PACK
         REF      AVRTBLSIZ         CHECK IF DEVICE PACK
         REF      JB:CUR            OUTPUT;
         SPACE    2
****************ROUTINES*****************
         REF      ABN3001           REPORT 30-01 ABNORMAL
         REF      CHKANS1           SKIP IF ANS DCB
         REF      CHKBIT            GET NEXT CLOSE FPT PARAM
         REF      CHKBIT1           GET FIRST CLOSE FPT PARAM
         REF      CLRBBUF           FLUSH BLOCKING BUFFER
         REF      DEALL             DEALLOCATE TAPE DRIVE
         REF      DISMNT            DO 'DISMNT' MSG AND DEALLOCATE DRIVE
         REF      GETASN            GET DCB:ASN
         REF      GETAVR            GET AVRX AND AVR ENTRY
         REF      GETFUN            GET DCB:FUN
         REF      GETTYC            GET DCB:TYC
         REF      IOCHEK1           DO ANS POSTPROCESSING
         REF      IOSPIN            WAIT FOR I/O
         REF      OERX              OPEN OVERLAY ERROR EXIT
         REF      OPNX              OPEN OVERLAY NORMAL EXIT
         REF      OFFREW            DO OFF-LINE REW OF TAPE
         REF      OPNLBL            FIND :BOF ON PREVIOUS VOLUME
         REF      PULLALLEXIT       MAJOR ROUTINE EXIT
         REF      PULLEXIT          EXIT *TSTACK
         REF      PUSHALL           SAVE ENVIRONMENT
         REF      PUTSZBF           SET DCB FOR I/O
         REF      REWTP             DO ON-LINE REW OF TAPE
         REF      RSETSPIN          SET SPINDLE/DRIVE NOT IN USE
         REF      SAVRL             DO 'SAVE' MSG AND DEALLOCATE DRIVE
         REF      SETBTDZ           SET BTD TO ZERO
         REF      SETTYC            SET DCB:TYC
         REF      SKFILE            SKIP TAPE FORWARD PAST NEXT TAPE MARK
         REF      SKFILER           SKIP TAPE BACK PAST TAPE MARK
         REF      SKRECR1           SKIP TAPE BACK OVER RECORD
         REF      T:SELFDESTRUCT
         REF      WRTANSLBL         WRITE ANS TRAILER LABELS
         REF      WRTEOF            WRITE A TAPE MARK
         REF      WRTTPE            WRITE LABEL IN BUFFER TO TAPE
         PAGE
CLSTP    EQU      %
*F*      NAME:    CLSTP
*F*      PURPOSE  TO CLOSE A DEVICE TAPE DCB AND VOLUME
*F*      DESCRIPTION IF THE LAST OPERATION WAS A DATA WRITE, 2 TAPE MARKS
*F*               ARE WRITTEN AND THE TAPE IS REPOSITIONED BETWEEN THE TWO.
*F*               IF THE REM OPTION IS SPECIFIED THE TAPE IS REMOVED.
*F*               IN ANY EVENT THE DCB IS MARKED CLOSED.
         BAL,3    GETAVR            IF PACK, CHECK FOR REMOVE
         CI,2     AVRTBLSIZ
         BL       CLSTP1            NOT PACK
         MTH,-1   AVRNOU,2          DECREMENT FOR THIS DCB
         LH,3     AVRNOU,2          CHECK IF 1 (FOR USER)
         BDR,3    MSRCLSX2          MORE DCBS OPEN
         LI,3     K20               CHECK FOR REMOVE OPTION
         CW,3     0,7
         BAZ      MSRCLSX2          MOT THERE
         MTH,-1   AVRNOU,2          ZAP NOU
         BNEZ     %-1               MAKE SURE
         LW,3     0                 GET SN FOR SAVRL
         BAL,11   SAVRL             OUTPUT MESS, DEALLOCATE
         B        MSRCLSX2          FINISH UP
CLSTP1   RES
         LW,R3    EOP,R6            IF READ OR WRITE, SET NOT AT LP
         CW,R3    Y000C
         BAZ      %+3
         OR,R1    X4
         STD,R0   AVRTBL,R2
         CW,R3    Y0008
         BAZ      MSRCLST1
         CI,R3    K8000             DRC
         BANZ     MSRCLST1
         BAL,SR2  WRTEOF
         BAL,SR2  WRTEOF
         BAL,SR2  SKFILER
         BAL,SR4  IOSPIN
MSRCLST1 EQU      %
         LW,R0    DSI,R6
         CI,R0    K8000             OPLABEL
         BAZ      CLSLB39           YES
         LI,SR2   K20
         AND,SR2  0,R7
         B        CLSLBLA
*                    CONSTANTS
*
PTLMSK   DATA     X'FB00FFFF'
MASKCLS  DATA     X'613C00'
Y1FFFFFFF EQU     MASKS+29
EOF1     EQU      TEOF1
EOV1     EQU      TEOV1
         PAGE     CLSLBL
RDCLS    EQU      %
         PUSH     1,SR4
         BAL,R1   FLUSH
         LW,SR2   CEOF
         BAL,R0   WRTSENT
         LW,SR2   CEOR
         BAL,R0   WRTSENT
         PULL     1,SR4
         B        *SR4
*                                      ENTERED FROM CVOL
MSRCLSLBL   EQU   %
*F*      NAME:    MSRCLSLBL
*F*      PURPOSE  PERFORMS CLOSE OF TAPE VOLUME FOR ANS OR LABEL TAPE
*F*               UNDERGOING VOLUME SWITCH(CVOL).
*F*      DESCRIPTION IF THE LAST OPERATION WAS A DATA WRITE, THE TRAILER
*F*               LABELS ARE WRITTEN.IN ANY EVENT A SAVE MESSAGE IS
*F*               SENT TO THE OPERATOR, THE TAPE IS REWOUND, AND THE AVR
*F*               TABLES ARE CLEARED. THE DCB IS CLOSED.
         BAL,R1   PUSHALL
         BAL,R1   CLSLBL0
         LW,SR2   CEOV
         BAL,R0   WRTSENT
         LW,SR2   CEOR
         BAL,R0   WRTSENT
         BAL,SR4  RELTP
         B        MSRCLSX2
CLSLBL   EQU      %                 CLOSE LABELED TAPE FILE
*F*      NAME:    CLSLBL
*F*      PURPOSE  PERFORMS CLOSE OF TAPE FOR ANS OR LABEL TAPE AS A
*F*               RESULT OF A CLOSE CAL.
*F*      DESCRIPTION IF THE LAST OPERATION WAS A DATA WRITE, THE LABELS
*F*               ARE WRITTEN. THE OPTIONS ON THE CLOSE FPT ARE INSPECTED
*F*               AND HONORED. IF THE DCB IS OPEN OUT OR OUTIN AND SAVE
*F*               IS NOT SPECIFIED, OR IF REM IS SPECIFIED,A SAVE OR
*F*               DISMOUNT MESSAGE IS SENT TO THE OPERATOR, THE TAPE IS
*F*               REWOUND(OFF-LINE IF POSSIBLE), AND THE AVR TABLE ENTRY
*F*               IS CLEARED. IN ANY EVENT, THE DCB IS MARKED CLOSED.
         SPACE    2
*D*      NAME:    CLSLBL
*,*      ENTRY    CLSTP, MSRCLSLBL
*,*      CALL     B CLSTP OR OVERTO OPENTPSEG,CLSTP#
*,*      INTERFACE WRTEOF,SKFILER, IOSPIN,PUSHALL, WRTSENT,RELTP,
*,*               IOCHEK1, GETTYC, SKFILE, GETFUN, GETAVR, REWTP,
*,*               SAVRL, DISMNT, RELTP
*,*      DESCRIPTION ENTRY AT CLSTP IS TO CLOSE DEVICE TAPE, AND RESULTS
*,*               IN 2 TAPE MARKS BEING WRITTEN AND POSITIONING BETWEEN THEM
*,*               IF THE LAST OPERATION WAS A DATA WRITE AND ALL CLOSE
*,*               OPTIONS OTHER THAN 'REM' BEING IGNORED.
*,*               ENTRY AT MSRCLSLBL IS FOR CVOL-CLOSE OF ALL TYPES OF
*,*               LABEL TAPE, AND CAUSES NECESSARY TRAILER LABELS TO BE
*,*               WRITTEN AND THE TAPE DISMOUNTED, THEN THE DCB IS CLOSED.
*,*               ENTRY AT CLSLBL IS FOR A NORMAL CLOSE OF ALL TYPES OF
*,*               LABEL TAPE. ANY PENDING DATA OPERATIONS ARE COMPLETED,
*,*               ANY OUTPUT BUFFERS ARE FLUSHED, AND IF THE SPECIAL CLOSE
*,*               FLAG IS SET A TAPE MARK IS WRITTEN AND THE DCB
*,*               CLOSED. OTHERWISE, THE TRAILER LABELS ARE WRITTEN IF
*,*               THE LAST OPERATION WAS A DATA WRITE AND THE TAPE IS
*,*               REPOSITIONED TO THE DATA AREA OF THE FILE. THE VARIOUS
*,*               CLOSE OPTIONS ARE THEN CHECKED FOR AND PROCESSED.
*,*               THE DCB IS SET CLOSED AND THE ROUTINE EXITS.
*
*
         LI,R1    CLSLBL2
CLSLBL0  PUSH     R1
         LI,SR4   X'F'              IF BLOCK ACCESS, MUST COMPLETE
         AND,SR4  ACS,R6
         CI,SR4   3
         BNE      CLSLBL1
         LW,SR4   Y000C
         AND,SR4  0,R6              LAST OPERATION
         SLS,SR4  -18
         CI,SR4   2                 WRITE
         BNE      %+3
         BAL,SR4  IOCHEK1
         B        CLSLBL1
         BAL,SR4  IOSPIN
         BAL,R4   GETTYC
         CI,R3    6
         BNE      CLSLBL1           TAPE MARK
         LI,R3    X'1000'           EGV
         CW,R3    0,R6
         BANZ     CLSLBL1           YES
         LI,R3    X'400'            DIRECTION
         CW,R3    0,R6
         BAZ      %+3               FORWARD
         BAL,SR2  SKFILE            GET INTO DATA AREA
         B        %+2
         BAL,SR2  SKFILER           GET INTO DATA
         BAL,SR4  IOSPIN
CLSLBL1  EQU      %
         PULL     R1
         B        FLUSH
CLSLBL2  RES
         LI,SR2   PLBTB2A
         INT,SR4  *R7               GET CLOSE FLAGS
         CI,SR4   X'40'
         BE       WRTEOF            SPECIAL CLOSE-NO EOF--DOTM AND BKF
         LW,SR2   CEOF
         BAL,R0   WRTSENT
*                    OUT/OUTIN AND NOT SAVE...
*                      IF SCR, RETURN TO SCR POOL & DEALLOC
*                      IF REM, REMOVE
*                      ELSE REWIND AND KEEP FOR USER
         LW,SR2   CEOR
         BAL,R0   WRTSENT
*
         LW,SR2   0,R7
         BAL,D2   GETFUN
         CI,D1    K5                SAVE IN AND INOUT FILES             717
         BANZ     CLSLBLA
*                                   SEE IF SAVE SPECIFIED
         LI,SR1   K0
         BAL,R2   CHKBIT1
         LW,SR1   D1
         CI,SR1   K2
         BNE      CLSLBLB
*
CLSLBLA  EQU      %
         CI,SR2   K20               REW
         BANZ     CLSREW
         CI,SR2   X'80'             CHECK PTV
         BANZ     CLSLBLV
         BAL,R0   CHKANS1
         B        CHKPSL            NOT ANS CHECK PSL
*
*        CHECK ANSDCB OPENED BY FILENAME
*
         LI,R0    X'20000'          SNFN BIT
         AND,R0   0,R6
         BEZ      CHKPSL+2          NOT BY FILENAME
         LI,R1    BACIS
         LB,R0    *R6,R1
         CI,R0    1
         BE CLSLBLV                 FORCE PTV
         BG       CLSREW            FORCE REW
         B        CHKPSL+2
CHKPSL   CI,SR2   K10
*                                   PSL
         BANZ     CLSLBLEOR
*
CLSLB39  EQU      %                 HERE IT IS
*
         LI,D1    K0
CLSLBL4  EQU      %
         BAL,R3   GETAVR
*
         AND,1    PTLMSK
         OR,R1    D1
         STD,R0   AVRTBL,R2
         B        MSRCLSX2
*
*        CLSLBLV ROUTINE- ANS TAPE ADDITION
*
CLSLBLV  BAL,SR2  REWTP             REWIND TAPE
         BAL,R0   CHKANS1
         B        CLSLBLVLT
         LI,SR3   5                 SKREC
         BAL,SR2  SKRECR1           AFTER VOL1
         BAL,R3   GETAVR
         LW,D1    Y2
         LW,D2    Y6
         STS,D1   R1                CLEAR POS,SET AVR
         STD,R0   AVRTBL,R2         FOR PTV IF ANSTAPE
         B        PLBTB2B
CLSLBLVLT BAL,SR2 SKFILE
         B        PLBTB2A
*                                   CLOSE AND REWIND
CLSREW   EQU      %
         LI,11    SAVRL
         B        %+2
CLSLBLE  EQU      %
         LI,11    DISMNT
         BAL,R3   GETAVR
         LW,R3    R0
         BAL,SR4  *SR4
         BAL,R0   CLRAVR
         LI,R0    0                 SET TO FIRST TAPE IF CLS,REM.
         LI,R1    BACVI
         STB,R0   *R6,R1
         LI,R1    BACIS
         STB,R0   *R6,R1
         B        MSRCLSX2
CLSLBLB  EQU      %
         CI,SR2   K20
         BANZ     CLSLBLE
         BAL,SR4  CLRSCR            RETURN TO SCR POOL & DEALLOC
         BAL,SR2  REWTP
         BAL,SR4  IOSPIN
         B        MSRCLSX2
CLSLBLEOR   EQU   %
*                                   POSITION TO BEGINNING OF LABEL
*                                   PSL OPTION
         LI,R1    BACVI
         LB,R4    *R6,R1
         AI,R4    KN1
         BEZ      PLBTB2
         BAL,SR4  RELTP
         LI,R1    BACVI
         LB,R4    *R6,R1
         LI,R2    BACIS
         LB,R1    *R6,R2            CURRENT REEL NO
         SW,R1    R4                NEW REEL NO
         BLZ      PLER
*                                   SEE IF REEL IS AT END AND RESERVED
*                                   BY THIS DCB
         AI,R1    K1
         STB,R1   *R6,R2
         BAL,D2   GETFUN
         PUSH     1,D1
         CI,D1    K1
         BE       PLBTB3
         LI,D1    K4
         BAL,R0   SETFUN
PLBTB3   EQU      %
         LI,SR4   PLBTB4
         BAL,R1   PUSHALL
         B        OPNLBL
PLBTB4   EQU      %
         PULL     1,D1
         BAL,R0   SETFUN
         AI,SR3   0
         BNEZ     PLER
PLBTB2   EQU      %
         BAL,SR2  SKFILER
PLBTB2A  EQU      %
         BAL,SR2  SKFILER
*
PLBTB2B  EQU      %
         BAL,SR4  IOSPIN
         LW,D1    Y04               SET PTL
         B        CLSLBL4
*
FLUSH    EQU      %                 WRITE BUFFER IF PRESENT
         PUSH     7
         LI,SR2   BUF1MSK
         AND,SR2  BUFX,R6
         BEZ      %+2               DONT SET TBT IF NO BUF
         BAL,R0   CLRBBUF
         PULL     7
         B        *R1
*
WRTSENT  EQU      %                 WRITE SPECIFIED SENTINEL
*D*      NAME:    WRTSENT
*,*      REGISTERS ALL VOLATILE
*,*      CALL     BAL,R0 WRTSENT
*,*      INTERFACE PUTSZBF, WRTEOF, CHKANS1, WRTANSLBL, WRTTPE, CHKBIT1,
*,*               MSR01EXIT, IOSPIN, SKFILER
*,*      INPUT    D1=LABEL TYPE(':EOR'/':EOF'9
*,*               R6=DCB ADDRESS
*,*      DESCRIPTION IF LAST OPERATION WAS NOT A WRITE, ROUTINE EXITS.
*,*               IF :EOF IS REQUESTED, WRITES A TAPE MARK, THE TRAILER
*,*               LABEL(S) APPROPRIATE TO THE ASSIGNMENT(XEROX/ANS),
*,*               THE USER LABEL IF ONE IS REQUESTED, AND ANOTHER  TAPE
*,*               MARK. IF :EOR IS REQUESTED THE END REEL SEQUENCE
*,*               DEPENDS ON LABEL TYPE(XEROX/ANS). IF ANS, A SINGLE
*,*               TAPE MARK IS WRITTEN(MAKING A TOTAL OF 2 AT THAT POINT
*,*               AS THERE WAS PREVIOUSLY ONE WRITTEN AFTER THE EOF).
*,*               IF XEROX, THE :EOR RECORD IS WRITTEN AND IS FOLLOWED
*,*               BY 2 TAPE MARKS. IN EITHER EVENT, THE TAPE IS
*,*               REPOSITIONED TO JUST PRECEEDING THE TAPE MARK AT THE
*,*               END OF THE DATA AREA OF THE FILE.
         PUSH     1,R0
         BAL,D4   SETBTDZ           HSKP HBTD
         LW,D1    Y0008             IF EOP = WRITE, WRITE SENTINEL
         CW,D1    EOP,R6
         BAZ      PULLEXIT
         LI,R2    12                MINIMUM RECORD 12 BYTES
         INT,SR4  PBD,R6            GET PBD (ONLY)
         STW,SR4  CMD,R6            CLEAR CMD
         PSW,SR2  TSTACK            PUT THE TWO WORDS IN TSTACK
         LW,D3    TSTACK
         PSW,SR4  TSTACK
         BAL,SR4  PUTSZBF
         CW,SR2   CEOR
         BE       WRTSENT1
         PSW,7  TSTACK             SAVE 7
         LW,7   SR2                SAVE SR2
         BAL,SR2  WRTEOF
*
*        FOR ANS TAPES EOF1,EOF2 REPLACE :EOF OF LT
*        FOR ANS TAPES EOV1,EOV2 REPLACE :EOV OF LT
*
         ANSBAL,R0 CHKANS1
         B        WRTSENT4
         LW,SR2   7
         LW,SR2   EOV1
         CW,R7    CEOF
         BNE      %+2
         LW,SR2   EOF1
         BAL,SR4  WRTANSLBL         WRITE EOF1,EOF2
         B        WRTSENT5
*
WRTSENT4 BAL,SR2  WRTTPE
**********       WRITE TRAILER LABEL
WRTSENT5 PLW,7 TSTACK
         LW,SR2 -1,7
         CW,SR2   Y06               IS IT CLOSE OR CVOL (03,15)
         BAZ      WRTSENT3          NO.READ AFTER WRITE OR WRITE AFT EOT
         BAL,R2   CHKBIT1           P1
         NOP
         BAL,R2   CHKBIT            P2
         B        %+2               GOT LABEL
         B        WRTSENT3          NO LABEL
         LW,D3    D1                LABEL ADR. CHKBIT HANDLES *
         BAL,R0   CHKANS1
         B        WRTSENT7
         LCI      2
         LM,R0    *D1
         SLD,R0   -24
         CD,R0    80UTL1
         BNE      ABN3001           REPORT 30-01.
         LI,R1    X'C0'             HBTD
         LI,R0    X'40'             BYTE DISPLACEMENT=1
         STS,R0   BTD,R6
         LI,R2    80                UTL LABEL IS 80 BYTES
         B        WRTSENT8
WRTSENT7 LI,R2    11
         CB,R2    *D1               IS TRAILER NOISE RECORD
         BGE      %+2               NO
         LB,R2    *D1               BYTE 0
         AI,R2    1
WRTSENT8 BAL,SR4  PUTSZBF           D3->QBUF,R2->BLK
         BAL,SR2  WRTTPE            WRITE LABEL
WRTSENT3 EQU      %
         BAL,SR2  WRTEOF
WRTSENTX  EQU     %
         BAL,SR4  IOSPIN
         PULL     2,R0
         B        PULLEXIT
WRTSENT1 EQU      %
         ANSBAL,R0 CHKANS1
         B        WRTSENT6
         BAL,SR2  WRTEOF            SINGLE TAPE MARK
         B        WRTSENT2
WRTSENT6 EQU      %
         BAL,SR2  WRTTPE
         BAL,SR2  WRTEOF
         BAL,SR2  WRTEOF
         BAL,SR2  SKFILER
WRTSENT2 EQU      %
         BAL,SR2  SKFILER
         BAL,SR2  SKFILER
         BAL,SR2  SKFILER
         B        WRTSENTX
*
         SPACE    3
RELTP    EQU      %
*D*      NAME:    RELTP
*,*      ENTRY    CLRAVR, SAVAVR
*,*      REGISTERS ALL VOLATILE
*,*      CALL     BAL,SR4 RELTP  OR  OVERLAY OPENTPSEG,RELTP#
*,*      DESCRIPTION RELTP RELEASES A TAPE FOR A USER BY CALLING THE
*,*               CLRAVR AND SAVAVR ROUTINES. CLRAVR DOES AN OFF-LINE REW
*,*               OF THE TAPE, AND IF NOT DEVICE TAPE BUMPS THE DCB:CIS
*,*               AND DCB:CVI FIELDS IN ANTICIPATION OF STEPPING TO
*,*               NEXT VOLUME. SAVAVR SETS UP A DISMOUNT MESSAGE FOR
*,*               'IN' TAPES OR A SAVE MESSAGE FOR ALL OTHERS AND
*,*               HAS IT TYPED VIA TYPR, WHICH ALSO DOES ALL THE TAPE
*,*               DEALLOCATION.
         PUSH     SR4
         BAL,0    CLRAVR            REWOFF & BUMP COS/CVO
         PULL     SR4
         B        SAVAVR            SAV/DSMNT MSG & DEALLOC
         SPACE    3
*
CLRAVR   EQU      %
         PUSH     1,R0
         BAL,SR2  OFFREW
         BAL,SR4  IOSPIN
         BAL,R0   GETASN
         CI,D2    K3
         BE       PULLEXIT
         LI,R2    BACIS
         MTB,1    *R6,R2
         LI,R2    BACVO
         MTB,1    *R6,R2
         B        PULLEXIT
*
SAVAVR   EQU      %
*                                   SEE IF OUTPUT FILE
         BAL,D2   GETFUN
         BAL,R3   GETAVR
         LW,3     0
         LI,0     SAVRL
         CI,D1    K1
         BNE      %+2
         LI,0     DISMNT
         B        *0
CLRSCR   EQU      %
         BAL,R3   GETAVR
         CW,1     Y1
         BANZ     CLRALLO
         AI,R1    X'F0000'
         AND,R1   Y1FFFFFFF
         OR,R1    Y01                                                   717
NALLO    RES      0
         STD,R0   AVRTBL,R2
         B        *SR4
SETFUN   EQU      %
         LI,D2    K7F
         SLD,D1   17
         STS,D1   FUN,R6
         B        *R0
CLRALLO  RES      0
         PSW,SR4  TSTACK            SAVE LINK REG
         BAL,15   DEALL             GLOBAL
         MTB,-1   JB:CUR,1
         AI,2     BATAPE            DCTX
         BAL,11   RSETSPIN
         AI,2     -BATAPE           AVRX
         LD,0     AVRTBL,2
         LW,R1    Y1
         STH,1    AVRID,2
         PLW,SR4  TSTACK            RESTORE LINK REG
         B        NALLO
MSRCLSX2 EQU      %
         CLEAR
MSRCLSX2A   EQU   %
         BAL,0    CHKANS1
         B        MSRCLSX2B         NONANS
         LI,0     0
         LW,1     Y000C
         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
MSRCLSX2C EQU     %
         LW,R0    Y004
         LW,R1    MASKCLS
         STS,R0   TTL,R6
         LI,SR4   PULLALLEXIT       SET RETURN FROM DESTRUCT
         LW,SR3   SR3
         BEZ      T:SELFDESTRUCT    OPEN EXIT--NO ERRORS.
         LI,R1    BACIS
         STB,R0   *R6,R1
         B        OERX
*                                   RELEASE SCRATCH TAPES
*
PLER     RES      0
         LI,D1    X'A'              BAD CVOL
         BAL,R0   SETTYC
*E*      ERROR    56 - 00  CANNOT COMPLETE CVOL EITHER BECAUSE
*,*                        NEXT VOLUME IS NOT SPECIFIED, OR AN ERROR
*,*                        OCCURRED DURING ITS MOUNT
         LI,SR3   K56
         B        MSRCLSX2A
*
*
         END

