diff src/data.c @ 412:697ef44129c6 r21-2-14

Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents de805c49cfc1
children e804706bfb8c
line wrap: on
line diff
--- a/src/data.c	Mon Aug 13 11:19:22 2007 +0200
+++ b/src/data.c	Mon Aug 13 11:20:41 2007 +0200
@@ -50,14 +50,14 @@
 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;
+Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp;
 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_char_or_marker_p;
-Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
+Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p;
+Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore;
 
 Lisp_Object Qfloatp;
 
@@ -147,7 +147,7 @@
 }
 
 void
-check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max)
+check_int_range (int val, int min, int max)
 {
   if (val < min || val > max)
     args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
@@ -160,8 +160,8 @@
 
 /* On a few machines, XINT can only be done by calling this.  */
 /* XEmacs:  only used by m/convex.h */
-EMACS_INT sign_extend_lisp_int (EMACS_INT num);
-EMACS_INT
+int sign_extend_lisp_int (EMACS_INT num);
+int
 sign_extend_lisp_int (EMACS_INT num)
 {
   if (num & (1L << (VALBITS - 1)))
@@ -357,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;
@@ -615,6 +615,7 @@
   if (!CONSP (conscell))
     conscell = wrong_type_argument (Qconsp, conscell);
 
+  CHECK_LISP_WRITEABLE (conscell);
   XCAR (conscell) = newcar;
   return newcar;
 }
@@ -627,6 +628,7 @@
   if (!CONSP (conscell))
     conscell = wrong_type_argument (Qconsp, conscell);
 
+  CHECK_LISP_WRITEABLE (conscell);
   XCDR (conscell) = newcdr;
   return newcdr;
 }
@@ -660,7 +662,7 @@
     }
 
   if (errorp && UNBOUNDP (hare))
-    return signal_void_function_error (object);
+    signal_void_function_error (object);
 
   return hare;
 }
@@ -687,7 +689,7 @@
 */
        (array, index_))
 {
-  EMACS_INT idx;
+  int idx;
 
  retry:
 
@@ -741,7 +743,7 @@
 */
        (array, index_, newval))
 {
-  EMACS_INT idx;
+  int idx;
 
  retry:
 
@@ -755,6 +757,8 @@
 
   if (idx < 0) goto range_error;
 
+  CHECK_LISP_WRITEABLE (array);
+
   if (VECTORP (array))
     {
       if (idx >= XVECTOR_LENGTH (array)) goto range_error;
@@ -795,7 +799,7 @@
   int int_p;
   union
   {
-    EMACS_INT ival;
+    int ival;
     double dval;
   } c;
 } int_or_double;
@@ -835,7 +839,7 @@
     }
 }
 
