(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.

diff --git a/src/alloc.c b/src/alloc.c
index 2def77bf0bfd1338fe820941ed862306f00e185b..a92ef25d2be04802b10c701623fb832f378e0ffa 100644 (file)
--- 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;
 }
 \f
-/* 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;
 }
 \f
@@ -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;
       }