Add save and empty

diff --git a/preForth/hi.forth b/preForth/hi.forth
index 92afbc9..33c7f9f 100644 (file)
--- a/preForth/hi.forth
+++ b/preForth/hi.forth
@@ -831,5 +831,22 @@ t{ : dotest   10 0 DO I LOOP ;  dotest -> 0 1 2 3 4 5 6 7 8 9 }t
    postpone r>  postpone drop 
    postpone r>  postpone drop ; immediate
 
+\ save and empty (need HP)  single wordlist only no string header reclaim
+\ not really valid in seedForth as the tokenizer would not know how to reset 
+\ token indices. Make SAVE and EMPTY special in the tokenizer?
+\ HEAD the start of seedForth header table is not required. 
+\ DP is not required as it can be read via HERE and set via ALLOT (see DP!) 
+
+: !+ ( x addr -- addr' )  swap over ! cell+ ;
+: @+ ( addr -- x addr' )  dup @ swap cell+ ;
+
+| Create savearea  0 , 0 , 0 ,
+
+: save ( -- )  here  hp @   forth-wordlist @   savearea !+ !+ ! ;
+: empty ( -- )  savearea @+ @+ @ dp! hp ! forth-wordlist ! ;
+
+save
+
+: remove-with-empty ; \ remove with empty
 
 echo on cr cr .( Welcome! ) input-echo on

diff --git a/preForth/seedForth-i386.pre b/preForth/seedForth-i386.pre
index 96d8a25..7f603df 100644 (file)
--- a/preForth/seedForth-i386.pre
+++ b/preForth/seedForth-i386.pre
@@ -32,7 +32,7 @@ rstck: DD 16 dup(0)
 _dp:    DD _start  ; dictionary pointer: points to next free location in memory
         ; free memory starts at _start
 
-_hp:    DD 0       ; head pointer: index of first unused head
+__hp:   DD 0       ; head pointer: index of first unused head
 _head:  DD 10000 dup (0)
 
 section '.text' executable writable align 4096
@@ -401,6 +401,9 @@ code usleep ( c -- )
 : +! ( x addr -- )
    swap >r  dup @ r> +  swap ! ;
 
+: hp ( -- addr )
+   lit _hp ;
+
 : h@ ( i -- addr )
    cells lit head + @ ;
 
@@ -408,7 +411,7 @@ code usleep ( c -- )
    cells lit head + ! ;
 
 : h, ( x -- )
-   lit hp @  h!   1 lit hp +! ;
+   hp @  h!   1 hp +! ;
 
 : here ( -- addr )
    lit dp @ ;
@@ -450,7 +453,7 @@ code usleep ( c -- )
    compile, tail compiler ;
 
 : new ( -- xt )
-   lit hp @   here h,  lit enter , ;
+   hp @   here h,  lit enter , ;
 
 : fun ( -- )
    new drop  compiler ;
@@ -463,7 +466,7 @@ code usleep ( c -- )
 
 : create ( -- xt )
    0 , \ dummy does> field
-   lit hp @  here h, lit dovar , ;
+   hp @  here h, lit dovar , ;
 
 : does> ( xt -- ) \ set code field of last defined word
     r>   swap h@  dup >r 1 cells - !   lit dodoes r> !
@@ -532,6 +535,7 @@ code usleep ( c -- )
    lit key?        h, \ 55  37
    lit token       h, \ 56  38
    lit usleep      h, \ 57  39  code
+   lit hp          h, \ 58  40
    interpreter bye ;
 
 pre

diff --git a/preForth/seedForth-tokenizer.fs b/preForth/seedForth-tokenizer.fs
index cc9d000..8f8650a 100644 (file)
--- a/preForth/seedForth-tokenizer.fs
+++ b/preForth/seedForth-tokenizer.fs
@@ -76,7 +76,7 @@ Variable #tokens  0 #tokens !
 ( 44 $2C ) Token and       Token or            Token sp@        Token sp!           
 ( 48 $30 ) Token rp@       Token rp!           Token $lit       Token num
 ( 52 $34 ) Token um*       Token um/mod        Token unused     Token key?          
-( 56 $38 ) Token token     Token usleep
+( 56 $38 ) Token token     Token usleep        Token hp
 
 \ generate token sequences for numbers
 

diff --git a/preForth/seedForthInteractive.seedsource b/preForth/seedForthInteractive.seedsource
index 8a10de6..1b4735b 100644 (file)
--- a/preForth/seedForthInteractive.seedsource
+++ b/preForth/seedForthInteractive.seedsource
@@ -660,6 +660,13 @@ end-macro
 ' rp!         has-header rp!         \ 49  31
 ' $lit        has-header $lit        \ 50  32
 ' num         has-header num         \ 51  33
+' um*         has-header um*
+' um/mod      has-header um/mod       
+' unused      has-header unused
+' key?        has-header key?
+\ ' token has-header token
+' usleep      has-header usleep
+' hp          has-header hp
 
 ' over        has-header over
 ' rot         has-header rot
@@ -678,7 +685,6 @@ end-macro
 ' dispose     has-header dispose
 ' alloc       has-header alloc
 
-' unused      has-header unused
 
 ' cr          has-header cr        
 ' .s          has-header .s        
@@ -701,8 +707,6 @@ end-macro
 ' =           has-header =         
 ' count       has-header count     
 ' 2*          has-header 2*
-' um*         has-header um*
-' um/mod      has-header um/mod       
 
 ' abs         has-header abs
 ' r@          has-header r@
@@ -749,7 +753,6 @@ end-macro
 ' only        has-header only
 \ ' OnlyForth   has-header OnlyForth
 ' .wordlist   has-header .wordlist
-' key?        has-header key?
 ' getkey      has-header getkey
 ' frame       has-header frame
 
@@ -759,7 +762,6 @@ end-macro
 
 
 
-' usleep has-header usleep
 
 
 Macro :noname
@@ -1152,7 +1154,6 @@ here swap - swap c!
  colored-header count "header dup link-header
 \ --------
 
-\ ' token has-header token
 
 cr
 t{ -> }t