Steel Bank Common Lisp

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

Modified Files:
	debug.lisp 
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: debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/debug.lisp,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- debug.lisp	14 Jul 2005 16:30:42 -0000	1.8
+++ debug.lisp	28 Jun 2007 14:24:49 -0000	1.9
@@ -110,9 +110,9 @@
   (:translate fun-code-header)
   (:variant fun-pointer-lowtag))
 
-(define-vop (make-lisp-obj)
+(define-vop (%make-lisp-obj)
   (:policy :fast-safe)
-  (:translate make-lisp-obj)
+  (:translate %make-lisp-obj)
   (:args (value :scs (unsigned-reg) :target result))
   (:arg-types unsigned-num)
   (:results (result :scs (descriptor-reg)))