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