From d3e7085a1fa858bf444a1ec8eaef3d0996d8a46f Mon Sep 17 00:00:00 2001
From: Pip Cet <pipcet@gmail.com>
Date: Sun, 22 Mar 2020 14:58:07 +0000
Subject: [PATCH] even more debugging

---
 src/alloc.c | 40 ++++++++++++++++++++++++++++++++++------
 src/lisp.h  |  2 +-
 2 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/src/alloc.c b/src/alloc.c
index 1c6b664b22..0191195d8d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -234,7 +234,7 @@ #define GC_DEFAULT_THRESHOLD (100000 * word_size)
 
 /* True during GC.  */
 
-bool gc_in_progress;
+volatile bool gc_in_progress;
 
 /* System byte and object counts reported by GC.  */
 
@@ -711,6 +711,8 @@ xmalloc (size_t size)
   if (!val && size)
     memory_full (size);
   MALLOC_PROBE (size);
+  if (val)
+    memset (val, 0xaa, size);
   return val;
 }
 
@@ -970,7 +972,12 @@ lisp_malloc (size_t nbytes, enum mem_type type)
 
 #ifndef GC_MALLOC_CHECK
   if (val && type != MEM_TYPE_NON_LISP)
-    mem_insert (val, (char *) val + nbytes, type);
+    {
+      eassert (!gc_in_progress);
+      gc_in_progress = true;
+      mem_insert (val, (char *) val + nbytes, type);
+      gc_in_progress = false;
+    }
 #endif
 
   MALLOC_UNBLOCK_INPUT;
@@ -1206,7 +1213,12 @@ lisp_align_malloc (size_t nbytes, enum mem_type type)
 
 #ifndef GC_MALLOC_CHECK
   if (type != MEM_TYPE_NON_LISP)
-    mem_insert (val, (char *) val + nbytes, type);
+    {
+      eassert (!gc_in_progress);
+      gc_in_progress = true;
+      mem_insert (val, (char *) val + nbytes, type);
+      gc_in_progress = false;
+    }
 #endif
 
   MALLOC_UNBLOCK_INPUT;
@@ -1301,7 +1313,10 @@ lmalloc (size_t size)
     {
       void *p = malloc (size);
       if (laligned (p, size))
-	return p;
+	{
+	  memset (p, 0x5a, size);
+	  return p;
+	}
       free (p);
       size_t bigger = size + LISP_ALIGNMENT;
       if (size < bigger)
@@ -2842,6 +2857,7 @@ setup_on_free_list (struct Lisp_Vector *v, ptrdiff_t nbytes)
   eassume (header_size <= nbytes);
   ptrdiff_t nwords = (nbytes - header_size) / word_size;
   XSETPVECTYPESIZE (v, PVEC_FREE, 0, nwords);
+  memset (v->contents, 0xa5, nbytes - header_size);
   eassert (nbytes % roundup_size == 0);
   ptrdiff_t vindex = VINDEX (nbytes);
   eassert (vindex < VECTOR_MAX_FREE_LIST_INDEX);
@@ -2857,8 +2873,13 @@ allocate_vector_block (void)
   struct vector_block *block = xmalloc (sizeof *block);
 
 #ifndef GC_MALLOC_CHECK
-  mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
-	      MEM_TYPE_VECTOR_BLOCK);
+  {
+    eassert (!gc_in_progress);
+    gc_in_progress = true;
+    mem_insert (block->data, block->data + VECTOR_BLOCK_BYTES,
+		MEM_TYPE_VECTOR_BLOCK);
+    gc_in_progress = false;
+  }
 #endif
 
   block->next = vector_blocks;
@@ -3094,6 +3115,7 @@ sweep_vectors (void)
 #ifndef GC_MALLOC_CHECK
 	  mem_delete (mem_find (block->data));
 #endif
+	  memset (block, 0x55, VECTOR_BLOCK_BYTES);
 	  xfree (block);
 	}
       else
@@ -3139,6 +3161,8 @@ #define VECTOR_ELTS_MAX \
 static struct Lisp_Vector *
 allocate_vectorlike (ptrdiff_t len)
 {
+  struct timespec ts = make_timespec (0, 100000);
+  nanosleep (&ts, NULL);
   eassert (0 < len && len <= VECTOR_ELTS_MAX);
   ptrdiff_t nbytes = header_size + len * word_size;
   struct Lisp_Vector *p;
@@ -5868,6 +5892,8 @@ garbage_collect (void)
   if (garbage_collection_inhibited)
     return;
 
+  eassert (!gc_in_progress);
+
   /* Record this function, so it appears on the profiler's backtraces.  */
   record_in_backtrace (QAutomatic_GC, 0, 0);
 
@@ -5934,6 +5960,8 @@ garbage_collect (void)
   shrink_regexp_cache ();
 
   gc_in_progress = 1;
+  struct timespec ts = make_timespec (0, 100000);
+  nanosleep (&ts, NULL);
 
   /* Mark all the special slots that serve as the roots of accessibility.  */
 
diff --git a/src/lisp.h b/src/lisp.h
index 8674fe11a6..4c94085170 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4006,7 +4006,7 @@ #define ALLOCATE_ZEROED_PSEUDOVECTOR(type, field, tag)		       \
 				   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 ptrdiff_t inhibit_garbage_collection (void);
-- 
2.26.0.rc2