diff options
author | Marius Vollmer <mvo@zagadka.de> | 2004-07-29 13:42:50 +0000 |
---|---|---|
committer | Marius Vollmer <mvo@zagadka.de> | 2004-07-29 13:42:50 +0000 |
commit | bfd7932e6644c91004c6e863ecc5db580eda12f6 (patch) | |
tree | 3dd36f35e219ffdf30122eff2f214e395d14f65f /libguile/conv-integer.i.c | |
parent | 3bfd202a72b19758b291219d7ef20c319ada2978 (diff) | |
download | guile-bfd7932e6644c91004c6e863ecc5db580eda12f6.tar.gz |
* conv-integer.i.c, conv-uinteger.i.c: New files, used to generate
the functions below.
* numbers.c, numbers.h (scm_to_int8, scm_to_uint8, scm_to_int16,
scm_to_uint16, scm_to_int32, scm_to_uint32, scm_to_int64,
scm_to_uint64, scm_from_int8, scm_from_uint8, scm_from_int16,
scm_from_uint16, scm_from_int32, scm_from_uint32, scm_from_int64,
scm_from_uint64): Turned from macros into proper functions.
(scm_to_signed_integer, scm_to_unsigned_integer,
scm_from_signed_integer, scm_from_unsigned_integer): Generate via
conv-integer.i.c and conv-uinteger.i.c, as well.
Diffstat (limited to 'libguile/conv-integer.i.c')
-rw-r--r-- | libguile/conv-integer.i.c | 126 |
1 files changed, 126 insertions, 0 deletions
diff --git a/libguile/conv-integer.i.c b/libguile/conv-integer.i.c new file mode 100644 index 000000000..4a6095fc1 --- /dev/null +++ b/libguile/conv-integer.i.c @@ -0,0 +1,126 @@ +TYPE +SCM_TO_TYPE_PROTO (SCM val) +{ + if (SCM_I_INUMP (val)) + { + scm_t_signed_bits n = SCM_I_INUM (val); +#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SIZEOF_SCM_T_BITS + return n; +#else + if (n >= TYPE_MIN && n <= TYPE_MAX) + return n; + else + { + goto out_of_range; + } +#endif + } + else if (SCM_BIGP (val)) + { + if (TYPE_MIN >= SCM_MOST_NEGATIVE_FIXNUM + && TYPE_MAX <= SCM_MOST_POSITIVE_FIXNUM) + goto out_of_range; + else if (TYPE_MIN >= LONG_MIN && TYPE_MAX <= LONG_MAX) + { + if (mpz_fits_slong_p (SCM_I_BIG_MPZ (val))) + { + long n = mpz_get_si (SCM_I_BIG_MPZ (val)); +#if SIZEOF_TYPE != 0 && SIZEOF_TYPE > SCM_SIZEOF_LONG + return n; +#else + if (n >= TYPE_MIN && n <= TYPE_MAX) + return n; + else + goto out_of_range; +#endif + } + else + goto out_of_range; + } + else + { + scm_t_intmax n; + size_t count; + + if (mpz_sizeinbase (SCM_I_BIG_MPZ (val), 2) + > CHAR_BIT*sizeof (scm_t_uintmax)) + goto out_of_range; + + mpz_export (&n, &count, 1, sizeof (scm_t_uintmax), 0, 0, + SCM_I_BIG_MPZ (val)); + + if (mpz_sgn (SCM_I_BIG_MPZ (val)) >= 0) + { + if (n < 0) + goto out_of_range; + } + else + { + n = -n; + if (n >= 0) + goto out_of_range; + } + + if (n >= TYPE_MIN && n <= TYPE_MAX) + return n; + else + { + out_of_range: + scm_out_of_range (NULL, val); + return 0; + } + } + } + else + { + scm_wrong_type_arg_msg (NULL, 0, val, "exact integer"); + return 0; + } +} + +SCM +SCM_FROM_TYPE_PROTO (TYPE val) +{ +#if SIZEOF_TYPE != 0 && SIZEOF_TYPE < SIZEOF_SCM_T_BITS + return SCM_I_MAKINUM (val); +#else + if (SCM_FIXABLE (val)) + return SCM_I_MAKINUM (val); + else if (val >= LONG_MIN && val <= LONG_MAX) + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init_set_si (SCM_I_BIG_MPZ (z), val); + return z; + } + else + { + SCM z = scm_double_cell (scm_tc16_big, 0, 0, 0); + mpz_init (SCM_I_BIG_MPZ (z)); + if (val < 0) + { + val = -val; + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0, + &val); + mpz_neg (SCM_I_BIG_MPZ (z), SCM_I_BIG_MPZ (z)); + } + else + mpz_import (SCM_I_BIG_MPZ (z), 1, 1, sizeof (TYPE), 0, 0, + &val); + return z; + } +#endif +} + +/* clean up */ +#undef TYPE +#undef TYPE_MIN +#undef TYPE_MAX +#undef SIZEOF_TYPE +#undef SCM_TO_TYPE_PROTO +#undef SCM_FROM_TYPE_PROTO + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ |