forth: CHAR/[CHAR]/KEY/ACCEPT (+7; Hayes 174/590)

lib/forth/compiler.sx

@@ -457,6 +457,56 @@
             (for-each
               (fn (t) (dict-set! t "v" exit-pc))
               (get marker "leaves"))))))
+    (forth-def-prim!
+      state
+      "CHAR"
+      (fn
+        (s)
+        (let
+          ((tok (forth-next-token! s)))
+          (when (nil? tok) (forth-error s "CHAR expects a word"))
+          (forth-push s (char-code (substr tok 0 1))))))
+    (forth-def-prim-imm!
+      state
+      "[CHAR]"
+      (fn
+        (s)
+        (let
+          ((tok (forth-next-token! s)))
+          (when (nil? tok) (forth-error s "[CHAR] expects a word"))
+          (let
+            ((c (char-code (substr tok 0 1))))
+            (if
+              (get s "compiling")
+              (forth-def-append! s (fn (ss) (forth-push ss c)))
+              (forth-push s c))))))
+    (forth-def-prim!
+      state
+      "KEY"
+      (fn
+        (s)
+        (let
+          ((kb (or (get s "keybuf") "")))
+          (if
+            (= (len kb) 0)
+            (forth-error s "KEY: no input available")
+            (begin
+              (forth-push s (char-code (substr kb 0 1)))
+              (dict-set! s "keybuf" (substr kb 1 (- (len kb) 1))))))))
+    (forth-def-prim!
+      state
+      "ACCEPT"
+      (fn
+        (s)
+        (let
+          ((n1 (forth-pop s)) (addr (forth-pop s)))
+          (let
+            ((kb (or (get s "keybuf") "")))
+            (let
+              ((n (if (< n1 (len kb)) n1 (len kb))))
+              (forth-mem-write-string! s addr (substr kb 0 n))
+              (dict-set! s "keybuf" (substr kb n (- (len kb) n)))
+              (forth-push s n))))))
     (forth-def-prim-imm!
       state
       "S\""

lib/forth/scoreboard.json

@@ -1,12 +1,12 @@
 {
   "source": "gerryjackson/forth2012-test-suite src/core.fr",
-  "generated_at": "2026-04-24T19:45:15Z",
+  "generated_at": "2026-04-24T20:12:09Z",
   "chunks_available": 638,
   "chunks_fed": 590,
   "total": 590,
-  "pass": 168,
+  "pass": 174,
   "fail": 0,
-  "error": 422,
-  "percent": 28,
+  "error": 416,
+  "percent": 29,
   "note": "completed"
 }

lib/forth/scoreboard.md

@@ -5,13 +5,13 @@
 | chunks available  | 638 |
 | chunks fed        | 590 |
 | total             | 590 |
-| pass              | 168 |
+| pass              | 174 |
 | fail              | 0 |
-| error             | 422 |
-| percent           | 28% |
+| error             | 416 |
+| percent           | 29% |
 
 - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr`
-- **Generated**: 2026-04-24T19:45:15Z
+- **Generated**: 2026-04-24T20:12:09Z
 - **Note**: completed
 
 A "chunk" is any preprocessed segment ending at a `}T` (every Hayes test

lib/forth/tests/test-phase4.sx

@@ -143,6 +143,34 @@
       "5 CHAR+"
       6)))
 
+(define
+  forth-p4-char-tests
+  (fn
+    ()
+    (forth-p4-check-top "CHAR A -> 65" "CHAR A" 65)
+    (forth-p4-check-top "CHAR x -> 120" "CHAR x" 120)
+    (forth-p4-check-top "CHAR takes only first char" "CHAR HELLO" 72)
+    (forth-p4-check-top
+      "[CHAR] compiles literal"
+      ": AA [CHAR] A ; AA"
+      65)
+    (forth-p4-check-top
+      "[CHAR] reads past IMMEDIATE"
+      ": ZZ [CHAR] Z ; ZZ"
+      90)
+    (forth-p4-check-stack-size
+      "[CHAR] doesn't leak at compile time"
+      ": FOO [CHAR] A ; "
+      0)))
+
+(define
+  forth-p4-key-accept-tests
+  (fn
+    ()
+    (let
+      ((r (forth-run "1000 2 ACCEPT")))
+      (let ((stk (nth r 2))) (forth-p4-assert "ACCEPT empty buf -> 0" (list 0) stk)))))
+
 (define
   forth-p4-run-all
   (fn
@@ -155,6 +183,8 @@
     (forth-p4-fill-tests)
     (forth-p4-cmove-tests)
     (forth-p4-charplus-tests)
+    (forth-p4-char-tests)
+    (forth-p4-key-accept-tests)
     (dict
       "passed"
       forth-p4-passed