changeset 1265:de6cf052e10b

[xemacs-hg @ 2003-02-07 00:49:41 by ben] add KKCC tail-recursion alloc.c: Implement tail-recursion in KKCC when the last-marked object is a Lisp object, to avoid stack-overflow errors when marking long lists. Factor out some duplicated error-checking into macros.
author ben
date Fri, 07 Feb 2003 00:49:42 +0000
parents 032904d02169
children b5a5863da615
files src/ChangeLog src/alloc.c
diffstat 2 files changed, 74 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Thu Feb 06 22:52:40 2003 +0000
+++ b/src/ChangeLog	Fri Feb 07 00:49:42 2003 +0000
@@ -1,3 +1,14 @@
+2003-02-06  Ben Wing  <ben@xemacs.org>
+
+	* alloc.c:
+	* alloc.c (GC_CHECK_NOT_FREE):
+	* alloc.c (mark_object_maybe_checking_free):
+	* alloc.c (mark_with_description):
+	* alloc.c (mark_object):
+	Implement tail-recursion in KKCC when the last-marked object is
+	a Lisp object, to avoid stack-overflow errors when marking long
+	lists.  Factor out some duplicated error-checking into macros.
+
 2003-02-05  Ben Wing  <ben@xemacs.org>
 
 	* Makefile.in.in (update-elc.stamp):
--- a/src/alloc.c	Thu Feb 06 22:52:40 2003 +0000
+++ b/src/alloc.c	Fri Feb 07 00:49:42 2003 +0000
@@ -1,7 +1,7 @@
 /* Storage allocation and gc for XEmacs Lisp interpreter.
    Copyright (C) 1985-1998 Free Software Foundation, Inc.
    Copyright (C) 1995 Sun Microsystems, Inc.
-   Copyright (C) 1995, 1996, 2001, 2002 Ben Wing.
+   Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing.
 
 This file is part of XEmacs.
 
@@ -3134,18 +3134,30 @@
 				  const struct sized_memory_description *sdesc,
 				  int count);
 
+#define GC_CHECK_NOT_FREE(lheader)					\
+      gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p ||	\
+			  ! ((struct lcrecord_header *) lheader)->free)
+
+
+#ifdef ERROR_CHECK_GC
+#define KKCC_DO_CHECK_FREE(obj, allow_free)			\
+do								\
+{								\
+  if (!allow_free && XTYPE (obj) == Lisp_Type_Record)		\
+    {								\
+      struct lrecord_header *lheader = XRECORD_LHEADER (obj);	\
+      GC_CHECK_NOT_FREE (lheader);				\
+    }								\
+} while (0)
+#else
+#define KKCC_DO_CHECK_FREE(obj, allow_free)
+#endif
 
 #ifdef ERROR_CHECK_GC
 void
 mark_object_maybe_checking_free (Lisp_Object obj, int allow_free)
 {
-
-  if (!allow_free && XTYPE (obj) == Lisp_Type_Record)
-    {
-      struct lrecord_header *lheader = XRECORD_LHEADER (obj);
-      gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p ||
-			  ! ((struct lcrecord_header *) lheader)->free);
-    }
+  KKCC_DO_CHECK_FREE (obj, allow_free);
   mark_object (obj);
 }
 #else
@@ -3166,6 +3178,8 @@
   static int last_occurred_flags;
 #endif
 
+ tail_recurse:
+
   for (pos = 0; desc[pos].type != XD_END; pos++)
     {
       const struct memory_description *desc1 = &desc[pos];
@@ -3273,12 +3287,47 @@
 
   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.
        */
-      mark_object_maybe_checking_free (*last_occurred_object,
-				       last_occurred_flags &
-				       XD_FLAG_FREE_LISP_OBJECT);
+      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;
     }
 }
@@ -3324,11 +3373,9 @@
 
 #ifndef USE_KKCC
       /* We handle this separately, above, so we can mark free objects */
-      gc_checking_assert (LHEADER_IMPLEMENTATION (lheader)->basic_p ||
-			  ! ((struct lcrecord_header *) lheader)->free);
+      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. */
       if (! MARKED_RECORD_HEADER_P (lheader))
@@ -3337,16 +3384,10 @@
 
 	  {
 #ifdef USE_KKCC
-	    const struct lrecord_implementation *imp;
 	    const struct memory_description *desc;
-
-	    imp = LHEADER_IMPLEMENTATION (lheader);
-	    desc = imp->description;
-	  
+	    desc = LHEADER_IMPLEMENTATION (lheader)->description;
 	    if (desc) /* && !CONSP(obj))*/  /* KKCC cons special case */
-	      {
-		mark_with_description (lheader, desc);
-	      }
+	      mark_with_description (lheader, desc);
 	    else 
 #endif /* USE_KKCC */
 	      {