[Emacs-diffs] Changes to emacs/src/alloc.c

[Stefan Monnier]

Index: emacs/src/alloc.c
diff -c emacs/src/alloc.c:1.315 emacs/src/alloc.c:1.316
*** emacs/src/alloc.c:1.315     Mon Jul 14 01:37:52 2003
--- emacs/src/alloc.c   Tue Jul 15 15:19:59 2003
***************
*** 2183,2196 ****
  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_free_list = 0;
!   n_float_blocks = 1;
  }
  
  
--- 2183,2192 ----
  void
  init_float ()
  {
!   float_block = NULL;
!   float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block.   
*/
    float_free_list = 0;
!   n_float_blocks = 0;
  }
  
  
***************
*** 2252,2272 ****
  /* 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. */
  
  #define CONS_BLOCK_SIZE \
!   ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))
  
  struct cons_block
  {
!   struct cons_block *next;
    struct Lisp_Cons conses[CONS_BLOCK_SIZE];
  };
  
  /* Current cons_block.  */
  
  struct cons_block *cons_block;
--- 2248,2282 ----
  /* 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.  */
  
  #define CONS_BLOCK_SIZE \
!   (((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
  {
!   /* 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,2301 ****
  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_free_list = 0;
!   n_cons_blocks = 1;
  }
  
  
--- 2299,2308 ----
  void
  init_cons ()
  {
!   cons_block = NULL;
!   cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block.  */
    cons_free_list = 0;
!   n_cons_blocks = 0;
  }
  
  
***************
*** 2332,2339 ****
        if (cons_block_index == CONS_BLOCK_SIZE)
        {
          register struct cons_block *new;
!         new = (struct cons_block *) lisp_malloc (sizeof *new,
!                                                  MEM_TYPE_CONS);
          new->next = cons_block;
          cons_block = new;
          cons_block_index = 0;
--- 2339,2346 ----
        if (cons_block_index == CONS_BLOCK_SIZE)
        {
          register struct cons_block *new;
!         new = (struct cons_block *) lisp_align_malloc (sizeof *new,
!                                                        MEM_TYPE_CONS);
          new->next = cons_block;
          cons_block = new;
          cons_block_index = 0;
***************
*** 2344,2349 ****
--- 2351,2357 ----
  
    XSETCAR (val, car);
    XSETCDR (val, cdr);
+   CONS_UNMARK (XCONS (val));
    consing_since_gc += sizeof (struct Lisp_Cons);
    cons_cells_consed++;
    return val;
***************
*** 3435,3440 ****
--- 3443,3449 ----
         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,3636 ****
          break;
  
        case Lisp_Cons:
!         mark_p = (live_cons_p (m, po)
!                   && !XMARKBIT (XCONS (obj)->car));
          break;
  
        case Lisp_Symbol:
--- 3638,3644 ----
          break;
  
        case Lisp_Cons:
!         mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
          break;
  
        case Lisp_Symbol:
***************
*** 3704,3711 ****
          break;
  
        case MEM_TYPE_CONS:
!         if (live_cons_p (m, p)
!             && !XMARKBIT (((struct Lisp_Cons *) p)->car))
            XSETCONS (obj, p);
          break;
  
--- 3712,3718 ----
          break;
  
        case MEM_TYPE_CONS:
!         if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
            XSETCONS (obj, p);
          break;
  
***************
*** 4405,4412 ****
        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]);
          }
--- 4412,4417 ----
***************
*** 4416,4422 ****
    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);
      }
--- 4421,4426 ----
***************
*** 5044,5052 ****
      case Lisp_Cons:
        {
        register struct Lisp_Cons *ptr = XCONS (obj);
!       if (XMARKBIT (ptr->car)) break;
        CHECK_ALLOCATED_AND_LIVE (live_cons_p);
!       XMARK (ptr->car);
        /* If the cdr is nil, avoid recursion for the car.  */
        if (EQ (ptr->cdr, Qnil))
          {
--- 5048,5056 ----
      case Lisp_Cons:
        {
        register struct Lisp_Cons *ptr = XCONS (obj);
!       if (CONS_MARKED_P (ptr)) break;
        CHECK_ALLOCATED_AND_LIVE (live_cons_p);
!       CONS_MARK (ptr);
        /* If the cdr is nil, avoid recursion for the car.  */
        if (EQ (ptr->cdr, Qnil))
          {
***************
*** 5105,5118 ****
        {
          register struct Lisp_Cons *ptr = XCONS (tail);
  
!         if (XMARKBIT (ptr->car))
            break;
!         XMARK (ptr->car);
          if (GC_CONSP (ptr->car)
!             && ! XMARKBIT (XCAR (ptr->car))
              && GC_MARKERP (XCAR (ptr->car)))
            {
!             XMARK (XCAR_AS_LVALUE (ptr->car));
              mark_object (XCDR (ptr->car));
            }
          else
--- 5109,5122 ----
        {
          register struct Lisp_Cons *ptr = XCONS (tail);
  
!         if (CONS_MARKED_P (ptr))
            break;
!         CONS_MARK (ptr);
          if (GC_CONSP (ptr->car)
!             && !CONS_MARKED_P (XCONS (ptr->car))
              && GC_MARKERP (XCAR (ptr->car)))
            {
!             CONS_MARK (XCONS (ptr->car));
              mark_object (XCDR (ptr->car));
            }
          else
***************
*** 5178,5200 ****
        break;
  
      case Lisp_String:
!       {
!       struct Lisp_String *s = XSTRING (obj);
!       survives_p = STRING_MARKED_P (s);
!       }
        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));
        break;
  
      case Lisp_Cons:
!       survives_p = XMARKBIT (XCAR (obj));
        break;
  
      case Lisp_Float:
--- 5182,5196 ----
        break;
  
      case Lisp_String:
!       survives_p = STRING_MARKED_P (XSTRING (obj));
        break;
  
      case Lisp_Vectorlike:
!       survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
        break;
  
      case Lisp_Cons:
!       survives_p = CONS_MARKED_P (XCONS (obj));
        break;
  
      case Lisp_Float:
***************
*** 5239,5245 ****
        register int i;
        int this_free = 0;
        for (i = 0; i < lim; i++)
!         if (!XMARKBIT (cblk->conses[i].car))
            {
              this_free++;
              *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
--- 5235,5241 ----
        register int i;
        int this_free = 0;
        for (i = 0; i < lim; i++)
!         if (!CONS_MARKED_P (&cblk->conses[i]))
            {
              this_free++;
              *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
***************
*** 5251,5257 ****
          else
            {
              num_used++;
!             XUNMARK (cblk->conses[i].car);
            }
        lim = CONS_BLOCK_SIZE;
        /* If this block contains only free conses and we have already
--- 5247,5253 ----
          else
            {
              num_used++;
!             CONS_UNMARK (&cblk->conses[i]);
            }
        lim = CONS_BLOCK_SIZE;
        /* If this block contains only free conses and we have already
***************
*** 5262,5268 ****
            *cprev = cblk->next;
            /* Unhook from the free list.  */
            cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
!           lisp_free (cblk);
            n_cons_blocks--;
          }
        else
--- 5258,5264 ----
            *cprev = cblk->next;
            /* Unhook from the free list.  */
            cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
!           lisp_align_free (cblk);
            n_cons_blocks--;
          }
        else