uf-toys

toys and experiments with uf forth
git clone git://git.alexwennerberg.com/uf-toys
Log | Files | Refs | README

commit bbb00e2068af9a040c20f00140429707c6405e32
parent 05c27ce07cf8200566f2011feddd3481a7e3b57b
Author: alex wennerberg <alex@alexwennerberg.com>
Date:   Wed,  5 Oct 2022 20:11:34 -0700

fix m*/

(thanks to felix)

Diffstat:
Maoc/02b.f | 2+-
Maoc/dmath.f | 13++++++-------
2 files changed, 7 insertions(+), 8 deletions(-)

diff --git a/aoc/02b.f b/aoc/02b.f @@ -15,4 +15,4 @@ variable aim 0 aim ! include input.txt -solve .s cr . d. cr bye \ TODO figure out how to multiply these +solve 1 m*/ d. bye \ TODO figure out how to multiply these diff --git a/aoc/dmath.f b/aoc/dmath.f @@ -1,6 +1,5 @@ \ mostly taken from: -\ http://excamera.com/files/j1demo/docforth/nuc.fs.html -\ from felix winkelmann +\ https://web.archive.org/web/20181118215700/http://excamera.com/files/j1demo/docforth/nuc.fs.html : d= ( a b c d -- f ) >r \ a b c @@ -36,6 +35,7 @@ : d2/ dup 31 lshift >r 2/ swap 2/ r> or swap ; : dmax 2over 2over d< if 2swap then 2drop ; : dmin 2over 2over d< 0= if 2swap then 2drop ; +: tf if -1 else 0 then ; variable scratch : um* ( u1 u2 -- ud ) @@ -52,7 +52,7 @@ variable scratch loop rot drop ; : abssgn ( a b -- |a| |b| negf ) - 2dup xor 0< >r abs swap abs swap r> ; + 2dup xor 0< tf >r abs swap abs swap r> ; : m* abssgn >r um* r> if dnegate then ; : divstep ( divisor dq hi ) @@ -60,7 +60,7 @@ variable scratch over 0< if 1+ then swap 2* swap rot ( dq hi divisor ) - 2dup < 0= if + 2dup >= if tuck ( dq divisor hi divisor ) - swap ( dq hi divisor ) @@ -70,7 +70,6 @@ variable scratch -rot then ; - : um/mod ( ud u1 -- u2 u3 ) -rot 16 0 do divstep loop rot drop swap ; @@ -79,7 +78,7 @@ variable scratch r> r@ xor 0< if negate then r> 0< if >r negate r> then ; : */mod >r m* r> sm/rem ; : */ */mod nip ; -: t2* over >r >r d2* r> 2* r> 0< 1 and + ; +: t2* over >r >r d2* r> 2* r> 0< tf 1 and + ; variable divisor : m*/mod @@ -95,7 +94,7 @@ variable divisor rot 1+ -rot then loop ; -: m*/ m*/mod drop ; +: m*/ ( d1 n1 +n2 -- d2 ) m*/mod drop ; \ double printing : (digit) ( u -- c ) 9 over < 7 and + [char] 0 + ;