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