*M*      7TAP     SPECIAL PROCESSING FOR MAG TAPE MODELS 7362,7372
         DEF      7TAP:
7TAP:    EQU      %
*
 TITLE '* * 7-TRACK TAPE HANDLER FOR E00 CP-V * *'
         SYSTEM   UTS
*
:CDW     COM,8,24,8,8,8,8  AF(1),AF(2),AF(3),X'80',AF(4),AF(5)
*
:DOT     CNAME
         PROC
         DO1      NUM(LF)=1
LF       SET      %-DOT
         GEN,8,8,8,8 AF(1),AF(2),AF(3),AF(4)
         PEND
*
:CLIST   CNAME
         PROC
         DO1      NUM(LF)=1
LF       SET      BA(%)-BA(DOT)
I        DO       NUM(AF)
         DATA,1   DA(AF(I))-DA(DOT)
         FIN      I
         PEND
*
*
         DEF      7TAP,7TAPCU,7TAP20
*
*
         REF      CUSETUP
         REF      COMLIST           BUILD COMMAND LIST IN BASHANDL
         REF      X400
         REF      MTAP06            IN MAGTAPE MODULE
         REF      IOQ5              CURRENT FUNCTION STEP TABLE
         REF      IOQ8              CDW/BA OF BUF TABLE
         REF      RE:ENT            RE-ENTRANCY CHECKER/RETURNS DISABLED
         REF      MAGTAPE
         REF      NOTOPTST
         REF      TYC:TST           FIND MATCHING TYC .VS. TDV STATUS
         REF      SPAC:FIL
         REF      SPAC:REC
         REF      IOQ11             RETRIES REMAINING TABLE
         REF      EXITRTY           EXIT RETRY START POINT
         REF      EXTSTORE
         REF      MT14
         REF      MT16
         REF      MT18
         REF      MT65
         REF      EXITFOL
         REF      MTAP10,MTAP20,MTAP30,MTAP50
         REF      MTAPCU
         REF      DCT3              TO TEST WHETHER TIMEOUT OCCURRED
         REF      DCT13
         REF      M16
         REF      MTAP54
*
         REF      VECT4             IN MAGTAPE MODULE
         REF      VECT5             IN MAGTAPE MODULE
         REF      RSTRBC            IN MAGTAPE
         REF      SAVRBC            IN MAGTAPE
         DEF      EXTREVCK          FOR MAGTAPE
         REF      X8000             DATA OF X'00008000'
         REF      Y8                DATA OF X'80000000'
         REF      X3
         REF      IOQ9
         REF      IOQ12
         REF      USECOM
         REF      REPCOM
         REF      DCT7              CLIST AREA HW TABLE
         REF      Y02               DATA OF X'02000000'
         REF      Y08               DATA OF X'08000000'
         REF      M24               DATA OF X'00FFFFFF'
         REF      IOARS             GET ARS IN IOQ ROUTINE
         REF      NOISE
         REF      BT31TO0
         REF      NB31TO0
         REF      SPECHK
         REF      NEWERCK
*
         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
R8       EQU      8
R9       EQU      9
R10      EQU      10
R11      EQU      11
R12      EQU      12
R13      EQU      13
R14      EQU      14
R15      EQU      15
*
*
*        TYC CODES
*
TYCOK    EQU      1                 SUCCESS
TYCBOT   EQU      3                 LOAD POINT
TYCEOT   EQU      5                 END OF TAPE
TYCTM    EQU      6                 TAPE MARK (END OF FILE)
TYCERR   EQU      8                 ERROR
*
*        FLAGS
*
FLGRETRY EQU      X'8000'
FLGFOLOW EQU      X'4000'
FLGINTER EQU      X'2000'
FLGKEYNC EQU      X'800'
FLGHOLD  EQU      X'400'
*
*        ORDER CODES
*
RDBCODE  EQU      12                READ BACKWARD
SRBCODE  EQU      75                SPACE RECORD BACKWARD
SFBCODE  EQU      91                SPACE FILE BACKWARD
SECODE   EQU      99                SET ERASE
RWONCODE EQU      19                REWIND ON-LINE
RWOFCODE EQU      35                REWIND OFF-LINE
*
         PAGE
