FTN4,L,Q
C 
C      DATE: SEPTEMBER 10,1979
C      NAME: FTEST
C      SOURCE: 02145-18009
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 
C 
      PROGRAM FTEST(3,89), 02145-16009  REV.2001  800304
C THIS IS A FUNCTIONAL TEST OF THE L-SERIES COMPUTER SYSTEM.  IT TESTS
C THE STATUS OF THE PERIPHERALS ON THE SYSTEM AND INDICATES WHICH 
C DEVICES ARE OPERATIONAL.
      IMPLICIT INTEGER(A-Z) 
C VARIABLE MEANINGS:
C ESCSQ IS A BUFFER TO HOLD ESCAPE SEQUENCES TO SEND TO THE TERMINALS 
C PTYPE IS AN ARRAY WHICH HOLDS THE TYPE OF DEVICE FOR EACH LU #
C STRES IS A BUFFER TO HOLD SELF TEST RESULTS 
C VALUS HOLDS THE ALL THE INFORMATION NECESSARY FOR THE OUTPUT FORMATTING 
C ROUTINE (FTSMT) TO PRINT THE RESULTS TO THE LOG DEVICE
C 
      INTEGER ESCSQ(2)
      INTEGER PTYPE(64) 
      INTEGER ITYPE(64) 
      INTEGER STRES(20) 
      INTEGER LUARY(1)
      INTEGER TUFT(20)
      INTEGER FTC(20) 
      INTEGER PUFT(20)
      INTEGER IDCB(144) 
      INTEGER STARS(12) 
      INTEGER BR(40)
      INTEGER NAME(6) 
      INTEGER VALUS(64,8) 
      LOGICAL IFTTY 
      LOGICAL IFBRK 
      DATA TUFT/2H T,2HHI,2HS ,2HTE,2HRM,2HIN,2HAL,2H U,2HND,2HER,
     12H F,2HUN,2HCT,2HIO,2HNA,2HL ,2HTE,2HST/
      DATA FTC/2H F,2HUN,2HCT,2HIO,2HNA,2HL ,2HTE,2HST,2H C,2HOM, 
     12HPL,2HET,2HE ,2H P,2HAS,2HS ,2H# / 
      DATA PUFT/2H T,2HHI,2HS ,2HPR,2HIN,2HTE,2HR ,2HUN,2HDE,2HR ,
     12HFU,2HNC,2HTI,2HON,2HAL,2H T,2HES,2HT /
C RETRIEVE RUN PARAMETERS 
      NEXT=1
      OPTION=1
      CALL EXEC(14,1,STRES,-40) 
      CALL ABREG(A,B) 
      CALL NAMR(NAME,STRES,B,NEXT)
      CALL NAMR(NAME,STRES,B,NEXT)
      CALL NAMR(NAME,STRES,B,NEXT)
      IF((NAME(4).AND.3B).EQ.0) NAME(1)=LOGLU(NAME(1))
2     CALL OPENF(IDCB,IERR,NAME,OPTION,NAME(5),NAME(6)) 
      IF(IERR.EQ.-32) 5,10
5     NAME(1)=LOGLU(NAME(1))
      NAME(4)=1 
      CALL REIO(2,NAME(1),32H   OUTFILE CARTRIDGE NOT MOUNTED,-32)
      GOTO 2
C 
10    IF(IERR.EQ.-6) 15,20
15    CALL CREAT(IDCB,IERR,NAME,8,4,NAME(5),NAME(6))
      IF(IERR.LT.0) 20,2
C 
20    IF(IERR.LT.0) 25,30 
25    NAME(1)=LOGLU(NAME(1))
      NAME(4)=1 
      GOTO 2
C 
30    IF ((NAME(4).AND.3B).NE.3B) GOTO 35 
      CALL POSNT(IDCB,IERR,30000,1,1) 
