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

forth: WITHIN/ABORT/ABORT"/EXIT/UNLOOP (+7; Hayes 486/638, 76%)
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 01:55:38 +00:00
parent b1a7852045
commit 8ca2fe3564
5 changed files with 107 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files

65
lib/forth/compiler.sx
View File

@@ -122,6 +122,8 @@
(forth-loop-step s op pc))
((and (dict? op) (= (get op "kind") "+loop"))
(forth-plusloop-step s op pc))
((and (dict? op) (= (get op "kind") "exit"))
(dict-set! pc "v" 1000000000))
(else (begin (op s) (dict-set! pc "v" (+ (get pc "v") 1)))))))
(define
@@ -791,6 +793,69 @@
(let
((w (forth-pop s)))
(forth-push s (or (get w "body-addr") 0)))))
(forth-def-prim!
state
"WITHIN"
(fn
(s)
(let
((n3 (forth-pop s)) (n2 (forth-pop s)) (n1 (forth-pop s)))
(let
((a (forth-to-unsigned (- n1 n2) 32))
(b (forth-to-unsigned (- n3 n2) 32)))
(forth-push s (if (< a b) -1 0))))))
(forth-def-prim!
state
"ABORT"
(fn
(s)
(dict-set! s "dstack" (list))
(dict-set! s "rstack" (list))
(dict-set! s "cstack" (list))
(forth-error s "ABORT")))
(forth-def-prim-imm!
state
"ABORT\""
(fn
(s)
(let
((msg (forth-parse-quote s)))
(if
(get s "compiling")
(forth-def-append!
s
(fn
(ss)
(when
(not (= (forth-pop ss) 0))
(begin
(dict-set! ss "dstack" (list))
(dict-set! ss "rstack" (list))
(dict-set! ss "cstack" (list))
(forth-error ss (str "ABORT: " msg))))))
(when
(not (= (forth-pop s) 0))
(begin
(dict-set! s "dstack" (list))
(dict-set! s "rstack" (list))
(dict-set! s "cstack" (list))
(forth-error s (str "ABORT: " msg))))))))
(forth-def-prim-imm!
state
"EXIT"
(fn
(s)
(when
(not (get s "compiling"))
(forth-error s "EXIT outside definition"))
(let
((op (dict)))
(dict-set! op "kind" "exit")
(forth-def-append! s op))))
(forth-def-prim!
state
"UNLOOP"
(fn (s) (forth-rpop s) (forth-rpop s)))
(forth-def-prim-imm!
state
"["