src/float/dfloat/elem/cl_DF_scale_I.cc

   1 // scale_float().
   2
   3 // General includes.
   4 #include "cl_sysdep.h"
   5
   6 // Specification.
   7 #include "cln/dfloat.h"
   8
   9
  10 // Implementation.
  11
  12 #include "cl_DF.h"
  13 #include "cl_F.h"
  14 #include "cl_I.h"
  15
  16 namespace cln {
  17
  18 const cl_DF scale_float (const cl_DF& x, const cl_I& delta)
  19 {
  20   // Methode:
  21   // x=0.0 -> x als Ergebnis
  22   // delta muß ein Fixnum betragsmäßig <= DF_exp_high-DF_exp_low sein.
  23   // Neues DF mit um delta vergrößertem Exponenten bilden.
  24       // x entpacken:
  25       var cl_signean sign;
  26       var sintL exp;
  27 #if (cl_word_size==64)
  28       var uint64 mant;
  29       DF_decode(x, { return x; }, sign=,exp=,mant=);
  30 #else
  31       var uint32 manthi;
  32       var uint32 mantlo;
  33       DF_decode2(x, { return x; }, sign=,exp=,manthi=,mantlo=);
  34 #endif
  35       if (!minusp(delta))
  36         // delta>=0
  37         { var uintL udelta;
  38           if (fixnump(delta)
  39               && ((udelta = FN_to_L(delta)) <= (uintL)(DF_exp_high-DF_exp_low))
  40              )
  41             { exp = exp+udelta;
  42 #if (cl_word_size==64)
  43               return encode_DF(sign,exp,mant);
  44 #else
  45               return encode_DF(sign,exp,manthi,mantlo);
  46 #endif
  47             }
  48             else
  49             { cl_error_floating_point_overflow(); }
  50         }
  51         else
  52         // delta<0
  53         { var uintL udelta;
  54           if (fixnump(delta)
  55               && ((udelta = -FN_to_L(delta)) <= (uintL)(DF_exp_high-DF_exp_low))
  56               && ((cl_value_len+1<intLsize) || !(udelta==0))
  57              )
  58             { exp = exp-udelta;
  59 #if (cl_word_size==64)
  60               return encode_DF(sign,exp,mant);
  61 #else
  62               return encode_DF(sign,exp,manthi,mantlo);
  63 #endif
  64             }
  65             else
  66             if (underflow_allowed())
  67               { cl_error_floating_point_underflow(); }
  68               else
  69               { return cl_DF_0; }
  70         }
  71 }
  72
  73 }  // namespace cln