ChangeLog

ChangeLog.3

@@ -1,3 +1,8 @@
+2023-04-06  Po Lu  <luangruo@yahoo.com>
+
+	* configure.ac: Detect what is necessary to start incremental
+	GC.
+
 2022-02-18  Stefan Kangas  <stefankangas@gmail.com>
 
 	* Version 28.3 released.

configure.ac

@@ -527,6 +527,9 @@ OPTION_DEFAULT_OFF([be-app],
 OPTION_DEFAULT_OFF([be-cairo],
   [enable use of cairo under Haiku's Application Kit])
 
+OPTION_DEFAULT_OFF([incremental-gc],
+  [enable incremental garbage collector])
+
 ## Makefile.in needs the cache file name.
 AC_SUBST([cache_file])
 
@@ -4993,7 +4996,7 @@ gai_strerror sync \
 getpwent endpwent getgrent endgrent \
 renameat2 \
 cfmakeraw cfsetspeed __executable_start log2 pthread_setname_np \
-pthread_set_name_np])
+pthread_set_name_np sysconf])
 LIBS=$OLD_LIBS
 
 if test "$ac_cv_func_pthread_setname_np" = "yes"; then
@@ -6535,6 +6538,174 @@ fi
 
 AC_SUBST([WINDOW_SYSTEM_OBJ])
 
