comparison src/alloc.c @ 28365:a72abbd8dc16

(mark_maybe_object): New function. (mark_memory): Use it. (SETJMP_WILL_LIKELY_WORK, SETJMP_WILL_NOT_WORK): New macros. (setjmp_tested_p, longjmp_done): New variables. (test_setjmp): New function. (mark_stack) [!GC_SETJMP_WORKS]: Call test_setjmp. (init_alloc): Initialize setjmp_tested_p and longjmp_done.

28364:e24d2e75dea0

static int live_string_p P_ ((struct mem_node *, void *));
static int live_cons_p P_ ((struct mem_node *, void *));
static int live_symbol_p P_ ((struct mem_node *, void *));
static int live_float_p P_ ((struct mem_node *, void *));
static int live_misc_p P_ ((struct mem_node *, void *));
static void mark_memory P_ ((void *, void *));
static void mem_init P_ ((void));
static struct mem_node *mem_insert P_ ((void *, void *, enum mem_type));
static void mem_insert_fixup P_ ((struct mem_node *));
static void mem_rotate_left P_ ((struct mem_node *));

}

#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */


/* Mark Lisp objects in the address range START..END.  */

static void 
mark_memory (start, end)
     void *start, *end;

    {
      void *tem = start;
      start = end;
      end = tem;
    }

  for (p = (Lisp_Object *) start; (void *) p < end; ++p)
    {
      void *po = (void *) XPNTR (*p);
      struct mem_node *m = mem_find (po);
      
      if (m != MEM_NIL)
	{
	  int mark_p = 0;

	  switch (XGCTYPE (*p))
	    {
	    case Lisp_String:
	      mark_p = (live_string_p (m, po)
			&& !STRING_MARKED_P ((struct Lisp_String *) po));
	      break;

	    case Lisp_Cons:
	      mark_p = (live_cons_p (m, po)
			&& !XMARKBIT (XCONS (*p)->car));
	      break;

	    case Lisp_Symbol:
	      mark_p = (live_symbol_p (m, po)
			&& !XMARKBIT (XSYMBOL (*p)->plist));
	      break;

	    case Lisp_Float:
	      mark_p = (live_float_p (m, po)
			&& !XMARKBIT (XFLOAT (*p)->type));
	      break;

	    case Lisp_Vectorlike:
	      /* Note: can't check GC_BUFFERP before we know it's a
		 buffer because checking that dereferences the pointer
		 PO which might point anywhere.  */
	      if (live_vector_p (m, po))
		mark_p = (!GC_SUBRP (*p)
			  && !(XVECTOR (*p)->size & ARRAY_MARK_FLAG));
	      else if (live_buffer_p (m, po))
		mark_p = GC_BUFFERP (*p) && !XMARKBIT (XBUFFER (*p)->name);
	      break;

	    case Lisp_Misc:
	      if (live_misc_p (m, po))
		{
		  switch (XMISCTYPE (*p))
		    {
		    case Lisp_Misc_Marker:
		      mark_p = !XMARKBIT (XMARKER (*p)->chain);
		      break;
		      
		    case Lisp_Misc_Buffer_Local_Value:
		    case Lisp_Misc_Some_Buffer_Local_Value:
		      mark_p = !XMARKBIT (XBUFFER_LOCAL_VALUE (*p)->realvalue);
		      break;
		      
		    case Lisp_Misc_Overlay:
		      mark_p = !XMARKBIT (XOVERLAY (*p)->plist);
		      break;
		    }
		}
	      break;
	    }

	  if (mark_p)
	    {
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
	      if (nzombies < MAX_ZOMBIES)
		zombies[nzombies] = *p;
	      ++nzombies;
#endif
	      mark_object (p);
	    }
	}
    }
}


#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS

/* Abort if anything GCPRO'd doesn't survive the GC.  */

}

#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */


/* Mark live Lisp objects on the C stack.  */

static void
mark_stack ()
{
  jmp_buf j;

  /* Save registers that we need to see on the stack.  We need to see
     registers used to hold register variables and registers used to
     pass parameters.  */
#ifdef GC_SAVE_REGISTERS_ON_STACK
  GC_SAVE_REGISTERS_ON_STACK (end);
#else
  setjmp (j);
  end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif

  /* This assumes that the stack is a contiguous region in memory.  If
     that's not the case, something has to be done here to iterate over
     the stack segments.  */
  mark_memory (stack_base, end);

#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
  check_gcpros ();
#endif
}

void
init_alloc ()
{
  gcprolist = 0;
  byte_stack_list = 0;
}

