diff src/data.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
line wrap: on
line diff
--- a/src/data.c	Mon Aug 13 11:12:06 2007 +0200
+++ b/src/data.c	Mon Aug 13 11:13:30 2007 +0200
@@ -50,18 +50,16 @@
 Lisp_Object Qarith_error, Qrange_error, Qdomain_error;
 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error;
 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
-Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp;
+Lisp_Object Qintegerp, Qnatnump, Qsymbolp;
 Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
 Lisp_Object Qconsp, Qsubrp;
 Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp;
 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp;
 Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p;
-Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p;
-Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore;
+Lisp_Object Qnumberp, Qnumber_char_or_marker_p;
+Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
 
-#ifdef LISP_FLOAT_TYPE
 Lisp_Object Qfloatp;
-#endif
 
 #ifdef DEBUG_XEMACS
 
@@ -69,19 +67,14 @@
 
 int debug_ebola_backtrace_length;
 
-#if 0
-/*#ifndef LRECORD_SYMBOL*/
-#include "backtrace.h"
-#endif
-
 int
 eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2)
 {
-  if (debug_issue_ebola_notices != -42 /* abracadabra */ &&
-      (((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1)))
-       && (debug_issue_ebola_notices >= 2
-	   || XCHAR_OR_INT (obj1) == XCHAR_OR_INT (obj2))))
+  if (debug_issue_ebola_notices
+      && ((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1))))
     {
+      /* #### It would be really nice if this were a proper warning
+         instead of brain-dead print ro Qexternal_debugging_output.  */
       write_c_string ("Comparison between integer and character is constant nil (",
 		      Qexternal_debugging_output);
       Fprinc (obj1, Qexternal_debugging_output);
@@ -130,9 +123,15 @@
 }
 
 DOESNT_RETURN
-pure_write_error (Lisp_Object obj)
+c_write_error (Lisp_Object obj)
 {
-  signal_simple_error ("Attempt to modify read-only object", obj);
+  signal_simple_error ("Attempt to modify read-only object (c)", obj);
+}
+
+DOESNT_RETURN
+lisp_write_error (Lisp_Object obj)
+{
+  signal_simple_error ("Attempt to modify read-only object (lisp)", obj);
 }
 
 DOESNT_RETURN
@@ -148,7 +147,7 @@
 }
 
 void
-check_int_range (int val, int min, int max)
+check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max)
 {
   if (val < min || val > max)
     args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
@@ -161,8 +160,8 @@
 
 /* On a few machines, XINT can only be done by calling this.  */
 /* XEmacs:  only used by m/convex.h */
-int sign_extend_lisp_int (EMACS_INT num);
-int
+EMACS_INT sign_extend_lisp_int (EMACS_INT num);
+EMACS_INT
 sign_extend_lisp_int (EMACS_INT num)
 {
   if (num & (1L << (VALBITS - 1)))
@@ -358,7 +357,7 @@
 */
        (subr))
 {
-  CONST char *prompt;
+  const char *prompt;
   CHECK_SUBR (subr);
   prompt = XSUBR (subr)->prompt;
   return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
@@ -546,22 +545,6 @@
 {
   switch (XTYPE (object))
     {
-#ifndef LRECORD_CONS
-      case Lisp_Type_Cons: return Qcons;
-#endif
-
-#ifndef LRECORD_SYMBOL
-    case Lisp_Type_Symbol: return Qsymbol;
-#endif
-
-#ifndef LRECORD_STRING
-    case Lisp_Type_String: return Qstring;
-#endif
-
-#ifndef LRECORD_VECTOR
-    case Lisp_Type_Vector: return Qvector;
-#endif
-
     case Lisp_Type_Record:
       return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name);
 
@@ -632,7 +615,6 @@
   if (!CONSP (conscell))
     conscell = wrong_type_argument (Qconsp, conscell);
 
-  CHECK_IMPURE (conscell);
   XCAR (conscell) = newcar;
   return newcar;
 }
@@ -645,7 +627,6 @@
   if (!CONSP (conscell))
     conscell = wrong_type_argument (Qconsp, conscell);
 
-  CHECK_IMPURE (conscell);
   XCDR (conscell) = newcdr;
   return newcdr;
 }
@@ -679,7 +660,7 @@
     }
 
   if (errorp && UNBOUNDP (hare))
