From d6cacf136631916da0db8bbe32554ca499e17589 Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Sun, 17 Aug 2003 17:17:06 +0000 Subject: [PATCH] 0.8.2.38: * Try to fix bug 267 = optimization issue #7: inside NAMED-LAMBDA replace references to a function with the same name with self-references; * ASSERT-GLOBAL-FUNCTION-DEFINITION-TYPE: do not put type assertions for functions with EXPLICIT-CHECK attribute; ... FLOAT-RADIX does not perform explicit check; * implement cross-compiler versions of %DPB and %WITH-ARRAY-DATA. --- BUGS | 10 ---------- OPTIMIZATIONS | 17 +++-------------- src/code/cross-misc.lisp | 7 +++++++ src/compiler/ctype.lisp | 11 ++++++++--- src/compiler/fndb.lisp | 2 +- src/compiler/ir1tran-lambda.lisp | 7 ++++++- version.lisp-expr | 2 +- 7 files changed, 26 insertions(+), 30 deletions(-) diff --git a/BUGS b/BUGS index d964818..4582384 100644 --- a/BUGS +++ b/BUGS @@ -1033,16 +1033,6 @@ WORKAROUND: be nice to understand why the first patch caused problems, and to fix the cause if possible. -267: - In - (defun fact (x i) - (if (= x 0) - i - (fact (1- x) (* x i)))) - sbcl does not convert the self-recursive call to a jump, though it - is allowed to by CLHS 3.2.2.3. CMUCL, however, does perform this - optimization. - 268: "wrong free declaration scope" The following code must signal type error: diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS index 2806884..3b6ebe1 100644 --- a/OPTIMIZATIONS +++ b/OPTIMIZATIONS @@ -90,25 +90,14 @@ VOP DATA-VECTOR-SET/SIMPLE-STRING V2!14[EDI] t32[EAX] t30[S2]>t33[CL] (incf x))))))) (format t "~A~%" x))) -------------------------------------------------------------------------------- -#7 -(defun foo (x) - (declare (optimize speed (debug 0))) - (if (< x 0) x (foo (1- x)))) - -SBCL generates a full call of FOO (but CMUCL does not). - -Partial explanation: CMUCL does generate a full (tail) call to FOO if -*BLOCK-COMPILE* is NIL. Maybe this is because in that case CMUCL doesn't -generate a temporary(?) function in its IR1-TRANSLATOR for %DEFUN? --------------------------------------------------------------------------------- #8 (defun foo (d) (declare (optimize (speed 3) (safety 0) (debug 0))) (declare (type (double-float 0d0 1d0) d)) (loop for i fixnum from 1 to 5 - for x1 double-float = (sin d) ;;; !!! - do (loop for j fixnum from 1 to 4 - sum x1 double-float))) + for x1 double-float = (sin d) ;;; !!! + do (loop for j fixnum from 1 to 4 + sum x1 double-float))) Without the marked declaration Python will use boxed representation for X1. diff --git a/src/code/cross-misc.lisp b/src/code/cross-misc.lisp index d2a4c34..dca1fdd 100644 --- a/src/code/cross-misc.lisp +++ b/src/code/cross-misc.lisp @@ -137,3 +137,10 @@ (defun sb!kernel:%ldb (size posn integer) (ldb (byte size posn) integer)) + +(defun sb!kernel:%dpb (newbyte size posn integer) + (dpb newbyte (byte size posn) integer)) + +(defun sb!kernel:%with-array-data (array start end) + (assert (typep array '(simple-array * (*)))) + (values array start end 0)) diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp index 93aeb42..1c2296b 100644 --- a/src/compiler/ctype.lisp +++ b/src/compiler/ctype.lisp @@ -759,15 +759,20 @@ (derive-node-type ref (make-single-value-type type)))))) t)))))) +;;; FIXME: This is quite similar to ASSERT-NEW-DEFINITION. (defun assert-global-function-definition-type (name fun) (declare (type functional fun)) (let ((type (info :function :type name)) (where (info :function :where-from name))) (when (eq where :declared) (setf (leaf-type fun) type) - (assert-definition-type fun type - :unwinnage-fun #'compiler-notify - :where "proclamation")))) + (assert-definition-type + fun type + :unwinnage-fun #'compiler-notify + :where "proclamation" + :really-assert (not (awhen (info :function :info name) + (ir1-attributep (fun-info-attributes it) + explicit-check))))))) ;;;; FIXME: Move to some other file. (defun check-catch-tag-type (tag) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index cc6cd91..3215e85 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -344,7 +344,7 @@ (defknown scale-float (float float-exponent) float (movable foldable unsafely-flushable explicit-check)) (defknown float-radix (float) float-radix - (movable foldable flushable explicit-check)) + (movable foldable flushable)) (defknown float-sign (float &optional float) float (movable foldable flushable explicit-check)) (defknown (float-digits float-precision) (float) float-digits diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp index d55bdeb..b7d218e 100644 --- a/src/compiler/ir1tran-lambda.lisp +++ b/src/compiler/ir1tran-lambda.lisp @@ -910,11 +910,16 @@ ((named-lambda) (let ((name (cadr thing))) (if (legal-fun-name-p name) - (let ((res (apply #'ir1-convert-lambda `(lambda ,@(cddr thing)) + (let ((defined-fun-res (get-defined-fun name)) + (res (apply #'ir1-convert-lambda `(lambda ,@(cddr thing)) :source-name name :debug-name nil args))) (assert-global-function-definition-type name res) + (setf (defined-fun-functional defined-fun-res) + res) + (unless (eq (defined-fun-inlinep defined-fun-res) :notinline) + (substitute-leaf res defined-fun-res)) res) (apply #'ir1-convert-lambda `(lambda ,@(cddr thing)) :debug-name name args)))) diff --git a/version.lisp-expr b/version.lisp-expr index 3ee9825..d03560a 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.2.37" +"0.8.2.38" -- 1.7.10.4