mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-26 02:49:17 +00:00
307 lines
20 KiB
Plaintext
307 lines
20 KiB
Plaintext
|
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 ;
|