6502/VolksForth
1
0
Fork 0
mirror of https://github.com/forth-ev/VolksForth.git synced 2024-11-26 02:49:17 +00:00
Code Issues Projects Releases Wiki Activity

Enable implementation of tmpheap

Browse Source
This commit is contained in:
Philip Zembrod 2020-11-23 22:07:59 +01:00
parent 38d4b75672
commit 35fee10b64
1 changed files with 31 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
6502/C64/src/vf-cbm-core.fth
View File

@ -1602,13 +1602,6 @@ Code clearstack
: heap? ( addr -- flag) : heap? ( addr -- flag)
heap up@ uwithin ; heap up@ uwithin ;
| : heapmove ( from -- from)
dup here over -
dup hallot heap swap cmove
heap over - last +! reveal ;
\ *** Block No. 74, Hexblock 4a \ *** Block No. 74, Hexblock 4a
4a fthpage 4a fthpage
@ -1642,7 +1635,7 @@ Label docreate
\ *** Block No. 75, Hexblock 4b \ *** Block No. 75, Hexblock 4b
4b fthpage 4b fthpage
( 6502-align ?head | 08sep84bp) ( 6502-align 08sep84bp)
| : 6502-align/1 ( adr -- adr' ) | : 6502-align/1 ( adr -- adr' )
dup $FF and $FF = - ; dup $FF and $FF = - ;
@ -1654,49 +1647,48 @@ Label docreate
1 last +! 1 allot THEN ; 1 last +! 1 allot THEN ;
Variable ?head 0 ?head !
: | ?head @ ?exit -1 ?head ! ;
\ *** Block No. 76, Hexblock 4c \ *** Block No. 76, Hexblock 4c
4c fthpage 4c fthpage
( warning Create 30dec84bp) \ warning ?heapmovetx | |on |off Create
Variable warning 0 warning ! Variable warning 0 warning !
| : exists? | : exists? ( -- )
warning @ ?exit warning @ ?exit
last @ current @ (find nip last @ current @ (find nip
IF space last @ .name ." exists " ?cr IF space last @ .name ." exists " ?cr
THEN ; 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 : 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 ELSE 6502-align/2 drop
THEN reveal 0 , THEN reveal 0 ,
;Code docreate jmp end-code ;Code docreate jmp end-code
\ *** Block No. 77, Hexblock 4d \ *** Block No. 77, Hexblock 4d
4d fthpage 4d fthpage
@ -2484,9 +2476,12 @@ Defer custom-remove
( deleting words from dict. 13jan83ks) ( deleting words from dict. 13jan83ks)
| : forget-words ( dic symb --) : (forget-words ( dic symb -- dic symb )
over remove-tasks remove-vocs over remove-tasks remove-vocs
remove-words custom-remove remove-words custom-remove ;
| : forget-words ( dic symb --)
(forget-words
heap swap - hallot dp ! 0 last ! ; heap swap - hallot dp ! 0 last ! ;
: clear : clear