/* Node color. */
enum {MEM_BLACK, MEM_RED} color;
-
+
/* Memory type. */
enum mem_type type;
};
#ifdef GC_MALLOC_CHECK
allocated_mem_type = type;
#endif
-
+
val = (void *) malloc (nbytes);
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
if (val && type != MEM_TYPE_NON_LISP)
mem_insert (val, (char *) val + nbytes, type);
#endif
-
+
UNBLOCK_INPUT;
if (!val && nbytes)
memory_full ();
struct buffer *
allocate_buffer ()
{
- struct buffer *b
+ struct buffer *b
= (struct buffer *) lisp_malloc (sizeof (struct buffer),
MEM_TYPE_BUFFER);
VALIDATE_LISP_STORAGE (b, sizeof *b);
if (ptr)
{
struct mem_node *m;
-
+
m = mem_find (ptr);
if (m == MEM_NIL || m->start != ptr)
{
}
}
#endif /* GC_MALLOC_CHECK */
-
+
__free_hook = old_free_hook;
free (ptr);
-
+
/* If we released our reserve (due to running out of memory),
and we have a fair amount free once again,
try to set aside another reserve in case we run out once more. */
}
}
#endif /* GC_MALLOC_CHECK */
-
+
__malloc_hook = emacs_blocked_malloc;
UNBLOCK_INPUT;
mem_delete (m);
}
-
+
/* fprintf (stderr, "%p -> realloc\n", ptr); */
-
+
/* Prevent malloc from registering blocks. */
dont_register_blocks = 1;
#endif /* GC_MALLOC_CHECK */
/* Can't handle zero size regions in the red-black tree. */
mem_insert (value, (char *) value + max (size, 1), MEM_TYPE_NON_LISP);
}
-
+
/* fprintf (stderr, "%p <- realloc\n", value); */
#endif /* GC_MALLOC_CHECK */
-
+
__realloc_hook = emacs_blocked_realloc;
UNBLOCK_INPUT;
struct Lisp_String *string;
#ifdef GC_CHECK_STRING_BYTES
-
+
EMACS_INT nbytes;
unsigned char data[1];
-
+
#define SDATA_NBYTES(S) (S)->nbytes
#define SDATA_DATA(S) (S)->data
-
+
#else /* not GC_CHECK_STRING_BYTES */
union
/* When STRING is null. */
EMACS_INT nbytes;
} u;
-
+
#define SDATA_NBYTES(S) (S)->u.nbytes
#define SDATA_DATA(S) (S)->u.data
S must be live, i.e. S->data must not be null. S->data is actually
a pointer to the `u.data' member of its sdata structure; the
structure starts at a constant offset in front of that. */
-
+
#ifdef GC_CHECK_STRING_BYTES
#define SDATA_OF_STRING(S) \
abort ();
return nbytes;
}
-
+
/* Check validity of Lisp strings' string_bytes member in B. */
void
struct sblock *b;
{
struct sdata *from, *end, *from_end;
-
+
end = b->next_free;
-
+
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
int nbytes;
-
+
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
if (from->string)
CHECK_STRING_BYTES (from->string);
-
+
if (from->string)
nbytes = GC_STRING_BYTES (from->string);
else
nbytes = SDATA_NBYTES (from);
-
+
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes);
}
if (s)
CHECK_STRING_BYTES (s);
}
-
+
for (b = oldest_sblock; b; b = b->next)
check_sblock (b);
}
#endif
b = (struct sblock *) lisp_malloc (size, MEM_TYPE_NON_LISP);
-
+
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-
+
b->next_free = &b->first_data;
b->first_data.string = NULL;
b->next = large_sblocks;
old_data = s->data ? SDATA_OF_STRING (s) : NULL;
old_nbytes = GC_STRING_BYTES (s);
-
+
data = b->next_free;
data->string = s;
s->data = SDATA_DATA (data);
s->size_byte = nbytes;
s->data[nbytes] = '\0';
b->next_free = (struct sdata *) ((char *) data + needed);
-
+
/* If S had already data assigned, mark that as free by setting its
string back-pointer to null, and recording the size of the data
in it. */
{
struct string_block *b, *next;
struct string_block *live_blocks = NULL;
-
+
string_free_list = NULL;
total_strings = total_free_strings = 0;
total_string_size = 0;
{
/* String is live; unmark it and its intervals. */
UNMARK_STRING (s);
-
+
if (!NULL_INTERVAL_P (s->intervals))
UNMARK_BALANCE_INTERVALS (s->intervals);
{
struct sblock *b, *next;
struct sblock *live_blocks = NULL;
-
+
for (b = large_sblocks; b; b = next)
{
next = b->next;
{
end = b->next_free;
xassert ((char *) end <= (char *) b + SBLOCK_SIZE);
-
+
for (from = &b->first_data; from < end; from = from_end)
{
/* Compute the next FROM here because copying below may
&& GC_STRING_BYTES (from->string) != SDATA_NBYTES (from))
abort ();
#endif /* GC_CHECK_STRING_BYTES */
-
+
if (from->string)
nbytes = GC_STRING_BYTES (from->string);
else
nbytes = SDATA_NBYTES (from);
-
+
nbytes = SDATA_SIZE (nbytes);
from_end = (struct sdata *) ((char *) from + nbytes);
-
+
/* FROM->string non-null means it's alive. Copy its data. */
if (from->string)
{
to = &tb->first_data;
to_end = (struct sdata *) ((char *) to + nbytes);
}
-
+
/* Copy, and update the string's `data' pointer. */
if (from != to)
{
p += len;
}
}
-
+
*p = 0;
return val;
}
slot `size' of the struct Lisp_Bool_Vector. */
val = Fmake_vector (make_number (length_in_elts + 1), Qnil);
p = XBOOL_VECTOR (val);
-
+
/* Get rid of any bits that would cause confusion. */
p->vector_size = 0;
XSETBOOL_VECTOR (val, p);
p->size = XFASTINT (length);
-
+
real_init = (NILP (init) ? 0 : -1);
for (i = 0; i < length_in_chars ; i++)
p->data[i] = real_init;
-
+
/* Clear the extraneous bits in the last byte. */
if (XINT (length) != length_in_chars * BITS_PER_CHAR)
XBOOL_VECTOR (val)->data[length_in_chars - 1]
}
XSETFLOAT (val, &float_block->floats[float_block_index++]);
}
-
+
XFLOAT_DATA (val) = float_value;
XSETFASTINT (XFLOAT (val)->type, 0); /* bug chasing -wsr */
consing_since_gc += sizeof (struct Lisp_Float);
}
XSETCONS (val, &cons_block->conses[cons_block_index++]);
}
-
+
XSETCAR (val, car);
XSETCDR (val, cdr);
consing_since_gc += sizeof (struct Lisp_Cons);
{
val = Fcons (init, val);
--size;
-
+
if (size > 0)
{
val = Fcons (init, val);
--size;
-
+
if (size > 0)
{
val = Fcons (init, val);
--size;
-
+
if (size > 0)
{
val = Fcons (init, val);
QUIT;
}
-
+
return val;
}
a dumped Emacs. */
mallopt (M_MMAP_MAX, 0);
#endif
-
+
nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);
-
+
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
#endif
-
+
VALIDATE_LISP_STORAGE (p, 0);
consing_since_gc += nbytes;
vector_cells_consed += len;
EMACS_INT len = VECSIZE (struct Lisp_Hash_Table);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE);
EMACS_INT i;
-
+
v->size = len;
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
-
+
return (struct Lisp_Hash_Table *) v;
}
EMACS_INT len = VECSIZE (struct window);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
v->size = len;
-
+
return (struct window *) v;
}
EMACS_INT len = VECSIZE (struct frame);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_FRAME);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = make_number (0);
v->size = len;
EMACS_INT len = VECSIZE (struct Lisp_Process);
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_PROCESS);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
v->size = len;
-
+
return (struct Lisp_Process *) v;
}
{
struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR);
EMACS_INT i;
-
+
for (i = 0; i < len; ++i)
v->contents[i] = Qnil;
v->size = len;
-
+
return v;
}
}
XSETSYMBOL (val, &symbol_block->symbols[symbol_block_index++]);
}
-
+
p = XSYMBOL (val);
p->xname = name;
p->plist = Qnil;
}
XSETMISC (val, &marker_block->markers[marker_block_index++]);
}
-
+
consing_since_gc += sizeof (union Lisp_Misc);
misc_objects_consed++;
return val;
characters, so we can make a string. */
{
Lisp_Object result;
-
+
result = Fmake_string (make_number (nargs), make_number (0));
for (i = 0; i < nargs; i++)
{
if (XINT (args[i]) & CHAR_META)
SSET (result, i, SREF (result, i) | 0x80);
}
-
+
return result;
}
}
parent = NULL;
#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-
+
while (c != MEM_NIL)
{
if (start >= c->start && start < c->end)
parent = c;
c = start < c->start ? c->left : c->right;
}
-
+
#else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
+
while (c != MEM_NIL)
{
parent = c;
c = start < c->start ? c->left : c->right;
}
-
+
#endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
/* Create a new node. */
else
parent->right = x;
}
- else
+ else
mem_root = x;
/* Re-establish red-black tree properties. */
{
/* X is red and its parent is red. This is a violation of
red-black tree property #3. */
-
+
if (x->parent == x->parent->parent->left)
{
/* We're on the left side of our grandparent, and Y is our
"uncle". */
struct mem_node *y = x->parent->parent->right;
-
+
if (y->color == MEM_RED)
{
/* Uncle and parent are red but should be black because
{
/* This is the symmetrical case of above. */
struct mem_node *y = x->parent->parent->left;
-
+
if (y->color == MEM_RED)
{
x->parent->color = MEM_BLACK;
x = x->parent;
mem_rotate_right (x);
}
-
+
x->parent->color = MEM_BLACK;
x->parent->parent->color = MEM_RED;
mem_rotate_left (x->parent->parent);
}
-/* (x) (y)
- / \ / \
+/* (x) (y)
+ / \ / \
a (y) ===> (x) c
/ \ / \
b c a b */
}
-/* (x) (Y)
- / \ / \
- (y) c ===> a (x)
- / \ / \
+/* (x) (Y)
+ / \ / \
+ (y) c ===> a (x)
+ / \ / \
a b b c */
static void
x->left = y->right;
if (y->right != MEM_NIL)
y->right->parent = x;
-
+
if (y != MEM_NIL)
y->parent = x->parent;
if (x->parent)
}
else
mem_root = y;
-
+
y->right = x;
if (x != MEM_NIL)
x->parent = y;
z->end = y->end;
z->type = y->type;
}
-
+
if (y->color == MEM_BLACK)
mem_delete_fixup (x);
if (x == x->parent->left)
{
struct mem_node *w = x->parent->right;
-
+
if (w->color == MEM_RED)
{
w->color = MEM_BLACK;
mem_rotate_left (x->parent);
w = x->parent->right;
}
-
+
if (w->left->color == MEM_BLACK && w->right->color == MEM_BLACK)
{
w->color = MEM_RED;
else
{
struct mem_node *w = x->parent->left;
-
+
if (w->color == MEM_RED)
{
w->color = MEM_BLACK;
mem_rotate_right (x->parent);
w = x->parent->left;
}
-
+
if (w->right->color == MEM_BLACK && w->left->color == MEM_BLACK)
{
w->color = MEM_RED;
mem_rotate_left (w);
w = x->parent->left;
}
-
+
w->color = x->parent->color;
x->parent->color = MEM_BLACK;
w->left->color = MEM_BLACK;
}
}
}
-
+
x->color = MEM_BLACK;
}
{
struct symbol_block *b = (struct symbol_block *) m->start;
int offset = (char *) p - (char *) &b->symbols[0];
-
+
/* P must point to the start of a Lisp_Symbol, not be
one of the unused cells in the current symbol block,
and not be on the free-list. */
{
struct float_block *b = (struct float_block *) m->start;
int offset = (char *) p - (char *) &b->floats[0];
-
+
/* P must point to the start of a Lisp_Float, not be
one of the unused cells in the current float block,
and not be on the free-list. */
{
struct marker_block *b = (struct marker_block *) m->start;
int offset = (char *) p - (char *) &b->markers[0];
-
+
/* P must point to the start of a Lisp_Misc, not be
one of the unused cells in the current misc block,
and not be on the free-list. */
{
void *po = (void *) XPNTR (obj);
struct mem_node *m = mem_find (po);
-
+
if (m != MEM_NIL)
{
int mark_p = 0;
case Lisp_Misc_Marker:
mark_p = !XMARKBIT (XMARKER (obj)->chain);
break;
-
+
case Lisp_Misc_Buffer_Local_Value:
case Lisp_Misc_Some_Buffer_Local_Value:
mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
break;
-
+
case Lisp_Misc_Overlay:
mark_p = !XMARKBIT (XOVERLAY (obj)->plist);
break;
assume that Lisp data is aligned on even addresses. */
if ((EMACS_INT) p & 1)
return;
-
+
m = mem_find (p);
if (m != MEM_NIL)
{
Lisp_Object obj = Qnil;
-
+
switch (m->type)
{
case MEM_TYPE_NON_LISP:
/* Nothing to do; not a pointer to Lisp memory. */
break;
-
+
case MEM_TYPE_BUFFER:
if (live_buffer_p (m, p)
&& !XMARKBIT (((struct buffer *) p)->name))
XSETVECTOR (obj, p);
break;
-
+
case MEM_TYPE_CONS:
if (live_cons_p (m, p)
&& !XMARKBIT (((struct Lisp_Cons *) p)->car))
XSETCONS (obj, p);
break;
-
+
case MEM_TYPE_STRING:
if (live_string_p (m, p)
&& !STRING_MARKED_P ((struct Lisp_String *) p))
{
Lisp_Object tem;
XSETMISC (tem, p);
-
+
switch (XMISCTYPE (tem))
{
case Lisp_Misc_Marker:
if (!XMARKBIT (XMARKER (tem)->chain))
obj = tem;
break;
-
+
case Lisp_Misc_Buffer_Local_Value:
case Lisp_Misc_Some_Buffer_Local_Value:
if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue))
obj = tem;
break;
-
+
case Lisp_Misc_Overlay:
if (!XMARKBIT (XOVERLAY (tem)->plist))
obj = tem;
}
}
break;
-
+
case MEM_TYPE_SYMBOL:
if (live_symbol_p (m, p)
&& !XMARKBIT (((struct Lisp_Symbol *) p)->plist))
XSETSYMBOL (obj, p);
break;
-
+
case MEM_TYPE_FLOAT:
if (live_float_p (m, p)
&& !XMARKBIT (((struct Lisp_Float *) p)->type))
XSETFLOAT (obj, p);
break;
-
+
case MEM_TYPE_VECTOR:
case MEM_TYPE_PROCESS:
case MEM_TYPE_HASH_TABLE:
/* Mark Lisp objects referenced from the address range START..END. */
-static void
+static void
mark_memory (start, end)
void *start, *end;
{
Here, `obj' isn't really used, and the compiler optimizes it
away. The only reference to the life string is through the
pointer `s'. */
-
+
for (pp = (void **) start; (void *) pp < end; ++pp)
mark_maybe_pointer (*pp);
}
#ifdef sparc
asm ("ta 3");
#endif
-
+
/* Save registers that we need to see on the stack. We need to see
registers used to hold register variables and registers used to
pass parameters. */
#ifdef GC_SAVE_REGISTERS_ON_STACK
GC_SAVE_REGISTERS_ON_STACK (end);
#else /* not GC_SAVE_REGISTERS_ON_STACK */
-
+
#ifndef GC_SETJMP_WORKS /* If it hasn't been checked yet that
setjmp will definitely work, test it
and print a message with the result
test_setjmp ();
}
#endif /* GC_SETJMP_WORKS */
-
+
setjmp (j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
Qt tends to return NULL, which effectively turns undo back on.
So don't call truncate_undo_list if undo_list is Qt. */
if (! EQ (nextb->undo_list, Qt))
- nextb->undo_list
+ nextb->undo_list
= truncate_undo_list (nextb->undo_list, undo_limit,
undo_strong_limit);
XMARK (tail->var[i]);
}
#endif
-
+
mark_byte_stack ();
for (bind = specpdl; bind != specpdl_ptr; bind++)
{
{
mark_object (&catch->tag);
mark_object (&catch->val);
- }
+ }
for (handler = handlerlist; handler; handler = handler->next)
{
mark_object (&handler->handler);
mark_object (&handler->var);
- }
+ }
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
if (!XMARKBIT (*backlist->function))
mark_object (&backlist->args[i]);
XMARK (backlist->args[i]);
}
- }
+ }
mark_kboards ();
/* Look thru every buffer's undo list
for (i = 0; i < tail->nvars; i++)
XUNMARK (tail->var[i]);
#endif
-
+
unmark_byte_stack ();
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
i = backlist->nargs - 1;
for (; i >= 0; i--)
XUNMARK (backlist->args[i]);
- }
+ }
XUNMARK (buffer_defaults.name);
XUNMARK (buffer_local_symbols.name);
{
/* Compute average percentage of zombies. */
double nlive = 0;
-
+
for (i = 0; i < 7; ++i)
if (CONSP (total[i]))
nlive += XFASTINT (XCAR (total[i]));
{
struct glyph *glyph = row->glyphs[area];
struct glyph *end_glyph = glyph + row->used[area];
-
+
for (; glyph < end_glyph; ++glyph)
if (GC_STRINGP (glyph->object)
&& !STRING_MARKED_P (XSTRING (glyph->object)))
struct image *img;
{
mark_object (&img->spec);
-
+
if (!NILP (img->data.lisp_val))
mark_object (&img->data.lisp_val);
}
CHECK_ALLOCATED (); \
CHECK_LIVE (LIVEP); \
} while (0) \
-
+
#else /* not GC_CHECK_MARKED_OBJECTS */
-
+
#define CHECK_ALLOCATED() (void) 0
#define CHECK_LIVE(LIVEP) (void) 0
#define CHECK_ALLOCATED_AND_LIVE(LIVEP) (void) 0
-
+
#endif /* not GC_CHECK_MARKED_OBJECTS */
switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
&& po != &buffer_local_symbols)
abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
-
+
if (GC_BUFFERP (obj))
{
if (!XMARKBIT (XBUFFER (obj)->name))
if (size & ARRAY_MARK_FLAG)
break; /* Already marked */
-
+
CHECK_LIVE (live_vector_p);
ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
size &= PSEUDOVECTOR_SIZE_MASK;
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
EMACS_INT size = h->size;
-
+
/* Stop if already marked. */
if (size & ARRAY_MARK_FLAG)
break;
-
+
/* Mark it. */
CHECK_LIVE (live_vector_p);
h->size |= ARRAY_MARK_FLAG;
/* Mark contents. */
/* Do not mark next_free or next_weak.
- Being in the next_weak chain
+ Being in the next_weak chain
should not keep the hash table alive.
No need to mark `count' since it is an integer. */
mark_object (&h->test);
mark_object (&h->key_and_value);
else
XVECTOR (h->key_and_value)->size |= ARRAY_MARK_FLAG;
-
+
}
else
{
if (!PURE_POINTER_P (XSTRING (ptr->xname)))
MARK_STRING (XSTRING (ptr->xname));
MARK_INTERVAL_TREE (STRING_INTERVALS (ptr->xname));
-
+
/* Note that we do not mark the obarray of the symbol.
It is safe not to do so because nothing accesses that
slot except to check whether it is nil. */
/* If this is an indirect buffer, mark its base buffer. */
if (buffer->base_buffer && !XMARKBIT (buffer->base_buffer->name))
{
- XSETBUFFER (base_buffer, buffer->base_buffer);
+ XSETBUFFER (base_buffer, buffer->base_buffer);
mark_buffer (base_buffer);
}
}
Lisp_Object obj;
{
int survives_p;
-
+
switch (XGCTYPE (obj))
{
case Lisp_Int:
case Lisp_Misc_Marker:
survives_p = XMARKBIT (obj);
break;
-
+
case Lisp_Misc_Buffer_Local_Value:
case Lisp_Misc_Some_Buffer_Local_Value:
survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);
break;
-
+
case Lisp_Misc_Intfwd:
case Lisp_Misc_Boolfwd:
case Lisp_Misc_Objfwd:
case Lisp_Misc_Kboard_Objfwd:
survives_p = 1;
break;
-
+
case Lisp_Misc_Overlay:
survives_p = XMARKBIT (XOVERLAY (obj)->plist);
break;
register int num_free = 0, num_used = 0;
cons_free_list = 0;
-
+
for (cblk = cons_block; cblk; cblk = *cprev)
{
register int i;
register int num_free = 0, num_used = 0;
float_free_list = 0;
-
+
for (fblk = float_block; fblk; fblk = *fprev)
{
register int i;
register int num_free = 0, num_used = 0;
symbol_free_list = NULL;
-
+
for (sblk = symbol_block; sblk; sblk = *sprev)
{
int this_free = 0;
it might be pointed to by pure bytecode which we don't trace,
so we conservatively assume that it is live. */
int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
-
+
if (!XMARKBIT (sym->plist) && !pure_p)
{
*(struct Lisp_Symbol **) &sym->value = symbol_free_list;
XUNMARK (sym->plist);
}
}
-
+
lim = SYMBOL_BLOCK_SIZE;
/* If this block contains only free symbols and we have already
seen more than two blocks worth of free symbols then deallocate
register int num_free = 0, num_used = 0;
marker_free_list = 0;
-
+
for (mblk = marker_block; mblk; mblk = *mprev)
{
register int i;
prev = vector, vector = vector->next;
}
}
-
+
#ifdef GC_CHECK_STRING_BYTES
if (!noninteractive)
check_string_bytes (1);
HCoop / bpt / emacs.git / blobdiff