dblmath.txt


\ dblmath 97.11.29 6:16 pm NAB
needs double

: dm* ( d n -- d*n)  1 m*/ ;
: dm/ ( d +n -- d/n)  1 swap m*/ ;

true  dup 1 rshift  xor  constant HiBit

: ud/mod ( ud1 ud2 -- udr udq)
  2dup >r >r
  2over 2over du<  over HiBit and  or
  if  2drop 0.
  else  2dup d+  recurse  d2*  then
  2swap r> r>
  2over 2over du<  if  2drop 2swap
  else  d-  2swap 1. d+  then ;

: dmod ( d +n -- +m)
\ Mixed-precision modulo:
  >r  2dup  r@ dm/  r> dm*  d-  d>s ;

: admod ( d +n -- +m)
\ Like dmod, but m=n when result=0:
  >r  -1 m+  r> dmod  1+ ;


  HTMLized by Forth2HTML