ASMB,R,L,C
* 
* 
* 
*   NAME:  DD.23
*   SOURCE: 92071-18312 
*   RELOC:  92071-16312 
*   PRGMR:  D.L.M 
* 
***************************************************************** 
*  COPYRIGHT 1980 HEWLETT-PACKARD CO. ALL RIGHTS RESERVED.      * 
*  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED,      * 
*  OR TRANSLATED INTO ANOTHER PROGRAMMING LANGUAGE WITHOUT THE  * 
*  PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD CO.                 * 
***************************************************************** 
* 
      HED DD.23 7970E HP-IB TAPE TRANSPORT DRIVER FOR RTE-XL  
      NAM DD.23,0   92071-16312 REV.2041 800731 
      ENT DD.23 
      EXT $DV1,$DV6,$DV12,$DV15,$DV16,$DV17,$DV18,$DV19 
      EXT $DV20,$DV22,$DVTP,.MVW,$ONER,$ONEW
      GEN 25,EDD.23,DX:3,TX:30,TO:1000,DT:23B 
* 
      GEN 11,M7970E:0,DP:2:400B:0 
* 
      GEN 12,M7970E:1,DP:2:1000B:0
* 
      GEN 12,M7970E:2,DP:2:1400B:0
* 
      GEN 13,M7970E:3,DP:2:2000B:0
* 
A     EQU 0 
B     EQU 1 
* 
DD.23 NOP           HERE WE GO!!! 
      LDB $DV1      GET ADDRESS OF DVT
      CPB DX10,I    ARE WE SET UP?? 
      JMP START     YES - START REQUEST 
      STA CSTAT     NO - SAVE FUNCTION CODE 
      LDA =D-16     SET COUNTER 
      STA UNTSL 
      LDA $DV22,I   GET ADDRESS OF EXTENSION
      LDB DXAD      AND ADDRESS OF TABLE
DXSET STA B,I       STORE ADDRESS 
      INA           BUMP A
      INB             AND B 
      ISZ UNTSL     INCREMENT THE COUNTER 
      JMP DXSET       AND DO IT AGAIN IF NOT DONE 
      LDA $DVTP     GET DRIVER PARAMETER ADDRESS
      INA           INCREMENT 
      STA DP1       AND SAVE
      INA           INCREMENT 
      STA DP2 
      LDA $DV1      ALL DONE - SAVE ADDRESS 
      STA DX10,I      IN EXTENSION
      SKP 
* 
      LDA CSTAT     GET SAVED CODE AGAIN
START AND B7       MASK OUT THE FUCTION CODE
      ADA JMPTA     ADD THE JUMP TABLE ADDRESS
      JMP A,I         AND GO TO IT! 
JMPTA DEF *+1,I 
      DEF ABORT     ABORT 
      DEF INIT      INITIATE
      DEF CO/RS     CONTINUE
      DEF TIMOT     TIMEOUT 
      DEF PFAIL     POWER FAIL
      DEF CO/RS     RESUME
      DEF REJ1      SIX AND 
      DEF REJ1        SEVEN ARE ILLEGAL 
* 
DP1   BSS 1         DRIVER PARAMETER 2
DP2   BSS 1           AND 3 
DXAD  DEF *+1       ADDRESS OF EXTENSION TABLE
DX1   BSS 1         REQUEST 
DX2   BSS 1         PRAM1/BUFR
DX3   BSS 1         PRAM2/BUFL
DX4   BSS 1         COROUTINE RETURN POINT
DX5   BSS 1         SCRATCH 
DX6   BSS 1         THREE BYTES STATUS
DX7   BSS 1 
DX8   BSS 1         READ/WRITE REQUEST
DX9   BSS 1         DSJ 
DX10  BSS 1         ADDRESS OF EXTENSION
DX11  BSS 1         SUBROUTINE RETURN 
DX12  BSS 1         RESTART FLAG
DX13  BSS 1         TRANSMISSION LOG
DX14  BSS 1         TIME-OUT FLAG 
DX15  BSS 1         END OF MEDIA FLAG 
QUINT BSS 1         QUINT AREA
      SKP 
* 
*     REQUEST INITATION COMES HERE
* 
INIT  LDA $DV15,I   SAVE REQUEST AND FUNCTION CODE
      AND =B7713    MASK OUT DATA 
      STA DX1,I     SAVE
      LDA $DV15,I   GET IT AGAIN
      AND MBMSK     AND WITH MULI-BUFFER MASK 
      STA $DV15,I     AND RESTORE 
      LDA $DV16,I   GET BUFFER ADDRESS/PRAM1
      STA DX2,I       AND SAVE
      LDA $DV17,I   GET BUFFER LENGTH 
      STA DX3,I       AND SAVE
      LDA $DV20,I   CLEAR 
      ELA,CLE,ERA     FIRST TIME BIT
      STA $DV20,I 
      CLA           CLEAR TIME OUT FLAG 
      STA DX14,I
      STA DX12,I      AND THE RESTART FLAG
* 
*  NOW THAT EVERYTHING IS INITIALIZED, SELECT THE PROPER
*  UNIT AND READ INITIAL STATUS AND DSJ 
* 
* 
      LDA DP1       GET SECOND PARAMETER
      STA UNTSL       AND STORE 
* 
*   UNIT SELECT QUINT 
* 
      LDB QUINT      GET THE ADDRESS OF EXTENSION 
      JSB MVQNT     GO MOVE INTO EXTENSION
* 
       OCT 120102    WRITE
UNTSL  NOP           UNIT SELECT
M1     OCT 177777    -1 
B1     OCT 1         NO OTHERS
       OCT 141       SECONDARY
* 
      CCA           STORE A -1
      STA $DV17,I     FOR # OF QUINTS 
      CLA 
      JSB EXITC 
* 
      JSB CSTAT     GO CHECK STATUS 
* 
      RRR 6         MOVE RIGHT SIX
      SLA           IS DEVICE BUSY? 
      JMP BUSY      YES - HANDLE ACCORDINGLY
      SKP 
* 
*  LET'S PROCESS THE REQUEST NOW
* 
      LDA DX1,I     GET REQUEST 
      LDB DP2,I       AND RETRY COUNT 
      SZB            NON-ZERO?
      JMP INIT1 
      LDB =D-11     DO IT THIS MANY FOR READ
      RAR,SLA,RAL   WRITE OR CONTROL??
      LDB =D-60     YES - THEN DO IT THIS MANY
      STB DP2,I 
INIT1 AND B3        MASK OUT IRRELEVANT BITS
      CPA B3        IS IT A CONTROL REQUEST?? 
      RSS 
      JMP RDWR      GO DO READ OR WRITE 
* 
*  CONTROL REQUESTS COME HERE 
* 
CNTRL LDB $DV6,I    GET STATUS
      RRR 5         MASK OUT EOT
      ERB           EOT SETS E=1
      LDA DX1,I     GET REQUEST CODE
      RRR 6         MOVE FUNCTION CODE INTO POSITION
      AND =B77      MASK OUT FUNCTION CODE
      SZA,RSS       IS IT ZERO? 
      JMP REW       YES - REWIND THE TAPE 
      CLB 
      CPA B6        IS THIS DYNAMIC STATUS? 
      CLE           YES - CLEAR E SO IT SKIPS 
      CPA B3        IS IT THREE?
FORWD LDB B11       YES - FORWARDSPACE RECORD 
      CPA B12       IS IT TWELVE? 
GAP   LDB B7        YES - WRITE GAP 
      CPA B13       IS IT 13? 
      LDB B13       YES - FORWARDSPACE FILE 
      CPA B1        IS IT A ONE?
      LDB B6        YES   -  WRITE EOF
      SEZ,SZB       IS THERE SOMETHING TO DO? 
      JSB EOMCK     YES - CHECK FOR EOM LEGALITY
      CPA B2        IS IT A TWO?
