10 CLS : PRINT "Z-80 DISASSEMBLER VERSION 6.2.0";


15 PRINT "FOR THE TRS-80 MODEL 4/4P (MUST HAVE AT MICROSOFT BASIC 5.0)"


20 PRINT : PRINT "COPYRIGHT (C) 1982, 1983, 1984, 1985 BY HAL N. FUQUAY"


30 PRINT "CREATIVE SOLUTIONS,INC. -- PLACED IN PUBLIC DOMAIN 1-1-85"


40 PRINT:PRINT STRING$(58,"*")


50 PRINT"* Zero symbols will give a ";


60 PRINT"quick single-pass disassembly.*"


70 PRINT"* Recommended procedure is ";


80 PRINT"to PRINT OUT a single-pass    *"


90 PRINT"* disassembly, then use it ";


100 PRINT"as a guide in a two-pass run. *"


110 PRINT"* Use 0 symbols for a single-";


120 PRINT"pass run, 30% of program    *"


130 PRINT"* length for two-pass run.  A ";


140 PRINT"two-pass run provides EXT  *"


150 PRINT"* statements for out-of-bounds symbols.";


160 PRINT STRING$(18,32);"*"


162 PRINT"* Eliminate ALL COMMENTS for increased";


164 PRINT" speed and MEMORY  *"


169 PRINT STRING$(58,"*"):PRINT


170 '


180 '***Name scalars important to speed first


190 DIM TEST,IS%,JS%,IP%,TS%,ST$(15),A$(15),NS%,X%,N%,INST$


200 DIM AD$,IH%,IL%,Y%,AS$,LO$,HX$


210 '


220 '***Define binary to HEX conversion array


232 DATA 0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F


250 FOR I%=0 TO 15:READ A$(I%):NEXT I%


270 '***Define blanks for fill in instruction fields


280 '   (fast substitute for STRING$(n," ") function)


290 ST$(0)="":FOR I=1 TO 15:ST$(I)=ST$(I-1)+" ":NEXT I


300 '


310 '***Statement functions


320 '***Integer to HEX (ASCII) single-byte conversion


330 DEF FN H1$(N)=A$((N AND TFO%)/HBY!)+A$(N AND FTEEN%)


340 '***Dual-byte conversion


350 DEF FN H2$(N)=FNH1$(INT(N/BY!))+FNH1$(N-BY!*INT(N/BY!))


360 '***Integer to floating address conversion


370 DEF FN AD(NN%)=NN%-HMX!*(SGN(NN%)-ABS(SGN(NN%)))


380 '***Floating to integer address conversion


390 DEF FN AD%(NN)=NN-HMX!*(1+SGN(NN-32767.5))


400 '***Constant-width ASCII fields for output


410 DEF FN W$(S$,L)=S$+ST$(L-LEN(S$))


420 '


430 '***Define all the instruction lookup tables


440 '***Define 8-bit register lookup


450 DATA B,C,D,E,H,L,(HL),A


460 FOR I%=0 TO 7:READ R$(I%):NEXT I%


470 '***Define 16-bit register lookup


480 DATA BC,DE,HL,SP:FOR I%=0 TO 3:READ RR$(I%):NEXT I%


490 '***Define operation lookup


500 DATA ADD,ADC,SUB,SBC,AND,XOR,OR,CP


510 FOR I%=0 TO 7:READ OP$(I%):NEXT I%


520 '***Define condition lookup


530 DATA NZ,Z,NC,C,PO,PE,P,M


540 FOR I%=0 TO 7:READ CD$(I%):NEXT I%


550 '***Define "CB" rotates lookup


560 DATA RLC,RRC,RL,RR,SLA,SRA,***,SRL


570 FOR I%=0 TO 7:READ CB$(I%):NEXT I%


580 '***Define "&O0n7" special cases lookup


590 DATA DAA,CPL,SCF,CCF:FOR I%=0 TO 3:READ O7$(I%):NEXT I%


600 '***Define "EDA" and "EDB" codes operation lookup


610 DATA LD,CP,IN,OUT:FOR I%=0 TO 3:READ ED$(I%):NEXT I%


620 '


630 '***BEGIN***


640 T$=CHR$(9)'***Define TAB character


650 MX!=65536!:HMX!=32768!:BY!=256!:A9=57  '*** DEFINE FP CONSTANTS


660 TFO%=240:HBY!=16!:FTEEN%=15:SEV%=7:FSX%=56:HOD%=192


670 CLS : PRINT@(5,10),"MAX. NO. OF SYMBOLS IN THIS VERSION IS:   100"


675 PRINT : PRINT"ONE PASS (ZERO) OR 2-PASS (100 SYMBOLS) ?"


676 PRINT : INPUT" ENTER EITHER <0> FOR ZERO OR <2> FOR TWO-PASS RUN  ";HAL%


677 MNSYMB% = 100 : IF HAL% <> 0 AND HAL% <> 2 THEN 670


680 IF MNSYMB% <= 0 THEN MNSYMB% = 0 : XS% = 0 ELSE XS% = 1


690 IF XS% = 0 THEN 730


700 '***Two-pass disassemble--define address table


710 DIM S%(100) : XI% = 0 : IS% = 0


720 PRINT"Remaining memory: ";FNH2$(MEM)+"H"


730 PRINT"Assembler format for OUTPUT:"


740 PRINT"  1 ==> EDTASM (TM)/EDTAS (TM)";


750 PRINT T$;"2 ==> ALASM (TM)"


760 PRINT"  3 ==> MACRO 80 (TM)";


770 PRINT T$;T$;"4 ==> M-ZAL (TM)"


