]> code.delx.au - gnu-emacs/blobdiff - src/alloc.c
Fix last change to isearch-update (bug#23406)
[gnu-emacs] / src / alloc.c
index 1f4b1a4694e7cf777b1365539a26fe7df22a66f0..4c9cbf1072470d48ea1027addad256ae3d31ea39 100644 (file)
@@ -1,14 +1,14 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
 
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
 
-Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2015 Free Software
+Copyright (C) 1985-1986, 1988, 1993-1995, 1997-2016 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
 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.
+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
 
 GNU Emacs is distributed in the hope that it will be useful,
 but WITHOUT ANY WARRANTY; without even the implied warranty of
@@ -32,9 +32,10 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 #endif
 
 #include "lisp.h"
 #endif
 
 #include "lisp.h"
-#include "process.h"
+#include "dispextern.h"
 #include "intervals.h"
 #include "puresize.h"
 #include "intervals.h"
 #include "puresize.h"
+#include "systime.h"
 #include "character.h"
 #include "buffer.h"
 #include "window.h"
 #include "character.h"
 #include "buffer.h"
 #include "window.h"
@@ -69,11 +70,7 @@ along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
 static bool valgrind_p;
 #endif
 
 static bool valgrind_p;
 #endif
 
-/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.
-   Doable only if GC_MARK_STACK.  */
-#if ! GC_MARK_STACK
-# undef GC_CHECK_MARKED_OBJECTS
-#endif
+/* GC_CHECK_MARKED_OBJECTS means do sanity checks on allocated objects.  */
 
 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
    memory.  Can do this only if using gmalloc.c and if not checking
 
 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
    memory.  Can do this only if using gmalloc.c and if not checking
@@ -95,6 +92,18 @@ static bool valgrind_p;
 #include "w32heap.h"   /* for sbrk */
 #endif
 
 #include "w32heap.h"   /* for sbrk */
 #endif
 
+#if defined DOUG_LEA_MALLOC || defined GNU_LINUX
+/* The address where the heap starts.  */
+void *
+my_heap_start (void)
+{
+  static void *start;
+  if (! start)
+    start = sbrk (0);
+  return start;
+}
+#endif
+
 #ifdef DOUG_LEA_MALLOC
 
 #include <malloc.h>
 #ifdef DOUG_LEA_MALLOC
 
 #include <malloc.h>
@@ -104,7 +113,69 @@ static bool valgrind_p;
 
 #define MMAP_MAX_AREAS 100000000
 
 
 #define MMAP_MAX_AREAS 100000000
 
-#endif /* not DOUG_LEA_MALLOC */
+/* A pointer to the memory allocated that copies that static data
+   inside glibc's malloc.  */
+static void *malloc_state_ptr;
+
+/* Get and free this pointer; useful around unexec.  */
+void
+alloc_unexec_pre (void)
+{
+  malloc_state_ptr = malloc_get_state ();
+}
+void
+alloc_unexec_post (void)
+{
+  free (malloc_state_ptr);
+}
+
+/* Restore the dumped malloc state.  Because malloc can be invoked
+   even before main (e.g. by the dynamic linker), the dumped malloc
+   state must be restored as early as possible using this special hook.  */
+static void
+malloc_initialize_hook (void)
+{
+  static bool malloc_using_checking;
+
+  if (! initialized)
+    {
+      my_heap_start ();
+      malloc_using_checking = getenv ("MALLOC_CHECK_") != NULL;
+    }
+  else
+    {
+      if (!malloc_using_checking)
+       {
+         /* Work around a bug in glibc's malloc.  MALLOC_CHECK_ must be
+            ignored if the heap to be restored was constructed without
+            malloc checking.  Can't use unsetenv, since that calls malloc.  */
+         char **p = environ;
+         if (p)
+           for (; *p; p++)
+             if (strncmp (*p, "MALLOC_CHECK_=", 14) == 0)
+               {
+                 do
+                   *p = p[1];
+                 while (*++p);
+
+                 break;
+               }
+       }
+
+      malloc_set_state (malloc_state_ptr);
+# ifndef XMALLOC_OVERRUN_CHECK
+      alloc_unexec_post ();
+# endif
+    }
+}
+
+# ifndef __MALLOC_HOOK_VOLATILE
+#  define __MALLOC_HOOK_VOLATILE
+# endif
+voidfuncptr __MALLOC_HOOK_VOLATILE __malloc_initialize_hook
+  = malloc_initialize_hook;
+
+#endif
 
 /* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
    to a struct Lisp_String.  */
 
 /* Mark, unmark, query mark bit of a Lisp string.  S must be a pointer
    to a struct Lisp_String.  */
@@ -183,11 +254,6 @@ static ptrdiff_t pure_size;
 
 static ptrdiff_t pure_bytes_used_before_overflow;
 
 
 static ptrdiff_t pure_bytes_used_before_overflow;
 
-/* True if P points into pure space.  */
-
-#define PURE_POINTER_P(P)                                      \
-  ((uintptr_t) (P) - (uintptr_t) purebeg <= pure_size)
-
 /* Index in pure at which next pure Lisp object will be allocated..  */
 
 static ptrdiff_t pure_bytes_used_lisp;
 /* Index in pure at which next pure Lisp object will be allocated..  */
 
 static ptrdiff_t pure_bytes_used_lisp;
@@ -298,8 +364,6 @@ enum mem_type
   MEM_TYPE_SPARE
 };
 
   MEM_TYPE_SPARE
 };
 
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
-
 /* A unique object in pure space used to make some Lisp objects
    on free lists recognizable in O(1).  */
 
 /* A unique object in pure space used to make some Lisp objects
    on free lists recognizable in O(1).  */
 
@@ -380,16 +444,10 @@ static void mem_delete (struct mem_node *);
 static void mem_delete_fixup (struct mem_node *);
 static struct mem_node *mem_find (void *);
 
 static void mem_delete_fixup (struct mem_node *);
 static struct mem_node *mem_find (void *);
 
-#endif /* GC_MARK_STACK || GC_MALLOC_CHECK */
-
 #ifndef DEADP
 # define DEADP(x) 0
 #endif
 
 #ifndef DEADP
 # define DEADP(x) 0
 #endif
 
-/* Recording what needs to be marked for gc.  */
-
-struct gcpro *gcprolist;
-
 /* Addresses of staticpro'd variables.  Initialize it to a nonzero
    value; otherwise some compilers put it into BSS.  */
 
 /* Addresses of staticpro'd variables.  Initialize it to a nonzero
    value; otherwise some compilers put it into BSS.  */
 
@@ -418,12 +476,48 @@ ALIGN (void *ptr, int alignment)
   return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
 }
 
   return (void *) ROUNDUP ((uintptr_t) ptr, alignment);
 }
 
+/* Extract the pointer hidden within A, if A is not a symbol.
+   If A is a symbol, extract the hidden pointer's offset from lispsym,
+   converted to void *.  */
+
+#define macro_XPNTR_OR_SYMBOL_OFFSET(a) \
+  ((void *) (intptr_t) (USE_LSB_TAG ? XLI (a) - XTYPE (a) : XLI (a) & VALMASK))
+
+/* Extract the pointer hidden within A.  */
+
+#define macro_XPNTR(a) \
+  ((void *) ((intptr_t) XPNTR_OR_SYMBOL_OFFSET (a) \
+            + (SYMBOLP (a) ? (char *) lispsym : NULL)))
+
+/* For pointer access, define XPNTR and XPNTR_OR_SYMBOL_OFFSET as
+   functions, as functions are cleaner and can be used in debuggers.
+   Also, define them as macros if being compiled with GCC without
+   optimization, for performance in that case.  The macro_* names are
+   private to this section of code.  */
+
+static ATTRIBUTE_UNUSED void *
+XPNTR_OR_SYMBOL_OFFSET (Lisp_Object a)
+{
+  return macro_XPNTR_OR_SYMBOL_OFFSET (a);
+}
+static ATTRIBUTE_UNUSED void *
+XPNTR (Lisp_Object a)
+{
+  return macro_XPNTR (a);
+}
+
+#if DEFINE_KEY_OPS_AS_MACROS
+# define XPNTR_OR_SYMBOL_OFFSET(a) macro_XPNTR_OR_SYMBOL_OFFSET (a)
+# define XPNTR(a) macro_XPNTR (a)
+#endif
+
 static void
 XFLOAT_INIT (Lisp_Object f, double n)
 {
   XFLOAT (f)->u.data = n;
 }
 
 static void
 XFLOAT_INIT (Lisp_Object f, double n)
 {
   XFLOAT (f)->u.data = n;
 }
 
+#ifdef DOUG_LEA_MALLOC
 static bool
 pointers_fit_in_lispobj_p (void)
 {
 static bool
 pointers_fit_in_lispobj_p (void)
 {
@@ -440,6 +534,7 @@ mmap_lisp_allowed_p (void)
      regions.  */
   return pointers_fit_in_lispobj_p () && !might_dump;
 }
      regions.  */
   return pointers_fit_in_lispobj_p () && !might_dump;
 }
