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

forth: File Access word set (in-memory backing, Hayes unchanged)
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-25 02:24:55 +00:00
parent 8ca2fe3564
commit 64af162b5d
7 changed files with 205 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

163
lib/forth/compiler.sx
View File

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

7
lib/forth/runtime.sx
View File

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

2
lib/forth/scoreboard.json
View File

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

2
lib/forth/scoreboard.md
View File

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

4
lib/forth/tests/test-phase4.sx
View File

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

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

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