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