(x_get_customization_string): Don't use value of strcpy.
[bpt/emacs.git] / src / alloc.c
index 48117d4..c141f4a 100644 (file)
@@ -234,7 +234,7 @@ emacs_blocked_malloc (size)
 
   BLOCK_INPUT;
   __malloc_hook = old_malloc_hook;
 
   BLOCK_INPUT;
   __malloc_hook = old_malloc_hook;
-  value = malloc (size);
+  value = (void *) malloc (size);
   __malloc_hook = emacs_blocked_malloc;
   UNBLOCK_INPUT;
 
   __malloc_hook = emacs_blocked_malloc;
   UNBLOCK_INPUT;
 
@@ -250,7 +250,7 @@ emacs_blocked_realloc (ptr, size)
 
   BLOCK_INPUT;
   __realloc_hook = old_realloc_hook;
 
   BLOCK_INPUT;
   __realloc_hook = old_realloc_hook;
-  value = realloc (ptr, size);
+  value = (void *) realloc (ptr, size);
   __realloc_hook = emacs_blocked_realloc;
   UNBLOCK_INPUT;
 
   __realloc_hook = emacs_blocked_realloc;
   UNBLOCK_INPUT;
 
@@ -349,17 +349,26 @@ static void
 mark_interval_tree (tree)
      register INTERVAL tree;
 {
 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);
 }
 
 
   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
 
 /* The oddity in the call to XUNMARK is necessary because XUNMARK
-   expands to an assigment to its argument, and most C compilers don't
+   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)                            \
 {                                                              \
    support casts on the left operand of `='.  */
 #define UNMARK_BALANCE_INTERVALS(i)                            \
 {                                                              \
@@ -958,9 +967,10 @@ make_event_array (nargs, args)
 
   for (i = 0; i < nargs; i++)
     /* The things that fit in a string
 
   for (i = 0; i < nargs; i++)
     /* The things that fit in a string
-       are characters that are in 0...127 after discarding the meta bit.  */
+       are characters that are in 0...127,
+       after discarding the meta bit and all the bits above it.  */
     if (XTYPE (args[i]) != Lisp_Int
     if (XTYPE (args[i]) != Lisp_Int
-       || (XUINT (args[i]) & ~CHAR_META) >= 0200)
+       || (XUINT (args[i]) & ~(-CHAR_META)) >= 0200)
       return Fvector (nargs, args);
 
   /* Since the loop exited, we know that all the things in it are
       return Fvector (nargs, args);
 
   /* Since the loop exited, we know that all the things in it are
@@ -1357,7 +1367,7 @@ Garbage collection happens automatically if you cons more than\n\
   if (gc_cons_threshold < 10000)
     gc_cons_threshold = 10000;
 
   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");
     message1 (omessage);
   else if (!noninteractive)
     message1 ("Garbage collecting...done");
@@ -1443,7 +1453,7 @@ clear_marks ()
   If the object referred to has not been seen yet, recursively mark
   all the references contained in it.
 
   If the object referred to has not been seen yet, recursively mark
   all the references contained in it.
 
-   If the object referenced is a short string, the referrencing slot
+   If the object referenced is a short string, the referencing slot
    is threaded into a chain of such slots, pointed to from
    the `size' field of the string.  The actual string size
    lives in the last slot in the chain.  We recognize the end
    is threaded into a chain of such slots, pointed to from
    the `size' field of the string.  The actual string size
    lives in the last slot in the chain.  We recognize the end
@@ -1516,17 +1526,19 @@ mark_object (objptr)
       {
        register struct Lisp_Vector *ptr = XVECTOR (obj);
        register int size = ptr->size;
       {
        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 */
        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;
 
       }
       break;
 
@@ -1537,6 +1549,7 @@ mark_object (objptr)
       {
        register struct Lisp_Vector *ptr = XVECTOR (obj);
        register int size = ptr->size;
       {
        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;
 
        struct Lisp_Vector *volatile ptr1 = ptr;
        register int i;
 
@@ -1544,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 */
          {
        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)
            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;
       }
        obj = *objptr;
        goto loop;
       }
@@ -1557,7 +1568,8 @@ mark_object (objptr)
 #ifdef MULTI_FRAME
     case Lisp_Frame:
       {
 #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 */
        register int size = ptr->size;
 
        if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
@@ -1580,7 +1592,8 @@ mark_object (objptr)
 
     case Lisp_Symbol:
       {
 
     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;
        struct Lisp_Symbol *ptrx;
 
        if (XMARKBIT (ptr->plist)) break;
@@ -1624,7 +1637,8 @@ mark_object (objptr)
            goto loop;
          }
        mark_object (&ptr->car);
            goto loop;
          }
        mark_object (&ptr->car);
-       objptr = &ptr->cdr;
+       /* See comment above under Lisp_Vector for why not use ptr here.  */
+       objptr = &XCONS (obj)->cdr;
        obj = ptr->cdr;
        goto loop;
       }
        obj = ptr->cdr;
        goto loop;
       }
@@ -1939,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;
   /* 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)
 
     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
   }
 }
 \f
@@ -2049,6 +2068,18 @@ compact_strings ()
                }
              /* Store the actual size in the size field.  */
              newaddr->size = size;
                }
              /* 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);
        }
            }
          pos += STRING_FULLSIZE (size);
        }