]> code.bitgloo.com Git - clyne/sprit-forth.git/commitdiff
add MOVE, FILL, ENVIRONMENT?, ACCEPT, RECURSE
authorClyne Sullivan <clyne@bitgloo.com>
Sat, 25 Nov 2023 12:03:06 +0000 (07:03 -0500)
committerClyne Sullivan <clyne@bitgloo.com>
Sat, 25 Nov 2023 12:03:06 +0000 (07:03 -0500)
Makefile
core.fth
source/core.cpp

index dbc8c10d47341f239f7d4e6bee862007b9eeebd6..434f49f850cd0b49a1e06eece754efef7aaceb1e 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -22,5 +22,5 @@ clean:
 sprit: source/libsprit.a
 
 source/libsprit.a: $(OBJ)
-       $(AR) rcu $@ $^
+       $(AR) rc $@ $^
 
index d55f71a387d3c8d5ca1f8a2a22831e0e12ab7434..0650811c127d019429a1ed1dfc855a5c4a262e2c 100644 (file)
--- a/core.fth
+++ b/core.fth
            swap postpone literal postpone literal ; imm
 : ."       postpone s" state @ if ['] type compile, else type then ; imm
 
-." hello world"
+: move     dup 0 <= if drop 2drop exit then
+           >r 2dup < r> swap if
+           1- 0 swap do over i + c@ over i + c! -1 +loop
+           else
+           0 do over i + c@ over i + c! loop
+           then 2drop ;
+: fill     -rot begin dup 0 > while
+           >r 2dup c! char+ r> 1- repeat
+           2drop drop ;
+
+: environment? 2drop 1 0= ;
+
+: accept   over >r begin dup 0 > while
+           key dup 32 < if 2drop 0
+           else dup emit rot 2dup c! char+ swap drop swap 1- then
+           repeat drop r> - [ 1 chars ] literal / ;
+
+: recurse  _compxt @ compile, ; imm
+
+: fib ( n1 -- n2 )   dup 1 > if    1- dup 1- recurse swap recurse + then ;
+
+: fibs 10 0 do i fib . loop cr ;
+
+fibs ." hello world"
index 52dbcbb164fe9e13548e9ebfbddcdafada71ebbe..c5d7f2897b132651333fe3f6ad9badcbe2d5fc44 100644 (file)
@@ -147,6 +147,8 @@ void colon()
     // The actual function list will begin one Cell beyond here.
     comma(HERE + sizeof(Cell));
 
+    DICT[DIdxCompXt] = *SP - 2 * sizeof(Cell);
+
     // Enter compiling state.
     STATE = -1;
 }