home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol078 / mxref.bas < prev    next >
BASIC Source File  |  1984-04-29  |  6KB  |  166 lines
  1. 10 PRINT:PRINT"MBASIC Cross Reference Program"
  2. 20 PRINT"(C) Copyright 1980 by Advanced Informatics"
  3. 21 ' Author: James Monagan
  4. 22 ' Published in Interface Age Vol 6 No 6 June 1981
  5. 23 '
  6. 24 ' Original version for Informer III Computer
  7. 25 '       in Microsoft BASIC-80 v5.0
  8. 26 '
  9. 27 ' Modified and keyed in by Tony Nicholson
  10. 28 '  for Microsoft BASIC-80 v5.21 with CP/M
  11. 29 '
  12. 30 PRINT
  13. 40 LZ=65
  14. 50 '
  15. 60 DEFINT I-J: LW=80
  16. 70 ON ERROR GOTO 1480
  17. 80 DIM RW$(126),PT%(25),F$(10)
  18. 90 I=400:DIM VNXT%(490),V$(490),FRST%(400),LST%(400),RFL%(2000),NXT%(2000)
  19. 100 '
  20. 110 ' Reserved words
  21. 120 '
  22. 130 DATA ABS,AND,ASC,AS,ATN,BASE,CALL,CDBL,CHAIN,CHR$,CINT,CLEAR,CLOSE,COMMON
  23. 140 DATA COS,CSNG,CVD,CVI,CVS,DATA
  24. 150 DATA DEFDBL,DEFINT,DEFSGN,DEFSTR,DEFUSR,DEF,DIM,DSKI$,DSKO$,DSKF
  25. 160 DATA ELSE,END,EOF,EQV,ERASE,ERL,ERR,ERROR,EXP,FIELD,FILES,FIX,FOR
  26. 170 DATA FRE,GET,GOSUB,GOTO,HEX$
  27. 180 DATA IF,IMP,INKEY$,INPUT,INP,INSTR,INT,KILL,LEFT$,LEN,LET,LINE
  28. 190 DATA LOC,LOF,LOG,LPOS,LPRINT,LSET,MID$,MKD$,MKI$
  29. 200 DATA MKS$,MOD,NAME,NEXT,NOT,NULL,OCT$,ON,OPEN,OPTION,OR,OUT
  30. 210 DATA PEEK,POKE,POS,PRINT,PUT,RANDOMIZE
  31. 220 DATA READ,REM,RESET,RESTORE,RESUME,RETURN,RIGHT$,RND,RSET
  32. 230 DATA SGN,SIN,SPACE$,SPC(,SQR,STEP,STOP,STR$,STRING$,SWAP
  33. 240 DATA TAB(,TAN,THEN,TO,TROFF,TRON
  34. 250 DATA USING,USR,VAL,VARPTR,WAIT,WEND,WHILE,WIDTH,WRITE,XOR,"\"
  35. 260 '
  36. 270 ' Fill array with reserved words
  37. 280 '
  38. 290 RW=0
  39. 300 READ RW$
  40. 310 RW=RW+1:RW$(RW)=RW$:IF RW$="\" THEN 340
  41. 320 I=ASC(RW$)-ASC("A"):IF PT%(I)=0 THEN PT%(I)=RW
  42. 330 GOTO 300
  43. 340 '
  44. 350 FOR I=0 TO 25:IF PT%(I)=0 THEN PT%(I)=RW
  45. 360 NEXT
  46. 370 '
  47. 380 ' Get list of filenames
  48. 390 '
  49. 400 FX=0
  50. 410 PRINT: PRINT"ASCII SAVEd program #";FX+1;" = ";:LINE INPUT L$
  51. 420 IF L$="" THEN IF FX<1 THEN 570 ELSE 480
  52. 430 IF INSTR(L$,".")=0 THEN L$=L$+".BAS"
  53. 440 NAME L$ AS L$
  54. 450 FX=FX+1:F$(FX)=L$
  55. 460 GOTO 410
  56. 470 '
  57. 480 PRINT:INPUT "Date = ";D$
  58. 490 PRINT:INPUT"1) Cross reference   2) List   or 3) Both ";M
  59. 500 '
  60. 510 ' Process list of filenames
  61. 520 '
  62. 530 FOR F=1 TO FX
  63. 540 CLOSE 1:OPEN "I",1,F$(F): PRG$="'"+F$(F)+"'   -   "+D$: GOSUB 610
  64. 550 NEXT
  65. 560 LPRINT STRING$(65-LZ,CHR$(10))
  66. 570 END
  67. 580 '
  68. 590 ' Initialise for cross reference
  69. 600 '
  70. 610 LC=0:BC=0:PZ=0:V$="":C$="":VC=91:RC=-1
  71. 620 FOR I=0 TO 91:VNXT%(I)=-1:NEXT
  72. 630 IF M>1 THEN GOSUB 1520
  73. 640 '
  74. 650 ' Input line and extract line number
  75. 660 '
  76. 670 IF EOF(1) THEN 1200
  77. 680 LINE INPUT #1,L$:IF M>1 THEN GOSUB 1430:IF M=2 THEN 670
  78. 690 LG=LEN(L$):BRNCH=0:ER$="":LC=LC+1:BC=BC+LG
  79. 700 LP=INSTR(L$," "):LN=VAL(LEFT$(L$,LP))
  80. 710 IF LN>32767 THEN LN=LN-65536!
  81. 720 '
  82. 730 ' Parse rest of line
  83. 740 '
  84. 750 LP=LP+1:IF LP>LG THEN GOSUB 1010:GOTO 670
  85. 760 C$=MID$(L$,LP,1)
  86. 770 IF C$>="A" AND C$<="Z" THEN 890 ELSE IF (C$>="0" AND C$<="9") OR C$="." THEN 1150
  87. 780 IF C$=" " THEN GOSUB 1010:GOTO 750 ELSE IF C$<>","THEN BRNCH=0
  88. 790 IF C$=CHR$(34) THEN GOSUB 1010:LP=INSTR(LP+1,L$,C$):IF LP>0 THEN 750 ELSE 670
  89. 800 IF C$="'" THEN GOSUB 1010: GOTO 670
  90. 810 IF C$="&" THEN GOSUB 1010:V$=C$:GOTO 750
  91. 820 IF C$="$" OR C$="!" OR C$="%" OR C$="#" THEN GOSUB 1130:GOTO 750
  92. 830 IF C$="(" THEN GOSUB 1130
  93. 840 GOSUB 1010:IF C$<>"," THEN ER$=""
  94. 850 GOTO 750
  95. 860 '
  96. 870 ' Test for command
  97. 880 '
  98. 890 IF V$<>"" THEN 1160 ELSE C=ASC(C$):P=PT%(C-ASC("A")):BRNCH=0
  99. 900 IF C<ASC(RW$(P))THEN 1160
  100. 910 IF INSTR(LP,L$,RW$(P))<>LP THEN P=P+1: GOTO 900
  101. 920 GOSUB 1010:RW$=RW$(P)
  102. 930 IF RW$="DATA" THEN LP=INSTR(LP,L$,":"):IF LP>0 THEN 750 ELSE 670
  103. 940 IF RW$="REM" THEN 670
  104. 950 IF RW$="GOTO" OR RW$="GOSUB" OR RW$="THEN" OR RW$="ELSE" OR RW$="RESUME" THEN BRNCH=1
  105. 960 IF RW$="ERASE" THEN ER$="(" ELSE ER$=""
  106. 970 LP=LP+LEN(RW$)-1:GOTO 750
  107. 980 '
  108. 990 ' End variable
  109. 1000 '
  110. 1010 IF V$="" THEN RETURN
  111. 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
  112. 1030 IL=-1:I=C
  113. 1040 IF V$>V$(I) THEN IL=I: I=VNXT%(I): IF I>0 THEN 1040 ELSE 1060
  114. 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
  115. 1060 VC=VC+1:IF IL>=0 THEN VNXT%(IL)=VC
  116. 1070 V$(VC)=V$:VNXT%(VC)=I:RC=RC+1:FRST%(VC-91)=RC:I=VC
  117. 1080 RFL%(RC)=LN:NXT%(RC)=-1:LST%(I-91)=RC
  118. 1090 V$="":RETURN
  119. 1100 '
  120. 1110 ' Expand variable
  121. 1120 '
  122. 1130 IF V$<>"" THEN V$=V$+C$
  123. 1140 RETURN
  124. 1150 IF V$="" AND BRNCH=0 THEN 750
  125. 1160 V$=V$+C$:GOTO 750
  126. 1170 '
  127. 1180 ' List variables
  128. 1190 '
  129. 1200 IF M=2 THEN RETURN
  130. 1210 PZ=0:GOSUB 1520
  131. 1220 FOR J=0 TO 91:V=J
  132. 1230 V=VNXT%(V):IF V<0 THEN 1340
  133. 1240 IF LZ>56 THEN GOSUB 1400 ELSE SZ=SZ+1:IF SZ=3 THEN GOSUB 1410
  134. 1250 RZ=0:I=FRST%(V-91):LPRINT V$(V);
  135. 1260 IF RZ=0 THEN LPRINT TAB(16);
  136. 1270 LN=RFL%(I):IF LN<0 THEN LN=LN+65536!
  137. 1280 LPRINT USING"    #####";LN,
  138. 1290 RZ=RZ+1
  139. 1300 IF RZ>6 THEN RZ=0:LPRINT:LZ=LZ+1:IF LZ>56 THEN GOSUB 1400
  140. 1310 I=NXT%(I):IF I>0 THEN 1260
  141. 1320 IF RZ>0 THEN LPRINT:LZ=LZ+1
  142. 1330 GOTO 1230
  143. 1340 NEXT J
  144. 1350 '
  145. 1360 LPRINT STRING$(80,"=")
  146. 1370 LPRINT"LINES:";LC;"    BYTES:";BC;"    SYMBOLS:";VC-91;"    REFERENCES:";RC+1
  147. 1380 LZ=LZ+2:RETURN
  148. 1390 '
  149. 1400 GOSUB 1520:LPRINT"SYMBOL";TAB(20);"REFERENCE LINE":LZ=LZ+1
  150. 1410 LPRINT STRING$(80,"-"):LZ=LZ+1:SZ=0:RETURN
  151. 1420 '
  152. 1430 X=1
  153. 1440 IF LZ>60 OR RIGHT$(L$,3)="'PG" THEN GOSUB 1520
  154. 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
  155. 1460 LPRINT MID$(L$,X,LW):LZ=LZ+1:X=X+LW:IF X<LEN(L$) THEN 1460 ELSE RETURN
  156. 1470 '
  157. 1480 IF ERR=53 THEN PRINT:PRINT"File not found":RESUME 410
  158. 1490 IF ERR=58 THEN RESUME 450
  159. 1500 ON ERROR GOTO 0
  160. 1510 '
  161. 1520 LPRINT STRING$(65-LZ,CHR$(10))
  162. 1530 PZ=PZ+1:LPRINT TAB(68);"Page";PZ
  163. 1540 LPRINT PRG$:LPRINT
  164. 1550 LZ=3:RETURN
  165. 32767 END
  166.