780 PRINT"Selection? ";


785 IA$=INKEY$:IF IA$="" THEN 785 ELSE PRINT IA$


787 IA%=VAL(IA$)


790 IF IA%<1 OR IA%>4 THEN PRINT"Use 1?":GOTO 730


800 IF IA%<4 THEN 850


810 PRINT"Use M-ZAL utility 'LEXCONV' to convert ";


820 PRINT"from EDTASM format (used here"


830 PRINT"because of pseudo-op compatability with M-ZAL)"


840 IA%=1


850 PRINT"<1> ==> Printer ON";


860 PRINT T$,"<4> ==> Printer OFF"


880 IPR$=INKEY$:IF IPR$<>"1" AND IPR$<>"4" THEN 880


890 PR%=0:IF IPR$="1" THEN PR%=1


900 PRINT"<2> ==> Read from DISK";


910 PRINT T$,"<5> ==> Read from MEMORY"


930 IDM$=INKEY$:IF IDM$<>"2" AND IDM$<>"5" THEN 930


940 DM%=0:IF IDM$="5" THEN DM%=1


950 PRINT"<3> ==> Write to disk";


960 PRINT T$,"<6> ==> No $/SRC file"


980 IDK$=INKEY$:IF IDK$<>"3" AND IDK$<>"6" THEN 980


990 '


1000 '***Initialize line number, reset PDS flag


1010 '***Skip input file name if memory dis. or 2nd pass


1020 LNE%=0:PDS%=0:IF DM%=1 OR XS%=2 THEN 1050


1030 INPUT" $/CMD INPUT file name (include extension)";FILE$


1040 '


1050 DK%=0:IF IDK$<>"3" THEN 1110


1060 DK%=1:INPUT "Name for $/SRC OUTPUT file: ";OFILE$


1070 OPEN "O",2,OFILE$


1080 '***Output M80 ASEG Pseudo-operand


1090 IF IA%=3 THEN PRINT# 2,T$,"ASEG"


1100 '***If memory disassemble, input address limits


1110 IF DM%=0 THEN 1190


1120 INPUT"Beginning memory location? ";LOW


1130 INPUT"Ending memory location?    ";HIGH


1140 PRINT"low = ";FNH2$(LOW);"H, High = ";FNH2$(HIGH);"H":PRINT


1150 IF HIGH<0 THEN HIGH=HIGH+MX!


1160 IF LOW<0 THEN LOW=LOW+MX!


1170 '


1180 '***Loop to here for second pass


1190 IF XS%>0 THEN PRINT">>>Disassembler pass ";XS%;"..."


1200 '***Reset PSECT/ORG


1210 IF IA%=2 OR IA%=4 THEN ORG$="PSECT" ELSE ORG$="ORG"


1220 '***Set disassembly option defaults


1230 SSOPT%=2:DAOPT%=1


1240 IF XS%=1 THEN 1400


1250 '***Print menu for last pass


1260 PRINT"Menu:":PRINT:PRINT"<1> => SINGLE STEP";


1270 PRINT T$;T$;"<4> => Free run (Disassemble ONLY)"


1280 PRINT"<2> => DEFM";T$;


1290 PRINT T$;T$;"<5> => Disassemble"


1300 PRINT"<3> => DEFW";


1310 PRINT T$;T$;T$"<6> => DEFB"


1320 PRINT"Mode may be changed at ANY TIME"


1330 PRINT"Default is Free run, Disassemble"


1340 PRINT"Press <1 thorough 6> to override,";


1350 PRINT" any key for Free run, Disassemble"


1360 OPT$=INKEY$:IF OPT$="" THEN 1360


1370 '***Check options


1380 GOSUB 5580


1390 '***Check flag for disk or memory disassemble


1400 IF DM%=1 THEN GOTO 2290


1410 '


1420 '***DISK FILE DISASSEMBLE****


1430 OPEN "R",1,FILE$


1440 FIELD 1, 128 AS REC$


1450 GET #1


