From 47f66ad1bea609be4a42ea84b81e697356119d8a Mon Sep 17 00:00:00 2001 From: giles Date: Sat, 25 Apr 2026 00:23:04 +0000 Subject: [PATCH] forth: pictured numeric output <#/#/#S/#>/HOLD/SIGN + U./U.R/.R (Hayes 448/638, 70%) --- lib/forth/runtime.sx | 185 +++++++++++++++++++++++++++++++++ lib/forth/scoreboard.json | 10 +- lib/forth/scoreboard.md | 10 +- lib/forth/tests/test-phase5.sx | 48 +++++++++ plans/forth-on-sx.md | 12 ++- 5 files changed, 254 insertions(+), 11 deletions(-) diff --git a/lib/forth/runtime.sx b/lib/forth/runtime.sx index 51e5ac22..3e92eb97 100644 --- a/lib/forth/runtime.sx +++ b/lib/forth/runtime.sx @@ -23,6 +23,7 @@ (dict-set! s "cstack" (list)) (dict-set! s "mem" (dict)) (dict-set! s "here" 0) + (dict-set! s "hold" (list)) s))) (define @@ -311,6 +312,85 @@ (forth-push state (forth-from-unsigned lo 32)) (forth-push state (forth-from-unsigned hi 32))))) +(define + forth-num-to-string-loop + (fn + (u base acc) + (if + (= u 0) + acc + (let + ((dig (mod u base)) (rest (floor (/ u base)))) + (let + ((ch + (if + (< dig 10) + (char-from-code (+ 48 dig)) + (char-from-code (+ 55 dig))))) + (forth-num-to-string-loop rest base (str ch acc))))))) + +(define + forth-num-to-string + (fn + (u base) + (if (= u 0) "0" (forth-num-to-string-loop u base "")))) + +(define + forth-spaces-str + (fn + (n) + (if (<= n 0) "" (str " " (forth-spaces-str (- n 1)))))) + +(define + forth-join-hold + (fn + (parts) + (forth-join-hold-loop parts ""))) + +(define + forth-join-hold-loop + (fn + (parts acc) + (if + (= (len parts) 0) + acc + (forth-join-hold-loop (rest parts) (str acc (first parts)))))) + +(define + forth-pic-step + (fn + (state) + (let + ((hi (forth-pop state)) (lo (forth-pop state))) + (let + ((d (forth-double-from-cells-u lo hi)) + (b (get (get state "vars") "base"))) + (let + ((dig (mod d b)) (rest (floor (/ d b)))) + (let + ((ch + (if + (< dig 10) + (char-from-code (+ 48 dig)) + (char-from-code (+ 55 dig))))) + (dict-set! state "hold" (cons ch (get state "hold"))) + (forth-double-push-u state rest))))))) + +(define + forth-pic-S-loop + (fn + (state) + (forth-pic-step state) + (let + ((hi (forth-pop state)) (lo (forth-pop state))) + (if + (and (= lo 0) (= hi 0)) + (begin (forth-push state 0) (forth-push state 0)) + (begin + (forth-push state lo) + (forth-push state hi) + (forth-pic-S-loop state)))))) + (define forth-double-push-s (fn @@ -999,4 +1079,109 @@ ((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 "<#" (fn (s) (dict-set! s "hold" (list)))) + (forth-def-prim! + state + "HOLD" + (fn + (s) + (let + ((c (forth-pop s))) + (dict-set! + s + "hold" + (cons (char-from-code c) (get s "hold")))))) + (forth-def-prim! + state + "SIGN" + (fn + (s) + (let + ((n (forth-pop s))) + (when + (< n 0) + (dict-set! s "hold" (cons "-" (get s "hold"))))))) + (forth-def-prim! + state + "#" + (fn + (s) + (let + ((hi (forth-pop s)) (lo (forth-pop s))) + (let + ((d (forth-double-from-cells-u lo hi)) + (b (get (get s "vars") "base"))) + (let + ((dig (mod d b)) (rest (floor (/ d b)))) + (let + ((ch + (if + (< dig 10) + (char-from-code (+ 48 dig)) + (char-from-code (+ 55 dig))))) + (dict-set! s "hold" (cons ch (get s "hold"))) + (forth-double-push-u s rest))))))) + (forth-def-prim! + state + "#S" + (fn + (s) + (forth-pic-S-loop s))) + (forth-def-prim! + state + "#>" + (fn + (s) + (forth-pop s) + (forth-pop s) + (let + ((str-out (forth-join-hold (get s "hold")))) + (let + ((addr (forth-alloc-bytes! s (len str-out)))) + (forth-mem-write-string! s addr str-out) + (forth-push s addr) + (forth-push s (len str-out)))))) + (forth-def-prim! + state + "U." + (fn + (s) + (let + ((u (forth-to-unsigned (forth-pop s) 32)) + (b (get (get s "vars") "base"))) + (forth-emit-str s (str (forth-num-to-string u b) " "))))) + (forth-def-prim! + state + "U.R" + (fn + (s) + (let + ((width (forth-pop s)) + (u (forth-to-unsigned (forth-pop s) 32)) + (b (get (get s "vars") "base"))) + (let + ((digits (forth-num-to-string u b))) + (forth-emit-str + s + (forth-spaces-str (- width (len digits)))) + (forth-emit-str s digits))))) + (forth-def-prim! + state + ".R" + (fn + (s) + (let + ((width (forth-pop s)) + (n (forth-pop s)) + (b (get (get s "vars") "base"))) + (let + ((sign-prefix (if (< n 0) "-" "")) + (abs-digits + (forth-num-to-string (forth-to-unsigned (abs n) 32) b))) + (let + ((digits (str sign-prefix abs-digits))) + (forth-emit-str + s + (forth-spaces-str (- width (len digits)))) + (forth-emit-str s digits)))))) state)) diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 864c0119..0f3f391c 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-24T23:52:16Z", + "generated_at": "2026-04-25T00:22:42Z", "chunks_available": 638, "chunks_fed": 638, "total": 638, - "pass": 446, - "fail": 7, - "error": 185, - "percent": 69, + "pass": 448, + "fail": 8, + "error": 182, + "percent": 70, "note": "completed" } diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index ad0297d6..8fec6650 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -5,13 +5,13 @@ | chunks available | 638 | | chunks fed | 638 | | total | 638 | -| pass | 446 | -| fail | 7 | -| error | 185 | -| percent | 69% | +| pass | 448 | +| fail | 8 | +| error | 182 | +| percent | 70% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-24T23:52:16Z +- **Generated**: 2026-04-25T00:22:42Z - **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 e73f3ccd..70cc26a8 100644 --- a/lib/forth/tests/test-phase5.sx +++ b/lib/forth/tests/test-phase5.sx @@ -135,6 +135,53 @@ (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-format-tests + (fn + () + (forth-p4-check-output-passthrough + "U. prints with trailing space" + "123 U." + "123 ") + (forth-p4-check-output-passthrough + "<# #S #> TYPE — decimal" + "123 0 <# #S #> TYPE" + "123") + (forth-p4-check-output-passthrough + "<# #S #> TYPE — hex" + "255 HEX 0 <# #S #> TYPE" + "FF") + (forth-p4-check-output-passthrough + "<# # # #> partial" + "1234 0 <# # # #> TYPE" + "34") + (forth-p4-check-output-passthrough + "SIGN holds minus" + "<# -1 SIGN -1 SIGN 0 0 #> TYPE" + "--") + (forth-p4-check-output-passthrough + ".R right-justifies" + "42 5 .R" + " 42") + (forth-p4-check-output-passthrough + ".R negative" + "-42 5 .R" + " -42") + (forth-p4-check-output-passthrough + "U.R" + "42 5 U.R" + " 42") + (forth-p4-check-output-passthrough + "HOLD char" + "<# 0 0 65 HOLD #> TYPE" + "A"))) + +(define + forth-p4-check-output-passthrough + (fn + (label src expected) + (let ((r (forth-run src))) (forth-p5-assert label expected (nth r 1))))) + (define forth-p5-run-all (fn @@ -147,6 +194,7 @@ (forth-p5-2bang-tests) (forth-p5-mixed-tests) (forth-p5-double-tests) + (forth-p5-format-tests) (dict "passed" forth-p5-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index 4387ce47..4a26c02e 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -89,7 +89,7 @@ Representation: - [x] Unsigned compare: `U<`, `U>` - [x] Mixed/double-cell math: `S>D`, `M*`, `UM*`, `UM/MOD`, `FM/MOD`, `SM/REM`, `*/`, `*/MOD` - [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` +- [x] 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` @@ -106,6 +106,16 @@ Representation: _Newest first._ +- **Phase 5 — pictured numeric output: `<#`/`#`/`#S`/`#>`/`HOLD`/`SIGN` + + `U.`/`U.R`/`.R` (+9; Hayes 446→448, 70%).** Added a `state.hold` + list of single-character strings — `<#` resets it, `HOLD` and + `SIGN` prepend, `#` divides ud by BASE and prepends one digit, + `#S` loops `#` until ud is zero (running once even on zero), + `#>` drops ud and copies the joined hold buffer into mem, + pushing `(addr, len)`. `U.` / `.R` / `U.R` use a separate + `forth-num-to-string` for one-shot decimal/hex output and + `forth-spaces-str` for right-justify padding. + - **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