forth: DO/LOOP/+LOOP/I/J/LEAVE + return stack words (+16)
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Has been cancelled

This commit is contained in:
2026-04-24 17:58:37 +00:00
parent bb16477fd4
commit e066e14267
4 changed files with 272 additions and 2 deletions

View File

@@ -449,4 +449,42 @@
(> n 0)
(for-each (fn (_) (forth-emit-str s " ")) (range 0 n))))))
(forth-def-prim! state "BL" (fn (s) (forth-push s 32)))
(forth-def-prim! state "I" (fn (s) (forth-push s (forth-rpeek s))))
(forth-def-prim!
state
"J"
(fn (s) (forth-push s (nth (get s "rstack") 2))))
(forth-def-prim! state ">R" (fn (s) (forth-rpush s (forth-pop s))))
(forth-def-prim! state "R>" (fn (s) (forth-push s (forth-rpop s))))
(forth-def-prim! state "R@" (fn (s) (forth-push s (forth-rpeek s))))
(forth-def-prim!
state
"2>R"
(fn
(s)
(let
((b (forth-pop s)) (a (forth-pop s)))
(forth-rpush s a)
(forth-rpush s b))))
(forth-def-prim!
state
"2R>"
(fn
(s)
(let
((b (forth-rpop s)) (a (forth-rpop s)))
(forth-push s a)
(forth-push s b))))
(forth-def-prim!
state
"2R@"
(fn
(s)
(let
((rs (get s "rstack")))
(when
(< (len rs) 2)
(forth-error s "return stack underflow"))
(forth-push s (nth rs 1))
(forth-push s (nth rs 0)))))
state))