Listing of file='MULTIDSK' on disk='vmedia/mvp-diag-2.6.2.wvd.zip'
# Sector 2412, program filename = 'MULTIDSK'
0010 REM % MULTIDSK
: REM This is MULTIDSK written by Ken LeBaron,
0020 REM \D5\F0\E4\E1\F4\E5\F3; 10/01/81, 08/12/83 by Paul J. Hossfeld - impro
ved screening, 04/01/84 Corrected read and write count
0030 REM %
0040 DIM A(35),A$(48)3,A1(70),A1$(70)8,A2$8,B$2,B$(64)4,B1$(64)4,B2$(64)4,B3$(
64)4,C$1,C1$2,C2$2,C(24),D$(70)3,E(70),E1(35),E2(35),E$5,E$(70)7,F$(35)6,
G,H$1,H1,H2(1),I1,I2,I3,I4,I5,M$1,M$(70)8,P$10,P1$7,P2$(2)7,R,R$(70)1,S(7
0),S$5,T$(70)3,V(35),X,Y,Z,Z1,Z2
0050 INIT (20)P1$,P2$
0060 DIM I$(10)80,I1$(70)3,V$(70)3,F1$(70)3,M1$22,P9$3,E9(1)
: INIT (" no")I1$()
: P9$="off"
: P,E9=0
0070 REM %
: REM NO. OF LINES ON THE SCREEN FOR THE DEVICE LIST
: D=17
: REM %
: REM MAXIUM NUMBER OF LINES TO PRINT ON PRINTER
: P1=500
0080 INIT(00)B$,C$,C1$,C2$,E$,F$(),M$,P$,P1$,R$,S$,A$(),A1$(),B$(),B1$(),B2$()
,B3$(),D$(),E$(),I$(),M$(),R$(),T$()
0090 A$()="310B10D10D11D12D13D14D15320B20D20D21D22D23D24D25330B30D30D31D32D33D
34D35350B50D50D51D52D53D54D55360B60D60D61D62D63D64D65370B70D70D71D72D73D7
4D75"
: I,Z=5
: SELECT PRINT 005(80)
0100 REM % First page
: PRINT HEX(0306);AT(0,20);" Multi-Disk Exerciser (Rev. 6441)";AT(1,19
);BOX(0,33)
0110 P$=$PSTAT(1)
: IF STR(P$,10)>=HEX(18)AND STR(P$,9,1)="M"THEN 120
: IF STR(P$,9,1)="V"AND STR(P$,10)>=HEX(21)THEN 120
: PRINT HEX(0E);AT(12,15);"CPU SOFTWARE MUST BE UPGRADED TO RUN THIS PROGRA
M.";
: GOTO 110
0120 PRINT AT(12,20,62);"Mount all platters to be tested"
: GOSUB 7010
: PRINT AT(23,38,41);
0130 PRINT AT(22,8,32);HEX(06);" RETURN/RUN to continue";
: KEYIN C$,,140
: IF C$=HEX(81) THEN 7150
: IF C$<>HEX(0D) AND C$<>HEX(82) THEN 130
: GOTO 160
0140 IF C$=HEX(42) OR C$=HEX(52) THEN 7150
: IF C$<>HEX(01) THEN 130
: GOSUB 2380
0150 GOSUB 7130
: IF E9<>3 THEN 150
: GOTO 10
0160 REM % Start search for drives
: PRINT HEX(03); AT(12,25); "please wait."
: I=1
0170 FOR I3=1TO 142STEP 3
: D$(I)=STR(A$(),I3,3)
: SELECT #2<D$(I)>
: $OPEN 390,#2
: ERRORX=ERR
: GOTO 390
0180 PRINT AT(12,38);" SEARCHING "
: $GIO SEARCH FOR VALID DEVICES #2(0100 020D 1200 1212 1020 1200 1212 0B00
70A0 4100 860B,R$)
: ERRORX=ERR
: GOTO 390
0190 REM % List of devices
: IF STR(R$,8,1)=HEX(10)THEN 390
: R$(I)=STR(R$,11,1)
0200 E(I)=65407
: M$(I)="Q2040"
: GOSUB 340
0210 E(I)=52607
: M$(I)="2280"
: GOSUB 340
0215 E(I)=38911
: M$(I)="2275"
: GOSUB 340
0220 E(I)=32639
: M$(I)="1004"
: GOSUB 340
0230 E(I)=19583
: M$(I)="2260"
: GOSUB 340
0240 E(I)=16319
: M$(I)="1002"
: GOSUB 340
0250 E(I)=9791
: M$(I)="2230-1"
: GOSUB 340
0260 E(I)=8127
: M$(I)="1000"
: GOSUB 340
0270 E(I)=4799
: M$(I)="2260-1/2"
: GOSUB 340
0280 E(I)=3873
: M$(I)="850 DSDD"
: GOSUB 340
0290 E(I)=2399
: M$(I)="2260-1/4"
: GOSUB 340
0295 E(I)=1279
: M$(I)="2275"
: GOSUB 340
0300 E(I)=1231
: M$(I)="2270a"
: GOSUB 340
0310 E(I)=1023
: M$(I)="2270"
: GOSUB 340
0320 E(I)=0
: M$(I)="UNKNOWN"
: GOSUB 340
0330 GOTO 390
0340 IF R$(I)=HEX(D0)AND STR(D$(I),,1)="D"THEN 350
: IF R$(I)=HEX(C0)AND STR(D$(I),,1)<>"D"THEN 360
: RETURN CLEAR
: GOTO 390
0350 IF M$(I)="2280"THEN 370
: IF STR(D$(I),2,1)>"3" THEN RETURN
: IF STR(M$(I),,3)="100" THEN 370
: IF M$(I)="850 DSDD" THEN 370
: IF M$(I)="Q2040" THEN 370
: IF M$(I)="2275" THEN 370
: RETURN
0360 IF R$(I)=HEX(C0) AND M$(I)="2275" THEN RETURN
0365 IF E(I)>1231THEN 370
: IF STR(D$(I),,1)="3"THEN 370
: IF STR(D$(I),,1)="B"AND STR(D$(I),2,1)<=HEX(33)THEN 370
: RETURN CLEAR
: GOTO 390
0370 PRINT AT(12,38);" searching"
: X=0
: VERIFY T#2,(E(I),E(I))E
: IF E=0THEN 380
: X=ERR
: IF X<>93AND X<>95AND X<>96THEN RETURN
0380 RETURN CLEAR
: STR(E$(I),,7)="I- on"
: CONVERT XTO STR(E$(I),3,2),(##)
: IF X=0THEN E$(I)=" "
: A1$(I)="infinite"
: V$(I),F1$(I),I1$(I),T$(I)=" no"
: S(I)=0
: I=I+1
0390 NEXT I3
: FOR I3=1 TO 48
: IF M$(I3)<>"850 DSDD" THEN 395
: SELECT #2<D$(I3)>
: $GIO RESET #2(4501)
0395 NEXT I3
: I4=I-1
: IF I4<=34 THEN 400
: PRINT AT(15,22); "More than 35 devices mounted"; AT(16,12); " MULTIDS
K can control only 34 devices at one time"
: GOTO 120
0400 I,I3=I4
: I1=1
: I2=I3
: E9=0
: IF I>D THEN I2=D
: GOTO 460
0410 REM Restore data for chart
: X=0
: FOR G=1 TO I4
: SELECT #2<D$(G)>
: $GIO RESET #2(4501)
: IF T$(G+35)=" no" THEN 420
: X=X+1
: I1$(G+35)=I1$(X)
0420 NEXT G
0430 FOR G=1 TO I4
: I=G+35
: GOSUB 900
: NEXT G
: GOTO 400
0440 DEFFN '0
: IF I4<=D THEN RETURN
: IF I1=1 THEN I1=D+1
: ELSE I1=1
: IF I1=1 THEN I2=D
: ELSE I2=I4
: G=2
: RETURN
0450 GOSUB 440
0460 GOSUB 470
: GOTO 570
0470 REM % Print table
: G=I
: PRINT HEX(03);" ";AT(1,0);" Test Frmt Init Ver Address
Model Sector Range Accesses"
: FOR I=I1TO I2
0480 IF I2<>0THEN 490
: D$(I),M$(I)="N/A"
: S(I),E(I)=0
: T$(I),E$(I)=" "
0490 PRINT AT((I-I1)+2,3);HEX(06); " ";
: PRINTUSING 500, T$(I),F1$(I),I1$(I),V$(I),E$(I),D$(I),M$(I),S(I),E(I),A1$
(I);""
0500 %### ### ### ### ####### ### ######## #####/##### ########
0510 NEXT I
0520 PRINT AT(1,1); BOX(1,75); AT(2,1); BOX(I-I1+1,75); AT(2,7); BOX(I-I1+1,0)
; AT(2,13);BOX(I-I1+1,0); AT(2,19); BOX(I-I1+1,0); AT(2,25); BOX(I-I1+1,0
); AT(2,39); BOX(I-I1+1,0);AT(2,50);BOX(I-I1+1,0);AT(2,65);BOX(I-I1+1,0)
0530 GOSUB 7010
: IF I3>0THEN 540
: PRINT HEX(07); AT(20,0,79); AT(20,20); " PROGRAM ABORTED. NO DISKS
RESPONDING "
: GOSUB 7120
: GOTO 530
0540 $CLOSE
: I=I1
: C1$=" "
: I=G
0550 IF I4>D AND E9<>1 THEN PRINT " ";AT(23,55); ", SF'0 - more devices"
; AT(0,67); "( More)";
: GOTO 7100
0560 REM % wait to return screen
: GOSUB 7130
: IF E9<>3 THEN 560
: E9=0
: GOTO 400
0570 REM % Parameters correct???
: GOSUB 7010
: C$="N"
: PRINT AT(20,0,79); AT(20,20);"Are all the above parameters correct?";"
"; AT(22,8,49); "Y/CONT/CTNUE for 'yes' or N for 'no'";
: GOSUB 550
: GOSUB 7120
: IF G=1 THEN 10
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
0580 ON POS("YyNn"=C$)GOTO 910,910,590,590
: IF C$=HEX(84) THEN 910
: GOTO 570
0590 REM % ***SET PARAMETERS***
: I=I1
: PRINT AT(20,20,59)
0600 REM %#1
: R=I-(I1-1)+1
: Y=3
: I5=3
: A2$=T$(I)
: GOSUB 7190
: ON POS("YyNn"=STR(A2$,1,1))GOTO 610,610,620,620
: ON POS(" N n"=STR(A2$,1,2))GOTO 620,620
: GOTO 600
0610 T$(I)="yes"
: GOTO 630
0620 T$(I)=" no"
0630 PRINT AT(I-(I1-1)+1 ,3);" "; T$(I)
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,650,640,600,600
0640 G1=4
: GOSUB 7370
: GOTO 830
0650 REM %#2
: R=I-(I1-1)+1
: Y=9
: I5=3
: A2$=F1$(I)
: GOSUB 7190
: IF STR(A2$,1,1)="Y" OR STR(A2$,1,1)="y" THEN F1$(I)="yes"
: IF STR(A2$,1,1)="N" OR STR(A2$,1,1)="n" OR STR(A2$,1,2)=" N" OR STR(A2$,1
,2)=" n" THEN F1$(I)=" no"
0660 PRINT AT(I-(I1-1)+1,9);" "; F1$(I)
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,670,600,650,650
0670 REM %#3
: R=I-(I1-1)+1
: Y=15
: I5=3
: A2$=I1$(I)
: GOSUB 7190
: IF STR(A2$,1,1)="Y" OR STR(A2$,1,1)="y" THEN I1$(I)="yes"
: IF STR(A2$,1,1)="N" OR STR(A2$,1,1)="n" OR STR(A2$,1,2)=" N" OR STR(A2$,1
,2)=" n" THEN I1$(I)=" no"
0680 PRINT AT(I-(I1-1)+1,15);" "; I1$(I)
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,690,650,670,670
0690 REM %#4
: R=I-(I1-1)+1
: Y=21
: I5=3
: A2$=V$(I)
: GOSUB 7190
: IF STR(A2$,1,1)="Y" OR STR(A2$,1,1)="y" THEN V$(I)="yes"
: IF STR(A2$,1,1)="N" OR STR(A2$,1,1)="n" OR STR(A2$,1,2)=" N" OR STR(A2$,1
,2)=" n" THEN V$(I)=" no"
0700 PRINT AT(I-(I1-1)+1,21);" "; V$(I)
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,710,670,690,690
0710 REM %#5
: H2=0
: A2$=D$(I)
: I5=3
: R=I-(I1-1)+1
: Y=35
: GOSUB 7190
: FOR H1=1 TO 3
: H$=STR(A2$,H1,1)
: GOSUB 720
: NEXT H1
: IF H2 = 1 THEN GOTO 710
: D$(I)=A2$
: GOTO 740
0720 CONVERT H$ TO H
: ERRORX=ERR
: IF H$<"A" OR H$>"F" THEN H2=1
0730 RETURN
0740 SELECT #2<D$(I)>
: $GIO CHECK FOR VALID ADDRESS #2(0100 020D 1212 1020 1212 0B00 70A0 4100 8
60B 4501,R$)
: ERRORX=ERR
: GOTO 710
0750 IF STR(R$,8,1)=HEX(10)THEN 710
: R$(I)=STR(R$,11,1)
0760 GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,770,690,710,710
0770 REM %#6
: A2$=M$(I)
: I5=8
: R=I-(I1-1)+1
: Y=41
: GOSUB 7190
: M$(I)=A2$
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,790,710,770,770
0780 REM %#7
: PRINT AT(20,22); " 'Sector range must be greater than 8'"
0790 CONVERT S(I)TO A2$,(#####)
: I5=5
: R=I-(I1-1)+1
: Y=52
: GOSUB 7190
: S$=A2$
: CONVERT S$TO S(I)
: ERRORX=ERR
: GOTO 790
0800 IF G1=0 OR G1=2 AND G<>1 AND G<>2 THEN 810
: IF S(I)+7>E(I) THEN 790
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,810,770,790,790
0810 REM %#8
: CONVERT E(I)TO A2$,(#####)
: R=I-(I1-1)+1
: Y=58
: I5=5
: GOSUB 7190
: E$=A2$
: CONVERT E$TO E(I)
: ERRORX=ERR
: GOTO 810
0820 IF G1=3 THEN 790
: IF S(I)+7>E(I) THEN 780
: GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,830,790,810,810
0830 PRINT AT(20,0,79)
: REM %#9
: IF A1$(I)<>"infinite" THEN CONVERT A1(I)TO A1$(I),(########)
0840 IF A1$(I)="INFINITE" THEN A1$(I)="infinite"
0850 R=I-(I1-1)+1
: Y=67
: I5=8
: A2$=A1$(I)
: GOSUB 7190
: A1$(I)=A2$
: IF A1$(I)="INFINITE" THEN A1$(I)="infinite"
: IF A1$(I)="infinite" THEN 880
: CONVERT A1$(I)TO A1(I)
: ERRORX=ERR
: GOTO 830
0860 CONVERT A1(I) TO A1$(I),(########)
0870 IF A1(I)<8THEN 830
: REM CLEAR PREV MESSAGE (LINE 1030)
: PRINT AT(20,0,79)
0880 GOSUB 7370
: IF G=1 THEN 570
: IF G=2 AND I4>D THEN 450
: IF E9<>0 THEN 560
: ON G1 GOTO 600,890,810,830,830
0890 G1=1
: GOSUB 7370
: GOTO 600
0900 REM Used to save data for initial screen
: A1(G)=A1(I)
: A1$(G)=A1$(I)
: E(G)=E(I)
: S(G)=S(I)
: M$(G)=M$(I)
: D$(G)=D$(I)
: E$(G)=E$(I)
: R$(G)=R$(I)
: T$(G)=T$(I)
: I1$(G)=I1$(I)
: V$(G)=V$(I)
: RETURN
0910 REM % ***FORMAT***
: REM Get and/or check the password
: PRINT AT(23,45,34);
: GOSUB 550
: GOSUB 7400
: IF E9<>0 THEN 920
: IF G=1 THEN 570
: I=1
: IF G<>2 THEN 930
: GOSUB 440
: GOSUB 470
: GOTO 910
0920 GOSUB 7130
: IF E9<>3 THEN 920
: E9=0
: GOSUB 470
: GOTO 910
0930 IF T$(I)=" no" OR F1$(I)=" no" THEN 990
0940 PRINT AT(20,20,);"Formatting device ";D$(I);"";
: SELECT #2<D$(I)>
: PRINT " "; AT(22,1); "CHECK: to ensure that the device is formatting
and the system isn't hung"
0950 $FORMATDISK T#2
: ERRORX=ERR
: IF X<>92THEN 980
: PRINT AT(20,20,59); "Press the format button for ";D$(I);""; AT(22,1,78
); "Press: CONT when the format is completted"
: GOTO 970
0960 GOTO 980
0970 GOSUB 7120
: PRINT AT(20,20,)
: IF G=1 THEN 570
: IF E9<>0 THEN 920
: IF C$<>HEX(84) THEN 970
0980 DATA LOAD BA T#2,(E(I))B$()
: ERRORX=ERR
: CONVERT I TO C1$,(##)
: PRINT AT(20,20,59);" ";
: IF X=93THEN PRINT "Device #"; D$(I); " still has a format error";
: ELSE PRINT "ERROR I-";X;" on DEVICE #";D$(I);""
: GOSUB 7010
: GOSUB '50
: GOTO 570
0990 E$(I)=" "
: I=I+1
: IF I<=I4 THEN 930
1000 REM % ***SET PARAMETERS***
: I=1
: PRINT AT(20,20,59)
1010 I1=0
: FOR I=1TO I3
: G=I+35
: GOSUB 900
: IF T$(I)<>"yes"THEN 1020
: I1=I1+1
: G=I1
: GOSUB 900
: F$(G)="----"
1020 NEXT I
: I3=I1
: Z1=1
: Z2=I3
: IF I3>D THEN Z2=D
1030 IF I3<>0THEN 1050
1040 REM % Parameter error
: PRINT AT(20,15,64);" RECHECK PERAMETERS, NO DEVICES ARE SELECTED"
: GOSUB 7010
: GOSUB '50
: GOTO 400
1050 REM % ***START TEST***
1060 Z=1
: S=RND(0)
: REM For testing; IF STR(P$,9,1)="V"THEN 1130; GOTO 1130; $RELEASETERMINAL
TO 3
1070 IF Z=0THEN 400
: FOR I=1TO I3
: A(I),E1(I),E2(I),V(I),V=0
: NEXT I
: M1$=ALL(" ")
1080 FOR I=1TO I3
: IF R$(I)<>HEX(D0)OR M$(I)="2280"THEN 1090
: SELECT #2<D$(I)>
: GOSUB '202
: $GIO NO RETRIES #2,(0600 0700 70A0 4002 88D0 7040 6A10 6817 4000,R$)
: ERRORREM
1090 NEXT I
: GOSUB 1100
: GOTO 1130
1100 IF E9=1 THEN RETURN
: IF Z=0THEN 400
: REM % Print test header
: PRINT HEX(03);" "; AT(1,0);"Address Function Accesses
Sectors Hard Errors Soft Errors";HEX(0D);BOX(0,80); AT(0,29); M1$
: GOSUB 7010
1110 IF I3>D AND E9<>1 THEN PRINT " ";AT(23,55); ", SF'0 - more devices"
; AT(0,67); "( More)";
: GOTO 7100
1120 % ### ###### ##,###,###,### #####/##### #####
#####
1130 I=1
: M1$=" INITIALIZING "
: REM LOOP TO I3 (1420)
1140 C$=" "
: FOR G=1 TO I3
: IF V$(G) ="yes" OR I1$(G)="yes" THEN C$="Y"
: NEXT G
: G=0
: IF C$=" " THEN 1150
: GOSUB '220
: B$(2)=D$(I)
: SELECT #2<D$(I)>
: IF V$(I)="yes" OR I1$(I)="yes" THEN F$(I)="INIT "
: GOSUB 1870
1150 IF I1$(I)<>"yes" AND V$(I)<>"yes" THEN 1470
: STR(F$(I),6,1)="w"
: PRINT AT(0,25);M1$
1160 IF R$(I)<>HEX(D0)THEN 1300
: B$(1)=BIN(S(I),2)
: L=S(I)-1
: B=INT((E(I)-S(I)+1)/4)
: IF I1$(I)=" no" THEN 1260
: GOSUB 2860
1170 FOR C=1 TO B
: IF INT(C/2)<>C/2THEN GOSUB '200
: Q=0
1180 REM %INIT (sequentially fill disk)
: GOSUB 1500
1190 B$=B$(1)
: L=VAL(B$(1),2)
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 1560
1200 L=L+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 1560
1210 L=L+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 1560
1220 L=L+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 1560
1230 IF INT(C/2)<>C/2THEN 1240
: GOSUB '202
: $GIO END MSG WRITE #2,(0600 0700 70A0 68D0 7040 6A10 6811 4000 8B67,R$)
: IF STR(R$,6,3)=HEX(000000)THEN 1240
: B$(1)=B$
: GOTO 1180
1240 NEXT C
: C=(E(I)-S(I)+1)-(B*4)
: IF C=0 THEN 1410
: FOR B=1 TO C
: L=VAL(B$(1),2)
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 1560
1250 NEXT B
1260 STR(F$(I),6,1)="r"
: GOSUB 2860
: IF V$(I)=" no" THEN 1410
: S=S(I)
1270 B$=BIN(S,2)
: L=L+1
: DATA LOAD BA T#2,(S,S)B$()
: ERRORX=ERR
: GOTO 1560
1280 GOSUB 1530
: GOSUB 1500
1290 IF S<=E(I)THEN 1270
: GOTO 1470
1300 IF E(I)<1232THEN 1310
: C=24
: C(1)=0
: C(2)=20
: C(3)=17
: C(4)=12
: C(5)=9
: C(6)=4
: C(7)=1
: C(8)=21
: C(9)=16
: C(10)=13
: C(11)=8
: C(12)=5
: C(13)=2
: C(14)=22
: C(15)=19
: C(16)=14
: C(17)=11
: C(18)=6
: C(19)=3
: C(20)=23
: C(21)=18
: C(22)=15
: C(23)=10
: C(24)=7
: GOTO 1320
1310 C=16
: C(1)=0
: C(2)=8
: C(3)=1
: C(4)=9
: C(5)=2
: C(6)=10
: C(7)=3
: C(8)=11
: C(9)=4
: C(10)=12
: C(11)=5
: C(12)=13
: C(13)=6
: C(14)=14
: C(15)=7
: C(16)=15
1320 IF I1$(I)<>"yes" THEN 1360
: GOSUB 2860
: FOR A=INT(S(I)/C)TO ((E(I)+1)/C)-1
: FOR B=1TO C
: IF A*C+C(B)<S(I)OR A*C+C(B)>E(I)THEN 1350
1330 B$(1)=BIN(A*C+C(B),2)
: GOSUB 1500
1340 L=VAL(B$(1),2)
: DATA SAVE BA T#2,(B$(1))B$()
: ERRORX=ERR
: GOTO 1560
1350 NEXT B,A
1360 STR(F$(I),6,1)="r"
: GOSUB 2860
: IF V$(I)=" no" THEN 1410
1370 FOR A=INT(S(I)/C)TO ((E(I)+1)/C)-1
: FOR B=1TO C
: IF A*C+C(B)<S(I)OR A*C+C(B)>E(I)THEN 1400
: B$=BIN(A*C+C(B),2)
: GOSUB 1500
1380 L=VAL(B$,2)
: DATA LOAD BA T#2,(B$)B$()
: ERRORX=ERR
: GOTO 1560
1390 GOSUB 1530
1400 NEXT B,A
: GOTO 1470
1410 B$=BIN(S(I),2)
: L=S(I)
: DATA LOAD BA T#2,(S(I))B$()
: ERRORX=ERR
: B$(1)=B$
: GOTO 1560
1420 GOSUB 1530
1430 B$=BIN(E(I),2)
: L=E(I)
: DATA LOAD BA T#2,(E(I))B$()
: ERRORX=ERR
: B$(1)=B$
: GOTO 1560
1440 GOSUB 1530
1450 B$=BIN((E(I)-S(I))/2+S(I),2)
: L=VAL(B$,2)
: DATA LOAD BA T#2,((E(I)-S(I))/2+S(I))B$()
: ERRORX=ERR
: B$(1)=B$
: GOTO 1560
1460 GOSUB 1530
1470 STR(F$(I),6,1)=" "
: I=I+1
: IF I<=I3 THEN 1140
: REM Set printer counter to 1
: P=1
1480 G=1
: GOSUB 1860
: M1$=" TESTING "
: PRINT AT(0,25,16); M1$
: GOTO 1750
1490 REM % Check for input during init and act on it
1500 GOSUB 7130
: IF E9<>3 THEN 1510
: E9,G=0
: GOSUB 1100
: GOTO 1860
1510 IF G<>1 THEN 1520
: RETURN CLEAR ALL
: GOTO 410
1520 IF G<>2 THEN RETURN
: G=0
: GOTO 1850
1530 IF B$=B$(1)AND D$(I)=B$(2)THEN RETURN
1540 REM % Error report
: REM % #1 read errors
: PRINT AT(21,1,78);"Last error: on disk ";D$(I);"/sector"; VAL(B$,2);"
during a ";F$(I)
1550 G=1
: GOTO 1660
1560 REM % #2 for INIT errors
: RETURN CLEAR ALL
: E$=ALL(" ")
1570 $IF OFF /005,1580
: PRINT " ";AT(21,1,78);"Last error: I-";X;"on disk ";D$(I);"/sect
or ";L;"during a ";F$(I);
: E$="HARD"
: G=O
: GOSUB 1660
: FOR G=35 TO 70
: Y=G
: IF D$(I)=D$(G) THEN G=70
: NEXT G
1580 STR(E$(Y),,7)="I- on"
: F$(I)="I- "
: CONVERT X TO STR(E$(Y),3,2),(##)
: STR(F$(I),3,2)=STR(E$(Y),3,2)
: T$(I)=" no"
: T$(Y)=" no"
: GOSUB 2860
: GOTO 1470
1590 GOSUB 1610
: GOTO 1730
1600 REM % Check for input during testing and act on it
1610 GOSUB 7130
: IF E9<>3 THEN 1620
: E9=0
: G=1
: GOSUB 1100
: GOTO 1860
1620 IF G<>1 THEN 1630
: RETURN CLEAR ALL
: GOTO 410
1630 IF G<>2 THEN RETURN
: GOSUB 1850
: GOTO 2830
1650 REM % #3 hard/soft errors
: $IF OFF /005,1660
: PRINT AT(21,1,78);"Last error: I-";X;"on disk ";D$(I); "/sector"; VA
L(B$(1),2);"during a ";STR(F$(I),,6); " and was ";E$;
: G=0
: GOSUB 1660
: GOTO 1730
1660 REM % PRINT ERROR
: IF P9$="off" THEN 1720
: REM IF MAX NUMBER OF LINES PRINTED OR PRINTER NOT SELECED THEN RETURN
: IF P9$="215" THEN 1680
1670 REM % 204 Printer
: $OPEN 1710,/204
: PRINT AT(0,25,16); " Printer 204 - buffer full";
: SELECT PRINT 204
: $IF OFF /204,1710
: GOTO 1690
1680 REM % 215 Printer
: $OPEN 1710,/215
: $GIO/215(410D)
: $IF OFF /215,1710
: PRINT AT(0,25,16); " Printer 215 - buffer full";
: SELECT PRINT 215
: REM %
1690 P=P+1
: IF G=1 THEN PRINT "COMPARE";
: ELSE PRINT TAB(3); E$;
: PRINT " ERROR ";
: IF G<>1 THEN PRINT "I-";X;
: ELSE PRINT "----- ";
1700 PRINT " disk "; D$(I);" sec";VAL(B$(1),2);TAB(40);"during ";STR(F$(I),,6
);
: IF STR(F$(I),1,4)<>"INIT" THEN PRINT TAB(54);" -- accesses=";A(I);
: PRINT
1710 SELECT PRINT 005
: $CLOSE/215
: $CLOSE/204
1720 PRINT AT(0,25,25);M1$
: IF P=P1 THEN 7090
: RETURN
1730 $CLOSE#2
: RETURN CLEAR ALL
: C=0
: $IF OFF /005,1750
1740 GOSUB 2840
1750 REM % End of test
: I=INT((RND(1)*I3)+1)
: IF A1$(I)="infinite"OR A(I)<A1(I)AND T$(I)<> " no" THEN 1770
: IF V(I)=1THEN 1750
: ELSE V(I)=1
: V=V+V(I)
: IF V<I3THEN 1750
: PRINT AT(0,25,54); " TEST COMPLETE"
: GOSUB '50
: GOTO 410
1760 GOSUB '50
: IF G<>2 THEN 410
: GOSUB 1850
: GOTO 1760
1770 SELECT #2<D$(I)>
: GOSUB '220
: B$(2)=D$(I)
: $OPEN 1750,#2
: IF A(I)>99999999991 THEN A(I)=0
1780 S,S1=INT(RND(1)*E(I))
: IF S<S(I)OR S+07>E(I) OR T$(I)=" no" THEN 1780
: B$,B$(1)=BIN(S,2)
: R=RND(1)
: IF R<=.40THEN 1830
: IF R<=.45THEN 1810
: IF R<=.90THEN 1800
1790 REM % Verify
: F$(I)="VERIFY"
: GOSUB 2830
: GOSUB 1890
: GOTO 1590
1800 REM % Read
: F$(I)="READ"
: GOSUB 2830
: GOSUB 1910
: GOSUB 1910
: GOTO 1590
1810 REM % R/A/W
: F$(I)="R/A/W"
: GOSUB 2830
1820 GOSUB 1990
: IF Q=1 THEN GOSUB '201
: IF Q=2 THEN GOSUB 2050
: GOSUB 1910
: GOSUB 1990
: IF Q=1 THEN GOSUB '201
: IF Q=2 THEN GOSUB 2050
: GOSUB 1910
: GOTO 1590
1830 REM % Write
: F$(I)="WRITE"
: GOSUB 2830
1840 GOSUB 1990
: GOSUB 1990
: IF Q=1 THEN GOSUB '201
: IF Q=2 THEN GOSUB 2050
: GOTO 1590
1850 REM % CHANGE PAGE
: IF I3<=D THEN RETURN
: IF Z1=1 THEN Z1=D+1
: ELSE Z1=1
: IF Z1=1 THEN Z2=D
: ELSE Z2=I3
1860 REM % Print page
: PRINT AT(2,0,(D*79))
: IF G=0 THEN 1870
: G=I
: FOR I=Z1 TO Z2
: GOSUB 2840
: NEXT I
: GOTO 1880
1870 G=I
: FOR I=Z1 TO Z2
: GOSUB 2860
: NEXT I
1880 I=G
: G=0
: RETURN
1890 L=0
1900 VERIFY T#2,(S,S+07)L
: IF L=0THEN A(I)=A(I)+08
: ELSE A(I)=A(I)+L-S1
: IF L<>0THEN 2050
: RETURN
1910 REM %Read 4 * 2 Sectors
: L=S
1920 A(I)=A(I)+1
: DATA LOAD BA T#2,(S,S)B$()
: ERRORX=ERR
: GOTO 2050
1930 A(I)=A(I)+1
: L=S
: DATA LOAD BA T#2,(S,S)B1$()
: ERRORX=ERR
: GOTO 2050
1940 A(I)=A(I)+1
: L=S
: DATA LOAD BA T#2,(S,S)B2$()
: ERRORX=ERR
: GOTO 2050
1950 A(I)=A(I)+1
: L=S
: DATA LOAD BA T#2,(S,S)B3$()
: ERRORX=ERR
: GOTO 2050
1960 IF B$(1)<>B$OR B$(2)<>D$(I)THEN 1980
: ADDC(B$,01)
: IF B1$(1)<>B$OR B1$(2)<>D$(I)THEN 1980
: ADDC(B$,01)
: IF B2$(1)<>B$OR B2$(2)<>D$(I)THEN 1980
: ADDC(B$,01)
: IF B3$(1)<>B$OR B3$(2)<>D$(I)THEN 1980
: ADDC(B$,01)
1970 RETURN
1980 GOSUB 1540
: E1(I)=E1(I)+1
: RETURN CLEAR
: GOTO 1730
1990 REM %Write 4 * 2 Sectors
: IF Q=0 AND R$(I)=HEX(D0) THEN GOSUB '200
: L=VAL(B$(1),2)
2000 A(I)=A(I)+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 2050
2010 L=VAL(B$(1),2)
: A(I)=A(I)+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 2050
2020 L=VAL(B$(1),2)
: A(I)=A(I)+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 2050
2030 L=VAL(B$(1),2)
: A(I)=A(I)+1
: DATA SAVE BA T#2,(B$(1),B$(1))B$()
: ERRORX=ERR
: GOTO 2050
2040 RETURN
2050 GOSUB 1610
: $IF OFF /005,2060
: PRINT AT(0,25,16);" CHECKING ERROR "
2060 A(I)=A(I)+1
: C=C+1
: IF L>E(I) OR F$(I)="VERIFY" THEN L=L-1
: B$(1)=BIN(L,2)
: S=L
: IF F$(I)<>"VERIFY"THEN 2070
: VERIFY T#2,(L,L)L
: IF L=0THEN 2120
: X=ERR
: GOTO 2130
2070 IF F$(I)<>"READ"THEN 2090
: DATA LOAD BA T#2,(S)B$()
: ERRORX=ERR
: GOTO 2130
2080 GOTO 2120
2090 IF F$(I)<>"WRITE"THEN 2110
: DATA SAVE BA T#2,(B$(1))B$()
: ERRORX=ERR
: GOTO 2130
2100 GOTO 2120
2110 IF F$(I)<>"R/A/W"THEN STOP "ERROR ??????? "#
: DATA SAVE BA T#2,(B$(1))B$()
: ERRORX=ERR
: GOTO 2130
2120 E$="SOFT "
: E2(I)=E2(I)+1
: IF E2(I)>99999THEN E2(I)=99999
: GOTO 1650
2130 IF C<10 THEN 2050
: $IF OFF /005,2380
: PRINT AT(0,25,16);M1$
2140 E$="HARD "
: E1(I)=E1(I)+1
: IF E1(I)>99999THEN E1(I)=99999
: GOTO 1650
2150 DEFFN'200
: REM %'200
: GOSUB '202
: $GIO BEGIN MSG WRITE #2(0600 0700 70A0 68D0 7040 6A10 6810 4000,R$)
: Q=1
: GOSUB '203
: IF Q=2 THEN Q=0
: RETURN
2160 DEFFN'201
: REM %'201
: GOSUB '202
: $GIO END MSG WRITE #2,(0600 0700 70A0 68D0 7040 6A10 6811 4000 8B67,R$)
: Q=0
: GOSUB '203
: RETURN
2170 DEFFN'202
: REM %'202
: STR(R$,,1)=STR(D$(I),3)
: IF STR(D$(I),3)<>"0"THEN STR(R$,,1)=AND HEX(0F)SUBHEX(01)OR HEX(20)
: RETURN
2180 DEFFN'203
: REM %'203
: IF STR(R$,6,3)=HEX(000000)THEN RETURN
: IF STR(R$,6,1)=HEX(01)OR STR(R$,6,1)=HEX(02)OR STR(R$,6,1)=HEX(04)OR STR(
R$,7,1)=HEX(01)OR STR(R$,7,1)=HEX(02)OR STR(R$,7,1)=HEX(04)OR STR(R$,8,1)
=HEX(04)THEN 2190
: PRINT HEX(03);AT(12,27);
: STOP "ERROR ?????????? "#
2190 B$(1)=BIN(S1,2)
: Q=2
: RETURN
2200 DEFFN'220
: REM %'220 select data to write to disk
: IF M$(I)<>"850 DSDD"AND STR(M$(I),,3)<>"100"AND M$(I)<>"Q2040"THEN 2240
: ON INT((RND(1)*3)+1)GOTO 2210,2220,2230
2210 B$()=HEX(DB6DB6)&STR(B$())
: RETURN
2220 B$()=HEX(B6DB6D)&STR(B$())
: RETURN
2230 B$()=HEX(6DB6DB)&STR(B$())
: RETURN
2240 IF M$(I)<>"2280"THEN 2290
: ON INT((RND(1)*4)+1)GOTO 2250,2260,2270,2280
2250 B$()=HEX(3B63B63B)&STR(B$())
: RETURN
2260 B$()=HEX(E255FE25)&STR(B$())
: RETURN
2270 B$()=HEX(FFFFA924)&STR(B$())
: RETURN
2280 B$()=HEX(FE254A80)&STR(B$())
: RETURN
2290 ON INT((RND(1)*8)+1)GOTO 2300,2310,2320,2330,2340,2350,2360,2370
2300 B$()=HEX(55AAA55A)&STR(B$())
: RETURN
2310 B$()=HEX(A55AAA55)&STR(B$())
: RETURN
2320 B$()=HEX(5A55AAA5)&STR(B$())
: RETURN
2330 B$()=HEX(55A55AAA)&STR(B$())
: RETURN
2340 B$()=HEX(A55A55AA)&STR(B$())
: RETURN
2350 B$()=HEX(AA55A55A)&STR(B$())
: RETURN
2360 B$()=HEX(AAA55A55)&STR(B$())
: RETURN
2370 B$()=HEX(5AAA55A5)&STR(B$())
: RETURN
2380 DEFFN'1
: IF E9=1 THEN 2810
: IF E9<>4 THEN 2390
: PRINT HEX(06);
: RETURN CLEAR
: GOTO 2810
: REM % Help messages for errors
: REM %'1
2390 IF X<90 OR X>99 THEN X=90
: PRINT HEX(03); AT(22,0); BOX(2,79); " Press: RETURN to continue, or
SF'1 to return to normal screen"; AT(20,25,54);
: CONVERT X TO C1$,(##)
: E9=4
: LINPUT "Define error I-"? C1$
: E9=0
: CONVERT C1$ TO X
: ERRORX=ERR
: GOTO 2390
2400 E9=1
: PRINT HEX(030A0A0A0A)
: ON X-89GOTO 2410,2440,2490,2520,2560,2590,2630,2690,2730,2770
: GOTO 2390
2410 PRINT " ERR I-90";HEX(0A0A0D);"Error: DISK HARDWARE ERROR";HEX(
0A0D);"Cause: The disk did not respond properly to the system at the
beginning of a read or write operation; the operation has no
t been performed."
2420 PRINT HEX(0D);"Recovery: Run the program again. If the error persists,
ensure that disk unit is powered on and that all cables are p
roperly connected."
2430 GOTO 2820
2440 PRINT " ERR I-91";HEX(0A0A0D);"Error: DISK HARDWARE ERROR";HEX(
0A0D);"Cause: A disk hardware error occurred because the disk is not
in file-ready position. If the disk is in LOAD mode or if the
power is not turned"
2450 PRINT HEX(0C);" on, for example, the disk is not in file-ready
position and a disk hardware error is generated."
2460 PRINT HEX(0D);"Recovery: Run the program again. If the error recurs, be
sure the disk is turned on, properly set up for operatio
n, and that all cables are properly connected. Set the disk
into LOAD mode and then back into";
2470 PRINT " RUN mode by using the RUN/LOAD selection switch."
2480 GOTO 2820
2490 PRINT " ERR I-92";HEX(0A0A0D);"Error: TIMEOUT ERROR";HEX(0A0D);
"Cause: The device did not respond to the system in the proper amoun
t of time (time-out). The read or write operation has not
been performed."
2500 PRINT HEX(0D);"Recovery: Run the program again. If the error persists,
be sure that the disk platter has been formatted."
2510 GOTO 2820
2520 PRINT " ERR I-93";HEX(0A0A0D);"Error: FORMAT ERROR";HEX(0A0D);"
Cause: A format error was detected during a disk operation. This err
or in- dicates that certain sector-control information is inv
alid. If this"
2530 PRINT HEX(0C);" error occurs during a read or write operation,
the platter may need to be reformatted. If this error occurs
during formatting, there may be a flaw on the platter's surfa
ce."
2540 PRINT HEX(0D);"Recovery: Format the disk platter again. If the error pe
rsists, replace the media."
2550 GOTO 2820
2560 PRINT " ERR I-94";HEX(0A0A0D);"Error: FORMAT KEY ENGAGED";HEX(0
A0D);"Cause: The disk format key is engaged. The key should be engag
ed only when formatting a disk."
2570 PRINT HEX(0A);"Recovery: Turn off the format key."
2580 GOTO 2820
2590 PRINT " ERR I-95";HEX(0A0A0D);"Error: DEVICE ERROR";HEX(0A0D);"
Cause: A device fault occurred indicating that the disk could not pe
rform the requested operation. This error may result from an
attempt to"
2600 PRINT " write to a write-protected platter."
2610 PRINT HEX(0A);"Recovery: If writing, make sure the platter is not write
-protected. Repeat the operation. If the error persists, power
the disk off and then on, and then repeat the operation."
2620 GOTO 2820
2630 PRINT " ERR I-96";HEX(0A0A0D);"Error: DATA ERROR (CRC)";HEX(0A0
D);"Cause: For read operations, the checksum calculations (CRC or EC
C) indicate that the data read is incorrect. The sector read m
ay have been writ-"
2640 PRINT HEX(0C);" ten incorrectly. For disk drives that perform
error correction (ECC), the error correction attempt was
unsuccessful. For write op- erations, the LRC calculation in
dicates that the data sent to the"
2650 PRINT " disk was incorrect. The data has not been written."
2660 PRINT HEX(0A);"Recovery: For read errors, rewrite the data. If read err
ors persist, the disk platter should be reformatted. For writ
e errors, the write operation should be repeated. If write err
ors persist, ensure that all cable"
2670 PRINT " connections are properly made and are tight."
2680 GOTO 2820
2690 PRINT " ERR I-97";HEX(0A0A0D);"Error: LONGITUDINAL REDUNDANCY C
HECK ERROR";HEX(0A0A0D);"Cause: A longitudinal redundancy check erro
r occurred when reading or writ-"
2700 PRINT HEX(0C);" ing a sector. Usually, this error indicates a
transmission error between the disk and the CPU. However,
the sector being accessed may have been previously written
incorrectly."
2710 PRINT "Recovery: Run the program again. If the error persists, rewrite
the flawed sector."
2720 GOTO 2820
2730 PRINT " ERR I-98";HEX(0A0A0D);"Error: PLATTER NOT MOUNTED";HEX(
0A0A0D);"Cause: The disk sector being addressed is not on the disk,
or the disk"
2740 PRINT HEX(0C);" platter is not mounted. (The maximum legal sec
tor address depends upon the disk model used.)"
2750 PRINT HEX(0A);"Recovery: Mount a platter in the specified drive."
2760 GOTO 2820
2770 PRINT " ERR I-99";HEX(0A0A0D);"Error: READ-AFTER-WRITE ERROR";H
EX(0A0A0D);"Cause: The comparison of read-after-write to a disk sect
or failed, indicat-"
2780 PRINT HEX(0C);" ing that the information was not written prope
rly. This error usual- ly indicates that the disk platter is d
efective."
2790 PRINT "Recovery: Write the information again. If the error persists, tr
y a new plat- ter."
2800 GOTO 2820
2810 E9=3
: RETURN
2820 PRINT AT(22,0);BOX(2,79); " Press: SF'1 to return to normal screen"
; HEX(06);AT(0,25);M1$
: RETURN
2830 PRINT " "
2840 $IF OFF /005,2870
: IF E9=1 OR (I-Z1)>=D OR (I-Z1)<0 THEN 2870
: IF T$(I)=" no" THEN 2860
: PRINT AT(I-Z1+2,0);
: PRINTUSING 1120,D$(I),F$(I),A(I),S1,S1+7,E1(I),E2(I)
2850 GOTO 2870
2860 $IF OFF /005,2870
: IF E9=1 OR (I-Z1)>=D OR (I-Z1)<0 THEN 2870
: IF STR(F$(I),6,1)<>" " THEN PRINT " "
: PRINT AT(I-Z1+2,0);
: PRINTUSING 1120,D$(I),F$(I), HEX(20),S(I),E(I)
2870 PRINT ""
: RETURN
7000 DEFFN'50
: REM %'50
: PRINT AT(22,8,71);HEX(06);" RETURN/RUN to continue";
: GOSUB 7120
: IF C$<>HEX(0D) AND C$<> HEX(82) AND G<>1 AND G<>2 THEN 7000
: INIT(00)C$
: RETURN
7010 REM % PREV SCRN message
: PRINT AT(22,0); BOX(2,79); " Press:"; " "; AT(23,8);"CLEAR/PREV SCR
N - prev. screen";AT(23,57);"SF'14 - printer"; AT(22,57);"SF'1 - exp
lain errors";
: RETURN
7030 DEFFN '0
: G=2
: REM % Change page
: RETURN
7040 DEFFN '1
: REM % Print error information
: GOTO 2380
7050 DEFFN '42
7060 DEFFN '52
: REM % Check for PREV SCRN or change of page
: G=1
: RETURN
7070 DEFFN '14
: REM SET PRINT COUNTER TO 1
: P=1
: REM % Change printer
: IF P9$="204" THEN 7080
: IF P9$="215" THEN 7090
: P9$="204"
: GOTO 7100
7080 P9$="215"
: GOTO 7100
7090 P9$="off"
7100 IF E9<>1 THEN PRINT AT(0,2); "Printer "; P9$;"";
: RETURN
7110 REM % Check for CLEAR
: IF C$=HEX(81) THEN G=1
: RETURN
7120 REM % Wait for input
: G=0
: KEYIN C$,,7140
: GOTO 7110
7130 REM % Input no wait
: G=0
: KEYIN C$,7110,7140
: RETURN
7140 IF C$=HEX(00) THEN GOTO 7030
: IF C$=HEX(01) THEN GOTO 7040
: IF C$=HEX(42) OR C$=HEX(52) THEN 7060
: IF C$=HEX(0E) THEN 7070
: RETURN
7150 REM % Reload menu
: LOAD T"@MENU"
: ERRORX=ERR
: PRINT HEX(03); AT(12,18); "";
: IF X=(82) THEN PRINT " NO PREVIOUS MENU IS AVAILABLE ";
: ELSE PRINT " DISK ERROR "; X; " "
7160 GOSUB 7010
: PRINT AT(23,38,41);
: GOSUB 7120
: IF G=1 THEN 30
: GOTO 7160
7170 LOAD RUN T"START"
7180 REM % Text input meaasge
: PRINT " "; AT(22,8,72); "RETURN, TAB/FN or arrows to change fi
elds, then edit as required"; AT(23,8,32); " CONT/CTNUE to continu
e ";
: RETURN
7190 REM % Input and edit data
: REM R,Y are screen cords. and A$ is data to edit
: Z2,Z1=1
: G,G1=0
: GOSUB 7180
: PRINT " ";AT(R,Y); A2$; ""; AT(R,Y); HEX(05);
: KEYIN C$,,7260
: PRINT HEX(06);
: IF C$ = HEX(0D) THEN 7360
: IF C$=HEX(84) THEN 7290
: A2$=" "
: PRINT AT(R,Y,I5);
: Z1=2
: GOTO 7210
7200 PRINT HEX(05);
: IF Z2=I5+1 THEN PRINT AT(R,Y+Z2-2);
: G1=0
: PRINT HEX(05);
: KEYIN C$,,7260
: PRINT HEX(06);
: IF C$=HEX(0D) THEN 7360
: IF C$=HEX(08) THEN 7220
: IF C$=HEX(84) THEN 7290
7210 IF Z2=I5+1 THEN Z2=Z2-1
: STR(A2$,Z2,1)=C$
: PRINT AT(R,Y+Z2-1); ""; C$;"";
: Z2=Z2+1
: GOTO 7200
7220 IF Z2 <> 1 THEN Z2=Z2-1
: C$=" "
: STR(A2$,Z2,1)=C$
: PRINT AT(R,Y+Z2-1); C$; HEX(08);
: GOTO 7200
7230 IF Z2=I5+1 THEN Z2=Z2-1
: IF Z2<>1 THEN Z2=Z2-1
: ELSE GOTO 7340
: PRINT HEX(08);
: GOTO 7200
7240 IF Z2<I5 THEN Z2=Z2+1
: ELSE GOTO 7350
: PRINT HEX(09);
: GOTO 7200
7250 IF C$=HEX(00) AND I4<=D THEN 7280
: GOTO 7030
: REM goto '0
7260 PRINT HEX(06);
: ON POS(HEX(4D5D4C5C7F7E4555465600010E)=C$)GOTO 7230,7230,7240,7240,7340,7
350,7320,7320,7330,7330,7250,7300,7270
: GOTO 7280
7270 GOSUB '14
7280 ON Z1 GOTO 7190,7200
7290 G=1
: RETURN
7300 GOSUB 2380
7310 GOSUB 7130
: IF E9<>3 THEN 7310
: E9=0
: GOSUB 470
: GOSUB 7180
: PRINT AT(R,Y+Z2-1);
: IF Z2=1 THEN 7190
: GOTO 7200
7320 G1=G1+1
7330 G1=G1+1
7340 G1=G1+1
7350 G1=G1+1
7360 G1=G1+1
: RETURN
7370 PRINT AT(I-(I1-1)+1,3);HEX(06); " ";
: PRINTUSING 500, T$(I),F1$(I),I1$(I),V$(I),E$(I),D$(I),M$(I),S(I),E(I),A1$
(I);""
7380 IF G1=2 OR G1=3 THEN RETURN
7390 IF G1=1 OR G1=5 THEN I=I+1
: IF G1=4 THEN I=I-1
: IF I1=1 AND I4<D AND I>I4 THEN I=I1
: IF I1=1 AND I4>D AND I>D THEN I=I1
: IF I1=D+1 AND I>I4 THEN I=I1
: IF I<I1 AND I1=1 AND I4>D THEN I=D
: IF I<I1 AND I1=D+1 THEN I=I4
: IF I<I1 AND I4<D THEN I=I4
: IF I<I1 AND I1=1 AND I4>D THEN I=D
: RETURN
7400 P2$(1)="DEPT52"
: P2$(2)="DEPT 52"
: G=0
7410 REM % Input password
: IF P1$=P2$(1) OR P1$=P2$(2) THEN 7460
: GOSUB 7010
: PRINT AT(22,8,70); " appropriate keys or RETURN to reenter passwor
d"; AT(20,20,59);"Enter the password ";
: P1$=" "
: FOR B=1TO 7
7420 KEYIN C$,,7440
: IF C$=HEX(81) THEN 7440
: IF C$<>HEX(0D) THEN 7430
: B=7
: C$=" "
7430 STR(P1$,B,1)=C$
: PRINT " *";
: IF STR(P1$,1,6)="DEPT52" THEN B=7
: NEXT B
: IF P1$=P2$(1) OR P1$=P2$(2) THEN 7460
: PRINT HEX(07)
: GOTO 7400
7440 IF C$<>HEX(01) AND C$<>HEX(14) AND C$<>HEX(30) AND C$<>HEX(81) AND C$<>HE
X(42) AND C$<>HEX(52) AND C$<>HEX(00) THEN GOTO 7430
: IF C$=HEX(01) THEN 7450
: IF C$=HEX(00) THEN G=2
: IF C$=HEX(00) AND I4<=D THEN 7420
: IF C$=HEX(14) OR C$=HEX(30) THEN 7420
: IF C$=HEX(81) OR C$=HEX(42) OR C$=HEX(52) THEN G=1
7450 B=7
: NEXT B
: IF C$=HEX(01) THEN 2380
: RETURN
7455 GOSUB '14
7460 REM % Print warning message and wait for operator response
: GOSUB 7010
: PRINT " "; AT(20,7);"WARNING: All resident data will be DESTROYED
by this exercise ";AT(22,8,49); " CONT/CTNUE to continue "
7470 KEYIN C$,,7480
: IF C$<>HEX(84) AND C$<>HEX(81) THEN 7470
: PRINT AT(20,0,)
: IF C$=HEX(84) THEN RETURN
: GOTO 7290
7480 IF C$=HEX(42) OR C$=HEX(52) THEN 7290
: IF C$=HEX(01) THEN 7490
: IF C$=HEX(0E) THEN GOTO 7455
: IF C$<>HEX(00) THEN 7470
: G=2
: RETURN
7490 GOSUB 2380
7500 GOSUB 7130
: IF E9<>3 THEN 7500
: E9=0
: GOSUB 470
: GOTO 7460