-static EMACS_INT
+static int
 integer_char_or_marker_to_int (Lisp_Object obj)
 {
  retry:
@@ -1064,7 +1068,7 @@
     p++;
 
 #ifdef LISP_FLOAT_TYPE
-  if (isfloat_string (p) && b == 10)
+  if (isfloat_string (p))
     return make_float (atof (p));
 #endif /* LISP_FLOAT_TYPE */
 
@@ -1412,8 +1416,8 @@
 */
        (num1, num2))
 {
-  EMACS_INT ival1 = integer_char_or_marker_to_int (num1);
-  EMACS_INT ival2 = integer_char_or_marker_to_int (num2);
+  int ival1 = integer_char_or_marker_to_int (num1);
+  int ival2 = integer_char_or_marker_to_int (num2);
 
   if (ival2 == 0)
     Fsignal (Qarith_error, Qnil);
@@ -1464,7 +1468,7 @@
     }
 #endif /* LISP_FLOAT_TYPE */
   {
-    EMACS_INT ival;
+    int ival;
     if (iod2.c.ival == 0) goto divide_by_zero;
 
     ival = iod1.c.ival % iod2.c.ival;
@@ -1566,7 +1570,7 @@
 static Lisp_Object encode_weak_list_type (enum weak_list_type type);
 
 static Lisp_Object
-mark_weak_list (Lisp_Object obj)
+mark_weak_list (Lisp_Object obj, void (*markobj) (Lisp_Object))
 {
   return Qnil; /* nichts ist gemarkt */
 }
@@ -1619,16 +1623,9 @@
   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
@@ -1648,19 +1645,20 @@
 */
 
 int
-finish_marking_weak_lists (void)
+finish_marking_weak_lists (int (*obj_marked_p) (Lisp_Object),
+			   void (*markobj) (Lisp_Object))
 {
   Lisp_Object rest;
   int did_mark = 0;
 
   for (rest = Vall_weak_lists;
-       !NILP (rest);
+       !GC_NILP (rest);
        rest = XWEAK_LIST (rest)->next_weak)
     {
       Lisp_Object rest2;
       enum weak_list_type type = XWEAK_LIST (rest)->type;
 
-      if (! marked_p (rest))
+      if (! obj_marked_p (rest))
 	/* The weak list is probably garbage.  Ignore it. */
 	continue;
 
@@ -1668,7 +1666,7 @@
 	   /* We need to be trickier since we're inside of GC;
 	      use CONSP instead of !NILP in case of user-visible
 	      imperfect lists */
-	   CONSP (rest2);
+	   GC_CONSP (rest2);
 	   rest2 = XCDR (rest2))
 	{
 	  Lisp_Object elem;
@@ -1683,7 +1681,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 (marked_p (rest2))
+	  if (obj_marked_p (rest2))
 	    break;
 
 	  elem = XCAR (rest2);
@@ -1691,19 +1689,19 @@
 	  switch (type)
 	    {
 	    case WEAK_LIST_SIMPLE:
-	      if (marked_p (elem))
+	      if (obj_marked_p (elem))
 		need_to_mark_cons = 1;
 	      break;
 
 	    case WEAK_LIST_ASSOC:
-	      if (!CONSP (elem))
+	      if (!GC_CONSP (elem))
 		{
 		  /* just leave bogus elements there */
 		  need_to_mark_cons = 1;
 		  need_to_mark_elem = 1;
 		}
-	      else if (marked_p (XCAR (elem)) &&
-		       marked_p (XCDR (elem)))
+	      else if (obj_marked_p (XCAR (elem)) &&
+		       obj_marked_p (XCDR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem, because it's
@@ -1713,13 +1711,13 @@
 	      break;
 
 	    case WEAK_LIST_KEY_ASSOC:
-	      if (!CONSP (elem))
+	      if (!GC_CONSP (elem))
 		{
 		  /* just leave bogus elements there */
 		  need_to_mark_cons = 1;
 		  need_to_mark_elem = 1;
 		}
-	      else if (marked_p (XCAR (elem)))
+	      else if (obj_marked_p (XCAR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem and XCDR (elem);
@@ -1729,30 +1727,13 @@
 	      break;
 
 	    case WEAK_LIST_VALUE_ASSOC:
-	      if (!CONSP (elem))
+	      if (!GC_CONSP (elem))
 		{
 		  /* just leave bogus elements there */
 		  need_to_mark_cons = 1;
 		  need_to_mark_elem = 1;
 		}
-	      else if (marked_p (XCDR (elem)))
-		{
-		  need_to_mark_cons = 1;
-		  /* We still need to mark elem and XCAR (elem);
-		     marking elem does both */
-		  need_to_mark_elem = 1;
-		}
-	      break;
-
-	    case WEAK_LIST_FULL_ASSOC:
-	      if (!CONSP (elem))
-		{
-		  /* just leave bogus elements there */
-		  need_to_mark_cons = 1;
-		  need_to_mark_elem = 1;
-		}
-	      else if (marked_p (XCAR (elem)) ||
-		       marked_p (XCDR (elem)))
+	      else if (obj_marked_p (XCDR (elem)))
 		{
 		  need_to_mark_cons = 1;
 		  /* We still need to mark elem and XCAR (elem);
@@ -1765,23 +1746,23 @@
 	      abort ();
 	    }
 
-	  if (need_to_mark_elem && ! marked_p (elem))
+	  if (need_to_mark_elem && ! obj_marked_p (elem))
 	    {
-	      mark_object (elem);
+	      markobj (elem);
 	      did_mark = 1;
 	    }
 
 	  /* We also need to mark the cons that holds the elem or
-	     assoc-pair.  We do *not* want to call (mark_object) here
+	     assoc-pair.  We do *not* want to call (markobj) here
 	     because that will mark the entire list; we just want to
 	     mark the cons itself.
 	     */
 	  if (need_to_mark_cons)
 	    {
-	      Lisp_Cons *c = XCONS (rest2);
-	      if (!CONS_MARKED_P (c))
+	      struct Lisp_Cons *ptr = XCONS (rest2);
+	      if (!CONS_MARKED_P (ptr))
 		{
-		  MARK_CONS (c);
+		  MARK_CONS (ptr);
 		  did_mark = 1;
 		}
 	    }
@@ -1789,9 +1770,9 @@
 
       /* In case of imperfect list, need to mark the final cons
          because we're not removing it */
-      if (!NILP (rest2) && ! marked_p (rest2))
+      if (!GC_NILP (rest2) && ! obj_marked_p (rest2))
 	{
-	  mark_object (rest2);
+	  markobj (rest2);
 	  did_mark = 1;
 	}
     }
@@ -1800,18 +1781,18 @@
 }
 
 void
-prune_weak_lists (void)
+prune_weak_lists (int (*obj_marked_p) (Lisp_Object))
 {
   Lisp_Object rest, prev = Qnil;
 
   for (rest = Vall_weak_lists;
-       !NILP (rest);
+       !GC_NILP (rest);
        rest = XWEAK_LIST (rest)->next_weak)
     {
-      if (! (marked_p (rest)))
+      if (! (obj_marked_p (rest)))
 	{
 	  /* This weak list itself is garbage.  Remove it from the list. */
-	  if (NILP (prev))
+	  if (GC_NILP (prev))
 	    Vall_weak_lists = XWEAK_LIST (rest)->next_weak;
 	  else
 	    XWEAK_LIST (prev)->next_weak =
@@ -1827,7 +1808,7 @@
 	       /* We need to be trickier since we're inside of GC;
 		  use CONSP instead of !NILP in case of user-visible
 		  imperfect lists */
-	       CONSP (rest2);)
+	       GC_CONSP (rest2);)
 	    {
 	      /* It suffices to check the cons for marking,
 		 regardless of the type of weak list:
@@ -1838,10 +1819,10 @@
 		    have been marked in finish_marking_weak_lists().
 		 -- otherwise, it's not marked and should disappear.
 		 */
-	      if (! marked_p (rest2))
+	      if (! obj_marked_p (rest2))
 		{
 		  /* bye bye :-( */
-		  if (NILP (prev2))
+		  if (GC_NILP (prev2))
 		    XWEAK_LIST (rest)->list = XCDR (rest2);
 		  else
 		    XCDR (prev2) = XCDR (rest2);
@@ -1882,7 +1863,7 @@
 		  if (go_tortoise)
 		    tortoise = XCDR (tortoise);
 		  go_tortoise = !go_tortoise;
-		  if (EQ (rest2, tortoise))
+		  if (GC_EQ (rest2, tortoise))
 		    break;
 		}
 	    }
@@ -1901,7 +1882,6 @@
   if (EQ (symbol, Qold_assoc))	 return WEAK_LIST_ASSOC;  /* EBOLA ALERT! */
   if (EQ (symbol, Qkey_assoc))	 return WEAK_LIST_KEY_ASSOC;
   if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC;
-  if (EQ (symbol, Qfull_assoc))  return WEAK_LIST_FULL_ASSOC;
 
   signal_simple_error ("Invalid weak list type", symbol);
   return WEAK_LIST_SIMPLE; /* not reached */
@@ -1916,7 +1896,6 @@
     case WEAK_LIST_ASSOC:       return Qassoc;
     case WEAK_LIST_KEY_ASSOC:   return Qkey_assoc;
     case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc;
-    case WEAK_LIST_FULL_ASSOC:  return Qfull_assoc;
     default:
       abort ();
     }
@@ -1955,8 +1934,6 @@
 		and the car is not pointed to.
 `value-assoc'	Objects in the list disappear if they are conses
 		and the cdr is not pointed to.
-`full-assoc'	Objects in the list disappear if they are conses
-		and neither the car nor the cdr is pointed to.
 */
        (type))
 {
@@ -2097,15 +2074,17 @@
 void
 syms_of_data (void)
 {
-  INIT_LRECORD_IMPLEMENTATION (weak_list);
-
+  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");
@@ -2122,6 +2101,7 @@
   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");
@@ -2220,7 +2200,6 @@
 {
   /* This must not be staticpro'd */
   Vall_weak_lists = Qnil;
-  pdump_wire_list (&Vall_weak_lists);
 
 #ifdef DEBUG_XEMACS
   DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*