mirror of
https://github.com/gentoo-mirror/gentoo.git
synced 2026-08-06 00:48:18 -07:00
dev-lisp/clozurecl: QA: Revert "fix bug with the ~e format"
Apparently EAPI 6 still breaks infra's metadata generation,
therefore temporarily reverting this.
This reverts commit 80832b5eb0.
This commit is contained in:
@@ -1,94 +0,0 @@
|
||||
# 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
|
||||
}
|
||||
@@ -1,128 +0,0 @@
|
||||
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
|
||||
Reference in New Issue
Block a user