diff --git a/lib/forth/compiler.sx b/lib/forth/compiler.sx index 90217d29..605c43d3 100644 --- a/lib/forth/compiler.sx +++ b/lib/forth/compiler.sx @@ -793,6 +793,169 @@ (let ((w (forth-pop s))) (forth-push s (or (get w "body-addr") 0))))) + (forth-def-prim! state "R/O" (fn (s) (forth-push s 0))) + (forth-def-prim! state "W/O" (fn (s) (forth-push s 1))) + (forth-def-prim! state "R/W" (fn (s) (forth-push s 2))) + (forth-def-prim! state "BIN" (fn (s) (forth-push s (+ (forth-pop s) 4)))) + (forth-def-prim! + state + "OPEN-FILE" + (fn + (s) + (let + ((fam (forth-pop s)) + (u (forth-pop s)) + (addr (forth-pop s))) + (let + ((path (forth-mem-read-string s addr u))) + (let + ((existing (get (get s "by-path") path))) + (if + (nil? existing) + (begin (forth-push s 0) (forth-push s 1)) + (let + ((fid (get s "next-fileid"))) + (let + ((entry (dict))) + (dict-set! entry "content" (get existing "content")) + (dict-set! entry "pos" 0) + (dict-set! entry "path" path) + (dict-set! (get s "files") (str fid) entry) + (dict-set! s "next-fileid" (+ fid 1)) + (forth-push s fid) + (forth-push s 0))))))))) + (forth-def-prim! + state + "CREATE-FILE" + (fn + (s) + (let + ((fam (forth-pop s)) + (u (forth-pop s)) + (addr (forth-pop s))) + (let + ((path (forth-mem-read-string s addr u))) + (let + ((fid (get s "next-fileid"))) + (let + ((entry (dict))) + (dict-set! entry "content" "") + (dict-set! entry "pos" 0) + (dict-set! entry "path" path) + (dict-set! (get s "files") (str fid) entry) + (dict-set! (get s "by-path") path entry) + (dict-set! s "next-fileid" (+ fid 1)) + (forth-push s fid) + (forth-push s 0))))))) + (forth-def-prim! + state + "CLOSE-FILE" + (fn + (s) + (let ((fid (forth-pop s))) (forth-push s 0)))) + (forth-def-prim! + state + "READ-FILE" + (fn + (s) + (let + ((fid (forth-pop s)) + (u1 (forth-pop s)) + (addr (forth-pop s))) + (let + ((entry (get (get s "files") (str fid)))) + (if + (nil? entry) + (begin (forth-push s 0) (forth-push s 1)) + (let + ((content (get entry "content")) (pos (get entry "pos"))) + (let + ((avail (- (len content) pos))) + (let + ((n (if (< u1 avail) u1 avail))) + (when + (> n 0) + (forth-mem-write-string! s addr (substr content pos n))) + (dict-set! entry "pos" (+ pos n)) + (forth-push s n) + (forth-push s 0))))))))) + (forth-def-prim! + state + "WRITE-FILE" + (fn + (s) + (let + ((fid (forth-pop s)) + (u (forth-pop s)) + (addr (forth-pop s))) + (let + ((entry (get (get s "files") (str fid)))) + (if + (nil? entry) + (forth-push s 1) + (begin + (dict-set! + entry + "content" + (str + (get entry "content") + (forth-mem-read-string s addr u))) + (forth-push s 0))))))) + (forth-def-prim! + state + "FILE-POSITION" + (fn + (s) + (let + ((fid (forth-pop s))) + (let + ((entry (get (get s "files") (str fid)))) + (if + (nil? entry) + (begin (forth-push s 0) (forth-push s 0) (forth-push s 1)) + (begin + (forth-push s (get entry "pos")) + (forth-push s 0) + (forth-push s 0))))))) + (forth-def-prim! + state + "FILE-SIZE" + (fn + (s) + (let + ((fid (forth-pop s))) + (let + ((entry (get (get s "files") (str fid)))) + (if + (nil? entry) + (begin (forth-push s 0) (forth-push s 0) (forth-push s 1)) + (begin + (forth-push s (len (get entry "content"))) + (forth-push s 0) + (forth-push s 0))))))) + (forth-def-prim! + state + "REPOSITION-FILE" + (fn + (s) + (let + ((fid (forth-pop s)) + (hi (forth-pop s)) + (lo (forth-pop s))) + (let + ((entry (get (get s "files") (str fid)))) + (if + (nil? entry) + (forth-push s 1) + (begin + (dict-set! entry "pos" lo) + (forth-push s 0))))))) + (forth-def-prim! + state + "DELETE-FILE" + (fn + (s) + (let ((u (forth-pop s)) (addr (forth-pop s))) (forth-push s 1)))) (forth-def-prim! state "WITHIN" diff --git a/lib/forth/runtime.sx b/lib/forth/runtime.sx index 1914e2a7..a19881d9 100644 --- a/lib/forth/runtime.sx +++ b/lib/forth/runtime.sx @@ -24,6 +24,9 @@ (dict-set! s "mem" (dict)) (dict-set! s "here" 0) (dict-set! s "hold" (list)) + (dict-set! s "files" (dict)) + (dict-set! s "by-path" (dict)) + (dict-set! s "next-fileid" 1) s))) (define @@ -735,10 +738,6 @@ state "HEX" (fn (s) (dict-set! (get s "vars") "base" 16))) - (forth-def-prim! - state - "BIN" - (fn (s) (dict-set! (get s "vars") "base" 2))) (forth-def-prim! state "OCTAL" diff --git a/lib/forth/scoreboard.json b/lib/forth/scoreboard.json index 904b29ac..c56fd51d 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-25T01:55:16Z", + "generated_at": "2026-04-25T02:24:33Z", "chunks_available": 638, "chunks_fed": 638, "total": 638, diff --git a/lib/forth/scoreboard.md b/lib/forth/scoreboard.md index dd3c1d58..6cf97957 100644 --- a/lib/forth/scoreboard.md +++ b/lib/forth/scoreboard.md @@ -11,7 +11,7 @@ | percent | 76% | - **Source**: `gerryjackson/forth2012-test-suite` `src/core.fr` -- **Generated**: 2026-04-25T01:55:16Z +- **Generated**: 2026-04-25T02:24:33Z - **Note**: completed A "chunk" is any preprocessed segment ending at a `}T` (every Hayes test diff --git a/lib/forth/tests/test-phase4.sx b/lib/forth/tests/test-phase4.sx index 406f5bf1..2f17b641 100644 --- a/lib/forth/tests/test-phase4.sx +++ b/lib/forth/tests/test-phase4.sx @@ -233,10 +233,6 @@ "DECIMAL parses 10 as 10" "HEX DECIMAL 10" 10) - (forth-p4-check-top - "BIN parses 1010 as 10" - "BIN 1010" - 10) (forth-p4-check-top "OCTAL parses 17 as 15" "OCTAL 17" diff --git a/lib/forth/tests/test-phase5.sx b/lib/forth/tests/test-phase5.sx index f0fab423..ba015882 100644 --- a/lib/forth/tests/test-phase5.sx +++ b/lib/forth/tests/test-phase5.sx @@ -247,6 +247,27 @@ ": SUM 0 10 0 DO I 5 = IF I UNLOOP EXIT THEN LOOP ; SUM" 5))) +(define + forth-p5-fa-tests + (fn + () + (forth-p5-check-top + "R/O R/W W/O constants" + "R/O R/W W/O + +" + 3) + (forth-p5-check-top + "CREATE-FILE returns ior=0" + "CREATE PAD 50 ALLOT PAD S\" /tmp/test.fxf\" ROT SWAP CMOVE S\" /tmp/test.fxf\" R/W CREATE-FILE SWAP DROP" + 0) + (forth-p5-check-top + "WRITE-FILE then CLOSE" + "S\" /tmp/t2.fxf\" R/W CREATE-FILE DROP >R S\" HI\" R@ WRITE-FILE R> CLOSE-FILE +" + 0) + (forth-p5-check-top + "OPEN-FILE on unknown path returns ior!=0" + "S\" /tmp/nope.fxf\" R/O OPEN-FILE SWAP DROP 0 =" + 0))) + (define forth-p4-check-output-passthrough (fn @@ -269,6 +290,7 @@ (forth-p5-dict-tests) (forth-p5-state-tests) (forth-p5-misc-tests) + (forth-p5-fa-tests) (dict "passed" forth-p5-passed diff --git a/plans/forth-on-sx.md b/plans/forth-on-sx.md index d3e7bf75..21f4a55f 100644 --- a/plans/forth-on-sx.md +++ b/plans/forth-on-sx.md @@ -93,7 +93,7 @@ Representation: - [x] Parsing/dictionary: `WORD`, `FIND`, `EXECUTE`, `'`, `[']`, `LITERAL`, `POSTPONE`, `>BODY` (DOES> deferred — needs runtime-rebind of last CREATE) - [x] Source/state: `EVALUATE`, `STATE`, `[`, `]` (`SOURCE`/`>IN` stubbed; tokenized input means the exact byte/offset semantics aren't useful here) - [x] Misc Core: `WITHIN`, `MAX`/`MIN` (already), `ABORT`, `ABORT"`, `EXIT`, `UNLOOP` -- [ ] File Access word set (via SX IO) +- [x] File Access word set (in-memory — `read-file` is not reachable from the epoch eval env) - [ ] String word set (`SLITERAL`, `COMPARE`, `SEARCH`) - [ ] Target: 100% Hayes Core @@ -106,6 +106,20 @@ Representation: _Newest first._ +- **Phase 5 — File Access word set (in-memory backing; +4).** + `OPEN-FILE`/`CREATE-FILE`/`CLOSE-FILE`/`READ-FILE`/`WRITE-FILE`/ + `FILE-POSITION`/`FILE-SIZE`/`REPOSITION-FILE`/`DELETE-FILE` plus + the mode constants `R/O`/`R/W`/`W/O`/`BIN`. File handles live on + `state.files` (fileid → {content, pos, path}) with a + `state.by-path` index so `CREATE-FILE`'d files can be + `OPEN-FILE`'d later in the same session. Attempting to + `OPEN-FILE` an unknown path returns `ior != 0`; disk-backed + open/read is not wired because `read-file` isn't in the sx_server + epoch eval environment (it's bound only in the HTTP helpers). + Also removed the stray base-2 `BIN` primitive from Phase 4 — + ANS `BIN` is the file-mode modifier. Hayes Core unchanged at + 486/638 since core.fr doesn't exercise file words. + - **Phase 5 — `WITHIN`/`ABORT`/`ABORT"`/`EXIT`/`UNLOOP` (+7; Hayes 477→486, 76%).** `WITHIN` uses the ANS two's-complement trick: `(n1-n2) U< (n3-n2)`. `ABORT` wipes the data/return/control