changeset 1598:ac1be85b4a5f

[xemacs-hg @ 2003-07-31 13:32:24 by crestani] 2003-07-29 Marcus Crestani <crestani@informatik.uni-tuebingen.de> Markus Kaltenbach <makalten@informatik.uni-tuebingen.de> * README.kkcc: Aligned to the changes. * alloc.c: Implemented the kkcc_gc_stack. (kkcc_gc_stack_init): (kkcc_gc_stack_free): (kkcc_gc_stack_realloc): (kkcc_gc_stack_full): (kkcc_gc_stack_empty): (kkcc_gc_stack_push): (kkcc_gc_stack_pop): (kkcc_gc_stack_push_lisp_object): (mark_object_maybe_checking_free): Push objects on kkcc stack instead of marking. (mark_struct_contents): Push objects on kkcc stack instead of marking. (kkcc_marking): KKCC mark algorithm using the kkcc_gc_stack. (mark_object): Removed KKCC ifdefs. (garbage_collect_1): Push objects on kkcc stack instead of marking. * data.c: Added XD_FLAG_NO_KKCC to ephemeron_description and to weak_list_description. * data.c (finish_marking_weak_lists): Push objects on kkcc stack instead of marking. (continue_marking_ephemerons): Push objects on kkcc stack instead of marking. (finish_marking_ephemerons): Push objects on kkcc stack instead of marking. * elhash.c (finish_marking_weak_hash_tables): Push objects on kkcc stack instead of marking. * eval.c: Added XD_FLAG_NO_KKCC to subr_description. * lisp.h: Added prototype for kkcc_gc_stack_push_lisp_object. * profile.c (mark_profiling_info_maphash): Push keys on kkcc stack instead of marking.
author crestani
date Thu, 31 Jul 2003 13:32:26 +0000
parents 4b6ee17c5f37
children a9254f6664b5
files src/ChangeLog src/README.kkcc src/alloc.c src/data.c src/elhash.c src/eval.c src/lisp.h src/profile.c
diffstat 8 files changed, 402 insertions(+), 228 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/ChangeLog	Thu Jul 31 13:32:26 2003 +0000
@@ -1,3 +1,37 @@
+2003-07-29  Marcus Crestani  <crestani@informatik.uni-tuebingen.de>
+	    Markus Kaltenbach  <makalten@informatik.uni-tuebingen.de>
+
+	* README.kkcc: Aligned to the changes.
+	* alloc.c: Implemented the kkcc_gc_stack.
+	(kkcc_gc_stack_init): 
+	(kkcc_gc_stack_free): 
+	(kkcc_gc_stack_realloc): 
+	(kkcc_gc_stack_full): 
+	(kkcc_gc_stack_empty): 
+	(kkcc_gc_stack_push): 
+	(kkcc_gc_stack_pop): 
+	(kkcc_gc_stack_push_lisp_object): 
+	(mark_object_maybe_checking_free): Push objects on kkcc stack instead 
+	of marking.
+	(mark_struct_contents): Push objects on kkcc stack instead of marking.
+	(kkcc_marking): KKCC mark algorithm using the kkcc_gc_stack.
+	(mark_object): Removed KKCC ifdefs.
+	(garbage_collect_1): Push objects on kkcc stack instead of marking.
+	* data.c: Added XD_FLAG_NO_KKCC to ephemeron_description and to
+	weak_list_description.
+	* data.c (finish_marking_weak_lists): Push objects on kkcc stack 
+	instead of marking.
+	(continue_marking_ephemerons): Push objects on kkcc stack instead 
+	of marking.
+	(finish_marking_ephemerons): Push objects on kkcc stack instead 
+	of marking.
+	* elhash.c (finish_marking_weak_hash_tables): Push objects on kkcc 
+	stack instead of marking.
+	* eval.c: Added XD_FLAG_NO_KKCC to subr_description.
+	* lisp.h: Added prototype for kkcc_gc_stack_push_lisp_object.
+	* profile.c (mark_profiling_info_maphash): Push keys on kkcc stack 
+	instead of marking.
+
 2003-07-30  Jerry James  <james@xemacs.org>
 
 	* sysdll.c: configure sets HAVE_DLD_INIT, not HAVE_INIT_DLD.