35    CALL NAMR(NAME,STRES,B,NEXT)
      INDEV=NAME(1) 
      IF((INDEV.LT.0).OR.(INDEV.GT.63)) INDEV=0 
      IF(.NOT.(IFTTY(INDEV))) INDEV=0 
      CALL NAMR(NAME,STRES,B,NEXT)
      LOOPS=NAME(1) 
      IF((LOOPS.LE.0).OR.(NAME(4).NE.1)) LOOPS=1
      CALL NAMR(NAME,STRES,B,NEXT)
      LEVEL=NAME(1) 
      IF(LEVEL.NE.2) LEVEL=1
      ONCE=2
      CALL NAMR(NAME,STRES,B,NEXT)
      TESLU=NAME(1) 
      IF((TESLU.LE.0).OR.(TESLU.GT.63)) ONCE=1
C LOOP NUMBER OF TIMES SPECIFIED IN RUN PARAMATER.  DEFAULT IS ONE
  
      DO 4000 TIMES=1,LOOPS 
C INITIALIZE ARRAYS 
      DO 51 I=1,64
         PTYPE(I)=999 
         VALUS(I,2)=-2
51       CONTINUE 
      LOCK=140001B
      DOWN=-98
      VDOWN=4 
      BUSY=-99
      VBUSY=6 
      UNASG=-100
      VPASD=3 
      VFAIL=5 
      VIFAL=7 
      VALUS(64,1)=TIMES 
      VALUS(64,2)=LOOPS 
C 
C CHECK TIME BASE GENERATOR.  IF IT IS NOT WORKING, ABORT PROGRAM 
      CALL EXEC(11,STRES) 
      TEMP=STRES(1) 
      DO 55 M=1,3000
      CALL EXEC(11,STRES) 
      IF(STRES(1).EQ.TEMP) 55,56
55    CONTINUE
      CALL WRITF(IDCB,IERR,STARS,12,0)
      CALL WRITF(IDCB,IERR,36H   NO TIME BASE GENERATOR           ,18,0)
      CALL WRITF(IDCB,IERR,36H   FUNCTIONAL TEST ABORTED          ,18,0)
      CALL WRITF(IDCB,IERR,STARS,12,0)
      GOTO 5000 
C IF ONLY ONE LU BEING TESTED KLUGE AROUND THE LOOP TO TEST ONLY ONCE 
56    IF (ONCE.NE.2) GOTO 58
      DO 57 I=1,63
      VALUS(I,2)=-2 
57    PTYPE(I)=20B
      PTYPE(TESLU)=999
      LUNO=TESLU
      GOTO 59 
C FOR EACH LU # CALL FOR STATUS TO DETERMINE TYPE.  IDENTIFY DEVICE 
C AND INITIATE APPROPRIATE SELF TEST
58    DO 1000 LUNO=1,63 
C CHECK IF LU IS UNASSIGNED.  IF SO, FLAG IT AND GO ON TO THE NEXT LU # 
59    TEMP=IFBIT(LUNO)
      IF(TEMP.NE.-1) GOTO 60
      PTYPE(LUNO)=UNASG 
      VALUS(LUNO,1)=UNASG 
      VALUS(LUNO,2)=UNASG 
      GOTO 990
C CALL FOR STATUS/TYPE
60    CALL EXEC(13+100000B,LUNO,STAT1,STAT2,STAT3,STAT4)
      GOTO 990
C 
C MASK AND SHIFT STATUS TO GET DRIVER NUMBER
65    STAT=STAT1
70    STAT1=(STAT1.AND.037400B)/256 
      ITYPE(LUNO)=(STAT2.AND.037400B)/256 
      VALUS(LUNO,1)=STAT1 
      VALUS(LUNO,2)=0 
      VALUS(LUNO,8)=ITYPE(LUNO) 
C 
C IF DEVICE IS HP-IB BUS LU, MARK IT NOW
C 
      IF((ITYPE(LUNO).EQ.37B).AND.(STAT3.EQ.36B)) VALUS(LUNO,1)=11B 
