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)
  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 numbits;
  92               if (UNSIGNED)
  93                 {
  94                   int sgn = mpz_sgn (SCM_I_BIG_MPZ (num));
  95                   scm_remember_upto_here_1 (num);
  96                   if (sgn < 0)
  97                     scm_out_of_range (s_caller, num);
  98                 }
  99
 100               numbits = mpz_sizeinbase (SCM_I_BIG_MPZ (num), 2);
 101               scm_remember_upto_here_1 (num);
 102               if (numbits > (sizeof (ITYPE) * SCM_CHAR_BIT))
 103                 scm_out_of_range (s_caller, num);
 104             }
 105
 106           if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG))
 107             {
 108               ITYPE result = (ITYPE) mpz_get_ui (SCM_I_BIG_MPZ (num));
 109               scm_remember_upto_here_1 (num);
 110               return result;
 111             }
 112           else if ((!UNSIGNED) && (SIZEOF_ITYPE <= SIZEOF_LONG))
 113             {
 114               ITYPE result = (ITYPE) mpz_get_si (SCM_I_BIG_MPZ (num));
 115               scm_remember_upto_here_1 (num);
 116               return result;
 117             }
 118           else
 119             {
 120               int sgn = mpz_sgn (SCM_I_BIG_MPZ (num));
 121               ITYPE result = 0;
 122               size_t count;
 123
 124               mpz_export (&result,
 125                           &count,
 126 #ifdef WORDS_BIGENDIAN
 127                           1,
 128 #else
 129                           -1,
 130 #endif
 131                           SIZEOF_ITYPE,
 132                           0,
 133                           0,
 134                           SCM_I_BIG_MPZ (num));
 135               /* mpz_export doesn't handle sign */
 136               if (sgn < 0) result = - result;
 137               scm_remember_upto_here_1 (num);
 138               return result;
 139             }
 140         }
 141     }
 142   else
 143     scm_wrong_type_arg (s_caller, pos, num);
 144 }
 145
 146
 147 SCM
 148 INTEGRAL2NUM (ITYPE n)
 149 {
 150   /* If we know the size of the type, determine at compile time
 151      whether we need to perform the FIXABLE test or not.  This is not
 152      done to get more optimal code out of the compiler (it can figure
 153      this out on its own already), but to avoid a spurious warning.
 154      If we don't know the size, assume that the test must be done.
 155   */
 156
 157   /* have to use #if here rather than if because of gcc warnings about
 158      limited range */
 159 #if SIZEOF_ITYPE < SIZEOF_SCM_T_BITS
 160     return SCM_MAKINUM ((scm_t_signed_bits) n);
 161 #else /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */
 162     if (UNSIGNED)
 163       {
 164         if (SCM_POSFIXABLE (n))
 165           return SCM_MAKINUM ((scm_t_signed_bits) n);
 166       }
 167     else
 168       {
 169         if (SCM_FIXABLE (n))
 170           return SCM_MAKINUM ((scm_t_signed_bits) n);
 171       }
 172       return INTEGRAL2BIG (n);
 173 #endif /* not SIZEOF_ITYPE < SIZEOF_SCM_T_BITS */
 174 }
 175
 176 SCM
 177 INTEGRAL2BIG (ITYPE n)
 178 {
 179   if (UNSIGNED && (SIZEOF_ITYPE <= SIZEOF_LONG))
 180     {
 181       SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
 182       mpz_init_set_ui (SCM_I_BIG_MPZ (z), n);
 183       return z;
 184     }
 185   else if ((!UNSIGNED) && (SIZEOF_ITYPE <= SIZEOF_UNSIGNED_LONG))
 186     {
 187       SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
 188       mpz_init_set_si (SCM_I_BIG_MPZ (z), n);
 189       return z;
 190     }
 191   else
 192     {
 193       int neg_input = 0;
 194       SCM result = scm_i_mkbig ();
 195
 196       /* mpz_import doesn't handle sign -- have to use #if here rather
 197          than if b/c gcc warnings for ushort, etc. */
 198 #if !UNSIGNED
 199       if (n < 0)
 200         {
 201           neg_input = 1;
 202           n = - n;
 203         }
 204 #endif
 205
 206       mpz_import (SCM_I_BIG_MPZ (result),
 207                   1,            /* one word */
 208                   1,            /* word order irrelevant when just one word */
 209                   SIZEOF_ITYPE, /* word size */
 210                   0,            /* native endianness within word */
 211                   0,            /* no nails */
 212                   &n);
 213
 214       /* mpz_import doesn't handle sign */
 215       if (!UNSIGNED)
 216         {
 217           if (neg_input)
 218             mpz_neg (SCM_I_BIG_MPZ (result), SCM_I_BIG_MPZ (result));
 219         }
 220       return result;
 221     }
 222 }
 223
 224 /* clean up */
 225 #undef INTEGRAL2NUM
 226 #undef INTEGRAL2BIG
 227 #undef NUM2INTEGRAL
 228 #undef UNSIGNED
 229 #undef ITYPE
 230 #undef SIZEOF_ITYPE
 231 #undef UNSIGNED_ITYPE
 232 #undef UNSIGNED_ITYPE_MAX
 233 #undef BIGMPZ_FITSP
 234
 235 /*
 236   Local Variables:
 237   c-file-style: "gnu"
 238   End:
 239 */