Commit e01e26ab authored by Raymond Toy's avatar Raymond Toy
Browse files

Fix #6: Support sbcl

Update code to work with sbcl:

- Add implementation for `float-infinity-p` and friends.
- Typos where `-` and `/` were used instead of `sub-qd` and `div-qd`.
- Change a `defconstant +digits+` to use `defparameter`
parent a471fa5c
......@@ -1251,8 +1251,8 @@ is the cosine of A"
;; is negative.
(cond ((minusp-qd x)
(if (minusp-qd y)
(- (neg-qd +qd-pi+) arg)
(- +qd-pi+ arg)))
(sub-qd (neg-qd +qd-pi+) arg)
(sub-qd +qd-pi+ arg)))
(t
arg))))
......
......@@ -30,7 +30,7 @@
(defconstant +double-float-min-e+
-1073)
(defconstant +digits+
(defparameter +digits+
"0123456789")
) ; eval-when
......
......@@ -240,9 +240,23 @@
(declare (ignore x))
nil))
#+sbcl
(progn
(defun float-infinity-p (x)
(= (abs x) #.sb-ext:double-float-positive-infinity))
(defun float-nan-p (x)
(and (sb-kernel:float-infinity-or-nan-p x)
(not (float-infinity-p x))))
(defun float-trapping-nan-p (x)
(declare (ignore x))
nil)
) ; end progn
;; Default implementation. Assume we can't recognize any of these.
#-(or cmu allegro ccl)
#-(or cmu allegro ccl sbcl)
(progn
(defun float-infinity-p (x)
(declare (ignore x))
......
......@@ -1032,7 +1032,7 @@
finally
(error 'simple-error
:format-control "~<Continued fraction failed to converge after ~D iterations.~% Delta = ~S~>"
:format-arguments (list *max-cf-iterations* (/ c d))))))))
:format-arguments (list *max-cf-iterations* (div-qd c d))))))))
(defun tan-qd/duplication (x)
;; tan(x) = 2*tan(x/2)/(1-tan(x/2)^2)
......
......@@ -62,19 +62,30 @@
(defvar *null* (make-broadcast-stream))
(setf rt:*expected-failures*
#-acl
'(oct.atanh-branch-neg.1
oct.atanh-branch-pos.1
oct.elliptic-pi.n2.d-1
oct.elliptic-pi.n0.q
#+acl
'(oct.elliptic-pi.n0.q
gamma-incomplete-tail.4.q
bessel-j.neg-order.d.4
bessel-j-complex-arg.d.5
bessel-j-1/2-complex.d.1
bessel-j-1/2-complex.q.1)
#+acl
'(oct.elliptic-pi.n0.q
gamma-incomplete-tail.4.q
#+sbcl
'(oct.asin-branch-neg.5
oct.asin-branch-pos.1
oct.acos-branch-neg.5
oct.acos-branch-pos.1
oct.atanh-branch-neg.1
bessel-j.neg-order.d.4
bessel-j.neg-order.d.7
bessel-j.pos-order.d.1
bessel-j-complex-arg.d.4
bessel-j-1/2-complex.d.1
bessel-j-1/2-complex.q.1)
#-(or acl sbcl)
'(oct.atanh-branch-neg.1
oct.atanh-branch-pos.1
oct.elliptic-pi.n2.d-1
oct.elliptic-pi.n0.q
bessel-j.neg-order.d.4
bessel-j-complex-arg.d.5
bessel-j-1/2-complex.d.1
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment