         PCC      0
*        704714   SIGMA 5/7         BPM M:TYPR
ANSPROC  SET      1
MONPROC  SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM   UTS
TYPR:    EQU      %
         DEF      TYPR:
         DEF      TYPR
TYPR     EQU      %
         TITLE    '**** TYPR ****'
         BOUND    8
K2       EQU      2
K0       EQU      X'0'
KA       EQU      X'A'
KF       EQU      X'F'
KFF      EQU      X'FF'
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
         REF      J:JIT
*  DRIVER FOR IODTYPR
*
*
         PAGE     TYPR DEFS
         DEF      ANSERR
         DEF      ANSREEL
         DEF      MOUNT
         DEF      REEL
         DEF      SAVRL
         REF      MSROCTY
         REF      Y8
         REF      CNVDEC
         REF      SIXBACK
         REF      SIXPACK
         REF      M8
         REF      AVRTBLSIZ
         REF      Y1
         REF      Y04
         REF      SOLICIT
         REF      AVRTBL
         REF      BATAPE
         REF      NBATAPE
         REF      DCT3
         REF      DID
         REF      DCT4
YC5FF    DATA     X'C5FF0000'
         REF      Y02
         REF      AVRID
         REF      S:CUN
         REF      T:REG
         REF      UH:DL             DO LIST
         REF      U:MISC,E:SL
         REF      DCT16
         REF      M16
         REF      J:BASE
         REF      DHHIT,RSETSPIN,DEALL
         REF      JB:CUR
         REF      JOVVPA
         REF      AVRTBLNE
DPT      EQU      AVRTBLNE          DEVICE PACKS
         REF      CHKANS1,CHKANS0
         REF      ANSFLGS,AVRFNMT
         REF      AVRSID
         REF      DOUBLEZERO
         PAGE     MOUNT
*
*                                   TYPE MOUNT MESSAGE FOR PARTICULAR
*                                   REEL NUMBER
MOUNT    EQU      %                 BAL,SR4  MOUNT--R3 = REEL NO
         LI,0     2
         LW,R1    MOUNTMES
         CI,3     -1                IS THIS SCRATCH REQUEST
         BNE      %+2               NO
         LW,1     SCRMES
TYPTPE1  EQU      %
*                                   GET BEST AVAILABLE DRIVE
         PUSH     1,R3
         LI,2     -DPT
         BAL,R3   GETTPDR           GET DRIVE WITH UNUSED TAPE
         B        NOTPE             ISN'T ONE
         BAL,R0   CHKANS0
         LW,R1    TANS0             SET R1 WITH ANS INDICATOR
         LW,D4    R2
*                                   AT THIS POINT THERE IS AT LEAST ONE
*                                   AVAIL DRIVE.  FIND BEST ONE
         LW,R2    LASTTPE           GET IX OF LAST DRIVE USED
         LI,0     2                 TWO PASSES, FIRST BALANCE OF TABLE
TPEFND3  EQU      %
         AI,R2    -DPT                SECOND PASS, ENTIRE TABLE
TPEFND   EQU      %
         BAL,R3   GETTPDR           GET ENTRY FROM AVRTBL
         B        TPEFND2A
         CI,D1    K0                EMPTY DRIVE
         BE       TPEFND1           YES - TAKE
         BIR,R2   TPEFND
         BDR,0    TPEFND3           RECHECK FROM BEGINNING
TPEFND2A EQU      %
         CW,R1    TANS0             DONT PICK A SCRATCH IF ANS
         BE       TPEFND2B
         LI,2     -DPT
TPEFND2  EQU      %
         BAL,R3   GETTPDR
         B        TPEFND2B
         CW,D2    Y1                SCRATCH DRIVE
         BANZ     TPEFND1           YES - TAKE
         BIR,R2   TPEFND2
TPEFND2B LW,R2    D4                USE DRIVE OBTAINED INITIALLY
TPEFND1  EQU      %
         AI,2     DPT
         STW,R2   LASTTPE           SAVE AS START POINT FOR NEXT TIME
         REF      LASTTPE
         LI,R3    KFF
         STS,R2   DSI,R6
         PULL     1,R3              RESTORE  REEL NO
         CI,2     AVRTBLSIZ
         BGE      DPOUT             DEVICE PACK
         B        TYPR2
