home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol023 / disasmb.bas < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  12.8 KB  |  434 lines
  1. 10 ' DISASMB
  2. 20 '
  3. 30 PRINT
  4. 40 PRINT "Disassembler program written in Microsoft Basic-80, ver 5.1"
  5. 50 '
  6. 60 DEFINT A-G
  7. 70 DEFSTR N-Z
  8. 80 DIM A(30)
  9. 90 '
  10. 100 ' If this program is to be compiled with BASCOM the following arrays
  11. 110 ' have to be dimensioned to maximum possible values and the ERASE
  12. 120 ' commands in LOAD TABLES have to be remove
  13. 130 '
  14. 140 DIM E(2,255):' opcodes table
  15. 150 DIM S(30):' opcodes list
  16. 160 DIM T(25):' operands list
  17. 170 '
  18. 180 DEF FNZHEX2(I)=RIGHT$("00"+HEX$(I),2)
  19. 190 DEF FNZHEX4(I)=RIGHT$("0000"+HEX$(I),4)
  20. 200 DEF FNZNO(I)=RIGHT$(STR$(I),LEN(STR$(I))-1)
  21. 210 '
  22. 220 X=STRING$(15," ")
  23. 230 W=STRING$(128,0)
  24. 240 ZT=CHR$(9)
  25. 250 STOG(0)="DISABLED"
  26. 260 STOG(1)="ENABLED"
  27. 270 Q(1)="IX"
  28. 280 Q(2)="IY"
  29. 290 '
  30. 300 ZEND1=STRING$(2,&HFF)+STRING$(2,&H1A)
  31. 310 ZEND2=STRING$(4,&H1A)
  32. 320 '
  33. 330 DIM R(127)
  34. 340 FOR A=0 TO 31
  35. 350 R(A)="CTL-"+CHR$(64+A)
  36. 360 NEXT A
  37. 370 R(32)="SP"
  38. 380 R(127)="DEL"
  39. 390 FOR A=33 TO 126
  40. 400 R(A)=CHR$(A)
  41. 410 NEXT A
  42. 420 ' FOR A=97 TO 122:R(A)="LC "+R(A):NEXT A
  43. 430 R(8)="BS"
  44. 440 R(9)="HT"
  45. 450 R(10)="LF"
  46. 460 R(11)="VT"
  47. 470 R(12)="FF"
  48. 480 R(13)="CR"
  49. 490 '
  50. 500 FC=1:' console enable toggle
  51. 510 FH=0:' hex string conversion error flag
  52. 520 FP=0:' printer enable toggle
  53. 530 FT=0:' tables loaded flag
  54. 540 FZ=0:' Zilog-opcode table flag
  55. 550 '
  56. 560 FI=1:' initial tables load flag
  57. 570 GOTO 1140
  58. 580 '
  59. 590 ' MENU
  60. 600 '
  61. 610 FW=0:' write file enable flag
  62. 620 FX=0:' x-ref file enabled flag
  63. 630 FR=0:' memory read return flag
  64. 640 CLOSE
  65. 650 FI=0
  66. 660 PRINT
  67. 670 PRINT "Enter:"
  68. 680 PRINT " C - Console listing toggle";TAB(35);STOG(FC)
  69. 690 PRINT " D - Disk file disassemble"
  70. 700 PRINT " E - End"
  71. 710 PRINT " L - List opcodes"
  72. 720 PRINT " M - Memory disassemble"
  73. 730 PRINT " P - Print listing toggle";TAB(35);STOG(FP)
  74. 740 PRINT " T - Tables load";:IF FT=0 THEN PRINT TAB(35);"none loaded" 
  75.     ELSE PRINT TAB(35);ZTAB;" loaded"
  76. 750 PRINT " X - X-ref file";:IF FX=1 THEN PRINT TAB(35);SXREF;" enabled" 
  77.     ELSE PRINT
  78. 760 PRINT " W - Write listing to disk";:
  79.     IF FW=1 THEN PRINT TAB(35);SWRITE;" enabled" ELSE PRINT
  80. 770 '
  81. 780 S=INPUT$(1)
  82. 790 IF S="c" OR S="C" THEN IF FC=0 THEN FC=1 ELSE FC=0
  83. 800 IF S="d" OR S="D" THEN GOTO 1970
  84. 810 IF S="e" OR S="E" THEN CLOSE:END
  85. 820 IF S="l" OR S="L" THEN GOTO 1530
  86. 830 IF S="m" OR S="M" THEN GOTO 3610
  87. 840 IF S="p" OR S="P" THEN IF FP=0 THEN FP=1 ELSE FP=0
  88. 850 IF S="t" OR S="T" THEN GOTO 1140
  89. 860 IF S="x" OR S="X" THEN GOTO 4040
  90. 870 IF S="w" OR S="W" THEN GOTO 960
  91. 880 GOTO 640
  92. 890 '
  93. 900 ' NAME OUTPUT FILE
  94. 910 ' Enables write to source code file on disk.
  95. 920 ' If an XREF file has been specified, defaults to <fname>.zext.
  96. 930 ' Is disabled on return from disassembly routines.
  97. 940 ' Note: error is correct condition.
  98. 950 '
  99. 960 PRINT
  100. 970 IF FT=0 THEN GOTO 1880
  101. 980 FW=1
  102. 990 IF FX=1 THEN SWRITE=LEFT$(SXREF,INSTR(SXREF,".")-1)+ZEXT
  103.     ELSE SWRITE=ZEXT
  104. 1000 PRINT "Output file name (";SWRITE;" assumed) :  ";
  105. 1010 INPUT "",S
  106. 1020 IF LEN(S)=0 THEN IF FX=1 THEN GOTO 640 ELSE GOTO 1000
  107. 1030 GOSUB 3470
  108. 1040 SWRITE=S
  109. 1050 IF INSTR(SWRITE,".")=0 THEN SWRITE=SWRITE+ZEXT
  110. 1060 ON ERROR GOTO 640
  111. 1070 OPEN "I",1,SWRITE
  112. 1080 PRINT " *** FILE ALREADY EXISTS *** "
  113. 1090 GOTO 610
  114. 1100 '
  115. 1110 ' LOAD TABLES
  116. 1120 ' they must exist, with proper extensions
  117. 1130 '
  118. 1140 PRINT
  119. 1150 ZBAK=ZTAB
  120. 1160 INPUT "Tables name :  ",S
  121. 1170 GOSUB 3470
  122. 1180 ZTAB=S
  123. 1190 ON ERROR GOTO 1880
  124. 1200 OPEN "I",1,ZTAB+".LST"
  125. 1210 ERASE E,S,T
  126. 1220 INPUT #1,ALEN:' number of opcode columns
  127. 1230 INPUT #1,ZCOM:' comment character
  128. 1240 INPUT #1,ZLAB:' label character
  129. 1250 INPUT #1,ZBYTE:' define byte
  130. 1260 INPUT #1,ZEXT:' source code extension
  131. 1270 INPUT #1,AZIL:' Zilog table definition
  132. 1280 INPUT #1,A
  133. 1290 DIM S(A)
  134. 1300 FOR B=0 TO A
  135. 1310 INPUT #1,S(B)
  136. 1320 NEXT B
  137. 1330 INPUT #1,A
  138. 1340 DIM T(A)
  139. 1350 FOR B=0 TO A
  140. 1360 INPUT #1,T(B)
  141. 1370 NEXT B
  142. 1380 CLOSE
  143. 1390 OPEN "R",1,ZTAB+".TAB",ALEN
  144. 1400 FIELD #1,ALEN AS S
  145. 1410 DIM E(ALEN-1,255)
  146. 1420 FOR A=0 TO 255
  147. 1430 GET 1
  148. 1440 FOR B=1 TO ALEN
  149. 1450 E(B-1,A)=ASC(MID$(S,B,1))
  150. 1460 NEXT B
  151. 1470 NEXT A
  152. 1480 FT=1
  153. 1490 GOTO 640
  154. 1500 '
  155. 1510 ' LIST OPCODES
  156. 1520 '
  157. 1530 PRINT
  158. 1540 IF FC+FP=0 THEN GOTO 3960
  159. 1550 IF FT=0 THEN GOTO 1880
  160. 1560 AL=0
  161. 1570 FOR A=0 TO 255
  162. 1580 IF FC=1 THEN PRINT FNZNO(A);TAB(7);FNZHEX2(A);TAB(14);
  163. 1590 IF FP=1 THEN LPRINT FNZNO(A);TAB(7);FNZHEX2(A);TAB(14);
  164. 1600 FOR B=0 TO (ALEN/3)-1
  165. 1610 Z=LEFT$(S(E(3*B,A))+X,6)
  166. 1620 IF FC=1 THEN PRINT Z;
  167. 1630 IF FP=1 THEN LPRINT Z;
  168. 1640 FOR C=0 TO 1
  169. 1650 C(C)=E((3*B)+C+1,A)
  170. 1660 Z(C)=T(C(C))
  171. 1670 NEXT C
  172. 1680 Z=X
  173. 1690 IF C(0)>0 AND C(1)>0 THEN Z=Z(0)+","+Z(1)+X ELSE IF C(0)>0 THEN Z=Z(0)+X
  174. 1700 Z=LEFT$(Z,13)
  175. 1710 IF FC=1 THEN PRINT Z;
  176. 1720 IF FP=1 THEN LPRINT Z;
  177. 1730 NEXT B
  178. 1740 IF A>127 THEN R=". "+R(A-128) ELSE R="   "+R(A)
  179. 1750 IF FC=1 THEN PRINT R
  180. 1760 IF FP=1 THEN LPRINT R
  181. 1770 IF AL=15 AND FC=1 THEN PRINT:AL=-1
  182. 1780 IF AL=15 AND FP=1 THEN LPRINT:AL=-1
  183. 1790 AL=AL+1
  184. 1800 NEXT A
  185. 1810 GOTO 640
  186. 1820 '
  187. 1830 ' ERRORS
  188. 1840 '
  189. 1850 PRINT " *** FILE NOT FOUND ***"
  190. 1860 GOTO 640
  191. 1870 '
  192. 1880 PRINT " *** NO OPCODE TABLE FOUND/LOADED ***"
  193. 1890 CLOSE
  194. 1900 ZTAB=ZBAK
  195. 1910 IF FI=1 THEN GOTO 1140 ELSE GOTO 640
  196. 1920 '
  197. 1930 ' DISK FILE DISASSEMBLY
  198. 1940 ' If either an xref or write file has been specified, defaults
  199. 1950 ' to <fname>.COM
  200. 1960 '
  201. 1970 PRINT
  202. 1980 IF FC+FP+FX+FW=0 THEN GOTO 3960
  203. 1990 IF FX=1 THEN SNAME=LEFT$(SXREF,INSTR(SXREF,".")-1)
  204.     ELSE IF FW=1 THEN SNAME=LEFT$(SWRITE,INSTR(SWRITE,".")-1)
  205.     ELSE SNAME=""
  206. 2000 SNAME=SNAME+".COM"
  207. 2010 PRINT "File name (";SNAME;" assumed) :  ";
  208. 2020 INPUT "",S
  209. 2030 IF LEN(S)>0 THEN SNAME=S:GOSUB 3470
  210. 2040 IF INSTR(SNAME,".")=0 THEN SNAME=SNAME+".COM"
  211. 2050 ON ERROR GOTO 1850
  212. 2060 OPEN "I",1,SNAME
  213. 2070 CLOSE
  214. 2080 PRINT
  215. 2090 INPUT "Starting address (100H assumed) :  ",S
  216. 2100 PRINT
  217. 2110 IF LEN(S)=0 THEN S="100"
  218. 2120 GOSUB 3230
  219. 2130 IF FH=1 THEN GOTO 2080
  220. 2140 I=J
  221. 2150 IF FW=1 THEN OPEN "O",2,SWRITE
  222. 2160 IF FX=1 THEN OPEN "R",3,SXREF,8:FIELD #3,4 AS X1,4 AS X2
  223. 2170 AI=0:AJ=0
  224. 2180 IF FC=1 THEN PRINT TAB(10);ZCOM;"  source file name :";TAB(40);SNAME
  225. 2190 IF FP=1 THEN LPRINT TAB(10);ZCOM;"  source file name :";TAB(40);SNAME
  226. 2200 IF FW=1 THEN PRINT #2,ZT;ZCOM;"  source file name :";ZT;SNAME
  227. 2210 IF FC=1 THEN PRINT TAB(10);ZCOM;:
  228.     IF FW=1 THEN PRINT "  output file name :";TAB(40);SWRITE ELSE PRINT
  229. 2220 IF FP=1 THEN LPRINT TAB(10);ZCOM;:
  230.     IF FW=1 THEN LPRINT "  output file name : ";TAB(40);SWRITE ELSE LPRINT
  231. 2230 IF FC=1 THEN PRINT TAB(10);ZCOM
  232. 2240 IF FP=1 THEN LPRINT TAB(10);ZCOM
  233. 2250 IF FW=1 THEN PRINT#2,ZT;ZCOM
  234. 2260 SI=FNZHEX4(I)+"H"
  235. 2270 IF I>40959! THEN SI="0"+SI
  236. 2280 IF FC=1 THEN PRINT TAB(10);"ORG   ";SI
  237. 2290 IF FP=1 THEN LPRINT TAB(10);"ORG   ";SI
  238. 2300 IF FW=1 THEN PRINT#2,ZT;"ORG";ZT;SI
  239. 2310 IF FC=1 THEN PRINT TAB(10);ZCOM
  240. 2320 IF FP=1 THEN LPRINT TAB(10);ZCOM
  241. 2330 IF FW=1 THEN PRINT#2,ZT;ZCOM
  242. 2340 IF FC=1 THEN FOR A=0 TO 11:PRINT:NEXT A
  243. 2350 IF FP=1 THEN FOR A=0 TO 11:LPRINT:NEXT A
  244. 2360 IF FR=1 THEN RETURN
  245. 2370 OPEN "R",1,SNAME
  246. 2380 FIELD #1,128 AS V
  247. 2390 GET 1
  248. 2400 R=V
  249. 2410 GET 1
  250. 2420 IF LEFT$(V,1)=CHR$(&H1A) THEN GOTO 2440
  251. 2430 IF EOF(1) THEN CLOSE 1:V=W:FE=1
  252. 2440 R=R+LEFT$(V,4)
  253. 2450 FOR A=1 TO 128
  254. 2460 FOR B=0 TO 3
  255. 2470 B(B)=ASC(MID$(R,A+B,1))
  256. 2480 NEXT B
  257. 2490 N="x"+FNZHEX4(I)+ZLAB
  258. 2500 O=FNZHEX2(B(0))+"H"
  259. 2510 IF B(0)>&H9F THEN O="0"+O ELSE O=" "+O
  260. 2520 IF B(0)>127 THEN P=ZCOM+" . "+R(B(0)-128) ELSE P=ZCOM+"   "+R(B(0))
  261. 2530 BA=0
  262. 2540 AX=0
  263. 2550 BB=0
  264. 2560 AJ=0
  265. 2570 IF AZIL=0 THEN GOTO 2630
  266. 2580 IF B(0)=203 THEN BA=3:B(0)=B(1):AJ=1
  267. 2590 IF B(0)=237 THEN BA=6:B(0)=B(1):B(1)=B(2):B(2)=B(3):AJ=1
  268. 2600 IF B(0)=221 THEN BB=1
  269. 2610 IF B(0)=253 THEN BB=2
  270. 2620 IF BB>0 THEN B(0)=B(1):B(1)=B(2):IF B(0)=203 THEN BA=3:AJ=2:B(0)=B(3) 
  271.     ELSE B(2)=B(3):AJ=1
  272. 2630 FOR C=0 TO 2
  273. 2640 C(C)=E(BA+C,B(0))
  274. 2650 NEXT C
  275. 2660 Y(0)=S(C(0))
  276. 2670 FOR C=1 TO 2
  277. 2680 IF C(C)>4 OR C(C)=0 THEN Y(C)=T(C(C)):GOTO 2760
  278. 2690 Y(C)=FNZHEX2(B(1))
  279. 2700 IF C(C)=1 THEN Y(C)=Y(C)+"H":AJ=AJ+1:IF B(1)>&H9F 
  280.     THEN Y(C)="0"+Y(C):GOTO 2760 ELSE GOTO 2760
  281. 2710 IF C(C)<4 THEN IY(C)=(256*B(2))+B(1):Y(C)="x"+FNZHEX2(B(2))+Y(C):
  282.     AJ=AJ+2:AX=C:IF C(C)=3 THEN Y(C)="("+Y(C)+")":GOTO 2760 ELSE GOTO 2760
  283. 2720 IF B(1)>&H7F THEN B(1)=B(1)-256
  284. 2730 J=I+B(1)+2
  285. 2740 IY(C)=J
  286. 2750 Y(C)="x"+FNZHEX4(J):AJ=1:AX=C
  287. 2760 IF BB=0 THEN GOTO 2940
  288. 2770 D(C)=0
  289. 2780 IF AZIL<>1 THEN GOTO 2830
  290. 2790 IF C(C)=15 THEN Y(C)=Q(BB):D(C)=1
  291. 2800 IF C(C)=11 THEN AJ=AJ+1:D(C)=1:
  292.     IF B(1)>&H7F THEN B(1)=B(1)-256:Y(C)="("+Q(BB)+STR$(B(1))+")" 
  293.     ELSE Y(C)="("+Q(BB)+"+"+FNZNO(B(1))+")"
  294. 2810 IF C(C)=11 AND C(0)=28 THEN Y(C)="("+Q(BB)+")":AJ=AJ-1
  295. 2820 IF C(2)=1 THEN B(1)=B(2)
  296. 2830 IF AZIL<>2 THEN GOTO 2920
  297. 2840 IF C(C)=11 THEN AJ=AJ+1:D(C)=1 :IF B(1)>&H7F 
  298.     THEN B(1)=B(1)-256:Y(C)=STR$(B(1))+"("+Q(BB)+")":
  299.     ELSE Y(C)=FNZNO(B(1))+"("+Q(BB)+")"
  300. 2850 IF C(0)=21 THEN Y(0)="DAD"+RIGHT$(Q(BB),1):D(C)=1
  301. 2860 IF (C(0)=42 OR C(0)=29 OR C(0)=23 OR C(0)=50 OR C(0)=51) AND C(1)=9 
  302.     THEN Y(1)=Q(BB):D(C)=1
  303. 2870 IF C(0)=69 THEN Y(0)="S"+Q(BB)+"D":D(C)=1
  304. 2880 IF C(0)=41 THEN Y(0)="L"+Q(BB)+"D":D(C)=1
  305. 2890 IF C(0)=80 THEN Y(0)="XT"+Q(BB):D(C)=1
  306. 2900 IF C(0)=71 THEN Y(0)="SP"+Q(BB):D(C)=1
  307. 2910 IF C(0)=49 THEN Y(0)="PC"+Q(BB):D(C)=1
  308. 2920 ' position for additional Zilog routines
  309. 2930 IF C=2 AND ((D(1)=0 AND D(2)=0) OR (BA=0 AND B(0)=235)) 
  310.     THEN AJ=0:C(0)=0:Y(0)=S(0):C(1)=0
  311. 2940 NEXT C
  312. 2950 IF AI>0 THEN D=20 ELSE D=0
  313. 2960 IF FC=1 THEN PRINT N;:IF AI>0 THEN PRINT TAB(10);ZCOM;
  314. 2970 IF FP=1 THEN LPRINT N;:IF AI>0 THEN LPRINT TAB(10);ZCOM;
  315. 2980 IF FW=1 THEN PRINT #2,N;ZT;:IF AI>0 THEN PRINT#2,ZCOM;ZT;ZT;ZT;
  316. 2990 IF C(1)>0 AND C(2)>0 THEN Y0=Y(1)+","+Y(2) ELSE Y0=Y(1)
  317. 3000 IF FC=1 THEN PRINT TAB(10+D);Y(0);:IF C(1)>0 THEN PRINT TAB(16+D);Y0;
  318. 3010 IF FP=1 THEN LPRINT TAB(10+D);Y(0);:IF C(1)>0 THEN LPRINT TAB(16+D);Y0;
  319. 3020 IF FW=1 THEN PRINT #2,Y(0);ZT;:IF C(1)=0 THEN PRINT #2,ZT;ZT; 
  320.     ELSE PRINT #2,Y0;ZT;:IF LEN(Y0)<8 THEN PRINT #2,ZT;
  321. 3030 IF FW=1 AND AI=0 THEN PRINT #2,ZT;ZT;ZT;
  322. 3040 IF FC=1 THEN PRINT TAB(50);ZCOM;ZBYTE;"   ";O;"   ";P
  323. 3050 IF FP=1 THEN LPRINT TAB(50);ZCOM;ZBYTE;"   ";O;"   "P
  324. 3060 IF FW=1 THEN PRINT #2,ZCOM;ZBYTE;ZT;O;ZT;P
  325. 3070 IF FC=1 AND MID$(N,5,1)="F" THEN PRINT
  326. 3080 IF FP=1 AND MID$(N,5,1)="F" THEN LPRINT
  327. 3090 IF AI>0 THEN AX1=2 ELSE AX1=1
  328. 3100 IF FX=1 AND AX>0 THEN LSET X1=MKS$(IY(AX)):LSET X2=MKS$((4*I)+AX1):PUT 3
  329. 3110 IF AI=0 THEN AI=AJ ELSE AI=AI-1
  330. 3120 AJ=0
  331. 3130 AX=0
  332. 3140 I=I+1
  333. 3150 IF FR=1 THEN RETURN
  334. 3160 NEXT A
  335. 3170 IF FE=0 THEN GOTO 2400
  336. 3180 IF FX=1 THEN LSET X1=ZEND1:LSET X2=ZEND2:PUT 3
  337. 3190 GOTO 610
  338. 3200 '
  339. 3210 ' string to hex conversion routine
  340. 3220 '
  341. 3230 IF RIGHT$(S,1)=" " THEN S=LEFT$(S,LEN(S)-1):GOTO 3230
  342. 3240 IF LEFT$(S,1)=" " THEN S=RIGHT$(S,LEN(S)-1):GOTO 3240
  343. 3250 IF RIGHT$(S,1)="h" OR RIGHT$(S,1)="H" THEN S=LEFT$(S,LEN(S)-1)
  344. 3260 FH=0
  345. 3270 A=LEN(S)
  346. 3280 J=0
  347. 3290 J0=1
  348. 3300 FOR B=0 TO A-1
  349. 3310 C=ASC(MID$(S,A-B,1))
  350. 3320 IF C=ASC(" ") THEN GOTO 3390
  351. 3330 IF C>=ASC("a") AND C<=ASC("z") THEN C=C-32
  352. 3340 C=C-48
  353. 3350 IF C>9 THEN C=C-7
  354. 3360 IF C<0 OR C>15 THEN FH=1:GOTO 3420
  355. 3370 J=J+(C*J0)
  356. 3380 J0=J0*16
  357. 3390 NEXT B
  358. 3400 RETURN
  359. 3410 '
  360. 3420 PRINT" *** BAD HEX STRING ";S;" -- PLEASE REENTER *** ";
  361. 3430 RETURN
  362. 3440 '
  363. 3450 ' convert string to caps, strip blanks
  364. 3460 '
  365. 3470 A=LEN(S)
  366. 3480 FOR B=1 TO A
  367. 3490 A(B)=ASC(MID$(S,B,1))
  368. 3500 NEXT B
  369. 3510 S=""
  370. 3520 FOR B=1 TO A
  371. 3530 IF A(B)=ASC(" ") THEN GOTO 3560
  372. 3540 IF A(B)>=ASC("a") AND A(B)<=ASC("z") THEN A(B)=A(B)-32
  373. 3550 S=S+CHR$(A(B))
  374. 3560 NEXT B
  375. 3570 RETURN
  376. 3580 '
  377. 3590 ' MEMORY DISASSEMBLY
  378. 3600 '
  379. 3610 PRINT
  380. 3620 IF FC+FP+FX+FW=0 THEN GOTO 3960
  381. 3630 FR=1
  382. 3640 PRINT "memory start";TAB(30);":   ";
  383. 3650 INPUT "",S
  384. 3660 GOSUB 3230
  385. 3670 IF LEN(S)=0 THEN GOTO 3640
  386. 3680 L=J
  387. 3690 S1=S
  388. 3700 PRINT "program start (";S;" assumed:";TAB(30);":   ";
  389. 3710 INPUT "",S
  390. 3720 IF LEN(S)>0 THEN GOSUB 3230 ELSE I=L:GOTO 3760
  391. 3730 IF LEN(S)=0 THEN GOTO 3760
  392. 3740 I=J
  393. 3750 S1=S
  394. 3760 PRINT "program end";TAB(30);":   ";
  395. 3770 INPUT "",S
  396. 3780 GOSUB 3230
  397. 3790 IE=J
  398. 3800 IF LEN(S)=0 THEN GOTO 3760
  399. 3810 SNAME="mem >  "+S1+"-"+S
  400. 3820 GOSUB 2150
  401. 3830 FOR A=0 TO 3
  402. 3840 L(A)=L+A
  403. 3850 IF L(A)>2^15 THEN L(A)=L(A)-2^16
  404. 3860 B(A)=PEEK(L(A))
  405. 3870 NEXT A
  406. 3880 GOSUB 2490
  407. 3890 L=L+1
  408. 3900 IF I<=IE THEN GOTO 3830
  409. 3910 GOTO 610
  410. 3920 '
  411. 3930 ' if no output is specified before disassembly, it will terminate
  412. 3940 ' and return to menu
  413. 3950 '
  414. 3960 PRINT "*** NO OUTPUT SPECIFIED ***"
  415. 3970 GOTO 640
  416. 3980 '
  417. 3990 ' NAME X-REF FILE
  418. 4000 ' This does not check for existing file, so will allow a write-over to
  419. 4010 ' occur. If a write file has been specified, defaults to <fname>.XRF.
  420. 4020 ' An extension .XRF is normally provided.
  421. 4030 '
  422. 4040 PRINT
  423. 4050 IF FT=0 THEN GOTO 1880
  424. 4060 FX=1
  425. 4070 IF FW=1 THEN SXREF=LEFT$(SWRITE,INSTR(SWRITE,"."))+"XRF" ELSE SXREF=".XRF"
  426. 4080 PRINT "X-ref file name (";SXREF;" assumed) :  ";
  427. 4090 INPUT "",S
  428. 4100 IF LEN(S)=0 THEN IF FW=1 THEN GOTO 640 ELSE GOTO 4080
  429. 4110 GOSUB 3470
  430. 4120 SXREF=S
  431. 4130 IF INSTR(SXREF,".")=0 THEN SXREF=SXREF+".XRF"
  432. 4140 GOTO 640
  433. 4150 '
  434.