*UPDATED 9/15/71 BH
*        704717   SIGMA 5/7   BPM  M:LBLT                               717
ANSPROC  SET      1
MONPROC  SET      1
         SYSTEM   UTS
         DEF      LBLT,LBLTSZ
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'
BAAVRFNMT STB,SR4 AVRFNMT,R1
         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      CJOB
         REF      DOUBLEZERO
         REF      CHKEOF
         REF      CLRMBG
         REF      GETASN
         REF      GETFUN
         REF      GETTYC
         REF      IOSPIN
         REF      MSREXIT
         REF      MSR01EXIT
         REF      NBATAPE
         REF      PULLALLEXIT
         REF      PULLEXIT
         REF      PUSHALL
         REF      QUEUE1
         REF      READL
         REF      MOVECAL
         REF      RECTRAN
         REF      SETBTDQ
         REF      SETTYC
         REF      Y02
         REF      Y04
         REF      Y001
         REF      Y002
         REF      Y0008
         REF      Y000C
         REF      YFFFF
MASKCLS  DATA     X'0060F700'
         DEF      CVOLA
         REF      IODTYSEG
         REF      ERO,ABO
         REF      READLEND
         REF      MSRWRTX
         REF      Y004
         REF      J:JIT
        REF     TB:FLGS,M6
         REF      Y00FF
         REF      Y01                                                   717
         REF      CHKTP
Y1FFFFFFF   DATA  X'1FFFFFFF'
         REF      GETBBUF
         REF      SAVBLK
         REF      TRANX
         REF      INITARS
         REF      GETCMD
         REF      CLRTRN
         REF      CHKTRN
         REF      YFFFFFFFC
         REF      SETCMD1
         REF      GETBTD
         REF      COMKEY
         REF      KEYER1
         REF      TRNTST
         REF      KEYER2
         REF      SETCMDL
         REF      GETKEYSB
         REF      CLRTP
         REF      CLRBBUF
         REF      SKRECR
         REF      XFF
         REF      MSRWRT,IOCHEK1
         REF      BATAPE
         REF      ANSFLGS,AVRFNMT
         REF      MSRRED
         REF      Y0004
XFFF7FFFF EQU     NB31TO0+20
         REF      CHKANS0,CHKANS1
         PAGE     LBLT DEFS
         PAGE
GETAVR   EQU      %
         DEF      GETAVR
         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
         PAGE     CVOL
*                                   CLOSE VOLUMNE AND GO TO NEXT TAPE
*
*
CVOL     EQU      %
*                                   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
         REF      RELTP#
         LI,R1    BACIS
         MTB,1    *R6,R1
         LI,SR4   CVOL6
         REMEMBER
         BAL,R1   PUSHALL
         OVERTO   OPNTPSEG,OPNT1#
         REF      OPNT1#
         REF      OPNTPSEG
         B        CVOL6
*
*
*
CVOLA    EQU      %
*                                   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
         B        PLBSR4
CVOLAA   EQU      %
         BAL,D2   GETFUN
         LW,D2    KAD,R6           SAVE KEY ADDRESS
         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#
         REF      MSRCLSLBL#
         LW,D3    KBUF,R6
         LW,D3    *D3
         PUSH     1,D3
         REF      SETBLK,RESBLK
         BAL,0    SETBLK
         LI,SR2   DOUBLEZERO
         LI,11    CVOL2
         REMEMBER
         BAL,R1   PUSHALL
         BAL,D2   GETFUN                                                717
         CI,D1    KA                                                    717
         BANZ     CVOL7
         OVERTO   OPNTPSEG,OPNLBL#
         REF      OPNLBL#
         B        CVOL2
CVOL7    EQU      %
         OVERTO   OPNTPSEG,AOPNL1#
         REF      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
         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      %
         DEF      WRITEL
         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
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   CHKANS1
         B        WRTEL12
         LI,R0    18                MINIMUM BLOCK SIZE
         CW,R0    RWS,R6
         BLE      %+2
         STW,R0   RWS,R6
         B        MSRWRT
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
         BLE      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       BARB1             BAD BLOCK..GIVE READ ERROR
         REF      BARB1
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
*
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
         BL       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        WRTLX
WRTL10   EQU      %
         LI,R2    X'20'
         CW,R2    ORG,R6            ORGTEST
         BAZ      WRTL12
         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
         DEF      KEYTRN
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      %
         DEF      SKFILER
         LI,SR3   6
         BAL,R3   GETAVR
         CI,R1    X'FFFF'
         BAZ      %+2               NEVER GO NEGATIVE
         AI,R1    KN1               DECR TPOS
         B        TAPEOP
SKFILE   EQU      %
         DEF      SKFILE
         LI,SR3   7
         BAL,R3   GETAVR
         AI,1     1
         B        TAPEOP
TAPEOP   EQU      %
TAPEOP1  EQU      TAPEOP            ENTRY FROM ARDL***SAME NAME
         DEF      TAPEOP1              IN IORT
         STD,R0   AVRTBL,R2
         B        DONEWQ
         REF      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
POSCHKOEF EQU     %
*
*                                   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,R2   *R6,R1
         B        MSR01EXIT
         PAGE
*                                   POSTANS PERFORMS
*                                   POST PROCESSING FOR ANS READS AND WRITES
POSTANS  EQU      %
         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
         BNEZ     RERED
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
         LW,R3    BLKCNT,R6
         AND,R3   M24
         REF      M24,ANSSENT2
         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  CVOL              GET PRECEEDING VOL
*                    POS TO EOV AND FIX BLKCNT
         BAL,SR2  SKFILE
*
         BAL,SR4  CHKEOF            FIXBLKCNT////// BLKCNT & DO SKFILER
*                    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        GETTYC-1
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     %
         PUSH     SR4
         BAL,SR4  CHKEOF
         B        EOFEOT
         LI,9     -1
         B        PULLEXIT
EOFEOT   EQU      %
         LI,9     0
         B        PULLEXIT
LBLTSZ   EQU      %-LBLT
         END      LBLT