C SKIP LU IF DEVICE HAS ALREADY BEEN TESTED UNDER DIFFERENT LU #
C IE SEVERAL DISC LU #'S ON ONE 7910 DRIVE
      IF(PTYPE(LUNO).LT.0) GOTO 990 
      PTYPE(LUNO)=0 
C CHECK IF DEVICE IS DOWN, IF SO FLAG IT AND GO TO NEXT DEVICE
      IF((STAT.AND.40000B).NE.40000B) GOTO 80 
         PTYPE(LUNO)=DOWN 
         VALUS(LUNO,2)=VDOWN
         GOTO 990 
C CHECK IF DEVICE IS BUSY, IF SO FLAG IT AND GO TO NEXT DEVICE
80    IF((STAT.AND.100000B).NE.100000B) GOTO 82 
         PTYPE(LUNO)=BUSY 
         VALUS(LUNO,2)=VBUSY
         GOTO 990 
C LOCK LU TO PREVENT INTERFERENCE FROM OTHER PROGRAMS.  LU'S WILL BE RELEASED 
C AT TERMINATION OF PROGRAM 
82    LUARY(1)=LUNO 
      IF(IFTTY(LUNO)) GOTO 85 
      IF(LEVEL.NE.2) GOTO 85
      CALL LURQ(LOCK,LUARY,1) 
      GOTO 990
84    CALL ABREG(A,B) 
      IF(A.EQ.0) GOTO 85
C IF A.NE.0=>LU NOT LOCKED, SOMEONE ELSE ALREADY HAS IT LOCKED  FLAG BUSY 
      PTYPE(LUNO)=BUSY
      VALUS(LUNO,1)=VBUSY 
      GOTO 990
C RESET TIME OUT SO REQUESTS DON'T GO INTO INDEFINITE SUSPENSION, RESTORE 
C THE TIME OUT AT LINE #1000
85    CALL ILUTA(ADDR)
      LUADR=ADDR+LUNO-1 
      LULOC=IGET(LUADR) 
      TOADR=LULOC+12
      TMOUT=IGET(TOADR) 
      CALL IPUT(TOADR,-76)
      PTYPE(LUNO)=STAT1 
C 
C LEVEL 2 IS SELF TEST LEVEL, IF NOT LEVEL 2 BYPASS THE SELF TESTS
      IF(LEVEL.NE.2) GOTO 984 
C DETERMINE DRIVER TYPE AND INITIATE APPROPRIATE SELF TEST
C STAT1 EQUAL TO 5B => LU IS AN INTERACTIVE TERMINAL
      IF ((STAT1.NE.5B).AND.(STAT1.NE.0B)) GOTO 110 
         ESCSQ(1)=15572B
         ESCSQ(2)=10400B
         CALL REIO(100002B,122000B+LUNO,ESCSQ,-3) 
         GOTO 990 
101      GOTO 980 
  
C STAT1 EQUAL TO 12B => LU IS A PRINTER 
110   IF(STAT1.NE.12B) GOTO 210 
         ESCSQ(1)=33B 
         ESCSQ(2)=75021B
         CALL REIO(100002B,122000B+LUNO,ESCSQ,-4) 
         GOTO 990 
201      GOTO 980 
  
C STAT1 EQUAL TO 20B=> LU IS A TAPE DRIVE ON A TERMINAL  BYPASS IT AND
C TEST THE TERMINAL, BUT FLAG THE TAPE DRIVE TO BE TESTED LATER IF
C OPERATOR HAS A SCRATCH TAPE 
210   IF(STAT1.NE.20B) GOTO 300 
      VALUS(LUNO,2)=0 
      GOTO 984
C STAT1 EQUAL TO 30B => LU IS A FLOPPY DISC 
300   IF(STAT1.NE.30B) GOTO 310 
         CALL EXEC( 2+100000B,120100B+LUNO,0B,-2,177B,0)
         GOTO 990 
