*M*      TYPR     OUTPUTS MESSAGES TO OPERATOR RELATIVE TO TAPE AND
*,*                DEVICE DISC HANDLING.
*P*      NAME:    TYPR
*,*      PURPOSE  OUTPUTS MESSAGES TO OPERATOR RELATIVE TO REMOVABLE
*,*               VOLUME HANDLING. FINDS EMPTY DRIVES.
*,*      DESCRIPTION SETS UP AND OUTPUTS TO THE OPERATOR THE REQUESTED
*,*               MESSAGE, INCLUDING SELECTION OF AN EMPTY TAPE DRIVE IF
*,*               THE MESSAGE IS OF THE 'MOUNT' CLASS. ALSO CLEARS THE
*,*               AVR TABLE ENTRY FOR MESSAGES OF THE DISMOUNT CLASS,
*,*               AND WAITS FOR AN OPERATOR RESPONSE TO MOUNT AND ERROR
*,*               CLASSES.
         PCC      0
*        704714   SIGMA 5/7         BPM M:TYPR
ANSPROC  SET      1
MONPROC  SET      1
DISCBPROC SET     1                                                     DISCB
         SYSTEM   UTS
         DEF      TYPR:             PATCHING DEF
TYPR:    RES
         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
DPT      EQU      AVRTBLNE          DEVICE PACKS
         PAGE
*****************    DEF'S     **************************
         DEF      ANSERR
         DEF      ANSREEL
         DEF      DISMNT
         DEF      MOUNT
         DEF      REEL
         DEF      SAVRL
         DEF      USRMOUNT
         SPACE    5
******************    DATA REFS    ************************
*
***********CONSTANTS************
         REF      AVRTBLNE
         REF      AVRTBLSIZ
         REF      BATAPE
         REF      DOUBLEZERO
         REF      E:SL
         REF      MASKS
         REF      M16
         REF      M8
         REF      NBATAPE
         REF      Y02
         REF      Y04
         REF      Y1
         REF      Y8
         REF      Y01
**************VARIABLES*****************
         REF      ANSFLGS           OUTPUT;
         REF      AVRFLGS           OUTPUT;
         REF      AVRFNMT           OUTPUT;
         REF      AVRID             OUTPUT;
         REF      AVRSID            OUTPUT;
         REF      AVRTBL            OUTPUT; INPUT;
         REF      DCT16             INPUT;
         REF      DCT3              INPUT;X'20'
         REF      DCT4              INPUT;
         REF      J:BASE            OUTPUT; INPUT;
         REF      J:JIT             INPUT;
         REF      JB:CUR            OUTPUT;
         REF      LASTTPE           INPUT; OUTPUT;
         REF      S:CUN             INPUT;
         REF      SOLICIT           INPUT; OUTPUT;
         REF      U:MISC            OUTPUT;
         REF      UH:DL             INPUT;X'F000'
         REF      J:TELFLGS         INPUT;
         REF      PIGHEAD           INPUT;OUTPUT
         REF      S:TELLEM          * AUDIO ALARM FLAG CELL
         SPACE    5
******************FUNCTION REFS********************
         REF      CHKANS0           SKIP IF DCB NOT ANS
         REF      CHKANS1           SKIP IF DCB ANS
         REF      CNVDEC            BINARY TO DECIMAL CONVERT
         REF      DEALL             DEALLOCATE RESOURCE
         REF      DHHIT             ASCERTAIN RESOURCE OWNERSHIP
         REF      MSROCTY           TYPE MESSAGE ON OC
         REF      RSETSPIN          RESET SPINDLE TABLES
         REF      SIXBACK           CONVERT ANS SN TO EBCDIC
         REF      SIXPACK           CONVERT EBCDIC TO ANS SN
         REF      T:REG             SLEEP USER
         REF      GMB               GET MPOOL BUFFER
         REF      ECBGBLK           GET ECB BLOCK
         REF      T:GJOBSTRT        STTART A GHOST JOB
         PAGE     MOUNT
*
*                                   TYPE MOUNT MESSAGE FOR PARTICULAR
*                                   REEL NUMBER
MOUNT    EQU      %                 BAL,SR4  MOUNT--R3 = REEL NO
*F*      TYPR     OUTPUTS MESSAGES TO OPERATOR RELATIVE TO REMOVABLE
*,*                VOLUME HANDLING.
*F*      NAME:    MOUNT
*,*      PURPOSE  OUTPUTS MESSAGES TO OPERATOR RELATIVE TO REMOVABLE
*,*               VOLUME HANDLING. FINDS EMPTY DRIVES.
*,*      DESCRIPTION SETS UP AND OUTPUTS TO THE OPERATOR THE REQUESTED
*,*               MESSAGE, INCLUDING SELECTION OF AN EMPTY DRIVE
*D*      NAME:    MOUNT
*,*      REGISTERS R3 IS SAVED, ALL OTHERS ARE VOLATILE.
*,*      CALL     BAL,SR4 MOUNT
*,*                WITH SERIAL NUMBER OF VOLUME TO BE MOUNTED IN R3.
*,*                -1 INDICATES A SCRATCH AND ZERO AN ANSSCRATCH.
*,*      INTERFACE CALLS MSROCTY TO TYPE MESSAGE.
*,*      DATA     BUILDS MESSAGE IN J:BASE+1, SOMETIMES CALLED AOC.
*,*      INPUT    R3 = SERIAL NUMBER OF VOLUME, AS ABOVE. AVR TABLES
*,*                USED AND SET.
*,*      OUTPUT   MESSAGE TO OC OF FORM:
*,*                 'MMMM YDD,XXXX'
*,*               WHERE MMMM IS MOUNT, ANSMOUNT, SCRATCH, OR ANSSCRATCH
*,*               DEPENDING ON R3 AND AVRFLGS,
*,*                 YDD IS THE ADDRESS OF THE DRIVE, AND
*,*                 XXXX IS THE SERIAL NUMBER OF THE VOLUME.
*,*      DESCRIPTION THE START OF THE MESSAGE IS SET INTO R1 FROM THE
*,*               CONTENTS OF R3, THEN THE AVR TABLES ARE SEARCHED FOR
*,*               THE BEST DRIVE TO USE. THE SEARCH CONSISTS OF
*,*               4 PASSES THRU THE AVR TABLES TO FIND AN UNUSED
*,*               DRIVE, AN UNASSIGNED SCRATCH DRIVE, OR ANY UNASSIGNED
*,*               DRIVE. THE UNUSED SEARCH CONSISTS OF TWO PASSES, THE
*,*               FIRST STARTING WHERE THE LAST WAS FOUND. THE AVR
*,*               TABLES ARE THEN FLAGGED TO PREVENT OTHERS FROM TAKING
*,*               THE SELECTED DRIVE, AND SPECIAL VALUES SUCH AS ANS
*,*               FILE NAME ARE SET INTO THE TABLES. THE BALANCE OF THE
*,*               MESSAGE IS THEN BUILT AND TYPED ON THE OC.
*,*                     'MMMM YDD,XXXX' *,*               WHERE MMMM IS
*,*               TO ACKNOWLEDGE THE REQUEST. PERIODICALLY THE USER
*,*               WAKES AND REPEATS THE MESSAGE IF NOT YET ACKNOWLEDGED.
*,*               IF ABORTED, YC, OR BREAK OCCURRS, THE AVR ENTRIES
*,*               ARE CLEARED AND THE ROUTINE EXITS. OTHERWISE, WHEN
*,*               THE REQUEST IS ACKNOWLEDGED A UNIT SWITCH IS HANDLED
*,*               IF PRESENT, AND IN ANY EVENT THE ROUTINE EXITS.
         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
*S*      SCREECH CODE 49-00
*,*      REPORTED BY TYPR
*,*      REMARKS GIVEN IF GERM TABLES SAY THERE ARE DRIVES OF THIS
*,*               CLASS AVAILABLE BUT NONE CAN BE FOUND IN THE AVR TABLES.
         B        NOTPE             ISN'T ONE
         BAL,R0   CHKANS0
         LW,R1    TANS0             SET R1 WITH ANS INDICATOR
         STW,R2   AOC               SAVE LAST RESORT
