home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / BASIC / ADVBS341.ZIP / XREF.BAS < prev   
Encoding:
BASIC Source File  |  1987-05-21  |  8.1 KB  |  296 lines
  1.      DEFINT A-Z
  2.      OPTION BASE 1
  3.      DIM LN!(500),LN$(500),VBL$(500)
  4.  
  5. 70   CLS
  6.      PRINT TAB(12);"XREF 1.2  --  BASIC Programmer's Cross-reference Utility"
  7.      PRINT TAB(22);"Copyright Thomas Hanlin III, 1985-1987"
  8.      PRINT
  9.      PRINT
  10.      PRINT"Enter <V> to xref variables, <L> for line numbers, <X> to exit: ";
  11.      GOOD$="VLX"
  12.      GOSUB 1060
  13.      PRINT A$
  14.      IF A$="V" THEN 2000
  15.      IF A$="X" THEN PRINT: PRINT: END
  16.  
  17.      CLEAR
  18. 1010 INPUT"File to xref";FIL$
  19.      IF FIL$="" THEN 70
  20.      IF FIL$="?" THEN FILES"*.BAS": GOTO 1010
  21.      T=INSTR(FIL$,".")
  22.      IF T THEN FIL$=LEFT$(FIL$,T) ELSE FIL$=FIL$+"."
  23.      CALL EXIST(FIL$+"BAS"+CHR$(0),FILEXISTS)
  24.      IF FILEXISTS=0 THEN PRINT"Missing file ";FIL$;"BAS": GOTO 1010
  25.      OPEN"I",1,FIL$+"BAS"
  26.      A$=INPUT$(1,1)
  27.      CLOSE
  28.      IF A$<>CHR$(255) THEN PRINT"Not a tokenized BASIC file.": GOTO 1010
  29.      CALL UPCASE(FIL$)
  30.      PRINT
  31.      PRINT"Send results to <S>creen or <F>ile? ";
  32.      GOOD$="SF"
  33.      GOSUB 1060
  34.      PRT=(A$="F")
  35.      IF PRT THEN OPEN"O",2,FIL$+"LIN" ELSE OPEN"O",2,"SCRN:"
  36.      GOTO 1100
  37.  
  38. 1060 LOCATE ,,1
  39.      A$=" "
  40.      CALL GETKEY(GOOD$,A$)
  41.      LOCATE ,,0
  42.      RETURN
  43.  
  44. 1100 OPEN"R",1,FIL$+"BAS"
  45.      FIELD 1,128 AS REC$
  46.      GET#1,1
  47.      A$=REC$
  48.      CLS
  49.      PRINT"Line # cross-reference listing for ";FIL$;"BAS"
  50.      PRINT: PRINT
  51.      PRINT"Examining line";
  52.      IF PRT THEN PRINT#2,"Line # cross-reference listing for ";FIL$;"BAS"
  53. 1110 IF MID$(A$,2,2)=STRING$(2,0) THEN 1340
  54.      LN$=MID$(A$,4,2)
  55.      LN!=CVI(LN$)
  56.      A$=MID$(A$,6)
  57.      IF LN!<0 THEN LN!=LN!+65536!
  58.      LOCATE 4,15
  59.      PRINT LN!;
  60. 1130 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  61.      C=ASC(A$)
  62.      IF C=0 THEN 1110
  63.      IF C=14 THEN 1240
  64.      IF C=34 THEN A$=MID$(A$,2): GOTO 1180
  65.      IF C=132 OR C=143 THEN A$=MID$(A$,2): GOTO 1200
  66.      L=2
  67.      IF C=15 OR C>249 THEN L=3 _
  68.      ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _
  69.      ELSE IF C=29 THEN L=6 _
  70.      ELSE IF C=31 THEN L=10
  71.      A$=MID$(A$,L)
  72.      GOTO 1130
  73. 1180 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  74.      C=ASC(A$)
  75.      IF C=0 THEN 1110
  76.      A$=MID$(A$,2)
  77.      IF C=34 THEN 1130
  78.      GOTO 1180
  79. 1200 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  80.      C=ASC(A$)
  81.      IF C=0 THEN QUOT=0: GOTO 1110
  82.      L=2
  83.      IF C=34 THEN QUOT=NOT QUOT
  84.      IF QUOT THEN A$=MID$(A$,2): GOTO 1200
  85.      IF C=15 OR C>249 THEN L=3 _
  86.      ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _
  87.      ELSE IF C=29 THEN L=6 _
  88.      ELSE IF C=31 THEN L=10
  89.      A$=MID$(A$,L)
  90.      GOTO 1200
  91. 1240 LNR!=CVI(MID$(A$,2,2))
  92.      A$=MID$(A$,4)
  93.      IF LNR!<0 THEN LNR!=LNR!+65536!
  94.      GOSUB 1260
  95.      GOTO 1130
  96. 1260 IF LINS=0 THEN LINS=1: LN!(1)=LNR!: LN$(1)=LN$: RETURN
  97.      GOSUB 1290
  98.      IF FOUND THEN GOSUB 1320: _
  99.         IF FOUND THEN RETURN ELSE LN$(WH1)=LN$(WH1)+LN$: RETURN _
  100.      ELSE IF LINS>499 THEN _
  101.         PRINT: PRINT"Too many lines referenced to handle": END
  102.      FOR X=LINS TO WH1 STEP -1
  103.         SWAP LN!(X),LN!(X+1)
  104.         SWAP LN$(X),LN$(X+1)
  105.      NEXT
  106.      LN!(WH1)=LNR!
  107.      LN$(WH1)=LN$
  108.      LINS=LINS+1
  109. 1290 FOUND=0
  110.      TOP=LINS+1
  111.      BOT=1
  112.      OLD=-1
  113.      WH1=LINS\2+1
  114.      LNF!=LN!(WH1)
  115.      WHILE OLD<>WH1 AND LNR!<>LNF!
  116.         IF LNR!<LNF! THEN TOP=WH1 ELSE BOT=WH1
  117.         OLD=WH1
  118.         WH1=(TOP+BOT)\2
  119.         LNF!=LN!(WH1)
  120.      WEND
  121.      IF LNR!=LNF! THEN FOUND=-1 ELSE IF LNR!>LNF! THEN WH1=WH1+1
  122.      RETURN
  123. 1320 LNF!=CVI(RIGHT$(LN$(WH1),2))
  124.      IF LNF!<0 THEN LNF!=65536!+LNF!
  125.      FOUND=(LNF!=LN!)
  126.      RETURN
  127. 1340 GOSUB 1342
  128.      GOTO 1346
  129. 1342 CLOSE 1
  130.      PRINT
  131.      PRINT#2,"": PRINT#2,""
  132.      IF PRT THEN RETURN
  133.      PRINT"Done-- press <SPACE> for results."
  134.      GOOD$=" "
  135.      GOSUB 1060
  136.      CLS
  137.      RETURN
  138. 1346 PRINT#2,"Number of lines: ";LINS
  139.      PRINT#2,"": PRINT#2,""
  140.      FOR X=1 TO LINS
  141.         LN!=LN!(X)
  142.         GOSUB 1380
  143.         PRINT#2," :  ";
  144.         LN!=CVI(LEFT$(LN$(X),2))
  145.         GOSUB 1380
  146.         FOR Y=3 TO LEN(LN$(X)) STEP 2
  147.            PRINT#2,", ";
  148.            LN!=CVI(MID$(LN$(X),Y,2))
  149.            GOSUB 1380
  150.         NEXT
  151.         GOSUB 1360
  152.      NEXT
  153.      CLOSE
  154.      GOTO 1500
  155. 1360 IF PRT THEN PRINT#2,""
  156.      IF NOT PRT THEN _
  157.         IF CSRLIN<20 THEN PRINT#2,"" _
  158.         ELSE LOCATE 25,23: PRINT"Press <SPACE> to continue listing";: _
  159.            GOOD$=" ": GOSUB 1060: CLS
  160.      RETURN
  161. 1380 IF LN!<0 THEN LN!=65536!+LN!
  162.      PRINT#2,MID$(STR$(LN!),2);
  163.      RETURN
  164. 1500 LOCATE 25,27
  165.      PRINT"Press any key to continue";
  166.      I$=INPUT$(1)
  167.      GOTO 70
  168.  
  169. 2000 CLEAR
  170. 2010 INPUT"File to xref";FIL$
  171.      IF FIL$="" THEN 70
  172.      IF FIL$="?" THEN FILES"*.BAS": GOTO 2010
  173.      T=INSTR(FIL$,".")
  174.      IF T THEN FIL$=LEFT$(FIL$,T) ELSE FIL$=FIL$+"."
  175.      CALL EXIST(FIL$+"BAS"+CHR$(0),FILEXISTS)
  176.      IF FILEXISTS=0 THEN PRINT"Missing file ";FIL$;"BAS": GOTO 2010
  177.      OPEN"I",1,FIL$+"BAS"
  178.      A$=INPUT$(1,1)
  179.      CLOSE
  180.      IF A$<>CHR$(255) THEN PRINT"Not a tokenized BASIC file.": GOTO 2010
  181.      CALL UPCASE(FIL$)
  182.      PRINT
  183.      PRINT"Send results to <S>creen or <F>ile? ";
  184.      GOOD$="SF"
  185.      GOSUB 1060
  186.      PRT=(A$="F")
  187.      IF PRT THEN OPEN"O",2,FIL$+"VBL" ELSE OPEN"O",2,"SCRN:"
  188.      OPEN"R",1,FIL$+"BAS"
  189.      FIELD 1,128 AS REC$
  190.      GET#1,1
  191.      A$=REC$
  192.      CLS
  193.      PRINT"Variable cross-reference listing for ";FIL$;"BAS"
  194.      PRINT: PRINT
  195.      PRINT"Examining line";
  196.      IF PRT THEN PRINT#2,"Variable cross-reference listing for ";FIL$;"BAS"
  197. 2110 IF MID$(A$,2,2)=STRING$(2,0) THEN 2350
  198.      LN$=MID$(A$,4,2)
  199.      LN!=CVI(LN$)
  200.      A$=MID$(A$,6)
  201.      IF LN!<0 THEN LN!=LN!+65536!
  202.      LOCATE 4,15
  203.      PRINT LN!;
  204. 2130 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  205.      C=ASC(A$)
  206. 2150 IF C=0 THEN 2110
  207.      IF C>64 AND C<91 THEN VBL$="": GOTO 2240
  208.      IF C=34 THEN A$=MID$(A$,2): GOTO 2180
  209.      IF C=132 OR C=143 THEN A$=MID$(A$,2): GOTO 2200
  210.      L=2
  211.      IF C=15 OR C>249 THEN L=3 _
  212.      ELSE IF C=11 OR C=12 OR C=14 OR C=28 THEN L=4 _
  213.      ELSE IF C=29 THEN L=6 _
  214.      ELSE IF C=31 THEN L=10
  215. 2170 A$=MID$(A$,L)
  216.      GOTO 2130
  217. 2180 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  218.      C=ASC(A$)
  219.      IF C=0 THEN 2110
  220.      A$=MID$(A$,2)
  221.      IF C=34 THEN 2130 ELSE 2180
  222. 2200 IF LEN(A$)<128 AND NOT EOF(1) THEN GET#1: A$=A$+REC$
  223.      C=ASC(A$)
  224.      IF C=0 THEN 2110
  225.      L=2
  226.      IF C=34 THEN QUOT=NOT QUOT
  227.      IF QUOT THEN A$=MID$(A$,2): GOTO 2200
  228.      IF C=15 OR C>249 THEN L=3 _
  229.      ELSE IF C=11 OR C=12 OR C=28 THEN L=4 _
  230.      ELSE IF C=29 THEN L=6 _
  231.      ELSE IF C=31 THEN L=10
  232. 2230 A$=MID$(A$,L)
  233.      GOTO 2200
  234. 2240 VBL$=VBL$+CHR$(C)
  235.      A$=MID$(A$,2)
  236.      C=ASC(A$)
  237.      IF C>64 AND C<91 OR C>47 AND C<58 OR C=46 THEN 2240
  238.      IF C=33 OR C>34 AND C<38 THEN VBL$=VBL$+CHR$(C): A$=MID$(A$,2): C=ASC(A$)
  239.      IF C=40 THEN VBL$=VBL$+"()": GOSUB 2270: L=2: GOTO 2170
  240.      GOSUB 2270
  241.      GOTO 2150
  242. 2270 IF VBLS=0 THEN VBLS=1: VBL$(1)=VBL$: LN$(1)=LN$: RETURN
  243.      GOSUB 2300
  244.      IF FOUND THEN GOSUB 2330: _
  245.         IF FOUND THEN RETURN _
  246.         ELSE LN$(WH1)=LN$(WH1)+LN$:RETURN _
  247.      ELSE IF VBLS>499 THEN PRINT: PRINT"Too many variables to handle": END
  248.      FOR X=VBLS TO WH1 STEP -1
  249.         SWAP VBL$(X),VBL$(X+1)
  250.         SWAP LN$(X),LN$(X+1)
  251.      NEXT
  252.      VBL$(WH1)=VBL$
  253.      LN$(WH1)=LN$
  254.      VBLS=VBLS+1
  255. 2300 FOUND=0
  256.      TOP=VBLS+1
  257.      BOT=1
  258.      OLD=-1
  259.      WH1=VBLS\2+1
  260.      VBLF$=VBL$(WH1)
  261.      WHILE OLD<>WH1 AND VBL$<>VBLF$
  262.         IF VBL$<VBLF$ THEN TOP=WH1 ELSE BOT=WH1
  263.         OLD=WH1
  264.         WH1=(TOP+BOT)\2
  265.         VBLF$=VBL$(WH1)
  266.      WEND
  267.      IF VBL$=VBLF$ THEN FOUND=-1 ELSE IF VBL$>VBLF$ THEN WH1=WH1+1
  268.      RETURN
  269.  
  270. 2330 FOUND=0
  271.      LNF!=CVI(RIGHT$(LN$(WH1),2))
  272.      IF LNF!<0 THEN LNF!=65536!+LNF!
  273.      FOUND=(LN!=LNF!)
  274.      RETURN
  275.  
  276. 2350 GOSUB 1342
  277.      PRINT#2,"Number of variables: ";VBLS
  278.      PRINT#2,"": PRINT#2,""
  279.      FOR X=1 TO VBLS
  280.         PRINT#2,VBL$(X);" :  ";
  281.         LN!=CVI(LEFT$(LN$(X),2))
  282.         GOSUB 2390
  283.         FOR Y=3 TO LEN(LN$(X)) STEP 2
  284.            PRINT#2,", ";
  285.            LN!=CVI(MID$(LN$(X),Y,2))
  286.            GOSUB 2390
  287.         NEXT
  288.         GOSUB 1360
  289.      NEXT
  290.      CLOSE
  291.      GOTO 1500
  292.  
  293. 2390 IF LN!<0 THEN LN!=65536!+LN!
  294.      PRINT#2,MID$(STR$(LN!),2);
  295.      RETURN
  296.