301      GOTO 980 
  
C STAT1.EQ.31B=> LU IS A HARD DISC (7910) 
C STAT1.EQ.32B=> LU IS A HARD DISC (7906) 
310   IF((STAT1.NE.32B).AND.(STAT1.NE.31B)) GOTO 980
         CALL EXEC(2+100000B,120100B+LUNO,0,-1,177B,0)
         GOTO 990 
315      CALL EXEC(2+100000B,120100B+LUNO,0,0,0,0)
         GOTO 990 
320      GOTO 980 
980   CONTINUE
C CHECK FOR OTHER LU'S ON THE SAME DEVICE AND SET THEIR PTYPE 
C TO ZERO SO AS NOT TO DUPLICATE SELF TEST ON ONE DEVICE
      CALL ILUTA(ADDR)
      ADDR=ADDR.AND.77777B
      ADDR=IGET(ADDR+LUNO-1)
      ADDR=ADDR.AND.77777B
      ADDR=ADDR+2 
C ADDR NOW CONTAINS THE ADDRESS OF THE NODE LIST ENTRY FOR LUNO 
      ADCHK=IGET(ADDR)
      ADCHK=ADCHK.AND.77777B
      COUNT=1 
      FLAG=0
981   IF(ADDR.EQ.ADCHK) GOTO 984
      COUNT=COUNT+1 
      IF(COUNT.GE.32) GOTO 984
      IF(FLAG.EQ.1) GOTO 984
      FLAG=1
C  CYCLE THROUGH THE LU #S LOOKING FOR THE LU WITH THE NODE ADDRESS 
C "ADCHK", SET IT'S PTYPE TO NEGATIVE OF LUNO 
      DO 983 LUCHK=1,32 
         IF(FLAG.EQ.0) GOTO 983 
         CALL ILUTA(ADTEM)
         ADTEM=ADTEM.AND.77777B 
         ADTEM=IGET(ADTEM+LUCHK-1)
         ADTEM=ADTEM.AND.77777B 
         ADTEM=ADTEM+2
         IF(ADTEM.EQ.ADCHK) 982,983 
C SET FLAG TO STOP LOOKING FOR MATCH, IF THIS IS NOT LUNO, FLAG IT (NEG)
C IF IT IS LUNO LEAVE IT ALONE
982      FLAG=0 
         IF(ADCHK.EQ.ADDR) GOTO 983 
         ADCHK=IGET(ADTEM)
         ADCHK=ADCHK.AND.77777B 
         PTYPE(LUCHK)=0-LUNO
         IF(IFTTY(LUCHK)) GOTO 983
         LUARY(1)=LUCHK 
         CALL LURQ(LOCK,LUARY,1)
         GOTO 983 
8888     CONTINUE 
983   CONTINUE
C MATCH THE NEW ADDRESS NOW JUMP TO 984 WHEN THE CYCLE IS COMPLETE
      GOTO 981
  
984   CONTINUE
990   CONTINUE
C RESTORE TIME OUT FOR LUNO 
      CALL IPUT(TOADR,TMOUT)
      IF (ONCE.EQ.2) GOTO 1001
  
1000  CONTINUE
C 
C*******************************************************
C ALL DEVICES NOW SELF TESTING
C SUSPEND FOR 10 SECONDS THEN CHECK SELF TEST RESULTS 
C PROGRAM SUSPENDED ONLY FOR LEVEL 2
C*******************************************************
C 
1001  IF(LEVEL.NE.2) GOTO 1020
      CALL EXEC(12+100000B,0,2,0,-10) 
      GOTO 2000 
  
C CYCLE THROUGH THE LU'S NOW PICKING UP AND REPORTING RESULTS 
1020  DO 2000 LUNO=1,63 
      CALL EXEC(100000B+13,LUNO,TEMP1,TEMP2)
      GOTO 2000 