+AC_DEFUN([emacs_PAGE_SIZE],
+[
+AC_CACHE_CHECK([for the page size, in bytes],
+  [emacs_cv_page_size],
+  [AS_IF([test "x$ac_cv_func_sysconf" = "xyes"],
+    [AC_RUN_IFELSE([AC_LANG_PROGRAM([
+AC_INCLUDES_DEFAULT
+[#include <stdio.h>
+]],[[
+FILE *file;
+long pagesize;
+
+file = fopen ("conftest.out", "w");
+if (!file)
+  exit (1);
+
+#ifdef _SC_PAGESIZE
+pagesize = sysconf (_SC_PAGESIZE);
+#else /* !_SC_PAGESIZE */
+pagesize = sysconf (_SC_PAGE_SIZE);
+#endif
+if (pagesize < 0)
+  exit (1);
+
+fprintf (file, "%ld\n", pagesize);
+fflush (file);
+fclose (file);
+exit (0);
+]])], [emacs_cv_page_size=`cat conftest.out`],
+      [AC_MSG_ERROR([Could not determine the page size])])],
+    [AS_IF([test "x$ac_cv_func_getpagesize" = "xyes"],
+      [AC_RUN_IFELSE([AC_LANG_PROGRAM([
+AC_INCLUDES_DEFAULT
+[#include <stdio.h>
+]],[[
+FILE *file;
+long pagesize;
+
+file = fopen ("conftest.out", "w");
+if (!file)
+  exit (1);
+
+pagesize = getpagesize ();
+if (pagesize < 0)
+  exit (1);
+
+fprintf (file, "%ld\n", pagesize);
+fflush (file);
+fclose (file);
+exit (0);
+]])], [emacs_cv_page_size=`cat conftest.out`],
+      [AC_MSG_ERROR([Could not determine the page size])])])])])
+AC_DEFINE_UNQUOTED([EMACS_PAGE_SIZE], [$emacs_cv_page_size],
+  [Define to the system page size, in bytes.])
+])
+
+AC_DEFUN([emacs_WRITE_FAULT_SIGNAL],
+[
+AC_CHECK_FUNCS([posix_memalign aligned_alloc valloc memalign])
+AS_CASE(["$ac_cv_func_posix_memalign$ac_cv_func_aligned_alloc\
+$ac_cv_func_valloc$ac_cv_func_memalign"], [*yes*], [],
+  [AC_MSG_ERROR([Cannot find a way to allocate page aligned memory])])
+
+AC_CACHE_CHECK([for signal sent upon writing to protected memory],
+  [emacs_cv_protection_fault_signal],
+  [AC_RUN_IFELSE([AC_LANG_PROGRAM([
+AC_INCLUDES_DEFAULT
+[
+#include <sys/mman.h>
+#if defined HAVE_VALLOC || defined HAVE_MEMALIGN
+#include <malloc.h>
+#endif /* HAVE_VALLOC || HAVE_MEMALIGN */
+#include <stdio.h>
+#include <signal.h>
+#include <setjmp.h>
+
+static volatile int sentsig;
+static jmp_buf env;
+
+static void
+handlesigbus (signal)
+     int signal;
+{
+  sentsig = SIGBUS;
+  longjmp (env, 1);
+}
+
+static void
+handlesigsegv (signal)
+     int signal;
+{
+  sentsig = SIGSEGV;
+  longjmp (env, 1);
+}
+
+]], [[
+char *mem;
+FILE *file;
+
+signal (SIGBUS, handlesigbus);
+signal (SIGSEGV, handlesigsegv);
+
+#ifdef HAVE_ALIGNED_ALLOC
+mem = aligned_alloc (EMACS_PAGE_SIZE, EMACS_PAGE_SIZE);
+if (!mem)
+  exit (1);
+#elif defined HAVE_POSIX_MEMALIGN
+if (posix_memalign (&mem, EMACS_PAGE_SIZE,
+		    EMACS_PAGE_SIZE))
+  exit (1);
+#elif defined HAVE_MEMALIGN
+mem = memalign (EMACS_PAGE_SIZE, EMACS_PAGE_SIZE);
+if (!mem)
+  exit (1);
+#elif defined HAVE_VALLOC
+mem = valloc (EMACS_PAGE_SIZE);
+if (!mem)
+  exit (1);
+#endif
+
+mprotect (mem, EMACS_PAGE_SIZE, PROT_READ);
+if (!setjmp (env))
+  *mem = 1;
+
+if (!sentsig)
+  exit (1);
+
+file = fopen ("conftest.out", "w");
+
+if (sentsig == SIGBUS)
+  {
+    fputs ("SIGBUS\n", file);
+    fflush (file);
+    fclose (file);
+  }
+else
+  {
+    fputs ("SIGSEGV\n", file);
+    fflush (file);
+    fclose (file);
+  }
+
+exit (0);
+]])],
+  [emacs_cv_protection_fault_signal=`cat conftest.out`],
+  [AC_MSG_ERROR([Could not determine whether to use SIGBUS])])])
+AC_DEFINE_UNQUOTED([WRITE_PROTECT_SIGNAL],
+  [$emacs_cv_protection_fault_signal],
+  [Signal sent upon a write protection fault.])
+])
+
+dnl Incremental GC setup.
+dnl Determine the page size of the system.
+dnl Then determine the signal raised during write
+dnl protection faults.
+
+AS_IF([test x"$with_incremental_gc" = x"yes"],
+  # Look for mprotect.
+  [AC_CHECK_FUNC([mprotect], [],
+     [AC_MSG_ERROR([mprotect not found.])])
+   # Determine the page size.
+   emacs_PAGE_SIZE
+   # Determine the signal raised due to a memory protection faults.
+   emacs_WRITE_FAULT_SIGNAL
+   # Finally, enable the incremental garbage collector.
+   AC_DEFINE([USE_INCREMENTAL_GC], [1],
+     [Define to 1 if garbage collection should run incrementally])])
+
 AH_TOP([/* GNU Emacs site configuration template file.
 
 Copyright (C) 1988, 1993-1994, 1999-2002, 2004-2021

src/ChangeLog.13

@@ -1,3 +1,100 @@
+2023-04-06  Po Lu  <luangruo@yahoo.com>
+
+	* thread.c (unmark_main_thread): Clear new mark bit.
+
+	* sysdep.c (handle_sigsegv): Call alloc_fault.
+	(write_protect_fault): New signal hanler func.
+	(init_signals): Set it to the write protect symbol.
+
+	* pdumper.c (dump_root_visitor): New root type `GC_ROOT_IGNORED'.
+	Ignore it.
+	(Fdump_emacs_portable): Adjust call to `garbage_collect'.
+
+	* lread.c (define_symbol): Add sanity check.
+
+	* lisp.h (s): New GC root type.
+	(union vectorlike_header) [USE_INCREMENTAL_GC]: New fields for
+	extra flags.
+	(SCHARS):
+	(STRING_BYTES):
+	(STRING_SET_CHARS):
+	(ASIZE): Handle vectors and strings with mark bits set when
+	USE_INCREMENTAL_GC.
+	(maybe_quit): Check gc_ticks and return to GC after that long.
+	(enum gc_root_type): New GC root type.
+
+
+	* intervals.h (interval): New mark bit when USE_INCREMENTAL_GC.
+
+	* fns.c (maybe_resize_hash_table): Add more sanity checks.
+
+	* data.c (wrong_type_argument): Add sanity check.
+
+	* alloc.c [USE_INCREMENTAL_GC]: Include sys/mman.h.
+	(struct protection): New structure.
+	(lmalloc):
+	(xzalloc):
+	(xrealloc): Don't implement with lisp_malloc.
+	(lisp_malloc):
+	(lisp_align_malloc): Implement in terms of page allocator
+	function.
+	(gc_in_progress): Make volatile.
+	(enum mem_type): Add MEM_TYPE_INTERVAL.
+	(BLOCK_SIZE, LISP_BLOCK_SIZE): New macros.
+	(struct interval_block): Make better use of page aligned space.
+	(make_interval): Set up GC protection.
+	(mark_interval_tree_1): Suspend write protection.
+	(struct string_block): Make better use of page aligned space.
+	(allocate_string): Set up GC protection.
+	(sweep_strings): Unprotect pages.
+	(struct float_block):
+	(struct cons_block): Make better use of GC'd space.
+	(Fcons): Unprotect pages.
+	(struct large_vector):
+	(struct vector_block):
+	(allocate_vector_block):
+	(sweep_vectors): Likewise.
+	(allocate_vectorlike): Here too.
+	(init_symbol):
+	(Fmake_symbol): Clear new GC mark bits.
+	(mark_finalizer_list): Suspend garbage collection.
+	(mem_insert):
+	(mem_delete): Set `mem_tree_is_being_modified'.
+	(mark_maybe_pointer):
+	(valid_lisp_object_p): Return 1 if P is the main thread.
+	(compact_font_cache_entry):
+	(compact_font_caches):
+	(compact_undo_list): Suspend write protection before writing into
+	object.
+	(visit_static_gc_roots): Visit static fields in static roots along
+	with the roots themselves.
+	(mark_and_sweep_weak_table_contents): Suspend vectorlike GC
+	protection.
+	(reenter_gc): New function.
+	(garbage_collect): Delegate to `reenter_gc'.  Handle longjmps from
+	`reenter_gc'.  New arg `no_compact'.  All callers changed.
+	(mark_objects): Don't push objects directly onto the mark stack.
+	(mark_objects_in_object): New function.  Make it behave like the
+	old `mark_objects'.
+	(mark_vectorlike): Use `mark_objects_in_object'.
+	(mark_char_table):
+	(mark_buffer):
+	(mark_face_cache):
+	(mark_discard_killed_buffers): Suspend protection before writing
+	into object.
+	(struct mark_entry): Allow placing intervals on the mark stack.
+	(mark_stk):
+	(process_mark_stack): Suspend write protection where necessary.
+	Place write protection as well.  Quit every once in a while.
+	(mark_terminals):
+	(sweep_conses):
+	(sweep_floats):
+	(sweep_intervals):
+	(sweep_symbols):
+	(sweep_buffers): Unprotect objects.
+	(gc_sweep): Rearrange sweep order.
+	(gdb_make_enums_visible): New enum Block_Alignment.
+
 2015-04-06  Koichi Arakawa  <arakawa@pp.iij4u.or.jp>  (tiny change)
 
 	* w32proc.c (w32_executable_type): Look for the DLL name in the

src/data.c

@@ -139,7 +139,7 @@ wrong_length_argument (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3)
 AVOID
 wrong_type_argument (Lisp_Object predicate, Lisp_Object value)
 {
-  eassert (!TAGGEDP (value, Lisp_Type_Unused0));
+  eassert (valid_lisp_object_p (value));
   xsignal2 (Qwrong_type_argument, predicate, value);
 }
 

src/fns.c

@@ -4593,6 +4593,8 @@ copy_hash_table (struct Lisp_Hash_Table *h1)
 static void
 maybe_resize_hash_table (struct Lisp_Hash_Table *h)
 {
+  ptrdiff_t i;
+
   if (h->next_free < 0)
     {
       ptrdiff_t old_size = HASH_TABLE_SIZE (h);
@@ -4620,7 +4622,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
       Lisp_Object next = larger_vecalloc (h->next, new_size - old_size,
 					  new_size);
       ptrdiff_t next_size = ASIZE (next);
-      for (ptrdiff_t i = old_size; i < next_size - 1; i++)
+      for (i = old_size; i < next_size - 1; i++)
 	ASET (next, i, make_fixnum (i + 1));
       ASET (next, next_size - 1, make_fixnum (-1));
 
@@ -4629,8 +4631,12 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
       Lisp_Object key_and_value
 	= larger_vecalloc (h->key_and_value, 2 * (next_size - old_size),
 			   2 * next_size);
-      for (ptrdiff_t i = 2 * old_size; i < 2 * next_size; i++)
+      for (i = 2 * old_size; i < 2 * next_size; i++)
         ASET (key_and_value, i, Qunbound);
+#ifdef ENABLE_CHECKING
+      for (i = 0; i < ASIZE (key_and_value); ++i)
+	eassert (valid_lisp_object_p (AREF (key_and_value, i)));
+#endif /* ENABLE_CHECKING */
 
       Lisp_Object hash = larger_vector (h->hash, next_size - old_size,
 					next_size);
@@ -4642,7 +4648,7 @@ maybe_resize_hash_table (struct Lisp_Hash_Table *h)
       h->next_free = old_size;
 
       /* Rehash.  */
-      for (ptrdiff_t i = 0; i < old_size; i++)
+      for (i = 0; i < old_size; i++)
 	if (!NILP (HASH_HASH (h, i)))
 	  {
 	    EMACS_UINT hash_code = XUFIXNUM (HASH_HASH (h, i));

src/intervals.h

@@ -52,6 +52,9 @@ struct interval
   bool_bf up_obj : 1;
 
   bool_bf gcmarkbit : 1;
+#ifdef USE_INCREMENTAL_GC
+  bool_bf gcmarkbit1 : 1;
+#endif /* USE_INCREMENTAL_GC */
 
   /* The remaining components are `properties' of the interval.
      The first four are duplicates for things which can be on the list,

src/lisp.h

@@ -838,6 +838,12 @@ struct Lisp_Symbol
     {
       bool_bf gcmarkbit : 1;
 
+#ifdef USE_INCREMENTAL_GC
+      /* Additional mark bit specifying whether or not this
+	 symbol has been scanned.  */
+      bool_bf gcmarkbit1 : 1;
+#endif /* USE_INCREMENTAL_GC */
+
       /* Indicates where the value can be found:
 	 0 : it's a plain var, the value is in the `value' field.
 	 1 : it's a varalias, the value is really in the `alias' symbol.
@@ -988,6 +994,7 @@ typedef EMACS_UINT Lisp_Word_tag;
    number of members has been reduced to one.  */
 union vectorlike_header
   {
+#ifndef USE_INCREMENTAL_GC
     /* The main member contains various pieces of information:
        - The MSB (ARRAY_MARK_FLAG) holds the gcmarkbit.
        - The next bit (PSEUDOVECTOR_FLAG) indicates whether this is a plain
@@ -1008,6 +1015,21 @@ union vectorlike_header
 	 Current layout limits the pseudovectors to 63 PVEC_xxx subtypes,
 	 4095 Lisp_Objects in GC-ed area and 4095 word-sized other slots.  */
     ptrdiff_t size;
+#else /* USE_INCREMENTAL_GC */
+    ptrdiff_t size;
+
+    struct {
+      ptrdiff_t size;
+
+      /* New mark bit flags associated with the incremental GC.  */
+      short new_flags;
+
+      /* Whether or not this vectorlike is a large vector.  */
+      short large_vector_p;
+
+      /* Four bytes wasted due to alignment below! */
+    } s;
+#endif /* !USE_INCREMENTAL_GC */
   };
 
 struct Lisp_Symbol_With_Pos
@@ -1690,7 +1712,13 @@ INLINE ptrdiff_t
 SCHARS (Lisp_Object string)
 {
   ptrdiff_t nchars = XSTRING (string)->u.s.size;
+#ifndef USE_INCREMENTAL_GC
   eassume (0 <= nchars);
+#else /* USE_INCREMENTAL_GC */
+  /* Incremental GC will leave mark bits in vectors while GC is
+     suspended.  */
+  nchars &= ~ARRAY_MARK_FLAG;
+#endif
   return nchars;
 }
 
@@ -1705,6 +1733,11 @@ STRING_BYTES (struct Lisp_String *s)
 #else
   ptrdiff_t nbytes = s->u.s.size_byte < 0 ? s->u.s.size : s->u.s.size_byte;
 #endif
+#ifdef USE_INCREMENTAL_GC
+  /* Incremental GC will leave mark bits in vectors while GC is
+     suspended.  */
+  nbytes &= ~ARRAY_MARK_FLAG;
+#endif /* USE_INCREMENTAL_GC */
   eassume (0 <= nbytes);
   return nbytes;
 }
@@ -1722,7 +1755,15 @@ STRING_SET_CHARS (Lisp_Object string, ptrdiff_t newsize)
   eassert (STRING_MULTIBYTE (string)
 	   ? 0 <= newsize && newsize <= SBYTES (string)
 	   : newsize == SCHARS (string));
+#ifdef USE_INCREMENTAL_GC
+  /* When incremental GC is in use, leave the mark bits in the string
+     intact.  */
+  XSTRING (string)->u.s.size
+    = (newsize | (XSTRING (string)->u.s.size
+		  & ARRAY_MARK_FLAG));
+#else
   XSTRING (string)->u.s.size = newsize;
+#endif
 }
 
 INLINE void
@@ -1764,7 +1805,13 @@ INLINE ptrdiff_t
 ASIZE (Lisp_Object array)
 {
   ptrdiff_t size = XVECTOR (array)->header.size;
+#ifndef USE_INCREMENTAL_GC
   eassume (0 <= size);
+#else /* USE_INCREMENTAL_GC */
+  /* Incremental GC will leave mark bits in vectors while GC is
+     suspended.  */
+  size &= ~ARRAY_MARK_FLAG;
+#endif
   return size;
 }
 
@@ -3669,6 +3716,13 @@ extern bool volatile pending_signals;
 extern void process_pending_signals (void);
 extern void probably_quit (void);
 
+#ifdef USE_INCREMENTAL_GC
+extern int gc_ticks;
+extern void return_to_gc (void);
+
+#define GC_QUIT_COUNT 100000
+#endif /* USE_INCREMENTAL_GC */
+
 /* Check quit-flag and quit if it is non-nil.  Typing C-g does not
    directly cause a quit; it only sets Vquit_flag.  So the program
    needs to call maybe_quit at times when it is safe to quit.  Every
@@ -3677,6 +3731,9 @@ extern void probably_quit (void);
    impossible, of course.  But it is very desirable to avoid creating
    loops where maybe_quit is impossible.
 
+   In addition, return to ongoing garbage collection every
+   GC_QUIT_COUNT if incremental GC is enabled.
+
    If quit-flag is set to `kill-emacs' the SIGINT handler has received
    a request to exit Emacs when it is safe to do.
 
@@ -3687,6 +3744,11 @@ maybe_quit (void)
 {
   if (!NILP (Vquit_flag) || pending_signals)
     probably_quit ();
+
+#ifdef USE_INCREMENTAL_GC
+  if (gc_ticks && gc_ticks++ > GC_QUIT_COUNT)
+    return_to_gc ();
+#endif /* USE_INCREMENTAL_GC */
 }
 
 /* Process a quit rarely, based on a counter COUNT, for efficiency.
@@ -4198,6 +4260,7 @@ extern AVOID buffer_memory_full (ptrdiff_t);
 extern bool survives_gc_p (Lisp_Object);
 extern void mark_object (Lisp_Object);
 extern void mark_objects (Lisp_Object *, ptrdiff_t);
+extern void mark_objects_in_object (Lisp_Object *, ptrdiff_t);
 #if defined REL_ALLOC && !defined SYSTEM_MALLOC && !defined HYBRID_MALLOC
 extern void refill_memory_reserve (void);
 #endif
@@ -4206,6 +4269,9 @@ extern void alloc_unexec_post (void);
 extern void mark_c_stack (char const *, char const *);
 extern void flush_stack_call_func1 (void (*func) (void *arg), void *arg);
 extern void mark_memory (void const *start, void const *end);
+#ifdef USE_INCREMENTAL_GC
+extern bool alloc_fault (void *);
+#endif /* USE_INCREMENTAL_GC */
 
 /* Force callee-saved registers and register windows onto the stack,
    so that conservative garbage collection can see their values.  */
