forth: Phase 5 memory + unsigned compare (Hayes 268→342, 53%)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled
This commit is contained in:
@@ -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.
|
||||
|
||||
@@ -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"
|
||||
}
|
||||
|
||||
@@ -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
|
||||
|
||||
101
lib/forth/tests/test-phase5.sx
Normal file
101
lib/forth/tests/test-phase5.sx
Normal file
@@ -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)))
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user