--- a/src/README.kkcc	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/README.kkcc	Thu Jul 31 13:32:26 2003 +0000
@@ -2,6 +2,8 @@
 	    Markus Kaltenbach  <makalten@informatik.uni-tuebingen.de>
 	    Mike Sperber <mike@xemacs.org>
 
+	updated 2003-07-29
+
 	New KKCC-GC mark algorithm:
 	configure flag : --use-kkcc
 
@@ -9,9 +11,9 @@
 	up to now:
 	Every Lisp_Object has its own mark method, which calls mark_object
 	with the stuff to be marked.
-	Also, many Lisp_Objects have pdump descriptions, which are used by 
-	the portable dumper. The dumper gets all the information it needs 
-	about the Lisp_Object from the descriptions.
+	Also, many Lisp_Objects have pdump descriptions memory_descriptions, 
+	which are used by the portable dumper. The dumper gets all the 
+	information it needs about the Lisp_Object from the descriptions.
 
 	Also the garbage collector can use the information in the pdump
 	descriptions, so we can get rid of the mark methods.
@@ -28,41 +30,44 @@
 	the Object, if it is set to 0, the dumper does not care about it.
 		
 
+	KKCC MARKING
+	------------
+	All Lisp_Objects have memory_descriptions now, so we could get
+	rid of the mark_object calls.
+	The KKCC algorithm manages its own stack. Instead of calling 
+	mark_object, all the alive Lisp_Objects are pushed on the 
+	kkcc_gc_stack. Then these elements on the stack  are processed 
+	according to their descriptions.
+
+
 	TODO
 	----
-	After all Lisp_Objects have pdump descriptions (THEY DO NOW!!), 
-	(mark_with_description) can get rid of the mark_object calls.
+	- For weakness use weak datatypes instead of XD_FLAG_NO_KKCC.
+	  XD_FLAG_NO_KKCC occurs in:
+		* elhash.c: htentry
+		* extents.c: lispobject_gap_array, extent_list, extent_info
+		* marker.c: marker     
+	  Not everything has to be rewritten. See Ben's comment in lrecord.h.
+	- Clean up special case marking (weak_hash_tables, weak_lists,
+	  ephemerons).
+	- Stack optimization (have one stack during runtime instead of 
+	  malloc/free it for every garbage collect)
 
-	
 	There are a few Lisp_Objects, where there occured differences and
 	inexactness between the mark-method and the pdump description.  All
 	these Lisp_Objects get dumped (except image instances), so their
 	descriptions have been written, before we started our work:
-
-	* alloc.c: lcrecord_list
-	description:
-	mark: performs extra gc_checking_assert() for various checks.
-
-	* alloc.c: cons
-	description: car and cdr
-	mark: cdr is marked, only if its != Qnil
-
 	* alloc.c: string
-	description: ???
-	mark: ???
-
-	* buffer.c: buffer
-	description: XD_LISP_OBJECT indirect_children
-	mark: indirect_children not marked if Qnull_pointer
-
-	* eval.c: subr
-	description: XD_DOC_STRING doc
-	mark: empty, nothing is marked
-
-	* file-coding.c: coding_system
-	description: ???
-	mark: ???
+	description: size_, data_, and plist is described
+	mark: only plist is marked, but flush_cached_extent_info is called.
+	      flush_cached_extent_info ->
+		free_soe ->
+		  free_extent_list ->
+		    free_gap_array ->
+		      gap_array_delete_all_markers ->
+			Add gap_array to the gap_array_marker_freelist
 
 	* glyphs.c: image_instance
-	description:
+	description: device is not set to nil
 	mark: mark method sets device to nil if dead
+	See comment above the description.
--- a/src/alloc.c	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/alloc.c	Thu Jul 31 13:32:26 2003 +0000
@@ -2951,6 +2951,116 @@
 
 #if defined (USE_KKCC) || defined (PDUMP)
 