C IF DEVICE IS BUSY, WRITE BUSY MESSAGE AND GOTO NEXT DEVICE
1022  IF(PTYPE(LUNO).NE.BUSY) GOTO 1033 
         VALUS(LUNO,2)=VBUSY
         GOTO 1995
C IF DEVICE IS DOWN, WRITE DOWN MESSAGE AND GOTO NEXT DEVICE
1033  IF(PTYPE(LUNO).NE.DOWN) GOTO 1035 
         VALUS(LUNO,2)=VDOWN
         GOTO 1995
C 
C IF DEVICE IS UNASSIGNED, WRITE UNASG MESSAGE AND GOTO NEXT
1035  IF(PTYPE(LUNO).NE.UNASG) GOTO 1040
      GOTO 1995 
C 
1040  IF(PTYPE(LUNO).LT.0) GOTO 2000
      IF(LUNO.NE.OTDEV) GOTO 1050 
      CALL EXEC(12+100000B,0,2,0,-2)
      GOTO 1990 
1050  DO 1080 I=1,5 
1080  STRES(I)=177777B
  
C STORE THE TIME-OUT FOR LUNO AND REPLACE IT WITH .5 SECONDS.  IF THE 
C DEVICE IS NOT THERE OR HAS A HAREWARE PROBLEM IT WILL TIME OUT
C QUICKLY.  RESTORE THE TIME-OUT AFTER CHECKING SELF TEST RESULTS 
      CALL ILUTA(ADDR)
      LUADR=ADDR+LUNO-1 
      LULOC=IGET(LUADR) 
      TOADR=LULOC+12
      TMOUT=IGET(TOADR) 
      CALL IPUT(TOADR,-76)
C PTYPE=5=>2645I75 TERMINAL 0=>2621 TERMINAL
      IF((PTYPE(LUNO).NE.5).AND.(PTYPE(LUNO).NE.0)) GOTO 1206 
         ESCSQ(1)=15536B
         ESCSQ(2)=10400B
         IF(LEVEL.EQ.1) 1150,1190 
1150     CALL REIO(100002B,20000B+LUNO,2H  ,-2) 
         GOTO 1204
1151     CALL REIO(100002B,20000B+LUNO,TUFT,-36)
         GOTO 1204
1155     CALL CNUMD(TIMES,FTC(18))
1160     CALL REIO(100002B,20000B+LUNO,FTC,-40) 
         GOTO 1204
1165     CALL REIO(100002B,20000B+LUNO,2H  ,-2) 
         GOTO 1204
1170     CALL EXEC(12,0,2,0,-1) 
C CALL FOR TEST RESULTS 
1190     CALL EXEC(100002B,120100B+LUNO,ESCSQ,-2,0) 
         GOTO 1990
1191     CALL EXEC(100001B,120000B+LUNO,STRES,-10,0,ESCSQ(2)) 
         GOTO 1990
1192     CALL REIO(100002B,20000B+LUNO,2H  ,-2) 
         GOTO 1990
C CHECK TO SEE THAT FIRST WORD IS "CR/", REMAINING BYTES BEGIN WITH "0011"
1201     IF(STRES(1).NE.15534B) GOTO 1204 
         DO 1202 I=2,4
            IF((STRES(I).AND.170360B).NE.30060B) GOTO 1204
1202        CONTINUE
         IF((STRES(5).AND.170000B).NE.30000B) GOTO 1204 
C SELF TEST RESULT IS BIT 1 OF WORD 4 AND SHOULD BE SET 
         IF(((STRES(4).AND.13B).NE.2B).AND.(LEVEL.EQ.2)) GOTO 1204
         VALUS(LUNO,2)=VPASD
         GOTO 1995
