#include <signal.h>
-#include "config.h"
+#include <config.h>
#include "lisp.h"
#include "intervals.h"
#include "puresize.h"
BLOCK_INPUT;
__malloc_hook = old_malloc_hook;
- value = malloc (size);
+ value = (void *) malloc (size);
__malloc_hook = emacs_blocked_malloc;
UNBLOCK_INPUT;
BLOCK_INPUT;
__realloc_hook = old_realloc_hook;
- value = realloc (ptr, size);
+ value = (void *) realloc (ptr, size);
__realloc_hook = emacs_blocked_realloc;
UNBLOCK_INPUT;
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 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) \
{ \
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
- || (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
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;
if (gc_cons_threshold < 10000)
gc_cons_threshold = 10000;
- if (omessage)
- message1 (omessage);
+ if (omessage || minibuf_level > 0)
+ message2 (omessage, omessage_length);
else if (!noninteractive)
message1 ("Garbage collecting...done");
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
{
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;
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.")