diff options
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 274 |
1 files changed, 35 insertions, 239 deletions
diff --git a/src/alloc.c b/src/alloc.c index 522547661a5..62d82664ac6 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -34,7 +34,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "bignum.h" #include "dispextern.h" #include "intervals.h" -#include "puresize.h" #include "sheap.h" #include "sysstdio.h" #include "systime.h" @@ -334,33 +333,6 @@ static char *spare_memory[7]; #define SPARE_MEMORY (1 << 14) -/* Initialize it to a nonzero value to force it into data space - (rather than bss space). That way unexec will remap it into text - space (pure), on some systems. We have not implemented the - remapping on more recent systems because this is less important - nowadays than in the days of small memories and timesharing. */ - -EMACS_INT pure[(PURESIZE + sizeof (EMACS_INT) - 1) / sizeof (EMACS_INT)] = {1,}; -#define PUREBEG (char *) pure - -/* Pointer to the pure area, and its size. */ - -static char *purebeg; -static ptrdiff_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 ptrdiff_t pure_bytes_used_before_overflow; - -/* Index in pure at which next pure Lisp object will be allocated.. */ - -static ptrdiff_t pure_bytes_used_lisp; - -/* Number of bytes allocated for non-Lisp objects in pure storage. */ - -static ptrdiff_t pure_bytes_used_non_lisp; - /* If positive, garbage collection is inhibited. Otherwise, zero. */ static intptr_t garbage_collection_inhibited; @@ -561,16 +533,6 @@ Lisp_Object const *staticvec[NSTATICS] int staticidx; -static void *pure_alloc (size_t, int); - -/* Return PTR rounded up to the next multiple of ALIGNMENT. */ - -static void * -pointer_align (void *ptr, int alignment) -{ - return (void *) ROUNDUP ((uintptr_t) ptr, alignment); -} - /* Extract the pointer hidden within O. */ static ATTRIBUTE_NO_SANITIZE_UNDEFINED void * @@ -1152,6 +1114,16 @@ struct ablocks (1 & (intptr_t) ABLOCKS_BUSY (abase) ? abase : ((void **) (abase))[-1]) #endif +/* Return PTR rounded up to the next multiple of ALIGNMENT. */ + +#ifndef USE_ALIGNED_ALLOC +static void * +pointer_align (void *ptr, int alignment) +{ + return (void *) ROUNDUP ((uintptr_t) ptr, alignment); +} +#endif + /* The list of free ablock. */ static struct ablock *free_ablock; @@ -1714,7 +1686,7 @@ string_bytes (struct Lisp_String *s) ptrdiff_t nbytes = (s->u.s.size_byte < 0 ? s->u.s.size & ~ARRAY_MARK_FLAG : s->u.s.size_byte); - if (!PURE_P (s) && !pdumper_object_p (s) && s->u.s.data + if (!pdumper_object_p (s) && s->u.s.data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s))) emacs_abort (); return nbytes; @@ -2529,7 +2501,7 @@ pin_string (Lisp_Object string) unsigned char *data = s->u.s.data; if (!(size > LARGE_STRING_BYTES - || PURE_P (data) || pdumper_object_p (data) + || pdumper_object_p (data) || s->u.s.size_byte == -3)) { eassert (s->u.s.size_byte == -1); @@ -2789,17 +2761,16 @@ list5 (Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, Lisp_Object arg4, } /* Make a list of COUNT Lisp_Objects, where ARG is the first one. - Use CONS to construct the pairs. AP has any remaining args. */ + AP has any remaining args. */ static Lisp_Object -cons_listn (ptrdiff_t count, Lisp_Object arg, - Lisp_Object (*cons) (Lisp_Object, Lisp_Object), va_list ap) +cons_listn (ptrdiff_t count, Lisp_Object arg, va_list ap) { eassume (0 < count); - Lisp_Object val = cons (arg, Qnil); + Lisp_Object val = Fcons (arg, Qnil); Lisp_Object tail = val; for (ptrdiff_t i = 1; i < count; i++) { - Lisp_Object elem = cons (va_arg (ap, Lisp_Object), Qnil); + Lisp_Object elem = Fcons (va_arg (ap, Lisp_Object), Qnil); XSETCDR (tail, elem); tail = elem; } @@ -2812,18 +2783,7 @@ listn (ptrdiff_t count, Lisp_Object arg1, ...) { va_list ap; va_start (ap, arg1); - Lisp_Object val = cons_listn (count, arg1, Fcons, ap); - va_end (ap); - return val; -} - -/* Make a pure list of COUNT Lisp_Objects, where ARG1 is the first one. */ -Lisp_Object -pure_listn (ptrdiff_t count, Lisp_Object arg1, ...) -{ - va_list ap; - va_start (ap, arg1); - Lisp_Object val = cons_listn (count, arg1, pure_cons, ap); + Lisp_Object val = cons_listn (count, arg1, ap); va_end (ap); return val; } @@ -2989,7 +2949,7 @@ static struct Lisp_Vector *vector_free_lists[VECTOR_MAX_FREE_LIST_INDEX]; static struct large_vector *large_vectors; -/* The only vector with 0 slots, allocated from pure space. */ +/* The only vector with 0 slots. */ Lisp_Object zero_vector; @@ -3628,13 +3588,6 @@ struct symbol_block static struct symbol_block *symbol_block; static int symbol_block_index = SYMBOL_BLOCK_SIZE; -/* Pointer to the first symbol_block that contains pinned symbols. - Tests for 24.4 showed that at dump-time, Emacs contains about 15K symbols, - 10K of which are pinned (and all but 250 of them are interned in obarray), - whereas a "typical session" has in the order of 30K symbols. - `symbol_block_pinned' lets mark_pinned_symbols scan only 15K symbols rather - than 30K to find the 10K symbols we need to mark. */ -static struct symbol_block *symbol_block_pinned; /* List of free symbols. */ @@ -3660,7 +3613,6 @@ init_symbol (Lisp_Object val, Lisp_Object name) p->u.s.interned = SYMBOL_UNINTERNED; p->u.s.trapped_write = SYMBOL_UNTRAPPED_WRITE; p->u.s.declared_special = false; - p->u.s.pinned = false; } DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0, @@ -5268,8 +5220,6 @@ valid_lisp_object_p (Lisp_Object obj) return 1; void *p = XPNTR (obj); - if (PURE_P (p)) - return 1; if (BARE_SYMBOL_P (obj) && c_symbol_p (p)) return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; @@ -5325,121 +5275,8 @@ valid_lisp_object_p (Lisp_Object obj) return 0; } -/*********************************************************************** - Pure Storage Management - ***********************************************************************/ - -/* Allocate room for SIZE bytes from pure Lisp storage and return a - pointer to it. TYPE is the Lisp type for which the memory is - allocated. TYPE < 0 means it's not used for a Lisp object, - and that the result should have an alignment of -TYPE. - - The bytes are initially zero. - - If pure space is exhausted, allocate space from the heap. This is - merely an expedient to let Emacs warn that pure space was exhausted - and that Emacs should be rebuilt with a larger pure space. */ - -static void * -pure_alloc (size_t size, int type) -{ - void *result; - - again: - if (type >= 0) - { - /* Allocate space for a Lisp object from the beginning of the free - space with taking account of alignment. */ - result = pointer_align (purebeg + pure_bytes_used_lisp, LISP_ALIGNMENT); - pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size; - } - else - { - /* Allocate space for a non-Lisp object from the end of the free - space. */ - ptrdiff_t unaligned_non_lisp = pure_bytes_used_non_lisp + size; - char *unaligned = purebeg + pure_size - unaligned_non_lisp; - int decr = (intptr_t) unaligned & (-1 - type); - pure_bytes_used_non_lisp = unaligned_non_lisp + decr; - result = unaligned - decr; - } - pure_bytes_used = pure_bytes_used_lisp + pure_bytes_used_non_lisp; - - if (pure_bytes_used <= pure_size) - return result; - - /* Don't allocate a large amount here, - because it might get mmap'd and then its address - might not be usable. */ - int small_amount = 10000; - eassert (size <= small_amount - LISP_ALIGNMENT); - purebeg = xzalloc (small_amount); - pure_size = small_amount; - pure_bytes_used_before_overflow += pure_bytes_used - size; - pure_bytes_used = 0; - pure_bytes_used_lisp = pure_bytes_used_non_lisp = 0; - - /* Can't GC if pure storage overflowed because we can't determine - if something is a pure object or not. */ - garbage_collection_inhibited++; - goto again; -} - - -#ifdef HAVE_UNEXEC - -/* Print a warning if PURESIZE is too small. */ - -void -check_pure_size (void) -{ - if (pure_bytes_used_before_overflow) - message (("emacs:0:Pure Lisp storage overflow (approx. %"pI"d" - " bytes needed)"), - pure_bytes_used + pure_bytes_used_before_overflow); -} -#endif - - -/* Return a string allocated in pure space. DATA is a buffer holding - NCHARS characters, and NBYTES bytes of string data. MULTIBYTE - means make the result string multibyte. - - Must get an error if pure storage is full, since if it cannot hold - a large string it may be able to hold conses that point to that - string; then the string is not protected from gc. */ - -Lisp_Object -make_pure_string (const char *data, - ptrdiff_t nchars, ptrdiff_t nbytes, bool multibyte) -{ - if (multibyte) - return make_multibyte_string (data, nchars, nbytes); - else - return make_unibyte_string (data, nchars); -} - -/* Return a string allocated in pure space. Do not - allocate the string data, just point to DATA. */ - -Lisp_Object -make_pure_c_string (const char *data, ptrdiff_t nchars) -{ - return make_unibyte_string (data, nchars); -} - static Lisp_Object purecopy (Lisp_Object obj); -/* Return a cons allocated from pure space. Give it pure copies - of CAR as car and CDR as cdr. */ - -Lisp_Object -pure_cons (Lisp_Object car, Lisp_Object cdr) -{ - return Fcons (car, cdr); -} - - DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. Recursively copies contents of vectors and cons cells. @@ -5455,19 +5292,10 @@ Does not copy symbols. Copies strings without text properties. */) return purecopy (obj); } -/* Pinned objects are marked before every GC cycle. */ -static struct pinned_object -{ - Lisp_Object object; - struct pinned_object *next; -} *pinned_objects; - static Lisp_Object purecopy (Lisp_Object obj) { - if (FIXNUMP (obj) - || (! SYMBOLP (obj) && PURE_P (XPNTR (obj))) - || SUBRP (obj)) + if (FIXNUMP (obj) || SUBRP (obj)) return obj; /* Already pure. */ if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ @@ -5475,12 +5303,12 @@ purecopy (Lisp_Object obj) Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); if (!NILP (tmp)) return tmp; + Fputhash (obj, obj, Vpurify_flag); } return obj; } - /*********************************************************************** Protection from GC @@ -5672,31 +5500,6 @@ compact_undo_list (Lisp_Object list) } static void -mark_pinned_objects (void) -{ - for (struct pinned_object *pobj = pinned_objects; pobj; pobj = pobj->next) - mark_object (pobj->object); -} - -static void -mark_pinned_symbols (void) -{ - struct symbol_block *sblk; - int lim = (symbol_block_pinned == symbol_block - ? symbol_block_index : SYMBOL_BLOCK_SIZE); - - for (sblk = symbol_block_pinned; sblk; sblk = sblk->next) - { - struct Lisp_Symbol *sym = sblk->symbols, *end = sym + lim; - for (; sym < end; ++sym) - if (sym->u.s.pinned) - mark_object (make_lisp_symbol (sym)); - - lim = SYMBOL_BLOCK_SIZE; - } -} - -static void visit_vectorlike_root (struct gc_root_visitor visitor, struct Lisp_Vector *ptr, enum gc_root_type type) @@ -5960,8 +5763,6 @@ garbage_collect (void) struct gc_root_visitor visitor = { .visit = mark_object_root_visitor }; visit_static_gc_roots (visitor); - mark_pinned_objects (); - mark_pinned_symbols (); mark_lread (); mark_terminals (); mark_kboards (); @@ -6088,10 +5889,6 @@ where each entry has the form (NAME SIZE USED FREE), where: keeps around for future allocations (maybe because it does not know how to return them to the OS). -However, if there was overflow in pure space, and Emacs was dumped -using the \"unexec\" method, `garbage-collect' returns nil, because -real GC can't be done. - Note that calling this function does not guarantee that absolutely all unreachable objects will be garbage-collected. Emacs uses a mark-and-sweep garbage collector, but is conservative when it comes to @@ -6519,8 +6316,6 @@ process_mark_stack (ptrdiff_t base_sp) Lisp_Object obj = mark_stack_pop (); mark_obj: ; void *po = XPNTR (obj); - if (PURE_P (po)) - continue; #if GC_REMEMBER_LAST_MARKED last_marked[last_marked_index++] = obj; @@ -6746,8 +6541,7 @@ process_mark_stack (ptrdiff_t base_sp) break; default: emacs_abort (); } - if (!PURE_P (XSTRING (ptr->u.s.name))) - set_string_marked (XSTRING (ptr->u.s.name)); + set_string_marked (XSTRING (ptr->u.s.name)); mark_interval_tree (string_intervals (ptr->u.s.name)); /* Inner loop to mark next symbol in this bucket, if any. */ po = ptr = ptr->u.s.next; @@ -6881,7 +6675,7 @@ survives_gc_p (Lisp_Object obj) emacs_abort (); } - return survives_p || PURE_P (XPNTR (obj)); + return survives_p; } @@ -7482,7 +7276,7 @@ init_alloc_once (void) { gc_cons_threshold = GC_DEFAULT_THRESHOLD; /* Even though Qt's contents are not set up, its address is known. */ - Vpurify_flag = Qt; + Vpurify_flag = Qt; /* FIXME: Redundant with setting in lread.c. */ PDUMPER_REMEMBER_SCALAR (buffer_defaults.header); PDUMPER_REMEMBER_SCALAR (buffer_local_symbols.header); @@ -7501,8 +7295,6 @@ init_alloc_once (void) static void init_alloc_once_for_pdumper (void) { - purebeg = PUREBEG; - pure_size = PURESIZE; mem_init (); #ifdef DOUG_LEA_MALLOC @@ -7546,7 +7338,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); Vgc_cons_percentage = make_float (0.1); DEFVAR_INT ("pure-bytes-used", pure_bytes_used, - doc: /* Number of bytes of shareable Lisp data allocated so far. */); + doc: /* No longer used. */); DEFVAR_INT ("cons-cells-consed", cons_cells_consed, doc: /* Number of cons cells that have been consed so far. */); @@ -7572,9 +7364,13 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); DEFVAR_LISP ("purify-flag", Vpurify_flag, doc: /* Non-nil means loading Lisp code in order to dump an executable. -This means that certain objects should be allocated in shared (pure) space. -It can also be set to a hash-table, in which case this table is used to -do hash-consing of the objects allocated to pure space. */); +This used to mean that certain objects should be allocated in shared (pure) +space. It can also be set to a hash-table, in which case this table is used +to do hash-consing of the objects allocated to pure space. +The hash-consing may still apply, but objects are not allocated in purespace +any more. +This flag is still used in a few places not to decide where objects are +allocated but to know if we're in the preload phase of Emacs's build. */); DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages, doc: /* Non-nil means display messages at start and end of garbage collection. */); @@ -7590,10 +7386,10 @@ do hash-consing of the objects allocated to pure space. */); /* 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. */ Vmemory_signal_data - = pure_list (Qerror, - build_pure_c_string ("Memory exhausted--use" - " M-x save-some-buffers then" - " exit and restart Emacs")); + = list (Qerror, + build_string ("Memory exhausted--use" + " M-x save-some-buffers then" + " exit and restart Emacs")); DEFVAR_LISP ("memory-full", Vmemory_full, doc: /* Non-nil means Emacs cannot get much more Lisp memory. */); |