libguile/num2integral.i.c

   1 /* this file is #include'd (many times) by numbers.c */
   2
   3 ITYPE
   4 NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller)
   5 {
   6   if (SCM_INUMP (num))
   7     { /* immediate */
   8
   9       scm_t_signed_bits n = SCM_INUM (num);
  10
  11 #ifdef UNSIGNED
  12       if (n < 0)
  13         scm_out_of_range (s_caller, num);
  14 #endif
  15
  16       if (sizeof (ITYPE) >= sizeof (scm_t_signed_bits))
  17         /* can't fit anything too big for this type in an inum
  18            anyway */
  19         return (ITYPE) n;
  20       else
  21         { /* an inum can be out of range, so check */
  22           if (n > (scm_t_signed_bits)MAX_VALUE
  23 #ifndef UNSIGNED
  24               || n < (scm_t_signed_bits)MIN_VALUE
  25 #endif
  26               )
  27             scm_out_of_range (s_caller, num);
  28           else
  29             return (ITYPE) n;
  30         }
  31     }
  32   else if (SCM_BIGP (num))
  33     { /* bignum */
  34
  35       ITYPE res = 0;
  36       size_t l;
  37
  38       for (l = SCM_NUMDIGS (num); l--;)
  39         {
  40           ITYPE new = SCM_I_BIGUP (ITYPE, res) + SCM_BDIGITS (num)[l];
  41           if (new < res
  42 #ifndef UNSIGNED
  43               && !(new == MIN_VALUE && l == 0)
  44 #endif
  45               )
  46             scm_out_of_range (s_caller, num);
  47           res = new;
  48         }
  49
  50       if (SCM_BIGSIGN (num))
  51 #ifdef UNSIGNED
  52         scm_out_of_range (s_caller, num);
  53 #else
  54         {
  55           res = -res;
  56           if (res <= 0)
  57             return res;
  58           else
  59             scm_out_of_range (s_caller, num);
  60         }
  61 #endif
  62       else
  63         {
  64           if (res >= 0)
  65             return res;
  66           else
  67             scm_out_of_range (s_caller, num);
  68         }
  69
  70       return res;
  71     }
  72   else
  73     scm_wrong_type_arg (s_caller, pos, num);
  74 }
  75
  76 SCM
  77 INTEGRAL2NUM (ITYPE n)
  78 {
  79   if (sizeof (ITYPE) < sizeof (scm_t_signed_bits)
  80       ||
  81 #ifndef UNSIGNED
  82       SCM_FIXABLE (n)
  83 #else
  84       SCM_POSFIXABLE (n)
  85 #endif
  86       )
  87     return SCM_MAKINUM ((scm_t_signed_bits) n);
  88
  89 #ifdef SCM_BIGDIG
  90   return INTEGRAL2BIG (n);
  91 #else
  92   return scm_make_real ((double) n);
  93 #endif
  94 }
  95
  96 #ifdef SCM_BIGDIG
  97
  98 SCM
  99 INTEGRAL2BIG (ITYPE n)
 100 {
 101   SCM res;
 102   int neg_p;
 103   unsigned int n_digits;
 104   size_t i;
 105   SCM_BIGDIG *digits;
 106
 107 #ifndef UNSIGNED
 108   neg_p = (n < 0);
 109   if (neg_p) n = -n;
 110 #else
 111   neg_p = 0;
 112 #endif
 113
 114 #ifndef UNSIGNED
 115   if (n == MIN_VALUE)
 116     /* special case */
 117     n_digits =
 118       (sizeof (ITYPE) + sizeof (SCM_BIGDIG) - 1) / sizeof (SCM_BIGDIG);
 119   else
 120 #endif
 121     {
 122       ITYPE tn;
 123       for (tn = n, n_digits = 0;
 124            tn;
 125            ++n_digits, tn = SCM_BIGDN (tn))
 126         ;
 127     }
 128
 129   i = 0;
 130   res = scm_i_mkbig (n_digits, neg_p);
 131   digits = SCM_BDIGITS (res);
 132
 133   while (i < n_digits)
 134     {
 135       digits[i++] = SCM_BIGLO (n);
 136       n = SCM_BIGDN (n);
 137     }
 138
 139   return res;
 140 }
 141
 142 #endif
 143
 144 /* clean up */
 145 #undef INTEGRAL2NUM
 146 #undef INTEGRAL2BIG
 147 #undef NUM2INTEGRAL
 148 #undef UNSIGNED
 149 #undef ITYPE
 150 #undef MIN_VALUE
 151 #undef MAX_VALUE
 152
 153 /*
 154   Local Variables:
 155   c-file-style: "gnu"
 156   End:
 157 */