diff --git a/lib/forth/runtime.sx b/lib/forth/runtime.sx index d918cf3d..3544f7df 100644 --- a/lib/forth/runtime.sx +++ b/lib/forth/runtime.sx @@ -285,6 +285,56 @@ (forth-to-unsigned n forth-bits-width) forth-bits-width))) +;; Double-cell helpers. Single = 32-bit signed, double = 64-bit signed +;; represented on the data stack as (lo, hi) where hi is on top. +;; Reassembly converts the low cell as unsigned and the high cell as +;; signed (signed) or as unsigned (unsigned), then combines. +(define forth-2pow32 (pow 2 32)) +(define forth-2pow64 (pow 2 64)) + +(define + forth-double-from-cells-u + (fn + (lo hi) + (+ (forth-to-unsigned lo 32) (* (forth-to-unsigned hi 32) forth-2pow32)))) + +(define + forth-double-from-cells-s + (fn (lo hi) (+ (forth-to-unsigned lo 32) (* hi forth-2pow32)))) + +(define + forth-double-push-u + (fn + (state d) + (let + ((lo (mod d forth-2pow32)) (hi (floor (/ d forth-2pow32)))) + (forth-push state (forth-from-unsigned lo 32)) + (forth-push state (forth-from-unsigned hi 32))))) + +(define + forth-double-push-s + (fn + (state d) + (if + (>= d 0) + (forth-double-push-u state d) + (let + ((q (- 0 d))) + (let + ((qlo (mod q forth-2pow32)) (qhi (floor (/ q forth-2pow32)))) + (if + (= qlo 0) + (begin + (forth-push state 0) + (forth-push state (forth-from-unsigned (- forth-2pow32 qhi) 32))) + (begin + (forth-push + state + (forth-from-unsigned (- forth-2pow32 qlo) 32)) + (forth-push + state + (forth-from-unsigned (- (- forth-2pow32 qhi) 1) 32))))))))) + (define forth-to-unsigned (fn (n w) (let ((m (pow 2 w))) (mod (+ (mod n m) m) m)))) @@ -728,4 +778,104 @@ (or (<= dst src) (>= dst (+ src u))) (forth-cmove-loop s src dst u 0) (forth-cmove-loop-desc s src dst u (- u 1)))))) + (forth-def-prim! + state + "S>D" + (fn + (s) + (let + ((n (forth-pop s))) + (forth-push s n) + (forth-push s (if (< n 0) -1 0))))) + (forth-def-prim! state "D>S" (fn (s) (forth-pop s))) + (forth-def-prim! + state + "M*" + (fn + (s) + (let + ((b (forth-pop s)) (a (forth-pop s))) + (forth-double-push-s s (* a b))))) + (forth-def-prim! + state + "UM*" + (fn + (s) + (let + ((b (forth-pop s)) (a (forth-pop s))) + (forth-double-push-u + s + (* (forth-to-unsigned a 32) (forth-to-unsigned b 32)))))) + (forth-def-prim! + state + "UM/MOD" + (fn + (s) + (let + ((u1 (forth-pop s)) (hi (forth-pop s)) (lo (forth-pop s))) + (let + ((d (forth-double-from-cells-u lo hi)) + (divisor (forth-to-unsigned u1 32))) + (when (= divisor 0) (forth-error s "division by zero")) + (let + ((q (floor (/ d divisor))) (r (mod d divisor))) + (forth-push s (forth-from-unsigned r 32)) + (forth-push s (forth-from-unsigned q 32))))))) + (forth-def-prim! + state + "FM/MOD" + (fn + (s) + (let + ((n (forth-pop s)) (hi (forth-pop s)) (lo (forth-pop s))) + (let + ((d (forth-double-from-cells-s lo hi))) + (when (= n 0) (forth-error s "division by zero")) + (let + ((q (floor (/ d n)))) + (let + ((r (- d (* q n)))) + (forth-push s (forth-clip r)) + (forth-push s (forth-clip q)))))))) + (forth-def-prim! + state + "SM/REM" + (fn + (s) + (let + ((n (forth-pop s)) (hi (forth-pop s)) (lo (forth-pop s))) + (let + ((d (forth-double-from-cells-s lo hi))) + (when (= n 0) (forth-error s "division by zero")) + (let + ((q (forth-trunc (/ d n)))) + (let + ((r (- d (* q n)))) + (forth-push s (forth-clip r)) + (forth-push s (forth-clip q)))))))) + (forth-def-prim! + state + "*/" + (fn + (s) + (let + ((n3 (forth-pop s)) (n2 (forth-pop s)) (n1 (forth-pop s))) + (when (= n3 0) (forth-error s "division by zero")) + (forth-push s (forth-clip (forth-trunc (/ (* n1 n2) n3))))))) + (forth-def-prim! + state + "*/MOD" + (fn + (s) + (let + ((n3 (forth-pop s)) (n2 (forth-pop s)) (n1 (forth-pop s))) + (when (= n3 0) (forth-error s "division by zero")) + (let + ((d (* n1 n2))) + (let + ((q (forth-trunc (/ d n3)))) + (let + ((r (- d (* q n3)))) + (forth-push s (forth-clip r)) + (forth-push s (forth-clip q)))))))) state)) diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 83991a0f..069ced0c 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:54:53Z", + "generated_at": "2026-04-24T23:25:04Z", "chunks_available": 638, "chunks_fed": 638, "total": 638, - "pass": 342, - "fail": 4, - "error": 292, - "percent": 53, + "pass": 446, + "fail": 7, + "error": 185, + "percent": 69, "note": "completed" } diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index 9edc4438..3d1e4360 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -5,13 +5,13 @@ | chunks available | 638 | | chunks fed | 638 | | total | 638 | -| pass | 342 | -| fail | 4 | -| error | 292 | -| percent | 53% | +| pass | 446 | +| fail | 7 | +| error | 185 | +| percent | 69% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-24T22:54:53Z +- **Generated**: 2026-04-24T23:25:04Z - **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 255fb64f..9197e626 100644 --- a/lib/forth/tests/test-phase5.sx +++ b/lib/forth/tests/test-phase5.sx @@ -82,6 +82,36 @@ "CREATE X 0 , 0 , 11 22 X 2! X 2@" (list 11 22)))) +(define + forth-p5-mixed-tests + (fn + () + (forth-p5-check-stack "S>D positive" "5 S>D" (list 5 0)) + (forth-p5-check-stack "S>D negative" "-5 S>D" (list -5 -1)) + (forth-p5-check-stack "S>D zero" "0 S>D" (list 0 0)) + (forth-p5-check-top "D>S keeps low" "5 0 D>S" 5) + (forth-p5-check-stack "M* small positive" "3 4 M*" (list 12 0)) + (forth-p5-check-stack "M* negative" "-3 4 M*" (list -12 -1)) + (forth-p5-check-stack + "M* negative * negative" + "-3 -4 M*" + (list 12 0)) + (forth-p5-check-stack "UM* small" "3 4 UM*" (list 12 0)) + (forth-p5-check-stack + "UM/MOD: 100 0 / 5" + "100 0 5 UM/MOD" + (list 0 20)) + (forth-p5-check-stack + "FM/MOD: -7 / 2 floored" + "-7 -1 2 FM/MOD" + (list 1 -4)) + (forth-p5-check-stack + "SM/REM: -7 / 2 truncated" + "-7 -1 2 SM/REM" + (list -1 -3)) + (forth-p5-check-top "*/ truncated" "7 11 13 */" 5) + (forth-p5-check-stack "*/MOD" "7 11 13 */MOD" (list 12 5)))) + (define forth-p5-run-all (fn @@ -92,6 +122,7 @@ (forth-p5-create-tests) (forth-p5-unsigned-tests) (forth-p5-2bang-tests) + (forth-p5-mixed-tests) (dict "passed" forth-p5-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 719c139e..6e693bef 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -87,7 +87,7 @@ Representation: ### Phase 5 — Core Extension + optional word sets - [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` +- [x] 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>` @@ -106,6 +106,16 @@ Representation: _Newest first._ +- **Phase 5 — mixed/double-cell math; Hayes 342→446 (69%).** Added + `S>D`, `D>S`, `M*`, `UM*`, `UM/MOD`, `FM/MOD`, `SM/REM`, `*/`, `*/MOD`. + Doubles ride on the stack as `(lo, hi)` with `hi` on top. + Helpers `forth-double-push-{u,s}` / `forth-double-from-cells-{u,s}` + split & rebuild via 32-bit unsigned mod/div, picking the negative + path explicitly so we don't form `2^64 + small` (float precision + drops at ULP=2^12 once you cross 2^64). `M*`/`UM*` use bignum + multiply then split; `*/`/`*/MOD` use bignum intermediate and + truncated division. Hayes: 446 pass / 185 error / 7 fail. + - **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