From 8ca2fe3564d29c426078f08b47ff7ee31ef281af Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 01:55:38 +0000 Subject: [PATCH] forth: WITHIN/ABORT/ABORT"/EXIT/UNLOOP (+7; Hayes 486/638, 76%) --- lib/forth/compiler.sx | 65 ++++++++++++++++++++++++++++++++++ lib/forth/scoreboard.json | 8 ++--- lib/forth/scoreboard.md | 8 ++--- lib/forth/tests/test-phase5.sx | 22 ++++++++++++ plans/forth-on-sx.md | 13 ++++++- 5 files changed, 107 insertions(+), 9 deletions(-) diff --git a/lib/forth/compiler.sx b/lib/forth/compiler.sx index 8c2af657..90217d29 100644 --- a/lib/forth/compiler.sx +++ b/lib/forth/compiler.sx @@ -122,6 +122,8 @@ (forth-loop-step s op pc)) ((and (dict? op) (= (get op "kind") "+loop")) (forth-plusloop-step s op pc)) + ((and (dict? op) (= (get op "kind") "exit")) + (dict-set! pc "v" 1000000000)) (else (begin (op s) (dict-set! pc "v" (+ (get pc "v") 1))))))) (define @@ -791,6 +793,69 @@ (let ((w (forth-pop s))) (forth-push s (or (get w "body-addr") 0))))) + (forth-def-prim! + state + "WITHIN" + (fn + (s) + (let + ((n3 (forth-pop s)) (n2 (forth-pop s)) (n1 (forth-pop s))) + (let + ((a (forth-to-unsigned (- n1 n2) 32)) + (b (forth-to-unsigned (- n3 n2) 32))) + (forth-push s (if (< a b) -1 0)))))) + (forth-def-prim! + state + "ABORT" + (fn + (s) + (dict-set! s "dstack" (list)) + (dict-set! s "rstack" (list)) + (dict-set! s "cstack" (list)) + (forth-error s "ABORT"))) + (forth-def-prim-imm! + state + "ABORT\"" + (fn + (s) + (let + ((msg (forth-parse-quote s))) + (if + (get s "compiling") + (forth-def-append! + s + (fn + (ss) + (when + (not (= (forth-pop ss) 0)) + (begin + (dict-set! ss "dstack" (list)) + (dict-set! ss "rstack" (list)) + (dict-set! ss "cstack" (list)) + (forth-error ss (str "ABORT: " msg)))))) + (when + (not (= (forth-pop s) 0)) + (begin + (dict-set! s "dstack" (list)) + (dict-set! s "rstack" (list)) + (dict-set! s "cstack" (list)) + (forth-error s (str "ABORT: " msg)))))))) + (forth-def-prim-imm! + state + "EXIT" + (fn + (s) + (when + (not (get s "compiling")) + (forth-error s "EXIT outside definition")) + (let + ((op (dict))) + (dict-set! op "kind" "exit") + (forth-def-append! s op)))) + (forth-def-prim! + state + "UNLOOP" + (fn (s) (forth-rpop s) (forth-rpop s))) (forth-def-prim-imm! state "[" diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 0da494f6..904b29ac 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-25T01:22:10Z", + "generated_at": "2026-04-25T01:55:16Z", "chunks_available": 638, "chunks_fed": 638, "total": 638, - "pass": 477, + "pass": 486, "fail": 14, - "error": 147, - "percent": 74, + "error": 138, + "percent": 76, "note": "completed" } diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index d1eedc5b..dd3c1d58 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -5,13 +5,13 @@ | chunks available | 638 | | chunks fed | 638 | | total | 638 | -| pass | 477 | +| pass | 486 | | fail | 14 | -| error | 147 | -| percent | 74% | +| error | 138 | +| percent | 76% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-25T01:22:10Z +- **Generated**: 2026-04-25T01:55:16Z - **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 index fbc22ffe..f0fab423 100644 --- a/lib/forth/tests/test-phase5.sx +++ b/lib/forth/tests/test-phase5.sx @@ -226,6 +226,27 @@ ": A 100 ; : B S\" A\" EVALUATE ; B" 100))) +(define + forth-p5-misc-tests + (fn + () + (forth-p5-check-top "WITHIN inclusive lower" "3 2 10 WITHIN" -1) + (forth-p5-check-top "WITHIN exclusive upper" "10 2 10 WITHIN" 0) + (forth-p5-check-top "WITHIN below range" "1 2 10 WITHIN" 0) + (forth-p5-check-top "WITHIN at lower" "2 2 10 WITHIN" -1) + (forth-p5-check-top + "EXIT leaves colon-def early" + ": F 5 EXIT 99 ; F" + 5) + (forth-p5-check-stack + "EXIT in IF branch" + ": F 5 0 IF DROP 99 EXIT THEN ; F" + (list 5)) + (forth-p5-check-top + "UNLOOP + EXIT in DO" + ": SUM 0 10 0 DO I 5 = IF I UNLOOP EXIT THEN LOOP ; SUM" + 5))) + (define forth-p4-check-output-passthrough (fn @@ -247,6 +268,7 @@ (forth-p5-format-tests) (forth-p5-dict-tests) (forth-p5-state-tests) + (forth-p5-misc-tests) (dict "passed" forth-p5-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 04779e73..d3e7bf75 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -92,7 +92,7 @@ Representation: - [x] Number formatting: `<#`, `#`, `#S`, `#>`, `HOLD`, `SIGN`, `.R`, `U.`, `U.R` - [x] Parsing/dictionary: `WORD`, `FIND`, `EXECUTE`, `'`, `[']`, `LITERAL`, `POSTPONE`, `>BODY` (DOES> deferred — needs runtime-rebind of last CREATE) - [x] Source/state: `EVALUATE`, `STATE`, `[`, `]` (`SOURCE`/`>IN` stubbed; tokenized input means the exact byte/offset semantics aren't useful here) -- [ ] Misc Core: `WITHIN`, `MAX`/`MIN` (already), `ABORT`, `ABORT"`, `EXIT`, `UNLOOP` +- [x] 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 @@ -106,6 +106,17 @@ Representation: _Newest first._ +- **Phase 5 — `WITHIN`/`ABORT`/`ABORT"`/`EXIT`/`UNLOOP` (+7; + Hayes 477→486, 76%).** `WITHIN` uses the ANS two's-complement + trick: `(n1-n2) U< (n3-n2)`. `ABORT` wipes the data/return/control + stacks and raises — the conformance runner catches it at the + chunk boundary. `ABORT"` parses its message like `S"`, then at + runtime pops a flag and raises only if truthy. `EXIT` adds a new + `:kind "exit"` op that the PC-driven body runner treats as a + jump-to-end; added a matching cond clause in `forth-step-op`. + `UNLOOP` pops two from the return stack — usable paired with + `EXIT` to bail from inside `DO`/`LOOP`. + - **Phase 5 — `[`, `]`, `STATE`, `EVALUATE` (+5; Hayes 463→477, 74%).** `[` (IMMEDIATE) clears `state.compiling`, `]` sets it. `STATE` pushes the sentinel address `"@@state"` and `@` reads it as