From 429aaa4b6432b6aa5c384bea4b820a879a2deff8 Mon Sep 17 00:00:00 2001 From: gerd <gerd> Date: Fri, 12 Sep 2003 12:55:19 +0000 Subject: [PATCH] * src/compiler/srctran.lisp (%mask-field): (unsigned-byte 0) is an invalid type specifier. * src/compiler/float-tran.lisp (float): Make three optimizers, one for no prototype, one for single-float prototype, and one for double-float prototype. --- compiler/float-tran.lisp | 14 +++++++------- compiler/srctran.lisp | 4 ++-- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 1f4c0469d..19bd250ad 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 39259fdb5..9fd471b9d 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*))) -- GitLab