[Sbcl-commits] CVS: sbcl/src/compiler ir1-translators.lisp,1.40,1.41 ir2tran.lisp,1.39,1.40

[Christophe R. <cr...@us...>]

Update of /cvsroot/sbcl/sbcl/src/compiler
In directory sc8-pr-cvs1:/tmp/cvs-serv13913/src/compiler

Modified Files:
	ir1-translators.lisp ir2tran.lisp 
Log Message:
0.7.12.38:
	PCL accessors/SLOT-MISSING fixes:
	Remove some package fragility of generated accessor functions
	... define a new generalized function name class:
		SB-PCL::SLOT-ACCESSOR
	... s/SLOT-READER-SYMBOL/SLOT-READER-NAME/, and use the new
		generalized function names
	... now SB-SLOT-ACCESSOR-NAME and *SLOT-ACCESSOR-NAME-PACKAGE*
		can go away
	Ensure that SLOT-MISSING is called in all required situations.
	The easy way would just have been to adjust ASV-FUNCALL	slightly, 
		but that would have been no fun, so include an
		optimization due to Gerd Moellmann:
	... new LOAD-TIME-VALUE logic that ensures that the relevant
		accessor name is always FBOUNDP, so the FBOUNDP check
		can be elided at runtime
	By this stage, it's all working, but
	... while we're at it, also include the
		ASV-FUNCALL-as-was/ENSURE-ACCESSOR optimization for
		SLOT-BOUNDP, which was not included in historical PCL.
	... also, ensure that fast discriminating functions are
		constructed, conditional on
		*OPTIMIZE-CACHE-FUNCTIONS-P*: eventually, this can
		probably be made either unconditional or conditional on
		the compilation policy when a generic function is
		compiled.
	Include a simple test for SLOT-MISSING behaviour.
	... this version has also been tested against Gerd Moellmann's
		test suite, with no regressions found.


Index: ir1-translators.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir1-translators.lisp,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -d -r1.40 -r1.41
--- ir1-translators.lisp	31 Jan 2003 09:28:35 -0000	1.40
+++ ir1-translators.lisp	15 Feb 2003 11:16:34 -0000	1.41
@@ -444,7 +444,7 @@
 			  thing
 			  :debug-name (debug-namify "#'~S" thing)
 			  :allow-debug-catch-tag t)))
-	((setf sb!pcl::class-predicate)
+	((setf sb!pcl::class-predicate sb!pcl::slot-accessor)
 	 (let ((var (find-lexically-apparent-fun
 		     thing "as the argument to FUNCTION")))
 	   (reference-leaf start cont var)))

Index: ir2tran.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/ir2tran.lisp,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -d -r1.39 -r1.40
--- ir2tran.lisp	11 Nov 2002 08:37:04 -0000	1.39
+++ ir2tran.lisp	15 Feb 2003 11:16:34 -0000	1.40
@@ -1039,9 +1039,11 @@
 	(bug "full call to ~S" fname)))
 
     (when (consp fname)
-      (destructuring-bind (setf stem) fname
-	(aver (eq setf 'setf))
-	(setf (gethash stem *setf-assumed-fboundp*) t)))))
+      (destructuring-bind (setfoid &rest stem) fname
+	(aver (member setfoid
+		      '(setf sb!pcl::class-predicate sb!pcl::slot-accessor)))
+	(when (eq setfoid 'setf)
+	  (setf (gethash (car stem) *setf-assumed-fboundp*) t))))))
 
 ;;; If the call is in a tail recursive position and the return
 ;;; convention is standard, then do a tail full call. If one or fewer