FTN4,L,Q
C 
C  DATE:  SEPTEMBER 10,1979 
C  NAME:  TXCTU 
C  SOURCE: 02145-18014
C  RELOC:  02145-16009
C  PGMR:D.E.B.
C 
C******************************************************************** 
C  (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS
C  RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, 
C  REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT 
C  THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.
C******************************************************************** 
C 
      SUBROUTINE TXCTU(LOGLU), 02145-1X014  REV.2001  800304
C 
C SUBROUTINE TO TEST CARTRIDGE TAPE DRIVES ON 2645, 2675 TERMINALS
C BY INITIATING SELF TEST ON AN OPERATOR SUPPLIED SCRATCH TAPE AND
C READING BACK THE STATUS 
C 
C THIS ROUTINE IS OPTIONALLY CALLED FROM THE FTEST PROGRAM, THE 
C L-SERIES FUNCTIONAL TEST. 
C 
      IMPLICIT INTEGER(A-Z) 
C 
C VARIABLE DESCRIPTIONS:
C 
      INTEGER INBUF(2)
      INTEGER STRES(10) 
      INTEGER ESCSQ(10) 
      INTEGER BR(40)
      INTEGER NUMB(3) 
C 
      R=100001B 
      W=100002B 
      O=LOGLU+20000B
C 
10    CALL REIO(W,O,14H   INSERT TAPE,-14)
      GOTO 9000 
12    CALL REIO(W,O,4H    ,-4)
      GOTO 9000 
13    CALL REIO(W,O,4H    ,-4)
      GOTO 9000 
14    CALL REIO(W,O,43H   ENTER LU # OF TAPE DRIVE.  (/A TO ABORT),-43) 
      GOTO 9000 
15    CALL REIO(R,O+400B,INBUF,-4)
      GOTO 9000 
20    IF(INBUF(1).EQ.2H/A) 9000,30
C 
C CONVERT ASCII INPUT TO INTEGER
30    TEMP1=IAND(INBUF(1),177400B)
      TEMP2=IAND(INBUF(1),377B) 
      COUNT=0 
      FLAG=0
      IF(TEMP2.EQ.40B) 40,50
40    LUNO=TEMP1/256-48 
      GOTO 60 
50    LUNO=((TEMP1/256)-48)*10+(TEMP2-48) 
60    IF((LUNO.GT.64).OR.(LUNO.LE.0)) 90,300
C 
C GENERALIZED UNKNOWN INPUT RESPONSE "??" 
90    CALL REIO(W,O,2H?? ,-2) 
      GOTO 14 
91    GOTO 14 
C 
C CHECK THAT DEVICE TYPE OF LUNO IS 20 (CTU)
300   CALL EXEC(100000B+13,LUNO,STAT1,STAT2,STAT3,STAT4)
      GOTO 90 
302   IF((STAT1.AND.40000B).NE.40000B) GOTO 303 
      CALL STV(BR,1,30H   LU # $$ IS DOWN              ,1,15) 
      GOTO 312
C 
C CHECK FOR DEVICE BUSY 
C 
303   IF((STAT1.AND.100000B).NE.100000B) GOTO 305 
      CALL STV(BR,1,30H   LU # $$ IS BUSY              ,1,15) 
      GOTO 312
C 
C MASK AND SHIFT TO CHECK DEVICE TYPE 
C 
305   STAT1=IAND(STAT1,37400B)
      STAT1=STAT1/256 
      IF(STAT1.NE.20B)310,320 
C 
C LUNO IS NOT A CARTRIDGE TAPE UNIT 
310   CALL STV(BR,1,30H   LU # $$ IS NOT A TAPE UNIT. ,1,15)
312   CALL STV(BR,16,16HPLEASE RE-ENTER ,1,8) 
      CALL CNUMD(LUNO,NUMB) 
      CALL STV(BR,5,NUMB,3,1) 
      CALL REIO(W,O,BR,-48) 
      GOTO 9000 
318   GOTO 90 
C 
320   SIDE=IAND(STAT3,3B) 
      ESCSQ(1)=15446B 
      ESCSQ(2)=70060B+SIDE
      ESCSQ(3)=57021B 
C 
C SET TIME OUT DOWN TO CATCH NON-RESPONSE ERRORS QUICKLY
      CALL ILUTA(ADDR)
      ADDR=ADDR+LUNO-1
      LOLOC=IGET(ADDR)
      TOADR=LOLOC+12
      TMOUT=IGET(TOADR) 
      CALL IPUT(TOADR,-51)
C 
C CALL FOR DRIVE STATUS  CHECK FOR TAPE IN DRIVE, NOT WRITE PROTECTED,
C NOT BUSY
      CALL EXEC(W,120000B+LUNO,ESCSQ,-5,0)
      GOTO 90 
330   CALL EXEC(R,120000B+LUNO,STRES,-8,0,10400B) 
      GOTO 90 
C 
C CHECK FOR IO ERROR ON EXEC CALL, (IE TIME-OUT)
335   CALL ABREG(A,B) 
      CALL IPUT(TOADR,TMOUT)
      IF(A.EQ.2HIO) 340,510 
340   CALL STV(BR,1,22H   IO ERROR TO LU # $$,1,11) 
      CALL CNUMD(LUNO,NUMB) 
      CALL STV(BR,11,NUMB,3,1)
      CALL REIO(W,O,BR,-22) 
      GOTO 10 
341   GOTO 10 
C 
C 
C CHECK FOR TAPE INSERTED 
510   IF((STRES(4).AND.400B).EQ.400B) 520,10
520   IF((STRES(3).AND.4B).EQ.4B) 530,540 
530   CALL REIO(W,O,27H   TAPE IS WRITE PROTECTED.,-27) 
      GOTO 10 
532   CALL STV(BR,1,40H   TAPE TEST REQUIRES WRITING ON SCRATCH,1,20) 
      CALL STV(BR,21,6H TAPE ,1,3)
      CALL REIO(W,O,BR,23)
      GOTO 10 
533   GOTO 10 
C 
540   IF((STRES(3).AND.1B).EQ.1B) 550,560 
C 
C TAPE BUSY PRESUMABLY REWINDING ETC.  WAIT A FEW SECONDS,TRY AGAIN 
550   COUNT=COUNT+1 
      IF(COUNT.GT.20) 553,555 
553   CALL REIO(W,O,42H   TAPE BUSY.  REWIND TAPE AND START AGAIN,-42)
      GOTO 10 
554   GOTO 10 
C 
555   CALL EXEC(12,0,2,0,-3)
      GOTO 300
C 
C TAPE IS IN, NOT PROTECTED, NOT BUSY  INITIATE SELF-TEST 
560   ESCSQ(3)=62067B 
      ESCSQ(4)=41421B 
      CALL EXEC(W,120000B+LUNO,ESCSQ,-7,0)
      GOTO 90 
562   CALL EXEC(R,120000B+LUNO,STRES,-2,0,10400B) 
      GOTO 90 
C 
C CHECK SELF TEST RESULTS 
565   IF(STRES(1).NE.51415B)570,720 
570   ESCSQ(3)=57021B 
C 
C CALL FOR STATUS AND ANALYZE CAUSE OF FAILURE
      CALL EXEC(W,120000B+LUNO,ESCSQ,-5,0)
      GOTO 90 
575   CALL EXEC(R,120000B+LUNO,STRES,-8,0,10400B) 
      GOTO 90 
580   CALL ABREG(A,B) 
      IF(B.LE.6)600,610 
C 
600   CALL REIO(W,O,42H   DRIVE FAILED TO RETURN ANY TEST RESULTS,-42)
      GOTO 10 
601   GOTO 10 
C CHECK FOR PROPER FORM FOR STATUS BYTES: SHOULD BEGIN WITH "0011"
610   IF((STRES(3).AND.170360B).NE.30060B) 615,620
615   CALL STV(BR,1,40H   TAPE DRIVE DOES NOT RETURN STATUS SEQ,20) 
      CALL STV(BR,21,6HUENCE ,1,3)
      CALL REIO(W,O,BR,23)
616   GOTO 10 
C 
620   IF((STRES(3).AND.400B).NE.400B) 630,640 
630   CALL REIO(W,O,41H   WRITE ERROR (WRITE/BACKSPACE/READ MODE,-41) 
      GOTO 10 
631   FLAG=1
C 
640   IF((STRES(3).AND.10B).NE.10B) 650,660 
650   CALL REIO(W,O,26H   SELF TEST NOT PERFORMED,-26)
      GOTO 10 
651   FLAG=1
C 
660   IF((STRES(3).AND.2B).NE.0B) 670,680 
670   CALL REIO(W,O,13H   READ ERROR,-13) 
      GOTO 10 
671   FLAG=1
C 
680   IF((STRES(4).AND.4000B).NE.0B) 690,700
690   CALL REIO(W,O,42H   SOFT ERROR (READ/WRITE ERROR-RECOVERED),-42)
      GOTO 10 
691   FLAG=1
C 
700   IF((STRES(4).AND.2000B).NE.0B) 710,715
710   CALL REIO(W,O,38H   HARD ERROR (10 READ/WRITE FAILURES),-38)
      GOTO 10 
711   FLAG=1
C 
C IF FLAG = 1 THEN AN ERROR HAS OCCURED 
715   IF(FLAG.EQ.1) 10,720
C 
720   CALL STV(BR,1,30H   TAPE TEST SUCCESSFUL, PROCE,1,15) 
      CALL STV(BR,16,16HED TO NEXT DRIVE,1,8) 
      CALL REIO(W,O,BR,-46) 
      GOTO 90 
730   CALL REIO(W,O,2H   ,-2) 
      GOTO 90 
740   CALL REIO(W,O,2H   ,-2) 
      GOTO 90 
750   GOTO 10 
C 
9000  CONTINUE
      RETURN
      END 
                                                                                                            