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 # if 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 #error SIZEOF_ITYPE must be defined.
  19 #endif
  20
  21 #if UNSIGNED
  22 #  if SIZEOF_ITYPE == SIZEOF_UNSIGNED_SHORT
  23 #    define BIGMPZ_FITSP mpz_fits_ushort_p
  24 #  elif SIZEOF_ITYPE == SIZEOF_UNSIGNED_INT
  25 #    define BIGMPZ_FITSP mpz_fits_uint_p
  26 #  elif SIZEOF_ITYPE == SIZEOF_UNSIGNED_LONG
  27 #    define BIGMPZ_FITSP mpz_fits_ulong_p
  28 #  else
  29 #    define BIGMPZ_FITSP ((int (*)(void *)) 0)
  30 #  endif /* sizeof checks */
  31 #else
  32 /* UNSIGNED is not defined */
  33 #  if SIZEOF_ITYPE == SIZEOF_SHORT
  34 #    define BIGMPZ_FITSP mpz_fits_sshort_p
  35 #  elif SIZEOF_ITYPE == SIZEOF_INT
  36 #    define BIGMPZ_FITSP mpz_fits_sint_p
  37 #  elif SIZEOF_ITYPE == SIZEOF_LONG
  38 #    define BIGMPZ_FITSP mpz_fits_slong_p
  39 #  else
  40 #    define BIGMPZ_FITSP ((int (*)(void *)) 0)
  41 #  endif /* sizeof checks */
  42 #endif /* UNSIGNED check */
  43
  44 /* We rely heavily on the compiler's optimizer to remove branches that
  45    have constant value guards. */
  46
  47 ITYPE
  48 NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
  49 {
  50   if (SCM_INUMP (num))
  51     { /* immediate */
  52       scm_t_signed_bits n = SCM_INUM (num);
  53
  54       if (UNSIGNED && (n < 0))
  55         scm_out_of_range (s_caller, num);
  56
  57       if (SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS)
  58         /* the target type is large enough to hold any possible inum */
  59         return (ITYPE) n;
  60       else
  61         {
  62 #if SIZEOF_SCM_T_BITS > SIZEOF_ITYPE
  63           /* an inum can be out of range, so check */
  64           if (UNSIGNED) /* n is known to be >= 0 */
  65             {
  66               if (((scm_t_bits) n) > UNSIGNED_ITYPE_MAX)
  67                 scm_out_of_range (s_caller, num);
  68             }
  69           else if (((ITYPE) n) != n)
  70             scm_out_of_range (s_caller, num);
  71 #endif
  72           return (ITYPE) n;
  73         }
  74     }
  75   else if (SCM_BIGP (num))
  76     { /* bignum */
  77       if (SIZEOF_ITYPE < SIZEOF_SCM_T_BITS)
  78         scm_out_of_range (s_caller, num);
  79       else
  80         {
  81           /* make sure the result will fit */
  82           if (BIGMPZ_FITSP != 0)
  83             {
  84               int fits_p = BIGMPZ_FITSP (SCM_I_BIG_MPZ (num));
  85               scm_remember_upto_here_1 (num);
  86               if (!fits_p)
  87                 scm_out_of_range (s_caller, num);
  88             }
  89           else
  90             {
  91               size_t itype_bits = sizeof (ITYPE) * SCM_CHAR_BIT;
  92               int sgn = mpz_sgn (SCM_I_BIG_MPZ (num));
  93               size_t numbits;
  94
  95               if (UNSIGNED)
  96                 {
  97                   if (sgn < 0)
  98                     scm_out_of_range (s_caller, num);
  99                 }
 100
 101               numbits = mpz_sizeinbase (SCM_I_BIG_MPZ (num), 2);
 102
 103               if (UNSIGNED)
 104                 {
 105                   if (numbits > itype_bits)
 106                     scm_out_of_range (s_caller, num);
 107                 }
 108               else
 109                 {
 110                   if (sgn >= 0)
 111                     {
 112                       /* positive, require num < 2^(itype_bits-1) */
 113                       if (numbits > itype_bits-1)
 114                         scm_out_of_range (s_caller, num);
 115                     }
 116                   else
 117                     {
 118                       /* negative, require abs(num) < 2^(itype_bits-1), but
 119                          also allow num == -2^(itype_bits-1), the latter
 120                          detected by numbits==itype_bits plus the lowest
 121                          (and only) 1 bit at position itype_bits-1 */
 122                       if (numbits > itype_bits
 123                           || (numbits == itype_bits
 124                               && (mpz_scan1 (SCM_I_BIG_MPZ (num), 0)
 125                                   != itype_bits - 1)))
 126                         scm_out_of_range (s_caller, num);
 127                     }
 128                 }
 129             }
 130
 131           if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG))
 132             {
 133               ITYPE result = (ITYPE) mpz_get_ui (SCM_I_BIG_MPZ (num));
 134               scm_remember_upto_here_1 (num);
 135               return result;
 136             }
 137           else if ((!UNSIGNED) && (SIZEOF_ITYPE <= SIZEOF_LONG))
 138             {
 139               ITYPE result = (ITYPE) mpz_get_si (SCM_I_BIG_MPZ (num));
 140               scm_remember_upto_here_1 (num);
 141               return result;
 142             }
 143           else
 144             {
 145               int sgn = mpz_sgn (SCM_I_BIG_MPZ (num));
 146               ITYPE result = 0;
 147               size_t count;
 148
 149               mpz_export (&result,
 150                           &count,
 151 #ifdef WORDS_BIGENDIAN
 152                           1,
 153 #else
 154                           -1,
 155 #endif
 156                           SIZEOF_ITYPE,
 157                           0,
 158                           0,
 159                           SCM_I_BIG_MPZ (num));
 160               /* mpz_export doesn't handle sign */
 161               if (sgn < 0) result = - result;
 162               scm_remember_upto_here_1 (num);
 163               return result;
 164             }
 165         }
 166     }
 167   else
 168     scm_wrong_type_arg (s_caller, pos, num);
 169 }
 170
 171
 172 SCM
 173 INTEGRAL2NUM (ITYPE n)
 174 {
 175   /* If we know the size of the type, determine at compile time
 176      whether we need to perform the FIXABLE test or not.  This is not
 177      done to get more optimal code out of the compiler (it can figure
 178      this out on its own already), but to avoid a spurious warning.
 179      If we don't know the size, assume that the test must be done.
 180   */
 181
 182   /* have to use #if here rather than if because of gcc warnings about
 183      limited range */
 184 #if SIZEOF_ITYPE < SIZEOF_SCM_T_BITS
 185     return SCM_MAKINUM ((scm_t_signed_bits) n);
 186 #else /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */
 187     if (UNSIGNED)
 188       {
 189         if (SCM_POSFIXABLE (n))
 190           return SCM_MAKINUM ((scm_t_signed_bits) n);
 191       }
 192     else
 193       {
 194         if (SCM_FIXABLE (n))
 195           return SCM_MAKINUM ((scm_t_signed_bits) n);
 196       }
 197       return INTEGRAL2BIG (n);
 198 #endif /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */
 199 }
 200
 201 SCM
 202 INTEGRAL2BIG (ITYPE n)
 203 {
 204   if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_LONG))
 205     {
 206       SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
 207       mpz_init_set_ui (SCM_I_BIG_MPZ (z), n);
 208       return z;
 209     }
 210   else if ((!UNSIGNED) && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG))
 211     {
 212       SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
 213       mpz_init_set_si (SCM_I_BIG_MPZ (z), n);
 214       return z;
 215     }
 216   else
 217     {
 218       int neg_input = 0;
 219       SCM result = scm_i_mkbig ();
 220
 221       /* mpz_import doesn't handle sign -- have to use #if here rather
 222          than if b/c gcc warnings for ushort, etc. */
 223 #if !UNSIGNED
 224       if (n < 0)
 225         {
 226           neg_input = 1;
 227           n = - n;
 228         }
 229 #endif
 230
 231       mpz_import (SCM_I_BIG_MPZ (result),
 232                   1,            /* one word */
 233                   1,            /* word order irrelevant when just one word */
 234                   SIZEOF_ITYPE, /* word size */
 235                   0,            /* native endianness within word */
 236                   0,            /* no nails */
 237                   &n);
 238
 239       /* mpz_import doesn't handle sign */
 240       if (!UNSIGNED)
 241         {
 242           if (neg_input)
 243             mpz_neg (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result));
 244         }
 245       return result;
 246     }
 247 }
 248
 249 /* clean up */
 250 #undef INTEGRAL2NUM
 251 #undef INTEGRAL2BIG
 252 #undef NUM2INTEGRAL
 253 #undef UNSIGNED
 254 #undef ITYPE
 255 #undef SIZEOF_ITYPE
 256 #undef UNSIGNED_ITYPE
 257 #undef UNSIGNED_ITYPE_MAX
 258 #undef BIGMPZ_FITSP
 259
 260 /*
 261   Local Variables:
 262   c-file-style: "gnu"
 263   End:
 264 */