0.8.3.84:

        * fix bug reported by Nicodemus Siivola:
        ... FIND-RESULT-TYPE: ignore uses in deleted blocks/functions;
        ... DELETE-LAMBDA: work with :OPTIONAL;
        * DELETE-BLOCK: when deleting ENTRY, delete it from
          LAMBDA-ENTRIES and delete all its EXITs.
        * add DERIVE-TYPE optimizer for ISQRT (thanks to Robert
          E. Brown).

diff --git a/NEWS b/NEWS
index 6032c17..ff90fba 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -2073,6 +2073,7 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3:
   * incompatible change: ICR structure is changed; the value part of
     CONTINUATION is now called LVAR; corresponding functions are
     renamed (e.g. SB-C::CONTINUATION-TYPE has become SB-C::LVAR-TYPE).
+  * added type deriver for ISQRT (thanks to Robert E. Brown).
   * fixed some bugs revealed by Paul Dietz' test suite:
     ** the RETURN clause in LOOP is now equivalent to DO (RETURN ...).
     ** ROUND and FROUND now give the right answer when given very

diff --git a/src/code/numbers.lisp b/src/code/numbers.lisp
index 3632cd6..283cd4a 100644 (file)
--- a/src/code/numbers.lisp
+++ b/src/code/numbers.lisp
@@ -1365,7 +1365,6 @@
                        (declare (integer x))
                        (etypecase x
                          ((unsigned-byte ,width) x)
-                         (bignum-element-type (logand x ,pattern))
                          (fixnum (logand x ,pattern))
                          (bignum (logand (%bignum-ref x 0) ,pattern)))))
                 (,name ,@(loop for arg in lambda-list

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index cb198bd..618b3d7 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -446,21 +446,24 @@
   (let ((result (return-result node)))
     (collect ((use-union *empty-type* values-type-union))
       (do-uses (use result)
-       (cond ((and (basic-combination-p use)
-                   (eq (basic-combination-kind use) :local))
-              (aver (eq (lambda-tail-set (node-home-lambda use))
-                        (lambda-tail-set (combination-lambda use))))
-              (when (combination-p use)
-                (when (nth-value 1 (maybe-convert-tail-local-call use))
-                  (return-from find-result-type (values)))))
-             (t
-              (use-union (node-derived-type use)))))
+        (let ((use-home (node-home-lambda use)))
+          (cond ((or (eq (functional-kind use-home) :deleted)
+                     (block-delete-p (node-block use))))
+                ((and (basic-combination-p use)
+                      (eq (basic-combination-kind use) :local))
+                 (aver (eq (lambda-tail-set use-home)
+                           (lambda-tail-set (combination-lambda use))))
+                 (when (combination-p use)
+                   (when (nth-value 1 (maybe-convert-tail-local-call use))
+                     (return-from find-result-type (values)))))
+                (t
+                 (use-union (node-derived-type use))))))
       (let ((int
              ;; (values-type-intersection
              ;; (continuation-asserted-type result) ; FIXME -- APD, 2002-01-26
              (use-union)
               ;; )
-            ))
+              ))
        (setf (return-result-type node) int))))
   (values))
 

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 5ac3a6a..57caf17 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -774,7 +774,7 @@
 
 ;;; Deal with deleting the last reference to a CLAMBDA. It is called
 ;;; in two situations: when the lambda is unreachable (so that its
-;;; body mey be deleted), and when it is an effectless LET (in this
+;;; body may be deleted), and when it is an effectless LET (in this
 ;;; case its body is reachable and is not completely "its"). We set
 ;;; FUNCTIONAL-KIND to :DELETED and rely on IR1-OPTIMIZE to delete its
 ;;; blocks.