+#endif
 
 /* Head of a circularly-linked list of extant finalizers. */
 static struct Lisp_Finalizer finalizers;
 
 /* Head of a circularly-linked list of extant finalizers. */
 static struct Lisp_Finalizer finalizers;
@@ -528,12 +623,8 @@ buffer_memory_full (ptrdiff_t nbytes)
    alignment that Emacs needs for C types and for USE_LSB_TAG.  */
 #define XMALLOC_BASE_ALIGNMENT alignof (max_align_t)
 
    alignment that Emacs needs for C types and for USE_LSB_TAG.  */
 #define XMALLOC_BASE_ALIGNMENT alignof (max_align_t)
 
-#if USE_LSB_TAG
-# define XMALLOC_HEADER_ALIGNMENT \
-    COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT)
-#else
-# define XMALLOC_HEADER_ALIGNMENT XMALLOC_BASE_ALIGNMENT
-#endif
+#define XMALLOC_HEADER_ALIGNMENT \
+   COMMON_MULTIPLE (GCALIGNMENT, XMALLOC_BASE_ALIGNMENT)
 #define XMALLOC_OVERRUN_SIZE_SIZE                              \
    (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t)             \
       + XMALLOC_HEADER_ALIGNMENT - 1)                          \
 #define XMALLOC_OVERRUN_SIZE_SIZE                              \
    (((XMALLOC_OVERRUN_CHECK_SIZE + sizeof (size_t)             \
       + XMALLOC_HEADER_ALIGNMENT - 1)                          \
@@ -711,8 +802,10 @@ malloc_unblock_input (void)
       malloc_probe (size);                     \
   } while (0)
 
       malloc_probe (size);                     \
   } while (0)
 
+static void *lmalloc (size_t) ATTRIBUTE_MALLOC_SIZE ((1));
+static void *lrealloc (void *, size_t);
 
 
-/* Like malloc but check for no memory and block interrupt input..  */
+/* Like malloc but check for no memory and block interrupt input.  */
 
 void *
 xmalloc (size_t size)
 
 void *
 xmalloc (size_t size)
@@ -720,7 +813,7 @@ xmalloc (size_t size)
   void *val;
 
   MALLOC_BLOCK_INPUT;
   void *val;
 
   MALLOC_BLOCK_INPUT;
-  val = malloc (size);
+  val = lmalloc (size);
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
@@ -737,7 +830,7 @@ xzalloc (size_t size)
   void *val;
 
   MALLOC_BLOCK_INPUT;
   void *val;
 
   MALLOC_BLOCK_INPUT;
-  val = malloc (size);
+  val = lmalloc (size);
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
@@ -758,9 +851,9 @@ xrealloc (void *block, size_t size)
   /* We must call malloc explicitly when BLOCK is 0, since some
      reallocs don't do this.  */
   if (! block)
   /* We must call malloc explicitly when BLOCK is 0, since some
      reallocs don't do this.  */
   if (! block)
-    val = malloc (size);
+    val = lmalloc (size);
   else
   else
-    val = realloc (block, size);
+    val = lrealloc (block, size);
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
   MALLOC_UNBLOCK_INPUT;
 
   if (!val && size)
@@ -798,9 +891,10 @@ void *
 xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
 {
   eassert (0 <= nitems && 0 < item_size);
 xnmalloc (ptrdiff_t nitems, ptrdiff_t item_size)
 {
   eassert (0 <= nitems && 0 < item_size);
-  if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
+  ptrdiff_t nbytes;
+  if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
     memory_full (SIZE_MAX);
     memory_full (SIZE_MAX);
-  return xmalloc (nitems * item_size);
+  return xmalloc (nbytes);
 }
 
 
 }
 
 
@@ -811,9 +905,10 @@ void *
 xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
 {
   eassert (0 <= nitems && 0 < item_size);
 xnrealloc (void *pa, ptrdiff_t nitems, ptrdiff_t item_size)
 {
   eassert (0 <= nitems && 0 < item_size);
-  if (min (PTRDIFF_MAX, SIZE_MAX) / item_size < nitems)
+  ptrdiff_t nbytes;
+  if (INT_MULTIPLY_WRAPV (nitems, item_size, &nbytes) || SIZE_MAX < nbytes)
     memory_full (SIZE_MAX);
     memory_full (SIZE_MAX);
-  return xrealloc (pa, nitems * item_size);
+  return xrealloc (pa, nbytes);
 }
 
 
 }
 
 
@@ -844,33 +939,43 @@ void *
 xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
         ptrdiff_t nitems_max, ptrdiff_t item_size)
 {
 xpalloc (void *pa, ptrdiff_t *nitems, ptrdiff_t nitems_incr_min,
         ptrdiff_t nitems_max, ptrdiff_t item_size)
 {
+  ptrdiff_t n0 = *nitems;
+  eassume (0 < item_size && 0 < nitems_incr_min && 0 <= n0 && -1 <= nitems_max);
+
   /* The approximate size to use for initial small allocation
      requests.  This is the largest "small" request for the GNU C
      library malloc.  */
   enum { DEFAULT_MXFAST = 64 * sizeof (size_t) / 4 };
 
   /* If the array is tiny, grow it to about (but no greater than)
   /* The approximate size to use for initial small allocation
      requests.  This is the largest "small" request for the GNU C
      library malloc.  */
   enum { DEFAULT_MXFAST = 64 * sizeof (size_t) / 4 };
 
   /* If the array is tiny, grow it to about (but no greater than)
-     DEFAULT_MXFAST bytes.  Otherwise, grow it by about 50%.  */
-  ptrdiff_t n = *nitems;
-  ptrdiff_t tiny_max = DEFAULT_MXFAST / item_size - n;
-  ptrdiff_t half_again = n >> 1;
-  ptrdiff_t incr_estimate = max (tiny_max, half_again);
-
-  /* Adjust the increment according to three constraints: NITEMS_INCR_MIN,
+     DEFAULT_MXFAST bytes.  Otherwise, grow it by about 50%.
+     Adjust the growth according to three constraints: NITEMS_INCR_MIN,
      NITEMS_MAX, and what the C language can represent safely.  */
      NITEMS_MAX, and what the C language can represent safely.  */
-  ptrdiff_t C_language_max = min (PTRDIFF_MAX, SIZE_MAX) / item_size;
-  ptrdiff_t n_max = (0 <= nitems_max && nitems_max < C_language_max
-                    ? nitems_max : C_language_max);
-  ptrdiff_t nitems_incr_max = n_max - n;
-  ptrdiff_t incr = max (nitems_incr_min, min (incr_estimate, nitems_incr_max));
 
 
-  eassert (0 < item_size && 0 < nitems_incr_min && 0 <= n && -1 <= nitems_max);
+  ptrdiff_t n, nbytes;
+  if (INT_ADD_WRAPV (n0, n0 >> 1, &n))
+    n = PTRDIFF_MAX;
+  if (0 <= nitems_max && nitems_max < n)
+    n = nitems_max;
+
+  ptrdiff_t adjusted_nbytes
+    = ((INT_MULTIPLY_WRAPV (n, item_size, &nbytes) || SIZE_MAX < nbytes)
+       ? min (PTRDIFF_MAX, SIZE_MAX)
+       : nbytes < DEFAULT_MXFAST ? DEFAULT_MXFAST : 0);
+  if (adjusted_nbytes)
+    {
+      n = adjusted_nbytes / item_size;
+      nbytes = adjusted_nbytes - adjusted_nbytes % item_size;
+    }
+
   if (! pa)
     *nitems = 0;
   if (! pa)
     *nitems = 0;
-  if (nitems_incr_max < incr)
+  if (n - n0 < nitems_incr_min
+      && (INT_ADD_WRAPV (n0, nitems_incr_min, &n)
+         || (0 <= nitems_max && nitems_max < n)
+         || INT_MULTIPLY_WRAPV (n, item_size, &nbytes)))
     memory_full (SIZE_MAX);
     memory_full (SIZE_MAX);
-  n += incr;
-  pa = xrealloc (pa, n * item_size);
+  pa = xrealloc (pa, nbytes);
   *nitems = n;
   return pa;
 }
   *nitems = n;
   return pa;
 }
@@ -950,7 +1055,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
   allocated_mem_type = type;
 #endif
 
   allocated_mem_type = type;
 #endif
 
