diff options
author | Clyne Sullivan <clyne@bitgloo.com> | 2023-11-25 12:40:45 -0500 |
---|---|---|
committer | Clyne Sullivan <clyne@bitgloo.com> | 2023-11-25 12:40:45 -0500 |
commit | 3038586ad459d58e3a621f155e5d2df69096bd39 (patch) | |
tree | eaf18cd69daf8c7d3a6f8cf659c1f4e958e9c36b | |
parent | 454d7a339521d250222372ffe8745c296028dee9 (diff) |
add CREATE, DOES>
-rw-r--r-- | core.fth | 16 |
1 files changed, 16 insertions, 0 deletions
@@ -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" |