comparison src/alloc.c @ 55720:1a56baecf37d

(struct backtrace): Add debug_on_exit member. (Fgarbage_collect): Clear out buffer undo_list markers after gc_sweep. Identify those markers as Lisp_Misc_Free objects. Clear car and cdr of the removed cons cells. (mark_object): Undo previous change - disallow Lisp_Misc_Free objects. (gc_sweep): Clear cons_blocks before sweeping strings, so we don't have any cons cells pointing to unallocated stings. Do not lisp_free any marker blocks, as there may still be pointers to them from buffer undo lists at this stage of GC.

55719:91bed9994bc1

#if GC_MARK_STACK
  ptr->car = Vdead;
#endif
  cons_free_list = ptr;
}


DEFUN ("cons", Fcons, Scons, 2, 2, 0,
       doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)
     (car, cdr)
     Lisp_Object car, cdr;

  Lisp_Object *args;	/* Points to vector of args.  */
  int nargs;		/* Length of vector.  */
  /* If nargs is UNEVALLED, args points to slot holding list of
     unevalled args.  */
  char evalargs;
};



/***********************************************************************

    extern void xg_mark_data ();
    xg_mark_data ();
  }
#endif

  /* Look thru every buffer's undo list
     for elements that update markers that were not marked,
     and delete them.  */
  {
    register struct buffer *nextb = all_buffers;

    while (nextb)
      {
	/* If a buffer's undo list is Qt, that means that undo is
	   turned off in that buffer.  Calling truncate_undo_list on
	   Qt tends to return NULL, which effectively turns undo back on.
	   So don't call truncate_undo_list if undo_list is Qt.  */
	if (! EQ (nextb->undo_list, Qt))
	  {
	    Lisp_Object tail, prev;
	    tail = nextb->undo_list;
	    prev = Qnil;
	    while (CONSP (tail))
	      {
		if (GC_CONSP (XCAR (tail))
		    && GC_MARKERP (XCAR (XCAR (tail)))
		    && !XMARKER (XCAR (XCAR (tail)))->gcmarkbit)
		  {
		    if (NILP (prev))
		      nextb->undo_list = tail = XCDR (tail);
		    else
		      {
			tail = XCDR (tail);
			XSETCDR (prev, tail);
		      }
		  }
		else
		  {

	  }

	nextb = nextb->next;
      }
  }

  gc_sweep ();

  /* Clear the mark bits that we set in certain root slots.  */

  unmark_byte_stack ();
  VECTOR_UNMARK (&buffer_defaults);

	  }
      }
      break;

    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;
	}
      CHECK_ALLOCATED_AND_LIVE (live_misc_p);
      if (XMARKER (obj)->gcmarkbit)
	break;
      XMARKER (obj)->gcmarkbit = 1;
      switch (XMISCTYPE (obj))

/* Sweep: find all structures not marked, and free them. */

static void
gc_sweep ()
{
  /* 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

  /* Put all unmarked conses on free list */
  {
    register struct cons_block *cblk;
    struct cons_block **cprev = &cons_block;
    register int lim = cons_block_index;

	  }
      }
    total_conses = num_used;
    total_free_conses = num_free;
  }

  /* Put all unmarked floats on free list */
  {
    register struct float_block *fblk;
    struct float_block **fprev = &float_block;

	  }
	lim = MARKER_BLOCK_SIZE;
	/* If this block contains only free markers and we have already
	   seen more than two blocks worth of free markers then deallocate
	   this block.  */
	if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)
	  {
	    *mprev = mblk->next;
	    /* Unhook from the free list.  */
	    marker_free_list = mblk->markers[0].u_free.chain;
	    lisp_free (mblk);
	    n_marker_blocks--;
	  }
	else
	  {
	    num_free += this_free;
	    mprev = &mblk->next;
	  }
      }

55720:1a56baecf37d

#if GC_MARK_STACK
  ptr->car = Vdead;
#endif
  cons_free_list = ptr;
}

DEFUN ("cons", Fcons, Scons, 2, 2, 0,
       doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)
     (car, cdr)
     Lisp_Object car, cdr;

  Lisp_Object *args;	/* Points to vector of args.  */
  int nargs;		/* Length of vector.  */
  /* If nargs is UNEVALLED, args points to slot holding list of
     unevalled args.  */
  char evalargs;
  /* Nonzero means call value of debugger when done with this operation. */
  char debug_on_exit;
};



/***********************************************************************

    extern void xg_mark_data ();
    xg_mark_data ();
  }
#endif

  gc_sweep ();

  /* Look thru every buffer's undo list for elements that used to
     contain update markers that were changed to Lisp_Misc_Free
     objects and delete them.  This may leave a few cons cells
     unchained, but we will get those on the next sweep.  */
  {
    register struct buffer *nextb = all_buffers;

    while (nextb)
      {
	/* If a buffer's undo list is Qt, that means that undo is
	   turned off in that buffer.  */
	if (! EQ (nextb->undo_list, Qt))
	  {
	    Lisp_Object tail, prev, elt, car;
	    tail = nextb->undo_list;
	    prev = Qnil;
	    while (CONSP (tail))
	      {
		if ((elt = XCAR (tail), GC_CONSP (elt))
		    && (car = XCAR (elt), GC_MISCP (car))
		    && XMISCTYPE (car) == Lisp_Misc_Free)
		  {
		    Lisp_Object cdr = XCDR (tail);
		    /* Do not use free_cons here, as we don't know if
		       anybody else has a pointer to these conses.  */
		    XSETCAR (elt, Qnil);
		    XSETCDR (elt, Qnil);
		    XSETCAR (tail, Qnil);
		    XSETCDR (tail, Qnil);
		    if (NILP (prev))
		      nextb->undo_list = tail = cdr;
		    else
		      {
			tail = cdr;
			XSETCDR (prev, tail);
		      }
		  }
		else
		  {

	  }

	nextb = nextb->next;
      }
  }

  /* Clear the mark bits that we set in certain root slots.  */

  unmark_byte_stack ();
  VECTOR_UNMARK (&buffer_defaults);

	  }
      }
      break;

    case Lisp_Misc:
      CHECK_ALLOCATED_AND_LIVE (live_misc_p);
      if (XMARKER (obj)->gcmarkbit)
	break;
      XMARKER (obj)->gcmarkbit = 1;
      switch (XMISCTYPE (obj))

/* Sweep: find all structures not marked, and free them. */

static void
gc_sweep ()
{
  /* Put all unmarked conses on free list */
  {
    register struct cons_block *cblk;
    struct cons_block **cprev = &cons_block;
    register int lim = cons_block_index;

	  }
      }
    total_conses = num_used;
    total_free_conses = num_free;
  }

  /* 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

  /* Put all unmarked floats on free list */
  {
    register struct float_block *fblk;
    struct float_block **fprev = &float_block;

	  }
	lim = MARKER_BLOCK_SIZE;
	/* If this block contains only free markers and we have already
	   seen more than two blocks worth of free markers then deallocate
	   this block.  */
#if 0
	/* There may still be pointers to these markers from a buffer's
	   undo list, so don't free them.  KFS 2004-05-21  /
	if (this_free == MARKER_BLOCK_SIZE && num_free > MARKER_BLOCK_SIZE)
	  {
	    *mprev = mblk->next;
	    /* Unhook from the free list.  */
	    marker_free_list = mblk->markers[0].u_free.chain;
	    lisp_free (mblk);
	    n_marker_blocks--;
	  }
	else
#endif
	  {
	    num_free += this_free;
	    mprev = &mblk->next;
	  }
      }