From 3a38ef48c9ae55b932b5639ac9ac3ccd56c7dd9f Mon Sep 17 00:00:00 2001 From: Alexey Dejneka Date: Wed, 3 Sep 2003 09:05:02 +0000 Subject: [PATCH] 0.8.3.28: * Fix bug reported by Paul Dietz in optimizer for (EXPT ... ) ... different treating of integer and complex arguments; ... SOURCE-TRANSFORM-NUMERIC-TYPEP: be accurate with (COMPLEX INTEGER); * SB-BSD-SOCKETS: really grovel SO_NO_CHECK. --- NEWS | 1 + contrib/sb-bsd-sockets/constants.lisp | 4 ++-- src/compiler/srctran.lisp | 14 +++++++++++++- src/compiler/typetran.lisp | 6 +++++- tests/compiler.pure.lisp | 33 +++++++++++++++++++++++++++++++++ version.lisp-expr | 2 +- 6 files changed, 55 insertions(+), 5 deletions(-) diff --git a/NEWS b/NEWS index 927c90d..1774726 100644 --- a/NEWS +++ b/NEWS @@ -2034,6 +2034,7 @@ changes in sbcl-0.8.4 relative to sbcl-0.8.3: small float arguments. ** (FLOAT X) for X of type DOUBLE-FLOAT now returns X in all circumstances. + ** optimizer for (EXPT X 0) did not work for X not of type FLOAT. planned incompatible changes in 0.8.x: * (not done yet, but planned:) When the profiling interface settles diff --git a/contrib/sb-bsd-sockets/constants.lisp b/contrib/sb-bsd-sockets/constants.lisp index e487966..9dbf4f7 100644 --- a/contrib/sb-bsd-sockets/constants.lisp +++ b/contrib/sb-bsd-sockets/constants.lisp @@ -47,8 +47,8 @@ "Send periodic keepalives: if peer does not respond, we get SIGPIPE") (:integer so-oobinline "SO_OOBINLINE" "Put out-of-band data into the normal input queue when received") - (:integer so-no-check 11) -#+linux (:integer so-priority "SO_PRIORITY") + (:integer so-no-check "SO_NO_CHECK") +#+linux (:integer so-priority "SO_PRIORITY") (:integer so-linger "SO_LINGER" "For reliable streams, pause a while on closing when unsent messages are queued") #+linux (:integer so-bsdcompat "SO_BSDCOMPAT") diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp index 150cb3a..adb1dc2 100644 --- a/src/compiler/srctran.lisp +++ b/src/compiler/srctran.lisp @@ -2772,7 +2772,19 @@ ;; multiplication and division for small integral powers. (unless (not-more-contagious y x) (give-up-ir1-transform)) - (cond ((zerop val) '(float 1 x)) + (cond ((zerop val) + (let ((x-type (continuation-type x))) + (cond ((csubtypep x-type (specifier-type '(or rational + (complex rational)))) + '1) + ((csubtypep x-type (specifier-type 'real)) + `(if (rationalp x) + 1 + (float 1 x))) + ((csubtypep x-type (specifier-type 'complex)) + ;; both parts are float + `(1+ (* x ,val))) + (t (give-up-ir1-transform))))) ((= val 2) '(* x x)) ((= val -2) '(/ (* x x))) ((= val 3) '(* x x x)) diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp index ccb585a..9624814 100644 --- a/src/compiler/typetran.lisp +++ b/src/compiler/typetran.lisp @@ -189,7 +189,11 @@ (defun source-transform-numeric-typep (object type) (let* ((class (numeric-type-class type)) (base (ecase class - (integer (containing-integer-type type)) + (integer (containing-integer-type + (if (numeric-type-complexp type) + (modified-numeric-type type + :complexp :real) + type))) (rational 'rational) (float (or (numeric-type-format type) 'float)) ((nil) 'real)))) diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index a5fd491..433b520 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -529,3 +529,36 @@ (declare (ignore x) (ignorable y)) (list u v))))))) + +;;; bug reported by Paul Dietz: wrong optimizer for (EXPT ... 0) +(loop for (x type) in + '((14 integer) + (14 rational) + (-14/3 (rational -8 11)) + (3s0 short-float) + (4f0 single-float) + (5d0 double-float) + (6l0 long-float) + (14 real) + (13/2 real) + (2s0 real) + (2d0 real) + (#c(-3 4) (complex fixnum)) + (#c(-3 4) (complex rational)) + (#c(-3/7 4) (complex rational)) + (#c(2s0 3s0) (complex short-float)) + (#c(2f0 3f0) (complex single-float)) + (#c(2d0 3d0) (complex double-float)) + (#c(2l0 3l0) (complex long-float)) + (#c(2d0 3s0) (complex float)) + (#c(2 3f0) (complex real)) + (#c(2 3d0) (complex real)) + (#c(-3/7 4) (complex real)) + (#c(-3/7 4) complex) + (#c(2 3l0) complex)) + do (dolist (zero '(0 0s0 0f0 0d0 0l0)) + (dolist (real-zero (list zero (- zero))) + (let* ((src `(lambda (x) (expt (the ,type x) ,real-zero))) + (fun (compile nil src)) + (result (1+ (funcall (eval #'*) x real-zero)))) + (assert (eql result (funcall fun x))))))) diff --git a/version.lisp-expr b/version.lisp-expr index f3b523d..791ca00 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.28" +"0.8.3.29" -- 1.7.10.4