Merge architecture into loops/forth

lib/forth/test.sh

@@ -0,0 +1,62 @@
+#!/usr/bin/env bash
+# lib/forth/test.sh — smoke-test the Forth runtime layer.
+
+set -uo pipefail
+cd "$(git rev-parse --show-toplevel)"
+
+SX_SERVER="${SX_SERVER:-hosts/ocaml/_build/default/bin/sx_server.exe}"
+if [ ! -x "$SX_SERVER" ]; then
+  SX_SERVER="/root/rose-ash/hosts/ocaml/_build/default/bin/sx_server.exe"
+fi
+if [ ! -x "$SX_SERVER" ]; then
+  echo "ERROR: sx_server.exe not found."
+  exit 1
+fi
+
+TMPFILE=$(mktemp); trap "rm -f $TMPFILE" EXIT
+
+cat > "$TMPFILE" << 'EPOCHS'
+(epoch 1)
+(load "lib/forth/runtime.sx")
+(epoch 2)
+(load "lib/forth/tests/runtime.sx")
+(epoch 3)
+(eval "(list forth-test-pass forth-test-fail)")
+EPOCHS
+
+OUTPUT=$(timeout 60 "$SX_SERVER" < "$TMPFILE" 2>/dev/null)
+
+LINE=$(echo "$OUTPUT" | awk '/^\(ok-len 3 / {getline; print; exit}')
+if [ -z "$LINE" ]; then
+  LINE=$(echo "$OUTPUT" | grep -E '^\(ok 3 \([0-9]+ [0-9]+\)\)' | tail -1 \
+          | sed -E 's/^\(ok 3 //; s/\)$//')
+fi
+if [ -z "$LINE" ]; then
+  echo "ERROR: could not extract summary"
+  echo "$OUTPUT" | tail -20
+  exit 1
+fi
+
+P=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\1/')
+F=$(echo "$LINE" | sed -E 's/^\(([0-9]+) ([0-9]+)\).*/\2/')
+TOTAL=$((P + F))
+
+if [ "$F" -eq 0 ]; then
+  echo "ok $P/$TOTAL lib/forth tests passed"
+else
+  echo "FAIL $P/$TOTAL passed, $F failed"
+  TMPFILE2=$(mktemp)
+  cat > "$TMPFILE2" << 'EPOCHS2'
+(epoch 1)
+(load "lib/forth/runtime.sx")
+(epoch 2)
+(load "lib/forth/tests/runtime.sx")
+(epoch 3)
+(eval "(map (fn (f) (list (get f :name) (get f :got) (get f :expected))) forth-test-fails)")
+EPOCHS2
+  FAILS=$(timeout 60 "$SX_SERVER" < "$TMPFILE2" 2>/dev/null | grep -E '^\(ok-len 3' -A1 | tail -1 || true)
+  echo "  Details: $FAILS"
+  rm -f "$TMPFILE2"
+fi
+
+[ "$F" -eq 0 ]

lib/forth/tests/runtime.sx