+/* the initial stack size in kkcc_gc_stack_entries */
+#define KKCC_INIT_GC_STACK_SIZE 16384
+
+typedef struct
+{
+  void *data;
+  const struct memory_description *desc;
+} kkcc_gc_stack_entry;
+
+static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
+static kkcc_gc_stack_entry *kkcc_gc_stack_top;
+static int kkcc_gc_stack_size;
+static int kkcc_gc_stack_count;
+
+static void
+kkcc_gc_stack_init (void)
+{
+  kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE;
+  kkcc_gc_stack_ptr = 
+    malloc (kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
+  if (!kkcc_gc_stack_ptr) 
+    {
+      stderr_out ("stack init failed for size %d\n", kkcc_gc_stack_size);
+      exit(23);
+    }
+  kkcc_gc_stack_top = kkcc_gc_stack_ptr - 1;
+  kkcc_gc_stack_count = 0;
+}
+
+static void
+kkcc_gc_stack_free (void)
+{
+  free (kkcc_gc_stack_ptr);
+  kkcc_gc_stack_ptr = 0;
+  kkcc_gc_stack_top = 0;
+  kkcc_gc_stack_size = 0;
+}
+
+static void
+kkcc_gc_stack_realloc (void)
+{
+  kkcc_gc_stack_size *= 2;
+  kkcc_gc_stack_ptr = 
+    realloc (kkcc_gc_stack_ptr, 
+	     kkcc_gc_stack_size * sizeof (kkcc_gc_stack_entry));
+  if (!kkcc_gc_stack_ptr) 
+    {
+      stderr_out ("stack realloc failed for size %d\n", kkcc_gc_stack_size);
+      exit(23);
+    }
+  kkcc_gc_stack_top = kkcc_gc_stack_ptr + kkcc_gc_stack_count - 1;
+}
+
+static int
+kkcc_gc_stack_full (void)
+{
+  if (kkcc_gc_stack_count > (kkcc_gc_stack_size - 1))
+    return 1;
+  return 0;
+}
+
+static int
+kkcc_gc_stack_empty (void)
+{
+  if (kkcc_gc_stack_count == 0)
+    return 1;
+  return 0;
+}
+
+static void
+kkcc_gc_stack_push (void *data, const struct memory_description *desc)
+{
+  if (kkcc_gc_stack_full ())
+      kkcc_gc_stack_realloc();
+
+  kkcc_gc_stack_top++;
+  kkcc_gc_stack_count++;
+  kkcc_gc_stack_top->data = data;
+  kkcc_gc_stack_top->desc = desc;
+}
+
+static kkcc_gc_stack_entry *
+kkcc_gc_stack_pop (void) //void *data, const struct memory_description *desc)
+{
+  if (kkcc_gc_stack_empty ())
+    return 0;
+
+  kkcc_gc_stack_top--;
+  kkcc_gc_stack_count--;
+
+  return kkcc_gc_stack_top + 1;
+}
+
+void
+kkcc_gc_stack_push_lisp_object (Lisp_Object obj)
+{
+  if (XTYPE (obj) == Lisp_Type_Record)
+    {
+      struct lrecord_header *lheader = XRECORD_LHEADER (obj);
+      const struct memory_description *desc;
+      GC_CHECK_LHEADER_INVARIANTS (lheader);
+      desc = LHEADER_IMPLEMENTATION (lheader)->description;
+      if (! MARKED_RECORD_HEADER_P (lheader)) 
+	{
+	  MARK_RECORD_HEADER (lheader);
+	  kkcc_gc_stack_push((void*) lheader, desc);
+	}
+    }
+}
+
 /* This function extracts the value of a count variable described somewhere 
    else in the description. It is converted corresponding to the type */ 
 EMACS_INT
@@ -3193,10 +3303,6 @@
    They mark objects according to their descriptions.  They 
    are modeled on the corresponding pdumper procedures. */
 
-static void mark_struct_contents (const void *data,
-				  const struct sized_memory_description *sdesc,
-				  int count);
-
 #ifdef ERROR_CHECK_GC
 #define KKCC_DO_CHECK_FREE(obj, allow_free)			\
 do								\
@@ -3212,183 +3318,20 @@
 #endif
 
 #ifdef ERROR_CHECK_GC
-void
+static void
 mark_object_maybe_checking_free (Lisp_Object obj, int allow_free)
 {
   KKCC_DO_CHECK_FREE (obj, allow_free);
+#ifdef USE_KKCC
+  kkcc_gc_stack_push_lisp_object (obj);
+#else /* NOT USE_KKCC */
   mark_object (obj);
+#endif /* NOT USE_KKCC */
 }
 #else
 #define mark_object_maybe_checking_free(obj, allow_free) mark_object (obj)
 #endif /* ERROR_CHECK_GC */
 
-/* This function is called to mark the elements of an object. It processes
-   the description of the object and calls mark object with every described
-   object. */
-static void
-mark_with_description (const void *data,
-		       const struct memory_description *desc)
-{
-  int pos;
-  static const Lisp_Object *last_occurred_object = (Lisp_Object *) 0;
-  static int mark_last_occurred_object = 0;
-#ifdef ERROR_CHECK_GC
-  static int last_occurred_flags;
-#endif
-
- tail_recurse:
-
-  for (pos = 0; desc[pos].type != XD_END; pos++)
-    {
-      const struct memory_description *desc1 = &desc[pos];
-      const void *rdata =
-	(const char *) data + lispdesc_indirect_count (desc1->offset,
-						       desc, data);
-    union_switcheroo:
-
-      /* If the flag says don't mark, then don't mark. */
-      if ((desc1->flags) & XD_FLAG_NO_KKCC)
-	continue;
-
-      switch (desc1->type)
-	{
-	case XD_BYTECOUNT:
-	case XD_ELEMCOUNT:
-	case XD_HASHCODE:
-	case XD_INT:
-	case XD_LONG:
-	case XD_INT_RESET:
-	case XD_LO_LINK:
-	case XD_OPAQUE_PTR:
-	case XD_OPAQUE_DATA_PTR:
-	case XD_C_STRING:
-	case XD_DOC_STRING:
-	  break;
-	case XD_LISP_OBJECT: 
-	  {
-	    const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
-
-	    /* Because of the way that tagged objects work (pointers and
-	       Lisp_Objects have the same representation), XD_LISP_OBJECT
-	       can be used for untagged pointers.  They might be NULL,
-	       though. */
-	    if (EQ (*stored_obj, Qnull_pointer))
-	      break;
-
-	    if (desc[pos+1].type == XD_END)
-	      {
-		mark_last_occurred_object = 1;
-		last_occurred_object = stored_obj;
-#ifdef ERROR_CHECK_GC
-		last_occurred_flags = desc1->flags;
-#endif
-		break;
-	      }
-	    else
-	      mark_object_maybe_checking_free
-		(*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
-
-	    break;
-	  }
-	case XD_LISP_OBJECT_ARRAY:
-	  {
-	    int i;
-	    EMACS_INT count =
-	      lispdesc_indirect_count (desc1->data1, desc, data);
-	
-	    for (i = 0; i < count; i++)
-	      {
-		const Lisp_Object *stored_obj =
-		  (const Lisp_Object *) rdata + i;
-
-		if (EQ (*stored_obj, Qnull_pointer))
-		  break;
-
-		mark_object_maybe_checking_free
-		  (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
-	      }
-	    break;
-	  }
-	case XD_STRUCT_PTR:
-	  {
-	    EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
-						       data);
-	    const struct sized_memory_description *sdesc =
-	      lispdesc_indirect_description (data, desc1->data2);
-	    const char *dobj = * (const char **) rdata;
-	    if (dobj)
-	      mark_struct_contents (dobj, sdesc, count);
-	    break;
-	  }
-	case XD_STRUCT_ARRAY:
-	  {
-	    EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
-						       data);
-	    const struct sized_memory_description *sdesc =
-	      lispdesc_indirect_description (data, desc1->data2);
-		      
-	    mark_struct_contents (rdata, sdesc, count);
-	    break;
-	  }
-	case XD_UNION:
-	case XD_UNION_DYNAMIC_SIZE:
-	  desc1 = lispdesc_process_xd_union (desc1, desc, data);
-	  if (desc1)
-	    goto union_switcheroo;
-	  break;
-		    
-	default:
-	  stderr_out ("Unsupported description type : %d\n", desc1->type);
-	  abort ();
-	}
-    }
-
-  if (mark_last_occurred_object)
-    {
-      Lisp_Object obj = *last_occurred_object;
-
-    old_tail_recurse:
-      /* NOTE: The second parameter isn't even evaluated
-	 non-ERROR_CHECK_GC, so it's OK for the variable not to exist.
-       */
-      KKCC_DO_CHECK_FREE
-	(obj, (last_occurred_flags & XD_FLAG_FREE_LISP_OBJECT) != 0);
-
-      if (XTYPE (obj) == Lisp_Type_Record)
-	{
-	  struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-
-	  GC_CHECK_LHEADER_INVARIANTS (lheader);
-
-	  /* All c_readonly objects have their mark bit set,
-	     so that we only need to check the mark bit here. */
-	  if (! MARKED_RECORD_HEADER_P (lheader))
-	    {
-	      MARK_RECORD_HEADER (lheader);
-
-	      {
-		desc = LHEADER_IMPLEMENTATION (lheader)->description;
-		if (desc) /* && !CONSP(obj))*/  /* KKCC cons special case */
-		  {
-		    data = lheader;
-		    mark_last_occurred_object = 0;
-		    goto tail_recurse;
-		  }
-		else 
-		  {
-		    if (RECORD_MARKER (lheader))
-		      {
-			obj = RECORD_MARKER (lheader) (obj);
-			if (!NILP (obj)) goto old_tail_recurse;
-		      }
-		  }
-	      }
-	    }
-	}
-
-      mark_last_occurred_object = 0;
-    }
-}
 
 /* This function loops all elements of a struct pointer and calls 
    mark_with_description with each element. */
@@ -3403,11 +3346,123 @@
 
   for (i = 0; i < count; i++)
     {
-      mark_with_description (((char *) data) + elsize * i,
-					  sdesc->description);
+      kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description);
     }
 }
 