@@ -4233,7 +4299,7 @@ flush_stack_call_func (void (*func) (void *arg), void *arg)
   flush_stack_call_func1 (func, arg);
 }
 
-extern void garbage_collect (void);
+extern void garbage_collect (bool);
 extern void maybe_garbage_collect (void);
 extern bool maybe_garbage_collect_eagerly (EMACS_INT factor);
 extern const char *pending_malloc_warning;
@@ -4257,10 +4323,11 @@ extern Lisp_Object pure_listn (ptrdiff_t, Lisp_Object, ...);
 
 enum gc_root_type
 {
+  GC_ROOT_IGNORED,
   GC_ROOT_STATICPRO,
   GC_ROOT_BUFFER_LOCAL_DEFAULT,
   GC_ROOT_BUFFER_LOCAL_NAME,
-  GC_ROOT_C_SYMBOL
+  GC_ROOT_C_SYMBOL,
 };
 
 struct gc_root_visitor
@@ -4420,7 +4487,7 @@ extern struct Lisp_Vector *allocate_pseudovector (int, int, int,
 				   PSEUDOVECSIZE (type, field),	       \
 				   VECSIZE (type), tag))
 
-extern bool gc_in_progress;
+extern volatile bool gc_in_progress;
 extern Lisp_Object make_float (double);
 extern void display_malloc_warning (void);
 extern specpdl_ref inhibit_garbage_collection (void);