C 
1204     VALUS(LUNO,2)=VFAIL
1203     GOTO 1600
C 
C PTYPE.EQ.12=>PRINTER ITYPE.EQ.00=>ASIC INTERFACE
1206  IF((PTYPE(LUNO).NE.12B).OR.(ITYPE(LUNO).NE.0B)) GOTO 1210 
         ESCSQ(1)=33B 
         ESCSQ(2)=57021B
         IF(LEVEL.EQ.1) 1207,1208 
1207     CALL REIO(100002B,20000B+LUNO,2H  ,-2) 
         GOTO 1240
8000     CALL REIO(100002B,20000B+LUNO,PUFT,-36)
         GOTO 1240
8001     CALL REIO(100002B,20000B+LUNO,FTC,-26) 
         GOTO 1240
8002     CALL REIO(100002B,20000B+LUNO,2H  ,-2) 
         GOTO 1240
C CALL FOR TEST RESULTS 
1208     CALL EXEC(100001B,32000B+LUNO,STRES,-10,ESCSQ,-4)
         GOTO 1990
C JUMP TO PRINTER VERIFY IN HP-IB PRINTER TEST SECTION
8003     GOTO 1216
C 
C PTYPE.EQ.12=>PRINTER ITYPE.EQ.37=>HP-IB INTERFACE 
C SAME EVENTS AS FOR TERMINAL, SAME RESULTS RETURNED
1210  IF((PTYPE(LUNO).NE.12B).OR.(ITYPE(LUNO).NE.37B)) GOTO 1260
      IF(LEVEL.EQ.1) 1211,1214
1211  CALL REIO(100002B,20000B+LUNO,2H  ,-2)
      GOTO 1240 
8004  CALL REIO(100002B,20000B+LUNO,PUFT,-36) 
       GOTO 1240
8005  CALL REIO(100002B,20000B+LUNO,FTC,-26)
      GOTO 1240 
8006  CALL REIO(100002B,20000B+LUNO,2H  ,-2)
      GOTO 1240 
8007  CALL EXEC(12+100000B,0,2,0,-1)
      GOTO 1990 
1214     CALL EXEC(100002B,122000B+LUNO,3000B,-1,142B)
         GOTO 1990
1215     CALL EXEC(100001B,122000B+LUNO,STRES,-10,140B) 
         GOTO 1990
1216  DO 1220 I=2,4 
         IF((STRES(I).AND.170360B).NE.30060B) GOTO 1240 
1220     CONTINUE 
         IF(STRES(5).NE.6400B) GOTO 1240
         IF(((STRES(4).AND.2B).NE.2B).AND.(LEVEL.EQ.2)) GOTO 1204 
         VALUS(LUNO,2)=VPASD
         DO 1230 LUTEM=1,32 
         IF(PTYPE(LUTEM).NE.(0-LUNO)) GOTO 1230 
            VALUS(LUTEM,2)=VPASD
            VALUS(LUTEM,1)=VALUS(LUNO,1)
            LUARY(1)=LUTEM
            CALL LURQ(40000B,LUARY,1) 
            GOTO 1230 
8889        CONTINUE
1230     CONTINUE 
         GOTO 1995
C 
1240  VALUS(LUNO,2)=VFAIL 
1250  GOTO 1600 
C 
1260  IF(PTYPE(LUNO).EQ.20B) GOTO 2000
C 
C PTYPE.EQ.30=>FLOPPY DISC
1310  IF(PTYPE(LUNO).NE.30B) GOTO 1410
      IF(LEVEL.EQ.1)1311,1312 
1311  CALL TXDSC(LUNO,ERR,VALUS)
      GOTO 1995 
C 
1316  GOTO 1313 
C CALL FOR SELF TEST RESULTS, THEN CLEAR DEVICE 
1312    CALL EXEC(100001B,120100B+LUNO,STRES,-2,177B,0) 
        GOTO 1316 
C CHECK FOR TWO BYTES SENT, BOTH 0
1313    CALL ABREG(A,B) 
1315    CALL EXEC(100001B,120000B+LUNO,TEMP,-1,160B,0)
        GOTO 1990 
1320    IF(B.NE.2) GOTO 1340
        IF(STRES(1).NE.0) GOTO 1340 
        VALUS(LUNO,2)=VPASD 
        DO 1330 LUTEM=1,32
           IF(PTYPE(LUTEM).NE.(0-LUNO)) GOTO 1330 
            VALUS(LUTEM,2)=VPASD
            VALUS(LUTEM,1)=VALUS(LUNO,1)
           LUARY(1)=LUTEM 
            CALL LURQ(40000B,LUARY,1) 
           GOTO 1330
8890       CONTINUE 
1330  CONTINUE
        GOTO 1995 
C 
1340    VALUS(LUNO,2)=VFAIL 
        DO 1347 LUTEM=1,32
            IF(PTYPE(LUTEM).NE.(0-LUNO)) GOTO 1347
            VALUS(LUTEM,2)=VFAIL
            VALUS(LUTEM,1)=VALUS(LUNO,1)
            LUARY(1)=LUTEM
            CALL LURQ(40000B,LUARY,1) 
            GOTO 1347 
8891        CONTINUE
1347    CONTINUE
1350    GOTO 1995 
C 
C PTYPE.EQ.31B=> LU IS A HARD DISC (7910) 
C PTYPE.EQ.32B=> LU IS A HARD DISC (7906) 
1410    IF((PTYPE(LUNO).NE.32B).AND.(PTYPE(LUNO).NE.31B)) GOTO 1500 
        IF(LEVEL.EQ.1)1411,1415 
1411    CALL TXDSC(LUNO,ERR,VALUS)
        GOTO 1995 
C 
C READ SELF TEST RESULTS
1415       CALL EXEC(100001B,120100B+LUNO,STRES,-1,177B,0)
           GOTO 1990
C CHECK TRANSMISSION LOG, B REGISTER SHOULD BE 1
1420       CALL ABREG(A,B)
           IF(B.NE.1) GOTO 1440 
C CHECK RETURNED RESULTS, SHOULD BE 0 IF SELF TEST PASSED 
           IF(STRES(1).NE.0) GOTO 1440
           VALUS(LUNO,2)=VPASD
           DO 1430 LUTEM=1,32 
              IF(PTYPE(LUTEM).NE.(0-LUNO)) GOTO 1430
              VALUS(LUTEM,2)=VPASD
              VALUS(LUTEM,1)=VALUS(LUNO,1)
              LUARY(1)=LUTEM
              CALL LURQ(40000B,LUARY,1) 
              GOTO 1430 
8892          CONTINUE
1430       CONTINUE 
           GOTO 1995
C 
1440  VALUS(LUNO,2)=VFAIL 
      DO 1447 LUTEM=1,32
         IF(PTYPE(LUTEM).NE.(0-LUNO)) GOTO 1447 
            VALUS(LUTEM,2)=VFAIL
            VALUS(LUTEM,1)=VALUS(LUNO,1)
            LUARY(1)=LUTEM
            CALL LURQ(40000B,LUARY,1) 
            GOTO 1447 
8893        CONTINUE
1447     CONTINUE 
1450  GOTO 1995 
C 
C IF ITYPE IS 37, CALL STATUS, CHECK IF STAT3.EQ.36=>LU IS HP-IB BUS LU 
1500  IF(ITYPE(LUNO).NE.37B) GOTO 1580
         CALL EXEC(100000B+13,LUNO,STAT1,STAT2,STAT3,STAT4) 
         GOTO 1990
1505     IF((STAT3.AND.37B).NE.36B) GOTO 1580 
         VALUS(LUNO,1)=11B
