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 MBASIC-80 v5.0
26 '
27 ' Modified and keyed in by Tony Nicholson
28 '  for MBASIC-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 C<ASC(RW$(P))THEN 1160
910 IF INSTR(LP,L$,RW$(P))<>LP 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<LEN(L$) THEN 1460 ELSE RETURN
1470 '
1480 IF ERR=53 THEN PRINT:PRINT"File not found":RESUME 410
1490 IF ERR=58 THEN RESUME 450
1500 ON ERROR GOTO 0
1510 '
1520 LPRINT STRING$(65-LZ,CHR$(10))
1530 PZ=PZ+1:LPRINT TAB(68);"Page";PZ
1540 LPRINT PRG$:LPRINT
1550 LZ=3:RETURN
32767 END
