From: Pip Cet Date: Tue, 20 Aug 2024 18:52:35 +0000 (+0000) Subject: Pure storage removal: Main part X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=a45dce05be8678c8bd31f06cdad03c6978ee7f44;p=emacs.git Pure storage removal: Main part * src/alloc.c (pure, PUREBEG, purebeg, pure_size) (pure_bytes_used_before_overflow, pure_bytes_used_lisp) (pure_bytes_used_non_lisp): Remove definitions. (init_strings): Make empty strings impure. (cons_listn): Drop 'cons' argument. (pure_listn): Remove function. (init_vectors): Allocate zero vector manually to avoid freelist issues. (pure_alloc, check_pure_size, find_string_data_in_pure) (make_pure_string, make_pure_c_string, pure_cons, make_pure_float) (make_pure_bignum, make_pure_vector, purecopy_hash_table): Remove functions. (purecopy): Reduce to hash consing our argument. (init_alloc_once_for_pdumper): Adjust to lack of pure space. (pure-bytes-used): Adjust docstring to mark as obsolete. (purify-flag): Keep for hash consing, but adjust docstring. * src/bytecode.c: * src/comp.c: Don't include "puresize.h". * src/conf_post.h (SYSTEM_PURESIZE_EXTRA): Remove definition. * src/data.c (pure_write_error): Remove function. * src/deps.mk: Remove puresize.h dependency throughout. * src/emacs.c: * src/fns.c: * src/intervals.c: * src/keymap.c: Don't include "puresize.h". * src/lisp.h (struct Lisp_Hash_Table): Adjust comment. (pure_listn, pure_list, build_pure_c_string): Remove. * src/w32heap.c (FREEABLE_P): Don't do use 'dumped_data'. (malloc_before_dump, realloc_before_dump, free_before_dump): Remove functions. * src/w32heap.h: Adjust prototype. * lisp/loadup.el: * lisp/startup.el: Remove purespace code. (cherry picked from commit f84ccff5a6275782a37534ed55b706db35f228ac) --- diff --git a/lisp/loadup.el b/lisp/loadup.el index c6b20697a3a..8b234d91dd6 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el @@ -184,12 +184,6 @@ (file-error (load "ldefs-boot.el"))) -(let ((new (make-hash-table :test #'equal))) - ;; Now that loaddefs has populated definition-prefixes, purify its contents. - (maphash (lambda (k v) (puthash (purecopy k) (purecopy v) new)) - definition-prefixes) - (setq definition-prefixes new)) - (load "button") ;After loaddefs, because of define-minor-mode! (when (interpreted-function-p (symbol-function 'add-hook)) @@ -503,11 +497,6 @@ lost after dumping"))) ;; Avoid storing references to build directory in the binary. (setq custom-current-group-alist nil) -;; We keep the load-history data in PURE space. -;; Make sure that the spine of the list is not in pure space because it can -;; be destructively mutated in lread.c:build_load_history. -(setq load-history (mapcar #'purecopy load-history)) - (set-buffer-modified-p nil) (remove-hook 'after-load-functions (lambda (_) (garbage-collect))) @@ -659,8 +648,7 @@ directory got moved. This is set to be a pair in the form of: (dump-emacs-portable (expand-file-name output invocation-directory)) (dump-emacs output (if (eq system-type 'ms-dos) "temacs.exe" - "temacs")) - (message "%d pure bytes used" pure-bytes-used)) + "temacs"))) (setq success t)) (unless success (ignore-errors diff --git a/lisp/startup.el b/lisp/startup.el index a55ff6e89e6..34e74c370a6 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -355,7 +355,7 @@ looked for. Setting `init-file-user' does not prevent Emacs from loading `site-start.el'. The only way to do that is to use `--no-site-file'.") -(defcustom site-run-file (purecopy "site-start") +(defcustom site-run-file "site-start" "File containing site-wide run-time initializations. This file is loaded at run-time before `user-init-file'. It contains inits that need to be in place for the entire site, but which, due to @@ -430,10 +430,6 @@ from being initialized." (defvar pure-space-overflow nil "Non-nil if building Emacs overflowed pure space.") -(defvar pure-space-overflow-message (purecopy "\ -Warning Warning!!! Pure space overflow !!!Warning Warning -\(See the node Pure Storage in the Lisp manual for details.)\n")) - (defcustom tutorial-directory (file-name-as-directory (expand-file-name "tutorials" data-directory)) "Directory containing the Emacs TUTORIAL files." @@ -1696,11 +1692,11 @@ Changed settings will be marked as \"CHANGED outside of Customize\"." `((changed ((t :background ,color))))) (put 'cursor 'face-modified t)))) -(defcustom initial-scratch-message (purecopy "\ +(defcustom initial-scratch-message "\ ;; This buffer is for text that is not saved, and for Lisp evaluation. ;; To create a file, visit it with `\\[find-file]' and enter text in its buffer. -") +" "Initial documentation displayed in *scratch* buffer at startup. If this is nil, no message will be displayed." :type '(choice (text :tag "Message") @@ -2099,8 +2095,6 @@ splash screen in another window." (erase-buffer) (setq default-directory command-line-default-directory) (make-local-variable 'startup-screen-inhibit-startup-screen) - (if pure-space-overflow - (insert pure-space-overflow-message)) ;; Insert the permissions notice if the user has yet to grant Emacs ;; storage permissions. (when (fboundp 'android-before-splash-screen) @@ -2142,8 +2136,6 @@ splash screen in another window." (setq buffer-undo-list t) (let ((inhibit-read-only t)) (erase-buffer) - (if pure-space-overflow - (insert pure-space-overflow-message)) (fancy-splash-head) (dolist (text fancy-about-text) (apply #'fancy-splash-insert text) @@ -2209,8 +2201,6 @@ splash screen in another window." (setq default-directory command-line-default-directory) (setq-local tab-width 8) - (if pure-space-overflow - (insert pure-space-overflow-message)) ;; Insert the permissions notice if the user has yet to grant ;; Emacs storage permissions. (when (fboundp 'android-before-splash-screen) @@ -2532,17 +2522,6 @@ A fancy display is used on graphic displays, normal otherwise." (defun command-line-1 (args-left) "A subroutine of `command-line'." (display-startup-echo-area-message) - (when (and pure-space-overflow - (not noninteractive) - ;; If we were dumped with pdumper, we don't care about - ;; pure-space overflow. - (or (not (fboundp 'pdumper-stats)) - (null (pdumper-stats)))) - (display-warning - 'initialization - "Building Emacs overflowed pure space.\ - (See the node Pure Storage in the Lisp manual for details.)" - :warning)) ;; `displayable-buffers' is a list of buffers that may be displayed, ;; which includes files parsed from the command line arguments and diff --git a/src/alloc.c b/src/alloc.c index 81a19dfc8d4..dcc5f567013 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -33,7 +33,6 @@ along with GNU Emacs. If not, see . */ #include "bignum.h" #include "dispextern.h" #include "intervals.h" -#include "puresize.h" #include "sysstdio.h" #include "systime.h" #include "character.h" @@ -380,33 +379,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. */ intptr_t garbage_collection_inhibited; @@ -457,7 +429,6 @@ static struct Lisp_Vector *allocate_clear_vector (ptrdiff_t, bool); static void unchain_finalizer (struct Lisp_Finalizer *); static void mark_terminals (void); static void gc_sweep (void); -static Lisp_Object make_pure_vector (ptrdiff_t); static void mark_buffer (struct buffer *); #if !defined REL_ALLOC || defined SYSTEM_MALLOC @@ -578,15 +549,13 @@ Lisp_Object const *staticvec[NSTATICS]; int staticidx; -static void *pure_alloc (size_t, int); - -/* Return PTR rounded up to the next multiple of ALIGNMENT. */ - +#ifndef HAVE_ALIGNED_ALLOC static void * pointer_align (void *ptr, int alignment) { return (void *) ROUNDUP ((uintptr_t) ptr, alignment); } +#endif /* Extract the pointer hidden within O. */ @@ -1644,12 +1613,30 @@ static ptrdiff_t const STRING_BYTES_MAX = /* Initialize string allocation. Called from init_alloc_once. */ +static struct Lisp_String *allocate_string (void); +static void +allocate_string_data (struct Lisp_String *s, + EMACS_INT nchars, EMACS_INT nbytes, bool clearit, + bool immovable); + static void init_strings (void) { - empty_unibyte_string = make_pure_string ("", 0, 0, 0); + /* String allocation code will return one of 'empty_*ibyte_string' + when asked to construct a new 0-length string, so in order to build + those special cases, we have to do it "by hand". */ + struct Lisp_String *ems = allocate_string (); + struct Lisp_String *eus = allocate_string (); + ems->u.s.intervals = NULL; + eus->u.s.intervals = NULL; + allocate_string_data (ems, 0, 0, false, false); + allocate_string_data (eus, 0, 0, false, false); + /* We can't use 'STRING_SET_UNIBYTE' because this one includes a hack + * to redirect its arg to 'empty_unibyte_string' when nbytes == 0. */ + eus->u.s.size_byte = -1; + XSETSTRING (empty_multibyte_string, ems); + XSETSTRING (empty_unibyte_string, eus); staticpro (&empty_unibyte_string); - empty_multibyte_string = make_pure_string ("", 0, 0, 1); staticpro (&empty_multibyte_string); } @@ -2852,17 +2839,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; } @@ -2875,18 +2861,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; } @@ -3067,7 +3042,7 @@ static ptrdiff_t last_inserted_vector_free_idx = VECTOR_FREE_LIST_ARRAY_SIZE; 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; @@ -3119,14 +3094,8 @@ allocate_vector_block (void) return block; } -/* Called once to initialize vector allocation. */ - -static void -init_vectors (void) -{ - zero_vector = make_pure_vector (0); - staticpro (&zero_vector); -} +static struct Lisp_Vector * +allocate_vector_from_block (ptrdiff_t nbytes); /* Memory footprint in bytes of a pseudovector other than a bool-vector. */ static ptrdiff_t @@ -3139,6 +3108,31 @@ pseudovector_nbytes (const union vectorlike_header *hdr) return vroundup (header_size + word_size * nwords); } +/* Called once to initialize vector allocation. */ + +static void +init_vectors (void) +{ + /* The normal vector allocation code refuses to allocate a 0-length vector + because we use the first field of vectors internally when they're on + the free list, so we can't put a zero-length vector on the free list. + This is not a problem for 'zero_vector' since it's always reachable. + An alternative approach would be to allocate zero_vector outside of the + normal heap, e.g. as a static object, and then to "hide" it from the GC, + for example by marking it by hand at the beginning of the GC and unmarking + it by hand at the end. */ + struct vector_block *block = allocate_vector_block (); + struct Lisp_Vector *zv = (struct Lisp_Vector *)block->data; + zv->header.size = 0; + ssize_t nbytes = pseudovector_nbytes (&zv->header); + ssize_t restbytes = VECTOR_BLOCK_BYTES - nbytes; + eassert (restbytes % roundup_size == 0); + setup_on_free_list (ADVANCE (zv, nbytes), restbytes); + + zero_vector = make_lisp_ptr (zv, Lisp_Vectorlike); + staticpro (&zero_vector); +} + /* Allocate vector from a vector block. */ static struct Lisp_Vector * @@ -5585,320 +5579,8 @@ hash_table_free_bytes (void *p, ptrdiff_t nbytes) } -/*********************************************************************** - 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; - static bool pure_overflow_warned = false; - - 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; - - if (!pure_overflow_warned) - { - message ("Pure Lisp storage overflowed"); - pure_overflow_warned = true; - } - - /* 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; -} - -/* 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. %jd" - " bytes needed)"), - pure_bytes_used + pure_bytes_used_before_overflow); -} - -/* Find the byte sequence {DATA[0], ..., DATA[NBYTES-1], '\0'} from - the non-Lisp data pool of the pure storage, and return its start - address. Return NULL if not found. */ - -static char * -find_string_data_in_pure (const char *data, ptrdiff_t nbytes) -{ - int i; - ptrdiff_t skip, bm_skip[256], last_char_skip, infinity, start, start_max; - const unsigned char *p; - char *non_lisp_beg; - - if (pure_bytes_used_non_lisp <= nbytes) - return NULL; - - /* The Android GCC generates code like: - - 0xa539e755 <+52>: lea 0x430(%esp),%esi -=> 0xa539e75c <+59>: movdqa %xmm0,0x0(%ebp) - 0xa539e761 <+64>: add $0x10,%ebp - - but data is not aligned appropriately, so a GP fault results. */ - -#if defined __i386__ \ - && defined HAVE_ANDROID \ - && !defined ANDROID_STUBIFY \ - && !defined (__clang__) - if ((intptr_t) data & 15) - return NULL; -#endif - - /* Set up the Boyer-Moore table. */ - skip = nbytes + 1; - for (i = 0; i < 256; i++) - bm_skip[i] = skip; - - p = (const unsigned char *) data; - while (--skip > 0) - bm_skip[*p++] = skip; - - last_char_skip = bm_skip['\0']; - - non_lisp_beg = purebeg + pure_size - pure_bytes_used_non_lisp; - start_max = pure_bytes_used_non_lisp - (nbytes + 1); - - /* See the comments in the function `boyer_moore' (search.c) for the - use of `infinity'. */ - infinity = pure_bytes_used_non_lisp + 1; - bm_skip['\0'] = infinity; - - p = (const unsigned char *) non_lisp_beg + nbytes; - start = 0; - do - { - /* Check the last character (== '\0'). */ - do - { - start += bm_skip[*(p + start)]; - } - while (start <= start_max); - - if (start < infinity) - /* Couldn't find the last character. */ - return NULL; - - /* No less than `infinity' means we could find the last - character at `p[start - infinity]'. */ - start -= infinity; - - /* Check the remaining characters. */ - if (memcmp (data, non_lisp_beg + start, nbytes) == 0) - /* Found. */ - return non_lisp_beg + start; - - start += last_char_skip; - } - while (start <= start_max); - - return NULL; -} - - -/* 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) -{ - Lisp_Object string; - struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->u.s.data = (unsigned char *) find_string_data_in_pure (data, nbytes); - if (s->u.s.data == NULL) - { - s->u.s.data = pure_alloc (nbytes + 1, -1); - memcpy (s->u.s.data, data, nbytes); - s->u.s.data[nbytes] = '\0'; - } - s->u.s.size = nchars; - s->u.s.size_byte = multibyte ? nbytes : -1; - s->u.s.intervals = NULL; - XSETSTRING (string, s); - return string; -} - -/* 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) -{ - Lisp_Object string; - struct Lisp_String *s = pure_alloc (sizeof *s, Lisp_String); - s->u.s.size = nchars; - s->u.s.size_byte = -2; - s->u.s.data = (unsigned char *) data; - s->u.s.intervals = NULL; - XSETSTRING (string, s); - return string; -} - 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) -{ - Lisp_Object new; - struct Lisp_Cons *p = pure_alloc (sizeof *p, Lisp_Cons); - XSETCONS (new, p); - XSETCAR (new, purecopy (car)); - XSETCDR (new, purecopy (cdr)); - return new; -} - - -/* Value is a float object with value NUM allocated from pure space. */ - -static Lisp_Object -make_pure_float (double num) -{ - Lisp_Object new; - struct Lisp_Float *p = pure_alloc (sizeof *p, Lisp_Float); - XSETFLOAT (new, p); - XFLOAT_INIT (new, num); - return new; -} - -/* Value is a bignum object with value VALUE allocated from pure - space. */ - -static Lisp_Object -make_pure_bignum (Lisp_Object value) -{ - mpz_t const *n = xbignum_val (value); - size_t i, nlimbs = mpz_size (*n); - size_t nbytes = nlimbs * sizeof (mp_limb_t); - mp_limb_t *pure_limbs; - mp_size_t new_size; - - struct Lisp_Bignum *b = pure_alloc (sizeof *b, Lisp_Vectorlike); - XSETPVECTYPESIZE (b, PVEC_BIGNUM, 0, VECSIZE (struct Lisp_Bignum)); - - int limb_alignment = alignof (mp_limb_t); - pure_limbs = pure_alloc (nbytes, - limb_alignment); - for (i = 0; i < nlimbs; ++i) - pure_limbs[i] = mpz_getlimbn (*n, i); - - new_size = nlimbs; - if (mpz_sgn (*n) < 0) - new_size = -new_size; - - mpz_roinit_n (b->value, pure_limbs, new_size); - - return make_lisp_ptr (b, Lisp_Vectorlike); -} - -/* Return a vector with room for LEN Lisp_Objects allocated from - pure space. */ - -static Lisp_Object -make_pure_vector (ptrdiff_t len) -{ - Lisp_Object new; - size_t size = header_size + len * word_size; - struct Lisp_Vector *p = pure_alloc (size, Lisp_Vectorlike); - XSETVECTOR (new, p); - XVECTOR (new)->header.size = len; - return new; -} - -/* Copy all contents and parameters of TABLE to a new table allocated - from pure space, return the purified table. */ -static struct Lisp_Hash_Table * -purecopy_hash_table (struct Lisp_Hash_Table *table) -{ - eassert (table->weakness == Weak_None); - eassert (table->purecopy); - - struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); - *pure = *table; - pure->mutable = false; - - if (table->table_size > 0) - { - ptrdiff_t hash_bytes = table->table_size * sizeof *table->hash; - pure->hash = pure_alloc (hash_bytes, -(int)sizeof *table->hash); - memcpy (pure->hash, table->hash, hash_bytes); - - ptrdiff_t next_bytes = table->table_size * sizeof *table->next; - pure->next = pure_alloc (next_bytes, -(int)sizeof *table->next); - memcpy (pure->next, table->next, next_bytes); - - ptrdiff_t nvalues = table->table_size * 2; - ptrdiff_t kv_bytes = nvalues * sizeof *table->key_and_value; - pure->key_and_value = pure_alloc (kv_bytes, - -(int)sizeof *table->key_and_value); - for (ptrdiff_t i = 0; i < nvalues; i++) - pure->key_and_value[i] = purecopy (table->key_and_value[i]); - - ptrdiff_t index_bytes = hash_table_index_size (table) - * sizeof *table->index; - pure->index = pure_alloc (index_bytes, -(int)sizeof *table->index); - memcpy (pure->index, table->index, index_bytes); - } - - return pure; -} - 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. @@ -5924,89 +5606,17 @@ static struct pinned_object static Lisp_Object purecopy (Lisp_Object obj) { - if (FIXNUMP (obj) - || (! SYMBOLP (obj) && PURE_P (XPNTR (obj))) - || SUBRP (obj)) - return obj; /* Already pure. */ - - if (STRINGP (obj) && XSTRING (obj)->u.s.intervals) - message_with_string ("Dropping text-properties while making string `%s' pure", - obj, true); + if (FIXNUMP (obj) || SUBRP (obj)) + return obj; /* No need to hash. */ if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ { Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil); if (!NILP (tmp)) return tmp; + Fputhash (obj, obj, Vpurify_flag); } - if (CONSP (obj)) - obj = pure_cons (XCAR (obj), XCDR (obj)); - else if (FLOATP (obj)) - obj = make_pure_float (XFLOAT_DATA (obj)); - else if (STRINGP (obj)) - obj = make_pure_string (SSDATA (obj), SCHARS (obj), - SBYTES (obj), - STRING_MULTIBYTE (obj)); - else if (HASH_TABLE_P (obj)) - { - struct Lisp_Hash_Table *table = XHASH_TABLE (obj); - /* Do not purify hash tables which haven't been defined with - :purecopy as non-nil or are weak - they aren't guaranteed to - not change. */ - if (table->weakness != Weak_None || !table->purecopy) - { - /* Instead, add the hash table to the list of pinned objects, - so that it will be marked during GC. */ - struct pinned_object *o = xmalloc (sizeof *o); - o->object = obj; - o->next = pinned_objects; - pinned_objects = o; - return obj; /* Don't hash cons it. */ - } - - obj = make_lisp_hash_table (purecopy_hash_table (table)); - } - else if (CLOSUREP (obj) || VECTORP (obj) || RECORDP (obj)) - { - struct Lisp_Vector *objp = XVECTOR (obj); - ptrdiff_t nbytes = vector_nbytes (objp); - struct Lisp_Vector *vec = pure_alloc (nbytes, Lisp_Vectorlike); - register ptrdiff_t i; - ptrdiff_t size = ASIZE (obj); - if (size & PSEUDOVECTOR_FLAG) - size &= PSEUDOVECTOR_SIZE_MASK; - memcpy (vec, objp, nbytes); - for (i = 0; i < size; i++) - vec->contents[i] = purecopy (vec->contents[i]); - /* Byte code strings must be pinned. */ - if (CLOSUREP (obj) && size >= 2 && STRINGP (vec->contents[1]) - && !STRING_MULTIBYTE (vec->contents[1])) - pin_string (vec->contents[1]); - XSETVECTOR (obj, vec); - } - else if (BARE_SYMBOL_P (obj)) - { - if (!XBARE_SYMBOL (obj)->u.s.pinned && !c_symbol_p (XBARE_SYMBOL (obj))) - { /* We can't purify them, but they appear in many pure objects. - Mark them as `pinned' so we know to mark them at every GC cycle. */ - XBARE_SYMBOL (obj)->u.s.pinned = true; - symbol_block_pinned = symbol_block; - } - /* Don't hash-cons it. */ - return obj; - } - else if (BIGNUMP (obj)) - obj = make_pure_bignum (obj); - else - { - AUTO_STRING (fmt, "Don't know how to purify: %S"); - Fsignal (Qerror, list1 (CALLN (Fformat, fmt, obj))); - } - - if (HASH_TABLE_P (Vpurify_flag)) /* Hash consing. */ - Fputhash (obj, obj, Vpurify_flag); - return obj; } @@ -8025,8 +7635,6 @@ init_alloc_once (void) static void init_alloc_once_for_pdumper (void) { - purebeg = PUREBEG; - pure_size = PURESIZE; mem_init (); #ifdef DOUG_LEA_MALLOC @@ -8080,7 +7688,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. */); @@ -8106,9 +7714,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 still applies, but objects are not allocated in pure +storage 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. */); diff --git a/src/bytecode.c b/src/bytecode.c index d62d7d067b1..b2d77ef03a6 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "syntax.h" #include "window.h" -#include "puresize.h" /* Define BYTE_CODE_SAFE true to enable some minor sanity checking, useful for debugging the byte compiler. It defaults to false. */ diff --git a/src/comp.c b/src/comp.c index ce59fdd80e3..25b00f31f1e 100644 --- a/src/comp.c +++ b/src/comp.c @@ -31,7 +31,6 @@ along with GNU Emacs. If not, see . */ #include #include -#include "puresize.h" #include "window.h" #include "dynlib.h" #include "buffer.h" diff --git a/src/conf_post.h b/src/conf_post.h index 29d14bf672b..ccf30a5e7e9 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -157,41 +157,8 @@ You lose; /* Emacs for DOS must be compiled with DJGPP */ /* DATA_START is needed by vm-limit.c and unexcoff.c. */ #define DATA_START (&etext + 1) - -/* Define one of these for easier conditionals. */ -#ifdef HAVE_X_WINDOWS -/* We need a little extra space, see ../../lisp/loadup.el and the - commentary below, in the non-X branch. The 140KB number was - measured on GNU/Linux and on MS-Windows. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+140000) -#else -/* We need a little extra space, see ../../lisp/loadup.el. - As of 20091024, DOS-specific files use up 62KB of pure space. But - overall, we end up wasting 130KB of pure space, because - BASE_PURESIZE starts at 1.47MB, while we need only 1.3MB (including - non-DOS specific files and load history; the latter is about 55K, - but depends on the depth of the top-level Emacs directory in the - directory tree). Given the unknown policy of different DPMI - hosts regarding loading of untouched pages, I'm not going to risk - enlarging Emacs footprint by another 100+ KBytes. */ -#define SYSTEM_PURESIZE_EXTRA (-170000+90000) -#endif #endif /* MSDOS */ -/* macOS / GNUstep need a bit more pure memory. Of the existing knobs, - SYSTEM_PURESIZE_EXTRA seems like the least likely to cause problems. */ -#ifdef HAVE_NS -#if defined NS_IMPL_GNUSTEP -# define SYSTEM_PURESIZE_EXTRA 30000 -#elif defined DARWIN_OS -# define SYSTEM_PURESIZE_EXTRA 200000 -#endif -#endif - -#ifdef CYGWIN -#define SYSTEM_PURESIZE_EXTRA 50000 -#endif - #if defined HAVE_NTGUI && !defined DebPrint # ifdef EMACSDEBUG extern void _DebPrint (const char *fmt, ...); diff --git a/src/data.c b/src/data.c index dcaa5756ebe..6df1276e4a3 100644 --- a/src/data.c +++ b/src/data.c @@ -27,7 +27,6 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "bignum.h" -#include "puresize.h" #include "character.h" #include "buffer.h" #include "keyboard.h" @@ -135,12 +134,6 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object value) xsignal2 (Qwrong_type_argument, predicate, value); } -void -pure_write_error (Lisp_Object obj) -{ - xsignal2 (Qerror, build_string ("Attempt to modify read-only object"), obj); -} - void args_out_of_range (Lisp_Object a1, Lisp_Object a2) { diff --git a/src/deps.mk b/src/deps.mk index 4acce04c04b..ffaa6b7f775 100644 --- a/src/deps.mk +++ b/src/deps.mk @@ -132,10 +132,10 @@ insdel.o: insdel.c window.h buffer.h $(INTERVALS_H) blockinput.h character.h \ keyboard.o: keyboard.c termchar.h termhooks.h termopts.h buffer.h character.h \ commands.h frame.h window.h macros.h disptab.h keyboard.h syssignal.h \ systime.h syntax.h $(INTERVALS_H) blockinput.h atimer.h composite.h \ - xterm.h puresize.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \ + xterm.h msdos.h keymap.h w32term.h nsterm.h nsgui.h coding.h \ process.h ../lib/unistd.h gnutls.h lisp.h globals.h $(config_h) keymap.o: keymap.c buffer.h commands.h keyboard.h termhooks.h blockinput.h \ - atimer.h systime.h puresize.h character.h charset.h $(INTERVALS_H) \ + atimer.h systime.h character.h charset.h $(INTERVALS_H) \ keymap.h window.h coding.h frame.h lisp.h globals.h $(config_h) lastfile.o: lastfile.c $(config_h) macros.o: macros.c window.h buffer.h commands.h macros.h keyboard.h msdos.h \ @@ -267,12 +267,12 @@ xsettings.o: xterm.h xsettings.h lisp.h frame.h termhooks.h $(config_h) \ atimer.h termopts.h globals.h ## The files of Lisp proper. -alloc.o: alloc.c process.h frame.h window.h buffer.h puresize.h syssignal.h \ +alloc.o: alloc.c process.h frame.h window.h buffer.h syssignal.h \ keyboard.h blockinput.h atimer.h systime.h character.h lisp.h $(config_h) \ $(INTERVALS_H) termhooks.h gnutls.h coding.h ../lib/unistd.h globals.h bytecode.o: bytecode.c buffer.h syntax.h character.h window.h dispextern.h \ lisp.h globals.h $(config_h) msdos.h -data.o: data.c buffer.h puresize.h character.h syssignal.h keyboard.h frame.h \ +data.o: data.c buffer.h character.h syssignal.h keyboard.h frame.h \ termhooks.h systime.h coding.h composite.h dispextern.h font.h ccl.h \ lisp.h globals.h $(config_h) msdos.h eval.o: eval.c commands.h keyboard.h blockinput.h atimer.h systime.h frame.h \ @@ -295,7 +295,7 @@ lread.o: lread.c commands.h keyboard.h buffer.h epaths.h character.h \ composite.o: composite.c composite.h buffer.h character.h coding.h font.h \ ccl.h frame.h termhooks.h $(INTERVALS_H) window.h \ lisp.h globals.h $(config_h) -intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h puresize.h \ +intervals.o: intervals.c buffer.h $(INTERVALS_H) keyboard.h \ keymap.h lisp.h globals.h $(config_h) systime.h coding.h textprop.o: textprop.c buffer.h window.h $(INTERVALS_H) \ lisp.h globals.h $(config_h) diff --git a/src/emacs.c b/src/emacs.c index cbf541538c9..0b08feb9209 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -113,7 +113,6 @@ along with GNU Emacs. If not, see . */ #include "syntax.h" #include "sysselect.h" #include "systime.h" -#include "puresize.h" #include "getpagesize.h" #include "gnutls.h" diff --git a/src/fns.c b/src/fns.c index 7f7de54383a..78f1429ddab 100644 --- a/src/fns.c +++ b/src/fns.c @@ -36,7 +36,6 @@ along with GNU Emacs. If not, see . */ #include "buffer.h" #include "intervals.h" #include "window.h" -#include "puresize.h" #include "gnutls.h" #ifdef HAVE_TREE_SITTER diff --git a/src/intervals.c b/src/intervals.c index b937c947ab0..4fb2edf4ba3 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -44,7 +44,6 @@ along with GNU Emacs. If not, see . */ #include "lisp.h" #include "intervals.h" #include "buffer.h" -#include "puresize.h" #include "keymap.h" /* Test for membership, allowing for t (actually any non-cons) to mean the diff --git a/src/keymap.c b/src/keymap.c index 99291e72b3f..521a8f70d00 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -50,7 +50,6 @@ along with GNU Emacs. If not, see . */ #include "keyboard.h" #include "termhooks.h" #include "blockinput.h" -#include "puresize.h" #include "intervals.h" #include "keymap.h" #include "window.h" diff --git a/src/lisp.h b/src/lisp.h index f54ad9fff00..6a694efa80b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2630,8 +2630,8 @@ struct Lisp_Hash_Table bool_bf purecopy : 1; /* True if the table is mutable. Ordinarily tables are mutable, but - pure tables are not, and while a table is being mutated it is - immutable for recursive attempts to mutate it. */ + some tables are not: while a table is being mutated it is immutable + for recursive attempts to mutate it. */ bool_bf mutable : 1; /* Next weak hash table if this is a weak hash table. The head of @@ -4430,7 +4430,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ extern intptr_t garbage_collection_inhibited; extern void *my_heap_start (void); -extern void check_pure_size (void); unsigned char *resize_string_data (Lisp_Object, ptrdiff_t, int, int); extern void malloc_warning (const char *); extern AVOID memory_full (size_t); @@ -4493,11 +4492,8 @@ extern Lisp_Object list4 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object list5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object listn (ptrdiff_t, Lisp_Object, ...); -extern Lisp_Object pure_listn (ptrdiff_t, Lisp_Object, ...); #define list(...) \ listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__) -#define pure_list(...) \ - pure_listn (ARRAYELTS (((Lisp_Object []) {__VA_ARGS__})), __VA_ARGS__) enum gc_root_type { @@ -4571,18 +4567,8 @@ extern Lisp_Object make_uninit_multibyte_string (EMACS_INT, EMACS_INT); extern Lisp_Object make_string_from_bytes (const char *, ptrdiff_t, ptrdiff_t); extern Lisp_Object make_specified_string (const char *, ptrdiff_t, ptrdiff_t, bool); -extern Lisp_Object make_pure_string (const char *, ptrdiff_t, ptrdiff_t, bool); -extern Lisp_Object make_pure_c_string (const char *, ptrdiff_t); extern void pin_string (Lisp_Object string); -/* Make a string allocated in pure space, use STR as string data. */ - -INLINE Lisp_Object -build_pure_c_string (const char *str) -{ - return make_pure_c_string (str, strlen (str)); -} - /* Make a string from the data at STR, treating it as multibyte if the data warrants. */ diff --git a/src/w32heap.c b/src/w32heap.c index f475bae4fed..2ba36f01751 100644 --- a/src/w32heap.c +++ b/src/w32heap.c @@ -135,6 +135,12 @@ static struct static DWORD blocks_number = 0; static unsigned char *bc_limit; +/* Handle for the private heap: + - inside the dumped_data[] array before dump with unexec, + - outside of it after dump, or always if pdumper is used. +*/ +HANDLE heap = NULL; + /* We redirect the standard allocation functions. */ malloc_fn the_malloc_fn; realloc_fn the_realloc_fn; @@ -237,9 +243,7 @@ init_heap (void) /* FREEABLE_P checks if the block can be safely freed. */ #define FREEABLE_P(addr) \ - ((DWORD_PTR)(unsigned char *)(addr) > 0 \ - && ((unsigned char *)(addr) < dumped_data \ - || (unsigned char *)(addr) >= dumped_data + DUMPED_HEAP_SIZE)) + ((DWORD_PTR)(unsigned char *)(addr) > 0) void * malloc_after_dump (size_t size) @@ -258,65 +262,6 @@ malloc_after_dump (size_t size) return p; } -/* FIXME: The *_before_dump functions should be removed when pdumper - becomes the only dumping method. */ -void * -malloc_before_dump (size_t size) -{ - void *p; - - /* Before dumping. The private heap can handle only requests for - less than MaxBlockSize. */ - if (size < MaxBlockSize) - { - /* Use the private heap if possible. */ - p = heap_alloc (size); - } - else - { - /* Find the first big chunk that can hold the requested size. */ - int i = 0; - - for (i = 0; i < blocks_number; i++) - { - if (blocks[i].occupied == 0 && blocks[i].size >= size) - break; - } - if (i < blocks_number) - { - /* If found, use it. */ - p = blocks[i].address; - blocks[i].occupied = TRUE; - } - else - { - /* Allocate a new big chunk from the end of the dumped_data - array. */ - if (blocks_number >= MAX_BLOCKS) - { - fprintf (stderr, - "malloc_before_dump: no more big chunks available.\nEnlarge MAX_BLOCKS!\n"); - exit (-1); - } - bc_limit -= size; - bc_limit = (unsigned char *)ROUND_DOWN (bc_limit, 0x10); - p = bc_limit; - blocks[blocks_number].address = p; - blocks[blocks_number].size = size; - blocks[blocks_number].occupied = TRUE; - blocks_number++; - /* Check that areas do not overlap. */ - if (bc_limit < dumped_data + committed) - { - fprintf (stderr, - "malloc_before_dump: memory exhausted.\nEnlarge dumped_data[]!\n"); - exit (-1); - } - } - } - return p; -} - /* Re-allocate the previously allocated block in ptr, making the new block SIZE bytes long. */ void * @@ -349,39 +294,6 @@ realloc_after_dump (void *ptr, size_t size) return p; } -void * -realloc_before_dump (void *ptr, size_t size) -{ - void *p; - - /* Before dumping. */ - if (dumped_data < (unsigned char *)ptr - && (unsigned char *)ptr < bc_limit && size <= MaxBlockSize) - { - p = heap_realloc (ptr, size); - } - else - { - /* In this case, either the new block is too large for the heap, - or the old block was already too large. In both cases, - malloc_before_dump() and free_before_dump() will take care of - reallocation. */ - p = malloc_before_dump (size); - /* If SIZE is below MaxBlockSize, malloc_before_dump will try to - allocate it in the fixed heap. If that fails, we could have - kept the block in its original place, above bc_limit, instead - of failing the call as below. But this doesn't seem to be - worth the added complexity, as loadup allocates only a very - small number of large blocks, and never reallocates them. */ - if (p && ptr) - { - CopyMemory (p, ptr, size); - free_before_dump (ptr); - } - } - return p; -} - /* Free a block allocated by `malloc', `realloc' or `calloc'. */ void free_after_dump (void *ptr) @@ -394,39 +306,6 @@ free_after_dump (void *ptr) } } -void -free_before_dump (void *ptr) -{ - if (!ptr) - return; - - /* Before dumping. */ - if (dumped_data < (unsigned char *)ptr - && (unsigned char *)ptr < bc_limit) - { - /* Free the block if it is allocated in the private heap. */ - HeapFree (heap, 0, ptr); - } - else - { - /* Look for the big chunk. */ - int i; - - for (i = 0; i < blocks_number; i++) - { - if (blocks[i].address == ptr) - { - /* Reset block occupation if found. */ - blocks[i].occupied = 0; - break; - } - /* What if the block is not found? We should trigger an - error here. */ - eassert (i < blocks_number); - } - } -} - /* On Windows 9X, HeapAlloc may return pointers that are not aligned on 8-byte boundary, alignment which is required by the Lisp memory management. To circumvent this problem, manually enforce alignment diff --git a/src/w32heap.h b/src/w32heap.h index 901c9b5a41e..01ec13c7122 100644 --- a/src/w32heap.h +++ b/src/w32heap.h @@ -42,7 +42,7 @@ extern void report_temacs_memory_usage (void); extern void *sbrk (ptrdiff_t size); /* Initialize heap structures for sbrk on startup. */ -extern void init_heap (bool); +extern void init_heap (void); /* ----------------------------------------------------------------- */ /* Useful routines for manipulating memory-mapped files. */