+
+/* This function implements the KKCC mark algorithm.
+   Instead of calling mark_object, all the alive Lisp_Objects are pushed
+   on the kkcc_gc_stack. This function processes all elements on the stack
+   according to their descriptions. */
+static void
+kkcc_marking (void) 
+{
+  kkcc_gc_stack_entry *stack_entry = 0;
+  void *data = 0;
+  const struct memory_description *desc = 0;
+  int pos;
+  
+  while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
+    {
+      data = stack_entry->data;
+      desc = stack_entry->desc;
+
+      for (pos = 0; desc[pos].type != XD_END; pos++)
+	{
+	  const struct memory_description *desc1 = &desc[pos];
+	  const void *rdata =
+	    (const char *) data + lispdesc_indirect_count (desc1->offset,
+							   desc, data);
+	union_switcheroo:
+	  
+	  /* If the flag says don't mark, then don't mark. */
+	  if ((desc1->flags) & XD_FLAG_NO_KKCC)
+	    continue;
+
+	  switch (desc1->type)
+	    {
+	    case XD_BYTECOUNT:
+	    case XD_ELEMCOUNT:
+	    case XD_HASHCODE:
+	    case XD_INT:
+	    case XD_LONG:
+	    case XD_INT_RESET:
+	    case XD_LO_LINK:
+	    case XD_OPAQUE_PTR:
+	    case XD_OPAQUE_DATA_PTR:
+	    case XD_C_STRING:
+	    case XD_DOC_STRING:
+	      break;
+	    case XD_LISP_OBJECT: 
+	      {
+		const Lisp_Object *stored_obj = (const Lisp_Object *) rdata;
+
+		/* Because of the way that tagged objects work (pointers and
+		   Lisp_Objects have the same representation), XD_LISP_OBJECT
+		   can be used for untagged pointers.  They might be NULL,
+		   though. */
+		if (EQ (*stored_obj, Qnull_pointer))
+		  break;
+		mark_object_maybe_checking_free
+		  (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
+	    
+		break;
+	      }
+	    case XD_LISP_OBJECT_ARRAY:
+	      {
+		int i;
+		EMACS_INT count =
+		  lispdesc_indirect_count (desc1->data1, desc, data);
+	
+		for (i = 0; i < count; i++)
+		  {
+		    const Lisp_Object *stored_obj =
+		      (const Lisp_Object *) rdata + i;
+
+		    if (EQ (*stored_obj, Qnull_pointer))
+		      break;
+
+		    mark_object_maybe_checking_free
+		      (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
+		  }
+		break;
+	      }
+	    case XD_STRUCT_PTR:
+	      {
+		EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
+							   data);
+		const struct sized_memory_description *sdesc =
+		  lispdesc_indirect_description (data, desc1->data2);
+		const char *dobj = * (const char **) rdata;
+		if (dobj)
+		  mark_struct_contents (dobj, sdesc, count);
+		break;
+	      }
+	    case XD_STRUCT_ARRAY:
+	      {
+		EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
+							   data);
+		const struct sized_memory_description *sdesc =
+		  lispdesc_indirect_description (data, desc1->data2);
+		      
+		mark_struct_contents (rdata, sdesc, count);
+		break;
+	      }
+	    case XD_UNION:
+	    case XD_UNION_DYNAMIC_SIZE:
+	      desc1 = lispdesc_process_xd_union (desc1, desc, data);
+	      if (desc1)
+		goto union_switcheroo;
+	      break;
+		    
+	    default:
+	      stderr_out ("Unsupported description type : %d\n", desc1->type);
+	      abort ();
+	    }
+	}
+    }
+}
 #endif /* USE_KKCC */  
 
 /* Mark reference to a Lisp_Object.  If the object referred to has not been
@@ -3416,6 +3471,13 @@
 void
 mark_object (Lisp_Object obj)
 {
+#ifdef USE_KKCC
+  /* this code should never be reached when configured for KKCC */
+  stderr_out ("KKCC: Invalid mark_object call.\n");
+  stderr_out ("Replace mark_object with kkcc_gc_stack_push_lisp_object.\n");
+  abort ();
+#endif /* USE_KKCC */
+
  tail_recurse:
 
   /* Checks we used to perform */