BKSPC LDB B12       YES   -  BACKSPACE RECORD 
      CPA B4        IS IT A FOUR? 
REW   LDB B15       YES   -  REWIND 
      CPA B5        IS IT A FIVE? 
      LDB B16       YES  - REWIND AND OFF-LINE
      CPA B14       IS IT A FOURTEEN? 
      LDB B14       YES  - BACKWARD SPACE FILE
      SZB,RSS       IS THERE SOMETHING TO DO? 
      JMP CNTCP     NO - POST STATUS AND ALL DONE 
* 
*  NOW THAT FUNCTION CODE HAS BEEN OBTAINED, LET'S DO IT
* 
      LDA $DV6,I    GET THE STATUS
      RAR,CLE,SLA,RAR ROTATE WHILE CHECKING IF ON-LINE
      JMP NR        NOT ON LINE 
      ERB           SO SAVE LSB 
      CPB B3        IS IT 6 OR 7? 
      SLA,RSS         AND IS IT WRITE PROTECTED?
      RSS           NO
      JMP WPRT      YES 
      ELB           MOVE BACK 
      BLF,BLF       MOVE TO UPPER BYTE
      STB DX5,I     STORE IN QUINT
      LDB DX5       GET ADDRESS 
      STB CMMD        AND STORE 
      SKP 
* 
* COMMAND QUINT 
* 
      LDB QUINT     GET STARTING ADDRESS
      JSB MVQNT     MOVE THE QUINT
* 
       OCT 120102    WRITE
CMMD   NOP
       OCT 177777    ONE CHARACTER
       OCT 20001     WAIT FOR PARALLEL POLL 
       OCT 141       SECONDARY
* 
      CCA           ONE QUINT 
      STA $DV17,I     TO DO 
      CLA 
      JSB EXITC     GO DO IT
* 
      LDA =D-18000  LOGICAL TIMEOUT VALUE 
      JSB EXITR     SET UP TO WAIT FOR PARALLEL POLL
      JSB EXITC       AND GO DO IT
* 
      LDB QUINT     GET ADDRESS AND 
      JSB BDSJQ       BUILD DSJ QUINT 
      CCA           STORE A 
      STA $DV17,I     -1 IN LENGTH
      CLA           CLEAR AND 
      JSB EXITC       GO DO IT
* 
      JSB CKDSJ     CHECK THE DSJ RESPONSE
      JMP CNTCP     ALL DONE
      JSB CSTAT     BAD DSJ - GO CHECK STATUS 
      CCB           INDICATE THE RESULT OF A CONTROL REQUEST
      JMP BRW1        AND CHECK         
CNTCP LDA DX12,I    GET THE ERROR CODE
      LDB A 
      SZA,RSS       IS IT ZERO??
      JMP EXIT
      CMB,SZB       WAS IT -1?? 
      JMP EXERR     AND EXIT
      LDA RSTRT     YES - GET RESTART CODE
      STA DX12,I
      JMP GAP       WRITE A GAP 
* 
      SKP 
* 
* READ AND WRITE REQUESTS COME HERE 
* 
RDWR  JSB EOMCK     CHECK FOR EOM 
      LDA $DV6,I    GET STATUS
      RAR,SLA,RAL   CHECK IF ON-LINE? 
      JMP NR        NO
      JSB RWCK      READ/WRITE? (ALSO LOADS B)
      JMP RW1       ITS A READ
      RAR,RAR       CHECK IF WRITE PROTECTED
      SLA           IS IT?
      JMP WPRT      YES - GO INDICATE 
RW1   LDA DX3,I     GET LENGTH
      SZA           IS IT ZERO? 
      JMP RDWR1     NO - NORMAL REQUEST 
      RRR 16        SWAP A & B
      AND =B101     CHECK IF BINARY READ
      CPA =B101     IS IT?
      JMP FORWD     YES - FORWARD SPACE 
      JMP EXIT      NO - IMMEDIATE COMPLETION 
