aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorClyne Sullivan <clyne@bitgloo.com>2023-02-22 10:38:07 -0500
committerClyne Sullivan <clyne@bitgloo.com>2023-02-22 10:38:07 -0500
commit90c27fd4c92e4e5dd44c81eacca7790d762116d9 (patch)
treeda958b3a0a9cb1ee460a26612cf2d9bdca7c3964
parent572a79b4c724d4c6c7770874bafc5546139f44b7 (diff)
fix comments; add accept, invert, true/false, environment?
-rw-r--r--compat.txt8
-rw-r--r--core.fth16
-rw-r--r--corewords.hpp2
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";