summaryrefslogtreecommitdiff
path: root/src/alloc.c
diff options
context:
space:
mode:
authorGerd Moellmann <gerd@gnu.org>2001-10-05 09:42:02 +0000
committerGerd Moellmann <gerd@gnu.org>2001-10-05 09:42:02 +0000
commit9e713715867e30e0689601ae1d10f0896eebbebd (patch)
tree60036461a0c6934910fbadd5f68c537c7cf46546 /src/alloc.c
parent26236f6d9c903a219fb1a1000f7fce17cc2bf5c3 (diff)
downloademacs-9e713715867e30e0689601ae1d10f0896eebbebd.tar.gz
(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.
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c82
1 files changed, 63 insertions, 19 deletions
diff --git a/src/alloc.c b/src/alloc.c
index b4989c4691b..c13d5b82002 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -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