/[emacs]/emacs/src/alloc.c
ViewVC logotype

Diff of /emacs/src/alloc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.315 by eggert, Mon Jul 14 05:37:52 2003 UTC revision 1.316 by monnier, Tue Jul 15 19:19:59 2003 UTC
# Line 2183  struct Lisp_Float *float_free_list; Line 2183  struct Lisp_Float *float_free_list;
2183  void  void
2184  init_float ()  init_float ()
2185  {  {
2186    float_block = (struct float_block *) lisp_align_malloc (sizeof *float_block,    float_block = NULL;
2187                                                            MEM_TYPE_FLOAT);    float_block_index = FLOAT_BLOCK_SIZE; /* Force alloc of new float_block.   */
   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;  
2188    float_free_list = 0;    float_free_list = 0;
2189    n_float_blocks = 1;    n_float_blocks = 0;
2190  }  }
2191    
2192    
# Line 2252  make_float (float_value) Line 2248  make_float (float_value)
2248  /* We store cons cells inside of cons_blocks, allocating a new  /* We store cons cells inside of cons_blocks, allocating a new
2249     cons_block with malloc whenever necessary.  Cons cells reclaimed by     cons_block with malloc whenever necessary.  Cons cells reclaimed by
2250     GC are put on a free list to be reallocated before allocating     GC are put on a free list to be reallocated before allocating
2251     any new cons cells from the latest cons_block.     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. */  
2252    
2253  #define CONS_BLOCK_SIZE \  #define CONS_BLOCK_SIZE \
2254    ((1020 - sizeof (struct cons_block *)) / sizeof (struct Lisp_Cons))    (((BLOCK_BYTES - sizeof (struct cons_block *)) * CHAR_BIT) \
2255       / (sizeof (struct Lisp_Cons) * CHAR_BIT + 1))
2256    
2257    #define CONS_BLOCK(fptr) \
2258      ((struct cons_block *)(((EMACS_UINT)(fptr)) & ~(BLOCK_ALIGN - 1)))
2259    
2260    #define CONS_INDEX(fptr) \
2261      ((((EMACS_UINT)(fptr)) & (BLOCK_ALIGN - 1)) / sizeof (struct Lisp_Cons))
2262    
2263  struct cons_block  struct cons_block
2264  {  {
2265    struct cons_block *next;    /* Place `conses' at the beginning, to ease up CONS_INDEX's job.  */
2266    struct Lisp_Cons conses[CONS_BLOCK_SIZE];    struct Lisp_Cons conses[CONS_BLOCK_SIZE];
2267      int gcmarkbits[1 + CONS_BLOCK_SIZE / (sizeof(int) * CHAR_BIT)];
2268      struct cons_block *next;
2269  };  };
2270    
2271    #define CONS_MARKED_P(fptr) \
2272      GETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
2273    
2274    #define CONS_MARK(fptr) \
2275      SETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
2276    
2277    #define CONS_UNMARK(fptr) \
2278      UNSETMARKBIT (CONS_BLOCK (fptr), CONS_INDEX ((fptr)))
2279    
2280  /* Current cons_block.  */  /* Current cons_block.  */
2281    
2282  struct cons_block *cons_block;  struct cons_block *cons_block;
# Line 2289  int n_cons_blocks; Line 2299  int n_cons_blocks;
2299  void  void
2300  init_cons ()  init_cons ()
2301  {  {
2302    cons_block = (struct cons_block *) lisp_malloc (sizeof *cons_block,    cons_block = NULL;
2303                                                    MEM_TYPE_CONS);    cons_block_index = CONS_BLOCK_SIZE; /* Force alloc of new cons_block.  */
   cons_block->next = 0;  
   bzero ((char *) cons_block->conses, sizeof cons_block->conses);  
   cons_block_index = 0;  
2304    cons_free_list = 0;    cons_free_list = 0;
2305    n_cons_blocks = 1;    n_cons_blocks = 0;
2306  }  }
2307    
2308    
# Line 2332  DEFUN ("cons", Fcons, Scons, 2, 2, 0, Line 2339  DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2339        if (cons_block_index == CONS_BLOCK_SIZE)        if (cons_block_index == CONS_BLOCK_SIZE)
2340          {          {
2341            register struct cons_block *new;            register struct cons_block *new;
2342            new = (struct cons_block *) lisp_malloc (sizeof *new,            new = (struct cons_block *) lisp_align_malloc (sizeof *new,
2343                                                     MEM_TYPE_CONS);                                                           MEM_TYPE_CONS);
2344            new->next = cons_block;            new->next = cons_block;
2345            cons_block = new;            cons_block = new;
2346            cons_block_index = 0;            cons_block_index = 0;
# Line 2344  DEFUN ("cons", Fcons, Scons, 2, 2, 0, Line 2351  DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2351    
2352    XSETCAR (val, car);    XSETCAR (val, car);
2353    XSETCDR (val, cdr);    XSETCDR (val, cdr);
2354      CONS_UNMARK (XCONS (val));
2355    consing_since_gc += sizeof (struct Lisp_Cons);    consing_since_gc += sizeof (struct Lisp_Cons);
2356    cons_cells_consed++;    cons_cells_consed++;
2357    return val;    return val;
# Line 3435  live_cons_p (m, p) Line 3443  live_cons_p (m, p)
3443           one of the unused cells in the current cons block,           one of the unused cells in the current cons block,
3444           and not be on the free-list.  */           and not be on the free-list.  */
3445        return (offset >= 0        return (offset >= 0
3446                  && offset < (CONS_BLOCK_SIZE * sizeof b->conses[0])
3447                && offset % sizeof b->conses[0] == 0                && offset % sizeof b->conses[0] == 0
3448                && (b != cons_block                && (b != cons_block
3449                    || offset / sizeof b->conses[0] < cons_block_index)                    || offset / sizeof b->conses[0] < cons_block_index)
# Line 3629  mark_maybe_object (obj) Line 3638  mark_maybe_object (obj)
3638            break;            break;
3639    
3640          case Lisp_Cons:          case Lisp_Cons:
3641            mark_p = (live_cons_p (m, po)            mark_p = (live_cons_p (m, po) && !CONS_MARKED_P (XCONS (obj)));
                     && !XMARKBIT (XCONS (obj)->car));  
3642            break;            break;
3643    
3644          case Lisp_Symbol:          case Lisp_Symbol:
# Line 3704  mark_maybe_pointer (p) Line 3712  mark_maybe_pointer (p)
3712            break;            break;
3713    
3714          case MEM_TYPE_CONS:          case MEM_TYPE_CONS:
3715            if (live_cons_p (m, p)            if (live_cons_p (m, p) && !CONS_MARKED_P ((struct Lisp_Cons *) p))
               && !XMARKBIT (((struct Lisp_Cons *) p)->car))  
3716              XSETCONS (obj, p);              XSETCONS (obj, p);
3717            break;            break;
3718    
# Line 4405  returns nil, because real GC can't be do Line 4412  returns nil, because real GC can't be do
4412        for (i = 0; i < tail->nvars; i++)        for (i = 0; i < tail->nvars; i++)
4413          if (!XMARKBIT (tail->var[i]))          if (!XMARKBIT (tail->var[i]))
4414            {            {
             /* Explicit casting prevents compiler warning about  
                discarding the `volatile' qualifier.  */  
4415              mark_object (tail->var[i]);              mark_object (tail->var[i]);
4416              XMARK (tail->var[i]);              XMARK (tail->var[i]);
4417            }            }
# Line 4416  returns nil, because real GC can't be do Line 4421  returns nil, because real GC can't be do
4421    mark_byte_stack ();    mark_byte_stack ();
4422    for (bind = specpdl; bind != specpdl_ptr; bind++)    for (bind = specpdl; bind != specpdl_ptr; bind++)
4423      {      {
       /* These casts avoid a warning for discarding `volatile'.  */  
4424        mark_object (bind->symbol);        mark_object (bind->symbol);
4425        mark_object (bind->old_value);        mark_object (bind->old_value);
4426      }      }
# Line 5044  mark_object (arg) Line 5048  mark_object (arg)
5048      case Lisp_Cons:      case Lisp_Cons:
5049        {        {
5050          register struct Lisp_Cons *ptr = XCONS (obj);          register struct Lisp_Cons *ptr = XCONS (obj);
5051          if (XMARKBIT (ptr->car)) break;          if (CONS_MARKED_P (ptr)) break;
5052          CHECK_ALLOCATED_AND_LIVE (live_cons_p);          CHECK_ALLOCATED_AND_LIVE (live_cons_p);
5053          XMARK (ptr->car);          CONS_MARK (ptr);
5054          /* If the cdr is nil, avoid recursion for the car.  */          /* If the cdr is nil, avoid recursion for the car.  */
5055          if (EQ (ptr->cdr, Qnil))          if (EQ (ptr->cdr, Qnil))
5056            {            {
# Line 5105  mark_buffer (buf) Line 5109  mark_buffer (buf)
5109          {          {
5110            register struct Lisp_Cons *ptr = XCONS (tail);            register struct Lisp_Cons *ptr = XCONS (tail);
5111    
5112            if (XMARKBIT (ptr->car))            if (CONS_MARKED_P (ptr))
5113              break;              break;
5114            XMARK (ptr->car);            CONS_MARK (ptr);
5115            if (GC_CONSP (ptr->car)            if (GC_CONSP (ptr->car)
5116                && ! XMARKBIT (XCAR (ptr->car))                && !CONS_MARKED_P (XCONS (ptr->car))
5117                && GC_MARKERP (XCAR (ptr->car)))                && GC_MARKERP (XCAR (ptr->car)))
5118              {              {
5119                XMARK (XCAR_AS_LVALUE (ptr->car));                CONS_MARK (XCONS (ptr->car));
5120                mark_object (XCDR (ptr->car));                mark_object (XCDR (ptr->car));
5121              }              }
5122            else            else
# Line 5178  survives_gc_p (obj) Line 5182  survives_gc_p (obj)
5182        break;        break;
5183    
5184      case Lisp_String:      case Lisp_String:
5185        {        survives_p = STRING_MARKED_P (XSTRING (obj));
         struct Lisp_String *s = XSTRING (obj);  
         survives_p = STRING_MARKED_P (s);  
       }  
5186        break;        break;
5187    
5188      case Lisp_Vectorlike:      case Lisp_Vectorlike:
5189        if (GC_BUFFERP (obj))        survives_p = GC_SUBRP (obj) || VECTOR_MARKED_P (XVECTOR (obj));
         survives_p = VECTOR_MARKED_P (XBUFFER (obj));  
       else if (GC_SUBRP (obj))  
         survives_p = 1;  
       else  
         survives_p = VECTOR_MARKED_P (XVECTOR (obj));  
5190        break;        break;
5191    
5192      case Lisp_Cons:      case Lisp_Cons:
5193        survives_p = XMARKBIT (XCAR (obj));        survives_p = CONS_MARKED_P (XCONS (obj));
5194        break;        break;
5195    
5196      case Lisp_Float:      case Lisp_Float:
# Line 5239  gc_sweep () Line 5235  gc_sweep ()
5235          register int i;          register int i;
5236          int this_free = 0;          int this_free = 0;
5237          for (i = 0; i < lim; i++)          for (i = 0; i < lim; i++)
5238            if (!XMARKBIT (cblk->conses[i].car))            if (!CONS_MARKED_P (&cblk->conses[i]))
5239              {              {
5240                this_free++;                this_free++;
5241                *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;                *(struct Lisp_Cons **)&cblk->conses[i].cdr = cons_free_list;
# Line 5251  gc_sweep () Line 5247  gc_sweep ()
5247            else            else
5248              {              {
5249                num_used++;                num_used++;
5250                XUNMARK (cblk->conses[i].car);                CONS_UNMARK (&cblk->conses[i]);
5251              }              }
5252          lim = CONS_BLOCK_SIZE;          lim = CONS_BLOCK_SIZE;
5253          /* If this block contains only free conses and we have already          /* If this block contains only free conses and we have already
# Line 5262  gc_sweep () Line 5258  gc_sweep ()
5258              *cprev = cblk->next;              *cprev = cblk->next;
5259              /* Unhook from the free list.  */              /* Unhook from the free list.  */
5260              cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;              cons_free_list = *(struct Lisp_Cons **) &cblk->conses[0].cdr;
5261              lisp_free (cblk);              lisp_align_free (cblk);
5262              n_cons_blocks--;              n_cons_blocks--;
5263            }            }
5264          else          else

Legend:
Removed from v.1.315  
changed lines
  Added in v.1.316

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26