(x_get_customization_string): Don't use value of strcpy.
[bpt/emacs.git] / src / alloc.c
index f47287d..c141f4a 100644 (file)
@@ -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
@@ -1358,7 +1367,7 @@ Garbage collection happens automatically if you cons more than\n\
   if (gc_cons_threshold < 10000)
     gc_cons_threshold = 10000;
 
-  if (omessage)
+  if (omessage || minibuf_level > 0)
     message1 (omessage);
   else if (!noninteractive)
     message1 ("Garbage collecting...done");
@@ -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,7 +1592,8 @@ 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;
@@ -1624,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;
       }
@@ -1944,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;
+         }
+      }
   }
 }
 \f
@@ -2054,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);
        }