Steel Bank Common Lisp

Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32059/src/runtime

Modified Files:
	cheneygc.c gc-common.c gc-internal.h gencgc.c 
Log Message:
0.9.0.9:
	More ThiemoSeuferPatches
	... move search_space out of a .h file and into the common .c
		file
		Message-ID: <20050422220942.GH10767@...>
	
	(this version passes a respectable number of PFD ansi-tests
	on the x86.  It doesn't run them to completion, mind you, but
	that I think is because of the test framework: MISC.587 at present
	signals a control-stack-exhausted error on the x86, which of course
	is not an ERROR but is a SERIOUS-CONDITION)


Index: cheneygc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/cheneygc.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- cheneygc.c	30 Apr 2005 17:24:20 -0000	1.13
+++ cheneygc.c	30 Apr 2005 18:20:58 -0000	1.14
@@ -530,9 +530,9 @@
     lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
     if ((pointer < (void *)start) || (pointer >= (void *)end))
 	return NULL;
-    return (search_space(start, 
-			 (((lispobj *)pointer)+2)-start, 
-			 (lispobj *)pointer));
+    return (gc_search_space(start, 
+			    (((lispobj *)pointer)+2)-start, 
+			    (lispobj *)pointer));
 }
 
 lispobj *
@@ -542,9 +542,9 @@
     lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
     if ((pointer < (void *)start) || (pointer >= (void *)end))
 	return NULL;
-    return (search_space(start, 
-			 (((lispobj *)pointer)+2)-start, 
-			 (lispobj *)pointer));
+    return (gc_search_space(start, 
+			    (((lispobj *)pointer)+2)-start, 
+			    (lispobj *)pointer));
 }
 
 lispobj *
@@ -554,9 +554,9 @@
     lispobj *end = (lispobj *) dynamic_space_free_pointer;
     if ((pointer < (void *)start) || (pointer >= (void *)end))
 	return NULL;
-    return (search_space(start, 
-			 (((lispobj *)pointer)+2)-start, 
-			 (lispobj *)pointer));
+    return (gc_search_space(start, 
+			    (((lispobj *)pointer)+2)-start, 
+			    (lispobj *)pointer));
 }
 
 /* initialization.  if gc_init can be moved to after core load, we could

Index: gc-common.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-common.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -d -r1.23 -r1.24
--- gc-common.c	30 Apr 2005 17:24:21 -0000	1.23
+++ gc-common.c	30 Apr 2005 18:20:58 -0000	1.24
@@ -2007,3 +2007,40 @@
 
     return (NULL);
 }
+
+/* Scan an area looking for an object which encloses the given pointer.
+ * Return the object start on success or NULL on failure. */
+lispobj *
+gc_search_space(lispobj *start, size_t words, lispobj *pointer)
+{
+    while (words > 0) {
+	size_t count = 1;
+	lispobj thing = *start;
+
+	/* If thing is an immediate then this is a cons. */
+	if (is_lisp_pointer(thing)
+	    || (fixnump(thing))
+	    || (widetag_of(thing) == CHARACTER_WIDETAG)
+#if N_WORD_BITS == 64
+	    || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
+#endif
+	    || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
+	    count = 2;
+	else
+	    count = (sizetab[widetag_of(thing)])(start);
+
+	/* Check whether the pointer is within this object. */
+	if ((pointer >= start) && (pointer < (start+count))) {
+	    /* found it! */
+	    /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
+	    return(start);
+	}
+
+	/* Round up the count. */
+	count = CEILING(count,2);
+
+	start += count;
+	words -= count;
+    }
+    return (NULL);
+}

Index: gc-internal.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-internal.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- gc-internal.h	16 Mar 2005 10:10:06 -0000	1.12
+++ gc-internal.h	30 Apr 2005 18:20:58 -0000	1.13
@@ -91,44 +91,9 @@
 lispobj *search_static_space(void *pointer);
 lispobj *search_dynamic_space(void *pointer);
 
-#include "fixnump.h"
-
-/* Scan an area looking for an object which encloses the given pointer.
- * Return the object start on success or NULL on failure. */
-static lispobj *
-search_space(lispobj *start, size_t words, lispobj *pointer)
-{
-    while (words > 0) {
-	size_t count = 1;
-	lispobj thing = *start;
-
-	/* If thing is an immediate then this is a cons. */
-	if (is_lisp_pointer(thing)
-	    || (fixnump(thing))
-	    || (widetag_of(thing) == CHARACTER_WIDETAG)
-#if N_WORD_BITS == 64
-	    || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG)
-#endif
-	    || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
-	    count = 2;
-	else
-	    count = (sizetab[widetag_of(thing)])(start);
-
-	/* Check whether the pointer is within this object. */
-	if ((pointer >= start) && (pointer < (start+count))) {
-	    /* found it! */
-	    /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
-	    return(start);
-	}
-
-	/* Round up the count. */
-	count = CEILING(count,2);
+lispobj *gc_search_space(lispobj *start, size_t words, lispobj *pointer);
 
-	start += count;
-	words -= count;
-    }
-    return (NULL);
-}
+#include "fixnump.h"
 
 #ifdef LISP_FEATURE_GENCGC
 #include "gencgc-internal.h"

Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.66
retrieving revision 1.67
diff -u -d -r1.66 -r1.67
--- gencgc.c	14 Apr 2005 22:34:44 -0000	1.66
+++ gencgc.c	30 Apr 2005 18:20:58 -0000	1.67
@@ -1970,9 +1970,9 @@
     lispobj *end = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
     if ((pointer < (void *)start) || (pointer >= (void *)end))
 	return NULL;
-    return (search_space(start, 
-			 (((lispobj *)pointer)+2)-start, 
-			 (lispobj *) pointer));
+    return (gc_search_space(start,
+			    (((lispobj *)pointer)+2)-start,
+			    (lispobj *) pointer));
 }
 
 lispobj *
@@ -1982,9 +1982,9 @@
     lispobj *end = (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
     if ((pointer < (void *)start) || (pointer >= (void *)end))
 	return NULL;
-    return (search_space(start, 
-			 (((lispobj *)pointer)+2)-start, 
-			 (lispobj *) pointer));
+    return (gc_search_space(start, 
+			    (((lispobj *)pointer)+2)-start, 
+			    (lispobj *) pointer));
 }
 
 /* a faster version for searching the dynamic space. This will work even
@@ -2001,9 +2001,9 @@
 	return NULL;
     start = (lispobj *)((void *)page_address(page_index)
 			+ page_table[page_index].first_object_offset);
-    return (search_space(start, 
-			 (((lispobj *)pointer)+2)-start, 
-			 (lispobj *)pointer));
+    return (gc_search_space(start, 
+			    (((lispobj *)pointer)+2)-start, 
+			    (lispobj *)pointer));
 }
 
 /* Is there any possibility that pointer is a valid Lisp object
@@ -4060,7 +4060,7 @@
 	page_table[page].bytes_used = PAGE_BYTES;
 	page_table[page].large_object = 0;
 
-	first=search_space(prev,(ptr+2)-prev,ptr);
+	first=gc_search_space(prev,(ptr+2)-prev,ptr);
 	if(ptr == first)  prev=ptr; 
 	page_table[page].first_object_offset =
 	    (void *)prev - page_address(page);