Mercurial > hg > xemacs-beta
diff src/data.c @ 4957:db2db229ee82
merge
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Thu, 28 Jan 2010 02:48:45 -0600 |
parents | 19a72041c5ed 6772ce4d982b |
children | e813cf16c015 |
line wrap: on
line diff
--- a/src/data.c Thu Jan 28 01:15:10 2010 -0600 +++ b/src/data.c Thu Jan 28 02:48:45 2010 -0600 @@ -65,6 +65,8 @@ Lisp_Object Qerror_lacks_explanatory_string; Lisp_Object Qfloatp; +Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum; + #ifdef DEBUG_XEMACS int debug_issue_ebola_notices; @@ -420,7 +422,7 @@ */ (integer)) { - CHECK_INT (integer); + CHECK_INTEGER (integer); if (CHAR_INTP (integer)) return make_char (XINT (integer)); else @@ -456,31 +458,34 @@ return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil; } -#ifdef HAVE_BIGNUM -/* In this case, integerp is defined in number.c. */ DEFUN ("fixnump", Ffixnump, 1, 1, 0, /* Return t if OBJECT is a fixnum. + +In this implementation, a fixnum is an immediate integer, and has a +maximum value described by the constant `most-positive-fixnum'. This +contrasts with bignums, integers where the values are limited by your +available memory. */ (object)) { return INTP (object) ? Qt : Qnil; } -#else DEFUN ("integerp", Fintegerp, 1, 1, 0, /* -Return t if OBJECT is an integer. +Return t if OBJECT is an integer, nil otherwise. + +On builds without bignum support, this function is identical to `fixnump'. */ (object)) { - return INTP (object) ? Qt : Qnil; + return INTEGERP (object) ? Qt : Qnil; } -#endif DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /* Return t if OBJECT is an integer or a marker (editor pointer). */ (object)) { - return INTP (object) || MARKERP (object) ? Qt : Qnil; + return INTEGERP (object) || MARKERP (object) ? Qt : Qnil; } DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /* @@ -488,7 +493,7 @@ */ (object)) { - return INTP (object) || CHARP (object) ? Qt : Qnil; + return INTEGERP (object) || CHARP (object) ? Qt : Qnil; } DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /* @@ -496,7 +501,7 @@ */ (object)) { - return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; + return INTEGERP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; } DEFUN ("natnump", Fnatnump, 1, 1, 0, /* @@ -542,11 +547,7 @@ */ (object)) { -#ifdef WITH_NUMBER_TYPES return NUMBERP (object) ? Qt : Qnil; -#else - return INT_OR_FLOATP (object) ? Qt : Qnil; -#endif } DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /* @@ -554,7 +555,7 @@ */ (object)) { - return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil; + return NUMBERP (object) || MARKERP (object) ? Qt : Qnil; } DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /* @@ -562,9 +563,7 @@ */ (object)) { - return (INT_OR_FLOATP (object) || - CHARP (object) || - MARKERP (object)) + return (NUMBERP (object) || CHARP (object) || MARKERP (object)) ? Qt : Qnil; } @@ -740,6 +739,19 @@ if (INTP (index_)) idx = XINT (index_); else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ +#ifdef HAVE_BIGNUM + else if (BIGNUMP (index_)) + { + Lisp_Object canon = Fcanonicalize_number (index_); + if (EQ (canon, index_)) + { + /* We don't support non-fixnum indices. */ + goto range_error; + } + index_ = canon; + goto retry; + } +#endif else { index_ = wrong_type_argument (Qinteger_or_char_p, index_); @@ -795,6 +807,19 @@ if (INTP (index_)) idx = XINT (index_); else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ +#ifdef HAVE_BIGNUM + else if (BIGNUMP (index_)) + { + Lisp_Object canon = Fcanonicalize_number (index_); + if (EQ (canon, index_)) + { + /* We don't support non-fixnum indices. */ + goto range_error; + } + index_ = canon; + goto retry; + } +#endif else { index_ = wrong_type_argument (Qinteger_or_char_p, index_); @@ -884,7 +909,7 @@ #endif /* WITH_NUMBER_TYPES */ static EMACS_INT -integer_char_or_marker_to_int (Lisp_Object obj) +fixnum_char_or_marker_to_int (Lisp_Object obj) { retry: if (INTP (obj)) return XINT (obj); @@ -892,6 +917,9 @@ else if (MARKERP (obj)) return marker_position (obj); else { + /* On bignum builds, we can only be called from #'lognot, which + protects against this happening: */ + assert (!BIGNUMP (obj)); obj = wrong_type_argument (Qinteger_char_or_marker_p, obj); goto retry; } @@ -1192,11 +1220,7 @@ */ (number)) { -#ifdef WITH_NUMBER_TYPES CHECK_NUMBER (number); -#else - CHECK_INT_OR_FLOAT (number); -#endif if (FLOATP (number)) { @@ -2132,7 +2156,7 @@ Lisp_Object *args_end = args + nargs; while (args < args_end) - bits &= integer_char_or_marker_to_int (*args++); + bits &= fixnum_char_or_marker_to_int (*args++); return make_int (bits); #endif /* HAVE_BIGNUM */ @@ -2184,7 +2208,7 @@ Lisp_Object *args_end = args + nargs; while (args < args_end) - bits |= integer_char_or_marker_to_int (*args++); + bits |= fixnum_char_or_marker_to_int (*args++); return make_int (bits); #endif /* HAVE_BIGNUM */ @@ -2206,7 +2230,7 @@ return make_int (0); while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) - args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); + args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]); result = args[0]; if (CHARP (result)) @@ -2216,7 +2240,7 @@ for (i = 1; i < nargs; i++) { while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) - args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); + args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]); other = args[i]; if (promote_args (&result, &other) == FIXNUM_T) { @@ -2235,7 +2259,7 @@ Lisp_Object *args_end = args + nargs; while (args < args_end) - bits ^= integer_char_or_marker_to_int (*args++); + bits ^= fixnum_char_or_marker_to_int (*args++); return make_int (bits); #endif /* !HAVE_BIGNUM */ @@ -2247,6 +2271,9 @@ */ (number)) { + while (!(CHARP (number) || MARKERP (number) || INTEGERP (number))) + number = wrong_type_argument (Qinteger_char_or_marker_p, number); + #ifdef HAVE_BIGNUM if (BIGNUMP (number)) { @@ -2254,7 +2281,8 @@ return make_bignum_bg (scratch_bignum); } #endif /* HAVE_BIGNUM */ - return make_int (~ integer_char_or_marker_to_int (number)); + + return make_int (~ fixnum_char_or_marker_to_int (number)); } DEFUN ("%", Frem, 2, 2, 0, /* @@ -2284,8 +2312,8 @@ return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); } #else /* !HAVE_BIGNUM */ - EMACS_INT ival1 = integer_char_or_marker_to_int (number1); - EMACS_INT ival2 = integer_char_or_marker_to_int (number2); + EMACS_INT ival1 = fixnum_char_or_marker_to_int (number1); + EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2); if (ival2 == 0) Fsignal (Qarith_error, Qnil); @@ -3550,11 +3578,8 @@ DEFSUBR (Fchar_to_int); DEFSUBR (Fint_to_char); DEFSUBR (Fchar_or_char_int_p); -#ifdef HAVE_BIGNUM DEFSUBR (Ffixnump); -#else DEFSUBR (Fintegerp); -#endif DEFSUBR (Finteger_or_marker_p); DEFSUBR (Finteger_or_char_p); DEFSUBR (Finteger_char_or_marker_p); @@ -3644,6 +3669,16 @@ Vall_weak_boxes = Qnil; dump_add_weak_object_chain (&Vall_weak_boxes); + 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; + #ifdef DEBUG_XEMACS DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* If non-zero, note when your code may be suffering from char-int confoundance.