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