From: Alexey Dejneka <adejneka@comail.ru>
Date: Wed, 29 Jan 2003 11:29:12 +0000 (+0000)
Subject: 0.7.12.10:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=a74b0bdb483504f6faddf8089f848f61ed94b92a;p=sbcl.git

0.7.12.10:
        * Definitions of dependent optimizations qualities are grouped
          in src/compiler/policies.lisp;
        * new dependent optimization policy: MERGE-TAIL-CALLS;
        ... which is used in XEPs.
---

diff --git a/build-order.lisp-expr b/build-order.lisp-expr
index f36fad8..f24b03a 100644
--- a/build-order.lisp-expr
+++ b/build-order.lisp-expr
@@ -279,6 +279,7 @@
 
  ("src/compiler/early-c")
  ("src/compiler/policy")
+ ("src/compiler/policies")
  ("src/code/typedefs")
 
  ;; ("src/code/defbangmacro" was here until sbcl-0.6.7.3.)
diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp
index 5b44d18..3ee6da7 100644
--- a/src/compiler/checkgen.lisp
+++ b/src/compiler/checkgen.lisp
@@ -116,18 +116,6 @@
 
 ;;;; checking strategy determination
 
-(define-optimization-quality type-check
-    (cond ((= safety 0) 0)
-          ;; FIXME: It is duplicated in PROBABLE-TYPE-CHECK-P and in
-          ;; some other places.
-
-          ((and (<= speed safety)
-                (<= space safety)
-                (<= compilation-speed safety))
-           3)
-          (t 2))
-  ("no" "maybe" "fast" "full"))
-
 ;;; Return the type we should test for when we really want to check
 ;;; for TYPE. If type checking policy is "fast", then we return a
 ;;; weaker type if it is easier to check. First we try the defined
diff --git a/src/compiler/dfo.lisp b/src/compiler/dfo.lisp
index 65134b1..291a1cb 100644
--- a/src/compiler/dfo.lisp
+++ b/src/compiler/dfo.lisp
@@ -59,7 +59,7 @@
       (unless (eq old-next old-tail)
 	(setf (block-next head) old-next)
 	(setf (block-prev old-next) head)
-	
+
 	(setf (block-prev next) old-last)
 	(setf (block-next old-last) next))
 
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index e6609c7..2a7f9a1 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1340,7 +1340,7 @@
 ;;; -- either continuation has a funky TYPE-CHECK annotation.
 ;;; -- the continuations have incompatible assertions, so the new asserted type
 ;;;    would be NIL.
-;;; -- the var's DEST has a different policy than the ARG's (think safety).
+;;; -- the VAR's DEST has a different policy than the ARG's (think safety).
 ;;;
 ;;; We change the REF to be a reference to NIL with unused value, and
 ;;; let it be flushed as dead code. A side effect of this substitution
