/[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.303 by monnier, Sun Jun 15 21:48:14 2003 UTC revision 1.304 by monnier, Wed Jun 25 23:27:32 2003 UTC
# Line 947  make_interval () Line 947  make_interval ()
947    consing_since_gc += sizeof (struct interval);    consing_since_gc += sizeof (struct interval);
948    intervals_consed++;    intervals_consed++;
949    RESET_INTERVAL (val);    RESET_INTERVAL (val);
950      val->gcmarkbit = 0;
951    return val;    return val;
952  }  }
953    
# Line 958  mark_interval (i, dummy) Line 959  mark_interval (i, dummy)
959       register INTERVAL i;       register INTERVAL i;
960       Lisp_Object dummy;       Lisp_Object dummy;
961  {  {
962    if (XMARKBIT (i->plist))    eassert (!i->gcmarkbit);              /* Intervals are never shared.  */
963      abort ();    i->gcmarkbit = 1;
964    mark_object (&i->plist);    mark_object (&i->plist);
   XMARK (i->plist);  
965  }  }
966    
967    
# Line 976  mark_interval_tree (tree) Line 976  mark_interval_tree (tree)
976       function is always called through the MARK_INTERVAL_TREE macro,       function is always called through the MARK_INTERVAL_TREE macro,
977       which takes care of that.  */       which takes care of that.  */
978    
   /* XMARK expands to an assignment; the LHS of an assignment can't be  
      a cast.  */  
   XMARK (tree->up.obj);  
   
979    traverse_intervals_noorder (tree, mark_interval, Qnil);    traverse_intervals_noorder (tree, mark_interval, Qnil);
980  }  }
981    
# Line 988  mark_interval_tree (tree) Line 984  mark_interval_tree (tree)
984    
985  #define MARK_INTERVAL_TREE(i)                           \  #define MARK_INTERVAL_TREE(i)                           \
986    do {                                                  \    do {                                                  \
987      if (!NULL_INTERVAL_P (i)                            \      if (!NULL_INTERVAL_P (i) && !i->gcmarkbit)          \
         && ! XMARKBIT (i->up.obj))                      \  
988        mark_interval_tree (i);                           \        mark_interval_tree (i);                           \
989    } while (0)    } while (0)
990    
991    
 /* The oddity in the call to XUNMARK is necessary because XUNMARK  
    expands to an assignment to its argument, and most C compilers  
    don't support casts on the left operand of `='.  */  
   
992  #define UNMARK_BALANCE_INTERVALS(i)                     \  #define UNMARK_BALANCE_INTERVALS(i)                     \
993    do {                                                  \    do {                                                  \
994     if (! NULL_INTERVAL_P (i))                           \     if (! NULL_INTERVAL_P (i))                           \
995       {                                                  \       (i) = balance_intervals (i);                       \
        XUNMARK ((i)->up.obj);                           \  
        (i) = balance_intervals (i);                     \  
      }                                                  \  
996    } while (0)    } while (0)
997    
998    
# Line 2568  Its value and function definition are vo Line 2556  Its value and function definition are vo
2556    p->value = Qunbound;    p->value = Qunbound;
2557    p->function = Qunbound;    p->function = Qunbound;
2558    p->next = NULL;    p->next = NULL;
2559      p->gcmarkbit = 0;
2560    p->interned = SYMBOL_UNINTERNED;    p->interned = SYMBOL_UNINTERNED;
2561    p->constant = 0;    p->constant = 0;
2562    p->indirect_variable = 0;    p->indirect_variable = 0;
# Line 2644  allocate_misc () Line 2633  allocate_misc ()
2633    
2634    consing_since_gc += sizeof (union Lisp_Misc);    consing_since_gc += sizeof (union Lisp_Misc);
2635    misc_objects_consed++;    misc_objects_consed++;
2636      XMARKER (val)->gcmarkbit = 0;
2637    return val;    return val;
2638  }  }
2639    
# Line 3302  live_vector_p (m, p) Line 3292  live_vector_p (m, p)
3292  }  }
3293    
3294    
3295  /* Value is non-zero of P is a pointer to a live buffer.  M is a  /* Value is non-zero if P is a pointer to a live buffer.  M is a
3296     pointer to the mem_block for P.  */     pointer to the mem_block for P.  */
3297    
3298  static INLINE int  static INLINE int
# Line 3397  mark_maybe_object (obj) Line 3387  mark_maybe_object (obj)
3387            break;            break;
3388    
3389          case Lisp_Symbol:          case Lisp_Symbol:
3390            mark_p = (live_symbol_p (m, po)            mark_p = (live_symbol_p (m, po) && !XSYMBOL (obj)->gcmarkbit);
                     && !XMARKBIT (XSYMBOL (obj)->plist));  
