From 50289572c8f4d8b72625296fc4888a60114fb342 Mon Sep 17 00:00:00 2001 From: Philip Zembrod Date: Tue, 11 Aug 2020 00:16:04 +0200 Subject: [PATCH] Initial checkin of tracer and 6502 assembler fth files as copied from converted disk image vforth4_3.fth --- 6502/C64/src/6502asm.fth | 222 +++++++++++++++++++++++++++++++ 6502/C64/src/rom-ram-sys.fth | 51 ++++++++ 6502/C64/src/tracer.fth | 244 +++++++++++++++++++++++++++++++++++ 6502/C64/src/trns6502asm.fth | 15 +++ 4 files changed, 532 insertions(+) create mode 100644 6502/C64/src/6502asm.fth create mode 100644 6502/C64/src/rom-ram-sys.fth create mode 100644 6502/C64/src/tracer.fth create mode 100644 6502/C64/src/trns6502asm.fth diff --git a/6502/C64/src/6502asm.fth b/6502/C64/src/6502asm.fth new file mode 100644 index 0000000..0368aba --- /dev/null +++ b/6502/C64/src/6502asm.fth @@ -0,0 +1,222 @@ +\ *** Block No. 5, Hexblock 5 + +\ Forth-6502 Assembler clv10oct87 + +\ Basis: Forth Dimensions VOL III No. 5) + +Onlyforth Assembler also definitions + +1 7 +thru + -3 +load \ Makros: rom ram sys + +Onlyforth + + + + + + + + + + + + + + + + +\ *** 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 ; diff --git a/6502/C64/src/rom-ram-sys.fth b/6502/C64/src/rom-ram-sys.fth new file mode 100644 index 0000000..b6f8e2d --- /dev/null +++ b/6502/C64/src/rom-ram-sys.fth @@ -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 ; diff --git a/6502/C64/src/tracer.fth b/6502/C64/src/tracer.fth new file mode 100644 index 0000000..e446c7e --- /dev/null +++ b/6502/C64/src/tracer.fth @@ -0,0 +1,244 @@ +\ *** Block No. 47, Hexblock 2f + +\ tracer: loadscreen cas16aug06 + +Onlyforth + +\needs Code -$2B +load \ Trans Assembler + +\needs Tools Vocabulary Tools + +Tools also definitions + + 1 6 +thru \ Tracer + 7 8 +thru \ Tools for decompiling + +Onlyforth + +\\ + +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 +| 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> off dup ! ; + + + + + + +\ *** 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 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 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--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 + off ; \ clears trap range + +: endloop last' @ 4 + 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 ) +( - - - - - - ) diff --git a/6502/C64/src/trns6502asm.fth b/6502/C64/src/trns6502asm.fth new file mode 100644 index 0000000..6ebce53 --- /dev/null +++ b/6502/C64/src/trns6502asm.fth @@ -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 ! + + 1 +load + +dp ! + +Onlyforth