Listing of file='2229FS' on disk='vmedia/2229_diagnostics.wvd.zip'
# Sector 268, program filename = '2229FS'
0010 REM % "2229FS" - COMMENTS STRIPPED TO FIT IN MEMORY
0015 REM ST 02/23/1986
0020 REM % COPYRIGHT WANG LABORATORIES, INC., 1986
0025 REM Changes ---> version 2.0
0026 REM CHANGED LINE 100 TO 'FOR A = 0 TO C-1' FOR CORRECT INDEX SECTORS
0027 REM CHANGED LINE 510 TO SAVE CORRECT MAXIMUM NUMBER OF FILES (2048)
0030 COM F$8
: DIM D$3,N$(2048)8,N1$(2048)3,S(2048),L$(2048)2,W$(2048)4,I$(16),J8$1,J9$1
,K$1,F1$8,D1$3,Y$1,J$8,L$2,I$8,K1$2
0040 J8$=HEX(80)
: J9$=HEX(96)
: PRINT HEX(03020402040E);AT(0,21);"CREATE REFERENCE FILE"
: L$()=ALL(00)
: N1$()=ALL(J8$)
: PRINT HEX(0202020E)
: PRINT HEX(0F)
: I$=HEX(1080100011801100)
0060 IF D$=" "THEN D$="D11"
: PRINT AT(2,0);HEX(020402000F);
: LINPUT "Source disk address ",D$
: IF VER(D$,"HHH")=3THEN 65
: PRINT AT(2,25,40);"Illegal Address";HEX(07)
: GOTO 60
0065 SELECT #2<D$>
: ERRORA=1
: GOTO 80
0070 VERIFY T#2,(0,0)A
: ERRORA=1
0080 IF A=0THEN 90
: PRINT AT(2,25,40);"Error ";ERR;HEX(07)
: GOTO 60
0090 PRINT AT(2,25,40);AT(3,0);HEX(06);"Sorting disk catalog - please wait ...
"
0100 N$()=ALL(FF)
: J=1
: DATA LOAD BA T#2,(0)I$()
: C=VAL(STR(I$(),2))
: FOR A=0TO C-1
: DATA LOAD BA T#2,(A)I$()
: FOR B=1TO 16
: IF A=0AND B=1THEN NEXT B
0105 MAT SEARCHI$,=STR(I$(B),1,2)TO L$STEP 2
: IF VAL(L$,2)=0THEN 170
: RESTORE LINE730,1+(VAL(L$,2)/2)
: READ STR(N1$(J),2,2)
0160 STR(N1$(J),1,1)=J8$
: STR(N$(J),1,8)=STR(I$(B),9,8)
: S(J)=VAL(STR(I$(B),5,2),2)-VAL(STR(I$(B),3,2),2)+1
: J=J+1
: IF J<=2048THEN 170
: PRINT AT(02,0); "Cannot handle more than 2048 entries in index"
: PRINT "Use Backup Platter to Tape"
: STOP
: GOTO 10
0170 NEXT B,A
: J=J-1
: IF J=0THEN 800
: P=INT(J/16)
: IF P=J/16THEN 180
: ELSE P=P+1
0180 MAT SORTN$()TO W$(),L$()
: PRINT HEX(06),AT(1,0,)
0190 PRINT AT(06,58);HEX(020402000E);"ACTIVE KEYS";HEX(0F)
: PRINT AT(08,55);"Cursor Up/Down"
: PRINT AT(09,55);"Space/Backspace"
: PRINT AT(10,55);"Insert/Delete"
: PRINT AT(11,55);"A / Select all files"
0195 PRINT AT(12,55);"N / Next Screen";AT(13,55);"P / Previous Screen";AT(14,5
5);"SF '00 - All P";AT(15,55);"SF '01 - All D";AT(16,55);"SF '02 - All SP
";AT(17,55);"SF '03 - All SD";AT(21,55);HEX(0E);"Press RUN when done";HEX
(0F)
0210 PRINT AT(2,55);"Disk address ";D$; AT(3,55);"Files selected"; AT(4,5);
HEX(020402000E); " Name Type Sectors";HEX(0F0D)
: J1=1
: P1=0
0230 FOR A=6TO 22
: PRINT HEX(06);AT(A,0,35);
: NEXT A
0240 C=1
0250 %############## ###.##%
0260 PRINT AT(J1+5,C);
: X=VAL(L$(J1+P1*16),2)
: PRINTUSING 270,STR(N1$(X),1,1),N$(X),STR(N1$(X),2,2),S(X);
0270 % # ######## ## #####
0280 J1=J1+1
: IF J1+P1*16>JTHEN 290
: IF J1<17THEN 260
0290 J1=1
: C=2
0300 X=VAL(L$(J1+P1*16),2)
: PRINT AT(J1+5,C);HEX(02050F);
: KEYIN K$,,330
: PRINT HEX(06);
: ON POS(HEX(504E200841824944)=K$) GOTO 340,350,370,390,440,490,460,480
: PRINT HEX(07)
: GOTO 300
0330 PRINT HEX(06);
: ON POS(HEX(064605450A4A0949424300010203)=K$)GOTO 390,390,370,370,460,460,
480,480,340,350,440,440,440,440
: PRINT HEX(07)
: GOTO 300
0340 IF P1=0THEN 290
: REM ON FIRST SCREEN
: P1=P1-1
: J1=1
: GOTO 230
0350 IF P1+1 <PTHEN 360
: J1=1
: GOTO 240
0360 P1=P1+1
: J1=1
: GOTO 230
0370 J1=J1+1
: IF J1+P1*16>JTHEN 380
: IF J1<17THEN 300
: J1=1
: GOTO 300
0380 J1=1
: GOTO 300
0390 IF J1=1THEN 400
: J1=J1-1
: GOTO 300
0400 IF P1+1=PTHEN 410
: J1=16
: GOTO 300
0410 J1=MOD(J,16)
: GOTO 300
0440 FOR J2=1TO J
: IF K$="A"THEN 445
: RESTORE LINE730,VAL(K$)+1
: READ K1$
: IF K1$<>STR(N1$(J2),2,2)THEN 446
0445 IF STR(N1$(J2),1,1)=J8$THEN F=F+1
: STR(N1$(J2),1,1)=J9$
0446 NEXT J2
0450 PRINT AT(3,70);
: PRINTUSING 470,F
: GOTO 210
: R1=16
: IF MOD(J,16)<>0AND P1=INT(J/16)THEN R1=MOD(J,16)
: FOR J2=1TO R1
: PRINT AT(J2+5,2);J9$
: NEXT J2
: GOTO 300
0460 X=VAL(L$(J1+P1*16),2)
: IF STR(N1$(X),1,1)=J8$THEN F=F+1
: STR(N1$(X),1,1)=J9$
: PRINT AT(J1+5,C);J9$
: PRINT AT(3,70);
: PRINTUSING 470,F
: GOTO 370
0470 %####
0480 X=VAL(L$(J1+P1*16),2)
: IF STR(N1$(X),1,1)=J9$THEN F=F-1
: STR(N1$(X),1,1)=J8$
: PRINT AT(J1+5,C);J8$
: PRINT AT(3,70);
: PRINTUSING 470,F
: GOTO 370
0490 PRINT HEX(06);AT(1,0,)
: G,G1=1
0500 IF STR(N1$(G1),1,1)=J8$THEN 510
: N$(G)=N$(G1)
: G=G+1
0510 G1=G1+1
: IF G1<=2048THEN 500
: G=G-1
: IF G=0THEN 720
: G1=INT(G/32)*2+3
0520 PRINT HEX(060202000F);AT(1,0,)
0530 PRINT AT(2,0);
: LINPUT "Reference file name",-F1$
0540 A=0
: PRINT AT(3,0);
: LINPUT "Reference file address ",-D1$
: IF VER(D1$,"HHH")=3THEN 545
: PRINT AT(3,30,30);"Illegal Address";HEX(07);
: GOTO 540
0545 SELECT #3<D1$>
: ERRORA=1
: GOTO 575
0550 VERIFY T#3,(0,0)A
: ERRORA=1
: GOTO 575
0570 LIMITS T#3,F1$,A,B,C,D
: ERRORA=1
: GOTO 575
0572 IF ABS(D)<>1THEN 580
: PRINT AT(2,30,40);"ERROR - NOT DATA FILE"
: GOTO 530
0575 IF A=0THEN 580
: PRINT AT(3,30,30);"ERROR ";ERR;HEX(07)
: GOTO 540
0580 PRINT AT(3,30,40)
: IF D<>0THEN 610
: REM JUMP IF ALREADY ON DISK
: PRINT AT(4,0); F1$;" does not exist - OK to create new file (Y/N)";
: Y$="Y"
: LINPUT -Y$
: IF Y$="Y"OR Y$="y"THEN 600
: IF Y$="N"OR Y$="n"THEN 520
: GOTO 580
0600 DATA SAVE DC OPEN T#3,(G1)F1$
: LIMITS T#3,F1$,A,B,C,D
: GOTO 670
0610 PRINT AT(6,0,79);"'";F1$;"' already exists "
: PRINT "Can file be overwritten (Y OR N)";
: Y$="N"
: LINPUT -Y$
: IF Y$="Y"OR Y$="y"THEN 620
: IF Y$="N"OR Y$="n"THEN 520
: GOTO 610
0620 IF G1<=B-A+1THEN 660
: PRINT AT(6,0,79);"Old file is too small. "
: J$="@JUNKAAA"
0630 LIMITS T #3,J$,A,A,A,A
: IF A=0THEN 640
: A=POS(-J$<"Z")
: STR(J$,A,1)=ADD HEX(01)
: IF A<8 THEN STR(J$,A+1)=ALL("A")
: GOTO 630
0640 PRINT "Can the file be junked (renamed to ";J$;" & scratched)?";
: Y$="N"
: LINPUT -Y$
: IF Y$="Y"OR Y$="y"THEN 650
: IF Y$="N"OR Y$="n"THEN 520
: GOTO 640
0650 SCRATCH T #3,F1$
: DATA SAVE DC OPEN T #3,F1$,J$
: SCRATCH T #3,J$
: PRINT AT(6,0,159);
: GOTO 600
0660 SCRATCH T#3,F1$
: DATA SAVE DC OPEN T#3,(F1$)F1$
: ERRORGOTO 10
0670 MAT REDIM N$(G)8
: DATA LOAD DC OPEN T#3,F1$
: ERRORGOTO 10
0680 DATA SAVE DC #3,D$,N$()
: ERRORGOTO 10
0690 DATA SAVE DC #3,END
: ERRORGOTO 10
0700 DATA SAVE DC CLOSEALL
: PRINT
: PRINT HEX(07);"DONE"
0710 $GIO(75FF 75FF 75FF 75FF)
: F$=".2229"
: $PSTAT=".2229"
: LOAD T"@MENU"
0720 PRINT
: PRINT "No file names selected"
: GOTO 710
0730 DATA " P"," D","SP","SD"
0800 PRINT
: PRINT "Index is empty"
: GOTO 710
9000 $CLOSE
: PRINT AT(10,0,79);"DISK ERROR ";ERR
: GOSUB '153
: STOP
: GOTO 10