diff --git a/lib/forth/runtime.sx b/lib/forth/runtime.sx index 3544f7df..51e5ac22 100644 --- a/lib/forth/runtime.sx +++ b/lib/forth/runtime.sx @@ -878,4 +878,125 @@ ((r (- d (* q n3)))) (forth-push s (forth-clip r)) (forth-push s (forth-clip q)))))))) + (forth-def-prim! + state + "D+" + (fn + (s) + (let + ((hi2 (forth-pop s)) + (lo2 (forth-pop s)) + (hi1 (forth-pop s)) + (lo1 (forth-pop s))) + (forth-double-push-s + s + (+ + (forth-double-from-cells-s lo1 hi1) + (forth-double-from-cells-s lo2 hi2)))))) + (forth-def-prim! + state + "D-" + (fn + (s) + (let + ((hi2 (forth-pop s)) + (lo2 (forth-pop s)) + (hi1 (forth-pop s)) + (lo1 (forth-pop s))) + (forth-double-push-s + s + (- + (forth-double-from-cells-s lo1 hi1) + (forth-double-from-cells-s lo2 hi2)))))) + (forth-def-prim! + state + "DNEGATE" + (fn + (s) + (let + ((hi (forth-pop s)) (lo (forth-pop s))) + (forth-double-push-s + s + (- 0 (forth-double-from-cells-s lo hi)))))) + (forth-def-prim! + state + "DABS" + (fn + (s) + (let + ((hi (forth-pop s)) (lo (forth-pop s))) + (forth-double-push-s s (abs (forth-double-from-cells-s lo hi)))))) + (forth-def-prim! + state + "D=" + (fn + (s) + (let + ((hi2 (forth-pop s)) + (lo2 (forth-pop s)) + (hi1 (forth-pop s)) + (lo1 (forth-pop s))) + (forth-push s (if (and (= lo1 lo2) (= hi1 hi2)) -1 0))))) + (forth-def-prim! + state + "D<" + (fn + (s) + (let + ((hi2 (forth-pop s)) + (lo2 (forth-pop s)) + (hi1 (forth-pop s)) + (lo1 (forth-pop s))) + (forth-push + s + (if + (< + (forth-double-from-cells-s lo1 hi1) + (forth-double-from-cells-s lo2 hi2)) + -1 + 0))))) + (forth-def-prim! + state + "D0=" + (fn + (s) + (let + ((hi (forth-pop s)) (lo (forth-pop s))) + (forth-push s (if (and (= lo 0) (= hi 0)) -1 0))))) + (forth-def-prim! + state + "D0<" + (fn + (s) + (let + ((hi (forth-pop s)) (lo (forth-pop s))) + (forth-push s (if (< hi 0) -1 0))))) + (forth-def-prim! + state + "DMAX" + (fn + (s) + (let + ((hi2 (forth-pop s)) + (lo2 (forth-pop s)) + (hi1 (forth-pop s)) + (lo1 (forth-pop s))) + (let + ((d1 (forth-double-from-cells-s lo1 hi1)) + (d2 (forth-double-from-cells-s lo2 hi2))) + (forth-double-push-s s (if (> d1 d2) d1 d2)))))) + (forth-def-prim! + state + "DMIN" + (fn + (s) + (let + ((hi2 (forth-pop s)) + (lo2 (forth-pop s)) + (hi1 (forth-pop s)) + (lo1 (forth-pop s))) + (let + ((d1 (forth-double-from-cells-s lo1 hi1)) + (d2 (forth-double-from-cells-s lo2 hi2))) + (forth-double-push-s s (if (< d1 d2) d1 d2)))))) state)) diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 069ced0c..864c0119 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-24T23:25:04Z", + "generated_at": "2026-04-24T23:52:16Z", "chunks_available": 638, "chunks_fed": 638, "total": 638, diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index 3d1e4360..ad0297d6 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -11,7 +11,7 @@ | percent | 69% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-24T23:25:04Z +- **Generated**: 2026-04-24T23:52: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 9197e626..e73f3ccd 100644 --- a/lib/forth/tests/test-phase5.sx +++ b/lib/forth/tests/test-phase5.sx @@ -112,6 +112,29 @@ (forth-p5-check-top "*/ truncated" "7 11 13 */" 5) (forth-p5-check-stack "*/MOD" "7 11 13 */MOD" (list 12 5)))) +(define + forth-p5-double-tests + (fn + () + (forth-p5-check-stack "D+ small" "5 0 7 0 D+" (list 12 0)) + (forth-p5-check-stack "D+ negative" "-5 -1 -3 -1 D+" (list -8 -1)) + (forth-p5-check-stack "D- small" "10 0 3 0 D-" (list 7 0)) + (forth-p5-check-stack "DNEGATE positive" "5 0 DNEGATE" (list -5 -1)) + (forth-p5-check-stack "DNEGATE negative" "-5 -1 DNEGATE" (list 5 0)) + (forth-p5-check-stack "DABS negative" "-7 -1 DABS" (list 7 0)) + (forth-p5-check-stack "DABS positive" "7 0 DABS" (list 7 0)) + (forth-p5-check-top "D= equal" "5 0 5 0 D=" -1) + (forth-p5-check-top "D= unequal lo" "5 0 7 0 D=" 0) + (forth-p5-check-top "D= unequal hi" "5 0 5 1 D=" 0) + (forth-p5-check-top "D< lt" "5 0 7 0 D<" -1) + (forth-p5-check-top "D< gt" "7 0 5 0 D<" 0) + (forth-p5-check-top "D0= zero" "0 0 D0=" -1) + (forth-p5-check-top "D0= nonzero" "5 0 D0=" 0) + (forth-p5-check-top "D0< neg" "-5 -1 D0<" -1) + (forth-p5-check-top "D0< pos" "5 0 D0<" 0) + (forth-p5-check-stack "DMAX" "5 0 7 0 DMAX" (list 7 0)) + (forth-p5-check-stack "DMIN" "5 0 7 0 DMIN" (list 5 0)))) + (define forth-p5-run-all (fn @@ -123,6 +146,7 @@ (forth-p5-unsigned-tests) (forth-p5-2bang-tests) (forth-p5-mixed-tests) + (forth-p5-double-tests) (dict "passed" forth-p5-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 6e693bef..4387ce47 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -88,7 +88,7 @@ Representation: - [x] Memory: `CREATE`, `HERE`, `ALLOT`, `,`, `C,`, `CELL+`, `CELLS`, `ALIGN`, `ALIGNED`, `2!`, `2@` - [x] Unsigned compare: `U<`, `U>` - [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` +- [x] 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`, `[`, `]` @@ -106,6 +106,15 @@ Representation: _Newest first._ +- **Phase 5 — double-cell ops `D+`/`D-`/`DNEGATE`/`DABS`/`D=`/`D<`/`D0=`/ + `D0<`/`DMAX`/`DMIN` (+18; Hayes unchanged).** Doubles get rebuilt + from `(lo, hi)` cells via `forth-double-from-cells-s`, the op runs + in bignum, and we push back via `forth-double-push-s`. Hayes Core + doesn't exercise D-words (those live in Gerry Jackson's separate + `doublest.fth` Double word-set tests we have not vendored), so the + scoreboard stays at 446/638 — but the words now exist for any + consumer that needs them. + - **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.