From 90c27fd4c92e4e5dd44c81eacca7790d762116d9 Mon Sep 17 00:00:00 2001
From: Clyne Sullivan <clyne@bitgloo.com>
Date: Wed, 22 Feb 2023 10:38:07 -0500
Subject: [PATCH] fix comments; add accept, invert, true/false, environment?

---
 compat.txt    |  8 ++++----
 core.fth      | 16 ++++++++++++++++
 corewords.hpp |  2 +-
 3 files changed, 21 insertions(+), 5 deletions(-)

diff --git a/compat.txt b/compat.txt
index b225c16..54abfe5 100644
--- a/compat.txt
+++ b/compat.txt
@@ -45,7 +45,7 @@ yes 6.1.0650 @
 yes 6.1.0670 ABORT
     6.1.0680 ABORT"
 yes 6.1.0690 ABS
-    6.1.0695 ACCEPT
+yes 6.1.0695 ACCEPT
 yes 6.1.0705 ALIGN
 yes 6.1.0706 ALIGNED
 yes 6.1.0710 ALLOT
@@ -73,11 +73,11 @@ yes 6.1.1260 DROP
 yes 6.1.1290 DUP
 yes 6.1.1310 ELSE
 yes 6.1.1320 EMIT
-    6.1.1345 ENVIRONMENT?
+yes 6.1.1345 ENVIRONMENT? (always false)
     6.1.1360 EVALUATE
 yes 6.1.1370 EXECUTE
 yes 6.1.1380 EXIT
-    6.1.1540 FILL
+yes 6.1.1540 FILL
     6.1.1550 FIND
     6.1.1561 FM/MOD
 yes 6.1.1650 HERE
@@ -85,7 +85,7 @@ yes 6.1.1650 HERE
 yes 6.1.1680 I
 yes 6.1.1700 IF
 yes 6.1.1710 IMMEDIATE (as "imm")
-    6.1.1720 INVERT
+yes 6.1.1720 INVERT
     6.1.1730 J 
 yes 6.1.1750 KEY
     6.1.1760 LEAVE
diff --git a/core.fth b/core.fth
index d156231..f460bef 100644
--- a/core.fth
+++ b/core.fth
@@ -81,6 +81,7 @@
 : xor      ^ ;
 : lshift   << ;
 : rshift   >> ;
+: invert   -1 ^ ;
 : mod      % ;
 : 2*       2 * ;
 : 2/       2 / ;
@@ -127,6 +128,9 @@
 : constant create , does> ['] @ , postpone ; ;
 ( TODO fix compile-time does>... above should simply be "does> @ ;" )
 
+-1 constant true 
+0  constant false 
+
 : >in      _input 80 chars + cell+ _input @ - 4 chars - ;
 : source   _input @ 6 chars + >in 3 chars - swap ;
 
@@ -139,3 +143,15 @@
            rot dup @ >r cell+
            rot r> over ! cell+
            rot 1- repeat drop 2drop ;
+: fill     ( c-addr u char -- )
+           -rot begin dup 0 > while
+           >r 2dup c! char+ r> 1- repeat
+           2drop drop ;
+
+: environment? 2drop false ;
+
+: accept   over >r begin dup 0 > while
+           key dup 32 < if
+           2drop r> - 1 chars / 0 else
+           dup emit rot 2dup c! char+ nip swap 1- then
+           repeat drop ;
diff --git a/corewords.hpp b/corewords.hpp
index d4eb881..9862beb 100644
--- a/corewords.hpp
+++ b/corewords.hpp
@@ -47,7 +47,7 @@ private:
         "+\0-\0*\0/\0%\0"
         "_@\0_!\0rot\0>r\0r>\0"
         "=\0<\0allot\0&\0|\0"
-        "^\0<<\0>>\0(\0:\1"
+        "^\0<<\0>>\0(\1:\1"
         ";\1here\0const\0depth\0"
         "key\0exit\0'\0execute\0_jmp\0"
         "_jmp0\0_lit\0literal\1_rdepth\0";