diff src/data.c @ 5125:b5df3737028a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 b46c89ccbed3
children a9c41067dd88
line wrap: on
line diff
--- a/src/data.c	Wed Jan 20 07:05:57 2010 -0600
+++ b/src/data.c	Wed Feb 24 01:58:04 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;
@@ -79,13 +81,13 @@
     {
       /* #### It would be really nice if this were a proper warning
          instead of brain-dead print to Qexternal_debugging_output.  */
-      write_c_string
+      write_msg_string
 	(Qexternal_debugging_output,
 	 "Comparison between integer and character is constant nil (");
       Fprinc (obj1, Qexternal_debugging_output);
-      write_c_string (Qexternal_debugging_output, " and ");
+      write_msg_string (Qexternal_debugging_output, " and ");
       Fprinc (obj2, Qexternal_debugging_output);
-      write_c_string (Qexternal_debugging_output, ")\n");
+      write_msg_string (Qexternal_debugging_output, ")\n");
       debug_short_backtrace (debug_ebola_backtrace_length);
     }
   return EQ (obj1, obj2);
@@ -295,10 +297,7 @@
 */
        (object))
 {
-  return (VECTORP	(object) ||
-	  STRINGP	(object) ||
-	  BIT_VECTORP	(object))
-    ? Qt : Qnil;
+  return ARRAYP (object) ? Qt : Qnil;
 }
 
 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /*
@@ -306,11 +305,7 @@
 */
        (object))
 {
-  return (LISTP		(object) ||
-	  VECTORP	(object) ||
-	  STRINGP	(object) ||
-	  BIT_VECTORP	(object))
-    ? Qt : Qnil;
+  return SEQUENCEP (object) ? Qt : Qnil;
 }
 
 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /*
@@ -340,7 +335,7 @@
 
 DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /*
 Return maximum number of args built-in function SUBR may be called with,
-or nil if it takes an arbitrary number of arguments or is a special form.
+or nil if it takes an arbitrary number of arguments or is a special operator.
 */
        (subr))
 {
@@ -363,7 +358,7 @@
   const CIbyte *prompt;
   CHECK_SUBR (subr);
   prompt = XSUBR (subr)->prompt;
-  return prompt ? list2 (Qinteractive, build_msg_string (prompt)) : Qnil;
+  return prompt ? list2 (Qinteractive, build_msg_cistring (prompt)) : Qnil;
 }
 
 
@@ -420,7 +415,7 @@
 */
        (integer))
 {
-  CHECK_INT (integer);
+  CHECK_INTEGER (integer);
   if (CHAR_INTP (integer))
     return make_char (XINT (integer));
   else
@@ -456,31 +451,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 +486,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 +494,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 +540,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 +548,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 +556,7 @@
 */
        (object))
 {
-  return (INT_OR_FLOATP (object) ||
-	  CHARP         (object) ||
-	  MARKERP       (object))
+  return (NUMBERP (object) || CHARP (object) || MARKERP (object))
     ? Qt : Qnil;
 }
 
