From 387a6e7f5d431bee6a3b067d69234e2060251f40 Mon Sep 17 00:00:00 2001
From: giles <giles.bradshaw@rose-ash.com>
Date: Fri, 24 Apr 2026 21:07:10 +0000
Subject: [PATCH] forth: SP@ / SP! (+4; Hayes 174/590)

---
 lib/forth/runtime.sx           | 13 +++++++++++++
 lib/forth/scoreboard.json      |  2 +-
 lib/forth/scoreboard.md        |  2 +-
 lib/forth/tests/test-phase4.sx | 19 +++++++++++++++++++
 plans/forth-on-sx.md           |  9 ++++++++-
 5 files changed, 42 insertions(+), 3 deletions(-)

diff --git a/lib/forth/runtime.sx b/lib/forth/runtime.sx
index 3eecbf8c..4ab5b6f8 100644
--- a/lib/forth/runtime.sx
+++ b/lib/forth/runtime.sx
@@ -393,6 +393,19 @@
         (s)
         (let ((a (forth-peek s))) (when (not (= a 0)) (forth-push s a)))))
     (forth-def-prim! state "DEPTH" (fn (s) (forth-push s (forth-depth s))))
+    (forth-def-prim! state "SP@" (fn (s) (forth-push s (forth-depth s))))
+    (forth-def-prim!
+      state
+      "SP!"
+      (fn
+        (s)
+        (let
+          ((n (forth-pop s)))
+          (let
+            ((cur (forth-depth s)))
+            (when
+              (> cur n)
+              (dict-set! s "dstack" (drop (get s "dstack") (- cur n))))))))
     (forth-def-prim!
       state
       "PICK"
diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json
index 351d8517..4cdbcb0d 100644
--- a/lib/forth/scoreboard.json
+++ b/lib/forth/scoreboard.json
@@ -1,6 +1,6 @@
 {
   "source": "gerryjackson/forth2012-test-suite src/core.fr",
-  "generated_at": "2026-04-24T20:39:51Z",
+  "generated_at": "2026-04-24T21:06:54Z",
   "chunks_available": 638,
   "chunks_fed": 590,
   "total": 590,
diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md
index d22e89ac..9ccebb0a 100644
--- a/lib/forth/scoreboard.md
+++ b/lib/forth/scoreboard.md
@@ -11,7 +11,7 @@
 | percent           | 29% |
 
 - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr`
-- **Generated**: 2026-04-24T20:39:51Z
+- **Generated**: 2026-04-24T21:06:54Z
 - **Note**: completed
 
 A "chunk" is any preprocessed segment ending at a `}T` (every Hayes test
diff --git a/lib/forth/tests/test-phase4.sx b/lib/forth/tests/test-phase4.sx
index 3bb3e8fc..1e24785a 100644
--- a/lib/forth/tests/test-phase4.sx
+++ b/lib/forth/tests/test-phase4.sx
@@ -171,6 +171,24 @@
       ((r (forth-run "1000 2 ACCEPT")))
       (let ((stk (nth r 2))) (forth-p4-assert "ACCEPT empty buf -> 0" (list 0) stk)))))
 
+(define
+  forth-p4-sp-tests
+  (fn
+    ()
+    (forth-p4-check-top "SP@ returns depth (0)" "SP@" 0)
+    (forth-p4-check-top
+      "SP@ after pushes"
+      "1 2 3 SP@ SWAP DROP SWAP DROP SWAP DROP"
+      3)
+    (forth-p4-check-stack-size
+      "SP! truncates"
+      "1 2 3 4 5 2 SP!"
+      2)
+    (forth-p4-check-top
+      "SP! leaves base items intact"
+      "1 2 3 4 5 2 SP!"
+      2)))
+
 (define
   forth-p4-base-tests
   (fn
@@ -227,6 +245,7 @@
     (forth-p4-char-tests)
     (forth-p4-key-accept-tests)
     (forth-p4-base-tests)
+    (forth-p4-sp-tests)
     (dict
       "passed"
       forth-p4-passed
diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md
index 13c2616c..a67dd360 100644
--- a/plans/forth-on-sx.md
+++ b/plans/forth-on-sx.md
@@ -81,7 +81,7 @@ Representation:
 - [x] `S"`, `C"`, `."`, `TYPE`, `COUNT`, `CMOVE`, `FILL`, `BLANK`
 - [x] `CHAR`, `[CHAR]`, `KEY`, `ACCEPT`
 - [x] `BASE` manipulation: `DECIMAL`, `HEX`
-- [ ] `DEPTH`, `SP@`, `SP!`
+- [x] `DEPTH`, `SP@`, `SP!`
 - [ ] Drive Hayes Core pass-rate up
 
 ### Phase 5 — Core Extension + optional word sets
@@ -99,6 +99,13 @@ Representation:
 
 _Newest first._
 
+- **Phase 4 — `SP@`/`SP!` (+4; Hayes unchanged; `DEPTH` was already present).**
+  `SP@` pushes the current data-stack depth (our closest analogue to a
+  stack pointer — SX lists have no addressable backing). `SP!` pops a
+  target depth and truncates the stack via `drop` on the dstack list.
+  This preserves the save/restore idiom `SP@ … SP!` even though the
+  returned "pointer" is really a count.
+
 - **Phase 4 — `BASE`/`DECIMAL`/`HEX`/`BIN`/`OCTAL` (+9; Hayes unchanged).**
   Moved `base` from its top-level state slot into `state.vars["base"]`
   so the regular `@`/`!`/VARIABLE machinery works on it.