/* this file is #include'd (many times) by numbers.c */ ITYPE NUM2INTEGRAL (SCM num, unsigned long int pos, const char *s_caller) { if (SCM_INUMP (num)) { /* immediate */ scm_t_signed_bits n = SCM_INUM (num); #ifdef UNSIGNED if (n < 0) scm_out_of_range (s_caller, num); #endif if (sizeof (ITYPE) >= sizeof (scm_t_signed_bits)) /* can't fit anything too big for this type in an inum anyway */ return (ITYPE) n; else { /* an inum can be out of range, so check */ if (n > (scm_t_signed_bits)MAX_VALUE #ifndef UNSIGNED || n < (scm_t_signed_bits)MIN_VALUE #endif ) scm_out_of_range (s_caller, num); else return (ITYPE) n; } } else if (SCM_BIGP (num)) { /* bignum */ ITYPE res = 0; size_t l; #ifdef UNSIGNED if (SCM_BIGSIGN (num)) scm_out_of_range (s_caller, num); #endif for (l = SCM_NUMDIGS (num); l--;) { ITYPE new = SCM_I_BIGUP (ITYPE, res) + SCM_BDIGITS (num)[l]; if (new < res #ifndef UNSIGNED && !(new == MIN_VALUE && l == 0) #endif ) scm_out_of_range (s_caller, num); res = new; } #ifdef UNSIGNED return res; #else if (SCM_BIGSIGN (num)) { res = -res; if (res <= 0) return res; else scm_out_of_range (s_caller, num); } else { if (res >= 0) return res; else scm_out_of_range (s_caller, num); } #endif } else scm_wrong_type_arg (s_caller, pos, num); } SCM INTEGRAL2NUM (ITYPE n) { /* Determine at compile time whether we need to porferm the FIXABLE test or not. This is not done to get more optimal code out of the compiler (it can figure this out on its already), but to avoid a spurious warning. */ #ifdef NEED_CHECK #undef NEED_CHECK #endif #ifdef NO_PREPRO_MAGIC #define NEED_CHECK #else #ifdef UNSIGNED #if MAX_VALUE > SCM_MOST_POSITIVE_FIXNUM #define NEED_CHECK #endif #else #if MIN_VALUESCM_MOST_POSITIVE_FIXNUM #define NEED_CHECK #endif #endif #endif #ifndef UNSIGNED #ifdef NEED_CHECK if (SCM_FIXABLE (n)) #endif #else #ifdef NEED_CHECK if (SCM_POSFIXABLE (n)) #endif #endif return SCM_MAKINUM ((scm_t_signed_bits) n); #undef NEED_CHECK #ifdef SCM_BIGDIG return INTEGRAL2BIG (n); #else return scm_make_real ((double) n); #endif } #ifdef SCM_BIGDIG SCM INTEGRAL2BIG (ITYPE n) { SCM res; int neg_p; unsigned int n_digits; size_t i; SCM_BIGDIG *digits; #ifndef UNSIGNED neg_p = (n < 0); if (neg_p) n = -n; #else neg_p = 0; #endif #ifndef UNSIGNED if (n == MIN_VALUE) /* special case */ n_digits = (sizeof (ITYPE) + sizeof (SCM_BIGDIG) - 1) / sizeof (SCM_BIGDIG); else #endif { ITYPE tn; for (tn = n, n_digits = 0; tn; ++n_digits, tn = SCM_BIGDN (tn)) ; } i = 0; res = scm_i_mkbig (n_digits, neg_p); digits = SCM_BDIGITS (res); while (i < n_digits) { digits[i++] = SCM_BIGLO (n); n = SCM_BIGDN (n); } return res; } #endif /* clean up */ #undef INTEGRAL2NUM #undef INTEGRAL2BIG #undef NUM2INTEGRAL #undef UNSIGNED #undef ITYPE #undef MIN_VALUE #undef MAX_VALUE #undef NO_PREPRO_MAGIC /* Local Variables: c-file-style: "gnu" End: */