@@ -3429,10 +3491,8 @@
 
       GC_CHECK_LHEADER_INVARIANTS (lheader);
 
-#ifndef USE_KKCC
       /* We handle this separately, above, so we can mark free objects */
       GC_CHECK_NOT_FREE (lheader);
-#endif /* not USE_KKCC */
 
       /* All c_readonly objects have their mark bit set,
 	 so that we only need to check the mark bit here. */
@@ -3440,28 +3500,15 @@
 	{
 	  MARK_RECORD_HEADER (lheader);
 
-	  {
-#ifdef USE_KKCC
-	    const struct memory_description *desc;
-	    desc = LHEADER_IMPLEMENTATION (lheader)->description;
-	    if (desc) /* && !CONSP(obj))*/  /* KKCC cons special case */
-	      mark_with_description (lheader, desc);
-	    else 
-#endif /* USE_KKCC */
-	      {
-		if (RECORD_MARKER (lheader))
-		  {
-		    obj = RECORD_MARKER (lheader) (obj);
-		    if (!NILP (obj)) goto tail_recurse;
-		  }
-	      }
-	  }
+	  if (RECORD_MARKER (lheader))
+	    {
+	      obj = RECORD_MARKER (lheader) (obj);
+	      if (!NILP (obj)) goto tail_recurse;
+	    }
 	}
     }
 }
 
