Mercurial > emacs

changeset 51658:00b3e009b3f5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(make_interval, Fmake_symbol, allocate_misc): Initialize the new field `gcmarkbit'. (mark_interval, MARK_INTERVAL_TREE): Use the new `gcmarkbit' field. (mark_interval_tree): Don't mark the tree separately from the nodes. (UNMARK_BALANCE_INTERVALS): Don't unmark the tree. (mark_maybe_object, mark_maybe_pointer, Fgarbage_collect, mark_object) (survives_gc_p, gc_sweep): Use new `gcmarkbit' fields.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Wed, 25 Jun 2003 23:27:32 +0000
parents 7fb427e8d984
children dcc02be2d7f4
files src/alloc.c
diffstat 1 files changed, 41 insertions(+), 118 deletions(-) [+]
line wrap: on
line diff
--- a/src/alloc.c	Wed Jun 25 23:16:30 2003 +0000
+++ b/src/alloc.c	Wed Jun 25 23:27:32 2003 +0000
@@ -947,6 +947,7 @@
   consing_since_gc += sizeof (struct interval);
   intervals_consed++;
   RESET_INTERVAL (val);
+  val->gcmarkbit = 0;
   return val;
 }
 
@@ -958,10 +959,9 @@
      register INTERVAL i;
      Lisp_Object dummy;
 {
-  if (XMARKBIT (i->plist))
-    abort ();
+  eassert (!i->gcmarkbit);		/* Intervals are never shared.  */
+  i->gcmarkbit = 1;
   mark_object (&i->plist);
-  XMARK (i->plist);
 }
 
 
@@ -976,10 +976,6 @@
      function is always called through the MARK_INTERVAL_TREE macro,
      which takes care of that.  */
 
-  /* XMARK expands to an assignment; the LHS of an assignment can't be
-     a cast.  */
-  XMARK (tree->up.obj);
-
   traverse_intervals_noorder (tree, mark_interval, Qnil);
 }
 
@@ -988,23 +984,15 @@
 
 #define MARK_INTERVAL_TREE(i)				\
   do {							\
-    if (!NULL_INTERVAL_P (i)				\
-	&& ! XMARKBIT (i->up.obj))			\
+    if (!NULL_INTERVAL_P (i) && !i->gcmarkbit)		\
       mark_interval_tree (i);				\
   } while (0)
 
 
-/* The oddity in the call to XUNMARK is necessary because XUNMARK
-   expands to an assignment to its argument, and most C compilers
-   don't support casts on the left operand of `='.  */
-
 #define UNMARK_BALANCE_INTERVALS(i)			\
   do {							\
    if (! NULL_INTERVAL_P (i))				\
-     {							\
-       XUNMARK ((i)->up.obj);				\
-       (i) = balance_intervals (i);			\
-     }							\
+     (i) = balance_intervals (i);			\
   } while (0)
 
 
@@ -2568,6 +2556,7 @@
   p->value = Qunbound;
   p->function = Qunbound;
   p->next = NULL;
+  p->gcmarkbit = 0;
   p->interned = SYMBOL_UNINTERNED;
   p->constant = 0;
   p->indirect_variable = 0;
@@ -2644,6 +2633,7 @@
 
   consing_since_gc += sizeof (union Lisp_Misc);
   misc_objects_consed++;
+  XMARKER (val)->gcmarkbit = 0;
   return val;
 }
 
@@ -3302,7 +3292,7 @@
 }
 
 
-/* Value is non-zero of P is a pointer to a live buffer.  M is a
+/* Value is non-zero if P is a pointer to a live buffer.  M is a
    pointer to the mem_block for P.  */
 
 static INLINE int
@@ -3397,8 +3387,7 @@
 	  break;
 
 	case Lisp_Symbol:
-	  mark_p = (live_symbol_p (m, po)
-		    && !XMARKBIT (XSYMBOL (obj)->plist));
+	  mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit);
 	  break;
 
 	case Lisp_Float:
@@ -3418,24 +3407,7 @@
 	  break;
 
 	case Lisp_Misc:
-	  if (live_misc_p (m, po))
-	    {
-	      switch (XMISCTYPE (obj))
-		{
-		case Lisp_Misc_Marker:
-		  mark_p = !XMARKBIT (XMARKER (obj)->chain);
-		  break;
-
-		case Lisp_Misc_Buffer_Local_Value:
-		case Lisp_Misc_Some_Buffer_Local_Value:
-		  mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
-		  break;
-
-		case Lisp_Misc_Overlay:
-		  mark_p = !XMARKBIT (XOVERLAY (obj)->plist);
-		  break;
-		}
-	    }
+	  mark_p = (live_misc_p (m, po) && !XMARKER (obj)->gcmarkbit);
 	  break;
 
 	case Lisp_Int:
