From 650a344aad4c32d9b476ce36a06aa7dce373bb30 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Wed, 25 Oct 2023 09:06:14 -0400
Subject: support long definitions; add tests as submodule

---
 forth/core.fth | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

(limited to 'forth')

diff --git a/forth/core.fth b/forth/core.fth
index 071af33..360d269 100644
--- a/forth/core.fth
+++ b/forth/core.fth
@@ -156,13 +156,14 @@
            swap postpone literal postpone literal ; imm
 : ."       postpone s" state @ if ['] type , else type then ; imm
 
-: create   align here
-           1 cells 1 chars - allot
-           bl word count swap drop
-           1 chars allot
-           swap over over ! swap allot align
+: create   align here dup _latest @ - 1 1 cells 8 * 6 - << 1- swap <=
+           dup if -1 6 << , then 0 , >r
+           begin key? if key else bl then dup bl <> while
+           c, 1 over +! repeat drop align
            ['] _lit , here 3 cells + , ['] exit dup , ,
-           dup @ 31 & over _latest @ - 6 << or over ! _latest ! ;
+           dup _latest @ - r> if
+           over cell+ else 6 << over then +! _latest ! ;
+
 : _does>   _latest @ dup @ 31 & + cell+ aligned 2 cells +
            ['] _jmp over ! cell+
            r@ 1 cells - @ swap ! ;
-- 
cgit v1.2.3