\ ***************************************************************************
\ logarithm, exponential
\ ***************************************************************************
Host

: log2 ( frac -- log2 )   \ Bit-wise Logarithm (K.Schleisiek/U.Lange)
   delta_width 0 ?DO  2*  LOOP
   0   data_width 0
   DO  2* >r   dup um*
      dup 0< IF  r> 1+ >r  ELSE  d2*  THEN     \ correction of 'B(i)' and 'A(i)'
      round   r>                               \ A(i+1):=A(i)*2^(B(i)-1)
   LOOP  nip
;
: ?fzero ( r -- r / rdrop !! )   dup 2* #data_mask and ?EXIT  drop #fmax_neg   overflow on   rdrop ;

: flog2  ( r1 -- r2 )  \ only defined for positive values
   ?fzero float> [ data_width 2 - ] Literal + 0 >float   swap
   abs 2* log2 u2/ [ data_width 1 - negate ] Literal >float f+
;
: exp2   ( ufrac -- uexp2 )  \ Hart 1042, 23 bit precision, 1 > ufrac > 0, 1 = 2**(cell_width-1)
   [ &001877576 &008989340 + &055826318 + &240153617 + &693153073 + &999999925 + scale_factor ]
   >r [ &001877576 scaled ] Literal   r@ *.
      [ &008989340 scaled ] Literal + r@ *.
      [ &055826318 scaled ] Literal + r@ *.
      [ &240153617 scaled ] Literal + r@ *.
      [ &693153073 scaled ] Literal + r> *.
      [ &999999925 scaled ] Literal +
;
: exp?   0 BEGIN  cr dup 9 u.r dup exp2 9 u.r $10000000 + ?dup 0= UNTIL
         cr -1 dup 9 u.r exp2 9 u.r ;

: +fexp2 ( r1 -- r2 )   int.frac 2** float swap exp2 [ data_width 2 - negate ] Literal >float f* ;

: fexp2  ( r1 -- r2 )   dup f0< IF  fnegate +fexp2 1/f  EXIT THEN  +fexp2 ;

&1442695 float micro Constant log2(e)

: fln    ( r1 -- r2 )   ?fzero flog2 log2(e) f/ ;

: fexp   ( r1 -- r2 )   log2(e) f* fexp2 ;

Target

: ?fzero ( r -- r / rdrop !! )   dup 2* ?EXIT  drop #fmax_neg   #ovfl st_set   rdrop ;

: flog2  ( r1 -- r2 )  \ only defined for positive values
   ?fzero float> [ data_width 2 - ] Literal + 0 >float   swap
   abs 2* log2 u2/ [ data_width 1 - negate ] Literal >float f+
;
Host: flog2  ( r1 -- r2 )  dbg? IF  t> flog2 >t  EXIT THEN  exec? IF  flog2  EXIT THEN  T flog2 H ; immediate

: exp2   ( frac -- exp2[frac] )  \ Hart 1042, 23 bit precision, 1 > frac > 0, 1 = 2**data_width
   [ &001877576 &008989340 + &055826318 + &240153617 + &693153073 + &999999925 + scale_factor ]
   >r [ &001877576 scaled ] Literal   r@ *.
      [ &008989340 scaled ] Literal + r@ *.
      [ &055826318 scaled ] Literal + r@ *.
      [ &240153617 scaled ] Literal + r@ *.
      [ &693153073 scaled ] Literal + r> *.
      [ &999999925 scaled ] Literal +
;
: +fexp2 ( r1 -- r2 )   int.frac 2** float swap exp2 [ data_width 2 - negate ] Literal >float f* ;

: fexp2  ( r1 -- r2 )   dup f0< IF  fnegate +fexp2 1/f  EXIT THEN  +fexp2 ;
Host: fexp2  ( r1 -- r2 )  dbg? IF  t> fexp2 >t  EXIT THEN  exec? IF  fexp2  EXIT THEN  T fexp2 H ; immediate

&1442695 float micro Constant log2(e)

: fln    ( r1 -- r2 )   ?fzero flog2 log2(e) f/ ;
Host: fln  ( r1 -- r2 ) dbg? IF  t> fln >t  EXIT THEN  exec? IF  fln  EXIT THEN  T fln H ; immediate

: fexp   ( r1 -- r2 )   log2(e) f* fexp2 ;
Host: fexp ( r1 -- r2 ) dbg? IF  t> fexp >t  EXIT THEN  exec? IF  fexp  EXIT THEN  T fexp H ; immediate

\ ***************************************************************************
\ Converting NTC resistance to/from temperature
\ ***************************************************************************

&3892  float Constant B-factor
&10000 float Constant R0
-&298  float Constant -T0
&27300       Constant 0_degC

B-factor -T0 f/ R0 fln f+ fexp Constant R_lim

: R>T   ( Ohm -- degC*100 )   float R_lim f/   fln   B-factor swap f/   &100 float f* integer 0_degC - ;

: T>R   ( degC*100 -- Ohm )   0_degC + float &100 float f/  B-factor swap f/   fexp   R_lim f*   integer ;