\ *************************************************************************** \ 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 ;