/* 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 Free Software Foundation, Inc.
+ 2000, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.
This file is part of GNU Emacs.
You should have received a copy of the GNU General Public License
along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-Boston, MA 02111-1307, USA. */
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA. */
#include <config.h>
#include <stdio.h>
#define MARK_STRING(S) ((S)->size |= ARRAY_MARK_FLAG)
#define UNMARK_STRING(S) ((S)->size &= ~ARRAY_MARK_FLAG)
-#define STRING_MARKED_P(S) ((S)->size & ARRAY_MARK_FLAG)
+#define STRING_MARKED_P(S) (((S)->size & ARRAY_MARK_FLAG) != 0)
#define VECTOR_MARK(V) ((V)->size |= ARRAY_MARK_FLAG)
#define VECTOR_UNMARK(V) ((V)->size &= ~ARRAY_MARK_FLAG)
-#define VECTOR_MARKED_P(V) ((V)->size & ARRAY_MARK_FLAG)
+#define VECTOR_MARKED_P(V) (((V)->size & ARRAY_MARK_FLAG) != 0)
/* Value is the number of bytes/chars of S, a pointer to a struct
Lisp_String. This must be used instead of STRING_BYTES (S) or
EMACS_INT intervals_consed;
EMACS_INT strings_consed;
-/* Number of bytes of consing since GC before another GC should be done. */
+/* Minimum number of bytes of consing since GC before next GC. */
EMACS_INT gc_cons_threshold;
+/* Similar minimum, computed from Vgc_cons_percentage. */
+
+EMACS_INT gc_relative_threshold;
+
+static Lisp_Object Vgc_cons_percentage;
+
/* Nonzero during GC. */
int gc_in_progress;
static void mark_face_cache P_ ((struct face_cache *));
#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 */
Fsignal (Qnil, Vmemory_signal_data);
}
+DEFUN ("memory-full-p", Fmemory_full_p, Smemory_full_p, 0, 0, 0,
+ doc: /* t if memory is nearly full, nil otherwise. */)
+ ()
+{
+ return (spare_memory ? Qnil : Qt);
+}
/* Called if we can't allocate relocatable space for a buffer. */
val + osize,
XMALLOC_OVERRUN_CHECK_SIZE))
abort ();
+#ifdef XMALLOC_CLEAR_FREE_MEMORY
+ val -= XMALLOC_OVERRUN_CHECK_SIZE;
+ memset (val, 0xff, osize + XMALLOC_OVERRUN_CHECK_SIZE*2);
+#else
bzero (val + osize, XMALLOC_OVERRUN_CHECK_SIZE);
val -= XMALLOC_OVERRUN_CHECK_SIZE;
bzero (val, XMALLOC_OVERRUN_CHECK_SIZE);
+#endif
}
free (val);
On glibc-2.3.2, malloc never tries to align, so a padding of 0 is best.
posix_memalign on the other hand would ideally prefer a value of 4
because otherwise, there's 1020 bytes wasted between each ablocks.
- But testing shows that those 1020 will most of the time be efficiently
- used by malloc to place other objects, so a value of 0 is still preferable
- unless you have a lot of cons&floats and virtually nothing else. */
+ In Emacs, testing shows that those 1020 can most of the time be
+ efficiently used by malloc to place other objects, so a value of 0 can
+ still preferable unless you have a lot of aligned blocks and virtually
+ nothing else. */
#define BLOCK_PADDING 0
#define BLOCK_BYTES \
- (BLOCK_ALIGN - sizeof (struct aligned_block *) - BLOCK_PADDING)
+ (BLOCK_ALIGN - sizeof (struct ablock *) - BLOCK_PADDING)
/* Internal data structures and constants. */
#ifndef make_number
Lisp_Object
make_number (n)
- int n;
+ EMACS_INT n;
{
Lisp_Object obj;
obj.s.val = n;
/* We check for overrun in string data blocks by appending a small
"cookie" after each allocated string data block, and check for the
- presense of this cookie during GC. */
+ presence of this cookie during GC. */
#define GC_STRING_OVERRUN_COOKIE_SIZE 4
static char string_overrun_cookie[GC_STRING_OVERRUN_COOKIE_SIZE] =
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;
}
-/* Return a newly created sub char table with default value DEFALT.
+/* Return a newly created sub char table with slots initialized by INIT.
Since a sub char table does not appear as a top level Emacs Lisp
object, we don't need a Lisp interface to make it. */
Lisp_Object
-make_sub_char_table (defalt)
- Lisp_Object defalt;
+make_sub_char_table (init)
+ Lisp_Object init;
{
Lisp_Object vector
- = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil);
+ = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), init);
XCHAR_TABLE (vector)->top = Qnil;
- XCHAR_TABLE (vector)->defalt = defalt;
+ XCHAR_TABLE (vector)->defalt = Qnil;
XSETCHAR_TABLE (vector, XCHAR_TABLE (vector));
return vector;
}
if (pure_bytes_used_before_overflow)
return Qnil;
+ CHECK_CONS_LIST ();
+
/* Don't keep undo information around forever.
Do this early on, so it is no problem if the user quits. */
{
}
mark_backtrace ();
+#ifdef HAVE_WINDOW_SYSTEM
+ mark_fringe_data ();
+#endif
+
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
mark_stack ();
#endif
UNBLOCK_INPUT;
+ CHECK_CONS_LIST ();
+
/* clear_marks (); */
gc_in_progress = 0;
if (gc_cons_threshold < 10000)
gc_cons_threshold = 10000;
+ if (FLOATP (Vgc_cons_percentage))
+ { /* Set gc_cons_combined_threshold. */
+ EMACS_INT total = 0;
+
+ total += total_conses * sizeof (struct Lisp_Cons);
+ total += total_symbols * sizeof (struct Lisp_Symbol);
+ total += total_markers * sizeof (union Lisp_Misc);
+ total += total_string_size;
+ total += total_vector_size * sizeof (Lisp_Object);
+ total += total_floats * sizeof (struct Lisp_Float);
+ total += total_intervals * sizeof (struct interval);
+ total += total_strings * sizeof (struct Lisp_String);
+
+ gc_relative_threshold = total * XFLOAT_DATA (Vgc_cons_percentage);
+ }
+ else
+ gc_relative_threshold = 0;
+
if (garbage_collection_messages)
{
if (message_p || minibuf_level > 0)
staticidx = 0;
consing_since_gc = 0;
gc_cons_threshold = 100000 * sizeof (Lisp_Object);
+ gc_relative_threshold = 0;
+
#ifdef VIRT_ADDR_VARIES
malloc_sbrk_unused = 1<<22; /* A large number */
malloc_sbrk_used = 100000; /* as reasonable as any number */
Garbage collection happens automatically only when `eval' is called.
By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program. */);
+prevent garbage collection during a part of the program.
+See also `gc-cons-percentage'. */);
+
+ DEFVAR_LISP ("gc-cons-percentage", &Vgc_cons_percentage,
+ doc: /* *Portion of the heap used for allocation.
+Garbage collection can happen automatically once this portion of the heap
+has been allocated since the last garbage collection.
+If this portion is smaller than `gc-cons-threshold', this is ignored. */);
+ Vgc_cons_percentage = make_float (0.1);
DEFVAR_INT ("pure-bytes-used", &pure_bytes_used,
doc: /* Number of bytes of sharable Lisp data allocated so far. */);
DEFVAR_INT ("gcs-done", &gcs_done,
doc: /* Accumulated number of garbage collections done. */);
+ defsubr (&Smemory_full_p);
defsubr (&Scons);
defsubr (&Slist);
defsubr (&Svector);