diff options
| author | Pip Cet <pipcet@gmail.com> | 2021-05-16 15:44:26 +0200 |
|---|---|---|
| committer | Lars Ingebrigtsen <larsi@gnus.org> | 2021-05-16 15:44:26 +0200 |
| commit | 9b6992a794c391c5d663b4a82b5acc9de611e2ac (patch) | |
| tree | 2af6fe2df10e3a9fa29f8cb1e7a41f3f0de10cb6 | |
| parent | bf8b8cc6c57e051e11306aa9c409dc4ed8c442bc (diff) | |
| download | emacs-scratch/no-purespace-old.tar.gz | |
Remove purespace from Emacsscratch/no-purespace-old
41 files changed, 206 insertions, 1054 deletions
diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 8b440c79774..158d60d034a 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -1609,7 +1609,6 @@ Tips and Conventions GNU Emacs Internals * Building Emacs:: How the dumped Emacs is made. -* Pure Storage:: Kludge to make preloaded Lisp functions shareable. * Garbage Collection:: Reclaiming space for Lisp objects no longer used. * Stack-allocated Objects:: Temporary conses and strings on C stack. * Memory Usage:: Info about total size of Lisp objects made so far. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index 4150a2b21b8..b684933887b 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -12,7 +12,6 @@ internal aspects of GNU Emacs that may be of interest to C programmers. @menu * Building Emacs:: How the dumped Emacs is made. -* Pure Storage:: Kludge to make preloaded Lisp functions shareable. * Garbage Collection:: Reclaiming space for Lisp objects no longer used. * Stack-allocated Objects:: Temporary conses and strings on C stack. * Memory Usage:: Info about total size of Lisp objects made so far. @@ -243,71 +242,6 @@ If the current session was not restored from a dump file, the value is nil. @end defun -@node Pure Storage -@section Pure Storage -@cindex pure storage - - Emacs Lisp uses two kinds of storage for user-created Lisp objects: -@dfn{normal storage} and @dfn{pure storage}. Normal storage is where -all the new data created during an Emacs session are kept -(@pxref{Garbage Collection}). Pure storage is used for certain data -in the preloaded standard Lisp files---data that should never change -during actual use of Emacs. - - Pure storage is allocated only while @command{temacs} is loading the -standard preloaded Lisp libraries. In the file @file{emacs}, it is -marked as read-only (on operating systems that permit this), so that -the memory space can be shared by all the Emacs jobs running on the -machine at once. Pure storage is not expandable; a fixed amount is -allocated when Emacs is compiled, and if that is not sufficient for -the preloaded libraries, @file{temacs} allocates dynamic memory for -the part that didn't fit. If Emacs will be dumped using the -@code{pdump} method (@pxref{Building Emacs}), the pure-space overflow -is of no special importance (it just means some of the preloaded stuff -cannot be shared with other Emacs jobs). However, if Emacs will be -dumped using the now obsolete @code{unexec} method, the resulting -image will work, but garbage collection (@pxref{Garbage Collection}) -is disabled in this situation, causing a memory leak. Such an -overflow normally won't happen unless you try to preload additional -libraries or add features to the standard ones. Emacs will display a -warning about the overflow when it starts, if it was dumped using -@code{unexec}. If this happens, you should increase the compilation -parameter @code{SYSTEM_PURESIZE_EXTRA} in the file -@file{src/puresize.h} and rebuild Emacs. - -@defun purecopy object -This function makes a copy in pure storage of @var{object}, and returns -it. It copies a string by simply making a new string with the same -characters, but without text properties, in pure storage. It -recursively copies the contents of vectors and cons cells. It does -not make copies of other objects such as symbols, but just returns -them unchanged. It signals an error if asked to copy markers. - -This function is a no-op except while Emacs is being built and dumped; -it is usually called only in preloaded Lisp files. -@end defun - -@defvar pure-bytes-used -The value of this variable is the number of bytes of pure storage -allocated so far. Typically, in a dumped Emacs, this number is very -close to the total amount of pure storage available---if it were not, -we would preallocate less. -@end defvar - -@defvar purify-flag -This variable determines whether @code{defun} should make a copy of the -function definition in pure storage. If it is non-@code{nil}, then the -function definition is copied into pure storage. - -This flag is @code{t} while loading all of the basic functions for -building Emacs initially (allowing those functions to be shareable and -non-collectible). Dumping Emacs as an executable always writes -@code{nil} in this variable, regardless of the value it actually has -before and after dumping. - -You should not change this flag in a running Emacs. -@end defvar - @node Garbage Collection @section Garbage Collection @@ -514,12 +448,6 @@ Total heap size, in @var{unit-size} units. @item free-size Heap space which is not currently used, in @var{unit-size} units. @end table - -If there was overflow in pure space (@pxref{Pure Storage}), and Emacs -was dumped using the (now obsolete) @code{unexec} method -(@pxref{Building Emacs}), then @code{garbage-collect} returns -@code{nil}, because a real garbage collection cannot be done in that -case. @end deffn @defopt garbage-collection-messages @@ -934,12 +862,6 @@ require a large number of iterations; in this case, the list of arguments could be very long. This increases Emacs responsiveness and improves user experience. - You must not use C initializers for static or global variables unless -the variables are never written once Emacs is dumped. These variables -with initializers are allocated in an area of memory that becomes -read-only (on certain operating systems) as a result of dumping Emacs. -@xref{Pure Storage}. - @cindex @code{defsubr}, Lisp symbol for a primitive Defining the C function is not enough to make a Lisp primitive available; you must also create the Lisp symbol for the primitive and diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index ed36f5139a8..11247cd6121 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -562,8 +562,7 @@ modes. @xref{Setting Hooks}. If the value is non-@code{nil}, the named function is considered to be pure (@pxref{What Is a Function}). Calls with constant arguments can be evaluated at compile time. This may shift run time errors to -compile time. Not to be confused with pure storage (@pxref{Pure -Storage}). +compile time. @item risky-local-variable If the value is non-@code{nil}, the named variable is considered risky diff --git a/src/Makefile.in b/src/Makefile.in index d9f65b5bd0e..c931363e5e0 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -386,8 +386,6 @@ ALL_OBJC_CFLAGS = $(EMACS_CFLAGS) \ .m.o: $(AM_V_CC)$(CC) -c $(CPPFLAGS) $(ALL_OBJC_CFLAGS) $(PROFILING_CFLAGS) $< -## lastfile must follow all files whose initialized data areas should -## be dumped as pure by dump-emacs. base_obj = dispnew.o frame.o scroll.o xdisp.o menu.o $(XMENU_OBJ) window.o \ charset.o coding.o category.o ccl.o character.o chartab.o bidi.o \ $(CM_OBJ) term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \ diff --git a/src/alloc.c b/src/alloc.c index 76d8c7ddd11..2409f9b88c2 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" @@ -333,33 +332,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; @@ -434,7 +406,6 @@ no_sanitize_memcpy (void *dest, void const *src, size_t size) 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 || defined HYBRID_MALLOC @@ -576,16 +547,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 * @@ -1075,6 +1036,15 @@ verify (POWER_OF_2 (BLOCK_ALIGN)); # elif !defined HYBRID_MALLOC && defined HAVE_POSIX_MEMALIGN # define USE_ALIGNED_ALLOC 1 # define aligned_alloc my_aligned_alloc /* Avoid collision with lisp.h. */ + +/* 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); +} + static void * aligned_alloc (size_t alignment, size_t size) { @@ -1679,9 +1649,9 @@ static ptrdiff_t const STRING_BYTES_MAX = static void init_strings (void) { - empty_unibyte_string = make_pure_string ("", 0, 0, 0); + empty_unibyte_string = make_specified_string ("", 0, 0, false); staticpro (&empty_unibyte_string); - empty_multibyte_string = make_pure_string ("", 0, 0, 1); + empty_multibyte_string = make_specified_string ("", 0, 0, true); staticpro (&empty_multibyte_string); } @@ -1699,7 +1669,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; @@ -2415,7 +2385,7 @@ make_specified_string (const char *contents, { Lisp_Object val; - if (nchars < 0) + if (nchars <= 0) { if (multibyte) nchars = multibyte_chars_in_text ((const unsigned char *) contents, @@ -2469,8 +2439,6 @@ make_clear_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes, bool clearit) if (nchars < 0) emacs_abort (); - if (!nbytes) - return empty_multibyte_string; s = allocate_string (); s->u.s.intervals = NULL; @@ -2751,17 +2719,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; } @@ -2774,18 +2741,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; } @@ -2951,7 +2907,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; @@ -2987,15 +2943,6 @@ 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); -} - /* Allocate vector from a vector block. */ static struct Lisp_Vector * @@ -3086,6 +3033,8 @@ vectorlike_nbytes (const union vectorlike_header *hdr) } else nwords = size; + if (nwords == 0) + nwords = 1; return vroundup (header_size + word_size * nwords); } @@ -3363,6 +3312,18 @@ allocate_nil_vector (ptrdiff_t len) } +/* Called once to initialize vector allocation. */ + +static void +init_vectors (void) +{ + zero_vector = + make_lisp_ptr (allocate_vectorlike (1, true), Lisp_Vectorlike); + XVECTOR (zero_vector)->header.size = 0; + XVECTOR (zero_vector)->contents[0] = Qnil; + staticpro (&zero_vector); +} + /* Allocate other vector-like structures. */ struct Lisp_Vector * @@ -3575,13 +3536,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. */ @@ -3607,7 +3561,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, @@ -5171,8 +5124,6 @@ valid_lisp_object_p (Lisp_Object obj) return 1; void *p = XPNTR (obj); - if (PURE_P (p)) - return 1; if (SYMBOLP (obj) && c_symbol_p (p)) return ((char *) p - (char *) lispsym) % sizeof lispsym[0] == 0; @@ -5228,296 +5179,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 - - -/* 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; - - /* 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 (NILP (table->weak)); - eassert (table->purecopy); - - struct Lisp_Hash_Table *pure = pure_alloc (sizeof *pure, Lisp_Vectorlike); - struct hash_table_test pure_test = table->test; - - /* Purecopy the hash table test. */ - pure_test.name = purecopy (table->test.name); - pure_test.user_hash_function = purecopy (table->test.user_hash_function); - pure_test.user_cmp_function = purecopy (table->test.user_cmp_function); - - pure->header = table->header; - pure->weak = purecopy (Qnil); - pure->hash = purecopy (table->hash); - pure->next = purecopy (table->next); - pure->index = purecopy (table->index); - pure->count = table->count; - pure->next_free = table->next_free; - pure->purecopy = table->purecopy; - eassert (!pure->mutable); - pure->rehash_threshold = table->rehash_threshold; - pure->rehash_size = table->rehash_size; - pure->key_and_value = purecopy (table->key_and_value); - pure->test = pure_test; - - return pure; -} +purecopy (Lisp_Object obj); DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0, doc: /* Make a copy of object OBJ in pure storage. @@ -5534,100 +5197,23 @@ 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 (STRINGP (obj) && XSTRING (obj)->u.s.intervals) - message_with_string ("Dropping text-properties while making string `%s' pure", - obj, true); - 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 (!NILP (table->weak) || !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. */ - } - - struct Lisp_Hash_Table *h = purecopy_hash_table (table); - XSET_HASH_TABLE (obj, h); - } - else if (COMPILEDP (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]); - XSETVECTOR (obj, vec); - } - else if (SYMBOLP (obj)) - { - if (!XSYMBOL (obj)->u.s.pinned && !c_symbol_p (XSYMBOL (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. */ - XSYMBOL (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; } - /*********************************************************************** Protection from GC @@ -5819,31 +5405,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) @@ -6103,8 +5664,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_terminals (); mark_kboards (); mark_threads (); @@ -6213,10 +5772,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 @@ -6586,8 +6141,8 @@ void mark_object (Lisp_Object arg) { register Lisp_Object obj; - void *po; #if GC_CHECK_MARKED_OBJECTS + void *po; struct mem_node *m = NULL; #endif ptrdiff_t cdr_count = 0; @@ -6595,10 +6150,6 @@ mark_object (Lisp_Object arg) obj = arg; loop: - po = XPNTR (obj); - if (PURE_P (po)) - return; - last_marked[last_marked_index++] = obj; last_marked_index &= LAST_MARKED_SIZE - 1; @@ -6607,6 +6158,8 @@ mark_object (Lisp_Object arg) by ~80%. */ #if GC_CHECK_MARKED_OBJECTS + po = XPNTR (obj); + /* Check that the object pointed to by PO is known to be a Lisp structure allocated from the heap. */ #define CHECK_ALLOCATED() \ @@ -6800,11 +6353,10 @@ mark_object (Lisp_Object arg) 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; + ptr = ptr->u.s.next; if (ptr) goto nextsym; } @@ -6917,7 +6469,7 @@ survives_gc_p (Lisp_Object obj) emacs_abort (); } - return survives_p || PURE_P (XPNTR (obj)); + return survives_p; } @@ -7505,8 +7057,6 @@ init_alloc_once (void) static void init_alloc_once_for_pdumper (void) { - purebeg = PUREBEG; - pure_size = PURESIZE; mem_init (); #ifdef DOUG_LEA_MALLOC @@ -7550,7 +7100,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. */); @@ -7575,10 +7125,7 @@ If this portion is smaller than `gc-cons-threshold', this is ignored. */); doc: /* Number of strings that have been consed so far. */); 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. */); + doc: /* No longer used. */); DEFVAR_BOOL ("garbage-collection-messages", garbage_collection_messages, doc: /* Non-nil means display messages at start and end of garbage collection. */); @@ -7594,10 +7141,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. */); diff --git a/src/buffer.c b/src/buffer.c index df302db0e52..0e94e69f737 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -5267,8 +5267,8 @@ init_buffer_once (void) set_buffer_intervals (&buffer_defaults, NULL); set_buffer_intervals (&buffer_local_symbols, NULL); /* This is not strictly necessary, but let's make them initialized. */ - bset_name (&buffer_defaults, build_pure_c_string (" *buffer-defaults*")); - bset_name (&buffer_local_symbols, build_pure_c_string (" *buffer-local-symbols*")); + bset_name (&buffer_defaults, build_string (" *buffer-defaults*")); + bset_name (&buffer_local_symbols, build_string (" *buffer-local-symbols*")); BUFFER_PVEC_INIT (&buffer_defaults); BUFFER_PVEC_INIT (&buffer_local_symbols); @@ -5276,7 +5276,7 @@ init_buffer_once (void) /* Must do these before making the first buffer! */ /* real setup is done in bindings.el */ - bset_mode_line_format (&buffer_defaults, build_pure_c_string ("%-")); + bset_mode_line_format (&buffer_defaults, build_string ("%-")); bset_header_line_format (&buffer_defaults, Qnil); bset_tab_line_format (&buffer_defaults, Qnil); bset_abbrev_mode (&buffer_defaults, Qnil); @@ -5343,7 +5343,7 @@ init_buffer_once (void) current_buffer = 0; pdumper_remember_lv_ptr_raw (¤t_buffer, Lisp_Vectorlike); - QSFundamental = build_pure_c_string ("Fundamental"); + QSFundamental = build_string ("Fundamental"); DEFSYM (Qfundamental_mode, "fundamental-mode"); bset_major_mode (&buffer_defaults, Qfundamental_mode); @@ -5357,10 +5357,10 @@ init_buffer_once (void) /* Super-magic invisible buffer. */ Vprin1_to_string_buffer = - Fget_buffer_create (build_pure_c_string (" prin1"), Qt); + Fget_buffer_create (build_string (" prin1"), Qt); Vbuffer_alist = Qnil; - Fset_buffer (Fget_buffer_create (build_pure_c_string ("*scratch*"), Qnil)); + Fset_buffer (Fget_buffer_create (build_string ("*scratch*"), Qnil)); inhibit_modification_hooks = 0; } @@ -5542,9 +5542,9 @@ syms_of_buffer (void) Qoverwrite_mode_binary)); Fput (Qprotected_field, Qerror_conditions, - pure_list (Qprotected_field, Qerror)); + list (Qprotected_field, Qerror)); Fput (Qprotected_field, Qerror_message, - build_pure_c_string ("Attempt to modify a protected field")); + build_string ("Attempt to modify a protected field")); DEFVAR_PER_BUFFER ("tab-line-format", &BVAR (current_buffer, tab_line_format), diff --git a/src/callint.c b/src/callint.c index 18624637843..8f8a7713105 100644 --- a/src/callint.c +++ b/src/callint.c @@ -824,10 +824,10 @@ syms_of_callint (void) callint_message = Qnil; staticpro (&callint_message); - preserved_fns = pure_list (intern_c_string ("region-beginning"), - intern_c_string ("region-end"), - intern_c_string ("point"), - intern_c_string ("mark")); + preserved_fns = list (intern_c_string ("region-beginning"), + intern_c_string ("region-end"), + intern_c_string ("point"), + intern_c_string ("mark")); staticpro (&preserved_fns); DEFSYM (Qlist, "list"); diff --git a/src/category.c b/src/category.c index ec8f61f7f00..907db145577 100644 --- a/src/category.c +++ b/src/category.c @@ -53,7 +53,7 @@ hash_get_category_set (Lisp_Object table, Lisp_Object category_set) (table, 1, make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false)); + Qnil)); struct Lisp_Hash_Table *h = XHASH_TABLE (XCHAR_TABLE (table)->extras[1]); Lisp_Object hash; ptrdiff_t i = hash_lookup (h, category_set, &hash); @@ -120,8 +120,6 @@ the current buffer's category table. */) if (!NILP (CATEGORY_DOCSTRING (table, XFIXNAT (category)))) error ("Category `%c' is already defined", (int) XFIXNAT (category)); - if (!NILP (Vpurify_flag)) - docstring = Fpurecopy (docstring); SET_CATEGORY_DOCSTRING (table, XFIXNAT (category), docstring); return Qnil; diff --git a/src/coding.c b/src/coding.c index 46e7fca0f43..6f0ef161616 100644 --- a/src/coding.c +++ b/src/coding.c @@ -11656,7 +11656,7 @@ syms_of_coding (void) Vcode_conversion_reused_workbuf = Qnil; staticpro (&Vcode_conversion_workbuf_name); - Vcode_conversion_workbuf_name = build_pure_c_string (" *code-conversion-work*"); + Vcode_conversion_workbuf_name = build_string (" *code-conversion-work*"); reused_workbuf_in_use = false; PDUMPER_REMEMBER_SCALAR (reused_workbuf_in_use); @@ -11720,9 +11720,9 @@ syms_of_coding (void) /* Error signaled when there's a problem with detecting a coding system. */ DEFSYM (Qcoding_system_error, "coding-system-error"); Fput (Qcoding_system_error, Qerror_conditions, - pure_list (Qcoding_system_error, Qerror)); + list (Qcoding_system_error, Qerror)); Fput (Qcoding_system_error, Qerror_message, - build_pure_c_string ("Invalid coding system")); + build_string ("Invalid coding system")); DEFSYM (Qtranslation_table, "translation-table"); Fput (Qtranslation_table, Qchar_table_extra_slots, make_fixnum (2)); @@ -11997,22 +11997,22 @@ encoding standard output and error streams. */); DEFVAR_LISP ("eol-mnemonic-unix", eol_mnemonic_unix, doc: /* String displayed in mode line for UNIX-like (LF) end-of-line format. */); - eol_mnemonic_unix = build_pure_c_string (":"); + eol_mnemonic_unix = build_string (":"); DEFVAR_LISP ("eol-mnemonic-dos", eol_mnemonic_dos, doc: /* String displayed in mode line for DOS-like (CRLF) end-of-line format. */); - eol_mnemonic_dos = build_pure_c_string ("\\"); + eol_mnemonic_dos = build_string ("\\"); DEFVAR_LISP ("eol-mnemonic-mac", eol_mnemonic_mac, doc: /* String displayed in mode line for MAC-like (CR) end-of-line format. */); - eol_mnemonic_mac = build_pure_c_string ("/"); + eol_mnemonic_mac = build_string ("/"); DEFVAR_LISP ("eol-mnemonic-undecided", eol_mnemonic_undecided, doc: /* String displayed in mode line when end-of-line format is not yet determined. */); - eol_mnemonic_undecided = build_pure_c_string (":"); + eol_mnemonic_undecided = build_string (":"); DEFVAR_LISP ("enable-character-translation", Venable_character_translation, doc: /* @@ -12152,7 +12152,7 @@ internal character representation. */); intern_c_string (":for-unibyte"), args[coding_arg_for_unibyte] = Qt, intern_c_string (":docstring"), - (build_pure_c_string + (build_string ("Do no conversion.\n" "\n" "When you visit a file with this coding, the file is read into a\n" @@ -12172,7 +12172,7 @@ internal character representation. */); plist[8] = intern_c_string (":charset-list"); plist[9] = args[coding_arg_charset_list] = list1 (Qascii); plist[11] = args[coding_arg_for_unibyte] = Qnil; - plist[13] = build_pure_c_string ("No conversion on encoding, " + plist[13] = build_string ("No conversion on encoding, " "automatic conversion on decoding."); plist[15] = args[coding_arg_eol_type] = Qnil; args[coding_arg_plist] = CALLMANY (Flist, plist); diff --git a/src/comp.c b/src/comp.c index c0445050b71..945e883c641 100644 --- a/src/comp.c +++ b/src/comp.c @@ -31,7 +31,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <libgccjit.h> #include <epaths.h> -#include "puresize.h" #include "window.h" #include "dynlib.h" #include "buffer.h" @@ -652,7 +651,6 @@ bool helper_PSEUDOVECTOR_TYPEP_XUNTAG (Lisp_Object a, enum pvec_type code); void *helper_link_table[] = { wrong_type_argument, helper_PSEUDOVECTOR_TYPEP_XUNTAG, - pure_write_error, push_handler, record_unwind_protect_excursion, helper_unbind_n, @@ -3625,52 +3623,6 @@ define_PSEUDOVECTORP (void) } static void -define_CHECK_IMPURE (void) -{ - gcc_jit_param *param[] = - { gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.lisp_obj_type, - "obj"), - gcc_jit_context_new_param (comp.ctxt, - NULL, - comp.void_ptr_type, - "ptr") }; - comp.check_impure = - gcc_jit_context_new_function (comp.ctxt, NULL, - GCC_JIT_FUNCTION_INTERNAL, - comp.void_type, - "CHECK_IMPURE", - 2, - param, - 0); - - DECL_BLOCK (entry_block, comp.check_impure); - DECL_BLOCK (err_block, comp.check_impure); - DECL_BLOCK (ok_block, comp.check_impure); - - comp.block = entry_block; - comp.func = comp.check_impure; - - emit_cond_jump (emit_PURE_P (gcc_jit_param_as_rvalue (param[0])), /* FIXME */ - err_block, - ok_block); - gcc_jit_block_end_with_void_return (ok_block, NULL); - - gcc_jit_rvalue *pure_write_error_arg = - gcc_jit_param_as_rvalue (param[0]); - - comp.block = err_block; - gcc_jit_block_add_eval (comp.block, - NULL, - emit_call (intern_c_string ("pure_write_error"), - comp.void_type, 1,&pure_write_error_arg, - false)); - - gcc_jit_block_end_with_void_return (err_block, NULL); -} - -static void define_maybe_gc_or_quit (void) { @@ -4708,10 +4660,10 @@ maybe_defer_native_compilation (Lisp_Object function_name, Lisp_Object src = concat2 (CALL1I (file-name-sans-extension, Vload_true_file_name), - build_pure_c_string (".el")); + build_string (".el")); if (NILP (Ffile_exists_p (src))) { - src = concat2 (src, build_pure_c_string (".gz")); + src = concat2 (src, build_string (".gz")); if (NILP (Ffile_exists_p (src))) return; } @@ -5281,40 +5233,40 @@ compiled one. */); Fput (Qnative_compiler_error, Qerror_conditions, pure_list (Qnative_compiler_error, Qerror)); Fput (Qnative_compiler_error, Qerror_message, - build_pure_c_string ("Native compiler error")); + build_string ("Native compiler error")); DEFSYM (Qnative_ice, "native-ice"); Fput (Qnative_ice, Qerror_conditions, pure_list (Qnative_ice, Qnative_compiler_error, Qerror)); Fput (Qnative_ice, Qerror_message, - build_pure_c_string ("Internal native compiler error")); + build_string ("Internal native compiler error")); /* By the load machinery. */ DEFSYM (Qnative_lisp_load_failed, "native-lisp-load-failed"); Fput (Qnative_lisp_load_failed, Qerror_conditions, pure_list (Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_load_failed, Qerror_message, - build_pure_c_string ("Native elisp load failed")); + build_string ("Native elisp load failed")); DEFSYM (Qnative_lisp_wrong_reloc, "native-lisp-wrong-reloc"); Fput (Qnative_lisp_wrong_reloc, Qerror_conditions, pure_list (Qnative_lisp_wrong_reloc, Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_wrong_reloc, Qerror_message, - build_pure_c_string ("Primitive redefined or wrong relocation")); + build_string ("Primitive redefined or wrong relocation")); DEFSYM (Qwrong_register_subr_call, "wrong-register-subr-call"); Fput (Qwrong_register_subr_call, Qerror_conditions, pure_list (Qwrong_register_subr_call, Qnative_lisp_load_failed, Qerror)); Fput (Qwrong_register_subr_call, Qerror_message, - build_pure_c_string ("comp--register-subr can only be called during " - "native lisp load phase.")); + build_string ("comp--register-subr can only be called during " + "native lisp load phase.")); DEFSYM (Qnative_lisp_file_inconsistent, "native-lisp-file-inconsistent"); Fput (Qnative_lisp_file_inconsistent, Qerror_conditions, pure_list (Qnative_lisp_file_inconsistent, Qnative_lisp_load_failed, Qerror)); Fput (Qnative_lisp_file_inconsistent, Qerror_message, - build_pure_c_string ("eln file inconsistent with current runtime " - "configuration, please recompile")); + build_string ("eln file inconsistent with current runtime " + "configuration, please recompile")); defsubr (&Scomp__subr_signature); defsubr (&Scomp_el_to_eln_rel_filename); diff --git a/src/conf_post.h b/src/conf_post.h index 176ab28b21a..da55a1fb54a 100644 --- a/src/conf_post.h +++ b/src/conf_post.h @@ -163,41 +163,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 d547f5da5e0..dc1df88cf07 100644 --- a/src/data.c +++ b/src/data.c @@ -30,7 +30,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "lisp.h" #include "bignum.h" -#include "puresize.h" #include "character.h" #include "buffer.h" #include "keyboard.h" @@ -144,12 +143,6 @@ wrong_type_argument (Lisp_Object predicate, Lisp_Object 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) { xsignal2 (Qargs_out_of_range, a1, a2); @@ -621,7 +614,6 @@ DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0, (register Lisp_Object cell, Lisp_Object newcar) { CHECK_CONS (cell); - CHECK_IMPURE (cell, XCONS (cell)); XSETCAR (cell, newcar); return newcar; } @@ -631,7 +623,6 @@ DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0, (register Lisp_Object cell, Lisp_Object newcdr) { CHECK_CONS (cell); - CHECK_IMPURE (cell, XCONS (cell)); XSETCDR (cell, newcdr); return newcdr; } @@ -801,10 +792,6 @@ The return value is undefined. */) (register Lisp_Object symbol, Lisp_Object definition, Lisp_Object docstring) { CHECK_SYMBOL (symbol); - if (!NILP (Vpurify_flag) - /* If `definition' is a keymap, immutable (and copying) is wrong. */ - && !KEYMAPP (definition)) - definition = Fpurecopy (definition); { bool autoload = AUTOLOADP (definition); @@ -2450,7 +2437,6 @@ bool-vector. IDX starts at 0. */) if (VECTORP (array)) { - CHECK_IMPURE (array, XVECTOR (array)); if (idxval < 0 || idxval >= ASIZE (array)) args_out_of_range (array, idx); ASET (array, idxval, newelt); @@ -2474,7 +2460,6 @@ bool-vector. IDX starts at 0. */) } else /* STRINGP */ { - CHECK_IMPURE (array, XSTRING (array)); if (idxval < 0 || idxval >= SCHARS (array)) args_out_of_range (array, idx); CHECK_CHARACTER (newelt); @@ -3956,7 +3941,7 @@ syms_of_data (void) DEFSYM (Qcdr, "cdr"); - error_tail = pure_cons (Qerror, Qnil); + error_tail = Fcons (Qerror, Qnil); /* ERROR is used as a signaler for random errors for which nothing else is right. */ @@ -3964,11 +3949,11 @@ syms_of_data (void) Fput (Qerror, Qerror_conditions, error_tail); Fput (Qerror, Qerror_message, - build_pure_c_string ("error")); + build_string ("error")); #define PUT_ERROR(sym, tail, msg) \ - Fput (sym, Qerror_conditions, pure_cons (sym, tail)); \ - Fput (sym, Qerror_message, build_pure_c_string (msg)) + Fput (sym, Qerror_conditions, Fcons (sym, tail)); \ + Fput (sym, Qerror_message, build_string (msg)) PUT_ERROR (Qquit, Qnil, "Quit"); @@ -3996,14 +3981,14 @@ syms_of_data (void) PUT_ERROR (Qno_catch, error_tail, "No catch for tag"); PUT_ERROR (Qend_of_file, error_tail, "End of file during parsing"); - arith_tail = pure_cons (Qarith_error, error_tail); + arith_tail = Fcons (Qarith_error, error_tail); Fput (Qarith_error, Qerror_conditions, arith_tail); - Fput (Qarith_error, Qerror_message, build_pure_c_string ("Arithmetic error")); + Fput (Qarith_error, Qerror_message, build_string ("Arithmetic error")); PUT_ERROR (Qbeginning_of_buffer, error_tail, "Beginning of buffer"); PUT_ERROR (Qend_of_buffer, error_tail, "End of buffer"); PUT_ERROR (Qbuffer_read_only, error_tail, "Buffer is read-only"); - PUT_ERROR (Qtext_read_only, pure_cons (Qbuffer_read_only, error_tail), + PUT_ERROR (Qtext_read_only, Fcons (Qbuffer_read_only, error_tail), "Text is read-only"); PUT_ERROR (Qinhibited_interaction, error_tail, "User interaction while inhibited"); diff --git a/src/dbusbind.c b/src/dbusbind.c index c005474d440..238142b9560 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -1868,7 +1868,7 @@ syms_of_dbusbind (void) Fput (Qdbus_error, Qerror_conditions, list2 (Qdbus_error, Qerror)); Fput (Qdbus_error, Qerror_message, - build_pure_c_string ("D-Bus error")); + build_string ("D-Bus error")); /* Lisp symbols of the system and session buses. */ DEFSYM (QCsystem, ":system"); @@ -1911,7 +1911,7 @@ syms_of_dbusbind (void) Vdbus_compiled_version, doc: /* The version of D-Bus Emacs is compiled against. */); #ifdef DBUS_VERSION_STRING - Vdbus_compiled_version = build_pure_c_string (DBUS_VERSION_STRING); + Vdbus_compiled_version = build_string (DBUS_VERSION_STRING); #else Vdbus_compiled_version = Qnil; #endif diff --git a/src/deps.mk b/src/deps.mk index eda2ed63382..3292cf201cf 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/doc.c b/src/doc.c index 6be023bb934..e40827c74b5 100644 --- a/src/doc.c +++ b/src/doc.c @@ -495,8 +495,6 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) { tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && FIXNUMP (XCAR (tem))) - /* FIXME: This modifies typically pure hash-cons'd data, so its - correctness is quite delicate. */ XSETCAR (tem, make_fixnum (offset)); } } @@ -581,7 +579,6 @@ the same file name is found in the `doc-directory'. */) int i = ARRAYELTS (buildobj); while (0 <= --i) Vbuild_files = Fcons (build_string (buildobj[i]), Vbuild_files); - Vbuild_files = Fpurecopy (Vbuild_files); } fd = emacs_open (name, O_RDONLY, 0); diff --git a/src/emacs-module.c b/src/emacs-module.c index f8fb54c0728..896ae65685e 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -1600,44 +1600,44 @@ syms_of_module (void) Vmodule_refs_hash = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Qnil); DEFSYM (Qmodule_load_failed, "module-load-failed"); Fput (Qmodule_load_failed, Qerror_conditions, - pure_list (Qmodule_load_failed, Qerror)); + list (Qmodule_load_failed, Qerror)); Fput (Qmodule_load_failed, Qerror_message, - build_pure_c_string ("Module load failed")); + build_string ("Module load failed")); DEFSYM (Qmodule_open_failed, "module-open-failed"); Fput (Qmodule_open_failed, Qerror_conditions, - pure_list (Qmodule_open_failed, Qmodule_load_failed, Qerror)); + list (Qmodule_open_failed, Qmodule_load_failed, Qerror)); Fput (Qmodule_open_failed, Qerror_message, - build_pure_c_string ("Module could not be opened")); + build_string ("Module could not be opened")); DEFSYM (Qmodule_not_gpl_compatible, "module-not-gpl-compatible"); Fput (Qmodule_not_gpl_compatible, Qerror_conditions, - pure_list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror)); + list (Qmodule_not_gpl_compatible, Qmodule_load_failed, Qerror)); Fput (Qmodule_not_gpl_compatible, Qerror_message, - build_pure_c_string ("Module is not GPL compatible")); + build_string ("Module is not GPL compatible")); DEFSYM (Qmissing_module_init_function, "missing-module-init-function"); Fput (Qmissing_module_init_function, Qerror_conditions, - pure_list (Qmissing_module_init_function, Qmodule_load_failed, - Qerror)); + list (Qmissing_module_init_function, Qmodule_load_failed, + Qerror)); Fput (Qmissing_module_init_function, Qerror_message, - build_pure_c_string ("Module does not export an " + build_string ("Module does not export an " "initialization function")); DEFSYM (Qmodule_init_failed, "module-init-failed"); Fput (Qmodule_init_failed, Qerror_conditions, - pure_list (Qmodule_init_failed, Qmodule_load_failed, Qerror)); + list (Qmodule_init_failed, Qmodule_load_failed, Qerror)); Fput (Qmodule_init_failed, Qerror_message, - build_pure_c_string ("Module initialization failed")); + build_string ("Module initialization failed")); DEFSYM (Qinvalid_arity, "invalid-arity"); - Fput (Qinvalid_arity, Qerror_conditions, pure_list (Qinvalid_arity, Qerror)); + Fput (Qinvalid_arity, Qerror_conditions, list (Qinvalid_arity, Qerror)); Fput (Qinvalid_arity, Qerror_message, - build_pure_c_string ("Invalid function arity")); + build_string ("Invalid function arity")); DEFSYM (Qmodule_function_p, "module-function-p"); DEFSYM (Qunicode_string_p, "unicode-string-p"); diff --git a/src/emacs.c b/src/emacs.c index 60a57a693ce..800f6b3b8f6 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -104,7 +104,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "syntax.h" #include "sysselect.h" #include "systime.h" -#include "puresize.h" #include "getpagesize.h" #include "gnutls.h" @@ -1782,7 +1781,9 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem if (!initialized) { init_alloc_once (); +#ifdef HAVE_PDUMPER init_pdumper_once (); +#endif init_obarray_once (); init_eval_once (); init_charset_once (); @@ -2763,8 +2764,6 @@ You must run Emacs in batch mode in order to dump it. */) Lisp_Object symbol; ptrdiff_t count = SPECPDL_INDEX (); - check_pure_size (); - if (! noninteractive) error ("Dumping Emacs works only in batch mode"); diff --git a/src/eval.c b/src/eval.c index aeedcc50cc0..7d5975e1010 100644 --- a/src/eval.c +++ b/src/eval.c @@ -794,8 +794,6 @@ value. */) XSYMBOL (symbol)->u.s.declared_special = true; if (!NILP (doc)) { - if (!NILP (Vpurify_flag)) - doc = Fpurecopy (doc); Fput (symbol, Qvariable_documentation, doc); } LOADHIST_ATTACH (symbol); @@ -912,8 +910,6 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) Finternal__define_uninitialized_variable (sym, docstring); tem = eval_sub (XCAR (XCDR (args))); - if (!NILP (Vpurify_flag)) - tem = Fpurecopy (tem); Fset_default (sym, tem); /* FIXME: set-default-toplevel-value? */ Fput (sym, Qrisky_local_variable, Qt); /* FIXME: Why? */ return sym; @@ -2227,12 +2223,6 @@ this does nothing and returns nil. */) && !AUTOLOADP (XSYMBOL (function)->u.s.function)) return Qnil; - if (!NILP (Vpurify_flag) && EQ (docstring, make_fixnum (0))) - /* `read1' in lread.c has found the docstring starting with "\ - and assumed the docstring will be provided by Snarf-documentation, so it - passed us 0 instead. But that leads to accidental sharing in purecopy's - hash-consing, so we use a (hopefully) unique integer instead. */ - docstring = make_ufixnum (XHASH (function)); return Fdefalias (function, list5 (Qautoload, file, docstring, interactive, type), Qnil); @@ -4490,7 +4480,7 @@ alist of active lexical bindings. */); also use something like Fcons (Qnil, Qnil), but json.c treats any cons cell as error data, so use an uninterned symbol instead. */ Qcatch_all_memory_full - = Fmake_symbol (build_pure_c_string ("catch-all-memory-full")); + = Fmake_symbol (build_string ("catch-all-memory-full")); defsubr (&Sor); defsubr (&Sand); diff --git a/src/fileio.c b/src/fileio.c index 741e297d29c..5d438865e20 100644 --- a/src/fileio.c +++ b/src/fileio.c @@ -6294,34 +6294,34 @@ behaves as if file names were encoded in `utf-8'. */); DEFSYM (Qcar_less_than_car, "car-less-than-car"); Fput (Qfile_error, Qerror_conditions, - Fpurecopy (list2 (Qfile_error, Qerror))); + list2 (Qfile_error, Qerror)); Fput (Qfile_error, Qerror_message, - build_pure_c_string ("File error")); + build_string ("File error")); Fput (Qfile_already_exists, Qerror_conditions, - Fpurecopy (list3 (Qfile_already_exists, Qfile_error, Qerror))); + list3 (Qfile_already_exists, Qfile_error, Qerror)); Fput (Qfile_already_exists, Qerror_message, - build_pure_c_string ("File already exists")); + build_string ("File already exists")); Fput (Qfile_date_error, Qerror_conditions, - Fpurecopy (list3 (Qfile_date_error, Qfile_error, Qerror))); + list3 (Qfile_date_error, Qfile_error, Qerror)); Fput (Qfile_date_error, Qerror_message, - build_pure_c_string ("Cannot set file date")); + build_string ("Cannot set file date")); Fput (Qfile_missing, Qerror_conditions, - Fpurecopy (list3 (Qfile_missing, Qfile_error, Qerror))); + list3 (Qfile_missing, Qfile_error, Qerror)); Fput (Qfile_missing, Qerror_message, - build_pure_c_string ("File is missing")); + build_string ("File is missing")); Fput (Qfile_notify_error, Qerror_conditions, - Fpurecopy (list3 (Qfile_notify_error, Qfile_error, Qerror))); + list3 (Qfile_notify_error, Qfile_error, Qerror)); Fput (Qfile_notify_error, Qerror_message, - build_pure_c_string ("File notification error")); + build_string ("File notification error")); Fput (Qremote_file_error, Qerror_conditions, Fpurecopy (list3 (Qremote_file_error, Qfile_error, Qerror))); Fput (Qremote_file_error, Qerror_message, - build_pure_c_string ("Remote file error")); + build_string ("Remote file error")); DEFVAR_LISP ("file-name-handler-alist", Vfile_name_handler_alist, doc: /* Alist of elements (REGEXP . HANDLER) for file names handled specially. diff --git a/src/fns.c b/src/fns.c index 41429c8863d..8339cdf4cec 100644 --- a/src/fns.c +++ b/src/fns.c @@ -36,7 +36,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "buffer.h" #include "intervals.h" #include "window.h" -#include "puresize.h" #include "gnutls.h" static void sort_vector_copy (Lisp_Object, ptrdiff_t, @@ -2703,7 +2702,6 @@ ARRAY is a vector, string, char-table, or bool-vector. */) size = SCHARS (array); if (size != 0) { - CHECK_IMPURE (array, XSTRING (array)); unsigned char str[MAX_MULTIBYTE_LENGTH]; int len; if (STRING_MULTIBYTE (array)) @@ -2745,7 +2743,6 @@ This makes STRING unibyte and may change its length. */) ptrdiff_t len = SBYTES (string); if (len != 0 || STRING_MULTIBYTE (string)) { - CHECK_IMPURE (string, XSTRING (string)); memset (SDATA (string), 0, len); STRING_SET_CHARS (string, len); STRING_SET_UNIBYTE (string); @@ -4283,16 +4280,12 @@ hash_index_size (struct Lisp_Hash_Table *h, ptrdiff_t size) size exceeds REHASH_THRESHOLD. WEAK specifies the weakness of the table. If non-nil, it must be - one of the symbols `key', `value', `key-or-value', or `key-and-value'. - - If PURECOPY is non-nil, the table can be copied to pure storage via - `purecopy' when Emacs is being dumped. Such tables can no longer be - changed after purecopy. */ + one of the symbols `key', `value', `key-or-value', or `key-and-value'. */ Lisp_Object make_hash_table (struct hash_table_test test, EMACS_INT size, float rehash_size, float rehash_threshold, - Lisp_Object weak, bool purecopy) + Lisp_Object weak) { struct Lisp_Hash_Table *h; Lisp_Object table; @@ -4321,7 +4314,6 @@ make_hash_table (struct hash_table_test test, EMACS_INT size, h->next = make_vector (size, make_fixnum (-1)); h->index = make_vector (hash_index_size (h, size), make_fixnum (-1)); h->next_weak = NULL; - h->purecopy = purecopy; h->mutable = true; /* Set up the free list. */ @@ -4422,11 +4414,6 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h) set_hash_next_slot (h, i, HASH_INDEX (h, start_of_bucket)); set_hash_index_slot (h, start_of_bucket, i); } - -#ifdef ENABLE_CHECKING - if (HASH_TABLE_P (Vpurify_flag) && XHASH_TABLE (Vpurify_flag) == h) - message ("Growing hash table to: %"pD"d", next_size); -#endif } } @@ -4489,7 +4476,6 @@ check_mutable_hash_table (Lisp_Object obj, struct Lisp_Hash_Table *h) { if (!h->mutable) signal_error ("hash table test modifies table", obj); - eassert (!PURE_P (h)); } static void @@ -5013,16 +4999,10 @@ key, value, one of key or value, or both key and value, depending on WEAK. WEAK t is equivalent to `key-and-value'. Default value of WEAK is nil. -:purecopy PURECOPY -- If PURECOPY is non-nil, the table can be copied -to pure storage when Emacs is being dumped, making the contents of the -table read only. Any further changes to purified tables will result -in an error. - usage: (make-hash-table &rest KEYWORD-ARGS) */) (ptrdiff_t nargs, Lisp_Object *args) { Lisp_Object test, weak; - bool purecopy; struct hash_table_test testdesc; ptrdiff_t i; USE_SAFE_ALLOCA; @@ -5056,9 +5036,8 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) testdesc.cmpfn = cmpfn_user_defined; } - /* See if there's a `:purecopy PURECOPY' argument. */ - i = get_key_arg (QCpurecopy, nargs, args, used); - purecopy = i && !NILP (args[i]); + /* Ignore a `:purecopy PURECOPY' argument. */ + get_key_arg (QCpurecopy, nargs, args, used); /* See if there's a `:size SIZE' argument. */ i = get_key_arg (QCsize, nargs, args, used); Lisp_Object size_arg = i ? args[i] : Qnil; @@ -5108,8 +5087,7 @@ usage: (make-hash-table &rest KEYWORD-ARGS) */) signal_error ("Invalid argument list", args[i]); SAFE_FREE (); - return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak, - purecopy); + return make_hash_table (testdesc, size, rehash_size, rehash_threshold, weak); } diff --git a/src/fontset.c b/src/fontset.c index 332be6c39d1..0421ca49c73 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -2129,7 +2129,7 @@ syms_of_fontset (void) set_fontset_id (Vdefault_fontset, make_fixnum (0)); set_fontset_name (Vdefault_fontset, - build_pure_c_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); + build_string ("-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default")); ASET (Vfontset_table, 0, Vdefault_fontset); next_fontset_id = 1; PDUMPER_REMEMBER_SCALAR (next_fontset_id); @@ -2187,7 +2187,7 @@ alternate fontnames (if any) are tried instead. */); doc: /* Alist of fontset names vs the aliases. */); Vfontset_alias_alist = list1 (Fcons (FONTSET_NAME (Vdefault_fontset), - build_pure_c_string ("fontset-default"))); + build_string ("fontset-default"))); DEFVAR_LISP ("vertical-centering-font-regexp", Vvertical_centering_font_regexp, diff --git a/src/frame.c b/src/frame.c index e3d65dd28f3..5b8faa1b9e6 100644 --- a/src/frame.c +++ b/src/frame.c @@ -1179,7 +1179,7 @@ make_initial_frame (void) Vframe_list = Fcons (frame, Vframe_list); tty_frame_count = 1; - fset_name (f, build_pure_c_string ("F1")); + fset_name (f, build_string ("F1")); SET_FRAME_VISIBLE (f, 1); diff --git a/src/image.c b/src/image.c index b34dc3e9161..d49b7f7e834 100644 --- a/src/image.c +++ b/src/image.c @@ -4844,7 +4844,7 @@ xpm_make_color_table_h (void (**put_func) (Lisp_Object, const char *, int, *get_func = xpm_get_color_table_h; return make_hash_table (hashtest_equal, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Qnil); } static void diff --git a/src/intervals.c b/src/intervals.c index f88a41f2549..5b69af2449a 100644 --- a/src/intervals.c +++ b/src/intervals.c @@ -44,7 +44,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #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 @@ -101,7 +100,6 @@ create_root_interval (Lisp_Object parent) } else { - CHECK_IMPURE (parent, XSTRING (parent)); new->total_length = SCHARS (parent); eassert (TOTAL_LENGTH (new) >= 0); set_string_intervals (parent, new); diff --git a/src/json.c b/src/json.c index 3f1d27ad7fb..ccb0405c4e0 100644 --- a/src/json.c +++ b/src/json.c @@ -1110,8 +1110,8 @@ define_error (Lisp_Object name, const char *message, Lisp_Object parent) eassert (CONSP (parent_conditions)); eassert (!NILP (Fmemq (parent, parent_conditions))); eassert (NILP (Fmemq (name, parent_conditions))); - Fput (name, Qerror_conditions, pure_cons (name, parent_conditions)); - Fput (name, Qerror_message, build_pure_c_string (message)); + Fput (name, Qerror_conditions, Fcons (name, parent_conditions)); + Fput (name, Qerror_message, build_string (message)); } void diff --git a/src/keyboard.c b/src/keyboard.c index 47b5e590245..6004c6dfe33 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1109,8 +1109,6 @@ top_level_1 (Lisp_Object ignore) /* On entry to the outer level, run the startup file. */ if (!NILP (Vtop_level)) internal_condition_case (top_level_2, Qerror, cmd_error); - else if (!NILP (Vpurify_flag)) - message1 ("Bare impure Emacs (standard Lisp code not loaded)"); else message1 ("Bare Emacs (standard Lisp code not loaded)"); return Qnil; @@ -11462,14 +11460,14 @@ syms_of_keyboard (void) pending_funcalls = Qnil; staticpro (&pending_funcalls); - Vlispy_mouse_stem = build_pure_c_string ("mouse"); + Vlispy_mouse_stem = build_string ("mouse"); staticpro (&Vlispy_mouse_stem); - regular_top_level_message = build_pure_c_string ("Back to top level"); + regular_top_level_message = build_string ("Back to top level"); staticpro (®ular_top_level_message); #ifdef HAVE_STACK_OVERFLOW_HANDLING recover_top_level_message - = build_pure_c_string ("Re-entering top level after C stack overflow"); + = build_string ("Re-entering top level after C stack overflow"); staticpro (&recover_top_level_message); #endif DEFVAR_LISP ("internal--top-level-message", Vinternal__top_level_message, diff --git a/src/keymap.c b/src/keymap.c index fb8eceaec18..d5a977c5b72 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -50,7 +50,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "keyboard.h" #include "termhooks.h" #include "blockinput.h" -#include "puresize.h" #include "intervals.h" #include "keymap.h" #include "window.h" @@ -117,8 +116,6 @@ in case you use it as a menu with `x-popup-menu'. */) { if (!NILP (string)) { - if (!NILP (Vpurify_flag)) - string = Fpurecopy (string); return list2 (Qkeymap, string); } return list1 (Qkeymap); @@ -296,7 +293,6 @@ Return PARENT. PARENT should be nil or another keymap. */) If we came to the end, add the parent in PREV. */ if (!CONSP (list) || KEYMAPP (list)) { - CHECK_IMPURE (prev, XCONS (prev)); XSETCDR (prev, parent); return parent; } @@ -734,7 +730,7 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) /* If we are preparing to dump, and DEF is a menu element with a menu item indicator, copy it to ensure it is not pure. */ - if (CONSP (def) && PURE_P (XCONS (def)) + if (CONSP (def) && (EQ (XCAR (def), Qmenu_item) || STRINGP (XCAR (def)))) def = Fcons (XCAR (def), XCDR (def)); @@ -778,7 +774,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) { if (FIXNATP (idx) && XFIXNAT (idx) < ASIZE (elt)) { - CHECK_IMPURE (elt, XVECTOR (elt)); ASET (elt, XFIXNAT (idx), def); return def; } @@ -831,7 +826,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else if (EQ (idx, XCAR (elt))) { - CHECK_IMPURE (elt, XCONS (elt)); XSETCDR (elt, def); return def; } @@ -877,7 +871,6 @@ store_in_keymap (Lisp_Object keymap, register Lisp_Object idx, Lisp_Object def) } else elt = Fcons (idx, def); - CHECK_IMPURE (insertion_point, XCONS (insertion_point)); XSETCDR (insertion_point, Fcons (elt, XCDR (insertion_point))); } } @@ -3136,12 +3129,12 @@ syms_of_keymap (void) current_global_map = Qnil; staticpro (¤t_global_map); - exclude_keys = pure_list - (pure_cons (build_pure_c_string ("DEL"), build_pure_c_string ("\\d")), - pure_cons (build_pure_c_string ("TAB"), build_pure_c_string ("\\t")), - pure_cons (build_pure_c_string ("RET"), build_pure_c_string ("\\r")), - pure_cons (build_pure_c_string ("ESC"), build_pure_c_string ("\\e")), - pure_cons (build_pure_c_string ("SPC"), build_pure_c_string (" "))); + exclude_keys = list + (Fcons (build_string ("DEL"), build_string ("\\d")), + Fcons (build_string ("TAB"), build_string ("\\t")), + Fcons (build_string ("RET"), build_string ("\\r")), + Fcons (build_string ("ESC"), build_string ("\\e")), + Fcons (build_string ("SPC"), build_string (" "))); staticpro (&exclude_keys); DEFVAR_LISP ("minibuffer-local-map", Vminibuffer_local_map, @@ -3185,13 +3178,12 @@ be preferred. */); DEFSYM (Qmode_line, "mode-line"); staticpro (&Vmouse_events); - Vmouse_events = pure_list (Qmenu_bar, Qtab_bar, Qtool_bar, - Qtab_line, Qheader_line, Qmode_line, - intern_c_string ("mouse-1"), - intern_c_string ("mouse-2"), - intern_c_string ("mouse-3"), - intern_c_string ("mouse-4"), - intern_c_string ("mouse-5")); + Vmouse_events = list (Qmenu_bar, Qtool_bar, Qheader_line, Qmode_line, + intern_c_string ("mouse-1"), + intern_c_string ("mouse-2"), + intern_c_string ("mouse-3"), + intern_c_string ("mouse-4"), + intern_c_string ("mouse-5")); /* Keymap used for minibuffers when doing completion. */ /* Keymap used for minibuffers when doing completion and require a match. */ diff --git a/src/lisp.h b/src/lisp.h index 91b7a89d0f5..720e8895d46 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -824,9 +824,6 @@ struct Lisp_Symbol special (with `defvar' etc), and shouldn't be lexically bound. */ bool_bf declared_special : 1; - /* True if pointed to from purespace and hence can't be GC'd. */ - bool_bf pinned : 1; - /* The symbol's name, as a Lisp string. */ Lisp_Object name; @@ -1537,20 +1534,14 @@ STRING_MULTIBYTE (Lisp_Object str) /* Mark STR as a unibyte string. */ #define STRING_SET_UNIBYTE(STR) \ do { \ - if (XSTRING (STR)->u.s.size == 0) \ - (STR) = empty_unibyte_string; \ - else \ - XSTRING (STR)->u.s.size_byte = -1; \ + XSTRING (STR)->u.s.size_byte = -1; \ } while (false) /* Mark STR as a multibyte string. Assure that STR contains only ASCII characters in advance. */ -#define STRING_SET_MULTIBYTE(STR) \ - do { \ - if (XSTRING (STR)->u.s.size == 0) \ - (STR) = empty_multibyte_string; \ - else \ - XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \ +#define STRING_SET_MULTIBYTE(STR) \ + do { \ + XSTRING (STR)->u.s.size_byte = XSTRING (STR)->u.s.size; \ } while (false) /* Convenience functions for dealing with Lisp strings. */ @@ -2313,12 +2304,8 @@ struct Lisp_Hash_Table /* Index of first free entry in free list, or -1 if none. */ ptrdiff_t next_free; - /* True if the table can be purecopied. The table cannot be - changed afterwards. */ - bool purecopy; - /* True if the table is mutable. Ordinarily tables are mutable, but - pure tables are not, and while a table is being mutated it is + some tables are not, and while a table is being mutated it is immutable for recursive attempts to mutate it. */ bool mutable; @@ -3617,7 +3604,7 @@ Lisp_Object hashfn_eql (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_equal (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object hashfn_user_defined (Lisp_Object, struct Lisp_Hash_Table *); Lisp_Object make_hash_table (struct hash_table_test, EMACS_INT, float, float, - Lisp_Object, bool); + Lisp_Object); ptrdiff_t hash_lookup (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object *); ptrdiff_t hash_put (struct Lisp_Hash_Table *, Lisp_Object, Lisp_Object, Lisp_Object); @@ -3774,7 +3761,6 @@ extern void parse_str_as_multibyte (const unsigned char *, ptrdiff_t, /* Defined in alloc.c. */ 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); @@ -3832,11 +3818,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 { @@ -3909,17 +3892,6 @@ 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); - -/* 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. */ @@ -3929,7 +3901,6 @@ build_string (const char *str) return make_string (str, strlen (str)); } -extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_vector (ptrdiff_t, Lisp_Object); extern struct Lisp_Vector *allocate_nil_vector (ptrdiff_t); diff --git a/src/lread.c b/src/lread.c index bca53a9a37a..297848c0832 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2259,13 +2259,13 @@ readevalloop (Lisp_Object readcharfun, read_objects_map = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Qnil); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Qnil); if (!NILP (Vpurify_flag) && c == '(') { val = read_list (0, readcharfun); @@ -2482,12 +2482,12 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) || XHASH_TABLE (read_objects_map)->count) read_objects_map = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Qnil); if (! HASH_TABLE_P (read_objects_completed) || XHASH_TABLE (read_objects_completed)->count) read_objects_completed = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + DEFAULT_REHASH_THRESHOLD, Qnil); if (EQ (Vread_with_symbol_positions, Qt) || EQ (Vread_with_symbol_positions, stream)) Vread_symbol_positions_list = Qnil; @@ -3057,11 +3057,6 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (!NILP (params[param_count + 1])) param_count += 2; - params[param_count] = QCpurecopy; - params[param_count + 1] = Fplist_get (tmp, Qpurecopy); - if (!NILP (params[param_count + 1])) - param_count += 2; - /* This is the hash table data. */ data = Fplist_get (tmp, Qdata); @@ -3371,13 +3366,13 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* No symbol character follows, this is the empty symbol. */ UNREAD (c); - return Fmake_symbol (empty_unibyte_string); + return Fmake_symbol (build_string ("")); } goto read_symbol; } /* ## is the empty symbol. */ if (c == '#') - return Fintern (empty_unibyte_string, Qnil); + return Fintern (build_string (""), Qnil); if (c >= '0' && c <= '9') { @@ -3773,9 +3768,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (uninterned_symbol) { Lisp_Object name - = ((! NILP (Vpurify_flag) - ? make_pure_string : make_specified_string) - (read_buffer, nchars, nbytes, multibyte)); + = make_specified_string (read_buffer, nchars, nbytes, + multibyte); result = Fmake_symbol (name); } else @@ -4364,16 +4358,8 @@ intern_c_string_1 (const char *str, ptrdiff_t len) Lisp_Object tem = oblookup (obarray, str, len, len); if (!SYMBOLP (tem)) - { - Lisp_Object string; + tem = intern_driver (make_string (str, len), obarray, tem); - if (NILP (Vpurify_flag)) - string = make_string (str, len); - else - string = make_pure_c_string (str, len); - - tem = intern_driver (string, obarray, tem); - } return tem; } @@ -4381,7 +4367,7 @@ static void define_symbol (Lisp_Object sym, char const *str) { ptrdiff_t len = strlen (str); - Lisp_Object string = make_pure_c_string (str, len); + Lisp_Object string = make_string (str, len); init_symbol (sym, string); /* Qunbound is uninterned, so that it's not confused with any symbol @@ -4408,8 +4394,7 @@ it defaults to the value of `obarray'. */) tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); if (!SYMBOLP (tem)) - tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), - obarray, tem); + tem = intern_driver (string, obarray, tem); return tem; } @@ -5061,20 +5046,20 @@ This list includes suffixes for both compiled and source Emacs Lisp files. This list should not include the empty string. `load' and related functions try to append these suffixes, in order, to the specified file name if a suffix is allowed or required. */); - Vload_suffixes = list2 (build_pure_c_string (".elc"), - build_pure_c_string (".el")); + Vload_suffixes = list2 (build_string (".elc"), + build_string (".el")); #ifdef HAVE_MODULES - Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes); + Vload_suffixes = Fcons (build_string (MODULES_SUFFIX), Vload_suffixes); #ifdef MODULES_SECONDARY_SUFFIX Vload_suffixes = - Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); + Fcons (build_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes); #endif #endif DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix, doc: /* Suffix of loadable module file, or nil if modules are not supported. */); #ifdef HAVE_MODULES - Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX); + Vmodule_file_suffix = build_string (MODULES_SUFFIX); #else Vmodule_file_suffix = Qnil; #endif @@ -5225,7 +5210,7 @@ from the file, and matches them against this regular expression. When the regular expression matches, the file is considered to be safe to load. */); Vbytecomp_version_regexp - = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); + = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); DEFSYM (Qlexical_binding, "lexical-binding"); DEFVAR_LISP ("lexical-binding", Vlexical_binding, diff --git a/src/pdumper.c b/src/pdumper.c index dfc7388b634..02399b35e2a 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2419,7 +2419,7 @@ dump_symbol (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_999DC26DEC +#if CHECK_STRUCTS && !defined HASH_Lisp_Symbol_DD2E6013B4 # error "Lisp_Symbol changed. See CHECK_STRUCTS comment in config.h." #endif #if CHECK_STRUCTS && !defined (HASH_symbol_redirect_ADB4F5B113) @@ -2456,7 +2456,6 @@ dump_symbol (struct dump_context *ctx, DUMP_FIELD_COPY (&out, symbol, u.s.trapped_write); DUMP_FIELD_COPY (&out, symbol, u.s.interned); DUMP_FIELD_COPY (&out, symbol, u.s.declared_special); - DUMP_FIELD_COPY (&out, symbol, u.s.pinned); dump_field_lv (ctx, &out, symbol, &symbol->u.s.name, WEIGHT_STRONG); switch (symbol->u.s.redirect) { @@ -2673,7 +2672,7 @@ dump_hash_table (struct dump_context *ctx, Lisp_Object object, dump_off offset) { -#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_6D63EDB618 +#if CHECK_STRUCTS && !defined HASH_Lisp_Hash_Table_203821C7EF # error "Lisp_Hash_Table changed. See CHECK_STRUCTS comment in config.h." #endif const struct Lisp_Hash_Table *hash_in = XHASH_TABLE (object); @@ -2689,7 +2688,6 @@ dump_hash_table (struct dump_context *ctx, them as close to the hash table as possible. */ DUMP_FIELD_COPY (out, hash, count); DUMP_FIELD_COPY (out, hash, next_free); - DUMP_FIELD_COPY (out, hash, purecopy); DUMP_FIELD_COPY (out, hash, mutable); DUMP_FIELD_COPY (out, hash, rehash_threshold); DUMP_FIELD_COPY (out, hash, rehash_size); @@ -5752,8 +5750,6 @@ thaw_hash_tables (void) hash_table_thaw (AREF (hash_tables, i)); } -#endif /* HAVE_PDUMPER */ - void init_pdumper_once (void) @@ -5762,6 +5758,7 @@ init_pdumper_once (void) pdumper_do_now_and_after_load (thaw_hash_tables); #endif } +#endif /* HAVE_PDUMPER */ void syms_of_pdumper (void) diff --git a/src/print.c b/src/print.c index d4301fd7b64..7172e67b950 100644 --- a/src/print.c +++ b/src/print.c @@ -1581,12 +1581,6 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_object (Fhash_table_rehash_threshold (obj), printcharfun, escapeflag); - if (h->purecopy) - { - print_c_string (" purecopy ", printcharfun); - print_object (h->purecopy ? Qt : Qnil, printcharfun, escapeflag); - } - print_c_string (" data ", printcharfun); /* Print the data here as a plist. */ diff --git a/src/process.c b/src/process.c index 47a2a6f1a31..f3b5d05daa2 100644 --- a/src/process.c +++ b/src/process.c @@ -8567,7 +8567,7 @@ amounts of data in one go. */); const struct socket_options *sopt; #define ADD_SUBFEATURE(key, val) \ - subfeatures = pure_cons (pure_cons (key, pure_cons (val, Qnil)), subfeatures) + subfeatures = Fcons (Fcons (key, Fcons (val, Qnil)), subfeatures) ADD_SUBFEATURE (QCnowait, Qt); #ifdef DATAGRAM_SOCKETS @@ -8589,7 +8589,7 @@ amounts of data in one go. */); ADD_SUBFEATURE (QCserver, Qt); for (sopt = socket_options; sopt->name; sopt++) - subfeatures = pure_cons (intern_c_string (sopt->name), subfeatures); + subfeatures = Fcons (intern_c_string (sopt->name), subfeatures); Fprovide (intern_c_string ("make-network-process"), subfeatures); } diff --git a/src/profiler.c b/src/profiler.c index 21ae2447aa4..44bf57eba20 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -63,7 +63,7 @@ make_log (void) Lisp_Object log = make_hash_table (hashtest_profiler, heap_size, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Qnil); struct Lisp_Hash_Table *h = XHASH_TABLE (log); /* What is special about our hash-tables is that the values are pre-filled diff --git a/src/puresize.h b/src/puresize.h deleted file mode 100644 index 811d0b4d369..00000000000 --- a/src/puresize.h +++ /dev/null @@ -1,115 +0,0 @@ -/* How much read-only Lisp storage a dumped Emacs needs. - Copyright (C) 1993, 2001-2021 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ - -#ifndef EMACS_PURESIZE_H -#define EMACS_PURESIZE_H - -#include "lisp.h" - -INLINE_HEADER_BEGIN - -/* Define PURESIZE, the number of bytes of pure Lisp code to leave space for. - - At one point, this was defined in config.h, meaning that changing - PURESIZE would make Make recompile all of Emacs. But only a few - files actually use PURESIZE, so we split it out to its own .h file. - - Make sure to include this file after config.h, since that tells us - whether we are running X windows, which tells us how much pure - storage to allocate. */ - -/* First define a measure of the amount of data we have. */ - -/* A system configuration file may set this to request a certain extra - amount of storage. This is a lot more update-robust that defining - BASE_PURESIZE or even PURESIZE directly. */ -#ifndef SYSTEM_PURESIZE_EXTRA -#define SYSTEM_PURESIZE_EXTRA 0 -#endif - -#ifndef SITELOAD_PURESIZE_EXTRA -#define SITELOAD_PURESIZE_EXTRA 0 -#endif - -#ifndef BASE_PURESIZE -#define BASE_PURESIZE (2000000 + SYSTEM_PURESIZE_EXTRA + SITELOAD_PURESIZE_EXTRA) -#endif - -/* Increase BASE_PURESIZE by a ratio depending on the machine's word size. */ -#ifndef PURESIZE_RATIO -#if EMACS_INT_MAX >> 31 != 0 -#if PTRDIFF_MAX >> 31 != 0 -#define PURESIZE_RATIO 10 / 6 /* Don't surround with `()'. */ -#else -#define PURESIZE_RATIO 8 / 6 /* Don't surround with `()'. */ -#endif -#else -#define PURESIZE_RATIO 1 -#endif -#endif - -#ifdef ENABLE_CHECKING -/* ENABLE_CHECKING somehow increases the purespace used, probably because - it tends to cause some macro arguments to be evaluated twice. This is - a bug, but it's difficult to track it down. */ -#define PURESIZE_CHECKING_RATIO 12 / 10 /* Don't surround with `()'. */ -#else -#define PURESIZE_CHECKING_RATIO 1 -#endif - -/* This is the actual size in bytes to allocate. */ -#ifndef PURESIZE -#define PURESIZE (BASE_PURESIZE * PURESIZE_RATIO * PURESIZE_CHECKING_RATIO) -#endif - -extern AVOID pure_write_error (Lisp_Object); - -extern EMACS_INT pure[]; - -/* The puresize_h_* macros are private to this include file. */ - -/* True if PTR is pure. */ - -#define puresize_h_PURE_P(ptr) \ - ((uintptr_t) (ptr) - (uintptr_t) pure <= PURESIZE) - -INLINE bool -PURE_P (void *ptr) -{ - return puresize_h_PURE_P (ptr); -} - -/* Signal an error if OBJ is pure. PTR is OBJ untagged. */ - -#define puresize_h_CHECK_IMPURE(obj, ptr) \ - (PURE_P (ptr) ? pure_write_error (obj) : (void) 0) - -INLINE void -CHECK_IMPURE (Lisp_Object obj, void *ptr) -{ - puresize_h_CHECK_IMPURE (obj, ptr); -} - -#if DEFINE_KEY_OPS_AS_MACROS -# define PURE_P(ptr) puresize_h_PURE_P (ptr) -# define CHECK_IMPURE(obj, ptr) puresize_h_CHECK_IMPURE (obj, ptr) -#endif - -INLINE_HEADER_END - -#endif /* EMACS_PURESIZE_H */ diff --git a/src/search.c b/src/search.c index df384e1dcff..768decac48d 100644 --- a/src/search.c +++ b/src/search.c @@ -3353,19 +3353,19 @@ syms_of_search (void) DEFSYM (Qinvalid_regexp, "invalid-regexp"); Fput (Qsearch_failed, Qerror_conditions, - pure_list (Qsearch_failed, Qerror)); + list (Qsearch_failed, Qerror)); Fput (Qsearch_failed, Qerror_message, - build_pure_c_string ("Search failed")); + build_string ("Search failed")); Fput (Quser_search_failed, Qerror_conditions, - pure_list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror)); + list (Quser_search_failed, Quser_error, Qsearch_failed, Qerror)); Fput (Quser_search_failed, Qerror_message, - build_pure_c_string ("Search failed")); + build_string ("Search failed")); Fput (Qinvalid_regexp, Qerror_conditions, - pure_list (Qinvalid_regexp, Qerror)); + list (Qinvalid_regexp, Qerror)); Fput (Qinvalid_regexp, Qerror_message, - build_pure_c_string ("Invalid regexp")); + build_string ("Invalid regexp")); re_match_object = Qnil; staticpro (&re_match_object); diff --git a/src/syntax.c b/src/syntax.c index 9fbf88535f3..993f91af19a 100644 --- a/src/syntax.c +++ b/src/syntax.c @@ -3719,9 +3719,9 @@ syms_of_syntax (void) DEFSYM (Qscan_error, "scan-error"); Fput (Qscan_error, Qerror_conditions, - pure_list (Qscan_error, Qerror)); + list (Qscan_error, Qerror)); Fput (Qscan_error, Qerror_message, - build_pure_c_string ("Scan error")); + build_string ("Scan error")); DEFVAR_BOOL ("parse-sexp-ignore-comments", parse_sexp_ignore_comments, doc: /* Non-nil means `forward-sexp', etc., should treat comments as whitespace. */); diff --git a/src/w32fns.c b/src/w32fns.c index 14d1154a2bc..204d2d9514e 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -10370,9 +10370,9 @@ syms_of_w32fns (void) DEFSYM (Qjson, "json"); Fput (Qundefined_color, Qerror_conditions, - pure_list (Qundefined_color, Qerror)); + list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, - build_pure_c_string ("Undefined color")); + build_string ("Undefined color")); staticpro (&w32_grabbed_keys); w32_grabbed_keys = Qnil; diff --git a/src/xdisp.c b/src/xdisp.c index 4841a0af6f3..766f7f3613f 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -34902,7 +34902,7 @@ be let-bound around code that needs to disable messages temporarily. */); staticpro (&echo_area_buffer[0]); staticpro (&echo_area_buffer[1]); - Vmessages_buffer_name = build_pure_c_string ("*Messages*"); + Vmessages_buffer_name = build_string ("*Messages*"); staticpro (&Vmessages_buffer_name); mode_line_proptrans_alist = Qnil; @@ -34994,7 +34994,7 @@ See also `overlay-arrow-string'. */); DEFVAR_LISP ("overlay-arrow-string", Voverlay_arrow_string, doc: /* String to display as an arrow in non-window frames. See also `overlay-arrow-position'. */); - Voverlay_arrow_string = build_pure_c_string ("=>"); + Voverlay_arrow_string = build_string ("=>"); DEFVAR_LISP ("overlay-arrow-variable-list", Voverlay_arrow_variable_list, doc: /* List of variables (symbols) which hold markers for overlay arrows. @@ -35119,17 +35119,17 @@ which no explicit name has been set (see `modify-frame-parameters'). */); This variable has the same structure as `mode-line-format' (which see), and is used only on frames for which no explicit name has been set \(see `modify-frame-parameters'). */); - /* Do not nest calls to pure_list. This works around a bug in + /* Do not nest calls to list. This works around a bug in Oracle Developer Studio 12.6. */ Lisp_Object icon_title_name_format - = pure_list (empty_unibyte_string, - build_pure_c_string ("%b - GNU Emacs at "), - intern_c_string ("system-name")); + = list (empty_unibyte_string, + build_string ("%b - GNU Emacs at "), + intern_c_string ("system-name")); Vicon_title_format = Vframe_title_format - = pure_list (intern_c_string ("multiple-frames"), - build_pure_c_string ("%b"), - icon_title_name_format); + = list (intern_c_string ("multiple-frames"), + build_string ("%b"), + icon_title_name_format); DEFVAR_LISP ("message-log-max", Vmessage_log_max, doc: /* Maximum number of lines to keep in the message log buffer. diff --git a/src/xfaces.c b/src/xfaces.c index ab4440f46ad..6cb08b0475c 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -7044,7 +7044,7 @@ only for this purpose. */); This stipple pattern is used on monochrome displays instead of shades of gray for a face background color. See `set-face-stipple' for possible values for this variable. */); - Vface_default_stipple = build_pure_c_string ("gray3"); + Vface_default_stipple = build_string ("gray3"); DEFVAR_LISP ("tty-defined-color-alist", Vtty_defined_color_alist, doc: /* An alist of defined terminal colors and their RGB values. diff --git a/src/xfns.c b/src/xfns.c index e46616e6d66..4ee0a7b3388 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -7850,9 +7850,9 @@ syms_of_xfns (void) #endif Fput (Qundefined_color, Qerror_conditions, - pure_list (Qundefined_color, Qerror)); + list (Qundefined_color, Qerror)); Fput (Qundefined_color, Qerror_message, - build_pure_c_string ("Undefined color")); + build_string ("Undefined color")); DEFVAR_LISP ("x-pointer-shape", Vx_pointer_shape, doc: /* The shape of the pointer when over text. @@ -8063,7 +8063,7 @@ eliminated in future versions of Emacs. */); char gtk_version[sizeof ".." + 3 * INT_STRLEN_BOUND (int)]; int len = sprintf (gtk_version, "%d.%d.%d", GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION); - Vgtk_version_string = make_pure_string (gtk_version, len, len, false); + Vgtk_version_string = make_specified_string (gtk_version, len, len, false); } #endif /* USE_GTK */ @@ -8077,7 +8077,8 @@ eliminated in future versions of Emacs. */); int len = sprintf (cairo_version, "%d.%d.%d", CAIRO_VERSION_MAJOR, CAIRO_VERSION_MINOR, CAIRO_VERSION_MICRO); - Vcairo_version_string = make_pure_string (cairo_version, len, len, false); + Vcairo_version_string = make_specified_string (cairo_version, len, len, + false); } #endif diff --git a/src/xterm.c b/src/xterm.c index 1887c3255d4..76de294d398 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -13642,7 +13642,7 @@ syms_of_xterm (void) DEFSYM (Qlatin_1, "latin-1"); #ifdef USE_GTK - xg_default_icon_file = build_pure_c_string ("icons/hicolor/scalable/apps/emacs.svg"); + xg_default_icon_file = build_string ("icons/hicolor/scalable/apps/emacs.svg"); staticpro (&xg_default_icon_file); DEFSYM (Qx_gtk_map_stock, "x-gtk-map-stock"); @@ -13763,7 +13763,7 @@ If set to a non-float value, there will be no wait at all. */); Vx_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD, - Qnil, false); + Qnil); DEFVAR_BOOL ("x-frame-normalize-before-maximize", x_frame_normalize_before_maximize, |