From 0223a229f6fd1b4cfc809e30e35361df99fb2340 Mon Sep 17 00:00:00 2001 From: Richard M Kreuter Date: Fri, 26 Dec 2008 14:19:06 +0000 Subject: [PATCH] 1.0.23.68: Cleanups in constraint propagation. * Three changes here: (1) Have the conset's min slot always be a fixnum. The min and max slots should now conform to CL sequence bounding index idioms. (2) Update the extrema in parallel, rather than in sequence, in the conset-union, -intersection, -difference. (3) Remove some noise from conset-intersection that probably included an off-by-one error. * Fixes a bug reported by Tobias C. Rittweiler on sbcl-devel. --- src/compiler/constraint.lisp | 82 ++++++++++++++++++------------------------ version.lisp-expr | 2 +- 2 files changed, 36 insertions(+), 48 deletions(-) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 4199027..ba008cd 100644 --- a/src/compiler/constraint.lisp +++ b/src/compiler/constraint.lisp @@ -149,10 +149,8 @@ :type simple-bit-vector) ;; Bit-vectors win over lightweight hashes for copy, union, ;; intersection, difference, but lose for iteration if you iterate - ;; over the whole vector. Tracking extrema helps a bit. Note - ;; that the CONSET-MIN is NIL when the set is known to be empty. - ;; CONSET-MAX is a normal end bounding index. - (min nil :type (or fixnum null)) + ;; over the whole vector. Tracking extrema helps a bit. + (min 0 :type fixnum) (max 0 :type fixnum)) (defmacro do-conset-elements ((constraint conset &optional result) &body body) @@ -169,7 +167,7 @@ (declare (ignore ,ignore)) (aver (<= ,end ,constraint-universe-end))))) `(let* ((,vector (conset-vector ,conset)) - (,start (or (conset-min ,conset) 0)) + (,start (conset-min ,conset)) (,end (min (conset-max ,conset) (length ,vector)))) (,@with-array-data (do ((,index ,start (1+ ,index))) ((>= ,index ,end) ,result) @@ -186,7 +184,7 @@ ,@body))) (defun conset-empty (conset) - (or (null (conset-min conset)) + (or (= (conset-min conset) (conset-max conset)) ;; TODO: I bet FIND on bit-vectors can be optimized, if it ;; isn't. (not (find 1 (conset-vector conset) @@ -233,8 +231,7 @@ (let ((number (%constraint-number constraint))) (conset-grow conset (1+ number)) (setf (sbit (conset-vector conset) number) 1) - (setf (conset-min conset) (min number (or (conset-min conset) - most-positive-fixnum))) + (setf (conset-min conset) (min number (conset-min conset))) (when (>= number (conset-max conset)) (setf (conset-max conset) (1+ number)))))) @@ -273,41 +270,26 @@ (declare (simple-bit-vector vector1 vector2)) (setf (conset-vector conset-1) (,bit-op vector1 vector2 t)) ;; Update the extrema. - (setf (conset-min conset-1) - ,(ecase name - ((conset-union) - `(min (or (conset-min conset-1) - most-positive-fixnum) - (or (conset-min conset-2) - most-positive-fixnum))) - ((conset-intersection) - `(let ((start (max (or (conset-min conset-1) 0) - (or (conset-min conset-2) 0))) - (end (min (conset-max conset-1) - (conset-max conset-1)))) + ,(ecase name + ((conset-union) + `(setf (conset-min conset-1) + (min (conset-min conset-1) + (conset-min conset-2)) + (conset-max conset-1) + (max (conset-max conset-1) + (conset-max conset-2)))) + ((conset-intersection) + `(let ((start (max (conset-min conset-1) + (conset-min conset-2))) + (end (min (conset-max conset-1) + (conset-max conset-2)))) + (setf (conset-min conset-1) (if (> start end) - nil - (position 1 (conset-vector conset-1) - :start start :end end)))) - ((conset-difference) - `(position 1 (conset-vector conset-1) - :start (or (conset-min conset-1) 0) - :end (conset-max conset-1) - ))) - (conset-max conset-1) - ,(ecase name - ((conset-union) - `(max (conset-max conset-1) - (conset-max conset-2))) - ((conset-intersection) - `(let ((start (max (or (conset-min conset-1) 0) - (or (conset-min conset-2) 0))) - (end (let ((minimum-maximum - (min (conset-max conset-1) - (conset-max conset-2)))) - (if (plusp minimum-maximum) - (1- minimum-maximum) - 0)))) + 0 + (or (position 1 (conset-vector conset-1) + :start start :end end) + 0)) + (conset-max conset-1) (if (> start end) 0 (let ((position @@ -316,12 +298,18 @@ :start start :end end :from-end t))) (if position (1+ position) - 0))))) - ((conset-difference) - `(let ((position + 0)))))) + ((conset-difference) + `(setf (conset-min conset-1) + (or (position 1 (conset-vector conset-1) + :start (conset-min conset-1) + :end (conset-max conset-1)) + 0) + (conset-max conset-1) + (let ((position (position 1 (conset-vector conset-1) - :start (or (conset-min conset-1) 0) + :start (conset-min conset-1) :end (conset-max conset-1) :from-end t))) (if position @@ -878,7 +866,7 @@ (frob let))))) ;;; Return the constraints that flow from PRED to SUCC. This is -;;; BLOCK-OUT unless PRED ends with and IF and test constraints were +;;; BLOCK-OUT unless PRED ends with an IF and test constraints were ;;; added. (defun block-out-for-successor (pred succ) (declare (type cblock pred succ)) diff --git a/version.lisp-expr b/version.lisp-expr index b8c9908..d8008a5 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.23.67" +"1.0.23.68" -- 1.7.10.4