VolksForth/sources/cpm/DISASS.FB.src

307 lines
20 KiB
Plaintext
Raw Normal View History

2020-06-20 16:59:14 +00:00
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 ;