-  val = malloc (nbytes);
+  val = lmalloc (nbytes);
 
 #if ! USE_LSB_TAG
   /* If the memory just allocated cannot be addressed thru a Lisp
 
 #if ! USE_LSB_TAG
   /* If the memory just allocated cannot be addressed thru a Lisp
@@ -969,7 +1074,7 @@ lisp_malloc (size_t nbytes, enum mem_type type)
     }
 #endif
 
     }
 #endif
 
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
   if (val && type != MEM_TYPE_NON_LISP)
     mem_insert (val, (char *) val + nbytes, type);
 #endif
   if (val && type != MEM_TYPE_NON_LISP)
     mem_insert (val, (char *) val + nbytes, type);
 #endif
@@ -989,7 +1094,7 @@ lisp_free (void *block)
 {
   MALLOC_BLOCK_INPUT;
   free (block);
 {
   MALLOC_BLOCK_INPUT;
   free (block);
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
   mem_delete (mem_find (block));
 #endif
   MALLOC_UNBLOCK_INPUT;
   mem_delete (mem_find (block));
 #endif
   MALLOC_UNBLOCK_INPUT;
@@ -1002,15 +1107,18 @@ lisp_free (void *block)
 
 /* Use aligned_alloc if it or a simple substitute is available.
    Address sanitization breaks aligned allocation, as of gcc 4.8.2 and
 
 /* Use aligned_alloc if it or a simple substitute is available.
    Address sanitization breaks aligned allocation, as of gcc 4.8.2 and
-   clang 3.3 anyway.  */
+   clang 3.3 anyway.  Aligned allocation is incompatible with
+   unexmacosx.c, so don't use it on Darwin.  */
 
 
-#if ! ADDRESS_SANITIZER
+#if ! ADDRESS_SANITIZER && !defined DARWIN_OS
 # if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC
 #  define USE_ALIGNED_ALLOC 1
 # if !defined SYSTEM_MALLOC && !defined DOUG_LEA_MALLOC && !defined HYBRID_MALLOC
 #  define USE_ALIGNED_ALLOC 1
+#  ifndef HAVE_ALIGNED_ALLOC
 /* Defined in gmalloc.c.  */
 void *aligned_alloc (size_t, size_t);
 /* Defined in gmalloc.c.  */
 void *aligned_alloc (size_t, size_t);
+#  endif
 # elif defined HYBRID_MALLOC
 # elif defined HYBRID_MALLOC
-#  if defined ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
+#  if defined HAVE_ALIGNED_ALLOC || defined HAVE_POSIX_MEMALIGN
 #   define USE_ALIGNED_ALLOC 1
 #   define aligned_alloc hybrid_aligned_alloc
 /* Defined in gmalloc.c.  */
 #   define USE_ALIGNED_ALLOC 1
 #   define aligned_alloc hybrid_aligned_alloc
 /* Defined in gmalloc.c.  */
@@ -1194,7 +1302,7 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
   val = free_ablock;
   free_ablock = free_ablock->x.next_free;
 
   val = free_ablock;
   free_ablock = free_ablock->x.next_free;
 
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
   if (type != MEM_TYPE_NON_LISP)
     mem_insert (val, (char *) val + nbytes, type);
 #endif
   if (type != MEM_TYPE_NON_LISP)
     mem_insert (val, (char *) val + nbytes, type);
 #endif
@@ -1214,7 +1322,7 @@ lisp_align_free (void *block)
   struct ablocks *abase = ABLOCK_ABASE (ablock);
 
   MALLOC_BLOCK_INPUT;
   struct ablocks *abase = ABLOCK_ABASE (ablock);
 
   MALLOC_BLOCK_INPUT;
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
   mem_delete (mem_find (block));
 #endif
   /* Put on free list.  */
   mem_delete (mem_find (block));
 #endif
   /* Put on free list.  */
@@ -1250,6 +1358,84 @@ lisp_align_free (void *block)
   MALLOC_UNBLOCK_INPUT;
 }
 
   MALLOC_UNBLOCK_INPUT;
 }
 
+#if !defined __GNUC__ && !defined __alignof__
+# define __alignof__(type) alignof (type)
+#endif
+
+/* True if malloc returns a multiple of GCALIGNMENT.  In practice this
+   holds if __alignof__ (max_align_t) is a multiple.  Use __alignof__
+   if available, as otherwise this check would fail with GCC x86.
+   This is a macro, not an enum constant, for portability to HP-UX
+   10.20 cc and AIX 3.2.5 xlc.  */
+#define MALLOC_IS_GC_ALIGNED (__alignof__ (max_align_t) % GCALIGNMENT == 0)
+
+/* True if P is suitably aligned for SIZE, where Lisp alignment may be
+   needed if SIZE is Lisp-aligned.  */
+
+static bool
+laligned (void *p, size_t size)
+{
+  return (MALLOC_IS_GC_ALIGNED || (intptr_t) p % GCALIGNMENT == 0
+         || size % GCALIGNMENT != 0);
+}
+
+/* Like malloc and realloc except that if SIZE is Lisp-aligned, make
+   sure the result is too, if necessary by reallocating (typically
+   with larger and larger sizes) until the allocator returns a
+   Lisp-aligned pointer.  Code that needs to allocate C heap memory
+   for a Lisp object should use one of these functions to obtain a
+   pointer P; that way, if T is an enum Lisp_Type value and L ==
+   make_lisp_ptr (P, T), then XPNTR (L) == P and XTYPE (L) == T.
+
+   On typical modern platforms these functions' loops do not iterate.
+   On now-rare (and perhaps nonexistent) platforms, the loops in
+   theory could repeat forever.  If an infinite loop is possible on a
+   platform, a build would surely loop and the builder can then send
+   us a bug report.  Adding a counter to try to detect any such loop
+   would complicate the code (and possibly introduce bugs, in code
+   that's never really exercised) for little benefit.  */
+
+static void *
+lmalloc (size_t size)
+{
+#if USE_ALIGNED_ALLOC
+  if (! MALLOC_IS_GC_ALIGNED)
+    return aligned_alloc (GCALIGNMENT, size);
+#endif
+
+  void *p;
+  while (true)
+    {
+      p = malloc (size);
+      if (laligned (p, size))
+       break;
+      free (p);
+      size_t bigger;
+      if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+       size = bigger;
+    }
+
+  eassert ((intptr_t) p % GCALIGNMENT == 0);
+  return p;
+}
+
+static void *
+lrealloc (void *p, size_t size)
+{
+  while (true)
+    {
+      p = realloc (p, size);
+      if (laligned (p, size))
+       break;
+      size_t bigger;
+      if (! INT_ADD_WRAPV (size, GCALIGNMENT, &bigger))
+       size = bigger;
+    }
+
+  eassert ((intptr_t) p % GCALIGNMENT == 0);
+  return p;
+}
+
 \f
 /***********************************************************************
                         Interval Allocation
 \f
 /***********************************************************************
                         Interval Allocation
@@ -1603,9 +1789,7 @@ string_bytes (struct Lisp_String *s)
   ptrdiff_t nbytes =
     (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
 
   ptrdiff_t nbytes =
     (s->size_byte < 0 ? s->size & ~ARRAY_MARK_FLAG : s->size_byte);
 
-  if (!PURE_POINTER_P (s)
-      && s->data
-      && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
+  if (!PURE_P (s) && s->data && nbytes != SDATA_NBYTES (SDATA_OF_STRING (s)))
     emacs_abort ();
   return nbytes;
 }
     emacs_abort ();
   return nbytes;
 }
@@ -2092,8 +2276,11 @@ INIT must be an integer that represents a character.  */)
     {
       nbytes = XINT (length);
       val = make_uninit_string (nbytes);
     {
       nbytes = XINT (length);
       val = make_uninit_string (nbytes);
-      memset (SDATA (val), c, nbytes);
-      SDATA (val)[nbytes] = 0;
+      if (nbytes)
+       {
+         memset (SDATA (val), c, nbytes);
+         SDATA (val)[nbytes] = 0;
+       }
     }
   else
     {
     }
   else
     {
@@ -2102,9 +2289,8 @@ INIT must be an integer that represents a character.  */)
       EMACS_INT string_len = XINT (length);
       unsigned char *p, *beg, *end;
 
       EMACS_INT string_len = XINT (length);
       unsigned char *p, *beg, *end;
 
-      if (string_len > STRING_BYTES_MAX / len)
+      if (INT_MULTIPLY_WRAPV (len, string_len, &nbytes))
        string_overflow ();
        string_overflow ();
-      nbytes = len * string_len;
       val = make_uninit_multibyte_string (string_len, nbytes);
       for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
        {
       val = make_uninit_multibyte_string (string_len, nbytes);
       for (beg = SDATA (val), p = beg, end = beg + nbytes; p < end; p += len)
        {
@@ -2119,7 +2305,8 @@ INIT must be an integer that represents a character.  */)
              memcpy (p, beg, len);
            }
        }
              memcpy (p, beg, len);
            }
        }
-      *p = 0;
+      if (nbytes)
+       *p = 0;
     }
 
   return val;
     }
 
   return val;
