Use exit instead of unnest

diff --git a/preForth/dynamic.seedsource b/preForth/dynamic.seedsource
index c10b107..f35f59a 100644 (file)
--- a/preForth/dynamic.seedsource
+++ b/preForth/dynamic.seedsource
@@ -108,7 +108,7 @@ Variable anchor
 
 : fits? ( size -- mem | false ) >r anchor @
     BEGIN addr&size  r@ u< 0=
-         IF r> drop unnest THEN
+         IF r> drop exit THEN
          @ dup anchor @ =
     UNTIL 0= r> drop ;
 
@@ -124,7 +124,7 @@ Variable anchor
 
 
 : allocate ( size -- mem ior )
-    3 cells max dup >r  fits? ?dup 0= IF r> -8 unnest THEN ( "dictionary overflow" )
+    3 cells max dup >r  fits? ?dup 0= IF r> -8 exit THEN ( "dictionary overflow" )
     addr&size r@ -  dup waste u<
     IF  drop  dup @ over unlink  over addr&size use
     ELSE 2 cells -   over r@ use
@@ -137,13 +137,13 @@ Variable anchor
     IF #max and 2 cells +  rot over - rot rot +
     ELSE  drop  over anchor @  dup cell+ @  link THEN
     2dup + cell+ dup @ dup 0<
