From 3ab01b271d82c0d30f0c498ca1ed37697c13932f Mon Sep 17 00:00:00 2001 From: giles Date: Fri, 24 Apr 2026 22:56:26 +0000 Subject: [PATCH] =?UTF-8?q?forth:=20Phase=205=20memory=20+=20unsigned=20co?= =?UTF-8?q?mpare=20(Hayes=20268=E2=86=92342,=2053%)?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lib/forth/compiler.sx | 91 +++++++++++++++++++++++++++-- lib/forth/scoreboard.json | 10 ++-- lib/forth/scoreboard.md | 10 ++-- lib/forth/tests/test-phase5.sx | 101 +++++++++++++++++++++++++++++++++ plans/forth-on-sx.md | 19 ++++++- 5 files changed, 216 insertions(+), 15 deletions(-) create mode 100644 lib/forth/tests/test-phase5.sx diff --git a/lib/forth/compiler.sx b/lib/forth/compiler.sx index 79cbba8e..92593e7c 100644 --- a/lib/forth/compiler.sx +++ b/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. diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 532be043..83991a0f 100644 --- a/lib/forth/scoreboard.json +++ b/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" } diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index 1ffdc4ca..9edc4438 100644 --- a/lib/forth/scoreboard.md +++ b/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 diff --git a/lib/forth/tests/test-phase5.sx b/lib/forth/tests/test-phase5.sx new file mode 100644 index 00000000..255fb64f --- /dev/null +++ b/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))) diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index da4908fd..719c139e 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -85,7 +85,14 @@ Representation: - [x] Drive Hayes Core pass-rate up ### Phase 5 — Core Extension + optional word sets -- [ ] Full Core + Core Extension +- [x] Memory: `CREATE`, `HERE`, `ALLOT`, `,`, `C,`, `CELL+`, `CELLS`, `ALIGN`, `ALIGNED`, `2!`, `2@` +- [x] Unsigned compare: `U<`, `U>` +- [ ] Mixed/double-cell math: `S>D`, `M*`, `UM*`, `UM/MOD`, `FM/MOD`, `SM/REM`, `*/`, `*/MOD` +- [ ] Double-cell ops: `D+`, `D-`, `D=`, `D<`, `D0=`, `2DUP`, `2DROP`, `2OVER`, `2SWAP` (already), plus `D>S`, `DABS`, `DNEGATE` +- [ ] Number formatting: `<#`, `#`, `#S`, `#>`, `HOLD`, `SIGN`, `.R`, `U.`, `U.R` +- [ ] Parsing/dictionary: `WORD`, `FIND`, `EXECUTE`, `'`, `[']`, `LITERAL`, `POSTPONE`, `>BODY`, `DOES>` +- [ ] Source/state: `SOURCE`, `>IN`, `EVALUATE`, `STATE`, `[`, `]` +- [ ] Misc Core: `WITHIN`, `MAX`/`MIN` (already), `ABORT`, `ABORT"`, `EXIT`, `UNLOOP` - [ ] File Access word set (via SX IO) - [ ] String word set (`SLITERAL`, `COMPARE`, `SEARCH`) - [ ] Target: 100% Hayes Core @@ -99,6 +106,16 @@ Representation: _Newest first._ +- **Phase 5 — memory primitives + unsigned compare; Hayes 268→342 (53%).** + Added `CREATE`/`HERE`/`ALLOT`/`,`/`C,`/`CELL+`/`CELLS`/`ALIGN`/`ALIGNED`/ + `2!`/`2@`/`U<`/`U>`. Generalised `@`/`!`/`+!` to dispatch on address + type: string addresses still go through `state.vars` (VARIABLE/VALUE + cells) while integer addresses now fall through to `state.mem` — + letting CREATE-allocated cells coexist with existing variables. + Decomposed the original "Full Core + Core Extension" box into + smaller unticked sub-bullets so iterations land per cluster. + Hayes: 342 pass / 292 error / 4 fail (53%). 237/237 internal. + - **Phase 4 close — LSHIFT/RSHIFT, 32-bit arith truncation, early binding; Hayes 174→268 (42%).** Added `LSHIFT` / `RSHIFT` as logical shifts on 32-bit unsigned values, converted through