************************************
*   7T TAPE POST-PROCESSOR         *
************************************
7TAPCU   EQU      %
         BAL,7    NEWERCK
         B        7TAP6             ***ERRORS FOUND -
*
*        NO ERROR RETURN
*
         LB,R4    IOQ5,R3           GET CURRENT STEP
         BNEZ     7TAP5             NOT READ PACKED
         BAL,R13  IOARS             GET ARS
         CI,R11   0                 ANY RBC
         BEZ      7TAP4             NO - AND THATS LOST DATA
*
*        RBC IS NON-ZERO
*
         MTW,0    IOQ12,R3          DID WE READ ANYTHING INTO
         BNEZ     7TAP4             YES - AND THATS LOST DATA
*
*        DID NOT DATA CHAIN INTO IOQ12 / RBC IS NON-ZERO THO
*
         LI,9     0
         XW,R8    R9                R9 HAS ARS
         DW,R8    X3                CALCULATE 3N
         CI,R8    0                 WHAT WAS RECORD LIKE
         BNEZ     7TAP2             GOTCHA AT 3N+1 AND 3N+2
*
*        RECORD WAS 3N EXACTLY / RBC IS NON-ZERO
*
         CI,R11   2                 WHAT WAS RBC RANGE
         BG       7TAP5             DIDNT USE OUR SPECIAL CDW
         LI,R11   1                 WE USED IT - MAKE NEW RBC
*
*        IF RBC IS LESS THAN TWO WE READ INTO IOQ12  ONE
*        BYTE TO ROUND OUT A 2048 BYTE RECORD (3N+2 CASE)
*
7TAP2    EQU      %
         LW,R7    R11               MOVE EXISTING RBC
         AI,R7    1                 INCREASE BY ONE
         LD,R10   DCT13,R1          GET TDV STATUS
         LW,R11   R7                MOVE NEW RBC INTO SLOT
         STD,R10  DCT13,R1          AND REPLACE FOR ARS CHKS IN IOQ
         LI,R12   1                 CHANGE TYC TO NORMAL
         B        7TAP5             MERGE
7TAP4    EQU      %
         LI,R12   2                 LOAD LOST DATA TYC
7TAP5    EQU      %
         LI,R13   0                 CLEAR FOR NO ERROR MSG
         BAL,R7   CUSETUP           SETUP CLEANUP REGISTERS
         LB,R7    VECT4,R4          NO ERRORS; GET INDEX FOR
*                                    NO ERROR CLEANUP
         B        MAGTAPE,R7        GO TO N0-ERROR-CLEANUP
         PAGE
*
*        FIND OUT WHAT KIND OF ERROR HAPPENED
*
7TAP6    EQU      %
         LC       DCT3,R1           DID DEVICE TIMEOUT?
         BCS,1    MT65              Y, REPORT LOST POSITION
         BAL,R15  NOTOPTST          CHECK IF DRIVE OPERATIONAL NOW
         BAL,R7   CUSETUP           SET CLEANUP REGISTERS
         OR,R5    X400+1            SET NON-CORR BIT IN STATUS
         LB,R7    VECT5,R4          GET ** ERROR ** CLEANUP INDEX
         B        MTAP06            JOIN W/COMMON CLEANUP PATH
*
7TMASK   DATA     X'0068007F'
         PAGE
*
*        AT TM/BOT/EOT ON A READ - CHECK IF REVERSE READ MODE
*
EXTREVCK EQU      %
         LB,R7    REVFC             # OF REVERSE READ FC'S
         LB,R4    IOQ5,R3           CURRENT FUNCTION STEP
         CB,R4    REVFC,R7          CHECK FOR REV READ FC
         BE       SAVRBC            YUP-> SAVE TDV STAT AND FOLLOW-ON
         BDR,R7   %-2
         B        TYC:TST           FORWARD READ-> REPORT TYC TO USER
