]> code.bitgloo.com Git - bitgloo/alee-forth.git/commitdiff
fix comments; add accept, invert, true/false, environment?
authorClyne Sullivan <clyne@bitgloo.com>
Wed, 22 Feb 2023 15:38:07 +0000 (10:38 -0500)
committerClyne Sullivan <clyne@bitgloo.com>
Wed, 22 Feb 2023 15:38:07 +0000 (10:38 -0500)
compat.txt
core.fth
corewords.hpp

index b225c1688f871f347d647c9f338c8b6f877cc36b..54abfe555641e23739fd6008c518ab232011a580 100644 (file)
@@ -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
index d1562310edbf542f7868b3c6c901e008e4890922..f460bef8e00b153edc096780e76acb6ec591cbf5 100644 (file)
--- a/core.fth
+++ b/core.fth
@@ -81,6 +81,7 @@
 : xor      ^ ;
 : lshift   << ;
 : rshift   >> ;
+: invert   -1 ^ ;
 : mod      % ;
 : 2*       2 * ;
 : 2/       2 / ;
 : 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 ;
 
            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 ;
index d4eb8810b22e4299214a84c30fe05e2b8c48e9df..9862bebe7cb96b55ad5c89014b1aa792dbb76062 100644 (file)
@@ -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";