From 27910181c53a7f836bfc8dc9c5619e2e3110eeaf Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 6 Jan 2022 20:12:06 +0100 Subject: [PATCH] Reimplement scm_from_int8 etc * libguile/integers.c (make_bignum_from_uint64): (make_bignum_from_int64): New helpers. (scm_integer_from_int64): (scm_integer_from_uint64): New internal functions. * libguile/integers.h: Declare new internal functions. * libguile/numbers.c (range_error): Declare as noreturn.xo (inum_in_range): New helper. (scm_from_signed_integer): (scm_to_signed_integer): (scm_from_unsigned_integer): (scm_to_unsigned_integer): (scm_to_int8): (scm_from_int8): (scm_to_uint8): (scm_from_uint8): (scm_to_int16): (scm_from_int16): (scm_to_uint16): (scm_from_uint16): Implement manually. --- libguile/integers.c | 41 ++++++++++++ libguile/integers.h | 3 + libguile/numbers.c | 157 ++++++++++++++++++++++++++++++++------------ 3 files changed, 158 insertions(+), 43 deletions(-) diff --git a/libguile/integers.c b/libguile/integers.c index b8cb1a908..9ec42694f 100644 --- a/libguile/integers.c +++ b/libguile/integers.c @@ -182,6 +182,31 @@ make_bignum_1 (int is_negative, mp_limb_t limb) return is_negative ? negate_bignum(z) : z; } +static struct scm_bignum * +make_bignum_from_uint64 (uint64_t val) +{ +#if SCM_SIZEOF_LONG == 4 + mp_limb_t lo = val, hi = val >> 32; + struct scm_bignum *z = allocate_bignum (hi ? 2 : 1); + z->limbs[0] = lo; + if (hi) + z->limbs[1] = hi; + return z; +#else + struct scm_bignum *z = allocate_bignum (1); + z->limbs[0] = val; + return z; +#endif +} + +static struct scm_bignum * +make_bignum_from_int64 (int64_t val) +{ + return val < 0 + ? negate_bignum (make_bignum_from_uint64 (int64_magnitude (val))) + : make_bignum_from_uint64 (val); +} + static struct scm_bignum * ulong_to_bignum (unsigned long u) { @@ -2896,6 +2921,22 @@ scm_integer_exact_quotient_zz (struct scm_bignum *n, struct scm_bignum *d) return take_mpz (q); } +SCM +scm_integer_from_int64 (int64_t n) +{ + if (SCM_FIXABLE (n)) + return SCM_I_MAKINUM (n); + return scm_from_bignum (make_bignum_from_int64 (n)); +} + +SCM +scm_integer_from_uint64 (uint64_t n) +{ + if (SCM_POSFIXABLE (n)) + return SCM_I_MAKINUM (n); + return scm_from_bignum (make_bignum_from_uint64 (n)); +} + int scm_integer_to_int64_z (struct scm_bignum *z, int64_t *val) { diff --git a/libguile/integers.h b/libguile/integers.h index 60e3ea9bd..8bf91f567 100644 --- a/libguile/integers.h +++ b/libguile/integers.h @@ -202,6 +202,9 @@ SCM_INTERNAL SCM scm_integer_exact_quotient_zz (struct scm_bignum *n, SCM_INTERNAL int scm_integer_to_int64_z (struct scm_bignum *z, int64_t *val); SCM_INTERNAL int scm_integer_to_uint64_z (struct scm_bignum *z, uint64_t *val); +SCM_INTERNAL SCM scm_integer_from_int64 (int64_t n); +SCM_INTERNAL SCM scm_integer_from_uint64 (uint64_t n); + #endif /* SCM_INTEGERS_H */ diff --git a/libguile/numbers.c b/libguile/numbers.c index 8657a6ebe..b1ef37752 100644 --- a/libguile/numbers.c +++ b/libguile/numbers.c @@ -6829,8 +6829,9 @@ scm_is_unsigned_integer (SCM val, uintmax_t min, uintmax_t max) return 0; } +static void range_error (SCM bad_val, SCM min, SCM max) SCM_NORETURN; static void -scm_i_range_error (SCM bad_val, SCM min, SCM max) +range_error (SCM bad_val, SCM min, SCM max) { scm_error (scm_out_of_range_key, NULL, @@ -6838,54 +6839,124 @@ scm_i_range_error (SCM bad_val, SCM min, SCM max) scm_list_3 (min, max, bad_val), scm_list_1 (bad_val)); } +#define scm_i_range_error range_error -#define TYPE intmax_t -#define TYPE_MIN min -#define TYPE_MAX max -#define SIZEOF_TYPE 0 -#define SCM_TO_TYPE_PROTO(arg) scm_to_signed_integer (arg, intmax_t min, intmax_t max) -#define SCM_FROM_TYPE_PROTO(arg) scm_from_signed_integer (arg) -#include "conv-integer.i.c" +static scm_t_inum +inum_in_range (SCM x, scm_t_inum min, scm_t_inum max) +{ + if (SCM_LIKELY (SCM_I_INUMP (x))) + { + scm_t_inum val = SCM_I_INUM (x); + if (min <= val && val <= max) + return val; + } + else if (!SCM_BIGP (x)) + scm_wrong_type_arg_msg (NULL, 0, x, "exact integer"); + range_error (x, scm_from_long (min), scm_from_long (max)); +} -#define TYPE uintmax_t -#define TYPE_MIN min -#define TYPE_MAX max -#define SIZEOF_TYPE 0 -#define SCM_TO_TYPE_PROTO(arg) scm_to_unsigned_integer (arg, uintmax_t min, uintmax_t max) -#define SCM_FROM_TYPE_PROTO(arg) scm_from_unsigned_integer (arg) -#include "conv-uinteger.i.c" +SCM +scm_from_signed_integer (intmax_t arg) +{ + return scm_integer_from_int64 (arg); +} -#define TYPE int8_t -#define TYPE_MIN INT8_MIN -#define TYPE_MAX INT8_MAX -#define SIZEOF_TYPE 1 -#define SCM_TO_TYPE_PROTO(arg) scm_to_int8 (arg) -#define SCM_FROM_TYPE_PROTO(arg) scm_from_int8 (arg) -#include "conv-integer.i.c" +intmax_t +scm_to_signed_integer (SCM arg, intmax_t min, intmax_t max) +{ + int64_t ret; + if (SCM_I_INUMP (arg)) + ret = SCM_I_INUM (arg); + else if (SCM_BIGP (arg)) + { + if (!scm_integer_to_int64_z (scm_bignum (arg), &ret)) + goto out_of_range; + } + else + scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer"); + if (min <= ret && ret <= max) + return ret; + out_of_range: + range_error (arg, scm_from_intmax (min), scm_from_intmax (max)); +} -#define TYPE uint8_t -#define TYPE_MIN 0 -#define TYPE_MAX UINT8_MAX -#define SIZEOF_TYPE 1 -#define SCM_TO_TYPE_PROTO(arg) scm_to_uint8 (arg) -#define SCM_FROM_TYPE_PROTO(arg) scm_from_uint8 (arg) -#include "conv-uinteger.i.c" +SCM +scm_from_unsigned_integer (uintmax_t arg) +{ + return scm_integer_from_uint64 (arg); +} -#define TYPE int16_t -#define TYPE_MIN INT16_MIN -#define TYPE_MAX INT16_MAX -#define SIZEOF_TYPE 2 -#define SCM_TO_TYPE_PROTO(arg) scm_to_int16 (arg) -#define SCM_FROM_TYPE_PROTO(arg) scm_from_int16 (arg) -#include "conv-integer.i.c" +uintmax_t +scm_to_unsigned_integer (SCM arg, uintmax_t min, uintmax_t max) +{ + uint64_t ret; + if (SCM_I_INUMP (arg)) + { + scm_t_inum n = SCM_I_INUM (arg); + if (n < 0) + goto out_of_range; + ret = n; + } + else if (SCM_BIGP (arg)) + { + if (!scm_integer_to_uint64_z (scm_bignum (arg), &ret)) + goto out_of_range; + } + else + scm_wrong_type_arg_msg (NULL, 0, arg, "exact integer"); + if (min <= ret && ret <= max) + return ret; + out_of_range: + range_error (arg, scm_from_uintmax (min), scm_from_uintmax (max)); +} -#define TYPE uint16_t -#define TYPE_MIN 0 -#define TYPE_MAX UINT16_MAX -#define SIZEOF_TYPE 2 -#define SCM_TO_TYPE_PROTO(arg) scm_to_uint16 (arg) -#define SCM_FROM_TYPE_PROTO(arg) scm_from_uint16 (arg) -#include "conv-uinteger.i.c" +int8_t +scm_to_int8 (SCM arg) +{ + return inum_in_range (arg, INT8_MIN, INT8_MAX); +} + +SCM +scm_from_int8 (int8_t arg) +{ + return SCM_I_MAKINUM (arg); +} + +uint8_t +scm_to_uint8 (SCM arg) +{ + return inum_in_range (arg, 0, UINT8_MAX); +} + +SCM +scm_from_uint8 (uint8_t arg) +{ + return SCM_I_MAKINUM (arg); +} + +int16_t +scm_to_int16 (SCM arg) +{ + return inum_in_range (arg, INT16_MIN, INT16_MAX); +} + +SCM +scm_from_int16 (int16_t arg) +{ + return SCM_I_MAKINUM (arg); +} + +uint16_t +scm_to_uint16 (SCM arg) +{ + return inum_in_range (arg, 0, UINT16_MAX); +} + +SCM +scm_from_uint16 (uint16_t arg) +{ + return SCM_I_MAKINUM (arg); +} #define TYPE int32_t #define TYPE_MIN INT32_MIN