commit/XEmacs: Jerry James: Convert C (un)signed long long values to bignums properly.

1 new commit in XEmacs: https://bitbucket.org/xemacs/xemacs/commits/3192994c49ca/ Changeset: 3192994c49ca User: Jerry James Date: 2013-06-17 18:23:00 Summary: Convert C (un)signed long long values to bignums properly. This patch also does the following: - Uses make_fixnum instead of make_integer when the argument is guaranteed to be in the fixnum range. - Introduces make_unsigned_integer so that we handle unsigned values with the high bit set correctly. - Introduces conversions between bignums and (un)signed long long values. - Uses mp_set_memory_functions with the BSD MP code, if it exists. - Eliminates some unnecessary consing in the Lisp + and * implementations. - Fixes a problem with check_valid_xbm_inline(). This function is called during intialization. It calls Ftimes. When using pdump, this is a problem, because (a) the bignum code is not initialized until *after* dumping, so we don't try to dump any bignums, and (b) multiplication of integers is done inside bignums so we handle fixnum overflow correctly. I decided that an XBM file with dimensions that don't fit into fixnums is probably not something we want to try to handle anyway, and did the arithmetic with C values instead of Lisp values. Doing that broke one test, which started getting a different error message from the one it expected, so I adjusted the test to match the new reality. - Fixes a few miscellaneous bugs in the BSD MP code. See <CAHCOHQk0u0=eD1fUMHTNWi2Yh=1WgiYyCXdMbsGzHBNhdqYz4w(a)mail.gmail.com&gt; in xemacs-patches, as well as followup messages. Affected #: 27 files diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 ChangeLog --- a/ChangeLog +++ b/ChangeLog ＠＠ -1,3 +1,7 ＠＠ +2013-06-17 Jerry James <james(a)xemacs.org&gt; + + * configure.ac: Add check for mp_set_memory_functions. + 2013-03-12 Jerry James <james(a)xemacs.org&gt; * config.guess: Update to latest upstream version. diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 configure --- a/configure +++ b/configure ＠＠ -20897,6 +20897,19 ＠＠ else { echo "Error:" "Required MP numeric support cannot be provided." >&2; exit 1; } fi + ac_fn_c_check_func "$LINENO" "mp_set_memory_functions" "ac_cv_func_mp_set_memory_functions" +if test "x$ac_cv_func_mp_set_memory_functions" = xyes; then : + $as_echo "#define HAVE_MP_SET_MEMORY_FUNCTIONS 1" >>confdefs.h + +else + ac_fn_c_check_func "$LINENO" "__gmp_set_memory_functions" "ac_cv_func___gmp_set_memory_functions" +if test "x$ac_cv_func___gmp_set_memory_functions" = xyes; then : + $as_echo "#define HAVE_MP_SET_MEMORY_FUNCTIONS 1" >>confdefs.h + +fi + +fi + $as_echo "#define WITH_NUMBER_TYPES 1" >>confdefs.h $as_echo "#define WITH_MP 1" >>confdefs.h diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 configure.ac --- a/configure.ac +++ b/configure.ac ＠＠ -5287,6 +5287,10 ＠＠ else XE_DIE("Required MP numeric support cannot be provided.") fi + AC_CHECK_FUNC(mp_set_memory_functions, + [AC_DEFINE(HAVE_MP_SET_MEMORY_FUNCTIONS)], + [AC_CHECK_FUNC(__gmp_set_memory_functions, + [AC_DEFINE(HAVE_MP_SET_MEMORY_FUNCTIONS)])]) AC_DEFINE(WITH_NUMBER_TYPES) AC_DEFINE(WITH_MP) fi diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/ChangeLog --- a/src/ChangeLog +++ b/src/ChangeLog ＠＠ -1,3 +1,72 ＠＠ +2013-06-17 Jerry James <james(a)xemacs.org&gt; + + * alloc.c (make_bignum_un): New function. + (make_bignum_ll): New function. + (make_bignum_ull): New function. + * config.h.in (HAVE_MP_SET_MEMORY_FUNCTIONS): Add. + * data.c (Fplus): avoid unnecessary consing. + (Ftimes): ditto. + * glyphs.c (check_valid_xbm_inline): Since this function is called + prior to dumping, when bignums are forbidden, do all arithmetic + with C integers. + * lisp.h (MOST_POSITIVE_FIXNUM_UNSIGNED): New constant. + (MOST_POSITIVE_FIXNUM): Redefine in terms of the above. + (UNSIGNED_NUMBER_FITS_IN_A_FIXNUM): New macro. + * number-gmp.c (bignum_to_llong): New function. + (bignum_to_ullong): New function. + (bignum_set_llong): New function. + (bigfloat_to_string): Adjust whitespace. + (gmp_realloc): Ditto. + (gmp_free): Ditto. + * number-gmp.h (bignum_fits_llong): New macro. + (bignum_fits_ullong): New macro. + (bignum_set_ullong): New macro. + * number-mp.c (bignum_long_sign_bit): Remove, didn't work. + (bignum_min_llong): New variable. + (bignum_max_llong): New variable. + (bignum_max_ullong): New variable. + (bignum_to_llong): New function. + (bignum_to_ullong): New function. + (bignum_set_long): Reimplement using MP_XTOM. + (bignum_set_ulong): Ditto. + (bignum_set_llong): New function. + (bignum_set_ullong): New function. + (bignum_clrbit): Fix a comment. + (bignum_random_seed): Move to number-mp.h, since it is a no-op. + (bignum_random): Implement. + (mp_realloc): New function. + (mp_free): New function. + (init_number_mp): Use them. Fix a comment. Eliminate + initialization of bignum_long_sign_bit. Initialize + bignum_min_llong, bignum_max_llong, and bignum_set_ullong. + * number-mp.h (MP_XTOM): New macro. + (bignum_fits_llong_p): New macro. + (bignum_fits_ullong_p): New macro. + (bignum_random_seed): New macro. + * number.h: Implement bignums as long long integers. + (make_bignum_ll): New macro. + (make_integer): Accept a long long value. + (make_unsigned_integer): New macro. + (NATNUMP): Adjust whitespace. + (non_fixnum_number_p): Ditto. + + * alloc.c (Fmake_list): Use make_unsigned_integer or make_fixnum + instead of make_integer where it is appropriate to do so. + * chartab.c (char_table_default_for_type): Ditto. + * dired.c (Ffile_attributes): Ditto. + * elhash.c (hash_table_size_validate): Ditto. + * eval.c (Fmacroexpand): Ditto. + * event-stream.c (Faccept_process_output): Ditto. + (Frecent_keys): Ditto. + * events.c (Fmake_event): Ditto. + (Fevent_timestamp_lessp): Ditto. + * font-mgr.c (Ffc_pattern_get): Ditto. + * indent.c (Fmove_to_column): Ditto. + * process.c (Fset_process_window_size): Ditto. + * profile.c (Fstart_profiling): Ditto. + * unicode.c (Fset_unicode_conversion): Ditto. + (Funicode_to_char): Ditto. + 2013-04-23 Vin Shelton <acs(a)xemacs.org&gt; * sysdep.c (qxe_getgrgid): Hack in WIN32_NATIVE group support. diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/alloc.c --- a/src/alloc.c +++ b/src/alloc.c ＠＠ -1583,7 +1583,7 ＠＠ Lisp_Object val = Qnil; Elemcount size; - check_integer_range (length, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (length, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); size = XFIXNUM (length); ＠＠ -1644,6 +1644,45 ＠＠ /* WARNING: This function returns a bignum even if its argument fits into a fixnum. See Fcanonicalize_number(). */ Lisp_Object +make_bignum_un (unsigned long bignum_value) +{ + Lisp_Bignum *b; + + ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum); + bignum_init (bignum_data (b)); + bignum_set_ulong (bignum_data (b), bignum_value); + return wrap_bignum (b); +} + +/* WARNING: This function returns a bignum even if its argument fits into a + fixnum. See Fcanonicalize_number(). */ +Lisp_Object +make_bignum_ll (long long bignum_value) +{ + Lisp_Bignum *b; + + ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum); + bignum_init (bignum_data (b)); + bignum_set_llong (bignum_data (b), bignum_value); + return wrap_bignum (b); +} + +/* WARNING: This function returns a bignum even if its argument fits into a + fixnum. See Fcanonicalize_number(). */ +Lisp_Object +make_bignum_ull (unsigned long long bignum_value) +{ + Lisp_Bignum *b; + + ALLOC_FROB_BLOCK_LISP_OBJECT (bignum, Lisp_Bignum, b, &lrecord_bignum); + bignum_init (bignum_data (b)); + bignum_set_ullong (bignum_data (b), bignum_value); + return wrap_bignum (b); +} + +/* WARNING: This function returns a bignum even if its argument fits into a + fixnum. See Fcanonicalize_number(). */ +Lisp_Object make_bignum_bg (bignum bg) { Lisp_Bignum *b; diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/chartab.c --- a/src/chartab.c +++ b/src/chartab.c ＠＠ -436,7 +436,7 ＠＠ break; case CHAR_TABLE_TYPE_SYNTAX: - return make_integer (Sinherit); + return make_fixnum (Sinherit); break; } ABORT(); diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/config.h.in --- a/src/config.h.in +++ b/src/config.h.in ＠＠ -750,6 +750,7 ＠＠ #undef WITH_MP #undef MP_PREFIX #undef HAVE_MP_MOVE +#undef HAVE_MP_SET_MEMORY_FUNCTIONS #undef SIZEOF_SHORT #undef SIZEOF_INT diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/data.c --- a/src/data.c +++ b/src/data.c ＠＠ -1447,16 +1447,14 ＠＠ break; #ifdef HAVE_BIGNUM case BIGNUM_T: - bignum_add (scratch_bignum, XBIGNUM_DATA (accum), + bignum_add (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum), XBIGNUM_DATA (addend)); - accum = make_bignum_bg (scratch_bignum); break; #endif #ifdef HAVE_RATIO case RATIO_T: - ratio_add (scratch_ratio, XRATIO_DATA (accum), + ratio_add (XRATIO_DATA (accum), XRATIO_DATA (accum), XRATIO_DATA (addend)); - accum = make_ratio_rt (scratch_ratio); break; #endif case FLOAT_T: ＠＠ -1464,12 +1462,11 ＠＠ break; #ifdef HAVE_BIGFLOAT case BIGFLOAT_T: - bigfloat_set_prec (scratch_bigfloat, + bigfloat_set_prec (XBIGFLOAT_DATA (accum), max (XBIGFLOAT_GET_PREC (addend), XBIGFLOAT_GET_PREC (accum))); - bigfloat_add (scratch_bigfloat, XBIGFLOAT_DATA (accum), + bigfloat_add (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (addend)); - accum = make_bigfloat_bf (scratch_bigfloat); break; #endif } ＠＠ -1643,16 +1640,14 ＠＠ { #ifdef HAVE_BIGNUM case BIGNUM_T: - bignum_mul (scratch_bignum, XBIGNUM_DATA (accum), + bignum_mul (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum), XBIGNUM_DATA (multiplier)); - accum = make_bignum_bg (scratch_bignum); break; #endif #ifdef HAVE_RATIO case RATIO_T: - ratio_mul (scratch_ratio, XRATIO_DATA (accum), + ratio_mul (XRATIO_DATA (accum), XRATIO_DATA (accum), XRATIO_DATA (multiplier)); - accum = make_ratio_rt (scratch_ratio); break; #endif case FLOAT_T: ＠＠ -1660,12 +1655,11 ＠＠ break; #ifdef HAVE_BIGFLOAT case BIGFLOAT_T: - bigfloat_set_prec (scratch_bigfloat, + bigfloat_set_prec (XBIGFLOAT_DATA (accum), max (XBIGFLOAT_GET_PREC (multiplier), XBIGFLOAT_GET_PREC (accum))); - bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (accum), + bigfloat_mul (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (multiplier)); - accum = make_bigfloat_bf (scratch_bigfloat); break; #endif } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/dired.c --- a/src/dired.c +++ b/src/dired.c ＠＠ -915,8 +915,8 ＠＠ } #ifndef HAVE_BIGNUM - size = make_integer (NUMBER_FITS_IN_A_FIXNUM (s.st_size) ? - (EMACS_INT)s.st_size : -1); + size = make_fixnum (NUMBER_FITS_IN_A_FIXNUM (s.st_size) ? + (EMACS_INT)s.st_size : -1); #else size = make_integer (s.st_size); #endif ＠＠ -939,8 +939,8 ＠＠ if (NILP(id_format) || EQ (id_format, Qinteger)) { - uidInfo = make_integer (s.st_uid); - gidInfo = make_integer (s.st_gid); + uidInfo = make_unsigned_integer (s.st_uid); + gidInfo = make_unsigned_integer (s.st_gid); } else { ＠＠ -957,7 +957,7 ＠＠ RETURN_UNGCPRO (listn (12, mode, - make_integer (s.st_nlink), + make_unsigned_integer (s.st_nlink), uidInfo, gidInfo, make_time (s.st_atime), ＠＠ -966,8 +966,8 ＠＠ size, modestring, gid, - make_integer (s.st_ino), - make_integer (s.st_dev))); + make_unsigned_integer (s.st_ino), + make_unsigned_integer (s.st_dev))); }  diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/elhash.c --- a/src/elhash.c +++ b/src/elhash.c ＠＠ -820,7 +820,7 ＠＠ /* hash_table_size() can't handle excessively large sizes. */ maybe_signal_error_1 (Qargs_out_of_range, list3 (value, Qzero, - make_integer (MOST_POSITIVE_FIXNUM)), + make_fixnum (MOST_POSITIVE_FIXNUM)), Qhash_table, errb); return 0; } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/eval.c --- a/src/eval.c +++ b/src/eval.c ＠＠ -1576,7 +1576,7 ＠＠ in case it expands into another macro call. */ if (SYMBOLP (form)) { - Lisp_Object hashed = make_integer ((EMACS_INT) (LISP_HASH (form))); + Lisp_Object hashed = make_unsigned_integer (LISP_HASH (form)); Lisp_Object assocked; if (BIGNUMP (hashed)) ＠＠ -7276,7 +7276,7 ＠＠ REGISTER int i; Lisp_Object tem; - check_integer_range (nframes, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (nframes, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); /* Find the frame requested. */ for (i = XFIXNUM (nframes); backlist && (i-- > 0);) diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/event-stream.c --- a/src/event-stream.c +++ b/src/event-stream.c ＠＠ -2626,7 +2626,7 ＠＠ if (!NILP (timeout_msecs)) { check_integer_range (timeout_msecs, Qzero, - make_integer (MOST_POSITIVE_FIXNUM)); + make_fixnum (MOST_POSITIVE_FIXNUM)); msecs += XFIXNUM (timeout_msecs); } if (msecs) ＠＠ -3716,7 +3716,7 ＠＠ else { check_integer_range (number, Qzero, - make_integer (ARRAY_DIMENSION_LIMIT)); + make_fixnum (ARRAY_DIMENSION_LIMIT)); nwanted = XFIXNUM (number); } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/events.c --- a/src/events.c +++ b/src/events.c ＠＠ -735,13 +735,13 ＠＠ else if (EQ (keyword, Qtimestamp)) { #ifdef HAVE_BIGNUM - check_integer_range (value, Qzero, make_integer (UINT_MAX)); + check_integer_range (value, Qzero, make_unsigned_integer (UINT_MAX)); if (BIGNUMP (value)) { SET_EVENT_TIMESTAMP (e, bignum_to_uint (XBIGNUM_DATA (value))); } #else - check_integer_range (value, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (value, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); #endif if (FIXNUMP (value)) { ＠＠ -1777,8 +1777,8 ＠＠ { EMACS_INT t1, t2; - check_integer_range (time1, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); - check_integer_range (time2, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (time1, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); + check_integer_range (time2, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); t1 = XFIXNUM (time1); t2 = XFIXNUM (time2); diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/font-mgr.c --- a/src/font-mgr.c +++ b/src/font-mgr.c ＠＠ -440,7 +440,7 ＠＠ check_integer_range (id, Qzero, make_integer (INT_MAX)); int_id = BIGNUMP (id) ? bignum_to_int (XBIGNUM_DATA (id)) : XFIXNUM (id); #else - check_integer_range (id, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (id, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); int_id = XFIXNUM (id); #endif } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/glyphs.c --- a/src/glyphs.c +++ b/src/glyphs.c ＠＠ -2638,6 +2638,7 ＠＠ check_valid_xbm_inline (Lisp_Object data) { Lisp_Object width, height, bits, args[2]; + unsigned long i_width, i_height; if (!CONSP (data) || !CONSP (XCDR (data)) || ＠＠ -2651,22 +2652,15 ＠＠ CHECK_STRING (bits); - if (!NATNUMP (width)) + if (!FIXNUMP (width) || XREALFIXNUM (width) < 0) invalid_argument ("Width must be a natural number", width); - if (!NATNUMP (height)) + if (!FIXNUMP (height) || XREALFIXNUM (height) < 0) invalid_argument ("Height must be a natural number", height); - args[0] = width; - args[1] = height; - - args[0] = Ftimes (countof (args), args); - args[1] = make_integer (8); - - args[0] = Fquo (countof (args), args); - args[1] = make_integer (string_char_length (bits)); - - if (!NILP (Fgtr (countof (args), args))) + i_width = (unsigned long) XREALFIXNUM (width); + i_height = (unsigned long) XREALFIXNUM (height); + if (i_width * i_height / 8UL > string_char_length (bits)) invalid_argument ("data is too short for width and height", vector3 (width, height, bits)); } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/indent.c --- a/src/indent.c +++ b/src/indent.c ＠＠ -411,7 +411,7 ＠＠ buffer = wrap_buffer (buf); if (tab_width <= 0 || tab_width > 1000) tab_width = 8; - check_integer_range (column, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (column, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); goal = XFIXNUM (column); retry: diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/lisp.h --- a/src/lisp.h +++ b/src/lisp.h ＠＠ -1677,11 +1677,14 ＠＠ #define FIXNUM_VALBITS (BITS_PER_EMACS_INT - FIXNUM_GCBITS) #define VALBITS (BITS_PER_EMACS_INT - GCBITS) -#define MOST_POSITIVE_FIXNUM ((EMACS_INT) ((1UL << (FIXNUM_VALBITS - 1)) -1UL)) +#define MOST_POSITIVE_FIXNUM_UNSIGNED ((1UL << (FIXNUM_VALBITS - 1)) -1UL) +#define MOST_POSITIVE_FIXNUM ((EMACS_INT) MOST_POSITIVE_FIXNUM_UNSIGNED) #define MOST_NEGATIVE_FIXNUM (-(MOST_POSITIVE_FIXNUM) - 1) /* WARNING: evaluates its arg twice. */ #define NUMBER_FITS_IN_A_FIXNUM(num) \ ((num) <= MOST_POSITIVE_FIXNUM && (num) >= MOST_NEGATIVE_FIXNUM) +#define UNSIGNED_NUMBER_FITS_IN_A_FIXNUM(num) \ + ((num) <= MOST_POSITIVE_FIXNUM_UNSIGNED) #ifdef USE_UNION_TYPE # include "lisp-union.h" diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/number-gmp.c --- a/src/number-gmp.c +++ b/src/number-gmp.c ＠＠ -27,8 +27,42 ＠＠ static mp_exp_t float_print_min, float_print_max; gmp_randstate_t random_state; +long long +bignum_to_llong (const bignum b) +{ + long long l; + + mpz_export (&l, NULL, 1, sizeof (l), 0, 0U, b); + return (mpz_sgn (b) < 0) ? -l : l; +} + +unsigned long long +bignum_to_ullong (const bignum b) +{ + unsigned long long l; + + mpz_export (&l, NULL, 1, sizeof (l), 0, 0U, b); + return l; +} + +void +bignum_set_llong (bignum b, long long l) +{ + if (l < 0LL) + { + /* This even works for LLONG_MIN. Try it! */ + l = -l; + mpz_import (b, 1U, 1, sizeof (l), 0, 0U, &l); + mpz_neg (b, b); + } + else + { + mpz_import (b, 1U, 1, sizeof (l), 0, 0U, &l); + } +} + CIbyte * -bigfloat_to_string(mpf_t f, int base) +bigfloat_to_string (mpf_t f, int base) { mp_exp_t expt; CIbyte *str = mpf_get_str (NULL, &expt, base, 0, f); ＠＠ -94,12 +128,14 ＠＠ /* We need the next two functions since GNU MP insists on giving us an extra parameter. */ -static void *gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size) +static void * +gmp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size) { return xrealloc (ptr, new_size); } -static void gmp_free (void *ptr, size_t UNUSED (size)) +static void +gmp_free (void *ptr, size_t UNUSED (size)) { xfree (ptr); } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/number-gmp.h --- a/src/number-gmp.h +++ b/src/number-gmp.h ＠＠ -69,6 +69,11 ＠＠ #define bignum_fits_uint_p(b) mpz_fits_uint_p (b) #define bignum_fits_long_p(b) mpz_fits_slong_p (b) #define bignum_fits_ulong_p(b) mpz_fits_ulong_p (b) +#define bignum_fits_llong_p(b) \ + (mpz_sizeinbase (b, 2) <= (sizeof(long long) << 3) - 1U) +#define bignum_fits_ullong_p(b) \ + (mpz_sgn (b) >= 0 && \ + mpz_sizeinbase (b, 2) <= (sizeof(unsigned long long) << 3)) /***** Bignum: conversions *****/ #define bignum_to_string(b,base) mpz_get_str (NULL, base, b) ＠＠ -76,6 +81,8 ＠＠ #define bignum_to_uint(b) ((unsigned int) mpz_get_ui (b)) #define bignum_to_long(b) mpz_get_si (b) #define bignum_to_ulong(b) mpz_get_ui (b) +extern long long bignum_to_llong(const bignum b); +extern unsigned long long bignum_to_ullong(const bignum b); #define bignum_to_double(b) mpz_get_d (b) /***** Bignum: converting assignments *****/ ＠＠ -83,6 +90,8 ＠＠ #define bignum_set_string(b,s,base) mpz_set_str (b, s, base) #define bignum_set_long(b,l) mpz_set_si (b, l) #define bignum_set_ulong(b,l) mpz_set_ui (b, l) +extern void bignum_set_llong(bignum b, long long l); +#define bignum_set_ullong(b,l) mpz_import (b,1U,1,sizeof (l),0,0U,&l) #define bignum_set_double(b,f) mpz_set_d (b, f) #define bignum_set_ratio(b,r) mpz_set_q (b, r) #define bignum_set_bigfloat(b,f) mpz_set_f (b, f) diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/number-mp.c --- a/src/number-mp.c +++ b/src/number-mp.c ＠＠ -21,12 +21,14 ＠＠ #include <config.h> #include <limits.h> #include <math.h> +#include <stdlib.h> #include "lisp.h" -static MINT *bignum_bytesize, *bignum_long_sign_bit, *bignum_one, *bignum_two; +static MINT *bignum_bytesize, *bignum_one, *bignum_two; MINT *bignum_zero, *intern_bignum; MINT *bignum_min_int, *bignum_max_int, *bignum_max_uint; MINT *bignum_min_long, *bignum_max_long, *bignum_max_ulong; +MINT *bignum_min_llong, *bignum_max_llong, *bignum_max_ullong; short div_rem; char * ＠＠ -164,6 +166,32 ＠＠ return retval; } +long long +bignum_to_llong (bignum b) +{ + short rem, sign; + unsigned long long retval = 0LL; + REGISTER unsigned int i; + MINT *quo; + + sign = bignum_sign (b); + BIGNUM_TO_TYPE (long long, unsigned long long); + return ((long long) retval) * sign; +} + +unsigned long long +bignum_to_ullong (bignum b) +{ + short rem, sign; + unsigned long long retval = 0UL; + REGISTER unsigned int i; + MINT *quo; + + sign = bignum_sign (b); + BIGNUM_TO_TYPE (unsigned long long, unsigned long long); + return retval; +} + double bignum_to_double (bignum b) { ＠＠ -249,6 +277,7 ＠＠ MP_MADD (b, temp, b); MP_MFREE (temp); } + MP_MFREE (mbase); if (neg) MP_MSUB (bignum_zero, b, b); ＠＠ -257,31 +286,61 ＠＠ } void -bignum_set_long (MINT *b, long l) +bignum_set_long (bignum b, long l) { - /* Negative l is hard, not least because -LONG_MIN == LONG_MIN. We pretend - that l is unsigned, then subtract off the amount equal to the sign bit. */ - bignum_set_ulong (b, (unsigned long) l); - if (l < 0L) - MP_MSUB (b, bignum_long_sign_bit, b); + char hex[SIZEOF_LONG * 2U + 2U]; + MINT *temp; + int neg = l < 0L; + + snprintf (hex, SIZEOF_LONG * 2U + 2U, "%lx", + neg ? (unsigned long) -l : (unsigned long) l); + temp = MP_XTOM (hex); + if (neg) + MP_MSUB (bignum_zero, temp, b); + else + MP_MOVE (temp, b); + MP_MFREE (temp); } void bignum_set_ulong (bignum b, unsigned long l) { - REGISTER unsigned int i; - MINT *multiplier = MP_ITOM (1); + char hex[SIZEOF_LONG * 2U + 2U]; + MINT *temp; - MP_MOVE (bignum_zero, b); - for (i = 0UL; l > 0UL; l >>= 8, i++) - { - MINT *temp = MP_ITOM ((short) (l & 255)); - MP_MULT (multiplier, temp, temp); - MP_MADD (b, temp, b); - MP_MULT (multiplier, bignum_bytesize, multiplier); - MP_MFREE (temp); - } - MP_MFREE (multiplier); + snprintf (hex, SIZEOF_LONG * 2U + 2U, "%lx", l); + temp = MP_XTOM (hex); + MP_MOVE (temp, b); + MP_MFREE (temp); +} + +void +bignum_set_llong (bignum b, long long l) +{ + char hex[SIZEOF_LONG_LONG * 2U + 2U]; + MINT *temp; + int neg = l < 0LL; + + snprintf (hex, SIZEOF_LONG_LONG * 2U + 2U, "%llx", + neg ? (unsigned long long) -l : (unsigned long long) l); + temp = MP_XTOM (hex); + if (neg) + MP_MSUB (bignum_zero, temp, b); + else + MP_MOVE (temp, b); + MP_MFREE (temp); +} + +void +bignum_set_ullong (bignum b, unsigned long long l) +{ + char hex[SIZEOF_LONG_LONG * 2U + 2U]; + MINT *temp; + + snprintf (hex, SIZEOF_LONG_LONG * 2U + 2U, "%llx", l); + temp = MP_XTOM (hex); + MP_MOVE (temp, b); + MP_MFREE (temp); } void ＠＠ -485,7 +544,7 ＠＠ { MINT *num = MP_ITOM (0); - /* See if the bit is already set, and subtract it off if not */ + /* See if the bit is set, and subtract it off if so */ MP_MOVE (b, intern_bignum); bignum_pow (num, bignum_two, bit); bignum_ior (intern_bignum, intern_bignum, num); ＠＠ -516,21 +575,59 ＠＠ MP_MDIV (b, intern_bignum, result, intern_bignum); } -void bignum_random_seed(unsigned long seed) +void +bignum_random (bignum result, bignum limit) { - /* FIXME: Implement me */ + MINT *denominator = MP_ITOM (0), *divisor = MP_ITOM (0); + bignum_set_long (denominator, RAND_MAX); + MP_MADD (denominator, bignum_one, denominator); + MP_MADD (limit, bignum_one, divisor); + MP_MDIV (denominator, divisor, denominator, intern_bignum); + MP_MFREE (divisor); + + do + { + MINT *limitcmp = MP_ITOM (1); + + /* Accumulate at least as many random bits as in LIMIT */ + MP_MOVE (bignum_zero, result); + do + { + bignum_lshift (limitcmp, limitcmp, FIXNUM_VALBITS); + bignum_lshift (result, result, FIXNUM_VALBITS); + bignum_set_long (intern_bignum, get_random ()); + MP_MADD (intern_bignum, result, result); + } + while (MP_MCMP (limitcmp, limit) <= 0); + MP_MDIV (result, denominator, result, intern_bignum); + MP_MFREE (limitcmp); + } + while (MP_MCMP (limit, result) <= 0); + + MP_MFREE (denominator); } -void bignum_random(bignum result, bignum limit) +#ifdef HAVE_MP_SET_MEMORY_FUNCTIONS +/* We need the next two functions due to the extra parameter. */ +static void * +mp_realloc (void *ptr, size_t UNUSED (old_size), size_t new_size) { - /* FIXME: Implement me */ - MP_MOVE (bignum_zero, result); + return xrealloc (ptr, new_size); } +static void +mp_free (void *ptr, size_t UNUSED (size)) +{ + xfree (ptr); +} +#endif + void init_number_mp () { - REGISTER unsigned int i; +#ifdef HAVE_MP_SET_MEMORY_FUNCTIONS + mp_set_memory_functions ((void *(*) (size_t)) xmalloc, mp_realloc, mp_free); +#endif bignum_zero = MP_ITOM (0); bignum_one = MP_ITOM (1); ＠＠ -540,14 +637,9 ＠＠ number-mp.h. Its value is immaterial. */ intern_bignum = MP_ITOM (0); - /* bignum_bytesize holds the number of bits in a byte. */ + /* The multiplier used to shift a number left by one byte's worth of bits */ bignum_bytesize = MP_ITOM (256); - /* bignum_long_sign_bit holds an adjustment for negative longs. */ - bignum_long_sign_bit = MP_ITOM (256); - for (i = 1UL; i < sizeof (long); i++) - MP_MULT (bignum_bytesize, bignum_long_sign_bit, bignum_long_sign_bit); - /* The MP interface only supports turning short ints into MINTs, so we have to set these the hard way. */ ＠＠ -568,4 +660,13 ＠＠ bignum_max_ulong = MP_ITOM (0); bignum_set_ulong (bignum_max_ulong, ULONG_MAX); + + bignum_min_llong = MP_ITOM (0); + bignum_set_llong (bignum_min_llong, LLONG_MIN); + + bignum_max_llong = MP_ITOM (0); + bignum_set_llong (bignum_max_llong, LLONG_MAX); + + bignum_max_ullong = MP_ITOM (0); + bignum_set_ullong (bignum_max_ullong, ULLONG_MAX); } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/number-mp.h --- a/src/number-mp.h +++ b/src/number-mp.h ＠＠ -40,6 +40,7 ＠＠ #ifdef MP_PREFIX #define MP_GCD mp_gcd #define MP_ITOM mp_itom +#define MP_XTOM mp_xtom #define MP_MADD mp_madd #define MP_MCMP mp_mcmp #define MP_MDIV mp_mdiv ＠＠ -55,6 +56,7 ＠＠ #else #define MP_GCD gcd #define MP_ITOM itom +#define MP_XTOM xtom #define MP_MADD madd #define MP_MCMP mcmp #define MP_MDIV mdiv ＠＠ -81,6 +83,7 ＠＠ extern MINT *bignum_zero, *intern_bignum; extern MINT *bignum_min_int, *bignum_max_int, *bignum_max_uint; extern MINT *bignum_min_long, *bignum_max_long, *bignum_max_ulong; +extern MINT *bignum_min_llong, *bignum_max_llong, *bignum_max_ullong; extern short div_rem; /***** Bignum: basic functions *****/ ＠＠ -102,6 +105,10 ＠＠ MP_MCMP (b, bignum_max_long) <= 0) #define bignum_fits_ulong_p(b) (MP_MCMP (b, bignum_zero) >= 0 && \ MP_MCMP (b, bignum_max_ulong) <= 0) +#define bignum_fits_llong_p(b) (MP_MCMP (b, bignum_min_llong) >= 0 && \ + MP_MCMP (b, bignum_max_llong) <= 0) +#define bignum_fits_ullong_p(b) (MP_MCMP (b, bignum_zero) >= 0 && \ + MP_MCMP (b, bignum_max_ullong) <= 0) /***** Bignum: conversions *****/ extern char *bignum_to_string(bignum, int); ＠＠ -109,6 +116,8 ＠＠ extern unsigned int bignum_to_uint(bignum); extern long bignum_to_long(bignum); extern unsigned long bignum_to_ulong(bignum); +extern long long bignum_to_llong(bignum); +extern unsigned long long bignum_to_ullong(bignum); extern double bignum_to_double(bignum); /***** Bignum: converting assignments *****/ ＠＠ -116,6 +125,8 ＠＠ extern int bignum_set_string(bignum, const char *, int); extern void bignum_set_long(bignum, long); extern void bignum_set_ulong(bignum, unsigned long); +extern void bignum_set_llong(bignum, long long); +extern void bignum_set_ullong(bignum, unsigned long long); extern void bignum_set_double(bignum, double); /***** Bignum: comparisons *****/ ＠＠ -155,7 +166,7 ＠＠ extern void bignum_rshift(bignum, bignum, unsigned long); /***** Bignum: random numbers *****/ -extern void bignum_random_seed(unsigned long); +#define bignum_random_seed(s) extern void bignum_random(bignum, bignum); #endif /* INCLUDED_number_mp_h_ */ diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/number.h --- a/src/number.h +++ b/src/number.h ＠＠ -105,10 +105,14 ＠＠ # define bignum_fits_emacs_int_p(b) bignum_fits_int_p(b) # define bignum_to_emacs_int(b) bignum_to_int(b) #else -# error Bignums currently do not work with long long Emacs integers. +# define bignum_fits_emacs_int_p(b) bignum_fits_llong_p(b) +# define bignum_to_emacs_int(b) bignum_to_llong(b) #endif extern Lisp_Object make_bignum (long); +extern Lisp_Object make_bignum_un (unsigned long); +extern Lisp_Object make_bignum_ll (long long); +extern Lisp_Object make_bignum_ull (unsigned long long); extern Lisp_Object make_bignum_bg (bignum); extern bignum scratch_bignum, scratch_bignum2; ＠＠ -119,6 +123,7 ＠＠ #define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x) typedef void bignum; #define make_bignum(l) This XEmacs does not support bignums +#define make_bignum_ll(l) This XEmacs does not support bignums #define make_bignum_bg(b) This XEmacs does not support bignums #endif /* HAVE_BIGNUM */ ＠＠ -140,10 +145,15 ＠＠ } while (0) #ifdef HAVE_BIGNUM -#define make_integer(x) \ - (NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) : make_bignum (x)) +#define make_integer(x) \ + (NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) \ +: (sizeof (x) > SIZEOF_LONG ? make_bignum_ll (x) : make_bignum (x))) +#define make_unsigned_integer(x) \ + (UNSIGNED_NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) \ +: (sizeof (x) > SIZEOF_LONG ? make_bignum_ull (x) : make_bignum_un (x))) #else #define make_integer(x) make_fixnum (x) +#define make_unsigned_integer(x) make_fixnum ((EMACS_INT) x) #endif extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum; ＠＠ -170,7 +180,7 ＠＠ #ifdef HAVE_BIGNUM #define NATNUMP(x) ((FIXNUMP (x) && XFIXNUM (x) >= 0) || \ - (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0)) + (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0)) #else #define NATNUMP(x) (FIXNUMP (x) && XFIXNUM (x) >= 0) #endif ＠＠ -376,19 +386,19 ＠＠ if (LRECORDP (object)) { switch (XRECORD_LHEADER (object)->type) - { - case lrecord_type_float: + { + case lrecord_type_float: #ifdef HAVE_BIGNUM - case lrecord_type_bignum: + case lrecord_type_bignum: #endif #ifdef HAVE_RATIO - case lrecord_type_ratio: + case lrecord_type_ratio: #endif #ifdef HAVE_BIGFLOAT - case lrecord_type_bigfloat: + case lrecord_type_bigfloat: #endif - return 1; - } + return 1; + } } return 0; } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/process.c --- a/src/process.c +++ b/src/process.c ＠＠ -975,8 +975,8 ＠＠ (process, height, width)) { CHECK_PROCESS (process); - check_integer_range (height, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); - check_integer_range (width, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (height, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); + check_integer_range (width, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); return MAYBE_INT_PROCMETH (set_window_size, (XPROCESS (process), XFIXNUM (height), XFIXNUM (width))) <= 0 diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/profile.c --- a/src/profile.c +++ b/src/profile.c ＠＠ -370,7 +370,7 ＠＠ XFIXNUM (microsecs); #else check_integer_range (microsecs, make_fixnum (1000), - make_integer (MOST_POSITIVE_FIXNUM)); + make_fixnum (MOST_POSITIVE_FIXNUM)); msecs = XFIXNUM (microsecs); #endif } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 src/unicode.c --- a/src/unicode.c +++ b/src/unicode.c ＠＠ -1370,7 +1370,7 ＠＠ CHECK_CHAR (character); - check_integer_range (code, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (code, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); unicode = XFIXNUM (code); ichar = XCHAR (character); ＠＠ -1446,7 +1446,7 ＠＠ int lbs[NUM_LEADING_BYTES]; int c; - check_integer_range (code, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (code, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); c = XFIXNUM (code); { EXTERNAL_LIST_LOOP_2 (elt, charsets) ＠＠ -1472,7 +1472,7 ＠＠ return make_char (ret); } #else - check_integer_range (code, Qzero, make_integer (MOST_POSITIVE_FIXNUM)); + check_integer_range (code, Qzero, make_fixnum (MOST_POSITIVE_FIXNUM)); return Fint_to_char (code); #endif /* MULE */ } diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 tests/ChangeLog --- a/tests/ChangeLog +++ b/tests/ChangeLog ＠＠ -1,3 +1,8 ＠＠ +2013-06-17 Jerry James <james(a)xemacs.org&gt; + + * automated/lisp-tests.el: Adjust expected failure message due to + changes in check_valid_xbm_inline(). + 2013-04-20 Mats Lidell <matsl(a)xemacs.org&gt; * automated/dired-tests.el: New. Tests for file-attributes. diff -r ff13c44ce0d92d2872eb38404c9c076628c3301d -r 3192994c49caeb8083d28711b176a8ffe32e6e31 tests/automated/lisp-tests.el --- a/tests/automated/lisp-tests.el +++ b/tests/automated/lisp-tests.el ＠＠ -2641,7 +2641,7 ＠＠ (when (featurep 'xbm) (Check-Error-Message invalid-argument - "^data is too short for width and height" + "^Height must be a natural number" (set-face-background-pixmap 'left-margin `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")]))) Repository URL: https://bitbucket.org/xemacs/xemacs/ -- This is a commit notification from bitbucket.org. You are receiving this because you have the service enabled, addressing the recipient of this email. _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches