Commit 9e713715 authored by Gerd Moellmann's avatar Gerd Moellmann
Browse files

(purebeg, pure_size, pure_bytes_used_before_overflow):

New variables.
(init_alloc_once): Initialize new variables.
(PURE_POINTER_P): Use new variables.
(pure_alloc): If pure storage overflows, allocate from the heap.
(check_pure_size): New function.
(Fgarbage_collect): Don't GC if pure storage has overflowed.

(Vpost_gc_hook, Qpost_gc_hook): New variables.
(syms_of_alloc): DEFVAR_LISP post-gc-hook, initialize
Qpost_gc_hook.
(Fgarbage_collect): Run post-gc-hook.

(Fmake_symbol): Adapt to changes of struct Lisp_Symbol.
parent 26236f6d
......@@ -191,29 +191,30 @@ Lisp_Object Vpurify_flag;
EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,};
#define PUREBEG (char *) pure
#else /* not HAVE_SHM */
#else /* HAVE_SHM */
#define pure PURE_SEG_BITS /* Use shared memory segment */
#define PUREBEG (char *)PURE_SEG_BITS
/* This variable is used only by the XPNTR macro when HAVE_SHM is
defined. If we used the PURESIZE macro directly there, that would
make most of Emacs dependent on puresize.h, which we don't want -
you should be able to change that without too much recompilation.
So map_in_data initializes pure_size, and the dependencies work
out. */
#endif /* HAVE_SHM */
EMACS_INT pure_size;
/* Pointer to the pure area, and its size. */
#endif /* not HAVE_SHM */
static char *purebeg;
static size_t pure_size;
/* Number of bytes of pure storage used before pure storage overflowed.
If this is non-zero, this implies that an overflow occurred. */
static size_t pure_bytes_used_before_overflow;
/* Value is non-zero if P points into pure space. */
#define PURE_POINTER_P(P) \
(((PNTR_COMPARISON_TYPE) (P) \
< (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)) \
< (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size)) \
&& ((PNTR_COMPARISON_TYPE) (P) \
>= (PNTR_COMPARISON_TYPE) pure))
>= (PNTR_COMPARISON_TYPE) purebeg))
/* Index in pure at which next pure object will be allocated.. */
......@@ -246,6 +247,10 @@ int ignore_warnings;
Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
/* Hook run after GC has finished. */
Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
static void mark_buffer P_ ((Lisp_Object));
static void mark_kboards P_ ((void));
static void gc_sweep P_ ((void));
......@@ -2541,11 +2546,13 @@ Its value and function definition are void, and its property list is nil.")
p = XSYMBOL (val);
p->name = XSTRING (name);
p->obarray = Qnil;
p->plist = Qnil;
p->value = Qunbound;
p->function = Qunbound;
p->next = 0;
p->next = NULL;
p->interned = SYMBOL_UNINTERNED;
p->constant = 0;
p->indirect_variable = 0;
consing_since_gc += sizeof (struct Lisp_Symbol);
symbols_consed++;
return val;
......@@ -3791,7 +3798,7 @@ pure_alloc (size, type)
{
size_t nbytes;
POINTER_TYPE *result;
char *beg = PUREBEG;
char *beg = purebeg;
/* Give Lisp_Floats an extra alignment. */
if (type == Lisp_Float)
......@@ -3806,8 +3813,14 @@ pure_alloc (size, type)
}
nbytes = ALIGN (size, sizeof (EMACS_INT));
if (pure_bytes_used + nbytes > PURESIZE)
error ("Pure Lisp storage exhausted");
if (pure_bytes_used + nbytes > pure_size)
{
beg = purebeg = (char *) xmalloc (PURESIZE);
pure_size = PURESIZE;
pure_bytes_used_before_overflow += pure_bytes_used;
pure_bytes_used = 0;
}
result = (POINTER_TYPE *) (beg + pure_bytes_used);
pure_bytes_used += nbytes;
......@@ -3815,6 +3828,17 @@ pure_alloc (size, type)
}
/* Signal an error if PURESIZE is too small. */
void
check_pure_size ()
{
if (pure_bytes_used_before_overflow)
error ("Pure Lisp storage overflow (approx. %d bytes needed)",
(int) (pure_bytes_used + pure_bytes_used_before_overflow));
}
/* Return a string allocated in pure space. DATA is a buffer holding
NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
non-zero means make the result string multibyte.
......@@ -4021,6 +4045,11 @@ Garbage collection happens automatically if you cons more than\n\
Lisp_Object total[8];
int count = BINDING_STACK_SIZE ();
/* Can't GC if pure storage overflowed because we can't determine
if something is a pure object or not. */
if (pure_bytes_used_before_overflow)
return Qnil;
/* In case user calls debug_print during GC,
don't let that cause a recursive GC. */
consing_since_gc = 0;
......@@ -4265,6 +4294,13 @@ Garbage collection happens automatically if you cons more than\n\
}
#endif
if (!NILP (Vpost_gc_hook))
{
int count = inhibit_garbage_collection ();
safe_run_hooks (Qpost_gc_hook);
unbind_to (count, Qnil);
}
return Flist (sizeof total / sizeof *total, total);
}
......@@ -5357,14 +5393,16 @@ void
init_alloc_once ()
{
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
purebeg = PUREBEG;
pure_size = PURESIZE;
pure_bytes_used = 0;
pure_bytes_used_before_overflow = 0;
#if GC_MARK_STACK || defined GC_MALLOC_CHECK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
#ifdef HAVE_SHM
pure_size = PURESIZE;
#endif
all_vectors = 0;
ignore_warnings = 1;
#ifdef DOUG_LEA_MALLOC
......@@ -5472,6 +5510,12 @@ which includes both saved text and other data.");
"Non-nil means display messages at start and end of garbage collection.");
garbage_collection_messages = 0;
DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
"Hook run after garbage collection has finished.");
Vpost_gc_hook = Qnil;
Qpost_gc_hook = intern ("post-gc-hook");
staticpro (&Qpost_gc_hook);
/* We build this in advance because if we wait until we need it, we might
not be able to allocate the memory to hold it. */
memory_signal_data
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment