/[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.272.2.7 by miles, Tue Jul 6 09:14:34 2004 UTC revision 1.272.2.8 by miles, Tue Jul 6 09:23:52 2004 UTC
# Line 1893  compact_small_strings () Line 1893  compact_small_strings ()
1893    
1894    
1895  DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,  DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
1896         doc: /* Return a newly created string of length LENGTH, with each element being INIT.         doc: /* Return a newly created string of length LENGTH, with INIT in each element.
1897  Both LENGTH and INIT must be numbers.  */)  LENGTH must be an integer.
1898    INIT must be an integer that represents a character.  */)
1899       (length, init)       (length, init)
1900       Lisp_Object length, init;       Lisp_Object length, init;
1901  {  {
# Line 2334  free_cons (ptr) Line 2335  free_cons (ptr)
2335    cons_free_list = ptr;    cons_free_list = ptr;
2336  }  }
2337    
   
2338  DEFUN ("cons", Fcons, Scons, 2, 2, 0,  DEFUN ("cons", Fcons, Scons, 2, 2, 0,
2339         doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)         doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)
2340       (car, cdr)       (car, cdr)
# Line 4287  struct backtrace Line 4287  struct backtrace
4287    /* If nargs is UNEVALLED, args points to slot holding list of    /* If nargs is UNEVALLED, args points to slot holding list of
4288       unevalled args.  */       unevalled args.  */
4289    char evalargs;    char evalargs;
4290      /* Nonzero means call value of debugger when done with this operation. */
4291      char debug_on_exit;
4292  };  };
4293    
4294    
# Line 4466  returns nil, because real GC can't be do Line 4468  returns nil, because real GC can't be do
4468      }      }
4469    mark_kboards ();    mark_kboards ();
4470    
4471    /* Look thru every buffer's undo list  #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
4472       for elements that update markers that were not marked,    mark_stack ();
4473       and delete them.  */  #endif
4474    
4475    #ifdef USE_GTK
4476      {
4477        extern void xg_mark_data ();
4478        xg_mark_data ();
4479      }
4480    #endif
4481    
4482      gc_sweep ();
4483    
4484      /* Look thru every buffer's undo list for elements that used to
4485         contain update markers that were changed to Lisp_Misc_Free
4486         objects and delete them.  This may leave a few cons cells
4487         unchained, but we will get those on the next sweep.  */
4488    {    {
4489      register struct buffer *nextb = all_buffers;      register struct buffer *nextb = all_buffers;
4490    
4491      while (nextb)      while (nextb)
4492        {        {
4493          /* If a buffer's undo list is Qt, that means that undo is          /* If a buffer's undo list is Qt, that means that undo is
4494             turned off in that buffer.  Calling truncate_undo_list on             turned off in that buffer.  */
            Qt tends to return NULL, which effectively turns undo back on.  
            So don't call truncate_undo_list if undo_list is Qt.  */  
4495          if (! EQ (nextb->undo_list, Qt))          if (! EQ (nextb->undo_list, Qt))
4496            {            {
4497              Lisp_Object tail, prev;              Lisp_Object tail, prev, elt, car;
4498              tail = nextb->undo_list;              tail = nextb->undo_list;
4499              prev = Qnil;              prev = Qnil;
4500              while (CONSP (tail))              while (CONSP (tail))
4501                {                {
4502                  if (GC_CONSP (XCAR (tail))                  if ((elt = XCAR (tail), GC_CONSP (elt))
4503                      && GC_MARKERP (XCAR (XCAR (tail)))                      && (car = XCAR (elt), GC_MISCP (car))
4504                      && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)                      && XMISCTYPE (car) == Lisp_Misc_Free)
4505                    {                    {
4506                        Lisp_Object cdr = XCDR (tail);
4507                        /* Do not use free_cons here, as we don't know if
4508                           anybody else has a pointer to these conses.  */
4509                        XSETCAR (elt, Qnil);
4510                        XSETCDR (elt, Qnil);
4511                        XSETCAR (tail, Qnil);
4512                        XSETCDR (tail, Qnil);
4513                      if (NILP (prev))                      if (NILP (prev))
4514                        nextb->undo_list = tail = XCDR (tail);                        nextb->undo_list = tail = cdr;
4515                      else                      else
4516                        {                        {
4517                          tail = XCDR (tail);                          tail = cdr;
4518                          XSETCDR (prev, tail);                          XSETCDR (prev, tail);
4519                        }                        }
4520                    }                    }
# Line 4509  returns nil, because real GC can't be do Line 4530  returns nil, because real GC can't be do
4530        }        }
4531    }    }
4532    
 #if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES  
   mark_stack ();  
 #endif  
   
 #ifdef USE_GTK  
   {  
     extern void xg_mark_data ();  
     xg_mark_data ();  
   }  
 #endif  
   
   gc_sweep ();  
   
4533    /* Clear the mark bits that we set in certain root slots.  */    /* Clear the mark bits that we set in certain root slots.  */
4534    
4535    unmark_byte_stack ();    unmark_byte_stack ();
# Line 4977  mark_object (arg) Line 4985  mark_object (arg)
4985        break;        break;
4986    
4987      case Lisp_Misc:      case Lisp_Misc:
       if (XMISCTYPE (obj) == Lisp_Misc_Free)  
         {  
           /* This is (probably) a freed marker which may still exist on  
              a buffer undo list, so accept it here, as check below will  
              fail (not live).  KFS 2004-05-17 */  
           XMARKER (obj)->gcmarkbit = 1;  
           break;  
         }  
4988        CHECK_ALLOCATED_AND_LIVE (live_misc_p);        CHECK_ALLOCATED_AND_LIVE (live_misc_p);
4989        if (XMARKER (obj)->gcmarkbit)        if (XMARKER (obj)->gcmarkbit)
4990          break;          break;
# Line 5210  survives_gc_p (obj) Line 5210  survives_gc_p (obj)
5210  static void  static void
5211  gc_sweep ()  gc_sweep ()
5212  {  {
   /* Remove or mark entries in weak hash tables.  
      This must be done before any object is unmarked.  */  
   sweep_weak_hash_tables ();  
   
   sweep_strings ();  
 #ifdef GC_CHECK_STRING_BYTES  
   if (!noninteractive)  
     check_string_bytes (1);  
 #endif  
   
5213    /* Put all unmarked conses on free list */    /* Put all unmarked conses on free list */
5214    {    {
5215      register struct cons_block *cblk;      register struct cons_block *cblk;
# Line 5270  gc_sweep () Line 5260  gc_sweep ()
5260      total_free_conses = num_free;      total_free_conses = num_free;
5261    }    }
5262    
5263      /* Remove or mark entries in weak hash tables.
5264         This must be done before any object is unmarked.  */
5265      sweep_weak_hash_tables ();
5266    
5267      sweep_strings ();
5268    #ifdef GC_CHECK_STRING_BYTES
5269      if (!noninteractive)
5270        check_string_bytes (1);
5271    #endif
5272    
5273    /* Put all unmarked floats on free list */    /* Put all unmarked floats on free list */
5274    {    {
5275      register struct float_block *fblk;      register struct float_block *fblk;
# Line 5468  gc_sweep () Line 5468  gc_sweep ()
5468          /* If this block contains only free markers and we have already          /* If this block contains only free markers and we have already
5469             seen more than two blocks worth of free markers then deallocate             seen more than two blocks worth of free markers then deallocate
5470             this block.  */             this block.  */
5471    #if 0
5472            /* There may still be pointers to these markers from a buffer's
5473               undo list, so don't free them.  KFS 2004-05-21  /
5474          if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)          if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)
5475            {            {
5476              *mprev = mblk->next;              *mprev = mblk->next;
# Line 5477  gc_sweep () Line 5480  gc_sweep ()
5480              n_marker_blocks--;              n_marker_blocks--;
5481            }            }
5482          else          else
5483    #endif
5484            {            {
5485              num_free += this_free;              num_free += this_free;
5486              mprev = &mblk->next;              mprev = &mblk->next;

Legend:
Removed from v.1.272.2.7  
changed lines
  Added in v.1.272.2.8

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