Use bitmaps for cons cells, as was done for floats.

(init_float, init_cons): Let the normal code allocate the first block.
(CONS_BLOCK_SIZE): Redefine based on BLOCK_BYTES and bitmap size.
(CONS_BLOCK, CONS_INDEX, CONS_MARKED_P, CONS_MARK, CONS_UNMARK): New macros.
(struct cons_block): Move conses to the beginning.  Add gcmarkbits.
(Fcons): Use lisp_align_malloc and CONS_UNMARK.
(live_cons_p): Check the pointer is not past the `conses' array.
(mark_maybe_object, mark_maybe_pointer): Use CONS_MARKED_P.
(mark_object, mark_buffer): Use CONS_MARKED_P and CONS_MARK.
(survives_gc_p): Use CONS_MARKED_P and simplify.
(gc_sweep): Use CONS_MARKED_P, CONS_UNMARK, and lisp_align_free.

diff --git a/src/alloc.c b/src/alloc.c
index 18770929532aa0132dc36dfc55c6547ea4cd4722..ea93ba0070af6ff753f06bebefe417b0a8e12fb5 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -2183,14 +2183,10 @@ struct Lisp_Float *float_free_list;
 void
 init_float ()
 {
-  float_block = (struct float_block *) lisp_align_malloc (sizeof *float_block,
-                                                         MEM_TYPE_FLOAT);
-  float_block->next = 0;
-  bzero ((char *) float_block->floats, sizeof float_block->floats);
-  bzero ((char *) float_block->gcmarkbits, sizeof float_block->gcmarkbits);
-  float_block_index = 0;
+  float_block = NULL;
+  float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block.   */
   float_free_list = 0;
-  n_float_blocks = 1;
+  n_float_blocks = 0;
 }
 
 
@@ -2252,21 +2248,35 @@ make_float (float_value)
 /* We store cons cells inside of cons_blocks, allocating a new
    cons_block with malloc whenever necessary.  Cons cells reclaimed by
    GC are put on a free list to be reallocated before allocating
-   any new cons cells from the latest cons_block.
-
-   Each cons_block is just under 1020 bytes long,
-   since malloc really allocates in units of powers of two
-   and uses 4 bytes for its own overhead. */
+   any new cons cells from the latest cons_block.  */
 
 #define CONS_BLOCK_SIZE \
-  ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
+  (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
+   / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
+
+#define CONS_BLOCK(fptr) \
+  ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
+
+#define CONS_INDEX(fptr) \
+  ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
 
 struct cons_block
 {
-  struct cons_block *next;
+  /* Place `conses' at the beginning, to ease up CONS_INDEX's job.  */
   struct Lisp_Cons conses[CONS_BLOCK_SIZE];
+  int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
+  struct cons_block *next;
 };
 
+#define CONS_MARKED_P(fptr) \
+  GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+
+#define CONS_MARK(fptr) \
+  SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+
+#define CONS_UNMARK(fptr) \
+  UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
+
 /* Current cons_block.  */
 
 struct cons_block *cons_block;
@@ -2289,13 +2299,10 @@ int n_cons_blocks;
 void
 init_cons ()
 {
-  cons_block = (struct cons_block *) lisp_malloc (sizeof *cons_block,
-                                                 MEM_TYPE_CONS);
-  cons_block->next = 0;
-  bzero ((char *) cons_block->conses, sizeof cons_block->conses);
-  cons_block_index = 0;
+  cons_block = NULL;
+  cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block.  */
   cons_free_list = 0;
-  n_cons_blocks = 1;
+  n_cons_blocks = 0;
 }
 
 
