Listing of file='I54D010A' on disk='vmedia/702-0079.wvd.zip'
# Sector 828, program filename = 'I54D010A'
0010 REM - D2254A - 2254 DIAGNOSTIC A -11/12/76 10 AM DA
0030 COM A$(5)1
: DIM B$10,O$1,P$8,P1$8,Y$16,X$64,L1$31
: SELECT #104C,#204D,#304E,INPUT 001
: INIT(0A)Y$
: STR(Y$,1,1)=HEX(01)
: INIT(09)X$
: STR(X$,1,1)=HEX(00)
: FOR I=0TO 30
: BIN(STR(L1$,I+1))=I+32
: NEXT I
: INIT(00)B$
: GOTO 8010
0200 INIT(O$)P$
: Q$=HEX(8040201008040201)
: AND (P$,Q$)
: Q$=HEX(0180014001200110010801040102)
: $TRAN(P$,Q$)R
: OR (P$,30)
: RETURN
0220 SELECT INPUT 04D
: RETURN
0500 A$(4)=" "
: A$(5)="@"
0510 B$=A$(4)
: STR(B$,2)=A$(5)
: $GIOUNLLADTAD#1(443F4610462044D08601,B$)
: O$=B$
: GOSUB 200
: IF STR(P$,7)="00"THEN 520
: IF STR(P$,7)="11"THEN 530
: STOP "ERROR - MLA NOT SAME AS MTA"
0520 ADD(A$(4),01)
: ADD(A$(5),01)
: IF A$(4)<"?"THEN 510
0530 RETURN
2010 PRINT HEX(03)
: GOSUB 8000
: E,N=0
: PRINT STR(Y$,1,8);" TESTING SRQ, PARALLEL POLL FUNCTIONS:"
: PRINT "SET PP JUMPERS TO A SPECIFIC SETTING AND MAKE SURE"
: PRINT "THE CORRECT SETTING IS DISPLAYED TO THE SCREEN."
: PRINT
: PRINT
2050 $GIOTFQ#1(44A0,B$)
: $GIOPP#1(44878601,B$)
: IF STR(B$,1,1)=HEX(00)THEN 2060
: E=E+1
: PRINT STR(Y$,1,10);"PP NOT ZERO WITH SRQ OFF",,
2060 $GIOTNQ#1(44B0,B$)
: $GIOPP#1(44878601,B$)
: PRINT STR(Y$,1,12);"PARALLEL POLL =";
: A$(2)=B$
: HEXPRINT A$(2)
: N=N+1
: PRINT HEX(010A);E;" ERRORS",,"PASS";N
: KEYIN O$,8190,8190
: GOTO 2050
2110 PRINT HEX(03)
: GOSUB 8000
: E,N=0
: PRINT STR(Y$,1,8);" TESTING TAD, LAD, UNT, UNL:"
: PRINT "SET 5 BIT ADDRESS SWITCHES TO SPECIFIC SETTINGS AND MAKE SURE"
: PRINT "THE CORRECT SETTING IS DISPLAYED TO THE SCREEN."
2140 $GIOIFC#1(4586,B$)
: $GIOSTATUS#1(44D08601,B$)
: O$=B$
: GOSUB 200
: IF STR(P$,2,7)="0000100"THEN 2145
: STOP "IMPROPER STATUS AFTER IFC"
2145 $GIOUNTUNL#1(445F443F,B$)
: P=0
: FOR I=0TO 31
: BIN(B$)=I+64
: $GIOTAD#1(461044D08601,B$)
: O$=B$
: GOSUB 200
: P1$=P$
: BIN(B$)=I+32
: $GIOLAD#1(445F461044D08601,B$)
: O$=B$
: GOSUB 200
: IF STR(P1$,7,1)=STR(P$,8,1)THEN 2170
: STOP "ERROR -TALK ADDRESS DOESN'T AGREE WITH LISTEN ADDRESS"
2170 IF STR(P$,8)="0"THEN 2180
: BIN(O$)=I
: PRINT STR(Y$,1,11);TAB(1.9*I);
: HEXPRINT O$;
: PRINT TAB(64)
: P=P+1
: IF STR(P1$,8)<>STR(P$,7,1)THEN 2178
: IF STR(P1$,8)<>"0"THEN 2178
: $GIOUNL#1(443F44D08601,B$)
: O$=B$
: GOSUB 200
: IF STR(P$,7)="00"THEN 2180
2178 STOP "ERROR - UNLISTEN/UNTALK DON'T WORK"
2180 NEXT I
: IF P>0THEN 2190
: PRINT STR(Y$,1,11);" 1F; NO TALK/LISTEN ADDRESS";TAB(64)
: GOTO 2210
2190 IF P=1THEN 2210
: STOP "ERROR - MORE THAN ONE BUS ADDRESS HAS RESPONDED"
2210 N=N+1
: PRINT HEX(010A);E;" ERRORS",,"PASS";N
: KEYIN O$,8190,8190
: GOTO 2140
2310 PRINT HEX(03)
: GOSUB 8000
: E,N=0
: PRINT STR(Y$,1,8);" TESTING IFC, DEVICE CLEAR FUNCTIONS:"
2360 B$=HEX(0001)
: P$=HEX(86D0)
: $GIOIFCSTAT(A50012128601,B$)P$
: IF STR(B$,8,1)>HEX(00)THEN 2370
: STOP "IFC IS TOO SHORT"
2370 B$=HEX(0001)
: P$=HEX(86D0)
: $GIOIFCSTAT(1211A50012128601,B$)P$
: IF STR(B$,8,1)>HEX(00)THEN 2380
: STOP "IFC IS TOO SHORT"
2380 B$=HEX(0002)
: P$=HEX(86D0)
: $GIOIFCSTAT(1211A50012128601,B$)P$
: IF STR(B$,8,1)>HEX(00)THEN 2390
: STOP "IFC IS TOO SHORT"
2385 PRINT "CHANGE BUS ADDRESS SWITCH TO SOMETHING OTHER THAN 1F"
: INPUT "PRESS EXEC WHEN CHANGED",A$
2390 $GIOLISTENALL#1(A400,B$)L1$
: $GIOSTATUS#1(44D08601,B$)
: O$=B$
: GOSUB 200
: IF STR(P$,8)<>"1"THEN 2385
: $GIOIFC#1(448644D08601,B$)
: O$=B$
: GOSUB 200
: IF STR(P$,8)="0"THEN 2400
: STOP "ERROR - IFC DIDN'T CLEAR LISTENER"
2400 $GIOSRQON#1(44B0,B$)
: $IF ON #32410
2403 STOP "ERROR - SRQ NOT DETECTED AT THIRD ADDRESS"
2410 $GIOIFC#1(4486,B$)
: $IF ON #32420
: GOTO 2430
2420 STOP "ERROR - SRQ NOT TURNED OFF PROPERLY BY IFC/TFQ"
2430 $GIOSRQON#1(44B0,B$)
: $IF ON #32440
: GOTO 2403
2440 $GIOSRQOFF#1(44A0,B$)
: $IF ON #32420
: N=N+1
: PRINT HEX(010A);E;" ERRORS",,"PASS";N
: KEYIN O$,8190,8190
: GOTO 2360
2599 DEFFN'4
2610 PRINT HEX(03)
: GOSUB 8000
: E,N=0
: PRINT STR(Y$,1,8);" TESTING BUF, UNBUF, KEYIN, END:"
2630 $GIOIFC#1(4586,B$)
: GOSUB 500
: IF A$(4)<"?"THEN 2640
: INPUT "CHANGE BUS ADDRESS TO SOMETHING OTHER THAN 1F",A$
: GOTO 2610
2640 $GIOSTAT#1(44D08601,B$)
: O$=B$
: GOSUB 200
: IF P$="00000011"THEN 2650
2645 STOP "ERROR - IMPROPER STATUS WORD"
2650 $GIOTALK#1(4040,B$)
: $IF ON #1,2665
: $GIOSTAT#1(45D08601,B$)
: O$=B$
: GOSUB 200
: IF P$="00100011"THEN 2660
: STOP "ERROR - OUTPUT BUFFER DID NOT HANG ONTO CHARACTER"
2660 $IF ON #2,2665
: $GIOINP#1(8601,B$)
: IF STR(B$,1,1)="@"THEN 2670
: STOP "ERROR - WRONG CHARACTER RECEIVED"
2665 STOP "ERROR - RB IS INCORRECT"
2670 $GIOBUF#1(44F044D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"00000111"THEN 2645
: $GIOOUT#1(4041,B$)
: $IF ON #1,2680
: GOTO 2665
2680 $GIOSTAT#1(44D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"01000011"THEN 2645
: $IF ON #2,2690
: GOTO 2665
2690 GOSUB 220
: KEYIN O$,2700,2695
: SELECT INPUT 001
: GOTO 2665
2695 SELECT INPUT 001
: STOP "ERROR - ENDI RECEIVED ERRONEOUSLY"
2700 IF O$="A"THEN 2710
: STOP "ERROR - WRONG CHARACTER RECEIVED"
2710 $GIOSTAT#1(44D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"00000111"THEN 2645
: $IF ON #2,2665
: $GIOUNBUF#1(44E044D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"00000011"THEN 2645
: $GIOUNL#1(443F,B$)
2720 $GIOSTAT#1(44D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"00000110"THEN 2645
: $GIOOUT#1(404245D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"00000110"THEN 2645
: $IF ON #12730
: GOTO 2665
2730 $GIOMLA#1(A40044904042,B$)A$(4)
: $GIOSTAT#1(45D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"00100011"THEN 2645
: $IF ON #1,2665
: $IF ON #2,2665
: $GIOIN#1(C660,B$)O$
: IF STR(B$,8,1)=HEX(00)THEN 2800
2740 IF STR(B$,6,1)<>"B"THEN 2800
: $GIOBUF#1(44F0404344904044,B$)
: $GIOSTAT#1(45D08601,B$)
: O$=B$
: GOSUB 200
: IF P$<>"01100011"THEN 2645
: $IF ON #1,2665
: $IF ON #2,2750
: GOTO 2665
2750 GOSUB 220
: KEYIN O$,2760,2800
: GOTO 2665
2760 IF O$<>"C"THEN 2800
: KEYIN O$,2800,2770
: GOTO 2665
2770 SELECT INPUT 001
: N=N+1
: PRINT HEX(010A);E;" ERRORS",,"PASS";N
: KEYIN O$,8190,8190
: GOTO 2630
2800 SELECT INPUT 001
: STOP "ERROR - END OR KEYIN NOT WORKING"
: STOP "WHOOPS 7900"
7920 B$=HEX(000001)
: FOR I=0TO 255
: BIN(B$)=I
: $GIO(731012224480,B$)
: IF STR(B$,8,1)>HEX(00)THEN 7970
: PRINT "READY ";I;
: HEXPRINT STR(B$,1,1)
7970 NEXT I
: GOTO 7920
8000 GOSUB 9000
: PRINT
: PRINT
: PRINT "CONTROLLER -";A$(1)
: PRINT "PARALLEL POLL ";
: HEXPRINT A$(2)
: PRINT "RESET CAUSES IFC -";A$(3)
: RETURN
8010 PRINT HEX(03);
: GOSUB 9000
: PRINT
: PRINT
: PRINT "THIS DIAGNOSTIC WILL FUNCTIONALLY CHECK OUT MOST OF A 2254"
: PRINT " WITHOUT ANY EXTERNAL CONNECTOR OR ADDITIONAL CPU CONNECTED."
8020 PRINT
: PRINT "MOUNT THE BOARD, PREFERABLY ON AN EXTENDER, WITH NO CONNECTIONS"
: PRINT "TO THE BUS CONNECTOR. DEVICE ADDRESS MUST BE SET TO /04C."
: PRINT "WHAT CONFIGURATION DOES THE BOARD HAVE?"
: PRINT TAB(20);"C - CONTROLLER"
: PRINT TAB(20);"N - NON-CONTROLLER"
: PRINT TAB(20);"? - YOU TELL ME"
8070 A$(1)="?"
: INPUT A$(1)
: IF A$(1)="?"THEN 8110
: IF A$(1)="C"THEN 8130
: IF A$(1)<>"N"THEN 8070
8080 PRINT "NON-CONTROLLERS CANNOT BE TESTED BY THIS PROGRAM"
: PRINT "PLEASE CHANGE IT AND RE-RUN THE PROGRAM"
: END
8110 $GIOIFC#1(45C04586,B$)
: B$=HEX(0001)
: $GIOPP#1(1212448701FF8607,B$)
: IF STR(B$,8,1)=HEX(00)THEN 8130
: IF STR(B$,1,1)=HEX(00)THEN 8120
: A$(1)="N"
: GOTO 8080
8120 PRINT "THE BOARD IS NOT READY, EVEN AFTER AN IFC."
: PRINT "CHECK THAT DEVICE ADDRESS IS PROPERLY SET TO /04C."
: END
8130 A$(1)="C"
8140 IF STR(B$,7,1)=HEX(00)THEN 8150
: HEXPRINT STR(B$,7,1);
: PRINT " IS THE PARALLEL POLL RESPONSE AFTER AN IFC!!!"
: STOP "PARALLEL POLL SHOULD HAVE ALL ZEROES HERE"
: GOTO 8140
8150 $GIOSRQPPSTATHALF#1(44B04487860144D0,B$)
: A$(2)=B$
: $IF ON #1,8165
8160 L$="RESET TEST"
: PRINT " PLEASE PRESS RESET, FOLLOWED BY SF '0";
: $GIO/000(8600,B$)
: GOTO 8160
8165 STOP "BOARD DID NOT GO BUSY AFTER HALF OF A STATUS REQUEST"
: GOTO 8165
8170 DEFFN'0
: IF L$<>"RESET TEST"THEN 8150
: L$=" "
: A$(3)="Y"
: $IF ON #1,8190
: A$(3)="N"
8190 $GIOIFC#1(4586,B$)
: PRINT HEX(03)
: GOSUB 8000
: PRINT
: PRINT "THE FOLLOWING OPTIONS ARE AVAILABLE"
: PRINT "1. SRQ/PP TEST",,"4. BUF/UNBUF/EOI"
: PRINT "2. TAD/LAD",,"5. ?????"
: PRINT "3. IFC/DVC/SRQ",,"6. ?????"
8540 O$=" "
: INPUT "WHICH OPTION",O$
: IF NUM(O$)=0THEN 8540
: CONVERT O$TO O
: ON OGOTO 2010,2110,2310,2610
: GOTO 8540
8990 DEFFN'31
: LOAD DC T"START"
9000 PRINT HEX(01);"2200 HARDWARE DIAGNOSTIC TEST - IEEE INTEFACE ------------
------"
: PRINT HEX(0A0A0A0A0A0A0A0A0A0A0A0A0A0A)
: PRINT "TO DISPLAY SYSTEM MENU KEY HALT/STEP & SF'31";HEX(01)
: RETURN