X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=e666b87d70b4c1414ca06d7a85f9c5625d88c24c;hb=436b2ab0276f547e8537b6c1fb52b11fa1f53975;hp=16accff9e535c3f8e03fccaf71884d8e1c3d8ae6;hpb=b198954cf7fd7750bfbba91b94b660f2ad891101;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 16accff..e666b87 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -529,7 +529,7 @@
                  :high (copy-interval-limit (interval-high x))))
 
 ;;; Given a point P contained in the interval X, split X into two
-;;; interval at the point P. If CLOSE-LOWER is T, then the left
+;;; intervals at the point P. If CLOSE-LOWER is T, then the left
 ;;; interval contains P. If CLOSE-UPPER is T, the right interval
 ;;; contains P. You can specify both to be T or NIL.
 (defun interval-split (p x &optional close-lower close-upper)
@@ -976,7 +976,7 @@
 
 ;;; a utility for defining derive-type methods of integer operations. If
 ;;; the types of both X and Y are integer types, then we compute a new
-;;; integer type with bounds determined Fun when applied to X and Y.
+;;; integer type with bounds determined by FUN when applied to X and Y.
 ;;; Otherwise, we use NUMERIC-CONTAGION.
 (defun derive-integer-type-aux (x y fun)
   (declare (type function fun))
@@ -2326,7 +2326,7 @@
   (if (and divisor-low divisor-high)
       ;; We know the range of the divisor, and the remainder must be
       ;; smaller than the divisor. We can tell the sign of the
-      ;; remainer if we know the sign of the number.
+      ;; remainder if we know the sign of the number.
       (let ((divisor-max (1- (max (abs divisor-low) (abs divisor-high)))))
         `(integer ,(if (or (null number-low)
                            (minusp number-low))
@@ -2337,7 +2337,7 @@
                        divisor-max
                        0)))
       ;; The divisor is potentially either very positive or very
-      ;; negative. Therefore, the remainer is unbounded, but we might
+      ;; negative. Therefore, the remainder is unbounded, but we might
       ;; be able to tell something about the sign from the number.
       `(integer ,(if (and number-low (not (minusp number-low)))
                      ;; The number we are dividing is positive.
@@ -3043,6 +3043,19 @@
                (reoptimize-component (node-component node) :maybe))
              (cut-node (node &aux did-something)
                (when (and (not (block-delete-p (node-block node)))
+                          (ref-p node)
+                          (constant-p (ref-leaf node)))
+                 (let* ((constant-value (constant-value (ref-leaf node)))
+                        (new-value (if signedp
+                                       (mask-signed-field width constant-value)
+                                       (ldb (byte width 0) constant-value))))
+                   (unless (= constant-value new-value)
+                     (change-ref-leaf node (make-constant new-value))
+                     (setf (lvar-%derived-type (node-lvar node)) (make-values-type :required (list (ctype-of new-value))))
+                     (setf (block-reoptimize (node-block node)) t)
+                     (reoptimize-component (node-component node) :maybe)
+                     (return-from cut-node t))))
+               (when (and (not (block-delete-p (node-block node)))
                           (combination-p node)
                           (eq (basic-combination-kind node) :known))
                  (let* ((fun-ref (lvar-use (combination-fun node)))
@@ -3117,9 +3130,23 @@
                 (best-modular-version width nil)
               (when w
                 ;; FIXME: This should be (CUT-TO-WIDTH NODE KIND WIDTH SIGNEDP).
-                (cut-to-width x kind width signedp)
-                (cut-to-width y kind width signedp)
-                nil ; After fixing above, replace with T.
+                ;;
+                ;; FIXME: I think the FIXME (which is from APD) above
+                ;; implies that CUT-TO-WIDTH should do /everything/
+                ;; that's required, including reoptimizing things
+                ;; itself that it knows are necessary.  At the moment,
+                ;; CUT-TO-WIDTH sets up some new calls with
+                ;; combination-type :FULL, which later get noticed as
+                ;; known functions and properly converted.
+                ;;
+                ;; We cut to W not WIDTH if SIGNEDP is true, because
+                ;; signed constant replacement needs to know which bit
+                ;; in the field is the signed bit.
+                (let ((xact (cut-to-width x kind (if signedp w width) signedp))
+                      (yact (cut-to-width y kind (if signedp w width) signedp)))
+                  (declare (ignore xact yact))
+                  nil) ; After fixing above, replace with T, meaning
+                       ; "don't reoptimize this (LOGAND) node any more".
                 ))))))))
 
 (defoptimizer (mask-signed-field optimizer) ((width x) node)
@@ -3132,8 +3159,9 @@
             (multiple-value-bind (w kind)
                 (best-modular-version width t)
               (when w
-                ;; FIXME: This should be (CUT-TO-WIDTH NODE KIND WIDTH T).
-                (cut-to-width x kind width t)
+                ;; FIXME: This should be (CUT-TO-WIDTH NODE KIND W T).
+                ;; [ see comment above in LOGAND optimizer ]
+                (cut-to-width x kind w t)
                 nil ; After fixing above, replace with T.
                 ))))))))
 
@@ -3844,7 +3872,7 @@
 (define-source-transform > (&rest args) (multi-compare '> args nil 'real))
 ;;; We cannot do the inversion for >= and <= here, since both
 ;;;   (< NaN X) and (> NaN X)
-;;; are false, and we don't have type-inforation available yet. The
+;;; are false, and we don't have type-information available yet. The
 ;;; deftransforms for two-argument versions of >= and <= takes care of
 ;;; the inversion to > and < when possible.
 (define-source-transform <= (&rest args) (multi-compare '<= args nil 'real))