/* Storage allocation and gc for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
- 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ Free Software Foundation, Inc.
This file is part of GNU Emacs.
out of memory. We keep one large block, four cons-blocks, and
two string blocks. */
-char *spare_memory[7];
+static char *spare_memory[7];
/* Amount of spare memory to keep in large reserve block. */
/* Buffer in which we save a copy of the C stack at each GC. */
-char *stack_copy;
-int stack_copy_size;
+static char *stack_copy;
+static int stack_copy_size;
/* Non-zero means ignore malloc warnings. Set during initialization.
Currently not used. */
-int ignore_warnings;
+static int ignore_warnings;
Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
#ifdef HAVE_WINDOW_SYSTEM
extern void mark_fringe_data P_ ((void));
-static void mark_image P_ ((struct image *));
-static void mark_image_cache P_ ((struct frame *));
#endif /* HAVE_WINDOW_SYSTEM */
static struct Lisp_String *allocate_string P_ ((void));
/* A unique object in pure space used to make some Lisp objects
on free lists recognizable in O(1). */
-Lisp_Object Vdead;
+static Lisp_Object Vdead;
#ifdef GC_MALLOC_CHECK
enum mem_type allocated_mem_type;
-int dont_register_blocks;
+static int dont_register_blocks;
#endif /* GC_MALLOC_CHECK */
value; otherwise some compilers put it into BSS. */
#define NSTATICS 0x600
-Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
+static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
/* Index of next unused slot in staticvec. */
-int staticidx = 0;
+static int staticidx = 0;
static POINTER_TYPE *pure_alloc P_ ((size_t, int));
/* Current interval block. Its `next' pointer points to older
blocks. */
-struct interval_block *interval_block;
+static struct interval_block *interval_block;
/* Index in interval_block above of the next unused interval
structure. */
/* Total number of interval blocks now in use. */
-int n_interval_blocks;
+static int n_interval_blocks;
/* Initialize interval allocation. */
/* Initialize string allocation. Called from init_alloc_once. */
-void
+static void
init_strings ()
{
total_strings = total_free_strings = total_string_size = 0;
static int check_string_bytes_count;
-void check_string_bytes P_ ((int));
-void check_sblock P_ ((struct sblock *));
+static void check_string_bytes P_ ((int));
+static void check_sblock P_ ((struct sblock *));
#define CHECK_STRING_BYTES(S) STRING_BYTES (S)
/* Check validity of Lisp strings' string_bytes member in B. */
-void
+static void
check_sblock (b)
struct sblock *b;
{
non-zero means check all strings, otherwise check only most
recently allocated strings. Used for hunting a bug. */
-void
+static void
check_string_bytes (all_p)
int all_p;
{
consing_since_gc += sizeof *s;
#ifdef GC_CHECK_STRING_BYTES
- if (!noninteractive
-#ifdef MAC_OS8
- && current_sblock
-#endif
- )
+ if (!noninteractive)
{
if (++check_string_bytes_count == 200)
{
/* Initialize float allocation. */
-void
+static void
init_float ()
{
float_block = NULL;
/* Explicitly free a float cell by putting it on the free-list. */
-void
+static void
free_float (ptr)
struct Lisp_Float *ptr;
{
/* Total number of cons blocks now in use. */
-int n_cons_blocks;
+static int n_cons_blocks;
/* Initialize cons allocation. */
-void
+static void
init_cons ()
{
cons_block = NULL;
/* Singly-linked list of all vectors. */
-struct Lisp_Vector *all_vectors;
+static struct Lisp_Vector *all_vectors;
/* Total number of vector-like objects now in use. */
-int n_vectors;
+static int n_vectors;
/* Value is a pointer to a newly allocated Lisp_Vector structure
/* Allocate other vector-like structures. */
-static struct Lisp_Vector *
+struct Lisp_Vector *
allocate_pseudovector (memlen, lisplen, tag)
int memlen, lisplen;
EMACS_INT tag;
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)
}
-/* Only used for PVEC_WINDOW_CONFIGURATION. */
-struct Lisp_Vector *
-allocate_other_vector (len)
- EMACS_INT len;
-{
- struct Lisp_Vector *v = allocate_vectorlike (len);
- EMACS_INT i;
-
- for (i = 0; i < len; ++i)
- v->contents[i] = Qnil;
- v->size = len;
-
- return v;
-}
-
-
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
See also the function `vector'. */)
/* Current symbol block and index of first unused Lisp_Symbol
structure in it. */
-struct symbol_block *symbol_block;
-int symbol_block_index;
+static struct symbol_block *symbol_block;
+static int symbol_block_index;
/* List of free symbols. */
-struct Lisp_Symbol *symbol_free_list;
+static struct Lisp_Symbol *symbol_free_list;
/* Total number of symbol blocks now in use. */
-int n_symbol_blocks;
+static int n_symbol_blocks;
/* Initialize symbol allocation. */
-void
+static void
init_symbol ()
{
symbol_block = NULL;
struct marker_block *next;
};
-struct marker_block *marker_block;
-int marker_block_index;
+static struct marker_block *marker_block;
+static int marker_block_index;
-union Lisp_Misc *marker_free_list;
+static union Lisp_Misc *marker_free_list;
/* Total number of marker blocks now in use. */
-int n_marker_blocks;
+static int n_marker_blocks;
-void
+static void
init_marker ()
{
marker_block = NULL;
/* Determine whether it is safe to access memory at address P. */
-int
+static int
valid_pointer_p (p)
void *p;
{
/* Value is a float object with value NUM allocated from pure space. */
-Lisp_Object
+static Lisp_Object
make_pure_float (num)
double num;
{
}
-#ifdef HAVE_WINDOW_SYSTEM
-
-/* Mark Lisp objects in image IMG. */
-
-static void
-mark_image (img)
- struct image *img;
-{
- mark_object (img->spec);
-
- if (!NILP (img->data.lisp_val))
- mark_object (img->data.lisp_val);
-}
-
-
-/* Mark Lisp objects in image cache of frame F. It's done this way so
- that we don't have to include xterm.h here. */
-
-static void
-mark_image_cache (f)
- struct frame *f;
-{
- forall_images_in_image_cache (f, mark_image);
-}
-
-#endif /* HAVE_X_WINDOWS */
-
-
\f
/* Mark reference to a Lisp_Object.
If the object referred to has not been seen yet, recursively mark
all the references contained in it. */
#define LAST_MARKED_SIZE 500
-Lisp_Object last_marked[LAST_MARKED_SIZE];
+static Lisp_Object last_marked[LAST_MARKED_SIZE];
int last_marked_index;
/* For debugging--call abort when we cdr down this many
links of a list, in mark_object. In debugging,
the call to abort will hit a breakpoint.
Normally this is zero and the check never goes off. */
-int mark_object_loop_halt;
+static int mark_object_loop_halt;
/* Return non-zero if the object was not yet marked. */
static int
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
{
register struct frame *ptr = XFRAME (obj);
if (mark_vectorlike (XVECTOR (obj)))
- {
- mark_face_cache (ptr->face_cache);
-#ifdef HAVE_WINDOW_SYSTEM
- mark_image_cache (ptr);
-#endif /* HAVE_WINDOW_SYSTEM */
- }
+ mark_face_cache (ptr->face_cache);
}
else if (WINDOWP (obj))
{
mark_object (tmp);
}
+ /* buffer-local Lisp variables start at `undo_list',
+ tho only the ones from `name' on are GC'd normally. */
for (ptr = &buffer->name;
(char *)ptr < (char *)buffer + sizeof (struct buffer);
ptr++)
for (t = terminal_list; t; t = t->next_terminal)
{
eassert (t->name != NULL);
+#ifdef HAVE_WINDOW_SYSTEM
+ mark_image_cache (t->image_cache);
+#endif /* HAVE_WINDOW_SYSTEM */
mark_vectorlike ((struct Lisp_Vector *)t);
}
}
}
int suppress_checking;
+
void
die (msg, file, line)
const char *msg;