/* this file is #include'd (many times) by numbers.c */ #ifndef UNSIGNED_ITYPE #ifdef UNSIGNED #define UNSIGNED_ITYPE ITYPE #else #define UNSIGNED_ITYPE unsigned ITYPE #endif #endif #define UNSIGNED_ITYPE_MAX (~((UNSIGNED_ITYPE)0)) #ifndef SIZEOF_ITYPE #define SIZEOF_ITYPE (2*SIZEOF_SCM_T_BITS) #endif 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_BITS /* the target type is large enough to hold any possible inum */ return (ITYPE) n; #else /* an inum can be out of range, so check */ #ifdef UNSIGNED /* n is known to be >= 0 */ if ((scm_t_bits) n > UNSIGNED_ITYPE_MAX) scm_out_of_range (s_caller, num); #else if (((ITYPE)n) != n) scm_out_of_range (s_caller, num); #endif return (ITYPE) n; #endif /* SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS */ } else if (SCM_BIGP (num)) { /* bignum */ #if SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS UNSIGNED_ITYPE pos_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--;) { if (pos_res > SCM_BIGDN (UNSIGNED_ITYPE_MAX)) scm_out_of_range (s_caller, num); pos_res = SCM_I_BIGUP (ITYPE, pos_res) + SCM_BDIGITS (num)[l]; } #ifdef UNSIGNED return pos_res; #else if (SCM_BIGSIGN (num)) { ITYPE res = -((ITYPE)pos_res); if (res <= 0) return res; else scm_out_of_range (s_caller, num); } else { ITYPE res = (ITYPE)pos_res; if (res >= 0) return res; else scm_out_of_range (s_caller, num); } #endif #else /* SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS */ scm_out_of_range (s_caller, num); #endif } else scm_wrong_type_arg (s_caller, pos, num); } SCM INTEGRAL2NUM (ITYPE n) { /* If we know the size of the type, determine at compile time whether we need to perform 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 own already), but to avoid a spurious warning. If we don't know the size, assume that the test must be done. */ #if SIZEOF_ITYPE >= SIZEOF_SCM_T_BITS #ifndef UNSIGNED if (SCM_FIXABLE (n)) #else if (SCM_POSFIXABLE (n)) #endif #endif return SCM_MAKINUM ((scm_t_signed_bits) n); #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 is still negative here, it must be the minimum value of the type (assuming twos-complement, but we are tied to that anyway). If this is the case, we can not count the number of digits by right-shifting n until it is zero. */ if (n < 0) { /* 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 #ifdef UNSIGNED #undef UNSIGNED #endif #undef ITYPE #undef SIZEOF_ITYPE #undef UNSIGNED_ITYPE #undef UNSIGNED_ITYPE_MAX /* Local Variables: c-file-style: "gnu" End: */