REVFC    DATA,1   3,2,12,15         REVERSE READ FC'S
         BOUND    4
         PAGE
*
*        GOT A READ ERROR (TME OR TDE) AND WE ARE NOT AT TM/BOT/EOT
*        IF REVERSE READ:
*           INSURE A RETRY IS REMAINING BEFORE RETRY ATTEMPT.
*        IF FOREWARD READ:
*           REPORT TYC TO USER (NO MORE I/O).
*
7TAP20   EQU      %
         LB,R4    IOQ5,R3           GET ORIG FUNCTION STEP
         LB,R7    REVFC
         CB,R4    REVFC,R7          CHECK IF REVERSE READ OPERATION
         BE       7TAP30            YUP
         BDR,R7   %-2
         CI,R4    FCRDPB1           OR IF FC IS LOWER THAN FIRST REC STEP
         BL       NOISE             FOREWARD READ-> DO RETRY
7TAP30   EQU      %
         LB,R8    IOQ11,R3          CHECK RETRY
         BNEZ     EXITRTY           GOT SOME LEFT
         LI,R5    FCOUT2            POSITION TAPE IN FRONT OF RECORD
         B        EXTSTORE          AND QUIT
         PAGE
*
*        7-TRACK TAPE
*        DEVICE OPERATION TABLE
*
7TAP     EQU      %
         LI,R4    0
         MTB,0    IOQ5,R3           TEST FOR UNPKD BINARY
         BNEZ     %+2               NOPE..DONT CLEAR BUCKET THEN
         STW,R4   IOQ12,R3          CLEAR BUCKET
         BAL,R10  COMLIST           POST DOT TABLE ADDRESS
DOT      SET       %
*
*        TABS 10,16,43,46
*
FCRDPF   :DOT  7CLRDF,1,FCRDPR,FCRDPR      0 READ PACKED FOREWARD
FCWTP    :DOT  7CLWT,1,FCWTPR1,FCWTPR1     1 WRITE PACKED
FCRDPB   :DOT  7CLSRB,1,FCRDPB,FCRDPB1     2 READ PACKED BACKWARD
FCTM7    :DOT  7CLTM,1,FCTM7R1             3 WRITE TAPE MARK
FCSRB7   :DOT  7CLSRB,1,FCSRB7,FCSRB7      4 SPACE RECORD BACKWARD
FCSRF7   :DOT  7CLSRF,1,FCSRF7,FCSRF7      5 SPACE RECORD FOREWARD
FCSFB7   :DOT  7CLSFB,60,FCSFB7            6 SPACE FILE BACKWARD
FCSFF7   :DOT  7CLSFF,60,FCSFF7            7 SPACE FILE FOREWARD
FCRWON7  :DOT  7CLRWON,60,FCRWON7          8 REWIND ON-LINE
FCRWOF7  :DOT  7CLRWOF,60,FCRWOF7          9 REWIND OFF-LINE
FCRDBF   :DOT  7CLRDBF,1,FCRDBR,FCRDBR    10 READ BINARY FOREWARD
FCWTB    :DOT  7CLWTB,1,FCWTBR1           11 WRITE BINARY
FCRDBB   :DOT  7CLSRB,1,FCRDBB,FCRDBB1    12 READ BINARY BACKWARD
FCRDDF   :DOT  7CLRDDF,1,FCRDDR,FCRDDR    13 READ DECIMAL FOREWARD
FCWTD    :DOT  7CLWTD,1,FCWTDR1           14 WRITE DECIMAL
FCRDDB   :DOT  7CLSRB,1,FCRDDB,FCRDDB1    15 READ DECIMAL BACKWARD
FCRDPR   :DOT  7CLSRB,1,FCRDPR,FCRDPF     16 RDPF RECOVERY
FCWTPR1  :DOT  7CLSRB,1,FCWTPR1,FCWTPR2   17 WRITE PACKED RECOVERY
FCWTPR2  :DOT  7CLSE,1,FCWTPR2,FCWTP      18 WRITE PACKED RECOVERY
FCTM7R1  :DOT  7CLSRB,1,FCTM7R1,FCTM7R2   19 WRITE TM RECOVERY
FCTM7R2  :DOT  7CLSE,1,FCTM7R2,FCTM7      20 WRITE TM RECOVERY
FCRDBR   :DOT  7CLSRB,1,FCRDBR,FCRDBF     21 READ BINARY RECOVERY
FCWTBR1  :DOT  7CLSRB,1,FCWTBR1,FCWTBR2   22 WRITE BINARY RECOVERY
FCWTBR2  :DOT  7CLSE,1,FCWTBR2,FCWTB      23 WRITE BINARY RECOVERY
FCRDDR   :DOT  7CLSRB,1,FCRDDR,FCRDDF     24 READ DECIMAL RECOVERY
FCWTDR1  :DOT  7CLSRB,1,FCWTDR1,FCWTDR2   25 WRITE DECIMAL RECOVERY
FCWTDR2  :DOT  7CLSE,1,FCWTDR2,FCWTD      26 WRITE DECIMAL RECOVERY
FCRDPB1  :DOT  7CLRDF,1,FCRDPB,FCRDPB2    27 READ PACKED BACK SEQ
FCRDPB2  :DOT  7CLSRB,1,FCRDPB2           28 READ PACKED BACK SEQ
FCRDBB1  :DOT  7CLRDBF,1,FCRDBB,FCRDBB2   29 READ BINARY BACK SEQ
FCRDBB2  :DOT  7CLSRB,1,FCRDBB2           30 READ BINARY BACK SEQ
FCRDDB1  :DOT  7CLRDDF,1,FCRDDB,FCRDDB2   31 READ DECIMAL BACK SEQ
FCRDDB2  :DOT  7CLSRB,1,FCRDDB2           32 READ DECIMAL BACK SEQ
FCOUT2   :DOT  7CLSRB,1,FCOUT2            33 FINAL SRB, FAILED REV RD
*
         PAGE
*
*        7T TAPE
*        COMMAND LIST TABLE
*
*
         BOUND    4
*
7CLRDF   :CLIST   RDF               READ PACKED
         :CLIST   RDF1              AND ITS SECOND CDW
7CLWT    :CLIST   WT                WRITE PACKED
7CLTM    :CLIST   TM                WRITE TAPE MARK
7CLSRB   :CLIST   SRB               SPACE RECORD BACKWARD
7CLSRF   :CLIST   SRF               SPACE RECORD FOREWARD
7CLSFB   :CLIST   SFB               SPACE FILE BACKWARD
7CLSFF   :CLIST   SFF               SPACE FILE FOREWARD
7CLRWON  :CLIST   RWON              REWIND ON-LINE
7CLRWOF  :CLIST   RWOF              REWIND OFF-LINE
7CLRDBF  :CLIST   RDBF              READ BINARY
7CLRDDF  :CLIST   RDDF              READ DECIMAL
7CLWTB   :CLIST   WTB               WRITE BINARY
7CLWTD   :CLIST   WTD               WRITE DECIMAL
7CLSE    :CLIST   SE                SET ERASE
*
         PAGE
*
*        ALL TAPE
*        COMMAND DOUBLE WORDS
*
         BOUND    8
*
FNC      EQU      X'16'             FLAGS, NO COMMAND CHAIN
DCC      EQU      X'96'             DATA CHAINED FLAGS
SCC      EQU      X'B6'             SPECIAL CASE DC PLUS CC
*
RDF      :CDW     2,0,SCC,2         READ FOREWARDS (PACKED BINARY)
RDF1     GEN,8,24,8,16,8   2,CHNCHK,FNC,4,2
*
*
WT       :CDW     1,0,FNC,2         WRITE OR WRITE PACKED
TM       :CDW     115,0,FNC,0,1     WRITE TAPE MARK
SRB      :CDW     75,0,FNC,0,1      SPACE RECORD BACKWARD
SRF      :CDW     67,0,FNC,0,1      SPACE RECORD FOREWARD
SFB      :CDW     91,0,FNC,0,1      SPACE FILE BACKWARD
SFF      :CDW     83,0,FNC,0,1      SPACE FILE FOREWARD
RWON     :CDW     19,MT16,4,4,1     REWIND ON-LINE
RWOF     :CDW     35,MT16,FNC,4,1   REWIND OFF-LINE
*
RDBF     :CDW     6,0,FNC,2         READ BINARY
RDDF     :CDW     14,0,FNC,2        READ DECIMAL
WTB      :CDW     5,0,FNC,2         WRITE BINARY
WTD      :CDW     13,0,FNC,2        WRITE DECIMAL
SE       :CDW     99,0,FNC,0,1      SET ERASE
         PAGE
*
*        WE HAVE CONSTRUCTED THE COMMAND LIST AND ARE NOW
*        ABOUT TO INSERT THE DATA CHAINED READ PACKED BINARY
*        PAIR INTO THE LIST.
*
*        IF THE CDW WILL FIT INTO THE MPOOL - RETURN TO DO IT.
*
*        IF NOT - SPLIT THE LIST TO TIC OVER TO THE CLIST AREA TO
*        FINISH UP.
*
CHNCHK   EQU      %
         INT,R5   IOQ8,R3           TEST FOR DATA CHAIN
         BCR,8    CHNCHK0           NOP
*
*        OPERATION IS DATA CHAINED
*
         LW,R7    IOQ8,R3           GET D/C LOCATION (DA FORM)
         AH,R7    IOQ9,R3           R7 = LAST CDW PAIR
CHNCHK0  EQU      %
         LD,R12   *M24,R7           GET LAST CDW PAIR FROM LIST
         AND,R13  =X'DFFFFFFF'      DROP COMMAND CHAIN BIT
         OR,R13   Y8                SET DATA CHAIN BIT
         STD,R12  *M24,R7           REPLACE PAIR INTO LIST
         INT,R5   IOQ8,R3           NOW WHERE TO GO
         BCR,8    CHNCHK01          NOT DATA CHAINED OP
         LH,R5    IOQ9,R3           GET COMMAND COUNT
         AI,R5    1                 ADVANCE BY ONE
         CI,R5    15                WILL THIS ONE FIT
         BG       CHNCHK1           NOPE- MUST SPLIT THE LIST
         STH,R5   IOQ9,R3           SAVE NEW COUNT
CHNCHK01 EQU      %
         AI,R9    X'100'            MAKE IT IOQ12 TYPE
         B        REPCOM            AND REPLACE
         PAGE
*
*        MUST SPLIT UP THE LIST
*
CHNCHK1  EQU      %
         LW,R5    IOQ8,R3           GET DA OF MPOOL LIST
         AH,R5    IOQ9,R3           AND
         AI,R5    -1                POINT TO LAST CDW IN THE LIST
         LD,R12   0,R5              GET LAST PAIR FROM LIST
         LH,R8    DCT7,R1           GET CLIST DA
         LI,R9    0
         AI,R8    1                 SKIP OVER FIRST TIC
         OR,R8    Y08               INSERT TIC ORDER CODE
         STD,R8   0,R5              STORE TIC IN BOTTOM OF LIST
         LW,R7    R8                MOVE CLIST DA
         AND,R7   M24               SCREEN ORDER CODE
         LI,R8    IOQ12
         AW,R8    R3
         SLS,R8   2                 BYTE ADDRESS FORMAT
         OR,R8    Y02               READ ORDER
         LW,R9    =X'16800002'      FLAGS / WRIT KEY / BYTE COUNT
         STD,R8   1,R7              DROP IOQ12 DC INTO LIST SLOT
         OR,R13   Y8                SET DATA CHAIN IN NEXT TO LAST CDW
         STD,R12  0,R7              STORE NEXT TO LAST IN LIST
         B        USECOM            AND REJOIN COMLIST
         END

