Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv19582
Modified Files: compiler.lisp Log Message: Fixed a nasty compiler bug that would let two function parameters be assigned to the same register. By some weird accident this bug didn't seem to do much actual harm, but the potential was certainly there.
Date: Fri Apr 16 15:20:46 2004 Author: ffjeld
Index: movitz/compiler.lisp diff -u movitz/compiler.lisp:1.48 movitz/compiler.lisp:1.49 --- movitz/compiler.lisp:1.48 Thu Apr 15 15:58:20 2004 +++ movitz/compiler.lisp Fri Apr 16 15:20:46 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.48 2004/04/15 19:58:20 ffjeld Exp $ +;;;; $Id: compiler.lisp,v 1.49 2004/04/16 19:20:46 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -2451,11 +2451,13 @@ (destructuring-bind (binding &key init-with-register init-with-type protect-registers protect-carry) (cdr i) - (declare (ignore binding protect-carry init-with-type)) + (declare (ignore protect-carry init-with-type)) (when init-with-register (setf free-so-far (remove-if (lambda (x) - (or (eq x init-with-register) - (member x protect-registers))) + (if (new-binding-located-p binding frame-map) + (eq x (new-binding-location binding frame-map)) + (or (eq x init-with-register) + (member x protect-registers)))) free-so-far))))) (t (case (instruction-is i) ((nil :call) @@ -2476,8 +2478,7 @@ (remove-if (lambda (r) (tree-search i r)) free-so-far))) - ((:load-constant :load-lexical :store-lexical :init-lexvar - :cons-get :endp :incf-lexvar) + ((:load-constant :load-lexical :store-lexical :cons-get :endp :incf-lexvar :init-lexvar) (assert (gethash (instruction-is i) *extended-code-expanders*)) (unless (can-expand-extended-p i frame-map) (return (values nil t))) @@ -3764,6 +3765,9 @@ (and (edx-var env) (new-binding-location (edx-var env) frame-map :default nil)))) ;; (warn "l0: ~S, l1: ~S" location-0 location-1) + (assert (not (and location-0 + (eql location-0 location-1))) () + "Compiler bug: two bindings in same location.") (cond ((and (eq :ebx location-0) (eq :eax location-1)) `((:xchgl :eax :ebx)))