Skip to content
Snippets Groups Projects
Commit 7aa4fe57 authored by Raymond Toy's avatar Raymond Toy
Browse files

Move the double-double functions and transforms to their own file.

compiler/float-tran-dd.lisp:
* Most of the double-double implementation moved here.

compiler/float-tran.lisp:
* Removed most of the double-double implementation.

compiler/loadcom.lisp:
* Load float-tran-dd.

tools/comcom.lisp:
* Compile float-tran-dd.

i18n/local/cmucl.pot:
* Regenerated.
parent 65a61bdb
No related branches found
No related tags found
No related merge requests found
;;; -*- Mode: Lisp; Package: C; Log: code.log -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: src/compiler/float-tran-dd.lisp $")
;;;
;;; **********************************************************************
;;;
;;; This file contains floating-point specific transforms for
;;; double-doubles.
;;;
;;; The algorithms contained herein are based on the code written by
;;; Yozo Hida. See http://www.cs.berkeley.edu/~yozo/ for more
;;; information.
(in-package "C")
(intl:textdomain "cmucl")
(declaim (inline quick-two-sum))
(defun quick-two-sum (a b)
"Computes fl(a+b) and err(a+b), assuming |a| >= |b|"
(declare (double-float a b))
(let* ((s (+ a b))
(e (- b (- s a))))
(values s e)))
(declaim (inline two-sum))
(defun two-sum (a b)
"Computes fl(a+b) and err(a+b)"
(declare (double-float a b))
(let* ((s (+ a b))
(v (- s a))
(e (+ (- a (- s v))
(- b v))))
(locally
(declare (optimize (inhibit-warnings 3)))
(values s e))))
(declaim (maybe-inline add-dd))
(defun add-dd (a0 a1 b0 b1)
"Add the double-double A0,A1 to the double-double B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-sum a0 b0)
(declare (double-float s1 s2))
(when (float-infinity-p s1)
(return-from add-dd (values s1 0d0)))
(multiple-value-bind (t1 t2)
(two-sum a1 b1)
(declare (double-float t1 t2))
(incf s2 t1)
(multiple-value-bind (s1 s2)
(quick-two-sum s1 s2)
(declare (double-float s1 s2))
(incf s2 t2)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b0))
;; Handle sum of signed zeroes here.
(values (float-sign (+ a0 b0) 0d0)
0d0)
(values r1 r2)))))))
(deftransform + ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(add-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline quick-two-diff))
(defun quick-two-diff (a b)
"Compute fl(a-b) and err(a-b), assuming |a| >= |b|"
(declare (double-float a b))
(let ((s (- a b)))
(values s (- (- a s) b))))
(declaim (inline two-diff))
(defun two-diff (a b)
"Compute fl(a-b) and err(a-b)"
(declare (double-float a b))
(let* ((s (- a b))
(v (- s a))
(e (- (- a (- s v))
(+ b v))))
(locally
(declare (optimize (inhibit-warnings 3)))
(values s e))))
(declaim (maybe-inline sub-dd))
(defun sub-dd (a0 a1 b0 b1)
"Subtract the double-double B0,B1 from A0,A1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-diff a0 b0)
(declare (double-float s2))
(when (float-infinity-p s1)
(return-from sub-dd (values s1 0d0)))
(multiple-value-bind (t1 t2)
(two-diff a1 b1)
(incf s2 t1)
(multiple-value-bind (s1 s2)
(quick-two-sum s1 s2)
(declare (double-float s2))
(incf s2 t2)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b0))
(values (float-sign (- a0 b0) 0d0)
0d0)
(values r1 r2)))))))
(declaim (maybe-inline sub-d-dd))
(defun sub-d-dd (a b0 b1)
"Compute double-double = double - double-double"
(declare (double-float a b0 b1)
(optimize (speed 3) (safety 0)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-diff a b0)
(declare (double-float s2))
(when (float-infinity-p s1)
(return-from sub-d-dd (values s1 0d0)))
(decf s2 b1)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a) (zerop b0))
(values (float-sign (- a b0) 0d0) 0d0)
(values r1 r2)))))
(declaim (maybe-inline sub-dd-d))
(defun sub-dd-d (a0 a1 b)
"Subtract the double B from the double-double A0,A1"
(declare (double-float a0 a1 b)
(optimize (speed 3) (safety 0)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-diff a0 b)
(declare (double-float s2))
(when (float-infinity-p s1)
(return-from sub-dd-d (values s1 0d0)))
(incf s2 a1)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b))
(values (float-sign (- a0 b) 0d0) 0d0)
(values r1 r2)))))
(deftransform - ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(sub-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform - ((a b) (double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(sub-d-dd a
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform - ((a b) (vm::double-double-float double-float)
* :node node)
`(multiple-value-bind (hi lo)
(sub-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
b)
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (maybe-inline split))
;; See Listing 2.6: Mul12 in "CR-LIBM: A library of correctly rounded
;; elementary functions in double-precision". Also known as Dekker's
;; algorithm.
(defun split (a)
"Split the double-float number a into a-hi and a-lo such that a =
a-hi + a-lo and a-hi contains the upper 26 significant bits of a and
a-lo contains the lower 26 bits."
(declare (double-float a))
(let* ((tmp (* a (+ 1 (expt 2 27))))
(a-hi (- tmp (- tmp a)))
(a-lo (- a a-hi)))
(values a-hi a-lo)))
;; Values used for scaling in two-prod. These are used to determine
;; if SPLIT might overflow so the value (and result) can be scaled to
;; prevent overflow.
(defconstant +two970+
(scale-float 1d0 970))
(defconstant +two53+
(scale-float 1d0 53))
(defconstant +two-53+
(scale-float 1d0 -53))
(declaim (inline two-prod))
;; This is essentially the algorithm given by Listing 2.7 Mul12Cond
;; given in "CR-LIBM: A library of correctly rounded elementary
;; functions in double-precision".
#-ppc
(defun two-prod (a b)
_N"Compute fl(a*b) and err(a*b)"
(declare (double-float a b)
(optimize (speed 3)))
;; If the numbers are too big, scale them done so SPLIT doesn't overflow.
(multiple-value-bind (aa bb)
(values (if (> a +two970+)
(* a +two-53+)
a)
(if (> b +two970+)
(* b +two-53+)
b))
(let ((p (* aa bb)))
(declare (double-float p)
(inline split))
(multiple-value-bind (aa-hi aa-lo)
(split aa)
;;(format t "aa-hi, aa-lo = ~S ~S~%" aa-hi aa-lo)
(multiple-value-bind (bb-hi bb-lo)
(split bb)
;;(format t "bb-hi, bb-lo = ~S ~S~%" bb-hi bb-lo)
(let ((e (+ (+ (- (* aa-hi bb-hi) p)
(* aa-hi bb-lo)
(* aa-lo bb-hi))
(* aa-lo bb-lo))))
(declare (double-float e))
(locally
(declare (optimize (inhibit-warnings 3)))
;; If the numbers was scaled down, we need to scale the
;; result back up.
(when (> a +two970+)
(setf p (* p +two53+)
e (* e +two53+)))
(when (> b +two970+)
(setf p (* p +two53+)
e (* e +two53+)))
(values p e))))))))
#+ppc
(defun two-prod (a b)
_N"Compute fl(a*b) and err(a*b)"
(declare (double-float a b))
;; PPC has a fused multiply-subtract instruction that can be used
;; here, so use it.
(let* ((p (* a b))
(err (vm::fused-multiply-subtract a b p)))
(values p err)))
(declaim (inline two-sqr))
#-ppc
(defun two-sqr (a)
_N"Compute fl(a*a) and err(a*b). This is a more efficient
implementation of two-prod"
(declare (double-float a))
(let ((q (* a a)))
(multiple-value-bind (a-hi a-lo)
(split a)
(locally
(declare (optimize (inhibit-warnings 3)))
(values q (+ (+ (- (* a-hi a-hi) q)
(* 2 a-hi a-lo))
(* a-lo a-lo)))))))
(defun two-sqr (a)
_N"Compute fl(a*a) and err(a*b). This is a more efficient
implementation of two-prod"
(declare (double-float a))
(let ((aa (if (> a +two970+)
(* a +two-53+)
a)))
(let ((q (* aa aa)))
(declare (double-float q)
(inline split))
(multiple-value-bind (a-hi a-lo)
(split aa)
(locally
(declare (optimize (inhibit-warnings 3)))
(let ((e (+ (+ (- (* a-hi a-hi) q)
(* 2 a-hi a-lo))
(* a-lo a-lo))))
(if (> a +two970+)
(values (* q +two53+)
(* e +two53+))
(values q e))))))))
#+ppc
(defun two-sqr (a)
_N"Compute fl(a*a) and err(a*b). This is a more efficient
implementation of two-prod"
(declare (double-float a))
(let ((q (* a a)))
(values q (vm::fused-multiply-subtract a a q))))
(declaim (maybe-inline mul-dd-d))
(defun mul-dd-d (a0 a1 b)
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (p1 p2)
(two-prod a0 b)
(declare (double-float p2))
(when (float-infinity-p p1)
(return-from mul-dd-d (values p1 0d0)))
;;(format t "mul-dd-d p1,p2 = ~A ~A~%" p1 p2)
(incf p2 (* a1 b))
;;(format t "mul-dd-d p2 = ~A~%" p2)
(multiple-value-bind (r1 r2)
(quick-two-sum p1 p2)
(when (zerop r1)
(setf r1 (float-sign p1 0d0))
(setf r2 p1))
(values r1 r2))))
(declaim (maybe-inline mul-dd))
(defun mul-dd (a0 a1 b0 b1)
"Multiply the double-double A0,A1 with B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (p1 p2)
(two-prod a0 b0)
(declare (double-float p1 p2))
(when (float-infinity-p p1)
(return-from mul-dd (values p1 0d0)))
(incf p2 (* a0 b1))
(incf p2 (* a1 b0))
(multiple-value-bind (r1 r2)
(quick-two-sum p1 p2)
(if (zerop r1)
(values (float-sign p1 0d0) 0d0)
(values r1 r2)))))
(declaim (maybe-inline add-dd-d))
(defun add-dd-d (a0 a1 b)
"Add the double-double A0,A1 to the double B"
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-sum a0 b)
(declare (double-float s1 s2))
(when (float-infinity-p s1)
(return-from add-dd-d (values s1 0d0)))
(incf s2 a1)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b))
(values (float-sign (+ a0 b) 0d0) 0d0)
(values r1 r2)))))
(declaim (maybe-inline sqr-dd))
(defun sqr-dd (a0 a1)
(declare (double-float a0 a1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (p1 p2)
(two-sqr a0)
(declare (double-float p1 p2))
(incf p2 (* 2 a0 a1))
;; Hida's version of sqr (qd-2.1.210) has the following line for
;; the sqr function. But if you compare this with mul-dd, this
;; doesn't exist there, and if you leave it in, it produces
;; results that are different from using mul-dd to square a value.
#+nil
(incf p2 (* a1 a1))
(quick-two-sum p1 p2)))
(deftransform + ((a b) (vm::double-double-float (or integer single-float double-float))
* :node node)
`(multiple-value-bind (hi lo)
(add-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
(float b 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform + ((a b) ((or integer single-float double-float) vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(add-dd-d (kernel:double-double-hi b) (kernel:double-double-lo b)
(float a 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform * ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
;; non-const-same-leaf-ref-p is stolen from two-arg-derive-type.
(flet ((non-const-same-leaf-ref-p (x y)
;; Just like same-leaf-ref-p, but we don't care if the
;; value of the leaf is constant or not.
(declare (type continuation x y))
(let ((x-use (continuation-use x))
(y-use (continuation-use y)))
(and (ref-p x-use)
(ref-p y-use)
(eq (ref-leaf x-use) (ref-leaf y-use))))))
(destructuring-bind (arg1 arg2)
(combination-args node)
;; If the two args to * are the same, we square the number
;; instead of multiply. Squaring is simpler than a full
;; multiply.
(if (non-const-same-leaf-ref-p arg1 arg2)
`(multiple-value-bind (hi lo)
(sqr-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo)))
`(multiple-value-bind (hi lo)
(mul-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo)))))))
(deftransform * ((a b) (vm::double-double-float (or integer single-float double-float))
* :node node)
`(multiple-value-bind (hi lo)
(mul-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
(float b 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform * ((a b) ((or integer single-float double-float) vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(mul-dd-d (kernel:double-double-hi b) (kernel:double-double-lo b)
(float a 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (maybe-inline div-dd))
(defun div-dd (a0 a1 b0 b1)
"Divide the double-double A0,A1 by B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3))
(inline sub-dd))
(let ((q1 (/ a0 b0)))
(when (float-infinity-p q1)
(return-from div-dd (values q1 0d0)))
;; (q1b0, q1b1) = q1*(b0,b1)
;;(format t "q1 = ~A~%" q1)
(multiple-value-bind (q1b0 q1b1)
(mul-dd-d b0 b1 q1)
;;(format t "q1*b = ~A ~A~%" q1b0 q1b1)
(multiple-value-bind (r0 r1)
;; r = a - q1 * b
(sub-dd a0 a1 q1b0 q1b1)
;;(format t "r = ~A ~A~%" r0 r1)
(let ((q2 (/ r0 b0)))
(multiple-value-bind (q2b0 q2b1)
(mul-dd-d b0 b1 q2)
(multiple-value-bind (r0 r1)
;; r = r - (q2*b)
(sub-dd r0 r1 q2b0 q2b1)
(declare (ignore r1))
(let ((q3 (/ r0 b0)))
(multiple-value-bind (q1 q2)
(quick-two-sum q1 q2)
(add-dd-d q1 q2 q3))))))))))
(declaim (maybe-inline div-dd-d))
(defun div-dd-d (a0 a1 b)
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
(let ((q1 (/ a0 b)))
;; q1 = approx quotient
;; Now compute a - q1 * b
(multiple-value-bind (p1 p2)
(two-prod q1 b)
(multiple-value-bind (s e)
(two-diff a0 p1)
(declare (double-float e))
(incf e a1)
(decf e p2)
;; Next approx
(let ((q2 (/ (+ s e) b)))
(quick-two-sum q1 q2))))))
(deftransform / ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(div-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform / ((a b) (vm::double-double-float (or integer single-float double-float))
* :node node)
`(multiple-value-bind (hi lo)
(div-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
(float b 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline sqr-d))
(defun sqr-d (a)
"Square"
(declare (double-float a)
(optimize (speed 3)
(inhibit-warnings 3)))
(two-sqr a))
(declaim (inline mul-d-d))
(defun mul-d-d (a b)
(two-prod a b))
(declaim (maybe-inline sqrt-dd))
(defun sqrt-dd (a0 a1)
(declare (type (double-float 0d0) a0)
(double-float a1)
(optimize (speed 3)
(inhibit-warnings 3)))
;; Strategy: Use Karp's trick: if x is an approximation to sqrt(a),
;; then
;;
;; y = a*x + (a-(a*x)^2)*x/2
;;
;; is an approximation that is accurate to twice the accuracy of x.
;; Also, the multiplication (a*x) and [-]*x can be done with only
;; half the precision.
(if (and (zerop a0) (zerop a1))
(values a0 a1)
(let* ((x (/ (sqrt a0)))
(ax (* a0 x)))
(multiple-value-bind (s0 s1)
(sqr-d ax)
(multiple-value-bind (s2)
(sub-dd a0 a1 s0 s1)
(multiple-value-bind (p0 p1)
(mul-d-d s2 (* x 0.5d0))
(add-dd-d p0 p1 ax)))))))
(deftransform sqrt ((a) ((vm::double-double-float 0w0))
* :node node)
`(multiple-value-bind (hi lo)
(sqrt-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline neg-dd))
(defun neg-dd (a0 a1)
(declare (double-float a0 a1)
(optimize (speed 3)
(inhibit-warnings 3)))
(values (- a0) (- a1)))
(declaim (inline abs-dd))
(defun abs-dd (a0 a1)
(declare (double-float a0 a1)
(optimize (speed 3)
(inhibit-warnings 3)))
(if (minusp a0)
(neg-dd a0 a1)
(values a0 a1)))
(deftransform abs ((a) (vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(abs-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform %negate ((a) (vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(neg-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline dd=))
(defun dd= (a0 a1 b0 b1)
(and (= a0 b0)
(= a1 b1)))
(declaim (inline dd<))
(defun dd< (a0 a1 b0 b1)
(or (< a0 b0)
(and (= a0 b0)
(< a1 b1))))
(declaim (inline dd>))
(defun dd> (a0 a1 b0 b1)
(or (> a0 b0)
(and (= a0 b0)
(> a1 b1))))
(deftransform = ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd= (kernel:double-double-hi a)
(kernel:double-double-lo a)
(kernel:double-double-hi b)
(kernel:double-double-lo b)))
(deftransform < ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd< (kernel:double-double-hi a)
(kernel:double-double-lo a)
(kernel:double-double-hi b)
(kernel:double-double-lo b)))
(deftransform > ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd> (kernel:double-double-hi a)
(kernel:double-double-lo a)
(kernel:double-double-hi b)
(kernel:double-double-lo b)))
...@@ -2170,609 +2170,3 @@ ...@@ -2170,609 +2170,3 @@
(make-values-type :required (list f (make-values-type :required (list f
e e
s)))) s))))
;;; Support for double-double floats
;;;
;;; The algorithms contained herein are based on the code written by
;;; Yozo Hida. See http://www.cs.berkeley.edu/~yozo/ for more
;;; information.
#+double-double
(progn
(declaim (inline quick-two-sum))
(defun quick-two-sum (a b)
"Computes fl(a+b) and err(a+b), assuming |a| >= |b|"
(declare (double-float a b))
(let* ((s (+ a b))
(e (- b (- s a))))
(values s e)))
(declaim (inline two-sum))
(defun two-sum (a b)
"Computes fl(a+b) and err(a+b)"
(declare (double-float a b))
(let* ((s (+ a b))
(v (- s a))
(e (+ (- a (- s v))
(- b v))))
(locally
(declare (optimize (inhibit-warnings 3)))
(values s e))))
(declaim (maybe-inline add-dd))
(defun add-dd (a0 a1 b0 b1)
"Add the double-double A0,A1 to the double-double B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-sum a0 b0)
(declare (double-float s1 s2))
(when (float-infinity-p s1)
(return-from add-dd (values s1 0d0)))
(multiple-value-bind (t1 t2)
(two-sum a1 b1)
(declare (double-float t1 t2))
(incf s2 t1)
(multiple-value-bind (s1 s2)
(quick-two-sum s1 s2)
(declare (double-float s1 s2))
(incf s2 t2)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b0))
;; Handle sum of signed zeroes here.
(values (float-sign (+ a0 b0) 0d0)
0d0)
(values r1 r2)))))))
(deftransform + ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(add-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline quick-two-diff))
(defun quick-two-diff (a b)
"Compute fl(a-b) and err(a-b), assuming |a| >= |b|"
(declare (double-float a b))
(let ((s (- a b)))
(values s (- (- a s) b))))
(declaim (inline two-diff))
(defun two-diff (a b)
"Compute fl(a-b) and err(a-b)"
(declare (double-float a b))
(let* ((s (- a b))
(v (- s a))
(e (- (- a (- s v))
(+ b v))))
(locally
(declare (optimize (inhibit-warnings 3)))
(values s e))))
(declaim (maybe-inline sub-dd))
(defun sub-dd (a0 a1 b0 b1)
"Subtract the double-double B0,B1 from A0,A1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-diff a0 b0)
(declare (double-float s2))
(when (float-infinity-p s1)
(return-from sub-dd (values s1 0d0)))
(multiple-value-bind (t1 t2)
(two-diff a1 b1)
(incf s2 t1)
(multiple-value-bind (s1 s2)
(quick-two-sum s1 s2)
(declare (double-float s2))
(incf s2 t2)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b0))
(values (float-sign (- a0 b0) 0d0)
0d0)
(values r1 r2)))))))
(declaim (maybe-inline sub-d-dd))
(defun sub-d-dd (a b0 b1)
"Compute double-double = double - double-double"
(declare (double-float a b0 b1)
(optimize (speed 3) (safety 0)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-diff a b0)
(declare (double-float s2))
(when (float-infinity-p s1)
(return-from sub-d-dd (values s1 0d0)))
(decf s2 b1)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a) (zerop b0))
(values (float-sign (- a b0) 0d0) 0d0)
(values r1 r2)))))
(declaim (maybe-inline sub-dd-d))
(defun sub-dd-d (a0 a1 b)
"Subtract the double B from the double-double A0,A1"
(declare (double-float a0 a1 b)
(optimize (speed 3) (safety 0)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-diff a0 b)
(declare (double-float s2))
(when (float-infinity-p s1)
(return-from sub-dd-d (values s1 0d0)))
(incf s2 a1)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b))
(values (float-sign (- a0 b) 0d0) 0d0)
(values r1 r2)))))
(deftransform - ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(sub-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform - ((a b) (double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(sub-d-dd a
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform - ((a b) (vm::double-double-float double-float)
* :node node)
`(multiple-value-bind (hi lo)
(sub-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
b)
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (maybe-inline split))
;; See Listing 2.6: Mul12 in "CR-LIBM: A library of correctly rounded
;; elementary functions in double-precision". Also known as Dekker's
;; algorithm.
(defun split (a)
"Split the double-float number a into a-hi and a-lo such that a =
a-hi + a-lo and a-hi contains the upper 26 significant bits of a and
a-lo contains the lower 26 bits."
(declare (double-float a))
(let* ((tmp (* a (+ 1 (expt 2 27))))
(a-hi (- tmp (- tmp a)))
(a-lo (- a a-hi)))
(values a-hi a-lo)))
;; Values used for scaling in two-prod. These are used to determine
;; if SPLIT might overflow so the value (and result) can be scaled to
;; prevent overflow.
(defconstant +two970+
(scale-float 1d0 970))
(defconstant +two53+
(scale-float 1d0 53))
(defconstant +two-53+
(scale-float 1d0 -53))
(declaim (inline two-prod))
;; This is essentially the algorithm given by Listing 2.7 Mul12Cond
;; given in "CR-LIBM: A library of correctly rounded elementary
;; functions in double-precision".
#-ppc
(defun two-prod (a b)
_N"Compute fl(a*b) and err(a*b)"
(declare (double-float a b)
(optimize (speed 3)))
;; If the numbers are too big, scale them done so SPLIT doesn't overflow.
(multiple-value-bind (aa bb)
(values (if (> a +two970+)
(* a +two-53+)
a)
(if (> b +two970+)
(* b +two-53+)
b))
(let ((p (* aa bb)))
(declare (double-float p)
(inline split))
(multiple-value-bind (aa-hi aa-lo)
(split aa)
;;(format t "aa-hi, aa-lo = ~S ~S~%" aa-hi aa-lo)
(multiple-value-bind (bb-hi bb-lo)
(split bb)
;;(format t "bb-hi, bb-lo = ~S ~S~%" bb-hi bb-lo)
(let ((e (+ (+ (- (* aa-hi bb-hi) p)
(* aa-hi bb-lo)
(* aa-lo bb-hi))
(* aa-lo bb-lo))))
(declare (double-float e))
(locally
(declare (optimize (inhibit-warnings 3)))
;; If the numbers was scaled down, we need to scale the
;; result back up.
(when (> a +two970+)
(setf p (* p +two53+)
e (* e +two53+)))
(when (> b +two970+)
(setf p (* p +two53+)
e (* e +two53+)))
(values p e))))))))
#+ppc
(defun two-prod (a b)
_N"Compute fl(a*b) and err(a*b)"
(declare (double-float a b))
;; PPC has a fused multiply-subtract instruction that can be used
;; here, so use it.
(let* ((p (* a b))
(err (vm::fused-multiply-subtract a b p)))
(values p err)))
(declaim (inline two-sqr))
#-ppc
(defun two-sqr (a)
_N"Compute fl(a*a) and err(a*b). This is a more efficient
implementation of two-prod"
(declare (double-float a))
(let ((q (* a a)))
(multiple-value-bind (a-hi a-lo)
(split a)
(locally
(declare (optimize (inhibit-warnings 3)))
(values q (+ (+ (- (* a-hi a-hi) q)
(* 2 a-hi a-lo))
(* a-lo a-lo)))))))
(defun two-sqr (a)
_N"Compute fl(a*a) and err(a*b). This is a more efficient
implementation of two-prod"
(declare (double-float a))
(let ((aa (if (> a +two970+)
(* a +two-53+)
a)))
(let ((q (* aa aa)))
(declare (double-float q)
(inline split))
(multiple-value-bind (a-hi a-lo)
(split aa)
(locally
(declare (optimize (inhibit-warnings 3)))
(let ((e (+ (+ (- (* a-hi a-hi) q)
(* 2 a-hi a-lo))
(* a-lo a-lo))))
(if (> a +two970+)
(values (* q +two53+)
(* e +two53+))
(values q e))))))))
#+ppc
(defun two-sqr (a)
_N"Compute fl(a*a) and err(a*b). This is a more efficient
implementation of two-prod"
(declare (double-float a))
(let ((q (* a a)))
(values q (vm::fused-multiply-subtract a a q))))
(declaim (maybe-inline mul-dd-d))
(defun mul-dd-d (a0 a1 b)
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (p1 p2)
(two-prod a0 b)
(declare (double-float p2))
(when (float-infinity-p p1)
(return-from mul-dd-d (values p1 0d0)))
;;(format t "mul-dd-d p1,p2 = ~A ~A~%" p1 p2)
(incf p2 (* a1 b))
;;(format t "mul-dd-d p2 = ~A~%" p2)
(multiple-value-bind (r1 r2)
(quick-two-sum p1 p2)
(when (zerop r1)
(setf r1 (float-sign p1 0d0))
(setf r2 p1))
(values r1 r2))))
(declaim (maybe-inline mul-dd))
(defun mul-dd (a0 a1 b0 b1)
"Multiply the double-double A0,A1 with B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (p1 p2)
(two-prod a0 b0)
(declare (double-float p1 p2))
(when (float-infinity-p p1)
(return-from mul-dd (values p1 0d0)))
(incf p2 (* a0 b1))
(incf p2 (* a1 b0))
(multiple-value-bind (r1 r2)
(quick-two-sum p1 p2)
(if (zerop r1)
(values (float-sign p1 0d0) 0d0)
(values r1 r2)))))
(declaim (maybe-inline add-dd-d))
(defun add-dd-d (a0 a1 b)
"Add the double-double A0,A1 to the double B"
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (s1 s2)
(two-sum a0 b)
(declare (double-float s1 s2))
(when (float-infinity-p s1)
(return-from add-dd-d (values s1 0d0)))
(incf s2 a1)
(multiple-value-bind (r1 r2)
(quick-two-sum s1 s2)
(if (and (zerop a0) (zerop b))
(values (float-sign (+ a0 b) 0d0) 0d0)
(values r1 r2)))))
(declaim (maybe-inline sqr-dd))
(defun sqr-dd (a0 a1)
(declare (double-float a0 a1)
(optimize (speed 3)
(inhibit-warnings 3)))
(multiple-value-bind (p1 p2)
(two-sqr a0)
(declare (double-float p1 p2))
(incf p2 (* 2 a0 a1))
;; Hida's version of sqr (qd-2.1.210) has the following line for
;; the sqr function. But if you compare this with mul-dd, this
;; doesn't exist there, and if you leave it in, it produces
;; results that are different from using mul-dd to square a value.
#+nil
(incf p2 (* a1 a1))
(quick-two-sum p1 p2)))
(deftransform + ((a b) (vm::double-double-float (or integer single-float double-float))
* :node node)
`(multiple-value-bind (hi lo)
(add-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
(float b 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform + ((a b) ((or integer single-float double-float) vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(add-dd-d (kernel:double-double-hi b) (kernel:double-double-lo b)
(float a 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform * ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
;; non-const-same-leaf-ref-p is stolen from two-arg-derive-type.
(flet ((non-const-same-leaf-ref-p (x y)
;; Just like same-leaf-ref-p, but we don't care if the
;; value of the leaf is constant or not.
(declare (type continuation x y))
(let ((x-use (continuation-use x))
(y-use (continuation-use y)))
(and (ref-p x-use)
(ref-p y-use)
(eq (ref-leaf x-use) (ref-leaf y-use))))))
(destructuring-bind (arg1 arg2)
(combination-args node)
;; If the two args to * are the same, we square the number
;; instead of multiply. Squaring is simpler than a full
;; multiply.
(if (non-const-same-leaf-ref-p arg1 arg2)
`(multiple-value-bind (hi lo)
(sqr-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo)))
`(multiple-value-bind (hi lo)
(mul-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo)))))))
(deftransform * ((a b) (vm::double-double-float (or integer single-float double-float))
* :node node)
`(multiple-value-bind (hi lo)
(mul-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
(float b 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform * ((a b) ((or integer single-float double-float) vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(mul-dd-d (kernel:double-double-hi b) (kernel:double-double-lo b)
(float a 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (maybe-inline div-dd))
(defun div-dd (a0 a1 b0 b1)
"Divide the double-double A0,A1 by B0,B1"
(declare (double-float a0 a1 b0 b1)
(optimize (speed 3)
(inhibit-warnings 3))
(inline sub-dd))
(let ((q1 (/ a0 b0)))
(when (float-infinity-p q1)
(return-from div-dd (values q1 0d0)))
;; (q1b0, q1b1) = q1*(b0,b1)
;;(format t "q1 = ~A~%" q1)
(multiple-value-bind (q1b0 q1b1)
(mul-dd-d b0 b1 q1)
;;(format t "q1*b = ~A ~A~%" q1b0 q1b1)
(multiple-value-bind (r0 r1)
;; r = a - q1 * b
(sub-dd a0 a1 q1b0 q1b1)
;;(format t "r = ~A ~A~%" r0 r1)
(let ((q2 (/ r0 b0)))
(multiple-value-bind (q2b0 q2b1)
(mul-dd-d b0 b1 q2)
(multiple-value-bind (r0 r1)
;; r = r - (q2*b)
(sub-dd r0 r1 q2b0 q2b1)
(declare (ignore r1))
(let ((q3 (/ r0 b0)))
(multiple-value-bind (q1 q2)
(quick-two-sum q1 q2)
(add-dd-d q1 q2 q3))))))))))
(declaim (maybe-inline div-dd-d))
(defun div-dd-d (a0 a1 b)
(declare (double-float a0 a1 b)
(optimize (speed 3)
(inhibit-warnings 3)))
(let ((q1 (/ a0 b)))
;; q1 = approx quotient
;; Now compute a - q1 * b
(multiple-value-bind (p1 p2)
(two-prod q1 b)
(multiple-value-bind (s e)
(two-diff a0 p1)
(declare (double-float e))
(incf e a1)
(decf e p2)
;; Next approx
(let ((q2 (/ (+ s e) b)))
(quick-two-sum q1 q2))))))
(deftransform / ((a b) (vm::double-double-float vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(div-dd (kernel:double-double-hi a) (kernel:double-double-lo a)
(kernel:double-double-hi b) (kernel:double-double-lo b))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform / ((a b) (vm::double-double-float (or integer single-float double-float))
* :node node)
`(multiple-value-bind (hi lo)
(div-dd-d (kernel:double-double-hi a) (kernel:double-double-lo a)
(float b 1d0))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline sqr-d))
(defun sqr-d (a)
"Square"
(declare (double-float a)
(optimize (speed 3)
(inhibit-warnings 3)))
(two-sqr a))
(declaim (inline mul-d-d))
(defun mul-d-d (a b)
(two-prod a b))
(declaim (maybe-inline sqrt-dd))
(defun sqrt-dd (a0 a1)
(declare (type (double-float 0d0) a0)
(double-float a1)
(optimize (speed 3)
(inhibit-warnings 3)))
;; Strategy: Use Karp's trick: if x is an approximation to sqrt(a),
;; then
;;
;; y = a*x + (a-(a*x)^2)*x/2
;;
;; is an approximation that is accurate to twice the accuracy of x.
;; Also, the multiplication (a*x) and [-]*x can be done with only
;; half the precision.
(if (and (zerop a0) (zerop a1))
(values a0 a1)
(let* ((x (/ (sqrt a0)))
(ax (* a0 x)))
(multiple-value-bind (s0 s1)
(sqr-d ax)
(multiple-value-bind (s2)
(sub-dd a0 a1 s0 s1)
(multiple-value-bind (p0 p1)
(mul-d-d s2 (* x 0.5d0))
(add-dd-d p0 p1 ax)))))))
(deftransform sqrt ((a) ((vm::double-double-float 0w0))
* :node node)
`(multiple-value-bind (hi lo)
(sqrt-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline neg-dd))
(defun neg-dd (a0 a1)
(declare (double-float a0 a1)
(optimize (speed 3)
(inhibit-warnings 3)))
(values (- a0) (- a1)))
(declaim (inline abs-dd))
(defun abs-dd (a0 a1)
(declare (double-float a0 a1)
(optimize (speed 3)
(inhibit-warnings 3)))
(if (minusp a0)
(neg-dd a0 a1)
(values a0 a1)))
(deftransform abs ((a) (vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(abs-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(deftransform %negate ((a) (vm::double-double-float)
* :node node)
`(multiple-value-bind (hi lo)
(neg-dd (kernel:double-double-hi a) (kernel:double-double-lo a))
(truly-the ,(type-specifier (node-derived-type node))
(kernel:%make-double-double-float hi lo))))
(declaim (inline dd=))
(defun dd= (a0 a1 b0 b1)
(and (= a0 b0)
(= a1 b1)))
(declaim (inline dd<))
(defun dd< (a0 a1 b0 b1)
(or (< a0 b0)
(and (= a0 b0)
(< a1 b1))))
(declaim (inline dd>))
(defun dd> (a0 a1 b0 b1)
(or (> a0 b0)
(and (= a0 b0)
(> a1 b1))))
(deftransform = ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd= (kernel:double-double-hi a)
(kernel:double-double-lo a)
(kernel:double-double-hi b)
(kernel:double-double-lo b)))
(deftransform < ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd< (kernel:double-double-hi a)
(kernel:double-double-lo a)
(kernel:double-double-hi b)
(kernel:double-double-lo b)))
(deftransform > ((a b) (vm::double-double-float vm::double-double-float) *)
`(dd> (kernel:double-double-hi a)
(kernel:double-double-lo a)
(kernel:double-double-hi b)
(kernel:double-double-lo b)))
) ; progn double-double
...@@ -32,6 +32,7 @@ ...@@ -32,6 +32,7 @@
(load "vm:vm-typetran") (load "vm:vm-typetran")
(load "vm:vm-tran") (load "vm:vm-tran")
(load "c:float-tran") (load "c:float-tran")
(load "c:float-tran-dd")
(load "c:saptran") (load "c:saptran")
(load "c:srctran") (load "c:srctran")
(load "c:locall") (load "c:locall")
......
...@@ -18776,68 +18776,68 @@ msgstr "" ...@@ -18776,68 +18776,68 @@ msgstr ""
msgid "Float zero bound ~s not correctly canonicalised?" msgid "Float zero bound ~s not correctly canonicalised?"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Compute fl(a*b) and err(a*b)"
msgstr ""
#: src/compiler/float-tran.lisp
msgid ""
"Compute fl(a*a) and err(a*b). This is a more efficient\n"
" implementation of two-prod"
msgstr ""
#: src/compiler/float-tran.lisp
msgid "Computes fl(a+b) and err(a+b), assuming |a| >= |b|" msgid "Computes fl(a+b) and err(a+b), assuming |a| >= |b|"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Computes fl(a+b) and err(a+b)" msgid "Computes fl(a+b) and err(a+b)"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Add the double-double A0,A1 to the double-double B0,B1" msgid "Add the double-double A0,A1 to the double-double B0,B1"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Compute fl(a-b) and err(a-b), assuming |a| >= |b|" msgid "Compute fl(a-b) and err(a-b), assuming |a| >= |b|"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Compute fl(a-b) and err(a-b)" msgid "Compute fl(a-b) and err(a-b)"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Subtract the double-double B0,B1 from A0,A1" msgid "Subtract the double-double B0,B1 from A0,A1"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Compute double-double = double - double-double" msgid "Compute double-double = double - double-double"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Subtract the double B from the double-double A0,A1" msgid "Subtract the double B from the double-double A0,A1"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "" msgid ""
"Split the double-float number a into a-hi and a-lo such that a =\n" "Split the double-float number a into a-hi and a-lo such that a =\n"
" a-hi + a-lo and a-hi contains the upper 26 significant bits of a and\n" " a-hi + a-lo and a-hi contains the upper 26 significant bits of a and\n"
" a-lo contains the lower 26 bits." " a-lo contains the lower 26 bits."
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Compute fl(a*b) and err(a*b)"
msgstr ""
#: src/compiler/float-tran-dd.lisp
msgid ""
"Compute fl(a*a) and err(a*b). This is a more efficient\n"
" implementation of two-prod"
msgstr ""
#: src/compiler/float-tran-dd.lisp
msgid "Multiply the double-double A0,A1 with B0,B1" msgid "Multiply the double-double A0,A1 with B0,B1"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Add the double-double A0,A1 to the double B" msgid "Add the double-double A0,A1 to the double B"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Divide the double-double A0,A1 by B0,B1" msgid "Divide the double-double A0,A1 by B0,B1"
msgstr "" msgstr ""
   
#: src/compiler/float-tran.lisp #: src/compiler/float-tran-dd.lisp
msgid "Square" msgid "Square"
msgstr "" msgstr ""
   
......
...@@ -121,6 +121,7 @@ ...@@ -121,6 +121,7 @@
(comf "target:compiler/typetran" :byte-compile *byte-compile*) (comf "target:compiler/typetran" :byte-compile *byte-compile*)
(comf "target:compiler/generic/vm-typetran" :byte-compile *byte-compile*) (comf "target:compiler/generic/vm-typetran" :byte-compile *byte-compile*)
(comf "target:compiler/float-tran" :byte-compile *byte-compile*) (comf "target:compiler/float-tran" :byte-compile *byte-compile*)
(comf "target:compiler/float-tran-dd" :byte-compile *byte-compile*)
(comf "target:compiler/saptran" :byte-compile *byte-compile*) (comf "target:compiler/saptran" :byte-compile *byte-compile*)
(comf "target:compiler/srctran") ;; try (comf "target:compiler/srctran") ;; try
(comf "target:compiler/locall") (comf "target:compiler/locall")
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment