GNU Emacs is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2, or (at your option)
+the Free Software Foundation; either version 3, or (at your option)
any later version.
GNU Emacs is distributed in the hope that it will be useful,
#include "blockinput.h"
#include "character.h"
#include "syssignal.h"
+#include "termhooks.h" /* For struct terminal. */
#include <setjmp.h>
/* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
remapping on more recent systems because this is less important
nowadays than in the days of small memories and timesharing. */
-EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {1,};
+EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
#define PUREBEG (char *) pure
#else /* HAVE_SHM */
EMACS_INT gcs_done; /* accumulated GCs */
static void mark_buffer P_ ((Lisp_Object));
+static void mark_terminals P_ ((void));
extern void mark_kboards P_ ((void));
+extern void mark_ttys P_ ((void));
extern void mark_backtrace P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
MEM_TYPE_MISC,
MEM_TYPE_SYMBOL,
MEM_TYPE_FLOAT,
- /* Keep the following vector-like types together, with
- MEM_TYPE_WINDOW being the last, and MEM_TYPE_VECTOR the
- first. Or change the code of live_vector_p, for instance. */
- MEM_TYPE_VECTOR,
- MEM_TYPE_PROCESS,
- MEM_TYPE_HASH_TABLE,
- MEM_TYPE_FRAME,
- MEM_TYPE_WINDOW
+ /* We used to keep separate mem_types for subtypes of vectors such as
+ process, hash_table, frame, terminal, and window, but we never made
+ use of the distinction, so it only caused source-code complexity
+ and runtime slowdown. Minor but pointless. */
+ MEM_TYPE_VECTORLIKE
};
static POINTER_TYPE *lisp_align_malloc P_ ((size_t, enum mem_type));
#define MEM_NIL &mem_z
static POINTER_TYPE *lisp_malloc P_ ((size_t, enum mem_type));
-static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT, enum mem_type));
+static struct Lisp_Vector *allocate_vectorlike P_ ((EMACS_INT));
static void lisp_free P_ ((POINTER_TYPE *));
static void mark_stack P_ ((void));
static int live_vector_p P_ ((struct mem_node *, void *));
#define free overrun_check_free
#endif
+#ifdef SYNC_INPUT
+/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
+ there's no need to block input around malloc. */
+#define MALLOC_BLOCK_INPUT ((void)0)
+#define MALLOC_UNBLOCK_INPUT ((void)0)
+#else
+#define MALLOC_BLOCK_INPUT BLOCK_INPUT
+#define MALLOC_UNBLOCK_INPUT UNBLOCK_INPUT
+#endif
/* Like malloc but check for no memory and block interrupt input.. */
{
register POINTER_TYPE *val;
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
val = (POINTER_TYPE *) malloc (size);
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
if (!val && size)
memory_full ();
{
register POINTER_TYPE *val;
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
/* We must call malloc explicitly when BLOCK is 0, since some
reallocs don't do this. */
if (! block)
val = (POINTER_TYPE *) malloc (size);
else
val = (POINTER_TYPE *) realloc (block, size);
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
if (!val && size) memory_full ();
return val;
xfree (block)
POINTER_TYPE *block;
{
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
free (block);
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
/* We don't call refill_memory_reserve here
because that duplicates doing so in emacs_blocked_free
and the criterion should go there. */
{
register void *val;
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
#ifdef GC_MALLOC_CHECK
allocated_mem_type = type;
mem_insert (val, (char *) val + nbytes, type);
#endif
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
memory_full ();
return val;
lisp_free (block)
POINTER_TYPE *block;
{
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
free (block);
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
mem_delete (mem_find (block));
#endif
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
}
/* Allocation of aligned blocks of memory to store Lisp data. */
eassert (nbytes <= BLOCK_BYTES);
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
#ifdef GC_MALLOC_CHECK
allocated_mem_type = type;
if (base == 0)
{
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
memory_full ();
}
{
lisp_malloc_loser = base;
free (base);
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
memory_full ();
}
}
mem_insert (val, (char *) val + nbytes, type);
#endif
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
if (!val && nbytes)
memory_full ();
struct ablock *ablock = block;
struct ablocks *abase = ABLOCK_ABASE (ablock);
- BLOCK_INPUT;
+ MALLOC_BLOCK_INPUT;
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
mem_delete (mem_find (block));
#endif
#endif
free (ABLOCKS_BASE (abase));
}
- UNBLOCK_INPUT;
+ MALLOC_UNBLOCK_INPUT;
}
/* Return a new buffer structure allocated from the heap with
can use GNU malloc. */
#ifndef SYNC_INPUT
+/* When using SYNC_INPUT, we don't call malloc from a signal handler, so
+ there's no need to block input around malloc. */
#ifndef DOUG_LEA_MALLOC
extern void * (*__malloc_hook) P_ ((size_t, const void *));
void *ptr;
const void *ptr2;
{
- EMACS_INT bytes_used_now;
-
BLOCK_INPUT_ALLOC;
#ifdef GC_MALLOC_CHECK
BLOCK_INPUT_ALLOC;
__malloc_hook = old_malloc_hook;
#ifdef DOUG_LEA_MALLOC
- mallopt (M_TOP_PAD, malloc_hysteresis * 4096);
+ /* Segfaults on my system. --lorentey */
+ /* mallopt (M_TOP_PAD, malloc_hysteresis * 4096); */
#else
__malloc_extra_blocks = malloc_hysteresis;
#endif
void
reset_malloc_hooks ()
{
- __free_hook = 0;
- __malloc_hook = 0;
- __realloc_hook = 0;
+ __free_hook = old_free_hook;
+ __malloc_hook = old_malloc_hook;
+ __realloc_hook = old_realloc_hook;
}
#endif /* HAVE_GTK_AND_PTHREAD */
/* eassert (!handling_signal); */
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
if (interval_free_list)
{
val = &interval_block->intervals[interval_block_index++];
}
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
consing_since_gc += sizeof (struct interval);
intervals_consed++;
string_blocks = NULL;
n_string_blocks = 0;
string_free_list = NULL;
+ empty_unibyte_string = make_pure_string ("", 0, 0, 0);
+ empty_multibyte_string = make_pure_string ("", 0, 0, 1);
}
/* eassert (!handling_signal); */
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
/* If the free-list is empty, allocate a new string_block, and
add all the Lisp_Strings in it to the free-list. */
s = string_free_list;
string_free_list = NEXT_FREE_LISP_STRING (s);
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
/* Probably not strictly necessary, but play it safe. */
bzero (s, sizeof *s);
old_data = s->data ? SDATA_OF_STRING (s) : NULL;
old_nbytes = GC_STRING_BYTES (s);
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
if (nbytes > LARGE_STRING_BYTES)
{
mmap'ed data typically have an address towards the top of the
address space, which won't fit into an EMACS_INT (at least on
32-bit systems with the current tagging scheme). --fx */
- BLOCK_INPUT;
mallopt (M_MMAP_MAX, 0);
- UNBLOCK_INPUT;
#endif
b = (struct sblock *) lisp_malloc (size + GC_STRING_EXTRA, MEM_TYPE_NON_LISP);
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
- BLOCK_INPUT;
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
- UNBLOCK_INPUT;
#endif
b->next_free = &b->first_data;
data = b->next_free;
b->next_free = (struct sdata *) ((char *) data + needed + GC_STRING_EXTRA);
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
data->string = s;
s->data = SDATA_DATA (data);
/* We must allocate one more elements than LENGTH_IN_ELTS for the
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);
+ XVECTOR (val)->size = 0; /* No Lisp_Object to trace in there. */
+ /* Use XVECTOR (val) rather than `p' because p->size is not TRT. */
+ XSETPVECTYPE (XVECTOR (val), PVEC_BOOL_VECTOR);
+
+ p = XBOOL_VECTOR (val);
p->size = XFASTINT (length);
real_init = (NILP (init) ? 0 : -1);
/* Clear the extraneous bits in the last byte. */
if (XINT (length) != length_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
- XBOOL_VECTOR (val)->data[length_in_chars - 1]
+ p->data[length_in_chars - 1]
&= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
return val;
int length;
{
Lisp_Object val;
+
+ if (!length)
+ return empty_unibyte_string;
val = make_uninit_multibyte_string (length, length);
STRING_SET_UNIBYTE (val);
return val;
if (nchars < 0)
abort ();
+ if (!nbytes)
+ return empty_multibyte_string;
s = allocate_string ();
allocate_string_data (s, nchars, nbytes);
/* eassert (!handling_signal); */
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
if (float_free_list)
{
float_block_index++;
}
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
XFLOAT_DATA (val) = float_value;
eassert (!FLOAT_MARKED_P (XFLOAT (val)));
/* eassert (!handling_signal); */
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
if (cons_free_list)
{
cons_block_index++;
}
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
XSETCAR (val, car);
XSETCDR (val, cdr);
with room for LEN Lisp_Objects. */
static struct Lisp_Vector *
-allocate_vectorlike (len, type)
+allocate_vectorlike (len)
EMACS_INT len;
- enum mem_type type;
{
struct Lisp_Vector *p;
size_t nbytes;
+ MALLOC_BLOCK_INPUT;
+
#ifdef DOUG_LEA_MALLOC
/* Prevent mmap'ing the chunk. Lisp data may not be mmap'ed
because mapped region contents are not preserved in
a dumped Emacs. */
- BLOCK_INPUT;
mallopt (M_MMAP_MAX, 0);
- UNBLOCK_INPUT;
#endif
/* This gets triggered by code which I haven't bothered to fix. --Stef */
/* eassert (!handling_signal); */
nbytes = sizeof *p + (len - 1) * sizeof p->contents[0];
- p = (struct Lisp_Vector *) lisp_malloc (nbytes, type);
+ p = (struct Lisp_Vector *) lisp_malloc (nbytes, MEM_TYPE_VECTORLIKE);
#ifdef DOUG_LEA_MALLOC
/* Back to a reasonable maximum of mmap'ed areas. */
- BLOCK_INPUT;
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS);
- UNBLOCK_INPUT;
#endif
consing_since_gc += nbytes;
vector_cells_consed += len;
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
-
p->next = all_vectors;
all_vectors = p;
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
++n_vectors;
return p;
allocate_vector (nslots)
EMACS_INT nslots;
{
- struct Lisp_Vector *v = allocate_vectorlike (nslots, MEM_TYPE_VECTOR);
+ struct Lisp_Vector *v = allocate_vectorlike (nslots);
v->size = nslots;
return v;
}
/* Allocate other vector-like structures. */
-struct Lisp_Hash_Table *
-allocate_hash_table ()
+static struct Lisp_Vector *
+allocate_pseudovector (memlen, lisplen, tag)
+ int memlen, lisplen;
+ EMACS_INT tag;
{
- EMACS_INT len = VECSIZE (struct Lisp_Hash_Table);
- struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_HASH_TABLE);
+ struct Lisp_Vector *v = allocate_vectorlike (memlen);
EMACS_INT i;
- v->size = len;
- for (i = 0; i < len; ++i)
+ /* Only the first lisplen slots will be traced normally by the GC. */
+ v->size = lisplen;
+ for (i = 0; i < lisplen; ++i)
v->contents[i] = Qnil;
- return (struct Lisp_Hash_Table *) v;
+ XSETPVECTYPE (v, tag); /* Add the appropriate tag. */
+ return v;
+}
+#define ALLOCATE_PSEUDOVECTOR(typ,field,tag) \
+ ((typ*) \
+ allocate_pseudovector \
+ (VECSIZE (typ), PSEUDOVECSIZE (typ, field), tag))
+
+struct Lisp_Hash_Table *
+allocate_hash_table (void)
+{
+ return ALLOCATE_PSEUDOVECTOR (struct Lisp_Hash_Table, count, PVEC_HASH_TABLE);
}
struct window *
allocate_window ()
{
- EMACS_INT len = VECSIZE (struct window);
- struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_WINDOW);
- EMACS_INT i;
+ return ALLOCATE_PSEUDOVECTOR(struct window, current_matrix, PVEC_WINDOW);
+}
- for (i = 0; i < len; ++i)
- v->contents[i] = Qnil;
- v->size = len;
- return (struct window *) v;
-}
+struct terminal *
+allocate_terminal ()
+{
+ struct terminal *t = ALLOCATE_PSEUDOVECTOR (struct terminal,
+ next_terminal, PVEC_TERMINAL);
+ /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
+ bzero (&(t->next_terminal),
+ ((char*)(t+1)) - ((char*)&(t->next_terminal)));
+ return t;
+}
struct frame *
allocate_frame ()
{
- 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;
- return (struct frame *) v;
+ struct frame *f = ALLOCATE_PSEUDOVECTOR (struct frame,
+ face_cache, PVEC_FRAME);
+ /* Zero out the non-GC'd fields. FIXME: This should be made unnecessary. */
+ bzero (&(f->face_cache),
+ ((char*)(f+1)) - ((char*)&(f->face_cache)));
+ return f;
}
struct Lisp_Process *
allocate_process ()
{
- /* Memory-footprint of the object in nb of Lisp_Object fields. */
- EMACS_INT memlen = VECSIZE (struct Lisp_Process);
- /* Size if we only count the actual Lisp_Object fields (which need to be
- traced by the GC). */
- EMACS_INT lisplen = PSEUDOVECSIZE (struct Lisp_Process, pid);
- struct Lisp_Vector *v = allocate_vectorlike (memlen, MEM_TYPE_PROCESS);
- EMACS_INT i;
-
- for (i = 0; i < lisplen; ++i)
- v->contents[i] = Qnil;
- v->size = lisplen;
-
- return (struct Lisp_Process *) v;
+ return ALLOCATE_PSEUDOVECTOR (struct Lisp_Process, pid, PVEC_PROCESS);
}
+/* Only used for PVEC_WINDOW_CONFIGURATION. */
struct Lisp_Vector *
allocate_other_vector (len)
EMACS_INT len;
{
- struct Lisp_Vector *v = allocate_vectorlike (len, MEM_TYPE_VECTOR);
+ struct Lisp_Vector *v = allocate_vectorlike (len);
EMACS_INT i;
for (i = 0; i < len; ++i)
args[index] = Fpurecopy (args[index]);
p->contents[index] = args[index];
}
+ XSETPVECTYPE (p, PVEC_COMPILED);
XSETCOMPILED (val, p);
return val;
}
/* eassert (!handling_signal); */
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
if (symbol_free_list)
{
symbol_block_index++;
}
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
p = XSYMBOL (val);
p->xname = name;
/* eassert (!handling_signal); */
-#ifndef SYNC_INPUT
- BLOCK_INPUT;
-#endif
+ MALLOC_BLOCK_INPUT;
if (marker_free_list)
{
marker_block_index++;
}
-#ifndef SYNC_INPUT
- UNBLOCK_INPUT;
-#endif
+ MALLOC_UNBLOCK_INPUT;
--total_free_markers;
consing_since_gc += sizeof (union Lisp_Misc);
struct mem_node *m;
void *p;
{
- return (p == m->start
- && m->type >= MEM_TYPE_VECTOR
- && m->type <= MEM_TYPE_WINDOW);
+ return (p == m->start && m->type == MEM_TYPE_VECTORLIKE);
}
{
int mark_p = 0;
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_String:
mark_p = (live_string_p (m, po)
break;
case Lisp_Vectorlike:
- /* Note: can't check GC_BUFFERP before we know it's a
+ /* Note: can't check BUFFERP before we know it's a
buffer because checking that dereferences the pointer
PO which might point anywhere. */
if (live_vector_p (m, po))
- mark_p = !GC_SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
+ mark_p = !SUBRP (obj) && !VECTOR_MARKED_P (XVECTOR (obj));
else if (live_buffer_p (m, po))
- mark_p = GC_BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
+ mark_p = BUFFERP (obj) && !VECTOR_MARKED_P (XBUFFER (obj));
break;
case Lisp_Misc:
{
struct mem_node *m;
- /* Quickly rule out some values which can't point to Lisp data. We
- assume that Lisp data is aligned on even addresses. */
- if ((EMACS_INT) p & 1)
+ /* Quickly rule out some values which can't point to Lisp data. */
+ if ((EMACS_INT) p %
+#ifdef USE_LSB_TAG
+ 8 /* USE_LSB_TAG needs Lisp data to be aligned on multiples of 8. */
+#else
+ 2 /* We assume that Lisp data is aligned on even addresses. */
+#endif
+ )
return;
m = mem_find (p);
XSETFLOAT (obj, p);
break;
- case MEM_TYPE_VECTOR:
- case MEM_TYPE_PROCESS:
- case MEM_TYPE_HASH_TABLE:
- case MEM_TYPE_FRAME:
- case MEM_TYPE_WINDOW:
+ case MEM_TYPE_VECTORLIKE:
if (live_vector_p (m, p))
{
Lisp_Object tem;
XSETVECTOR (tem, p);
- if (!GC_SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
+ if (!SUBRP (tem) && !VECTOR_MARKED_P (XVECTOR (tem)))
obj = tem;
}
break;
abort ();
}
- if (!GC_NILP (obj))
+ if (!NILP (obj))
mark_object (obj);
}
}
case MEM_TYPE_FLOAT:
return live_float_p (m, p);
- case MEM_TYPE_VECTOR:
- case MEM_TYPE_PROCESS:
- case MEM_TYPE_HASH_TABLE:
- case MEM_TYPE_FRAME:
- case MEM_TYPE_WINDOW:
+ case MEM_TYPE_VECTORLIKE:
return live_vector_p (m, p);
default:
for (i = 0; i < size; i++)
vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
if (COMPILEDP (obj))
- XSETCOMPILED (obj, vec);
+ {
+ XSETPVECTYPE (vec, PVEC_COMPILED);
+ XSETCOMPILED (obj, vec);
+ }
else
XSETVECTOR (obj, vec);
return obj;
mark_object (bind->symbol);
mark_object (bind->old_value);
}
+ mark_terminals ();
mark_kboards ();
+ mark_ttys ();
#ifdef USE_GTK
{
prev = Qnil;
while (CONSP (tail))
{
- if (GC_CONSP (XCAR (tail))
- && GC_MARKERP (XCAR (XCAR (tail)))
+ if (CONSP (XCAR (tail))
+ && MARKERP (XCAR (XCAR (tail)))
&& !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
{
if (NILP (prev))
struct glyph *end_glyph = glyph + row->used[area];
for (; glyph < end_glyph; ++glyph)
- if (GC_STRINGP (glyph->object)
+ if (STRINGP (glyph->object)
&& !STRING_MARKED_P (XSTRING (glyph->object)))
mark_object (glyph->object);
}
Normally this is zero and the check never goes off. */
int mark_object_loop_halt;
+/* Return non-zero if the object was not yet marked. */
+static int
+mark_vectorlike (ptr)
+ struct Lisp_Vector *ptr;
+{
+ register EMACS_INT size = ptr->size;
+ register int i;
+
+ if (VECTOR_MARKED_P (ptr))
+ return 0; /* Already marked */
+ VECTOR_MARK (ptr); /* Else mark it */
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+
+ /* Note that this size is not the memory-footprint size, but only
+ the number of Lisp_Object fields that we should trace.
+ The distinction is used e.g. by Lisp_Process which places extra
+ non-Lisp_Object fields at the end of the structure. */
+ for (i = 0; i < size; i++) /* and then mark its elements */
+ mark_object (ptr->contents[i]);
+ return 1;
+}
+
void
mark_object (arg)
Lisp_Object arg;
#endif /* not GC_CHECK_MARKED_OBJECTS */
- switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
+ switch (SWITCH_ENUM_CAST (XTYPE (obj)))
{
case Lisp_String:
{
case Lisp_Vectorlike:
#ifdef GC_CHECK_MARKED_OBJECTS
m = mem_find (po);
- if (m == MEM_NIL && !GC_SUBRP (obj)
+ if (m == MEM_NIL && !SUBRP (obj)
&& po != &buffer_defaults
&& po != &buffer_local_symbols)
abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */
- if (GC_BUFFERP (obj))
+ if (BUFFERP (obj))
{
if (!VECTOR_MARKED_P (XBUFFER (obj)))
{
mark_buffer (obj);
}
}
- else if (GC_SUBRP (obj))
+ else if (SUBRP (obj))
break;
- else if (GC_COMPILEDP (obj))
+ else if (COMPILEDP (obj))
/* We could treat this just like a vector, but it is better to
save the COMPILED_CONSTANTS element for last and avoid
recursion there. */
obj = ptr->contents[COMPILED_CONSTANTS];
goto loop;
}
- else if (GC_FRAMEP (obj))
+ else if (FRAMEP (obj))
{
register struct frame *ptr = XFRAME (obj);
-
- if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
- VECTOR_MARK (ptr); /* Else mark it */
-
- CHECK_LIVE (live_vector_p);
- mark_object (ptr->name);
- mark_object (ptr->icon_name);
- mark_object (ptr->title);
- mark_object (ptr->focus_frame);
- mark_object (ptr->selected_window);
- mark_object (ptr->minibuffer_window);
- mark_object (ptr->param_alist);
- mark_object (ptr->scroll_bars);
- mark_object (ptr->condemned_scroll_bars);
- mark_object (ptr->menu_bar_items);
- mark_object (ptr->face_alist);
- mark_object (ptr->menu_bar_vector);
- mark_object (ptr->buffer_predicate);
- mark_object (ptr->buffer_list);
- mark_object (ptr->menu_bar_window);
- mark_object (ptr->tool_bar_window);
- mark_face_cache (ptr->face_cache);
+ if (mark_vectorlike (XVECTOR (obj)))
+ {
+ mark_face_cache (ptr->face_cache);
#ifdef HAVE_WINDOW_SYSTEM
- mark_image_cache (ptr);
- mark_object (ptr->tool_bar_items);
- mark_object (ptr->desired_tool_bar_string);
- mark_object (ptr->current_tool_bar_string);
+ mark_image_cache (ptr);
#endif /* HAVE_WINDOW_SYSTEM */
+ }
}
- else if (GC_BOOL_VECTOR_P (obj))
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
-
- if (VECTOR_MARKED_P (ptr))
- break; /* Already marked */
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (ptr); /* Else mark it */
- }
- else if (GC_WINDOWP (obj))
+ else if (WINDOWP (obj))
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
struct window *w = XWINDOW (obj);
- register int i;
-
- /* Stop if already marked. */
- if (VECTOR_MARKED_P (ptr))
- break;
-
- /* Mark it. */
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (ptr);
-
- /* There is no Lisp data above The member CURRENT_MATRIX in
- struct WINDOW. Stop marking when that slot is reached. */
- for (i = 0;
- (char *) &ptr->contents[i] < (char *) &w->current_matrix;
- i++)
- mark_object (ptr->contents[i]);
-
- /* Mark glyphs for leaf windows. Marking window matrices is
- sufficient because frame matrices use the same glyph
- memory. */
- if (NILP (w->hchild)
- && NILP (w->vchild)
- && w->current_matrix)
+ if (mark_vectorlike (ptr))
{
- mark_glyph_matrix (w->current_matrix);
- mark_glyph_matrix (w->desired_matrix);
+ /* Mark glyphs for leaf windows. Marking window matrices is
+ sufficient because frame matrices use the same glyph
+ memory. */
+ if (NILP (w->hchild)
+ && NILP (w->vchild)
+ && w->current_matrix)
+ {
+ mark_glyph_matrix (w->current_matrix);
+ mark_glyph_matrix (w->desired_matrix);
+ }
}
}
- else if (GC_HASH_TABLE_P (obj))
+ else if (HASH_TABLE_P (obj))
{
struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
-
- /* Stop if already marked. */
- if (VECTOR_MARKED_P (h))
- break;
-
- /* Mark it. */
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (h);
-
- /* Mark contents. */
- /* Do not mark next_free or next_weak.
- 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->weak);
- mark_object (h->rehash_size);
- mark_object (h->rehash_threshold);
- mark_object (h->hash);
- mark_object (h->next);
- mark_object (h->index);
- mark_object (h->user_hash_function);
- mark_object (h->user_cmp_function);
-
- /* If hash table is not weak, mark all keys and values.
- For weak tables, mark only the vector. */
- if (GC_NILP (h->weak))
- mark_object (h->key_and_value);
- else
- VECTOR_MARK (XVECTOR (h->key_and_value));
+ if (mark_vectorlike ((struct Lisp_Vector *)h))
+ { /* If hash table is not weak, mark all keys and values.
+ For weak tables, mark only the vector. */
+ if (NILP (h->weak))
+ mark_object (h->key_and_value);
+ else
+ VECTOR_MARK (XVECTOR (h->key_and_value));
+ }
}
else
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_INT size = ptr->size;
- register int i;
-
- if (VECTOR_MARKED_P (ptr)) break; /* Already marked */
- CHECK_LIVE (live_vector_p);
- VECTOR_MARK (ptr); /* Else mark it */
- if (size & PSEUDOVECTOR_FLAG)
- size &= PSEUDOVECTOR_SIZE_MASK;
-
- /* Note that this size is not the memory-footprint size, but only
- the number of Lisp_Object fields that we should trace.
- The distinction is used e.g. by Lisp_Process which places extra
- non-Lisp_Object fields at the end of the structure. */
- for (i = 0; i < size; i++) /* and then mark its elements */
- mark_object (ptr->contents[i]);
- }
+ mark_vectorlike (XVECTOR (obj));
break;
case Lisp_Symbol:
}
}
+/* Mark the Lisp pointers in the terminal objects.
+ Called by the Fgarbage_collector. */
+
+static void
+mark_terminals (void)
+{
+ struct terminal *t;
+ for (t = terminal_list; t; t = t->next_terminal)
+ {
+ eassert (t->name != NULL);
+ mark_vectorlike ((struct Lisp_Vector *)t);
+ }
+}
+
+
/* Value is non-zero if OBJ will survive the current GC because it's
either marked or does not need to be marked to survive. */
{
int survives_p;
- switch (XGCTYPE (obj))
+ switch (XTYPE (obj))
{
case Lisp_Int:
survives_p = 1;
break;
case Lisp_Vectorlike:
- survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
+ survives_p = SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
break;
case Lisp_Cons:
for (cblk = cons_block; cblk; cblk = *cprev)
{
- register int i;
+ register int i = 0;
int this_free = 0;
- for (i = 0; i < lim; i++)
- if (!CONS_MARKED_P (&cblk->conses[i]))
- {
- this_free++;
- cblk->conses[i].u.chain = cons_free_list;
- cons_free_list = &cblk->conses[i];
+ int ilim = (lim + BITS_PER_INT - 1) / BITS_PER_INT;
+
+ /* Scan the mark bits an int at a time. */
+ for (i = 0; i <= ilim; i++)
+ {
+ if (cblk->gcmarkbits[i] == -1)
+ {
+ /* Fast path - all cons cells for this int are marked. */
+ cblk->gcmarkbits[i] = 0;
+ num_used += BITS_PER_INT;
+ }
+ else
+ {
+ /* Some cons cells for this int are not marked.
+ Find which ones, and free them. */
+ int start, pos, stop;
+
+ start = i * BITS_PER_INT;
+ stop = lim - start;
+ if (stop > BITS_PER_INT)
+ stop = BITS_PER_INT;
+ stop += start;
+
+ for (pos = start; pos < stop; pos++)
+ {
+ if (!CONS_MARKED_P (&cblk->conses[pos]))
+ {
+ this_free++;
+ cblk->conses[pos].u.chain = cons_free_list;
+ cons_free_list = &cblk->conses[pos];
#if GC_MARK_STACK
- cons_free_list->car = Vdead;
+ cons_free_list->car = Vdead;
#endif
- }
- else
- {
- num_used++;
- CONS_UNMARK (&cblk->conses[i]);
- }
+ }
+ else
+ {
+ num_used++;
+ CONS_UNMARK (&cblk->conses[pos]);
+ }
+ }
+ }
+ }
+
lim = CONS_BLOCK_SIZE;
/* If this block contains only free conses and we have already
seen more than two blocks worth of free conses then deallocate
HCoop / bpt / emacs.git / blobdiff