diff --git a/code/float.lisp b/code/float.lisp index 78f7f825861b944fe0c5b5e57b505780f5df4edb..736e611e5f0a50ab09482dbf54a6ef075044e035 100644 --- a/code/float.lisp +++ b/code/float.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/code/float.lisp,v 1.42 2008/10/24 21:45:00 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/float.lisp,v 1.43 2008/12/22 23:24:28 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -1007,6 +1007,25 @@ #+(and nil double-double) (frob %double-double-float double-double-float)) + +;; Note: There might be bootstrap issues when adding double-double +;; floats. Use the above definition if that's the case. +#+double-double +(defun %double-double-float (n) + (typecase n + (fixnum + (%make-double-double-float (float n 1d0) 0d0)) + (single-float + (%make-double-double-float (float n 1d0) 0d0)) + (double-float + (%make-double-double-float (float n 1d0) 0d0)) + (double-double-float + n) + (bignum + (bignum:bignum-to-float n 'double-double-float)) + (ratio + (kernel::float-ratio n 'double-double-float)))) + ;; Convert rational to double-double-float. The core algorithm is ;; from Richard Fateman. It was slightly modified to handle rationals ;; instead of just bignums. diff --git a/compiler/float-tran.lisp b/compiler/float-tran.lisp index 84fe6e7a4a7afbe1741c14d13d3a153a9475a5b1..7da521660590b5aadf2e2da94cfaf14431fb0c65 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.126 2008/11/16 14:23:33 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.127 2008/12/22 23:24:28 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -59,6 +59,9 @@ (defun %double-double-float (n) (make-double-double-float (float n 1d0) 0d0)) +;; Moved to code/float.lisp, because we need this relatively early in +;; the build process to handle float and real types. +#+nil (defun %double-double-float (n) (typecase n (fixnum