Merge pull request #30 from pzembrod/v3.9.2

V3.9.2

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 $@
 

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}"

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

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"

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

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 ;

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 @ @ ,
+ here
- name  c@ dup 1 $20
+ blk @ ,  current @ @ ,
- uwithin not  Abort" invalid name"
+ name c@
- here  last ! 1+ allot
+ dup 1 $20 uwithin not  Abort" invalid name"
- exists? ?head @
+ here last !  1+ allot  exists?
- IF 1 ?head +!  dup  6502-align/1 ,
+ ?heapmovetx @
-                    \ Pointer to code
+ IF dup  6502-align/1 ,  \ Pointer to code
-    heapmove $20 flag! 6502-align/1 dp !
+    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
+ dey  txa      UP 1+ adc  SP )Y sta
- SP )Y sta   Next jmp   end-code
+ 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
+ \ heap is the starting value for symb
- BEGIN r> @ ?dup    \ through all Vocabs
+ \ at the end symb is heap or 2 + the highest of all cfas that are
- WHILE dup >r 4 - >r \ link on returnst.
+ \ either in the heap or u> addr
-  BEGIN r> @ >r over 1- dup r@  u<
+ heap   voc-link >r  ( addr symb / R: voc-link )
-                    \ until link  or
+ BEGIN  \ outer loop through all vocabs
-             swap  r@ 2+ name> u< and
+ r> @ ?dup  ( addr symb / R: )  \ this is the word's exit point
-                    \ code under adr
+ WHILE dup >r 4 - >r  ( addr symb / R: next-voc prev-lfa )
-  WHILE  r@ heap?  [ 2dup ] UNTIL
+  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 rdrop  ( R: next-voc )
- REPEAT  ;
+ 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 ! ;

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
 

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.9.2-C16+ " )
- (C16- ," volksFORTH-83 3.91-C16- " )
+ (C16- ," volksFORTH-83 3.9.2-C16- " )

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  "

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  "

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

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

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

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 -
+ disk $F busin bus@  dup Ascii 0 =
-   IF  BEGIN emit bus@ dup #cr =  UNTIL
+   IF drop BEGIN bus@ drop i/o-status? UNTIL false
-   0= cr ELSE BEGIN bus@ #cr = UNTIL
+   ELSE BEGIN emit bus@ i/o-status? UNTIL emit true THEN
-   THEN   0=  busoff ;
+ busoff ;
+

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

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