home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / basic / xref19.bzs / XREF19.BAS
BASIC Source File  |  1987-01-27  |  9KB  |  263 lines
  1. 100 REM  Version 1.9 February 05/86 Ian Cottrell
  2. 110 CLEAR
  3. 120 VER$="1.9":DATE$="February 05/86"
  4. 130 CLS$=CHR$(24):PRINT CLS$;:    REM  Clear Screen Code
  5. 140 E$=CHR$(27):REM  Escape Character
  6. 150 DIM PRNAME$(8)
  7. 160 PRINT TAB(29) "=== C R O S S R E F ==="
  8. 170 PRINT
  9. 180 PRINT TAB(19) "COPYRIGHT (C) 1980 BY ADVANCED INFORMATICS"
  10. 190 PRINT TAB(17) "LISTS ALL VARIABLES AND REFERENCE LINE NUMBERS"
  11. 200 PRINT
  12. 210 PRINT TAB((71-LEN(VER$)-LEN(DATE$))/2);"Version ";VER$;" ";DATE$
  13. 220 PRINT TAB(39) "by"
  14. 230 PRINT TAB(24) "Klaus Bartels and Ian Cottrell":PRINT
  15. 240 GOSUB 2450
  16. 250 ON P GOSUB 2140,2180,2220,2260,2300,2340,2380,2420
  17. 260 LPRINT RP$;:REM  RESET PRINTER IF POSSIBLE
  18. 270 DEFINT I-J:LW=132
  19. 280 ON ERROR GOTO 1950
  20. 290 DIM RW$(150),PT%(25),F$(10)
  21. 300 DIM VNXT%(490),V$(490),FRST%(400),LST%(400),RFL%(2000),NXT%(2000)
  22. 310 '
  23. 320 '  RESERVED WORDS
  24. 330 '
  25. 340 DATA ABS,ALL,AND,ASC,AS,ATN,AUTO,BASE
  26. 350 DATA CALL,CDBL,CHAIN,CHR$,CINT,CLEAR,CLOSE,COMMON,CONSOLE,CONT
  27. 360 DATA COS,CSAVE,CSNG,CVD,CVI,CVS
  28. 370 DATA DATA,DEFDBL,DEFINT,DEFSNG,DEFSTR,DEFUSR,DEF
  29. 380 DATA DELETE,DIM,DSKI$,DSKO$,DSKF
  30. 390 DATA EDIT,ELSE,END,EOF,EQV,ERASE,ERL,ERROR,ERR,EXP
  31. 400 DATA FIELD#,FIELD,FILES,FIX,FN,FOR,FRE
  32. 410 DATA GET,GOSUB,GOTO,HEX$
  33. 420 DATA IF,IMP,INKEY$,INPUT#,INPUT$,INPUT,INP,INSTR,INT,KILL
  34. 430 DATA LEFT$,LEN,LET,LINE,LIST,LLIST,LOAD,LOC,LOF,LOG,LPOS,LPRINT,LSET
  35. 440 DATA MERGE,MID$,MKD$,MKI$,MKS$,MOD,MOUNT
  36. 450 DATA NAME,NEW,NEXT,NOT,NULL,OCT$,ON,OPEN,OPTION,OR,OUT
  37. 460 DATA PEEK,POKE,POS,PRINT#,PRINT,PUT
  38. 470 DATA RANDOMIZE,READ,REM,REMOVE,RENUM,RESET,RESTORE,RESUME
  39. 480 DATA RETURN,RIGHT$,RND,RSET,RUN
  40. 490 DATA SAVE,SGN,SIN,SPACE$,SPC,SQR,STEP,STOP,STR$,STRING$,SWAP,SYSTEM
  41. 500 DATA TAB,TAN,THEN,TO,TROFF,TRON,UNLOAD,USING,USR
  42. 510 DATA VAL,VARPTR,WAIT,WEND,WHILE,WIDTH,WRITE#,WRITE,XOR,"\"
  43. 520 '
  44. 530 ' FILL ARRAY WITH RESERVED WORDS
  45. 540 '
  46. 550 RESTORE 340
  47. 560 RW=0
  48. 570 READ RW$
  49. 580 RW=RW+1:RW$(RW)=RW$:IF RW$="\" THEN 620
  50. 590 I=ASC(RW$)-ASC("A"):IF PT%(I)=0 THEN PT%(I)=RW
  51. 600 GOTO 570
  52. 610 '
  53. 620 FOR I=0 TO 25:IF PT%(I)=0 THEN PT%(I)=RW
  54. 630 NEXT
  55. 640 '
  56. 650 '  GET LIST OF FILE NAMES
  57. 660 '
  58. 670 FX=0:PRINT CLS$
  59. 680 PRINT:PRINT "ASCII SAVE PROGRAM #" FX+1 " = ";:LINE INPUT L$
  60. 690 IF L$="" THEN IF FX<1 THEN 910 ELSE 750
  61. 700 IF INSTR(L$,".")=0 THEN L$=L$+".BAS"
  62. 710 NAME L$ AS L$
  63. 720 FX=FX+1:F$(FX)=L$
  64. 730 GOTO 680
  65. 740 '
  66. 750 PRINT:INPUT "DATE = ",D$
  67. 760 PRINT:INPUT "1)  CROSS REFERENCE    2)  LIST    3)  BOTH ";M
  68. 770 '
  69. 780 ' PROCESS LIST OF FILE NAMES
  70. 790 '
  71. 800 PRINT CLS$
  72. 810 FOR IDENT=1 TO FX
  73. 820  PRINT TAB(18);"XREF FILE ";F$(IDENT)
  74. 830 NEXT IDENT
  75. 840 PRINT
  76. 850 FOR F=1 TO FX
  77. 860 CLOSE:OPEN "I",1,F$(F):PRG$="'"+F$(F)+"' - "+D$
  78. 870 PRINT "CROSS-REF RUN LIST OF : ";PRG$
  79. 880 GOSUB 950
  80. 890 NEXT
  81. 900 LPRINT FF$
  82. 910 END
  83. 920 '
  84. 930 '  INITIALIZE FOR CROSS REFERENCE
  85. 940 '
  86. 950 LC=0:BC=0:PZ=0:V$="":C$="":VC=91:RC=-1:PZ=0
  87. 960 FOR I=0 TO 91:VNXT%(I)=-1:NEXT
  88. 970 IF M>1 THEN GOSUB 1990
  89. 980 '
  90. 990 '  INPUT LINE AND EXTRACT LINE NUMBER
  91. 1000 '
  92. 1010 IF EOF(1) THEN 1660
  93. 1020 LINE INPUT#1,L$:IF M>1 THEN GOSUB 1890:IF M=2 THEN 1010
  94. 1030 LG=LEN(L$):BRNCH=0:ER$="":LC=LC+1:BC=BC+LG
  95. 1040 GOSUB 2070
  96. 1050 PRINT "LEN=";LG;TAB(10);LEFT$(L$,65);TAB(78);"<"
  97. 1060  IF LN<10 THEN LP=2:GOTO 1110
  98. 1070   IF LN<100 THEN LP=3:GOTO 1110
  99. 1080    IF LN<1000 THEN LP=4:GOTO 1110
  100. 1090     IF LN<10000 THEN LP=5:GOTO 1110
  101. 1100 LP=6
  102. 1110 IF LN>32767 THEN LN=LN-65536!
  103. 1120 '
  104. 1130 '  PARSE REST OF LINE
  105. 1140 '
  106. 1150 LP=LP+1:IF LP>LG THEN GOSUB 1470:GOTO 1010
  107. 1160 C$=MID$(L$,LP,1)
  108. 1170 IF C$=CHR$(10) THEN LZ=LZ+1
  109. 1180 IF C$>="A" AND C$<="Z" THEN 1300 ELSE IF C$>="0" AND C$<="9" THEN 1610
  110. 1190 IF C$=" " THEN 1200 ELSE IF C$<>"," THEN BRNCH=0
  111. 1200 IF C$=CHR$(34) THEN GOSUB 1470:LP=INSTR(LP+1,L$,C$):IF LP>0 THEN 1150
  112.      ELSE 1010
  113. 1210 IF C$="'" THEN GOSUB 1470:GOTO 1010
  114. 1220 IF C$="&" THEN GOSUB 1470:V$=C$:GOTO 1150
  115. 1230 IF C$="$" OR C$="!" OR C$="%" OR C$="#" THEN GOSUB 1590:GOTO 1150
  116. 1240 IF C$="(" THEN GOSUB 1590
  117. 1250 GOSUB 1470:IF C$<>"," THEN ER$=""
  118. 1260 GOTO 1150
  119. 1270 '
  120. 1280 '  TEST FOR COMMAND
  121. 1290 '
  122. 1300 C=ASC(C$):P=PT%(C-ASC("A")):BRNCH=0
  123. 1310 IF C<ASC(RW$(P)) THEN 1620
  124. 1320 IF INSTR(LP,L$,RW$(P))<>LP THEN P=P+1:GOTO 1310
  125. 1330 N$=MID$(L$,LP+LEN(RW$(P)),1)
  126. 1340 N=VAL(N$)
  127. 1350 IF N>47 AND N<58 AND N>64 AND N<90 AND N>94 THEN P=P+1:GOTO 1310
  128. 1360 T$=MID$(L$,LP-1,1)
  129. 1370 IF (T$>="A" AND T$<="Z") OR (T$>="0" AND T$<="9") OR T$="." THEN 1620
  130. 1380 GOSUB 1470:RW$=RW$(P)
  131. 1390 IF RW$="DATA" THEN LP=INSTR(LP,L$,":"):IF LP>0 THEN 1150 ELSE 1010
  132. 1400 IF RW$="REM" THEN 1010
  133. 1410 IF RW$="GOTO" OR RW$="GOSUB" OR RW$="THEN" OR RW$="ELSE" OR RW$="RESUME"
  134.       THEN BRNCH=1
  135. 1420 IF RW$="ERASE" THEN ER$="(" ELSE ER$=""
  136. 1430 LP=LP+LEN(RW$)-1:GOTO 1150
  137. 1440 '
  138. 1450 '  END VARIABLE
  139. 1460 '
  140. 1470 IF V$=""THEN RETURN
  141. 1480 IF V$>="A" THEN V$=V$+ER$:C=ASC(V$)+1 ELSE IF V$>="0" THEN 
  142.      V$=RIGHT$("    "+V$,5):C=VAL(LEFT$(V$,2)) ELSE 1550
  143. 1490 IL=-1:I=C
  144. 1500 IF V$>V$(I) THEN IL=I:I=VNXT%(I):IF I>0 THEN 1500 ELSE 1520
  145. 1510 IF V$=V$(I) THEN J=LST%(I-91):IF RFL%(J)=LN THEN 1550 ELSE RC=RC+1:
  146.      NXT%(J)=RC:GOTO 1540
  147. 1520 VC=VC+1:IF IL>=0 THEN VNXT%(IL)=VC
  148. 1530 V$(VC)=V$:VNXT%(VC)=I:RC=RC+1:FRST%(VC-91)=RC:I=VC
  149. 1540 RFL%(RC)=LN:NXT%(RC)=-1:LST%(I-91)=RC
  150. 1550 V$="":RETURN
  151. 1560 '
  152. 1570 '  EXPAND VARIABLE
  153. 1580 '
  154. 1590 IF V$<>"" THEN V$=V$+C$
  155. 1600 RETURN
  156. 1610 IF V$="" AND BRNCH=0 THEN 1150
  157. 1620 V$=V$+C$:GOTO 1150
  158. 1630 '
  159. 1640 '  LIST VARIABLES
  160. 1650 '
  161. 1660 IF M=2 THEN RETURN
  162. 1670 GOSUB 1860
  163. 1680 FOR J=0 TO 91:V=J
  164. 1690 V=VNXT%(V):IF V<0 THEN 1800
  165. 1700 IF LZ>56 THEN GOSUB 1860 ELSE SZ=SZ+1:IF SZ=3 THEN GOSUB 1870
  166. 1710 RZ=0:I=FRST%(V-91):LPRINT TAB(10) V$(V);
  167. 1720 IF RZ=0 THEN LPRINT TAB(26);
  168. 1730 LN=RFL%(I):IF LN<0 THEN LN=LN+65536!
  169. 1740 LPRINT USING "    #####";LN,
  170. 1750 RZ=RZ+1
  171. 1760 IF RZ>10 THEN RZ=0:LPRINT:LZ=LZ+1:IF LZ>56 THEN GOSUB 1870
  172. 1770 I=NXT%(I):IF I>0 THEN 1720
  173. 1780 IF RZ>0 THEN LPRINT:LZ=LZ+1
  174. 1790 GOTO 1690
  175. 1800 NEXT J
  176. 1810 '
  177. 1820 LPRINT TAB(10) STRING$(122,"=")
  178. 1830 LPRINT TAB(10) "LINES: " LC "     BYTES: " BC "    SYMBOLS: "
  179.      VC-91 "    REFERENCES: " RC+1
  180. 1840 LZ=LZ+2:RETURN
  181. 1850 '
  182. 1860 GOSUB 1990:LPRINT TAB(10) "SYMBOL" TAB(30) "REFERENCE LINE":LZ=LZ+1
  183. 1870 LPRINT TAB(10) STRING$(122,"-"):LZ=LZ+1:SZ=0:RETURN
  184. 1880 '
  185. 1890 X=1
  186. 1900 IF LZ>60 THEN GOSUB 1990
  187. 1910 IF RIGHT$(L$,3)="'PG" THEN GOSUB 1990
  188. 1920 Y=INSTR(X,L$,CHR$(10)):IF Y>0 THEN LPRINT TAB(10) MID$(L$,X,Y-X):
  189.      LZ=LZ+1:IF ASC(MID$(L$,Y+1,1))=13 THEN X=Y+2 ELSE X=Y+1:GOTO 1920
  190. 1930 LPRINT TAB(10) MID$(L$,X,LW):LZ=LZ+1:X=X+LW:
  191.      IF X<LEN(L$) THEN 1930 ELSE RETURN
  192. 1940 '
  193. 1950 IF ERR=53 THEN PRINT:PRINT "FILE NOT FOUND":RESUME 680
  194. 1960 IF ERR=58 THEN RESUME 720
  195. 1970 ON ERROR GOTO 0
  196. 1980 '
  197. 1990 LPRINT FF$;
  198. 2000 PZ=PZ+1
  199. 2010 LS=(58-LEN(PRG$)-6)
  200. 2020 LPRINT CMP$;
  201. 2030 LPRINT TAB(10);EXO$;PRG$;SPC(LS);
  202. 2040 LPRINT " Page ";PZ
  203. 2050 LPRINT EXF$:LPRINT
  204. 2060 LZ=4:RETURN
  205. 2070 NUM=0
  206. 2080 FOR II=1 TO LG
  207. 2090 IF MID$(L$,II,1)=" " THEN II=LG ELSE NUM=NUM+1
  208. 2100 NEXT II
  209. 2110 LN=VAL(LEFT$(L$,NUM))
  210. 2120 RETURN
  211. 2130 REM  QANTEX 7030 PRINTER
  212. 2140 EXO$=CHR$(14):EXF$=CHR$(15)
  213. 2150 CMP$=E$+"[4w":RP$=E$+"c":FF$=CHR$(12)
  214. 2160 RETURN
  215. 2170 REM  C. ITOH PROWRITER PRINTERS
  216. 2180 EXO$=CHR$(14):EXF$=CHR$(15)
  217. 2190 CMP$=E$+"Q":RP$="":FF$=CHR$(12)
  218. 2200 RETURN
  219. 2210 REM  EPSON MX-80/100 PRINTERS
  220. 2220 EXO$=CHR$(14):EXF$=CHR$(20)
  221. 2230 CMP$=CHR$(15):RP$="":FF$=CHR$(12)
  222. 2240 RETURN
  223. 2250 REM  STAR MICRONICS GEMINI PRINTER
  224. 2260 EXO$=E$+CHR$(14):EXF$=CHR$(20)
  225. 2270 CMP$=E$+"B"+CHR$(3):RP$="":FF$=CHR$(12)
  226. 2280 RETURN
  227. 2290 REM  GENICOM 3400 PRINTER
  228. 2300 EXO$=E$+CHR$(14):EXF$=CHR$(20)
  229. 2310 CMP$=E$+"[;43 G":RP$="":FF$=CHR$(12)
  230. 2320 RETURN
  231. 2330 REM  CITIZEN MSP-10/15/20/25 PRINTERS
  232. 2340 EXO$=CHR$(14):EXF$=CHR$(20)
  233. 2350 CMP$=CHR$(15):RP$=E$+"@":FF$=CHR$(12)
  234. 2360 RETURN
  235. 2370 REM  PANASONIC KX-P1090 PRINTER
  236. 2380 EXO$=CHR$(14):EXF$=CHR$(20)
  237. 2390 CMP$=CHR$(15):RP$=E$+"@":FF$=CHR$(12)
  238. 2400 RETURN
  239. 2410 REM  FACIT 4510 PRINTER
  240. 2420 EXO$=CHR$(30):EXF$=CHR$(31)
  241. 2430 CMP$=E$+"7":RP$=E$+"0":FF$=CHR$(12)
  242. 2440 RETURN
  243. 2450 REM  Read names of available printers
  244. 2460 RESTORE 2500
  245. 2470 FOR M=1 TO 8
  246. 2480    READ PRNAME$(M)
  247. 2490 NEXT M
  248. 2500 DATA "Qantex 7030","C. Itoh Prowriter","Epson MX/FX-80/100"
  249. 2510 DATA "Star Micronics Gemini","GE Genicom 3400","Citizen MSP-10/15/20/25"
  250. 2520 DATA "Panasonic KX-P1090","Facit 4510"
  251. 2530 REM  Ask for desired printer
  252. 2540 PRINT
  253. 2550 PRINT "> This program presently supports the following printers:":PRINT
  254. 2560 FOR I=1 TO 8 STEP 2
  255. 2570    PRINT "       " CHR$(I+48) ")  " PRNAME$(I) TAB(41)
  256.         CHR$(I+1+48) ")  " PRNAME$(I+1)
  257. 2580 NEXT I
  258. 2590 PRINT:PRINT "> Please select the printer you wish to use .... ";
  259. 2600 R$=INKEY$:IF R$="" THEN 2600 ELSE PRINT R$
  260. 2610 P=VAL(R$)
  261. 2620 IF P<1 OR P>8 THEN 2590
  262. 2630 RETURN
  263. s