1460 LC=FNAD(VARPTR(#1))


1470 I%=0:I0=0:IX=0:PCNT%=0:DCNT%=0


1480 '


1490 '***DISK LOOP RETURNS TO HERE--


1500 '   READ BLOCK IDENTIFIER & COUNT ***


1510 GOSUB 6050:TYPE=N%:IF XS%=2 OR N%<>6 AND N%<>8 THEN 1580


1520 '***Partitioned Data Set (PDS)--Print menu and set options


1530 IF PDS%=1 THEN 1580 ELSE PDS%=1:PMX%=0


1535 IF XS%<2 THEN DIM EN(100)'***PDS file entry points


1540 PRINT"PDS--Specifying 0 symbols and ISAM 0";


1550 PRINT" allows a scan of entire file"


1560 INPUT"ISAM No.";PNO%


1570 '***Loop back to here if instruction overran ldr block


1580 N%=TYPE:PRINT:PRINT"Block type = ";FNH1$(TYPE)+"H";


1590 '***Decode loader block type


1600 SS$="":IF N%>9 THEN 1700


1610 ON N% GOTO 1630,1640,1800,1650,1660,1670,1680,1690,1800


1620 SY$="ERROR!":GOSUB 6310:GOTO 1820


1630 SY$="Loader block":GOTO 1820


1640 SY$="END of loader block":GOTO 1820


1650 IF XS%=0 OR PCNT%<>PNO% THEN 1659


1654 SY$="":S=EN(PNO%):GOSUB 2990:PRINT


1656 LO$="":HX$="":INST$="END":NN$=FNH2$(S):GOSUB 5920


1658 AD$=NN$:AS$="":GOSUB 5370


1659 SY$="End of PDS member":PCNT%=PCNT%+1:GOTO 1820


1660 SY$="File header":GOTO 1820


1670 SY$="PDS header":GOTO 1820


1680 SY$="Patch header":GOTO 1820


1690 SY$="ISAM Directory entry":DCNT%=DCNT%+1:GOTO 1820


1700 IF N%>31 THEN 1620


1710 IF N%=31 THEN 1790


1720 IF N%>17 THEN 1800


1730 ON N%-10 GOTO 1750,1760,1800,1770,1800,1780


1740 SY$="END ISAM Directory":PMX%=DCNT%:GOTO 1820


1750 SY$="Comment":GOTO 1820


1760 SY$="PDS Directory entry":GOTO 1820


1770 SY$="END of PDS Directory ":GOTO 1820


1780 SY$="YANKed PATCH load file block":SS$=";":GOTO 1820


1790 SY$="Copyright notice":GOTO 1820


1800 SY$="RESERVED":GOSUB 6310


1810 '


1820 IF N%>2 AND XS%<>1 AND PR%=1 THEN LPRINT SY$


1830 HX$="":LO$="":HX$="":INST$="":AD$="":AS$=""


1840 SY$="; "+SY$'***Output remark to $/SRC file


1850 PRINT SY$;:GOSUB 5420:GOSUB 6050:JN=N%


1860 PRINT ", Length=";FNH1$(JN)+"H"


1870 '***End pass if selected PDS was passed


1880 IF XS%>0 AND PDS%=1 AND PCNT%>PNO% THEN 2260


1890 IF TYPE<3 OR TYPE=16 THEN 2010


1900 IF TYPE>4 AND TYPE<8 OR TYPE>16 THEN 1960


1901 IF TYPE<>12 THEN 1920'***PDS header


1902 FOR J=1 TO JN-3:GOSUB 6050:GOSUB 5720:NEXT J


1903 SY$="; "+AS$:AS$="":GOSUB 5370:JN=3


1910 '***Miscellaneous HEX markers & pointers


1920 SY$="; "


1930 FOR J=1 TO JN:GOSUB 6050:SY$=SY$+FNH1$(N%)


1932 IF TYPE<>8 THEN 1940'***Save PDS entry points


1933 IF J=2 AND PDS%=1 THEN EN(DCNT%)=N%


1934 IF J<>3 OR PDS%<>1 THEN 1940


1936 EN(DCNT%)=EN(DCNT%)+BY!*N%:PRINT"Count=";DCNT%;", ";


1937 NN$=FNH2$(EN(DCNT%)):GOSUB 5940:PRINT"Entry=";NN$


1938 IF PR%=0 OR XS%=1 THEN 1940


1939 LPRINT "Count=";DCNT%;", Entry=";NN%


1940 NEXT J:GOSUB 5370:IF TYPE<>4 THEN 1510


1941 IF PCNT%>PMX% THEN 2260'***End pass at last PDS


1942 PRINT"PDS Count=";PCNT%


1944 IF PR%>0 THEN LPRINT "PDS Count=";PCNT%


1946 GOTO 1510


1950 '***Header, comment, or copyright notice


1960 FOR J=1 TO JN:GOSUB 6050:GOSUB 5720:NEXT J


1970 SY$="; "+AS$:AS$="":GOSUB 5370:GOTO 1510


1980 '


1990 '***Loader block or END of loader block


2000 '***Adjust block size for address


2010 JN=JN-2:IF TYPE=1 AND JN<1 THEN JN=JN+256


2020 '***Skip ISAMS when appropriate


2030 IF PDS%=0 OR PNO%+XS%=0 OR PNO%=PCNT% THEN 2070


2040 PRINT"Skipping No.";PCNT%;"..."'***Skip it


2050 FOR I=1 TO JN+2:GOSUB 6050:NEXT I:GOTO 1510


2060 '***Fetch loader block address or transfer address


2070 SY$=SS$:GOSUB 6050:I0=N%:GOSUB 6050:I0=I0+256!*N%


2080 IF TYPE=2 THEN 2220


2090 '***TYPE=1 or 16--Loader block or yanked patch


2100 IF XS%<>1 AND I0-1=IX THEN 2140


2110 LO$="":HX$=""


2120 INST$=ORG$:ORG$="ORG"


2130 NN$=FNH2$(I0):GOSUB 5940:AD$=NN$:AS$="":GOSUB 5370


2140 OFF=I0-I%-1:IX=I0+JN-1:I=I0


2150 '***While-Wend loop for loader blocks


2160 IF XS%=1 THEN THI=I


2170 GOSUB 2460:I=I+1:IF I<=IX THEN 2160


2180 '***TYPE aready read in if instruction overran block


2190 IF TYPE<>1 AND TYPE<>16 THEN 1580 ELSE 1510


2200 '


2210 '***TYPE=2--END with transfer address


2220 LO$="":HX$="":INST$="END"


2230 '***Add transfer address to symbol table


2240 IF XS%=1 THEN S=I0:GOSUB 2990


2250 NN$=FNH2$(I0):GOSUB 5920:AD$=NN$:AS$="":GOSUB 5370


2255 IF PDS%>0 AND (PCNT%<=PNO% OR XS%+PNO%=0) THEN 1500


2260 CLOSE 1:GOTO 2380


2270 '


2280 '***MEMORY DISASSEMBLE***


2290 IF XS%=2 THEN 2320


2300 OFF=LOW:LC=LOW+1


2310 TLOW=LOW:THI=HIGH


2320 FOR I=LOW TO HIGH:GOSUB 2460:NEXT I


2330 LO$="":HX$="":SY$="":INST$="END":AD$="":AS$=""


2340 GOSUB 5370


2350 '


2360 '***Output symbol table and go back


2370 '   for second loop, or END


2380 IF XS%=1 THEN XS%=2:GOSUB 6350:GOTO 1190


2390 '***Add EOF to disk file


2400 IF DK%=0 THEN 2420


2410 PRINT# 2,CHR$(26);:CLOSE 2


2420 END


2430 '


2440 '***SUBROUTINE TO FETCH,


2450 '   DECODE AND OUTPUT Z-80 INSTRUCTION***


2460 ON XS%+1 GOTO 3190,2500,3190


2470 '


2480 '***First pass: find addresses for table


2490 '***Define address table, low load address


2500 IF XI%=0 THEN XI%=1:TLOW=I


2510 PRINT".";


2520 '***Find IX, IY instructions, allow for extra byte


2530 GOSUB 6090:GOSUB 5680


2540 IF N%<>221 AND N%<>253 THEN 2640


2550 GOSUB 6070:GOSUB 5680


2560 IF N%>51 AND N%<55 THEN 2620


2570 '***Find 'DD CB XX' instructions


2580 IF N%=203 THEN 2620


2590 IF Z%=1 AND X%=6 OR Y%=6 THEN 2620


2600 IF Z%=2 AND X%=6 THEN 2620


2610 GOTO 2640


2620 NT%=N%:GOSUB 6070:N%=NT%


2630 IF N%=118 THEN GOSUB 6280:GOTO 2970


2640 ON Z% GOTO 2790,2810,2840


2650 'Low instructions--00H to 3FH


2660 '***Find LD XX,nn instructions


2670 IF X%<>1 THEN 2700


2680 IF (Y% AND 1)<>0 THEN RETURN ELSE GOTO 2970


2690 '***Find LD (nn),HL /LD HL,(nn)/LD (nn),A/LD A,(nn)


2700 IF X%<>2 THEN 2730


2710 IF Y%<4 THEN RETURN ELSE GOTO 2970


2720 '***Skip byte for LD X,n instructions


2730 IF X%=6 THEN GOSUB 6070:RETURN ELSE 2750


2740 '***Find the JR and DJNZ instructions


2750 IF X%<>0 OR Y%<2 THEN RETURN


2760 GOSUB 6070:IO=N%:IF IO>127 THEN IO=IO-256


2770 S=IO+I+1:GOTO 2990


2780 'Interregister 8-bit loads--40H to 7FH


2790 RETURN


2800 '8-bit ops on A reg--80H to 0BFH


2810 RETURN


2820 'High instructions--0C0H to 0FFH


2830 '***Find JP and CALL instructions


2840 IF X%=2 OR X%=4 THEN 2970


2850 IF N%=195 OR N%=205 THEN 2970


2860 '***Find OUT n,A and IN A,n instructions


2870 '   and the 8-bit arithmetic/logical immediate


2880 IF X%=6 OR N%=211 OR N%=219 THEN GOSUB 6070:RETURN


2890 '***Find 'CB' instructions


2900 IF N%=203 THEN GOSUB 6070:RETURN


2910 '***Decode 'ED' instructions--only LD (nn),XX/XX,(nn)


2920 IF N%<>237 THEN RETURN


2930 GOSUB 6070:GOSUB 5680:IF X%<>3 THEN RETURN


2940 '


2950 '***Address table building routine


2960 '***16-bit address--add to table


2970 GOSUB 6070:S=N%:GOSUB 6070:S=S+256!*N%


2980 '***Enter here if S already defined for JR instructions


2990 IF IS%<MNSYMB% THEN 3040


3000 PRINT"SYMBOL TABLE FULL--PASS 1 TERMINATED":GOSUB 6310


3010 IS%=IS%-1:IF DM%=0 THEN CLOSE 1


3020 GOTO 2380


3030 '***Store no duplicate addresses, order--smallest first


3040 N%=FNAD%(S):IF IS%=0 THEN IS%=1:S%(1)=N%:RETURN


3050 FOR IP%=IS% TO 1 STEP -1


3060 '***Exit if symbol address already referenced


3070 NS%=S%(IP%):IF N%=NS% THEN RETURN


3080 '***Avoid FNAD(NN%) for speed here


3090 TEST=NS%:IF NS%<0 THEN TEST=TEST+MX!


3100 '***Search down array until S%(IP%)<S<S%(IP%+1)


3110 IF TEST<S THEN 3140


3120 NEXT IP%'***Loop will exit with IP%=0


3130 '***Move array up one from IP%+1 on


3140 IS%=IS%+1:TS%=IS%:FOR JS%=IS%-1 TO IP%+1 STEP -1


3150 S%(TS%)=S%(JS%):TS%=JS%:NEXT JS%:S%(IP%+1)=N%:RETURN


3160 '


3170 '***Second or Only pass--decode instruction


3180 '***Check for change of single step option


3190 OPT$=INKEY$


3200 GOSUB 5580


3210 '***Special symbols are <NULL> & <F1>


3220 IF OPT$="" OR OPT$="1" THEN ON SSOPT% GOTO 3190,3250


3230 '


3240 '***Set symbol field


3250 SY$=SS$:IF XS%=0 OR SP%>NS% THEN 3390


3260 TEST=FNAD(S%(SP%))


3270 IF I<TEST THEN 3390


3280 SY$=SS$+"X"+FNH2$(S%(SP%)):SP%=SP%+1


3290 '***Add ":" for M80 symbol terminator


3300 IF I>TEST THEN 3340


3310 IF IA%=3 THEN SY$=SY$+":"


3320 GOTO 3390


3330 '***Symbol after start of instruction--use EQU $-n


3340 NN$=FNH1$(I-TEST):GOSUB 5940:AD$="$-"+NN$:AS$=""


3350 '***Loop back after EQU $-n pseudo-operations


3360 LO$="":HX$="":INST$="EQU":GOSUB 5370:GOTO 3250


3370 '


3380 '***Reset JR flag, initialize HEX/Address/ASCII fields


3390 IJR=0:HX$="":AD$="":AS$=";":LO$=FNH2$(I)


3400 '***Fetch instruction byte, decode, update ASCII field


3410 GOSUB 6090:GOSUB 5680:GOSUB 5720


3420 '***Update HEX field, initialize 16-bit registers


3430 HX$=HX$+FNH1$(N%):RR$(3)="SP":HL$="HL"


3440 '


3450 '***Check disassembly option:


3460 '   Decode OP, DEFM, DEFW, DEFB


3470 ON DAOPT% GOTO 3680,3500,3610,3660


3480 '


3490 '***DEFM:


3500 INST$="DEFM":AD$="'":MLN%=0


3510 '***Use DEFB if non-ASCII byte


3520 IF N%<32 OR N%>127 THEN IF MLN%=0 THEN 3660 ELSE 3580


3530 '***Add character to AD$ string & increment counter


3540 HX$="":AS$="":AD$=AD$+CHR$(N%):MLN%=MLN%+1


3550 '***Get next byte and decide whether to go to new line


3560 GOSUB 6070:IF MLN%<32 AND (TYPE=1 OR TYPE=16) THEN 3520


3570 '***End line, output it, go back to interpret next byte


3580 AD$=AD$+"'":GOSUB 5370:IF NOT(TYPE=1 OR TYPE=16) THEN RETURN


3585 IF MLN%=32 THEN 3250 ELSE 3190


3590 '


3600 '***DEFW:


3610 INST$="DEFW":IW=N%:GOSUB 6070:GOSUB 5720:IW=IW+256!*N%


3620 HX$=HX$+FNH1$(N%)


3630 NN$=FNH2$(IW):GOSUB 5940:AD$=NN$:GOTO 5370


3640 '


3650 '***DEFB:


3660 INST$="DEFB":NN$=FNH1$(N%):GOSUB 5940:AD$=NN$:GOTO 5370


3670 '


3680 R$(4)="H":R$(5)="L":XY=0


3690 '***CHECK FOR IX OR IY INSTRUCTIONS AND


3700 '   ALLOW FOR OFFSET BYTE WHERE APPROPRIATE


3710 IF N%<>221 THEN 3750


3720 '***XH AND XL INSTRUCTIONS UNDOCUMENTED--


3730 '   TRY THEM BEFORE YOU TRUST THEM ON YOUR Z-80


3740 HL$="IX":R$(4)="XH":R$(5)="XL":XY=1:GOSUB 5840


3750 IF N%<>253 THEN 3770


3760 HL$="IY":R$(4)="YH":R$(5)="YL":XY=1:GOSUB 5840


3770 R$(6)="("+HL$+")"


3780 IF XY<>1 THEN 3920


3790 '***PICK UP OFFSET BYTE FOR INDEXED INSTRUCTIONS


3800 IF N%>51 AND N%<55 THEN 3870


3810 IF N%=203 THEN 3870


3820 IF Z%=1 AND X%=6 OR Y%=6 OR Y%=6 THEN 3870


3830 IF Z%=2 AND X%=6 THEN 3870


3840 GOTO 3920


3850 '***INDEXED INSTRUCTIONS WITH OFFSET--


3860 '   EXTRA BYTE FOR OFFSET


3870 NT%=N%:GOSUB 5840:SN$="+"


3880 IF N%>127 THEN N%=N%-256:SN$="-"


3890 NN$=FNH1$(ABS(N%)):GOSUB 5940:N%=NT%


3900 R$(6)="("+HL$+SN$+NN$+")":GOSUB 5680


3910 IF N%=118 THEN GOTO 5330


3920 RR$(2)=HL$:ON Z% GOTO 4300,4380,4430


3930 '


3940 '***LOW INSTRUCTIONS<==>&H00 TO &H3F


3950 IF N%=0 THEN INST$="NOP":GOTO 5370'***SPECIAL CASE


3960 IF IL%=1 OR X%=2 OR X%=6 THEN INST$="LD"


3970 IF IL%=3 OR X%=4 THEN INST$="INC"


3980 IF IL%=11 OR X%=5 THEN INST$="DEC"


3990 IF X%=3 THEN AD$=RR$(IH%):GOTO 5370


4000 IF X%=4 OR X%=5 THEN AD$=R$(Y%):GOTO 5370


4010 IF X%<>6 THEN 4030


4020 AD$=R$(Y%):GOSUB 5840:AD$=AD$+","+NN$:GOTO 5370


4030 IF IL%<>9 THEN 4050


4040 INST$="ADD":AD$=HL$+","+RR$(IH%):GOTO 5370


4050 IF IL%<>1 THEN 4090


4060 AD$=RR$(IH%):GOSUB 5800:AD$=AD$+","+NN$:GOTO 5370


4070 '***IRREGULAR INSTRUCTIONS


4080 '***INDEXED, IMMEDIATE, AND 16-BIT LOADS


4090 IF X%<>2 THEN 4180


4100 IF IL%=10 THEN 4140


4110 IF IH%<2 THEN AD$="("+RR$(IH%)+"),A":GOTO 5370


4120 IF Y%=4 THEN GOSUB 5800:AD$="("+NN$+"),"+HL$:GOTO 5370


4130 GOSUB 5800:AD$="("+NN$+"),A":GOTO 5370


4140 IF IH%<2 THEN AD$="A,("+RR$(IH%)+")":GOTO 5370


4150 IF Y%=5 THEN GOSUB 5800:AD$=HL$+",("+NN$+")":GOTO 5370


4160 GOSUB 5800:AD$="A,("+NN$+")":GOTO 5370


4170 '***RELATIVE JUMPS


4180 IF X%<>0 THEN 4260


4190 '***EX AF,AF' is special case


4200 IF N%=8 THEN INST$="EX":AD$="AF,AF'":GOTO 5370


4210 IJR=1:IF N%=16 THEN INST$="DJNZ":ELSE INST$="JR"


4220 IF N%<32 THEN GOSUB 5840:AD$=NN$:GOTO 5370


4230 AD$=CD$(Y%-4)+",":GOSUB 5840:AD$=AD$+NN$:GOTO 5370


4240 '***8-BIT ROTATES, DECIMAL ADJUST,


4250 '   COMPLEMENT, AND CARRY FLAG SET & CLEAR


4260 IF Y%<4 THEN INST$=CB$(Y%)+"A":ELSE INST$=O7$(Y%-4)


4270 GOTO 5370


4280 '


4290 '***INTERREGISTER 8-BIT LOADS<==>&H40 TO &H7F


4300 IF N%=118 THEN INST$="HALT":GOTO 5370


4310 IF N%=102 OR N%=110 OR N%=116 OR N%=117 THEN 4340


4320 GOTO 4350


4330 '***XH, XL Instructions NOT USED here


4340 R$(4)="H":R$(5)="L"


4350 INST$="LD":AD$=R$(Y%)+","+R$(X%):GOTO 5370


4360 '


4370 '***8-BIT OPERATIONS ON "A" REGISTER<==>&H80 TO &HBF


4380 INST$=OP$(Y%):AD$=R$(X%)


4390 IF Y%=0 OR Y%=1 OR Y%=3 THEN AD$="A,"+AD$


4400 GOTO 5370


4410 '


4420 '***HIGH INSTRUCTIONS<==>&HC0 TO &HFF


4430 IF X%=0 THEN INST$="RET":AD$=CD$(Y%):GOTO 5370


4440 IF X%<>2 THEN 4470


4450 INST$="JP":AD$=CD$(Y%)+",":GOSUB 5800


4460 AD$=AD$+NN$:GOTO 5370


4470 IF X%<>4 THEN 4500


4480 INST$="CALL":AD$=CD$(Y%)+",":GOSUB 5800:AD$=AD$+NN$


4490 GOTO 5370


4500 IF X%<>6 THEN 4530


4510 INST$=OP$(Y%):GOSUB 5760:GOSUB 5840:AD$=AD$+NN$


4520 GOTO 5370


4530 IF X%=7 THEN INST$="RST":AD$=FNH1$(8*Y%)+"H":GOTO 5370


4540 '***SEPARATE OUT "CB" INSTRUCTIONS


4550 IF N%=203 THEN 4790


4560 '***SEPARATE OUT "ED" INSTRUCTIONS


4570 IF N%=237 THEN 4900


4580 RR$(3)="AF"


4590 IF IL%=1 THEN INST$="POP":AD$=RR$(IH%-12):GOTO 5370


4600 IF IL%=5 THEN INST$="PUSH":AD$=RR$(IH%-12):GOTO 5370


4610 '***ONE-OF-A-KIND INSTRUCTIONS


4620 IF N%=201 THEN INST$="RET":GOTO 5370


4630 IF N%<>205 THEN 4650


4640 INST$="CALL":GOSUB 5800:AD$=NN$:GOTO 5370


4650 IF N%=217 THEN INST$="EXX":GOTO 5370


4660 IF N%=233 THEN INST$="JP":AD$=R$(6):GOTO 5370


4670 IF N%=249 THEN INST$="LD":AD$="SP,"+HL$:GOTO 5370


4680 IF N%=195 THEN INST$="JP":GOSUB 5800:AD$=NN$:GOTO 5370


4690 IF N%<>211 THEN 4710


4700 INST$="OUT":GOSUB 5840:AD$="("+NN$+"),A":GOTO 5370


4710 IF N%<>219 THEN 4730


4720 INST$="IN":GOSUB 5840:AD$="A,("+NN$+")":GOTO 5370


4730 IF N%=227 THEN INST$="EX":AD$="(SP),"+HL$:GOTO 5370


4740 IF N%=235 THEN INST$="EX":AD$="DE,"+HL$:GOTO 5370


4750 IF N%=243 THEN INST$="DI":GOTO 5370


4760 INST$="EI":GOTO 5370


4770 '


4780 '***"CB" INSTRUCTIONS


4790 GOSUB 5840:AD$=R$(X%)


4800 IF N%<64 THEN INST$=CB$(Y%):GOTO 4830


4810 AD$=A$(Y%)+","+AD$:IF N%<128 THEN INST$="BIT":GOTO 5370


4820 IF N%<192 THEN INST$="RES":ELSE INST$="SET"


4830 IF XY<>1 OR X%=6 THEN 5370


4840 INST$=INST$+"LD":AD$=R$(X%)+","+A$(Y%)+","+R$(6)


4850 GOTO 5370


4860 '


4870 '***SOME 'DD ED' ARE UNDOCUMENTED INSTRUCTIONS--


4880 '   TRY THEM BEFORE YOU TRUST THEM ON YOUR Z-80


4890 '***"ED" INSTRUCTIONS


4900 GOSUB 5840


4910 '***Eliminate IN/OUT (HL), other illegal instructions


4920 IF N%<64 OR N%=112 OR N%=113 OR N%>187 THEN 5330


4930 IF N%<124 THEN 4960


4940 IF N%>159 THEN 5250


4950 GOTO 5330


4960 IF X%=0 THEN INST$="IN":AD$=R$(Y%)+",(C)":GOTO 5370


4970 IF X%=1 THEN INST$="OUT":AD$="(C),"+R$(Y%):GOTO 5370


4980 IF IL%<>2 THEN 5000


4990 INST$="SBC":AD$="HL,"+RR$(IH%-4):GOTO 5370


5000 IF IL%<>10 THEN 5030


5010 INST$="ADC":AD$="HL,"+RR$(IH%-4):GOTO 5370


5020 '***REDUNDANCY WITH 22H, 2AH IS ILLEGAL


5030 IF N%=99 OR N%=107 THEN 5330


5040 IF IL%<>3 THEN 5070


5050 INST$="LD":Y%=IH%-4:GOSUB 5800:AD$="("+NN$+"),"+RR$(Y%)


5060 GOTO 5370


5070 IF IL%<>11 THEN 5110


5080 INST$="LD":Y%=IH%-4:GOSUB 5800


5090 AD$=RR$(Y%)+",("+NN$+")":GOTO 5370


5100 '***ONE OF A KIND INSTRUCTIONS


5110 IF N%=68 THEN INST$="NEG":GOTO 5370


5120 IF N%=69 THEN INST$="RETN":GOTO 5370


5130 IF N%=77 THEN INST$="RETI":GOTO 5370


5140 IF N%=70 THEN INST$="IM":AD$="0":GOTO 5370


5150 IF N%=86 THEN INST$="IM":AD$="1":GOTO 5370


5160 IF N%=94 THEN INST$="IM":AD$="2":GOTO 5370


5170 IF N%=71 THEN INST$="LD":AD$="I,A":GOTO 5370


5180 IF N%=79 THEN INST$="LD":AD$="R,A":GOTO 5370


5190 IF N%=95 THEN INST$="LD":AD$="A,R":GOTO 5370


5200 IF N%=103 THEN INST$="RRD":GOTO 5370


5210 IF N%=111 THEN INST$="RLD":GOTO 5370


5220 GOTO 5330'***ALL OTHERS ARE ILLEGAL


5230 '


5240 '***BLOCK MOVE AND INPUT/OUTPUT INSTRUCTIONS


5250 IF X%>3 OR Y%<4 THEN 5330'***ONLY 16 IMPLEMENTED


5260 INST$=ED$(X%):IF N%<164 THEN INST$=INST$+"I":GOTO 5370


5270 IF N%<176 THEN INST$=INST$+"D":GOTO 5370


5280 '


5290 '***SPECIAL CASES; OTIR FOR OUTIR, OTDR FOR OUTDR


5300 IF X%=3 THEN INST$="OT"


5310 IF N%<180 THEN INST$=INST$+"IR":GOTO 5370


5320 INST$=INST$+"DR":GOTO 5370


5330 INST$="***":GOSUB 6280


5340 '


5350 '***OUTPUT ROUTINE***'


5360 '***Screen output


5370 PRINT LO$;" ";FNW$(HX$,9);T$;SY$;T$;INST$;T$;AD$;


5372 IF INST$="DEFM" THEN PRINT ELSE PRINT TAB(48)AS$


5380 '***Printer output


5390 IF XS%=1 THEN RETURN


5400 IF PR%=0 THEN 5420


5410 LPRINT LO$;" ";FNW$(HX$,9);T$;SY$;T$;INST$;T$;AD$;


5412 IF INST$="DEFM" THEN LPRINT ELSE LPRINT TAB(48)AS$


5420 IF DK%=0 OR INST$="" THEN RETURN


5430 '***DISK OUTPUT


5440 L$="":IF IA%=2 OR IA%=3 THEN 5520


5450 '***EDAS/EDASM line number format


5460 LNE%=LNE%+10:L0%=INT(LNE%/10000):LX%=LNE%-L0%*10000


5470 L1%=INT(LX%/1000):LX%=LX%-L1%*1000


5480 L2%=INT(LX%/100):LX%=LX%-L2%*100


5490 L3%=INT(LX%/10):L4%=LX%-L3%*10


5500 L$=CHR$(176+L0%)+CHR$(176+L1%)+CHR$(176+L2%)


5510 L$=L$+CHR$(176+L3%)+CHR$(176+L4%)+T$


5520 L$=L$+SY$+T$+INST$+T$+AD$


5530 PRINT# 2,L$:RETURN


5540 RETURN


5550 '


5560 '***UTILITY SUBROUTINES***'


5570 '***Check and set 2nd pass disassembler options


5580 IF OPT$="1" THEN SSOPT%=1


5590 IF OPT$="4" THEN SSOPT%=2


5600 IF OPT$="2" THEN DAOPT%=2


5610 IF OPT$="5" THEN DAOPT%=1


5620 IF OPT$="3" THEN DAOPT%=3


5630 IF OPT$="6" THEN DAOPT%=4


5640 '***Single-step always when DEFM, DEFW, or DEFB


5650 IF DAOPT%>1 THEN SSOPT%=1


5660 RETURN


5670 '***Break up N% into HEX and OCTAL digits


5680 X%=N% AND SEV%:Y%=.125*(N% AND FSX%):Z%=(N% AND HOD%)/64


5690 IL%=N% AND FTEEN%:IH%=INT(.0625*N%):RETURN


5700 '***CONVERT BINARY TO ASCII


5710 '   (ILLEGAL CHARACTERS ARE TRANSLATED TO ".")


5720 IF N%>31 AND N%<127 THEN CH$=CHR$(N%):ELSE CH$="."


5730 AS$=AS$+CH$:RETURN


5740 '***CORRECT SYNTAX IN 8-BIT ADD,


5750 '   ADC, AND SBC ADDRESS FIELDS


5760 IF Y%=0 OR Y%=1 OR Y%=3 THEN AD$="A,"+AD$


5770 RETURN


5780 '***FETCH AND DECODE IMMEDIATE DATA OR ADDRESS


5790 '***NN$=TWO BYTE QUANTITY***


5800 GOSUB 6070:GOSUB 5720:Q1$=FNH1$(N%)


5810 GOSUB 6070:GOSUB 5720:Q2$=FNH1$(N%)


5820 NN$=Q2$+Q1$:HX$=HX$+Q1$+Q2$:GOTO 5920


5830 '***NN$=one byte quantity***


5840 GOSUB 6070:GOSUB 5720:GOSUB 5680


5850 Q1$=FNH1$(N%):HX$=HX$+Q1$


5860 IF IJR=0 THEN NN$=Q1$:GOSUB 5940:RETURN


5870 '***Subroutine to compute addresses


5880 '   from offset for JR instructions


5890 IO=N%:IF IO>127 THEN IO=IO-BY!


5900 IO=I+IO+1:NN$=FNH2$(IO)


5910 '***Complete the hex notation in EDTASM format


5920 IF XS%=2 THEN NN$="X"+NN$:RETURN


5930 '***Enter here for standard HEX notation


5940 NN$=NN$+"H":IF ASC(NN$)>A9 THEN NN$="0"+NN$


5950 RETURN


5960 '


5970 '***SUBROUTINE TO FETCH NEW BYTES***


5980 ' I=Memory pointer, I%=Sector pointer, IX=Top of buffer


5990 ' N%=Output byte from memory or disk file


6000 ' DM%=1 for Memory, DM%=2 for Disk disassembles


6010 ' I0=Memory pointer for loader block


6020 ' OFF=Offset of I from I%


6030 ' LC=Pointer to buffer 1


6040 '***ENTER HERE for simple disk fetches


6050 I%=I%+1:GOTO 6240


6060 '***ENTER HERE for subsequent byte fetches


6070 I=I+1


6080 '***ENTER HERE for first byte of disassemble


6090 IF DM%=1 THEN N%=PEEK(I):RETURN


6100 IF I<=IX THEN GOTO 6230


6110 '***End of data record during multiple byte


6120 '   instruction--error if not an allowed case


6130 '***Begin new data record--type MUST be 1 or 16


6140 GOSUB 6050:TYPE=N%:IF N%=1 OR N%=16 THEN 6160


6150 GOTO 6280


6160 GOSUB 6050:JN=N%-2:IF JN<1 THEN JN=JN+256


6170 '***Disk reads include offset from disk buffer


6180 '   to loader target locations in address


6190 '   & location fields


6200 GOSUB 6050:I0=N%:GOSUB 6050:I0=I0+BY!*N%


6210 OFF=I0-I%-1:IX=I0+JN-1


6220 '***COMPUTES I% FROM I, IF NECESSARY


6230 I%=I-OFF


6240 IF I% > 256 THEN GET #1 : OFF = OFF + 256 : I% = 1


6250 N%=PEEK(I%-1+LC):RETURN


6260 '


6270 '***Error routine


6280 N%=0:I=I-1


6290 PRINT "Disassembler ERROR at ";FNH2$(I);


6300 PRINT"--ASCII or address data?"


6310 FOR LOOP = 1 TO 5 : PRINT CHR$(7) : NEXT


6320 RETURN


6330 '


6340 '***Output of address table


6350 NS%=IS%:PRINT NS%;"Symbols.  Output symbol table..."


6360 IF TLOW<0 THEN TLOW=TLOW+MX!


6370 IF THI<0 THEN THI=THI+MX!


6380 LO$="":HX$="":INST$="EQU":AS$=""


6390 '***Oput low EQUs


6400 FOR IS%=1 TO NS%:TEST=FNAD(S%(IS%))


6410 IF TEST>=TLOW THEN 6480


6420 NN$=FNH2$(S%(IS%)):SY$="X"+NN$:GOSUB 5940:AD$=NN$


6430 GOSUB 5370


6440 NEXT IS%


6450 '


6460 '***Output high EQUs


6470 '***Use SP% in assigning symbol fields in 2nd pass


6480 SP%=IS%:IF NS%=0 THEN IS%=0:GOTO 6570


6490 FOR IS%=SP% TO NS%:TEST=FNAD(S%(IS%))


6500 IF TEST>THI THEN 6520


6510 NEXT IS%:RETURN


6520 FOR JS%=IS% TO NS%


6530 NN$=FNH2$(S%(JS%)):SY$="X"+NN$:GOSUB 5940:AD$=NN$


6540 GOSUB 5370


6550 NEXT JS%:PRINT SP%-1;" Low EQUs,";NS%-IS%+1;


6560 PRINT" High EQUs,";IS%-SP%;" Program symbols."


6570 NS%=IS%:RETURN










>>Download of 685 lines: Complete.





ACTION> (Ne