forth: Phase 5 memory + unsigned compare (Hayes 268→342, 53%)

lib/forth/compiler.sx

@@ -648,7 +648,10 @@
         (s)
         (let
           ((addr (forth-pop s)))
-          (forth-push s (or (get (get s "vars") addr) 0)))))
+          (if
+            (string? addr)
+            (forth-push s (or (get (get s "vars") addr) 0))
+            (forth-push s (forth-mem-read s addr))))))
     (forth-def-prim!
       state
       "!"
@@ -656,7 +659,10 @@
         (s)
         (let
           ((addr (forth-pop s)) (v (forth-pop s)))
-          (dict-set! (get s "vars") addr v))))
+          (if
+            (string? addr)
+            (dict-set! (get s "vars") addr v)
+            (forth-mem-write! s addr v)))))
     (forth-def-prim!
       state
       "+!"
@@ -664,9 +670,86 @@
         (s)
         (let
           ((addr (forth-pop s)) (v (forth-pop s)))
+          (if
+            (string? addr)
+            (let
+              ((cur (or (get (get s "vars") addr) 0)))
+              (dict-set! (get s "vars") addr (+ cur v)))
+            (forth-mem-write! s addr (+ (forth-mem-read s addr) v))))))
+    (forth-def-prim! state "HERE" (fn (s) (forth-push s (get s "here"))))
+    (forth-def-prim!
+      state
+      "ALLOT"
+      (fn
+        (s)
+        (let
+          ((n (forth-pop s)))
+          (dict-set! s "here" (+ (get s "here") n)))))
+    (forth-def-prim!
+      state
+      ","
+      (fn
+        (s)
+        (let
+          ((v (forth-pop s)) (addr (forth-alloc-bytes! s 1)))
+          (forth-mem-write! s addr v))))
+    (forth-def-prim!
+      state
+      "C,"
+      (fn
+        (s)
+        (let
+          ((v (forth-pop s)) (addr (forth-alloc-bytes! s 1)))
+          (forth-mem-write! s addr v))))
+    (forth-def-prim!
+      state
+      "CREATE"
+      (fn
+        (s)
+        (let
+          ((name (forth-next-token! s)))
+          (when (nil? name) (forth-error s "CREATE expects name"))
           (let
-            ((cur (or (get (get s "vars") addr) 0)))
-            (dict-set! (get s "vars") addr (+ cur v))))))
+            ((addr (get s "here")))
+            (forth-def-prim! s name (fn (ss) (forth-push ss addr)))))))
+    (forth-def-prim! state "CELL+" (fn (s) (forth-push s (+ (forth-pop s) 1))))
+    (forth-def-prim! state "CELLS" (fn (s) nil))
+    (forth-def-prim! state "ALIGN" (fn (s) nil))
+    (forth-def-prim! state "ALIGNED" (fn (s) nil))
+    (forth-def-prim!
+      state
+      "U<"
+      (forth-cmp
+        (fn (a b) (< (forth-to-unsigned a 32) (forth-to-unsigned b 32)))))
+    (forth-def-prim!
+      state
+      "U>"
+      (forth-cmp
+        (fn (a b) (> (forth-to-unsigned a 32) (forth-to-unsigned b 32)))))
+    (forth-def-prim!
+      state
+      "2@"
+      (fn
+        (s)
+        (let
+          ((addr (forth-pop s)))
+          (if
+            (string? addr)
+            (forth-error s "2@ on var unsupported")
+            (begin
+              (forth-push s (forth-mem-read s (+ addr 1)))
+              (forth-push s (forth-mem-read s addr)))))))
+    (forth-def-prim!
+      state
+      "2!"
+      (fn
+        (s)
+        (let
+          ((addr (forth-pop s))
+            (a (forth-pop s))
+            (b (forth-pop s)))
+          (forth-mem-write! s addr a)
+          (forth-mem-write! s (+ addr 1) b))))
     state))
 
 ;; Track the most recently defined word name for IMMEDIATE.

lib/forth/scoreboard.json

@@ -1,12 +1,12 @@
 {
   "source": "gerryjackson/forth2012-test-suite src/core.fr",
-  "generated_at": "2026-04-24T22:26:31Z",
+  "generated_at": "2026-04-24T22:54:53Z",
   "chunks_available": 638,
   "chunks_fed": 638,
   "total": 638,
-  "pass": 268,
-  "fail": 2,
-  "error": 368,
-  "percent": 42,
+  "pass": 342,
+  "fail": 4,
+  "error": 292,
+  "percent": 53,
   "note": "completed"
 }

