libguile/num2integral.i.c

   1 /* this file is #include'd (many times) by numbers.c */
   2
   3 #ifndef UNSIGNED_ITYPE
   4 #ifdef UNSIGNED
   5 #define UNSIGNED_ITYPE ITYPE
   6 #else
   7 #define UNSIGNED_ITYPE unsigned ITYPE
   8 #endif
   9 #endif
  10
  11 #define UNSIGNED_ITYPE_MAX (~((UNSIGNED_ITYPE)0))
  12
  13 #ifndef SIZEOF_ITYPE
  14 #define SIZEOF_ITYPE (2*SIZEOF_SCM_T_BITS)
  15 #endif
  16
  17 ITYPE
  18 NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
  19 {
  20   if (SCM_INUMP (num))
  21     { /* immediate */
  22
  23       scm_t_signed_bits n = SCM_INUM (num);
  24
  25 #ifdef UNSIGNED
  26       if (n < 0)
  27         scm_out_of_range (s_caller, num);
  28 #endif
  29
  30       if (sizeof (ITYPE) >= sizeof (scm_t_signed_bits))
  31         /* can't fit anything too big for this type in an inum
  32            anyway */
  33         return (ITYPE) n;
  34       else
  35         { /* an inum can be out of range, so check */
  36           if (((ITYPE)n) != n)
  37             scm_out_of_range (s_caller, num);
  38           else
  39             return (ITYPE) n;
  40         }
  41     }
  42   else if (SCM_BIGP (num))
  43     { /* bignum */
  44 #if SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS
  45
  46       UNSIGNED_ITYPE pos_res = 0;
  47       size_t l;
  48
  49 #ifdef UNSIGNED
  50       if (SCM_BIGSIGN (num))
  51         scm_out_of_range (s_caller, num);
  52 #endif
  53
  54       for (l = SCM_NUMDIGS (num); l--;)
  55         {
  56           if (pos_res > SCM_BIGDN (UNSIGNED_ITYPE_MAX))
  57             scm_out_of_range (s_caller, num);
  58           pos_res = SCM_I_BIGUP (ITYPE, pos_res) + SCM_BDIGITS (num)[l];
  59         }
  60
  61 #ifdef UNSIGNED
  62       return pos_res;
  63 #else
  64       if (SCM_BIGSIGN (num))
  65         {
  66           ITYPE res = -((ITYPE)pos_res);
  67           if (res <= 0)
  68             return res;
  69           else
  70             scm_out_of_range (s_caller, num);
  71         }
  72       else
  73         {
  74           ITYPE res = (ITYPE)pos_res;
  75           if (res >= 0)
  76             return res;
  77           else
  78             scm_out_of_range (s_caller, num);
  79         }
  80 #endif
  81
  82 #else /* SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS */
  83             scm_out_of_range (s_caller, num);
  84 #endif
  85
  86     }
  87   else
  88     scm_wrong_type_arg (s_caller, pos, num);
  89 }
  90
  91 SCM
  92 INTEGRAL2NUM (ITYPE n)
  93 {
  94   /* If we know the size of the type, determine at compile time
  95      whether we need to perform the FIXABLE test or not.  This is not
  96      done to get more optimal code out of the compiler (it can figure
  97      this out on its own already), but to avoid a spurious warning.
  98      If we don't know the size, assume that the test must be done.
  99   */
 100
 101 #if SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS
 102 #ifndef UNSIGNED
 103   if (SCM_FIXABLE (n))
 104 #else
 105   if (SCM_POSFIXABLE (n))
 106 #endif
 107 #endif
 108     return SCM_MAKINUM ((scm_t_signed_bits) n);
 109
 110 #ifdef SCM_BIGDIG
 111   return INTEGRAL2BIG (n);
 112 #else
 113   return scm_make_real ((double) n);
 114 #endif
 115 }
 116
 117 #ifdef SCM_BIGDIG
 118
 119 SCM
 120 INTEGRAL2BIG (ITYPE n)
 121 {
 122   SCM res;
 123   int neg_p;
 124   unsigned int n_digits;
 125   size_t i;
 126   SCM_BIGDIG *digits;
 127
 128 #ifndef UNSIGNED
 129   neg_p = (n < 0);
 130   if (neg_p) n = -n;
 131 #else
 132   neg_p = 0;
 133 #endif
 134
 135 #ifndef UNSIGNED
 136   /* If n is still negative here, it must be the minimum value of the
 137      type (assuming twos-complement, but we are tied to that anyway).
 138      If this is the case, we can not count the number of digits by
 139      right-shifting n until it is zero.
 140   */
 141   if (n < 0)
 142     {
 143       /* special case */
 144       n_digits =
 145         (sizeof (ITYPE) + sizeof (SCM_BIGDIG) - 1) / sizeof (SCM_BIGDIG);
 146     }
 147   else
 148 #endif
 149     {
 150       ITYPE tn;
 151       for (tn = n, n_digits = 0;
 152            tn;
 153            ++n_digits, tn = SCM_BIGDN (tn))
 154         ;
 155     }
 156
 157   i = 0;
 158   res = scm_i_mkbig (n_digits, neg_p);
 159   digits = SCM_BDIGITS (res);
 160
 161   while (i < n_digits)
 162     {
 163       digits[i++] = SCM_BIGLO (n);
 164       n = SCM_BIGDN (n);
 165     }
 166
 167   return res;
 168 }
 169
 170 #endif
 171
 172 /* clean up */
 173 #undef INTEGRAL2NUM
 174 #undef INTEGRAL2BIG
 175 #undef NUM2INTEGRAL
 176 #ifdef UNSIGNED
 177 #undef UNSIGNED
 178 #endif
 179 #undef ITYPE
 180 #undef SIZEOF_ITYPE
 181 #undef UNSIGNED_ITYPE
 182 #undef UNSIGNED_ITYPE_MAX
 183
 184 /*
 185   Local Variables:
 186   c-file-style: "gnu"
 187   End:
 188 */