TYPRX2   EQU      %
         LW,D2    Y04               SET DRIVE TO BUSY
         LW,D1    R3                PUT IN REEL NO
         LI,D3    KF                SET ULBL BIT IN AVRTBL
         AND,D3   ASN,R6
         AI,D3    -3
         BE       TPEFND4           NOT LABEL TAPE
         LW,D3    FUN,R6            SET ULBL IF OUT, OUTIN
         CW,D3    Y0014
         BAZ      TPEFND5
TPEFND4  EQU      %
         OR,D2    Y02
TPEFND5  EQU      %
         STD,D1   AVRTBL,R2
         B        TYPR6             DEPOSIT FILENAME IF ANS
TYPRX6   EQU      %
         MTB,1    SOLICIT,2         MARK DRIVE AS SOLICITED
         LW,4     S:CUN
         STH,4    AVRID,2           ID TO AVR TABLE
         B        CVTINDX           CREATE MOUNT MESSAGE
*
*                                   DEVICE PACK
DPOUT    LD,D1    AVRTBL,2
         LW,D1    R3
         B        TPEFND5
*
*
MOUNT1   EQU      %
         PUSH     7,R5              TYPE IT OUT
         LI,R6    J:BASE+1
         LW,R5    Y8
         PUSH     2,R5              SAVE PLIST IN STACK
MOUNT10  EQU      %
         LW,R7    TSTACK
         AI,R7    -1                R7 POINTS TO PLIST
         LI,SR1   K2
         LI,R5    J:JIT
         PUSH     15                SAVE AVR INDEX
         BAL,11   MSROCTY
         PULL     15                RESTORE AVR INDEX
         LW,2     15
         BLZ      MOUNT3            COMMENT REQUIRED
         LW,3     S:CUN
         LW,R1    J:BASE+2          GET 'MOUN','SCRA','ANS0',ETC.
*                                   SEE IF WAIT IS NECESSARY
*
         CW,R1    SCRMES            SCRATCH
         BE       AVRWT
         CW,R1    MOUNTMES          MOUNT
         BE       AVRWT
         CW,R1    RINGMES
         BE       AVRWT
         AND,R1   YFFFFFF
         CW,R1    TANS0             WAIT FOR OPERATOR RESPONSE
         BE       AVRWT             IF ANS REQUEST OR TAPE
         CW,R1    TNOTZ
         BE       AVRWT
*                 DEALLOCATE DRIVE-   MUST HAVE BADEVTP=TYPE
AVRCLEAR EQU      %
         LD,4     AVRTBL,2
         LI,4     0                 CLEAR SER #
         STW,0    *TSTACK           SAVE YC, BREAK FLAG
         AND,5    M16               CLEAR FLAGS
         CI,5     X'8000'           CHK REMOUNT FLAG
         BANZ     MOUNT3
         CI,2     AVRTBLSIZ         IS THIS TAPE
         BGE      CLR10+1
CLR10    LI,5     0                 TAPE => CLEAR TPOS
         STD,4    AVRTBL,2
         STB,4    SOLICIT,2
         STH,4    AVRID,2
         STB,4    AVRFLGS,2
         REF      AVRFLGS
         B        TYPR1             GO CLEAR ANS TABLES
TYPRX1    EQU     %
         AI,2     BATAPE
         BAL,11   DHHIT             DOES HE HAVE IT
         BAZ      MOUNT3            LEAVE R0 TO NOT DEALL
         BAL,11   RSETSPIN          RESET SPINS
         LB,4     DCT4,2            GET DCT INDEX
         BAL,15   DEALL             DE-ALLOCATE  FROM GLOBAL
         MTB,-1   JB:CUR,1          DE-ALLOCATE FROM USER
*
SET%ERR  EQU      %                 SET ERROR CONDITION FOR OPEN
         LI,0     0                 ABORT AND DEALLOCT FLAG
         STW,0    *TSTACK           SAVE YC, BREAK FLAG
MOUNT3   EQU      %
         PULL     2,15              GET RID OF PLIST AND GET YC FLAG
         LW,1     J:BASE+2         GET MESSAGE TYPE
         LW,R3    J:BASE+5         GET SERIAL NUMBER
         B        TYPR5
TYPRX5   EQU      %
         CW,1     SCRMES            IF SCRATCH SET 3=-1
         BNE      %+2
TYPRX51  EQU      %
         LI,3     -1
         PULL     7,R5
         CI,11    JOVVPA
         BG       *11               CALLED FROM THIS OVERLAY
         DESTRUCT
*
*
Y0014    DATA     X'00140000'
*
*
NOTPE    EQU      %
         SCREECH X'49'
*
*
GETTPDR  EQU      %                 HAS TWO RETURN POINTS
         LD,D1    AVRTBL+DPT+DPT,2
         CW,D2    YC5FF             ONLY AVR, SCR, HLD, UNL MAY BE ON
         BAZ      CHKTYPE           AVAIL DRIVE
GETTPDR1 EQU      %
         BIR,R2   GETTPDR
         B        0,R3              NO TAPE
CHKTYPE  RES      0   CHECK TYPE
         AI,R2    BATAPE+DPT        GET DCT INDEX
         LB,D3    DCT3,R2
         AI,R2    NBATAPE-DPT
         CI,D3    X'20'             PARTITIONED DEVICE FLAG
         BAZ      CHKTYPDG    NO--- DEVICE PARTITIONED
         LW,D4    S:CUN       YES-- GET USER #
         CW,D4    DID
         BNE      GETTPDR1    NO--- USER ALLOWED PARTITIONED DEVICE
CHKTYPDG EQU      %           YES-- CONTINUE
*                                   R4 CONTAINS TYPE
         CI,R4    KA
         BE       1,R3
         AI,2     BATAPE+DPT
         LB,D3    DCT4,R2           GET TYPE
         AI,2     NBATAPE-DPT
         CW,D3    R4
         BE       1,R3              RIGHT TYPE
         B        GETTPDR1          KEEP SEARCHING
*
*
AVRWT    EQU      %
         BAL,11   AVRWTCHK          DID WE MISS KEYIN
         LI,6     60                SLEEP FOR 60*1.2 SECONDS
         STW,6    U:MISC,3          ASSUMES E:SL IS ABOUT 18
         LI,6     E:SL
         BAL,11   T:REG
         BAL,11   AVRWTCHK          IS IT TIME TO GO BACK
         B        MOUNT10           NO, PUT OUT MOUNT AGAIN
AVRWTCHK EQU      %
         LI,0     -1                SET ERR FLAG FOR USECHECK
         LH,R6    UH:DL,R3          GET ERR,ABRT,BRK, & EC FLAGS
         CI,R6    X'F000'
         BANZ     AVRCLEAR          YES
         LI,0     2
         MTB,0    SOLICIT,2         DID WE GET AVR OR KEYIN
         BEZ      WTCHK1
         LH,6     AVRID,2
         BEZ      *11               OK, NOT ASSIGNED
         CW,6     S:CUN             DOES SOMEBODY ELSE NOW HAVE
         BE       *11               ID MATCH=>GOOD GUY STILL WAITS
WTCHK1   RES      0
         LD,R4    AVRTBL,R2
         REF      MASKS
M15      EQU      MASKS+15
         AND,R5   M15
         BEZ      NOUNSW            NO UNIT SWITCH
         AI,R5    -1                REMOVE BIAS
         LW,R6    TSTACK
         LW,R6    -7,R6             DCB ADDRESS
         SW,R5    R2                DIFFERENCE OF DCTXS
         AWM,R5   DSI,R6
         LD,R4    DOUBLEZERO
         STD,R4   AVRTBL,R2         RELEASE AVR ENTRY
NOUNSW   EQU      %
*                 GO BACK TO CHECK
         B        MOUNT3
*
*
MOUNTMES EQU      %
         DATA,4   'MOUN'
SCRMES   EQU      %
         TEXT     'SCRATCH '
*
COUNT    DATA     X'13404040'
REEL     EQU      %
         LCI      4
         LM,R0    ERRMESS
         B        CVT41
ERRMESS  EQU      %
         TEXTC       'REEL NO. ERR'
*
COUNT1   DATA     X'10404040'
*
*
DISMNT   EQU      %
         DEF      DISMNT
*        INPUT:   R2=AVRTBL ENTRY NO ,R3=SERIAL NO
*
         LW,R1    DISMES
         B        CVTINDX           CREATE DSMNT MESSAGE
DISMES   DATA,6   'DISMT '
         DATA,2   X'0000'
SAVRL    EQU      %
*        INPUT:   R2=AVRTBL ENTRY #, R3=SERIAL #
         LW,R1    SAVMES
         B        CVTINDX           CREATE SAVE MESSAGE
SAVMES   DATA,6   'SAVE  '
         DATA,2   0
RINGMES  DATA,4   'RING'
ANSERR   EQU      CVTINDX
         TITLE    '**** CVTINDX ****'
*        PURPOSE: TO GET THE EBCDIC CHANNEL AND DEVICE ADR OF THE
*                 DEVICE WHOSE AVRTBL ENTRY IS IN DCB:DSI (IF ENTERED
*                 AT CVTINDX) OR R2 (IF ENTERED AT CVTINDX1) AND TO
*                 CREATE THE TEXT OF THE TYPED MESSAGE
*
*        INPUT:   R6=DCB  ADR
*                 DCB:DSI=AVRTBL ENTRY NO OF THE DEVICE (CVTINDX)
*                 R2=AVRTBL ENTRY NO (IF ENTERED AT CVTINDX1)
*                 R3=EBCDIC SERIAL NO (FOR DISMT,SAVE,MOUNT MESSAGES)
*                 R1=FIRST WORD OF SCRMES,MOUNTMES,SAVMES,OR DISMES
*
*        CALL:    BAL,D4  CVTINDX
*
*        OUTPUT:  R0-R4 CONTAINS TYPED MESSAGE WITH THE SERIAL NO.
*                       IN R4 FOR DISMES AND MOUNTMES
*
*        REGS:    R2,R4  VOLATILE
*
CVTINDX  EQU      %
         LW,15    2                 SAVE AVR INDEX
         AI,R2    BATAPE
         LW,R4    R3                R4=SERIAL NO
         LD,R2    DCT16,R2
         CW,R1    SCRMES
         BE       CVT30
         B        TYPR3
TYPRX3   EQU      %
         LW,R0    COUNT             MOUNT,SAVE,OR DISMT MESSAGE
         SLD,R2   8
         AND,R2   M16
         AI,3     ','
         CW,1     MOUNTMES
         BE       CVT10
         CW,1     RINGMES
         BNE      %+2
         B        CVT11
         CW,1     SAVMES
         BNE      %+3
CVT11    EQU      %
         OR,2     SAVMES+1
         B        TYPR4
         OR,2     DISMES+1
         B        TYPR4
CVT10    OR,R2    DISMES+1
CVT20    EQU      %
         B        CVT40
CVT30    LW,R0    COUNT1            SCRATCH MESSAGE
         SCD,R2   -8
         LW,R4    R2
         LW,R2    SCRMES+1
TYPRX4   EQU      %
CVT40    LCI      5
CVT41    EQU      %
         STM,0    J:BASE+1
         B        MOUNT1
         TITLE    '**** MTPV ****'
TANSB    TEXT     'ANS '
TANSSCR  TEXT     '    ANSSCRATCH'
         RES,2    -1
         DATA,2   0
TANSM    TEXT     'ANSMOUNT'
TNOTEXP  TEXT     'NOT EXPIRED'
TVOL     TEXT     'VOL'
TANS1    TEXT     'ANS1'
TANS2    TEXT     'ANS2'
YFFFFFF  DATA     X'FFFFFF00'
TANS0    GEN,24,8 'ANS',
TNOTZ    GEN,24,8 'NOT',
TREEL    GEN,8,24 X'13','   '
         TEXT     'ANS REEL NO. ERR'
AOC      EQU      J:BASE+1
TYPR1    EQU      %                 CLEAR ANS TABLES
         STB,4    ANSFLGS,2
         STW,4    AVRSID,2
         LW,5     2
         MI,5     6
         AI,5     AVRFNMT
         AI,5     6
         LI,6     -6
         STW,4    *5,6
         BIR,6    %-1
         B        TYPRX1
TYPR2    EQU      %
         LI,D1    0
         BAL,R0   CHKANS0
         AI,D1    X'40'
         CI,R3    -1
         BNE      %+2
         AI,D1    1
         STB,D1   ANSFLGS,R2
         B        TYPRX2
TYPR3    EQU      %
         STW,R1   AOC+10            SAVE MESSAGE TYPE
         AND,R1   YFFFFFF
         CW,R1    TANS0
         BE       TYPR30
         LW,R1    AOC+10            BACK TO TYPR IF NOT ANS
         B        TYPRX3
TYPR30   EQU      %
         PUSH     7,R5
*                                   R2,R3 = XXXY YNDD
         AND,R2   M8
         AI,R2    X'4000'
*                                   R2,R3 = ZZB9TA80
*                                   ASSUME ANSSCRATCH
         LCI      2
         STM,R2   AOC+3             STORE ZZB9 TA80
         LCI      4
         LM,0     TANSSCR
         OR,3     AOC+3
         LCI      4
         STM,0    AOC               STORE   CBBBANSSCRATCHBYYNDD
         LI,1     BA(AOC+5)         SET BYTE POINTER
         LW,R0    AOC+10            RESTORE MESSAGE TYPE
         CW,R0    TANS0             IS IT SCRATCH OR MOUNT
         BNE      TYPR33            BRANCH IF ERROR TYPE.
         CI,R4    -1                YES. IS IT SCRATCH.
         BE       TYPR31A
         LCI      2                 NO, ITS MOUNT
         LM,2     TANSM
         STM,2    AOC+1             STORE ANSMOUNT
         LM,2     AOC+3
         SLD,2    16
         LCI      2
         STM,2    AOC+3             STORE BYYNDDZZ
         LI,1     BA(AOC+4)+2       SET BYTE POINTER
TYPR31   EQU      %
         LI,R0    ','
         STB,R0   0,R1
         AI,R1    1
         LW,R0    SNFN,R6
         CI,R0    X'20000'
         BANZ     TYPR32            BRANCH IF FILENAME
         LW,R2    R4                UNHASH SERIAL NUMBER
         BAL,SR4  SIXBACK
         LW,R0    SR2
         SLS,R0   8
         STW,R0   AOC+6
         LB,R0    SR1
         OR,R0    AOC+4
         STW,R0   AOC+4
         SLD,SR1  8
         STW,SR1  AOC+5
         LI,R1    24
         B        SETBC
TYPR31A  EQU      %
         LW,0     SNFN,R6           TYPE OF OPEN
         CI,0     X'20000'
         BANZ     TYPR31            FILE NAME
         LI,R1    19                MESSAGE SIZE
         B        SETBC
TYPR32   EQU      %
         LI,R0    ''''              BEGINNING APOSTROPHE
         STB,R0   0,1
         AI,1     1
         LI,R2    HAFLD
         LH,R7    *R6,R2
         AW,R7    FLP,R6            GET ADDRESS OF FILENAME
         LW,SR2   R1
         LB,SR1   *R7               SET UP REGS FOR MBS
         STB,SR1  SR2               SR2 = COUNT,DESTINATION
         ANLZ,SR1 %-2               SR1 = SOURCE = DCB
         MBS,SR1  1                 DISPLACEMENT GETS PAST BC
         LW,R1    SR2
         LI,R0    ''''
         STB,R0   0,1               ENDING APOSTROPHE
         AI,R1    1
         LI,R0    ','
         STB,R0   0,1
         AI,R1    1
         LW,R3    R1
         LI,R1    BACIS             GET TAPE SEQUENCE NUMBER
         LB,R1    *R6,R1
         LI,R2    3
         BAL,SR4  CNVDEC
         LI,R0    3
         STB,R0   R3                R3 = DESTINATION,COUNT
         LI,R2    SR1**2            SOURCE = R2
         MBS,2    0
         LW,R1    R3
         AI,R1    -BA(AOC)-1        COMPUTE BYTE COUNT FOR MESSAGE
         B        SETBC