void
syms_of_alloc ()
{

28365:a72abbd8dc16

static int live_string_p P_ ((struct mem_node *, void *));
static int live_cons_p P_ ((struct mem_node *, void *));
static int live_symbol_p P_ ((struct mem_node *, void *));
static int live_float_p P_ ((struct mem_node *, void *));
static int live_misc_p P_ ((struct mem_node *, void *));
static void mark_maybe_object P_ ((Lisp_Object));
static void mark_memory P_ ((void *, void *));
static void mem_init P_ ((void));
static struct mem_node *mem_insert P_ ((void *, void *, enum mem_type));
static void mem_insert_fixup P_ ((struct mem_node *));
static void mem_rotate_left P_ ((struct mem_node *));

}

#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */


/* Mark OBJ if we can prove it's a Lisp_Object.  */

static INLINE void
mark_maybe_object (obj)
     Lisp_Object obj;
{
  void *po = (void *) XPNTR (obj);
  struct mem_node *m = mem_find (po);
      
  if (m != MEM_NIL)
    {
      int mark_p = 0;

      switch (XGCTYPE (obj))
	{
	case Lisp_String:
	  mark_p = (live_string_p (m, po)
		    && !STRING_MARKED_P ((struct Lisp_String *) po));
	  break;

	case Lisp_Cons:
	  mark_p = (live_cons_p (m, po)
		    && !XMARKBIT (XCONS (obj)->car));
	  break;

	case Lisp_Symbol:
	  mark_p = (live_symbol_p (m, po)
		    && !XMARKBIT (XSYMBOL (obj)->plist));
	  break;

	case Lisp_Float:
	  mark_p = (live_float_p (m, po)
		    && !XMARKBIT (XFLOAT (obj)->type));
	  break;

	case Lisp_Vectorlike:
	  /* Note: can't check GC_BUFFERP before we know it's a
	     buffer because checking that dereferences the pointer
	     PO which might point anywhere.  */
	  if (live_vector_p (m, po))
	    mark_p = (!GC_SUBRP (obj)
		      && !(XVECTOR (obj)->size & ARRAY_MARK_FLAG));
	  else if (live_buffer_p (m, po))
	    mark_p = GC_BUFFERP (obj) && !XMARKBIT (XBUFFER (obj)->name);
	  break;

	case Lisp_Misc:
	  if (live_misc_p (m, po))
	    {
	      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;
		}
	    }
	  break;
	}

      if (mark_p)
	{
#if GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES
	  if (nzombies < MAX_ZOMBIES)
	    zombies[nzombies] = *p;
	  ++nzombies;
#endif
	  mark_object (&obj);
	}
    }
}
	  
/* Mark Lisp objects in the address range START..END.  */

static void 
mark_memory (start, end)
     void *start, *end;

    {
      void *tem = start;
      start = end;
      end = tem;
    }
  
  for (p = (Lisp_Object *) start; (void *) p < end; ++p)
    mark_maybe_object (*p);
}


#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS

static int setjmp_tested_p, longjmps_done;

#define SETJMP_WILL_LIKELY_WORK "\
\n\
Emacs garbage collector has been changed to use conservative stack\n\
marking.  Emacs has determined that the method it uses to do the\n\
marking will likely work on your system, but this isn't sure.\n\
\n\
If you are a system-programmer, or can get the help of a local wizard\n\
who is, please take a look at the function mark_stack in alloc.c, and\n\
verify that the methods used are appropriate for your system.\n\
\n\
Please mail the result to <[e-mail]>.\n\
"

#define SETJMP_WILL_NOT_WORK "\
\n\
Emacs garbage collector has been changed to use conservative stack\n\
marking.  Emacs has determined that the default method it uses to do the\n\
marking will not work on your system.  We will need a system-dependent\n\
solution for your system.\n\
\n\
Please take a look at the function mark_stack in alloc.c, and\n\
try to find a way to make it work on your system.\n\
Please mail the result to <[e-mail]>.\n\
"


/* Perform a quick check if it looks like setjmp saves registers in a
   jmp_buf.  Print a message to stderr saying so.  When this test
   succeeds, this is _not_ a proof that setjmp is sufficient for
   conservative stack marking.  Only the sources or a disassembly
   can prove that.  */

