comparison src/alloc.c @ 105986:850debe3a245

(mark_object): Don't reprocess marked strings. Check vector's markbit earlier. Adjust calls to mark_vectorlike. (mark_vectorlike, mark_char_table): Assume the object is unmarked.

105985:10cb13aa45b6

   links of a list, in mark_object.  In debugging,
   the call to abort will hit a breakpoint.
   Normally this is zero and the check never goes off.  */
static int mark_object_loop_halt;

/* Return non-zero if the object was not yet marked.  */
static int
mark_vectorlike (ptr)
     struct Lisp_Vector *ptr;
{
  register EMACS_INT size = ptr->size;
  register int i;

  if (VECTOR_MARKED_P (ptr))
    return 0;			/* Already marked */
  VECTOR_MARK (ptr);		/* Else mark it */
  if (size & PSEUDOVECTOR_FLAG)
    size &= PSEUDOVECTOR_SIZE_MASK;

  /* Note that this size is not the memory-footprint size, but only
     the number of Lisp_Object fields that we should trace.
     The distinction is used e.g. by Lisp_Process which places extra
     non-Lisp_Object fields at the end of the structure.  */
  for (i = 0; i < size; i++) /* and then mark its elements */
    mark_object (ptr->contents[i]);
  return 1;
}

/* Like mark_vectorlike but optimized for char-tables (and
   sub-char-tables) assuming that the contents are mostly integers or
   symbols.  */

     struct Lisp_Vector *ptr;
{
  register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
  register int i;

  VECTOR_MARK (ptr);
  for (i = 0; i < size; i++)
    {
      Lisp_Object val = ptr->contents[i];

  switch (SWITCH_ENUM_CAST (XTYPE (obj)))
    {
    case Lisp_String:
      {
	register struct Lisp_String *ptr = XSTRING (obj);
	CHECK_ALLOCATED_AND_LIVE (live_string_p);
	MARK_INTERVAL_TREE (ptr->intervals);
	MARK_STRING (ptr);
#ifdef GC_CHECK_STRING_BYTES
	/* Check that the string size recorded in the string is the

#endif /* GC_CHECK_STRING_BYTES */
      }
      break;

    case Lisp_Vectorlike:
#ifdef GC_CHECK_MARKED_OBJECTS
      m = mem_find (po);
      if (m == MEM_NIL && !SUBRP (obj)
	  && po != &buffer_defaults
	  && po != &buffer_local_symbols)
	abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */

      if (BUFFERP (obj))
	{
	  if (!VECTOR_MARKED_P (XBUFFER (obj)))
	    {
#ifdef GC_CHECK_MARKED_OBJECTS
	      if (po != &buffer_defaults && po != &buffer_local_symbols)
		{
		  struct buffer *b;
		  for (b = all_buffers; b && b != po; b = b->next)
		    ;
		  if (b == NULL)
		    abort ();
		}
#endif /* GC_CHECK_MARKED_OBJECTS */
	      mark_buffer (obj);
	    }
	}
      else if (SUBRP (obj))
	break;
      else if (COMPILEDP (obj))
	/* We could treat this just like a vector, but it is better to

	   recursion there.  */
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  register EMACS_INT size = ptr->size;
	  register int i;

	  if (VECTOR_MARKED_P (ptr))
	    break;   /* Already marked */

	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);	/* Else mark it */
	  size &= PSEUDOVECTOR_SIZE_MASK;
	  for (i = 0; i < size; i++) /* and then mark its elements */

	  goto loop;
	}
      else if (FRAMEP (obj))
	{
	  register struct frame *ptr = XFRAME (obj);
	  if (mark_vectorlike (XVECTOR (obj)))
	    mark_face_cache (ptr->face_cache);
	}
      else if (WINDOWP (obj))
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  struct window *w = XWINDOW (obj);
	  if (mark_vectorlike (ptr))
	    {
	      /* Mark glyphs for leaf windows.  Marking window matrices is
		 sufficient because frame matrices use the same glyph
		 memory.  */
	      if (NILP (w->hchild)
		  && NILP (w->vchild)
		  && w->current_matrix)
		{
		  mark_glyph_matrix (w->current_matrix);
		  mark_glyph_matrix (w->desired_matrix);
		}
	    }
	}
      else if (HASH_TABLE_P (obj))
	{
	  struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
	  if (mark_vectorlike ((struct Lisp_Vector *)h))
	    { /* If hash table is not weak, mark all keys and values.
		 For weak tables, mark only the vector.  */
	      if (NILP (h->weak))
		mark_object (h->key_and_value);
	      else
		VECTOR_MARK (XVECTOR (h->key_and_value));
	    }
	}
      else if (CHAR_TABLE_P (obj))
	{
	  if (! VECTOR_MARKED_P (XVECTOR (obj)))
	    mark_char_table (XVECTOR (obj));
	}
      else
	mark_vectorlike (XVECTOR (obj));
      break;

    case Lisp_Symbol:
      {
	register struct Lisp_Symbol *ptr = XSYMBOL (obj);
	struct Lisp_Symbol *ptrx;

	if (ptr->gcmarkbit) break;
	CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
	ptr->gcmarkbit = 1;
	mark_object (ptr->value);
	mark_object (ptr->function);
	mark_object (ptr->plist);

      break;

    case Lisp_Cons:
      {
	register struct Lisp_Cons *ptr = XCONS (obj);
	if (CONS_MARKED_P (ptr)) break;
	CHECK_ALLOCATED_AND_LIVE (live_cons_p);
	CONS_MARK (ptr);
	/* If the cdr is nil, avoid recursion for the car.  */
	if (EQ (ptr->u.cdr, Qnil))
	  {

{
  register struct buffer *buffer = XBUFFER (buf);
  register Lisp_Object *ptr, tmp;
  Lisp_Object base_buffer;

  VECTOR_MARK (buffer);

  MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));

  /* For now, we just don't mark the undo_list.  It's done later in

{
  struct terminal *t;
  for (t = terminal_list; t; t = t->next_terminal)
    {
      eassert (t->name != NULL);
#ifdef HAVE_WINDOW_SYSTEM
      mark_image_cache (t->image_cache);
#endif /* HAVE_WINDOW_SYSTEM */
      mark_vectorlike ((struct Lisp_Vector *)t);
    }
}

