xemacs-beta: src/data.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:3461165c79be
+:db2db229ee82
 Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
 Lisp_Object Qerror_lacks_explanatory_string;
 Lisp_Object Qfloatp;
+Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
 #ifdef DEBUG_XEMACS
 int debug_issue_ebola_notices;
 Fixnum debug_ebola_backtrace_length;
 determine whether this is the case.  If the integer cannot be converted,
 nil is returned.
 */
 (integer))
 {
-CHECK_INT (integer);
+CHECK_INTEGER (integer);
 if (CHAR_INTP (integer))
 return make_char (XINT (integer));
 else
 return Qnil;
 }
 (object))
 {
 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, /*
 Return t if OBJECT is an integer or a character.
 */
 (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, /*
 Return t if OBJECT is an integer, character or a marker (editor pointer).
 */
 (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, /*
 Return t if OBJECT is a nonnegative integer.
 */
 DEFUN ("numberp", Fnumberp, 1, 1, 0, /*
 Return t if OBJECT is a number (floating point or integer).
 */
 (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, /*
 Return t if OBJECT is a number or a marker.
 */
 (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, /*
 Return t if OBJECT is a number, character or a marker.
 */
 (object))
 {
-return (INT_OR_FLOATP (object) ||
+return (NUMBERP (object) || CHARP (object) || MARKERP (object))
-	  CHARP         (object) ||
-	  MARKERP       (object))
 ? Qt : Qnil;
 }
 DEFUN ("floatp", Ffloatp, 1, 1, 0, /*
 Return t if OBJECT is a floating point number.
 retry:
 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_);
 goto retry;
 }
 retry:
 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_);
 goto retry;
 }
 }
 }
 #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);
 else if (CHARP   (obj)) return XCHAR (obj);
 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;
 }
 }
 NUMBER may be an integer or a floating point number.
 If supported, it may also be a ratio.
 */
 (number))
 {
-#ifdef WITH_NUMBER_TYPES
 CHECK_NUMBER (number);
-#else
-CHECK_INT_OR_FLOAT (number);
-#endif
 if (FLOATP (number))
 {
 Ascbyte pigbuf[350];	/* see comments in float_to_string */
 #else /* !HAVE_BIGNUM */
 EMACS_INT bits = ~0;
 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 */
 }
 #else /* !HAVE_BIGNUM */
 EMACS_INT bits = 0;
 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 */
 }
 if (nargs == 0)
 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))
 result = make_int (XCHAR (result));
 else if (MARKERP (result))
 result = make_int (marker_position (result));
 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)
 	{
 	  result = make_int (XREALINT (result) ^ XREALINT (other));
 	}
 #else /* !HAVE_BIGNUM */
 EMACS_INT bits = 0;
 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 */
 }
 Return the bitwise complement of NUMBER.
 NUMBER may be an integer, marker or character converted to integer.
 */
 (number))
 {
+while (!(CHARP (number) || MARKERP (number) || INTEGERP (number)))
+number = wrong_type_argument (Qinteger_char_or_marker_p, number);
 #ifdef HAVE_BIGNUM
 if (BIGNUMP (number))
 {
 bignum_not (scratch_bignum, XBIGNUM_DATA (number));
 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, /*
 Return remainder of first arg divided by second.
 Both must be integers, characters or markers.
 bignum_mod (scratch_bignum, XBIGNUM_DATA (number1),
 		  XBIGNUM_DATA (number2));
 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
 }
 #else /* !HAVE_BIGNUM */
-EMACS_INT ival1 = integer_char_or_marker_to_int (number1);
+EMACS_INT ival1 = fixnum_char_or_marker_to_int (number1);
-EMACS_INT ival2 = integer_char_or_marker_to_int (number2);
+EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2);
 if (ival2 == 0)
 Fsignal (Qarith_error, Qnil);
 return make_int (ival1 % ival2);
 DEFSUBR (Fcharacterp);
 DEFSUBR (Fchar_int_p);
 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);
 DEFSUBR (Fnumberp);
 DEFSUBR (Fnumber_or_marker_p);
 staticpro (&Vfinalize_list);
 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.
 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal',
 etc. where an int and a char with the same value are being compared,

Mercurial > hg > xemacs-beta

comparison src/data.c @ 4957:db2db229ee82