-
-/* Find all structures not marked, and free them. */
 
 static int gc_count_num_short_string_in_use;
 static Bytecount gc_count_string_total_size;
@@ -4542,18 +4589,31 @@
 
   /* Mark all the special slots that serve as the roots of accessibility. */
 
+#ifdef USE_KKCC
+  /* initialize kkcc stack */
+  kkcc_gc_stack_init();
+#endif /* USE_KKCC */
+
   { /* staticpro() */
     Lisp_Object **p = Dynarr_begin (staticpros);
     Elemcount count;
     for (count = Dynarr_length (staticpros); count; count--)
+#ifdef USE_KKCC
+      kkcc_gc_stack_push_lisp_object (**p++);
+#else /* NOT USE_KKCC */
       mark_object (**p++);
+#endif /* NOT USE_KKCC */
   }
 
   { /* staticpro_nodump() */
     Lisp_Object **p = Dynarr_begin (staticpros_nodump);
     Elemcount count;
     for (count = Dynarr_length (staticpros_nodump); count; count--)
+#ifdef USE_KKCC
+      kkcc_gc_stack_push_lisp_object (**p++);
+#else /* NOT USE_KKCC */
       mark_object (**p++);
+#endif /* NOT USE_KKCC */
   }
 
   { /* GCPRO() */
@@ -4561,15 +4621,24 @@
     int i;
     for (tail = gcprolist; tail; tail = tail->next)
       for (i = 0; i < tail->nvars; i++)
+#ifdef USE_KKCC
+	kkcc_gc_stack_push_lisp_object (tail->var[i]);
+#else /* NOT USE_KKCC */
 	mark_object (tail->var[i]);
+#endif /* NOT USE_KKCC */
   }
 
   { /* specbind() */
     struct specbinding *bind;
     for (bind = specpdl; bind != specpdl_ptr; bind++)
       {
+#ifdef USE_KKCC
+	kkcc_gc_stack_push_lisp_object (bind->symbol);
+	kkcc_gc_stack_push_lisp_object (bind->old_value);
+#else /* NOT USE_KKCC */
 	mark_object (bind->symbol);
 	mark_object (bind->old_value);
+#endif /* NOT USE_KKCC */
       }
   }
 