3391            break;            break;
3392    
3393          case Lisp_Float:          case Lisp_Float:
# Line 3418  mark_maybe_object (obj) Line 3407  mark_maybe_object (obj)
3407            break;            break;
3408    
3409          case Lisp_Misc:          case Lisp_Misc:
3410            if (live_misc_p (m, po))            mark_p = (live_misc_p (m, po) && !XMARKER (obj)->gcmarkbit);
             {  
               switch (XMISCTYPE (obj))  
                 {  
                 case Lisp_Misc_Marker:  
                   mark_p = !XMARKBIT (XMARKER (obj)->chain);  
                   break;  
   
                 case Lisp_Misc_Buffer_Local_Value:  
                 case Lisp_Misc_Some_Buffer_Local_Value:  
                   mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);  
                   break;  
   
                 case Lisp_Misc_Overlay:  
                   mark_p = !XMARKBIT (XOVERLAY (obj)->plist);  
                   break;  
                 }  
             }  
3411            break;            break;
3412    
3413          case Lisp_Int:          case Lisp_Int:
# Line 3500  mark_maybe_pointer (p) Line 3472  mark_maybe_pointer (p)
3472            break;            break;
3473    
3474          case MEM_TYPE_MISC:          case MEM_TYPE_MISC:
3475            if (live_misc_p (m, p))            if (live_misc_p (m, p) && !((struct Lisp_Free *) p)->gcmarkbit)
3476              {              XSETMISC (obj, p);
               Lisp_Object tem;  
               XSETMISC (tem, p);  
   
               switch (XMISCTYPE (tem))  
                 {  
                 case Lisp_Misc_Marker:  
                   if (!XMARKBIT (XMARKER (tem)->chain))  
                     obj = tem;  
                   break;  
   
                 case Lisp_Misc_Buffer_Local_Value:  
                 case Lisp_Misc_Some_Buffer_Local_Value:  
                   if (!XMARKBIT (XBUFFER_LOCAL_VALUE (tem)->realvalue))  
                     obj = tem;  
                   break;  
   
                 case Lisp_Misc_Overlay:  
                   if (!XMARKBIT (XOVERLAY (tem)->plist))  
                     obj = tem;  
                   break;  
                 }  
             }  
3477            break;            break;
3478    
3479          case MEM_TYPE_SYMBOL:          case MEM_TYPE_SYMBOL:
3480            if (live_symbol_p (m, p)            if (live_symbol_p (m, p) && !((struct Lisp_Symbol *) p)->gcmarkbit)
               && !XMARKBIT (((struct Lisp_Symbol *) p)->plist))  
