1 line
18 KiB
Plaintext
1 line
18 KiB
Plaintext
\\ Z80-Disassembler 08Nov86 Dieses File enthaelt einen Z80-Disassembler, der assemblierten Code in Standard Zilog-Z80 Mnemonics umsetzt. Benutzung: TOOLS ALSO \ Schalte Disassembler-Vokabular an addr DIS \ Disassembliere ab Adresse addr xxxx displace ! \ Beruecksichte bei allen Adressen einen \ Versatz von xxxx. \ Wird gebraucht, wenn ein Assemblerstueck \ nicht an dem Platz disassembliert wird, \ an dem es ablaeuft. \ Z80-Disassembler Load Screen 08Nov86 Onlyforth Tools also definitions hex ' Forth | Alias F: immediate ' Tools | Alias T: immediate 1 $10 +THRU cr .( Disassembler geladen. ) cr OnlyForth \\ Fragen Anregungen & Kritik an: U. Hoffmann Harmsstrasse 71 2300 Kiel 1 \ Speicherzugriff und Ausgabe 07Jul86internal \needs Case: : Case: Create: Does> swap 2* + perform ; Variable index Variable address Variable offset Variable oldoutput external Variable displace displace off internal ' pad Alias str1 ( -- addr ) : str2 ( -- addr ) str1 $40 + ; : byte ( -- b ) address @ displace @ + c@ ; : word ( -- w ) address @ displace @ + @ ; : .byte ( byte -- ) 0 <# # #s #> type ; : .word ( addr -- ) 0 <# # # # #s #> type ; \ neue Bytes lesen Byte-Fraktionen 07Jul86 : next-byte output push oldoutput @ output ! byte .byte space 1 address +! ; : next-word next-byte next-byte ; : f ( -- b ) byte $40 / ; : g ( -- b ) byte 8 / 7 and ; : h ( -- b ) byte 7 and ; : j ( -- b ) g 2/ ; : k ( -- b ) g 1 and ; \\ 76543210 ffggghhh jjk \ Select" 08Nov86 : scan/ ( limit start -- limit start' ) over swap DO I c@ Ascii / = IF I F: ENDLOOP T: exit THEN LOOP dup ; : select ( n addr len -- addr' len' ) bounds rot 0 ?DO scan/ 1+ 2dup < IF 2drop " -" count ENDLOOP exit THEN LOOP under scan/ nip over - ; : (select" ( n -- ) "lit count select type ; : select" ( -- ) compile (select" ," ; immediate : append ( c str -- ) under count + c! dup c@ 1+ swap c! ; \ StringOutput 07Jul86 Variable $ : $emit ( c -- ) $ @ append pause ; : $type ( adr len -- ) 0 ?DO count $emit LOOP drop ; : $cr ( -- ) $ @ off ; : $at? ( -- row col ) 0 $ @ c@ ; Output: $output $emit $cr $type noop $cr 2drop $at? ; \ Register 07Jul86 : reg ( n -- ) dup 5 = IF index @ negate index ! THEN select" B/C/D/E/H/L/$/A" ; : double-reg ( n -- ) select" BC/DE/%/SP" ; : double-reg2 ( n -- ) select" BC/DE/%/AF" ; : num ( n -- ) select" 0/1/2/3/4/5/6/7" ; : cond ( n -- ) select" nz/z/nc/c/po/pe/p/m" ; : arith ( n -- ) select" add A,/adc A,/sub /sbc A,/and /xor /or /cp " ; \ no-prefix Einteilung der Befehle in Klassen 07Jul86 : 00xxx000 g dup 3 > IF ." jr " 4- cond ." ,?" exit THEN select" nop/ex AF,AF'/djnz ?/jr ?" ; : 00xxx001 k IF ." add %," j double-reg exit THEN ." ld " j double-reg ." ,&" ; : 00xxx010 ." ld " g select" (BC),A/A,(BC)/(DE),A/A,(DE)/(&),%/%,(&)/(&),A/A,(&)" ; : 00xxx011 k IF ." dec " ELSE ." inc " THEN j double-reg ; \ no-prefix 07Jul86 : 00xxx100 ." inc " g reg ; : 00xxx101 ." dec " g reg ; : 00xxx110 ." ld " g reg ." ,#" ; : 00xxx111 g select" rlca/rrca/rla/rra/daa/cpl/scf/ccf" ; : 01xxxxxx ." ld " g reg ." ," h reg ; : 10xxxxxx g arith h reg ; \ no-prefix 07Jul86 : 11xxx000 ." ret " g cond ; : 11xxx001 k IF j select" ret/exx/jp (%)/ld sp,%" exit THEN ." pop " j double-reg2 ; : 11xxx010 ." JP " g cond ." ,&" ; : 11xxx011 g select" jp &/-/out (#),A/in a,(#)/ex (SP),%/ex DE,HL/di/ei" ; : 11xxx100 ." call " g cond ; : 11xxx101 k IF ." call &" exit THEN ." push " j double-reg2 ; : 11xxx110 g arith ." #" ; : 11xxx111 ." rst " g select" 00/08/10/18/20/28/30/38" ; \ no-prefix 07Jul86 Case: 00xxxhhh 00xxx000 00xxx001 00xxx010 00xxx011 00xxx100 00xxx101 00xxx110 00xxx111 ; Case: 11xxxhhh 11xxx000 11xxx001 11xxx010 11xxx011 11xxx100 11xxx101 11xxx110 11xxx111 ; : 00xxxxxx h 00xxxhhh ; : 11xxxxxx h 11xxxhhh ; Case: ffxxxxxx 00xxxxxx 01xxxxxx 10xxxxxx 11xxxxxx ; \ no-prefix 07Jul86 : get-offset index @ 0> IF byte offset ! next-byte THEN ; : no-prefix f ffxxxxxx next-byte get-offset ; \ CB-Prefix 07Jul86 : CB-00xxxxxx g select" rlc /rrc /rl /rr /sla /sra /-/srl " h reg ; : CB-01xxxxxx ." bit " g num ." ," h reg ; : CB-10xxxxxx ." res " g num ." ," h reg ; : CB-11xxxxxx ." set " g num ." ," h reg ; case: singlebit CB-00xxxxxx CB-01xxxxxx CB-10xxxxxx CB-11xxxxxx ; : CB-prefix get-offset f singlebit next-byte ; \ ED-Prefix 30Sep86: ED-01xxx000 ." in (C)," g reg ; : ED-01xxx001 ." out (C)," g reg ; : ED-01xxx010 k IF ." adc " ELSE ." sbc " THEN ." HL," j double-reg ; : ED-01xxx011 ." ld " k IF j double-reg ." ,(&)" exit THEN ." (&)," j double-reg ; : ED-01xxx100 ." neg" ; : ED-01xxx101 k IF ." reti" exit THEN ." retn" ; : ED-01xxx110 g select" im 0/-/im 1/im 2" ; : ED-01xxx111 g select" ld I,A/ld R,A/ld A,I/ld A,R/rrd/rld" ; : ED-10xxxxxx h select" ld/cp/in/ot" g 4- select" i/d/ir/dr" ; Case: ED-01xxxhhh ED-01xxx000 ED-01xxx001 ED-01xxx010 ED-01xxx011 ED-01xxx100 ED-01xxx101 ED-01xxx110 ED-01xxx111 ; : ED-01xxxxxx h ED-01xxxhhh ; \ ED-Prefix 07Jul86 Case: extended noop ED-01xxxxxx ED-10xxxxxx noop ; : ED-prefix get-offset f extended next-byte ; \ Disassassemblieren eines einzelnen Befehls 30Sep86 : index-register ( n -- ) index ! next-byte ; : get-instruction ( -- ) index off str1 $ ! cr byte $DD = IF 1 index-register ELSE byte $FD = IF 2 index-register THEN THEN byte $76 case? IF next-byte ." halt" exit THEN $CB case? IF next-byte CB-prefix exit THEN $ED case? IF next-byte ED-prefix exit THEN drop no-prefix ; \ Adressierungsarten ausgeben 07Jul86 27Nov87: .index-register ( -- ) index @ abs select" HL/IX/IY" ; : offset-sign ( o -- o' ) dup $7F > IF $100 - THEN ; : +- ( s -- ) 0< IF Ascii - ELSE Ascii + THEN hold ; : .offset ( -- ) offset @ offset-sign extend under dabs <# # #s rot +- #> type ; : .index-register-offset index @ abs dup select" (HL)/(IX/(IY" IF .offset ." )" THEN ; : .inline-byte ( -- ) byte .byte next-byte ; : .inline-word ( -- ) word .word next-word ; : .displace ( -- ) byte offset-sign address @ + 1+ .word next-byte ; \ Hauptebene: dis 07Jul86: .char ( c -- ) Ascii % case? IF .index-register exit THEN Ascii $ case? IF .index-register-offset exit THEN Ascii # case? IF .inline-byte exit THEN Ascii & case? IF .inline-word exit THEN Ascii ? case? IF .displace exit THEN emit ; : instruction ( -- ) cr address @ .word 2 spaces output @ oldoutput ! $output get-instruction str2 $ ! cr str1 count 0 ?DO count .char LOOP drop oldoutput @ output ! $20 col - 0 max spaces str2 count type ; external : dis ( addr -- ) address ! BEGIN instruction stop? UNTIL ; |