Remove purespace and ancillary codescratch/no-purespace-old

Now that purespace is not used any more, remove it, along with the functions
used to allocate into it.  Use equivalent functions allocating into the
normal heap.
Remove calls to PURE_P since they always return false.

* src/puresize.h: Delete file.

* src/alloc.c: Don't include `puresize.h` any more.
(pure, purebeg, pure_size, pure_bytes_used_before_overflow)
(pure_bytes_used_lisp, pure_bytes_used_non_lisp, symbol_block_pinned)
(pinned_objects): Delete vars.
(PUREBEG): Delete macro.
(pointer_align): Move after definition of USE_ALIGNED_ALLOC and only
define it if USE_ALIGNED_ALLOC is not used.
(cons_listn): Remove `cons` arg, hardcode `Fcons` instead.
(pure_listn, pure_alloc, check_pure_size, make_pure_string)
(make_pure_c_string, pure_cons): Delete functions.
(init_symbol): Don't set `pinned` any more.
(mark_pinned_objects, mark_pinned_symbols): Delete functions.
(garbage_collect): Don't call them any more.
(init_alloc_once_for_pdumper): Don't initialize purebeg and pure_size.

* src/print.c (print_object) <PVEC_HASH_TABLE>: Don't print `purecopy`.

* src/pdumper.c (dump_symbol, dump_hash_table): Update sig hash.
(dump_symbol): Don't dump `pinned`.
(dump_hash_table): Don't dump `purecopy`.

* src/lread.c (readevalloop, read_internal_start): Adjust call to
`make_hash_table`.
(read0, intern_c_string_1, define_symbol, Fintern): Don't purify
symbol names.
(string): Avoid `pure_cons` and `build_pure_c_string`.

* src/lisp.h (struct Lisp_Symbol): Remove `pinned` field.
(struct Lisp_Hash_Table): Remove `purecopy` field.
(check_pure_size, pure_listn, pure_list, make_pure_string)
(make_pure_c_string, pure_cons): Remove prototypes.
(build_pure_c_string): Delete function.

* src/keymap.c: Don't include `puresize.h` any more.
(Fmake_sparse_keymap): Don't purecopy the menu name.
(Fset_keymap_parent, store_in_keymap): Don't `CHECK_IMPURE` any more.
(syms_of_keymap): Avoid `pure_cons` and `build_pure_c_string`.

* src/intervals.c: Don't include `puresize.h` any more.
(create_root_interval): Don't `CHECK_IMPURE` any more.

* src/fns.c: Don't include `puresize.h` any more.
(Ffillarray, Fclear_string): Don't `CHECK_IMPURE` any more.
(make_hash_table): Remove `purecopy` arg.
(Fmake_hash_table): Remove `:purecopy` keyword argument.

* src/eval.c (Finternal__define_uninitialized_variable): Don't purecopy
the doc any more.
(Fdefconst_1): Don't purecopy the initvalue any more.
(Fautoload): Get rid of hack needed when we used hash-consing.
(syms_of_eval): Avoid `build_pure_c_string`.

* src/emacs.c: Don't include `puresize.h` any more.
(Fdump_emacs): Don't `check_pure_size`.

* src/doc.c (Fsnarf_documentation): Don't purecopy the build files.

* src/deps.mk: Remove puresize.h.

* src/data.c: Don't include `puresize.h` any more.
(pure_write_error): Delete function.
(Fsetcar, Fsetcdr): Don't `CHECK_IMPURE` any more.
(Fdefalias): Don't purecopy the definition any more.
(Faset): Don't `CHECK_IMPURE` any more.
(syms_of_data): Avoid `pure_cons` and `build_pure_c_string`.

* src/conf_post.h (SYSTEM_PURESIZE_EXTRA): Delete macro.

* src/comp.c: Don't include `puresize.h` any more.
(helper_link_table): Remove `pure_write_error`.
(define_CHECK_IMPURE): Delete function.
(maybe_defer_native_compilation, syms_of_comp):
Avoid `build_pure_c_string`.

* src/category.c (hash_get_category_set): Update call to `make_hash_table`.
(Fdefine_category): Don't purecopy the docstring any more.

* src/bytecode.c: Don't include `puresize.h` any more.
(Bsetcar, Bsetcdr): Don't `CHECK_IMPURE` any more.

* doc/lispref/internals.texi (Pure Storage): Delete section.
(Garbage Collection): Remove note about purespace overflow.

* src/xfaces.c (syms_of_xfaces):
* src/emacs-module.c (syms_of_module):
* src/frame.c (make_frame, make_initial_frame):
* src/fileio.c (syms_of_fileio):
* src/image.c (xpm_make_color_table_h):
* src/process.c (ADD_SUBFEATURE, syms_of_process):
* src/profiler.c (make_log):
* src/json.c (define_error):
* src/xterm.c (syms_of_xterm):
* src/xfns.c (syms_of_xfns):
* src/xdisp.c (syms_of_xdisp):
* src/w32fns.c (syms_of_w32fns):
* src/syntax.c (syms_of_syntax):
* src/sqlite.c (syms_of_sqlite):
* src/search.c (syms_of_search):
* src/keyboard.c (syms_of_keyboard):
* src/fontset.c (syms_of_fontset):
* src/dbusbind.c (syms_of_dbusbind):
* src/coding.c (syms_of_coding):
* src/callint.c (syms_of_callint):
* src/buffer.c (init_buffer_once, syms_of_buffer):
Avoid `build_pure_c_string`, `Fpurecopy`, `pure_cons`, and `pure_list`,
and adjust calls to `make_hash_table`.

1 files changed, 35 insertions, 239 deletions

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