diff options
| author | Gerd Moellmann | 2001-10-05 09:42:02 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2001-10-05 09:42:02 +0000 |
| commit | 9e713715867e30e0689601ae1d10f0896eebbebd (patch) | |
| tree | 60036461a0c6934910fbadd5f68c537c7cf46546 /src/alloc.c | |
| parent | 26236f6d9c903a219fb1a1000f7fce17cc2bf5c3 (diff) | |
| download | emacs-9e713715867e30e0689601ae1d10f0896eebbebd.tar.gz emacs-9e713715867e30e0689601ae1d10f0896eebbebd.zip | |
(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; | |||
| 191 | EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; | 191 | EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; |
| 192 | #define PUREBEG (char *) pure | 192 | #define PUREBEG (char *) pure |
| 193 | 193 | ||
| 194 | #else /* not HAVE_SHM */ | 194 | #else /* HAVE_SHM */ |
| 195 | 195 | ||
| 196 | #define pure PURE_SEG_BITS /* Use shared memory segment */ | 196 | #define pure PURE_SEG_BITS /* Use shared memory segment */ |
| 197 | #define PUREBEG (char *)PURE_SEG_BITS | 197 | #define PUREBEG (char *)PURE_SEG_BITS |
| 198 | 198 | ||
| 199 | /* This variable is used only by the XPNTR macro when HAVE_SHM is | 199 | #endif /* HAVE_SHM */ |
| 200 | defined. If we used the PURESIZE macro directly there, that would | ||
| 201 | make most of Emacs dependent on puresize.h, which we don't want - | ||
| 202 | you should be able to change that without too much recompilation. | ||
| 203 | So map_in_data initializes pure_size, and the dependencies work | ||
| 204 | out. */ | ||
| 205 | 200 | ||
| 206 | EMACS_INT pure_size; | 201 | /* Pointer to the pure area, and its size. */ |
| 207 | 202 | ||
| 208 | #endif /* not HAVE_SHM */ | 203 | static char *purebeg; |
| 204 | static size_t pure_size; | ||
| 205 | |||
| 206 | /* Number of bytes of pure storage used before pure storage overflowed. | ||
| 207 | If this is non-zero, this implies that an overflow occurred. */ | ||
| 208 | |||
| 209 | static size_t pure_bytes_used_before_overflow; | ||
| 209 | 210 | ||
| 210 | /* Value is non-zero if P points into pure space. */ | 211 | /* Value is non-zero if P points into pure space. */ |
| 211 | 212 | ||
| 212 | #define PURE_POINTER_P(P) \ | 213 | #define PURE_POINTER_P(P) \ |
| 213 | (((PNTR_COMPARISON_TYPE) (P) \ | 214 | (((PNTR_COMPARISON_TYPE) (P) \ |
| 214 | < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)) \ | 215 | < (PNTR_COMPARISON_TYPE) ((char *) purebeg + pure_size)) \ |
| 215 | && ((PNTR_COMPARISON_TYPE) (P) \ | 216 | && ((PNTR_COMPARISON_TYPE) (P) \ |
| 216 | >= (PNTR_COMPARISON_TYPE) pure)) | 217 | >= (PNTR_COMPARISON_TYPE) purebeg)) |
| 217 | 218 | ||
| 218 | /* Index in pure at which next pure object will be allocated.. */ | 219 | /* Index in pure at which next pure object will be allocated.. */ |
| 219 | 220 | ||
| @@ -246,6 +247,10 @@ int ignore_warnings; | |||
| 246 | 247 | ||
| 247 | Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; | 248 | Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; |
| 248 | 249 | ||
| 250 | /* Hook run after GC has finished. */ | ||
| 251 | |||
| 252 | Lisp_Object Vpost_gc_hook, Qpost_gc_hook; | ||
| 253 | |||
| 249 | static void mark_buffer P_ ((Lisp_Object)); | 254 | static void mark_buffer P_ ((Lisp_Object)); |
| 250 | static void mark_kboards P_ ((void)); | 255 | static void mark_kboards P_ ((void)); |
| 251 | static void gc_sweep P_ ((void)); | 256 | static void gc_sweep P_ ((void)); |
| @@ -2541,11 +2546,13 @@ Its value and function definition are void, and its property list is nil.") | |||
| 2541 | 2546 | ||
| 2542 | p = XSYMBOL (val); | 2547 | p = XSYMBOL (val); |
| 2543 | p->name = XSTRING (name); | 2548 | p->name = XSTRING (name); |
| 2544 | p->obarray = Qnil; | ||
| 2545 | p->plist = Qnil; | 2549 | p->plist = Qnil; |
| 2546 | p->value = Qunbound; | 2550 | p->value = Qunbound; |
| 2547 | p->function = Qunbound; | 2551 | p->function = Qunbound; |
| 2548 | p->next = 0; | 2552 | p->next = NULL; |
| 2553 | p->interned = SYMBOL_UNINTERNED; | ||
| 2554 | p->constant = 0; | ||
| 2555 | p->indirect_variable = 0; | ||
| 2549 | consing_since_gc += sizeof (struct Lisp_Symbol); | 2556 | consing_since_gc += sizeof (struct Lisp_Symbol); |
| 2550 | symbols_consed++; | 2557 | symbols_consed++; |
| 2551 | return val; | 2558 | return val; |
| @@ -3791,7 +3798,7 @@ pure_alloc (size, type) | |||
| 3791 | { | 3798 | { |
| 3792 | size_t nbytes; | 3799 | size_t nbytes; |
| 3793 | POINTER_TYPE *result; | 3800 | POINTER_TYPE *result; |
| 3794 | char *beg = PUREBEG; | 3801 | char *beg = purebeg; |
| 3795 | 3802 | ||
| 3796 | /* Give Lisp_Floats an extra alignment. */ | 3803 | /* Give Lisp_Floats an extra alignment. */ |
| 3797 | if (type == Lisp_Float) | 3804 | if (type == Lisp_Float) |
| @@ -3806,8 +3813,14 @@ pure_alloc (size, type) | |||
| 3806 | } | 3813 | } |
| 3807 | 3814 | ||
| 3808 | nbytes = ALIGN (size, sizeof (EMACS_INT)); | 3815 | nbytes = ALIGN (size, sizeof (EMACS_INT)); |
| 3809 | if (pure_bytes_used + nbytes > PURESIZE) | 3816 | |
| 3810 | error ("Pure Lisp storage exhausted"); | 3817 | if (pure_bytes_used + nbytes > pure_size) |
| 3818 | { | ||
| 3819 | beg = purebeg = (char *) xmalloc (PURESIZE); | ||
| 3820 | pure_size = PURESIZE; | ||
| 3821 | pure_bytes_used_before_overflow += pure_bytes_used; | ||
| 3822 | pure_bytes_used = 0; | ||
| 3823 | } | ||
| 3811 | 3824 | ||
| 3812 | result = (POINTER_TYPE *) (beg + pure_bytes_used); | 3825 | result = (POINTER_TYPE *) (beg + pure_bytes_used); |
| 3813 | pure_bytes_used += nbytes; | 3826 | pure_bytes_used += nbytes; |
| @@ -3815,6 +3828,17 @@ pure_alloc (size, type) | |||
| 3815 | } | 3828 | } |
| 3816 | 3829 | ||
| 3817 | 3830 | ||
| 3831 | /* Signal an error if PURESIZE is too small. */ | ||
| 3832 | |||
| 3833 | void | ||
| 3834 | check_pure_size () | ||
| 3835 | { | ||
| 3836 | if (pure_bytes_used_before_overflow) | ||
| 3837 | error ("Pure Lisp storage overflow (approx. %d bytes needed)", | ||
| 3838 | (int) (pure_bytes_used + pure_bytes_used_before_overflow)); | ||
| 3839 | } | ||
| 3840 | |||
| 3841 | |||
| 3818 | /* Return a string allocated in pure space. DATA is a buffer holding | 3842 | /* Return a string allocated in pure space. DATA is a buffer holding |
| 3819 | NCHARS characters, and NBYTES bytes of string data. MULTIBYTE | 3843 | NCHARS characters, and NBYTES bytes of string data. MULTIBYTE |
| 3820 | non-zero means make the result string multibyte. | 3844 | non-zero means make the result string multibyte. |
| @@ -4021,6 +4045,11 @@ Garbage collection happens automatically if you cons more than\n\ | |||
| 4021 | Lisp_Object total[8]; | 4045 | Lisp_Object total[8]; |
| 4022 | int count = BINDING_STACK_SIZE (); | 4046 | int count = BINDING_STACK_SIZE (); |
| 4023 | 4047 | ||
| 4048 | /* Can't GC if pure storage overflowed because we can't determine | ||
| 4049 | if something is a pure object or not. */ | ||
| 4050 | if (pure_bytes_used_before_overflow) | ||
| 4051 | return Qnil; | ||
| 4052 | |||
| 4024 | /* In case user calls debug_print during GC, | 4053 | /* In case user calls debug_print during GC, |
| 4025 | don't let that cause a recursive GC. */ | 4054 | don't let that cause a recursive GC. */ |
| 4026 | consing_since_gc = 0; | 4055 | consing_since_gc = 0; |
| @@ -4265,6 +4294,13 @@ Garbage collection happens automatically if you cons more than\n\ | |||
| 4265 | } | 4294 | } |
| 4266 | #endif | 4295 | #endif |
| 4267 | 4296 | ||
| 4297 | if (!NILP (Vpost_gc_hook)) | ||
| 4298 | { | ||
| 4299 | int count = inhibit_garbage_collection (); | ||
| 4300 | safe_run_hooks (Qpost_gc_hook); | ||
| 4301 | unbind_to (count, Qnil); | ||
| 4302 | } | ||
| 4303 | |||
| 4268 | return Flist (sizeof total / sizeof *total, total); | 4304 | return Flist (sizeof total / sizeof *total, total); |
| 4269 | } | 4305 | } |
| 4270 | 4306 | ||
| @@ -5357,14 +5393,16 @@ void | |||
| 5357 | init_alloc_once () | 5393 | init_alloc_once () |
| 5358 | { | 5394 | { |
| 5359 | /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ | 5395 | /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */ |
| 5396 | purebeg = PUREBEG; | ||
| 5397 | pure_size = PURESIZE; | ||
| 5360 | pure_bytes_used = 0; | 5398 | pure_bytes_used = 0; |
| 5399 | pure_bytes_used_before_overflow = 0; | ||
| 5400 | |||
| 5361 | #if GC_MARK_STACK || defined GC_MALLOC_CHECK | 5401 | #if GC_MARK_STACK || defined GC_MALLOC_CHECK |
| 5362 | mem_init (); | 5402 | mem_init (); |
| 5363 | Vdead = make_pure_string ("DEAD", 4, 4, 0); | 5403 | Vdead = make_pure_string ("DEAD", 4, 4, 0); |
| 5364 | #endif | 5404 | #endif |
| 5365 | #ifdef HAVE_SHM | 5405 | |
| 5366 | pure_size = PURESIZE; | ||
| 5367 | #endif | ||
| 5368 | all_vectors = 0; | 5406 | all_vectors = 0; |
| 5369 | ignore_warnings = 1; | 5407 | ignore_warnings = 1; |
| 5370 | #ifdef DOUG_LEA_MALLOC | 5408 | #ifdef DOUG_LEA_MALLOC |
| @@ -5472,6 +5510,12 @@ which includes both saved text and other data."); | |||
| 5472 | "Non-nil means display messages at start and end of garbage collection."); | 5510 | "Non-nil means display messages at start and end of garbage collection."); |
| 5473 | garbage_collection_messages = 0; | 5511 | garbage_collection_messages = 0; |
| 5474 | 5512 | ||
| 5513 | DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook, | ||
| 5514 | "Hook run after garbage collection has finished."); | ||
| 5515 | Vpost_gc_hook = Qnil; | ||
| 5516 | Qpost_gc_hook = intern ("post-gc-hook"); | ||
| 5517 | staticpro (&Qpost_gc_hook); | ||
| 5518 | |||
| 5475 | /* We build this in advance because if we wait until we need it, we might | 5519 | /* We build this in advance because if we wait until we need it, we might |
| 5476 | not be able to allocate the memory to hold it. */ | 5520 | not be able to allocate the memory to hold it. */ |
| 5477 | memory_signal_data | 5521 | memory_signal_data |