diff --git a/6502/C64/src/vf-c16+jsr.fth b/6502/C64/src/vf-c16+jsr.fth new file mode 100644 index 0000000..64c4270 --- /dev/null +++ b/6502/C64/src/vf-c16+jsr.fth @@ -0,0 +1,18 @@ + +\ *** Block No. 8, Hexblock 8 +8 fthpage + +\ ram rom jsr NormJsr f.C16+ clv12.4.87) + +Assembler also definitions + +\ C16+Macros for Bankswitching + +: ram $ff3f sta ; : rom $ff3e sta ; + +' Jsr Alias NormJsr Defer Jsr + +: C16+Jsr dup $c000 u> + IF rom NormJsr ram ELSE NormJsr THEN ; + +' C16+Jsr Is Jsr diff --git a/6502/C64/src/vf-c16-32k.fth b/6502/C64/src/vf-c16-32k.fth index e88907b..a8aab2d 100644 --- a/6502/C64/src/vf-c16-32k.fth +++ b/6502/C64/src/vf-c16-32k.fth @@ -4,7 +4,6 @@ hex \ load transient part of target compiler 2 drive 27 30 thru -1 drive Onlyforth hex @@ -28,7 +27,7 @@ include vf-pr-target.fth \ The actual volksForth sources include vf-sys-indep.fth -$7E $93 thru \ CBM-Interface +include vf-sys-c16.fth include vf-finalize.fth include vf-pr-target.fth diff --git a/6502/C64/src/vf-c16-main.fth b/6502/C64/src/vf-c16-main.fth index 8345f7d..679a75c 100644 --- a/6502/C64/src/vf-c16-main.fth +++ b/6502/C64/src/vf-c16-main.fth @@ -4,7 +4,6 @@ hex \ load transient part of target compiler 2 drive 27 30 thru -1 drive Onlyforth hex @@ -27,15 +26,11 @@ cr .( Host is: ) include vf-pr-target.fth \ The actual volksForth sources -\ including some initial C16 tweaks - -Assembler also definitions -\needs C16+Jsr 8 load -' C16+Jsr Is Jsr +\ including an initial C16+ tweak +include vf-c16+jsr.fth include vf-sys-indep.fth -$7E $93 thru \ CBM-Interface -(c16+ $94 load ) \ c16init RamIRQ +include vf-sys-c16.fth include vf-finalize.fth include vf-pr-target.fth diff --git a/6502/C64/src/vf-sys-c16.fth b/6502/C64/src/vf-sys-c16.fth new file mode 100644 index 0000000..7b3e2a1 --- /dev/null +++ b/6502/C64/src/vf-sys-c16.fth @@ -0,0 +1,481 @@ + +\ *** Block No. 126, Hexblock 7e +7e fthpage + +\ CBM-Labels 05nov87re + +$FFA5 >label ACPTR +$FFC6 >label CHKIN +$FFC9 >label CHKOUT +$FFD2 >label CHROUT +$FF81 >label CINT +$FFA8 >label CIOUT +$FFC3 >label CLOSE +$FFCC >label CLRCHN +$FFE4 >label GETIN +$FF84 >label IOINIT +$FFB1 >label LISTEN +$FFC0 >label OPEN +$FFF0 >label PLOT +$FF8A >label RESTOR +$FF93 >label SECOND +$FFE1 >label STOP +$FFB4 >label TALK +$FF96 >label TKSA +$FFEA >label UDTIM +$FFAE >label UNLSN +$FFAB >label UNTLK +$FFCF >label CHRIN +$FF99 >label MEMTOP + +\ *** Block No. 128, Hexblock 80 +80 fthpage + +\ C16-Labels clv13.4.87) + +0ff4c >label ConOut + 09a >label MsgFlg + 099 >label OutDev + 098 >label InDev +0ff19 >label BrdCol +0ff15 >label BkgCol + 0540 >label PenCol + 09d >label PrgEnd + 0b2 >label IOBeg + 0cb >label CurFlg + 0cf >label InsCnt + 0540 >label KeyRep + + 055d >label PKeys + + +\ *** Block No. 129, Hexblock 81 +81 fthpage + +\ C16 c64key? getkey + +Code c64key? ( -- flag) + 0ef lda 055d ora + 0<> ?[ 0FF # lda ]? pha + Push jmp end-code + +Code getkey ( -- 8b) + 0ebdd jsr + 0A0 # cmp 0= ?[ bl # lda ]? + Push0A jmp end-code + + +\ *** Block No. 130, Hexblock 82 +82 fthpage + +\ C16 curon curoff + +Code curon \ -- +0ca lda clc 0c8 adc 0ff0d sta +0c9 lda 0 # adc 0b # sbc 0ff0c sta +next jmp end-code + +Code curoff \ -- +0ff # lda ff0c sta 0ff0d sta Next jmp +end-code + + +\ *** Block No. 131, Hexblock 83 +83 fthpage + +( #bs #cr ..keyboard clv12.4.87) + +: c64key ( -- 8b) + curon BEGIN pause c64key? UNTIL + curoff getkey ; + +14 Constant #bs 0D Constant #cr + +: c64decode + ( addr cnt1 key -- addr cnt2) + #bs case? IF dup IF del 1- THEN + exit THEN + #cr case? IF dup span ! exit THEN + >r 2dup + r@ swap c! r> emit 1+ ; + +: c64expect ( addr len1 -- ) + span ! 0 + BEGIN dup span @ u< + WHILE key decode + REPEAT 2drop space ; + +Input: keyboard [ here input ! ] + c64key c64key? c64decode c64expect ; + + +\ *** Block No. 132, Hexblock 84 +84 fthpage + +( con! printable? clv11.4.87) + +Code con! ( 8b --) SP X) lda +Label (con! ConOut jsr SP 2inc +Label (con!end CurFlg stx InsCnt stx + 1 # ldy ;c: pause ; + +Label (printable? \ for CBM-Code ! + \ CS is printable + 80 # cmp CC ?[ bl # cmp rts ]? + 0E0 # cmp CC ?[ 0C0 # cmp rts ]? + clc rts end-code + +Code printable? ( 8b -- 8b flag) + SP X) lda (printable? jsr CS ?[ dex ]? + txa PushA jmp end-code + + +\ *** Block No. 133, Hexblock 85 +85 fthpage + +( emit cr del page at at? clv11.4.87) + +Code c64emit ( 8b -- ) + SP X) lda (printable? jsr + CC ?[ Ascii . # lda ]? + (con! jmp end-code + +: c64cr #cr con! ; + +: c64del 9D con! space 9D con! ; + +: c64page 93 con! ; + +Code c64at ( row col --) + 2 # lda Setup jsr + N 2+ ldx N ldy clc PLOT jsr +(C16 \ ) 0D3 ldy 0D1 )Y lda 0CE sta + xyNext jmp end-code + +Code c64at? ( -- row col) + SP 2dec txa SP )Y sta + sec PLOT jsr + 28 # cpy tya CS ?[ 28 # sbc ]? + pha txa 0 # ldx SP X) sta pla + Push0A jmp end-code + + +\ *** Block No. 134, Hexblock 86 +86 fthpage + +( type display (bye clv11.4.87) + +Code c64type ( adr len -- ) + 2 # lda Setup jsr 0 # ldy + [[ N cpy 0<> + ?[[ N 2+ )Y lda (printable? jsr + CC ?[ Ascii . # lda ]? + ConOut jsr iny ]]? + (con!end jmp end-code + +Output: display [ here output ! ] + c64emit c64cr c64type c64del c64page + c64at c64at? ; + +(C64 | Create (bye $FCE2 here 2- ! ) + +(C16- | Create (bye $FF52 here 2- ! ) + +(C16+ | CODE (bye rom $FF52 jmp end-code ) + + +\ *** Block No. 135, Hexblock 87 +87 fthpage + +\ b/blk drive >drive drvinit clv14:2x87 + +400 Constant b/blk + +0AA Constant blk/drv + +Variable (drv 0 (drv ! + +| : disk ( -- dev.no ) (drv @ 8 + ; + +: drive ( drv# -- ) + blk/drv * offset ! ; + +: >drive ( block drv# -- block' ) + blk/drv * + offset @ - ; + +: drv? ( block -- drv# ) + offset @ + blk/drv / ; + +: drvinit noop ; + + +\ *** Block No. 136, Hexblock 88 +88 fthpage + +( i/o busoff 10may85we) + +Variable i/o 0 i/o ! \ Semaphore + +Code busoff ( --) CLRCHN jsr +Label unlocki/o 1 # ldy 0 # ldx + ;c: i/o unlock ; + +Label nodevice 0 # ldx 1 # ldy + ;c: busoff buffers unlock + true Abort" no device" ; + + +\ *** Block No. 137, Hexblock 89 +89 fthpage + +\ ?device clv12jul87 + +Label (?dev + 90 stx (C16 $ae sta ( ) LISTEN jsr + \ because of error in OS + 60 # lda SECOND jsr UNLSN jsr + 90 lda 0<> ?[ pla pla nodevice jmp ]? + rts end-code + + Code (?device ( dev --) + SP X) lda (?dev jsr SP 2inc + unlocki/o jmp end-code + +: ?device ( dev -- ) + i/o lock (?device ; + + Code (busout ( dev 2nd -- ) + MsgFlg stx 2 # lda Setup jsr + N 2+ lda (?dev jsr + N 2+ lda LISTEN jsr + N lda 60 # ora SECOND jsr + N 2+ ldx OutDev stx + xyNext jmp end-code + + +\ *** Block No. 138, Hexblock 8a +8a fthpage + +\ busout/open/close/in clv12jul87 + +: busout ( dev 2nd -- ) + i/o lock (busout ; + +: busopen ( dev 2nd -- ) + 0F0 or busout ; + +: busclose ( dev 2nd -- ) + 0E0 or busout busoff ; + + Code (busin ( dev 2nd -- ) + MsgFlg stx 2 # lda Setup jsr + N 2+ lda (?dev jsr + N 2+ lda TALK jsr + N lda 60 # ora (C16 $ad sta ( ) + TKSA jsr +\ because of error in old C16 OS + N 2+ ldx InDev stx + xyNext jmp end-code + +: busin ( dev 2nd -- ) + i/o lock (busin ; + + +\ *** Block No. 139, Hexblock 8b +8b fthpage + +( bus-!/type/@/input derror? 24feb85re) + +Code bus! ( 8b --) + SP X) lda CIOUT jsr (xydrop jmp + end-code + +: bustype ( adr n --) + bounds ?DO I c@ bus! LOOP pause ; + +Code bus@ ( -- 8b) + ACPTR jsr Push0A jmp end-code + +: businput ( adr n --) + bounds ?DO bus@ I c! LOOP pause ; + +: derror? ( -- flag ) + disk $F busin bus@ dup Ascii 0 - + IF BEGIN emit bus@ dup #cr = UNTIL + 0= cr THEN 0= busoff ; + + +\ *** Block No. 140, Hexblock 8c +8c fthpage + +( s#>s+t x,x 28may85re) + +165 | Constant 1.t +1EA | Constant 2.t +256 | Constant 3.t + +| : (s#>s+t ( sector# -- sect track) + dup 1.t u< IF 15 /mod exit THEN + 3 + dup 2.t u< IF 1.t - 13 /mod 11 + + exit THEN + dup 3.t u< IF 2.t - 12 /mod 18 + + exit THEN + 3.t - 11 /mod 1E + ; + +| : s#>t+s ( sector# -- track sect ) + (s#>s+t 1+ swap ; + +| : x,x ( sect track -- adr count) + base push decimal + 0 <# #s drop Ascii , hold #s #> ; + + +\ *** Block No. 141, Hexblock 8d +8d fthpage + +( readsector writesector 28may85re) + +100 | Constant b/sek + +: readsector ( adr tra# sect# -- flag) + disk 0F busout + " u1:13,0," count bustype + x,x bustype busoff pause + derror? ?exit + disk 0D busin b/sek businput busoff + false ; + +: writesector ( adr tra# sect# -- flag) + rot disk 0F busout + " b-p:13,0" count bustype busoff + disk 0D busout b/sek bustype busoff + disk 0F busout + " u2:13,0," count bustype + x,x bustype busoff pause derror? ; + + +\ *** Block No. 142, Hexblock 8e +8e fthpage + +( 1541r/w 28may85re) + +: diskopen ( -- flag) + disk 0D busopen Ascii # bus! busoff + derror? ; + +: diskclose ( -- ) + disk 0D busclose busoff ; + +: 1541r/w ( adr blk file r/wf -- flag) + swap Abort" no file" + -rot blk/drv /mod dup (drv ! 3 u> + IF . ." beyond capacity" nip exit THEN + diskopen IF drop nip exit THEN + 0 swap 2* 2* 4 bounds + DO drop 2dup I rot + IF s#>t+s readsector + ELSE s#>t+s writesector THEN + >r b/sek + r> dup IF LEAVE THEN + LOOP -rot 2drop diskclose ; + +' 1541r/w Is r/w + + +\ *** Block No. 143, Hexblock 8f +8f fthpage + +\ index findex ink-pot 05nov87re + +: index ( from to --) + 1+ swap DO + cr I 2 .r I block 1+ 25 type + stop? IF LEAVE THEN LOOP ; + +: findex ( from to --) + diskopen IF 2drop exit THEN + 1+ swap DO cr I 2 .r + pad dup I 2* 2* s#>t+s readsector + >r 1+ 25 type + r> stop? or IF LEAVE THEN + LOOP diskclose ; + +Create ink-pot + \ border bkgnd pen 0 +(C64 6 c, 6 c, 3 c, 0 c, ) \ Forth +(C64 0E c, 6 c, 3 c, 0 c, ) \ Edi +(C64 6 c, 6 c, 3 c, 0 c, ) \ User +(C16 f6 c, 0f6 c, 03 c, 0 c, ) \ Forth +(C16 0eE c, 0f6 c, 03 c, 0 c, ) \ Edi +(C16 0f6 c, 0f6 c, 03 c, 0 c, ) \ User + + +\ *** Block No. 146, Hexblock 92 +92 fthpage + +\ C16:Init 01oct87clv/re) + +Code init-system $F7 # ldx txs + xyNext jmp end-code + +$fcb3 >label IRQ \ normal IRQ +$fffe >label >IRQ \ 6502-Ptr to IRQ + +\ selfmodifying code: +Label RAMIRQ \ the new IRQ + rom RAMIRQ $15 + sta RAMIRQ $17 + stx +( +9) RAMIRQ $1b + $100 u/mod # lda pha + # lda pha +( +f) tsx $103 ,x lda pha \ flags +( +14) 0 # lda 0 # ldx IRQ jmp +( +1b) ram rti end-code + + +\ *** Block No. 147, Hexblock 93 +93 fthpage + +\ C16:..Init 01oct87clv/re) + +Label first-init + \ will be called in ROM first time + \ later called from RAM + sei rom + RAMIRQ $100 u/mod \ new IRQ + # lda >IRQ 1+ sta \ .. install + # lda >IRQ sta + $FF84 normJsr $FF8A normJsr + \ CIAs init. and set I/O-Vectors + ink-pot lda BrdCol sta \ border + ink-pot 1+ lda BkgCol sta \ backgrnd + ink-pot 2+ lda PenCol sta \ pen + $80 # lda KeyRep sta \ repeat all keys + $FF13 lda 04 # ora $FF13 sta \ low/upp + ram cli rts end-code + +first-init dup bootsystem 1+ ! + warmboot 1+ ! + +Code c64init first-init jsr + xyNext jmp end-code + + +\ *** Block No. 148, Hexblock 94 +94 fthpage + +\ C16-Pushkeys C64-like 01oct87clv/re) + +Label InitPKs \ Pushkeys: Daten +00 c, 00 c, \ curr. numb Char, currPtr +01 c, 01 c, 01 c, 01 c, \ StrLength +01 c, 01 c, 01 c, 01 c, \ " + +85 c, 86 c, 87 c, 89 c, \ Content +8a c, 8b c, 8c c, 88 c, \ " + + +here InitPKs - >label InitPKlen + + +Code C64fkeys \ Pushkeys a la C64 + InitPKlen # ldx + [[ dex 0>= ?[[ + InitPKs ,X lda PKeys ,x sta ]]? + xyNext jmp end-code diff --git a/6502/C64/src/vf-sys-c64.fth b/6502/C64/src/vf-sys-c64.fth index 15881f8..b5daecc 100644 --- a/6502/C64/src/vf-sys-c64.fth +++ b/6502/C64/src/vf-sys-c64.fth @@ -414,7 +414,7 @@ Create ink-pot \ *** Block No. 144, Hexblock 90 90 fthpage -\ restore 05nov87re +\ C64 restore Label asave 0 c, Label 1save 0 c,