comparison src/alloc.c @ 83142:62cf3d6337a0

Merged in changes from CVS trunk. Patches applied: * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-344 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-345 Tweak source regexps so that building in place won't cause problems * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-346 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-347 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-348 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-349 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-350 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-351 Update from CVS * [e-mail]--gnu-2004/emacs--cvs-trunk--0--patch-352 Update from CVS: lisp/flymake.el: New file. git-archimport-id: [e-mail]--2004/emacs--multi-tty--0--patch-182

83141:8d02e70dd3cc

EMACS_INT gcs_done;		/* accumulated GCs  */

static void mark_buffer P_ ((Lisp_Object));
extern void mark_kboards P_ ((void));
extern void mark_ttys P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
static void mark_face_cache P_ ((struct face_cache *));

#ifdef HAVE_WINDOW_SYSTEM

struct marker_block *marker_block;
int marker_block_index;

union Lisp_Misc *marker_free_list;

/* Marker blocks which should be freed at end of GC.  */

struct marker_block *marker_blocks_pending_free;

/* Total number of marker blocks now in use.  */

int n_marker_blocks;

void
init_marker ()
{
  marker_block = NULL;
  marker_block_index = MARKER_BLOCK_SIZE;
  marker_free_list = 0;
  marker_blocks_pending_free = 0;
  n_marker_blocks = 0;
}

/* Return a newly allocated Lisp_Misc object, with no substructure.  */

    Lisp_Object tag;
    Lisp_Object val;
    struct catchtag *next;
};

struct backtrace
{
  struct backtrace *next;
  Lisp_Object *function;
  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;
};



/***********************************************************************
			  Protection from GC
 ***********************************************************************/

     ()
{
  register struct specbinding *bind;
  struct catchtag *catch;
  struct handler *handler;
  register struct backtrace *backlist;
  char stack_top_variable;
  register int i;
  int message_p;
  Lisp_Object total[8];
  int count = SPECPDL_INDEX ();

  for (handler = handlerlist; handler; handler = handler->next)
    {
      mark_object (handler->handler);
      mark_object (handler->var);
    }
  for (backlist = backtrace_list; backlist; backlist = backlist->next)
    {
      mark_object (*backlist->function);

      if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
	i = 0;
      else
	i = backlist->nargs - 1;
      for (; i >= 0; i--)
	mark_object (backlist->args[i]);
    }
  mark_kboards ();
  mark_ttys ();

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
  mark_stack ();

    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
		  {
		    prev = tail;
		    tail = XCDR (tail);
		  }
	      }
	  }

	nextb = nextb->next;
      }
  }

  /* Undo lists have been cleaned up, so we can free marker blocks now.  */

  {
    struct marker_block *mblk;

    while ((mblk = marker_blocks_pending_free) != 0)
      {
	marker_blocks_pending_free = mblk->next;
	lisp_free (mblk);
      }
  }

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

  unmark_byte_stack ();
  VECTOR_UNMARK (&buffer_defaults);

  VECTOR_MARK (buffer);

  MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));

  if (CONSP (buffer->undo_list))
    {
      Lisp_Object tail;
      tail = buffer->undo_list;

      /* We mark the undo list specially because
	 its pointers to markers should be weak.  */

      while (CONSP (tail))
	{
	  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
	    mark_object (ptr->car);

	  if (CONSP (ptr->cdr))
	    tail = ptr->cdr;
	  else
	    break;
	}

      mark_object (XCDR (tail));
    }
  else
    mark_object (buffer->undo_list);

  if (buffer->overlays_before)
    {
      XSETMISC (tmp, buffer->overlays_before);
      mark_object (tmp);

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

    struct marker_block **mprev = &marker_block;
    register int lim = marker_block_index;
    register int num_free = 0, num_used = 0;

    marker_free_list = 0;
    marker_blocks_pending_free = 0;

    for (mblk = marker_block; mblk; mblk = *mprev)
      {
	register int i;
	int this_free = 0;

	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;
	    n_marker_blocks--;

	    /* It is not safe to free the marker block at this stage,
	       since there may still be pointers to these markers from
	       a buffer's undo list.  KFS 2004-05-25.  */
	    mblk->next = marker_blocks_pending_free;
	    marker_blocks_pending_free = mblk;
	  }
	else
	  {
	    num_free += this_free;
	    mprev = &mblk->next;

83142:62cf3d6337a0

EMACS_INT gcs_done;		/* accumulated GCs  */

static void mark_buffer P_ ((Lisp_Object));
extern void mark_kboards P_ ((void));
extern void mark_ttys P_ ((void));
extern void mark_backtrace P_ ((void));
static void gc_sweep P_ ((void));
static void mark_glyph_matrix P_ ((struct glyph_matrix *));
static void mark_face_cache P_ ((struct face_cache *));

#ifdef HAVE_WINDOW_SYSTEM

struct marker_block *marker_block;
int marker_block_index;

union Lisp_Misc *marker_free_list;

/* Total number of marker blocks now in use.  */

int n_marker_blocks;

void
init_marker ()
{
  marker_block = NULL;
  marker_block_index = MARKER_BLOCK_SIZE;
  marker_free_list = 0;
  n_marker_blocks = 0;
}

/* Return a newly allocated Lisp_Misc object, with no substructure.  */

    Lisp_Object tag;
    Lisp_Object val;
    struct catchtag *next;
};


/***********************************************************************
			  Protection from GC
 ***********************************************************************/

     ()
{
  register struct specbinding *bind;
  struct catchtag *catch;
  struct handler *handler;
  char stack_top_variable;
  register int i;
  int message_p;
  Lisp_Object total[8];
  int count = SPECPDL_INDEX ();

  for (handler = handlerlist; handler; handler = handler->next)
    {
      mark_object (handler->handler);
      mark_object (handler->var);
    }
  mark_backtrace ();
  mark_kboards ();
  mark_ttys ();

#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
  mark_stack ();

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

  /* Everything is now marked, except for the things that require special
     finalization, i.e. the undo_list.
     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
		  {
		    prev = tail;
		    tail = XCDR (tail);
		  }
	      }
	  }
	/* Now that we have stripped the elements that need not be in the
	   undo_list any more, we can finally mark the list.  */
	mark_object (nextb->undo_list);

	nextb = nextb->next;
      }
  }

  gc_sweep ();

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

  unmark_byte_stack ();
  VECTOR_UNMARK (&buffer_defaults);

  VECTOR_MARK (buffer);

  MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));

  /* For now, we just don't mark the undo_list.  It's done later in
     a special way just before the sweep phase, and after stripping
     some of its elements that are not needed any more.  */

  if (buffer->overlays_before)
    {
      XSETMISC (tmp, buffer->overlays_before);
      mark_object (tmp);

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

    struct marker_block **mprev = &marker_block;
    register int lim = marker_block_index;
    register int num_free = 0, num_used = 0;

    marker_free_list = 0;

    for (mblk = marker_block; mblk; mblk = *mprev)
      {
	register int i;
	int this_free = 0;

	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;