Steel Bank Common Lisp

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

Modified Files:
	gencgc.c 
Log Message:
1.0.7.2: fix potential GC errors due to bogus objects in backtraces

 Backtrace construction involves calling MAKE-LISP-OBJ on things we
 devoutly hope are tagged lisp pointers, but this is not always the
 case. When we fail to detect this, and a GC follows while the bogus
 object is at location visible to GC bad things will happen. (Pinning
 doesn't change anything, as the object still needs to be scavenged.)

 To fix this (mostly -- one can still construct bogus lisp-objects
 using MAKE-LISP-OBJ, it just takes more work / is less likely to
 happen by accident):

  * Rename MAKE-LISP-OBJ %MAKE-LISP-OBJ, and MAKE-VALID-LISP-OBJ
    MAKE-LISP-OBJ.

  * Add an optional ERRORP argument to the former MAKE-VALID-LISP-OBJ,
    defaulting to T.

  * Always use the function formerly known as MAKE-VALID-LISP-OBJ,
    passing in errorp=NIL when in doubt.

  * Improve the validation done on x86/x86-64: factor out the checking
    logic in possibly_valid_dynamic_space_pointer, and use it to
    implment valid_lisp_ponter_p. Could be done on other platforms as
    well, but better done by someone who can test the results...

 Adjust other code to suit:

  * MAP-ALLOCATED-OBJECTS uses %MAKE-LISP-OBJ for now, as the new
    MAKE-LISP-OBJ is too slow to use for groveling over the whole
    heap. (Though it does detect a bunch of bogus objects we're
    constructing in ROOM now, so the time would not be really
    wasted...)

 No test cases because I've been unable to construct one that calls
 MAKE-LISP-OBJ with bogus arguments while backtracing, but such
 backtraces have been seen in the wild.


Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.116
retrieving revision 1.117
diff -u -d -r1.116 -r1.117
--- gencgc.c	20 Jun 2007 19:05:54 -0000	1.116
+++ gencgc.c	28 Jun 2007 14:24:49 -0000	1.117
@@ -2127,37 +2127,28 @@
 
 #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
 
-/* Is there any possibility that pointer is a valid Lisp object
- * reference, and/or something else (e.g. subroutine call return
- * address) which should prevent us from moving the referred-to thing?
- * This is called from preserve_pointers() */
+/* Helper for valid_lisp_pointer_p and
+ * possibly_valid_dynamic_space_pointer.
+ *
+ * pointer is the pointer to validate, and start_addr is the address
+ * of the enclosing object.
+ */
 static int
-possibly_valid_dynamic_space_pointer(lispobj *pointer)
+looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
 {
-    lispobj *start_addr;
-
-    /* Find the object start address. */
-    if ((start_addr = search_dynamic_space(pointer)) == NULL) {
-        return 0;
-    }
-
     /* We need to allow raw pointers into Code objects for return
      * addresses. This will also pick up pointers to functions in code
      * objects. */
-    if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) {
+    if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG)
         /* XXX could do some further checks here */
         return 1;
-    }
 
-    /* If it's not a return address then it needs to be a valid Lisp
-     * pointer. */
     if (!is_lisp_pointer((lispobj)pointer)) {
         return 0;
     }
 
     /* Check that the object pointed to is consistent with the pointer
-     * low tag.
-     */
+     * low tag. */
     switch (lowtag_of((lispobj)pointer)) {
     case FUN_POINTER_LOWTAG:
         /* Start_addr should be the enclosing code object, or a closure
@@ -2399,6 +2390,47 @@
     return 1;
 }
 
+/* Used by the debugger to validate possibly bogus pointers before
+ * calling MAKE-LISP-OBJ on them.
+ *
+ * FIXME: We would like to make this perfect, because if the debugger
+ * constructs a reference to a bugs lisp object, and it ends up in a
+ * location scavenged by the GC all hell breaks loose.
+ *
+ * Whereas possibly_valid_dynamic_space_pointer has to be conservative
+ * and return true for all valid pointers, this could actually be eager
+ * and lie about a few pointers without bad results... but that should
+ * be reflected in the name.
+ */
+int
+valid_lisp_pointer_p(lispobj *pointer)
+{
+    lispobj *start;
+    if (((start=search_dynamic_space(pointer))!=NULL) ||
+        ((start=search_static_space(pointer))!=NULL) ||
+        ((start=search_read_only_space(pointer))!=NULL))
+        return looks_like_valid_lisp_pointer_p(pointer, start);
+    else
+        return 0;
+}
+
+/* Is there any possibility that pointer is a valid Lisp object
+ * reference, and/or something else (e.g. subroutine call return
+ * address) which should prevent us from moving the referred-to thing?
+ * This is called from preserve_pointers() */
+static int
+possibly_valid_dynamic_space_pointer(lispobj *pointer)
+{
+    lispobj *start_addr;
+
+    /* Find the object start address. */
+    if ((start_addr = search_dynamic_space(pointer)) == NULL) {
+        return 0;
+    }
+
+    return looks_like_valid_lisp_pointer_p(pointer, start_addr);
+}
+
 /* Adjust large bignum and vector objects. This will adjust the
  * allocated region if the size has shrunk, and move unboxed objects
  * into unboxed pages. The pages are not promoted here, and the