libguile/conv-uinteger.i.c

   1 /* This code in included by number.s.c to generate integer conversion
   2    functions like scm_to_int and scm_from_int.  It is only for
   3    unsigned types, see conv-integer.i.c for the signed 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 giove 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, typically 0.
  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 (n >= 0
  33           && ((scm_t_uintmax)n) >= TYPE_MIN && ((scm_t_uintmax)n) <= TYPE_MAX)
  34         return n;
  35       else
  36         {
  37         out_of_range:
  38           scm_i_range_error (val,
  39                              scm_from_unsigned_integer (TYPE_MIN),
  40                              scm_from_unsigned_integer (TYPE_MAX));
  41           return 0;
  42         }
  43     }
  44   else if (SCM_BIGP (val))
  45     {
  46       if (TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM)
  47         goto out_of_range;
  48       else if (TYPE_MAX <= ULONG_MAX)
  49         {
  50           if (mpz_fits_ulong_p (SCM_I_BIG_MPZ (val)))
  51             {
  52               unsigned long n = mpz_get_ui (SCM_I_BIG_MPZ (val));
  53 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG
  54               return n;
  55 #else
  56
  57 #if TYPE_MIN == 0
  58               if (n <= TYPE_MAX)
  59                 return n;
  60 #else /* TYPE_MIN != 0 */
  61               if (n >= TYPE_MIN && n <= TYPE_MAX)
  62                 return n;
  63 #endif /* TYPE_MIN != 0 */
  64               else
  65                 goto out_of_range;
  66
  67 #endif
  68             }
  69           else
  70             goto out_of_range;
  71         }
  72       else
  73         {
  74           scm_t_uintmax n;
  75           size_t count;
  76
  77           if (mpz_sgn (SCM_I_BIG_MPZ (val)) < 0)
  78             goto out_of_range;
  79
  80           if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2)
  81               > CHAR_BIT*sizeof (TYPE))
  82             goto out_of_range;
  83
  84           mpz_export (&n, &count, 1, sizeof (TYPE), 0, 0, SCM_I_BIG_MPZ (val));
  85
  86 #if TYPE_MIN == 0
  87           if (n <= TYPE_MAX)
  88             return n;
  89 #else /* TYPE_MIN != 0 */
  90           if (n >= TYPE_MIN && n <= TYPE_MAX)
  91             return n;
  92 #endif /* TYPE_MIN != 0 */
  93           else
  94             goto out_of_range;
  95
  96         }
  97     }
  98   else
  99     {
 100       scm_wrong_type_arg_msg (NULL, 0, val, "exact integer");
 101       return 0;
 102     }
 103 }
 104
 105 SCM
 106 SCM_FROM_TYPE_PROTO (TYPE val)
 107 {
 108 #if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS
 109   return SCM_I_MAKINUM (val);
 110 #else
 111   if (SCM_POSFIXABLE (val))
 112     return SCM_I_MAKINUM (val);
 113   else if (val <= ULONG_MAX)
 114     return scm_i_ulong2big (val);
 115   else
 116     {
 117       SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0);
 118       mpz_init (SCM_I_BIG_MPZ (z));
 119       mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0, &val);
 120       return z;
 121     }
 122 #endif
 123 }
 124
 125 #undef TYPE
 126 #undef TYPE_MIN
 127 #undef TYPE_MAX
 128 #undef SIZEOF_TYPE
 129 #undef SCM_TO_TYPE_PROTO
 130 #undef SCM_FROM_TYPE_PROTO
 131