diff --git a/6502/C64/Makefile b/6502/C64/Makefile index 685cee4..f331e1b 100644 --- a/6502/C64/Makefile +++ b/6502/C64/Makefile @@ -24,7 +24,7 @@ update: $(vf_blk_fth_files) $(vf_fth_files_petscii) clean: - rm -f cbmfiles/*.fr cbmfiles/*.fth cbmfiles/*.log + rm -f cbmfiles/*.fr cbmfiles/*.fth cbmfiles/*.log tmp/* rm -f *.log *.result *.golden rm -f cbmfiles/c??-testbase rm -f disks/scratch.d64 emulator/sdcard.img @@ -58,7 +58,7 @@ run-testbase16: emulator/testbase16.T64 # Targetcompiler targets -cbmfiles/tcbase: emulator/c64-vf-390.T64 emulator/build-tcbase.sh \ +cbmfiles/tcbase: emulator/v4th-c64-4tc.T64 emulator/build-tcbase.sh \ disks/tc38q.d64 disks/file-words.d64 cbmfiles/tc-base.fth emulator/build-tcbase.sh @@ -132,7 +132,7 @@ test-v4th-c16-.log: emulator/v4th-c16-.T64 test-v4th-x16.log: cbmfiles/v4th-x16 emulator/sdcard.img rm -f cbmfiles/test.log emulator/run-in-x16emu.sh v4th-x16 \ - "INCLUDE RUN-STD-TESTS.FTH\\X0D1234567890\\X0D" + "include run-std-tests.fth\n1234567890\n" mcopy -i emulator/sdcard.img ::TEST.LOG cbmfiles/test.log petscii2ascii cbmfiles/test.log $@ diff --git a/6502/C64/cbmfiles/tcbase b/6502/C64/cbmfiles/tcbase index a243b0d..2fb47ad 100644 Binary files a/6502/C64/cbmfiles/tcbase and b/6502/C64/cbmfiles/tcbase differ diff --git a/6502/C64/cbmfiles/v4th-c16+ b/6502/C64/cbmfiles/v4th-c16+ index fd10bdb..e2eb33b 100644 Binary files a/6502/C64/cbmfiles/v4th-c16+ and b/6502/C64/cbmfiles/v4th-c16+ differ diff --git a/6502/C64/cbmfiles/v4th-c16- b/6502/C64/cbmfiles/v4th-c16- index 6ca1c4d..e0d236e 100644 Binary files a/6502/C64/cbmfiles/v4th-c16- and b/6502/C64/cbmfiles/v4th-c16- differ diff --git a/6502/C64/cbmfiles/v4th-c64 b/6502/C64/cbmfiles/v4th-c64 index ffa7748..c6f216a 100644 Binary files a/6502/C64/cbmfiles/v4th-c64 and b/6502/C64/cbmfiles/v4th-c64 differ diff --git a/6502/C64/cbmfiles/v4th-c64-4tc b/6502/C64/cbmfiles/v4th-c64-4tc new file mode 100644 index 0000000..e38a38e Binary files /dev/null and b/6502/C64/cbmfiles/v4th-c64-4tc differ diff --git a/6502/C64/cbmfiles/v4th-x16 b/6502/C64/cbmfiles/v4th-x16 index 72e70f0..3efa28c 100644 Binary files a/6502/C64/cbmfiles/v4th-x16 and b/6502/C64/cbmfiles/v4th-x16 differ diff --git a/6502/C64/cbmfiles/v4thblk-c16+ b/6502/C64/cbmfiles/v4thblk-c16+ index 3206c94..d153008 100644 Binary files a/6502/C64/cbmfiles/v4thblk-c16+ and b/6502/C64/cbmfiles/v4thblk-c16+ differ diff --git a/6502/C64/cbmfiles/v4thblk-c16- b/6502/C64/cbmfiles/v4thblk-c16- index 045df50..747d5f4 100644 Binary files a/6502/C64/cbmfiles/v4thblk-c16- and b/6502/C64/cbmfiles/v4thblk-c16- differ diff --git a/6502/C64/cbmfiles/v4thblk-c64 b/6502/C64/cbmfiles/v4thblk-c64 index 923d7bb..1255bda 100644 Binary files a/6502/C64/cbmfiles/v4thblk-c64 and b/6502/C64/cbmfiles/v4thblk-c64 differ diff --git a/6502/C64/emulator/build-tcbase.sh b/6502/C64/emulator/build-tcbase.sh index db3c513..3e65753 100755 --- a/6502/C64/emulator/build-tcbase.sh +++ b/6502/C64/emulator/build-tcbase.sh @@ -14,4 +14,4 @@ keybuf="3 drive 20 load\n3 drive 10 load\nsave\n\ savesystem tcbase\ndos s0:notdone\n" DISK10=tc38q DISK11=file-words "${emulatordir}/run-in-vice.sh" \ - "c64-vf-390" "${keybuf}" + "v4th-c64-4tc" "${keybuf}" diff --git a/6502/C64/emulator/run-in-x16emu.sh b/6502/C64/emulator/run-in-x16emu.sh index d228b37..ee7af5a 100755 --- a/6502/C64/emulator/run-in-x16emu.sh +++ b/6502/C64/emulator/run-in-x16emu.sh @@ -5,9 +5,10 @@ emulatordir="$(realpath --relative-to="$PWD" "$(dirname "${BASH_SOURCE[0]}")")" basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")" cbmfilesdir="${basedir}/cbmfiles" sdcard="${emulatordir}/sdcard.img" +x16script="${basedir}/tmp/x16script" mformat -i "${sdcard}" -F -for asciifile in $(cd "${cbmfilesdir}" && ls *.fth *fr) +for asciifile in $(cd "${cbmfilesdir}" && ls) do # Convert filename to PETSCII, remove trailing CR. petsciifile="$(echo ${asciifile} | ascii2petscii - |tr -d '\r')" @@ -20,13 +21,18 @@ then autostart="-prg ${cbmfilesdir}/${1} -run" fi -keybuf="" +script="" warp="" scale="" debug="" if [ -n "$2" ] then - keybuf="${2}" + test -d tmp || mkdir tmp + rm -f "${x16script}".* + echo "load\"${1}\"\nrun\n${2}" | sed 's/\\n/\n/g' > "${x16script}".ascii + ascii2petscii "${x16script}.ascii" "${x16script}.petscii" + script="-bas ${x16script}.petscii" + autostart="" mcopy -i "${sdcard}" "${emulatordir}/notdone" "::NOTDONE" warp="-warp" else @@ -39,13 +45,13 @@ x16emu \ -keymap de \ -sdcard "${sdcard}" \ $autostart \ - -keybuf "$keybuf" \ + $script \ $warp \ $scale \ $debug \ & -if [ -n "$keybuf" ] +if [ -n "$script" ] then while mtype -i "${sdcard}" "::NOTDONE" > /dev/null do sleep 1 diff --git a/6502/C64/emulator/update-v4th-4tc.sh b/6502/C64/emulator/update-v4th-4tc.sh new file mode 100755 index 0000000..557742c --- /dev/null +++ b/6502/C64/emulator/update-v4th-4tc.sh @@ -0,0 +1,15 @@ +#!/bin/bash +set -e + +# Script to update the base binary on which the target compiler +# is run. + +# The updating of v4th-c64-4tc from the newly built binaries +# is intentionally not automatically via Makefile, to ensure a +# certain stability for the target compiler. + +emulatordir="$(realpath --relative-to="$PWD" "$(dirname "${BASH_SOURCE[0]}")")" +basedir="$(realpath --relative-to="$PWD" "${emulatordir}/..")" +cbmfilesdir="${basedir}/cbmfiles" + +cp "${cbmfilesdir}/v4thblk-c64" "${cbmfilesdir}/v4th-c64-4tc" diff --git a/6502/C64/src/notmpheap.fth b/6502/C64/src/notmpheap.fth new file mode 100644 index 0000000..48c32d5 --- /dev/null +++ b/6502/C64/src/notmpheap.fth @@ -0,0 +1,11 @@ + +\ When no tmpheap mechanism is needed, i.e. all temporary names +\ of a project fit onto the regular heap at once, then this zero-cost +\ implementation can be used which directs all tmpheap definitions +\ to the regular heap. + +' | alias || +' |on alias ||on +' |off alias ||off + +' noop alias tmpclear diff --git a/6502/C64/src/tmpheap.fth b/6502/C64/src/tmpheap.fth new file mode 100644 index 0000000..4237e9c --- /dev/null +++ b/6502/C64/src/tmpheap.fth @@ -0,0 +1,59 @@ + +\ This is the reference implementation of tmpheap which allocates +\ the tmpheap on the regular heap and moves definitons prefixed +\ with || or within a ||on to ||off range onto the tmpheap. +\ tmpclear will remove all words on the tmpheap, wheras regular clear +\ will remove all words on tmpheap and heap together. + +\ Before the first use of ||, the tmpheap size in bytes must be +\ set with mk-tmp-heap ( size -- ) + +User tmpheap[ +User tmpheap> +User ]tmpheap + +: reset-tmp-heap ( -- ) + up@ dup ]tmpheap ! dup tmpheap> ! tmpheap[ ! ; + +reset-tmp-heap +' reset-tmp-heap is custom-remove + +: mk-tmp-heap ( size -- ) + heap dup ]tmpheap ! tmpheap> ! hallot heap tmpheap[ ! ; + +: tmp-hallot ( size -- addr ) + tmpheap> @ swap - + dup tmpheap[ @ u< abort" tmp heap overflow" + dup tmpheap> ! ; + +| : tmp-heapmove ( from from size -- from offset ) + dup tmp-hallot swap cmove + tmpheap> @ over - ; + +| : tmp-heapmove1x ( from size -- from offset ) + tmp-heapmove ?heapmovetx off ; + +: || ['] tmp-heapmove1x ?heapmovetx ! ; +: ||on ['] tmp-heapmove ?heapmovetx ! ; +: ||off ?heapmovetx off ; + + +| : remove-tmp-words-in-voc ( voc -- ) + BEGIN dup @ ?dup WHILE ( thread next-in-thread ) + dup tmpheap[ @ ]tmpheap @ uwithin IF ( thread next-in-thread ) + @ ?dup IF ( thread next-next-in-thread ) over ! + ELSE ( thread ) off exit THEN + ELSE ( thread next-in-thread ) nip + THEN + REPEAT drop ; + +| : remove-tmp-words ( -- ) + voc-link BEGIN @ ?dup + WHILE dup 4 - remove-tmp-words-in-voc REPEAT ; + +: tmpclear ( -- ) + remove-tmp-words + \ Uncomment the following line to help determine the ideal tmpheap + \ size for your project. + \ tmpheap> @ tmpheap[ @ - cr u. ." spare tmpheap bytes" + ]tmpheap @ tmpheap> ! last off ; diff --git a/6502/C64/src/vf-cbm-core.fth b/6502/C64/src/vf-cbm-core.fth index 77e7876..4120af0 100644 --- a/6502/C64/src/vf-cbm-core.fth +++ b/6502/C64/src/vf-cbm-core.fth @@ -7,7 +7,7 @@ (C64 02 ) (C16 02 ) -(X16 $30 ) +(X16 $50 ) dup >label RP 2+ dup >label UP 2+ @@ -1602,13 +1602,6 @@ Code clearstack : heap? ( addr -- flag) heap up@ uwithin ; -| : heapmove ( from -- from) - dup here over - - dup hallot heap swap cmove - heap over - last +! reveal ; - - - \ *** Block No. 74, Hexblock 4a 4a fthpage @@ -1642,7 +1635,7 @@ Label docreate \ *** Block No. 75, Hexblock 4b 4b fthpage -( 6502-align ?head | 08sep84bp) +( 6502-align 08sep84bp) | : 6502-align/1 ( adr -- adr' ) dup $FF and $FF = - ; @@ -1654,49 +1647,48 @@ Label docreate 1 last +! 1 allot THEN ; -Variable ?head 0 ?head ! - -: | ?head @ ?exit -1 ?head ! ; - - - - - - - - - - - \ *** Block No. 76, Hexblock 4c 4c fthpage -( warning Create 30dec84bp) +\ warning ?heapmovetx | |on |off Create Variable warning 0 warning ! -| : exists? +| : exists? ( -- ) warning @ ?exit last @ current @ (find nip IF space last @ .name ." exists " ?cr THEN ; +Variable ?heapmovetx 0 ?heapmovetx ! + +| : heapmove ( from size -- offset ) + over >r dup hallot ( from size ) heap swap cmove ( ) + heap r> - ; + +| : heapmove1x ( from size -- offset ) + heapmove ?heapmovetx off ; + +: | ['] heapmove1x ?heapmovetx ! ; +: |on ['] heapmove ?heapmovetx ! ; +: |off ?heapmovetx off ; + : Create - here blk @ , current @ @ , - name c@ dup 1 $20 - uwithin not Abort" invalid name" - here last ! 1+ allot - exists? ?head @ - IF 1 ?head +! dup 6502-align/1 , - \ Pointer to code - heapmove $20 flag! 6502-align/1 dp ! + here + blk @ , current @ @ , + name c@ + dup 1 $20 uwithin not Abort" invalid name" + here last ! 1+ allot exists? + ?heapmovetx @ + IF dup 6502-align/1 , \ Pointer to code + dup here over - + ?heapmovetx perform last +! + $20 flag! 6502-align/1 dp ! ELSE 6502-align/2 drop THEN reveal 0 , ;Code docreate jmp end-code - - \ *** Block No. 77, Hexblock 4d 4d fthpage @@ -1797,8 +1789,8 @@ Variable warning 0 warning ! : User Create 2 uallot c, ;Code SP 2dec 2 # ldy W )Y lda clc UP adc SP X) sta - txa iny UP 1+ adc 1 # ldy - SP )Y sta Next jmp end-code + dey txa UP 1+ adc SP )Y sta + Next jmp end-code : Alias ( cfa --) Create last @ dup c@ $20 and @@ -1818,6 +1810,13 @@ Variable warning 0 warning ! ( voc-link vp current context also bp) +\ vp contains the vocabulary search oder respectively stack. +\ vp/vp+1: order/stack size. 0 = one vocabulary on the stack +\ vp+2/vp+3: bottom vocabulary on the stack +\ ... +\ vp+N+2/vp+N+3: the current context vocabulary, the top of stack, +\ if N is the content of vp/vp+1. +\ The top two vocabularies are the same after also is called. Create vp $10 allot Variable current @@ -1961,6 +1960,8 @@ Label findloop 0 # ldy ( find ' ['] 13jan85bp) : find ( string -- cfa n / string false) + \ Skip the top vocabulary in the search order if it's equal to the + \ second in the search order, as is the case after also is called. context dup @ over 2- @ = IF 2- THEN BEGIN under @ (find IF nip found exit THEN @@ -2404,21 +2405,30 @@ Defer init-buffers ' noop IS init-buffers name> under 1+ u< swap heap? or ; | : endpoints ( addr -- addr symb) - heap voc-link >r - BEGIN r> @ ?dup \ through all Vocabs - WHILE dup >r 4 - >r \ link on returnst. - BEGIN r> @ >r over 1- dup r@ u< - \ until link or - swap r@ 2+ name> u< and - \ code under adr - WHILE r@ heap? [ 2dup ] UNTIL + \ heap is the starting value for symb + \ at the end symb is heap or 2 + the highest of all cfas that are + \ either in the heap or u> addr + heap voc-link >r ( addr symb / R: voc-link ) + BEGIN \ outer loop through all vocabs + r> @ ?dup ( addr symb / R: ) \ this is the word's exit point + WHILE dup >r 4 - >r ( addr symb / R: next-voc prev-lfa ) + BEGIN \ inner loop through all words of a vocab + r> @ >r ( R: prev-voc next-lfa ) + over 1- dup r@ u< + ( addr heap addr-1 flag:addr-1_u<_next-lfa_? ) + swap r@ 2+ name> u< + ( addr heap flag:addr-1_u<_next-lfa_? flag:addr-1_u<_next-cfa_? ) + and ( addr heap flag ) + \ flag means both lfa and cfa of next word are still u> addr-1 + \ i.e. WHILE flag means exit loop if either lfa or cfa u<= addr + WHILE r@ heap? [ 2dup ] UNTIL \ Continue loop if lfa not on heap \ search for a name in heap r@ 2+ |? IF over r@ 2+ forget? IF r@ 2+ (name> 2+ umax THEN \ then update symb THEN - REPEAT rdrop - REPEAT ; + REPEAT rdrop ( R: next-voc ) + REPEAT ; \ *** Block No. 114, Hexblock 72 @@ -2426,23 +2436,41 @@ Defer init-buffers ' noop IS init-buffers \ remove 23jul85we -| Code remove ( dic symb thr - dic symb) +| Code remove ( dict symb thread - dict symb) + \ thread: vocabulary linked list + \ 5 # ldy [[ SP )Y lda N ,Y sta dey 0< ?] + \ N+4/5: dict N+2/3: symb N+0/1: thread user' s0 # ldy clc UP )Y lda 6 # adc N 6 + sta iny UP )Y lda 0 # adc N 7 + sta 1 # ldy + \ N+6/7: s0 [[ N X) lda N 8 + sta N )Y lda N 9 + sta N 8 + ora 0<> + \ N+8/9: next ptr in thread + \ compare N+8/9 next ptr to s0 in N+6/7: ?[[ N 8 + lda N 6 + cmp N 9 + lda N 7 + sbc CS + \ CS aka u>= : + \ compare N+8/9 next ptr to symb N+2/3 ?[ N 8 + lda N 2 + cmp N 9 + lda N 3 + sbc + \ CC aka u< : + \ compare N+4/5 dict to next ptr N+8/9 ][ N 4 + lda N 8 + cmp N 5 + lda N 9 + sbc ]? CC + \ CC aka u< i.e. + \ either (inner CS above) s0 u<= next ptr u< symb + \ or (inner CC above) dict u< next ptr u< s0 + \ let current ptr's adr point to next ptr's adr, + \ i.e. remover next ptr from vocabulary thread. ?[ N 8 + X) lda N X) sta N 8 + )Y lda N )Y sta + \ CS aka u>= : + \ let next ptr N+8/9 be current ptr N+0/1 + \ i.e. leave next ptr in vocabulary thread. ][ N 8 + lda N sta N 9 + lda N 1+ sta ]? ]]? (drop jmp end-code @@ -2455,17 +2483,17 @@ Defer init-buffers ' noop IS init-buffers ( remove- forget-words 29apr85bp) -| : remove-words ( dic symb -- dic symb) +| : remove-words ( dict symb -- dict symb) voc-link BEGIN @ ?dup WHILE dup >r 4 - remove r> REPEAT ; -| : remove-tasks ( dic --) +| : remove-tasks ( dict --) up@ BEGIN 1+ dup @ up@ - WHILE 2dup @ swap here uwithin IF dup @ 1+ @ over ! 1- ELSE @ THEN REPEAT 2drop ; -| : remove-vocs ( dic symb -- dic symb) +| : remove-vocs ( dict symb -- dict symb) voc-link remove thru.vocstack DO 2dup I @ -rot uwithin IF [ ' Forth 2+ ] Literal I ! THEN @@ -2484,7 +2512,13 @@ Defer custom-remove ( deleting words from dict. 13jan83ks) -| : forget-words ( dic symb --) +\ forget-words use cases: +\ clear: dict=here, symb=up@ +\ forget: dict=cfa-to-forget, +\ symb=umax(heap, 2 + (highest cfa either in heap or u> dict) +\ empty: dict=here@cold, symb=up@ +\ save: dict=here, symb=up@ +| : forget-words ( dict symb --) over remove-tasks remove-vocs remove-words custom-remove heap swap - hallot dp ! 0 last ! ; diff --git a/6502/C64/src/vf-finalize.fth b/6502/C64/src/vf-finalize.fth index e9c659e..6a6b511 100644 --- a/6502/C64/src/vf-finalize.fth +++ b/6502/C64/src/vf-finalize.fth @@ -11,17 +11,21 @@ Target Forth also definitions +(C16 : (16 ) (C64 : (64 ) (X16 : (CX ) ; immediate + (C16 : (64 ) \ jumps belhind C) (C64 : (16 ) -(X16 : (CX ) +(X16 : (64 ) BEGIN name count dup 0= abort" C) missing" 2 = >r @ [ Ascii C Ascii ) $100 * + ] Literal = r> and UNTIL ; immediate -: C) ; immediate +(C16 ' (64 alias (CX immediate ) +(C64 ' (16 alias (CX immediate ) +(X16 ' (64 alias (16 immediate ) -(C16 : (16 ) (C64 : (64 ) (X16 : (CX ) ; immediate +: C) ; immediate : forth-83 ; \ last word in Dictionary diff --git a/6502/C64/src/vf-head-c16.fth b/6502/C64/src/vf-head-c16.fth index 2542313..9d8788a 100644 --- a/6502/C64/src/vf-head-c16.fth +++ b/6502/C64/src/vf-head-c16.fth @@ -28,5 +28,5 @@ here dup origin! $100 allot Create logo - (C16+ ," volksFORTH-83 3.91-C16+ " ) - (C16- ," volksFORTH-83 3.91-C16- " ) + (C16+ ," volksFORTH-83 3.9.2-C16+ " ) + (C16- ," volksFORTH-83 3.9.2-C16- " ) diff --git a/6502/C64/src/vf-head-c64.fth b/6502/C64/src/vf-head-c64.fth index 45159b6..140eb3e 100644 --- a/6502/C64/src/vf-head-c64.fth +++ b/6502/C64/src/vf-head-c64.fth @@ -28,4 +28,4 @@ here dup origin! $100 allot Create logo - ," volksFORTH-83 3.91-C64 " + ," volksFORTH-83 3.9.2-C64 " diff --git a/6502/C64/src/vf-head-x16.fth b/6502/C64/src/vf-head-x16.fth index 9503a1d..6da58ee 100644 --- a/6502/C64/src/vf-head-x16.fth +++ b/6502/C64/src/vf-head-x16.fth @@ -27,4 +27,4 @@ here dup origin! $100 allot Create logo - ," volksFORTH-83 3.91-X16 " + ," volksFORTH-83 3.9.2-X16 " diff --git a/6502/C64/src/vf-lbls-cbm.fth b/6502/C64/src/vf-lbls-cbm.fth index 3b7fb9a..d1a5480 100644 --- a/6502/C64/src/vf-lbls-cbm.fth +++ b/6502/C64/src/vf-lbls-cbm.fth @@ -8,6 +8,7 @@ $FFA5 >label ACPTR $FFC6 >label CHKIN $FFC9 >label CHKOUT $FFD2 >label CHROUT +$FFCF >label CHRIN $FF81 >label CINT $FFA8 >label CIOUT $FFC3 >label CLOSE @@ -25,5 +26,6 @@ $FF96 >label TKSA $FFEA >label UDTIM $FFAE >label UNLSN $FFAB >label UNTLK -$FFCF >label CHRIN $FF99 >label MEMTOP +$FFBD >label SETNAM +$FFBA >label SETLFS diff --git a/6502/C64/src/vf-sys-c16.fth b/6502/C64/src/vf-sys-c16.fth index ce4e0c6..3dd8d44 100644 --- a/6502/C64/src/vf-sys-c16.fth +++ b/6502/C64/src/vf-sys-c16.fth @@ -7,6 +7,7 @@ include vf-lbls-cbm.fth \ C16-Labels clv13.4.87) 0ff4c >label ConOut + 090 >label IOStatus 09a >label MsgFlg 099 >label OutDev 098 >label InDev @@ -55,8 +56,6 @@ end-code include vf-sys-cbm.fth -: i/o-status? $90 c@ ; - \ *** Block No. 143, Hexblock 8f \ ... continued diff --git a/6502/C64/src/vf-sys-c64.fth b/6502/C64/src/vf-sys-c64.fth index 92fcb10..e787350 100644 --- a/6502/C64/src/vf-sys-c64.fth +++ b/6502/C64/src/vf-sys-c64.fth @@ -7,6 +7,7 @@ include vf-lbls-cbm.fth \ C64-Labels clv13.4.87) 0E716 >label ConOut + 090 >label IOStatus 09d >label MsgFlg 09a >label OutDev 099 >label InDev @@ -58,8 +59,6 @@ Code curoff ( --) include vf-sys-cbm.fth -: i/o-status? $90 c@ ; - \ *** Block No. 143, Hexblock 8f \ ... continued diff --git a/6502/C64/src/vf-sys-cbm.fth b/6502/C64/src/vf-sys-cbm.fth index d0a4dde..260a63e 100644 --- a/6502/C64/src/vf-sys-cbm.fth +++ b/6502/C64/src/vf-sys-cbm.fth @@ -99,6 +99,9 @@ Output: display [ here output ! ] \ *** Block No. 135, Hexblock 87 87 fthpage +Code i/o-status? ( -- n ) + IOStatus lda Push0A jmp end-code + \ b/blk drive >drive drvinit clv14:2x87 400 Constant b/blk @@ -143,10 +146,10 @@ Label nodevice 0 # ldx 1 # ldy \ ?device clv12jul87 Label (?dev - 90 stx (C16 $ae sta ( ) LISTEN jsr + IOStatus stx (C16 $ae sta ( ) LISTEN jsr \ because of error in OS 60 # lda SECOND jsr UNLSN jsr - 90 lda 0<> ?[ pla pla nodevice jmp ]? + IOStatus lda 0<> ?[ pla pla nodevice jmp ]? rts end-code Code (?device ( dev --) @@ -212,7 +215,8 @@ Code bus@ ( -- 8b) 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 ELSE BEGIN bus@ #cr = UNTIL - THEN 0= busoff ; + disk $F busin bus@ dup Ascii 0 = + IF drop BEGIN bus@ drop i/o-status? UNTIL false + ELSE BEGIN emit bus@ i/o-status? UNTIL emit true THEN + busoff ; + diff --git a/6502/C64/src/vf-sys-x16.fth b/6502/C64/src/vf-sys-x16.fth index 3e5062a..732dcc9 100644 --- a/6502/C64/src/vf-sys-x16.fth +++ b/6502/C64/src/vf-sys-x16.fth @@ -6,6 +6,7 @@ include vf-lbls-cbm.fth \ X16 labels 0c28c >label ConOut + 0286 >label IOStatus 028c >label MsgFlg 028b >label OutDev 028a >label InDev @@ -29,18 +30,23 @@ include vf-lbls-cbm.fth \ X16 c64key? getkey Code c64key? ( -- flag) + 9f61 ldx 0 # lda 9f61 sta 0a00a lda 0<> ?[ 0FF # lda ]? pha + 9f61 stx Push jmp end-code Code getkey ( -- 8b) + 9f61 lda N sta 0 # lda 9f61 sta 0a00a lda 0<> ?[ sei 0a000 ldy [[ 0a000 1+ ,X lda 0a000 ,X sta inx 0a00a cpx 0= ?] - 0a00a dec tya cli 0A0 # cmp + 0a00a dec + N lda 9f61 sta + tya cli 0A0 # cmp 0= ?[ bl # lda ]? ]? Push0A jmp end-code @@ -70,8 +76,6 @@ Code curoff ( --) include vf-sys-cbm.fth -: i/o-status? $0286 c@ ; - \ *** Block No. 143, Hexblock 8f \ ... continued diff --git a/6502/C64/src/x16tmpheap.fth b/6502/C64/src/x16tmpheap.fth new file mode 100644 index 0000000..c677e90 --- /dev/null +++ b/6502/C64/src/x16tmpheap.fth @@ -0,0 +1,62 @@ + +\ This is a custom implementation of tmpheap for the X16 which +\ allocates the tmpheap in a RAM bank and moves definitons prefixed +\ with || or within a ||on to ||off range there. +\ tmpclear will remove all words on the tmpheap, wheras regular clear +\ will remove all words on tmpheap and heap together. + +\ Other than the reference tmpheap living on the regular heap, this +\ custom tmpheap needs no initialization as its position and +\ size (8k) is fixed. + +User tmpheap[ +User tmpheap> +User ]tmpheap + +\ $9f61 is the X16 RAM bank select register. This will change to $0001 +\ in the next X16 board version. +\ 1 is the RAM bank selected for the tmpheap. RAM bank 0 is used by the +\ X16 KERNAL. The banked RAM lives from $a000 to $bfff. + 1 $9f61 c! $a000 tmpheap[ ! $c000 dup ]tmpheap ! tmpheap> ! + +: mk-tmp-heap ( size -- ) + heap dup ]tmpheap ! tmpheap> ! hallot heap tmpheap[ ! ; + +: tmp-hallot ( size -- addr ) + tmpheap> @ swap - + dup tmpheap[ @ u< abort" tmp heap overflow" + dup tmpheap> ! ; + +| : tmp-heapmove ( from from size -- from offset ) + dup tmp-hallot swap cmove + tmpheap> @ over - ; + +| : tmp-heapmove1x ( from size -- from offset ) + tmp-heapmove ?heapmovetx off ; + +: || ['] tmp-heapmove1x ?heapmovetx ! ; +: ||on ['] tmp-heapmove ?heapmovetx ! ; +: ||off ?heapmovetx off ; + + +| : remove-tmp-words-in-voc ( voc -- ) + BEGIN dup @ ?dup WHILE ( thread next-in-thread ) + dup tmpheap[ @ ]tmpheap @ uwithin IF ( thread next-in-thread ) + @ ?dup IF ( thread next-next-in-thread ) over ! + ELSE ( thread ) off exit THEN + ELSE ( thread next-in-thread ) nip + THEN + REPEAT drop ; + +| : remove-tmp-words ( -- ) + voc-link BEGIN @ ?dup + WHILE dup 4 - remove-tmp-words-in-voc REPEAT ; + +: tmpclear ( -- ) + remove-tmp-words + \ Uncomment the following line to help determine the ideal tmpheap + \ size for your project. + \ tmpheap> @ tmpheap[ @ - cr u. ." tmpheap spare" + ]tmpheap @ tmpheap> ! last off ; + +' tmpclear is custom-remove