X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/5d7aa25b522fdabcc75b020f791deec0c068430b..abfc2e5fd21a2f8430fff7af6b9481a0a9a8a0db:/src/alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index e6edea42c9..c141f4a1e2 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -349,14 +349,23 @@ static void
 mark_interval_tree (tree)
      register INTERVAL tree;
 {
-  if (XMARKBIT (tree->plist))
-    return;
+  /* No need to test if this tree has been marked already; this
+     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 (* (Lisp_Object *) &tree->parent);
 
   traverse_intervals (tree, 1, 0, mark_interval, Qnil);
 }
 
-#define MARK_INTERVAL_TREE(i) \
-  { if (!NULL_INTERVAL_P (i)) mark_interval_tree (i); }
+#define MARK_INTERVAL_TREE(i)				\
+  do {							\
+    if (!NULL_INTERVAL_P (i)				\
+	&& ! XMARKBIT ((Lisp_Object) i->parent))	\
+      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
@@ -1517,17 +1526,19 @@ mark_object (objptr)
       {
 	register struct Lisp_Vector *ptr = XVECTOR (obj);
 	register int size = ptr->size;
+	/* The reason we use ptr1 is to avoid an apparent hardware bug
+	   that happens occasionally on the FSF's HP 300s.
+	   The bug is that a2 gets clobbered by recursive calls to mark_object.
+	   The clobberage seems to happen during function entry,
+	   perhaps in the moveml instruction.
+	   Yes, this is a crock, but we have to do it.  */
 	struct Lisp_Vector *volatile ptr1 = ptr;
 	register int i;
 
 	if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
 	ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
 	for (i = 0; i < size; i++)     /* and then mark its elements */
-	  {
-	    if (ptr != ptr1)
-	      abort ();
-	    mark_object (&ptr->contents[i]);
-	  }
+	  mark_object (&ptr1->contents[i]);
       }
       break;
 
@@ -1538,6 +1549,7 @@ mark_object (objptr)
       {
 	register struct Lisp_Vector *ptr = XVECTOR (obj);
 	register int size = ptr->size;
+	/* See comment above under Lisp_Vector.  */
 	struct Lisp_Vector *volatile ptr1 = ptr;
 	register int i;
 
@@ -1545,12 +1557,10 @@ mark_object (objptr)
 	ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
 	for (i = 0; i < size; i++)     /* and then mark its elements */
 	  {
-	    if (ptr != ptr1)
-	      abort ();
 	    if (i != COMPILED_CONSTANTS)
-	      mark_object (&ptr->contents[i]);
+	      mark_object (&ptr1->contents[i]);
 	  }
-	objptr = &ptr->contents[COMPILED_CONSTANTS];
+	objptr = &ptr1->contents[COMPILED_CONSTANTS];
 	obj = *objptr;
 	goto loop;
       }
@@ -1558,7 +1568,8 @@ mark_object (objptr)
 #ifdef MULTI_FRAME
     case Lisp_Frame:
       {
-	register struct frame *ptr = XFRAME (obj);
+	/* See comment above under Lisp_Vector for why this is volatile.  */
+	register struct frame *volatile ptr = XFRAME (obj);
 	register int size = ptr->size;
 
 	if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
@@ -1581,24 +1592,17 @@ mark_object (objptr)
 
     case Lisp_Symbol:
       {
-	register struct Lisp_Symbol *ptr = XSYMBOL (obj);
+	/* See comment above under Lisp_Vector for why this is volatile.  */
+	register struct Lisp_Symbol *volatile ptr = XSYMBOL (obj);
 	struct Lisp_Symbol *ptrx;
 
 	if (XMARKBIT (ptr->plist)) break;
 	XMARK (ptr->plist);
 	mark_object ((Lisp_Object *) &ptr->value);
-	if ((unsigned int) ptr <= 4)
-	  abort ();
 	mark_object (&ptr->function);
-	if ((unsigned int) ptr <= 4)
-	  abort ();
 	mark_object (&ptr->plist);
-	if ((unsigned int) ptr <= 4)
-	  abort ();
 	XSETTYPE (*(Lisp_Object *) &ptr->name, Lisp_String);
 	mark_object (&ptr->name);
-	if ((unsigned int) ptr <= 4)
-	  abort ();
 	ptr = ptr->next;
 	if (ptr)
 	  {
@@ -1632,12 +1636,9 @@ mark_object (objptr)
 	    XUNMARK (obj);
 	    goto loop;
 	  }
-	if (ptr == 0)
-	  abort ();
 	mark_object (&ptr->car);
-	if (ptr == 0)
-	  abort ();
-	objptr = &ptr->cdr;
+	/* See comment above under Lisp_Vector for why not use ptr here.  */
+	objptr = &XCONS (obj)->cdr;
 	obj = ptr->cdr;
 	goto loop;
       }
@@ -1952,25 +1953,30 @@ gc_sweep ()
   /* Free all "large strings" not marked with ARRAY_MARK_FLAG.  */
   {
     register struct string_block *sb = large_string_blocks, *prev = 0, *next;
+    struct Lisp_String *s;
 
     while (sb)
-      if (!(((struct Lisp_String *)(&sb->chars[0]))->size & ARRAY_MARK_FLAG))
-	{
-	  if (prev)
-	    prev->next = sb->next;
-	  else
-	    large_string_blocks = sb->next;
-	  next = sb->next;
-	  xfree (sb);
-	  sb = next;
-	}
-      else
-	{
-	  ((struct Lisp_String *)(&sb->chars[0]))->size
-	    &= ~ARRAY_MARK_FLAG & ~MARKBIT;
-	  total_string_size += ((struct Lisp_String *)(&sb->chars[0]))->size;
-	  prev = sb, sb = sb->next;
-	}
+      {
+	s = (struct Lisp_String *) &sb->chars[0];
+	if (s->size & ARRAY_MARK_FLAG)
+	  {
+	    ((struct Lisp_String *)(&sb->chars[0]))->size
+	      &= ~ARRAY_MARK_FLAG & ~MARKBIT;
+	    UNMARK_BALANCE_INTERVALS (s->intervals);
+	    total_string_size += ((struct Lisp_String *)(&sb->chars[0]))->size;
+	    prev = sb, sb = sb->next;
+	  }
+	else
+	  {
+	    if (prev)
+	      prev->next = sb->next;
+	    else
+	      large_string_blocks = sb->next;
+	    next = sb->next;
+	    xfree (sb);
+	    sb = next;
+	  }
+      }
   }
 }
 
@@ -2062,6 +2068,18 @@ compact_strings ()
 		}
 	      /* Store the actual size in the size field.  */
 	      newaddr->size = size;
+
+#ifdef USE_TEXT_PROPERTIES
+	      /* Now that the string has been relocated, rebalance its
+                 interval tree, and update the tree's parent pointer. */
+	      if (! NULL_INTERVAL_P (newaddr->intervals))
+		{
+		  UNMARK_BALANCE_INTERVALS (newaddr->intervals);
+		  XSET (* (Lisp_Object *) &newaddr->intervals->parent,
+			Lisp_String,
+			newaddr);
+		}
+#endif /* USE_TEXT_PROPERTIES */
 	    }
 	  pos += STRING_FULLSIZE (size);
 	}