coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions 7 Packages Projects Releases Wiki Activity

forth: double-cell ops D+/D-/DNEGATE/DABS/D=/D</D0=/D0</DMAX/DMIN (+18)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Details

Browse Source
This commit is contained in:
giles
2026-04-24 23:52:43 +00:00
parent b6810e90ab
commit c726a9e0fe
5 changed files with 157 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

121
lib/forth/runtime.sx
View File

@@ -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))

2
lib/forth/scoreboard.json
View File

@@ -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,

2
lib/forth/scoreboard.md
View File

@@ -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

24
lib/forth/tests/test-phase5.sx
View File

@@ -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

11
plans/forth-on-sx.md
View File

@@ -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.