@@ -2503,9 +2690,7 @@ void
 free_cons (struct Lisp_Cons *ptr)
 {
   ptr->u.chain = cons_free_list;
 free_cons (struct Lisp_Cons *ptr)
 {
   ptr->u.chain = cons_free_list;
-#if GC_MARK_STACK
   ptr->car = Vdead;
   ptr->car = Vdead;
-#endif
   cons_free_list = ptr;
   consing_since_gc -= sizeof *ptr;
   total_free_conses++;
   cons_free_list = ptr;
   consing_since_gc -= sizeof *ptr;
   total_free_conses++;
@@ -2730,7 +2915,7 @@ enum
   {
     /* Alignment of struct Lisp_Vector objects.  */
     vector_alignment = COMMON_MULTIPLE (ALIGNOF_STRUCT_LISP_VECTOR,
   {
     /* Alignment of struct Lisp_Vector objects.  */
     vector_alignment = COMMON_MULTIPLE (ALIGNOF_STRUCT_LISP_VECTOR,
-                                       USE_LSB_TAG ? GCALIGNMENT : 1),
+                                       GCALIGNMENT),
 
     /* Vector size requests are a multiple of this.  */
     roundup_size = COMMON_MULTIPLE (vector_alignment, word_size)
 
     /* Vector size requests are a multiple of this.  */
     roundup_size = COMMON_MULTIPLE (vector_alignment, word_size)
@@ -2853,7 +3038,7 @@ allocate_vector_block (void)
 {
   struct vector_block *block = xmalloc (sizeof *block);
 
 {
   struct vector_block *block = xmalloc (sizeof *block);
 
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
   mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
              MEM_TYPE_VECTOR_BLOCK);
 #endif
   mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
              MEM_TYPE_VECTOR_BLOCK);
 #endif
@@ -3062,7 +3247,7 @@ sweep_vectors (void)
       if (free_this_block)
        {
          *bprev = block->next;
       if (free_this_block)
        {
          *bprev = block->next;
-#if GC_MARK_STACK && !defined GC_MALLOC_CHECK
+#ifndef GC_MALLOC_CHECK
          mem_delete (mem_find (block->data));
 #endif
          xfree (block);
          mem_delete (mem_find (block->data));
 #endif
          xfree (block);
@@ -3164,7 +3349,8 @@ allocate_vector (EMACS_INT len)
   if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len)
     memory_full (SIZE_MAX);
   v = allocate_vectorlike (len);
   if (min ((nbytes_max - header_size) / word_size, MOST_POSITIVE_FIXNUM) < len)
     memory_full (SIZE_MAX);
   v = allocate_vectorlike (len);
-  v->header.size = len;
+  if (len)
+    v->header.size = len;
   return v;
 }
 
   return v;
 }
 
@@ -3299,15 +3485,13 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
  ***********************************************************************/
 
 /* Like struct Lisp_Symbol, but padded so that the size is a multiple
  ***********************************************************************/
 
 /* Like struct Lisp_Symbol, but padded so that the size is a multiple
-   of the required alignment if LSB tags are used.  */
+   of the required alignment.  */
 
 union aligned_Lisp_Symbol
 {
   struct Lisp_Symbol s;
 
 union aligned_Lisp_Symbol
 {
   struct Lisp_Symbol s;
-#if USE_LSB_TAG
   unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1)
                  & -GCALIGNMENT];
   unsigned char c[(sizeof (struct Lisp_Symbol) + GCALIGNMENT - 1)
                  & -GCALIGNMENT];
-#endif
 };
 
 /* Each symbol_block is just under 1020 bytes long, since malloc
 };
 
 /* Each symbol_block is just under 1020 bytes long, since malloc
@@ -3411,15 +3595,13 @@ Its value is void, and its function definition and property list are nil.  */)
  ***********************************************************************/
 
 /* Like union Lisp_Misc, but padded so that its size is a multiple of
  ***********************************************************************/
 
 /* Like union Lisp_Misc, but padded so that its size is a multiple of
-   the required alignment when LSB tags are used.  */
+   the required alignment.  */
 
 union aligned_Lisp_Misc
 {
   union Lisp_Misc m;
 
 union aligned_Lisp_Misc
 {
   union Lisp_Misc m;
-#if USE_LSB_TAG
   unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1)
                  & -GCALIGNMENT];
   unsigned char c[(sizeof (union Lisp_Misc) + GCALIGNMENT - 1)
                  & -GCALIGNMENT];
-#endif
 };
 
 /* Allocation of markers and other objects that share that structure.
 };
 
 /* Allocation of markers and other objects that share that structure.
@@ -3548,7 +3730,6 @@ make_save_ptr_int (void *a, ptrdiff_t b)
   return val;
 }
 
   return val;
 }
 
-#if ! (defined USE_X_TOOLKIT || defined USE_GTK)
 Lisp_Object
 make_save_ptr_ptr (void *a, void *b)
 {
 Lisp_Object
 make_save_ptr_ptr (void *a, void *b)
 {
@@ -3559,7 +3740,6 @@ make_save_ptr_ptr (void *a, void *b)
   p->data[1].pointer = b;
   return val;
 }
   p->data[1].pointer = b;
   return val;
 }
-#endif
 
 Lisp_Object
 make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
 
 Lisp_Object
 make_save_funcptr_ptr_obj (void (*a) (void), void *b, Lisp_Object c)
@@ -3704,6 +3884,23 @@ make_event_array (ptrdiff_t nargs, Lisp_Object *args)
   }
 }
 
   }
 }
 
+#ifdef HAVE_MODULES
+/* Create a new module user ptr object.  */
+Lisp_Object
+make_user_ptr (void (*finalizer) (void *), void *p)
+{
+  Lisp_Object obj;
+  struct Lisp_User_Ptr *uptr;
+
+  obj = allocate_misc (Lisp_Misc_User_Ptr);
+  uptr = XUSER_PTR (obj);
+  uptr->finalizer = finalizer;
+  uptr->p = p;
+  return obj;
+}
+
+#endif
+
 static void
 init_finalizer_list (struct Lisp_Finalizer *head)
 {
 static void
 init_finalizer_list (struct Lisp_Finalizer *head)
 {
@@ -3773,21 +3970,18 @@ queue_doomed_finalizers (struct Lisp_Finalizer *dest,
 static Lisp_Object
 run_finalizer_handler (Lisp_Object args)
 {
 static Lisp_Object
 run_finalizer_handler (Lisp_Object args)
 {
-  add_to_log ("finalizer failed: %S", args, Qnil);
+  add_to_log ("finalizer failed: %S", args);
   return Qnil;
 }
 
 static void
 run_finalizer_function (Lisp_Object function)
 {
   return Qnil;
 }
 
 static void
 run_finalizer_function (Lisp_Object function)
 {
-  struct gcpro gcpro1;
   ptrdiff_t count = SPECPDL_INDEX ();
 
   ptrdiff_t count = SPECPDL_INDEX ();
 
-  GCPRO1 (function);
   specbind (Qinhibit_quit, Qt);
   internal_condition_case_1 (call0, function, Qt, run_finalizer_handler);
   unbind_to (count, Qnil);
   specbind (Qinhibit_quit, Qt);
   internal_condition_case_1 (call0, function, Qt, run_finalizer_handler);
   unbind_to (count, Qnil);
-  UNGCPRO;
 }
 
 static void
 }
 
 static void
@@ -3926,8 +4120,6 @@ refill_memory_reserve (void)
                           C Stack Marking
  ************************************************************************/
 
                           C Stack Marking
  ************************************************************************/
 
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
-
 /* Conservative C stack marking requires a method to identify possibly
    live Lisp objects given a pointer value.  We do this by keeping
    track of blocks of Lisp data that are allocated in a red-black tree
 /* Conservative C stack marking requires a method to identify possibly
    live Lisp objects given a pointer value.  We do this by keeping
    track of blocks of Lisp data that are allocated in a red-black tree
@@ -3994,26 +4186,12 @@ mem_insert (void *start, void *end, enum mem_type type)
   c = mem_root;
   parent = NULL;
 
   c = mem_root;
   parent = NULL;
 
-#if GC_MARK_STACK != GC_MAKE_GCPROS_NOOPS
-
-  while (c != MEM_NIL)
-    {
-      if (start >= c->start && start < c->end)
-       emacs_abort ();
-      parent = c;
-      c = start < c->start ? c->left : c->right;
-    }
-
-#else /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
   while (c != MEM_NIL)
     {
       parent = c;
       c = start < c->start ? c->left : c->right;
     }
 
   while (c != MEM_NIL)
     {
       parent = c;
       c = start < c->start ? c->left : c->right;
     }
 
-#endif /* GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS */
-
   /* Create a new node.  */
 #ifdef GC_MALLOC_CHECK
   x = malloc (sizeof *x);
   /* Create a new node.  */
 #ifdef GC_MALLOC_CHECK
   x = malloc (sizeof *x);
@@ -4496,73 +4674,14 @@ live_buffer_p (struct mem_node *m, void *p)
      must not have been killed.  */
   return (m->type == MEM_TYPE_BUFFER
          && p == m->start
      must not have been killed.  */
   return (m->type == MEM_TYPE_BUFFER
          && p == m->start
-         && !NILP (((struct buffer *) p)->INTERNAL_FIELD (name)));
+         && !NILP (((struct buffer *) p)->name_));
 }
 
 }
 
-#endif /* GC_MARK_STACK || defined GC_MALLOC_CHECK */
-
-#if GC_MARK_STACK
-
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-
-/* Currently not used, but may be called from gdb.  */
-
-void dump_zombies (void) EXTERNALLY_VISIBLE;
-
-/* Array of objects that are kept alive because the C stack contains
-   a pattern that looks like a reference to them.  */
-
-#define MAX_ZOMBIES 10
-static Lisp_Object zombies[MAX_ZOMBIES];
-
-/* Number of zombie objects.  */
-
-static EMACS_INT nzombies;
-
-/* Number of garbage collections.  */
-
-static EMACS_INT ngcs;
-
-/* Average percentage of zombies per collection.  */
-
-static double avg_zombies;
-
-/* Max. number of live and zombie objects.  */
-
-static EMACS_INT max_live, max_zombies;
-
-/* Average number of live objects per GC.  */
-
-static double avg_live;
-
-DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
-       doc: /* Show information about live and zombie objects.  */)
-  (void)
-{
-  Lisp_Object zombie_list = Qnil;
-  for (int i = 0; i < min (MAX_ZOMBIES, nzombies); i++)
-    zombie_list = Fcons (zombies[i], zombie_list);
-  return CALLN (Fmessage,
-               build_string ("%d GCs, avg live/zombies = %.2f/%.2f"
-                             " (%f%%), max %d/%d\nzombies: %S"),
-               make_number (ngcs), make_float (avg_live),
-               make_float (avg_zombies),
-               make_float (avg_zombies / avg_live / 100),
-               make_number (max_live), make_number (max_zombies),
-               zombie_list);
-}
-
-#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */
-
-
 /* Mark OBJ if we can prove it's a Lisp_Object.  */
 
 static void
 mark_maybe_object (Lisp_Object obj)
 {
 /* Mark OBJ if we can prove it's a Lisp_Object.  */
 
 static void
 mark_maybe_object (Lisp_Object obj)
 {
-  void *po;
-  struct mem_node *m;
-
 #if USE_VALGRIND
   if (valgrind_p)
     VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
 #if USE_VALGRIND
   if (valgrind_p)
     VALGRIND_MAKE_MEM_DEFINED (&obj, sizeof (obj));
@@ -4571,12 +4690,12 @@ mark_maybe_object (Lisp_Object obj)
   if (INTEGERP (obj))
     return;
 
   if (INTEGERP (obj))
     return;
 
-  po = (void *) XPNTR (obj);
-  m = mem_find (po);
+  void *po = XPNTR (obj);
+  struct mem_node *m = mem_find (po);
 
   if (m != MEM_NIL)
     {
 
   if (m != MEM_NIL)
     {
-      bool mark_p = 0;
+      bool mark_p = false;
 
       switch (XTYPE (obj))
        {
 
       switch (XTYPE (obj))
        {
@@ -4616,27 +4735,24 @@ mark_maybe_object (Lisp_Object obj)
        }
 
       if (mark_p)
        }
 
       if (mark_p)
-       {
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-         if (nzombies < MAX_ZOMBIES)
-           zombies[nzombies] = obj;
-         ++nzombies;
-#endif
-         mark_object (obj);
-       }
+       mark_object (obj);
     }
 }
 
 /* Return true if P can point to Lisp data, and false otherwise.
     }
 }
 
 /* Return true if P can point to Lisp data, and false otherwise.
-   USE_LSB_TAG needs Lisp data to be aligned on multiples of GCALIGNMENT.
-   Otherwise, assume that Lisp data is aligned on even addresses.  */
+   Symbols are implemented via offsets not pointers, but the offsets
+   are also multiples of GCALIGNMENT.  */
 
 static bool
 maybe_lisp_pointer (void *p)
 {
 
 static bool
 maybe_lisp_pointer (void *p)
 {
-  return !((intptr_t) p % (USE_LSB_TAG ? GCALIGNMENT : 2));
+  return (uintptr_t) p % GCALIGNMENT == 0;
 }
 
 }
 
+#ifndef HAVE_MODULES
+enum { HAVE_MODULES = false };
+#endif
+
 /* If P points to Lisp data, mark that as live if it isn't already
    marked.  */
 
 /* If P points to Lisp data, mark that as live if it isn't already
    marked.  */
 
@@ -4650,8 +4766,17 @@ mark_maybe_pointer (void *p)
     VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
 #endif
 
     VALGRIND_MAKE_MEM_DEFINED (&p, sizeof (p));
 #endif
 
-  if (!maybe_lisp_pointer (p))
-    return;
+  if (sizeof (Lisp_Object) == sizeof (void *) || !HAVE_MODULES)
+    {
+      if (!maybe_lisp_pointer (p))
+        return;
+    }
+  else
+    {
+      /* For the wide-int case, also mark emacs_value tagged pointers,
+        which can be generated by emacs-module.c's value_to_lisp.  */
+      p = (void *) ((uintptr_t) p & ~(GCALIGNMENT - 1));
+    }
 
   m = mem_find (p);
   if (m != MEM_NIL)
 
   m = mem_find (p);
   if (m != MEM_NIL)
@@ -4722,39 +4847,13 @@ mark_maybe_pointer (void *p)
    miss objects if __alignof__ were used.  */
 #define GC_POINTER_ALIGNMENT alignof (void *)
 
    miss objects if __alignof__ were used.  */
 #define GC_POINTER_ALIGNMENT alignof (void *)
 
-/* Define POINTERS_MIGHT_HIDE_IN_OBJECTS to 1 if marking via C pointers does
-   not suffice, which is the typical case.  A host where a Lisp_Object is
-   wider than a pointer might allocate a Lisp_Object in non-adjacent halves.
-   If USE_LSB_TAG, the bottom half is not a valid pointer, but it should
-   suffice to widen it to to a Lisp_Object and check it that way.  */
-#if USE_LSB_TAG || VAL_MAX < UINTPTR_MAX
-# if !USE_LSB_TAG && VAL_MAX < UINTPTR_MAX >> GCTYPEBITS
-  /* If tag bits straddle pointer-word boundaries, neither mark_maybe_pointer
-     nor mark_maybe_object can follow the pointers.  This should not occur on
-     any practical porting target.  */
-#  error "MSB type bits straddle pointer-word boundaries"
-# endif
-  /* Marking via C pointers does not suffice, because Lisp_Objects contain
-     pointer words that hold pointers ORed with type bits.  */
-# define POINTERS_MIGHT_HIDE_IN_OBJECTS 1
-#else
-  /* Marking via C pointers suffices, because Lisp_Objects contain pointer
-     words that hold unmodified pointers.  */
-# define POINTERS_MIGHT_HIDE_IN_OBJECTS 0
-#endif
-
 /* Mark Lisp objects referenced from the address range START+OFFSET..END
    or END+OFFSET..START.  */
 
 static void ATTRIBUTE_NO_SANITIZE_ADDRESS
 mark_memory (void *start, void *end)
 {
 /* Mark Lisp objects referenced from the address range START+OFFSET..END
    or END+OFFSET..START.  */
 
 static void ATTRIBUTE_NO_SANITIZE_ADDRESS
 mark_memory (void *start, void *end)
 {
-  void **pp;
-  int i;
-
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-  nzombies = 0;
-#endif
+  char *pp;
 
   /* Make START the pointer to the start of the memory region,
      if it isn't already.  */
 
   /* Make START the pointer to the start of the memory region,
      if it isn't already.  */
@@ -4765,6 +4864,8 @@ mark_memory (void *start, void *end)
       end = tem;
     }
 
       end = tem;
     }
 
+  eassert (((uintptr_t) start) % GC_POINTER_ALIGNMENT == 0);
+
   /* Mark Lisp data pointed to.  This is necessary because, in some
      situations, the C compiler optimizes Lisp objects away, so that
      only a pointer to them remains.  Example:
   /* Mark Lisp data pointed to.  This is necessary because, in some
      situations, the C compiler optimizes Lisp objects away, so that
      only a pointer to them remains.  Example:
@@ -4775,7 +4876,7 @@ mark_memory (void *start, void *end)
        Lisp_Object obj = build_string ("test");
        struct Lisp_String *s = XSTRING (obj);
        Fgarbage_collect ();
        Lisp_Object obj = build_string ("test");
        struct Lisp_String *s = XSTRING (obj);
        Fgarbage_collect ();
-       fprintf (stderr, "test `%s'\n", s->data);
+       fprintf (stderr, "test '%s'\n", s->data);
        return Qnil;
      }
 
        return Qnil;
      }
 
@@ -4783,14 +4884,11 @@ mark_memory (void *start, void *end)
      away.  The only reference to the life string is through the
      pointer `s'.  */
 
      away.  The only reference to the life string is through the
      pointer `s'.  */
 
-  for (pp = start; (void *) pp < end; pp++)
-    for (i = 0; i < sizeof *pp; i += GC_POINTER_ALIGNMENT)
-      {
-       void *p = *(void **) ((char *) pp + i);
-       mark_maybe_pointer (p);
-       if (POINTERS_MIGHT_HIDE_IN_OBJECTS)
-         mark_maybe_object (XIL ((intptr_t) p));
-      }
+  for (pp = start; (void *) pp < end; pp += GC_POINTER_ALIGNMENT)
+    {
+      mark_maybe_pointer (*(void **) pp);
+      mark_maybe_object (*(Lisp_Object *) pp);
+    }
 }
 
 #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
 }
 
 #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
@@ -4877,42 +4975,6 @@ test_setjmp (void)
 #endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
 
 
 #endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */
 
 
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
-
-/* Abort if anything GCPRO'd doesn't survive the GC.  */
-
-static void
-check_gcpros (void)
-{
-  struct gcpro *p;
-  ptrdiff_t i;
-
-  for (p = gcprolist; p; p = p->next)
-    for (i = 0; i < p->nvars; ++i)
-      if (!survives_gc_p (p->var[i]))
-       /* FIXME: It's not necessarily a bug.  It might just be that the
-          GCPRO is unnecessary or should release the object sooner.  */
-       emacs_abort ();
-}
-
-#elif GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-
-void
-dump_zombies (void)
-{
-  int i;
-
-  fprintf (stderr, "\nZombies kept alive = %"pI"d:\n", nzombies);
-  for (i = 0; i < min (MAX_ZOMBIES, nzombies); ++i)
-    {
-      fprintf (stderr, "  %d = ", i);
-      debug_print (zombies[i]);
-    }
-}
-
-#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */
-
-
 /* Mark live Lisp objects on the C stack.
 
    There are several system-dependent problems to consider when
 /* Mark live Lisp objects on the C stack.
 
    There are several system-dependent problems to consider when
@@ -4975,18 +5037,8 @@ mark_stack (void *end)
 #ifdef GC_MARK_SECONDARY_STACK
   GC_MARK_SECONDARY_STACK ();
 #endif
 #ifdef GC_MARK_SECONDARY_STACK
   GC_MARK_SECONDARY_STACK ();
 #endif
-
-#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
-  check_gcpros ();
-#endif
 }
 
 }
 
-#else /* GC_MARK_STACK == 0 */
-
-#define mark_maybe_object(obj) emacs_abort ()
-
-#endif /* GC_MARK_STACK != 0 */
-
 static bool
 c_symbol_p (struct Lisp_Symbol *sym)
 {
 static bool
 c_symbol_p (struct Lisp_Symbol *sym)
 {
@@ -5036,16 +5088,11 @@ valid_pointer_p (void *p)
 int
 valid_lisp_object_p (Lisp_Object obj)
 {
 int
 valid_lisp_object_p (Lisp_Object obj)
 {
-  void *p;
-#if GC_MARK_STACK
-  struct mem_node *m;
-#endif
-
   if (INTEGERP (obj))
     return 1;
 
   if (INTEGERP (obj))
     return 1;
 
-  p = (void *) XPNTR (obj);
-  if (PURE_POINTER_P (p))
+  void *p = XPNTR (obj);
+  if (PURE_P (p))
     return 1;
 
   if (SYMBOLP (obj) && c_symbol_p (p))
     return 1;
 
   if (SYMBOLP (obj) && c_symbol_p (p))
@@ -5054,11 +5101,7 @@ valid_lisp_object_p (Lisp_Object obj)
   if (p == &buffer_defaults || p == &buffer_local_symbols)
     return 2;
 
   if (p == &buffer_defaults || p == &buffer_local_symbols)
     return 2;
 
-#if !GC_MARK_STACK
-  return valid_pointer_p (p);
-#else
-
-  m = mem_find (p);
+  struct mem_node *m = mem_find (p);
 
   if (m == MEM_NIL)
     {
 
   if (m == MEM_NIL)
     {
@@ -5105,35 +5148,6 @@ valid_lisp_object_p (Lisp_Object obj)
     }
 
   return 0;
     }
 
   return 0;
-#endif
-}
-
-/* If GC_MARK_STACK, return 1 if STR is a relocatable data of Lisp_String
-   (i.e. there is a non-pure Lisp_Object X so that SDATA (X) == STR) and 0
-   if not.  Otherwise we can't rely on valid_lisp_object_p and return -1.
-   This function is slow and should be used for debugging purposes.  */
-
-int
-relocatable_string_data_p (const char *str)
-{
-  if (PURE_POINTER_P (str))
-    return 0;
-#if GC_MARK_STACK
-  if (str)
-    {
-      struct sdata *sdata
-       = (struct sdata *) (str - offsetof (struct sdata, data));
-
-      if (0 < valid_pointer_p (sdata)
-         && 0 < valid_pointer_p (sdata->string)
-         && maybe_lisp_pointer (sdata->string))
-       return (valid_lisp_object_p
-               (make_lisp_ptr (sdata->string, Lisp_String))
-               && (const char *) sdata->string->data == str);
-    }
-  return 0;
-#endif /* GC_MARK_STACK */
-  return -1;
 }
 
 /***********************************************************************
 }
 
 /***********************************************************************
@@ -5148,22 +5162,13 @@ static void *
 pure_alloc (size_t size, int type)
 {
   void *result;
 pure_alloc (size_t size, int type)
 {
   void *result;
-#if USE_LSB_TAG
-  size_t alignment = GCALIGNMENT;
-#else
-  size_t alignment = alignof (EMACS_INT);
-
-  /* Give Lisp_Floats an extra alignment.  */
-  if (type == Lisp_Float)
-    alignment = alignof (struct Lisp_Float);
-#endif
 
  again:
   if (type >= 0)
     {
       /* Allocate space for a Lisp object from the beginning of the free
         space with taking account of alignment.  */
 
  again:
   if (type >= 0)
     {
       /* Allocate space for a Lisp object from the beginning of the free
         space with taking account of alignment.  */
-      result = ALIGN (purebeg + pure_bytes_used_lisp, alignment);
+      result = ALIGN (purebeg + pure_bytes_used_lisp, GCALIGNMENT);
       pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
     }
   else
       pure_bytes_used_lisp = ((char *)result - (char *)purebeg) + size;
     }
   else
@@ -5375,9 +5380,15 @@ Does not copy symbols.  Copies strings without text properties.  */)
 static Lisp_Object
 purecopy (Lisp_Object obj)
 {
 static Lisp_Object
 purecopy (Lisp_Object obj)
 {
-  if (PURE_POINTER_P (XPNTR (obj)) || INTEGERP (obj) || SUBRP (obj))
+  if (INTEGERP (obj)
+      || (! SYMBOLP (obj) && PURE_P (XPNTR_OR_SYMBOL_OFFSET (obj)))
+      || SUBRP (obj))
     return obj;    /* Already pure.  */
 
     return obj;    /* Already pure.  */
 
+  if (STRINGP (obj) && XSTRING (obj)->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 (HASH_TABLE_P (Vpurify_flag)) /* Hash consing.  */
     {
       Lisp_Object tmp = Fgethash (obj, Vpurify_flag, Qnil);
@@ -5390,13 +5401,9 @@ purecopy (Lisp_Object obj)
   else if (FLOATP (obj))
     obj = make_pure_float (XFLOAT_DATA (obj));
   else if (STRINGP (obj))
   else if (FLOATP (obj))
     obj = make_pure_float (XFLOAT_DATA (obj));
   else if (STRINGP (obj))
-    {
-      if (XSTRING (obj)->intervals)
-       message ("Dropping text-properties when making string pure");
-      obj = make_pure_string (SSDATA (obj), SCHARS (obj),
-                             SBYTES (obj),
-                             STRING_MULTIBYTE (obj));
-    }
+    obj = make_pure_string (SSDATA (obj), SCHARS (obj),
+                           SBYTES (obj),
+                           STRING_MULTIBYTE (obj));
   else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
   else if (COMPILEDP (obj) || VECTORP (obj) || HASH_TABLE_P (obj))
     {
       struct Lisp_Vector *objp = XVECTOR (obj);
@@ -5495,10 +5502,6 @@ total_bytes_of_live_objects (void)
 
 #ifdef HAVE_WINDOW_SYSTEM
 
 
 #ifdef HAVE_WINDOW_SYSTEM
 
-/* This code has a few issues on MS-Windows, see Bug#15876 and Bug#16140.  */
-
-#if !defined (HAVE_NTGUI)
-
 /* Remove unmarked font-spec and font-entity objects from ENTRY, which is
    (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...), and return changed entry.  */
 
 /* Remove unmarked font-spec and font-entity objects from ENTRY, which is
    (DRIVER-TYPE NUM-FRAMES FONT-CACHE-DATA ...), and return changed entry.  */
 
@@ -5513,21 +5516,49 @@ compact_font_cache_entry (Lisp_Object entry)
       Lisp_Object obj = XCAR (tail);
 
       /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]).  */
       Lisp_Object obj = XCAR (tail);
 
       /* Consider OBJ if it is (font-spec . [font-entity font-entity ...]).  */
-      if (CONSP (obj) && FONT_SPEC_P (XCAR (obj))
-         && !VECTOR_MARKED_P (XFONT_SPEC (XCAR (obj)))
-         && VECTORP (XCDR (obj)))
+      if (CONSP (obj) && GC_FONT_SPEC_P (XCAR (obj))
+         && !VECTOR_MARKED_P (GC_XFONT_SPEC (XCAR (obj)))
+         /* Don't use VECTORP here, as that calls ASIZE, which could
+            hit assertion violation during GC.  */
+         && (VECTORLIKEP (XCDR (obj))
+             && ! (gc_asize (XCDR (obj)) & PSEUDOVECTOR_FLAG)))
        {
        {
-         ptrdiff_t i, size = ASIZE (XCDR (obj)) & ~ARRAY_MARK_FLAG;
+         ptrdiff_t i, size = gc_asize (XCDR (obj));
+         Lisp_Object obj_cdr = XCDR (obj);
 
          /* If font-spec is not marked, most likely all font-entities
             are not marked too.  But we must be sure that nothing is
             marked within OBJ before we really drop it.  */
          for (i = 0; i < size; i++)
 
          /* If font-spec is not marked, most likely all font-entities
             are not marked too.  But we must be sure that nothing is
             marked within OBJ before we really drop it.  */
          for (i = 0; i < size; i++)
-           if (VECTOR_MARKED_P (XFONT_ENTITY (AREF (XCDR (obj), i))))
-             break;
+            {
+              Lisp_Object objlist;
+
+              if (VECTOR_MARKED_P (GC_XFONT_ENTITY (AREF (obj_cdr, i))))
+                break;
+
+              objlist = AREF (AREF (obj_cdr, i), FONT_OBJLIST_INDEX);
+              for (; CONSP (objlist); objlist = XCDR (objlist))
+                {
+                  Lisp_Object val = XCAR (objlist);
+                  struct font *font = GC_XFONT_OBJECT (val);
+
+                  if (!NILP (AREF (val, FONT_TYPE_INDEX))
+                      && VECTOR_MARKED_P(font))
+                    break;
+                }
+              if (CONSP (objlist))
+               {
+                 /* Found a marked font, bail out.  */
+                 break;
+               }
+            }
 
          if (i == size)
 
          if (i == size)
-           drop = 1;
+           {
+             /* No marked fonts were found, so this entire font
+                entity can be dropped.  */
+             drop = 1;
+           }
        }
       if (drop)
        *prev = XCDR (tail);
        }
       if (drop)
        *prev = XCDR (tail);
@@ -5537,8 +5568,6 @@ compact_font_cache_entry (Lisp_Object entry)
   return entry;
 }
 
   return entry;
 }
 
-#endif /* not HAVE_NTGUI */
-
 /* Compact font caches on all terminals and mark
    everything which is still here after compaction.  */
 
 /* Compact font caches on all terminals and mark
    everything which is still here after compaction.  */
 
@@ -5550,7 +5579,6 @@ compact_font_caches (void)
   for (t = terminal_list; t; t = t->next_terminal)
     {
       Lisp_Object cache = TERMINAL_FONT_CACHE (t);
   for (t = terminal_list; t; t = t->next_terminal)
     {
       Lisp_Object cache = TERMINAL_FONT_CACHE (t);
-#if !defined (HAVE_NTGUI)
       if (CONSP (cache))
        {
          Lisp_Object entry;
       if (CONSP (cache))
        {
          Lisp_Object entry;
@@ -5558,7 +5586,6 @@ compact_font_caches (void)
          for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry))
            XSETCAR (entry, compact_font_cache_entry (XCAR (entry)));
        }
          for (entry = XCDR (cache); CONSP (entry); entry = XCDR (entry))
            XSETCAR (entry, compact_font_cache_entry (XCAR (entry)));
        }
-#endif /* not HAVE_NTGUI */
       mark_object (cache);
     }
 }
       mark_object (cache);
     }
 }
@@ -5653,9 +5680,16 @@ garbage_collect_1 (void *end)
      don't let that cause a recursive GC.  */
   consing_since_gc = 0;
 
      don't let that cause a recursive GC.  */
   consing_since_gc = 0;
 
-  /* Save what's currently displayed in the echo area.  */
-  message_p = push_message ();
-  record_unwind_protect_void (pop_message_unwind);
+  /* Save what's currently displayed in the echo area.  Don't do that
+     if we are GC'ing because we've run out of memory, since
+     push_message will cons, and we might have no memory for that.  */
+  if (NILP (Vmemory_full))
+    {
+      message_p = push_message ();
+      record_unwind_protect_void (pop_message_unwind);
+    }
+  else
+    message_p = false;
 
   /* Save a copy of the contents of the stack, for debugging.  */
 #if MAX_SAVE_STACK > 0
 
   /* Save a copy of the contents of the stack, for debugging.  */
 #if MAX_SAVE_STACK > 0
@@ -5714,18 +5748,8 @@ garbage_collect_1 (void *end)
   xg_mark_data ();
 #endif
 
   xg_mark_data ();
 #endif
 
-#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS \
-     || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS)
   mark_stack (end);
   mark_stack (end);
-#else
-  {
-    register struct gcpro *tail;
-    for (tail = gcprolist; tail; tail = tail->next)
-      for (i = 0; i < tail->nvars; i++)
-       mark_object (tail->var[i]);
-  }
-  mark_byte_stack ();
-#endif
+
   {
     struct handler *handler;
     for (handler = handlerlist; handler; handler = handler->next)
   {
     struct handler *handler;
     for (handler = handlerlist; handler; handler = handler->next)
@@ -5738,10 +5762,6 @@ garbage_collect_1 (void *end)
   mark_fringe_data ();
 #endif
 
   mark_fringe_data ();
 #endif
 
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-  mark_stack (end);
-#endif
-
   /* Everything is now marked, except for the data in font caches,
      undo lists, and finalizers.  The first two are compacted by
      removing an items which aren't reachable otherwise.  */
   /* Everything is now marked, except for the data in font caches,
      undo lists, and finalizers.  The first two are compacted by
      removing an items which aren't reachable otherwise.  */
@@ -5762,23 +5782,19 @@ garbage_collect_1 (void *end)
      after GC.  It's important to scan finalizers at this stage so
      that we can be sure that unmarked finalizers are really
      unreachable except for references from their associated functions
      after GC.  It's important to scan finalizers at this stage so
      that we can be sure that unmarked finalizers are really
      unreachable except for references from their associated functions
-     and from other finalizers. */
+     and from other finalizers.  */
 
   queue_doomed_finalizers (&doomed_finalizers, &finalizers);
   mark_finalizer_list (&doomed_finalizers);
 
   gc_sweep ();
 
 
   queue_doomed_finalizers (&doomed_finalizers, &finalizers);
   mark_finalizer_list (&doomed_finalizers);
 
   gc_sweep ();
 
-  /* Clear the mark bits that we set in certain root slots.  */
+  relocate_byte_stack ();
 
 
-  unmark_byte_stack ();
+  /* Clear the mark bits that we set in certain root slots.  */
   VECTOR_UNMARK (&buffer_defaults);
   VECTOR_UNMARK (&buffer_local_symbols);
 
   VECTOR_UNMARK (&buffer_defaults);
   VECTOR_UNMARK (&buffer_local_symbols);
 
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES && 0
-  dump_zombies ();
-#endif
-
   check_cons_list ();
 
   gc_in_progress = 0;
   check_cons_list ();
 
   gc_in_progress = 0;
@@ -5804,7 +5820,7 @@ garbage_collect_1 (void *end)
        }
     }
 
        }
     }
 
-  if (garbage_collection_messages)
+  if (garbage_collection_messages && NILP (Vmemory_full))
     {
       if (message_p || minibuf_level > 0)
        restore_message ();
     {
       if (message_p || minibuf_level > 0)
        restore_message ();
@@ -5852,21 +5868,6 @@ garbage_collect_1 (void *end)
   };
   retval = CALLMANY (Flist, total);
 
   };
   retval = CALLMANY (Flist, total);
 
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-  {
-    /* Compute average percentage of zombies.  */
-    double nlive
-      = (total_conses + total_symbols + total_markers + total_strings
-         + total_vectors + total_floats + total_intervals + total_buffers);
-
-    avg_live = (avg_live * ngcs + nlive) / (ngcs + 1);
-    max_live = max (nlive, max_live);
-    avg_zombies = (avg_zombies * ngcs + nzombies) / (ngcs + 1);
-    max_zombies = max (nzombies, max_zombies);
-    ++ngcs;
-  }
-#endif
-
   /* GC is complete: now we can run our finalizer callbacks.  */
   run_finalizers (&doomed_finalizers);
 
   /* GC is complete: now we can run our finalizer callbacks.  */
   run_finalizers (&doomed_finalizers);
 
@@ -5917,9 +5918,6 @@ returns nil, because real GC can't be done.
 See Info node `(elisp)Garbage Collection'.  */)
   (void)
 {
 See Info node `(elisp)Garbage Collection'.  */)
   (void)
 {
-#if (GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS             \
-     || GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS    \
-     || GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES)
   void *end;
 
 #ifdef HAVE___BUILTIN_UNWIND_INIT
   void *end;
 
 #ifdef HAVE___BUILTIN_UNWIND_INIT
@@ -5974,12 +5972,6 @@ See Info node `(elisp)Garbage Collection'.  */)
 #endif /* not GC_SAVE_REGISTERS_ON_STACK */
 #endif /* not HAVE___BUILTIN_UNWIND_INIT */
   return garbage_collect_1 (end);
 #endif /* not GC_SAVE_REGISTERS_ON_STACK */
 #endif /* not HAVE___BUILTIN_UNWIND_INIT */
   return garbage_collect_1 (end);
-#elif (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE)
-  /* Old GCPROs-based method without stack marking.  */
-  return garbage_collect_1 (NULL);
-#else
-  emacs_abort ();
-#endif /* GC_MARK_STACK */
 }
 
 /* Mark Lisp objects in glyph matrix MATRIX.  Currently the
 }
 
 /* Mark Lisp objects in glyph matrix MATRIX.  Currently the
@@ -6172,7 +6164,7 @@ mark_save_value (struct Lisp_Save_Value *ptr)
   /* If `save_type' is zero, `data[0].pointer' is the address
      of a memory area containing `data[1].integer' potential
      Lisp_Objects.  */
   /* If `save_type' is zero, `data[0].pointer' is the address
      of a memory area containing `data[1].integer' potential
      Lisp_Objects.  */
-  if (GC_MARK_STACK && ptr->save_type == SAVE_TYPE_MEMORY)
+  if (ptr->save_type == SAVE_TYPE_MEMORY)
     {
       Lisp_Object *p = ptr->data[0].pointer;
       ptrdiff_t nelt;
     {
       Lisp_Object *p = ptr->data[0].pointer;
       ptrdiff_t nelt;
@@ -6238,7 +6230,7 @@ mark_object (Lisp_Object arg)
  loop:
 
   po = XPNTR (obj);
  loop:
 
   po = XPNTR (obj);
-  if (PURE_POINTER_P (po))
+  if (PURE_P (po))
     return;
 
   last_marked[last_marked_index++] = obj;
     return;
 
   last_marked[last_marked_index++] = obj;
@@ -6247,7 +6239,7 @@ mark_object (Lisp_Object arg)
 
   /* Perform some sanity checks on the objects marked here.  Abort if
      we encounter an object we know is bogus.  This increases GC time
 
   /* Perform some sanity checks on the objects marked here.  Abort if
      we encounter an object we know is bogus.  This increases GC time
-     by ~80%, and requires compilation with GC_MARK_STACK != 0.  */
+     by ~80%.  */
 #ifdef GC_CHECK_MARKED_OBJECTS
 
   /* Check that the object pointed to by PO is known to be a Lisp
 #ifdef GC_CHECK_MARKED_OBJECTS
 
   /* Check that the object pointed to by PO is known to be a Lisp
@@ -6475,11 +6467,11 @@ mark_object (Lisp_Object arg)
            break;
          default: emacs_abort ();
          }
            break;
          default: emacs_abort ();
          }
-       if (!PURE_POINTER_P (XSTRING (ptr->name)))
+       if (!PURE_P (XSTRING (ptr->name)))
          MARK_STRING (XSTRING (ptr->name));
        MARK_INTERVAL_TREE (string_intervals (ptr->name));
        /* Inner loop to mark next symbol in this bucket, if any.  */
          MARK_STRING (XSTRING (ptr->name));
        MARK_INTERVAL_TREE (string_intervals (ptr->name));
        /* Inner loop to mark next symbol in this bucket, if any.  */
-       ptr = ptr->next;
+       po = ptr = ptr->next;
        if (ptr)
          goto nextsym;
       }
        if (ptr)
          goto nextsym;
       }
@@ -6514,6 +6506,12 @@ mark_object (Lisp_Object arg)
           mark_object (XFINALIZER (obj)->function);
           break;
 
           mark_object (XFINALIZER (obj)->function);
           break;
 
+#ifdef HAVE_MODULES
+       case Lisp_Misc_User_Ptr:
+         XMISCANY (obj)->gcmarkbit = true;
+         break;
+#endif
+
        default:
          emacs_abort ();
        }
        default:
          emacs_abort ();
        }
@@ -6622,7 +6620,7 @@ survives_gc_p (Lisp_Object obj)
       emacs_abort ();
     }
 
       emacs_abort ();
     }
 
-  return survives_p || PURE_POINTER_P ((void *) XPNTR (obj));
+  return survives_p || PURE_P (XPNTR (obj));
 }
 
 
 }
 
 
@@ -6673,9 +6671,7 @@ sweep_conses (void)
                       this_free++;
                       cblk->conses[pos].u.chain = cons_free_list;
                       cons_free_list = &cblk->conses[pos];
                       this_free++;
                       cblk->conses[pos].u.chain = cons_free_list;
                       cons_free_list = &cblk->conses[pos];
-#if GC_MARK_STACK
                       cons_free_list->car = Vdead;
                       cons_free_list->car = Vdead;
-#endif
                     }
                   else
                     {
                     }
                   else
                     {
@@ -6834,9 +6830,7 @@ sweep_symbols (void)
                 xfree (SYMBOL_BLV (&sym->s));
               sym->s.next = symbol_free_list;
               symbol_free_list = &sym->s;
                 xfree (SYMBOL_BLV (&sym->s));
               sym->s.next = symbol_free_list;
               symbol_free_list = &sym->s;
-#if GC_MARK_STACK
               symbol_free_list->function = Vdead;
               symbol_free_list->function = Vdead;
-#endif
               ++this_free;
             }
           else
               ++this_free;
             }
           else
