ASMB,R
* 
*     NAME:   DD.30 
*     SOURCE: 92070-18085 
*     RELOC:  92070-16085 
*     PGMR:   B.L.L.,C.H.W. 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
* 
      NAM DD.30,0  92070-16085  REV.1941  791228
* 
* 
      SKP 
*  DEFINE DEVICE TABLE DEFAULTS FOR DISCS 
      GEN 10,EDD.30,TX:25,DX:8
*  7902 DEFAULTS  (2 LU'S)
      GEN 11,M7902:0,TO:750,DT:30B
      GEN 13,DP:2:0:0:0:3:134,DP:7:30:2 
* 
      GEN 11,M7902:1,TO:750,DT:30B
      GEN 13,DP:2:1:0:0:3:134,DP:7:30:2 
* 
*  7906 DEFAULTS  (4 LU'S)
      GEN 11,M7906:0,DT:32B,TO:100
      GEN 14,DP:2:0:0:0:5:406,DP:7:48:1 
* 
      GEN 11,M7906:1,DT:32B,TO:100
      GEN 14,DP:2:0:1:0:5:406,DP:7:48:1 
* 
      GEN 11,M7906:2,DT:32B,TO:100
      GEN 14,DP:2:0:2:0:5:406,DP:7:48:1 
* 
      GEN 11,M7906:3,DT:32B,TO:100
      GEN 14,DP:2:0:3:0:5:406,DP:7:48:1 
* 
*  7910 DEFAULTS  (4 LU'S)
      GEN 11,M7910:0,DT:31B,TO:1000 
      GEN 13,DP:2:0:0:0:4:370,DP:7:32:2 
* 
      GEN 11,M7910:1,DT:31B,TO:1000 
      GEN 14,DP:2:0:0:187:4:370,DP:7:32:2 
* 
      GEN 11,M7910:2,DT:31B,TO:1000 
      GEN 14,DP:2:0:0:373:4:370,DP:7:32:2 
* 
      GEN 11,M7910:3,DT:31B,TO:1000 
      GEN 14,DP:2:0:0:559:4:370,DP:7:32:2 
* 
*  7920 DEFAULTS  (10 LU'S) 
      GEN 11,M7920:0,DT:32B,TO:100
      GEN 13,DP:2:0:0:0:9:406,DP:7:48:5 
* 
      GEN 11,M7920:1,DT:32B,TO:100
      GEN 14,DP:2:0:0:83:9:406,DP:7:48:5
* 
      GEN 11,M7920:2,DT:32B,TO:100
      GEN 14,DP:2:0:0:166:9:406,DP:7:48:5 
* 
      GEN 11,M7920:3,DT:32B,TO:100
      GEN 14,DP:2:0:0:249:9:406,DP:7:48:5 
* 
      GEN 11,M7920:4,DT:32B,TO:100
      GEN 14,DP:2:0:0:332:9:406,DP:7:48:5 
* 
      GEN 11,M7920:5,DT:32B,TO:100
      GEN 14,DP:2:0:0:415:9:406,DP:7:48:5 
* 
      GEN 11,M7920:6,DT:32B,TO:100
      GEN 14,DP:2:0:0:498:9:406,DP:7:48:5 
* 
      GEN 11,M7920:7,DT:32B,TO:100
      GEN 14,DP:2:0:0:581:9:406,DP:7:48:5 
* 
      GEN 11,M7920:8,DT:32B,TO:100
      GEN 14,DP:2:0:0:664:9:406,DP:7:48:5 
* 
      GEN 11,M7920:9,DT:32B,TO:100
      GEN 15,DP:2:0:0:747:10:370,DP:7:48:5
* 
*  7925 DEFAULTS  (9 LU'S)
      GEN 11,M7925:0,DT:32B,TO:100
      GEN 13,DP:2:0:0:0:9:549,DP:7:64:9 
* 
      GEN 11,M7925:1,DT:32B,TO:100
      GEN 14,DP:2:0:0:62:9:549,DP:7:64:9
* 
      GEN 11,M7925:2,DT:32B,TO:100
      GEN 14,DP:2:0:0:124:9:549,DP:7:64:9 
* 
      GEN 11,M7925:3,DT:32B,TO:100
      GEN 14,DP:2:0:0:186:9:549,DP:7:64:9 
* 
      GEN 11,M7925:4,DT:32B,TO:100
      GEN 15,DP:2:0:0:248:11:1024,DP:7:64:9 
* 
      GEN 11,M7925:5,DT:32B,TO:100
      GEN 15,DP:2:0:0:363:11:1024,DP:7:64:9 
* 
      GEN 11,M7925:6,DT:32B,TO:100
      GEN 15,DP:2:0:0:478:11:1024,DP:7:64:9 
* 
      GEN 11,M7925:7,DT:32B,TO:100
      GEN 15,DP:2:0:0:593:11:1024,DP:7:64:9 
* 
      GEN 11,M7925:8,DT:32B,TO:100
      GEN 15,DP:2:0:0:708:11:1024,DP:7:64:9 
* 
* 
* 
      ENT DD.30 
* 
      EXT $DVTP,$DV1,$DV6,$DV12,$DV15,$DV16 
      EXT $DV17,$DV18,$DV19,$DV20,$DV22 
      EXT .MVW,$CVT1,$SYMG,$DVLU
* 
      SKP 
DD.30 NOP 
      LDB $DVTP      ARE WE 
      CPB DVP1         SET UP?
      JMP START      YES. 
      STA TEMP
      LDA N19 
      STA TEMP2 
      LDA DVAD
DXSET STB 0,I 
      INA 
      INB 
      CPA DXAD          DVT EXTENSION YET?
      LDB $DV22,I       YES. PICK UP DVT EXT. ADDRESS.
      ISZ TEMP2 
      JMP DXSET 
      LDA TEMP      GET ENTRY CODE
* 
START AND B7
      ADA JPTBA     JUMP TABLE ADDR 
      JMP 0,I       VECTOR BASED ON ENTRY TYPE
* 
JPTBA DEF JUMPA,I 
N19   DEC -19 
DXAD  DEF EXT1
DVAD  DEF *+1 
DVP1  BSS 1         DEVICE ADDRESS
DVP2  BSS 1         UNIT
DVP3  BSS 1         STARTING HEAD 
DVP4  BSS 1         STARTING CYLINDER 
DVP5  BSS 1         SPARES (NOT USED BY DD.30)
DVP6  BSS 1         # OF TRACKS 
DVP7  BSS 1         SECTORS/TRACK 
DVP8  BSS 1 
EXT1  BSS 1         ORIGINAL REQ BUFFER ADDR
EXT2  BSS 1         ORIGINAL REQ LENGTH 
EXT3  BSS 1         COROUTINE ADDR ON CONTINUE
EXT4  BSS 1         DEVICE CMDS 
EXT5  BSS 1         CYLINDER IN SEEK CMD   / RCVD STATUS-1
EXT6  BSS 1         HEAD(15-8)/SECTOR(7-0) / RCVD STATUS-2
EXT7  BSS 1         DSJ RECEIVED
EXT8  BSS 1         BUF'D(B15=0)/UNBUF'D(B15=1) FLAG + RQ CODE
EXT9  BSS 1         ABORT FG(B15=1), T.O.FLAG(14-0 NOT 0) 
EXT10 BSS 1         ERROR COUNT FOR RETRIES 
QUIN1 BSS 1         ADDR OF 1ST QUINTUPLET
      SKP 
************************************************************* 
*     INITIATION ENTRY
************************************************************* 
INIT  LDA $DV15,I     SAVE CONWORD
      LDB 0 
      AND N4          CHANGE REQUEST TYPE TO MULTI-BUFFERED.
      STA $DV15,I 
      XOR 1 
      SZA           RQ CODE=0?
      CPA B3         OR 3?
      JMP REJ1        YES, REQ ERROR
      STA EXT8,I    SAVE CONWORD BITS 1&0 
      DLD $DV16,I     SAVE USER'S BUFFER ADDRESS. 
      DST EXT1,I        & REQUEST LENGTH
      LDA $DV20,I   TEST "FIRST TIME" FLAG
      IOR EXT9,I     AND ABORT FLAG (FOR ENTIRE NODE) 
      SSA,RSS         TO SEE IF DSJ & FILE MASK REQUIRED
      JMP INIT2      NO 
************************************************************* 
*  1ST TIME THROUGH FOR THIS LU -INITIALIZE, OR 
*  LAST REQUEST ON THIS NODE ABORTED
************************************************************* 
      JSB BDSJQ       BUILD DSJ QUINT.
      LDA DVP8,I    GET # OF SURFACES 
      CPA B1        SINGLE SURFACE? 
      INA,RSS        YES, GO SURFACE MODE 
      CLA             ELSE GO CYLINDER MODE 
      XOR FMOP      USE AUTO TRACK SWITCHING
      JSB BDCMD     BUILD FILE MASK COMMAND (QUINT #2)
      LDA N2        2 QUINTS
* 
      JSB EXIT      *** READ DSJ & SET FILE MASK ***
* 
      JSB CKDSJ     VERIFY DSJ
*  NOTE: WE RETURN HERE ONLY IF DSJ WAS GOOD (0)
      STA EXT9,I    CLEAR ABORT FLAG (A=0)
      LDA $DV20,I 
      ELA,CLE,ERA   CLEAR 1ST TIME BIT
      STA $DV20,I 
* END OF 1ST TIME INITIALIZATION CODE 
* 
INIT2 LDA DVP6,I       NO. OF TRACKS
      CMA,INA 
      LDB $DV18,I      REQUESTED TRACK
      SSB              NEGATIVE?
      JMP REJ1         YES
      ADA 1 
      SSA,RSS          TRACK NO. TOO HIGH?
      JMP EOM          YES, TAKE EOM RETURN.
      LDB $DV19,I      SECTOR 
      CLE,SLB,ERB      NEGATIVE OR ODD? 
      JMP REJ1         YES. 
      STB TEMP2        SAVE PHYSICAL SECTOR 
      CMB 
      ADB DVP7,I       SECTORS/TRACK
      CCE,SSB          SECTOR NO. TOO LARGE?
      JMP REJ1         YES. 
* 
*     CHECK FOR ENOUGH ROOM FOR REQUEST 
* 
      LDB EXT2,I
      SZB,RSS 
      JMP DONE1+1   ZERO LENGTH 
      CMB,SSB,INB 
      CMB,INB,RSS   POSITIVE WORDS
      BRS           -BYTES TO POS WORDS 
      CLA 
      RRR 7         DIVIDE BY 128 
      CLE,SZA 
      INB           ROUND UP
      LDA $DV6,I
      AND B234C     DEVICE TYPE 
      CPB B1        IF FLOPPY AND 
      SZA           SINGLE SECTOR, E=0
      CLA,CCE         ELSE E=1 (UNBUFFERED) 
      SWP 
      ADA TEMP2 
      DIV DVP7,I    DIVIDE BY SECTORS/TRACK 
      SZB 
      INA           ROUND UP TRACK
      LDB EXT8,I
      RBL,ERB       BIT 15= 0 IF BUFFERED 
      STB EXT8,I
      ADA $DV18,I      STARTING TRACK.
      CMA,INA 
      ADA DVP6,I       NO. OF GOOD TRACKS.
      SSA,RSS          ENUF ROOM FOR REQUEST? 
      JMP OK         YES, CONTINUE
* 
EOM   LDA $DV6,I       NO. END OF MEDIA RETURN. 
      IOR B20          SET END OF MEDIA BIT.
      STA $DV6,I
*  ILLEGAL REQUEST REJECT 
REJ1  LDA NDDF      DON'T DOWN, DO FLUSH, ILL REQ 
      JMP LDONE 
      SKP 
************************************************************* 
* BUILD SEEK CMD: TRACK TO CYLINDER, HEAD, SECTOR ADDRESS 
************************************************************* 
OK    LDA $DV18,I      GET TRACK NO.
      CLB              SET TO DIVIDE. 
      DIV DVP8,I       A = CYL OFFSET, B = HEAD OFFSET. 
      ADA DVP4,I       ADD STARTING CYL 
      STA EXT5,I         AND SAVE IT. 
      ADB DVP3,I       NOW HAVE ACTUAL HEAD.
      BLF,BLF          POSITION IT IN UPPER BYTE. 
      ADB TEMP2        COMBINE HEAD & SECTOR
      STB EXT6,I         AND SAVE IT. 
      SPC 3 
************************************************************* 
*   BUILD SEEK QUINTUPLET IN DVT EXTENSION  & DO SEEK 
************************************************************* 
      LDA DVP2,I    UNIT
      IOR SEKOP     INCLUDE SEEK OP CODE
      LDB QUIN1 
      ADB B5        POINT TO 2ND QUINT
      STB $DV16,I 
* 
      JSB BDCMD     ** BUILD SEEK QUINT **
      ADB N3
      LDA N6        FIX-UP LENGTH TO
      STA 1,I        6 BYTES
* 
      CCA 
* 
      JSB EXIT      *** SEND SEEK CMD *** 
      STA EXT5,I    CLEAR STATUS FIELD
      SKP 
************************************************************* 
*     SEEK DONE - READS AND WRITES
************************************************************* 
      LDA EXT8,I       GET REQUEST FLAG 
      ERA,RAL          0 = WRITE
      SEZ,SSA          1 = READ 
      JMP UNBUF     UNBUFFERED READ 
************************************************************* 
*     BUFFERED READ - BUILD DSJ, READ CMD QUINTS. 
*             WRITE - BUILD DSJ, WRITE CMD, WRITE DATA QUINTS.
************************************************************* 
      JSB BDSJQ        ** BUILD DSJ QUINT **
* 
      LDA DVP2,I    UNIT
      SEZ,RSS 
      JMP WRIT      DO WRITE
      SPC 3 
************************************************************* 
*   BUFFERED READ PROCESSING
************************************************************* 
      IOR RDOP      ADD READ OPCODE TO UNIT 
* 
      JSB BDCMD     ** BUILD READ CMD QUINT **
      ADB N2
      STB TEMP      POINT TO WORDS 4,5
      DLD BUFRD     CACON,SECONDARY FOR BUFRD RD
      DST *         MODIFY QUINT
TEMP  EQU *-1 
* 
      LDA N2        TWO QUINTUPLETS FOR READ
      JSB EXIT      *** SEND READ CMD *** 
* 
      LDB RESUM     SENT, NOW DO LOGICAL WAIT 
      LDA NEGTO 
      STA $DV12,I   SET TIMEOUT VALUE 
      CLA,INA 
LWAIT ISZ DD.30 
      JMP EXIT1 
NEGTO DEC -200      2 SECONDS 
* 
RESUM DEF *+1 
************************************************************* 
*  PARALLEL POLL RECEIVED, GET THE DATA NOW 
************************************************************* 
      JSB CKDSJ     VALIDATE DSJ
      JSB RDDSJ     ** BUILD READ DATA & DSJ QUINTS **
      LDA N2
      JMP DATIN     GO DO XFER
      SKP 
************************************************************* 
*     BUILD WRITE CMD AND WRITE DATA QUINTS 
************************************************************* 
WRIT  IOR WROP      INCLUDE WRITE OPCODE WITH UNIT
* 
      JSB BDCMD     ** BUILD WRITE CMD QUINT ** 
* 
      LDA EXT1,I    USER BUFR ADDR
      STA WBUF
      LDA EXT2,I    GET REQ LENGTH
      STA WLEN
* 
      JSB QUINT     ** BUILD WRITE DATA QUINT **
       OCT 120102 
WBUF   NOP
WLEN   NOP
       DEC 2
       OCT 140
* 
      LDA N3
      JSB EXIT      *** DO WRITE ***
      SPC 3 
*  DATA SENT, CHECK XLOG & DSJ
      JSB LENCK     VERIFY XLOG 
* 
      JSB BDSJQ     ** BUILD A POST-WRITE DSJ QUINT **
* 
      CCA 
      JSB EXIT      *** DO A DSJ ***
* 
      JSB CKDSJ     CHECK DSJ 
      JMP DONE      GO WRAP IT UP 
      SKP 
************************************************************* 
*     UNBUFFERED READ - BUILD READ CMD, READ DATA, DSJ QUINT. 
************************************************************* 
UNBUF JSB RDDSJ     ** BUILD READ DATA & READ DSJ QUINTS ** 
      LDB QUIN1 
      STB $DV16,I   BEGINNING OF MULTI-BUF REQ
      LDA DVP2,I    GET UNIT
      IOR RDOP      ADD READ OPCODE 
* 
      JSB BDCMD     ** BUILD READ CMD QUINT **
* 
      LDA N3
* 
DATIN JSB EXIT      *** DO A DATA READ ***
* 
      JSB LENCK     VERIFY XLOG 
* 
      SKP 
************************************************************* 
*     SEND AN END COMMAND 
************************************************************* 
DONE  LDB QUIN1 
      STB $DV16,I 
      LDA ENDOP 
* 
      JSB BDCMD     ** BUILD END QUINT ** 
      CCA              ONE QUINTUPLET.
      JSB EXIT      *** SEND END COMMAND ***
      SPC 3 
* 
      LDA EXT2,I       LENGTH 
DONE1 STA $DV17,I      XLOG.
      CLA 
      STA $DV18,I 
      STA $DV19,I 
* 
*  HERE TO CLEAN-UP & TAKE DONE EXIT
LDONE CLB 
      SZA           ANY ERROR?
      STB $DV17,I    YES, WIPE XLOG 
      STA $DV16,I   SAVE ERROR CODE 
      CPA RSTRT     IS THIS A RESTART?
      JMP LDON2      YES, DON'T PROCESS RETRY BIT YET 
      LDA $DV6,I
      AND UMSK      CLEAR-OUT DV6 STATUS
      CPB EXT10,I   ERR COUNT=0?
      RSS 
      IOR B10        NO, SET "RETRY"
      STA $DV6,I    UPDATE DV6
      STB EXT10,I   CLEAR ERROR COUNT 
* 
LDON2 STB EXT3,I    CLEAR COROUTINE ADDR
      LDA EXT9,I
      AND BIT15     MAINTAIN "ABORTED" BIT
      STA EXT9,I     BUT CLEAR T.O. FLAG
CLAI  CLA 
      JMP DD.30,I   DONE
* 
UMSK  OCT 177400
B234C OCT 23400 
      SPC 3 
LENCK NOP 
      JSB CKDSJ 
      LDB EXT2,I
      SSB 
      CMB,INB 
      CPB $DV17,I   XLOG MATCH REQ LENGTH?
      JMP LENCK,I    YES
      JMP RETRY      NO, ERROR
      SKP 
************************************************************* 
*  CONTINUE AND RESUME COME HERE
************************************************************* 
CONT  LDA $DV16,I 
      CPA RSTRT     RESTART FROM INTERFACE DVR
      JMP LDONE      YES, OBEY IT 
      AND B77       TEST ERROR CODE 
      CPA B3        TIME OUT AT INTERFACE LEVEL?
      JMP TIMOT      YES
      SZA           NO ERROR? 
      JMP LDONE      ERROR, GO OUT DONE 
      LDB EXT3,I    COROUTINE ADDR
      SZB 
      JMP 1,I       ** GO TO COROUTINE (A=0) ** 
* 
      LDA B4        ILLEGAL INTERRUPT 
      JMP LWAIT     GET OUT 
      SKP 
************************************************************* 
*  ENTERED ON ABORT 
************************************************************* 
ABORT LDA B24          TELL PHY DVR TO ABORT WITH LOCK
      LDB ABAD         WHERE TO GO TO ON RETURN.
      JMP EXIT1 
* 
AB1   LDA $DV15,I 
      AND NDDF      SAVE "TY" FIELD IN CONTROL WORD 
      IOR B4103     BUILD A PPOLL DISABLE CONTROL REQ 
      STA $DV15,I 
      CLA 
      JSB EXIT      *** DO CONTROL(42) TO DISABLE POLL ***
* 
*  BELOW CODE DOES A "HARD CLEAR" IN TWO STEPS.  THIS CONSISTS
*  OF SENDING A SECONDARY OF "160" FOLLOWED BY A SINGLE BYTE
*  WITH EOI.  THE ADDRESSED DEVICE THEN IS SENT A "SELECTED 
*  DEVICE CLEAR". 
* 
      LDA $DV15,I 
      AND .14       CONWD=MUBUF REQ 
      STA $DV15,I 
      LDB QUIN1 
      STB $DV16,I   DVT16 POINTS TO QUINT 
      JSB QUINT     MOVE QUINT TO EXT 
      OCT 120102    WRITE 
      DEF *+2        A ZERO WITH
      DEC -1          EOI AS THE
      DEC 0            1ST PART OF "AMIGO 
      OCT 160           CLEAR" SEQUENCE 
* 
      CCA 
      JSB EXIT      DROP SINGLE QUINT ON TO PHY DVR 
* 
      LDA $DV15,I 
      AND .14 
      IOR B3        FORM A CONTROL CLEAR REQ
      STA $DV15,I 
      JSB EXIT      DO A CTL (0) TO PHY DVR TO SEND "SDC" 
* 
      LDB BIT15      SET ABORT FLAG: NEXT REQUEST FOR 
      STB EXT9,I      ANY LU ON THIS NODE WILL 1ST DO 
      JMP DONE1        A DSJ AND RESEND FILE MASK 
* 
ABAD  DEF AB1 
B1    OCT 1 
B4    OCT 4 
B20   OCT 20
B24   OCT 24
B77   OCT 77
B4103 OCT 4103
B377  OCT 377 
N6    DEC -6
.14   OCT 140000
NDDF  OCT 140001
BIT15 OCT 100000
      SKP 
************************************************************* 
*  SUBROUTINE TO BUILD THE DSJ QUINTUPLET 
************************************************************* 
BDSJQ NOP             BUILD DSJ QUINT SUB.
      LDB QUIN1 
      STB $DV16,I 
* 
BDSJ2 LDA EXT7
      STA BDSJ4     ADDR OF EXT WD #11
* 
      JSB QUINT     ** BUILD DSJ QUINT ** 
       OCT 120101 
BDSJ4  NOP
       DEC -1 
       DEC 0
       OCT 160
      JMP BDSJQ,I 
      SPC 3 
************************************************************* 
*     BUILD READ DATA, DSJ QUINTS.
************************************************************* 
RDDSJ NOP 
      DLD EXT1,I    GET USER BUFFER/LENGTH
      DST DBUF      SET FOR MOVE TO QUINT 
      LDB QUIN1 
      ADB B5
      STB $DV16,I 
* 
      JSB QUINT     ** BUILD READ DATA QUINT ** 
       OCT 120101 
DBUF   NOP
       NOP
B2     DEC 2
       OCT 140
* 
      LDA RDDSJ 
      STA BDSJQ     STORE RTN ADDR
      JMP BDSJ2     BUILD DSJ QUINT 
      SKP 
************************************************************* 
*     CHECK DSJ & RETURN IF OK.  OTHERWISE DO A STATUS READ 
*     AND DETERMINE RECOVERY PROCEDURE. 
*     CKDSJ ALWAYS RETURNS A=0
************************************************************* 
CKDSJ NOP 
      LDA EXT7,I    GET DSJ BYTE
      AND B377        ISOLATE ONE BYTE
      CCE,SZA,RSS     ZERO? 
      JMP CKDSJ,I     YES,O.K.
      ADA N4
      SSA,RSS         GREATER THAN 3? 
      JMP XMSER       YES. CONTROLLER IS FUBAR. 
* 
*     STATUS ROUTINE, ENTERED ON BAD DSJ
* 
      LDB QUIN1 
      STB $DV16,I 
      LDA DVP2,I    UNIT
      IOR STOP      INCLUDE STATUS OPCODE 
* 
      JSB BDCMD     ** BUILD STATUS CMD QUINT **
* 
      LDA EXT5      RCVD STATUS GOES
      STA TEMP2      INTO EXT5 & EXT6 
      JSB QUINT     ** BUILD READ STATUS QUINT ** 
       OCT 120101 
TEMP2  NOP
N4     DEC -4 
B10    OCT 10 
       OCT 150
* 
      LDA CKDSJ 
      STA EXT7,I    SAVE SUBR RETURN ADDR 
      LDA N2           TWO QUINTUPLETS
      JSB EXIT      *** READ THE STATUS *** 
* 
      LDA EXT5,I       STATUS-1 WORD
      ALF,ALF 
      AND B37 
      CPA B37       DRIVE ATTENTION?
      JMP DVATN      YES
      CPA B14         END OF CYLINDER?
      JMP POWUP        YES, RESEND FILE MASK
      CPA B21         DEFECTIVE TRACK?
      JMP PARER       YES. NOT ALLOWED. 
      CPA B23         STATUS-2 ERROR? 
      JMP NR?         YES. CHECK FOR NOT READY. 
* 
RETRY LDA EXT10,I     STEP ERROR COUNT. 
      INA 
      CPA B3           THREE TIMES? 
      JMP PARER       YES. XMISSION ERROR RETURN. 
      STA EXT10,I     PUT IT BACK.
      LDA RSTRT       100077B = RETRY CODE. NO MSG PRINTED. 
      JMP LDONE     ** GO OUT LOGICAL COMPLETION ** 
* 
*  HERE TO CHECK STATUS-2 
* 
NR?   LDA EXT6,I      STATUS-2 WORD.
      RAR,SLA         DRIVE CONNECTED?
      JMP NRDY        NO. SET DOWN. 
      RAR,SLA,RAR     SEEK CHECK? 
      JMP RETRY       YES.
      RAR,SLA         DRIVE FAULT?
      JMP FAULT       YES.
      LDB EXT8,I
      RAR,RAR 
      SLA            WRITE PROTECTED? 
      SLB             YES, IS THIS A WRITE? 
      JMP RETRY       NO. TRY AGAIN.
      LDA B6          YES. DOWN, DON'T FLUSH. 
      JMP LDONE 
* 
FAULT LDA B12         FAULT ERROR CODE = 10 
      JMP LDONE 
* 
POWUP LDA $DV20,I 
      RAL,ERA       SET "FIRST TIME" FLAG 
      STA $DV20,I   TO REISSUE DSJ & SET FILE MASK
      JMP RETRY     RETRY ENTIRE REQUEST
      SPC 2 
NRDY  LDA B2        ERROR CODE=2, NOT READY 
      JMP LDONE 
      SPC 3 
* 
DVATN AND EXT6,I    EXAMINE STAT-2 BITS 4-0 
      SZA           ANY ERRORS? 
      JMP RETRY      YES
      LDB EXT7,I     NO, OK TO PROCEED
      JMP 1,I       RETURN TO "CKDSJ" CALLER
      SKP 
*  HERE ON HARD FAILURE.  DOWN DISC & DONT GIVE TRK/SECTOR
*  IF WE COULDN'T GET STATUS BACK (TIMEOUT OR BAD XLOG).
*  OTHERWISE PRINT TRACK/SECTOR/STATUS & DONT DOWN THE DISC 
PARER LDA EXT5,I    STATUS
      ALF,ALF 
      AND B37       ISOLATE STAT-1 TYPE 
      CLE,SZA,RSS   DID WE GET A STATUS?
      JMP XMSER      NO, DOWN THE LU
      JSB $CVT1     CONVERT STAT TO ASCII/OCTAL 
      STA MSF3
      LDA $DV18,I   GET TRACK 
      CLB 
      DIV .100
      CCE,SZA       >100? 
      IOR B20        YES
      IOR SPACE 
      STA MSF1      STORE TRACK # 
      LDA 1         GET 2 LOW-ORDER DIGITS
      JSB $CVT1     CONVERT TO ASCII-DECIMAL
      IOR BIT12     FORCE NUMERIC IN LHW
      STA MSF1+1
      LDB $DV1      DVT ADDR
      JSB $DVLU     GET LU
      JSB $CVT1     CONVERT TO ASCII-DECIMAL
      STA MSF2
      JSB $SYMG     PRINT MSG TO CONSOLE
      DEF DSMSG 
      DLD EXT5,I    GET STAT-1 & STAT-2 
      DST $DV18,I   STORE IN DV18 & DV19
      LDA MEDER     DON'T DOWN & FLUSH
      JMP LDONE     EXIT BY LOGICAL DONE
* 
XMSER LDA B5        XMISSION ERROR
      JMP LDONE 
      SKP 
************************************************************* 
*  HERE ON A TIMEOUT, IF 1ST, DO A READ DSJ 
*  AND TRY TO RECOVER.
************************************************************* 
TIMOT LDB EXT9,I
      LDA B3
      RBR,SLB         THIRD TIME? 
      JMP LDONE        YES
      ISZ EXT9,I    BUMP T.O. FLAG
* 
      JSB BDSJQ       ** BUILD DSJ QUINT ** 
* 
      CCA              ONE QUINT. 
      JSB EXIT      *** GET DSJ *** 
* 
      STA EXT5,I    CLEAR STATUS WORD 
      JMP RETRY     DIDN'T TIMEOUT, SO RETRY
* 
* 
* 
SEKOP OCT 1000        SEEK OPCODE ( 2)
RDOP  EQU CLAI        READ OPCODE ( 5)
WROP  OCT 4000        WRITE OPCODE(10)
STOP  OCT 1400        STATUS OPCODE( 3) 
FMOP  OCT 7407      FILE MASK OPCODE(17)
ENDOP OCT 12400       END OPCODE   (25) 
* 
B3    OCT 3 
B5    DEC 5 
B6    DEC 6 
B7    OCT 7 
B12   OCT 12
B14   OCT 14
B21   OCT 21
B23   OCT 23
B37   OCT 37
BIT12 OCT 10000 
SPACE OCT 20040 
RSTRT OCT 100077
MEDER OCT 140077    FLUSH,DON'T DOWN
.100  DEC 100 
N3    DEC -3
BUFRD OCT 20000,152   BUFRD RD CACON & SECONDARY
      SKP 
* 
*  SUBROUTINE TO BUILD A SEND CMD QUINT 
* 
BDCMD NOP 
      STA EXT4,I    STORE CMD 
      LDA EXT4
      STA BDCM2     ADDR OF CMD INTO QUINT
* 
      JSB QUINT     MOVE CMD QUINT TO EXTENSION 
       OCT 120102 
BDCM2  NOP
N2     DEC -2 
       DEC 0
       OCT 150
* 
      JMP BDCMD,I   RETURN
      SPC 3 
* 
*  SUBROUTINE TO BUILD A QUINTUPLET 
* 
QUINT NOP 
      LDA QUINT 
      JSB .MVW
       DEF B5 
       NOP
      JMP 0,I       RETURN
* 
*  ENTER HERE TO SAVE COROUTINE ADDR FOR RETURNING ON CONTINUE
EXIT  NOP 
      STA $DV17,I   SAVE NEG # OF QUINTS
      CLA 
      LDB EXIT
EXIT1 STB EXT3,I      STORE NEXT ENTRY. 
      ISZ DD.30 
      JMP DD.30,I     RETURN. 
      SPC 2 
DSMSG OCT 40001     CONSOLE TRACK ERROR MSG 
      DEC -22 
      ASC 02,*TRK 
MSF1  DEC 0,0 
      ASC 02, LU
MSF2  NOP 
      ASC 03, STAT= 
MSF3  NOP 
      SPC 3 
JUMPA DEF ABORT 
      DEF INIT
      DEF CONT
      DEF TIMOT 
      DEF RETRY 
      DEF CONT
      END