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

2026-04-24 20:12:31 +00:00
parent 1c975f229d
commit 35ce18eb97
5 changed files with 98 additions and 9 deletions
--- a/lib/forth/compiler.sx
+++ b/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\""