RDWR1 STA LEN       STORE LENGTH
      ALS           MULT. BY 2
      CMA,SSA,INA   NEG., <0? 
      STA LEN       YES SO RESTORE
      LDA DX2,I     GET ADDRESS OF BUFFER 
      STA BUF         AND SAVE
      LDA B5        GET WRITE REQUEST 
      JSB RWCK      READ/WRITE? 
      LDA B10       THEN LOAD READ REQUEST
      ALF,ALF       MOVE TO UPPER BYTE
      STA DX8,I       AND STORE 
      LDA DX8       STORE COMMAND ADDRESS IN BUFFER 
      STA RDWRC 
* 
* READ WRITE COMMAND QUINT
* 
      LDB QUINT       EXTENSION 
      JSB MVQNT     MOVE THE QUINTS 
* 
       OCT 120102    WRITE CONTROL
RDWRC  NOP           ADDRESS
       OCT 177777    LENGTH 
       OCT 10001     ANOTHER FOLLOWS
       OCT 141       SECONDARY
* 
      JSB BDSJQ     BUILD A DSJ QUINT 
      SKP 
*  DATA  QUINT
* 
      JSB MVQNT     GO MOVE THE QUINT 
* 
       OCT 120101    READ/WRITE CONTROL 
BUF    NOP           BUFFER ADDRESS 
LEN    NOP             AND LENGTH 
B3     OCT 3         POST TRANSMISSION LOG
       OCT 140       SECONDARY
* 
*  AT THIS POINT B = ADDRESS OF LAST THING MOVED IN EXTENSION 
* 
      LDA M3        THREE QUINTS
      STA $DV17,I     STORE 
      STA $DV12,I   SET CLOCK TO 30 MS
      ADB M5        DECREMENT B BY 5
      LDA DX1,I     GET SYSTEM/USER BIT 
      AND B10 
      IOR B,I       STORE B IN A
      STA B,I       RESTORE THE WORDE 
      RRR 16        PUT B IN A
      JSB RWCK      READ/WRITE? 
      RSS 
      ISZ A,I       WRITE - INCREMENT CONTROL 
      LDA =D-400    ALLOW THIS MANY RE-ENTRIES
      STA DX14,I      IN CLOCK
      CCA           STORE A -1
      STA DX9,I         IN DSJ LOC. 
      LDA =B21      START TIME OUT
      JSB EXITC     GO DO IT!!!!! 
* 
* END COMMAND TO TERMINATE READ/WRITE 
* 
      LDA $DV17,I   GET TRANSMISSION LOG
      STA DX13,I       AND SAVE 
      CLA,INA       STORE 
      ALF,ALF        A 1
      STA DX5,I     IN DX5
      LDA DX5       GET ADDRESS 
      STA END         AND STORE IN EXTENSION
      LDB QUINT       AND ADDRESS 
      JSB MVQNT     GO MOVE THE QUINT 
* 
       OCT 120102 
END    NOP
       OCT 177777 
       OCT 100001    START ON PARALLEL POLL 
       OCT 147       SECONDARY
* 
      JSB BDSJQ     GO BUILD THE DSJ QUINT
      LDA M2        TWO QUINTS
      STA $DV17,I     TO DO 
      CLA 
      JSB EXITC     GO DO IT
* 
      SKP 
      JSB RWCK      READ/WRITE? 
      RSS           READ - DO PADDING 
      JMP RDDSJ     WRITE - DO COMPLETION 
      LDB DX13,I    YES - GET LOG 
      SLB,RSS       IS IT ODD?
      JMP RDDSJ     YES - COMPLETE
      CLE,ERB       YES DIVIDE BY TWO 
      ADB DX2,I     ADD THE BUFFER ADDRESS
      JSB $ONER     GET THE DATA
       DEF DX1,I    CONTROL 
       DEF $DV1,I   DVT ADDRESS 
      STB TEMP      SAVE ADDRESS TEMPORARILY
      AND =B177400  MASK OUT LOWER BYTE 
      RRR 16        SWAP TEMPORARILY
      LDA DX1,I     GET REQUEST AGAIN 
      AND B100      MASK OUT BINARY BIT 
      RRR 16        SWAP AGAIN
      CCE,SZB,RSS   IS IT ZERO? 
      IOR B40       YES - OR IN A SPACE 
      LDB TEMP
      JSB $ONEW     RESTORE THE DATA
       DEF DX1,I    USING CONTROL WORD
       DEF $DV1,I    DVT ADDRESS