-    IF #max and swap cell+ unlink  +  2 cells +  release 0 unnest THEN
+    IF #max and swap cell+ unlink  +  2 cells +  release 0 exit THEN
     2drop release 0 ;
 
 : resize ( mem newsize -- mem' ior )
     over swap  over size  2dup >
-    IF ( mem mem size newsize )  swap allocate ?dup IF >r drop 2drop r>  unnest THEN 
-        dup >r swap move free r> swap unnest THEN
+    IF ( mem mem size newsize )  swap allocate ?dup IF >r drop 2drop r>  exit THEN 
+        dup >r swap move free r> swap exit THEN
     2drop drop ;
 
 : empty-memory ( addr size -- )

diff --git a/preForth/seedForth-i386.pre b/preForth/seedForth-i386.pre
index 388cb2a..5c463f5 100644 (file)
--- a/preForth/seedForth-i386.pre
+++ b/preForth/seedForth-i386.pre
@@ -229,7 +229,10 @@ code and ( x1 x2 -- x3 )
         next
 ;
 
-code unnest ( -- )
+pre 
+_unnest:
+;
+code exit ( -- )
         mov esi,[ebp]
         lea ebp,[ebp+4]
         next
@@ -421,7 +424,7 @@ code rp! ( x -- )
    lit >r          h, \ 8   08
    lit r>          h, \ 9   09
    lit -           h, \ 10  0A
-   lit unnest      h, \ 11  0B
+   lit exit        h, \ 11  0B
    lit lit         h, \ 12  0C
    lit @           h, \ 13  0D
    lit c@          h, \ 14  0E

diff --git a/preForth/seedForth-tokenizer.fs b/preForth/seedForth-tokenizer.fs
index f3063cd..625d78b 100644 (file)
--- a/preForth/seedForth-tokenizer.fs
+++ b/preForth/seedForth-tokenizer.fs
@@ -26,7 +26,12 @@ Create tokens  #hashsize cells allot  tokens #hashsize cells 0 fill
 
 : token@ ( c-addr u -- x )  'token @ ;
 
-: ?token ( c-addr u -- x )  2dup 'token dup @ IF  >r cr type ."  collides with token " r> @ name-see abort THEN nip nip ;
+: ?token ( c-addr u -- x )  
+    2dup 'token dup @ 
+    IF  
+       >r cr type ."  collides with another token " 
+       cr source type cr r> @ name-see abort 
+    THEN nip nip ;
 
 VARIABLE OUTFILE
 
@@ -56,7 +61,7 @@ Variable #tokens  0 #tokens !
 
 Token bye       Token emit          Token key        Token dup
 Token swap      Token drop          Token 0<         Token ?exit
-Token >r        Token r>            Token -          Token unnest
+Token >r        Token r>            Token -          Token exit
 Token lit       Token @             Token c@         Token !
 Token c!        Token execute       Token branch     Token ?branch
 Token negate    Token +             Token 0=         Token ?dup
@@ -120,7 +125,7 @@ Macro [ ( -- )  0 SUBMIT end-macro  \ bye
 Macro ] ( -- )  seed compiler end-macro  \ compiler
 
 Macro : ( <name> -- ) seed fun  Token  end-macro
-Macro ; ( -- )         seed unnest   seed [ end-macro
+Macro ; ( -- )         seed exit   seed [ end-macro
 
 \ generate token sequences for strings
 
@@ -229,3 +234,16 @@ Macro Definer ( <name> -- )
       seed fun
    postpone end-macro
 end-macro
+
+\ for defining Macros later in seedForth
+Macro Macro ( <name> -- )
+   Macro
+end-macro
+
+Macro end-macro
+   postpone end-macro
+end-macro
+
+Macro seed ( <name> -- )
+   postpone seed
+end-macro

diff --git a/preForth/seedForthDemo.seedsource b/preForth/seedForthDemo.seedsource
index 9f784da..d808d3b 100644 (file)
--- a/preForth/seedForthDemo.seedsource
+++ b/preForth/seedForthDemo.seedsource
@@ -44,8 +44,8 @@ Variable actual-depth  ( actual-results )  20 cells allot
    BEGIN depth WHILE  depth nth-result !  REPEAT ;
 
 : }t ( i*x -- )
-   depth actual-depth @ - IF  s" wrong number of results" error  unnest THEN
-   BEGIN depth WHILE  depth nth-result @ - IF  s" incorrect result" error  unnest THEN  REPEAT ;
+   depth actual-depth @ - IF  s" wrong number of results" error  exit THEN
+   BEGIN depth WHILE  depth nth-result @ - IF  s" incorrect result" error  exit THEN  REPEAT ;
 
 \ Test basics
 t{ 10 '*' + ->  52 }t
@@ -139,6 +139,9 @@ Definer Constant ( x <name> -- )  create , does> @ ;
 t{ five -> 5 }t
 
 
+\ What about a inlining Constant?
+
+
 \ structured data
 
 Definer Field ( offset size <name> -- offset' ) 
@@ -232,7 +235,7 @@ t{ greeting nip -> 16 }t
     WHILE
       dup
     WHILE
-      >r >r  over c@ over c@ - ?dup IF 0< dup + 1  + nip nip r> drop r> drop unnest THEN
+      >r >r  over c@ over c@ - ?dup IF 0< dup + 1  + nip nip r> drop r> drop exit THEN
       1+ swap 1+ swap
       r> 1- r> 1-
     REPEAT
@@ -297,9 +300,101 @@ Variable #tib
      tib #tib @  2dup uppercase type  s"  ok" type
    AGAIN ;
 
+\ Adder
+
+Definer Adder ( n <name> -- )  create , does>  @ + ;
+
+5 Adder 5+
+
+t{ 0 5+ -> 5 }t
+t{ 1 5+ -> 6 }t
+
 \ -----------------------------------------------
 
-: done ( -- )  cr s" done" type cr ; done
+\ Inlining Constant
+
+Definer iConstant ( x <name> -- )  create , ( immediate )  does> @  lit lit , , ;
+
+\ improve: needs to define macro
+
+5 iConstant iFive
+
+: test  [ iFive ] dup + ;
+
+t{ test -> 10 }t
+
+\ -----------------------------------------------
+
+Macro ." ( ccc" -- )
+   seed s"
+   seed type
+end-macro
+
+: hello ( -- ) ." Hello, seedForth world!" ;
+
+\ ---- self growing array
+
+: cmove ( c-addr1 c-addr2 u -- )
+   BEGIN
+     ?dup
+   WHILE
+     >r
+     over c@ over c!
+     1+ swap 1+ swap
+     r> 1-
+   REPEAT
+   2drop ;
+
+\ : place ( c-addr1 u c-addr2 -- )
+\    2dup >r >r 1+ swap cmove  r> r> c! ;
+
+: cell+ ( addr1 -- addr2 )
+    1 cells + ;
+
+: 2@ ( addr -- x1 x2 )
+   dup cell+ @ swap @ ;
+
+: 2! ( x1 x2 addr -- )
+   swap over ! cell+ ! ;
+
+Create m  1 , 2 ,
+
+t{ m 2@  m 2!  m @  m cell+ @ -> 1 2 }t
+
+
+
+: resize-array ( addr1 size1 -- addr2 size2 ) 
+    over swap \ addr1 addr1 size1 
+    dup 2* dup cells alloc swap \ addr1 addr1 size1 addr2 size2
+    >r dup >r  swap cells cmove \ addr1 
+    dispose
+    r> r> ;
+
+Definer Array ( n -- )  
+    create dup , 
+           here >r 0 ,
+           cells alloc r> !  \ { size | addr }
+    does> ( n -- addr )
+      BEGIN ( n body )
+         2dup @ < 0= 
+      WHILE ( n body )
+         dup >r 2@ resize-array r@ 2! r>
+      REPEAT ( n body ) 
+      cell+ @ swap  cells +
+;
+
+5 Array a
+
+10 0 a !
+20 1 a !
+30 2 a !
+40 3 a !
+50 4 a !
+
+t{ 60 5 a !  0 a @  1 a @  2 a @  3 a @  4 a @   5 a @  -> 10 20 30 40 50 60 }t
+
+
+: done ( -- )  cr ." done" cr ; done
 \ cr  'd'  emit 'o'  emit 'n'  emit 'e'  emit cr
 
 \ hi