(MARKER_BLOCK_SIZE, marker_block, marker_free_list): Now refers to the

superset type, not just markers.
(allocate_misc): New function, extracted from Fmake_marker.
(Fpurecopy): Check the substructure.
(clear_marks, mark_object, gc_sweep): Likewise.

1 files changed, 69 insertions, 36 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 2def77bf0bf..a92ef25d2be 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -733,22 +733,22 @@ Its value and function definition are void, and its property list is nil.")
   return val;
 }
 
-/* Allocation of markers.
+/* Allocation of markers and other objects that share that structure.
    Works like allocation of conses. */
 
 #define MARKER_BLOCK_SIZE \
-  ((1020 - sizeof (struct marker_block *)) / sizeof (struct Lisp_Marker))
+  ((1020 - sizeof (struct marker_block *)) / sizeof (union Lisp_Misc))
 
 struct marker_block
   {
     struct marker_block *next;
-    struct Lisp_Marker markers[MARKER_BLOCK_SIZE];
+    union Lisp_Misc markers[MARKER_BLOCK_SIZE];
   };
 
 struct marker_block *marker_block;
 int marker_block_index;
 
-struct Lisp_Marker *marker_free_list;
+union Lisp_Misc *marker_free_list;
 
 void
 init_marker ()
@@ -760,36 +760,47 @@ init_marker ()
   marker_free_list = 0;
 }
 
-DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
-  "Return a newly allocated marker which does not point at any place.")
-  ()
+/* Return a newly allocated Lisp_Misc object, with no substructure.  */
+Lisp_Object
+allocate_misc ()
 {
-  register Lisp_Object val;
-  register struct Lisp_Marker *p;
+  Lisp_Object val;
 
   if (marker_free_list)
     {
-      XSETMARKER (val, marker_free_list);
-      marker_free_list
-	= (struct Lisp_Marker *) XFASTINT (marker_free_list->chain);
+      XSETMISC (val, marker_free_list);
+      marker_free_list = marker_free_list->u_free.chain;
     }
   else
     {
       if (marker_block_index == MARKER_BLOCK_SIZE)
 	{
-	  struct marker_block *new = (struct marker_block *) xmalloc (sizeof (struct marker_block));
+	  struct marker_block *new
+	    = (struct marker_block *) xmalloc (sizeof (struct marker_block));
 	  VALIDATE_LISP_STORAGE (new, sizeof *new);
 	  new->next = marker_block;
 	  marker_block = new;
 	  marker_block_index = 0;
 	}
-      XSETMARKER (val, &marker_block->markers[marker_block_index++]);
+      XSETMISC (val, &marker_block->markers[marker_block_index++]);
     }
+  consing_since_gc += sizeof (union Lisp_Misc);
+  return val;
+}
+
+DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
+  "Return a newly allocated marker which does not point at any place.")
+  ()
+{
+  register Lisp_Object val;
+  register struct Lisp_Marker *p;
+
+  val = allocate_misc ();
+  XMISC (val)->type = Lisp_Misc_Marker;
   p = XMARKER (val);
   p->buffer = 0;
   p->bufpos = 0;
   p->chain = Qnil;
-  consing_since_gc += sizeof (struct Lisp_Marker);
   return val;
 }
 
@@ -1125,8 +1136,15 @@ Does not copy symbols.")
   switch (XTYPE (obj))
 #endif
     {
-    case Lisp_Marker:
-      error ("Attempt to copy a marker to pure storage");
+    case Lisp_Misc:
+      switch (XMISC (obj)->type)
+	{
+	case Lisp_Misc_Marker:
+	  error ("Attempt to copy a marker to pure storage");
+
+	default:
+	  abort ();
+	}
 
     case Lisp_Cons:
       return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr);
@@ -1426,7 +1444,8 @@ clear_marks ()
       {
 	register int i;
 	for (i = 0; i < lim; i++)
-	  XUNMARK (sblk->markers[i].chain);
+	  if (sblk->markers[i].type == Lisp_Misc_Marker)
+	    XUNMARK (sblk->markers[i].u_marker.chain);
 	lim = MARKER_BLOCK_SIZE;
       }
   }
@@ -1613,11 +1632,19 @@ mark_object (objptr)
       }
       break;
 
-    case Lisp_Marker:
-      XMARK (XMARKER (obj)->chain);
-      /* DO NOT mark thru the marker's chain.
-	 The buffer's markers chain does not preserve markers from gc;
-	 instead, markers are removed from the chain when freed by gc.  */
+    case Lisp_Misc:
+      switch (XMISC (obj)->type)
+	{
+	case Lisp_Misc_Marker:
+	  XMARK (XMARKER (obj)->chain);
+	  /* DO NOT mark thru the marker's chain.
+	     The buffer's markers chain does not preserve markers from gc;
+	     instead, markers are removed from the chain when freed by gc.  */
+	  break;
+
+	default:
+	  abort ();
+	}
       break;
 
     case Lisp_Cons:
@@ -1855,20 +1882,26 @@ gc_sweep ()
       {
 	register int i;
 	for (i = 0; i < lim; i++)
-	  if (!XMARKBIT (mblk->markers[i].chain))
+	  if (mblk->markers[i].type == Lisp_Misc_Marker)
 	    {
-	      Lisp_Object tem;
-	      tem1 = &mblk->markers[i];  /* tem1 avoids Sun compiler bug */
-	      XSETMARKER (tem, tem1);
-	      unchain_marker (tem);
-	      XSETFASTINT (mblk->markers[i].chain, (EMACS_INT) marker_free_list);
-	      marker_free_list = &mblk->markers[i];
-	      num_free++;
-	    }
-	  else
-	    {
-	      num_used++;
-	      XUNMARK (mblk->markers[i].chain);
+	      if (!XMARKBIT (mblk->markers[i].u_marker.chain))
+		{
+		  Lisp_Object tem;
+		  tem1 = &mblk->markers[i].u_marker;  /* tem1 avoids Sun compiler bug */
+		  XSETMARKER (tem, tem1);
+		  unchain_marker (tem);
+		  /* We could leave the type alone, since nobody checks it,
+		     but this might catch bugs faster.  */
+		  mblk->markers[i].type = Lisp_Misc_Free;
+		  mblk->markers[i].u_free.chain = marker_free_list;
+		  marker_free_list = &mblk->markers[i];
+		  num_free++;
+		}
+	      else
+		{
+		  num_used++;
+		  XUNMARK (mblk->markers[i].u_marker.chain);
+		}
 	    }
 	lim = MARKER_BLOCK_SIZE;
       }