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

forth: String word set COMPARE/SEARCH/SLITERAL (+9)
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:53:46 +00:00
parent 64af162b5d
commit 1b2935828c
6 changed files with 134 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

47
lib/forth/compiler.sx
View File

@@ -793,6 +793,53 @@
(let
((w (forth-pop s)))
(forth-push s (or (get w "body-addr") 0)))))
(forth-def-prim-imm!
state
"SLITERAL"
(fn
(s)
(let
((u (forth-pop s)) (c-addr (forth-pop s)))
(let
((content (forth-mem-read-string s c-addr u)))
(let
((new-addr (forth-alloc-bytes! s u)))
(forth-mem-write-string! s new-addr content)
(forth-def-append! s (fn (ss) (forth-push ss new-addr)))
(forth-def-append! s (fn (ss) (forth-push ss u))))))))
(forth-def-prim!
state
"COMPARE"
(fn
(s)
(let
((u2 (forth-pop s))
(a2 (forth-pop s))
(u1 (forth-pop s))
(a1 (forth-pop s)))
(forth-push s (forth-compare-bytes-loop s a1 u1 a2 u2 0)))))
(forth-def-prim!
state
"SEARCH"
(fn
(s)
(let
((u2 (forth-pop s))
(a2 (forth-pop s))
(u1 (forth-pop s))
(a1 (forth-pop s)))
(let
((idx (forth-search-bytes s a1 u1 a2 u2 0)))
(if
(< idx 0)
(begin
(forth-push s a1)
(forth-push s u1)
(forth-push s 0))
(begin
(forth-push s (+ a1 idx))
(forth-push s (- u1 idx))
(forth-push s -1)))))))
(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)))