TYPR33   EQU      %
         LCI 2
         LM,2     AOC+3
         SLD,2    24                R2,R3 = 9TA80ZZZ
         LCI      2
         STM,2    AOC+4
         LCI      3
         LM,1     TNOTEXP           ASSUME NOT EXPIRED
         STM,1    AOC+1
         CW,R0    TANS2
         BE       JD
         LCI      2
         LM,2     AOC+4
         STM,2    AOC+3
         LW,1     TANSB
         CW,0     TANS1
         BE       %+3
         STW,1    AOC+1
         LW,1     TVOL
         STW,1    AOC+2
         LI,1     16
         B        SETBC             SET BYTE COUNT
JD       EQU      %                 OUTPUT EXPIRATION DATE
         LW,1     15
         MI,1     6
         AI,1     AVRFNMT
         LCI      2
         LM,2     4,1               XXXY YDDD
         AND,2    M8                ZZZY YDDD
         AI,2     X'6B00'           ZZ,Y YDDD
         SLD,2    8                 Z,YY DDDZ
         OR,2     AOC+5
         LCI      2
         STM,2    AOC+5
         LI,1     26                SET BYTE COUNT
SETBC    EQU      %
         PULL     7,R5
         STB,1    AOC               ALL SET, RETURN TO TYPR
         B        MOUNT1
TYPR4    EQU      %
         LCI      5
         STM,R0   AOC
         BAL,R0   CHKANS0
         B        TYPR41
         LW,R0    AOC
         B        TYPRX4
TYPR41   EQU      %                 DISMOUNT ANS TAPE
         PUSH     4,SR1
        LW,2     15                RESTORE AVR INDEX
         LD,2     AVRTBL,2          CONVERT SERIAL NUMBER
         BAL,SR4  SIXBACK
         LCI      2
         STM,SR1  AOC+4
         PULL     4,SR1
         LB,R1    AOC
         AI,R1    2
         B SETBC+2
TYPR5    EQU      %
         CW,R1    TANSSCR+1
         BE       TYPRX51
         CW,R1    TANSM             IS IT ANSMOUNT
         BNE      TYPRX5
TYPR55   EQU      %                 ITS ANSMOUNT.
         LW,R6    TSTACK            GET DCB ADDRESS.
         AI,R6    -5
         LW,R6    *R6
         LW,R5    SNFN,R6
         CI,R5    X'20000'          IS IT BY SERIAL NUMBER
         BANZ     TYPRX5
         LI,R1    BA(AOC+4)+3       NUMBER FROM THE BUFFER.
         BAL,SR4  SIXPACK           HASH IT.
         LW,R1    AOC+1             RESTORE MESSAGE TYPE.
         LW,R3    R2                RESTORE IT TO R3 FOR USECHECK
         B TYPRX5
TYPR6    EQU      %
         BAL,R0   CHKANS1
         B        TYPRX6
         PUSH     2,R4
         LI,R5    HAFLD
         LH,R4    *R6,R5
         AW,R4    FLP,R6
         LW,R5    R2                FILE ADDR IN R4
         MI,R5    6
         AI,R5    AVRFNMT
         SLS,R5   2
         LB,R0    *R4               R4=SOURCE=DCB
         AI,R0    1
         STB,R0   R5                R5=COUNT,DESTIN=AVRFNMT
         SLS,R4   2
         MBS,R4   0
         LI,R0    0
         STW,R0   AVRSID,R2         CLEAR AVRSID
         PULL     2,R4
         B        TYPRX6
ANSREEL  EQU      %
         LW,15    2
         LI,0     0
         STW,0    AVRSID,2
         LCI      5
         LM,0     TREEL
         STM,0    AOC
         B        MOUNT1
         END

