aboutsummaryrefslogtreecommitdiffstats
path: root/src/alloc.c
diff options
context:
space:
mode:
authorStefan Kangas2025-02-01 04:56:52 +0100
committerStefan Kangas2025-02-01 04:56:52 +0100
commitbf97946d7dc460b7d3c3ce03193041b891b51faf (patch)
treec799f87903ca3dcba8b804bd185b519aacc0a636 /src/alloc.c
parenta4a0957b6b3b1db858524ac6d4dc3d951f65960b (diff)
parentaa07e94439c663f768c32a689d14506d25a7a5bc (diff)
downloademacs-bf97946d7dc460b7d3c3ce03193041b891b51faf.tar.gz
emacs-bf97946d7dc460b7d3c3ce03193041b891b51faf.zip
Merge branch 'scratch/no-purespace' into 'master'
Diffstat (limited to 'src/alloc.c')
-rw-r--r--src/alloc.c734
1 files changed, 90 insertions, 644 deletions
diff --git a/src/alloc.c b/src/alloc.c
index b13c3e49224..40a59854a87 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -33,7 +33,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
33#include "bignum.h" 33#include "bignum.h"
34#include "dispextern.h" 34#include "dispextern.h"
35#include "intervals.h" 35#include "intervals.h"
36#include "puresize.h"
37#include "sysstdio.h" 36#include "sysstdio.h"
38#include "systime.h" 37#include "systime.h"
39#include "character.h" 38#include "character.h"
@@ -127,7 +126,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
127 marked objects. */ 126 marked objects. */
128 127
129#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \ 128#if (defined SYSTEM_MALLOC || defined DOUG_LEA_MALLOC \
130 || defined HYBRID_MALLOC || GC_CHECK_MARKED_OBJECTS) 129 || GC_CHECK_MARKED_OBJECTS)
131#undef GC_MALLOC_CHECK 130#undef GC_MALLOC_CHECK
132#endif 131#endif
133 132
@@ -210,10 +209,6 @@ enum { MALLOC_ALIGNMENT = max (2 * sizeof (size_t), alignof (long double)) };
210 209
211# define MMAP_MAX_AREAS 100000000 210# define MMAP_MAX_AREAS 100000000
212 211
213/* A pointer to the memory allocated that copies that static data
214 inside glibc's malloc. */
215static void *malloc_state_ptr;
216
217/* Restore the dumped malloc state. Because malloc can be invoked 212/* Restore the dumped malloc state. Because malloc can be invoked
218 even before main (e.g. by the dynamic linker), the dumped malloc 213 even before main (e.g. by the dynamic linker), the dumped malloc
219 state must be restored as early as possible using this special hook. */ 214 state must be restored as early as possible using this special hook. */
@@ -224,9 +219,6 @@ malloc_initialize_hook (void)
224 219
225 if (! initialized) 220 if (! initialized)
226 { 221 {
227# ifdef GNU_LINUX
228 my_heap_start ();
229# endif
230 malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL; 222 malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL;
231 } 223 }
232 else 224 else
@@ -248,10 +240,6 @@ malloc_initialize_hook (void)
248 break; 240 break;
249 } 241 }
250 } 242 }
251
252 if (malloc_set_state (malloc_state_ptr) != 0)
253 emacs_abort ();
254 alloc_unexec_post ();
255 } 243 }
256} 244}
257 245
@@ -266,43 +254,6 @@ voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook EXTERNALLY_VISIBLE
266 254
267#endif 255#endif
268 256
269#if defined DOUG_LEA_MALLOC || defined HAVE_UNEXEC
270
271/* Allocator-related actions to do just before and after unexec. */
272
273void
274alloc_unexec_pre (void)
275{
276# ifdef DOUG_LEA_MALLOC
277 malloc_state_ptr = malloc_get_state ();
278 if (!malloc_state_ptr)
279 fatal ("malloc_get_state: %s", strerror (errno));
280# endif
281}
282
283void
284alloc_unexec_post (void)
285{
286# ifdef DOUG_LEA_MALLOC
287 free (malloc_state_ptr);
288# endif
289}
290
291# ifdef GNU_LINUX
292
293/* The address where the heap starts. */
294void *
295my_heap_start (void)
296{
297 static void *start;
298 if (! start)
299 start = sbrk (0);
300 return start;
301}
302# endif
303
304#endif
305
306/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer 257/* Mark, unmark, query mark bit of a Lisp string. S must be a pointer
307 to a struct Lisp_String. */ 258 to a struct Lisp_String. */
308 259
@@ -380,33 +331,6 @@ static char *spare_memory[7];
380 331
381#define SPARE_MEMORY (1 << 14) 332#define SPARE_MEMORY (1 << 14)
382 333
383/* Initialize it to a nonzero value to force it into data space
384 (rather than bss space). That way unexec will remap it into text
385 space (pure), on some systems. We have not implemented the
386 remapping on more recent systems because this is less important
387 nowadays than in the days of small memories and timesharing. */
388
389EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,};
390#define PUREBEG (char *) pure
391
392/* Pointer to the pure area, and its size. */
393
394static char *purebeg;
395static ptrdiff_t pure_size;
396
397/* Number of bytes of pure storage used before pure storage overflowed.
398 If this is non-zero, this implies that an overflow occurred. */
399
400static ptrdiff_t pure_bytes_used_before_overflow;
401
402/* Index in pure at which next pure Lisp object will be allocated.. */
403
404static ptrdiff_t pure_bytes_used_lisp;
405
406/* Number of bytes allocated for non-Lisp objects in pure storage. */
407
408static ptrdiff_t pure_bytes_used_non_lisp;
409
410/* If positive, garbage collection is inhibited. Otherwise, zero. */ 334/* If positive, garbage collection is inhibited. Otherwise, zero. */
411 335
412intptr_t garbage_collection_inhibited; 336intptr_t garbage_collection_inhibited;
@@ -457,10 +381,9 @@ static struct Lisp_Vector *allocate_clear_vector (ptrdiff_t, bool);
457static void unchain_finalizer (struct Lisp_Finalizer *); 381static void unchain_finalizer (struct Lisp_Finalizer *);
458static void mark_terminals (void); 382static void mark_terminals (void);
459static void gc_sweep (void); 383static void gc_sweep (void);
460static Lisp_Object make_pure_vector (ptrdiff_t);
461static void mark_buffer (struct buffer *); 384static void mark_buffer (struct buffer *);
462 385
463#if !defined REL_ALLOC || defined SYSTEM_MALLOC || defined HYBRID_MALLOC 386#if !defined REL_ALLOC || defined SYSTEM_MALLOC
464static void refill_memory_reserve (void); 387static void refill_memory_reserve (void);
465#endif 388#endif
466static void compact_small_strings (void); 389static void compact_small_strings (void);
@@ -570,29 +493,21 @@ static void mem_delete (struct mem_node *);
570static void mem_delete_fixup (struct mem_node *); 493static void mem_delete_fixup (struct mem_node *);
571static struct mem_node *mem_find (void *); 494static struct mem_node *mem_find (void *);
572 495
573/* Addresses of staticpro'd variables. Initialize it to a nonzero 496/* Addresses of staticpro'd variables. */
574 value if we might unexec; otherwise some compilers put it into
575 BSS. */
576 497
577Lisp_Object const *staticvec[NSTATICS] 498Lisp_Object const *staticvec[NSTATICS];
578#ifdef HAVE_UNEXEC
579= {&Vpurify_flag}
580#endif
581 ;
582 499
583/* Index of next unused slot in staticvec. */ 500/* Index of next unused slot in staticvec. */
584 501
585int staticidx; 502int staticidx;
586 503
587static void *pure_alloc (size_t, int); 504#ifndef HAVE_ALIGNED_ALLOC
588
589/* Return PTR rounded up to the next multiple of ALIGNMENT. */
590
591static void * 505static void *
592pointer_align (void *ptr, int alignment) 506pointer_align (void *ptr, int alignment)
593{ 507{
594 return (void *) ROUNDUP ((uintptr_t) ptr, alignment); 508 return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
595} 509}
510#endif
596 511
597/* Extract the pointer hidden within O. */ 512/* Extract the pointer hidden within O. */
598 513
@@ -631,10 +546,8 @@ mmap_lisp_allowed_p (void)
631{ 546{
632 /* If we can't store all memory addresses in our lisp objects, it's 547 /* If we can't store all memory addresses in our lisp objects, it's
633 risky to let the heap use mmap and give us addresses from all 548 risky to let the heap use mmap and give us addresses from all
634 over our address space. We also can't use mmap for lisp objects 549 over our address space. */
635 if we might dump: unexec doesn't preserve the contents of mmapped 550 return pointers_fit_in_lispobj_p ();
636 regions. */
637 return pointers_fit_in_lispobj_p () && !will_dump_with_unexec_p ();
638} 551}
639#endif 552#endif
640 553
@@ -652,7 +565,7 @@ struct Lisp_Finalizer doomed_finalizers;
652 Malloc 565 Malloc
653 ************************************************************************/ 566 ************************************************************************/
654 567
655#if defined SIGDANGER || (!defined SYSTEM_MALLOC && !defined HYBRID_MALLOC) 568#if defined SIGDANGER || (!defined SYSTEM_MALLOC)
656 569
657/* Function malloc calls this if it finds we are near exhausting storage. */ 570/* Function malloc calls this if it finds we are near exhausting storage. */
658 571
@@ -1074,26 +987,17 @@ lisp_free (void *block)
1074 BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */ 987 BLOCK_BYTES and guarantees they are aligned on a BLOCK_ALIGN boundary. */
1075 988
1076/* Byte alignment of storage blocks. */ 989/* Byte alignment of storage blocks. */
1077#ifdef HAVE_UNEXEC
1078# define BLOCK_ALIGN (1 << 10)
1079#else /* !HAVE_UNEXEC */
1080# define BLOCK_ALIGN (1 << 15) 990# define BLOCK_ALIGN (1 << 15)
1081#endif
1082static_assert (POWER_OF_2 (BLOCK_ALIGN)); 991static_assert (POWER_OF_2 (BLOCK_ALIGN));
1083 992
1084/* Use aligned_alloc if it or a simple substitute is available. 993/* Use aligned_alloc if it or a simple substitute is available. */
1085 Aligned allocation is incompatible with unexmacosx.c, so don't use 994
1086 it on Darwin if HAVE_UNEXEC. */ 995#if (defined HAVE_ALIGNED_ALLOC \
1087 996 || (!defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC))
1088#if ! (defined DARWIN_OS && defined HAVE_UNEXEC) 997# define USE_ALIGNED_ALLOC 1
1089# if (defined HAVE_ALIGNED_ALLOC \ 998#elif defined HAVE_POSIX_MEMALIGN
1090 || (defined HYBRID_MALLOC \ 999# define USE_ALIGNED_ALLOC 1
1091 ? defined HAVE_POSIX_MEMALIGN \ 1000# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */
1092 : !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC))
1093# define USE_ALIGNED_ALLOC 1
1094# elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN
1095# define USE_ALIGNED_ALLOC 1
1096# define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */
1097static void * 1001static void *
1098aligned_alloc (size_t alignment, size_t size) 1002aligned_alloc (size_t alignment, size_t size)
1099{ 1003{
@@ -1106,7 +1010,6 @@ aligned_alloc (size_t alignment, size_t size)
1106 void *p; 1010 void *p;
1107 return posix_memalign (&p, alignment, size) == 0 ? p : 0; 1011 return posix_memalign (&p, alignment, size) == 0 ? p : 0;
1108} 1012}
1109# endif
1110#endif 1013#endif
1111 1014
1112/* Padding to leave at the end of a malloc'd block. This is to give 1015/* Padding to leave at the end of a malloc'd block. This is to give
@@ -1662,12 +1565,30 @@ static ptrdiff_t const STRING_BYTES_MAX =
1662 1565
1663/* Initialize string allocation. Called from init_alloc_once. */ 1566/* Initialize string allocation. Called from init_alloc_once. */
1664 1567
1568static struct Lisp_String *allocate_string (void);
1569static void
1570allocate_string_data (struct Lisp_String *s,
1571 EMACS_INT nchars, EMACS_INT nbytes, bool clearit,
1572 bool immovable);
1573
1665static void 1574static void
1666init_strings (void) 1575init_strings (void)
1667{ 1576{
1668 empty_unibyte_string = make_pure_string ("", 0, 0, 0); 1577 /* String allocation code will return one of 'empty_*ibyte_string'
1578 when asked to construct a new 0-length string, so in order to build
1579 those special cases, we have to do it "by hand". */
1580 struct Lisp_String *ems = allocate_string ();
1581 struct Lisp_String *eus = allocate_string ();
1582 ems->u.s.intervals = NULL;
1583 eus->u.s.intervals = NULL;
1584 allocate_string_data (ems, 0, 0, false, false);
1585 allocate_string_data (eus, 0, 0, false, false);
1586 /* We can't use 'STRING_SET_UNIBYTE' because this one includes a hack
1587 * to redirect its arg to 'empty_unibyte_string' when nbytes == 0. */
1588 eus->u.s.size_byte = -1;
1589 XSETSTRING (empty_multibyte_string, ems);
1590 XSETSTRING (empty_unibyte_string, eus);
1669 staticpro (&empty_unibyte_string); 1591 staticpro (&empty_unibyte_string);
1670 empty_multibyte_string = make_pure_string ("", 0, 0, 1);
1671 staticpro (&empty_multibyte_string); 1592 staticpro (&empty_multibyte_string);
1672} 1593}
1673 1594
@@ -1720,7 +1641,7 @@ string_bytes (struct Lisp_String *s)
1720 ptrdiff_t nbytes = 1641 ptrdiff_t nbytes =
1721 (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte); 1642 (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte);
1722 1643
1723 if (!PURE_P (s) && !pdumper_object_p (s) && s->u.s.data 1644 if (!pdumper_object_p (s) && s->u.s.data
1724 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) 1645 && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
1725 emacs_abort (); 1646 emacs_abort ();
1726 return nbytes; 1647 return nbytes;
@@ -2571,7 +2492,7 @@ pin_string (Lisp_Object string)
2571 unsigned char *data = s->u.s.data; 2492 unsigned char *data = s->u.s.data;
2572 2493
2573 if (!(size > LARGE_STRING_BYTES 2494 if (!(size > LARGE_STRING_BYTES
2574 || PURE_P (data) || pdumper_object_p (data) 2495 || pdumper_object_p (data)
2575 || s->u.s.size_byte == -3)) 2496 || s->u.s.size_byte == -3))
2576 { 2497 {
2577 eassert (s->u.s.size_byte == -1); 2498 eassert (s->u.s.size_byte == -1);
@@ -2870,17 +2791,16 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4,
2870} 2791}
2871 2792
2872/* Make a list of COUNT Lisp_Objects, where ARG is the first one. 2793/* Make a list of COUNT Lisp_Objects, where ARG is the first one.
2873 Use CONS to construct the pairs. AP has any remaining args. */ 2794 AP has any remaining args. */
2874static Lisp_Object 2795static Lisp_Object
2875cons_listn (ptrdiff_t count, Lisp_Object arg, 2796cons_listn (ptrdiff_t count, Lisp_Object arg, va_list ap)
2876 Lisp_Object (*cons) (Lisp_Object, Lisp_Object), va_list ap)
2877{ 2797{
2878 eassume (0 < count); 2798 eassume (0 < count);
2879 Lisp_Object val = cons (arg, Qnil); 2799 Lisp_Object val = Fcons (arg, Qnil);
2880 Lisp_Object tail = val; 2800 Lisp_Object tail = val;
2881 for (ptrdiff_t i = 1; i < count; i++) 2801 for (ptrdiff_t i = 1; i < count; i++)
2882 { 2802 {
2883 Lisp_Object elem = cons (va_arg (ap, Lisp_Object), Qnil); 2803 Lisp_Object elem = Fcons (va_arg (ap, Lisp_Object), Qnil);
2884 XSETCDR (tail, elem); 2804 XSETCDR (tail, elem);
2885 tail = elem; 2805 tail = elem;
2886 } 2806 }
@@ -2893,18 +2813,7 @@ listn (ptrdiff_t count, Lisp_Object arg1, ...)
2893{ 2813{
2894 va_list ap; 2814 va_list ap;
2895 va_start (ap, arg1); 2815 va_start (ap, arg1);
2896 Lisp_Object val = cons_listn (count, arg1, Fcons, ap); 2816 Lisp_Object val = cons_listn (count, arg1, ap);
2897 va_end (ap);
2898 return val;
2899}
2900
2901/* Make a pure list of COUNT Lisp_Objects, where ARG1 is the first one. */
2902Lisp_Object
2903pure_listn (ptrdiff_t count, Lisp_Object arg1, ...)
2904{
2905 va_list ap;
2906 va_start (ap, arg1);
2907 Lisp_Object val = cons_listn (count, arg1, pure_cons, ap);
2908 va_end (ap); 2817 va_end (ap);
2909 return val; 2818 return val;
2910} 2819}
@@ -3085,7 +2994,7 @@ static ptrdiff_t last_inserted_vector_free_idx = VECTOR_FREE_LIST_ARRAY_SIZE;
3085 2994
3086static struct large_vector *large_vectors; 2995static struct large_vector *large_vectors;
3087 2996
3088/* The only vector with 0 slots, allocated from pure space. */ 2997/* The only vector with 0 slots. */
3089 2998
3090Lisp_Object zero_vector; 2999Lisp_Object zero_vector;
3091 3000
@@ -3137,14 +3046,8 @@ allocate_vector_block (void)
3137 return block; 3046 return block;
3138} 3047}
3139 3048
3140/* Called once to initialize vector allocation. */ 3049static struct Lisp_Vector *
3141 3050allocate_vector_from_block (ptrdiff_t nbytes);
3142static void
3143init_vectors (void)
3144{
3145 zero_vector = make_pure_vector (0);
3146 staticpro (&zero_vector);
3147}
3148 3051
3149/* Memory footprint in bytes of a pseudovector other than a bool-vector. */ 3052/* Memory footprint in bytes of a pseudovector other than a bool-vector. */
3150static ptrdiff_t 3053static ptrdiff_t
@@ -3157,6 +3060,31 @@ pseudovector_nbytes (const union vectorlike_header *hdr)
3157 return vroundup (header_size + word_size * nwords); 3060 return vroundup (header_size + word_size * nwords);
3158} 3061}
3159 3062
3063/* Called once to initialize vector allocation. */
3064
3065static void
3066init_vectors (void)
3067{
3068 /* The normal vector allocation code refuses to allocate a 0-length vector
3069 because we use the first field of vectors internally when they're on
3070 the free list, so we can't put a zero-length vector on the free list.
3071 This is not a problem for 'zero_vector' since it's always reachable.
3072 An alternative approach would be to allocate zero_vector outside of the
3073 normal heap, e.g. as a static object, and then to "hide" it from the GC,
3074 for example by marking it by hand at the beginning of the GC and unmarking
3075 it by hand at the end. */
3076 struct vector_block *block = allocate_vector_block ();
3077 struct Lisp_Vector *zv = (struct Lisp_Vector *)block->data;
3078 zv->header.size = 0;
3079 ssize_t nbytes = pseudovector_nbytes (&zv->header);
3080 ssize_t restbytes = VECTOR_BLOCK_BYTES - nbytes;
3081 eassert (restbytes % roundup_size == 0);
3082 setup_on_free_list (ADVANCE (zv, nbytes), restbytes);
3083
3084 zero_vector = make_lisp_ptr (zv, Lisp_Vectorlike);
3085 staticpro (&zero_vector);
3086}
3087
3160/* Allocate vector from a vector block. */ 3088/* Allocate vector from a vector block. */
3161 3089
3162static struct Lisp_Vector * 3090static struct Lisp_Vector *
@@ -3764,13 +3692,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
3764 /* Bytecode must be immovable. */ 3692 /* Bytecode must be immovable. */
3765 pin_string (args[CLOSURE_CODE]); 3693 pin_string (args[CLOSURE_CODE]);
3766 3694
3767 /* We used to purecopy everything here, if purify-flag was set. This worked
3768 OK for Emacs-23, but with Emacs-24's lexical binding code, it can be
3769 dangerous, since make-byte-code is used during execution to build
3770 closures, so any closure built during the preload phase would end up
3771 copied into pure space, including its free variables, which is sometimes
3772 just wasteful and other times plainly wrong (e.g. those free vars may want
3773 to be setcar'd). */
3774 Lisp_Object val = Fvector (nargs, args); 3695 Lisp_Object val = Fvector (nargs, args);
3775 XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE); 3696 XSETPVECTYPE (XVECTOR (val), PVEC_CLOSURE);
3776 return val; 3697 return val;
@@ -3850,13 +3771,6 @@ struct symbol_block
3850 3771
3851static struct symbol_block *symbol_block; 3772static struct symbol_block *symbol_block;
3852static int symbol_block_index = SYMBOL_BLOCK_SIZE; 3773static int symbol_block_index = SYMBOL_BLOCK_SIZE;
3853/* Pointer to the first symbol_block that contains pinned symbols.
3854 Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols,
3855 10K of which are pinned (and all but 250 of them are interned in obarray),
3856 whereas a "typical session" has in the order of 30K symbols.
3857 `symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather
3858 than 30K to find the 10K symbols we need to mark. */
3859static struct symbol_block *symbol_block_pinned;
3860 3774
3861/* List of free symbols. */ 3775/* List of free symbols. */
3862 3776
@@ -3882,7 +3796,6 @@ init_symbol (Lisp_Object val, Lisp_Object name)
3882 p->u.s.interned = SYMBOL_UNINTERNED; 3796 p->u.s.interned = SYMBOL_UNINTERNED;
3883 p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE; 3797 p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE;
3884 p->u.s.declared_special = false; 3798 p->u.s.declared_special = false;
3885 p->u.s.pinned = false;
3886} 3799}
3887 3800
3888DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, 3801DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
@@ -4373,7 +4286,7 @@ memory_full (size_t nbytes)
4373void 4286void
4374refill_memory_reserve (void) 4287refill_memory_reserve (void)
4375{ 4288{
4376#if !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC 4289#if !defined SYSTEM_MALLOC
4377 if (spare_memory[0] == 0) 4290 if (spare_memory[0] == 0)
4378 spare_memory[0] = malloc (SPARE_MEMORY); 4291 spare_memory[0] = malloc (SPARE_MEMORY);
4379 if (spare_memory[1] == 0) 4292 if (spare_memory[1] == 0)
@@ -5522,8 +5435,6 @@ valid_lisp_object_p (Lisp_Object obj)
5522 return 1; 5435 return 1;
5523 5436
5524 void *p = XPNTR (obj); 5437 void *p = XPNTR (obj);
5525 if (PURE_P (p))
5526 return 1;
5527 5438
5528 if (BARE_SYMBOL_P (obj) && c_symbol_p (p)) 5439 if (BARE_SYMBOL_P (obj) && c_symbol_p (p))
5529 return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; 5440 return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0;
@@ -5602,433 +5513,6 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes)
5602 xfree (p); 5513 xfree (p);
5603} 5514}
5604 5515
5605
5606/***********************************************************************
5607 Pure Storage Management
5608 ***********************************************************************/
5609
5610/* Allocate room for SIZE bytes from pure Lisp storage and return a
5611 pointer to it. TYPE is the Lisp type for which the memory is
5612 allocated. TYPE < 0 means it's not used for a Lisp object,
5613 and that the result should have an alignment of -TYPE.
5614
5615 The bytes are initially zero.
5616
5617 If pure space is exhausted, allocate space from the heap. This is
5618 merely an expedient to let Emacs warn that pure space was exhausted
5619 and that Emacs should be rebuilt with a larger pure space. */
5620
5621static void *
5622pure_alloc (size_t size, int type)
5623{
5624 void *result;
5625 static bool pure_overflow_warned = false;
5626
5627 again:
5628 if (type >= 0)
5629 {
5630 /* Allocate space for a Lisp object from the beginning of the free
5631 space with taking account of alignment. */
5632 result = pointer_align (purebeg + pure_bytes_used_lisp, LISP_ALIGNMENT);
5633 pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
5634 }
5635 else
5636 {
5637 /* Allocate space for a non-Lisp object from the end of the free
5638 space. */
5639 ptrdiff_t unaligned_non_lisp = pure_bytes_used_non_lisp + size;
5640 char *unaligned = purebeg + pure_size - unaligned_non_lisp;
5641 int decr = (intptr_t) unaligned & (-1 - type);
5642 pure_bytes_used_non_lisp = unaligned_non_lisp + decr;
5643 result = unaligned - decr;
5644 }
5645 pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp;
5646
5647 if (pure_bytes_used <= pure_size)
5648 return result;
5649
5650 if (!pure_overflow_warned)
5651 {
5652 message ("Pure Lisp storage overflowed");
5653 pure_overflow_warned = true;
5654 }
5655
5656 /* Don't allocate a large amount here,
5657 because it might get mmap'd and then its address
5658 might not be usable. */
5659 int small_amount = 10000;
5660 eassert (size <= small_amount - LISP_ALIGNMENT);
5661 purebeg = xzalloc (small_amount);
5662 pure_size = small_amount;
5663 pure_bytes_used_before_overflow += pure_bytes_used - size;
5664 pure_bytes_used = 0;
5665 pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0;
5666
5667 /* Can't GC if pure storage overflowed because we can't determine
5668 if something is a pure object or not. */
5669 garbage_collection_inhibited++;
5670 goto again;
5671}
5672
5673/* Print a warning if PURESIZE is too small. */
5674
5675void
5676check_pure_size (void)
5677{
5678 if (pure_bytes_used_before_overflow)
5679 message (("emacs:0:Pure Lisp storage overflow (approx. %jd"
5680 " bytes needed)"),
5681 pure_bytes_used + pure_bytes_used_before_overflow);
5682}
5683
5684/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from
5685 the non-Lisp data pool of the pure storage, and return its start
5686 address. Return NULL if not found. */
5687
5688static char *
5689find_string_data_in_pure (const char *data, ptrdiff_t nbytes)
5690{
5691 int i;
5692 ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max;
5693 const unsigned char *p;
5694 char *non_lisp_beg;
5695
5696 if (pure_bytes_used_non_lisp <= nbytes)
5697 return NULL;
5698
5699 /* The Android GCC generates code like:
5700
5701 0xa539e755 <+52>: lea 0x430(%esp),%esi
5702=> 0xa539e75c <+59>: movdqa %xmm0,0x0(%ebp)
5703 0xa539e761 <+64>: add $0x10,%ebp
5704
5705 but data is not aligned appropriately, so a GP fault results. */
5706
5707#if defined __i386__ \
5708 && defined HAVE_ANDROID \
5709 && !defined ANDROID_STUBIFY \
5710 && !defined (__clang__)
5711 if ((intptr_t) data & 15)
5712 return NULL;
5713#endif
5714
5715 /* Set up the Boyer-Moore table. */
5716 skip = nbytes + 1;
5717 for (i = 0; i < 256; i++)
5718 bm_skip[i] = skip;
5719
5720 p = (const unsigned char *) data;
5721 while (--skip > 0)
5722 bm_skip[*p++] = skip;
5723
5724 last_char_skip = bm_skip['\0'];
5725
5726 non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp;
5727 start_max = pure_bytes_used_non_lisp - (nbytes + 1);
5728
5729 /* See the comments in the function `boyer_moore' (search.c) for the
5730 use of `infinity'. */
5731 infinity = pure_bytes_used_non_lisp + 1;
5732 bm_skip['\0'] = infinity;
5733
5734 p = (const unsigned char *) non_lisp_beg + nbytes;
5735 start = 0;
5736 do
5737 {
5738 /* Check the last character (== '\0'). */
5739 do
5740 {
5741 start += bm_skip[*(p + start)];
5742 }
5743 while (start <= start_max);
5744
5745 if (start < infinity)
5746 /* Couldn't find the last character. */
5747 return NULL;
5748
5749 /* No less than `infinity' means we could find the last
5750 character at `p[start - infinity]'. */
5751 start -= infinity;
5752
5753 /* Check the remaining characters. */
5754 if (memcmp (data, non_lisp_beg + start, nbytes) == 0)
5755 /* Found. */
5756 return non_lisp_beg + start;
5757
5758 start += last_char_skip;
5759 }
5760 while (start <= start_max);
5761
5762 return NULL;
5763}
5764
5765
5766/* Return a string allocated in pure space. DATA is a buffer holding
5767 NCHARS characters, and NBYTES bytes of string data. MULTIBYTE
5768 means make the result string multibyte.
5769
5770 Must get an error if pure storage is full, since if it cannot hold
5771 a large string it may be able to hold conses that point to that
5772 string; then the string is not protected from gc. */
5773
5774Lisp_Object
5775make_pure_string (const char *data,
5776 ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte)
5777{
5778 Lisp_Object string;
5779 struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
5780 s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes);
5781 if (s->u.s.data == NULL)
5782 {
5783 s->u.s.data = pure_alloc (nbytes + 1, -1);
5784 memcpy (s->u.s.data, data, nbytes);
5785 s->u.s.data[nbytes] = '\0';
5786 }
5787 s->u.s.size = nchars;
5788 s->u.s.size_byte = multibyte ? nbytes : -1;
5789 s->u.s.intervals = NULL;
5790 XSETSTRING (string, s);
5791 return string;
5792}
5793
5794/* Return a string allocated in pure space. Do not
5795 allocate the string data, just point to DATA. */
5796
5797Lisp_Object
5798make_pure_c_string (const char *data, ptrdiff_t nchars)
5799{
5800 Lisp_Object string;
5801 struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String);
5802 s->u.s.size = nchars;
5803 s->u.s.size_byte = -2;
5804 s->u.s.data = (unsigned char *) data;
5805 s->u.s.intervals = NULL;
5806 XSETSTRING (string, s);
5807 return string;
5808}
5809
5810static Lisp_Object purecopy (Lisp_Object obj);
5811
5812/* Return a cons allocated from pure space. Give it pure copies
5813 of CAR as car and CDR as cdr. */
5814
5815Lisp_Object
5816pure_cons (Lisp_Object car, Lisp_Object cdr)
5817{
5818 Lisp_Object new;
5819 struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons);
5820 XSETCONS (new, p);
5821 XSETCAR (new, purecopy (car));
5822 XSETCDR (new, purecopy (cdr));
5823 return new;
5824}
5825
5826
5827/* Value is a float object with value NUM allocated from pure space. */
5828
5829static Lisp_Object
5830make_pure_float (double num)
5831{
5832 Lisp_Object new;
5833 struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float);
5834 XSETFLOAT (new, p);
5835 XFLOAT_INIT (new, num);
5836 return new;
5837}
5838
5839/* Value is a bignum object with value VALUE allocated from pure
5840 space. */
5841
5842static Lisp_Object
5843make_pure_bignum (Lisp_Object value)
5844{
5845 mpz_t const *n = xbignum_val (value);
5846 size_t i, nlimbs = mpz_size (*n);
5847 size_t nbytes = nlimbs * sizeof (mp_limb_t);
5848 mp_limb_t *pure_limbs;
5849 mp_size_t new_size;
5850
5851 struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike);
5852 XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum));
5853
5854 int limb_alignment = alignof (mp_limb_t);
5855 pure_limbs = pure_alloc (nbytes, - limb_alignment);
5856 for (i = 0; i < nlimbs; ++i)
5857 pure_limbs[i] = mpz_getlimbn (*n, i);
5858
5859 new_size = nlimbs;
5860 if (mpz_sgn (*n) < 0)
5861 new_size = -new_size;
5862
5863 mpz_roinit_n (b->value, pure_limbs, new_size);
5864
5865 return make_lisp_ptr (b, Lisp_Vectorlike);
5866}
5867
5868/* Return a vector with room for LEN Lisp_Objects allocated from
5869 pure space. */
5870
5871static Lisp_Object
5872make_pure_vector (ptrdiff_t len)
5873{
5874 Lisp_Object new;
5875 size_t size = header_size + len * word_size;
5876 struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike);
5877 XSETVECTOR (new, p);
5878 XVECTOR (new)->header.size = len;
5879 return new;
5880}
5881
5882/* Copy all contents and parameters of TABLE to a new table allocated
5883 from pure space, return the purified table. */
5884static struct Lisp_Hash_Table *
5885purecopy_hash_table (struct Lisp_Hash_Table *table)
5886{
5887 eassert (table->weakness == Weak_None);
5888 eassert (table->purecopy);
5889
5890 struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike);
5891 *pure = *table;
5892 pure->mutable = false;
5893
5894 if (table->table_size > 0)
5895 {
5896 ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash;
5897 pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash);
5898 memcpy (pure->hash, table->hash, hash_bytes);
5899
5900 ptrdiff_t next_bytes = table->table_size * sizeof *table->next;
5901 pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next);
5902 memcpy (pure->next, table->next, next_bytes);
5903
5904 ptrdiff_t nvalues = table->table_size * 2;
5905 ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value;
5906 pure->key_and_value = pure_alloc (kv_bytes,
5907 -(int)sizeof *table->key_and_value);
5908 for (ptrdiff_t i = 0; i < nvalues; i++)
5909 pure->key_and_value[i] = purecopy (table->key_and_value[i]);
5910
5911 ptrdiff_t index_bytes = hash_table_index_size (table)
5912 * sizeof *table->index;
5913 pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index);
5914 memcpy (pure->index, table->index, index_bytes);
5915 }
5916
5917 return pure;
5918}
5919
5920DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
5921 doc: /* Make a copy of object OBJ in pure storage.
5922Recursively copies contents of vectors and cons cells.
5923Does not copy symbols. Copies strings without text properties. */)
5924 (register Lisp_Object obj)
5925{
5926 if (NILP (Vpurify_flag))
5927 return obj;
5928 else if (MARKERP (obj) || OVERLAYP (obj) || SYMBOLP (obj))
5929 /* Can't purify those. */
5930 return obj;
5931 else
5932 return purecopy (obj);
5933}
5934
5935/* Pinned objects are marked before every GC cycle. */
5936static struct pinned_object
5937{
5938 Lisp_Object object;
5939 struct pinned_object *next;
5940} *pinned_objects;
5941
5942static Lisp_Object
5943purecopy (Lisp_Object obj)
5944{
5945 if (FIXNUMP (obj)
5946 || (! SYMBOLP (obj) && PURE_P (XPNTR (obj)))
5947 || SUBRP (obj))
5948 return obj; /* Already pure. */
5949
5950 if (STRINGP (obj) && XSTRING (obj)->u.s.intervals)
5951 message_with_string ("Dropping text-properties while making string `%s' pure",
5952 obj, true);
5953
5954 if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
5955 {
5956 Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil);
5957 if (!NILP (tmp))
5958 return tmp;
5959 }
5960
5961 if (CONSP (obj))
5962 obj = pure_cons (XCAR (obj), XCDR (obj));
5963 else if (FLOATP (obj))
5964 obj = make_pure_float (XFLOAT_DATA (obj));
5965 else if (STRINGP (obj))
5966 obj = make_pure_string (SSDATA (obj), SCHARS (obj),
5967 SBYTES (obj),
5968 STRING_MULTIBYTE (obj));
5969 else if (HASH_TABLE_P (obj))
5970 {
5971 struct Lisp_Hash_Table *table = XHASH_TABLE (obj);
5972 /* Do not purify hash tables which haven't been defined with
5973 :purecopy as non-nil or are weak - they aren't guaranteed to
5974 not change. */
5975 if (table->weakness != Weak_None || !table->purecopy)
5976 {
5977 /* Instead, add the hash table to the list of pinned objects,
5978 so that it will be marked during GC. */
5979 struct pinned_object *o = xmalloc (sizeof *o);
5980 o->object = obj;
5981 o->next = pinned_objects;
5982 pinned_objects = o;
5983 return obj; /* Don't hash cons it. */
5984 }
5985
5986 obj = make_lisp_hash_table (purecopy_hash_table (table));
5987 }
5988 else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj))
5989 {
5990 struct Lisp_Vector *objp = XVECTOR (obj);
5991 ptrdiff_t nbytes = vector_nbytes (objp);
5992 struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike);
5993 register ptrdiff_t i;
5994 ptrdiff_t size = ASIZE (obj);
5995 if (size & PSEUDOVECTOR_FLAG)
5996 size &= PSEUDOVECTOR_SIZE_MASK;
5997 memcpy (vec, objp, nbytes);
5998 for (i = 0; i < size; i++)
5999 vec->contents[i] = purecopy (vec->contents[i]);
6000 /* Byte code strings must be pinned. */
6001 if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1])
6002 && !STRING_MULTIBYTE (vec->contents[1]))
6003 pin_string (vec->contents[1]);
6004 XSETVECTOR (obj, vec);
6005 }
6006 else if (BARE_SYMBOL_P (obj))
6007 {
6008 if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj)))
6009 { /* We can't purify them, but they appear in many pure objects.
6010 Mark them as `pinned' so we know to mark them at every GC cycle. */
6011 XBARE_SYMBOL (obj)->u.s.pinned = true;
6012 symbol_block_pinned = symbol_block;
6013 }
6014 /* Don't hash-cons it. */
6015 return obj;
6016 }
6017 else if (BIGNUMP (obj))
6018 obj = make_pure_bignum (obj);
6019 else
6020 {
6021 AUTO_STRING (fmt, "Don't know how to purify: %S");
6022 Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj)));
6023 }
6024
6025 if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */
6026 Fputhash (obj, obj, Vpurify_flag);
6027
6028 return obj;
6029}
6030
6031
6032 5516
6033/*********************************************************************** 5517/***********************************************************************
6034 Protection from GC 5518 Protection from GC
@@ -6220,13 +5704,6 @@ compact_undo_list (Lisp_Object list)
6220 return list; 5704 return list;
6221} 5705}
6222 5706
6223static void
6224mark_pinned_objects (void)
6225{
6226 for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next)
6227 mark_object (pobj->object);
6228}
6229
6230#if defined HAVE_ANDROID && !defined (__clang__) 5707#if defined HAVE_ANDROID && !defined (__clang__)
6231 5708
6232/* The Android gcc is broken and needs the following version of 5709/* The Android gcc is broken and needs the following version of
@@ -6251,29 +5728,6 @@ android_make_lisp_symbol (struct Lisp_Symbol *sym)
6251#endif 5728#endif
6252 5729
6253static void 5730static void
6254mark_pinned_symbols (void)
6255{
6256 struct symbol_block *sblk;
6257 int lim;
6258 struct Lisp_Symbol *sym, *end;
6259
6260 if (symbol_block_pinned == symbol_block)
6261 lim = symbol_block_index;
6262 else
6263 lim = SYMBOL_BLOCK_SIZE;
6264
6265 for (sblk = symbol_block_pinned; sblk; sblk = sblk->next)
6266 {
6267 sym = sblk->symbols, end = sym + lim;
6268 for (; sym < end; ++sym)
6269 if (sym->u.s.pinned)
6270 mark_object (make_lisp_symbol (sym));
6271
6272 lim = SYMBOL_BLOCK_SIZE;
6273 }
6274}
6275
6276static void
6277visit_vectorlike_root (struct gc_root_visitor visitor, 5731visit_vectorlike_root (struct gc_root_visitor visitor,
6278 struct Lisp_Vector *ptr, 5732 struct Lisp_Vector *ptr,
6279 enum gc_root_type type) 5733 enum gc_root_type type)
@@ -6536,8 +5990,6 @@ garbage_collect (void)
6536 struct gc_root_visitor visitor = { .visit = mark_object_root_visitor }; 5990 struct gc_root_visitor visitor = { .visit = mark_object_root_visitor };
6537 visit_static_gc_roots (visitor); 5991 visit_static_gc_roots (visitor);
6538 5992
6539 mark_pinned_objects ();
6540 mark_pinned_symbols ();
6541 mark_lread (); 5993 mark_lread ();
6542 mark_terminals (); 5994 mark_terminals ();
6543 mark_kboards (); 5995 mark_kboards ();
@@ -6681,10 +6133,6 @@ where each entry has the form (NAME SIZE USED FREE), where:
6681 keeps around for future allocations (maybe because it does not know how 6133 keeps around for future allocations (maybe because it does not know how
6682 to return them to the OS). 6134 to return them to the OS).
6683 6135
6684However, if there was overflow in pure space, and Emacs was dumped
6685using the \"unexec\" method, `garbage-collect' returns nil, because
6686real GC can't be done.
6687
6688Note that calling this function does not guarantee that absolutely all 6136Note that calling this function does not guarantee that absolutely all
6689unreachable objects will be garbage-collected. Emacs uses a 6137unreachable objects will be garbage-collected. Emacs uses a
6690mark-and-sweep garbage collector, but is conservative when it comes to 6138mark-and-sweep garbage collector, but is conservative when it comes to
@@ -7093,10 +6541,6 @@ process_mark_stack (ptrdiff_t base_sp)
7093 { 6541 {
7094 Lisp_Object obj = mark_stack_pop (); 6542 Lisp_Object obj = mark_stack_pop ();
7095 mark_obj: ; 6543 mark_obj: ;
7096 void *po = XPNTR (obj);
7097 if (PURE_P (po))
7098 continue;
7099
7100#if GC_REMEMBER_LAST_MARKED 6544#if GC_REMEMBER_LAST_MARKED
7101 last_marked[last_marked_index++] = obj; 6545 last_marked[last_marked_index++] = obj;
7102 last_marked_index &= LAST_MARKED_SIZE - 1; 6546 last_marked_index &= LAST_MARKED_SIZE - 1;
@@ -7106,6 +6550,7 @@ process_mark_stack (ptrdiff_t base_sp)
7106 we encounter an object we know is bogus. This increases GC time 6550 we encounter an object we know is bogus. This increases GC time
7107 by ~80%. */ 6551 by ~80%. */
7108#if GC_CHECK_MARKED_OBJECTS 6552#if GC_CHECK_MARKED_OBJECTS
6553 void *po = XPNTR (obj);
7109 6554
7110 /* Check that the object pointed to by PO is known to be a Lisp 6555 /* Check that the object pointed to by PO is known to be a Lisp
7111 structure allocated from the heap. */ 6556 structure allocated from the heap. */
@@ -7339,11 +6784,13 @@ process_mark_stack (ptrdiff_t base_sp)
7339 break; 6784 break;
7340 default: emacs_abort (); 6785 default: emacs_abort ();
7341 } 6786 }
7342 if (!PURE_P (XSTRING (ptr->u.s.name))) 6787 set_string_marked (XSTRING (ptr->u.s.name));
7343 set_string_marked (XSTRING (ptr->u.s.name));
7344 mark_interval_tree (string_intervals (ptr->u.s.name)); 6788 mark_interval_tree (string_intervals (ptr->u.s.name));
7345 /* Inner loop to mark next symbol in this bucket, if any. */ 6789 /* Inner loop to mark next symbol in this bucket, if any. */
7346 po = ptr = ptr->u.s.next; 6790 ptr = ptr->u.s.next;
6791#if GC_CHECK_MARKED_OBJECTS
6792 po = ptr;
6793#endif
7347 if (ptr) 6794 if (ptr)
7348 goto nextsym; 6795 goto nextsym;
7349 } 6796 }
@@ -7475,7 +6922,7 @@ survives_gc_p (Lisp_Object obj)
7475 emacs_abort (); 6922 emacs_abort ();
7476 } 6923 }
7477 6924
7478 return survives_p || PURE_P (XPNTR (obj)); 6925 return survives_p;
7479} 6926}
7480 6927
7481 6928
@@ -8043,8 +7490,6 @@ init_alloc_once (void)
8043static void 7490static void
8044init_alloc_once_for_pdumper (void) 7491init_alloc_once_for_pdumper (void)
8045{ 7492{
8046 purebeg = PUREBEG;
8047 pure_size = PURESIZE;
8048 mem_init (); 7493 mem_init ();
8049 7494
8050#ifdef DOUG_LEA_MALLOC 7495#ifdef DOUG_LEA_MALLOC
@@ -8098,7 +7543,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */);
8098 Vgc_cons_percentage = make_float (0.1); 7543 Vgc_cons_percentage = make_float (0.1);
8099 7544
8100 DEFVAR_INT ("pure-bytes-used", pure_bytes_used, 7545 DEFVAR_INT ("pure-bytes-used", pure_bytes_used,
8101 doc: /* Number of bytes of shareable Lisp data allocated so far. */); 7546 doc: /* No longer used. */);
8102 7547
8103 DEFVAR_INT ("cons-cells-consed", cons_cells_consed, 7548 DEFVAR_INT ("cons-cells-consed", cons_cells_consed,
8104 doc: /* Number of cons cells that have been consed so far. */); 7549 doc: /* Number of cons cells that have been consed so far. */);
@@ -8124,9 +7569,11 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */);
8124 7569
8125 DEFVAR_LISP ("purify-flag", Vpurify_flag, 7570 DEFVAR_LISP ("purify-flag", Vpurify_flag,
8126 doc: /* Non-nil means loading Lisp code in order to dump an executable. 7571 doc: /* Non-nil means loading Lisp code in order to dump an executable.
8127This means that certain objects should be allocated in shared (pure) space. 7572This used to mean that certain objects should be allocated in shared
8128It can also be set to a hash-table, in which case this table is used to 7573(pure) space, but objects are not allocated in pure storage any more.
8129do hash-consing of the objects allocated to pure space. */); 7574This flag is still used in a few places, not to decide where objects are
7575allocated, but to know if we're in the preload phase of Emacs's
7576build. */);
8130 7577
8131 DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages, 7578 DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages,
8132 doc: /* Non-nil means display messages at start and end of garbage collection. */); 7579 doc: /* Non-nil means display messages at start and end of garbage collection. */);
@@ -8142,10 +7589,10 @@ do hash-consing of the objects allocated to pure space. */);
8142 /* We build this in advance because if we wait until we need it, we might 7589 /* We build this in advance because if we wait until we need it, we might
8143 not be able to allocate the memory to hold it. */ 7590 not be able to allocate the memory to hold it. */
8144 Vmemory_signal_data 7591 Vmemory_signal_data
8145 = pure_list (Qerror, 7592 = list (Qerror,
8146 build_pure_c_string ("Memory exhausted--use" 7593 build_string ("Memory exhausted--use"
8147 " M-x save-some-buffers then" 7594 " M-x save-some-buffers then"
8148 " exit and restart Emacs")); 7595 " exit and restart Emacs"));
8149 7596
8150 DEFVAR_LISP ("memory-full", Vmemory_full, 7597 DEFVAR_LISP ("memory-full", Vmemory_full,
8151 doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); 7598 doc: /* Non-nil means Emacs cannot get much more Lisp memory. */);
@@ -8195,7 +7642,6 @@ N should be nonnegative. */);
8195 defsubr (&Smake_symbol); 7642 defsubr (&Smake_symbol);
8196 defsubr (&Smake_marker); 7643 defsubr (&Smake_marker);
8197 defsubr (&Smake_finalizer); 7644 defsubr (&Smake_finalizer);
8198 defsubr (&Spurecopy);
8199 defsubr (&Sgarbage_collect); 7645 defsubr (&Sgarbage_collect);
8200 defsubr (&Sgarbage_collect_maybe); 7646 defsubr (&Sgarbage_collect_maybe);
8201 defsubr (&Smemory_info); 7647 defsubr (&Smemory_info);