VolksForth/sources/AtariST/DISASS.FB.src

358 lines
23 KiB
Plaintext
Raw Normal View History

2020-06-20 16:59:55 +00:00
Screen 0 not modified
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Screen 1 not modified
0 \ 68000 Disassembler loadscreen 05dec86we
1
2 Onlyforth
3
4 \needs >absaddr : >absaddr 0 forthstart d+ ;
5 \needs Code .( Load assemble.scr first) abort
6
7 1 ?head ! \ alle Disassembler-Worte headerless
8 1 $12 +thru
9
10 0 ?head !
11 $13 +load \ Benutzer-Worte mit Header
12
13
14
15
Screen 2 not modified
0 \ long words and presigns 14oct86we
1
2 : l+ ( n -- ) extend d+ ;
3 : l- ( n -- ) extend d- ;
4 : l+! ( n addr -- ) >absaddr ln+! ;
5
6 : .# Ascii # emit ;
7 : .$ Ascii $ emit ;
8 : ., Ascii , emit ;
9 : .- Ascii - emit ;
10 : .. Ascii . emit ;
11
12 : .0r ( n width --) over abs swap
13 <# 0 DO # LOOP swap sign #> type space ;
14
15
Screen 3 not modified
0 \ signed / unsigned byte, word and long output 28jan86ma
1
2 : .lformat ( laddr --) <# #s #> dup 8 swap - spaces type ;
3
4 : .lu ( d -- ) <# #s #> type ;
5 : .$lu ( d -- ) .$ .lu ;
6
7 : .wo ( n -- ) 0 <# # # # # #> type ;
8 : .$wu ( n -- ) .$ .wo ;
9 : .$ws ( n -- ) dup $7FFF u>
10 IF .- 1.0000 rot d- THEN .$ .wo ;
11 : .by ( 8b -- ) 0 <# # # #> type ;
12 : .$bu ( 8b -- ) .$ .by ;
13 : .$bs ( 8b -- ) $FF and dup $7F >
14 IF .- 100 swap - THEN .$ .by ;
15 : .lb ( hi lo len -- ) bounds ?DO I over lc@ .by LOOP ;
Screen 4 not modified
0 \ Variables and tabs 18jan86ma
1
2 2Variable addr 2Variable dispaddr 2Variable saveaddr
3 Variable opcode Variable mne Variable mode
4 Variable reg Variable length Variable sr
5 Variable predec
6
7 &10 constant bytfld : tab row swap at ;
8 &32 constant mnefld
9 &40 constant adrfld : tab1 row adrfld at ;
10
11 : getword
12 addr 2@ 2 l+ 2dup addr 2! l@ ;
13 : getlong
14 addr 2@ 4 l+ 2dup addr 2! 2dup 2 l- l@ >r l@ r> ;
15
Screen 5 not modified
0 \ print registernumber, dump 18jan86ma
1
2 : .reg ( n -- ) 7 and Ascii 0 + emit ;
3 : .(areg) ( n -- ) Ascii A emit .reg ;
4 : .(dreg) ( n -- ) Ascii D emit .reg ;
5
6 : .areg reg @ .(areg) ;
7 : .dreg reg @ .(dreg) ;
8
9 : .aind Ascii ( emit .areg Ascii ) emit ;
10 : .apost .aind Ascii + emit ;
11 : .apre .- .aind ;
12
13 : dumpws getword .$ws ;
14 : dumpw getword .$wu ;
15 : dumpl getlong .$lu ;
Screen 6 not modified
0 \ print length , bitmasking 04mar86we
1
2 : len. length @
3 0 case? IF ." .b" tab1 exit THEN
4 1 case? IF ." .w" tab1 exit THEN
5 2 case? IF ." .l" tab1 exit THEN
6 tab1 drop ;
7
8 Code shift ( n -- ) SP )+ D0 move SP ) D1 move
9 D0 D1 lsr D1 SP ) move Next end-code
10 : 4shft 4 shift ; : 8shft 8 shift ;
11 : cshft $0C shift ;
12 : bitce $0C shift 7 and ; : bit5 5 shift 1 and ;
13 : bit6 6 shift 1 and ; : bit7 7 shift 1 and ;
14 : bit10 $0A shift 1 and ; : bit11 $0B shift 1 and ;
15 : bit8b 8 shift $0F and ;
Screen 7 not modified
0 \ bitmasking 2 28jan86ma
1
2 : bit02 7 and ; : bit8 8 shift 1 and ;
3 : bit35 3 shift 7 and ; : bit3 3 shift 1 and ;
4 : bit68 6 shift 7 and ; : bit9b 9 shift 7 and ;
5 : bit67 6 shift 3 and ; : bit37 3 shift $1F and ;
6
7 : len!. length ! len. ;
8 : length6 opcode @ bit6 1+ len!. ;
9 : length67 opcode @ bit67 len!. ;
10
11 : reg02! opcode @ bit02 reg ! ;
12 : reg9b! opcode @ bit9b reg ! ;
13
14 : bit9b. .# opcode @ bit9b dup 0=
15 IF drop 8 THEN .$bu ;
Screen 8 not modified
0 \ list register 26jan86ma
1
2 : reglist
3 getword 10 0 DO
4 dup 2/ swap 1 and
5 IF I predec @
6 IF $0F swap - THEN dup 7 >
7 IF .(areg) ELSE .(dreg) THEN dup
8 IF ." /" THEN
9 THEN LOOP drop ;
10
11 : mnext length6 reg02! .dreg ;
12
13
14
15
Screen 9 not modified
0 \ print adressing mode bp 28Aug86
1
2 : .a/pcreg mode @ 7 =
3 IF ." PC" ELSE .areg THEN ;
4 : l? ( ext.word -- ) $800 and IF ." .L" exit THEN ." .W" ;
5 : i8bit
6 getword dup .$bs
7 Ascii ( emit .a/pcreg ., dup $7FFF >
8 IF Ascii A emit ELSE Ascii D emit THEN
9 dup bitce .reg l? Ascii ) emit ;
10
11 : imm
12 .# length @
13 0 case? IF getword .$bu exit THEN
14 1 case? IF dumpw exit THEN
15 2 case? IF dumpl exit THEN drop ;
Screen 10 not modified
0 \ print adressing mode 28jan86ma
1
2 : mode7 reg @
3 0 case? IF dumpws exit THEN
4 1 case? IF dumpl exit THEN
5 2 case? IF dumpws ." (PC)" exit THEN
6 3 case? IF i8bit exit THEN
7 4 case? IF sr @ IF ." SR" ELSE imm THEN exit THEN
8 drop ." ???" ;
9
10 : effadr mode @
11 0 case? IF .dreg exit THEN 1 case? IF .areg exit THEN
12 2 case? IF .aind exit THEN 3 case? IF .apost exit THEN
13 4 case? IF .apre exit THEN 5 case? IF dumpws .aind exit THEN
14 6 case? IF i8bit exit THEN 7 case? IF mode7 exit THEN
15 drop ;
Screen 11 not modified
0 \ find register and mode 28jan86ma
1 : .ea opcode @ dup bit02 reg ! bit35 mode ! effadr ;
2 : .eadest opcode @ dup bit68 mode ! bit9b reg ! effadr ;
3 : mnabcd
4 tab1 opcode @ bit3
5 IF reg02! .apre ., reg9b! .apre
6 ELSE reg02! .dreg ., reg9b! .dreg THEN ;
7 : mnaddx length67 mnabcd ;
8 : mncmpm length67 reg02! .apost ., reg9b! .apost ;
9 : mnexg
10 tab1 reg9b! opcode @ bit37
11 dup 9 = IF .areg ELSE .dreg THEN ., reg02!
12 8 = IF .dreg ELSE .areg THEN ;
13 : mnadd length67 opcode @
14 bit8 IF reg9b! .dreg ., .ea
15 ELSE .ea ., reg9b! .dreg THEN ;
Screen 12 not modified
0 \ find register and mode 26jan86ma
1 : mnadda opcode @ bit8 1+ len!. .ea ., reg9b! .areg ;
2 : mnaddi length67 imm ., 1 sr ! .ea ;
3 : mnaddq length67 bit9b. ., .ea ;
4 : mnmoveq tab1 .# opcode @ .$bs ., reg9b! .dreg ;
5 : mnswap tab1 reg02! .dreg ;
6 : mnunlk tab1 reg02! .areg ;
7 : mnclr length67 .ea ;
8 : mnjmp tab1 .ea ;
9 : mnchk mnjmp ., reg9b! .dreg ;
10 : mnlea tab1 .ea ., reg9b! .areg ;
11 : mnbchg tab1 opcode @ bit8
12 IF reg9b! .dreg ELSE .# dumpw THEN ., .ea ;
13 : mnbchg2 tab1 reg9b! .dreg ., .ea ;
14 : .dir opcode @ bit8
15 IF Ascii l emit ELSE Ascii r emit THEN ;
Screen 13 not modified
0 \ find register and mode 23sep86we
1
2 : mnshft
3 .dir length67 opcode @ bit5
4 IF reg9b! .dreg ELSE bit9b. THEN ., reg02! .dreg ;
5 : mnshft2 .dir mnjmp ;
6 : reladr2
7 getword dup $7FFF >
8 IF 1.0000 rot d- THEN 2+ dispaddr 2@ rot l+ .$lu ;
9 : reladr
10 opcode @ $FF and ?dup
11 IF dup $7F > IF 100 - THEN 2+ dispaddr 2@ rot l+ .$lu
12 ELSE reladr2 THEN ;
13 : quote Create $22 word drop $22 allot Does> 1+ ;
14 quote ctbl0 t f hilscccsneeqvcvsplmigeltgtle"
15 quote ctbl1 rasrhilscccsneeqvcvsplmigeltgtle"
Screen 14 not modified
0 \ find register and mode 18jan86ma
1
2 : .cond ( ctblflag --> )
3 IF ctbl1 ELSE ctbl0 THEN
4 opcode @ bit8b 2* + 2 type tab1 ;
5 : mnscc 0 .cond .ea ;
6 : mnbcc 1 .cond reladr ;
7 : mndbcc 0 .cond reg02! .dreg ., reladr2 ;
8 : mnlink tab1 reg02! .areg ., .# dumpws ;
9 : mnmove
10 4 opcode @ bitce - dup 3 = IF drop 0 THEN
11 len!. .ea ., .eadest ;
12 : mnmoveccr mnjmp ." ,ccr" ;
13 : mnmovesr mnjmp ." ,sr" ;
14 : mnmovefsr tab1 ." sr," .ea ;
15
Screen 15 not modified
0 \ find register and mode 26jan86ma
1
2 : mnmoveusp tab1 reg02! opcode @ bit3
3 IF ." usp," .areg ELSE .areg ." ,usp" THEN ;
4 : mnmovem
5 length6 opcode @ dup bit35 4 = predec ! bit10
6 IF .ea ., reglist ELSE reglist ., .ea THEN ;
7 : mnmovep
8 length6 opcode @ bit7
9 IF reg9b! .dreg ., dumpws reg02! .aind
10 ELSE dumpws reg02! .aind ., reg9b! .dreg THEN ;
11 : mnstop tab1 .# dumpw ;
12 : mntrap tab1 .# opcode @ $0F and .$bu ;
13 : mnimp ;
14
15 : t, swap , , [compile] ' , bl word drop 8 allot ;
Screen 16 not modified
0 \ mask- and opcode-table 18jan86ma
1
2 Create mntbl base @ hex
3 ff00 0600 t, mnaddi addi ff00 0200 t, mnaddi andi
4 ff00 0c00 t, mnaddi cmpi ff00 0a00 t, mnaddi eori
5 ff00 0000 t, mnaddi ori ff00 0400 t, mnaddi subi
6 ffc0 0840 t, mnbchg bchg ffc0 0880 t, mnbchg bclr
7 ffc0 08c0 t, mnbchg bset ffc0 0800 t, mnbchg btst
8 e1c0 2040 t, mnmove movea c000 0000 t, mnmove move
9 ffff 4afc t, mnimp illegal ffff 4e71 t, mnimp nop
10 ffff 4e70 t, mnimp reset ffff 4e73 t, mnimp rte
11 ffff 4e77 t, mnimp rtr ffff 4e75 t, mnimp rts
12 ffff 4e76 t, mnimp trapv ffff 4e72 t, mnstop stop
13 fff0 4e40 t, mntrap trap fff8 4840 t, mnswap swap
14 fff8 4e58 t, mnunlk unlk fff8 4e50 t, mnlink link
15 ffb8 4880 t, mnext ext ffc0 44c0 t, mnmoveccr move
Screen 17 not modified
0 \ mask- and opcode-table 18jan86ma
1
2 ffc0 46c0 t, mnmovesr move ffc0 40c0 t, mnmovefsr move
3 fff0 4e60 t, mnmoveusp move ffc0 4ac0 t, mnjmp tas
4 ff00 4200 t, mnclr clr ff00 4400 t, mnclr neg
5 ff00 4000 t, mnclr negx ff00 4600 t, mnclr not
6 ff00 4a00 t, mnclr tst ffc0 4ec0 t, mnjmp jmp
7 ffc0 4e80 t, mnjmp jsr ffc0 4800 t, mnjmp nbcd
8 ffc0 4840 t, mnjmp pea f1c0 41c0 t, mnlea lea
9 f1c0 4180 t, mnchk chk fb80 4880 t, mnmovem movem
10 f0f8 50c8 t, mndbcc db f0c0 50c0 t, mnscc s
11 f100 5000 t, mnaddq addq f100 5100 t, mnaddq subq
12 f000 6000 t, mnbcc b f100 7000 t, mnmoveq moveq
13 f1f0 8100 t, mnabcd sbcd f1c0 81c0 t, mnchk divs
14 f1c0 80c0 t, mnchk divu f000 8000 t, mnadd or
15
Screen 18 not modified
0 \ mask- and opcode-table 18jan86ma
1
2 f0c0 90c0 t, mnadda suba f130 9100 t, mnaddx subx
3 f000 9000 t, mnadd sub f000 a000 t, mnimp ?ext0a
4 f0c0 b0c0 t, mnadda cmpa f138 b108 t, mncmpm cmpm
5 f100 b100 t, mnadd eor f100 b000 t, mnadd cmp
6 f1f0 c100 t, mnabcd abcd f1c0 c1c0 t, mnchk muls
7 f1c0 c0c0 t, mnchk mulu f130 c100 t, mnexg exg
8 f000 c000 t, mnadd and f0c0 d0c0 t, mnadda adda
9 f130 d100 t, mnaddx addx f000 d000 t, mnadd add
10 fec0 e0c0 t, mnshft2 as fec0 e2c0 t, mnshft2 ls
11 fec0 e4c0 t, mnshft2 rox fec0 e6c0 t, mnshft2 ro
12 f018 e000 t, mnshft as f018 e008 t, mnshft ls
13 f018 e010 t, mnshft rox f018 e018 t, mnshft ro
14 f000 f000 t, mnimp ?ext0f 0000 0000 t, mnimp ???
15 base !
Screen 19 not modified
0 \ search mne and dis a line 05dec86we
1
2 : searchmne ( -- )
3 mntbl 0 sr ! 0 predec !
4 BEGIN dup @ opcode @ and over 2+ @ =
5 IF dup 6 + count type 4+ @ execute exit THEN
6 $0E + REPEAT ;
7
8 : disline ( -- ) base push hex
9 cr dispaddr 2@ .lformat mnefld tab
10 addr 2@ 2dup saveaddr 2! l@ opcode !
11 searchmne 2 addr l+! bytfld tab
12 addr 2@ saveaddr 2@ d- drop dup >r dispaddr l+!
13 saveaddr 2@ swap r> .lb drop ;
14
15
Screen 20 not modified
0 \ addr! dis ldis disw 14oct86we
1
2 : addr! 2dup addr 2! dispaddr 2! ;
3
4 : disassline addr! disline ;
5
6 : ldis addr! BEGIN disline stop? UNTIL cr ;
7
8 : dis >absaddr ldis ;
9
10 : disw ' 2+ dup ." Adresse : " u. cr >absaddr addr!
11 BEGIN
12 BEGIN disline opcode @ $4EF3 = stop? or UNTIL
13 key $FF and #esc = UNTIL
14 cr ;
15