10 ' DISASMB 20 ' 30 PRINT 40 PRINT "Disassembler program written in Microsoft Basic-80, ver 5.1" 50 ' 60 DEFINT A-G 70 DEFSTR N-Z 80 DIM A(30) 90 ' 100 ' If this program is to be compiled with BASCOM the following arrays 110 ' have to be dimensioned to maximum possible values and the ERASE 120 ' commands in LOAD TABLES have to be remove 130 ' 140 DIM E(2,255):' opcodes table 150 DIM S(30):' opcodes list 160 DIM T(25):' operands list 170 ' 180 DEF FNZHEX2(I)=RIGHT$("00"+HEX$(I),2) 190 DEF FNZHEX4(I)=RIGHT$("0000"+HEX$(I),4) 200 DEF FNZNO(I)=RIGHT$(STR$(I),LEN(STR$(I))-1) 210 ' 220 X=STRING$(15," ") 230 W=STRING$(128,0) 240 ZT=CHR$(9) 250 STOG(0)="DISABLED" 260 STOG(1)="ENABLED" 270 Q(1)="IX" 280 Q(2)="IY" 290 ' 300 ZEND1=STRING$(2,&HFF)+STRING$(2,&H1A) 310 ZEND2=STRING$(4,&H1A) 320 ' 330 DIM R(127) 340 FOR A=0 TO 31 350 R(A)="CTL-"+CHR$(64+A) 360 NEXT A 370 R(32)="SP" 380 R(127)="DEL" 390 FOR A=33 TO 126 400 R(A)=CHR$(A) 410 NEXT A 420 ' FOR A=97 TO 122:R(A)="LC "+R(A):NEXT A 430 R(8)="BS" 440 R(9)="HT" 450 R(10)="LF" 460 R(11)="VT" 470 R(12)="FF" 480 R(13)="CR" 490 ' 500 FC=1:' console enable toggle 510 FH=0:' hex string conversion error flag 520 FP=0:' printer enable toggle 530 FT=0:' tables loaded flag 540 FZ=0:' Zilog-opcode table flag 550 ' 560 FI=1:' initial tables load flag 570 GOTO 1140 580 ' 590 ' MENU 600 ' 610 FW=0:' write file enable flag 620 FX=0:' x-ref file enabled flag 630 FR=0:' memory read return flag 640 CLOSE 650 FI=0 660 PRINT 670 PRINT "Enter:" 680 PRINT " C - Console listing toggle";TAB(35);STOG(FC) 690 PRINT " D - Disk file disassemble" 700 PRINT " E - End" 710 PRINT " L - List opcodes" 720 PRINT " M - Memory disassemble" 730 PRINT " P - Print listing toggle";TAB(35);STOG(FP) 740 PRINT " T - Tables load";:IF FT=0 THEN PRINT TAB(35);"none loaded" ELSE PRINT TAB(35);ZTAB;" loaded" 750 PRINT " X - X-ref file";:IF FX=1 THEN PRINT TAB(35);SXREF;" enabled" ELSE PRINT 760 PRINT " W - Write listing to disk";: IF FW=1 THEN PRINT TAB(35);SWRITE;" enabled" ELSE PRINT 770 ' 780 S=INPUT$(1) 790 IF S="c" OR S="C" THEN IF FC=0 THEN FC=1 ELSE FC=0 800 IF S="d" OR S="D" THEN GOTO 1970 810 IF S="e" OR S="E" THEN CLOSE:END 820 IF S="l" OR S="L" THEN GOTO 1530 830 IF S="m" OR S="M" THEN GOTO 3610 840 IF S="p" OR S="P" THEN IF FP=0 THEN FP=1 ELSE FP=0 850 IF S="t" OR S="T" THEN GOTO 1140 860 IF S="x" OR S="X" THEN GOTO 4040 870 IF S="w" OR S="W" THEN GOTO 960 880 GOTO 640 890 ' 900 ' NAME OUTPUT FILE 910 ' Enables write to source code file on disk. 920 ' If an XREF file has been specified, defaults to .zext. 930 ' Is disabled on return from disassembly routines. 940 ' Note: error is correct condition. 950 ' 960 PRINT 970 IF FT=0 THEN GOTO 1880 980 FW=1 990 IF FX=1 THEN SWRITE=LEFT$(SXREF,INSTR(SXREF,".")-1)+ZEXT ELSE SWRITE=ZEXT 1000 PRINT "Output file name (";SWRITE;" assumed) : "; 1010 INPUT "",S 1020 IF LEN(S)=0 THEN IF FX=1 THEN GOTO 640 ELSE GOTO 1000 1030 GOSUB 3470 1040 SWRITE=S 1050 IF INSTR(SWRITE,".")=0 THEN SWRITE=SWRITE+ZEXT 1060 ON ERROR GOTO 640 1070 OPEN "I",1,SWRITE 1080 PRINT " *** FILE ALREADY EXISTS *** " 1090 GOTO 610 1100 ' 1110 ' LOAD TABLES 1120 ' they must exist, with proper extensions 1130 ' 1140 PRINT 1150 ZBAK=ZTAB 1160 INPUT "Tables name : ",S 1170 GOSUB 3470 1180 ZTAB=S 1190 ON ERROR GOTO 1880 1200 OPEN "I",1,ZTAB+".LST" 1210 ERASE E,S,T 1220 INPUT #1,ALEN:' number of opcode columns 1230 INPUT #1,ZCOM:' comment character 1240 INPUT #1,ZLAB:' label character 1250 INPUT #1,ZBYTE:' define byte 1260 INPUT #1,ZEXT:' source code extension 1270 INPUT #1,AZIL:' Zilog table definition 1280 INPUT #1,A 1290 DIM S(A) 1300 FOR B=0 TO A 1310 INPUT #1,S(B) 1320 NEXT B 1330 INPUT #1,A 1340 DIM T(A) 1350 FOR B=0 TO A 1360 INPUT #1,T(B) 1370 NEXT B 1380 CLOSE 1390 OPEN "R",1,ZTAB+".TAB",ALEN 1400 FIELD #1,ALEN AS S 1410 DIM E(ALEN-1,255) 1420 FOR A=0 TO 255 1430 GET 1 1440 FOR B=1 TO ALEN 1450 E(B-1,A)=ASC(MID$(S,B,1)) 1460 NEXT B 1470 NEXT A 1480 FT=1 1490 GOTO 640 1500 ' 1510 ' LIST OPCODES 1520 ' 1530 PRINT 1540 IF FC+FP=0 THEN GOTO 3960 1550 IF FT=0 THEN GOTO 1880 1560 AL=0 1570 FOR A=0 TO 255 1580 IF FC=1 THEN PRINT FNZNO(A);TAB(7);FNZHEX2(A);TAB(14); 1590 IF FP=1 THEN LPRINT FNZNO(A);TAB(7);FNZHEX2(A);TAB(14); 1600 FOR B=0 TO (ALEN/3)-1 1610 Z=LEFT$(S(E(3*B,A))+X,6) 1620 IF FC=1 THEN PRINT Z; 1630 IF FP=1 THEN LPRINT Z; 1640 FOR C=0 TO 1 1650 C(C)=E((3*B)+C+1,A) 1660 Z(C)=T(C(C)) 1670 NEXT C 1680 Z=X 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 1700 Z=LEFT$(Z,13) 1710 IF FC=1 THEN PRINT Z; 1720 IF FP=1 THEN LPRINT Z; 1730 NEXT B 1740 IF A>127 THEN R=". "+R(A-128) ELSE R=" "+R(A) 1750 IF FC=1 THEN PRINT R 1760 IF FP=1 THEN LPRINT R 1770 IF AL=15 AND FC=1 THEN PRINT:AL=-1 1780 IF AL=15 AND FP=1 THEN LPRINT:AL=-1 1790 AL=AL+1 1800 NEXT A 1810 GOTO 640 1820 ' 1830 ' ERRORS 1840 ' 1850 PRINT " *** FILE NOT FOUND ***" 1860 GOTO 640 1870 ' 1880 PRINT " *** NO OPCODE TABLE FOUND/LOADED ***" 1890 CLOSE 1900 ZTAB=ZBAK 1910 IF FI=1 THEN GOTO 1140 ELSE GOTO 640 1920 ' 1930 ' DISK FILE DISASSEMBLY 1940 ' If either an xref or write file has been specified, defaults 1950 ' to .COM 1960 ' 1970 PRINT 1980 IF FC+FP+FX+FW=0 THEN GOTO 3960 1990 IF FX=1 THEN SNAME=LEFT$(SXREF,INSTR(SXREF,".")-1) ELSE IF FW=1 THEN SNAME=LEFT$(SWRITE,INSTR(SWRITE,".")-1) ELSE SNAME="" 2000 SNAME=SNAME+".COM" 2010 PRINT "File name (";SNAME;" assumed) : "; 2020 INPUT "",S 2030 IF LEN(S)>0 THEN SNAME=S:GOSUB 3470 2040 IF INSTR(SNAME,".")=0 THEN SNAME=SNAME+".COM" 2050 ON ERROR GOTO 1850 2060 OPEN "I",1,SNAME 2070 CLOSE 2080 PRINT 2090 INPUT "Starting address (100H assumed) : ",S 2100 PRINT 2110 IF LEN(S)=0 THEN S="100" 2120 GOSUB 3230 2130 IF FH=1 THEN GOTO 2080 2140 I=J 2150 IF FW=1 THEN OPEN "O",2,SWRITE 2160 IF FX=1 THEN OPEN "R",3,SXREF,8:FIELD #3,4 AS X1,4 AS X2 2170 AI=0:AJ=0 2180 IF FC=1 THEN PRINT TAB(10);ZCOM;" source file name :";TAB(40);SNAME 2190 IF FP=1 THEN LPRINT TAB(10);ZCOM;" source file name :";TAB(40);SNAME 2200 IF FW=1 THEN PRINT #2,ZT;ZCOM;" source file name :";ZT;SNAME 2210 IF FC=1 THEN PRINT TAB(10);ZCOM;: IF FW=1 THEN PRINT " output file name :";TAB(40);SWRITE ELSE PRINT 2220 IF FP=1 THEN LPRINT TAB(10);ZCOM;: IF FW=1 THEN LPRINT " output file name : ";TAB(40);SWRITE ELSE LPRINT 2230 IF FC=1 THEN PRINT TAB(10);ZCOM 2240 IF FP=1 THEN LPRINT TAB(10);ZCOM 2250 IF FW=1 THEN PRINT#2,ZT;ZCOM 2260 SI=FNZHEX4(I)+"H" 2270 IF I>40959! THEN SI="0"+SI 2280 IF FC=1 THEN PRINT TAB(10);"ORG ";SI 2290 IF FP=1 THEN LPRINT TAB(10);"ORG ";SI 2300 IF FW=1 THEN PRINT#2,ZT;"ORG";ZT;SI 2310 IF FC=1 THEN PRINT TAB(10);ZCOM 2320 IF FP=1 THEN LPRINT TAB(10);ZCOM 2330 IF FW=1 THEN PRINT#2,ZT;ZCOM 2340 IF FC=1 THEN FOR A=0 TO 11:PRINT:NEXT A 2350 IF FP=1 THEN FOR A=0 TO 11:LPRINT:NEXT A 2360 IF FR=1 THEN RETURN 2370 OPEN "R",1,SNAME 2380 FIELD #1,128 AS V 2390 GET 1 2400 R=V 2410 GET 1 2420 IF LEFT$(V,1)=CHR$(&H1A) THEN GOTO 2440 2430 IF EOF(1) THEN CLOSE 1:V=W:FE=1 2440 R=R+LEFT$(V,4) 2450 FOR A=1 TO 128 2460 FOR B=0 TO 3 2470 B(B)=ASC(MID$(R,A+B,1)) 2480 NEXT B 2490 N="x"+FNZHEX4(I)+ZLAB 2500 O=FNZHEX2(B(0))+"H" 2510 IF B(0)>&H9F THEN O="0"+O ELSE O=" "+O 2520 IF B(0)>127 THEN P=ZCOM+" . "+R(B(0)-128) ELSE P=ZCOM+" "+R(B(0)) 2530 BA=0 2540 AX=0 2550 BB=0 2560 AJ=0 2570 IF AZIL=0 THEN GOTO 2630 2580 IF B(0)=203 THEN BA=3:B(0)=B(1):AJ=1 2590 IF B(0)=237 THEN BA=6:B(0)=B(1):B(1)=B(2):B(2)=B(3):AJ=1 2600 IF B(0)=221 THEN BB=1 2610 IF B(0)=253 THEN BB=2 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) ELSE B(2)=B(3):AJ=1 2630 FOR C=0 TO 2 2640 C(C)=E(BA+C,B(0)) 2650 NEXT C 2660 Y(0)=S(C(0)) 2670 FOR C=1 TO 2 2680 IF C(C)>4 OR C(C)=0 THEN Y(C)=T(C(C)):GOTO 2760 2690 Y(C)=FNZHEX2(B(1)) 2700 IF C(C)=1 THEN Y(C)=Y(C)+"H":AJ=AJ+1:IF B(1)>&H9F THEN Y(C)="0"+Y(C):GOTO 2760 ELSE GOTO 2760 2710 IF C(C)<4 THEN IY(C)=(256*B(2))+B(1):Y(C)="x"+FNZHEX2(B(2))+Y(C): AJ=AJ+2:AX=C:IF C(C)=3 THEN Y(C)="("+Y(C)+")":GOTO 2760 ELSE GOTO 2760 2720 IF B(1)>&H7F THEN B(1)=B(1)-256 2730 J=I+B(1)+2 2740 IY(C)=J 2750 Y(C)="x"+FNZHEX4(J):AJ=1:AX=C 2760 IF BB=0 THEN GOTO 2940 2770 D(C)=0 2780 IF AZIL<>1 THEN GOTO 2830 2790 IF C(C)=15 THEN Y(C)=Q(BB):D(C)=1 2800 IF C(C)=11 THEN AJ=AJ+1:D(C)=1: IF B(1)>&H7F THEN B(1)=B(1)-256:Y(C)="("+Q(BB)+STR$(B(1))+")" ELSE Y(C)="("+Q(BB)+"+"+FNZNO(B(1))+")" 2810 IF C(C)=11 AND C(0)=28 THEN Y(C)="("+Q(BB)+")":AJ=AJ-1 2820 IF C(2)=1 THEN B(1)=B(2) 2830 IF AZIL<>2 THEN GOTO 2920 2840 IF C(C)=11 THEN AJ=AJ+1:D(C)=1 :IF B(1)>&H7F THEN B(1)=B(1)-256:Y(C)=STR$(B(1))+"("+Q(BB)+")": ELSE Y(C)=FNZNO(B(1))+"("+Q(BB)+")" 2850 IF C(0)=21 THEN Y(0)="DAD"+RIGHT$(Q(BB),1):D(C)=1 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 THEN Y(1)=Q(BB):D(C)=1 2870 IF C(0)=69 THEN Y(0)="S"+Q(BB)+"D":D(C)=1 2880 IF C(0)=41 THEN Y(0)="L"+Q(BB)+"D":D(C)=1 2890 IF C(0)=80 THEN Y(0)="XT"+Q(BB):D(C)=1 2900 IF C(0)=71 THEN Y(0)="SP"+Q(BB):D(C)=1 2910 IF C(0)=49 THEN Y(0)="PC"+Q(BB):D(C)=1 2920 ' position for additional Zilog routines 2930 IF C=2 AND ((D(1)=0 AND D(2)=0) OR (BA=0 AND B(0)=235)) THEN AJ=0:C(0)=0:Y(0)=S(0):C(1)=0 2940 NEXT C 2950 IF AI>0 THEN D=20 ELSE D=0 2960 IF FC=1 THEN PRINT N;:IF AI>0 THEN PRINT TAB(10);ZCOM; 2970 IF FP=1 THEN LPRINT N;:IF AI>0 THEN LPRINT TAB(10);ZCOM; 2980 IF FW=1 THEN PRINT #2,N;ZT;:IF AI>0 THEN PRINT#2,ZCOM;ZT;ZT;ZT; 2990 IF C(1)>0 AND C(2)>0 THEN Y0=Y(1)+","+Y(2) ELSE Y0=Y(1) 3000 IF FC=1 THEN PRINT TAB(10+D);Y(0);:IF C(1)>0 THEN PRINT TAB(16+D);Y0; 3010 IF FP=1 THEN LPRINT TAB(10+D);Y(0);:IF C(1)>0 THEN LPRINT TAB(16+D);Y0; 3020 IF FW=1 THEN PRINT #2,Y(0);ZT;:IF C(1)=0 THEN PRINT #2,ZT;ZT; ELSE PRINT #2,Y0;ZT;:IF LEN(Y0)<8 THEN PRINT #2,ZT; 3030 IF FW=1 AND AI=0 THEN PRINT #2,ZT;ZT;ZT; 3040 IF FC=1 THEN PRINT TAB(50);ZCOM;ZBYTE;" ";O;" ";P 3050 IF FP=1 THEN LPRINT TAB(50);ZCOM;ZBYTE;" ";O;" "P 3060 IF FW=1 THEN PRINT #2,ZCOM;ZBYTE;ZT;O;ZT;P 3070 IF FC=1 AND MID$(N,5,1)="F" THEN PRINT 3080 IF FP=1 AND MID$(N,5,1)="F" THEN LPRINT 3090 IF AI>0 THEN AX1=2 ELSE AX1=1 3100 IF FX=1 AND AX>0 THEN LSET X1=MKS$(IY(AX)):LSET X2=MKS$((4*I)+AX1):PUT 3 3110 IF AI=0 THEN AI=AJ ELSE AI=AI-1 3120 AJ=0 3130 AX=0 3140 I=I+1 3150 IF FR=1 THEN RETURN 3160 NEXT A 3170 IF FE=0 THEN GOTO 2400 3180 IF FX=1 THEN LSET X1=ZEND1:LSET X2=ZEND2:PUT 3 3190 GOTO 610 3200 ' 3210 ' string to hex conversion routine 3220 ' 3230 IF RIGHT$(S,1)=" " THEN S=LEFT$(S,LEN(S)-1):GOTO 3230 3240 IF LEFT$(S,1)=" " THEN S=RIGHT$(S,LEN(S)-1):GOTO 3240 3250 IF RIGHT$(S,1)="h" OR RIGHT$(S,1)="H" THEN S=LEFT$(S,LEN(S)-1) 3260 FH=0 3270 A=LEN(S) 3280 J=0 3290 J0=1 3300 FOR B=0 TO A-1 3310 C=ASC(MID$(S,A-B,1)) 3320 IF C=ASC(" ") THEN GOTO 3390 3330 IF C>=ASC("a") AND C<=ASC("z") THEN C=C-32 3340 C=C-48 3350 IF C>9 THEN C=C-7 3360 IF C<0 OR C>15 THEN FH=1:GOTO 3420 3370 J=J+(C*J0) 3380 J0=J0*16 3390 NEXT B 3400 RETURN 3410 ' 3420 PRINT" *** BAD HEX STRING ";S;" -- PLEASE REENTER *** "; 3430 RETURN 3440 ' 3450 ' convert string to caps, strip blanks 3460 ' 3470 A=LEN(S) 3480 FOR B=1 TO A 3490 A(B)=ASC(MID$(S,B,1)) 3500 NEXT B 3510 S="" 3520 FOR B=1 TO A 3530 IF A(B)=ASC(" ") THEN GOTO 3560 3540 IF A(B)>=ASC("a") AND A(B)<=ASC("z") THEN A(B)=A(B)-32 3550 S=S+CHR$(A(B)) 3560 NEXT B 3570 RETURN 3580 ' 3590 ' MEMORY DISASSEMBLY 3600 ' 3610 PRINT 3620 IF FC+FP+FX+FW=0 THEN GOTO 3960 3630 FR=1 3640 PRINT "memory start";TAB(30);": "; 3650 INPUT "",S 3660 GOSUB 3230 3670 IF LEN(S)=0 THEN GOTO 3640 3680 L=J 3690 S1=S 3700 PRINT "program start (";S;" assumed:";TAB(30);": "; 3710 INPUT "",S 3720 IF LEN(S)>0 THEN GOSUB 3230 ELSE I=L:GOTO 3760 3730 IF LEN(S)=0 THEN GOTO 3760 3740 I=J 3750 S1=S 3760 PRINT "program end";TAB(30);": "; 3770 INPUT "",S 3780 GOSUB 3230 3790 IE=J 3800 IF LEN(S)=0 THEN GOTO 3760 3810 SNAME="mem > "+S1+"-"+S 3820 GOSUB 2150 3830 FOR A=0 TO 3 3840 L(A)=L+A 3850 IF L(A)>2^15 THEN L(A)=L(A)-2^16 3860 B(A)=PEEK(L(A)) 3870 NEXT A 3880 GOSUB 2490 3890 L=L+1 3900 IF I<=IE THEN GOTO 3830 3910 GOTO 610 3920 ' 3930 ' if no output is specified before disassembly, it will terminate 3940 ' and return to menu 3950 ' 3960 PRINT "*** NO OUTPUT SPECIFIED ***" 3970 GOTO 640 3980 ' 3990 ' NAME X-REF FILE 4000 ' This does not check for existing file, so will allow a write-over to 4010 ' occur. If a write file has been specified, defaults to .XRF. 4020 ' An extension .XRF is normally provided. 4030 ' 4040 PRINT 4050 IF FT=0 THEN GOTO 1880 4060 FX=1 4070 IF FW=1 THEN SXREF=LEFT$(SWRITE,INSTR(SWRITE,"."))+"XRF" ELSE SXREF=".XRF" 4080 PRINT "X-ref file name (";SXREF;" assumed) : "; 4090 INPUT "",S 4100 IF LEN(S)=0 THEN IF FW=1 THEN GOTO 640 ELSE GOTO 4080 4110 GOSUB 3470 4120 SXREF=S 4130 IF INSTR(SXREF,".")=0 THEN SXREF=SXREF+".XRF" 4140 GOTO 640 4150 '