@@ -4577,9 +4646,15 @@
     struct catchtag *catch;
     for (catch = catchlist; catch; catch = catch->next)
       {
+#ifdef USE_KKCC
+	kkcc_gc_stack_push_lisp_object (catch->tag);
+	kkcc_gc_stack_push_lisp_object (catch->val);
+	kkcc_gc_stack_push_lisp_object (catch->actual_tag);
+#else /* NOT USE_KKCC */
 	mark_object (catch->tag);
 	mark_object (catch->val);
 	mark_object (catch->actual_tag);
+#endif /* NOT USE_KKCC */
       }
   }
 
@@ -4590,6 +4665,16 @@
 	int nargs = backlist->nargs;
 	int i;
 
+#ifdef USE_KKCC
+	kkcc_gc_stack_push_lisp_object (*backlist->function);
+	if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
+	    /* might be fake (internal profiling entry) */
+	    && backlist->args)
+	  kkcc_gc_stack_push_lisp_object (backlist->args[0]);
+	else
+	  for (i = 0; i < nargs; i++)
+	    kkcc_gc_stack_push_lisp_object (backlist->args[i]);
+#else /* NOT USE_KKCC */
 	mark_object (*backlist->function);
 	if (nargs < 0 /* nargs == UNEVALLED || nargs == MANY */
 	    /* might be fake (internal profiling entry) */
@@ -4598,6 +4683,7 @@
 	else
 	  for (i = 0; i < nargs; i++)
 	    mark_object (backlist->args[i]);
+#endif /* NOT USE_KKCC */
       }
   }
 
@@ -4609,13 +4695,20 @@
      a weak hash table might be unmarked, but after processing a later
      weak hash table, the former one might get marked.  So we have to
      iterate until nothing more gets marked. */
-  
+#ifdef USE_KKCC
+  kkcc_marking ();
+#endif /* USE_KKCC */
   init_marking_ephemerons ();
   while (finish_marking_weak_hash_tables () > 0 ||
 	 finish_marking_weak_lists       () > 0 ||
 	 continue_marking_ephemerons     () > 0)
     ;
 
+#ifdef USE_KKCC
+  kkcc_marking ();
+  kkcc_gc_stack_free ();
+#endif /* USE_KKCC */
+
   /* At this point, we know which objects need to be finalized: we
      still need to resurrect them */
 
--- a/src/data.c	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/data.c	Thu Jul 31 13:32:26 2003 +0000
@@ -1613,8 +1613,10 @@
 }
 
 static const struct memory_description weak_list_description[] = {
-  { XD_LISP_OBJECT, offsetof (struct weak_list, list) },
-  { XD_LO_LINK,     offsetof (struct weak_list, next_weak) },
+  { XD_LISP_OBJECT, offsetof (struct weak_list, list), 
+  0, 0, XD_FLAG_NO_KKCC },
+  { XD_LO_LINK,     offsetof (struct weak_list, next_weak), 
+  0, 0, XD_FLAG_NO_KKCC },
   { XD_END }
 };
 
@@ -1761,7 +1763,11 @@
 
 	  if (need_to_mark_elem && ! marked_p (elem))
 	    {
+#ifdef USE_KKCC
+	      kkcc_gc_stack_push_lisp_object (elem);
+#else /* NOT USE_KKCC */
 	      mark_object (elem);
+#endif /* NOT USE_KKCC */
 	      did_mark = 1;
 	    }
 
@@ -1785,7 +1791,11 @@
          because we're not removing it */
       if (!NILP (rest2) && ! marked_p (rest2))
 	{
+#ifdef USE_KKCC
+	  kkcc_gc_stack_push_lisp_object (rest2);
+#else /* NOT USE_KKCC */
 	  mark_object (rest2);
+#endif /* NOT USE_KKCC */
 	  did_mark = 1;
 	}
     }
