guile18/libguile/conv-integer.i.c

   1 /* This code in included by numbers.c to generate integer conversion
   2    functions like scm_to_int and scm_from_int.  It is only for signed
   3    types, see conv-uinteger.i.c for the unsigned variant.
   4 */
   5
   6 /* You need to define the following macros before including this
   7    template.  They are undefined at the end of this file to give a
   8    clean slate for the next inclusion.
   9
  10    TYPE         - the integral type to be converted
  11    TYPE_MIN     - the smallest representable number of TYPE
  12    TYPE_MAX     - the largest representable number of TYPE
  13    SIZEOF_TYPE  - the size of TYPE, equal to "sizeof (TYPE)" but
  14                   in a form that can be computed by the preprocessor.
  15                   When this number is 0, the preprocessor is not used
  16                   to select which code to compile; the most general
  17                   code is always used.
  18
  19    SCM_TO_TYPE_PROTO(arg), SCM_FROM_TYPE_PROTO(arg)
  20                 - These two macros should expand into the prototype
  21                   for the two defined functions, without the return
  22                   type.
  23
  24 */
  25
  26 TYPE
  27 SCM_TO_TYPE_PROTO (SCM val)
  28 {
  29   if (SCM_I_INUMP (val))
  30     {
  31       scm_t_signed_bits n = SCM_I_INUM (val);
  32 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS
  33       return n;
  34 #else
  35       if (n >= TYPE_MIN && n <= TYPE_MAX)
  36         return n;
  37       else
  38         {
  39           goto out_of_range;
  40         }
  41 #endif
  42     }
  43   else if (SCM_BIGP (val))
  44     {
  45       if (TYPE_MIN >= SCM_MOST_NEGATIVE_FIXNUM
  46           && TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM)
  47         goto out_of_range;
  48       else if (TYPE_MIN >= LONG_MIN && TYPE_MAX <= LONG_MAX)
  49         {
  50           if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val)))
  51             {
  52               long n = mpz_get_si (SCM_I_BIG_MPZ (val));
  53 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
  54               return n;
  55 #else
  56               if (n >= TYPE_MIN && n <= TYPE_MAX)
  57                 return n;
  58               else
  59                 goto out_of_range;
  60 #endif
  61             }
  62           else
  63             goto out_of_range;
  64         }
  65       else
  66         {
  67           scm_t_intmax n;
  68           size_t count;
  69
  70           if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
  71               > CHAR_BIT*sizeof (scm_t_uintmax))
  72             goto out_of_range;
  73
  74           mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0,
  75                       SCM_I_BIG_MPZ (val));
  76
  77           if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0)
  78             {
  79               if (n < 0)
  80                 goto out_of_range;
  81             }
  82           else
  83             {
  84               n = -n;
  85               if (n >= 0)
  86                 goto out_of_range;
  87             }
  88
  89           if (n >= TYPE_MIN && n <= TYPE_MAX)
  90             return n;
  91           else
  92             {
  93             out_of_range:
  94               scm_i_range_error (val,
  95                                  scm_from_signed_integer (TYPE_MIN),
  96                                  scm_from_signed_integer (TYPE_MAX));
  97               return 0;
  98             }
  99         }
 100     }
 101   else
 102     {
 103       scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
 104       return 0;
 105     }
 106 }
 107
 108 SCM
 109 SCM_FROM_TYPE_PROTO (TYPE val)
 110 {
 111 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS
 112   return SCM_I_MAKINUM (val);
 113 #else
 114   if (SCM_FIXABLE (val))
 115     return SCM_I_MAKINUM (val);
 116   else if (val >= LONG_MIN && val <= LONG_MAX)
 117     return scm_i_long2big (val);
 118   else
 119     {
 120       SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
 121       mpz_init (SCM_I_BIG_MPZ (z));
 122       if (val < 0)
 123         {
 124           val = -val;
 125           mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0,
 126                       &val);
 127           mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z));
 128         }
 129       else
 130         mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0,
 131                     &val);
 132       return z;
 133     }
 134 #endif
 135 }
 136
 137 /* clean up */
 138 #undef TYPE
 139 #undef TYPE_MIN
 140 #undef TYPE_MAX
 141 #undef SIZEOF_TYPE
 142 #undef SCM_TO_TYPE_PROTO
 143 #undef SCM_FROM_TYPE_PROTO
 144
 145 /*
 146   Local Variables:
 147   c-file-style: "gnu"
 148   End:
 149 */