*                                   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,2     -DPT-2            START AT LASTTPE
         AW,2     0                 OR FIRST IN TABLE
TPEFND   EQU      %
         BAL,R3   GETTPDR1          GET ENTRY FROM AVRTBL
         B        TPEFND2A
         CI,D1    K0                EMPTY DRIVE
         BE       TPEFND1           YES - TAKE
         B        TPEFND
TPEFND2A EQU      %
         BDR,0    TPEFND3           RECHECK FROM BEGINNING
         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    AOC               USE LAST RESORT DRIVE
TPEFND1  EQU      %
         AI,2     DPT
         STW,R2   LASTTPE           SAVE AS START POINT FOR NEXT TIME
         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      %
         LW,R4    J:TELFLGS         GET THE ERROR BIT
         AND,R4   Y01               ONLY
         LB,R4    R4                GET IT PLACED CORRECTLY
         AI,R4    1                 SETT THE FLAG FOR SOLICIT
*                                   1 = SOLICIT NO CNTRL Y
*                                   2 = SOLICIT CNTRL Y
         STB,R4   SOLICIT,R2        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
         LW,2     15                RESTORE AVR INDEX TO 2
         LB,9     SOLICIT,2         WAIT IF SOLICIT SET
MOUNT10  EQU      %
         LW,R7    TSTACK
         AI,R7    -1                R7 POINTS TO PLIST
         LI,SR1   K2
         LI,R5    J:JIT
         PUSH     2
         BAL,11   MSROCTY
         LW,R2    J:TELFLGS         SEE IF WE NEED TO PRINT THE MESSAGE TO THE U
         AND,R2   Y01               GET ERROR BIT ONLY
         BEZ      MOUNT7            NOT ONN MEANS NO PRINT
         PUSH     SR2               SAVE SOLICIT FLAG
         BAL,SR4  USRMOUNT          SEND MESSAGE TO USER
         PULL     SR2               RESTORE SOLICITT FLAG
MOUNT7   EQU      %
         PULL     2
         LW,3     S:CUN
         AI,9     0                 IF SOLICIT SET, WAIT
         BNEZ     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,2     AVRTBLSIZ         IS THIS TAPE
         BL       TYPR1             CLRAE TAPE TABLES
TYPRX1   RES
         STD,4    AVRTBL,2
         STB,4    SOLICIT,2
         STH,4    AVRID,2
         STB,4    AVRFLGS,2
DEALX    RES
         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
         LI,R6    0                 CLEAR DCB ADDRESS
         BAL,15   DEALL             DE-ALLOCATE  FROM GLOBAL
         MTB,-1   JB:CUR,1          DE-ALLOCATE FROM USER
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
         B        *11
*
*
Y0014    DATA     X'00140000'
YC5FF    DATA     X'C5FF0000'
*
*
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
         BANZ     GETTPDR1
         CI,2     AVRTBLSIZ-DPT     IF PACK, MOTHING MAY BE ON
         BL       CHKTYPE
         CI,D2    X'F0000'
         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
         LB,D4    DCT4,2            GET TYPE
         AI,R2    NBATAPE-DPT
         CI,D3    X'20'             PARTITIONED DEVICE FLAG
         BANZ     GETTPDR1          DONT ALLOCATE PARTITIONED DEVICE
         CW,D4    R4                IS IT
         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
         MTW,1    S:TELLEM          * RING AUDIO ALARM
         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     10
         CH,3     AVRID,2           ARE WE STILL HERE
         BNE      DEALX             NO..GET OUT..CLEANLY
         MTB,0    SOLICIT,2         DID WE GET AVR OR KEYIN
         BNEZ     *11               NO..KEEP WAITING
         B        MOUNT3
         SPACE    2