@@ -782,17 +782,18 @@
   (declare (type clambda clambda))
   (let ((original-kind (functional-kind clambda))
        (bind (lambda-bind clambda)))
-    (aver (not (member original-kind '(:deleted :optional :toplevel))))
+    (aver (not (member original-kind '(:deleted :toplevel))))
     (aver (not (functional-has-external-references-p clambda)))
     (setf (functional-kind clambda) :deleted)
     (setf (lambda-bind clambda) nil)
 
-    (when bind ; CLAMBDA is deleted due to unreachability
+    (when bind              ; CLAMBDA is deleted due to unreachability
       (labels ((delete-children (lambda)
                  (dolist (child (lambda-children lambda))
-                   (if (eq (functional-kind child) :deleted)
-                       (delete-children child)
-                       (delete-lambda child)))
+                   (cond ((eq (functional-kind child) :deleted)
+                          (delete-children child))
+                         (t
+                          (delete-lambda child))))
                  (setf (lambda-children lambda) nil)
                  (setf (lambda-parent lambda) nil)))
         (delete-children clambda)))
@@ -1005,7 +1006,7 @@
   (do-nodes-carefully (node block)
     (when (valued-node-p node)
       (delete-lvar-use node))
-    (typecase node
+    (etypecase node
       (ref (delete-ref node))
       (cif (flush-dest (if-test node)))
       ;; The next two cases serve to maintain the invariant that a LET
@@ -1038,6 +1039,11 @@
          (when entry
            (setf (entry-exits entry)
                  (delq node (entry-exits entry))))))
+      (entry
+       (dolist (exit (entry-exits node))
+         (mark-for-deletion (node-block exit)))
+       (let ((home (node-home-lambda node)))
+         (setf (lambda-entries home) (delq node (lambda-entries home)))))
       (creturn
        (flush-dest (return-result node))
        (delete-return node))

diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 1c1528e..5988f86 100644 (file)
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -926,6 +926,7 @@
   %source-name
   %debug-name
   #!+sb-show id
+  kind
   (type :test (not (eq type *universal-type*)))
   (where-from :test (not (eq where-from :assumed)))
   (vars :prin1 (mapcar #'leaf-source-name vars)))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index a403e28..bee1713 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2287,6 +2287,15 @@
             (setf min-len 0))
           (specifier-type `(integer ,(or min-len '*) ,(or max-len '*))))))))
 
+(defoptimizer (isqrt derive-type) ((x))
+  (let ((x-type (lvar-type x)))
+    (when (numeric-type-p x-type)
+      (let* ((lo (numeric-type-low x-type))
+             (hi (numeric-type-high x-type))
+             (lo-res (if lo (isqrt lo) '*))
+             (hi-res (if hi (isqrt hi) '*)))
+        (specifier-type `(integer ,lo-res ,hi-res))))))
+
 (defoptimizer (code-char derive-type) ((code))
   (specifier-type 'base-char))
 

diff --git a/tests/compiler.impure-cload.lisp b/tests/compiler.impure-cload.lisp
index 4f275bd..661c184 100644 (file)
--- a/tests/compiler.impure-cload.lisp
+++ b/tests/compiler.impure-cload.lisp
@@ -263,5 +263,28 @@
                  c)))
       (if (<= 11 c) (%f5) c))))
 
+;;; two bugs: "aggressive" deletion of optional entries and problems
+;;; of FIND-RESULT-TYPE in dealing with deleted code; reported by
+;;; Nikodemus Siivola (simplified version)
+(defun lisp-error-error-handler (condition)
+  (invoke-debugger condition)
+  (handler-bind ()
+    (unwind-protect
+         (with-simple-restart
+             (continue "return to hemlock's debug loop.")
+           (invoke-debugger condition))
+      (device))))
+
+;;;
+(defun foo ()
+  (labels ((foo (x)
+             (return-from foo x)
+             (block u
+               (labels ((bar (x &optional (y (return-from u)))
+                          (list x y (apply #'bar (fee)))))
+                 (list (bar 1) (bar 1 2))))
+             (1+ x)))
+    #'foo))
+
 \f
 (sb-ext:quit :unix-status 104)

diff --git a/version.lisp-expr b/version.lisp-expr
index af13694..1f20576 100644 (file)
--- 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.83"
+"0.8.3.84"