3481              XSETSYMBOL (obj, p);              XSETSYMBOL (obj, p);
3482            break;            break;
3483    
# Line 4278  Garbage collection happens automatically Line 4227  Garbage collection happens automatically
4227                {                {
4228                  if (GC_CONSP (XCAR (tail))                  if (GC_CONSP (XCAR (tail))
4229                      && GC_MARKERP (XCAR (XCAR (tail)))                      && GC_MARKERP (XCAR (XCAR (tail)))
4230                      && ! XMARKBIT (XMARKER (XCAR (XCAR (tail)))->chain))                      && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
4231                    {                    {
4232                      if (NILP (prev))                      if (NILP (prev))
4233                        nextb->undo_list = tail = XCDR (tail);                        nextb->undo_list = tail = XCDR (tail);
# Line 4774  mark_object (argptr) Line 4723  mark_object (argptr)
4723          register struct Lisp_Symbol *ptr = XSYMBOL (obj);          register struct Lisp_Symbol *ptr = XSYMBOL (obj);
4724          struct Lisp_Symbol *ptrx;          struct Lisp_Symbol *ptrx;
4725    
4726          if (XMARKBIT (ptr->plist)) break;          if (ptr->gcmarkbit) break;
4727          CHECK_ALLOCATED_AND_LIVE (live_symbol_p);          CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
4728          XMARK (ptr->plist);          ptr->gcmarkbit = 1;
4729          mark_object ((Lisp_Object *) &ptr->value);          mark_object ((Lisp_Object *) &ptr->value);
4730          mark_object (&ptr->function);          mark_object (&ptr->function);
4731          mark_object (&ptr->plist);          mark_object (&ptr->plist);
# Line 4804  mark_object (argptr) Line 4753  mark_object (argptr)
4753    
4754      case Lisp_Misc:      case Lisp_Misc:
4755        CHECK_ALLOCATED_AND_LIVE (live_misc_p);        CHECK_ALLOCATED_AND_LIVE (live_misc_p);
4756          if (XMARKER (obj)->gcmarkbit)
4757            break;
4758          XMARKER (obj)->gcmarkbit = 1;
4759        switch (XMISCTYPE (obj))        switch (XMISCTYPE (obj))
4760          {          {
         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;  
   
4761          case Lisp_Misc_Buffer_Local_Value:          case Lisp_Misc_Buffer_Local_Value:
4762          case Lisp_Misc_Some_Buffer_Local_Value:          case Lisp_Misc_Some_Buffer_Local_Value:
4763            {            {
4764              register struct Lisp_Buffer_Local_Value *ptr              register struct Lisp_Buffer_Local_Value *ptr
4765                = XBUFFER_LOCAL_VALUE (obj);                = XBUFFER_LOCAL_VALUE (obj);
             if (XMARKBIT (ptr->realvalue)) break;  
             XMARK (ptr->realvalue);  
4766              /* If the cdr is nil, avoid recursion for the car.  */              /* If the cdr is nil, avoid recursion for the car.  */
4767              if (EQ (ptr->cdr, Qnil))              if (EQ (ptr->cdr, Qnil))
4768                {                {
# Line 4833  mark_object (argptr) Line 4776  mark_object (argptr)
4776              goto loop;              goto loop;
4777            }            }
4778    
4779            case Lisp_Misc_Marker:
4780              /* DO NOT mark thru the marker's chain.
4781                 The buffer's markers chain does not preserve markers from gc;
4782                 instead, markers are removed from the chain when freed by gc.  */
4783          case Lisp_Misc_Intfwd:          case Lisp_Misc_Intfwd:
4784          case Lisp_Misc_Boolfwd:          case Lisp_Misc_Boolfwd:
4785          case Lisp_Misc_Objfwd:          case Lisp_Misc_Objfwd:
# Line 4847  mark_object (argptr) Line 4794  mark_object (argptr)
4794          case Lisp_Misc_Overlay:          case Lisp_Misc_Overlay:
4795            {            {
4796              struct Lisp_Overlay *ptr = XOVERLAY (obj);              struct Lisp_Overlay *ptr = XOVERLAY (obj);
4797              if (!XMARKBIT (ptr->plist))              mark_object (&ptr->start);
4798                {              mark_object (&ptr->end);
4799                  XMARK (ptr->plist);              objptr = &ptr->plist;
4800                  mark_object (&ptr->start);              goto loop;
                 mark_object (&ptr->end);  
                 objptr = &ptr->plist;  
                 goto loop;  
               }  
4801            }            }
4802            break;            break;
4803    
# Line 4922  mark_buffer (buf) Line 4865  mark_buffer (buf)
4865        Lisp_Object tail;        Lisp_Object tail;
4866        tail = buffer->undo_list;        tail = buffer->undo_list;
4867    
4868          /* We mark the undo list specially because
4869             its pointers to markers should be weak.  */
4870    
4871        while (CONSP (tail))        while (CONSP (tail))
4872          {          {
4873            register struct Lisp_Cons *ptr = XCONS (tail);            register struct Lisp_Cons *ptr = XCONS (tail);
# Line 4980  survives_gc_p (obj) Line 4926  survives_gc_p (obj)
4926        break;        break;
4927    
4928      case Lisp_Symbol:      case Lisp_Symbol:
4929        survives_p = XMARKBIT (XSYMBOL (obj)->plist);        survives_p = XSYMBOL (obj)->gcmarkbit;
4930        break;        break;
4931    
4932      case Lisp_Misc:      case Lisp_Misc:
4933          /* FIXME: Maybe we should just use obj->mark for all?  */
4934        switch (XMISCTYPE (obj))        switch (XMISCTYPE (obj))
4935          {          {
4936          case Lisp_Misc_Marker:          case Lisp_Misc_Marker:
4937            survives_p = XMARKBIT (obj);            survives_p = XMARKER (obj)->gcmarkbit;
4938            break;            break;
4939    
4940          case Lisp_Misc_Buffer_Local_Value:          case Lisp_Misc_Buffer_Local_Value:
4941          case Lisp_Misc_Some_Buffer_Local_Value:          case Lisp_Misc_Some_Buffer_Local_Value:
4942            survives_p = XMARKBIT (XBUFFER_LOCAL_VALUE (obj)->realvalue);            survives_p = XBUFFER_LOCAL_VALUE (obj)->gcmarkbit;
4943            break;            break;
4944    
4945          case Lisp_Misc_Intfwd:          case Lisp_Misc_Intfwd:
# Line 5004  survives_gc_p (obj) Line 4951  survives_gc_p (obj)
4951            break;            break;
4952    
4953          case Lisp_Misc_Overlay:          case Lisp_Misc_Overlay:
4954            survives_p = XMARKBIT (XOVERLAY (obj)->plist);            survives_p = XOVERLAY (obj)->gcmarkbit;
4955            break;            break;
4956    
4957          default:          default:
# Line 5176  gc_sweep () Line 5123  gc_sweep ()
5123    
5124          for (i = 0; i < lim; i++)          for (i = 0; i < lim; i++)
5125            {            {
5126              if (! XMARKBIT (iblk->intervals[i].plist))              if (!iblk->intervals[i].gcmarkbit)
5127                {                {
5128                  SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);                  SET_INTERVAL_PARENT (&iblk->intervals[i], interval_free_list);
5129                  interval_free_list = &iblk->intervals[i];                  interval_free_list = &iblk->intervals[i];
# Line 5185  gc_sweep () Line 5132  gc_sweep ()
5132              else              else
5133                {                {
5134                  num_used++;                  num_used++;
5135                  XUNMARK (iblk->intervals[i].plist);                  iblk->intervals[i].gcmarkbit = 0;
5136                }                }
5137            }            }
5138          lim = INTERVAL_BLOCK_SIZE;          lim = INTERVAL_BLOCK_SIZE;
# Line 5232  gc_sweep () Line 5179  gc_sweep ()
5179                 so we conservatively assume that it is live.  */                 so we conservatively assume that it is live.  */
5180              int pure_p = PURE_POINTER_P (XSTRING (sym->xname));              int pure_p = PURE_POINTER_P (XSTRING (sym->xname));
5181    
5182              if (!XMARKBIT (sym->plist) && !pure_p)              if (!sym->gcmarkbit && !pure_p)
5183                {                {
5184                  *(struct Lisp_Symbol **) &sym->value = symbol_free_list;                  *(struct Lisp_Symbol **) &sym->value = symbol_free_list;
5185                  symbol_free_list = sym;                  symbol_free_list = sym;
# Line 5246  gc_sweep () Line 5193  gc_sweep ()
5193                  ++num_used;                  ++num_used;
5194                  if (!pure_p)                  if (!pure_p)
5195                    UNMARK_STRING (XSTRING (sym->xname));                    UNMARK_STRING (XSTRING (sym->xname));
5196                  XUNMARK (sym->plist);                  sym->gcmarkbit = 0;
5197                }                }
5198            }            }
5199    
# Line 5286  gc_sweep () Line 5233  gc_sweep ()
5233        {        {
5234          register int i;          register int i;
5235          int this_free = 0;          int this_free = 0;
         EMACS_INT already_free = -1;  
5236    
5237          for (i = 0; i < lim; i++)          for (i = 0; i < lim; i++)
5238            {            {
5239              Lisp_Object *markword;              if (!mblk->markers[i].u_marker.gcmarkbit)
             switch (mblk->markers[i].u_marker.type)  
               {  
               case Lisp_Misc_Marker:  
                 markword = &mblk->markers[i].u_marker.chain;  
                 break;  
               case Lisp_Misc_Buffer_Local_Value:  
               case Lisp_Misc_Some_Buffer_Local_Value:  
                 markword = &mblk->markers[i].u_buffer_local_value.realvalue;  
                 break;  
               case Lisp_Misc_Overlay:  
                 markword = &mblk->markers[i].u_overlay.plist;  
                 break;  
               case Lisp_Misc_Free:  
                 /* If the object was already free, keep it  
                    on the free list.  */  
                 markword = (Lisp_Object *) &already_free;  
                 break;  
               default:  
                 markword = 0;  
                 break;  
               }  
             if (markword && !XMARKBIT (*markword))  
5240                {                {
5241                  Lisp_Object tem;                  Lisp_Object tem;
5242                  if (mblk->markers[i].u_marker.type == Lisp_Misc_Marker)                  if (mblk->markers[i].u_marker.type == Lisp_Misc_Marker)
# Line 5333  gc_sweep () Line 5257  gc_sweep ()
5257              else              else
5258                {                {
5259                  num_used++;                  num_used++;
5260                  if (markword)                  mblk->markers[i].u_marker.gcmarkbit = 0;
                   XUNMARK (*markword);  
5261                }                }
5262            }            }
5263          lim = MARKER_BLOCK_SIZE;          lim = MARKER_BLOCK_SIZE;

Legend:
Removed from v.1.303  
changed lines
  Added in v.1.304

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