105986:850debe3a245

   links of a list, in mark_object.  In debugging,
   the call to abort will hit a breakpoint.
   Normally this is zero and the check never goes off.  */
static int mark_object_loop_halt;

static void
mark_vectorlike (ptr)
     struct Lisp_Vector *ptr;
{
  register EMACS_INT size = ptr->size;
  register int i;

  eassert (!VECTOR_MARKED_P (ptr));
  VECTOR_MARK (ptr);		/* Else mark it */
  if (size & PSEUDOVECTOR_FLAG)
    size &= PSEUDOVECTOR_SIZE_MASK;

  /* Note that this size is not the memory-footprint size, but only
     the number of Lisp_Object fields that we should trace.
     The distinction is used e.g. by Lisp_Process which places extra
     non-Lisp_Object fields at the end of the structure.  */
  for (i = 0; i < size; i++) /* and then mark its elements */
    mark_object (ptr->contents[i]);
}

/* Like mark_vectorlike but optimized for char-tables (and
   sub-char-tables) assuming that the contents are mostly integers or
   symbols.  */

     struct Lisp_Vector *ptr;
{
  register EMACS_INT size = ptr->size & PSEUDOVECTOR_SIZE_MASK;
  register int i;

  eassert (!VECTOR_MARKED_P (ptr));
  VECTOR_MARK (ptr);
  for (i = 0; i < size; i++)
    {
      Lisp_Object val = ptr->contents[i];

  switch (SWITCH_ENUM_CAST (XTYPE (obj)))
    {
    case Lisp_String:
      {
	register struct Lisp_String *ptr = XSTRING (obj);
	if (STRING_MARKED_P (ptr))
	  break;
	CHECK_ALLOCATED_AND_LIVE (live_string_p);
	MARK_INTERVAL_TREE (ptr->intervals);
	MARK_STRING (ptr);
#ifdef GC_CHECK_STRING_BYTES
	/* Check that the string size recorded in the string is the

#endif /* GC_CHECK_STRING_BYTES */
      }
      break;

    case Lisp_Vectorlike:
      if (VECTOR_MARKED_P (XVECTOR (obj)))
	break;
#ifdef GC_CHECK_MARKED_OBJECTS
      m = mem_find (po);
      if (m == MEM_NIL && !SUBRP (obj)
	  && po != &buffer_defaults
	  && po != &buffer_local_symbols)
	abort ();
#endif /* GC_CHECK_MARKED_OBJECTS */

      if (BUFFERP (obj))
	{
#ifdef GC_CHECK_MARKED_OBJECTS
	  if (po != &buffer_defaults && po != &buffer_local_symbols)
	    {
	      struct buffer *b;
	      for (b = all_buffers; b && b != po; b = b->next)
		;
	      if (b == NULL)
		abort ();
	    }
#endif /* GC_CHECK_MARKED_OBJECTS */
	  mark_buffer (obj);
	}
      else if (SUBRP (obj))
	break;
      else if (COMPILEDP (obj))
	/* We could treat this just like a vector, but it is better to

	   recursion there.  */
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  register EMACS_INT size = ptr->size;
	  register int i;

	  CHECK_LIVE (live_vector_p);
	  VECTOR_MARK (ptr);	/* Else mark it */
	  size &= PSEUDOVECTOR_SIZE_MASK;
	  for (i = 0; i < size; i++) /* and then mark its elements */

	  goto loop;
	}
      else if (FRAMEP (obj))
	{
	  register struct frame *ptr = XFRAME (obj);
	  mark_vectorlike (XVECTOR (obj));
	  mark_face_cache (ptr->face_cache);
	}
      else if (WINDOWP (obj))
	{
	  register struct Lisp_Vector *ptr = XVECTOR (obj);
	  struct window *w = XWINDOW (obj);
	  mark_vectorlike (ptr);
	  /* Mark glyphs for leaf windows.  Marking window matrices is
	     sufficient because frame matrices use the same glyph
	     memory.  */
	  if (NILP (w->hchild)
	      && NILP (w->vchild)
	      && w->current_matrix)
	    {
	      mark_glyph_matrix (w->current_matrix);
	      mark_glyph_matrix (w->desired_matrix);
	    }
	}
      else if (HASH_TABLE_P (obj))
	{
	  struct Lisp_Hash_Table *h = XHASH_TABLE (obj);
	  mark_vectorlike ((struct Lisp_Vector *)h);
	  /* If hash table is not weak, mark all keys and values.
	     For weak tables, mark only the vector.  */
	  if (NILP (h->weak))
	    mark_object (h->key_and_value);
	  else
	    VECTOR_MARK (XVECTOR (h->key_and_value));
	}
      else if (CHAR_TABLE_P (obj))
	mark_char_table (XVECTOR (obj));
      else
	mark_vectorlike (XVECTOR (obj));
      break;

    case Lisp_Symbol:
      {
	register struct Lisp_Symbol *ptr = XSYMBOL (obj);
	struct Lisp_Symbol *ptrx;

	if (ptr->gcmarkbit)
	  break;
	CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
	ptr->gcmarkbit = 1;
	mark_object (ptr->value);
	mark_object (ptr->function);
	mark_object (ptr->plist);

      break;

    case Lisp_Cons:
      {
	register struct Lisp_Cons *ptr = XCONS (obj);
	if (CONS_MARKED_P (ptr))
	  break;
	CHECK_ALLOCATED_AND_LIVE (live_cons_p);
	CONS_MARK (ptr);
	/* If the cdr is nil, avoid recursion for the car.  */
	if (EQ (ptr->u.cdr, Qnil))
	  {

{
  register struct buffer *buffer = XBUFFER (buf);
  register Lisp_Object *ptr, tmp;
  Lisp_Object base_buffer;

  eassert (!VECTOR_MARKED_P (buffer));
  VECTOR_MARK (buffer);

  MARK_INTERVAL_TREE (BUF_INTERVALS (buffer));

  /* For now, we just don't mark the undo_list.  It's done later in

{
  struct terminal *t;
  for (t = terminal_list; t; t = t->next_terminal)
    {
      eassert (t->name != NULL);
      if (!VECTOR_MARKED_P (t))
	{
#ifdef HAVE_WINDOW_SYSTEM
	  mark_image_cache (t->image_cache);
#endif /* HAVE_WINDOW_SYSTEM */
	  mark_vectorlike ((struct Lisp_Vector *)t);
	}
    }
}