ANSPROC,MONPROC SET 1
         SYSTEM   UTS
CLSTP:   EQU      %
         DEF      CLSTP:
         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'
PTLMSK   DATA     X'FB00FFFF'
         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
         REF      AVRTBL
         REF      DOUBLEZERO
         REF      GETASN
         REF      GETFUN
         REF      GETTYC
         REF      IOSPIN
         REF      MSR01EXIT
         REF      PULLALLEXIT
         REF      PULLEXIT
         REF      PUSHALL
         REF      PUTSZBF
         REF      SETTYC
         REF      WRTTPE
         REF      Y2
         REF      WRTANSLBL
         REF      Y04
         REF      Y0008
         REF      Y000C
MASKCLS  DATA     X'0060F700'
         REF      CEOF,CEOR,CEOV
EOF1     EQU      TEOF1
EOV1     EQU      TEOV1
         REF      TEOF1,TEOV1
         REF      80UTL1
ULBLBAD  ERRABNCD X'30',01
         REF      DISMNT
         REF      MSRWRTX
         REF      Y004
         REF      CHKBIT1
         REF      SAVRL
         REF      Y01                                                   717
Y1FFFFFFF EQU     MASKS+29
         REF      MASKS
         DEF      RDCLS
         REF      CLRBBUF
SKFILEF  EQU      SKFILE
         REF      REWTP
         REF      SKFILE
         REF      SKFILER
         REF      WRTEOF
         REF      Y6
         REF      IOCHEK1
         REF      BATAPE
         REF      CHKANS0,CHKANS1
         PAGE     LBLT DEFS
         PAGE
         REF      GETAVR
CLSTP    EQU      %
         DEF      CLSTP
         LW,R0    EOP,R6
         CW,R0    Y0008
         BAZ      MSRCLST1
         CI,R0    K8000
         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
         PAGE     CLSLBL
RDCLS    EQU      %
         PUSH     1,SR4
         LW,SR2   CEOF
         BAL,R0   WRTSENT
         LW,SR2   CEOR
         BAL,R0   WRTSENT
         PULL     1,SR4
         B        *SR4
*                                      ENTERED FROM CVOL
MSRCLSLBL   EQU   %
         DEF      MSRCLSLBL
         BAL,R1   PUSHALL
         LW,SR2   CEOV
         BAL,R0   WRTSENT
         LW,SR2   CEOR
         BAL,R0   WRTSENT
         BAL,SR4  RELTP
         B        MSRCLSX2
CLSLBL   EQU      %                 CLOSE LABELED TAPE FILE
         DEF      CLSLBL
*
*
         BAL,R0   CHKANS1
         B        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  SKFILEF           GET IN TO DATA
         B        %+2
         BAL,SR2  SKFILER           GET INTO DATA
         BAL,SR4  IOSPIN
CLSLBL1  EQU      %
         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
         REF      SKRECR1
         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 SKFILEF
         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
         REF      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
*
*
WRTSENT  EQU      %                 WRITE SPECIFIED SENTINEL
         PUSH     1,R0
         REF      SETBTDZ
         BAL,D4   SETBTDZ           HSKP HBTD
         LW,D1    Y0008             IF EOP = WRITE, WRITE SENTINEL
         CW,D1    EOP,R6
         BAZ      PULLEXIT
         PUSH     3,7
         LI,SR2   BUF1MSK
         AND,SR2  BUFX,R6
         BEZ      %+2               DONT SET TBT IF NO BUF
         BAL,R0   CLRBBUF
         PULL     3,7
         LI,R2    12                MINIMUM RECORD 12 BYTES
         LW,SR3   PBD,R6            PREVIOUS BLOCK SIZE
         PUSH     2,SR2
         LW,D3    TSTACK
         AI,D3    KN1
         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,R7    EOV1
         CW,SR2   CEOF
         BNE      %+2
         LW,R7    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
         BE       %+3
BADUSLBL LW,SR3   ULBLBAD
         B        MSR01EXIT
         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      %
         REF      CHKBIT,Y06
         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      %
         DEF      RELTP
         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
         REF      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
         REF      Y1,AVRID
CLRALLO  RES      0
         PSW,SR4  TSTACK            SAVE LINK REG
         BAL,15   DEALLTY           GLOBAL
         MTB,-1   JB:CUR,1
         AI,2     BATAPE            DCTX
         BAL,11   RSETSPIN
         AI,2     -BATAPE           AVRX
         REF      JB:CUR,DEALLTY,RSETSPIN
         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
         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
*                                   RELEASE SCRATCH TAPES
*
PLER     RES      0
         LI,D1    X'A'              BAD CVOL
         BAL,R0   SETTYC
         LI,SR3   K56
         B        MSRCLSX2A
*
*
         END