@@ -740,6 +732,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 +800,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 +902,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 +910,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,52 +1213,48 @@
 */
        (number))
 {
-#ifdef WITH_NUMBER_TYPES
   CHECK_NUMBER (number);
-#else
-  CHECK_INT_OR_FLOAT (number);
-#endif
 
   if (FLOATP (number))
     {
-      char pigbuf[350];	/* see comments in float_to_string */
+      Ascbyte pigbuf[350];	/* see comments in float_to_string */
 
       float_to_string (pigbuf, XFLOAT_DATA (number));
-      return build_string (pigbuf);
+      return build_ascstring (pigbuf);
     }
 #ifdef HAVE_BIGNUM
   if (BIGNUMP (number))
     {
-      char *str = bignum_to_string (XBIGNUM_DATA (number), 10);
-      Lisp_Object retval = build_string (str);
-      xfree (str, char *);
+      Ascbyte *str = bignum_to_string (XBIGNUM_DATA (number), 10);
+      Lisp_Object retval = build_ascstring (str);
+      xfree (str);
       return retval;
     }
 #endif
 #ifdef HAVE_RATIO
   if (RATIOP (number))
     {
-      char *str = ratio_to_string (XRATIO_DATA (number), 10);
-      Lisp_Object retval = build_string (str);
-      xfree (str, char *);
+      Ascbyte *str = ratio_to_string (XRATIO_DATA (number), 10);
+      Lisp_Object retval = build_ascstring (str);
+      xfree (str);
       return retval;
     }
 #endif
 #ifdef HAVE_BIGFLOAT
   if (BIGFLOATP (number))
     {
-      char *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10);
-      Lisp_Object retval = build_string (str);
-      xfree (str, char *);
+      Ascbyte *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10);
+      Lisp_Object retval = build_ascstring (str);
+      xfree (str);
       return retval;
     }
 #endif
 
   {
-    char buffer[DECIMAL_PRINT_SIZE (long)];
+    Ascbyte buffer[DECIMAL_PRINT_SIZE (long)];
 
     long_to_string (buffer, XINT (number));
-    return build_string (buffer);
+    return build_ascstring (buffer);
   }
 }
 
@@ -2132,7 +2149,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 +2201,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 +2223,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 +2233,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 +2252,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 +2264,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 +2274,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 +2305,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);
@@ -2592,7 +2613,7 @@
 		 int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_object ("#<weak-list>");
+    printing_unreadable_lcrecord (obj, 0);
 
   write_fmt_string_lisp (printcharfun, "#<weak-list %s %S>", 2,
 			 encode_weak_list_type (XWEAK_LIST (obj)->type),
@@ -2600,13 +2621,13 @@
 }
 
 static int
-weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
 {
   struct weak_list *w1 = XWEAK_LIST (obj1);
   struct weak_list *w2 = XWEAK_LIST (obj2);
 
   return ((w1->type == w2->type) &&
-	  internal_equal (w1->list, w2->list, depth + 1));
+	  internal_equal_0 (w1->list, w2->list, depth + 1, foldcase));
 }
 
 static Hashcode
@@ -3064,21 +3085,21 @@
 }
 
 static void
-print_weak_box (Lisp_Object UNUSED (obj), Lisp_Object printcharfun,
+print_weak_box (Lisp_Object obj, Lisp_Object printcharfun,
 		int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_object ("#<weak_box>");
-  write_fmt_string (printcharfun, "#<weak_box>");
+    printing_unreadable_lcrecord (obj, 0);
+  write_fmt_string (printcharfun, "#<weak-box>"); /* #### fix */
 }
 
 static int
-weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
 {
   struct weak_box *wb1 = XWEAK_BOX (obj1);
   struct weak_box *wb2 = XWEAK_BOX (obj2);
 
-  return (internal_equal (wb1->value, wb2->value, depth + 1));
+  return (internal_equal_0 (wb1->value, wb2->value, depth + 1, foldcase));
 }
 
 static Hashcode
@@ -3286,19 +3307,20 @@
 }
 
 static void
-print_ephemeron (Lisp_Object UNUSED (obj), Lisp_Object printcharfun,
+print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun,
 		 int UNUSED (escapeflag))
 {
   if (print_readably)
-    printing_unreadable_object ("#<ephemeron>");
-  write_fmt_string (printcharfun, "#<ephemeron>");
+    printing_unreadable_lcrecord (obj, 0);
+  write_fmt_string (printcharfun, "#<ephemeron>"); /* #### fix */
 }
 
 static int
-ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
+ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
 {
   return
-    internal_equal (XEPHEMERON_REF (obj1), XEPHEMERON_REF(obj2), depth + 1);
+    internal_equal_0 (XEPHEMERON_REF (obj1), XEPHEMERON_REF(obj2), depth + 1,
+		      foldcase);
 }
 
 static Hashcode
@@ -3541,11 +3563,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);
@@ -3635,6 +3654,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.