* 
RDDSJ LDB DX13,I    GET TRANSMISSION LOG
      LDA DX3,I       AND ORIGINAL LENGTH 
      CLE,SLB,ERB   DIVIDE BY TWO AND INC. IF ODD 
      INB 
      SSA           IF A>0 B=TLOG ELSE DX13=TLOG
      LDB DX13,I    GET TRANSMISSION LOG AGAIN
      STB DX13,I      AND SAVE
* 
      JSB CKDSJ     GO CHECK DSJ
      JMP RWCMP     ALL DONE
BADRW JSB CSTAT     BAD DSJ - CHECK STATUS
      CLB           
      SKP 
* 
*  DV6 STATUS RETURNED IN A REGISTER
* 
BRW1  RAR,SLA,RAR   CHECK IF ON-LINE
      JMP NR        NO! 
      SEZ           HARD ERROR??
      JMP HE        YES 
      RAR,SLA,RAR   SOFT ERROR? 
      JMP SE        YES - CHECK IT
      RAR,SLA       EOM?
      JMP EOM       YES - INDICATE
      RAR,SLA       IS IT DEVICE BUSY 
      JMP NR
      SZB           IF CONTROL REQUEST
      JMP CNTCP       EXIT THIS WAY OR . . .  
      JMP EXIT                 EXIT WITH ZERO TLOG
* 
* SUCCESSFUL COMPLETION, CALCULATE RETRIES
* 
RWCMP LDA DP2,I     GET RETRY COUNTER 
      SZA,RSS       IS IT ZERO? 
      JMP EXIT      YES - DON'T WORRY ABOUT 
      CMA           NEGATE
      LDB DX1,I     GET THE REQUEST AGAIN 
      RBR,SLB 
      JMP RWCM2 
      ADA =D-11     WRITE 
      RSS 
RWCM2 ADA =D-60     READ
      CMA 
      IOR $DV19,I   OR INTO LOWER BYTE
      STA $DV19,I     AND RESTORE 
      LDB DX13,I
      RSS 
EXIT  CLB 
      CLA 
      STA DP2,I     AND RESTORE 
EXITE STB $DV17,I   POST TRANSMISSION LOG 
      SKP 
* 
* SUCCESSFUL COMPLETION COMES HERE
* 
EXITD STA $DV16,I   SAVE ERROR CODE 
      CLA           CLEAR A 
      STA DX4,I     CLEAR INTERRUPT ENTRY POINT 
      JMP DD.23,I   ALL DONE! 
* 
* ERROR ROUTINES
* 
* 
SE    SZB          WAS THIS A CONTROL REQUEST?
      JMP CNTCP    YES - INDICATE 
      JSB RWCK     IF READ
      JMP RWCMP      COMPLETE NORMALLY
      CLB            MAKE SURE B IS CLEAR 
* 
HE    LDA B5
      SZB 
      JMP EXERR 
      CCA           SET A -1 IN CASE OF WRITE 
      JSB RWCK      READ/WRITE? 
      LDA RSTRT     READ IS A RESTART ONLY
      ISZ DP2,I     INCREMENT RESTART COUNT 
      RSS           NOT OVER YET
HDERR LDA B5        ROLLED OVER SO DOWN DEVICE
ERR1  STA DX12,I      AND SAVE
      CLA           CLEAR A 
      JMP BKSPC     GO DO A BACKSPACE 
* 
WPRT  LDA B6        INDICATE WRITE PROTECTED
EXERR CLB             AND CLEAR B 
      JMP EXITE     DONE FOR NOW
