1 files changed, 45 insertions, 21 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 07775391bfb..93146526118 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
@@ -1957,25 +1966,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;
+	  }
+      }
   }
 }
 
@@ -2067,6 +2081,16 @@ compact_strings ()
 		}
 	      /* Store the actual size in the size field.  */
 	      newaddr->size = size;
+
+	      /* 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);
+		}
 	    }
 	  pos += STRING_FULLSIZE (size);
 	}