static void
test_setjmp ()
{
  char buf[10];
  register int x;
  jmp_buf jbuf;
  int result = 0;

  /* Arrange for X to be put in a register.  */
  sprintf (buf, "1");
  x = strlen (buf);
  x = 2 * x - 1;

  setjmp (jbuf);
  if (longjmps_done == 1)
    {
      /* Came here after the longjmp at the end of the function.

         If x == 1, the longjmp has restored the register to its
         value before the setjmp, and we can hope that setjmp
         saves all such registers in the jmp_buf, although that
	 isn't sure.

         For other values of X, either something really strange is
         taking place, or the setjmp just didn't save the register.  */

      if (x == 1)
	fprintf (stderr, SETJMP_WILL_LIKELY_WORK);
      else
	{
	  fprintf (stderr, SETJMP_WILL_NOT_WORK);
	  exit (1);
	}
    }

  ++longjmps_done;
  x = 2;
  if (longjmps_done == 1)
    longjmp (jbuf, 1);
}

#endif /* not GC_SAVE_REGISTERS_ON_STACK && not GC_SETJMP_WORKS */


#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS

/* Abort if anything GCPRO'd doesn't survive the GC.  */

}

#endif /* GC_MARK_STACK == GC_USE_GCPROS_CHECK_ZOMBIES */


/* Mark live Lisp objects on the C stack.

   There are several system-dependent problems to consider when
   porting this to new architectures:

   Processor Registers

   We have to mark Lisp objects in CPU registers that can hold local
   variables or are used to pass parameters.

   If GC_SAVE_REGISTERS_ON_STACK is defined, it should expand to
   something that either saves relevant registers on the stack, or
   calls mark_maybe_object passing it each register's contents.

   If GC_SAVE_REGISTERS_ON_STACK is not defined, the current
   implementation assumes that calling setjmp saves registers we need
   to see in a jmp_buf which itself lies on the stack.  This doesn't
   have to be true!  It must be verified for each system, possibly
   by taking a look at the source code of setjmp.

   Stack Layout

   Architectures differ in the way their processor stack is organized.
   For example, the stack might look like this

     +----------------+
     |  Lisp_Object   |  size = 4
     +----------------+
     | something else |  size = 2
     +----------------+
     |  Lisp_Object   |  size = 4
     +----------------+
     |	...	      |

   In such a case, not every Lisp_Object will be aligned equally.  To
   find all Lisp_Object on the stack it won't be sufficient to walk
   the stack in steps of 4 bytes.  Instead, two passes will be
   necessary, one starting at the start of the stack, and a second
   pass starting at the start of the stack + 2.  Likewise, if the
   minimal alignment of Lisp_Objects on the stack is 1, four passes
   would be necessary, each one starting with one byte more offset
   from the stack start.

   The current code assumes by default that Lisp_Objects are aligned
   equally on the stack.  */

static void
mark_stack ()
{
  jmp_buf j;

  /* Save registers that we need to see on the stack.  We need to see
     registers used to hold register variables and registers used to
     pass parameters.  */
#ifdef GC_SAVE_REGISTERS_ON_STACK
  GC_SAVE_REGISTERS_ON_STACK (end);
#else /* not GC_SAVE_REGISTERS_ON_STACK */
  
#ifndef GC_SETJMP_WORKS  /* If it hasn't been checked yet that
			    setjmp will definitely work, test it
			    and print a message with the result
			    of the test.  */
  if (!setjmp_tested_p)
    {
      setjmp_tested_p = 1;
      test_setjmp ();
    }
#endif /* GC_SETJMP_WORKS */
  
  setjmp (j);
  end = stack_grows_down_p ? (char *) &j + sizeof j : (char *) &j;
#endif /* not GC_SAVE_REGISTERS_ON_STACK */

  /* This assumes that the stack is a contiguous region in memory.  If
     that's not the case, something has to be done here to iterate
     over the stack segments.  */
#if GC_LISP_OBJECT_ALIGNMENT == 1
  mark_memory (stack_base, end);
  mark_memory ((char *) stack_base + 1, end);
  mark_memory ((char *) stack_base + 2, end);
  mark_memory ((char *) stack_base + 3, end);
#elif GC_LISP_OBJECT_ALIGNMENT == 2
  mark_memory (stack_base, end);
  mark_memory ((char *) stack_base + 2, end);
#else
  mark_memory (stack_base, end);
#endif

#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
  check_gcpros ();
#endif
}

void
init_alloc ()
{
  gcprolist = 0;
  byte_stack_list = 0;
#if GC_MARK_STACK
#if !defined GC_SAVE_REGISTERS_ON_STACK && !defined GC_SETJMP_WORKS
  setjmp_tested_p = longjmps_done = 0;
#endif
#endif
}

void
syms_of_alloc ()
{