@@ -3500,35 +3472,12 @@
 	  break;
 
 	case MEM_TYPE_MISC:
-	  if (live_misc_p (m, p))
-	    {
-	      Lisp_Object tem;
-	      XSETMISC (tem, p);
-
-	      switch (XMISCTYPE (tem))
-		{
-		case Lisp_Misc_Marker:
-		  if (!XMARKBIT (XMARKER (tem)->chain))
-		    obj = tem;
-		  break;
-
-		case Lisp_Misc_Buffer_Local_Value:
-		case Lisp_Misc_Some_Buffer_Local_Value:
-		  if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue))
-		    obj = tem;
-		  break;
-
-		case Lisp_Misc_Overlay:
-		  if (!XMARKBIT (XOVERLAY (tem)->plist))
-		    obj = tem;
-		  break;
-		}
-	    }
+	  if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit)
+	    XSETMISC (obj, p);
 	  break;
 
 	case MEM_TYPE_SYMBOL:
-	  if (live_symbol_p (m, p)
-	      && !XMARKBIT (((struct Lisp_Symbol *) p)->plist))
+	  if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit)
 	    XSETSYMBOL (obj, p);
 	  break;
 
@@ -4278,7 +4227,7 @@
 	      {
 		if (GC_CONSP (XCAR (tail))
 		    && GC_MARKERP (XCAR (XCAR (tail)))
-		    && ! XMARKBIT (XMARKER (XCAR (XCAR (tail)))->chain))
+		    && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
 		  {
 		    if (NILP (prev))
 		      nextb->undo_list = tail = XCDR (tail);
@@ -4774,9 +4723,9 @@
 	register struct Lisp_Symbol *ptr = XSYMBOL (obj);
 	struct Lisp_Symbol *ptrx;
 
-	if (XMARKBIT (ptr->plist)) break;
+	if (ptr->gcmarkbit) break;
 	CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
-	XMARK (ptr->plist);
+	ptr->gcmarkbit = 1;
 	mark_object ((Lisp_Object *) &ptr->value);
 	mark_object (&ptr->function);
 	mark_object (&ptr->plist);
@@ -4804,22 +4753,16 @@
 
     case Lisp_Misc:
       CHECK_ALLOCATED_AND_LIVE (live_misc_p);
+      if (XMARKER (obj)->gcmarkbit)
+	break;
+      XMARKER (obj)->gcmarkbit = 1;
       switch (XMISCTYPE (obj))
 	{
-	case Lisp_Misc_Marker:
-	  XMARK (XMARKER (obj)->chain);
-	  /* DO NOT mark thru the marker's chain.
-	     The buffer's markers chain does not preserve markers from gc;
-	     instead, markers are removed from the chain when freed by gc.  */
-	  break;
-
 	case Lisp_Misc_Buffer_Local_Value:
 	case Lisp_Misc_Some_Buffer_Local_Value:
 	  {
 	    register struct Lisp_Buffer_Local_Value *ptr
 	      = XBUFFER_LOCAL_VALUE (obj);
-	    if (XMARKBIT (ptr->realvalue)) break;
-	    XMARK (ptr->realvalue);
 	    /* If the cdr is nil, avoid recursion for the car.  */
 	    if (EQ (ptr->cdr, Qnil))
 	      {
@@ -4833,6 +4776,10 @@
 	    goto loop;
 	  }
 
+	case Lisp_Misc_Marker:
+	  /* DO NOT mark thru the marker's chain.
+	     The buffer's markers chain does not preserve markers from gc;
+	     instead, markers are removed from the chain when freed by gc.  */
 	case Lisp_Misc_Intfwd:
 	case Lisp_Misc_Boolfwd:
 	case Lisp_Misc_Objfwd:
@@ -4847,14 +4794,10 @@
 	case Lisp_Misc_Overlay:
 	  {
 	    struct Lisp_Overlay *ptr = XOVERLAY (obj);
-	    if (!XMARKBIT (ptr->plist))
-	      {
-		XMARK (ptr->plist);
-		mark_object (&ptr->start);
-		mark_object (&ptr->end);
-		objptr = &ptr->plist;
-		goto loop;
-	      }
+	    mark_object (&ptr->start);
+	    mark_object (&ptr->end);
+	    objptr = &ptr->plist;
+	    goto loop;
 	  }
 	  break;
 
@@ -4922,6 +4865,9 @@
       Lisp_Object tail;
       tail = buffer->undo_list;
 
+      /* We mark the undo list specially because
+	 its pointers to markers should be weak.  */
+
       while (CONSP (tail))
 	{
 	  register struct Lisp_Cons *ptr = XCONS (tail);
@@ -4980,19 +4926,20 @@
       break;
 
     case Lisp_Symbol:
-      survives_p = XMARKBIT (XSYMBOL (obj)->plist);
+      survives_p = XSYMBOL (obj)->gcmarkbit;
       break;
 
     case Lisp_Misc:
+      /* FIXME: Maybe we should just use obj->mark for all?  */
       switch (XMISCTYPE (obj))
 	{
 	case Lisp_Misc_Marker:
-	  survives_p = XMARKBIT (obj);
+	  survives_p = XMARKER (obj)->gcmarkbit;
 	  break;
 
 	case Lisp_Misc_Buffer_Local_Value:
 	case Lisp_Misc_Some_Buffer_Local_Value:
-	  survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
+	  survives_p = XBUFFER_LOCAL_VALUE (obj)->gcmarkbit;
 	  break;
 
 	case Lisp_Misc_Intfwd:
@@ -5004,7 +4951,7 @@
 	  break;
 
 	case Lisp_Misc_Overlay:
-	  survives_p = XMARKBIT (XOVERLAY (obj)->plist);
+	  survives_p = XOVERLAY (obj)->gcmarkbit;
 	  break;
 
 	default:
@@ -5176,7 +5123,7 @@
 
 	for (i = 0; i < lim; i++)
 	  {
-	    if (! XMARKBIT (iblk->intervals[i].plist))
+	    if (!iblk->intervals[i].gcmarkbit)
 	      {
 		SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);
 		interval_free_list = &iblk->intervals[i];
@@ -5185,7 +5132,7 @@
 	    else
 	      {
 		num_used++;
-		XUNMARK (iblk->intervals[i].plist);
+		iblk->intervals[i].gcmarkbit = 0;
 	      }
 	  }
 	lim = INTERVAL_BLOCK_SIZE;
@@ -5232,7 +5179,7 @@
 	       so we conservatively assume that it is live.  */
 	    int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
 
-	    if (!XMARKBIT (sym->plist) && !pure_p)
+	    if (!sym->gcmarkbit && !pure_p)
 	      {
 		*(struct Lisp_Symbol **) &sym->value = symbol_free_list;
 		symbol_free_list = sym;
@@ -5246,7 +5193,7 @@
 		++num_used;
 		if (!pure_p)
 		  UNMARK_STRING (XSTRING (sym->xname));
-		XUNMARK (sym->plist);
+		sym->gcmarkbit = 0;
 	      }
 	  }
 
@@ -5286,33 +5233,10 @@
       {
 	register int i;
 	int this_free = 0;
-	EMACS_INT already_free = -1;
 
 	for (i = 0; i < lim; i++)
 	  {
-	    Lisp_Object *markword;
-	    switch (mblk->markers[i].u_marker.type)
-	      {
-	      case Lisp_Misc_Marker:
-		markword = &mblk->markers[i].u_marker.chain;
-		break;
-	      case Lisp_Misc_Buffer_Local_Value:
-	      case Lisp_Misc_Some_Buffer_Local_Value:
-		markword = &mblk->markers[i].u_buffer_local_value.realvalue;
-		break;
-	      case Lisp_Misc_Overlay:
-		markword = &mblk->markers[i].u_overlay.plist;
-		break;
-	      case Lisp_Misc_Free:
-		/* If the object was already free, keep it
-		   on the free list.  */
-		markword = (Lisp_Object *) &already_free;
-		break;
-	      default:
-		markword = 0;
-		break;
-	      }
-	    if (markword && !XMARKBIT (*markword))
+	    if (!mblk->markers[i].u_marker.gcmarkbit)
 	      {
 		Lisp_Object tem;
 		if (mblk->markers[i].u_marker.type == Lisp_Misc_Marker)
@@ -5333,8 +5257,7 @@
 	    else
 	      {
 		num_used++;
-		if (markword)
-		  XUNMARK (*markword);
+		mblk->markers[i].u_marker.gcmarkbit = 0;
 	      }
 	  }
 	lim = MARKER_BLOCK_SIZE;