aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c117
1 files changed, 64 insertions, 53 deletions
diff --git a/src/alloc.c b/src/alloc.c
index b71cdb98d78..4c924f72384 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -209,7 +209,6 @@ Lisp_Object Qchar_table_extra_slots;
209 209
210static Lisp_Object Qpost_gc_hook; 210static Lisp_Object Qpost_gc_hook;
211 211
212static void free_save_value (Lisp_Object);
213static void mark_terminals (void); 212static void mark_terminals (void);
214static void gc_sweep (void); 213static void gc_sweep (void);
215static Lisp_Object make_pure_vector (ptrdiff_t); 214static Lisp_Object make_pure_vector (ptrdiff_t);
@@ -342,7 +341,7 @@ struct gcpro *gcprolist;
342/* Addresses of staticpro'd variables. Initialize it to a nonzero 341/* Addresses of staticpro'd variables. Initialize it to a nonzero
343 value; otherwise some compilers put it into BSS. */ 342 value; otherwise some compilers put it into BSS. */
344 343
345#define NSTATICS 0x800 344enum { NSTATICS = 2048 };
346static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag}; 345static Lisp_Object *staticvec[NSTATICS] = {&Vpurify_flag};
347 346
348/* Index of next unused slot in staticvec. */ 347/* Index of next unused slot in staticvec. */
@@ -813,22 +812,13 @@ xputenv (char const *string)
813 memory_full (0); 812 memory_full (0);
814} 813}
815 814
816/* Unwind for SAFE_ALLOCA */
817
818Lisp_Object
819safe_alloca_unwind (Lisp_Object arg)
820{
821 free_save_value (arg);
822 return Qnil;
823}
824
825/* Return a newly allocated memory block of SIZE bytes, remembering 815/* Return a newly allocated memory block of SIZE bytes, remembering
826 to free it when unwinding. */ 816 to free it when unwinding. */
827void * 817void *
828record_xmalloc (size_t size) 818record_xmalloc (size_t size)
829{ 819{
830 void *p = xmalloc (size); 820 void *p = xmalloc (size);
831 record_unwind_protect (safe_alloca_unwind, make_save_pointer (p)); 821 record_unwind_protect_ptr (xfree, p);
832 return p; 822 return p;
833} 823}
834 824
@@ -3352,67 +3342,88 @@ verify (((SAVE_INTEGER | SAVE_POINTER | SAVE_FUNCPOINTER | SAVE_OBJECT)
3352 >> SAVE_SLOT_BITS) 3342 >> SAVE_SLOT_BITS)
3353 == 0); 3343 == 0);
3354 3344
3355/* Return a Lisp_Save_Value object with the data saved according to 3345/* Return Lisp_Save_Value objects for the various combinations
3356 DATA_TYPE. DATA_TYPE should be one of SAVE_TYPE_INT_INT, etc. */ 3346 that callers need. */
3357 3347
3358Lisp_Object 3348Lisp_Object
3359make_save_value (enum Lisp_Save_Type save_type, ...) 3349make_save_int_int_int (ptrdiff_t a, ptrdiff_t b, ptrdiff_t c)
3360{ 3350{
3361 va_list ap;
3362 int i;
3363 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); 3351 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
3364 struct Lisp_Save_Value *p = XSAVE_VALUE (val); 3352 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3353 p->save_type = SAVE_TYPE_INT_INT_INT;
3354 p->data[0].integer = a;
3355 p->data[1].integer = b;
3356 p->data[2].integer = c;
3357 return val;
3358}
3365 3359
3366 eassert (0 < save_type 3360Lisp_Object
3367 && (save_type < 1 << (SAVE_TYPE_BITS - 1) 3361make_save_obj_obj_obj_obj (Lisp_Object a, Lisp_Object b, Lisp_Object c,
3368 || save_type == SAVE_TYPE_MEMORY)); 3362 Lisp_Object d)
3369 p->save_type = save_type; 3363{
3370 va_start (ap, save_type); 3364 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
3371 save_type &= ~ (1 << (SAVE_TYPE_BITS - 1)); 3365 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3372 3366 p->save_type = SAVE_TYPE_OBJ_OBJ_OBJ_OBJ;
3373 for (i = 0; save_type; i++, save_type >>= SAVE_SLOT_BITS) 3367 p->data[0].object = a;
3374 switch (save_type & ((1 << SAVE_SLOT_BITS) - 1)) 3368 p->data[1].object = b;
3375 { 3369 p->data[2].object = c;
3376 case SAVE_POINTER: 3370 p->data[3].object = d;
3377 p->data[i].pointer = va_arg (ap, void *); 3371 return val;
3378 break; 3372}
3379
3380 case SAVE_FUNCPOINTER:
3381 p->data[i].funcpointer = va_arg (ap, voidfuncptr);
3382 break;
3383
3384 case SAVE_INTEGER:
3385 p->data[i].integer = va_arg (ap, ptrdiff_t);
3386 break;
3387 3373
3388 case SAVE_OBJECT: 3374#if defined HAVE_NS || defined DOS_NT
3389 p->data[i].object = va_arg (ap, Lisp_Object); 3375Lisp_Object
3390 break; 3376make_save_ptr (void *a)
3377{
3378 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
3379 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3380 p->save_type = SAVE_POINTER;
3381 p->data[0].pointer = a;
3382 return val;
3383}
3384#endif
3391 3385
3392 default: 3386Lisp_Object
3393 emacs_abort (); 3387make_save_ptr_int (void *a, ptrdiff_t b)
3394 } 3388{
3389 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
3390 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3391 p->save_type = SAVE_TYPE_PTR_INT;
3392 p->data[0].pointer = a;
3393 p->data[1].integer = b;
3394 return val;
3395}
3395 3396
3396 va_end (ap); 3397Lisp_Object
3398make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
3399{
3400 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
3401 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3402 p->save_type = SAVE_TYPE_FUNCPTR_PTR_OBJ;
3403 p->data[0].funcpointer = a;
3404 p->data[1].pointer = b;
3405 p->data[2].object = c;
3397 return val; 3406 return val;
3398} 3407}
3399 3408
3400/* The most common task it to save just one C pointer. */ 3409/* Return a Lisp_Save_Value object that represents an array A
3410 of N Lisp objects. */
3401 3411
3402Lisp_Object 3412Lisp_Object
3403make_save_pointer (void *pointer) 3413make_save_memory (Lisp_Object *a, ptrdiff_t n)
3404{ 3414{
3405 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value); 3415 Lisp_Object val = allocate_misc (Lisp_Misc_Save_Value);
3406 struct Lisp_Save_Value *p = XSAVE_VALUE (val); 3416 struct Lisp_Save_Value *p = XSAVE_VALUE (val);
3407 p->save_type = SAVE_POINTER; 3417 p->save_type = SAVE_TYPE_MEMORY;
3408 p->data[0].pointer = pointer; 3418 p->data[0].pointer = a;
3419 p->data[1].integer = n;
3409 return val; 3420 return val;
3410} 3421}
3411 3422
3412/* Free a Lisp_Save_Value object. Do not use this function 3423/* Free a Lisp_Save_Value object. Do not use this function
3413 if SAVE contains pointer other than returned by xmalloc. */ 3424 if SAVE contains pointer other than returned by xmalloc. */
3414 3425
3415static void 3426void
3416free_save_value (Lisp_Object save) 3427free_save_value (Lisp_Object save)
3417{ 3428{
3418 xfree (XSAVE_POINTER (save, 0)); 3429 xfree (XSAVE_POINTER (save, 0));
@@ -4741,7 +4752,7 @@ valid_pointer_p (void *p)
4741 Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may 4752 Unfortunately, we cannot use NULL_DEVICE here, as emacs_write may
4742 not validate p in that case. */ 4753 not validate p in that case. */
4743 4754
4744 if (pipe2 (fd, O_CLOEXEC) == 0) 4755 if (emacs_pipe (fd) == 0)
4745 { 4756 {
4746 bool valid = emacs_write (fd[1], (char *) p, 16) == 16; 4757 bool valid = emacs_write (fd[1], (char *) p, 16) == 16;
4747 emacs_close (fd[1]); 4758 emacs_close (fd[1]);
@@ -5125,9 +5136,9 @@ Does not copy symbols. Copies strings without text properties. */)
5125void 5136void
5126staticpro (Lisp_Object *varaddress) 5137staticpro (Lisp_Object *varaddress)
5127{ 5138{
5128 staticvec[staticidx++] = varaddress;
5129 if (staticidx >= NSTATICS) 5139 if (staticidx >= NSTATICS)
5130 fatal ("NSTATICS too small; try increasing and recompiling Emacs."); 5140 fatal ("NSTATICS too small; try increasing and recompiling Emacs.");
5141 staticvec[staticidx++] = varaddress;
5131} 5142}
5132 5143
5133 5144
@@ -5227,7 +5238,7 @@ See Info node `(elisp)Garbage Collection'. */)
5227 5238
5228 /* Save what's currently displayed in the echo area. */ 5239 /* Save what's currently displayed in the echo area. */
5229 message_p = push_message (); 5240 message_p = push_message ();
5230 record_unwind_protect (pop_message_unwind, Qnil); 5241 record_unwind_protect_void (pop_message_unwind);
5231 5242
5232 /* Save a copy of the contents of the stack, for debugging. */ 5243 /* Save a copy of the contents of the stack, for debugging. */
5233#if MAX_SAVE_STACK > 0 5244#if MAX_SAVE_STACK > 0