diff options
author | Gerd Moellmann <gerd@gnu.org> | 2001-10-05 09:42:02 +0000 |
---|---|---|
committer | Gerd Moellmann <gerd@gnu.org> | 2001-10-05 09:42:02 +0000 |
commit | 9e713715867e30e0689601ae1d10f0896eebbebd (patch) | |
tree | 60036461a0c6934910fbadd5f68c537c7cf46546 /src/alloc.c | |
parent | 26236f6d9c903a219fb1a1000f7fce17cc2bf5c3 (diff) | |
download | emacs-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.c | 82 |
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 |