X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir2tran.lisp;h=c614cbcf6333de8c4f66fffa6d9bfc3b5d14d896;hb=df679ed627975948b1cee190f4d79c397588c43e;hp=b916025a110f1eb3c4a71577036f24c1f783f3dd;hpb=cf6f2e4b33475c59d999e53d3d5c290726fe0a7c;p=sbcl.git

diff --git a/src/compiler/ir2tran.lisp b/src/compiler/ir2tran.lisp
index b916025..c614cbc 100644
--- a/src/compiler/ir2tran.lisp
+++ b/src/compiler/ir2tran.lisp
@@ -291,7 +291,7 @@
 
     (cond ((and (eq (continuation-type-check cont) t)
 		(multiple-value-bind (check types)
-		    (continuation-check-types cont)
+		    (continuation-check-types cont nil)
 		  (aver (eq check :simple))
 		  ;; If the proven type is a subtype of the possibly
 		  ;; weakened type check then it's always true and is
@@ -323,7 +323,7 @@
 	 (nlocs (length locs)))
     (aver (= nlocs (length ptypes)))
     (if (eq (continuation-type-check cont) t)
-	(multiple-value-bind (check types) (continuation-check-types cont)
+	(multiple-value-bind (check types) (continuation-check-types cont nil)
 	  (aver (eq check :simple))
 	  (let ((ntypes (length types)))
 	    (mapcar (lambda (from to-type assertion)
@@ -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
@@ -1333,8 +1335,7 @@
 (def-ir1-translator progv ((vars vals &body body) start cont)
   (ir1-convert
    start cont
-   (let ((bind (gensym "BIND"))
-         (unbind (gensym "UNBIND")))
+   (with-unique-names (bind unbind)
      (once-only ((n-save-bs '(%primitive current-binding-pointer)))
                 `(unwind-protect
                       (progn
@@ -1347,7 +1348,9 @@
                                    (declare (optimize (speed 2) (debug 0)))
                                    (cond ((null vars))
                                          ((null vals) (,unbind vars))
-                                         (t (%primitive bind (car vals) (car vars))
+                                         (t (%primitive bind
+							(car vals)
+							(car vars))
                                             (,bind (cdr vars) (cdr vals))))))
                           (,bind ,vars ,vals))
                         nil