mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-09 13:29:33 +00:00
358 lines
22 KiB
Forth
358 lines
22 KiB
Forth
\ *** Block No. 0 Hexblock 0
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
\ *** Block No. 1 Hexblock 1
|
|
\ 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
|
|
|
|
|
|
|
|
|
|
\ *** Block No. 2 Hexblock 2
|
|
\ 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 ;
|
|
|
|
|
|
\ *** Block No. 3 Hexblock 3
|
|
\ 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 ;
|
|
\ *** Block No. 4 Hexblock 4
|
|
\ 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> ;
|
|
|
|
\ *** Block No. 5 Hexblock 5
|
|
\ 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 ;
|
|
\ *** Block No. 6 Hexblock 6
|
|
\ 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 ;
|
|
\ *** Block No. 7 Hexblock 7
|
|
\ 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 ;
|
|
\ *** Block No. 8 Hexblock 8
|
|
\ 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 ;
|
|
|
|
|
|
|
|
|
|
\ *** Block No. 9 Hexblock 9
|
|
\ 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 ;
|
|
\ *** Block No. 10 Hexblock A
|
|
\ 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 ;
|
|
\ *** Block No. 11 Hexblock B
|
|
\ 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 ;
|
|
\ *** Block No. 12 Hexblock C
|
|
\ 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 ;
|
|
\ *** Block No. 13 Hexblock D
|
|
\ 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"
|
|
\ *** Block No. 14 Hexblock E
|
|
\ 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 ;
|
|
|
|
\ *** Block No. 15 Hexblock F
|
|
\ 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 ;
|
|
\ *** Block No. 16 Hexblock 10
|
|
\ 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
|
|
\ *** Block No. 17 Hexblock 11
|
|
\ 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
|
|
|
|
\ *** Block No. 18 Hexblock 12
|
|
\ 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 !
|
|
\ *** Block No. 19 Hexblock 13
|
|
\ 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 ;
|
|
|
|
|
|
\ *** Block No. 20 Hexblock 14
|
|
\ 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 ;
|
|
|