Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv4591
Modified Files: compiler.lisp Log Message: Fix detection of unused variables.
Date: Wed Nov 24 11:02:43 2004 Author: ffjeld
Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.116 movitz/compiler.lisp:1.117 --- movitz/compiler.lisp:1.116 Tue Nov 23 17:10:17 2004 +++ movitz/compiler.lisp Wed Nov 24 11:02:42 2004 @@ -8,7 +8,7 @@ ;;;; Created at: Wed Oct 25 12:30:49 2000 ;;;; Distribution: See the accompanying file COPYING. ;;;; -;;;; $Id: compiler.lisp,v 1.116 2004/11/23 16:10:17 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.117 2004/11/24 10:02:42 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -2772,7 +2772,7 @@ This function is factored out from assign-bindings." (let* ((count-init-pc (gethash binding var-counts)) (count (car count-init-pc)) - (init-pc (cdr count-init-pc))) + (init-pc (second count-init-pc))) ;; (warn "b ~S: count: ~D, init-pc: ~{~&~A~}" binding count init-pc) (cond ((binding-lended-p binding) @@ -2845,13 +2845,20 @@ (check-type function-env function-env) ;; (print-code 'discover code) (let ((var-counter (make-hash-table :test #'eq :size 40))) - (labels ((take-note-of-binding (binding &optional storep init-pc) + (labels ((record-binding-used (binding) (let ((count-init-pc (or (gethash binding var-counter) (setf (gethash binding var-counter) - (cons 0 nil))))) + (list 0 nil t))))) + (setf (third count-init-pc) t) + (when (typep binding 'forwarding-binding) + (record-binding-used (forwarding-binding-target binding))))) + (take-note-of-binding (binding &optional storep init-pc) + (let ((count-init-pc (or (gethash binding var-counter) + (setf (gethash binding var-counter) + (list 0 nil t))))) (when init-pc - (assert (not (cdr count-init-pc))) - (setf (cdr count-init-pc) init-pc)) + (assert (not (second count-init-pc))) + (setf (second count-init-pc) init-pc)) (unless storep (unless (eq binding (binding-target binding)) ;; (break "ewfew: ~S" (gethash (binding-target binding) var-counter)) @@ -2902,6 +2909,8 @@ (take-note-of-binding init-with-register))))) (t (mapcar #'take-note-of-binding (find-read-bindings instruction)) + (mapcar #'record-binding-used ; This is just concerning "unused variable" + (find-used-bindings instruction)) ; warnings! (let ((store-binding (find-written-binding-and-type instruction))) (when store-binding (take-note-of-binding store-binding t))) @@ -2953,13 +2962,13 @@ (prog1 nil ; may need lending-cons (setf (new-binding-location binding frame-map) `(:argument-stack ,(function-argument-argnum binding))))) - ((not (plusp (or (car (gethash binding var-counts)) 0))) - (prog1 t - (unless (or (movitz-env-get variable 'ignore nil env nil) - (movitz-env-get variable 'ignorable nil env nil) - (typep binding 'hidden-rest-function-argument)) - (warn "Unused variable: ~S" - (binding-name binding)))))) + ((unless (or (movitz-env-get variable 'ignore nil env nil) + (movitz-env-get variable 'ignorable nil env nil) + (typep binding 'hidden-rest-function-argument) + (third (gethash binding var-counts))) + (warn "Unused variable: ~S" + (binding-name binding)))) + ((not (plusp (or (car (gethash binding var-counts)) 0))))) collect binding)) (bindings-fun-arg-sorted (when (eq env function-env) @@ -2987,7 +2996,7 @@ (located-binding (let* ((count-init (gethash b var-counts)) (count (car count-init)) - (init-pc (cdr count-init))) + (init-pc (second count-init))) (if (not (and count init-pc)) 50 (truncate @@ -5924,6 +5933,9 @@ (defvar *extended-code-find-read-binding* (make-hash-table :test #'eq))
+(defvar *extended-code-find-used-bindings* + (make-hash-table :test #'eq)) + (defmacro define-find-read-bindings (name lambda-list &body body) (let ((defun-name (intern (with-standard-io-syntax @@ -5935,6 +5947,28 @@ (cdr instruction) ,@body)))))
+(defmacro define-find-used-bindings (name lambda-list &body body) + (let ((defun-name (intern + (with-standard-io-syntax + (format nil "~A-~A" 'find-used-bindings name))))) + `(progn + (setf (gethash ',name *extended-code-find-used-bindings*) ',defun-name) + (defun ,defun-name (instruction) + (destructuring-bind ,lambda-list + (cdr instruction) + ,@body))))) + +(defun find-used-bindings (extended-instruction) + "Return zero, one or two bindings that this instruction reads." + (when (listp extended-instruction) + (let* ((operator (car extended-instruction)) + (finder (or (gethash operator *extended-code-find-used-bindings*) + (gethash operator *extended-code-find-read-binding*)))) + (when finder + (let ((result (funcall finder extended-instruction))) + (check-type result list "a list of read bindings") + result))))) + (defun find-read-bindings (extended-instruction) "Return zero, one or two bindings that this instruction reads." (when (listp extended-instruction) @@ -6417,6 +6451,11 @@ x)) (list term0 term1) )))) + +(define-find-used-bindings :add (term0 term1 destination) + (if (bindingp destination) + (list term0 term1 destination) + (list term0 term1)))
(define-find-read-bindings :add (term0 term1 destination) (declare (ignore destination))