diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 1f4c0469d4d9eb9b2406fef31da37c9710f2f01c..19bd250ad69dfba09915169f3a01ae7f968788c9 100644 --- a/compiler/float-tran.lisp +++ b/compiler/float-tran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.94 2003/09/07 11:48:29 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.95 2003/09/12 12:55:19 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -22,15 +22,15 @@ (defknown %single-float (real) single-float (movable foldable flushable)) (defknown %double-float (real) double-float (movable foldable flushable)) -(deftransform float ((n &optional f) (* &optional single-float) * - :when :both) - '(if (single-float-p n) - n - (%single-float n))) +(deftransform float ((n prototype) (* single-float) * :when :both) + '(%single-float n)) -(deftransform float ((n f) (* double-float) * :when :both) +(deftransform float ((n prototype) (* double-float) * :when :both) '(%double-float n)) +(deftransform float ((n) *) + `(if (floatp n) n (%single-float n))) + (deftransform %single-float ((n) (single-float) * :when :both) 'n) diff --git a/compiler/srctran.lisp b/compiler/srctran.lisp index 39259fdb54f8510984798cf0602a3433499cf554..9fd471b9d187339479353fffd0788465701726cb 100644 --- a/compiler/srctran.lisp +++ b/compiler/srctran.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.132 2003/09/12 11:29:37 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/srctran.lisp,v 1.133 2003/09/12 12:55:18 gerd Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2439,7 +2439,7 @@ (let ((size-high (numeric-type-high size)) (posn-high (numeric-type-high posn))) (if (and size-high posn-high - (<= (+ size-high posn-high) vm:word-bits)) + (<= 1 (+ size-high posn-high) vm:word-bits)) (specifier-type `(unsigned-byte ,(+ size-high posn-high))) (specifier-type 'unsigned-byte))) *universal-type*)))