aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2023-11-25 12:40:45 -0500
committerClyne Sullivan <clyne@bitgloo.com>2023-11-25 12:40:45 -0500
commit3038586ad459d58e3a621f155e5d2df69096bd39 (patch)
treeeaf18cd69daf8c7d3a6f8cf659c1f4e958e9c36b
parent454d7a339521d250222372ffe8745c296028dee9 (diff)
add CREATE, DOES>
-rw-r--r--core.fth16
1 files changed, 16 insertions, 0 deletions
diff --git a/core.fth b/core.fth
index 0650811..ec34191 100644
--- a/core.fth
+++ b/core.fth
@@ -16,6 +16,7 @@
: base [ 0 _d ] literal ;
: here [ 1 cells _d ] literal @ ;
: allot [ 1 cells _d ] literal +! ;
+: _latest [ 2 cells _d ] literal ;
: state [ 3 cells _d ] literal ;
: _compxt [ 4 cells _d ] literal ;
: _source [ 5 cells _d ] literal ;
@@ -111,6 +112,19 @@
swap postpone literal postpone literal ; imm
: ." postpone s" state @ if ['] type compile, else type then ; imm
+: create : here [ 4 cells ] literal + postpone literal postpone ; 0 , ;
+: >body cell+ @ ;
+
+: _does> _latest @ @ [ 4 cells ] literal +
+ ['] _jmp @ over !
+ r@ [ 2 cells ] literal +
+ swap cell+ ! ;
+
+: does> ['] _does> compile, ['] exit compile, ; imm
+
+: variable create [ 1 cells ] literal allot ;
+: constant create , does> @ ;
+
: 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
@@ -134,4 +148,6 @@
: fibs 10 0 do i fib . loop cr ;
+5 constant five
+five .
fibs ." hello world"