libguile/num2integral.i.c

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