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

forth: double-cell ops D+/D-/DNEGATE/DABS/D=/D</D0=/D0</DMAX/DMIN (+18)
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 23:52:43 +00:00
parent b6810e90ab
commit c726a9e0fe
5 changed files with 157 additions and 3 deletions
Download Patch File Download Diff File Expand all files Collapse all files

121
lib/forth/runtime.sx
View File

@@ -878,4 +878,125 @@
((r (- d (* q n3))))
(forth-push s (forth-clip r))
(forth-push s (forth-clip q))))))))
(forth-def-prim!
state
"D+"
(fn
(s)
(let
((hi2 (forth-pop s))
(lo2 (forth-pop s))
(hi1 (forth-pop s))
(lo1 (forth-pop s)))
(forth-double-push-s
s
(+
(forth-double-from-cells-s lo1 hi1)
(forth-double-from-cells-s lo2 hi2))))))
(forth-def-prim!
state
"D-"
(fn
(s)
(let
((hi2 (forth-pop s))
(lo2 (forth-pop s))
(hi1 (forth-pop s))
(lo1 (forth-pop s)))
(forth-double-push-s
s
(-
(forth-double-from-cells-s lo1 hi1)
(forth-double-from-cells-s lo2 hi2))))))
(forth-def-prim!
state
"DNEGATE"
(fn
(s)
(let
((hi (forth-pop s)) (lo (forth-pop s)))
(forth-double-push-s
s
(- 0 (forth-double-from-cells-s lo hi))))))
(forth-def-prim!
state
"DABS"
(fn
(s)
(let
((hi (forth-pop s)) (lo (forth-pop s)))
(forth-double-push-s s (abs (forth-double-from-cells-s lo hi))))))
(forth-def-prim!
state
"D="
(fn
(s)
(let
((hi2 (forth-pop s))
(lo2 (forth-pop s))
(hi1 (forth-pop s))
(lo1 (forth-pop s)))
(forth-push s (if (and (= lo1 lo2) (= hi1 hi2)) -1 0)))))
(forth-def-prim!
state
"D<"
(fn
(s)
(let
((hi2 (forth-pop s))
(lo2 (forth-pop s))
(hi1 (forth-pop s))
(lo1 (forth-pop s)))
(forth-push
s
(if
(<
(forth-double-from-cells-s lo1 hi1)
(forth-double-from-cells-s lo2 hi2))
-1
0)))))
(forth-def-prim!
state
"D0="
(fn
(s)
(let
((hi (forth-pop s)) (lo (forth-pop s)))
(forth-push s (if (and (= lo 0) (= hi 0)) -1 0)))))
(forth-def-prim!
state
"D0<"
(fn
(s)
(let
((hi (forth-pop s)) (lo (forth-pop s)))
(forth-push s (if (< hi 0) -1 0)))))
(forth-def-prim!
state
"DMAX"
(fn
(s)
(let
((hi2 (forth-pop s))
(lo2 (forth-pop s))
(hi1 (forth-pop s))
(lo1 (forth-pop s)))
(let
((d1 (forth-double-from-cells-s lo1 hi1))
(d2 (forth-double-from-cells-s lo2 hi2)))
(forth-double-push-s s (if (> d1 d2) d1 d2))))))
(forth-def-prim!
state
"DMIN"
(fn
(s)
(let
((hi2 (forth-pop s))
(lo2 (forth-pop s))
(hi1 (forth-pop s))
(lo1 (forth-pop s)))
(let
((d1 (forth-double-from-cells-s lo1 hi1))
(d2 (forth-double-from-cells-s lo2 hi2)))
(forth-double-push-s s (if (< d1 d2) d1 d2))))))
state))