@@ -2332,8 +2339,8 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
       if (cons_block_index == CONS_BLOCK_SIZE)
        {
          register struct cons_block *new;
-         new = (struct cons_block *) lisp_malloc (sizeof *new,
-                                                  MEM_TYPE_CONS);
+         new = (struct cons_block *) lisp_align_malloc (sizeof *new,
+                                                        MEM_TYPE_CONS);
          new->next = cons_block;
          cons_block = new;
          cons_block_index = 0;
@@ -2344,6 +2351,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
 
   XSETCAR (val, car);
   XSETCDR (val, cdr);
+  CONS_UNMARK (XCONS (val));
   consing_since_gc += sizeof (struct Lisp_Cons);
   cons_cells_consed++;
   return val;
@@ -3435,6 +3443,7 @@ live_cons_p (m, p)
         one of the unused cells in the current cons block,
         and not be on the free-list.  */
       return (offset >= 0
+             && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
              && offset % sizeof b->conses[0] == 0
              && (b != cons_block
                  || offset / sizeof b->conses[0] < cons_block_index)
@@ -3629,8 +3638,7 @@ mark_maybe_object (obj)
          break;
 
        case Lisp_Cons:
-         mark_p = (live_cons_p (m, po)
-                   && !XMARKBIT (XCONS (obj)->car));
+         mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
          break;
 
        case Lisp_Symbol:
@@ -3704,8 +3712,7 @@ mark_maybe_pointer (p)
          break;
 
        case MEM_TYPE_CONS:
-         if (live_cons_p (m, p)
-             && !XMARKBIT (((struct Lisp_Cons *) p)->car))
+         if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
            XSETCONS (obj, p);
          break;
 
@@ -4405,8 +4412,6 @@ returns nil, because real GC can't be done.  */)
       for (i = 0; i < tail->nvars; i++)
        if (!XMARKBIT (tail->var[i]))
          {
-           /* Explicit casting prevents compiler warning about
-              discarding the `volatile' qualifier.  */
            mark_object (tail->var[i]);
            XMARK (tail->var[i]);
          }
@@ -4416,7 +4421,6 @@ returns nil, because real GC can't be done.  */)
   mark_byte_stack ();
   for (bind = specpdl; bind != specpdl_ptr; bind++)
     {
-      /* These casts avoid a warning for discarding `volatile'.  */
       mark_object (bind->symbol);
       mark_object (bind->old_value);
     }
@@ -5044,9 +5048,9 @@ mark_object (arg)
     case Lisp_Cons:
       {
        register struct Lisp_Cons *ptr = XCONS (obj);
-       if (XMARKBIT (ptr->car)) break;
+       if (CONS_MARKED_P (ptr)) break;
        CHECK_ALLOCATED_AND_LIVE (live_cons_p);
-       XMARK (ptr->car);
+       CONS_MARK (ptr);
        /* If the cdr is nil, avoid recursion for the car.  */
        if (EQ (ptr->cdr, Qnil))
          {
@@ -5105,14 +5109,14 @@ mark_buffer (buf)
        {
          register struct Lisp_Cons *ptr = XCONS (tail);
 
-         if (XMARKBIT (ptr->car))
+         if (CONS_MARKED_P (ptr))
            break;
-         XMARK (ptr->car);
+         CONS_MARK (ptr);
          if (GC_CONSP (ptr->car)
-             && ! XMARKBIT (XCAR (ptr->car))
+             && !CONS_MARKED_P (XCONS (ptr->car))
              && GC_MARKERP (XCAR (ptr->car)))
            {
-             XMARK (XCAR_AS_LVALUE (ptr->car));
+             CONS_MARK (XCONS (ptr->car));
              mark_object (XCDR (ptr->car));
            }
          else
@@ -5178,23 +5182,15 @@ survives_gc_p (obj)
       break;
 
     case Lisp_String:
-      {
-       struct Lisp_String *s = XSTRING (obj);
-       survives_p = STRING_MARKED_P (s);
-      }
+      survives_p = STRING_MARKED_P (XSTRING (obj));
       break;
 
     case Lisp_Vectorlike:
-      if (GC_BUFFERP (obj))
-       survives_p = VECTOR_MARKED_P (XBUFFER (obj));
-      else if (GC_SUBRP (obj))
-       survives_p = 1;
-      else
-       survives_p = VECTOR_MARKED_P (XVECTOR (obj));
+      survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
       break;
 
     case Lisp_Cons:
-      survives_p = XMARKBIT (XCAR (obj));
+      survives_p = CONS_MARKED_P (XCONS (obj));
       break;
 
     case Lisp_Float:
@@ -5239,7 +5235,7 @@ gc_sweep ()
        register int i;
        int this_free = 0;
        for (i = 0; i < lim; i++)
-         if (!XMARKBIT (cblk->conses[i].car))
+         if (!CONS_MARKED_P (&cblk->conses[i]))
            {
              this_free++;
              *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
@@ -5251,7 +5247,7 @@ gc_sweep ()
          else
            {
              num_used++;
-             XUNMARK (cblk->conses[i].car);
+             CONS_UNMARK (&cblk->conses[i]);
            }
        lim = CONS_BLOCK_SIZE;
        /* If this block contains only free conses and we have already
@@ -5262,7 +5258,7 @@ gc_sweep ()
            *cprev = cblk->next;
            /* Unhook from the free list.  */
            cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
-           lisp_free (cblk);
+           lisp_align_free (cblk);
            n_cons_blocks--;
          }
        else