commit: 80832b5eb0eb27505045760cff5e04230d4f08e2 Author: Andrey Grozin <grozin <AT> gentoo <DOT> org> AuthorDate: Sat Nov 21 04:52:27 2015 +0000 Commit: Andrey Grozin <grozin <AT> gentoo <DOT> org> CommitDate: Sat Nov 21 04:53:49 2015 +0000 URL: https://gitweb.gentoo.org/repo/gentoo.git/commit/?id=80832b5e
dev-lisp/clozurecl: fix bug with the ~e format Upstream patch http://trac.clozure.com/ccl/changeset/16639 Bug: http://trac.clozure.com/ccl/ticket/563, http://trac.clozure.com/ccl/ticket/1186 Package-Manager: portage-2.2.25 dev-lisp/clozurecl/clozurecl-1.11-r1.ebuild | 94 ++++++++++++++++++++ dev-lisp/clozurecl/files/ccl-format.patch | 128 ++++++++++++++++++++++++++++ 2 files changed, 222 insertions(+) diff --git a/dev-lisp/clozurecl/clozurecl-1.11-r1.ebuild b/dev-lisp/clozurecl/clozurecl-1.11-r1.ebuild new file mode 100644 index 0000000..5a39a3a --- /dev/null +++ b/dev-lisp/clozurecl/clozurecl-1.11-r1.ebuild @@ -0,0 +1,94 @@ +# Copyright 1999-2015 Gentoo Foundation +# Distributed under the terms of the GNU General Public License v2 +# $Id$ + +EAPI=6 + +inherit eutils multilib toolchain-funcs + +MY_PN=ccl +MY_P=${MY_PN}-${PV} + +DESCRIPTION="Common Lisp implementation, derived from Digitool's MCL product" +HOMEPAGE="http://ccl.clozure.com/"; +SRC_URI=" + x86? ( ftp://ftp.clozure.com/pub/release/${PV}/${MY_P}-linuxx86.tar.gz ) + amd64? ( ftp://ftp.clozure.com/pub/release/${PV}/${MY_P}-linuxx86.tar.gz ) + doc? ( http://ccl.clozure.com/docs/ccl.html )" + # ppc? ( ftp://ftp.clozure.com/pub/release/${PV}/${MY_P}-linuxppc.tar.gz ) + # ppc64? ( ftp://ftp.clozure.com/pub/release/${PV}/${MY_P}-linuxppc.tar.gz )" + +LICENSE="LLGPL-2.1" +SLOT="0" +# KEYWORDS="~amd64 ~ppc ~ppc64 ~x86" +KEYWORDS="~amd64 ~x86" +IUSE="doc" + +RDEPEND=">=dev-lisp/asdf-2.33-r3:=" +DEPEND="${RDEPEND} + !dev-lisp/openmcl" + +S="${WORKDIR}"/${MY_PN} +PATCHES=( "${FILESDIR}"/ccl-format.patch ) +ENVD="${T}"/50ccl + +src_configure() { + if use x86; then + CCL_RUNTIME=lx86cl; CCL_HEADERS=x86-headers; CCL_KERNEL=linuxx8632 + elif use amd64; then + CCL_RUNTIME=lx86cl64; CCL_HEADERS=x86-headers64; CCL_KERNEL=linuxx8664 + elif use ppc; then + CCL_RUNTIME=ppccl; CCL_HEADERS=headers; CCL_KERNEL=linuxppc + elif use ppc64; then + CCL_RUNTIME=ppccl64; CCL_HEADERS=headers64; CCL_KERNEL=linuxppc64 + fi +} + +src_prepare() { + default + cp /usr/share/common-lisp/source/asdf/build/asdf.lisp tools/ || die +} + +src_compile() { + emake -C lisp-kernel/${CCL_KERNEL} clean + emake -C lisp-kernel/${CCL_KERNEL} all CC="$(tc-getCC)" + + unset CCL_DEFAULT_DIRECTORY + ./${CCL_RUNTIME} -n -b -Q -e '(ccl:rebuild-ccl :full t)' -e '(ccl:quit)' || die "Compilation failed" + + # remove non-owner write permissions on the full-image + chmod go-w ${CCL_RUNTIME}{,.image} || die + + esvn_clean +} + +src_install() { + local install_dir=/usr/$(get_libdir)/${PN} + + exeinto ${install_dir} + # install executable + doexe ${CCL_RUNTIME} + # install core image + cp ${CCL_RUNTIME}.image "${D}"/${install_dir} || die + # install optional libraries + dodir ${install_dir}/tools + cp tools/*fsl "${D}"/${install_dir}/tools || die + + # until we figure out which source files are necessary for runtime + # optional features and which aren't, we install all sources + find . -type f -name '*fsl' -delete || die + rm -f lisp-kernel/${CCL_KERNEL}/*.o || die + cp -a compiler level-0 level-1 lib library \ + lisp-kernel scripts tools xdump contrib \ + "${D}"/${install_dir} || die + cp -a ${CCL_HEADERS} "${D}"/${install_dir} || die + + make_wrapper ccl "${install_dir}/${CCL_RUNTIME}" + + echo "CCL_DEFAULT_DIRECTORY=${install_dir}" > "${ENVD}" + doenvd "${ENVD}" + + dodoc doc/release-notes.txt + use doc && dodoc "${DISTDIR}"/ccl.html + use doc && dodoc -r examples +} diff --git a/dev-lisp/clozurecl/files/ccl-format.patch b/dev-lisp/clozurecl/files/ccl-format.patch new file mode 100644 index 0000000..c2df37c --- /dev/null +++ b/dev-lisp/clozurecl/files/ccl-format.patch @@ -0,0 +1,128 @@ +diff -r -U1 ccl.orig/lib/format.lisp ccl/lib/format.lisp +--- ccl.orig/lib/format.lisp 2015-11-07 02:10:10.000000000 +0600 ++++ ccl/lib/format.lisp 2015-11-20 22:51:51.736191995 +0600 +@@ -1296,5 +1296,2 @@ + +- +- +- + ;;; Given a non-negative floating point number, SCALE-EXPONENT returns a +@@ -1305,41 +1302,74 @@ + +- +-(defconstant long-log10-of-2 0.30103d0) +- +-#| +-(defun scale-exponent (x) +- (if (floatp x ) +- (scale-expt-aux (abs x) 0.0d0 1.0d0 1.0d1 1.0d-1 long-log10-of-2) +- (report-bad-arg x 'float))) +- +-#|this is the slisp code that was in the place of the error call above. +- before floatp was put in place of shortfloatp. +- ;(scale-expt-aux x (%sp-l-float 0) (%sp-l-float 1) %long-float-ten +- ; %long-float-one-tenth long-log10-of-2))) +-|# +- +-; this dies with floating point overflow (?) if fed least-positive-double-float +- +-(defun scale-expt-aux (x zero one ten one-tenth log10-of-2) +- (let ((exponent (nth-value 1 (decode-float x)))) +- (if (= x zero) +- (values zero 1) +- (let* ((e (round (* exponent log10-of-2))) +- (x (if (minusp e) ;For the end ranges. +- (* x ten (expt ten (- -1 e))) +- (/ x ten (expt ten (1- e)))))) +- (do ((d ten (* d ten)) +- (y x (/ x d)) +- (e e (1+ e))) +- ((< y one) +- (do ((m ten (* m ten)) +- (z y (* z m)) +- (e e (1- e))) +- ((>= z one-tenth) (values x e))))))))) +-|# +- +-(defun scale-exponent (n) +- (let ((exp (nth-value 1 (decode-float n)))) +- (values (round (* exp long-log10-of-2))))) +- ++(defconstant single-float-min-e ++ (nth-value 1 (decode-float least-positive-single-float))) ++(defconstant double-float-min-e ++ (nth-value 1 (decode-float least-positive-double-float))) ++ ++;;; Adapted from CMUCL. ++ ++;; This is a modified version of the scale computation from Burger and ++;; Dybvig's paper "Printing floating-point quickly and accurately." ++;; We only want the exponent, so most things not needed for the ++;; computation of the exponent have been removed. We also implemented ++;; the floating-point log approximation given in Burger and Dybvig. ++;; This is very noticeably faster for large and small numbers. It is ++;; slower for intermediate sized numbers. ++(defun accurate-scale-exponent (v) ++ (declare (type float v)) ++ (if (zerop v) ++ 1 ++ (let ((float-radix 2) ; b ++ (float-digits (float-digits v)) ; p ++ (min-e ++ (etypecase v ++ (single-float single-float-min-e) ++ (double-float double-float-min-e)))) ++ (multiple-value-bind (f e) ++ (integer-decode-float v) ++ (let ( ;; FIXME: these even tests assume normal IEEE rounding ++ ;; mode. I wonder if we should cater for non-normal? ++ (high-ok (evenp f))) ++ ;; We only want the exponent here. ++ (labels ((flog (x) ++ (declare (type (float (0.0)) x)) ++ (let ((xd (etypecase x ++ (single-float ++ (float x 1d0)) ++ (double-float ++ x)))) ++ (ceiling (- (the (double-float -400d0 400d0) ++ (log xd 10d0)) ++ 1d-10)))) ++ (fixup (r s m+ k) ++ (if (if high-ok ++ (>= (+ r m+) s) ++ (> (+ r m+) s)) ++ (+ k 1) ++ k)) ++ (scale (r s m+) ++ (let* ((est (flog v)) ++ (scale (the integer (10-to-e (abs est))))) ++ (if (>= est 0) ++ (fixup r (* s scale) m+ est) ++ (fixup (* r scale) s (* m+ scale) est))))) ++ (let (r s m+) ++ (if (>= e 0) ++ (let* ((be (expt float-radix e)) ++ (be1 (* be float-radix))) ++ (if (/= f (expt float-radix (1- float-digits))) ++ (setf r (* f be 2) ++ s 2 ++ m+ be) ++ (setf r (* f be1 2) ++ s (* float-radix 2) ++ m+ be1))) ++ (if (or (= e min-e) ++ (/= f (expt float-radix (1- float-digits)))) ++ (setf r (* f 2) ++ s (* (expt float-radix (- e)) 2) ++ m+ 1) ++ (setf r (* f float-radix 2) ++ s (* (expt float-radix (- 1 e)) 2) ++ m+ float-radix))) ++ (scale r s m+)))))))) + +@@ -1922,3 +1952,3 @@ + (format-error "incompatible values for k and d"))) +- (when (not exp) (setq exp (scale-exponent number))) ++ (when (not exp) (setq exp (accurate-scale-exponent (abs number)))) + AGAIN
