/* 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, 2008, 2009, 2010
+ 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
Free Software Foundation, Inc.
This file is part of GNU Emacs.
#include <limits.h> /* For CHAR_BIT. */
#include <setjmp.h>
-#ifdef STDC_HEADERS
-#include <stddef.h> /* For offsetof, used by PSEUDOVECSIZE. */
-#endif
-
#ifdef ALLOC_DEBUG
#undef INLINE
#endif
#undef GC_MALLOC_CHECK
#endif
-#ifdef HAVE_UNISTD_H
#include <unistd.h>
-#else
+#ifndef HAVE_UNISTD_H
extern POINTER_TYPE *sbrk ();
#endif
-#ifdef HAVE_FCNTL_H
#include <fcntl.h>
-#endif
-#ifndef O_WRONLY
-#define O_WRONLY 1
-#endif
#ifdef WINDOWSNT
-#include <fcntl.h>
#include "w32.h"
#endif
static __malloc_size_t bytes_used_when_full;
-static __malloc_size_t bytes_used_when_reconsidered;
-
/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
to a struct Lisp_String. */
int garbage_collection_messages;
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
-int malloc_sbrk_used;
-
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
-int malloc_sbrk_unused;
-
/* Number of live and free conses etc. */
static int total_conses, total_markers, total_symbols, total_vector_size;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
-char *pending_malloc_warning;
+const char *pending_malloc_warning;
/* Pre-computed signal argument for use when memory is exhausted. */
static POINTER_TYPE *lisp_align_malloc (size_t, enum mem_type);
static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
-void refill_memory_reserve (void);
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
static struct mem_node mem_z;
#define MEM_NIL &mem_z
-static POINTER_TYPE *lisp_malloc (size_t, enum mem_type);
static struct Lisp_Vector *allocate_vectorlike (EMACS_INT);
static void lisp_free (POINTER_TYPE *);
static void mark_stack (void);
/* Function malloc calls this if it finds we are near exhausting storage. */
void
-malloc_warning (char *str)
+malloc_warning (const char *str)
{
pending_malloc_warning = str;
}
static void * (*old_realloc_hook) (void *, size_t, const void*);
static void (*old_free_hook) (void*, const void*);
+static __malloc_size_t bytes_used_when_reconsidered;
+
/* This function is used as the hook for free to call. */
static void
-emacs_blocked_free (ptr, ptr2)
- void *ptr;
- const void *ptr2;
+emacs_blocked_free (void *ptr, const void *ptr2)
{
BLOCK_INPUT_ALLOC;
/* This function is the malloc hook that Emacs uses. */
static void *
-emacs_blocked_malloc (size, ptr)
- size_t size;
- const void *ptr;
+emacs_blocked_malloc (size_t size, const void *ptr)
{
void *value;
/* This function is the realloc hook that Emacs uses. */
static void *
-emacs_blocked_realloc (ptr, size, ptr2)
- void *ptr;
- size_t size;
- const void *ptr2;
+emacs_blocked_realloc (void *ptr, size_t size, const void *ptr2)
{
void *value;
/* Called from main to set up malloc to use our hooks. */
void
-uninterrupt_malloc ()
+uninterrupt_malloc (void)
{
#ifdef HAVE_GTK_AND_PTHREAD
#ifdef DOUG_LEA_MALLOC
can't create number objects in macros. */
#ifndef make_number
Lisp_Object
-make_number (n)
- EMACS_INT n;
+make_number (EMACS_INT n)
{
Lisp_Object obj;
obj.s.val = n;
/* Number of bytes used by live strings. */
-static int total_string_size;
+static EMACS_INT total_string_size;
/* Given a pointer to a Lisp_String S which is on the free-list
string_free_list, return a pointer to its successor in the
/* Like GC_STRING_BYTES, but with debugging check. */
-int
-string_bytes (s)
- struct Lisp_String *s;
+EMACS_INT
+string_bytes (struct Lisp_String *s)
{
- int nbytes = (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
+ EMACS_INT nbytes =
+ (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
+
if (!PURE_POINTER_P (s)
&& s->data
&& nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- int nbytes;
+ EMACS_INT nbytes;
/* Check that the string size recorded in the string is the
same as the one recorded in the sdata structure. */
s = string_free_list;
while (s != NULL)
{
- if ((unsigned)s < 1024)
+ if ((unsigned long)s < 1024)
abort();
s = NEXT_FREE_LISP_STRING (s);
}
S->data if it was initially non-null. */
void
-allocate_string_data (struct Lisp_String *s, int nchars, int nbytes)
+allocate_string_data (struct Lisp_String *s,
+ EMACS_INT nchars, EMACS_INT nbytes)
{
struct sdata *data, *old_data;
struct sblock *b;
- int needed, old_nbytes;
+ EMACS_INT needed, old_nbytes;
/* Determine the number of bytes needed to store NBYTES bytes
of string data. */
{
/* Compute the next FROM here because copying below may
overwrite data we need to compute it. */
- int nbytes;
+ EMACS_INT nbytes;
#ifdef GC_CHECK_STRING_BYTES
/* Check that the string size recorded in the string is the
{
register Lisp_Object val;
register unsigned char *p, *end;
- int c, nbytes;
+ int c;
+ EMACS_INT nbytes;
CHECK_NATNUM (length);
CHECK_NUMBER (init);
{
unsigned char str[MAX_MULTIBYTE_LENGTH];
int len = CHAR_STRING (c, str);
+ EMACS_INT string_len = XINT (length);
- nbytes = len * XINT (length);
- val = make_uninit_multibyte_string (XINT (length), nbytes);
+ if (string_len > MOST_POSITIVE_FIXNUM / len)
+ error ("Maximum string size exceeded");
+ nbytes = len * string_len;
+ val = make_uninit_multibyte_string (string_len, nbytes);
p = SDATA (val);
end = p + nbytes;
while (p != end)
register Lisp_Object val;
struct Lisp_Bool_Vector *p;
int real_init, i;
- int length_in_chars, length_in_elts, bits_per_value;
+ EMACS_INT length_in_chars, length_in_elts;
+ int bits_per_value;
CHECK_NATNUM (length);
multibyte, depending on the contents. */
Lisp_Object
-make_string (const char *contents, int nbytes)
+make_string (const char *contents, EMACS_INT nbytes)
{
register Lisp_Object val;
- int nchars, multibyte_nbytes;
+ EMACS_INT nchars, multibyte_nbytes;
parse_str_as_multibyte (contents, nbytes, &nchars, &multibyte_nbytes);
if (nbytes == nchars || nbytes != multibyte_nbytes)
/* Make an unibyte string from LENGTH bytes at CONTENTS. */
Lisp_Object
-make_unibyte_string (const char *contents, int length)
+make_unibyte_string (const char *contents, EMACS_INT length)
{
register Lisp_Object val;
val = make_uninit_string (length);
bytes at CONTENTS. */
Lisp_Object
-make_multibyte_string (const char *contents, int nchars, int nbytes)
+make_multibyte_string (const char *contents,
+ EMACS_INT nchars, EMACS_INT nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
CONTENTS. It is a multibyte string if NBYTES != NCHARS. */
Lisp_Object
-make_string_from_bytes (const char *contents, int nchars, int nbytes)
+make_string_from_bytes (const char *contents,
+ EMACS_INT nchars, EMACS_INT nbytes)
{
register Lisp_Object val;
val = make_uninit_multibyte_string (nchars, nbytes);
characters by itself. */
Lisp_Object
-make_specified_string (const char *contents, int nchars, int nbytes, int multibyte)
+make_specified_string (const char *contents,
+ EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
{
register Lisp_Object val;
occupying LENGTH bytes. */
Lisp_Object
-make_uninit_string (int length)
+make_uninit_string (EMACS_INT length)
{
Lisp_Object val;
which occupy NBYTES bytes. */
Lisp_Object
-make_uninit_multibyte_string (int nchars, int nbytes)
+make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
{
Lisp_Object string;
struct Lisp_String *s;
}
-/* Explicitly free a float cell by putting it on the free-list. */
-
-static void
-free_float (struct Lisp_Float *ptr)
-{
- ptr->u.chain = float_free_list;
- float_free_list = ptr;
-}
-
-
/* Return a new float object with value FLOAT_VALUE. */
Lisp_Object
(register Lisp_Object length, Lisp_Object init)
{
register Lisp_Object val;
- register int size;
+ register EMACS_INT size;
CHECK_NATNUM (length);
size = XFASTINT (length);
{
Lisp_Object vector;
register EMACS_INT sizei;
- register int index;
+ register EMACS_INT index;
register struct Lisp_Vector *p;
CHECK_NATNUM (length);
if (m->type == MEM_TYPE_STRING)
{
struct string_block *b = (struct string_block *) m->start;
- int offset = (char *) p - (char *) &b->strings[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->strings[0];
/* P must point to the start of a Lisp_String structure, and it
must not be on the free-list. */
if (m->type == MEM_TYPE_CONS)
{
struct cons_block *b = (struct cons_block *) m->start;
- int offset = (char *) p - (char *) &b->conses[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->conses[0];
/* P must point to the start of a Lisp_Cons, not be
one of the unused cells in the current cons block,
if (m->type == MEM_TYPE_SYMBOL)
{
struct symbol_block *b = (struct symbol_block *) m->start;
- int offset = (char *) p - (char *) &b->symbols[0];
+ ptrdiff_t 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,
if (m->type == MEM_TYPE_FLOAT)
{
struct float_block *b = (struct float_block *) m->start;
- int offset = (char *) p - (char *) &b->floats[0];
+ ptrdiff_t offset = (char *) p - (char *) &b->floats[0];
/* P must point to the start of a Lisp_Float and not be
one of the unused cells in the current float block. */
if (m->type == MEM_TYPE_MISC)
{
struct marker_block *b = (struct marker_block *) m->start;
- int offset = (char *) p - (char *) &b->markers[0];
+ ptrdiff_t 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,
static INLINE void
mark_maybe_object (Lisp_Object obj)
{
- void *po = (void *) XPNTR (obj);
- struct mem_node *m = mem_find (po);
+ void *po;
+ struct mem_node *m;
+
+ if (INTEGERP (obj))
+ return;
+
+ po = (void *) XPNTR (obj);
+ m = mem_find (po);
if (m != MEM_NIL)
{
can prove that. */
static void
-test_setjmp ()
+test_setjmp (void)
{
char buf[10];
register int x;
/* Abort if anything GCPRO'd doesn't survive the GC. */
static void
-check_gcpros ()
+check_gcpros (void)
{
struct gcpro *p;
int i;
#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
static void
-dump_zombies ()
+dump_zombies (void)
{
int i;
have to be true! It must be verified for each system, possibly
by taking a look at the source code of setjmp.
+ If __builtin_unwind_init is available (defined by GCC >= 2.8) we
+ can use it as a machine independent method to store all registers
+ to the stack. In this case the macros described in the previous
+ two paragraphs are not used.
+
Stack Layout
Architectures differ in the way their processor stack is organized.
volatile int stack_grows_down_p = (char *) &j > (char *) stack_base;
void *end;
+#ifdef HAVE___BUILTIN_UNWIND_INIT
+ /* Force callee-saved registers and register windows onto the stack.
+ This is the preferred method if available, obviating the need for
+ machine dependent methods. */
+ __builtin_unwind_init ();
+ end = &end;
+#else /* not HAVE___BUILTIN_UNWIND_INIT */
/* This trick flushes the register windows so that all the state of
the process is contained in the stack. */
/* Fixme: Code in the Boehm GC suggests flushing (with `flushrs') is
setjmp (j.j);
end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */
+#endif /* not HAVE___BUILTIN_UNWIND_INIT */
/* This assumes that the stack is a contiguous region in memory. If
that's not the case, something has to be done here to iterate
address. Return NULL if not found. */
static char *
-find_string_data_in_pure (const char *data, int nbytes)
+find_string_data_in_pure (const char *data, EMACS_INT nbytes)
{
- int i, skip, bm_skip[256], last_char_skip, infinity, start, start_max;
+ int i;
+ EMACS_INT skip, bm_skip[256], last_char_skip, infinity, start, start_max;
const unsigned char *p;
char *non_lisp_beg;
string; then the string is not protected from gc. */
Lisp_Object
-make_pure_string (const char *data, int nchars, int nbytes, int multibyte)
+make_pure_string (const char *data,
+ EMACS_INT nchars, EMACS_INT nbytes, int multibyte)
{
Lisp_Object string;
struct Lisp_String *s;
{
Lisp_Object string;
struct Lisp_String *s;
- int nchars = strlen (data);
+ EMACS_INT nchars = strlen (data);
s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
s->size = nchars;
else if (COMPILEDP (obj) || VECTORP (obj))
{
register struct Lisp_Vector *vec;
- register int i;
+ register EMACS_INT i;
EMACS_INT size;
size = XVECTOR (obj)->size;
static void
mark_vectorlike (struct Lisp_Vector *ptr)
{
- register EMACS_INT size = ptr->size;
- register int i;
+ register EMACS_UINT size = ptr->size;
+ register EMACS_UINT i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr); /* Else mark it */
static void
mark_char_table (struct Lisp_Vector *ptr)
{
- register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
- register int i;
+ register EMACS_UINT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
+ register EMACS_UINT i;
eassert (!VECTOR_MARKED_P (ptr));
VECTOR_MARK (ptr);
{
Lisp_Object val = ptr->contents[i];
- if (INTEGERP (val) || SYMBOLP (val) && XSYMBOL (val)->gcmarkbit)
+ if (INTEGERP (val) || (SYMBOLP (val) && XSYMBOL (val)->gcmarkbit))
continue;
if (SUB_CHAR_TABLE_P (val))
{
recursion there. */
{
register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_INT size = ptr->size;
- register int i;
+ register EMACS_UINT size = ptr->size;
+ register EMACS_UINT i;
CHECK_LIVE (live_vector_p);
VECTOR_MARK (ptr); /* Else mark it */
for (t = terminal_list; t; t = t->next_terminal)
{
eassert (t->name != NULL);
- if (!VECTOR_MARKED_P (t))
- {
#ifdef HAVE_WINDOW_SYSTEM
- mark_image_cache (t->image_cache);
+ /* If a terminal object is reachable from a stacpro'ed object,
+ it might have been marked already. Make sure the image cache
+ gets marked. */
+ mark_image_cache (t->image_cache);
#endif /* HAVE_WINDOW_SYSTEM */
- mark_vectorlike ((struct Lisp_Vector *)t);
- }
+ if (!VECTOR_MARKED_P (t))
+ mark_vectorlike ((struct Lisp_Vector *)t);
}
}
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 */
-#endif /* VIRT_ADDR_VARIES */
}
void
HCoop / bpt / emacs.git / blobdiff