*D*      NAME:    USRMOUNT
*D*      REGISTERS:  ALL VOLATILE
*D*      CALL:    BAL,SR4  USRMOUNT
*D*      INTERFACE:  GMB,ECBGBLK,T:GJOBSTRT
*D*      INPUT:   TEXTC MESSAGE IN J:BASE+1
*D*      DESCRIPTION:  The message is moved to an MPOOL.  A COC
*D*               buffer is obtained and initialized, placed
*D*               on PIGEON's  chain, and PIGEON  is awakened.
*
USRMOUNT PUSH     SR4
         BAL,SR4  GMB               GET MPOOL
         BEZ      %-1
         LW,R3    D3                MOVE ADDRESS OF MPOOL
         SLS,R3   2
         LB,R1    J:BASE+1
         AI,R1    1                 SIZE OF MESSAGE INCLUDING COUNT
         STB,R1   R3
         LI,R2    BA(J:BASE+1)
         MBS,R2   0                 MOVE MESSAGE TO MPOOL
*
         BAL,R1   ECBGBLK           GET 4-WORD COC BUFFER
         BEZ      %-1
         STW,D3   3,R2              STORE MPOOL ADDRESS
         LW,R3    S:CUN             USER #
         MTB,5    R3                PUT BUFFER TYPE IN BYTE ZERO
         STW,R3   1,R2
         LW,R3    TEXTC:S           GET TEXTC 'S: '
         STW,R3   2,R2
         LI,R1    PIGHEAD           HEAD OF PIGEON'S  CHAIN
         DISABLE
USRM2    LW,R3    0,R1              LINK TO NEXT ENTRY
         BEZ      USRM4             AT END
         LW,R1    R3
         B        USRM2
USRM4    STW,R2   0,R1              MAKE NEW BUF THE END
         ENABLE
         LD,R0    TPIGEON
         BAL,SR3  T:GJOBSTRT        START PIGEON
         PULL     SR4
         B        *SR4
*
*
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      %
*D*      NAME:    DISMNT
*,*      ENTRY    SAVRL
*,*      REGISTERS ALL ARE VOLATILE EXCEPT R3
*,*      CALL     BAL,SR4 DISMNT (OR SAVRL)
*,*      INTERFACE CALSS MSROCTY TO OUTPUT SAVE/DISMNT MESSAGE.
*,*      INPUT    R3=SERIAL NUMBER OF VOLUME, R2=AVRX OF DRIVE.
*,*      OUTPUT   MESSAGE ON OPERATORS CONSOLE OF FORM:
*,*               SAVE(DISMNT)  NDD,XXXX
*,*               WHERE NDD=DEVICE ADDRESS AND
*,*                  XXXX=SERIAL NUMBER OF VOLUME
*,*      DESCRIPTION START OF MESSAGE IS SET IN R1, THEN BOTH ROUTINES
*,*               COMPLETE BUILDING OF MESSAGE, WHICH IS STORED IN
*,*               J:BASE+1, ETC. MESSAGE IS OUTPUT TO OC AND THE AVR
*,*               TABLES ARE CLEARED FOR THAT AVRX.
*        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
         BE       CVT11
         CW,1     SAVMES
         BE       %+2
         OR,2     DISMES+1
CVT11    EQU      %
         OR,2     SAVMES+1
         B        TYPR4
CVT10    OR,R2    DISMES+1
         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
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'
TEXTC:S  TEXTC    'S: '
         BOUND    8
TPIGEON  TEXTC    'PIGEON'
*
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
         STB,4    AVRFLGS,2
         LI,5     0
         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
         LW,R0    SNFN,R6           NO FILE NAME IF
         CI,R0    X'20000'            BY SERIAL NUMBER.
         BAZ      TYPR6BX
         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
         PULL     2,R4
TYPR6BX  EQU      %
         LI,R0    0
         STW,R0   VSETID,R6
         B        TYPRX6
ANSREEL  EQU      %
         LW,15    2
         LI,0     0
         STW,R0   VSETID,R6
         LCI      5
         LM,0     TREEL
         STM,0    AOC
         B        MOUNT1
         END

