\ *********************************************************************
\                                                                     *
\    Filename:      math.fth                                          *
\    Date:          15.1.2008                                         *
\    FF Version:    3.2                                               *
\    Copyright:     Mikael Nordman                                    *
\    Author:        Mikael Nordman                                    *
\ *********************************************************************
\    FlashForth is licensed acording to the GNU General Public License*
\ *********************************************************************
\ Double and mixed math words

\ s>d   n -- d single to double precision
: s>d 
  dup 0<
;

\ ud/mod   ud1 u2 -- u3 ud4   32/16->32 divide
: ud/mod
  >r 0 r@ um/mod rot rot r> um/mod rot
;

\ ud* ud1 u2 -- u3           32*16->32 multiply
: ud*
  dup >r um* drop swap r> um* rot +
;

\ dnegate  d1 -- d2          32 bit negate
: dnegate
  swap invert swap invert 1 m+
;

\ ?dnegate d1 n -- d2  negate d1 if n is negative
: ?dnegate
  0< if dnegate then
;

\ dabs   d1 -- +d2     32 bit absolute value
: dabs
  dup ?dnegate
;

\ m*     n1 n2 -- d    signed 16*16->32 multiply
: m*
  2dup xor >r
  abs swap abs um*
  r> ?dnegate
;

: sm/rem ( d1 n1 -- n2 n3 )
  2dup xor >r
  over >r
  abs >r dabs r> um/mod
  swap r> ?negate
  swap r> ?negate
;

: fm/mod ( d1 n1 -- n2 n3 )
  dup >r
  2dup xor >r
  >r
  dabs r@ abs um/mod
  swap r> ?negate swap
  r> 0< if
    negate
    over if
      r@ rot - swap 1-
    then
  then
  r> drop
;
: /mod ( n1 n2 -- n3 n4 )
  >r s>d r> sm/rem
;
: mod ( n1 n2 -- n3 )
  /mod drop
;
: */mod ( n1 n2 n3 -- n4 n5 )
  >r m* r> sm/rem
;

\ d+, d- by Andrew Smith
: d+ ( d1 d2 -- d1+d2 ) dup >r dabs r> tuck ?negate >r ?negate m+ r> + ;
: d- ( d1 d2 -- d1-d2 ) dnegate d+ ;