* 
NR    LDA B2        DEVICE NOT READY
      JMP EXERR     TAKE ERROR EXIT 
* 
EOM   LDA DX1,I     GET REQUEST 
      ALF,RAL       CHECK BIT 10
      SSA,RSS       IF SET DON'T INCREMENT
      ISZ DX15,I    INCREMENT EOM FLAG
      NOP 
      JMP RWCMP     EXIT NORMALLY 
      SKP 
* 
* 
*  ALL TIME-OUTS COME HERE.  ON A READ/WRITE, THE DRIVER GETS RE-ENTERED
*   WHILE THE OPERATION IS EXECUTING IN ORDER TO CHECK THE DSJ.  IF THE 
*   DSJ IS 0, THE DRIVER EXITS LOGICAL WAIT FOR THE COMPLETION INTERRUPT
*   FROM THE INTERFACE, IF NON-ZERO THE DRIVER ABORTS THE OPERATION.  IF THE
*   WORD = -1, THE DSJ HASN'T BEEN DONE YET AND THE DRIVER DOES A WAIT
*   AGAIN.
* 
TIMOT LDA DX14,I    GET FLAG
      SZA,RSS       IS THIS A "LEGAL" TIMEOUT?
      JMP TMT1      NO - GO INDICATE
      ISZ DX14,I    INCREMENT THE FLAG
      RSS 
      JMP TMT1      CALL IT A TIMEOUT ANYWAY
      LDA DX9,I     DSJ VALUE 
      CMA,SZA,RSS   HAS IT BEEN DONE YET? 
      JMP TMT2      NO - WAIT SOME MORE 
      CMA           COMPLEMENT AGAIN
      AND =B177400  GET RELEVENT DATA 
      SZA           WAS IT GOOD?
      JMP RDABR     NO - ABORT
      STA DX14,I    CLEAR TIMEOUT FLAG
      LDA =D-2000   SET UP TIMEOUT
WAIT  JSB EXITR     SET UP FOR LOGICAL WAIT 
      JMP EXIT2       AND EXIT
* 
RDABR LDA B4        GO ABORT THE READ 
      JSB EXITC     DO IT 
* 
      JMP BADRW     GO CHECK STATUS 
* 
TMT1  LDA $DV6,I    GET STATUS
      RRR 6         CHECK FOR DEVICE BUSY 
      SLA           IS IT?
      JMP PFAIL     YES - GO RESTART REQUEST
TMT3  LDA B3        GO INDICATE REAL TIME-OUT 
      JMP EXERR     GO INDICATE 
* 
TMT2  LDA M2        SET ANOTHER TIMEOUT 
      JMP WAIT      AND WAIT SOME MORE! 
* 
*  THIS ROUTINE BUILDS THE DSJ QUINT IN THE EXTENSION LOCATION
*  LOCATED IN THE B REGISTER
* 
BDSJQ NOP 
      LDA DX9       STORE RESULT IN DX9 
      STA DSJ 
      JSB MVQNT     GO MOVE IT
      SKP 
* 
*  DSJ QUINT
* 
      OCT 120101    READ
DSJ   NOP           ADDRESS 
      OCT 177777
      OCT 100001    WAIT FOR PARALLEL POLL
      OCT 160       DSJ SECONDARY 
* 
      JMP BDSJQ,I   BACK WE GO
* 
*  THIS ROUTINE MOVES QUINTS INTO THE EXTENSION ACCORDING TO THE
*     EXTENSION LOCATION IN THE B REG AND THE COUNT IN THE A REG. 
* UPON EXIT A = SUBROUTINE RETURN ; B = ADDRESS OF NEXT WORD IN EXT.
* 
MVQNT NOP 
      CPB QUINT     IS THIS THE FIRST ONE IN QUINT? 
      STB $DV16,I   YES - SO STORE IN DVT 
      LDA MVQNT     GET THE ADDRESS OF QUINT
      JSB .MVW      MOVE THE WORDS
      DEF B5        THIS MANY 
      NOP           FOR UCODE 
      JMP A,I       ALL DONE
TEMP  EQU * 
* 
*  THIS SUBROUTINE CHECKS THE DSJ RESPONSE FOR CORRECTNESS
* 
CKDSJ NOP 
      LDA DX9,I     GET RESULT OF DSJ 
      AND =B177400  CLEAR LOWER BYTE
      SZA           IS IT ZERO? 
      ISZ CKDSJ     YES - INCREMENT RETURN
      JMP CKDSJ,I   RETURN
* 
EOMCK NOP 
      STB CKDSJ     SAVE B
      LDB DX15,I    GET THE EOM FLAG
      CPB B2        IS THIS THE SECOND TIME?
      RSS 
      JMP EOMC1 
      LDA B4        NO - DOWN THE DEVICE
      JMP EXERR 
EOMC1 LDB CKDSJ     RESTORE B 
      JMP EOMCK,I 
      SKP 
* 
*  THIS ROUTINE CHECKS STATUS AND UPDATES WORD 6 OF THE DVT 
*  IT RETURNS THIS STATUS IN THE A AND E REGISTERS
* 
* 
CSTAT NOP 
      LDA CSTAT 
      STA DX11,I   SAVE RETURN
      LDB QUINT     GET ADDRESS AND 
      LDA DX6       GET THE ADDRESS 
      STA STAT        AND SAVE IN THE QUINT 
* 
*  STATUS QUINT 
* 
      JSB MVQNT     GO MOVE IT
* 
       OCT 120101    READ 
STAT   NOP           ADDRESS
M3     OCT 177775    COUNT
       OCT 10001     ANOTHER FOLLOWS
       OCT 141       SECONDARY
* 
      JSB BDSJQ     BUILD DSJ QUINT 
* 
      ADB M2        SUBTRACT TWO
      CLA,INA       AND SET A TO ONE
      STA B,I       CHANGE DSJ CONTROL
      LDA M2        TWO QUINTS
      STA $DV17,I   STORE 
      CLA 
      JSB EXITC    GO DO IT 
