aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorGerd Moellmann2001-10-05 09:42:02 +0000
committerGerd Moellmann2001-10-05 09:42:02 +0000
commit9e713715867e30e0689601ae1d10f0896eebbebd (patch)
tree60036461a0c6934910fbadd5f68c537c7cf46546 /src/alloc.c
parent26236f6d9c903a219fb1a1000f7fce17cc2bf5c3 (diff)
downloademacs-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.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;
191EMACS_INT pure[PURESIZE / sizeof (EMACS_INT)] = {0,}; 191EMACS_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
206EMACS_INT pure_size; 201/* Pointer to the pure area, and its size. */
207 202
208#endif /* not HAVE_SHM */ 203static char *purebeg;
204static 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
209static 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
247Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots; 248Lisp_Object Qgc_cons_threshold, Qchar_table_extra_slots;
248 249
250/* Hook run after GC has finished. */
251
252Lisp_Object Vpost_gc_hook, Qpost_gc_hook;
253
249static void mark_buffer P_ ((Lisp_Object)); 254static void mark_buffer P_ ((Lisp_Object));
250static void mark_kboards P_ ((void)); 255static void mark_kboards P_ ((void));
251static void gc_sweep P_ ((void)); 256static 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
3833void
3834check_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
5357init_alloc_once () 5393init_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