@@ -2160,7 +2170,12 @@
 	  MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain));
 	  if (marked_p (XEPHEMERON (rest)->key))
 	    {
+#ifdef USE_KKCC
+	      kkcc_gc_stack_push_lisp_object 
+	      (XCAR (XEPHEMERON (rest)->cons_chain));
+#else /* NOT USE_KKCC */
 	      mark_object (XCAR (XEPHEMERON (rest)->cons_chain));
+#endif /* NOT USE_KKCC */
 	      did_mark = 1;
 	      XSET_EPHEMERON_NEXT (rest, Vnew_all_ephemerons);
 	      Vnew_all_ephemerons = rest;
@@ -2205,7 +2220,12 @@
 	  if (! NILP (XEPHEMERON_FINALIZER (rest)))
 	    {
 	      MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain));
+#ifdef USE_KKCC
+	      kkcc_gc_stack_push_lisp_object 
+	      (XCAR (XEPHEMERON (rest)->cons_chain));
+#else /* NOT USE_KKCC */
 	      mark_object (XCAR (XEPHEMERON (rest)->cons_chain));
+#endif /* NOT USE_KKCC */
 
 	      /* Register the finalizer */
 	      XSET_EPHEMERON_NEXT (rest, Vfinalize_list);
@@ -2298,6 +2318,8 @@
   return result;
 }
 
+/* Ephemerons are special cases in the KKCC mark algorithm, so nothing
+   is marked here. */
 static const struct memory_description ephemeron_description[] = {
   { XD_LISP_OBJECT, offsetof(struct ephemeron, key),
     0, 0, XD_FLAG_NO_KKCC },
--- a/src/elhash.c	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/elhash.c	Thu Jul 31 13:32:26 2003 +0000
@@ -1429,6 +1429,18 @@
 /************************************************************************/
 /*		   garbage collecting weak hash tables			*/
 /************************************************************************/
+#ifdef USE_KKCC
+#define MARK_OBJ(obj) do {		       \
+  Lisp_Object mo_obj = (obj);		       \
+  if (!marked_p (mo_obj))		       \
+    {					       \
+      kkcc_gc_stack_push_lisp_object (mo_obj); \
+      did_mark = 1;			       \
+    }					       \
+} while (0)
+
+#else /* NO USE_KKCC */
+
 #define MARK_OBJ(obj) do {		\
   Lisp_Object mo_obj = (obj);		\
   if (!marked_p (mo_obj))		\
@@ -1437,6 +1449,7 @@
       did_mark = 1;			\
     }					\
 } while (0)
+#endif /*NO USE_KKCC */
 
 
 /* Complete the marking for semi-weak hash tables. */
--- a/src/eval.c	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/eval.c	Thu Jul 31 13:32:26 2003 +0000
@@ -428,7 +428,7 @@
 }
 
 static const struct memory_description subr_description[] = {
-  { XD_DOC_STRING, offsetof (Lisp_Subr, doc) },
+  { XD_DOC_STRING, offsetof (Lisp_Subr, doc), 0, 0, XD_FLAG_NO_KKCC },
   { XD_END }
 };
 
--- a/src/lisp.h	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/lisp.h	Thu Jul 31 13:32:26 2003 +0000
@@ -3568,6 +3568,9 @@
 void free_marker (Lisp_Object);
 int object_dead_p (Lisp_Object);
 void mark_object (Lisp_Object obj);
+#ifdef USE_KKCC
+void kkcc_gc_stack_push_lisp_object (Lisp_Object obj);
+#endif /* USE_KKCC */
 int marked_p (Lisp_Object obj);
 extern int funcall_allocation_flag;
 extern int need_to_garbage_collect;
--- a/src/profile.c	Wed Jul 30 21:52:22 2003 +0000
+++ b/src/profile.c	Thu Jul 31 13:32:26 2003 +0000
@@ -672,7 +672,11 @@
 			     void *void_val,
 			     void *void_closure)
 {
+#ifdef USE_KKCC
+  kkcc_gc_stack_push_lisp_object (VOID_TO_LISP (void_key));
+#else /* NOT USE_KKCC */
   mark_object (VOID_TO_LISP (void_key));
+#endif /* NOT USE_KKCC */
   return 0;
 }