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