@@ -1354,7 +1354,7 @@
 	 (dest (continuation-dest cont)))
     (when (and (eq (continuation-use cont) ref)
 	       dest
-	       (not (typep dest '(or creturn exit mv-combination)))
+	       (continuation-single-value-p cont)
 	       (eq (node-home-lambda ref)
 		   (lambda-home (lambda-var-home var)))
 	       (member (continuation-type-check arg) '(t nil))
@@ -1455,9 +1455,9 @@
 ;;; If the function has an XEP, then we don't do anything, since we
 ;;; won't discover anything.
 ;;;
-;;; We can clear the Continuation-Reoptimize flags for arguments in
-;;; all calls corresponding to changed arguments in Call, since the
-;;; only use in IR1 optimization of the Reoptimize flag for local call
+;;; We can clear the CONTINUATION-REOPTIMIZE flags for arguments in
+;;; all calls corresponding to changed arguments in CALL, since the
+;;; only use in IR1 optimization of the REOPTIMIZE flag for local call
 ;;; args is right here.
 (defun propagate-local-call-args (call fun)
   (declare (type combination call) (type clambda fun))
@@ -1713,6 +1713,8 @@
 ;;; CONVERT-MV-BIND-TO-LET. We grab the args of LIST and make them
 ;;; args of the VALUES-LIST call, flushing the old argument
 ;;; continuation (allowing the LIST to be flushed.)
+;;;
+;;; FIXME: Thus we lose possible type assertions on (LIST ...).
 (defoptimizer (values-list optimizer) ((list) node)
   (let ((use (continuation-use list)))
     (when (and (combination-p use)
@@ -1734,8 +1736,7 @@
 ;;; to a PROG1. This allows the computation of the additional values
 ;;; to become dead code.
 (deftransform values ((&rest vals) * * :node node)
-  (when (typep (continuation-dest (node-cont node))
-	       '(or creturn exit mv-combination))
+  (unless (continuation-single-value-p (node-cont node))
     (give-up-ir1-transform))
   (setf (node-derived-type node) *wild-type*)
   (if vals
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 4988282..683bca8 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -382,6 +382,11 @@
 (defun continuation-home-lambda (cont)
   (the clambda
     (continuation-home-lambda-or-null cont)))
+
+#!-sb-fluid (declaim (inline continuation-single-value-p))
+(defun continuation-single-value-p (cont)
+  (not (typep (continuation-dest cont)
+              '(or creturn exit mv-combination))))
 
 ;;; Return a new LEXENV just like DEFAULT except for the specified
 ;;; slot values. Values for the alist slots are NCONCed to the
@@ -1506,8 +1511,3 @@
 
   (let ((action (event-info-action info)))
     (when action (funcall action node))))
-
-;;; It should be in locall.lisp, but is used before in ir1opt.lisp.
-(define-optimization-quality verify-arg-count
-    (if (zerop safety) 0 3)
-  ("no" "maybe" "yes" "yes"))
diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index a2abf54..0257739 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -138,7 +138,7 @@
 	       `(declare (ignore ,n-supplied))
 	       `(%verify-arg-count ,n-supplied ,nargs))
 	  (locally
-	    (declare (optimize (let-convertion 3)))
+	    (declare (optimize (merge-tail-calls 3)))
 	    (%funcall ,fun ,@temps)))))
     (optional-dispatch
      (let* ((min (optional-dispatch-min-args fun))
@@ -166,11 +166,7 @@
 		       `(multiple-value-bind (,n-context ,n-count)
 			    (%more-arg-context ,n-supplied ,max)
 			  (locally
-			    ;; KLUDGE: As above, we're trying to
-			    ;; enable tail recursion optimization and
-			    ;; any other effects of this declaration
-			    ;; are accidental. -- WHN 2002-07-08
-			    (declare (optimize (speed 2) (debug 1)))
+			    (declare (optimize (merge-tail-calls 3)))
 			    (%funcall ,more ,@temps ,n-context ,n-count)))))))
 	     (t
 	      (%arg-count-error ,n-supplied)))))))))
@@ -982,9 +978,6 @@
 
 ;;; Are there any declarations in force to say CLAMBDA shouldn't be
 ;;; LET converted?
-(define-optimization-quality let-convertion
-    (if (<= debug speed) 3 0)
-  ("off" "maybe" "on" "on"))
 (defun declarations-suppress-let-conversion-p (clambda)
   ;; From the user's point of view, LET-converting something that
   ;; has a name is inlining it. (The user can't see what we're doing
diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 3423c37..7d1cc76 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -37,7 +37,7 @@
   ;;	until it is assigned a block, and may be also be temporarily
   ;;	unused during later manipulations of IR1. In a consistent
   ;;	state there should never be any mention of :UNUSED
-  ;;	continuations. Next can have a non-null value if the next node
+  ;;	continuations. NEXT can have a non-null value if the next node
   ;;	has already been determined.
   ;;
   ;; :DELETED
@@ -87,7 +87,7 @@
   ;; the node where this continuation is used, if unique. This is always
   ;; null in :DELETED and :UNUSED continuations, and is never null in
   ;; :INSIDE-BLOCK continuations. In a :BLOCK-START continuation, the
-  ;; Block's START-USES indicate whether NIL means no uses or more
+  ;; BLOCK's START-USES indicate whether NIL means no uses or more
   ;; than one use.
   (use nil :type (or node null))
   ;; the basic block this continuation is in. This is null only in
diff --git a/src/compiler/physenvanal.lisp b/src/compiler/physenvanal.lisp
index 2ded900..8b4bb25 100644
--- a/src/compiler/physenvanal.lisp
+++ b/src/compiler/physenvanal.lisp
@@ -419,9 +419,7 @@
       (when ret
 	(let ((result (return-result ret)))
 	  (do-uses (use result)
-	    (when (and (policy use
-			       (or (> space debug)
-				   (> speed debug)))
+	    (when (and (policy use merge-tail-calls)
 		       (immediately-used-p result use)
 		       (or (not (eq (node-derived-type use) *empty-type*))
 			   (not (basic-combination-p use))
diff --git a/src/compiler/policy.lisp b/src/compiler/policy.lisp
index 3402be1..ff543cc 100644
--- a/src/compiler/policy.lisp
+++ b/src/compiler/policy.lisp
@@ -123,4 +123,3 @@
            (setf (cdr acons) item)
            (push `(,',name . ,item) *policy-dependent-qualities*)))
      ',name))
-
diff --git a/version.lisp-expr b/version.lisp-expr
index 1f6a5bc..41c4969 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -18,4 +18,4 @@
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
 
-"0.7.12.9"
+"0.7.12.10"