lib/forth/scoreboard.md

@@ -5,13 +5,13 @@
 | chunks available  | 638 |
 | chunks fed        | 638 |
 | total             | 638 |
-| pass              | 268 |
-| fail              | 2 |
-| error             | 368 |
-| percent           | 42% |
+| pass              | 342 |
+| fail              | 4 |
+| error             | 292 |
+| percent           | 53% |
 
 - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr`
-- **Generated**: 2026-04-24T22:26:31Z
+- **Generated**: 2026-04-24T22:54:53Z
 - **Note**: completed
 
 A "chunk" is any preprocessed segment ending at a `}T` (every Hayes test

lib/forth/tests/test-phase5.sx

@@ -0,0 +1,101 @@
+;; Phase 5 — Core Extension + memory primitives.
+
+(define forth-p5-passed 0)
+(define forth-p5-failed 0)
+(define forth-p5-failures (list))
+
+(define
+  forth-p5-assert
+  (fn
+    (label expected actual)
+    (if
+      (= expected actual)
+      (set! forth-p5-passed (+ forth-p5-passed 1))
+      (begin
+        (set! forth-p5-failed (+ forth-p5-failed 1))
+        (set!
+          forth-p5-failures
+          (concat
+            forth-p5-failures
+            (list
+              (str label ": expected " (str expected) " got " (str actual)))))))))
+
+(define
+  forth-p5-check-stack
+  (fn
+    (label src expected)
+    (let ((r (forth-run src))) (forth-p5-assert label expected (nth r 2)))))
+
+(define
+  forth-p5-check-top
+  (fn
+    (label src expected)
+    (let
+      ((r (forth-run src)))
+      (let
+        ((stk (nth r 2)))
+        (forth-p5-assert label expected (nth stk (- (len stk) 1)))))))
+
+(define
+  forth-p5-create-tests
+  (fn
+    ()
+    (forth-p5-check-top
+      "CREATE pushes HERE-at-creation"
+      "HERE CREATE FOO FOO ="
+      -1)
+    (forth-p5-check-top
+      "CREATE + ALLOT advances HERE"
+      "HERE 5 ALLOT HERE SWAP -"
+      5)
+    (forth-p5-check-top
+      "CREATE + , stores cell"
+      "CREATE FOO 42 , FOO @"
+      42)
+    (forth-p5-check-stack
+      "CREATE multiple ,"
+      "CREATE TBL 1 , 2 , 3 , TBL @ TBL CELL+ @ TBL CELL+ CELL+ @"
+      (list 1 2 3))
+    (forth-p5-check-top
+      "C, stores byte"
+      "CREATE B 65 C, 66 C, B C@"
+      65)))
+
+(define
+  forth-p5-unsigned-tests
+  (fn
+    ()
+    (forth-p5-check-top "1 2 U<" "1 2 U<" -1)
+    (forth-p5-check-top "2 1 U<" "2 1 U<" 0)
+    (forth-p5-check-top "0 1 U<" "0 1 U<" -1)
+    (forth-p5-check-top "-1 1 U< (since -1 unsigned is huge)" "-1 1 U<" 0)
+    (forth-p5-check-top "1 -1 U<" "1 -1 U<" -1)
+    (forth-p5-check-top "1 2 U>" "1 2 U>" 0)
+    (forth-p5-check-top "-1 1 U>" "-1 1 U>" -1)))
+
+(define
+  forth-p5-2bang-tests
+  (fn
+    ()
+    (forth-p5-check-stack
+      "2! / 2@"
+      "CREATE X 0 , 0 , 11 22 X 2! X 2@"
+      (list 11 22))))
+
+(define
+  forth-p5-run-all
+  (fn
+    ()
+    (set! forth-p5-passed 0)
+    (set! forth-p5-failed 0)
+    (set! forth-p5-failures (list))
+    (forth-p5-create-tests)
+    (forth-p5-unsigned-tests)
+    (forth-p5-2bang-tests)
+    (dict
+      "passed"
+      forth-p5-passed
+      "failed"
+      forth-p5-failed
+      "failures"
+      forth-p5-failures)))