@@ -0,0 +1,201 @@
+;; lib/forth/tests/runtime.sx — Tests for lib/forth/runtime.sx
+
+(define forth-test-pass 0)
+(define forth-test-fail 0)
+(define forth-test-fails (list))
+
+(define
+  (forth-test name got expected)
+  (if
+    (= got expected)
+    (set! forth-test-pass (+ forth-test-pass 1))
+    (begin
+      (set! forth-test-fail (+ forth-test-fail 1))
+      (set! forth-test-fails (append forth-test-fails (list {:got got :expected expected :name name}))))))
+
+;; ---------------------------------------------------------------------------
+;; 1. Bitwise operations
+;; ---------------------------------------------------------------------------
+
+;; AND
+(forth-test "and 0b1100 0b1010" (forth-and 12 10) 8)
+(forth-test "and 0xFF 0x0F" (forth-and 255 15) 15)
+(forth-test "and 0 any" (forth-and 0 42) 0)
+
+;; OR
+(forth-test "or 0b1100 0b1010" (forth-or 12 10) 14)
+(forth-test "or 0 x" (forth-or 0 7) 7)
+
+;; XOR
+(forth-test "xor 0b1100 0b1010" (forth-xor 12 10) 6)
+(forth-test "xor x x" (forth-xor 42 42) 0)
+
+;; INVERT
+(forth-test "invert 0" (forth-invert 0) -1)
+(forth-test "invert -1" (forth-invert -1) 0)
+(forth-test "invert 1" (forth-invert 1) -2)
+
+;; LSHIFT RSHIFT
+(forth-test "lshift 1 3" (forth-lshift 1 3) 8)
+(forth-test "lshift 3 2" (forth-lshift 3 2) 12)
+(forth-test "rshift 8 3" (forth-rshift 8 3) 1)
+(forth-test "rshift 16 2" (forth-rshift 16 2) 4)
+
+;; 2* 2/
+(forth-test "2* 5" (forth-2* 5) 10)
+(forth-test "2/ 10" (forth-2/ 10) 5)
+(forth-test "2/ 7" (forth-2/ 7) 3)
+
+;; BIT-COUNT
+(forth-test "bit-count 0" (forth-bit-count 0) 0)
+(forth-test "bit-count 1" (forth-bit-count 1) 1)
+(forth-test "bit-count 7" (forth-bit-count 7) 3)
+(forth-test "bit-count 255" (forth-bit-count 255) 8)
+(forth-test "bit-count 256" (forth-bit-count 256) 1)
+
+;; INTEGER-LENGTH
+(forth-test "integer-length 0" (forth-integer-length 0) 0)
+(forth-test "integer-length 1" (forth-integer-length 1) 1)
+(forth-test "integer-length 4" (forth-integer-length 4) 3)
+(forth-test "integer-length 255" (forth-integer-length 255) 8)
+
+;; WITHIN
+(forth-test
+  "within 5 0 10"
+  (forth-within 5 0 10)
+  true)
+(forth-test
+  "within 0 0 10"
+  (forth-within 0 0 10)
+  true)
+(forth-test
+  "within 10 0 10"
+  (forth-within 10 0 10)
+  false)
+(forth-test
+  "within -1 0 10"
+  (forth-within -1 0 10)
+  false)
+
+;; Arithmetic ops
+(forth-test "negate 5" (forth-negate 5) -5)
+(forth-test "negate -3" (forth-negate -3) 3)
+(forth-test "abs -7" (forth-abs -7) 7)
+(forth-test "min 3 5" (forth-min 3 5) 3)
+(forth-test "max 3 5" (forth-max 3 5) 5)
+(forth-test "mod 7 3" (forth-mod 7 3) 1)
+(forth-test
+  "divmod 7 3"
+  (forth-divmod 7 3)
+  (list 1 2))
+(forth-test
+  "divmod 10 5"
+  (forth-divmod 10 5)
+  (list 0 2))
+
+;; ---------------------------------------------------------------------------
+;; 2. String buffer
+;; ---------------------------------------------------------------------------
+
+(define sb1 (forth-sb-new))
+(forth-test "sb? new" (forth-sb? sb1) true)
+(forth-test "sb? non-sb" (forth-sb? 42) false)
+(forth-test "sb value empty" (forth-sb-value sb1) "")
+(forth-test "sb length empty" (forth-sb-length sb1) 0)
+
+(forth-sb-type! sb1 "HELLO")
+(forth-test "sb type" (forth-sb-value sb1) "HELLO")
+(forth-test "sb length after type" (forth-sb-length sb1) 5)
+
+;; EMIT one char
+(define sb2 (forth-sb-new))
+(forth-sb-emit! sb2 (nth (string->list "A") 0))
+(forth-sb-emit! sb2 (nth (string->list "B") 0))
+(forth-sb-emit! sb2 (nth (string->list "C") 0))
+(forth-test "sb emit chars" (forth-sb-value sb2) "ABC")
+
+;; Emit integer
+(define sb3 (forth-sb-new))
+(forth-sb-type! sb3 "n=")
+(forth-sb-emit-int! sb3 42)
+(forth-test "sb emit-int" (forth-sb-value sb3) "n=42")
+
+(forth-sb-clear! sb1)
+(forth-test "sb clear" (forth-sb-value sb1) "")
+(forth-test "sb length after clear" (forth-sb-length sb1) 0)
+
+;; Build a word definition-style name
+(define sb4 (forth-sb-new))
+(forth-sb-type! sb4 ": ")
+(forth-sb-type! sb4 "SQUARE")
+(forth-sb-type! sb4 " DUP * ;")
+(forth-test "sb word def" (forth-sb-value sb4) ": SQUARE DUP * ;")
+
+;; ---------------------------------------------------------------------------
+;; 3. Memory / Bytevectors
+;; ---------------------------------------------------------------------------
+
+(define m1 (forth-mem-new 8))
+(forth-test "mem? yes" (forth-mem? m1) true)
+(forth-test "mem? no" (forth-mem? 42) false)
+(forth-test "mem size" (forth-mem-size m1) 8)
+(forth-test "mem cfetch zero" (forth-cfetch m1 0) 0)
+
+;; C! C@
+(forth-cstore m1 0 65)
+(forth-cstore m1 1 66)
+(forth-test "mem cstore/cfetch 0" (forth-cfetch m1 0) 65)
+(forth-test "mem cstore/cfetch 1" (forth-cfetch m1 1) 66)
+(forth-cstore m1 2 256)
+(forth-test
+  "mem cstore wraps 256→0"
+  (forth-cfetch m1 2)
+  0)
+(forth-cstore m1 2 257)
+(forth-test
+  "mem cstore wraps 257→1"
+  (forth-cfetch m1 2)
+  1)
+
+;; @ ! (32-bit LE cell)
+(define m2 (forth-mem-new 8))
+(forth-store m2 0 305419896)
+(forth-test "mem store/fetch" (forth-fetch m2 0) 305419896)
+(forth-store m2 4 1)
+(forth-test "mem fetch byte 4" (forth-cfetch m2 4) 1)
+(forth-test "mem fetch byte 5" (forth-cfetch m2 5) 0)
+
+;; FILL ERASE
+(define m3 (forth-mem-new 4))
+(forth-fill! m3 0 4 42)
+(forth-test
+  "mem fill"
+  (forth-mem->list m3 0 4)
+  (list 42 42 42 42))
+(forth-erase! m3 1 2)
+(forth-test
+  "mem erase middle"
+  (forth-mem->list m3 0 4)
+  (list 42 0 0 42))
+
+;; MOVE
+(define m4 (forth-mem-new 4))
+(forth-cstore m4 0 1)
+(forth-cstore m4 1 2)
+(forth-cstore m4 2 3)
+(define m5 (forth-mem-new 4))
+(forth-move! m4 0 m5 0 3)
+(forth-test
+  "mem move"
+  (forth-mem->list m5 0 3)
+  (list 1 2 3))
+
+;; mem->list
+(define m6 (forth-mem-new 3))
+(forth-cstore m6 0 10)
+(forth-cstore m6 1 20)
+(forth-cstore m6 2 30)
+(forth-test
+  "mem->list"
+  (forth-mem->list m6 0 3)
+  (list 10 20 30))