10 ' XREF 20 ' 30 DEFINT A-F 40 DEFDBL L-N 50 DEFSTR P-Z 60 ' 70 ZEND1=STRING$(2,&HFF)+STRING$(2,&H1A) 80 ZEND2=STRING$(4,&H1A) 90 ' 100 DIM A(20):' for caps conversion routine 110 ' 120 ACOLS=2:' number of columns in list - this keeps display within default 72 char/line value 130 APAGE=66:' total depth of page 140 ALINES=APAGE-6:' depth of list 150 BCOLS=ACOLS-1 160 ABLOCK=ACOLS*ALINES 170 ' 180 ' MBASIC assumes 72 columns as a default width, which means that 190 ' two columns of xref listing can be accomodated. If listing is to 200 ' be sent to a device with a wider display, the value can be 210 ' specified either absolutely with WIDTH or by the following 220 ' relative values. Note that ACOLS has to be adjusted accordingly. 230 ' 240 ' WIDTH (32*ACOLS)-6 250 ' WIDTH LPRINT (32*ACOLS)-6 260 ' 270 ' 280 ' If this program is to be compiled with BASCOM the following 290 ' arrays will have to be dimensioned absolutely. 300 ' 310 DIM F(ABLOCK) 320 ' 330 ASORT=(FRE(0)/8)-500 340 DIM G(ASORT+1):DIM H(ASORT+1):' sort tables 350 ' 360 T1="XREFWORK.###":' working file 1 370 T2="XREFWORK.$$$":' working file 2 380 ' 390 FC=1:' console listing flag 400 FP=0:' print listings flag 410 ' 420 DEF FNZNO(I)=RIGHT$(STR$(I),LEN(STR$(I))-1) 430 DEF FNZHEX(I)=RIGHT$("0000"+HEX$(I),4) 440 ' 450 P(0)="DISABLED" 460 P(1)="ENABLED" 470 ' 480 Q(1)=CHR$(9) 490 Q(2)=Q(1)+Q(1) 500 ' 510 PRINT 520 CLOSE 530 PRINT "Enter:" 540 PRINT " C - Console listing toggle";TAB(35);P(FC) 550 PRINT " P - Print listing toggle";TAB(35);P(FP) 560 PRINT " L - List sorted X-ref table" 570 PRINT " S - Sort & list X-ref table" 580 PRINT " E - End" 590 ' 600 S=INPUT$(1) 610 IF S="c" OR S="C" THEN IF FC=0 THEN FC=1 ELSE FC=0 620 IF S="p" OR S="P" THEN IF FP=0 THEN FP=1 ELSE FP=0 630 IF S="l" OR S="L" THEN FJ=1:GOTO 680 640 IF S="s" OR S="S" THEN FJ=0:GOTO 680 650 IF S="e" OR S="E" THEN CLOSE:END 660 GOTO 510 670 ' 680 PRINT 690 INPUT "X-ref file name (.XRF assumed): ",S 700 IF LEN(S)=0 THEN GOTO 680 710 IF INSTR(S,".")=0 THEN S=S+".XRF" 720 GOSUB 2010 730 IF FJ=1 THEN GOTO 1560 740 ' 750 ' INPUT UNSORTED FILE 760 ' 770 FM=-1 780 FE=0 790 ON ERROR GOTO 1940 800 OPEN "R",1,S,8 810 FIELD #1,4 AS X1,4 AS X2 820 FOR A=1 TO ASORT 830 GET 1 840 IF X1=ZEND1 THEN FE=1:GOTO 910 850 G(A)=CVS(X1) 860 H(A)=CVS(X2) 870 NEXT A 880 ' 890 ' SORT 900 ' 910 FM=FM+1 920 A=A-1 930 ALAST=A 940 A1=A 950 B=INT(A/2)+1 960 IF B=1 THEN GOTO 1010 970 B=B-1 980 G=G(B) 990 H=H(B) 1000 GOTO 1070 1010 G=G(A1) 1020 H=H(A1) 1030 G(A1)=G(1) 1040 H(A1)=H(1) 1050 A1=A1-1 1060 IF A1=1 THEN GOTO 1210 1070 D=B 1080 E=D 1090 D=2*D 1100 IF D=A1 THEN GOTO 1140 1110 IF D>A1 THEN GOTO 1180 1120 L=(2^18*G(D))+H(D):M=(2^18*G(D+1))+H(D+1):IF L>=M THEN GOTO 1140 1130 D=D+1 1140 L=(2^18*G)+H:M=(2^18*G(D))+H(D):IF L>M THEN GOTO 1180 1150 G(E)=G(D) 1160 H(E)=H(D) 1170 GOTO 1080 1180 G(E)=G 1190 H(E)=H 1200 GOTO 960 1210 G(E)=G 1220 H(E)=H 1230 IF G(1)=G(2) AND H(1)>H(2) THEN SWAP H(1),H(2) 1240 ' 1250 ' BUILD INTERMEDIATE FILES 1260 ' 1270 PRINT 1280 IF FM>0 THEN NAME T1 AS T2:OPEN "R",3,T2,8:FIELD #3,4 AS Z1,4 AS Z2 1290 OPEN "R",2,T1,8 1300 FIELD #2,4 AS Y1,4 AS Y2 1310 FF=0 1320 FG=0 1330 IF FM<1 THEN FOR A=1 TO ALAST:LSET Y1=MKS$(G(A)):LSET Y2=MKS$(H(A)):PUT 2: NEXT A:GOTO 1440 1340 GET 3 1350 G=CVS(Z1) 1360 H=CVS(Z2) 1370 A=1 1380 IF FF=0 THEN L=(2^18*G)+H:NM(2^18*G(A))+H(A): IF (L0 THEN CLOSE 3:KILL T2 1490 IF FE=0 THEN GOTO 820 1500 CLOSE 1510 KILL S 1520 NAME T1 AS S 1530 ' 1540 ' LIST .XRF FILE 1550 ' 1560 IF FC+FP=0 THEN PRINT:PRINT "*** NO LISTING SPECIFIED ***":GOTO 510 1570 ERASE G,H 1580 DIM G(ABLOCK) 1590 DIM H(ABLOCK) 1600 ON ERROR GOTO 1940 1610 OPEN "R",1,S,8 1620 FIELD #1,4 AS X1,4 AS X2 1630 FE=0 1640 FA=1 1650 PRINT 1660 FOR A=1 TO ABLOCK 1670 GET 1 1680 IF X1=ZEND1 THEN CLOSE:FE=1:GOTO 1730 1690 G(A)=CVS(X1) 1700 H(A)=INT(CVS(X2)/4) 1710 F(A)=CVS(X2)-(4*H(A)) 1720 NEXT A 1730 IF FE=1 THEN ALAST=A-1 ELSE ALAST=A 1740 PRINT FNZNO(FA);TAB(11);"Cross reference listing";TAB(40);S 1750 PRINT 1760 FOR A=1 TO ALINES 1770 FOR B=0 TO BCOLS 1780 C=(B*ALINES)+A 1790 IF C<=ALAST AND FC=1 THEN PRINT TAB(32*B);FNZHEX(G(C));Q(F(C)); FNZHEX(H(C));:IF B20 THEN S=LEFT$(S,20):A=20 2030 FOR B=1 TO A 2040 A(B)=ASC(MID$(S,B,1)) 2050 NEXT B 2060 S="" 2070 FOR B=1 TO A 2080 IF A(B)=ASC(" ") THEN GOTO 2110 2090 IF A(B)>=ASC("a") AND A(B)<=ASC("z") THEN A(B)=A(B)-32 2100 S=S+CHR$(A(B)) 2110 NEXT B 2120 RETURN