Mercurial > hg > xemacs-beta
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 */ {