mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-14 16:29:26 +00:00
358 lines
23 KiB
Plaintext
358 lines
23 KiB
Plaintext
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
|