#include <signal.h>
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "intervals.h"
#include "puresize.h"
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
XSTRING (new)->size = length;
bcopy (data, XSTRING (new)->data, length);
XSTRING (new)->data[length] = 0;
+
+ /* We must give strings in pure storage some kind of interval. So we
+ give them a null one. */
+#if defined (USE_TEXT_PROPERTIES)
+ XSTRING (new)->intervals = NULL_INTERVAL;
+#endif
pureptr += (size + sizeof (int) - 1)
/ sizeof (int) * sizeof (int);
return new;
register struct backtrace *backlist;
register Lisp_Object tem;
char *omessage = echo_area_glyphs;
+ int omessage_length = echo_area_glyphs_length;
char stack_top_variable;
register int i;
gc_cons_threshold = 10000;
if (omessage || minibuf_level > 0)
- message1 (omessage);
+ message2 (omessage, omessage_length);
else if (!noninteractive)
message1 ("Garbage collecting...done");
{
register Lisp_Object obj;
+ loop:
obj = *objptr;
+ loop2:
XUNMARK (obj);
- loop:
-
if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)
&& (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
return;
{
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;
{
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;
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];
- obj = *objptr;
+ objptr = &ptr1->contents[COMPILED_CONSTANTS];
goto loop;
}
#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 */
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)
{
+ /* For the benefit of the last_marked log. */
+ objptr = (Lisp_Object *)&XSYMBOL (obj)->next;
ptrx = ptr; /* Use of ptrx avoids compiler bug on Sun */
XSETSYMBOL (obj, ptrx);
- goto loop;
+ /* We can't goto loop here because *objptr doesn't contain an
+ actual Lisp_Object with valid datatype field. */
+ goto loop2;
}
}
break;
if (EQ (ptr->cdr, Qnil))
{
objptr = &ptr->car;
- obj = ptr->car;
- XUNMARK (obj);
goto loop;
}
- if (ptr == 0)
- abort ();
mark_object (&ptr->car);
- if (ptr == 0)
- abort ();
- objptr = &ptr->cdr;
- obj = ptr->cdr;
+ /* See comment above under Lisp_Vector for why not use ptr here. */
+ objptr = &XCONS (obj)->cdr;
goto loop;
}
/* 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
}
/* 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);
}
\f
/* Debugging aids. */
-DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, "",
+DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0,
"Return the address of the last byte Emacs has allocated, divided by 1024.\n\
This may be helpful in debugging Emacs's memory usage.\n\
We divide the value by 1024 to make sure it fits in a Lisp integer.")