mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-10-07 10:57:32 +00:00
Merge pull request #23 from pzembrod/master
Make C64/C16 tracer and 6502 assembler available as separate .fth files
This commit is contained in:
commit
8d1016d373
183
6502/C64/src/6502asm.fth
Normal file
183
6502/C64/src/6502asm.fth
Normal file
@ -0,0 +1,183 @@
|
|||||||
|
\ *** Block No. 5, Hexblock 5
|
||||||
|
|
||||||
|
\ Forth-6502 Assembler clv10oct87
|
||||||
|
|
||||||
|
\ Basis: Forth Dimensions VOL III No. 5)
|
||||||
|
|
||||||
|
Onlyforth Assembler also definitions
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 6, Hexblock 6
|
||||||
|
|
||||||
|
\ Forth-83 6502-Assembler 20oct87re
|
||||||
|
|
||||||
|
: end-code context 2- @ context ! ;
|
||||||
|
|
||||||
|
Create index
|
||||||
|
$0909 , $1505 , $0115 , $8011 ,
|
||||||
|
$8009 , $1D0D , $8019 , $8080 ,
|
||||||
|
$0080 , $1404 , $8014 , $8080 ,
|
||||||
|
$8080 , $1C0C , $801C , $2C80 ,
|
||||||
|
|
||||||
|
| Variable mode
|
||||||
|
|
||||||
|
: Mode: ( n -) Create c,
|
||||||
|
Does> ( -) c@ mode ! ;
|
||||||
|
|
||||||
|
0 Mode: .A 1 Mode: #
|
||||||
|
2 | Mode: mem 3 Mode: ,X
|
||||||
|
4 Mode: ,Y 5 Mode: X)
|
||||||
|
6 Mode: )Y $F Mode: )
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 7, Hexblock 7
|
||||||
|
|
||||||
|
\ upmode cpu 20oct87re
|
||||||
|
|
||||||
|
| : upmode ( addr0 f0 - addr1 f1)
|
||||||
|
IF mode @ 8 or mode ! THEN
|
||||||
|
1 mode @ $F and ?dup IF
|
||||||
|
0 DO dup + LOOP THEN
|
||||||
|
over 1+ @ and 0= ;
|
||||||
|
|
||||||
|
: cpu ( 8b -) Create c,
|
||||||
|
Does> ( -) c@ c, mem ;
|
||||||
|
|
||||||
|
00 cpu brk $18 cpu clc $D8 cpu cld
|
||||||
|
$58 cpu cli $B8 cpu clv $CA cpu dex
|
||||||
|
$88 cpu dey $E8 cpu inx $C8 cpu iny
|
||||||
|
$EA cpu nop $48 cpu pha $08 cpu php
|
||||||
|
$68 cpu pla $28 cpu plp $40 cpu rti
|
||||||
|
$60 cpu rts $38 cpu sec $F8 cpu sed
|
||||||
|
$78 cpu sei $AA cpu tax $A8 cpu tay
|
||||||
|
$BA cpu tsx $8A cpu txa $9A cpu txs
|
||||||
|
$98 cpu tya
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 8, Hexblock 8
|
||||||
|
|
||||||
|
\ m/cpu 20oct87re
|
||||||
|
|
||||||
|
: m/cpu ( mode opcode -) Create c, ,
|
||||||
|
Does>
|
||||||
|
dup 1+ @ $80 and IF $10 mode +! THEN
|
||||||
|
over $FF00 and upmode upmode
|
||||||
|
IF mem true Abort" invalid" THEN
|
||||||
|
c@ mode @ index + c@ + c, mode @ 7 and
|
||||||
|
IF mode @ $F and 7 <
|
||||||
|
IF c, ELSE , THEN THEN mem ;
|
||||||
|
|
||||||
|
$1C6E $60 m/cpu adc $1C6E $20 m/cpu and
|
||||||
|
$1C6E $C0 m/cpu cmp $1C6E $40 m/cpu eor
|
||||||
|
$1C6E $A0 m/cpu lda $1C6E $00 m/cpu ora
|
||||||
|
$1C6E $E0 m/cpu sbc $1C6C $80 m/cpu sta
|
||||||
|
$0D0D $01 m/cpu asl $0C0C $C1 m/cpu dec
|
||||||
|
$0C0C $E1 m/cpu inc $0D0D $41 m/cpu lsr
|
||||||
|
$0D0D $21 m/cpu rol $0D0D $61 m/cpu ror
|
||||||
|
$0414 $81 m/cpu stx $0486 $E0 m/cpu cpx
|
||||||
|
$0486 $C0 m/cpu cpy $1496 $A2 m/cpu ldx
|
||||||
|
$0C8E $A0 m/cpu ldy $048C $80 m/cpu sty
|
||||||
|
$0480 $14 m/cpu jsr $8480 $40 m/cpu jmp
|
||||||
|
$0484 $20 m/cpu bit
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 9, Hexblock 9
|
||||||
|
|
||||||
|
\ Assembler conditionals 20oct87re
|
||||||
|
|
||||||
|
| : range? ( branch -- branch )
|
||||||
|
dup abs $7F u> Abort" out of range " ;
|
||||||
|
|
||||||
|
: [[ ( BEGIN) here ;
|
||||||
|
|
||||||
|
: ?] ( UNTIL) c, here 1+ - range? c, ;
|
||||||
|
|
||||||
|
: ?[ ( IF) c, here 0 c, ;
|
||||||
|
|
||||||
|
: ?[[ ( WHILE) ?[ swap ;
|
||||||
|
|
||||||
|
: ]? ( THEN) here over c@ IF swap !
|
||||||
|
ELSE over 1+ - range? swap c! THEN ;
|
||||||
|
|
||||||
|
: ][ ( ELSE) here 1+ 1 jmp
|
||||||
|
swap here over 1+ - range? swap c! ;
|
||||||
|
|
||||||
|
: ]] ( AGAIN) jmp ;
|
||||||
|
|
||||||
|
: ]]? ( REPEAT) jmp ]? ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 10, Hexblock a
|
||||||
|
|
||||||
|
\ Assembler conditionals 20oct87re
|
||||||
|
|
||||||
|
$90 Constant CS $B0 Constant CC
|
||||||
|
$D0 Constant 0= $F0 Constant 0<>
|
||||||
|
$10 Constant 0< $30 Constant 0>=
|
||||||
|
$50 Constant VS $70 Constant VC
|
||||||
|
|
||||||
|
: not $20 [ Forth ] xor ;
|
||||||
|
|
||||||
|
: beq 0<> ?] ; : bmi 0>= ?] ;
|
||||||
|
: bne 0= ?] ; : bpl 0< ?] ;
|
||||||
|
: bcc CS ?] ; : bvc VS ?] ;
|
||||||
|
: bcs CC ?] ; : bvs VC ?] ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 11, Hexblock b
|
||||||
|
|
||||||
|
\ 2inc/2dec winc/wdec 20oct87re
|
||||||
|
|
||||||
|
: 2inc ( adr -- )
|
||||||
|
dup lda clc 2 # adc
|
||||||
|
dup sta CS ?[ swap 1+ inc ]? ;
|
||||||
|
|
||||||
|
: 2dec ( adr -- )
|
||||||
|
dup lda sec 2 # sbc
|
||||||
|
dup sta CC ?[ swap 1+ dec ]? ;
|
||||||
|
|
||||||
|
: winc ( adr -- )
|
||||||
|
dup inc 0= ?[ swap 1+ inc ]? ;
|
||||||
|
|
||||||
|
: wdec ( adr -- )
|
||||||
|
dup lda 0= ?[ over 1+ dec ]? dec ;
|
||||||
|
|
||||||
|
: ;c:
|
||||||
|
recover jsr end-code ] 0 last ! 0 ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 12, Hexblock c
|
||||||
|
|
||||||
|
\ ;code Code code> bp/re03feb85
|
||||||
|
|
||||||
|
Onlyforth
|
||||||
|
|
||||||
|
: Assembler
|
||||||
|
Assembler [ Assembler ] mem ;
|
||||||
|
|
||||||
|
: ;Code
|
||||||
|
[compile] Does> -3 allot
|
||||||
|
[compile] ; -2 allot Assembler ;
|
||||||
|
immediate
|
||||||
|
|
||||||
|
: Code Create here dup 2- ! Assembler ;
|
||||||
|
|
||||||
|
: >label ( adr -)
|
||||||
|
here | Create immediate swap ,
|
||||||
|
4 hallot heap 1 and hallot ( 6502-alig)
|
||||||
|
here 4 - heap 4 cmove
|
||||||
|
heap last @ count $1F and + ! dp !
|
||||||
|
Does> ( - adr) @
|
||||||
|
state @ IF [compile] Literal THEN ;
|
||||||
|
|
||||||
|
: Label
|
||||||
|
[ Assembler ] here >label Assembler ;
|
||||||
|
|
||||||
|
\ TODO(pzembrod): enable once rom-ram-sys.fth works with include
|
||||||
|
\ include rom-ram-sys.fth \ Makros: rom ram sys
|
||||||
|
|
||||||
|
Onlyforth
|
51
6502/C64/src/rom-ram-sys.fth
Normal file
51
6502/C64/src/rom-ram-sys.fth
Normal file
@ -0,0 +1,51 @@
|
|||||||
|
\ *** Block No. 2, Hexblock 2
|
||||||
|
|
||||||
|
\ rom ram sys cas16aug06
|
||||||
|
\ Shadow with Ctrl+W--->
|
||||||
|
|
||||||
|
\ needed for jumps
|
||||||
|
\ in the ROM Area
|
||||||
|
|
||||||
|
Assembler also definitions
|
||||||
|
(16 \ Switch Bank 8000-FFFF
|
||||||
|
: rom here 9 + $8000 u> abort" not here"
|
||||||
|
$ff3e sta ;
|
||||||
|
: ram $ff3f sta ;
|
||||||
|
: sys rom jsr ram ;
|
||||||
|
\ if suffering from abort" not here"
|
||||||
|
\ see next screen Screen --> C)
|
||||||
|
|
||||||
|
|
||||||
|
(64 \ Switch Bank A000-BFFF
|
||||||
|
: rom here 9 + $A000 u> abort" not here"
|
||||||
|
$37 # lda 1 sta ;
|
||||||
|
: ram $36 # lda 1 sta ;
|
||||||
|
C)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 3, Hexblock 3
|
||||||
|
|
||||||
|
\ sysMacro Long cas16aug06
|
||||||
|
|
||||||
|
(64 .( not for C64 !) \\ C)
|
||||||
|
|
||||||
|
\ for advanced users, use macros
|
||||||
|
|
||||||
|
here $8000 $20 - u> ?exit \ not possible
|
||||||
|
|
||||||
|
|
||||||
|
' 0 | Alias ???
|
||||||
|
|
||||||
|
Label long ROM
|
||||||
|
Label long1 ??? jsr RAM rts end-code
|
||||||
|
|
||||||
|
| : sysMacro ( adr -- )
|
||||||
|
$100 u/mod pha # lda long1 2+ sta
|
||||||
|
# lda long1 1+ sta pla long jsr ;
|
||||||
|
|
||||||
|
: sys ( adr -- ) \ for Jsr to ROM
|
||||||
|
here 9 + $8000 u>
|
||||||
|
IF sysMacro ELSE sys THEN ;
|
214
6502/C64/src/tracer.fth
Normal file
214
6502/C64/src/tracer.fth
Normal file
@ -0,0 +1,214 @@
|
|||||||
|
\ *** Block No. 47, Hexblock 2f
|
||||||
|
|
||||||
|
\ tracer: loadscreen cas16aug06
|
||||||
|
|
||||||
|
Onlyforth
|
||||||
|
|
||||||
|
\needs Code include trns6502asm.fth
|
||||||
|
|
||||||
|
\needs Tools Vocabulary Tools
|
||||||
|
|
||||||
|
Tools also definitions
|
||||||
|
|
||||||
|
\ This nice Forth Tracer has been
|
||||||
|
\ developed by B. Pennemann and co
|
||||||
|
\ for Atari ST. CL Vogt has ported it
|
||||||
|
\ back to the volksForth 6502 C-16 and
|
||||||
|
\ C-64
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 48, Hexblock 30
|
||||||
|
|
||||||
|
\ tracer: wcmp variables clv04aug87
|
||||||
|
|
||||||
|
Assembler also definitions
|
||||||
|
|
||||||
|
: wcmp ( adr1 adr2--) \ Assembler-Macro
|
||||||
|
over lda dup cmp swap \ compares word
|
||||||
|
1+ lda 1+ sbc ;
|
||||||
|
|
||||||
|
|
||||||
|
Only Forth also Tools also definitions
|
||||||
|
|
||||||
|
| Variable (W
|
||||||
|
| Variable <ip | Variable ip>
|
||||||
|
| Variable nest? | Variable trap?
|
||||||
|
| Variable last' | Variable #spaces
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 49, Hexblock 31
|
||||||
|
|
||||||
|
\ tracer:cpush oneline cas16aug06
|
||||||
|
|
||||||
|
| Create cpull 0 ]
|
||||||
|
rp@ count 2dup + rp! r> swap cmove ;
|
||||||
|
|
||||||
|
: cpush ( addr len -)
|
||||||
|
r> -rot over >r
|
||||||
|
rp@ over 1+ - dup rp! place
|
||||||
|
cpull >r >r ;
|
||||||
|
|
||||||
|
| : oneline &82 allot keyboard display
|
||||||
|
.status space query interpret
|
||||||
|
-&82 allot rdrop
|
||||||
|
( delete quit from tnext ) ;
|
||||||
|
|
||||||
|
: range ( adr--) \ gets <ip ip>
|
||||||
|
ip> off dup <ip !
|
||||||
|
BEGIN 1+ dup @
|
||||||
|
[ Forth ] ['] unnest = UNTIL
|
||||||
|
3+ ip> ! ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 50, Hexblock 32
|
||||||
|
|
||||||
|
\ tracer:step tnext clv04aug87
|
||||||
|
|
||||||
|
| Code step
|
||||||
|
$ff # lda trap? sta trap? 1+ sta
|
||||||
|
RP X) lda IP sta
|
||||||
|
RP )Y lda IP 1+ sta RP 2inc
|
||||||
|
(W lda W sta (W 1+ lda W 1+ sta
|
||||||
|
Label W1- W 1- jmp end-code
|
||||||
|
|
||||||
|
| Create: nextstep step ;
|
||||||
|
|
||||||
|
Label tnext IP 2inc
|
||||||
|
trap? lda W1- beq
|
||||||
|
nest? lda 0= \ low(!)Byte test
|
||||||
|
?[ IP <ip wcmp W1- bcc
|
||||||
|
IP ip> wcmp W1- bcs
|
||||||
|
][ nest? stx \ low(!)Byte clear
|
||||||
|
]?
|
||||||
|
trap? dup stx 1+ stx \ disable tracer
|
||||||
|
W lda (W sta W 1+ lda (W 1+ sta
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 51, Hexblock 33
|
||||||
|
|
||||||
|
\ tracer:..tnext clv12oct87
|
||||||
|
|
||||||
|
;c: nest? @
|
||||||
|
IF nest? off r> ip> push <ip push
|
||||||
|
dup 2- range
|
||||||
|
#spaces push 1 #spaces +! >r THEN
|
||||||
|
r@ nextstep >r
|
||||||
|
input push output push
|
||||||
|
2- dup last' !
|
||||||
|
cr #spaces @ spaces
|
||||||
|
dup 4 u.r @ dup 5 u.r space
|
||||||
|
>name .name $10 col - 0 max spaces .s
|
||||||
|
state push blk push >in push
|
||||||
|
[ ' 'quit >body ] Literal push
|
||||||
|
[ ' >interpret >body ] Literal push
|
||||||
|
#tib push tib #tib @ cpush r0 push
|
||||||
|
rp@ r0 !
|
||||||
|
['] oneline Is 'quit quit ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 52, Hexblock 34
|
||||||
|
|
||||||
|
\ tracer:do-trace traceable cas16aug06
|
||||||
|
|
||||||
|
| Code do-trace \ installs TNEXT
|
||||||
|
tnext 0 $100 m/mod
|
||||||
|
# lda Next $c + sta
|
||||||
|
# lda Next $b + sta
|
||||||
|
$4C # lda Next $a + sta Next jmp
|
||||||
|
end-code
|
||||||
|
|
||||||
|
| : traceable ( cfa--<IP ) recursive
|
||||||
|
dup @
|
||||||
|
['] : @ case? IF >body exit THEN
|
||||||
|
['] key @ case? IF >body c@ Input @ +
|
||||||
|
@ traceable exit THEN
|
||||||
|
['] type @ case? IF >body c@ Output @ +
|
||||||
|
@ traceable exit THEN
|
||||||
|
['] r/w @ case? IF >body
|
||||||
|
@ traceable exit THEN
|
||||||
|
@ [ ' Forth @ @ ] Literal =
|
||||||
|
IF @ 3 + exit THEN
|
||||||
|
\ for defining words with DOES>
|
||||||
|
>name .name ." can't be DEBUGged"
|
||||||
|
quit ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 53, Hexblock 35
|
||||||
|
|
||||||
|
\ tracer:User-Words cas16aug06
|
||||||
|
|
||||||
|
: nest \ trace into current word
|
||||||
|
last' @ @ traceable drop nest? on ;
|
||||||
|
|
||||||
|
: unnest \ proceeds at calling word
|
||||||
|
<ip on ip> off ; \ clears trap range
|
||||||
|
|
||||||
|
: endloop last' @ 4 + <ip ! ;
|
||||||
|
\ no trace of next word to skip LOOP..
|
||||||
|
|
||||||
|
' end-trace Alias unbug \ cont. execut.
|
||||||
|
|
||||||
|
: (debug ( cfa-- )
|
||||||
|
traceable range
|
||||||
|
nest? off trap? on #spaces off
|
||||||
|
Tools do-trace ;
|
||||||
|
|
||||||
|
Forth definitions
|
||||||
|
|
||||||
|
: debug ' (debug ; \ word follows
|
||||||
|
|
||||||
|
: trace' \ word follows
|
||||||
|
' dup (debug execute end-trace ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 54, Hexblock 36
|
||||||
|
|
||||||
|
\ tools for decompiling, clv12oct87
|
||||||
|
|
||||||
|
( interactive use )
|
||||||
|
|
||||||
|
Onlyforth Tools also definitions
|
||||||
|
|
||||||
|
| : ?: ?cr dup 4 u.r ." :" ;
|
||||||
|
| : @? dup @ 6 u.r ;
|
||||||
|
| : c? dup c@ 3 .r ;
|
||||||
|
| : bl $24 col - 0 max spaces ;
|
||||||
|
|
||||||
|
: s ( adr - adr+)
|
||||||
|
( print literal string)
|
||||||
|
?: space c? 4 spaces dup count type
|
||||||
|
dup c@ + 1+ bl ; ( count + re)
|
||||||
|
|
||||||
|
: n ( adr - adr+2)
|
||||||
|
( print name of next word by its cfa)
|
||||||
|
?: @? 2 spaces
|
||||||
|
dup @ >name .name 2+ bl ;
|
||||||
|
|
||||||
|
: k ( adr - adr+2)
|
||||||
|
( print literal value)
|
||||||
|
?: @? 2+ bl ;
|
||||||
|
|
||||||
|
|
||||||
|
\ *** Block No. 55, Hexblock 37
|
||||||
|
|
||||||
|
( tools for decompiling, interactive )
|
||||||
|
|
||||||
|
: d ( adr n - adr+n) ( dump n bytes)
|
||||||
|
2dup swap ?: 3 spaces swap 0
|
||||||
|
DO c? 1+ LOOP
|
||||||
|
4 spaces -rot type bl ;
|
||||||
|
|
||||||
|
: c ( adr - adr+1)
|
||||||
|
( print byte as unsigned value)
|
||||||
|
1 d ;
|
||||||
|
|
||||||
|
: b ( adr - adr+2)
|
||||||
|
( print branch target location )
|
||||||
|
?: @? dup @ over + 6 u.r 2+ bl ;
|
||||||
|
|
||||||
|
( used for : )
|
||||||
|
( Name String Literal Dump Clit Branch )
|
||||||
|
( - - - - - - )
|
||||||
|
|
||||||
|
|
||||||
|
Onlyforth
|
15
6502/C64/src/trns6502asm.fth
Normal file
15
6502/C64/src/trns6502asm.fth
Normal file
@ -0,0 +1,15 @@
|
|||||||
|
\ *** Block No. 4, Hexblock 4
|
||||||
|
|
||||||
|
\ transient Assembler clv10oct87
|
||||||
|
|
||||||
|
\ Basis: Forth Dimensions VOL III No. 5)
|
||||||
|
|
||||||
|
\ internal loading 04may85BP/re)
|
||||||
|
|
||||||
|
here $800 hallot heap dp !
|
||||||
|
|
||||||
|
include 6502asm.fth
|
||||||
|
|
||||||
|
dp !
|
||||||
|
|
||||||
|
Onlyforth
|
Loading…
Reference in New Issue
Block a user