C LU IS THE HP-IB BUS.  CHECK THAT IT HAS A NON-ZERO STATUS 
         CALL ILUTA(ADDR) 
         ADDR=IGET(ADDR+LUNO-1) 
         CALL EXEC(100003B,120600B+LUNO)
         GOTO 1990
1510     STATS=IGET(ADDR+17)
         IF(STATS.EQ.0) GOTO 1560 
         VALUS(LUNO,2)=VPASD
         GOTO 1995
C 
1560     VALUS(LUNO,2)=VFAIL
         GOTO 1995
C AT THIS POINT THE DEVICE IS UNDEFINED, THEREFORE UNTESTED 
1580  CONTINUE
C 
C TEST INTERFACE CARD IF LU IS AN ASIC DEVICE OR A GPIO DEVICE
1600  IF(ITYPE(LUNO).EQ.37B) GOTO 1995
      IF(ITYPE(LUNO).EQ.50B) 1700,1800
C 
C GPIO TEST SECTION 
1700  CALL ILUTA(ADDR)
      ADDR=IGET(ADDR+LUNO-1)
      CALL EXEC(100003B,120600B+LUNO) 
      GOTO 1990 
1710  RSLT1=IGET(ADDR+17) 
C RSLT1 SHOULD BE NON-ZERO.  A ZERO STATUS IMPLIES THERE IS NO CARD IN
C THE CARD CAGE.  NO DEVICE IS NECESSARY TO PERFORM THIS TEST 
      IF (RSLT1 .EQ. 0B) 1720,1730
1720  VALUS(LUNO,2)=VIFAL 
      GOTO 1995 
C 
1730  VALUS(LUNO,2)=VFAIL 
      GOTO 1995 
C 
C ASIC TEST SECTION 
1800  CALL ILUTA(ADDR)
      ADDR=IGET(ADDR+LUNO-1)
      STATS=IGET(ADDR+17) 
      IF((STATS.AND.177774B).EQ.0B) GOTO 1890 
      VALUS(LUNO,2)=VFAIL 
      GOTO 1995 
C 
1890  VALUS(LUNO,2)=VIFAL 
      GOTO 1995 
C 
1985  GOTO 2000 
1990  CONTINUE
C 
1995  LUARY(1)=LUNO 
      CALL LURQ(40000B,LUARY,1) 
      GOTO 1985 
2000  CALL IPUT(TOADR,TMOUT)
C 
C CALL TAPE TEST IF OPERATOR WANTS TO.
3000  IF(INDEV.EQ.0) GOTO 3900
      CALL STV  (BR  ,1,36H   INITIATE TAPE TEST?   REQUIRES SC  ,1,18) 
      CALL STV(BR,19,38HRATCH TAPE WHICH   WILL BE WRITTEN OVE,1,19)
      CALL STV  (BR  ,38,8HR (Y/N) ,1,4)
      CALL REIO(100002B,INDEV+20000B,BR,-52)
      GOTO 3900 
3005  CALL REIO(100002B,INDEV+20000B,BR(27),-30)
      GOTO 3900 
3010  CALL REIO(100001B,INDEV+400B,STRES,-4)
      GOTO 3900 
3011  STRES(1)=STRES(1).AND.177400B 
      IF(STRES(1).EQ.(2HY .AND.177400B))3020,3030 
3020  CALL TXCTU(INDEV) 
      GOTO 3900 
C 
3030  IF(STRES(1).EQ.(2HN .AND.177400B))3900,3040 
3040  CALL REIO(100002B,INDEV+20000B,4H    ,-4) 
      GOTO 3010 
3041  GOTO 3010 
C 
3900  CALL FTSMT(IDCB,VALUS)
C 
C IF BREAK BIT IS SET, JUMP OUT OF OUTER LOOP AND QUIT PROGRAM
      IF(IFBRK(IDUMY)) GOTO 5000
C 
4000  CONTINUE
5000  CONTINUE
      CALL CLOSE(IDCB)
  
      CALL EXEC(6)
      END 
                                                      