src/lread.c

@@ -4721,6 +4721,8 @@ define_symbol (Lisp_Object sym, char const *str)
   Lisp_Object string = make_pure_c_string (str, len);
   init_symbol (sym, string);
 
+  eassert (valid_lisp_object_p (SYMBOL_VAL (XSYMBOL (sym))));
+
   /* Qunbound is uninterned, so that it's not confused with any symbol
      'unbound' created by a Lisp program.  */
   if (! BASE_EQ (sym, Qunbound))

src/pdumper.c

@@ -1711,6 +1711,10 @@ dump_root_visitor (Lisp_Object const *root_ptr, enum gc_root_type type,
 {
   struct dump_context *ctx = data;
   Lisp_Object value = *root_ptr;
+
+  if (type == GC_ROOT_IGNORED)
+    return;
+
   if (type == GC_ROOT_C_SYMBOL)
     {
       eassert (dump_builtin_symbol_p (value));
@@ -4095,7 +4099,7 @@ types.  */)
   do
     {
       number_finalizers_run = 0;
-      garbage_collect ();
+      garbage_collect (false);
     }
   while (number_finalizers_run);
 

src/sysdep.c

@@ -1876,6 +1876,11 @@ handle_sigsegv (int sig, siginfo_t *siginfo, void *arg)
      too nested calls to mark_object.  No way to survive.  */
   bool fatal = gc_in_progress;
 
+#if USE_INCREMENTAL_GC && WRITE_PROTECT_SIGNAL == SIGSEGV
+  if (alloc_fault (siginfo->si_addr))
+    return;
+#endif /* USE_INCREMENTAL_GC && WRITE_PROTECT_SIGNAL == SIGSEGV */
+
 #ifdef FORWARD_SIGNAL_TO_MAIN_THREAD
   if (!fatal && !pthread_equal (pthread_self (), main_thread_id))
     fatal = true;
@@ -1963,11 +1968,28 @@ maybe_fatal_sig (int sig)
     sigaction (sig, &process_fatal_action, 0);
 }
 
+#ifdef USE_INCREMENTAL_GC
+
+static void
+write_protect_fault (int signal, siginfo_t *siginfo, void *arg)
+{
+  if (alloc_fault (siginfo->si_addr))
+    return;
+
+  /* Otherwise, this is another kind of fault.  */
+  deliver_fatal_thread_signal (signal);
+}
+
+#endif /* USE_INCREMENTAL_GC */
+
 void
 init_signals (void)
 {
   struct sigaction thread_fatal_action;
   struct sigaction action;
+#ifdef USE_INCREMENTAL_GC
+  bool was_sigsegv_init;
+#endif /* USE_INCREMENTAL_GC */
 
   sigemptyset (&empty_mask);
 
@@ -2052,7 +2074,12 @@ init_signals (void)
   sigaction (SIGBUS, &thread_fatal_action, 0);
 #endif
   if (!init_sigsegv ())
-    sigaction (SIGSEGV, &thread_fatal_action, 0);
+    {
+#ifdef USE_INCREMENTAL_GC
+      was_sigsegv_init = true;
+#endif /* USE_INCREMENTAL_GC */
+      sigaction (SIGSEGV, &thread_fatal_action, 0);
+    }
 #ifdef SIGSYS
   sigaction (SIGSYS, &thread_fatal_action, 0);
 #endif
@@ -2098,6 +2125,18 @@ init_signals (void)
 #ifdef SIGTALRM
   sigaction (SIGTALRM, &thread_fatal_action, 0);
 #endif
+
+#ifdef USE_INCREMENTAL_GC
+#if WRITE_PROTECT_SIGNAL == SIGSEGV
+  if (!was_sigsegv_init)
+#endif /* WRITE_PROTECT_SIGNAL == SIGSEGV */
+    {
+      memset (&action, 0, sizeof action);
+      action.sa_flags = SA_SIGINFO;
+      action.sa_sigaction = write_protect_fault;
+      sigaction (WRITE_PROTECT_SIGNAL, &action, 0);
+    }
+#endif /* USE_INCREMENTAL_GC */
 }
 
 #ifndef HAVE_RANDOM

src/thread.c

@@ -702,6 +702,9 @@ void
 unmark_main_thread (void)
 {
   main_thread.s.header.size &= ~ARRAY_MARK_FLAG;
+#ifdef USE_INCREMENTAL_GC
+  main_thread.s.header.s.new_flags = 0;
+#endif /* USE_INCREMENTAL_GC */
 }