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: :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 ] ;
--
cgit v1.2.3