home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / pcxref3.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-11-09  |  13.3 KB  |  305 lines
  1. 1000  ' PC-XREF3.BAS Program Ver 3.1 Rev 15 Jan 1984 
  2. 1010  ' WARNING!!! DO NOT ALTER, BYPASS OR REMOVE LINES 1000-1220 
  3. 1020  CLS: CLEAR ,,512: KEY OFF: WIDTH 80: LOCATE ,,0: COLOR 7,0: SCREEN 0,0,0 
  4. 1030  DEFSTR C,S: DEFINT A-B,E-Q,U-Z: DEFSNG R,T: DEFDBL D 
  5. 1040  DIM SR(4000),C(4),CX(127),CF(37),CE(36),CD(6),F(8),VC(8),UC(8) 
  6. 1050  DIM CA(6),CC(8),SM(8): DATA 011584
  7. 1060  IM=4000: I=VARPTR(C(1))-VARPTR(C(0)): IF I=4 THEN IC=-1 ELSE IC=0 
  8. 1070  PRINT TAB(16) STRING$(15,45)" U S E R W A R E "STRING$(15,45) 
  9. 1080  PRINT: PRINT TAB(28)"User Supported Software": PRINT: R=SCREEN(3,29)*97 
  10. 1090  RESTORE 1100: FOR I=1 TO 15: READ S: PRINT SPC(8)S: NEXT I 
  11. 1100  DATA"                          PC-XREF3 
  12. 1110  DATA"                   Version 3.1  15 Jan 1983","" 
  13. 1120  DATA"      If you are using PC-XREF3 and finding it of value," 
  14. 1130  DATA"    your contribution ($3 suggested) will be appreciated.","" 
  15. 1140  DATA"            Copyright (c) 1984 by James T. Demberger 
  16. 1150  DATA"                     7280 60th Avenue North, 
  17. 1160  DATA"                    St. Petersburg, FL 33709 
  18. 1170  DATA"                          813-546-1182 
  19. 1180  DATA"                     CompuServe 74425,1642","" 
  20. 1190  DATA"You are encouraged to copy and share this program with other users, 
  21. 1200  DATA"so long as the program is not distributed in modified form, that 
  22. 1210  DATA"no fee is charged, and that this notice is not bypassed or removed. 
  23. 1220  SE=" Press any key to ": ON ERROR GOTO 1240: GOSUB 1420: GOTO 3260 
  24. 1230  ' subroutines 
  25. 1240  IF ERR<28 AND ERR>23 AND ERL=1410 THEN 1250 ELSE 1260 
  26. 1250  PRINT: PRINT SPC(30)"FIX THE PRINTER": GOSUB 1420: RESUME 1410 
  27. 1260  CLOSE: IF ERR=14 THEN 1280 ELSE I=ERR: J=ERL: RESUME 1270 
  28. 1270  PRINT: PRINT SPC(25)"ERROR ";I;" AT ";J: GOSUB 1420: GOTO 1570 
  29. 1280  FOR J=1 TO 4: C(J)="": NEXT J: PRINT: RESUME 2710 
  30. 1290  IF PR=0 THEN RETURN ELSE PRINT #1,CHR$(12); 
  31. 1300  IF PR=0 THEN RETURN ELSE PRINT #1,SF;" ";SH; 
  32. 1310  S=" ": IF IW>80 THEN S=SPACE$(50) 
  33. 1320  PRINT #1,S;TIME$;" ";DATE$;" Page ";PG: PRINT #1,"": LP=0: PG=PG+1: RETURN 
  34. 1330  PRINT: PRINT SPC(20)"Output to Display or Printer - D/p ";: GOSUB 1430 
  35. 1340  CLOSE #1: IF K=80 THEN SX="LPT1:": PR=1 ELSE PR=0: SX="SCRN:" 
  36. 1350  LP=0: IW=80: WIDTH 80: OPEN "O",#1,SX: IF K<>80 THEN RETURN 
  37. 1360  PRINT: PRINT SPC(20)"Compressed or Normal width - c/N ";: GOSUB 1430 
  38. 1370  IF K<>67 THEN SA=CHR$(18)+CHR$(27)+CHR$(81)+CHR$(80): GOTO 1390 
  39. 1380  SA=CHR$(15)+CHR$(27)+CHR$(81)+CHR$(132): IW=132: WIDTH #1,132 
  40. 1390  PRINT: PRINT SPC(20)"Set paper to top of page and press Enter or" 
  41. 1400  PRINT SPC(25)"Press S key to Skip to top of page ";: GOSUB 1430 
  42. 1410  IF K=83 THEN PRINT #1,SA+CHR$(12);: RETURN ELSE PRINT #1,SA;: RETURN 
  43. 1420  PRINT: PRINT SPC(24)SE;"continue ";: GOSUB 1430: RETURN 
  44. 1430  LR=CSRLIN: LC=POS(0): LOCATE 25,4: COLOR 0,7: PRINT" Press letter key or"; 
  45. 1440  PRINT" Enter key for upper case default or Escape key to END "; 
  46. 1450  LOCATE LR,LC: COLOR 23,0: PRINT"_";: COLOR 7,0: LOCATE LR,LC: BEEP 
  47. 1460  DEF SEG=&H40: POKE &H1A,PEEK(&H1C): S=INPUT$(1): K=ASC(S) 
  48. 1470  IF K=27 THEN 1570 ELSE IF K=6 THEN 1560 
  49. 1480  IF K>96 AND K<123 THEN K=K-32 ELSE IF K<33 THEN K=32 
  50. 1490  IF K>31 THEN PRINT CHR$(K) ELSE PRINT" " 
  51. 1500  LR=CSRLIN: LC=POS(0): LOCATE 25,1: PRINT SPACE$(79);: LOCATE LR,LC 
  52. 1510  RETURN 
  53. 1520  LR=CSRLIN: LC=POS(0): LOCATE 25,4: COLOR 0,7: PRINT SE; 
  54. 1530  PRINT"stop/start scrolling/printing or press Escape key to Exit "; 
  55. 1540  LOCATE LR,LC: COLOR 7,0: RETURN 
  56. 1550  SOUND 32767,50: SOUND 32767,1: RETURN 
  57. 1560  PRINT"FREe=";FRE(S);: GOSUB 1550: LOCATE LR,LC: PRINT SPC(12): GOTO 1450 
  58. 1570  CLS: WIDTH 80: LOCATE 10,35: PRINT"End Program? Y/n ";: GOSUB 1430 
  59. 1580  IF K=78 THEN 3490 ELSE CLS: PRINT SPC(36)"END PC-XREF3": GOSUB 1550: END 
  60. 1590  CLS: LOCATE 4,25: PRINT"Display/print cancelled by Escape" 
  61. 1600  PRINT: PRINT SPC(20)"Do you want to continue, rerun or end? c/r/e "; 
  62. 1610  GOSUB 1430: IF K=69 THEN 1570 ELSE IF K=82 THEN 3490 
  63. 1620  IF K=67 THEN RETURN 
  64. 1630  PRINT: PRINT SPC(33)"Not C D or E": GOSUB 1550: GOTO 1590 
  65. 1640  S=TIME$: TC=VAL(LEFT$(S,2))*3600+VAL(MID$(S,4,2))*60+VAL(RIGHT$(S,2)) 
  66. 1650  RETURN 
  67. 1660  S=INKEY$: IF S="" THEN 1680 ELSE IF ASC(S)=27 THEN IE=-1: RETURN 
  68. 1670  S=INKEY$: IF S="" THEN 1670 ELSE IF ASC(S)=27 THEN IE=-1 
  69. 1680  RETURN 
  70. 1690  ' print program 
  71. 1700  CLS: PG=1: NL=0: NR=0: ST="": SL="": GOSUB 1640: T1=TC 
  72. 1710  RB=FRE(S): GOSUB 1520: LSET SH=S1: IF PR THEN GOSUB 1300 
  73. 1720  GOSUB 2660: GOSUB 2660: GOSUB 2630: ST=STR$(RT)+" ": RH=RT: GOSUB 2590 
  74. 1730  ' identify tokens 
  75. 1740  GOSUB 2670: IF NR>=IM THEN 2720 
  76. 1750  IF A<128 THEN 1940 ELSE IF A=132 THEN 1900 
  77. 1760  IF A=177 THEN M=M+1  'drop + after while 
  78. 1770  IF A=143 OR A=217 THEN 1870 ELSE IF A<253 THEN J=252 ELSE J=A: GOSUB 2670 
  79. 1780  ON J-251 GOTO 1790,1820,1830,1840 
  80. 1790  ST=CX(A-128): IF A=161 AND RIGHT$(SL,1)=":" THEN SL=LEFT$(SL,LEN(SL)-1) 
  81. 1800  GOSUB 2600: IF (A>229 AND A<238) OR A=244 THEN 1740 
  82. 1810  GOTO 1850 
  83. 1820  ST=CD(A-128): GOSUB 2600: GOTO 1850  'FD 
  84. 1830  ST=CE(A-128): GOSUB 2600: GOTO 1850  'FE 
  85. 1840  ST=CF(A-128): GOSUB 2600             'FF 
  86. 1850  ST=CC(8)+ST: GOTO 2550               'reserved word 
  87. 1860  ' remark 
  88. 1870  IF RIGHT$(SL,1)=":" THEN SL=LEFT$(SL,LEN(SL)-1) ELSE ST="REM": GOTO 1910 
  89. 1880  GOSUB 2670: ST="'": GOTO 1910 
  90. 1890  ' data 
  91. 1900  ST="DATA" 
  92. 1910  IF F(8) THEN IF (RH>=RS AND RH<=RE) THEN NR=NR+1: SR(NR)=CC(8)+ST+SN 
  93. 1920  GOSUB 2670: IF A=0 THEN SL=SL+ST: GOTO 2410 ELSE ST=ST+SC: GOTO 1920 
  94. 1930  ' name 
  95. 1940  IF A<65 OR A>90 THEN 2060 
  96. 1950  ST=SC 
  97. 1960  GOSUB 2670: IF A=46 OR A=33 OR A=35 OR A=36 OR A=37 THEN 1980 
  98. 1970  IF (A>64 AND A<91) OR (A>47 AND A<58) THEN 1980 ELSE 1990 
  99. 1980  ST=ST+SC: GOTO 1960 
  100. 1990  SL=SL+ST: IF A=40 THEN ST=ST+CHR$(A): GOTO 2030 
  101. 2000  IF A<>32 THEN 2030 ELSE SL=SL+SC 
  102. 2010  GOSUB 2670: IF A=40 OR A=32 THEN SL=SL+SC: GOTO 2020 ELSE 2030 
  103. 2020  IF A=40 THEN ST=ST+CHR$(A): M=M+1 ELSE IF A=32 THEN 2010 
  104. 2030  IF M=1 THEN SB=SP: M=255: GOTO 2040 ELSE M=M-1 
  105. 2040  ST=CC(1)+ST: GOTO 2550 
  106. 2050  ' line number 
  107. 2060  IF A<>14 THEN 2090 ELSE GOSUB 2660: IF RT<0 THEN RT=RT+65535 
  108. 2070  ST=STR$(RT): GOSUB 2590: GOSUB 2580: ST=CC(2)+ST: GOTO 2550 
  109. 2080  ' literal constant 
  110. 2090  IF A<>34 THEN 2140 ELSE ST=SC 
  111. 2100  GOSUB 2670: ST=ST+SC: IF A=0 THEN SL=SL+ST: ST=CC(7)+ST: GOTO 2410 
  112. 2110  IF A=34 THEN 2120 ELSE 2100 
  113. 2120  GOSUB 2600: ST=CC(7)+ST: GOTO 2550 
  114. 2130  ' 1 decimal digit constant 
  115. 2140  IF A<17 OR A>26 THEN 2170 
  116. 2150  ST=STR$(A-17): GOSUB 2590: GOSUB 2580: ST=CC(3)+ST: GOTO 2550 
  117. 2160  ' 1 byte integer constant 
  118. 2170  IF A<>15 THEN 2200 
  119. 2180  GOSUB 2670: ST=STR$(A): GOSUB 2590: GOSUB 2580: ST=CC(3)+ST: GOTO 2550 
  120. 2190  ' 2 byte signed integer constant 
  121. 2200  IF A<>28 THEN 2230 ELSE GOSUB 2660 
  122. 2210  ST=STR$(RT): GOSUB 2590: GOSUB 2580: ST=CC(3)+ST: GOTO 2550 
  123. 2220  ' 4 byte single prec constant 
  124. 2230  IF A<>29 THEN 2270 ELSE DEF SEG 
  125. 2240  ST="": T=0: J=VARPTR(T): FOR I=0 TO 3: GOSUB 2670: POKE J+I,A: NEXT I 
  126. 2250  SW="!": ST=STR$(T): GOSUB 2590: ST=CC(4)+ST: GOTO 2550 
  127. 2260  ' 8 byte double prec constant 
  128. 2270  IF A<>31 THEN 2310 ELSE DEF SEG 
  129. 2280  ST="": D=0: J=VARPTR(D): FOR I=0 TO 7: GOSUB 2670: POKE J+I,A: NEXT I 
  130. 2290  SW="#": ST=STR$(D): GOSUB 2590: ST=CC(5)+ST: GOTO 2550 
  131. 2300  ' 2 byte hex/oct constant 
  132. 2310  IF A<>11 AND A<>12 THEN 2350 ELSE I=A 
  133. 2320  GOSUB 2660: IF I=12 THEN ST="&H"+HEX$(RT) ELSE ST="&O"+OCT$(RT) 
  134. 2330  GOSUB 2600: ST=CC(6)+ST: GOTO 2550 
  135. 2340  ' special characters 
  136. 2350  IF A=32 OR A=35 OR A=36 OR A=40 OR A=41 OR A=44 THEN 2380 
  137. 2360  IF A=45 OR A=58 OR A=59 OR A=91 OR A=93 THEN 2380 
  138. 2370  GOTO 2400 
  139. 2380  ST=CHR$(A): GOSUB 2600: GOTO 1740 
  140. 2390  ' end of line 
  141. 2400  IF A<>0 THEN 2500 
  142. 2410  GOSUB 2660: GOSUB 2630: IF RT THEN 2440 
  143. 2420  IF RH<RS OR RH>RE THEN 2430 ELSE NL=NL+1: PRINT #1,SL 
  144. 2430  IF PR THEN RETURN ELSE GOSUB 1420: RETURN 
  145. 2440  GOSUB 2660: GOSUB 2630: IF RH>RE THEN 2430 
  146. 2450  IF RH<RS THEN 2480 ELSE NL=NL+1: PRINT #1,SL: GOSUB 1660 
  147. 2460  IF IE THEN IE=0: GOSUB 1590: GOTO 3760 
  148. 2470  IF PR THEN LP=LP+(LEN(SL)\IW+1): IF LP>=57 THEN GOSUB 1290 
  149. 2480  SL="": ST=STR$(RT)+" ": RH=RT: GOSUB 2590: GOTO 1740 
  150. 2490  ' other 
  151. 2500  IF RIGHT$(SL,5)="BASE " THEN SL=SL+CHR$(A): GOTO 1740 
  152. 2510  ' get to here must be an invalid code with A 
  153. 2520  ' (>47 AND <58),(>96 AND <122),<11,=13,=15,=16,=30 
  154. 2530  ST=CHR$(1)+" ->ASCII="+STR$(A)+"<- ": GOSUB 2600: GOTO 2560 
  155. 2540  ' store token 
  156. 2550  IF NOT F(ASC(ST)) OR RH<RS OR RH>RE THEN 1740 
  157. 2560  NR=NR+1: SR(NR)=ST+SN: GOTO 1740 
  158. 2570  ' add/strip leading blank 
  159. 2580  RSET S6=ST: ST=S6: RETURN 
  160. 2590  IF LEFT$(ST,1)=" " THEN ST=RIGHT$(ST,LEN(ST)-1): GOTO 2590 
  161. 2600  SL=SL+ST: IF SW<>"" THEN SL=SL+SW: SW="" 
  162. 2610  RETURN 
  163. 2620  ' convert line no to string 
  164. 2630  R=RT: IF R>32767 THEN R=R-(65535) 
  165. 2640  J=R: SN=MKI$(J): SN=" "+RIGHT$(SN,1)+LEFT$(SN,1): RETURN 
  166. 2650  ' get character, advance pointer 
  167. 2660  GOSUB 2670: R=A: GOSUB 2670: RT=A: RT=R+256*RT: RETURN 
  168. 2670  IF M<=LEN(SB) THEN 2690  'char in buffer? 
  169. 2680  SP=SB: GET #2,RN: RN=RN+1: SB=SD: M=1 
  170. 2690  SC=MID$(SB,M,1): A=ASC(SC): M=M+1: RETURN 
  171. 2700  ' out of string space or array dim 
  172. 2710  PRINT SPC(20);"Out of string space at line ";RH: GOTO 2730 
  173. 2720  PRINT: PRINT SPC(20)"Number references exceeds maximum of";IM 
  174. 2730  GOSUB 1600: GOTO 3760 
  175. 2740  ' sort 
  176. 2750  CLS: LOCATE 9,37: PRINT"SORTING": GOSUB 1640: T2=TC: K=NR: L=K 
  177. 2760  K=INT(K/2): IF K>0 THEN K=(K OR 1) ELSE GOSUB 1640: T3=TC: RETURN 
  178. 2770  FOR I=1 TO L-K: J=I 
  179. 2780  IF SR(J)>SR(J+K) THEN 2790 ELSE 2800 
  180. 2790  SWAP SR(J),SR(J+K): J=J-K: IF J>0 GOTO 2780 
  181. 2800  NEXT I: GOTO 2760 
  182. 2810  ' print cross reference 
  183. 2820  CLS: CLOSE: PG=1: S="Cross Reference List" 
  184. 2830  LSET SH=S: PRINT SPC(30)S: GOSUB 1330: CLS: GOSUB 1520: GOSUB 1300 
  185. 2840  FOR I=0 TO 8: VC(I)=0: UC(I)=0: NEXT I: IF IW=80 THEN IW=72 ELSE IW=120 
  186. 2850  LT=ASC(SR(1)): PRINT #1,SPC(30)SM(LT);: LP=2 
  187. 2860  IF LT>2 AND LT<8 THEN PRINT #1,SM(0) ELSE PRINT #1,"" 
  188. 2870  FOR I=1 TO NR: GOSUB 1660: IF IE=0 THEN 2890 
  189. 2880  IE=0: GOSUB 1590: K=127: PRINT #1,"": GOTO 3060 
  190. 2890  J=ASC(SR(I)): VC(J)=VC(J)+1: IF J=LT THEN 2920 ELSE LT=J 
  191. 2900  PRINT #1,"": PRINT #1,"": PRINT #1,SPC(30)SM(LT);: LP=LP+3 
  192. 2910  IF LT>2 AND LT<8 THEN PRINT #1,SM(0) ELSE PRINT #1,"" 
  193. 2920  IF SR(I)=SR(I-1) THEN 3040 ELSE ST=MID$(SR(I),2): L=LEN(ST) 
  194. 2930  IF L-3<=IW THEN NP=(L-3)\6 ELSE NP=IW\6 
  195. 2940  CW=SPACE$((NP+1)*6): IF LEN(CW)>IW THEN CW=LEFT$(CW,IW) 
  196. 2950  L=LEN(CW): SN=RIGHT$(ST,2): SN=RIGHT$(SN,1)+LEFT$(SN,1): R=CVI(SN) 
  197. 2960  IF R<0 THEN R=R+65535 
  198. 2970  SN=STR$(R): RSET S6=SN: ST=LEFT$(ST,LEN(ST)-3): IF SP=ST THEN 3000 
  199. 2980  PRINT #1,"": IF LP=>57 THEN GOSUB 1290 
  200. 2990  LSET CW=ST: PRINT #1,CW;: K=L: LP=LP+1: SP=ST: UC(LT)=UC(LT)+1: GOTO 3010 
  201. 3000  IF S6=SS THEN 3040 
  202. 3010  IF K>IW THEN 3020 ELSE PRINT #1,S6;: K=K+6: SS=S6: GOTO 3040 
  203. 3020  PRINT #1,"": IF LP=>57 THEN GOSUB 1290 
  204. 3030  PRINT #1,SPACE$(6);: LP=LP+1: K=6: GOTO 3010 
  205. 3040  NEXT I: PRINT #1,"" 
  206. 3050  ' end 
  207. 3060  GOSUB 1500: IF PR AND LP>44 THEN GOSUB 1290 
  208. 3070  IF PR=0 AND K<>127 THEN GOSUB 1420 
  209. 3080  PRINT #1,"": GOSUB 1640: T4=TC: PRINT #1,"     Program lines printed";NL; 
  210. 3090  PRINT #1,"   Time Run";T4-T1;"seconds   Sort";T3-T2;"seconds" 
  211. 3100  IF IC=0 THEN PRINT SPC(25)"Delay - checking FREe memory" 
  212. 3110  RA=FRE(S): PRINT #1,SPC(19)"Memory start";RB;" end";RA;" "; 
  213. 3120  PRINT #1,USING"##% used";ABS((RA/RB)*100-100) 
  214. 3130  PRINT #1,SPC(41)"Number Referenced" 
  215. 3140  SF="####": FOR I=1 TO 8: IF F(I)=0 THEN 3180 ELSE PRINT #1,TAB(20); 
  216. 3150  PRINT #1,SM(I);: IF I>2 AND I<8 THEN PRINT #1,SM(0); ELSE PRINT #1,""; 
  217. 3160  PRINT #1,TAB(42);: PRINT #1,USING SF;UC(I);: PRINT #1,TAB(50); 
  218. 3170  PRINT #1,USING SF;VC(I): UC(0)=UC(0)+UC(I): VC(0)=VC(0)+VC(I) 
  219. 3180  NEXT I: PRINT #1,TAB(20);"  Total";TAB(42);: PRINT #1,USING SF;UC(0); 
  220. 3190  PRINT #1,TAB(50);: PRINT #1,USING SF;VC(0); 
  221. 3200  PRINT #1,TAB(58);: PRINT #1,USING"##.## byte/ref";(RB-RA)/VC(0) 
  222. 3210  GOSUB 1420: CLS: LOCATE 6,28:  PRINT"End of Cross Reference Run" 
  223. 3220  PRINT: IF PR=0 THEN 3230 ELSE GOSUB 1400 
  224. 3230  CLOSE: PRINT: PRINT SPC(25)"Another Cross Reference Run? y/N "; 
  225. 3240  GOSUB 1430: IF K=89 THEN 3490 ELSE 1570 
  226. 3250  ' initialization 
  227. 3260  CLS: PRINT SPC(22)"PC-XREF3 CROSS REFERENCE UTILITY PROGRAM": PRINT 
  228. 3270  RESTORE: READ T: IF T+R=22739 THEN 3290 
  229. 3280  PRINT SPC(22)"USERWARE NOTICE DELETED OR BYPASSED": GOSUB 1550: END 
  230. 3290  PRINT TAB(13): COLOR 0,7 
  231. 3300  PRINT" Input to PC-XREF3 must be a program file in SYSTEM format. " 
  232. 3310  PRINT: J=9: COLOR 7,0: IF IC THEN 3450 
  233. 3320  DATA"This program is using interpreted BASIC.  Do to frequent lengthy 
  234. 3330  DATA"delays while system cleans up string space, use the interpreted 
  235. 3340  DATA"version only for testing program modifications with small programs. 
  236. 3350  DATA"        The compiled version has no string cleanup delay.","" 
  237. 3360  RESTORE 3320: FOR I=1 TO 5: READ S: PRINT SPC(J)S: NEXT I 
  238. 3370  DATA"Depending on available memory and length of variable names and 
  239. 3380  DATA"strings, up to 4000 names, strings, line numbers and/or numeric 
  240. 3390  DATA"constants may be processed in one run.  If out of string space error 
  241. 3400  DATA"occurs, run the program with a lesser number of options selected. 
  242. 3410  DATA"","Program description and run instructions are on diskette with a 
  243. 3420  DATA"filename of PC-XREF3.DOC.  Send a diskette in stamped self-addressed 
  244. 3430  DATA"mailer to author for the BASIC program PC-XREF3.BAS, the compiled 
  245. 3440  DATA"program PC-XREF3.EXE and documentation file PC-XREF3.DOC.","" 
  246. 3450  RESTORE 3370: FOR I=1 TO 10: READ S: PRINT SPC(J)S 
  247. 3460  IF I<5 THEN C(I)=SPACE$(75) 
  248. 3470  NEXT I: PRINT SPC(22)"Reading Reserved Words, Please Wait" 
  249. 3480  S6="      ": SH=SPACE$(25): S1="Program List": GOSUB 3770: GOSUB 1420 
  250. 3490  FOR I=1 TO NR: SR(I)="": NEXT I 
  251. 3500  CLS: PRINT SPC(33)S1: PRINT 
  252. 3510  PRINT SPC(20)"Enter dr:name.BAS of program file "; 
  253. 3520  LINE INPUT"",SF: IF INSTR(SF,".") THEN 3530 ELSE SF=SF+".BAS" 
  254. 3530  ON ERROR GOTO 3640: CLOSE #2: OPEN "I",#2,SF: CLOSE #2: ON ERROR GOTO 1240 
  255. 3540  CLOSE #2: OPEN SF AS #2 LEN=128: FIELD #2,128 AS SD: RN=1: M=1: SB="" 
  256. 3550  GOSUB 2670: IF A=255 THEN 3580 ELSE PRINT 
  257. 3560  IF A=254 THEN ST="IN PROTECTED" ELSE ST="NOT IN SYSTEM" 
  258. 3570  PRINT SPC(25)"PROGRAM ";ST;" FORMAT": PRINT: PRINT SPC(20);: GOTO 3650 
  259. 3580  RS=0: PRINT: PRINT SPC(20)"Enter starting line number   ";RS; 
  260. 3590  INPUT"",S: IF S="" THEN RS=0 ELSE RS=VAL(S): IF RS<0 THEN RS=0 
  261. 3600  RE=65529: PRINT: PRINT SPC(20)"Enter ending line number ";RE;: INPUT"",S 
  262. 3610  IF S="" THEN RE=65529 ELSE RE=VAL(S): IF RE>65529 THEN RE=65529 
  263. 3620  IF RE<RS THEN PRINT: PRINT SPC(30)"END LESS THAN START": GOTO 3580 
  264. 3630  GOSUB 1330: GOTO 3660 
  265. 3640  PRINT: PRINT SPC(25)"File not found - ";SF: PRINT: RESUME 3650 
  266. 3650  PRINT SPC(25)"Press Esc or Enter to continue";: GOSUB 1430: GOTO 3500 
  267. 3660  CLS: LOCATE 3,15: SG="ABCDEFGH" 
  268. 3670  PRINT"The following cross reference options may be selected:": PRINT 
  269. 3680  FOR I=1 TO 8: F(I)=0: PRINT SPC(30);CHR$(I+64);"  ";SM(I); 
  270. 3690  IF I>2 AND I<8 THEN PRINT SM(0) ELSE PRINT 
  271. 3700  NEXT I: PRINT: PRINT SPC(20)"Enter letters for options, for example, ABCG" 
  272. 3710  PRINT SPC(21)"or press Enter key for all options ";: LINE INPUT SO 
  273. 3720  IF SO="" THEN SO=SG 
  274. 3730  FOR I=1 TO LEN(SO): J=ASC(MID$(SO,I,1)) 
  275. 3740  IF J>96 AND J<123 THEN MID$(SO,I,1)=CHR$(J-32) 
  276. 3750  F(INSTR(SG,MID$(SO,I,1)))=-1: NEXT I: GOSUB 1700 
  277. 3760  GOSUB 2750: GOTO 2820 
  278. 3770  RESTORE 3790: FOR I=1 TO 8: READ SM(I): IF I<7 THEN CA(I)=CHR$(I+64) 
  279. 3780  CC(I)=CHR$(I): NEXT I: SM(0)=" Constants" 
  280. 3790  DATA Variables,Line Numbers,Integer,Sgle Prec,Dble Prec,"Hex & Oct" 
  281. 3800  DATA String,Reserved Words 
  282. 3810  RESTORE 3820: FOR I=1 TO 127: READ CX(I): NEXT I 
  283. 3820  DATA END,FOR,NEXT,DATA,INPUT,DIM,READ,LET,GOTO,RUN,IF,RESTORE,GOSUB,RETURN 
  284. 3830  DATA REM,STOP,PRINT,CLEAR,LIST,NEW,ON,WAIT,DEF,POKE,CONT,9A,9B,OUT 
  285. 3840  DATA LPRINT,LLIST,9F,WIDTH,ELSE,TRON,TROFF,SWAP,ERASE,EDIT,ERROR,RESUME 
  286. 3850  DATA DELETE,AUTO,RENUM,DEFSTR,DEFINT,DEFSNG,DEFDBL,LINE,WHILE,WEND,CALL 
  287. 3860  DATA B4,B5,B6,WRITE,OPTION,RANDOMIZE,OPEN,CLOSE,LOAD,MERGE,SAVE,COLOR 
  288. 3870  DATA CLS,MOTOR,BSAVE,BLOAD,SOUND,BEEP,PSET,PRESET,SCREEN,KEY,LOCATE,CB 
  289. 3880  DATA TO,THEN,TAB(,STEP,USR,FN,SPC(,NOT,ERL,ERR,STRING$,USING,INSTR,"'" 
  290. 3890  DATA VARPTR,CSRLIN,POINT,OFF,INKEY$,DF,E0,E1,E2,E3,E4,E5,">","=" 
  291. 3900  DATA "<","+","-","*","/","^",AND,OR,XOR,EQV,IMP,MOD,"\" 
  292. 3910  DATA F5,F6,F7,F8,F9,FA,FB,FC,FD,FE,FF 
  293. 3920  RESTORE 3930: FOR I=1 TO 37: READ CF(I): NEXT I 
  294. 3930  DATA LEFT$,RIGHT$,MID$,SGN,INT,ABS,SQR,RND,SIN,LOG,EXP,COS,TAN,ATN,FRE,INP 
  295. 3940  DATA POS,LEN,STR$,VAL,ASC,CHR$,PEEK,SPACE$,OCT$,HEX$,LPOS,CINT,CSNG,CDBL 
  296. 3950  DATA FIX,PEN,STICK,STRIG,EOF,LOC,LOF 
  297. 3960  RESTORE 3970: FOR I=1 TO 36: READ CE(I): NEXT I 
  298. 3970  DATA FILES,FIELD,SYSTEM,NAME,LSET,RSET,KILL,PUT,GET,RESET,COMMON,CHAIN 
  299. 3980  DATA DATE$,TIME$,PAINT,COM,CIRCLE,DRAW,PLAY,TIMER,IOCTL,MKDIR,SHELL,VIEW 
  300. 3990  DATA PMAP,ERDEV,CHDIR,RMDIR,ENVIRON,WINDOW,9F,A0,A1,A2,A3,NOISE 
  301. 4000  RESTORE 4010: FOR I=1 TO 6: READ CD(I): NEXT I
  302. 4010  DATA CVI,CVS,CVD,MKI$,MKS$,MKD$
  303. 4020  RETURN
  304. 4030  ' last line PC-XREF3
  305.