[git] CMU Common Lisp branch master updated. snapshot-2014-06-9-gcc7145c
Raymond Toy
rtoy at common-lisp.net
Tue Jul 22 15:10:22 UTC 2014
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".
The branch, master has been updated
via cc7145cac2b298800b0650938d559c11c35caa24 (commit)
via 7a11c612892beceb575257c8b2e7fe239964f0e7 (commit)
from e934d7ccdc07f355d29014b670605d1bc0b92dc1 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit cc7145cac2b298800b0650938d559c11c35caa24
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Jul 22 08:09:42 2014 -0700
Comment out all of the trig functions in lisp in favor of calling out
to C. Also add interface to sincos function in C.
This needs more testing and currently some tests fail.
diff --git a/src/code/irrat.lisp b/src/code/irrat.lisp
index bcd40c3..6d17c6c 100644
--- a/src/code/irrat.lisp
+++ b/src/code/irrat.lisp
@@ -197,6 +197,20 @@
(y0 double-float :out)
(y1 double-float :out))
+(declaim (inline %%sincos))
+(alien:def-alien-routine ("sincos" %%sincos) c-call:void
+ (x double-float)
+ (s double-float :out)
+ (c double-float :out))
+
+(declaim (inline %sincos))
+(defun %sincos (x)
+ (declare (double-float x))
+ (multiple-value-bind (ign s c)
+ (%%sincos x)
+ (values s c)))
+
+#||
;; Implement sin/cos/tan in Lisp. These are based on the routines
;; from fdlibm.
@@ -603,7 +617,7 @@
(let ((flag (- 1 (ash (logand n 1) 1))))
;; flag = 1 if n even, -1 if n odd
(kernel-tan y0 y1 flag)))))))
-
+||#
;; Compute sin and cos of x, simultaneously.
(defun %sincos (x)
(declare (double-float x)
@@ -628,7 +642,7 @@
(3
(values (- (kernel-cos y0 y1))
(kernel-sin y0 y1 1))))))))
-(declaim (ext:end-block))
+;;(declaim (ext:end-block))
;;;; Power functions.
commit 7a11c612892beceb575257c8b2e7fe239964f0e7
Author: Raymond Toy <toy.raymond at gmail.com>
Date: Tue Jul 22 08:07:31 2014 -0700
Add implmeentation of sincos in C.
Darwin/x86 doesn't have sincos in libm so include sincos when building
on Darwin.
diff --git a/src/lisp/Config.x86_darwin b/src/lisp/Config.x86_darwin
index 39c09bd..2af8d77 100644
--- a/src/lisp/Config.x86_darwin
+++ b/src/lisp/Config.x86_darwin
@@ -17,3 +17,14 @@ OS_LINK_FLAGS = -m32 $(MIN_VER)
OS_LIBS =
EXEC_FINAL_OBJ = exec-final.o
+
+OS_SRC += sincos.c k_sin.o k_cos.o
+
+sincos.o : sincos.c
+ $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $<
+
+k_sin.o : k_sin.c
+ $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $<
+
+k_cos.o : k_cos.c
+ $(CC) -c $(CFLAGS) $(CPPFLAGS) $(CC_REM_PIO2) $<
diff --git a/src/lisp/sincos.c b/src/lisp/sincos.c
new file mode 100644
index 0000000..f5db8b3
--- /dev/null
+++ b/src/lisp/sincos.c
@@ -0,0 +1,43 @@
+#include "fdlibm.h"
+
+void sincos (double x, double *s, double *c)
+{
+ int ix;
+ union { int i[2]; double d; } ux;
+
+ ux.d = x;
+ ix = ux.i[HIWORD] & 0x7fffffff;
+
+ /* |x| ~< pi/4 */
+ if (ix < 0x3fe921fb) {
+ *s = __kernel_sin(x, 0.0, 0);
+ *c = __kernel_cos(x, 0.0);
+ } else {
+ /* Argument reduction needed */
+ double y[2];
+ int n;
+
+ n = __ieee754_rem_pio2(x, y);
+
+ switch (n & 3) {
+ case 0:
+ *s = __kernel_sin(y[0], y[1], 1);
+ *c = __kernel_cos(y[0], y[1]);
+ break;
+ case 1:
+ *s = __kernel_cos(y[0], y[1]);
+ *c = - __kernel_sin(y[0], y[1], 1);
+ break;
+ case 2:
+ *s = - __kernel_sin(y[0], y[1], 1);
+ *c = - __kernel_cos(y[0], y[1]);
+ break;
+ case 3:
+ *s = - __kernel_cos(y[0], y[1]);
+ *c = __kernel_sin(y[0], y[1], 1);
+ break;
+ }
+ }
+
+ return;
+}
-----------------------------------------------------------------------
Summary of changes:
src/code/irrat.lisp | 18 ++++++++++++++++--
src/lisp/Config.x86_darwin | 11 +++++++++++
src/lisp/sincos.c | 43 +++++++++++++++++++++++++++++++++++++++++++
3 files changed, 70 insertions(+), 2 deletions(-)
create mode 100644 src/lisp/sincos.c
hooks/post-receive
--
CMU Common Lisp
More information about the cmucl-cvs
mailing list