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"