[Sbcl-commits] CVS: sbcl/src/pcl boot.lisp, 1.160, 1.161 vector.lisp, 1.69, 1.70

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

Update of /cvsroot/sbcl/sbcl/src/pcl
In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv19336/src/pcl

Modified Files:
	boot.lisp vector.lisp 
Log Message:
1.0.42.32: fix for lp#611361

Only omit IGNORE declarations for required method parameters, not all
parameters.


Index: boot.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/boot.lisp,v
retrieving revision 1.160
retrieving revision 1.161
diff -u -d -r1.160 -r1.161
--- boot.lisp	31 Aug 2010 14:29:16 -0000	1.160
+++ boot.lisp	4 Sep 2010 08:01:29 -0000	1.161
@@ -733,6 +733,7 @@
                                            ,call-next-method-p
                                            :next-method-p-p ,next-method-p-p
                                            :setq-p ,setq-p
+                                           :parameters-setqd ,parameters-setqd
                                            :method-cell ,method-cell
                                            :closurep ,closurep
                                            :applyp ,applyp)
@@ -967,7 +968,7 @@
 
 (defmacro bind-simple-lexical-method-functions
     ((method-args next-methods (&key call-next-method-p next-method-p-p setq-p
-                                     closurep applyp method-cell))
+                                     parameters-setqd closurep applyp method-cell))
      &body body
      &environment env)
   (if (not (or call-next-method-p setq-p closurep next-method-p-p applyp))
@@ -1318,6 +1319,7 @@
     ((args rest-arg next-method-call (&key
                                       call-next-method-p
                                       setq-p
+                                      parameters-setqd
                                       method-cell
                                       next-method-p-p
                                       closurep
@@ -1491,23 +1493,6 @@
                     (setq next-method-p-p t)
                     form)
                    ((memq (car form) '(setq multiple-value-setq))
-                    ;; FIXME: this is possibly a little strong as
-                    ;; conditions go.  Ideally we would want to detect
-                    ;; which, if any, of the method parameters are
-                    ;; being set, and communicate that information to
-                    ;; e.g. SPLIT-DECLARATIONS.  However, the brute
-                    ;; force method doesn't really cost much; a little
-                    ;; loss of discrimination over IGNORED variables
-                    ;; should be all.  -- CSR, 2004-07-01
-                    ;;
-                    ;; As of 2006-09-18 modified parameter bindings
-                    ;; are now tracked with more granularity than just
-                    ;; one SETQ-P flag, in order to disable SLOT-VALUE
-                    ;; optimizations for parameters that are SETQd.
-                    ;; The old binary SETQ-P flag is still used for
-                    ;; all other purposes, since as noted above, the
-                    ;; extra cost is minimal. -- JES, 2006-09-18
-                    ;;
                     ;; The walker will split (SETQ A 1 B 2) to
                     ;; separate (SETQ A 1) and (SETQ B 2) forms, so we
                     ;; only need to handle the simple case of SETQ

Index: vector.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/pcl/vector.lisp,v
retrieving revision 1.69
retrieving revision 1.70
diff -u -d -r1.69 -r1.70
--- vector.lisp	15 Sep 2009 11:07:39 -0000	1.69
+++ vector.lisp	4 Sep 2010 08:01:30 -0000	1.70
@@ -550,7 +550,7 @@
         (declare ,(make-pv-type-declaration '.pv.))
         ,@forms)))
 
-(defun split-declarations (body args maybe-reads-params-p)
+(defun split-declarations (body args req-args cnm-p parameters-setqd)
   (let ((inner-decls nil)
         (outer-decls nil)
         decl)
@@ -579,7 +579,7 @@
                            ;; args when a next-method is involved, to
                            ;; prevent compiler warnings about ignored
                            ;; args being read.
-                           (unless (and (eq 'ignore name) maybe-reads-params-p)
+                           (unless (and (eq 'ignore name) (member var req-args :test #'eq) (or cnm-p (member var parameters-setqd)))
                              (push var outers))
                            (push var inners)))
                      (when outers
@@ -677,7 +677,7 @@
          (outer-parameters req-args)
          ;; The lambda-list used by BIND-ARGS
          (bind-list lambda-list)
-         (setq-p (getf (cdr lmf-params) :setq-p))
+         (parameters-setqd (getf (cdr lmf-params) :parameters-setqd))
          (auxp (member '&aux bind-list))
          (call-next-method-p (getf (cdr lmf-params) :call-next-method-p)))
     ;; Try to use the normal function call machinery instead of BIND-ARGS
@@ -702,7 +702,7 @@
             bind-list req-args))
     (multiple-value-bind (outer-decls inner-decls body-sans-decls)
         (split-declarations
-         body outer-parameters (or call-next-method-p setq-p))
+         body outer-parameters req-args call-next-method-p parameters-setqd)
       (let* ((rest-arg (when restp
                          '.rest-arg.))
              (fmf-lambda-list (if rest-arg