From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Mon, 30 Oct 2006 10:53:45 +0000 (+0000)
Subject: 0.9.18.17: Hyperbolic functions for Win32
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=ddaf14f0438b5252d4d5d149f65921795c9a771d;p=sbcl.git

0.9.18.17: Hyperbolic functions for Win32
 * Lisp-side definitions for %TANH, %ASINH, %ACOSH, and %ATANH.
 * One sequence test tweaked to make it run on Windows.
---

diff --git a/NEWS b/NEWS
index 18b34db..e934acc 100644
--- a/NEWS
+++ b/NEWS
@@ -22,6 +22,7 @@ changes in sbcl-0.9.19 (1.0.0?) relative to sbcl-0.9.18:
     ** DIRECTORY now works correctly with :WILD-INFERIORS.
     ** DECODE-UNIVERSAL-TIME works on times before 00:00:00 January
        1st 1970 (although time timezone data will be unreliable).
+    ** Hyperbolic functions TANH, ASINH, ACOSH, and ATANH work.
 
 changes in sbcl-0.9.18 (1.0.beta?) relative to sbcl-0.9.17:
   * enhancement: SB-POSIX now supports cfsetispeed(3), cfsetospeed(3),
diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index 0f2b7a3..5477d6d 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -76,10 +76,30 @@
 #!-x86 (def-math-rtn "atan2" 2)
 (def-math-rtn "sinh" 1)
 (def-math-rtn "cosh" 1)
-#!-win32(def-math-rtn "tanh" 1)
-#!-win32(def-math-rtn "asinh" 1)
-#!-win32(def-math-rtn "acosh" 1)
-#!-win32(def-math-rtn "atanh" 1)
+#!-win32
+(progn
+  (def-math-rtn "tanh" 1)
+  (def-math-rtn "asinh" 1)
+  (def-math-rtn "acosh" 1)
+  (def-math-rtn "atanh" 1))
+#!+win32
+(progn
+  (declaim (inline %tanh))
+  (defun %tanh (number)
+    (/ (%sinh number) (%cosh number)))
+  (declaim (inline %asinh))
+  (defun %asinh (number)
+    (log (+ number (sqrt (+ (* number number) 1.0d0))) #.(exp 1.0d0)))
+  (declaim (inline %acosh))
+  (defun %acosh (number)
+    (log (+ number (sqrt (- (* number number) 1.0d0))) #.(exp 1.0d0)))
+  (declaim (inline %atanh))
+  (defun %atanh (number)
+    (let ((ratio (/ (1+ number) (1- number))))
+      ;; Were we effectively zero?
+      (if (= ratio -1.0d0)
+          0.0d0
+          (/ (log ratio #.(exp 1.0d0)) 2.0d0)))))
 
 ;;; exponential and logarithmic
 #!-x86 (def-math-rtn "exp" 1)
diff --git a/src/runtime/win32-os.c b/src/runtime/win32-os.c
index 9f945e8..0e6bc1c 100644
--- a/src/runtime/win32-os.c
+++ b/src/runtime/win32-os.c
@@ -50,6 +50,7 @@
 #include <sys/stat.h>
 #include <unistd.h>
 #include <shlobj.h>
+#include <math.h>
 
 #include <excpt.h>
 
@@ -57,7 +58,6 @@
 #include "thread.h"
 size_t os_vm_page_size;
 
-
 #include "gc.h"
 #include "gencgc-internal.h"
 
diff --git a/tests/debug.impure.lisp b/tests/debug.impure.lisp
index ea5d8b7..9c6473d 100644
--- a/tests/debug.impure.lisp
+++ b/tests/debug.impure.lisp
@@ -172,10 +172,10 @@
                    (list '(flet not-optimized))
                    (list '(flet test) #'not-optimized))))))
 
-;;; Division by zero was a common error on PPC.  It depended on the
+;;; Division by zero was a common error on PPC. It depended on the
 ;;; return function either being before INTEGER-/-INTEGER in memory,
-;;; or more than MOST-POSITIVE-FIXNUM bytes ahead.  It also depends on
-;;; INTEGER-/-INTEGER calling SIGNED-TRUNCATE.  I believe Raymond Toy
+;;; or more than MOST-POSITIVE-FIXNUM bytes ahead. It also depends on
+;;; INTEGER-/-INTEGER calling SIGNED-TRUNCATE. I believe Raymond Toy
 ;;; says that the Sparc backend (at least for CMUCL) inlines this, so
 ;;; if SBCL does the same this test is probably not good for the
 ;;; Sparc.
diff --git a/tests/seq.impure.lisp b/tests/seq.impure.lisp
index 0d3269b..f91e797 100644
--- a/tests/seq.impure.lisp
+++ b/tests/seq.impure.lisp
@@ -515,7 +515,9 @@
 (sequence-bounding-indices-test
  (format t "~&/Function PARSE-NAMESTRING")
  (setf (fill-pointer string) 10)
- (setf (subseq string 0 10) "/dev/ /tmp")
+ (setf (subseq string 0 10) 
+       #-win32 "/dev/ /tmp"
+       #+win32 "C:/   NUL")
  (setf (fill-pointer string) 5)
  (assert (truename (parse-namestring string nil *default-pathname-defaults*
                                      :start 0 :end 5)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 2334483..d2bf15b 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.18.16"
+"0.9.18.17"