Listing of file='T28D010A' on disk='vmedia/mvp-diag-2.6.2.wvd.zip'
# Sector 4583, program filename = 'T28D010A'
0010 REM DIAG-01 04/02/76 2228 FIELD SERVICE DIAGNOSTIC (B+OP 2)
: COM Q1$(2),Q1$3,Q0$2,R0$32,Q$3,R$1,R1$1,R2$1,R3$1,Q3$(4)64,Q2$12,Q4$(4)64
,T$1
0020 DIM P$1,D8$17
: INIT(0A)D8$
: STR(D8$,1,1)=HEX(01)
: GOTO 1890
0230 IF T$>HEX(0F)THEN 250
0240 PRINT "UNDEFINED ERROR"
: RETURN
0250 IF T$>HEX(1F)THEN 330
: IF T$<>HEX(10)THEN 260
: PRINT " LOOP BACK CONNECTIONS"
: IF P$<>HEX(FF)THEN 570
: RETURN
0260 E=E+1
: PRINT STR(D8$,1,8)
0270 IF T$<>HEX(11)THEN 280
: PRINT "MODEM SIGNAL ON"
0280 IF T$<>HEX(12)THEN 290
: PRINT "MODEM SIGNAL NOT ON"
0290 IF T$<>HEX(13)THEN 300
: PRINT "OTHER THAN CAR ON"
0300 IF T$<>HEX(14)THEN 310
: PRINT "LOOP BACK CLIP NOT ATTACHED"
0310 IF T$<>HEX(15)THEN 320
: PRINT "CTS NOT TIED IN"
0320 IF T$<>HEX(16)THEN 240
: PRINT "DSR NOT TIED IN"
: RETURN
0330 IF T$>HEX(2F)THEN 340
: GOTO 240
0340 IF T$>HEX(3F)THEN 440
: IF T$<>HEX(30)THEN 350
: PRINT " DATA SIGNALS AND SYNC"
: RETURN
0350 E=E+1
: PRINT STR(D8$,1,9)
0360 IF T$<>HEX(31)THEN 370
: PRINT "RRDY ON"
0370 IF T$<>HEX(33)THEN 380
: PRINT "TXE ON"
0380 IF T$<>HEX(34)THEN 390
: PRINT "TC STATUS ERROR"
0390 IF T$<>HEX(35)THEN 400
: PRINT "SYNC DETECT OR RRDY NOT ON"
0400 IF T$<>HEX(37)THEN 410
: PRINT "OFLO NOT ON"
0410 IF T$<>HEX(38)THEN 420
: PRINT "SYNC CHAR NOT FOUND"
0420 IF T$<>HEX(39)THEN 430
: PRINT "RRDY STILL ON"
0430 IF T$<>HEX(3A)THEN 240
: PRINT "TRDY NEVER CAME ON"
: RETURN
0440 IF T$>HEX(5F)THEN 500
: IF T$<>HEX(50)THEN 450
: PRINT " CLOCK"
: RETURN
0450 E=E+1
: PRINT STR(D8$,1,10)
0460 IF T$<>HEX(51)THEN 470
: PRINT "CLOCK NOT SETTING"
0470 IF T$<>HEX(52)THEN 480
: PRINT "CLEAR CLOCK NOT WORKING"
0480 IF T$<>HEX(53)THEN 490
: PRINT "TICK CLOCK SETS BEFORE MINIMUM TIME"
0490 IF T$<>HEX(54)THEN 240
: PRINT "TICK CLOCK SETS AFTER MAXIMUM TIME"
: RETURN
0500 IF T$>HEX(6F)THEN 560
: IF T$<>HEX(60)THEN 510
: PRINT " TRANSMIT/RECEIVE"
: RETURN
0510 E=E+1
: PRINT STR(D8$,1,11)
0520 IF T$<>HEX(61)THEN 530
: PRINT "EXPECTED CHAR NOT RECEIVED"
0530 IF T$<>HEX(62)THEN 540
: PRINT "RRDY/UFLO/OFLO SHOULD BE 0"
0540 IF T$<>HEX(64)THEN 550
: PRINT "RCVR OVERFLOWED"
0550 IF T$<>HEX(65)THEN 240
: PRINT "RCVR OVERLOW DID NOT OCCUR"
: RETURN
0560 IF T$>HEX(7F)THEN 630
: IF T$<>HEX(70)THEN 570
: PRINT " INTERRUPT"
: RETURN
0570 E=E+1
: PRINT STR(D8$,1,12)
0575 IF P$<>HEX(70)THEN 580
: PRINT "UNDEFINED ERROR IN INTERRUPT PROCESSING"
: PRINT HEX(010A0A);
0580 IF T$<>HEX(71)THEN 590
: PRINT "INTERRUPT OCCURRED (DISABLED)"
0590 IF T$<>HEX(72)THEN 600
: PRINT "INT. OCCURRED (INT DISABLED-TE/RE ENABLED)"
0600 IF T$<>HEX(73)THEN 610
: PRINT "NO TRDY INTERRUPT"
0610 IF T$<>HEX(75)THEN 620
: PRINT "INTERRUPT OCCURED (NO SYNC)"
0620 IF T$<>HEX(76)THEN 240
: PRINT "NO RRDY INTERRUPT"
: RETURN
0630 IF T$=HEX(FF)THEN 640
: GOSUB 230
: P$=T$
: GOTO 1200
0640 P$=T$
: L=L+1
: PRINT " T.C. TEST COMPLETE LOOP=";L;" ERRORS=";E
: PRINT HEX(01);
: GOTO 1790
1010 DEFFN'3
: PRINT HEX(03);"INTERNAL 2228 RAM TEST"
: GOSUB '0
1020 INIT(00)Q3$()
: Q3$(1)=HEX(10035F214610707EB8C42A1004C20610237CFE20C31C100000000000C20610
3E00321910CD3C10C303103EFFCD3C107CCD3C107DCD3C1078CD3C10C9D311DB01)
1030 Q3$(2)=HEX(E608CA3E10C9)
1040 STR(Q$,1,3)=STR(Q3$(1),1,3)
: GOSUB 1150
1050 PRINT "DIAGNOSTIC LOADED IN RAM"
1060 E,L=0
: STR(Q3$(1),4,1)="1"
: Q$=Q1$
: GOSUB 1150
1070 PRINT "EACH PASS TAKES ABOUT 35 SECONDS"
: PRINT "RESPONSE IS--00 DENOTES PASS"
: PRINT "FF-ERROR LOCATION-PATTERN"
1080 GOSUB 1140
: IF T$<>HEX(00)THEN 1090
: L=L+1
: PRINT "--LOOP COMPLETE=";L,"ERRORS=";E
: GOTO 1080
1090 E=E+1
: PRINT "--ERROR";E;"--LOC.=";
: GOSUB 1140
: GOSUB 1140
: PRINT " PATTERN=";
: GOSUB 1140
: PRINT
: GOTO 1080
1110 RETURN
1120 IF STR(Q2$,6,1)=HEX(00)THEN 1130
: GOSUB 1880
: STOP "NO 'ENDI' RECEIVED"
1130 IF STR(Q2$,8,1)=HEX(00)THEN 1110
: GOSUB 1880
: STOP "BAD 'RETURN' CODE"
: REM %GET A SINGLE CHARACTER
1140 INIT(00)Q2$
: $GIO/01C(8602,Q2$)
: REM /CRB,IBS
: GOSUB 1120
: T$=STR(Q2$,2,1)
: HEXPRINT T$;
: RETURN
: REM \D8SEND 'WRITE'
1150 INIT(00)Q2$
: STR(Q2$,1,3)=STR(Q$,1,3)
: Q1=VAL(STR(Q$,3,1))
: $GIO WRITE/01C(Q1$(1),Q2$)Q3$()<4,Q1>
1160 IF STR(Q2$,8,1)=HEX(00)THEN 1110
1170 STOP "ERROR ON WRITE"
: REM %SEND 'READ'
1180 INIT(00)Q2$
: STR(Q2$,1,3)=STR(Q$,1,3)
: $GIOREAD/01C(Q1$(2),Q2$)Q4$()
1190 IF STR(Q2$,8,1)=HEX(20)THEN 1110
: STOP "ERROR ON READ"
: REM %MONITOR 2228 EXECUTION
1200 GOSUB 1140
: IF T$<>HEX(DD)THEN 1230
1210 PRINT
: PRINT " A F B C D E H L 2228 REGISTERS"
1220 FOR Q=1TO 4
: GOSUB 1140
: STR(R0$,2*Q-1,1)=T$
: GOSUB 1140
: STR(R0$,2*Q,1)=T$
: PRINT " ";
: NEXT Q
: GOSUB 1140
: PRINT
: GOTO 1200
: REM \D8USER RESPONSE TO EXECUTE
1230 GOTO 630
1250 REM %KEY HEX DIGITS/MODIFY R0$
1260 Q=1
: SELECT PRINT 005(64)
1270 KEYIN R$,1280,2040
: GOTO 1270
1280 IF R$>"F"THEN 1270
: IF R$<"0"THEN 1320
: IF R$<="9"THEN 1290
: IF R$<"A"THEN 1270
1290 STR(R0$,Q,1)=R$
1300 PRINT R$;
: Q=Q+1
: IF Q<=Q1THEN 1270
1310 Q=Q-1
: PRINT HEX(08);
: GOTO 1270
1320 IF R$<>HEX(08)THEN 1330
: IF Q<2THEN 1270
: GOTO 1310
1330 IF R$<>" "THEN 1340
: R$=HEX(09)
: GOTO 1300
1340 IF R$<>HEX(0D)THEN 1270
1350 FOR Q=1 TO Q1/2
: R2$=STR(R0$,2*Q-1,1)
: IF R2$<="9"THEN 1360
: ADD(R2$,F9)
1360 ROTATE(R2$,4)
: AND (R2$,F0)
: R1$=R2$
: R2$=STR(R0$,2*Q,1)
: IF R2$<="9"THEN 1370
: ADD(R2$,F9)
1370 AND (R2$,0F)
: OR (R1$,R2$)
: STR(Q3$(1),Q+3,1)=R1$
: NEXT Q
1380 PRINT
: RETURN
1390 REM %GET ADDRESS
1400 PRINT "START ADDRESS=1000";HEX(08080808);
: Q1=4
: R0$="1000"
: GOSUB 1260
: STR(Q$,1,2)=STR(Q3$(1),4,2)
: RETURN
1420 HEXPRINT Q0$;
: PRINT " = ";
: HEXPRINT R$;
: PRINT " ";
: HEXPRINT T$;
1430 REM -- BITS LOST
: BOOL4(R$,T$)
: PRINT " ";
: HEXPRINT R$;
1440 REM ++ BITS GAINED
: R$=T$
: BOOL4(R$,R1$)
: PRINT " ";
: HEXPRINT R$;
: RETURN
1450 DEFFN'4
: GOSUB '0
: PRINT HEX(03);
: R,R1,R3,R4,R5,R7=0
1460 INPUT "TEST RAM--RANDOM=1",R
: IF R=1THEN 1480
1470 PRINT "TEST PATTERN=";
: Q1=2
: GOSUB 1260
: R3$=R1$
1480 R0$=HEX(102040)
: Q$="102040"
: INPUT "CYCLIC MEMORY=1",R1
: IF R1=1THEN 1500
1490 PRINT HEX(010A0A),,HEX(0D);
: GOSUB 1400
: R0$=Q$
: STR(R0$,3)=HEX(40)
: IF Q$<HEX(101A)THEN 1600
1500 IF R=1THEN 1570
: R1$=R3$
: GOTO 1580
1510 STR(Q$,1,3)=STR(R0$,1,3)
: INIT(R1$)Q3$()
1520 PRINT HEX(010A);"AT=";
: HEXPRINT STR(Q$,1,2);
: PRINT TAB(64)
: GOSUB 1150
1530 INIT(00)Q4$()
: GOSUB 1180
: REM CHECK RESULTS
1540 IF Q3$(1)=Q4$(1)THEN 1550
: GOSUB 1590
: REM /FIND DIFFERENCE
1550 IF R1<>1THEN 1570
: ADDC(STR(Q$,1,2),40)
1560 IF STR(Q$,1,2)<HEX(1F60)THEN 1520
: REM /TEST END ADDRESS
1570 IF R=0THEN 1580
: BIN(R1$)=INT(1+(255*RND(1)))
1580 R7=R7+1
: PRINT HEX(01);"TEST 2228 RAM*PASS=";R7;" PATTERN=";
: HEXPRINT R1$
: GOTO 1510
1590 IF STR(Q$,1,2)<>STR(Q1$,1,2)THEN 1620
: STOP "7150"
1600 PRINT HEX(010A);"SPECIFY ADDRESS GT 1019"
: GOTO 1490
1610 REM FLAG ERROR
1620 FOR Q=1 TO 64
: IF R1$=STR(Q4$(1),Q,1)THEN 1660
: STR(Q0$,1,2)=STR(Q$,1,2)
: BIN(T$)=Q
: ADDC(Q0$,T$)
1630 R4=R4+1
: PRINT HEX(010A0A0A);"LOC. T$ MEM -- ++ IN ERROR ";R4
1640 R5=R5+1
: IF R5=1THEN 1650
: PRINT HEX(0C);
: FOR Q1=1TO R5
: PRINT
: NEXT Q1
: IF R5<11THEN 1650
: R5=0
1650 R$=R1$
: T$=STR(Q4$(1),Q,1)
: GOSUB 1420
: PRINT " ON PASS=";R7
1660 NEXT Q
: RETURN
: REM %^LOAD 2228 RAM
1670 Q9=1
: GOSUB '0
: R,R1=0
1680 R0$="DIAG-01A"
: REM /MICROCODE DATA FILE NAME
1700 INPUT A
1710 DATA LOAD DC OPEN T #6,R0$
: LIMITS T#6,R0$,R4,Q,Q1
1720 DATA LOAD BA T#6,(R4,R4)Q3$()
1740 STR(Q$,1,3)=STR(Q3$(1),1,3)
: IF STR(Q$,3,1)=HEX(00)THEN 1110
: R=R+1
: PRINT "RECORD";R;" ADDR/COUNT=";
: HEXPRINT Q$;
1750 GOSUB 1150
: FOR Q=1TO 4
: Q4$(Q)=Q3$(Q)
: NEXT Q
: $GIO/01C(Q1$(2),Q2$)Q4$()<4>
: IF STR(Q2$,8,1)<>HEX(20)THEN 1190
: FOR Q=1TO 4
: IF Q4$(Q)<>Q3$(Q)THEN 1760
: NEXT Q
: PRINT " good transfer"
: GOTO 1720
1760 STOP "NON-COMPARE"
1770 DEFFN'1
: IF Q9=1THEN 1780
: GOSUB 1670
1780 PRINT "SEND 'EXECUTE' SEQUENCE"
: STR(Q3$(1),4,1)="1"
: Q$=Q1$
: GOSUB 1150
: PRINT HEX(03);
: E,L=0
: P$=HEX(FF)
1790 PRINT "WAITING FOR RESPONSE FROM 2228"
: GOTO 1200
1800 REM %'0 SEND 2228 RESET
1810 DEFFN'0
: PRINT "SENDING 2228 RESET"
1820 $GIO /01C(4580,Q2$)
: RETURN
1830 DEFFN'2
: GOSUB '0
: PRINT HEX(03);"INITIALIZE 2228 RAM"
: R,R4,R5=0
: R0$=HEX(100040)
1840 STR(Q$,1,3)=STR(R0$,1,3)
: INIT(00)Q3$()
1850 HEXPRINT STR(Q$,1,2);
: PRINT HEX(0C)
: GOSUB 1150
1860 INIT(00)Q4$()
: GOSUB 1180
1870 IF Q3$(1)<>Q4$(1)THEN 1760
: ADDC(STR(Q$,1,2),40)
: IF STR(Q$,1,2)<HEX(1FC0)THEN 1850
: GOTO 2050
1880 STOP "ERROR IN CONTROLLER RESPONSE"
1890 Q1$=HEX(101901)
: REM /LOAD FLAG ADDR.
1900 Q1$(1)=HEX(6C0042104220A2004404)
: REM /ARG1 WRITE
1960 Q1$(2)=HEX(6C01421042204230C660)
: REM /ARG1 READ
2020 SELECT #6 B20
: REM /PROGRAM DISK
2040 DEFFN'15
: SELECT PRINT 005(64),INPUT 001
: PRINT HEX(03);"2200 HARDWARE DIAGNOSTIC - 2228 --------------------------
------"
2050 PRINT "'0 RESET 2228",,"'1 START TC DIAGNOSTIC"
2060 PRINT "'2 INITIALIZE RAM","'3 INTERNAL RAM TEST"
2070 PRINT "'4 LOAD/STORE RAM TEST","'15 PROGRAM MENU"
2075 PRINT "'31 SYSTEM MENU"
2080 STOP " - KEY APPROPRIATE SPECIAL FUNCTION"
2090 DEFFN'31
: SELECT PRINT 005,INPUT 001,CI 001,CO 005
: LOAD DC T"START"