Mercurial > hg > xemacs-beta
diff src/number.c @ 5125:b5df3737028a ben-lisp-object
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Wed, 24 Feb 2010 01:58:04 -0600 |
parents | 623d57b7fbe8 16112448d484 |
children | 0dcd22290039 |
line wrap: on
line diff
--- a/src/number.c Wed Jan 20 07:05:57 2010 -0600 +++ b/src/number.c Wed Feb 24 01:58:04 2010 -0600 @@ -1,5 +1,6 @@ /* Numeric types for XEmacs. Copyright (C) 2004 Jerry James. + Copyright (C) 2010 Ben Wing. This file is part of XEmacs. @@ -15,8 +16,8 @@ You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor, +Boston, MA 02111-1301, USA. */ /* Synched up with: Not in FSF. */ @@ -32,7 +33,7 @@ Lisp_Object Qrationalp, Qfloatingp, Qrealp; Lisp_Object Vdefault_float_precision; -Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum; + static Lisp_Object Qunsupported_type; static Lisp_Object Vbigfloat_max_prec; static int number_initialized; @@ -53,13 +54,30 @@ bignum_print (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { - CIbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10); - write_c_string (printcharfun, bstr); - xfree (bstr, CIbyte *); + Ascbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10); + write_ascstring (printcharfun, bstr); + xfree (bstr); } +#ifdef NEW_GC +static void +bignum_finalize (void *header) +{ + struct Lisp_Bignum *num = (struct Lisp_Bignum *) header; + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + bignum_fini (num->data); +} +#define BIGNUM_FINALIZE bignum_finalize +#else +#define BIGNUM_FINALIZE 0 +#endif + static int -bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) +bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), + int UNUSED (foldcase)) { return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); } @@ -82,7 +100,7 @@ bignum_convfree (const void * UNUSED (object), void *data, Bytecount UNUSED (size)) { - xfree (data, void *); + xfree (data); } static void * @@ -107,8 +125,9 @@ }; DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print, - 0, bignum_equal, bignum_hash, - bignum_description, Lisp_Bignum); + BIGNUM_FINALIZE, bignum_equal, + bignum_hash, bignum_description, + Lisp_Bignum); #endif /* HAVE_BIGNUM */ @@ -123,38 +142,6 @@ } -/********************************* Integers *********************************/ -DEFUN ("integerp", Fintegerp, 1, 1, 0, /* -Return t if OBJECT is an integer, nil otherwise. -*/ - (object)) -{ - return INTEGERP (object) ? Qt : Qnil; -} - -DEFUN ("evenp", Fevenp, 1, 1, 0, /* -Return t if INTEGER is even, nil otherwise. -*/ - (integer)) -{ - CONCHECK_INTEGER (integer); - return (BIGNUMP (integer) - ? bignum_evenp (XBIGNUM_DATA (integer)) - : XTYPE (integer) == Lisp_Type_Int_Even) ? Qt : Qnil; -} - -DEFUN ("oddp", Foddp, 1, 1, 0, /* -Return t if INTEGER is odd, nil otherwise. -*/ - (integer)) -{ - CONCHECK_INTEGER (integer); - return (BIGNUMP (integer) - ? bignum_oddp (XBIGNUM_DATA (integer)) - : XTYPE (integer) == Lisp_Type_Int_Odd) ? Qt : Qnil; -} - - /********************************** Ratios **********************************/ #ifdef HAVE_RATIO static void @@ -162,12 +149,29 @@ int UNUSED (escapeflag)) { CIbyte *rstr = ratio_to_string (XRATIO_DATA (obj), 10); - write_c_string (printcharfun, rstr); - xfree (rstr, CIbyte *); + write_ascstring (printcharfun, rstr); + xfree (rstr); } +#ifdef NEW_GC +static void +ratio_finalize (void *header) +{ + struct Lisp_Ratio *num = (struct Lisp_Ratio *) header; + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + ratio_fini (num->data); +} +#define RATIO_FINALIZE ratio_finalize +#else +#define RATIO_FINALIZE 0 +#endif + static int -ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) +ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), + int UNUSED (foldcase)) { return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); } @@ -184,7 +188,7 @@ }; DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print, - 0, ratio_equal, ratio_hash, + RATIO_FINALIZE, ratio_equal, ratio_hash, ratio_description, Lisp_Ratio); #endif /* HAVE_RATIO */ @@ -217,12 +221,13 @@ { CONCHECK_RATIONAL (rational); #ifdef HAVE_RATIO - return RATIOP (rational) - ? make_bignum_bg (XRATIO_NUMERATOR (rational)) - : rational; -#else + if (RATIOP (rational)) + { + return + Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (rational))); + } +#endif return rational; -#endif } DEFUN ("denominator", Fdenominator, 1, 1, 0, /* @@ -233,12 +238,13 @@ { CONCHECK_RATIONAL (rational); #ifdef HAVE_RATIO - return RATIOP (rational) - ? make_bignum_bg (XRATIO_DENOMINATOR (rational)) - : make_int (1); -#else - return rational; + if (RATIOP (rational)) + { + return Fcanonicalize_number (make_bignum_bg + (XRATIO_DENOMINATOR (rational))); + } #endif + return make_int (1); } @@ -248,13 +254,30 @@ bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { - CIbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10); - write_c_string (printcharfun, fstr); - xfree (fstr, CIbyte *); + Ascbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10); + write_ascstring (printcharfun, fstr); + xfree (fstr); } +#ifdef NEW_GC +static void +bigfloat_finalize (void *header) +{ + struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header; + /* #### WARNING: It would be better to put some sort of check to make + sure this doesn't happen more than once, just in case --- + e.g. checking if it's zero before finalizing and then setting it to + zero after finalizing. */ + bigfloat_fini (num->bf); +} +#define BIGFLOAT_FINALIZE bigfloat_finalize +#else +#define BIGFLOAT_FINALIZE 0 +#endif + static int -bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) +bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), + int UNUSED (foldcase)) { return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); } @@ -271,7 +294,7 @@ }; DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0, - bigfloat_print, 0, + bigfloat_print, BIGFLOAT_FINALIZE, bigfloat_equal, bigfloat_hash, bigfloat_description, Lisp_Bigfloat); @@ -345,7 +368,7 @@ #ifdef HAVE_BIGFLOAT if (INTP (*val)) prec = XINT (*val); - else + else { if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val))) args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec); @@ -405,7 +428,7 @@ if (RATIOP (number) && bignum_fits_long_p (XRATIO_DENOMINATOR (number)) && bignum_to_long (XRATIO_DENOMINATOR (number)) == 1L) - number = make_bignum_bg (XRATIO_NUMERATOR (number)); + number = Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (number))); #endif #ifdef HAVE_BIGNUM if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number))) @@ -655,7 +678,7 @@ 0UL); return type2; } - + if (type2 < type1) { *arg2 = internal_coerce_number (*arg2, type1, @@ -762,9 +785,6 @@ /* Functions */ DEFSUBR (Fbignump); - DEFSUBR (Fintegerp); - DEFSUBR (Fevenp); - DEFSUBR (Foddp); DEFSUBR (Fratiop); DEFSUBR (Frationalp); DEFSUBR (Fnumerator); @@ -800,26 +820,13 @@ */); #ifdef HAVE_BIGFLOAT -#ifdef HAVE_BIGNUM - Vbigfloat_max_prec = make_bignum (0L); - bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX); -#else + /* Don't create a bignum here. Otherwise, we lose with NEW_GC + pdump. + See reinit_vars_of_number(). */ Vbigfloat_max_prec = make_int (EMACS_INT_MAX); -#endif #else Vbigfloat_max_prec = make_int (0); #endif /* HAVE_BIGFLOAT */ - DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /* -The fixnum closest in value to negative infinity. -*/); - Vmost_negative_fixnum = EMACS_INT_MIN; - - DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /* -The fixnum closest in value to positive infinity. -*/); - Vmost_positive_fixnum = EMACS_INT_MAX; - Fprovide (intern ("number-types")); #ifdef HAVE_BIGNUM Fprovide (intern ("bignum")); @@ -833,6 +840,15 @@ } void +reinit_vars_of_number (void) +{ +#if defined(HAVE_BIGFLOAT) && defined(HAVE_BIGNUM) + Vbigfloat_max_prec = make_bignum (0L); + bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX); +#endif +} + +void init_number (void) { if (!number_initialized) @@ -860,5 +876,9 @@ bigfloat_init (scratch_bigfloat); bigfloat_init (scratch_bigfloat2); #endif + +#ifndef PDUMP + reinit_vars_of_number (); +#endif } }