10 PRINT:PRINT"MBASIC Cross Reference Program" 20 PRINT"(C) Copyright 1980 by Advanced Informatics" 21 ' Author: James Monagan 22 ' Published in Interface Age Vol 6 No 6 June 1981 23 ' 24 ' Original version for Informer III Computer 25 ' in Microsoft BASIC-80 v5.0 26 ' 27 ' Modified and keyed in by Tony Nicholson 28 ' for Microsoft BASIC-80 v5.21 with CP/M 29 ' 30 PRINT 40 LZ=65 50 ' 60 DEFINT I-J: LW=80 70 ON ERROR GOTO 1480 80 DIM RW$(126),PT%(25),F$(10) 90 I=400:DIM VNXT%(490),V$(490),FRST%(400),LST%(400),RFL%(2000),NXT%(2000) 100 ' 110 ' Reserved words 120 ' 130 DATA ABS,AND,ASC,AS,ATN,BASE,CALL,CDBL,CHAIN,CHR$,CINT,CLEAR,CLOSE,COMMON 140 DATA COS,CSNG,CVD,CVI,CVS,DATA 150 DATA DEFDBL,DEFINT,DEFSGN,DEFSTR,DEFUSR,DEF,DIM,DSKI$,DSKO$,DSKF 160 DATA ELSE,END,EOF,EQV,ERASE,ERL,ERR,ERROR,EXP,FIELD,FILES,FIX,FOR 170 DATA FRE,GET,GOSUB,GOTO,HEX$ 180 DATA IF,IMP,INKEY$,INPUT,INP,INSTR,INT,KILL,LEFT$,LEN,LET,LINE 190 DATA LOC,LOF,LOG,LPOS,LPRINT,LSET,MID$,MKD$,MKI$ 200 DATA MKS$,MOD,NAME,NEXT,NOT,NULL,OCT$,ON,OPEN,OPTION,OR,OUT 210 DATA PEEK,POKE,POS,PRINT,PUT,RANDOMIZE 220 DATA READ,REM,RESET,RESTORE,RESUME,RETURN,RIGHT$,RND,RSET 230 DATA SGN,SIN,SPACE$,SPC(,SQR,STEP,STOP,STR$,STRING$,SWAP 240 DATA TAB(,TAN,THEN,TO,TROFF,TRON 250 DATA USING,USR,VAL,VARPTR,WAIT,WEND,WHILE,WIDTH,WRITE,XOR,"\" 260 ' 270 ' Fill array with reserved words 280 ' 290 RW=0 300 READ RW$ 310 RW=RW+1:RW$(RW)=RW$:IF RW$="\" THEN 340 320 I=ASC(RW$)-ASC("A"):IF PT%(I)=0 THEN PT%(I)=RW 330 GOTO 300 340 ' 350 FOR I=0 TO 25:IF PT%(I)=0 THEN PT%(I)=RW 360 NEXT 370 ' 380 ' Get list of filenames 390 ' 400 FX=0 410 PRINT: PRINT"ASCII SAVEd program #";FX+1;" = ";:LINE INPUT L$ 420 IF L$="" THEN IF FX<1 THEN 570 ELSE 480 430 IF INSTR(L$,".")=0 THEN L$=L$+".BAS" 440 NAME L$ AS L$ 450 FX=FX+1:F$(FX)=L$ 460 GOTO 410 470 ' 480 PRINT:INPUT "Date = ";D$ 490 PRINT:INPUT"1) Cross reference 2) List or 3) Both ";M 500 ' 510 ' Process list of filenames 520 ' 530 FOR F=1 TO FX 540 CLOSE 1:OPEN "I",1,F$(F): PRG$="'"+F$(F)+"' - "+D$: GOSUB 610 550 NEXT 560 LPRINT STRING$(65-LZ,CHR$(10)) 570 END 580 ' 590 ' Initialise for cross reference 600 ' 610 LC=0:BC=0:PZ=0:V$="":C$="":VC=91:RC=-1 620 FOR I=0 TO 91:VNXT%(I)=-1:NEXT 630 IF M>1 THEN GOSUB 1520 640 ' 650 ' Input line and extract line number 660 ' 670 IF EOF(1) THEN 1200 680 LINE INPUT #1,L$:IF M>1 THEN GOSUB 1430:IF M=2 THEN 670 690 LG=LEN(L$):BRNCH=0:ER$="":LC=LC+1:BC=BC+LG 700 LP=INSTR(L$," "):LN=VAL(LEFT$(L$,LP)) 710 IF LN>32767 THEN LN=LN-65536! 720 ' 730 ' Parse rest of line 740 ' 750 LP=LP+1:IF LP>LG THEN GOSUB 1010:GOTO 670 760 C$=MID$(L$,LP,1) 770 IF C$>="A" AND C$<="Z" THEN 890 ELSE IF (C$>="0" AND C$<="9") OR C$="." THEN 1150 780 IF C$=" " THEN GOSUB 1010:GOTO 750 ELSE IF C$<>","THEN BRNCH=0 790 IF C$=CHR$(34) THEN GOSUB 1010:LP=INSTR(LP+1,L$,C$):IF LP>0 THEN 750 ELSE 670 800 IF C$="'" THEN GOSUB 1010: GOTO 670 810 IF C$="&" THEN GOSUB 1010:V$=C$:GOTO 750 820 IF C$="$" OR C$="!" OR C$="%" OR C$="#" THEN GOSUB 1130:GOTO 750 830 IF C$="(" THEN GOSUB 1130 840 GOSUB 1010:IF C$<>"," THEN ER$="" 850 GOTO 750 860 ' 870 ' Test for command 880 ' 890 IF V$<>"" THEN 1160 ELSE C=ASC(C$):P=PT%(C-ASC("A")):BRNCH=0 900 IF CLP THEN P=P+1: GOTO 900 920 GOSUB 1010:RW$=RW$(P) 930 IF RW$="DATA" THEN LP=INSTR(LP,L$,":"):IF LP>0 THEN 750 ELSE 670 940 IF RW$="REM" THEN 670 950 IF RW$="GOTO" OR RW$="GOSUB" OR RW$="THEN" OR RW$="ELSE" OR RW$="RESUME" THEN BRNCH=1 960 IF RW$="ERASE" THEN ER$="(" ELSE ER$="" 970 LP=LP+LEN(RW$)-1:GOTO 750 980 ' 990 ' End variable 1000 ' 1010 IF V$="" THEN RETURN 1020 IF V$>="A" THEN V$=V$+ER$:C=ASC(V$)+1 ELSE IF V$>="0" THEN V$=RIGHT$(" "+V$,5):C=VAL(LEFT$(V$,2)) ELSE 1090 1030 IL=-1:I=C 1040 IF V$>V$(I) THEN IL=I: I=VNXT%(I): IF I>0 THEN 1040 ELSE 1060 1050 IF V$=V$(I) THEN J=LST%(I-91):IF RFL%(J)=LN THEN 1090 ELSE RC=RC+1:NXT%(J)=RC:GOTO 1080 1060 VC=VC+1:IF IL>=0 THEN VNXT%(IL)=VC 1070 V$(VC)=V$:VNXT%(VC)=I:RC=RC+1:FRST%(VC-91)=RC:I=VC 1080 RFL%(RC)=LN:NXT%(RC)=-1:LST%(I-91)=RC 1090 V$="":RETURN 1100 ' 1110 ' Expand variable 1120 ' 1130 IF V$<>"" THEN V$=V$+C$ 1140 RETURN 1150 IF V$="" AND BRNCH=0 THEN 750 1160 V$=V$+C$:GOTO 750 1170 ' 1180 ' List variables 1190 ' 1200 IF M=2 THEN RETURN 1210 PZ=0:GOSUB 1520 1220 FOR J=0 TO 91:V=J 1230 V=VNXT%(V):IF V<0 THEN 1340 1240 IF LZ>56 THEN GOSUB 1400 ELSE SZ=SZ+1:IF SZ=3 THEN GOSUB 1410 1250 RZ=0:I=FRST%(V-91):LPRINT V$(V); 1260 IF RZ=0 THEN LPRINT TAB(16); 1270 LN=RFL%(I):IF LN<0 THEN LN=LN+65536! 1280 LPRINT USING" #####";LN, 1290 RZ=RZ+1 1300 IF RZ>6 THEN RZ=0:LPRINT:LZ=LZ+1:IF LZ>56 THEN GOSUB 1400 1310 I=NXT%(I):IF I>0 THEN 1260 1320 IF RZ>0 THEN LPRINT:LZ=LZ+1 1330 GOTO 1230 1340 NEXT J 1350 ' 1360 LPRINT STRING$(80,"=") 1370 LPRINT"LINES:";LC;" BYTES:";BC;" SYMBOLS:";VC-91;" REFERENCES:";RC+1 1380 LZ=LZ+2:RETURN 1390 ' 1400 GOSUB 1520:LPRINT"SYMBOL";TAB(20);"REFERENCE LINE":LZ=LZ+1 1410 LPRINT STRING$(80,"-"):LZ=LZ+1:SZ=0:RETURN 1420 ' 1430 X=1 1440 IF LZ>60 OR RIGHT$(L$,3)="'PG" THEN GOSUB 1520 1450 Y=INSTR(X,L$,CHR$(10)):IF Y>0 THEN LPRINT MID$(L$,X,Y-X):LZ=LZ+1:X=Y+1:GOTO 1450 1460 LPRINT MID$(L$,X,LW):LZ=LZ+1:X=X+LW:IF X