Listing of file='FTU' on disk='vmedia/cs386_host_1.2.wvd.zip'
# Sector 605, program filename = 'FTU'
0010 REM % THIS IS THE 2200 FTU
0011 REM % NOTE
: REM Rev. Number is in subroutine '35
0012 REM \D5\F0\E4\E1\F4\E5\F3; 08/18/81, 06/01/84 by Paul J. Hossfeld - impro
ved screening, Added head step
0015 REM \D5\F0\E4\E1\F4\E5\F3; 10/23/84 by Paul J. Hossfeld - Added 2275 as o
ption. Slowed $GIO (3 places) search for drives so 2280DPU can read driv
es.
0016 REM \D5\F0\E4\E1\F4\E5\F3; 12/04/84 by Paul J. Hossfeld - Fixed print opt
ion on fast verify. Fixed end sector print on sector compare and box func
tion when complete.
0017 REM \D5\F0\E4\E1\F4\E5\F3; 08/09/85 by Paul J. Hossfeld - Fixed Instructi
on Test for PC emulation.
0018 REM \D5\F0\E4\E1\F4\E5\F3; 11/04/85 by Paul J. Hossfeld - Fixed Instructi
on Test large disk testing. i.e. winchesters with >30000 sectors. Lines
5050,4740, 4750, 4630, 4640 change C to C3. Line 4380 change INT(E4/16)
+37 to 477.
0019 REM Line 4600 change323+(INT(E$/16)+37)) to 800.
0030 DIM A$3,A2$32,B$,C$1,C1$2,C3$1,D$(100)3,R$(100),D3$(3)3,E(100),E$,E$(100)
7,F$(2)8,G,H1,I1,I2,I4,I5,M$1,M$(100)12,P3$3,P3,R,X,Y,Z,Z1,Z2
0040 DIM A3$(2),A4$(2,2),C$(16),L2$(1)2,N$8,N1$8,Q0$82,R2,T2,T3,T4,X(2),X1(2,2
),Y2$5,Y3$5
0050 DIM C9$8,D2,E3,E3$7,H$57,H1$57,I6,L1$1,L$1,K$(30)29,M3$12,P9$3,R1$(16),R3
$1,S3,T(14),W$(16),W1$(256)1,W2$(256)1,W9$(512)1
0060 F$(2),F$(1)="\A0\A0\A0\A0\A0\A0\A0\A0"
: R2=1000
: Z=9
: Z3=25
: X1=90
0070 REM NO. OF LINES ON THE SCREEN FOR THE DEVICE LIST
: D2=17
: REM MAXIUM NUMBER OF LINES TO PRINT ON PRINTER
: P1=500
0080 P9$="OFF"
: W9$()="B8B8B8B8B8B8B8B8B8B8B8B8B8B8B8B8"
: M$="I"
: L$="N"
: W9$()=W9$()&STR(W9$())
: HEXPACKW1$()FROMW9$()
0090 INIT(00)C$,C1$,E$,R$,D$(),E$(),M$()
0100 SELECT PRINT 005(80)
: I=1
: Z=5
: S,S3,P,E9=0
0110 REM % First page
: GOSUB '35("2200 FTU (Field Test Unit)")
0120 B$=$PSTAT(1)
: IF STR(B$,9,1)="M"AND STR(B$,10,1)>=HEX(18)THEN 125
: IF STR(B$,9,1)="V"AND STR(B$,10,1)>=HEX(21)THEN 125
: IF STR(B$,9,1)="W"THEN 125
: PRINT HEX(0E);AT(12,15);"CPU SOFTWARE MUST BE UPGRADED TO 'MVP 1.8' OR HI
GHER, OR 'VP 2.0' OR HIGHER"
: GOTO 120
0125 IF STR(B$,10,1)>=HEX(30)THEN D3$(1)="340"
: ELSE D3$(1)="D10"
0130 PRINT AT(12,25,62);"Load all devices to be tested";AT(22,58);" SF'0
define err"
: GOSUB 6250
: GOSUB '52
: GOSUB 6300
0140 IF G=1THEN 6330
: IF C$=HEX(0D)OR C$=HEX(82)THEN 170
: IF C$<>HEX(00)THEN 130
: GOSUB 5800
: E9=0
: GOTO 110
0170 REM % Second page
: PRINT HEX(06);AT(1,0,1680);AT(23,38,41);
: REM % Start search for drives
: REM Skip first time
: GOTO 204
0199 REM ROLL THROUGH ALL POSSIBLE DRIVE ADDRESS
0200 IF D3$(1)<>"340"THEN 202
: D3$(1)="D10"
: GOTO 204
0202 IF STR(D3$(1),3,1)="9"THEN STR(D3$(1),3,1)="A"
: ELSE STR(D3$(1),3,1)=ADDHEX(01)
: IF STR(D3$(1),3,1)<="F"THEN 204
: STR(D3$(1),3,1)="0"
: IF STR(D3$(1),2,1)>="7"THEN 490
: IF STR(D3$(1),2,1)>"3"THEN STR(D3$(1),2,1)=SUBHEX(03)
: ELSE STR(D3$(1),2,1)=ADDHEX(04)
0204 REM GO CHECK THIS DRIVE
: GOSUB 210
0206 REM Get any input
: GOSUB 6310
: IF G=1THEN 90
: IF C$<>HEX(00)THEN 208
: GOSUB 5800
: E9=0
: PRINT HEX(03)
: GOSUB '35("2200 FTU(Field Test Unit)")
: P=0
0208 IF I>2AND M$(I-2)="Q2020"AND M$(I-1)="Q2020"AND STR(D$(I-2),1,2)=STR(D$(I
-1),1,2)THEN M$(I-2),M$(I-1)="Q2040"
0209 REM IF 2270 THEN NO MORE THAN 1 SLAVE
: IF STR(D3$,1,4)="2270"AND STR(D3$(1),2,2)="60"THEN STR(D3$(1),3,1)="F"
: GOTO 200
0210 REM ENABLE THE DRIVE TO #2
: SELECT #2<D3$(1)>
: ERRORX=ERR
: GOTO 470
0211 REM READY
: $OPEN 470,#2
: ERRORX=ERR
: GOTO 470
0212 IF P=0AND S<>3THEN PRINT AT(11,Z3-4);"please wait";
: IF P=0OR S=3THEN PRINT AT(11,Z3+8);" CHECKING ";HEX(06);
: ELSE PRINT AT(11,Z3+8);"checking ";
0214 REM If test select screen then S=3 and this
: IF S<>3THEN PRINT D3$(1)
: ELSE PRINT AT(11,Z3+16,4)
: IF P=0THEN P=2
: P=P-1
: IF D3$(1)<>"340"THEN 216
: STR(R$,11,1)=HEX(C0)
: GOTO 224
0216 $GIOSEARCHFORVALIDDEVICES#2(0104020002E8120012121020120012120B0070A041008
60B,R$)
: ERRORX=ERR
: GOTO 470
0220 REM If timeout skip usless addresses
: IF STR(R$,8,1)<>HEX(10)THEN 222
: IF S=2OR S=3THEN 221
: STR(D3$(1),3,1)="F"
: GOTO 470
0221 REM REPORT TIME OUT
: X=91
: GOTO 460
0222 REM NO MORE DRIVES ON CO TYPE DEVICES
: IF STR(R$,11,1)>=HEX(D0)THEN 224
: IF S=2OR S=3THEN 224
: IF STR(D3$(1),3,1)<"2"THEN 224
: STR(D3$(1),3,1)="F"
: GOTO 470
0224 GOSUB 7020
: VERIFY T#2,(0,0)E
: ERRORE=1
0225 X=ERR
: GOSUB 7040
: IF E=0OR X=93OR X=95OR X=96THEN 230
: IF S=2OR S=3THEN 460
: GOTO 470
0230 R3$=STR(R$,11,1)
: R$(I)=R3$
: REM % Now lets look for the drive types
0240 E3=65407
: M3$="Q2020"
: T2=128
: GOSUB 450
0250 E3=65023
: M3$="2275 WIN "
: T2=128
: GOSUB 450
0260 E3=52607
: M3$="2280"
: T2=64
: GOSUB 450
0270 E3=38911
: M3$="2275 WIN "
: T2=128
: GOSUB 450
0280 E3=32639
: M3$="1004"
: T2=128
: GOSUB 450
0290 E3=19583
: M3$="2260"
: T2=48
: GOSUB 450
0300 E3=16319
: M3$="1002"
: T2=64
: GOSUB 450
0310 E3=9791
: M3$="2230-1"
: T2=24
: GOSUB 450
0320 E2=9599
: M3$="2260-1/2"
: T2=48
: GOSUB 450
0330 E3=8127
: M3$="1000"
: T2=32
: GOSUB 450
0335 E3=4159
: M3$="2275 FLPm"
: T2=32
: GOSUB 450
0340 E3=3873
: M3$="850 DSDD"
: T2=52
: GOSUB 450
0350 E3=4799
: M3$="2260-1/4"
: T2=48
: GOSUB 450
0360 E3=1279
: M3$="2275 FLPk"
: T2=32
: IF R3$=HEX(D0)THEN GOSUB 450
0370 E3=1231
: M3$="2270a"
: T2=16
: GOSUB 450
0380 E3=1023
: M3$="2270"
: T2=16
: GOSUB 450
0390 IF D3$(1)<>"340"THEN 410
: E3=65535
: M3$="SYSTEM RAMD"
: T2=1
: VERIFY T#2,(0,E3)E3
: ERRORX=ERR
0400 E3=E3-2
: IF E3<1THEN E3=1
: GOSUB 450
: GOTO 470
0410 E3=0
: M3$="UNKNOWN"
: T2=1
: GOSUB 450
: GOTO 470
0449 REM HERE TO AUTO SIZE
0450 X=0
: VERIFY T#2,(E3,E3)E
: ERRORE=1
0451 IF E=0THEN 455
: X=ERR
: IF X<>93AND X<>95AND X<>96THEN RETURN
0455 GOSUB 7020
: VERIFY T#2,(0,0)E
: ERRORGOTO 456
: REM RESTORE HEADS
0456 GOSUB 7040
: RETURN CLEAR
0460 STR(E3$,,7)="I- on"
: CONVERT XTO STR(E3$,3,2),(##)
: IF X=0THEN E3$=" "
0461 IF STR(M3$,,4)<>"2275"AND M3$<>"UNKNOWN"THEN 469
: GOSUB 1245
: IF STR(R$,6,3)<>HEX(000000)THEN 469
0462 IF STR(H$,1,1)<>"3"THEN 469
: IF STR(D3$(1),2,1)>"4"THEN 463
: IF STR(D3$(1),3,1)="0"THEN STR(M3$,1,6)="2200DS"
: ELSE M3$="2200DS WIN "
: IF STR(D3$(1),3,1)="F"THEN M3$="2200DS WINr"
: GOTO 467
0463 M3$="2200DS WIN "
: IF STR(D3$(1),3,1)<>"0"THEN 465
: M3$="2200DS RAMD"
: VERIFY T#2,(0,65534)E3
: ERRORX=ERR
0464 E3=E3-2
: IF E3<1THEN E3=1
: GOTO 467
0465 IF STR(D3$(1),3,1)="F"THEN 470
0467 REM MAXSTORE
: IF STR(H$,2,1)="7"OR STR(H$,2,1)="9"THEN T=64
: REM OTHER WIN
: IF STR(H$,2,1)="1"OR STR(H$,2,1)="3"OR STR(H$,2,1)="4"OR STR(H$,2,1)="5"O
R STR(H$,2,1)="6"OR STR(H$,2,1)="8"THEN T=64
0469 IF S=2OR S=3THEN 470
: E(I)=E3
: M$(I)=M3$
: D$(I)=D3$(1)
: E$(I)=E3$
: I=I+1
: IF STR(M3$,1,4)="2270"AND STR(D3$(1),2,2)="60"THEN STR(D3$(1),3,1)="F"
: IF M3$="850 DSDD"THEN $GIORESET#2(4501)
0470 RETURN
0490 I4=I-1
: FOR I=1TO I4
: IF R$(I)<HEX(D0)THEN 492
: SELECT #2<D$(I)>
: ERRORX=ERR
: GOTO 492
0491 $GIORESET#2(4501)
0492 NEXT I
0495 IF I4<=34THEN 510
: PRINT AT(15,22);"More than 100 devices mounted";AT(16,12);" FTU can D
ISPLAY only 100 devices"
: GOSUB '50
0500 LINPUT C$
: PRINT C$
: STOP
0510 I,I2=I4
: I6=1
: E9=0
: IF I>D2THEN I2=D2
: GOTO 540
0520 REM CHANGE PAGE
: IF I4<D2THEN RETURN
: IF C$=HEX(1F)THEN 522
: I6=I6+D2
: IF I6>I4THEN I6=1
: GOTO 526
0522 I6=I6-D2
: IF I6<=0THEN 524
: GOTO 526
0524 I6=MOD(I4,D2)
: IF I6=0THEN I6=D2
: I6=I4-I6+1
: GOTO 526
0526 I2=I6+D2-1
: IF I2>I4THEN I2=I4
: G=2
: RETURN
0530 GOSUB 520
0540 REM This indicates page 0
: K1=0
: REM % Print table
: G=I
: GOSUB '35("2200 FTU (Field Test Unit)")
: PRINT AT(1,0,1680);" Available Addresses Disk Model
Ending Sector"
0550 FOR I=I6TO I2
: IF I2<>0THEN 560
: D$(I),M$(I)="N/A"
: E(I)=0
: E$(I)=" "
0560 PRINT AT((I-I6)+2,1);HEX(06);" ";
0570 PRINTUSING 580,E$(I),D$(I),M$(I),E(I)
0580 %>- ####### ### -< >- ############ -< >- #####
-<
0590 REM PRINT AT(I-I6+1,1);">-";AT(I-I6+1,27);"-< >-";AT(I-I6+1,53);"-< >-"
;AT(I-I6+1,77);"-<"
0600 NEXT I
0610 PRINT AT(1,0);BOX(1,79);AT(2,0);BOX((I-I6)+1,79);AT(2,29);BOX((I-I6)+1,26
)
0620 GOSUB 6250
: IF I4>0THEN 630
: PRINT HEX(07);AT(20,0,79);AT(20,20);" PROGRAM ABORTED. NO DISKS RE
SPONDING "
: GOSUB 6300
: IF G=1THEN 30
: GOTO 620
0630 $CLOSE
: I=I6
: C1$=" "
: I=G
0640 IF I4>D2AND E9<>1THEN PRINT " ";AT(22,36);" SF'15 - more dev";AT(0
,67);"( More)";
0650 GOSUB 6250
: PRINT AT(20,0,79);AT(20,15);"Select the address of the device to be teste
d. \A0\A0\A0";AT(22,58);" SF'0 define err"
0655 GOSUB '52
: P,S3=0
: D=2
: R=20
: Y=62
: GOSUB 5460
: IF C$=HEX(00)THEN GOTO 656
: ON GGOTO 30,530,650
: ON G1GOTO 660,650,650,650,650
: GOTO 650
0656 GOSUB 5800
: GOTO 540
0660 PRINT HEX(03)
: D3$(1),D3$(2)=D$
: IF D3$(3)=" "THEN D3$(3)=D3$(1)
: S=2
: GOSUB '35("2200 FTU (Field Test Unit)")
: GOSUB 210
: E4=E3
0670 IF X=0THEN 700
: E3$="I-"
: CONVERT XTO STR(E3$,3,2),(##)
: GOTO 700
0680 REM % wait to return screen
: GOSUB 6310
: IF E9<>3THEN 680
: E9=0
: GOTO 510
0690 REM % START
0700 K$(1)="Error Definitions 90-99"
: K$(2)="Compare Sector(s)"
: K$(3)="Compare File "
: K$(4)="Display a Sector"
: K$(5)="Verify"
: K$(6)="Read"
: K$(7)="Position Head(s)"
: K$(8)="Code Revs"
0710 K$(9)="Write Enable"
: K$(10)="Write Lock"
: K$(11)="Scratch Disk"
: K$(12)="Format Disk"
: K$(13)="Write"
: K$(14)="Read After Write"
: K$(15)="Instruction Test"
: K$(16)=" "
0720 SELECT PRINT 005(80)
: H1,L,C1,C2,M,M1=0
: GOSUB '35("TEST SELECTION MENU")
0730 K1=16
: IF K1/2<>ROUND((K1/2,0)THEN K1=ROUND((K1/2,0)*2
: FOR K=2TO K1
: GOSUB 740
: NEXT K
: $CLOSE
: GOTO 760
0732 REM % SF key select
: IF K1=0THEN RETURN
: GOSUB 6320
: IF G=1THEN 540
: PRINT " ";
: K=VAL(C$)+1
: IF K<=15THEN 734
: PRINT HEX(070F)
: Z=9
: R=R-(Z+1)
: GOTO 760
0734 REM % Hilite SF selection
: IF K=1THEN 738
: GOSUB 740
: PRINT AT(22,8,28)
0736 GOSUB '52
: GOSUB 6300
: PRINT AT(23,58,20);
: IF G=3OR G=1THEN GOSUB 740
: IF G=1THEN 850
: IF G=3THEN 732
: IF C$<>HEX(0D)AND C$<>HEX(82)THEN 736
0738 ON KGOSUB 5800,1260,1400,1650,1810,1950,2320,1190,2420,2430,2500,2660,272
0,2850,3040
: GOTO 700
0740 IF K$(K)=" "THEN RETURN
: CONVERT K-1TO C1$,(##)
: Z=K
: Z1=2
: IF K<=K1/2THEN 750
: Z=K-K1/2+1
: Z1=50
0750 PRINT AT(Z,Z1);
: IF Z1<10AND Z<>5THEN PRINTUSING "SF ## - ##############################",
C1$,K$(K);
: ELSE PRINTUSING "SF ## - ###################",C1$,K$(K);
: RETURN
0760 Z=9
: Z3=25
: T3=INT(S3/T2)
: T4=INT((E3)/T2)
: PRINT " ";AT(22,36);"SF' key listed above";AT(22,58);"SF'0 define
err ";HEX(060F)
: IF M3$<>"850 DSDD"THEN 770
: IF E3<26THEN T4=0
: ELSE T4=INT(((E3-26)/T2)+1)
0770 PRINT AT(Z+2,Z3-8);"Device ";D3$(1);"";
: IF STR(E3$,1,2)="I-"THEN PRINT " Error = ";E3$;""
0780 PRINT AT(Z+3,Z3-14);"Start Sector ";
: IF S3>E3THEN PRINT " ";
: PRINT S3;"";AT(Z+3,Z3+8);"Track ";T3;"";
0790 PRINT AT(Z+4,Z3-12);"End Sector ";E3;AT(Z+4,Z3+8);"Track ";T4;AT(Z
+4,Z3+22);"Maximum ="
: IF E4<E3OR E4=0THEN PRINT " "
: PRINT AT(Z+4,Z3+32);E4;""
0800 PRINT AT(Z+5,Z3-18);"Hex data pattern ";STR(W9$(),1,32);""
0810 PRINT AT(Z+6,Z3-9);"Printer ";P9$;"";AT(Z+6,Z3+4);"(204, 215, OFF)"
0820 PRINT AT(Z+7,Z3-6);"Loop ";L$;"";AT(Z+7,Z3+2);"(N=No, T=on Test, E=on
Error or test)";
0830 PRINT AT(Z+8,Z3-6);"Mode ";M$;"";AT(Z+8,Z3+2);"(I = sequential step In
, A = Alternate step)";AT(Z+9,Z3+2);"(O = sequential step Out, R = Rando
m step)";
0840 IF M$="R"THEN PRINT AT(Z+10,Z3-21);"# Random Operations ";R2;"";
: ELSE PRINT AT(Z+10,Z3-21,71)
: IF STR(E3$,1,2)<>"I-"THEN GOSUB 5150
0850 Z=9
: Z3=25
: REM % Device
: R=Z+2
: Y=Z3
: D$=D3$(1)
: P=0
: D=2
: GOSUB 5460
: X=0
: IF G=1THEN 540
: IF D3$(1)=D$THEN 870
: D3$(1),D3$(2)=D$
: E4=E3
: S=3
: GOSUB 210
: E=E3
: E3=E4
: E4=E
: E3$=ALL(20)
: VERIFY T#2,(1,1)E
: ERRORE=1
0855 X=ERR
: IF E=0OR X=0THEN 860
: E3$="I-"
: CONVERT XTO STR(E3$,3,2),(##)
0860 PRINT AT(5,32,13);
: REM SAVE THESE
: S=G
: C3$=C$
: IF X=0THEN GOSUB 5150
: G=S
: C$=C3$
0870 PRINT AT(Z+2,Z3,20);" ";D3$(1);"";
: IF STR(E3$,1,2)="I-"THEN PRINT " Error = ";E3$;""
: IF E3>E4OR E4=0THEN PRINT " "
: PRINT AT(Z+4,Z3+32,8);E4;" "
: IF G=3OR G=2THEN 732
: ON G1GOTO 890,890,880,880,890
: GOTO 850
0880 IF M$="R"THEN 1130
: GOTO 1110
0890 REM % Start sector
: R=Z+3
: Y=Z3
: GOSUB 5570
: T3=INT(S3/T2)
: IF M3$="850 DSDD"AND S3>25THEN T3=INT((S3-26)/T2)+1
: IF T3>9999THEN T3=0
: PRINT AT(Z+3,Z3+14,4);" ";T3
: IF S3>E3THEN PRINT " "
: PRINT AT(Z+3,Z3-1,8);S3;"";
: IF G=1THEN 540
: IF G=3OR G=2THEN 732
: ON G1GOTO 900,900,850,850,900
: GOTO 890
0900 REM % Start track
: R=Z+3
: Y=Z3+15
: I=T3
: I5=4
: CONVERT T3TO A2$,(####)
: ERRORX=ERR
: T3=0
: GOTO 930
0910 GOSUB 6360
: CONVERT A2$TO T3
: ERRORX=ERR
: T3=0
: GOTO 900
0920 IF T3=ITHEN 930
: S3=T3*T2
: IF M3$="850 DSDD"AND S3<>0THEN S3=S3-26
: IF S3>E3THEN PRINT " "
: ELSE PRINT " "
: PRINT AT(Z+3,Z3-1,8);S3
0930 PRINT AT(Z+3,Z3+14,5);" ";T3;""
: IF G=1THEN 540
: IF G=3OR G=2THEN 732
: ON G1GOTO 940,940,890,890,940
: GOTO 900
0940 REM % End sector
: R=Z+4
: Y=Z3
: GOSUB 5590
: T4=INT((E3)/T2)
: IF M3$="850 DSDD"AND E3>25THEN T4=INT((E3-26)/T2)+1
: IF T4>9999THEN T4=0
: PRINT AT(Z+4,Z3+14,5);" ";T4;" "
: IF E3>E4THEN PRINT " "
: PRINT AT(Z+4,Z3+32,8);E4;AT(Z+4,Z3-1,8);" ";E3;"";
0950 IF S3>E3THEN PRINT " ";
: ELSE PRINT " ";
: PRINT AT(Z+3,Z3-1,8);S3;" ";
: IF G=1THEN 540
: IF G=2OR G=3THEN 732
: ON G1GOTO 960,960,900,900,960
: GOTO 940
0960 REM % End track
: R=Z+4
: Y=Z3+15
: I=T4
: I5=4
: CONVERT T4TO A2$,(####)
: ERRORX=ERR
: T4=0
: GOTO 990
0970 GOSUB 6360
: CONVERT A2$TO T4
: ERRORX=ERR
: T4=0
: GOTO 960
0980 IF T4=ITHEN 990
: E3=(T4*T2)+T2-1
: IF M3$="850 DSDD"THEN E3=E3-26
: IF S3>E3THEN PRINT " "
: ELSE PRINT " "
: PRINT AT(Z+3,Z3-1,8);S3;" "
: IF E3>E4THEN PRINT " "
: PRINT AT(Z+4,Z3+32,8);E4
: PRINT AT(Z+4,Z3-1,8);" ";E3
0990 PRINT AT(Z+4,Z3+14,5);" ";T4;""
: IF G=1THEN 540
: IF G=3OR G=2THEN 732
: ON G1GOTO 1000,1000,940,940,1000
: GOTO 900
1000 REM % Data pattern
: R=Z+5
: Y=Z3
: I5=32
: A2$=STR(W9$(),1,32)
: GOSUB 6360
1010 FOR Y=1TO 32
: IF STR(A2$,Y,1)>="0"AND STR(A2$,Y,1)<="9"OR STR(A2$,Y,1)>="A"AND STR(A2$,
Y,1)<="F"THEN 1040
: FOR I5=YTO 32
: IF STR(A2$,I5,1)=" "THEN 1030
: Y=32
1020 R=0
1030 NEXT I5
1040 NEXT Y
: IF R=0THEN 1000
: IF G=1THEN 540
: IF STR(A2$,1,1)=" "THEN 1000
: INIT(20)W9$()
: A2$=A2$&STR(A2$)
: STR(W9$(),1,32)=A2$
: W9$()=W9$()&STR(W9$())
: HEXPACKW1$()FROMW9$()
: PRINT HEX(06);AT(Z+5,Z3);" ";STR(W9$(),1,32);"";
: IF G=2OR G=3THEN 732
: ON G1GOTO 1050,1050,960,960,1050
: GOTO 1000
1050 REM % Printer
: R=Z+6
: Y=Z3
: I5=3
: A2$=P9$
: GOSUB 6360
: P9$=A2$
: IF P9$="204"OR P9$="215"OR P9$="OFF"THEN 1060
: P9$="OFF"
: PRINT AT(Z+6,Z3);" ";P9$;"";
1060 PRINT AT(Z+6,Z3);" ";P9$;"";
: IF G=1THEN 540
: IF G=2OR G=3THEN 732
: ON G1GOTO 1070,1070,1000,1000,1070
: GOTO 1050
1070 REM % Loop
: R=Z+7
: Y=Z3
: I5=1
: A2$=L$
: GOSUB 6360
: L$=A2$
: IF L$="T"OR L$="N"OR L$="E"THEN 1080
: L$="N"
1080 PRINT AT(Z+7,Z3);" ";L$;"";
: IF G=1THEN 540
: IF G=2OR G=3THEN 732
: ON G1GOTO 1110,1110,1050,1050,1110
: GOTO 1070
1110 REM % Mode
: R=Z+8
: Y=Z3
: I5=1
: A2$=M$
: GOSUB 6360
: M$=A2$
: IF M$="R"OR M$="O"OR M$="I"OR M$="A"THEN 1120
: M$="I"
1120 PRINT AT(Z+8,Z3);" ";M$;"";
: IF M$<>"R"THEN PRINT AT(Z+10,Z3-21,71)
: ELSE PRINT AT(Z+10,Z3-21);"# Random Operations ";R2;""
: IF G=1THEN 540
: IF G=2OR G=3THEN 732
: ON G1GOTO 1130,1130,1070,1070,1130
: GOTO 1110
1130 REM % # Random Operations
: IF M$<>"R"THEN 850
: R=Z+10
: Y=Z3
: I5=4
: CONVERT R2TO A2$,(####)
: GOSUB 6360
: CONVERT A2$TO R2
: ERRORX=ERR
: R2=1000
: GOTO 1130
1140 PRINT AT(Z+10,Z3-1,5);" ";R2;"";
: IF G=1THEN 540
: IF G=2OR G=3THEN 732
: ON G1GOTO 850,850,1110,1110,850
: GOTO 1130
1180 REM % Status
1190 PRINT AT(Z+3,Z3+25,30);
: B$=$PSTAT(1)
: HEXUNPACKSTR(B$,10,1)TO C1$
: PRINT "OS Rev. ";
: IF STR(B$,9,1)="M"THEN PRINT "MVP";
: ELSE IF STR(B$,9,1)="L"THEN PRINT "LVP";
: ELSE PRINT STR(B$,9,1);
: PRINT " ";STR(C1$,1,1);".";STR(C1$,2,1)
1191 PRINT AT(Z+2,Z3+25,30);HEX(0E);
: IF D3$(1)="340"THEN 1195
: GOSUB 1245
: IF STR(R$,6,3)=HEX(000000)AND X=0THEN 1200
: PRINT " ";D3$(D);"'s Status can't be determined"
: GOTO 1240
1195 PRINT "Ram disk ";
: GOTO 1240
1200 IF STR(H$,1,1)<>"2"THEN 1223
: IF STR(H$,2,1)="0"THEN 1228
1220 PRINT "2275";
: GOTO 1230
1223 IF STR(H$,,1)<>"3"THEN 1228
: PRINT "2200DS";
: GOTO 1230
1228 IF STR(H$,,2)="20"THEN PRINT TAB(2);"SVP DPU"
: IF STR(H$,,2)="19"THEN PRINT "Quantum";
: IF STR(H$,,2)="18"THEN PRINT TAB(2);"LVP DPU";
: IF STR(H$,,2)="10"THEN PRINT "Phoenix";
1230 PRINT HEX(0F);" has Rev. ";HEX(0E);STR(H$,4,2);HEX(0F);" proms."
1240 GOSUB 740
: RETURN CLEAR
: GOTO 850
1245 REM Get the stats
: GOSUB 7060
: X=0
: $GIOREADSTATUS#2(0600070070A0400288D070406A106816400087051A00C340,R$)R$;S
TR(H$,1,VAL(STR(R$,5,1)))
: ERRORX=ERR
1246 RETURN
1250 REM % Sector(s) compare
1260 H$="DISK COMPARE ROUTINE"
: GOSUB '35(H$)
: GOSUB '52
: D=3
: Y1=S3
1270 PRINT AT(11,20);" 2nd device you wish to work with?"
: R=11
: Y=55
: D$=D3$(D)
1280 GOSUB 5460
: IF G=1THEN RETURN
: D3$(D)=D$
: S=S3
: E=E3
1290 PRINT AT(12,22);"Starting sector on this device?";
1300 REM Select sector
: R=12
: Y=55
: CONVERT Y1TO A2$,(#####)
: I5=5
: GOSUB 6360
: IF G=1THEN RETURN
: CONVERT A2$TO Y1
: ERRORX=ERR
: GOTO 5590
1310 IF G1=2THEN 1270
1320 PRINT AT(11,1,240);AT(22,8,50);AT(13,25);"Comparing ";D3$(1);" to "
;D3$(3);AT(11,28);"Sector ";
1330 PRINT AT(11,36);
: G=4
: GOSUB '39(S)
: GOSUB '40(2,S)
: IF G=1THEN RETURN
: IF X<>0THEN 1360
: W$()=R1$()
1340 G=4
: GOSUB '39(Y1)
: GOSUB '40(3,Y1)
: IF G=1THEN RETURN
: IF X<>0THEN 1360
1350 IF R1$()=W$()THEN 1360
: L=1
: PRINT AT(16,27);" The sectors are not equal."
: GOSUB '60
: IF L$="T"THEN 1360
: IF L$="E"THEN 1330
: GOSUB '50
: IF G=1THEN RETURN
: PRINT AT(16,27,26)
1360 IF S=ETHEN 1370
: GOSUB 6310
: IF G=1THEN RETURN
: S=S+1
: Y1=Y1+1
: GOTO 1330
1370 PRINT AT(12,46)
: S=S3
: IF L$="N"THEN 5340
: GOSUB '61
: GOTO 1330
1380 REM % File compare
1390 F$(1)="? ?? ?"
1400 Y,Y1,Y2,Y3=0
: H$="DISK FILE COMPARE ROUTINE"
: GOSUB '35(H$)
: IF STR(F$(2),1,1)=" "OR STR(F$(2),1,1)="\A0"THEN F$(2)=F$(1)
1410 PRINT AT(10,12);" Enter the file name for device ";D3$(1);"
";F$(1);AT(11,12);"2nd platter or surface you wish to work with ";D3
$(3);AT(12,12);" Enter the file name for the second device ";F$(2);A
T(22,36);"SF'2 to continue"
1420 Y=58
: R=10
: I5=8
: A2$=F$(1)
: GOSUB 6360
: IF G=1THEN RETURN
: F$(1)=A2$
: PRINT AT(R,Y,8);" ";F$(1);"";
: IF G=3AND C$=HEX(02)THEN 1470
: ON G1GOTO 1430,1430,1450,1450,1430
: GOTO 1420
1430 D=3
: R=11
: Y=58
: D$=D3$(D)
1440 GOSUB 5460
: IF G=1THEN RETURN
: D3$(D)=D$
: PRINT AT(R,Y);" ";D3$(D);"";
: IF G=3AND C$=HEX(02)THEN 1470
: ON G1GOTO 1450,1450,1420,1420,1450
: GOTO 1430
1450 IF STR(F$(2),1,1)=" "OR STR(F$(2),1,1)="\A0"THEN F$(2)=F$(1)
: Y=58
: R=12
: I5=8
: A2$=F$(2)
: GOSUB 6360
: IF G=1THEN RETURN
: F$(2)=A2$
: PRINT AT(R,Y,8);" ";F$(2);""
: IF G=3AND C$=HEX(02)THEN 1470
: ON G1GOTO 1420,1420,1430,1430,1420
: GOTO 1450
1460 F$(2)=A2$
1470 ON POS("\A0 "=STR(F$(1),1,1))GOTO 1390,1390
: ON POS("\A0 "=STR(F$(2),1,1))GOTO 1390,1390
: D1=0
: PRINT AT(4,0,);"Searching for file name ";HEX(0E);F$(1);HEX(0F);" on ";HE
X(0E);D3$(1)
1480 LIMITS T#2,STR(F$(1)),Y,Y1,U,D1
: ERRORX=ERR
: GOSUB '70(X,2)
: IF G=1THEN RETURN
1490 IF D1<>0THEN 1500
: PRINT HEX(07);" ";AT(4,0);F$(1);HEX(0F);" is not on disk ";HEX(0E);D3
$(1);" "
: PRINT "Do you wish to re-input the file name? ( 'Y' or 'N' )";
: C$="Y"
: LINPUT HEX(0E)C$
: IF C$="Y"THEN 1400
: RETURN
1500 PRINT AT(4,0);"File name ";HEX(0E);F$(1);HEX(0F);" located on ";HEX(0E);D
3$(1);" "
: PRINT "First valid data sector = ";HEX(0E);Y
: PRINT "Last valid data sector = ";HEX(0E);Y+U-1
: PRINT "Total number of sectors = ";HEX(0E);U
1510 Y1=Y+U-1
: D1=0
: PRINT AT(9,0,);"Searching for file name ";HEX(0E);F$(2);HEX(0F);" on ";HE
X(0E);D3$(3)
1520 LIMITS T#3,STR(F$(2)),Y2,Y3,U1,D1
: ERRORX=ERR
: GOSUB '70(X,3)
1530 IF D1<>0THEN 1540
: PRINT HEX(07);" ";AT(9,0);F$(2);HEX(0F);" is not on disk ";HEX(0E);D3
$(3);" "
: PRINT "Do you wish to re-input the file name? ( 'Y' or 'N' )";
: C$="Y"
: LINPUT HEX(0E)C$
: IF C$="Y"THEN 1400
: RETURN
1540 PRINT AT(9,0);"File name ";HEX(0E);F$(2);HEX(0F);" located on ";HEX(0E);D
3$(3);" "
: PRINT "First valid data sector = ";HEX(0E);Y2
: PRINT "Last valid data sector = ";HEX(0E);Y2+U1-1
: PRINT "Total number of sectors = ";HEX(0E);U1
: GOSUB 6250
1550 Y3=Y2+U1-1
: R=Y
: I=Y2
: IF U1=UTHEN 1560
: PRINT AT(7,30);" <- ERROR";AT(12,30);"<- ERROR";
: L=1
: IF L$="N"THEN GOSUB '50
: IF G=1THEN RETURN
: IF L$="Y"THEN GOSUB '60
1560 PRINT AT(14,0);"Comparing sector on ";HEX(0E);D3$(1);HEX(0F);" to
sector on ";HEX(0E);D3$(3)
: Y=R
: Y2=I
1570 PRINT AT(14,17);
: G=4
: GOSUB '39(Y)
: GOSUB '40(2,Y)
: W$()=R1$()
: IF G=1THEN RETURN
1580 PRINT AT(14,42);
: G=4
: GOSUB '39(Y2)
: GOSUB '40(3,Y2)
: IF G=1THEN RETURN
1590 IF R1$()=W$()THEN 1610
: L=1
: GOSUB '60
: IF L$="N"OR L$="T"THEN 1600
: GOTO 1570
1600 PRINT AT(16,27);HEX(07);" The sectors are not equal."
: IF L$="T"THEN 1610
: GOSUB '50
: PRINT AT(16,27,26)
: IF G=1THEN RETURN
1610 IF Y=Y1THEN 1620
: Y=Y+1
: Y2=Y2+1
: GOTO 1570
1620 IF L$="N"THEN 1630
: GOSUB '61
: GOTO 1560
1630 PRINT AT(1,1,1680);AT(14,17);BOX(-1,-6);AT(14,42);BOX(-1,-6)
: GOTO 5340
1640 REM % Display sector
1650 H$="DISPLAY A SECTOR ROUTINE"
: GOSUB '35(H$)
: S=S3
: E=1
: IF L$="N"THEN E=0
: IF M$="O"THEN S=E3
1660 PRINT AT(3,4);"0000";AT(4,4);"0032";AT(5,4);"0064";AT(6,4);"0096";AT(7,4)
;"0128";AT(8,4);"0160";AT(9,4);"0192";AT(10,4);"0224";AT(12,4);"0000";AT(
13,4);"0064";AT(14,4);"0128";AT(15,4);"0192"
1670 PRINT AT(20,4);"Disk: ";D3$(1);AT(20,21);"Sector: ";
: GOSUB '39(S)
: PRINT " ";AT(18,70,10);"NOT READY"
1680 L1$=L$
: L$="T"
: GOSUB '40(2,S)
: L$=L1$
: IF G=1THEN RETURN
: IF X=0THEN 1690
: PRINT AT(21,52,27);" ERROR I-";X;"on sector";S;
: IF E=0THEN 1740
: IF M$="O"AND S=S3THEN 1740
: IF S=E3AND M$<>"O"THEN 1740
: GOSUB '50
: IF G=1THEN RETURN
: PRINT AT(22,8,71);
: GOTO 1760
1690 PRINT AT(3,12,68);HEX(06);
: FOR R=1TO 8
: FOR C=1TO 32
: C$=STR(R1$(),C+32*(R-1),1)
: PRINT HEXOF(C$);
: NEXT C
: PRINT AT(3+R,12,68);
: NEXT R
1700 PRINT AT(12,12,68);HEX(06);
: FOR R=1TO 4
: FOR C=1TO 64
: C$=STR(R1$(),C+64*(R-1),1)
: IF C$>HEX(0F)THEN 1710
: C$=HEX(80)
: PRINT HEX(0202020F);
1710 PRINT C$;HEX(0202000F);
: NEXT C
: PRINT AT(12+R,12,68);
: NEXT R
1720 PRINT AT(18,70,10);HEX(060E);"READY"
: GOSUB 6250
1730 IF L$<>"N"AND E<>0THEN 1760
1740 E=0
: PRINT AT(22,8);HEX(06);" RETURN/SF'7 for next sector";AT(22,40);"
BACK SPACE/SF'4 for previous sector";
: C$=" "
: KEYIN C$,,1750
: PRINT AT(22,8,71)
: IF C$=HEX(0D)THEN 1790
: IF C$=HEX(08)THEN 1770
: GOSUB 6290
: IF G=1THEN RETURN
: GOTO 1730
1750 PRINT AT(22,8,79)
: IF C$=HEX(07)THEN 1790
: IF C$=HEX(04)THEN 1770
: GOSUB 6320
: IF G=1THEN RETURN
: GOTO 1730
1760 IF M$<>"O"THEN 1780
: IF S=S3THEN 1740
1770 IF S=0THEN 1740
: S=S-1
: GOTO 1670
1780 IF S=E3THEN 1740
1790 S=S+1
: GOTO 1670
1800 REM % Verify sequential
1810 D=2
: C1$="Y"
: IF M$="A"THEN 2010
: L=0
: IF M$="R"THEN H$="RANDOM VERIFY ROUTINE"
: ELSE H$="SEQUENTIAL VERIFY ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
1820 S=S3
: E=E3
: GOSUB 6250
: IF M$="O"THEN 1850
: IF M$="R"THEN 1860
1830 IF C1$="N"THEN 1840
: PRINT AT(11,15);"Do you want to verify fast? 'Y' or 'N'";
: GOSUB 6300
: IF G=1THEN RETURN
: C1$="N"
: PRINT AT(11,0,79)
: IF C$="Y"THEN 1910
1840 FOR Q=STO E
: GOSUB 1870
: IF G=1THEN Q=E
: NEXT Q
: GOTO 1900
1850 FOR Q=ETO SSTEP -1
: GOSUB 1870
: IF G=1THEN Q=S
: NEXT Q
: GOTO 1900
1860 FOR S=1TO R2
: Q=INT(RND(1)*(E3-S3))+S3
: GOSUB 1870
: IF G=1THEN S=R2
: NEXT S
: GOTO 1900
1870 PRINT AT(13,28);"Device: ";D3$(1);AT(11,18);"Verifying Sector: ";
: GOSUB '39(Q)
1880 L=0
: VERIFY T#2,(Q,Q)L
: GOSUB 6310
: IF G=1OR L=0THEN 1890
: IF C2=0THEN PRINT HEX(07)
: PRINT HEX(06);AT(21,54);" ERROR in sector ";Q$
: E$="VERIFY "
: IF P9$<>"OFF"THEN 5700
: IF L$="N"AND G<>1THEN GOSUB 6240
: GOSUB 5260
1890 IF L=0OR L$="T"OR L$="N"OR G=1THEN RETURN
: GOSUB '60
: GOTO 1880
1900 IF G=1THEN RETURN
: IF L$="N"THEN 5340
: GOSUB '61
: GOTO 1820
1910 PRINT AT(11,37,41);AT(13,28);"Device: ";D3$(1);AT(11,18);"Verifyi
ng Sectors: ";S;"to";E;AT(22,8,)
1920 L=0
: VERIFY T#2,(S,E)L
: GOSUB 6310
: IF G=1OR L=0THEN 1930
: IF C2=0THEN PRINT HEX(07)
: GOSUB '60
: Q=L-1
: PRINT HEX(06);AT(21,54);" ERROR in sector ";L-1
: E$="VERIFY "
: IF P9$<>"OFF"THEN GOSUB 5700
: IF L$<>"N"OR G=1THEN 1930
: GOSUB 6250
: GOSUB '50
1930 IF G=1THEN RETURN
: IF L=0AND L$="N"THEN 5340
: IF L$="E"THEN GOTO 1910
: S=L
: IF S<=EAND L<>0THEN GOTO 1910
: GOSUB '61
: S=S3
: GOTO 1910
1940 REM % Read sequential
1950 D=2
: IF M$="A"THEN GOTO 2070
: IF M$="R"THEN H$="RANDOM READ ROUTINE"
: ELSE H$="SEQUENTIAL READ ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
1960 IF M$="O"THEN 1970
: IF M$="R"THEN 1980
: FOR Q=S3TO E3
: GOSUB 2160
: IF G=1THEN Q=E3
: NEXT Q
: GOTO 1990
1970 FOR Q=E3TO S3STEP -1
: GOSUB 2160
: IF G=1THEN Q=S3
: NEXT Q
: GOTO 1990
1980 FOR I=1TO R2
: Q=INT(RND(1)*(E3-S3))+S3
: GOSUB 2160
: IF G=1THEN I=R2
: NEXT I
: GOTO 1990
1990 IF G=1THEN RETURN
: IF L$="N"THEN 5340
: GOSUB '61
: GOTO 1960
2000 REM % Verify Alternate
2010 L=0
: H$="ALTERNATING VERIFY ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
2020 M=E3-S3
: FOR I=0TO M
: Q=S3+I
: GOSUB 1860
: IF S3+I=E3-ITHEN 2040
2030 Q=E3-I
: GOSUB 1860
: IF G=1THEN I=M
2040 NEXT I
: IF G=1THEN RETURN
: IF L$="N"THEN 2050
: GOSUB '61
: GOTO 2020
2050 GOTO 5340
2060 REM % Read alternate
2070 D=2
: H$="ALTERNATING READ ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
2080 M=E3-S3
: FOR I=0TO M
2090 Q=S3+I
: GOSUB 2160
: IF G=1THEN 2110
2100 Q=E3-I
: GOSUB 2160
2110 IF G=1THEN RETURN
: IF S3+I>E3-ITHEN I=M
2120 NEXT I
2130 IF G=1THEN RETURN
: IF L$="N"THEN 2140
: GOSUB '61
: GOTO 2080
2140 IF G=1THEN RETURN
: PRINT AT(4,0,30);HEX(0E);
2150 GOTO 5340
2160 PRINT AT(13,28);"Device: ";D3$(1);AT(11,20);"Reading Sector: ";
: GOSUB '39(Q)
2170 GOSUB '40(2,Q)
: IF G=1OR X=0OR L$="N"OR L$="T"THEN 2180
: GOSUB '60
: GOTO 2170
2180 IF G=1THEN RETURN
: IF X<>0THEN 2300
: IF R1<>0THEN 2190
: IF STR(W1$(),1,6)=STR(R1$(),1,6)AND STR(W1$(),8,249)=STR(R1$(),8,249)THEN
RETURN
2190 IF R1$()=W1$()THEN RETURN
2200 GOSUB '60
: PRINT AT(15,10);" ERROR Data read from sec. ";Q$;" does not equ
al hex pattern";
: E$="COMPARE"
: IF P9$<>"OFF"THEN GOSUB 5700
: IF L$="N"THEN 2220
2210 L=3
: GOTO 2300
2220 L=3
2230 FOR B=1TO 256
: IF STR(R1$(),B,1)=STR(W1$(),B,1)THEN 2290
: IF R1=0AND B=7AND STR(R1$(),7,1)=HEX(FF)THEN 2290
: PRINT AT(17,18);HEX(06);"Read byte is hex(";HEX(0E);HEXOF(STR(R1$(),B,1))
;HEX(0F);")";AT(18,14);"Expected byte is hex(";HEX(0E);HEXOF(STR(W1$(),B,
1));HEX(0F);")"
2240 W$()=R1$()
: GOSUB 2270
: N1$=C9$
: PRINT AT(17,38);", in binary is ";N1$
: W$()=W1$()
: GOSUB 2270
: PRINT AT(18,38);", in binary is ";C9$
: PRINT AT(19,17);HEX(07);"Byte";HEX(0E);B;HEX(0F);"bits not equal (<>)
"
: FOR I1=1TO 8
: IF STR(N1$,I1,1)=STR(C9$,I1,1)THEN 2250
: PRINT AT(19,52+I1,8);HEX(0E);"^";
2250 NEXT I1
2260 C$=" "
: PRINT AT(22,8,50);HEX(06);" CTNUE for next sector";
: GOSUB '52
: GOSUB 6300
: IF G=1THEN 2300
: IF C$=HEX(0D)OR C$=HEX(82)THEN 2290
: IF C$<>HEX(84)THEN 2260
: PRINT AT(15,0,400);AT(22,8,60)
2270 C9$=ALL(30)
: C$=HEX(01)
: FOR I1=1TO 8
: ROTATEC(C$,-1)
: L1$=STR(W$(),B,1)AND C$
2280 IF L1$<>HEX(00)THEN STR(C9$,I1,1)=HEX(31)
: NEXT I1
: GOTO 2300
2290 IF B<>256THEN GOSUB '60
: NEXT B
2300 IF L$="N"OR L$="T"THEN RETURN
: GOSUB '60
: GOTO 2170
2310 REM % Position heads
2320 L=0
: D=2
: Q=S3
: H$="HEAD POSITIONING ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
2330 CONVERT (INT(Q/T2))TO A2$,(####)
: PRINT AT(13,29);"Track ";HEX(08);BOX(1,5);" ";A2$;AT(11,12);"Head
s loaded on sector ";
: GOSUB '39(Q)
2340 PRINT AT(22,8);HEX(06);" RETURN/SF'7 for next sector ";AT(22,40);"
BACK SPACE/SF'4 for previous sector";
2350 VERIFY T#D,(Q,Q)L
: ERRORL=ERR
2360 C$=" "
: KEYIN C$,2370,2380
2370 IF C$=HEX(0D)THEN 2390
: IF C$=HEX(08)THEN 2400
: GOSUB 6290
: IF G=1THEN RETURN
: GOTO 2350
2380 IF C$=HEX(07)THEN 2390
: IF C$=HEX(04)THEN 2400
: GOSUB 6320
: IF G=1THEN RETURN
: GOTO 2350
2390 Q=Q+T2
: GOTO 2330
2400 IF Q<T2THEN 2350
: Q=Q-T2
: GOTO 2330
2410 REM % Enable/Disable
2420 E$="ENABLING"
: GOTO 2440
2430 E$="LOCKING"
2440 D=2
: T(3)=90000
: PRINT AT(5,32,13);E$;
2450 GOSUB '40(2,0)
: IF G=1THEN RETURN
: IF X<>0THEN 2470
: IF STR(H$,12,1)="L"AND STR(R1$(),7,1)<>HEX(FF)THEN 5340
: IF STR(H$,12,1)="E"THEN STR(R1$(),7,1)=HEX(FF)
: ELSE STR(R1$(),7,1)=HEX(00)
: GOSUB '41(2,0,R1$())
: IF G=1OR X=0THEN 2460
: GOTO 2470
2460 REM GO BYE BYE
: GOSUB 740
: IF STR(E3$,1,2)<>"I-"THEN GOSUB 5150
: GOTO 850
2470 H$="DISK WRITE ENABLE/LOCK ROUTINE"
: GOSUB '35(H$)
: PRINT AT(12,28,50);"Error ";E$;" disk ";D3$(1);HEX(0F)
: PRINT AT(13,18);"Do you want to Format this disk? ('Y' OR 'N')";
: GOSUB 6300
: IF C$="Y"THEN 2660
: IF C$<>"N"THEN 2470
: RETURN
2490 REM % Scratch
2500 D=2
: H$="DISK SCRATCH ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
: GOSUB '34(0)
: IF G=1THEN RETURN
2510 A2$="00024"
: IF E3>52606THEN A2$="00050"
: CONVERT E3TO B$,(#####)
: PRINT AT(4,0,)
2520 PRINT AT(12,7);"How many sectors do you wish to dedicate to catalog index
area?";AT(22,36);" RETURN/RUN to continue";
: R=12
: Y=72
: I5=5
: GOSUB 6360
: IF G=1THEN RETURN
: ON G1GOTO 2530,2520,2520,2520,2520
2530 CONVERT A2$TO U
: ERRORGOTO 2520
2540 IF U<1THEN 2520
: PRINT AT(13,7);"How many sectors do you wish to dedicate to catalog area?
";
: R=13
: Y=72
: I5=5
: A2$=B$
: GOSUB 6360
: IF G=1THEN RETURN
: ON G1GOTO 2550,2540,2540,2540,2540
2550 CONVERT A2$TO U1
: ERRORGOTO 2540
2560 IF U>U1THEN 2520
2570 PRINT HEX(06);AT(4,0,);" Device address = \A0";HEX(0E);D3$(1);"\A0";HEX
(0F);AT(5,0);"Last index sector = ";HEX(0E);U-1;HEX(0F);AT(6,0);" Ca
talog end = ";HEX(0E);U1;"";
2580 PRINT AT(12,25,220);" SCRATCHING";
: SCRATCH DISK T#2,LS=U,END =U1
: ERRORX=ERR
: H$="SCRAT"
: GOSUB 6250
: GOSUB '70(X,2)
: GOTO 2620
2590 PRINT AT(12,25);"Verifying disk scratch on ";HEX(0E);D3$(1)
: INIT(00)W2$()
: STR(W2$(),1,2),STR(W2$(),3,2)=BIN(U,2)
: STR(W2$(),5,2)=BIN(U1+1,2)
2600 GOSUB '40(2,0)
: IF G=1THEN RETURN
: IF X<>0THEN 2620
2610 GOSUB 6250
: IF R1$()=W2$()THEN 2630
2620 IF L$<>"N"THEN 2640
: PRINT HEX(0706);AT(12,25,220);"Disk did not scratch properly.";AT(13,25);
"Key return to re-scratch";
: GOSUB '50
: IF G=1THEN RETURN
: GOTO 2580
2630 GOSUB 2700
: IF X=0THEN 5340
2640 GOSUB '60
: GOSUB 6310
: IF G=1THEN RETURN
2650 IF L$="N"THEN 5340
: GOSUB '61
: GOTO 2580
2660 REM % Format disk
: H$="DISK FORMAT ROUTINE"
: G1=9
: GOSUB '35(H$)
2670 GOSUB '34(0)
: IF G=1THEN RETURN
2680 GOSUB 5620
: IF G=1OR C$=HEX(84)THEN RETURN
2690 PRINT AT(22,1,79)
: GOSUB 6250
: GOSUB 2700
: IF X<>0THEN GOSUB '60
: GOTO 5340
2700 REM Rewrite write enable
: GOSUB '40(2,0)
: STR(R1$(),7,1)=HEX(FF)
: GOSUB '41(2,0,R1$())
: RETURN
2710 REM % Write sequential
2720 IF M$="A"THEN 2920
: I1=1
: IF M$="R"THEN H$="RANDOM WRITE ROUTINE"
: ELSE H$="SEQUENTIAL WRITE ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
: GOSUB '34(0)
: IF G=1THEN RETURN
2730 PRINT AT(8,0,80)
2740 IF M$="R"THEN 2760
: IF M$="O"THEN 2750
: FOR Q=S3TO E3
: GOSUB 2770
: IF G=1THEN Q=E3
: NEXT Q
: GOTO 2830
2750 FOR Q=E3TO S3STEP -1
: GOSUB 2770
: IF G=1THEN Q=S3
: NEXT Q
: GOTO 2830
2760 FOR S=1TO R2
: Q=INT(RND(1)*(E3-S3))+S3
: GOSUB 2770
: IF G=1OR C$=HEX(0D)THEN S=R2
: NEXT S
: GOTO 2830
2770 PRINT AT(13,28);"Device: ";D3$(1);AT(11,20);"Writing Sector: ";
: GOSUB '39(Q)
: IF R3$<>HEX(D0)OR I1<>1OR M$<>"I"THEN 2790
2780 GOSUB '200(D)
: IF X=0THEN GOTO 2790
: GOSUB '70
: RETURN
2790 GOSUB 6310
: IF G=1THEN RETURN
2800 GOSUB '41(2,Q,W1$())
: IF I1<>-1THEN I1=I1+1
: IF X=0OR L$="T"OR L$="N"THEN 2810
: IF R3$=HEX(D0)AND C2=0AND M$="I"THEN GOSUB '201
: GOSUB '60
: GOTO 2790
2810 IF M$<>"I"OR R3$=HEX(C0)OR I1<8OR I1=-1THEN 2820
: I1=1
: GOSUB '201(D)
2820 RETURN
2830 IF I1<>0AND R3$=HEX(D0)THEN GOSUB '201(D)
: IF G=1THEN RETURN
: IF L$="N"THEN 5340
: GOSUB '61
: GOTO 2730
2840 REM % Read after write sequential
2850 I1=-1
: IF M$="A"THEN 2980
: R1=0
: H$="SEQUENTIAL READ AFTER WRITE ROUTINE"
: IF M$="R"THEN H$="RANDOM READ AFTER WRITE ROUTINE"
2860 GOSUB '35(H$)
: T(3)=90000
: D=2
: GOSUB '34(0)
: IF G=1THEN RETURN
2870 IF M$="O"THEN 2880
: IF M$="R"THEN 2890
: FOR Q=S3TO E3
: GOSUB 2770
: IF G=1THEN RETURN
: GOSUB 2160
: IF G=1THEN RETURN
: NEXT Q
: GOTO 2900
2880 FOR Q=E3TO S3STEP -1
: GOSUB 2770
: IF G=1THEN RETURN
: GOSUB 2160
: IF G=1THEN RETURN
: NEXT Q
: GOTO 2900
2890 FOR I=1TO R2
: Q=INT(RND(1)*(E3-S3))+S3
: GOSUB 2770
: IF G=1THEN RETURN
: GOSUB 2160
: IF G=1THEN RETURN
: NEXT I
: GOTO 2900
2900 IF L$="N"THEN 5340
: GOSUB '61
: GOTO 2870
2910 REM % Write alternate
2920 I1=-1
: H$="ALTERNATING WRITE ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
: GOSUB '34(0)
: IF G=1THEN RETURN
2930 PRINT AT(8,0,80)
: M=E3-S3
: FOR I=0TO M
2940 Q=S3+I
: GOSUB 2770
: IF G=1THEN RETURN
2950 Q=E3-I
: GOSUB 2770
: IF G=1THEN RETURN
: IF S3+I>E3-ITHEN I=M
2960 NEXT I
: IF L$="N"THEN 5340
: GOSUB '61
: GOTO 2930
2970 REM % Read after write alternate
2980 H$="ALTERNATING READ AFTER WRITE ROUTINE"
: GOSUB '35(H$)
: T(3)=90000
: D=2
: GOSUB '34(0)
: IF G=1THEN RETURN
2990 M=E3-S3
: FOR I=0TO M
3000 Q=S3+I
: GOSUB 2770
: IF G=1THEN RETURN
: GOSUB 2160
: IF G=1THEN RETURN
3010 Q=E3-I
: GOSUB 2770
: IF G=1THEN RETURN
: GOSUB 2160
: IF G=1THEN RETURN
: IF S3+I>E3-ITHEN I=M
3020 NEXT I
: IF L$="N"THEN 5340
: GOSUB '61
: GOTO 2990
3030 REM % INSTRUCTION EXERCISER
3040 G1=0
: D=2
: Y2$="DATA2"
: Y3$="DATA3"
: A3$()=ALL("1")
: A4$()=ALL("2")
: X(1)=10/3
: X(2)=X(1)
: Q0$=ALL("4")
3050 H$="DISK INSTRUCTION EXERCISER"
: GOSUB '35(H$)
: I1=-1
: GOSUB '34(0)
: IF G=1THEN RETURN
3060 GOSUB 6250
: PRINT " ";AT(10,7);"WARNING: \C1\CC\CC resident data will be DESTRO
YED by this exercise "
3065 IF E3-S3<=15THEN PRINT AT(12,10);"Start sector must be at least 17 less t
han the end sector"
: GOSUB '50
: IF G=1OR E3-S3<=15THEN RETURN
: PRINT AT(10,0,240);AT(22,8,42)
3070 K$(1)="DATA SAVE DA"
3080 K$(2)="DATA LOAD DA"
3090 K$(3)="DATA SAVE BA"
3100 K$(4)="DATA LOAD BA"
3110 K$(5)="SCRATCH DISK"
3120 K$(6)="MOVE END"
3130 K$(7)="LIMITS"
3140 K$(8)="VERIFY"
3150 K$(9)="SCRATCH FILES"
3160 K$(10)="DATASAVE DC OPEN"
3170 K$(11)="DATASAVE DC CLOSE"
3180 K$(12)="DATA LOAD DC OPEN"
3190 K$(13)="DSKIP"
3200 K$(14)="DBACKSPACE"
3210 K$(15)="DATALOAD DC"
3220 FOR I=1TO 15
: PRINT AT(I+2,30);K$(I)
: NEXT I
3230 C=0
: GOSUB '32(C)
: GOTO 3240
3240 REM DATA SAVE DA
: E=0
3250 GOSUB 6310
: IF G=1THEN 4830
: DATA SAVE DA T#1,(S3,S)S3,A3$(),X(),A4$(),X1(),"ABC",Q0$
: ERRORX=ERR
: GOSUB '64
3260 IF S<>S3+1THEN 3340
: DATA SAVE DA T#1,(S,S)END
: ERRORX=ERR
: GOSUB '64
3270 DATA SAVE DA T$#2,(S,C1$)S,A3$(),X(),A4$(),X1(),"ABC",Q0$
: ERRORX=ERR
: GOSUB '64
3280 S=S3+3
: IF VAL(C1$,2)<>STHEN 3340
: IF G=1THEN 3250
: DATA SAVE DA T$#2,(S,C1$)END
: ERRORX=ERR
: GOSUB '64
3290 GOSUB 6310
: IF G=1THEN 4830
: S=S3+4
: DATA SAVE DA T$#5,(C1$,C1$)S,A3$(),X(),A4$(),X1(),"ABC",Q0$
: ERRORX=ERR
: GOSUB '64
3300 IF VAL(C1$,2)<>S+1THEN 3340
: IF G=1THEN 3250
: DATA SAVE DA T$#5,(C1$,C1$)END
: ERRORX=ERR
: GOSUB '64
3310 S=S3+6
: DATA SAVE DA T$#2,(C1$,S)S,A3$(),X(),A4$(),X1(),"ABC",Q0$
: ERRORX=ERR
: GOSUB '64
3320 IF VAL(C1$,2)+1<>STHEN 3340
: C1$=BIN(S,2)
: DATA SAVE DA T#2,(C1$,S)END
: ERRORX=ERR
: GOSUB '64
3330 GOTO 3350
3340 IF C2=0THEN GOSUB 5070
3350 IF C2=0OR L$<>"E"THEN 3360
: GOSUB '61
: GOTO 3230
3360 C=1
: GOSUB '32(C)
: %
3370 REM DATA LOAD DA
: E=0
3380 GOSUB 6310
: IF G=1THEN 4830
: DATA LOAD DA T#2,(S3,S)I,A3$(),X(),A4$(),X1(),H$,Q0$
: ERRORX=ERR
: GOSUB '64
3390 IF I<>S3THEN 3470
3400 S=S3+2
: DATA LOAD DA T#1,(S,C1$)I,A3$(),X(),A4$(),X1(),H$,Q0$
: ERRORX=ERR
: GOSUB '64
3410 IF I<>STHEN 3470
3420 GOSUB 6310
: IF G=1THEN 4830
: C1$=BIN(S3+4,2)
: DATA LOAD DA T#5,(C1$,C1$)I,A3$(),X(),A4$(),X1(),H$,Q0$
: ERRORX=ERR
: GOSUB '64
3430 IF I<>VAL(C1$,2)-1THEN 3470
3440 C1$=BIN(S3+6,2)
: DATA LOAD DA T#4,(C1$,S)I,A3$(),X(),A4$(),X1(),H$,Q0$
: ERRORX=ERR
: GOSUB '64
3450 IF I<>S-1THEN 3470
3460 GOTO 3490
3470 IF C2=0THEN GOSUB 5070
3480 IF C2=0OR L$<>"E"THEN 3490
: GOSUB '61
: GOTO 3360
3490 C=2
: GOSUB '32(C)
: %
3500 REM DATA SAVE BA
: E=0
3510 CONVERT S3TO STR(C$(1),1,2),(##)
: ERRORX=ERR
3520 GOSUB 6310
: IF G=1THEN 4830
3530 DATA SAVE BA T#2,(S3,S)C$()
: ERRORX=ERR
: GOSUB '64
3540 IF S<>S3+1THEN 3640
: CONVERT STO STR(C$(1),1,2),(##)
: ERRORX=ERR
3550 DATA SAVE BA T$#2,(S,C1$)C$()
: ERRORX=ERR
: GOSUB '64
3560 IF VAL(C1$,2)<>S+1THEN 3640
: IF G=1THEN 3510
3570 GOSUB 6310
: IF G=1THEN 4830
: CONVERT S3+2TO STR(C$(1),1,2),(##)
: ERRORX=ERR
3580 DATA SAVE BA T$#2,(C1$,C1$)C$()
: ERRORX=ERR
: GOSUB '64
3590 IF VAL(C1$,2)<>S3+3THEN 3640
: IF G=1THEN 3510
3600 CONVERT S3+3TO STR(C$(1),1,2),(##)
: ERRORX=ERR
3610 DATA SAVE BA T#2,(C1$,V0)C$()
: ERRORX=ERR
: GOSUB '64
3620 IF V0<>S3+4THEN 3640
3630 GOTO 3660
3640 IF C2=0THEN GOSUB 5070
3650 IF C2=0OR L$<>"E"THEN 3660
: GOSUB '61
: GOTO 3490
3660 C=3
: GOSUB '32(C)
: %
3670 REM DATA LOAD BA
: E=0
: GOSUB '47(1,2,S3)
: GOSUB '47(4,1,S3+1)
: GOSUB '47(5,3,S3+2)
: GOSUB '47(4,4,S3+3)
3680 IF C2=0OR L$<>"E"THEN 3690
: GOSUB '61
: GOTO 3660
3690 C=4
: GOSUB '32(C)
: GOTO 3820
: %
3700 DEFFN'47(F,T,S)
3710 GOSUB 6310
: IF G=1THEN 3720
: C1$=BIN(S,2)
: ON TGOTO 3730,3760,3780,3800
: GOTO 5090
3720 RETURN CLEAR
: GOTO 4830
3730 DATA LOAD BA T#F,(S,V2)C$()
: ERRORX=ERR
: GOSUB '64
3740 CONVERT STR(C$(1),1,2)TO V0
: ERRORX=ERR
3750 IF V2<>V0+1THEN 5070
: RETURN
3760 DATA LOAD BA T#1,(S,C1$)C$()
: ERRORX=ERR
: GOSUB '64
3770 V2=VAL(C1$,2)
: GOTO 3740
3780 DATA LOAD BA T#F,(C1$,C1$)C$()
: ERRORX=ERR
: GOSUB '64
3790 GOTO 3770
3800 DATA LOAD BA T#F,(C1$,V2)C$()
: ERRORX=ERR
: GOSUB '64
3810 GOTO 3740
: %
3820 REM SCRATCH DISK
: E=0
3830 GOSUB 6310
: IF G=1THEN 4830
: SCRATCH DISK T#D,LS=2,END =E3-1
: ERRORX=ERR
: GOSUB '64
3840 GOSUB '44(2,2,E3-1)
: IF G=1THEN 4830
: GOSUB '53(1)
3850 GOSUB 6310
: IF G=1THEN 4830
: SCRATCH DISK T#D,LS=3,END =E3
: ERRORX=ERR
: GOSUB '64
3860 GOSUB '44(3,3,E3)
: IF G=1THEN 4830
: GOSUB '53(1)
: IF L$<>"E"OR C2=0THEN 3870
: GOSUB '60
: GOTO 3690
3870 C=5
: GOSUB '32(C)
: %
3880 REM MOVE END
: E=0
3890 MOVE END T#D=E3-1
: ERRORX=ERR
: GOSUB '64
3900 GOSUB '44(3,3,E3-1)
: IF G=1THEN 3890
3910 GOSUB 6310
: IF G=1THEN 4830
: MOVE END T#D=E3
: ERRORX=ERR
: GOSUB '64
3920 GOSUB '44(3,3,E3)
: IF G=1THEN 4830
: IF E>0THEN 3980
: IF L$<>"E"OR C2=0THEN 3930
: GOSUB '61
: GOTO 3870
3930 C=6
: GOSUB '32(C)
: GOTO 3980
3940 DEFFN'53(V1)
: V0=0
: T=17
3950 DATA LOAD BA T#1,(V0,V0)C$()
: ERRORX=ERR
: GOSUB '64
3960 MAT SEARCHC$()<T,256-T+1>,<>HEX(00)TO L2$()
: T=1
: IF L2$(1)>HEX(0000)THEN 5070
: IF V0<=V1THEN 3950
: RETURN
3970 REM LIMITS
3980 DATA SAVE DC OPEN T$#5,5,STR(Y3$,1,5)
: ERRORX=ERR
: GOSUB '64
3990 GOSUB 6310
: IF G=1THEN 4830
: DATA SAVE DC OPEN T#D,D*3,Y2$
: ERRORX=ERR
: GOSUB '64
4020 DATA SAVE DC OPEN T$#1,4,"DATA1"
: ERRORX=ERR
: GOSUB '64
4030 GOSUB '45(1,2)
: GOSUB '45(D,4)
: GOSUB '45(5,2)
: E=0
4040 LIMITS T#D,Y2$,V1,V2,X(1)
: ERRORX=ERR
: GOSUB '64
4050 GOSUB '42(V1,V2,X(1),8,13,6)
: IF G=1THEN 4040
4060 GOSUB 6310
: IF G=1THEN 4830
: LIMITS T#5,STR(Y3$,1,5),X1(1,1),V2,V3
: ERRORX=ERR
: GOSUB '64
4070 GOSUB '42(X1(1,1),V2,V3,3,7,4)
: IF G=1THEN 4060
: IF L$<>"E"OR C2=0THEN 4080
: GOSUB '61
: GOTO 3930
4080 C=7
: GOSUB '32(C)
: GOTO 4150
: %
4090 DEFFN'44(V1,V2,V3)
: DATA LOAD BA T#1,(0,C1$)C$()
: ERRORX=ERR
: GOSUB '64
4095 GOSUB 6310
: IF G=1THEN RETURN
: IF V1<>VAL(STR(C$(1),2,1))THEN 5070
4120 V0=VAL(STR(C$(1),3,2),2)
: IF V2<>V0THEN 5070
4130 V0=VAL(STR(C$(1),5,2),2)
: IF V3<>V0-1THEN 5070
: FOR I=1TO 10
: IF STR(C$(1),6+I,1)<>HEX(00)THEN 5070
: NEXT I
: RETURN
4150 REM VERIFY
: E=0
: VERIFY T#2,(S3,S3+8)L
: GOSUB 6310
: IF G=1THEN 4830
: IF L<>0THEN 4160
: VERIFY T#4,(S3,S3+15)L
: IF L=0THEN 4170
4160 GOSUB 5070
: GOSUB '60
: IF L$<>"E"OR C2=0THEN 4170
: GOSUB '61
: GOTO 4080
4170 C=8
: GOSUB '32(C)
4180 REM SCRATCH FILES
: E=0
4190 SCRATCH T#D,Y2$
: ERRORX=ERR
: GOSUB '64
4200 GOSUB '43(Y2$)
4210 GOSUB 6310
: IF G=1THEN 4830
: SCRATCH T#1,"DATA1",STR(Y3$,1,5)
: ERRORX=ERR
: GOSUB '64
4220 GOSUB '43("DATA1")
: GOSUB '43(STR(Y3$,1,5))
: IF C2=0OR L$<>"E"THEN 4230
: GOSUB 5070
: GOSUB '63
: GOTO 4170
4230 C=9
: GOSUB '32(C)
: GOTO 4280
4240 DEFFN'43(N$)
: N1$=N$
: XOR (STR(N1$,2),N1$)
: C$=STR(N1$,8,1)
: ADDC(C1$,C$)
: ADDC(C1$,C$)
: ADDC(C1$,C$)
: ADD(STR(C1$,1,1),STR(C1$,2,1))
: S=VAL(C1$)-INT(VAL(C1$)/3)*3
4250 DATA LOAD BA T#1,(S,C1$)C$()
: ERRORX=ERR
: GOSUB '64
4260 MAT SEARCHC$(),=STR(N$,1,8)TO L2$()STEP 8
: IF L2$(1)<>HEX(0000)THEN 4270
: S=S-1
: IF S>=0THEN 4250
: S=2
: GOTO 4250
4270 GOSUB '62(L2$(1))
: V1=INT(V0/16)
: V2=V0-V1*16
: IF STR(C$(V1+1),1,1)<>HEX(11)THEN 5070
: RETURN
4280 REM DATASAVE DC OPEN
: E=0
4290 SCRATCH DISK T#2,LS=3,END =E3-3
: ERRORX=ERR
: GOSUB '64
4300 DATA SAVE DC OPEN T#1,3,"DATA1"
: ERRORX=ERR
: GOSUB '64
4310 GOSUB 6310
: IF G=1THEN 4830
: SCRATCH T#1,"DATA1"
: ERRORX=ERR
: GOSUB '64
4320 DATA SAVE DC OPEN T#1,"DATA1","DATA1"
: ERRORX=ERR
: GOSUB '64
4330 GOSUB '45(1,1)
4340 DATA SAVE DC OPEN T$#D,3,Y2$
: ERRORX=ERR
: GOSUB '64
4350 GOSUB '45(D,1)
4360 DATA SAVE DC OPEN T#4,3,STR(Y3$,1,5)
: ERRORX=ERR
: GOSUB '64
4370 GOSUB '45(4,1)
4380 DATA SAVE DC OPEN T$#5,3,"DATA5"
: ERRORX=ERR
: GOSUB '64
4390 GOSUB '45(5,1)
4400 DATA SAVE DC OPEN T#4,TEMP,E3-2,E3
: ERRORX=ERR
: GOSUB '64
4410 GOSUB '45(4,1)
: GOSUB '48("DATA1",3,5,3)
: GOSUB '48(Y2$,6,8,3)
: GOSUB '48(STR(Y3$,1,5),9,11,3)
4415 IF C2=0OR L$<>"E"THEN 4420
: GOSUB '61
: GOTO 4230
4420 C=10
: GOSUB '32(C)
: GOTO 4460
: %
4430 DEFFN'48(N$,V1,V2,V3)
4440 GOSUB 6310
: IF G=1THEN 4830
: LIMITS T#D,N$,A,B,C
: ERRORX=ERR
: GOSUB '64
: IF G=1THEN 4440
4450 GOSUB '42(V1,V2,V3,A,B,C)
: IF G<>1THEN RETURN
: RETURN CLEAR
: GOTO 4290
: %
4460 REM DATASAVE DC CLOSE
: E=0
4470 DATA SAVE DC CLOSE#4
: ERRORX=ERR
: GOSUB '64
: IF G=1THEN 4470
4480 GOSUB '49(4,0,0,0)
: IF G=1THEN 4470
4490 DATA SAVE DC CLOSE#D
: ERRORX=ERR
: GOSUB '64
4500 GOSUB '49(D,0,0,0)
: IF G=1THEN 4490
4510 DATA SAVE DC CLOSEALL
: ERRORX=ERR
: GOSUB '64
4520 GOSUB '49(1,0,0,0)
: GOSUB '49(5,0,0,0)
: FOR I=1TO 200
: NEXT I
: IF C2=0OR L$<>"E"THEN 4530
: GOSUB '61
: GOTO 4420
4530 C=11
: GOSUB '32(C)
: %
4540 REM DATALOAD DC OPEN
: E=0
4550 DATA LOAD DC OPEN T#1,"DATA1"
: ERRORX=ERR
: GOSUB '64
4560 GOSUB 6310
: IF G=1THEN 4830
: DATA LOAD DC OPEN T#D,Y2$
: ERRORX=ERR
: GOSUB '64
4570 DATA LOAD DC OPEN T#5,"DATA5"
: ERRORX=ERR
: GOSUB '64
4580 DATA LOAD DC OPEN T#4,TEMP,E3-2,E3
: ERRORX=ERR
: GOSUB '64
4590 GOSUB '49(1,3,5,3)
: GOSUB '49(2,6,8,6)
4600 GOSUB '49(4,E3-2,E3,E3-2)
: GOSUB '49(5,12,14,12)
: IF C2=0OR L$<>"E"THEN 4610
: GOSUB '61
: GOTO 4530
4605 REM DATALOAD DC
: E=0
: GOSUB '54(4,1)
: GOSUB '54(1,5)
: GOSUB '54(2,5)
: GOSUB '54(5,5)
: IF C2=0OR L$<>"E"THEN 4610
: GOSUB '61
: GOTO 4530
4610 C=12
: GOSUB '32(C)
: GOTO 4650
: %
4620 DEFFN'49(F,V1,V2,V3)
: GOSUB 6310
: IF G=1THEN 4830
4630 LIMITS T#F,A,B,C3
: ERRORX=ERR
: GOSUB '64
4640 GOSUB '42(V1,V2,V3,A,B,C3)
: RETURN
: %
4650 REM DSKIP
: E=0
: GOSUB '55(1,1,2,5)
: GOSUB '55(2,2,1,7)
: GOSUB '55(4,1,3,E3)
: GOSUB '55(5,3,0,13)
: IF C2=0OR L$<>"E"THEN 4660
: GOSUB '61
: GOTO 4610
4660 C=13
: GOSUB '32(C)
: GOTO 4760
4665 ELSE M3$="2200DS WIN "
: IF STR(D3$(1),3,1)="F"THEN 470
4670 DEFFN'55(F,T,V1,M)
: GOSUB 6310
: IF G=1THEN 3720
4680 ON TGOTO 4690,4720,4730
: GOTO 5090
4690 DSKIP #F,V1S
: ERRORX=ERR
: GOSUB '64
4700 LIMITS T#F,A,B,I
: ERRORX=ERR
: GOSUB '64
4710 IF I<>MTHEN 5070
: RETURN
4720 DSKIP #F,V1
: ERRORX=ERR
: GOSUB '64
4725 GOTO 4700
4730 DSKIP #F,END
: ERRORX=ERR
: GOSUB '64
4740 LIMITS T#F,A,B,C3
: ERRORX=ERR
: GOSUB '64
4750 IF M<>C3THEN 5070
: RETURN
: %
4760 REM DBACKSPACE
: E=0
: GOSUB '51(1,1,1,4)
: GOSUB '51(2,1,1,6)
: GOSUB '51(4,3,0,E3-2)
: GOSUB '51(5,2,2,12)
: IF C2=0OR L$<>"E"THEN 4770
: GOSUB '61
: GOTO 4660
4770 C=14
: GOSUB '32(C)
: GOTO 4820
4780 DEFFN'51(F,T,V1,M)
: GOSUB 6310
: IF G=1THEN 3720
: ON TGOTO 4790,4800,4810
: GOTO 5090
4790 DBACKSPACE #F,V1S
: ERRORX=ERR
: GOSUB '64
4795 GOTO 4700
4800 DBACKSPACE #F,V1
: ERRORX=ERR
: GOSUB '64
4805 GOTO 4700
4810 DBACKSPACE #F,BEG
: ERRORX=ERR
: GOSUB 4700
4815 GOTO 4700
4820 REM DATALOAD DC
: E=0
: GOSUB '54(4,1)
: GOSUB '54(1,1)
: GOSUB '54(2,1)
: GOSUB '54(5,1)
: IF C2=0OR L$<>"E"THEN 4840
: GOSUB '61
: GOTO 4770
4830 G1=99
4840 GOSUB '40(2,0)
: STR(R1$(),7,1)=HEX(FF)
: GOSUB '41(2,0,R1$())
: IF G1=99THEN RETURN
: C=15
: GOSUB '32(C)
: IF L$<>"N"THEN 4870
4850 PRINT AT(20,29);BOX(1,20);" Device ";D3$(D);" COMPLETE"
4860 GOSUB '50
: G=1
: RETURN
4870 GOSUB '61
: GOTO 3230
4880 DEFFN'54(F,V1)
: GOSUB 6310
: IF G=1THEN 3720
4890 DATA LOAD DC #F,I,A3$(),X(),A4$()
: ERRORX=ERR
: GOSUB '64
4900 IF I<>V1THEN 5070
: IF G=1THEN 4890
: RETURN
4920 DEFFN'45(F,V1)
: GOSUB 6310
: IF G=1THEN 3720
: FOR I=1TO V1
: IF F<>0THEN 4930
: T=3
: GOTO 4940
4930 T=T+1
: IF T<3THEN 4940
: T=1
4940 ON TGOTO 4990,4970,4990
: GOTO 5090
4970 IF V1=ITHEN 4975
: DATA SAVE DC $#F,I,A3$(),X(),A4$(),X1(),Q0$,"ABC",I+1,A3$(),X(),A4$(),X1(
),Q0$,"ABC"
: ERRORX=ERR
: GOSUB '64
4971 I=I+1
: GOTO 4980
4975 DATA SAVE DC $#F,I,A3$(),X(),A4$(),X1(),Q0$,"ABC"
: ERRORX=ERR
: GOSUB '64
4980 NEXT I
: DATA SAVE DC $#F,END
: ERRORX=ERR
: GOSUB '64
4985 RETURN
4990 IF V1=ITHEN 4995
: DATA SAVE DC #F,I,A3$(),X(),A4$(),X1(),Q0$,"ABC",I+1,A3$(),X(),A4$(),X1()
,Q0$,"ABC"
: ERRORX=ERR
: GOSUB '64
4991 I=I+1
: GOTO 5000
4995 DATA SAVE DC #F,I,A3$(),X(),A4$(),X1(),Q0$,"ABC"
: ERRORX=ERR
: GOSUB '64
5000 NEXT I
: DATA SAVE DC #F,END
: ERRORX=ERR
: GOSUB '64
5010 RETURN
5050 DEFFN'42(V1,V2,V3,A,B,C3)
: IF V1<>ATHEN 5070
: IF V2<>BTHEN 5070
: IF V3<>C3THEN 5070
: RETURN
5060 DEFFN'62(C1$)
: V0=VAL(C1$,2)
: RETURN
5070 GOSUB 5080
: GOTO 5300
5080 IF E=0THEN PRINT AT(C+3,24);"ERROR";
: GOSUB '60
: RETURN
5090 STOP "SYS ERROR"
5100 %
5110 DEFFN'32(I)
: IF I<>0THEN 5120
: I=1
: GOTO 5130
5120 PRINT AT(I+2,29);BOX(-1,-((LEN(K$(I)))+1));" ";K$(I);
: I=I+1
: IF I>15AND L$="N"THEN RETURN
: IF I>15THEN I=1
5130 PRINT AT(I+2,29);BOX(1,LEN(K$(I))+1);" ";K$(I);"";
: RETURN
5140 DEFFN'34(Z1)
: H$="CHECK"
: GOSUB '40(2,0)
: IF X=0THEN 5160
: PRINT HEX(070E);AT(15,10);D3$(D);" write enable can't be determined! Pr
oceed with caution!"
: GOSUB '50
: INIT(20)H$
: PRINT AT(15,10,69);
: IF G=1THEN 5170
: RETURN
5150 H$="CHECK"
: GOSUB '40(2,0)
: IF X<>0THEN RETURN
: IF STR(R1$(),7,1)=HEX(FF)THEN PRINT AT(5,32);" WRITE ENABLED"
: ELSE PRINT AT(5,32);" WRITE LOCKED"
: RETURN
5160 IF STR(R1$(),7,1)=HEX(FF)THEN RETURN
: PRINT HEX(070E);AT(11,26);D$;HEX(0F);" is not write enabled."
: IF Z1=1THEN RETURN
: PRINT AT(12,15);"Either enable ";HEX(0E);D3$(1);HEX(0F);" or mount a pre-
enabled disk"
: GOSUB '50
: G=1
5170 RETURN
5180 DEFFN'35(H1$)
: H1$=H1$&" Rev. 8734"
: PRINT HEX(0306);" ";AT(0,(80-LEN(H1$))/2);H1$;AT(1,(80-LEN(H1$))/2-1)
;BOX(0,LEN(H1$)+1);""
: GOSUB 6250
: RETURN
5190 DEFFN'39(Q)
: CONVERT QTO Q$,(#####)
: PRINT BOX(1,6);HEX(20060E);Q$;HEX(0F);
: IF H1=1AND Q<>S3AND Q<>E3THEN PRINT " ";
HEX(08080808080808080808080808080808080808080808080808080808080808080808)
;
: H1=0
5200 IF G=4THEN RETURN
: IF Q<>S3AND Q<>E3THEN RETURN
: H1=1
: IF Q=S3THEN PRINT " (starting sector)";
: IF Q=E3THEN PRINT " (ending sector) "
: RETURN
5210 DEFFN'40(D,R1)
: X=0
: DATA LOAD BA T#D,(R1)R1$()
: ERRORX=ERR
: IF H$="CHECK"THEN 5220
: GOSUB '70(X,D)
: IF G=1THEN RETURN
5220 INIT(20)H$
: GOTO 6310
5230 DEFFN'41(D,W1,R1$())
: X=0
: IF W1<>0THEN 5240
: IF E$="LOCKING"THEN 5240
: C$=STR(R1$(),7,1)
: STR(R1$(),7,1)=HEX(FF)
5240 DATA SAVE BA T#D,(W1)R1$()
: ERRORX=ERR
: GOSUB '70(X,D)
5250 IF W1=0THEN STR(R1$(),7,1)=C$
: RETURN
5260 DEFFN'60
5270 C2=C2+1
: PRINT AT(20,54);"# of errors= ";C2;"";
: IF C2<9999THEN RETURN
: PRINT AT(20,52,27);HEX(07)
: C2=0
: GOTO 5270
5280 DEFFN'61
: C1=C1+1
: PRINT AT(20,10);"Pass # ";C1;
: IF C1<>9999THEN RETURN
: PRINT AT(20,10,12);
: C1=1
: RETURN
5290 DEFFN'64
: GOSUB 5080
: GOSUB '70(X,D)
: IF G=1THEN 5320
5300 GOSUB 6310
: IF G=1THEN 5320
5310 IF L$<>"N"THEN RETURN
: GOSUB '50
: PRINT AT(22,8,50)
5320 IF G<>1THEN RETURN
: RETURN CLEAR ALL
: GOSUB 4830
: GOTO 700
5330 DEFFN'70(X,D)
: X1=X
: IF L$<>"N"AND H$<>"CHECK"THEN GOSUB '60
: IF M1=XAND C2<>0AND L$<>"N"THEN RETURN
: M1=X
: PRINT AT(21,54,25);" ERROR ";
5335 IF X<10THEN PRINT "A";
: ELSE IF X<30THEN PRINT "S";
: ELSE IF X<60THEN PRINT "P";
: ELSE IF X<80THEN PRINT "X";
: ELSE IF X<90THEN PRINT "D";
: ELSE PRINT "I";
: PRINT X;" on disk ";D3$(D);""
: E$="DEVICE "
: IF P9$<>"OFF"THEN GOSUB 5700
: IF L$<>"N"OR G=1OR H$="CHECK"OR H$="SCRAT"THEN RETURN
: GOSUB '50
: RETURN
5340 DEFFN'90
: PRINT AT(20,25);BOX(1,26);" Device ";D3$(D);" task COMPLETE";AT(11
,36);BOX(-1,-6);BOX(-1,-12)
5350 GOSUB '50
: G=1
: RETURN
5360 GOSUB '203
: RETURN
5370 IF R3$=HEX(D0)THEN PRINT AT(0,68);HEX(0E);"multi-sector"
: RETURN
5380 DEFFN'201(D)
: IF D3$(D)="340"THEN RETURN
: GOSUB '202(D)
: $GIOENDMSGWRITE#D,(0600070070A0400288D070406A10681140008B67,R$)
: ERRORX=ERR
: GOSUB '70
: RETURN
5390 GOSUB '203
: RETURN
5400 DEFFN'200(D)
: X=0
: IF D3$(1)="340"THEN RETURN
: GOSUB '202(D)
: $GIOBEGINMSGWRITE#D,(0600070070A068D070406A1068104000,R$)
: ERRORX=ERR
5410 RETURN
5420 DEFFN'203
: IF STR(R$,6,1)=HEX(00)THEN 5430
: IF STR(R$,6,1)=HEX(01)THEN X=98
: IF STR(R$,6,1)=HEX(02)THEN X=91
: IF STR(R$,6,1)=HEX(04)THEN X=94
: GOSUB '70
: RETURN
5430 IF STR(R$,7,1)=HEX(00)THEN RETURN
: IF STR(R$,7,1)=HEX(01)THEN X=95
: IF STR(R$,7,1)=HEX(02)THEN X=93
: IF STR(R$,7,1)=HEX(04)THEN X=96
: GOSUB '70
: RETURN
5440 REM % ***SET PARAMETERS***
5450 IF G=3OR G=2THEN RETURN
5460 REM %Select device
: E=0
: I5=3
: A2$=D$
: GOSUB 6360
: IF G=1THEN RETURN
: FOR I=1TO 3
: H$=STR(A2$,I,1)
: GOSUB 5490
: STR(A2$,I,1)=H$
: NEXT I
: IF E<>1THEN 5510
5480 PRINT AT(R,Y);"\A0\A0\A0"
: GOTO 5450
5490 CONVERT H$TO S
: ERRORX=ERR
: H$=AND HEX(DF)
: IF H$<"A"OR H$>"F"THEN E=1
5500 IF I=1AND H$<>"D"AND H$<>"B"AND H$<>"3"THEN E=1
: RETURN
5510 SELECT #D<A2$>
: IF D<>2THEN 5530
: IF D3$(1)="340"THEN 5520
: $GIOCHECKFORVALIDADDRESS#3(010402E81212102012120B0070A04100860B4501,R$)
: ERRORX=ERR
5520 SELECT #1<A2$>
: SELECT #4<A2$>
: SELECT #5<A2$>
: GOTO 5540
5530 IF A2$="340"THEN 5540
: $GIOCHECKFORVALIDADDRESS#3(010402E81212102012120B0070A04100860B4501,R$)
: ERRORX=ERR
: GOTO 5450
5540 IF A2$="340"THEN 5555
: IF STR(R$,8,1)=HEX(10)THEN 5450
: D$=A2$
5550 R3$=STR(R$,11,1)
: RETURN
5555 REM RAM DISK
: D$=A2$
: R3$="D0"
: RETURN
5560 REM %Select starting sector
5570 CONVERT S3TO A2$,(#####)
: I5=5
: GOSUB 6360
: CONVERT A2$TO S3
: ERRORX=ERR
: GOTO 5570
5580 RETURN
5590 REM %Select ending sector
: CONVERT E3TO A2$,(#####)
: I5=5
: GOSUB 6360
: CONVERT A2$TO E3
: ERRORX=ERR
: GOTO 5590
5600 RETURN
5610 REM % ***FORMAT DISK***
: PRINT AT(23,45,34);
5620 GOSUB 6250
: PRINT AT(6,32);"Format device ";D3$(1);AT(8,34);" ARE YOU SURE?
";AT(22,8);" Y to continue"
: GOSUB 6300
: IF G=1THEN RETURN
: IF C$<>"Y"THEN 5620
5630 PRINT AT(6,29,);"Formatting device ";D3$(1);AT(22,1);"CHECK: to ens
ure that the device is formatting and the system isn't hung"
: E3$=ALL(" ")
5640 GOSUB 6310
: IF G=1THEN RETURN
: X=0
: $FORMATDISK T#2
: ERRORX=ERR
: IF X<>92THEN 5670
: PRINT AT(11,20,59);"Press the format button for ";D3$(1);"";AT(22,1,78)
;"Press: CONT when the format is completted"
: GOSUB 6250
: GOTO 5660
5650 GOTO 5670
5660 GOSUB 6300
: PRINT AT(20,20,)
: IF G=1THEN RETURN
: IF C$<>HEX(84)THEN 5660
5670 DATA LOAD BA T#2,(S3)R1$()
: ERRORX=ERR
: E3$="I-"
: CONVERT XTO STR(E3$,3,2),(##)
: PRINT AT(8,34,59);" ";
: IF X=93THEN PRINT "Device #";D3$(1);" still has a format error";
: ELSE PRINT "ERROR ";E3$;" on DEVICE #";D3$(1);""
: GOSUB 6250
: IF L$<>"N"THEN GOSUB '60
: IF L$="N"THEN GOSUB '50
: G=1
5680 IF X<>0THEN GOSUB '60
5690 IF L$="N"THEN RETURN
: GOSUB '61
: GOTO 5640
5700 REM % PRINT ERROR
: REM IF MAX NUMBER OF LINES PRINTED OR PRINTER NOT SELECED THEN RETURN
: IF P3=QAND P3$=D$(D)THEN RETURN
: IF P9$="215"THEN 5720
5710 REM % 204 Printer
: $OPEN 5750,/204
: PRINT AT(21,25,16);" Printer 204 - buffer full";
: SELECT PRINT 204
: $IF OFF /204,5750
: GOTO 5730
5720 REM % 215 Printer
: $OPEN 5750,/215
: $GIO/215(410D)
: $IF OFF /215,5750
: PRINT AT(21,25,16);" Printer 215 - buffer full";
: SELECT PRINT 215
: REM %
5730 P=P+1
: PRINT TAB(3);E$;
: PRINT " ERROR ";
: IF X<>0THEN PRINT "I-";X;
: ELSE PRINT "----- ";
5740 PRINT " disk ";D3$(D);" sec";Q;
: PRINT
5750 SELECT PRINT 005
: $CLOSE/215
: $CLOSE/204
5760 PRINT AT(21,25,25);
: IF P=P1THEN P9$="OFF"
: P3=Q
: P3$=D$(D)
: RETURN
5770 $CLOSE#2
: RETURN CLEAR ALL
: $IF OFF /005,5770
5780 GOSUB 5800
5790 REM % Help messages for errors
5800 IF X1<90OR X1>99THEN X1=90
: PRINT HEX(03)
: GOSUB '52
: GOSUB 6250
: PRINT AT(11,25,54);"Define error I- (90-99)";
: CONVERT X1TO A2$,(##)
: ERRORX=ERR
5810 R=11
: Y=40
: I5=2
: GOSUB 6360
: IF G=1THEN G=2
: IF G=2THEN RETURN
: ON G1GOTO 5820
: GOTO 5810
5820 CONVERT A2$TO X1
: ERRORX=ERR
: GOTO 5810
5830 E9=1
: PRINT HEX(03)
: GOSUB 6250
: PRINT AT(4,0);
: ON X1-89GOSUB 5840,5870,5920,5950,5990,6020,6060,6120,6160,6200
: IF G=1THEN G=2
: IF G<>2THEN 5800
: ELSE RETURN
5840 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."
5850 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."
5860 GOTO 6240
5870 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"
5880 PRINT HEX(0C);" on, for example, the disk is not in file-ready
position and a disk hardware error is generated."
5890 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";
5900 PRINT " RUN mode by using the RUN/LOAD selection switch."
5910 GOTO 6240
5920 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."
5930 PRINT HEX(0D);"Recovery: Run the program again. If the error persists,
be sure that the disk platter has been formatted."
5940 GOTO 6240
5950 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"
5960 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."
5970 PRINT HEX(0D);"Recovery: Format the disk platter again. If the error pe
rsists, replace the media."
5980 GOTO 6240
5990 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."
6000 PRINT HEX(0A);"Recovery: Turn off the format key."
6010 GOTO 6240
6020 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"
6030 PRINT " write to a write-protected platter."
6040 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."
6050 GOTO 6240
6060 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-"
6070 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"
6080 PRINT " disk was incorrect. The data has not been written."
6090 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"
6100 PRINT " connections are properly made and are tight."
6110 GOTO 6240
6120 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-"
6130 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."
6140 PRINT "Recovery: Run the program again. If the error persists, rewrite
the flawed sector."
6150 GOTO 6240
6160 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"
6170 PRINT HEX(0C);" platter is not mounted. (The maximum legal sec
tor address depends upon the disk model used.)"
6180 PRINT HEX(0A);"Recovery: Mount a platter in the specified drive."
6190 GOTO 6240
6200 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-"
6210 PRINT HEX(0C);" ing that the information was not written prope
rly. This error usual- ly indicates that the disk platter is d
efective."
6220 PRINT "Recovery: Write the information again. If the error persists, tr
y a new plat- ter."
6230 GOTO 6240
6240 DEFFN'50
: REM %'50
: C$=" "
: GOSUB '52
: GOSUB 6300
: IF C$<>HEX(0D)AND C$<>HEX(82)AND G<>1AND G<>2THEN 6240
: RETURN
6245 DEFFN'52
: REM %'52
: PRINT HEX(06);" ";AT(23,58);"RETURN/RUN to cont.";AT(1,1)
: RETURN
6250 REM % PREV SCRN message
: PRINT AT(22,0);BOX(2,79);" Press:";" ";AT(23,8);"CLEAR/PREV SCRN
- to exit";
: RETURN
6260 REM % Change page
: G=2
: RETURN
6270 REM % Print error information
: GOTO 5800
6280 REM % Check for PREV SCRN or change of page
: G=1
: RETURN
6290 REM % Check for CLEAR
: IF C$=HEX(81)THEN G=1
: RETURN
6300 REM % Wait for input
: G=0
: KEYIN C$,,6320
: GOTO 6290
6310 REM % Input no wait
: C$=" "
: G=0
: KEYIN C$,6290,6320
: RETURN
6320 G=3
: IF C$=HEX(0F)THEN GOTO 6260
: IF C$=HEX(42)OR C$=HEX(52)THEN 6280
: RETURN
6325 REM % Get drive status
: R$=" "
: $GIOREADSTATUS#2(0600070070A0400288D070406A106816400087051A00C340,R$)R$;S
TR(H$,1,VAL(STR(R$,5,1)))
: ERRORX=ERR
6326 RETURN
6330 REM DEFFN'31
: 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;" "
6340 GOSUB 6250
: PRINT AT(23,38,41);
: GOSUB 6300
: IF G=1THEN 30
: GOTO 6340
6350 REM % Text input meaasge
: GOSUB 6250
: PRINT AT(22,8);" ANY KEY to input parameters ";
: RETURN
6360 REM % Input and edit data
: REM R,Y are screen cords. and A$ is data to edit
: Z2,Z1=1
: G,G1=0
: GOSUB 6350
: PRINT "";AT(R,Y);A2$;"";AT(R,Y);HEX(05);
6370 KEYIN C$,,6440
: PRINT HEX(06)
: IF C$=HEX(08)THEN 6510
: IF C$=HEX(0D)OR C$=HEX(82)THEN 6540
: IF C$=HEX(81)THEN 6480
: A2$=ALL(" ")
: PRINT AT(R,Y,I5);"";STR(A2$,1,I5);"";
: Z1=2
: GOTO 6390
6380 PRINT HEX(05);
: IF Z2=I5+1THEN PRINT AT(R,Y+Z2-2);
: G1=0
: PRINT HEX(05);
: KEYIN C$,,6440
: PRINT HEX(060F);
: IF C$=HEX(0D)OR C$=HEX(82)THEN 6540
: IF C$=HEX(08)THEN 6400
6390 IF Z2=I5+1THEN Z2=Z2-1
: STR(A2$,Z2,1)=C$
: PRINT AT(R,Y+Z2-1);"";C$;"";
: Z2=Z2+1
: GOTO 6380
6400 IF Z2=1THEN 6510
: Z2=Z2-1
: C$=" "
: STR(A2$,Z2,1)=C$
: PRINT AT(R,Y+Z2-1);C$;HEX(08);
: GOTO 6380
6410 IF Z2=I5+1THEN Z2=Z2-1
: IF Z2<>1THEN Z2=Z2-1
: ELSE GOTO 6520
: PRINT HEX(08);
: GOTO 6380
6420 IF Z2<I5THEN Z2=Z2+1
: ELSE GOTO 6530
: PRINT HEX(09);
: GOTO 6380
6430 IF C$=HEX(00)AND I4<=DTHEN 6470
: GOTO 6260
: REM goto '0
6440 PRINT HEX(060F);
: IF C$=HEX(48)THEN 6450
: ON POS(HEX(4D5D4C5C7F7E4555465642521F0F)=C$)GOTO 6410,6410,6420,6420,6520
,6530,6500,6500,6510,6510,6280,6280,6260,6260
: G=3
: RETURN
6450 A2$=ALL(" ")
: PRINT AT(R,Y,I5);"";STR(A2$,1,I5);"";
: GOTO 6360
6460 PRINT HEX(07)
6470 ON Z1GOTO 6360,6380
6480 G=1
: RETURN
6490 GOSUB 6310
: IF E9<>3THEN 6490
: E9=0
: GOSUB 540
: GOSUB 6350
: PRINT AT(R,Y+Z2-1);
: IF Z2=1THEN 6360
: GOTO 6380
6500 G1=G1+1
6510 G1=G1+1
6520 G1=G1+1
6530 G1=G1+1
6540 G1=G1+1
: RETURN
7020 REM DISABLE RETRIES
: IF D3$(1)="340"THEN RETURN
: GOSUB 7060
: $GIODISABLERETRIES#2(0600070070A0400288D070406A1068174000,R$)
: ERRORX=ERR
7030 RETURN
7040 REM ENABLE RETRIES
: IF D3$(1)="340"THEN RETURN
: GOSUB 7060
: $GIOALLOWRETRIES#2(02000330122112220600070070A0400288D070406A1068244000,R
$)
: ERRORX=ERR
: REM PASS OVER ERROR
7050 RETURN
7060 REM FORMAT THE DRIVE NUMBER FOR GIO STATEMENT
: D=1
7061 DEFFN'202(D)
: IF STR(D3$(1),1,1)="B"THEN 7080
: IF STR(D3$(1),1,1)="D"AND STR(D3$(1),3,1)="0"THEN 7080
7065 DEFFN'202(D)
: R$=" "
: IF STR(D3$(1),1,1)="B"THEN 7080
: IF STR(D3$(1),1,1)="D"AND STR(D3$(1),3,1)="0"THEN 7080
7070 HEXPACKSTR(R$,1,1)FROMSTR(D3$(1),2,2)
: STR(R$,1,1)=AND HEX(0F)
: STR(R$,1,1)=SUBHEX(01)
: GOTO 7090
7080 STR(R$,1,1)=HEX(10)
7090 STR(R$,1,1)=OR HEX(20)
: RETURN
8000 REM CHECK FOR VALID ADDRESS
: X=0
: IF D3$(1)="340"THEN RETURN
: $GIOCHECKFORVALIDADDRESS#3(010402E81212102012120B0070A04100860B4501,R$)
: ERRORX=ERR
8010 RETURN
9900 DEFFN'00
: PRINT HEX(03);" DEFFN'XX LISTING"
: PRINT
: LIST S9900,
: STOP
9901 DEFFN'01HEX(020400020E)
: REM - - -Reverse- -On
9902 DEFFN'02HEX(020400040E)
: REM - - - -Underline-On
9903 DEFFN'03HEX(020402000E)
: REM -Bright- - - -On
9904 DEFFN'04HEX(020402020E)
: REM -Bright- -Reverse- -On
9905 DEFFN'05HEX(020402040E)
: REM -Bright- - -Underline-On
9906 DEFFN'06HEX(020404000E)
: REM - -Blinking- - -On
9907 DEFFN'07HEX(020404020E)
: REM - -Blinking-Reverse- -On
9908 DEFFN'08HEX(020404040E)
: REM - -Blinking- -Underline-On
9909 DEFFN'09HEX(02040B000E)
: REM -Bright-Blinking- - -On
9910 DEFFN'10HEX(02040B020E)
: REM -Bright-Blinking-Reverse- -On
9911 DEFFN'11HEX(02040B040E)
: REM -Bright-Blinking- -Underline-On
9912 DEFFN'12HEX(0202000F)
: REM -Select normal character set-
9913 DEFFN'13HEX(0202020F)
: REM -Select alternate character set-
9914 DEFFN'14HEX(0E)
: REM - - - - -On
9915 DEFFN'15HEX(0F)
: REM - - - - -Off
9916 DEFFN'16
: REM - Print a listing
: SELECT LIST 215(132)
: LIST " PROGRAM "D
: LIST " Variables"V
: LIST " Prime Numbers"'
: LIST " Line numbers"#
9917 SELECT LIST 005(80)
: PRINT HEX(03)
: STOP " DONE PRINTING"
9931 DEFFN'30
: REM - Update the program
: SCRATCH T/D10,"FTU"
: SAVE T/D10,()"FTU"
: STOP " 'FTU' SAVED"