home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PROGRAMS / UTILS / LASER / LISTINGS.ZIP / LISTINGS.BAS < prev    next >
Encoding:
BASIC Source File  |  1985-02-08  |  11.3 KB  |  292 lines
  1. 100 REM         +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  2. 110 REM         +  ORIGINAL: CREFBAS.BAS          NEW: LISTINGS.BAS           +
  3. 120 REM         +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  4. 121 DEFINT I-J
  5. 122 DIM RW$(159),PT%(25),F$(30)
  6. 123 DIM VNXT%(490),V$(490),FRST%(400),LST%(400),RFL%(2000),NXT%(2000)
  7. 125 I=400
  8. 126 LW=75:PL=58
  9. 127 PRT2$=""
  10. 128 PRT3$=""
  11. 130 CLS
  12. 140 REM *** THIS PROGRAM WILL NOT PRODUCE A CROSS REFERENCE SYMBOL 
  13. 141 REM *** FOR ANY VARIABLE WHICH CONTAINS AN IMBEDDED RESERVED WORD.
  14. 142 REM
  15. 190 'PROGRAM REVISIONS FOR IBM PC:
  16. 192 '7-23-82 CHANGED PRINTER STATEMENTS                          J. E. PERRY
  17. 194 '7-24-82 ADDED TIME AND DATE TO HEADING                             JEP
  18. 196 '9-3-82 ADDED RESERVED WORDS FOR IBM BASIC, CHANGED PAGE LENGTH     JEP
  19. 198 '9-4-82 ADDED PRINTOUT OF FILE CREATION DATE                        JEP
  20. 200 '9-10-82 CORRECTED DISPLAY OF LINE NO.                              JEP
  21. 202 ' 11-9-84 CORRECTED COM VS. COMMON, EXP. PRINT HEADINGS.  PAT FREEMAN
  22. 204 ' 1-24-85 ADJUSTED FOR LASER/LINE PTR, CHANGED PROGRAM LISTINGS     P.F.
  23. 206 '
  24. 220 ON ERROR GOTO 1820
  25. 221 PRINT "THIS PROGRAM WILL LIST PROGRAMS AND/OR PRODUCE CROSS REFERENCES"
  26. 222 PRINT "IF THE SOURCE PROGRAM IS SAVED AS ASCII, AND USES LINE NUMBERS."
  27. 223 PRINT
  28. 224 Z=4
  29. 226 Z1=1
  30. 228 INPUT "ENTER DESTINATION FILENAME FOR LISTINGS OR 'ENTER' FOR LPT1:",F0$
  31. 230 IF LEN(F0$)=0 THEN F0$="LPT1:"
  32. 232 A1$=F0$
  33. 234 GOSUB 37000
  34. 236 F0$=A1$
  35. 238 IF F0$="LPT1:" GOTO 260
  36. 240 ON ERROR GOTO 45100
  37. 242 OPEN "I",9,F0$
  38. 244 CLOSE 9
  39. 246 ON ERROR GOTO 1820
  40. 248 GOTO 45200
  41. 250 ON ERROR GOTO 1820
  42. 252 PRINT
  43. 254 INPUT "ENTER 'Y' TO SET UP FOR LASERJET OR 'ENTER' FOR REGULAR SET UP ",A$
  44. 256 IF LEN(A$)=0 OR A$="N" OR A$="n" THEN Z1=1 ELSE IF A$="Y" OR A$="y" THEN Z1=2 ELSE GOTO 254
  45. 258 IF Z1=2 GOTO 266
  46. 260 PRINT
  47. 262 INPUT "ENTER PAGE OFFSET (0-4) ",Z
  48. 264 IF Z<0 OR Z>4 GOTO 262
  49. 266 OPEN "O",9, F0$
  50. 268 IF Z1=1 GOTO 278 ELSE PRINT #9, CHR$(27)+"E"
  51. 270 PRINT #9, CHR$(27)+"&l0O"+CHR$(27)+"(8U"+CHR$(27)+"(s0p10h12v0s0b3T"
  52. 272 PRINT #9, CHR$(27)+"&l0O"+CHR$(27)+")0U"+CHR$(27)+")s1p14.4v0s1b4T"
  53. 274 PRT2$=CHR$(27)+"&dD"
  54. 276 PRT3$=CHR$(27)+"&d@"
  55. 278 CLOSE 9
  56. 284 IF F0$="LPT1:" THEN Z2=1 ELSE Z2=2
  57. 300 'PRINT:PRINT"CROSSREF":'  -  BASIC-80 VERSION OF 05/19/80"
  58. 301 'PRINT:PRINT"COPYRIGHT (C) 1980 BY ADVANCED INFORMATICS"
  59. 302 PRINT:'PRINT"LISTS ALL PROGRAM LINES AND/OR REFERENCED LINE #'S TO ";F0$
  60. 303 PRINT"------------------------------------------------------------"
  61. 310 ' RESERVED WORDS 
  62. 320 '                
  63. 330 DATA ABS,AND,ASC,AS,ATN,AUTO,BEEP
  64. 340 DATA CALL,CDBL,CHAIN,CHR$,CINT,CIRCLE,CLEAR,CLOSE,CLS,COLOR,COMMON,COM
  65. 350 DATA CONSOLE,CONT,COS,CSNG,CSRLIN,CVD,CVI,CVS,DATA,DATE$
  66. 360 DATA DEFDBL,DEFINT,DEFSNG,DEFSTR,DEFUSR,DEF,DELETE,DIM,DRAW,DSKI$,DSKO$,DSKF
  67. 370 DATA EDIT,ELSE,END,EOF,EQV,ERASE,ERL,ERR,ERROR,EXP,FIELD,FILES,FIX,FOR
  68. 380 DATA FRE,GET,GOSUB,GOTO,HEX$
  69. 390 DATA IF,IMP,INKEY$,INPUT,INP,INSTR,INT,KEY,KILL,LEFT$,LEN,LET,LINE
  70. 400 DATA LIST,LLIST,LOAD,LOCATE,LOC,LOF,LOG,LPOS,LPRINT,LSET
  71. 410 DATA MERGE,MID$,MKD$,MKI$,MKS$,MOD,MOTOR,MOUNT
  72. 420 DATA NAME,NEW,NEXT,NOT,NULL,OCT$,OFF,ON,OPEN,OPTION,OR,OUT
  73. 430 DATA PAINT,PALETTE,PEEK,PEN,POINT,POKE,POS,PRINT,PUT
  74. 440 DATA RANDOMIZE,READ,REM,RENUM,RESET,RESTORE,RESUME,RETURN,RIGHT$,RND,RSET,RUN
  75. 450 DATA SAVE,SCREEN,SEG,SGN,SIN,SOUND,SPACE$,SPC(,SQR,STEP,STOP,STR$,STRIG,STRING$,SWAP,SYSTEM
  76. 460 DATA TAB(,TAN,THEN,TIME$,TO,TROFF,TRON,UNLOAD
  77. 470 DATA USING,USR,VAL,VARPTR,WAIT,WEND,WHILE,WIDTH,WRITE,XOR,"\"
  78. 480 'IBM BASIC EXTENSIONS:
  79. 490 'BEEP,CIRCLE,CLS,COLOR,COM,CSRLIN,DATE$,DRAW
  80. 500 'KEY,LOCATE,MOTOR,OFF,PAINT,PALETTE,PEN,POINT
  81. 510 'SCREEN,SEG,SOUND,STRIG,TIME$
  82. 520 '
  83. 530 'FILL ARRAY WITH RESERVED WORDS
  84. 540 '                
  85. 550 RW=0             
  86. 560 READ RW$         
  87. 570 RW=RW+1:RW$(RW)=RW$:IF RW$="\" THEN 610                    
  88. 580 I=ASC(RW$)-ASC("A"):IF PT%(I)=0 THEN PT%(I)=RW             
  89. 590 GOTO 560         
  90. 600 '                
  91. 610 FOR I=0 TO 25:IF PT%(I)=0 THEN PT%(I)=RW                   
  92. 620 NEXT             
  93. 630 '                
  94. 640 'GET LIST OF FILE NAMES
  95. 650 '                
  96. 660 FX=0             
  97. 670 PRINT "ASCII SAVED PROGRAM #" FX+1 "[.BAS]: ";:LINE INPUT A1$
  98. 680 IF A1$="" THEN IF FX<1 THEN 900 ELSE 740
  99. 690 IF INSTR(A1$,".")=0 THEN A1$=A1$+".BAS"
  100. 700 'NAME A1$ AS A1$
  101. 705 GOSUB 37000
  102. 706 ON ERROR GOTO 45000
  103. 707 OPEN "I",1,A1$
  104. 708 ON ERROR GOTO 1820
  105. 709 CLOSE 1
  106. 710 FX=FX+1:F$(FX)=A1$
  107. 720 IF FX<30 GOTO 670
  108. 730 '                
  109. 740 'PRINT:INPUT"DATE = ";D$
  110. 750 PRINT:INPUT"1) CROSS REFERENCE   2) LIST    3) BOTH ";M
  111. 755 IF M<1 OR M>3 GOTO 750
  112. 760 '                
  113. 770 'PROCESS LIST OF FILE NAMES
  114. 780 '                
  115. 790 FOR F=1 TO FX    
  116. 800   CLOSE:OPEN"I",1,F$(F):OPEN MID$("OA",Z2,1),9,F0$
  117. 810   DEF SEG:FCBADR=VARPTR(#1):DC=256*PEEK(FCBADR+22)+PEEK(FCBADR+21)
  118. 820   MM%=(DC AND &H1E0)/32:DD%=DC AND &H1F:YY%=80+(DC AND &HFE00)/512
  119. 830   DT$=RIGHT$(STR$(MM%),2)+"-"
  120. 840   DT$=DT$+RIGHT$(STR$(DD%),SGN(INT(DD%/10))+1)+"-"+RIGHT$(STR$(YY%),2)
  121. 850   PRG$=SPACE$(Z)+CHR$(Z1+13)+"PROGRAM:"+CHR$(14)+PRT2$+F$(F)+PRT3$+CHR$(20-(Z1-1)*5)+"("+DT$+")"
  122. 852   IF M>1 THEN GOSUB 25000
  123. 853   ON ERROR GOTO 1820
  124. 854   IF M=2 GOTO 880
  125. 855   PRINT
  126. 860   PRINT "BUILDING XREF FOR ";F$(F);" -- ";:RP=CSRLIN:CP=POS(0)
  127. 870   GOSUB 940
  128. 875   ON ERROR GOTO 1820
  129. 880 NEXT             
  130. 890 PRINT #9, CHR$(12)
  131. 895 CLOSE
  132. 898 PRINT
  133. 900 END
  134. 910 '                
  135. 920 'INITIALIZE FOR CROSS REFERENCE
  136. 930 '                
  137. 940 ON ERROR GOTO 1865
  138. 942 LC=0:BC=0:PZ=0:V$="":C$="":VC=91:RC=-1
  139. 950 FOR I=0 TO 91:VNXT%(I)=-1:NEXT
  140. 970 '                
  141. 980 '   INPUT LINE & EXTRACT LINE#
  142. 990 '                
  143. 1000 IF EOF(1)THEN 1530
  144. 1010 LINE INPUT#1,L$
  145. 1020 LG=LEN(L$):BRNCH=0:ER$="":LC=LC+1:BC=BC+LG                 
  146. 1030 LP=INSTR(L$," "):LN=VAL(LEFT$(L$,LP)):LOCATE RP,CP,0:PRINT "LINE:";LN;:LOCATE RP,1,0
  147. 1040 IF LN=0 GOTO 45300 ELSE IF LN>32767 THEN LN=LN-65536!
  148. 1050 '                
  149. 1060 '    PARSE REST OF LINE
  150. 1070 '                
  151. 1080 LP=LP+1:IF LP>LG THEN GOSUB 1340:GOTO 1000                  
  152. 1090 C$=MID$(L$,LP,1) 
  153. 1100 IF C$>="A" AND C$<="Z" THEN 1220 ELSE IF C$>="0" AND C$<="9" THEN 1480
  154. 1110 IF C$=" " THEN GOSUB 1340:GOTO 1080 ELSE IF C$<>", " THEN BRNCH=0
  155. 1120 IF C$=CHR$(34)THEN GOSUB 1340:LP=INSTR(LP+1,L$,C$):IF LP>0 THEN 1080 ELSE 1000
  156. 1130 IF C$="'" THEN GOSUB 1340:GOTO 1000
  157. 1140 IF C$="&" THEN GOSUB 1340:V$=C$:GOTO 1080                   
  158. 1150 IF C$="$" OR C$="!" OR C$="%" OR C$="#" THEN GOSUB 1460:GOTO 1080
  159. 1160 IF C$="("THEN GOSUB 1460
  160. 1170 GOSUB 1340:IF C$<>", " THEN ER$=""
  161. 1180 GOTO 1080         
  162. 1190 '                
  163. 1200 '  TEST FOR COMMAND
  164. 1210 '                
  165. 1220 IF V$>"" THEN 1490 ELSE C=ASC(C$):P=PT%(C-ASC("A")):BRNCH=0
  166. 1230 IF C<ASC(RW$(P))THEN 1490
  167. 1240 IF INSTR(LP,L$,RW$(P))<>LP THEN P=P+1:GOTO 1230             
  168. 1250 GOSUB 1340:RW$=RW$(P)
  169. 1260 IF RW$="DATA" THEN LP=INSTR(LP,L$,":"):IF LP>0 THEN 1080 ELSE 1000
  170. 1270 IF RW$="REM" THEN 1000
  171. 1280 IF RW$="GOTO" OR RW$="GOSUB" OR RW$="THEN" OR RW$="ELSE" OR RW$="RESUME" THEN BRNCH=1                
  172. 1290 IF RW$="ERASE" THEN ER$="(" ELSE ER$=""                    
  173. 1300 LP=LP+LEN(RW$)-1:GOTO 1080
  174. 1310 '                
  175. 1320 '  END VARIABLE  
  176. 1330 '               
  177. 1340 IF V$="" THEN RETURN
  178. 1350 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 1420
  179. 1360 IL=-1:I=C       
  180. 1370 IF V$>V$(I)THEN IL=I:I=VNXT%(I):IF I>0 THEN 1370 ELSE 1390
  181. 1380 IF V$=V$(I)THEN J=LST%(I-91):IF RFL%(J)=LN THEN 1420 ELSE RC=RC+1:NXT%(J)=RC:GOTO 1410              
  182. 1390 VC=VC+1:IF IL>=0 THEN VNXT%(IL)=VC
  183. 1400 V$(VC)=V$:VNXT%(VC)=I:RC=RC+1:FRST%(VC-91)=RC:I=VC        
  184. 1410 RFL%(RC)=LN:NXT%(RC)=-1:LST%(I-91)=RC
  185. 1420 V$="":RETURN    
  186. 1430 '               
  187. 1440 '  EXPAND VARIABLE
  188. 1450 '               
  189. 1460 IF V$<>"" THEN V$=V$+C$
  190. 1470 RETURN          
  191. 1480 IF V$="" AND BRNCH=0 THEN 1080
  192. 1490 V$=V$+C$:GOTO 1080
  193. 1500 '               
  194. 1510 '  LIST VARIABLES
  195. 1520 '               
  196. 1530 IF M=2 THEN RETURN
  197. 1532 LOCATE RP,1:PRINT "PRINTING";
  198. 1540 PZ=0:GOSUB 1740 
  199. 1550 FOR J=0 TO 91:V=J
  200. 1560 V=VNXT%(V):IF V<0 THEN 1680
  201. 1570 IF LZ>PL-4 THEN GOSUB 1740 ELSE SZ=SZ+1:IF SZ=3 THEN GOSUB 1750
  202. 1580 'IF SYMFLG=0 THEN IF LEFT$(V$(V),1)>="A" AND LEFT$(V$(V),1)<="Z" THEN GOSUB 1400:SYMFLG=1           
  203. 1590 RZ=0:I=FRST%(V-91):PRINT #9, SPACE$(Z);V$(V);
  204. 1600 IF RZ=0 THEN PRINT #9, TAB(16+Z);
  205. 1610 LN=RFL%(I):IF LN<0 THEN LN=LN+65536! 
  206. 1620 PRINT #9, USING "    #####";LN,
  207. 1630 RZ=RZ+1         
  208. 1640 IF RZ>5 THEN RZ=0:PRINT #9,SPACE$(2):LZ=LZ+1:IF LZ>PL-4 THEN GOSUB 1740
  209. 1650 I=NXT%(I):IF I>0 THEN 1600
  210. 1660 IF RZ>0 THEN PRINT #9,SPACE$(2):LZ=LZ+1
  211. 1670 GOTO 1560       
  212. 1680 NEXT J          
  213. 1690 '               
  214. 1700 PRINT #9, SPACE$(Z);STRING$(LW,"=")
  215. 1710 PRINT #9, SPACE$(Z);"LINES:"LC"   BYTES:"BC"    SYMBOLS:"VC-91"    REFERENCES:"RC+1
  216. 1720 LZ=LZ+2:RETURN  
  217. 1730 '               
  218. 1740 GOSUB 1870:PRINT #9,SPACE$(Z);"SYMBOL"TAB(20)"REFERENCE LINE":LZ=LZ+1
  219. 1750 PRINT #9, SPACE$(Z);STRING$(LW,"-"):LZ=LZ+1:SZ=0:RETURN
  220. 1760 '               
  221. 1820 IF ERR=53 THEN PRINT:PRINT"FILE ";F$(F);" NOT FOUND":RESUME 880
  222. 1830 IF ERR=24 THEN RESUME '24 IS TIMEOUT
  223. 1840 IF ERR=58 THEN RESUME 710
  224. 1850 PRINT "*** ERROR ***   ERR=";ERR;"  ERL=";ERL
  225. 1860 RESUME 880
  226. 1865 PRINT "*** ERROR ***   ERR=";ERR;"  ERL=";ERL
  227. 1868 RESUME 1869
  228. 1869 IF ERL>780 THEN RETURN 880 ELSE GOTO 895
  229. 1870 PRINT #9, CHR$(12);
  230. 1880 PRINT #9, PRG$;
  231. 1890 PZ=PZ+1:PRINT #9, " ";TIME$;" ";DATE$;" PAGE";PZ:PRINT #9, SPACE$(2)
  232. 1900 LZ=3:RETURN     
  233. 25000 ON ERROR GOTO 45400
  234. 25002 I9=0
  235. 25005 I8=1
  236. 25010 I7=0
  237. 25015 B9=0
  238. 25017 PRINT
  239. 25018 PRINT "GENERATING LISTING OF ";F$(F);" TO ";F0$;" NOW";
  240. 25019 PRINT #9,CHR$(12);
  241. 25020 GOSUB 25150
  242. 25025 IF I9/55=INT(I9/55) AND I9><0 THEN GOSUB 25145
  243. 25030 LINE INPUT #1,P9$
  244. 25035 B9=B9+LEN(P9$)
  245. 25040 I7=I7+1
  246. 25045 LET A1$=LEFT$(P9$,INSTR(P9$," ")-1)
  247. 25047 IF VAL(A1$)=0 GOTO 45300
  248. 25050 LET P9$=STRING$(5-LEN(A1$),32)+P9$
  249. 25055 IF LEN(P9$)>76 GOTO 25070
  250. 25060 PRINT #9,SPACE$(Z)+P9$
  251. 25065 GOTO 25095
  252. 25070 PRINT #9,SPACE$(Z)+LEFT$(P9$,76)
  253. 25075 I9=I9+1
  254. 25080 IF I9/55=INT(I9/55) THEN GOSUB 25145
  255. 25085 LET P9$=SPACE$(6)+RIGHT$(P9$,LEN(P9$)-76)
  256. 25090 GOTO 25055
  257. 25095 I9=I9+1
  258. 25100 IF EOF(1) GOTO 25110
  259. 25105 GOTO 25025
  260. 25110 PRINT #9,SPACE$(5)
  261. 25115 PRINT #9,TAB(10+Z);"NUMBER OF LINES="+STR$(I7)+"  NUMBER OF BYTES="+STR$(B9)
  262. 25125 CLOSE 1
  263. 25130 OPEN "I",1,F$(F)
  264. 25135 RETURN
  265. 25140 '------------------- MAIN PROGRAM BODY ENDS -----------------------------
  266. 25145 PRINT #9,CHR$(12);
  267. 25150 PRINT #9,PRG$;
  268. 25155 PRINT #9," "+DATE$+" "+TIME$+" PAGE:"+STR$(I8)
  269. 25160 PRINT #9,SPACE$(5)
  270. 25165 I8=I8+1
  271. 25170 RETURN
  272. 37000 FOR I0=1 TO LEN(A1$)
  273. 37010   A$=MID$(A1$,I0,1)
  274. 37020   IF ASC(A$)>96 AND ASC(A$)<123 THEN MID$(A1$,I0,1)=CHR$(ASC(A$)-32)
  275. 37030 NEXT I0
  276. 37040 RETURN
  277. 45000 IF ERR=53 THEN RESUME 45010 ELSE GOTO 1820
  278. 45010 ON ERROR GOTO 1820
  279. 45020 PRINT CHR$(7);"FILE NOT FOUND"
  280. 45030 GOTO 670
  281. 45100 IF ERR=53 THEN RESUME 250 ELSE RESUME 45120
  282. 45120 PRINT CHR$(7);"INVALID FILENAME"
  283. 45130 ON ERROR GOTO 1820
  284. 45140 GOTO 228
  285. 45200 PRINT CHR$(7);"FILE ALREADY EXISTS - ENTER 'Y' TO OVERWRITE IT, "
  286. 45210 INPUT "OR ANY OTHER KEY TO RE-ENTER FILENAME ",A$
  287. 45220 IF A$="y" OR A$="Y" GOTO 250 ELSE GOTO 228
  288. 45300 PRINT
  289. 45310 PRINT CHR$(7);F$(F);" NOT SAVED AS ASCII OR NO LINE NUMBERS !";
  290. 45320 RETURN 880
  291. 45400 IF ERR><5 THEN GOTO 1865 ELSE RESUME 45300
  292.