-    signal_void_function_error (object);
+    return signal_void_function_error (object);
 
   return hare;
 }
@@ -706,7 +687,7 @@
 */
        (array, index_))
 {
-  int idx;
+  EMACS_INT idx;
 
  retry:
 
@@ -760,7 +741,7 @@
 */
        (array, index_, newval))
 {
-  int idx;
+  EMACS_INT idx;
 
  retry:
 
@@ -774,8 +755,6 @@
 
   if (idx < 0) goto range_error;
 
-  CHECK_IMPURE (array);
-
   if (VECTORP (array))
     {
       if (idx >= XVECTOR_LENGTH (array)) goto range_error;
@@ -816,7 +795,7 @@
   int int_p;
   union
   {
-    int ival;
+    EMACS_INT ival;
     double dval;
   } c;
 } int_or_double;
@@ -856,7 +835,7 @@
     }
 }
 
-static int
+static EMACS_INT
 integer_char_or_marker_to_int (Lisp_Object obj)
 {
  retry:
@@ -1433,8 +1412,8 @@
 */
        (num1, num2))
 {
-  int ival1 = integer_char_or_marker_to_int (num1);
-  int ival2 = integer_char_or_marker_to_int (num2);
+  EMACS_INT ival1 = integer_char_or_marker_to_int (num1);
+  EMACS_INT ival2 = integer_char_or_marker_to_int (num2);
 
   if (ival2 == 0)
     Fsignal (Qarith_error, Qnil);
@@ -1485,7 +1464,7 @@
     }
 #endif /* LISP_FLOAT_TYPE */
   {
-    int ival;
+    EMACS_INT ival;
     if (iod2.c.ival == 0) goto divide_by_zero;
 
     ival = iod1.c.ival % iod2.c.ival;
@@ -1587,7 +1566,7 @@
 static Lisp_Object encode_weak_list_type (enum weak_list_type type);
 
 static Lisp_Object
-mark_weak_list (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_weak_list (Lisp_Object obj)
 {
   return Qnil; /* nichts ist gemarkt */
 }
@@ -1630,7 +1609,7 @@
 {
   Lisp_Object result;
   struct weak_list *wl =
-    alloc_lcrecord_type (struct weak_list, lrecord_weak_list);
+    alloc_lcrecord_type (struct weak_list, &lrecord_weak_list);
 
   wl->list = Qnil;
   wl->type = type;
@@ -1640,9 +1619,16 @@
   return result;
 }
 
+static const struct lrecord_description weak_list_description[] = {
+  { XD_LISP_OBJECT, offsetof (struct weak_list, list) },
+  { XD_LO_LINK,     offsetof (struct weak_list, next_weak) },
+  { XD_END }
+};
+
 DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
 			       mark_weak_list, print_weak_list,
 			       0, weak_list_equal, weak_list_hash,
+			       weak_list_description,
 			       struct weak_list);
 /*
    -- we do not mark the list elements (either the elements themselves
@@ -1662,20 +1648,19 @@
 */
 
 int
-finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object),
-			   void (*markobj) (Lisp_Object))
+finish_marking_weak_lists (void)
 {
   Lisp_Object rest;
   int did_mark = 0;
 
   for (rest = Vall_weak_lists;
-       !GC_NILP (rest);
+       !NILP (rest);
        rest = XWEAK_LIST (rest)->next_weak)
     {
       Lisp_Object rest2;
       enum weak_list_type type = XWEAK_LIST (rest)->type;
 
-      if (! obj_marked_p (rest))
+      if (! marked_p (rest))
 	/* The weak list is probably garbage.  Ignore it. */
 	continue;
 
@@ -1683,7 +1668,7 @@
 	   /* We need to be trickier since we're inside of GC;
 	      use CONSP instead of !NILP in case of user-visible
 	      imperfect lists */
-	   GC_CONSP (rest2);
+	   CONSP (rest2);
 	   rest2 = XCDR (rest2))
 	{
 	  Lisp_Object elem;
@@ -1698,7 +1683,7 @@
 	     (either because of an external pointer or because of
 	     a previous call to this function), and likewise for all
 	     the rest of the elements in the list, so we can stop now. */
-	  if (obj_marked_p (rest2))
+	  if (marked_p (rest2))
 	    break;
 
 	  elem = XCAR (rest2);
@@ -1706,19 +1691,19 @@
 	  switch (type)
 	    {
 	    case WEAK_LIST_SIMPLE:
-	      if (obj_marked_p (elem))
+	      if (marked_p (elem))
 		need_to_mark_cons = 1;
 	      break;
 
 	    case WEAK_LIST_ASSOC:
-	      if (!GC_CONSP (elem))
+	      if (!CONSP (elem))
 		{
 		  /* just leave bogus elements there */
 		  need_to_mark_cons = 1;
 		  need_to_mark_elem = 1;
 		}
-	      else if (obj_marked_p (XCAR (elem)) &&
-		       obj_marked_p (XCDR (elem)))
+	      else if (marked_p (XCAR (elem)) &&
+		       marked_p (XCDR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem, because it's
@@ -1728,13 +1713,13 @@
 	      break;
 
 	    case WEAK_LIST_KEY_ASSOC:
-	      if (!GC_CONSP (elem))
+	      if (!CONSP (elem))
 		{
 		  /* just leave bogus elements there */
 		  need_to_mark_cons = 1;
 		  need_to_mark_elem = 1;
 		}
-	      else if (obj_marked_p (XCAR (elem)))
+	      else if (marked_p (XCAR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem and XCDR (elem);
@@ -1744,13 +1729,13 @@
 	      break;
 
 	    case WEAK_LIST_VALUE_ASSOC:
-	      if (!GC_CONSP (elem))
+	      if (!CONSP (elem))
 		{
 		  /* just leave bogus elements there */
 		  need_to_mark_cons = 1;
 		  need_to_mark_elem = 1;
 		}
-	      else if (obj_marked_p (XCDR (elem)))
+	      else if (marked_p (XCDR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem and XCAR (elem);
@@ -1763,23 +1748,23 @@
 	      abort ();
 	    }
 
-	  if (need_to_mark_elem && ! obj_marked_p (elem))
+	  if (need_to_mark_elem && ! marked_p (elem))
 	    {
-	      markobj (elem);
+	      mark_object (elem);
 	      did_mark = 1;
 	    }
 
 	  /* We also need to mark the cons that holds the elem or
-	     assoc-pair.  We do *not* want to call (markobj) here
+	     assoc-pair.  We do *not* want to call (mark_object) here
 	     because that will mark the entire list; we just want to
 	     mark the cons itself.
 	     */
 	  if (need_to_mark_cons)
 	    {
-	      struct Lisp_Cons *ptr = XCONS (rest2);
-	      if (!CONS_MARKED_P (ptr))
+	      Lisp_Cons *c = XCONS (rest2);
+	      if (!CONS_MARKED_P (c))
 		{
-		  MARK_CONS (ptr);
+		  MARK_CONS (c);
 		  did_mark = 1;
 		}
 	    }
@@ -1787,9 +1772,9 @@
 
       /* In case of imperfect list, need to mark the final cons
          because we're not removing it */
-      if (!GC_NILP (rest2) && ! obj_marked_p (rest2))
+      if (!NILP (rest2) && ! marked_p (rest2))
 	{
-	  markobj (rest2);
+	  mark_object (rest2);
 	  did_mark = 1;
 	}
     }
@@ -1798,18 +1783,18 @@
 }
 
 void
-prune_weak_lists (int (*obj_marked_p) (Lisp_Object))
+prune_weak_lists (void)
 {
   Lisp_Object rest, prev = Qnil;
 
   for (rest = Vall_weak_lists;
-       !GC_NILP (rest);
+       !NILP (rest);
        rest = XWEAK_LIST (rest)->next_weak)
     {
-      if (! (obj_marked_p (rest)))
+      if (! (marked_p (rest)))
 	{
 	  /* This weak list itself is garbage.  Remove it from the list. */
-	  if (GC_NILP (prev))
+	  if (NILP (prev))
 	    Vall_weak_lists = XWEAK_LIST (rest)->next_weak;
 	  else
 	    XWEAK_LIST (prev)->next_weak =
@@ -1825,7 +1810,7 @@
 	       /* We need to be trickier since we're inside of GC;
 		  use CONSP instead of !NILP in case of user-visible
 		  imperfect lists */
-	       GC_CONSP (rest2);)
+	       CONSP (rest2);)
 	    {
 	      /* It suffices to check the cons for marking,
 		 regardless of the type of weak list:
@@ -1836,10 +1821,10 @@
 		    have been marked in finish_marking_weak_lists().
 		 -- otherwise, it's not marked and should disappear.
 		 */
-	      if (! obj_marked_p (rest2))
+	      if (! marked_p (rest2))
 		{
 		  /* bye bye :-( */
-		  if (GC_NILP (prev2))
+		  if (NILP (prev2))
 		    XWEAK_LIST (rest)->list = XCDR (rest2);
 		  else
 		    XCDR (prev2) = XCDR (rest2);
@@ -1880,7 +1865,7 @@
 		  if (go_tortoise)
 		    tortoise = XCDR (tortoise);
 		  go_tortoise = !go_tortoise;
-		  if (GC_EQ (rest2, tortoise))
+		  if (EQ (rest2, tortoise))
 		    break;
 		}
 	    }
@@ -2091,17 +2076,13 @@
 void
 syms_of_data (void)
 {
-  defsymbol (&Qcons, "cons");
-  defsymbol (&Qkeyword, "keyword");
   defsymbol (&Qquote, "quote");
   defsymbol (&Qlambda, "lambda");
-  defsymbol (&Qignore, "ignore");
   defsymbol (&Qlistp, "listp");
   defsymbol (&Qtrue_list_p, "true-list-p");
   defsymbol (&Qconsp, "consp");
   defsymbol (&Qsubrp, "subrp");
   defsymbol (&Qsymbolp, "symbolp");
-  defsymbol (&Qkeywordp, "keywordp");
   defsymbol (&Qintegerp, "integerp");
   defsymbol (&Qcharacterp, "characterp");
   defsymbol (&Qnatnump, "natnump");
@@ -2118,7 +2099,6 @@
   defsymbol (&Qinteger_or_char_p, "integer-or-char-p");
   defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p");
   defsymbol (&Qnumberp, "numberp");
-  defsymbol (&Qnumber_or_marker_p, "number-or-marker-p");
   defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p");
   defsymbol (&Qcdr, "cdr");
   defsymbol (&Qweak_listp, "weak-list-p");
@@ -2217,9 +2197,10 @@
 {
   /* This must not be staticpro'd */
   Vall_weak_lists = Qnil;
+  pdump_wire_list (&Vall_weak_lists);
 
 #ifdef DEBUG_XEMACS
-  DEFVAR_INT ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
+  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,
@@ -2233,7 +2214,7 @@
 impossible to accurately determine Ebola infection.
 */ );
 
-  debug_issue_ebola_notices = 2; /* #### temporary hack */
+  debug_issue_ebola_notices = 0;
 
   DEFVAR_INT ("debug-ebola-backtrace-length",
 	      &debug_ebola_backtrace_length /*