* 
*    (CON'T)
      SKP 
* 
* NOW THAT STATUS HAS BEEN READ,  LET'S ANALYZE IT AND POST CORRECT 
*   BITS IN WORD 6 OF THE DVT 
* 
      LDA DX7,I     GET THREE BYTES 
      LDB DX6,I 
      AND =B177400  GET RID OF LOWER BYTE 
      STA $DV19,I 
      STB $DV18,I     AND STORE IN THE EXTENSION
      LDA $DV6,I    GET STATUS BYTE 
      AND =B177401  GET RID OF OLD STATUS 
      RRR 16        SWAP A & B
      AND =B4007    MASK OUT BUSY BITS
      RRR 16        SWAP AGAIN
      SZB           ANYTHING BUSY?
      IOR B100      YES - INDICATE
      LDB $DV18,I   GET WORD AGAIN
      RRR 16        SWAP A & B
      AND =B1020    MASK OUT BITS 
      RRR 16        SWAP AGAIN
      CLE,SZB       DATA ERRORS?
      CCE           YES - INDICATE
      LDB $DV18,I   GET WORD AGAIN
      BLF,BLF       SWAP UPPER AND LOWER
      SLB,RSS       IS TAPE ON-LINE?
      IOR B2        NO - INDICATE 
      RBR,RBR       FILE PROTECTED? 
      SLB,RBR       CHECK WHILE ROTATING
      IOR B4        OR IN BIT 
      RBR,SLB       CHECK FOR SOFT ERROR
      IOR B10       OR IN BIT 
      RBR,SLB       EOT?
      IOR =B240     OR IN BIT ALONG WITH EOF
      RBR,SLB       BOT?
      IOR B20       YES - INDICATE
      RBR,SLB       EOF?
      IOR B200      YES - INDICATE
      LDB $DV19,I   GET SECOND BYTE 
      BLF,SLB       COMMAND ERROR?
      CCE           YES - INDICATE
      STA $DV6,I    RESTORE 
      RRR 5         CLEAR B 
      CLB           GET EOT 
      SLA,RSS       IF NOT EOT THEN 
      STB DX15,I      CLEAR THE EOM FLAG
      LDA $DV6,I    RESTORE STATUS
      LDB DX11,I    GET RETURN
      JMP B,I       RETURN TO PROGRAM 
      SKP 
*  THIS ROUTINE DELAYS THE DRIVER FOR ONE SECOND WHILE THE
*   TAPE UNIT IS REWINDING. IT THEN RESTARTS THE REQUEST
* 
BUSY  CLA           CLEAR 
      STA DX14,I      THE RETRY COUNTER 
      LDA =D-100    SET A ONE SEC. LOGICAL TIME-OUT 
      JSB EXITR     SET UP FOR LOGICAL WAIT 
      JSB EXITC     GO DO IT
* 
* 
* 
* THESE ARE THE EXIT POINTS 
* 
EXITC NOP 
      LDB EXITC     GET RETURN ADDRESS
      STB DX4,I       AND SAVE
EXIT2 ISZ DD.23     INCREMENT RETURN
      JMP DD.23,I   AND DO IT 
* 
EXITR NOP 
      STA $DV12,I     IN DVT12
      CLA,INA       SET A ONE 
      ISZ DD.23     BUMP RETURN TWICE 
      JMP EXITR,I   GO WAIT 
* 
*  ABORT REQUESTS COME HERE 
* 
ABORT LDA B4        TELL INTERFACE TO ABORT 
      JSB EXITC     GO DO IT
* 
      LDA $DV15,I   GET DV15
      AND =B140000  SET FOR 
      IOR =B4103      DISABLE SCHEDULING
      STA $DV15,I   RESTORE 
      CLA           CLEAR 
      STA $DV16,I     DVT16 
      JSB EXITC 
* 
      CLA           CLEAR RESTART FLAG
      JMP EXITD     ALL DONE
* 
* 
* POWER FAIL REQUESTS JUST GET RESTARTED
* 
PFAIL LDA RSTRT     RESTART 
      JMP EXERR      GO DO IT 
* 
REJ1  LDA B3        DON'T KNOW WHAT IT IS SO REJECT IT
      JMP EXERR 
      SKP 
* 
*  CONTINUE AND RESUME ENTRIES TO THE DRIVER COME HERE
* 
* 
CO/RS LDA DX4,I     GET RETURN
      LDB $DV16,I    AND ERROR FROM ID.XX 
      CPB B3        PHYSICAL TIMEOUT? 
      JMP TMT3      YES 
      SZA           ILLEGAL INTERRUPT?
      JMP A,I       NO - BACK TO PROGRAM
      LDA B4        INDICATE ILLEGAL INTERRUPT
      CLB 
      ISZ DD.23     INCREMENT RETURN
      JMP EXIT2     AND DO IT!
* 
*  THIS ROUTINE CHECKS FOR READ OR WRITE. RETURNS 
*  P+1 IF READ , P+2 IF WRITE 
* 
RWCK  NOP 
      LDB DX1,I     GET ORIGINAL REQUEST
      SLB,RSS       IS IT A READ? 
      ISZ RWCK      NO - INCREMENT RETURN 
      JMP RWCK,I    AND RETURN
      SKP 
* 
*   CONSTANT AREA 
* 
MBMSK OCT 167774
B2    OCT 2 
B4    OCT 4 
B5    OCT 5 
B6    OCT 6 
B7    OCT 7 
B10   OCT 10
B11   OCT 11
B12   OCT 12
B13   OCT 13
B14   OCT 14
B15   OCT 15
B16   OCT 16
B20   OCT 20
B40   OCT 40
B100  OCT 100 
B200  OCT 200 
M2    DEC -2
M5    DEC -5
RSTRT OCT 100077    DON'T DOWN ;DON'T FLUSH 
      END 
                                                                                                                                                                                                                                      