From d175fa6a882805212cd489d6afbda9f54443bd7b Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Mon, 27 Feb 2023 12:14:43 -0500
Subject: [PATCH] :noname, ?do; fix +loop, aligned

---
 compat.txt |  4 ++--
 core.fth   | 19 ++++++++++++++-----
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/compat.txt b/compat.txt
index 91e2931..364ac7e 100644
--- a/compat.txt
+++ b/compat.txt
@@ -143,9 +143,9 @@ yes 6.2.0280 0>
 yes 6.2.0340 2>R
 yes 6.2.0410 2R>
 yes 6.2.0415 2R@
-    6.2.0455 :NONAME
+yes 6.2.0455 :NONAME
 yes 6.2.0500 <>
-    6.2.0620 ?DO
+yes 6.2.0620 ?DO
 yes 6.2.0698 ACTION-OF
 yes 6.2.0700 AGAIN
 yes 6.2.0825 BUFFER:
diff --git a/core.fth b/core.fth
index 178a5d2..5832a95 100644
--- a/core.fth
+++ b/core.fth
@@ -62,7 +62,7 @@
 : 0=       0 = ;
 : 0<       0 < ;
 : <=       - 1- 0< ;
-: >        <= 0= ;
+: >        swap < ;
 : <>       = 0= ;
 : 0<>      0= 0= ;
 : 0>       0 > ;
@@ -78,19 +78,27 @@
 : again    postpone repeat ; imm
 
 : do       ['] _lit , here 0 , ['] >r , postpone 2>r here ; imm
+: ?do      ['] 2dup , ['] _lit , here 0 , ['] >r , ['] = , postpone if
+           ['] 2drop , postpone 2r> ['] drop , ['] >r , ['] exit ,
+           postpone then postpone 2>r here ; imm
 : unloop   postpone 2r> ['] 2drop , ; imm
 : leave    postpone unloop postpone 2r>
            ['] drop , ['] >r , ['] exit , ; imm
-: +loop    postpone 2r> ['] rot , ['] + , ['] 2dup ,
-           postpone 2>r ['] - , ['] 0= , ['] _jmp0 , ,
+: +loop    postpone 2r> ['] 2dup , ['] swap , ['] < , ['] >r ,
+           ['] rot , ['] + , ['] 2dup , ['] swap , ['] < ,
+           ['] r> , ['] ^ , ['] -rot ,
+           postpone 2>r ['] _jmp0 , ,
+           postpone unloop
+           here swap ! ['] r> , ['] drop , ; imm
+: loop     postpone 2r> ['] 1+ , ['] 2dup ,
+           postpone 2>r ['] = , ['] _jmp0 , ,
            postpone unloop
            here swap ! ['] r> , ['] drop , ; imm
-: loop     1 postpone literal postpone +loop ; imm
 : i        postpone r@ ; imm 
 : j        postpone 2r> postpone r@ ['] -rot , postpone 2>r ; imm
 
 : align    here 1 cells 1- tuck & if 1 cells swap - allot else drop then ;
-: aligned  dup 1 cells 1- tuck & if 1 cells swap - allot else drop then ;
+: aligned  dup 1 cells 1- tuck & if 1 cells swap - + else drop then ;
 
 : and      & ;
 : or       | ;
@@ -209,3 +217,4 @@
 
 : marker   create _latest @ , here , does>
            dup @ _latest ! cell+ @ here swap - allot ;
+: :noname  0 , here ] ;