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

forth: Phase 5 memory + unsigned compare (Hayes 268→342, 53%)
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-24 22:56:26 +00:00
parent 8e1466032a
commit 3ab01b271d
5 changed files with 216 additions and 15 deletions
Download Patch File Download Diff File Expand all files Collapse all files

91
lib/forth/compiler.sx
View File

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