@@ -6894,8 +6888,15 @@ sweep_misc (void)
             {
               if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
                 unchain_marker (&mblk->markers[i].m.u_marker);
             {
               if (mblk->markers[i].m.u_any.type == Lisp_Misc_Marker)
                 unchain_marker (&mblk->markers[i].m.u_marker);
-              if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
+              else if (mblk->markers[i].m.u_any.type == Lisp_Misc_Finalizer)
                 unchain_finalizer (&mblk->markers[i].m.u_finalizer);
                 unchain_finalizer (&mblk->markers[i].m.u_finalizer);
+#ifdef HAVE_MODULES
+             else if (mblk->markers[i].m.u_any.type == Lisp_Misc_User_Ptr)
+               {
+                 struct Lisp_User_Ptr *uptr = &mblk->markers[i].m.u_user_ptr;
+                 uptr->finalizer (uptr->p);
+               }
+#endif
               /* Set the type of the freed object to Lisp_Misc_Free.
                  We could leave the type alone, since nobody checks it,
                  but this might catch bugs faster.  */
               /* Set the type of the freed object to Lisp_Misc_Free.
                  We could leave the type alone, since nobody checks it,
                  but this might catch bugs faster.  */
@@ -7265,7 +7266,6 @@ init_alloc_once (void)
 {
   /* Even though Qt's contents are not set up, its address is known.  */
   Vpurify_flag = Qt;
 {
   /* Even though Qt's contents are not set up, its address is known.  */
   Vpurify_flag = Qt;
-  gc_precise = (GC_MARK_STACK == GC_USE_GCPROS_AS_BEFORE);
 
   purebeg = PUREBEG;
   pure_size = PURESIZE;
 
   purebeg = PUREBEG;
   pure_size = PURESIZE;
@@ -7274,10 +7274,8 @@ init_alloc_once (void)
   init_finalizer_list (&finalizers);
   init_finalizer_list (&doomed_finalizers);
 
   init_finalizer_list (&finalizers);
   init_finalizer_list (&doomed_finalizers);
 
-#if GC_MARK_STACK || defined GC_MALLOC_CHECK
   mem_init ();
   Vdead = make_pure_string ("DEAD", 4, 4, 0);
   mem_init ();
   Vdead = make_pure_string ("DEAD", 4, 4, 0);
-#endif
 
 #ifdef DOUG_LEA_MALLOC
   mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold.  */
 
 #ifdef DOUG_LEA_MALLOC
   mallopt (M_TRIM_THRESHOLD, 128 * 1024); /* Trim threshold.  */
@@ -7294,12 +7292,8 @@ init_alloc_once (void)
 void
 init_alloc (void)
 {
 void
 init_alloc (void)
 {
-  gcprolist = 0;
-  byte_stack_list = 0;
-#if GC_MARK_STACK
 #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
   setjmp_tested_p = longjmps_done = 0;
 #if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
   setjmp_tested_p = longjmps_done = 0;
-#endif
 #endif
   Vgc_elapsed = make_float (0.0);
   gcs_done = 0;
 #endif
   Vgc_elapsed = make_float (0.0);
   gcs_done = 0;
@@ -7409,11 +7403,6 @@ The time is in seconds as a floating point value.  */);
   DEFVAR_INT ("gcs-done", gcs_done,
               doc: /* Accumulated number of garbage collections done.  */);
 
   DEFVAR_INT ("gcs-done", gcs_done,
               doc: /* Accumulated number of garbage collections done.  */);
 
-  DEFVAR_BOOL ("gc-precise", gc_precise,
-               doc: /* Non-nil means GC stack marking is precise.
-Useful mainly for automated GC tests.  Build time constant.*/);
-  XSYMBOL (intern_c_string ("gc-precise"))->constant = 1;
-
   defsubr (&Scons);
   defsubr (&Slist);
   defsubr (&Svector);
   defsubr (&Scons);
   defsubr (&Slist);
   defsubr (&Svector);
@@ -7432,10 +7421,6 @@ Useful mainly for automated GC tests.  Build time constant.*/);
   defsubr (&Smemory_info);
   defsubr (&Smemory_use_counts);
   defsubr (&Ssuspicious_object);
   defsubr (&Smemory_info);
   defsubr (&Smemory_use_counts);
   defsubr (&Ssuspicious_object);
-
-#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
-  defsubr (&Sgc_status);
-#endif
 }
 
 /* When compiled with GCC, GDB might say "No enum type named
 }
 
 /* When compiled with GCC, GDB might say "No enum type named