From: Gerd Moellmann Date: Fri, 5 Oct 2001 09:42:02 +0000 (+0000) Subject: (purebeg, pure_size, pure_bytes_used_before_overflow): X-Git-Tag: ttn-vms-21-2-B4~19745 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9e713715867e30e0689601ae1d10f0896eebbebd;p=emacs.git (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. --- 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