From: Alexey Dejneka Date: Wed, 17 Sep 2003 17:11:46 +0000 (+0000) Subject: 0.8.3.74: X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=227096b878fee7afae9d3bc2cee5df01449bca2d;p=sbcl.git 0.8.3.74: * Change transformers for />=/<= to work with unions of intervals; * CONSTRAIN-REF-TYPE: ignore constraints of form (EQL val ). --- diff --git a/BUGS b/BUGS index 3319a10..788da3e 100644 --- a/BUGS +++ b/BUGS @@ -1257,13 +1257,4 @@ WORKAROUND: have made. 292: - (COMPILE NIL - `(LAMBDA (C) - (DECLARE (TYPE (INTEGER -5945502333 12668542) C) - (OPTIMIZE (SPEED 3))) - (LET ((V2 (* C 12))) - (- (MAX (IF (/= 109335113 V2) -26479 V2) - (DEPOSIT-FIELD 311 - (BYTE 14 28) - (MIN (MAX 521326 C) -51))))))) - causes compiler failure (reported by Paul Dietz). + (fixed in 0.8.3.74) diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp index 1037b72..8844aeb 100644 --- a/src/compiler/constraint.lisp +++ b/src/compiler/constraint.lisp @@ -354,7 +354,8 @@ (setq not-res (type-union not-res other-type))) (let ((leaf-type (leaf-type leaf))) (when (or (constant-p other) - (and (csubtypep other-type leaf-type) + (and (leaf-refs other) ; protect from deleted vars + (csubtypep other-type leaf-type) (not (type= other-type leaf-type)))) (change-ref-leaf ref other) (when (constant-p other) (return))))))) diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 0482f1b..cd22846 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -243,7 +243,8 @@ (defun make-interval (&key low high) (labels ((normalize-bound (val) - (cond ((and (floatp val) + (cond #-sb-xc-host + ((and (floatp val) (float-infinity-p val)) ;; Handle infinities. nil) @@ -304,6 +305,23 @@ (make-interval :low (numeric-type-low x) :high (numeric-type-high x))) +(defun type-approximate-interval (type) + (declare (type ctype type)) + (let ((types (prepare-arg-for-derive-type type)) + (result nil)) + (dolist (type types) + (let ((type (if (member-type-p type) + (convert-member-type type) + type))) + (unless (numeric-type-p type) + (return-from type-approximate-interval nil)) + (let ((interval (numeric-type->interval type))) + (setq result + (if result + (interval-approximate-union result interval) + interval))))) + result)) + (defun copy-interval-limit (limit) (if (numberp limit) limit @@ -535,6 +553,16 @@ (make-interval :low (select-bound x-lo y-lo #'< #'>) :high (select-bound x-hi y-hi #'> #'<)))))) +;;; return the minimal interval, containing X and Y +(defun interval-approximate-union (x y) + (cond ((interval-merge-pair x y)) + ((interval-< x y) + (make-interval :low (copy-interval-limit (interval-low x)) + :high (copy-interval-limit (interval-high y)))) + (t + (make-interval :low (copy-interval-limit (interval-low y)) + :high (copy-interval-limit (interval-high x)))))) + ;;; basic arithmetic operations on intervals. We probably should do ;;; true interval arithmetic here, but it's complicated because we ;;; have float and integer types and bounds can be open or closed. @@ -2945,65 +2973,35 @@ ;;; information. If X's high bound is < Y's low, then X < Y. ;;; Similarly, if X's low is >= to Y's high, the X >= Y (so return ;;; NIL). If not, at least make sure any constant arg is second. -;;; -;;; FIXME: Why should constant argument be second? It would be nice to -;;; find out and explain. -#+sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.) -(defun ir1-transform-< (x y first second inverse) - (if (same-leaf-ref-p x y) - nil - (let* ((x-type (numeric-type-or-lose x)) - (x-lo (numeric-type-low x-type)) - (x-hi (numeric-type-high x-type)) - (y-type (numeric-type-or-lose y)) - (y-lo (numeric-type-low y-type)) - (y-hi (numeric-type-high y-type))) - (cond ((and x-hi y-lo (< x-hi y-lo)) - t) - ((and y-hi x-lo (>= x-lo y-hi)) - nil) - ((and (constant-lvar-p first) - (not (constant-lvar-p second))) - `(,inverse y x)) - (t - (give-up-ir1-transform)))))) -#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.) -(defun ir1-transform-< (x y first second inverse) - (if (same-leaf-ref-p x y) - nil - (let ((xi (numeric-type->interval (numeric-type-or-lose x))) - (yi (numeric-type->interval (numeric-type-or-lose y)))) - (cond ((interval-< xi yi) - t) - ((interval->= xi yi) - nil) - ((and (constant-lvar-p first) - (not (constant-lvar-p second))) - `(,inverse y x)) - (t - (give-up-ir1-transform)))))) - -(deftransform < ((x y) (integer integer) *) - (ir1-transform-< x y x y '>)) - -(deftransform > ((x y) (integer integer) *) - (ir1-transform-< y x x y '<)) - -#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.) -(deftransform < ((x y) (float float) *) - (ir1-transform-< x y x y '>)) - -#-sb-xc-host ; (See CROSS-FLOAT-INFINITY-KLUDGE.) -(deftransform > ((x y) (float float) *) - (ir1-transform-< y x x y '<)) +(macrolet ((def (name reflexive-p surely-true surely-false) + `(deftransform ,name ((x y)) + (if (same-leaf-ref-p x y) + ,reflexive-p + (let ((x (or (type-approximate-interval (lvar-type x)) + (give-up-ir1-transform))) + (y (or (type-approximate-interval (lvar-type y)) + (give-up-ir1-transform)))) + (cond (,surely-true + t) + (,surely-false + nil) + ((and (constant-lvar-p x) + (not (constant-lvar-p y))) + `(,',name y x)) + (t + (give-up-ir1-transform)))))))) + (def < nil (interval-< x y) (interval->= x y)) + (def > nil (interval-< y x) (interval->= y x)) + (def <= t (interval->= y x) (interval-< y x)) + (def >= t (interval->= x y) (interval-< x y))) (defun ir1-transform-char< (x y first second inverse) (cond ((same-leaf-ref-p x y) nil) ;; If we had interval representation of character types, as we ;; might eventually have to to support 2^21 characters, then here - ;; we could do some compile-time computation as in IR1-TRANSFORM-< - ;; above. -- CSR, 2003-07-01 + ;; we could do some compile-time computation as in transforms for + ;; < above. -- CSR, 2003-07-01 ((and (constant-lvar-p first) (not (constant-lvar-p second))) `(,inverse y x)) diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp index 4c14ce6..194a4c6 100644 --- a/tests/compiler.impure-cload.lisp +++ b/tests/compiler.impure-cload.lisp @@ -234,5 +234,22 @@ (MIN A (RETURN-FROM B8 C)))))) C)) +;;; bug 292, reported by Paul Dietz +(defun #:foo (C) + (DECLARE (TYPE (INTEGER -5945502333 12668542) C) + (OPTIMIZE (SPEED 3))) + (LET ((V2 (* C 12))) + (- (MAX (IF (/= 109335113 V2) -26479 V2) + (DEPOSIT-FIELD 311 + (BYTE 14 28) + (MIN (MAX 521326 C) -51)))))) + +;;; zombie variables, arising from constraints +(defun #:foo (A B) + (DECLARE (TYPE (INTEGER -40945116 24028306) B) + (OPTIMIZE (SPEED 3))) + (LET ((V5 (MIN 31883 (LOGCOUNT A)))) + (IF (/= B V5) (IF (EQL 122911784 V5) -43765 1487) B))) + (sb-ext:quit :unix-status 104) diff --git a/version.lisp-expr b/version.lisp-expr index 30555b3..169ad62 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".) -"0.8.3.73" +"0.8.3.74"