summaryrefslogtreecommitdiff
path: root/libmath
diff options
context:
space:
mode:
authorCharles.Forsyth <devnull@localhost>2006-12-22 17:07:39 +0000
committerCharles.Forsyth <devnull@localhost>2006-12-22 17:07:39 +0000
commit37da2899f40661e3e9631e497da8dc59b971cbd0 (patch)
treecbc6d4680e347d906f5fa7fca73214418741df72 /libmath
parent54bc8ff236ac10b3eaa928fd6bcfc0cdb2ba46ae (diff)
20060303a
Diffstat (limited to 'libmath')
-rw-r--r--libmath/FPcontrol-FreeBSD.c78
-rw-r--r--libmath/FPcontrol-Hp.c103
-rw-r--r--libmath/FPcontrol-Inferno.c77
-rw-r--r--libmath/FPcontrol-Irix.c102
-rw-r--r--libmath/FPcontrol-Linux.c78
-rw-r--r--libmath/FPcontrol-MacOSX.c94
-rw-r--r--libmath/FPcontrol-Nt.c82
-rw-r--r--libmath/FPcontrol-Plan9.c1
-rw-r--r--libmath/FPcontrol-Solaris.c99
-rw-r--r--libmath/FPcontrol-Unixware.c77
-rw-r--r--libmath/NOTICE29
-rw-r--r--libmath/bin/fdlibm-stubs71
-rw-r--r--libmath/bin/unif_dtoa37
-rw-r--r--libmath/bin/unif_fdlibm20
-rw-r--r--libmath/blas.c61
-rw-r--r--libmath/dtoa.c1807
-rw-r--r--libmath/fdim.c30
-rw-r--r--libmath/fdlibm/e_acos.c97
-rw-r--r--libmath/fdlibm/e_acosh.c57
-rw-r--r--libmath/fdlibm/e_asin.c106
-rw-r--r--libmath/fdlibm/e_atan2.c115
-rw-r--r--libmath/fdlibm/e_atanh.c60
-rw-r--r--libmath/fdlibm/e_cosh.c81
-rw-r--r--libmath/fdlibm/e_exp.c149
-rw-r--r--libmath/fdlibm/e_fmod.c132
-rw-r--r--libmath/fdlibm/e_hypot.c111
-rw-r--r--libmath/fdlibm/e_j0.c375
-rw-r--r--libmath/fdlibm/e_j1.c370
-rw-r--r--libmath/fdlibm/e_jn.c259
-rw-r--r--libmath/fdlibm/e_lgamma_r.c291
-rw-r--r--libmath/fdlibm/e_log.c131
-rw-r--r--libmath/fdlibm/e_log10.c83
-rw-r--r--libmath/fdlibm/e_pow.c296
-rw-r--r--libmath/fdlibm/e_rem_pio2.c159
-rw-r--r--libmath/fdlibm/e_remainder.c69
-rw-r--r--libmath/fdlibm/e_sinh.c74
-rw-r--r--libmath/fdlibm/e_sqrt.c442
-rw-r--r--libmath/fdlibm/fdlibm.h153
-rw-r--r--libmath/fdlibm/k_cos.c84
-rw-r--r--libmath/fdlibm/k_rem_pio2.c300
-rw-r--r--libmath/fdlibm/k_sin.c66
-rw-r--r--libmath/fdlibm/k_tan.c117
-rw-r--r--libmath/fdlibm/readme261
-rw-r--r--libmath/fdlibm/s_asinh.c53
-rw-r--r--libmath/fdlibm/s_atan.c114
-rw-r--r--libmath/fdlibm/s_cbrt.c75
-rw-r--r--libmath/fdlibm/s_ceil.c70
-rw-r--r--libmath/fdlibm/s_copysign.c27
-rw-r--r--libmath/fdlibm/s_cos.c74
-rw-r--r--libmath/fdlibm/s_erf.c297
-rw-r--r--libmath/fdlibm/s_expm1.c208
-rw-r--r--libmath/fdlibm/s_fabs.c25
-rw-r--r--libmath/fdlibm/s_finite.c27
-rw-r--r--libmath/fdlibm/s_floor.c71
-rw-r--r--libmath/fdlibm/s_ilogb.c42
-rw-r--r--libmath/fdlibm/s_isnan.c30
-rw-r--r--libmath/fdlibm/s_log1p.c157
-rw-r--r--libmath/fdlibm/s_modf.c72
-rw-r--r--libmath/fdlibm/s_nextafter.c74
-rw-r--r--libmath/fdlibm/s_rint.c88
-rw-r--r--libmath/fdlibm/s_scalbn.c55
-rw-r--r--libmath/fdlibm/s_sin.c74
-rw-r--r--libmath/fdlibm/s_tan.c68
-rw-r--r--libmath/fdlibm/s_tanh.c74
-rw-r--r--libmath/g_fmt.c106
-rw-r--r--libmath/gemm.c167
-rw-r--r--libmath/gfltconv.c123
-rw-r--r--libmath/mkfile67
-rw-r--r--libmath/pow10.c8
69 files changed, 9530 insertions, 0 deletions
diff --git a/libmath/FPcontrol-FreeBSD.c b/libmath/FPcontrol-FreeBSD.c
new file mode 100644
index 00000000..a4419c8f
--- /dev/null
+++ b/libmath/FPcontrol-FreeBSD.c
@@ -0,0 +1,78 @@
+#include "lib9.h"
+#include "fpuctl.h"
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ setfsr(0); /* Clear pending exceptions */
+ setfcr(FPPDBL|FPRNR|FPINVAL|FPZDIV|FPUNFL|FPOVFL);
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0, fsr9 = getfsr();
+ /* on specific machines, could be table lookup */
+ if(fsr9&FPAINEX) fsr |= INEX;
+ if(fsr9&FPAOVFL) fsr |= OVFL;
+ if(fsr9&FPAUNFL) fsr |= UNFL;
+ if(fsr9&FPAZDIV) fsr |= ZDIV;
+ if(fsr9&FPAINVAL) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FPAINEX;
+ if(fsr&OVFL) fsr9 |= FPAOVFL;
+ if(fsr&UNFL) fsr9 |= FPAUNFL;
+ if(fsr&ZDIV) fsr9 |= FPAZDIV;
+ if(fsr&INVAL) fsr9 |= FPAINVAL;
+ setfsr(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0, fcr9 = getfcr();
+ switch(fcr9&FPRMASK){
+ case FPRNR: fcr = RND_NR; break;
+ case FPRNINF: fcr = RND_NINF; break;
+ case FPRPINF: fcr = RND_PINF; break;
+ case FPRZ: fcr = RND_Z; break;
+ }
+ if(fcr9&FPINEX) fcr |= INEX;
+ if(fcr9&FPOVFL) fcr |= OVFL;
+ if(fcr9&FPUNFL) fcr |= UNFL;
+ if(fcr9&FPZDIV) fcr |= ZDIV;
+ if(fcr9&FPINVAL) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong fcr9 = FPPDBL;
+ ulong old = getFPcontrol();
+ fcr = (fcr&mask) | (old&~mask);
+ if(fcr&INEX) fcr9 |= FPINEX;
+ if(fcr&OVFL) fcr9 |= FPOVFL;
+ if(fcr&UNFL) fcr9 |= FPUNFL;
+ if(fcr&ZDIV) fcr9 |= FPZDIV;
+ if(fcr&INVAL) fcr9 |= FPINVAL;
+ switch(fcr&RND_MASK){
+ case RND_NR: fcr9 |= FPRNR; break;
+ case RND_NINF: fcr9 |= FPRNINF; break;
+ case RND_PINF: fcr9 |= FPRPINF; break;
+ case RND_Z: fcr9 |= FPRZ; break;
+ }
+ setfcr(fcr9);
+ return(old&mask);
+}
+
diff --git a/libmath/FPcontrol-Hp.c b/libmath/FPcontrol-Hp.c
new file mode 100644
index 00000000..34be3dd9
--- /dev/null
+++ b/libmath/FPcontrol-Hp.c
@@ -0,0 +1,103 @@
+#include <math.h>
+#include "lib9.h"
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ fpsetdefaults();
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0;
+ fp_except fsr9=fpgetsticky();
+ if(fsr9&FP_X_IMP) fsr |= INEX;
+ if(fsr9&FP_X_OFL) fsr |= OVFL;
+ if(fsr9&FP_X_UFL) fsr |= UNFL;
+ if(fsr9&FP_X_DZ) fsr |= ZDIV;
+ if(fsr9&FP_X_INV) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FP_X_IMP;
+ if(fsr&OVFL) fsr9 |= FP_X_OFL;
+ if(fsr&UNFL) fsr9 |= FP_X_UFL;
+ if(fsr&ZDIV) fsr9 |= FP_X_DZ;
+ if(fsr&INVAL) fsr9 |= FP_X_INV;
+ fpsetmask(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0;
+ fp_except fpc = fpgetmask();
+ fp_rnd fpround = fpgetround();
+
+ if(fpc&FP_X_INV)
+ fcr|=INVAL;
+ if(fpc&FP_X_DZ)
+ fcr|=ZDIV;
+ if(fpc&FP_X_OFL)
+ fcr|=OVFL;
+ if(fpc&FP_X_UFL)
+ fcr|=UNFL;
+ if(fpc&FP_X_IMP)
+ fcr|=INEX;
+ switch(fpround){
+ case FP_RZ:
+ fcr|=RND_Z;
+ break;
+ case FP_RN:
+ fcr|=RND_NINF;
+ break;
+ case FP_RP:
+ fcr|=RND_PINF;
+ break;
+ case FP_RM:
+ fcr|=RND_NR;
+ }
+ return fcr;
+}
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ fp_except fc;
+ fp_rnd round;
+ ulong old = getFPcontrol();
+ ulong changed = mask&(fcr^old);
+ fcr = (fcr&mask) | (old&~mask);
+
+ if(fcr&INEX) fc |= FP_X_IMP;
+ if(fcr&OVFL) fc |= FP_X_OFL;
+ if(fcr&UNFL) fc |= FP_X_UFL;
+ if(fcr&ZDIV) fc |= FP_X_DZ;
+ if(fcr&INVAL) fc |= FP_X_INV;
+
+ switch(fcr&RND_MASK){
+ case RND_NR: round |= FP_RM; break;
+ case RND_NINF: round |= FP_RN; break;
+ case RND_PINF: round |= FP_RP; break;
+ case RND_Z: round |= FP_RZ; break;
+ }
+
+ fpsetround(round);
+ fpsetmask(fc);
+ return(old&mask);
+}
+
+FPsave(fp_control *fpu) {
+ *fpu= fpgetcontrol();
+}
+FPrestore(fp_control *fpu) {
+ fpsetcontrol(*fpu);
+}
diff --git a/libmath/FPcontrol-Inferno.c b/libmath/FPcontrol-Inferno.c
new file mode 100644
index 00000000..13b64690
--- /dev/null
+++ b/libmath/FPcontrol-Inferno.c
@@ -0,0 +1,77 @@
+#include "lib9.h"
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ ulong fcr9 = FPPDBL|FPRNR|FPINVAL|FPZDIV|FPUNFL|FPOVFL;
+ setfcr(fcr9);
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0, fsr9 = getfsr();
+ /* on specific machines, could be table lookup */
+ if(fsr9&FPAINEX) fsr |= INEX;
+ if(fsr9&FPAOVFL) fsr |= OVFL;
+ if(fsr9&FPAUNFL) fsr |= UNFL;
+ if(fsr9&FPAZDIV) fsr |= ZDIV;
+ if(fsr9&FPAINVAL) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FPAINEX;
+ if(fsr&OVFL) fsr9 |= FPAOVFL;
+ if(fsr&UNFL) fsr9 |= FPAUNFL;
+ if(fsr&ZDIV) fsr9 |= FPAZDIV;
+ if(fsr&INVAL) fsr9 |= FPAINVAL;
+ setfsr(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0, fcr9 = getfcr();
+ switch(fcr9&FPRMASK){
+ case FPRNR: fcr = RND_NR; break;
+ case FPRNINF: fcr = RND_NINF; break;
+ case FPRPINF: fcr = RND_PINF; break;
+ case FPRZ: fcr = RND_Z; break;
+ }
+ if(fcr9&FPINEX) fcr |= INEX;
+ if(fcr9&FPOVFL) fcr |= OVFL;
+ if(fcr9&FPUNFL) fcr |= UNFL;
+ if(fcr9&FPZDIV) fcr |= ZDIV;
+ if(fcr9&FPINVAL) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong fcr9 = FPPDBL;
+ ulong old = getFPcontrol();
+ fcr = (fcr&mask) | (old&~mask);
+ if(fcr&INEX) fcr9 |= FPINEX;
+ if(fcr&OVFL) fcr9 |= FPOVFL;
+ if(fcr&UNFL) fcr9 |= FPUNFL;
+ if(fcr&ZDIV) fcr9 |= FPZDIV;
+ if(fcr&INVAL) fcr9 |= FPINVAL;
+ switch(fcr&RND_MASK){
+ case RND_NR: fcr9 |= FPRNR; break;
+ case RND_NINF: fcr9 |= FPRNINF; break;
+ case RND_PINF: fcr9 |= FPRPINF; break;
+ case RND_Z: fcr9 |= FPRZ; break;
+ }
+ setfcr(fcr9);
+ return(old&mask);
+}
+
diff --git a/libmath/FPcontrol-Irix.c b/libmath/FPcontrol-Irix.c
new file mode 100644
index 00000000..7a215736
--- /dev/null
+++ b/libmath/FPcontrol-Irix.c
@@ -0,0 +1,102 @@
+/* Load programs with -lfpe. See man pages for fpc and /usr/include/sigfpe.h, sys/fpu.h. */
+#include <stdlib.h>
+#include <sigfpe.h>
+#include <sys/fpu.h>
+typedef unsigned int ulong;
+#include "mathi.h"
+
+/*
+ * Irix does not permit a use handled SIGFPE since the floating point unit
+ * cannot be IEEE754 compliant without some software, so we must vector using
+ * the library
+ */
+extern void trapFPE(unsigned exception[5], int value[2]);
+
+void
+FPinit(void)
+{
+ union fpc_csr csr;
+ int i;
+ for(i=1; i<=4; i++) {
+ sigfpe_[i].repls = _USER_DETERMINED;
+ sigfpe_[i].abort = 2;
+ }
+ handle_sigfpes(_ON,
+ _EN_UNDERFL|_EN_OVERFL|_EN_DIVZERO|_EN_INVALID,
+ trapFPE,
+ _ABORT_ON_ERROR, 0);
+}
+
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0;
+ union fpc_csr csr;
+ csr.fc_word = get_fpc_csr();
+ if(csr.fc_struct.se_inexact) fsr |= INEX;
+ if(csr.fc_struct.se_overflow) fsr |= OVFL;
+ if(csr.fc_struct.se_underflow) fsr |= UNFL;
+ if(csr.fc_struct.se_divide0) fsr |= ZDIV;
+ if(csr.fc_struct.se_invalid) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong old = getFPstatus();
+ union fpc_csr csr;
+ csr.fc_word = get_fpc_csr();
+ fsr = (fsr&mask) | (old&~mask);
+ csr.fc_struct.se_inexact = (fsr&INEX)?1:0;
+ csr.fc_struct.se_overflow = (fsr&OVFL)?1:0;
+ csr.fc_struct.se_underflow = (fsr&UNFL)?1:0;
+ csr.fc_struct.se_divide0 = (fsr&ZDIV)?1:0;
+ csr.fc_struct.se_invalid = (fsr&INVAL)?1:0;
+ set_fpc_csr(csr.fc_word);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0;
+ union fpc_csr csr;
+ double junk = fabs(1.); /* avoid bug mentioned in sigfpes man page [ehg] */
+ csr.fc_word = get_fpc_csr();
+ switch(csr.fc_struct.rounding_mode){
+ case ROUND_TO_NEAREST: fcr = RND_NR; break;
+ case ROUND_TO_MINUS_INFINITY: fcr = RND_NINF; break;
+ case ROUND_TO_PLUS_INFINITY: fcr = RND_PINF; break;
+ case ROUND_TO_ZERO: fcr = RND_Z; break;
+ }
+ if(csr.fc_struct.en_inexact) fcr |= INEX;
+ if(csr.fc_struct.en_overflow) fcr |= OVFL;
+ if(csr.fc_struct.en_underflow) fcr |= UNFL;
+ if(csr.fc_struct.en_divide0) fcr |= ZDIV;
+ if(csr.fc_struct.en_invalid) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong old = getFPcontrol();
+ union fpc_csr csr;
+ csr.fc_word = get_fpc_csr();
+ fcr = (fcr&mask) | (old&~mask);
+ csr.fc_struct.en_inexact = (fcr&INEX)?1:0;
+ csr.fc_struct.en_overflow = (fcr&OVFL)?1:0;
+ csr.fc_struct.en_underflow = (fcr&UNFL)?1:0;
+ csr.fc_struct.en_divide0 = (fcr&ZDIV)?1:0;
+ csr.fc_struct.en_invalid = (fcr&INVAL)?1:0;
+ switch(fcr&RND_MASK){
+ case RND_NR: csr.fc_struct.rounding_mode = ROUND_TO_NEAREST; break;
+ case RND_NINF: csr.fc_struct.rounding_mode = ROUND_TO_MINUS_INFINITY; break;
+ case RND_PINF: csr.fc_struct.rounding_mode = ROUND_TO_PLUS_INFINITY; break;
+ case RND_Z: csr.fc_struct.rounding_mode = ROUND_TO_ZERO; break;
+ }
+ set_fpc_csr(csr.fc_word);
+ return(old&mask);
+}
diff --git a/libmath/FPcontrol-Linux.c b/libmath/FPcontrol-Linux.c
new file mode 100644
index 00000000..a4419c8f
--- /dev/null
+++ b/libmath/FPcontrol-Linux.c
@@ -0,0 +1,78 @@
+#include "lib9.h"
+#include "fpuctl.h"
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ setfsr(0); /* Clear pending exceptions */
+ setfcr(FPPDBL|FPRNR|FPINVAL|FPZDIV|FPUNFL|FPOVFL);
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0, fsr9 = getfsr();
+ /* on specific machines, could be table lookup */
+ if(fsr9&FPAINEX) fsr |= INEX;
+ if(fsr9&FPAOVFL) fsr |= OVFL;
+ if(fsr9&FPAUNFL) fsr |= UNFL;
+ if(fsr9&FPAZDIV) fsr |= ZDIV;
+ if(fsr9&FPAINVAL) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FPAINEX;
+ if(fsr&OVFL) fsr9 |= FPAOVFL;
+ if(fsr&UNFL) fsr9 |= FPAUNFL;
+ if(fsr&ZDIV) fsr9 |= FPAZDIV;
+ if(fsr&INVAL) fsr9 |= FPAINVAL;
+ setfsr(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0, fcr9 = getfcr();
+ switch(fcr9&FPRMASK){
+ case FPRNR: fcr = RND_NR; break;
+ case FPRNINF: fcr = RND_NINF; break;
+ case FPRPINF: fcr = RND_PINF; break;
+ case FPRZ: fcr = RND_Z; break;
+ }
+ if(fcr9&FPINEX) fcr |= INEX;
+ if(fcr9&FPOVFL) fcr |= OVFL;
+ if(fcr9&FPUNFL) fcr |= UNFL;
+ if(fcr9&FPZDIV) fcr |= ZDIV;
+ if(fcr9&FPINVAL) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong fcr9 = FPPDBL;
+ ulong old = getFPcontrol();
+ fcr = (fcr&mask) | (old&~mask);
+ if(fcr&INEX) fcr9 |= FPINEX;
+ if(fcr&OVFL) fcr9 |= FPOVFL;
+ if(fcr&UNFL) fcr9 |= FPUNFL;
+ if(fcr&ZDIV) fcr9 |= FPZDIV;
+ if(fcr&INVAL) fcr9 |= FPINVAL;
+ switch(fcr&RND_MASK){
+ case RND_NR: fcr9 |= FPRNR; break;
+ case RND_NINF: fcr9 |= FPRNINF; break;
+ case RND_PINF: fcr9 |= FPRPINF; break;
+ case RND_Z: fcr9 |= FPRZ; break;
+ }
+ setfcr(fcr9);
+ return(old&mask);
+}
+
diff --git a/libmath/FPcontrol-MacOSX.c b/libmath/FPcontrol-MacOSX.c
new file mode 100644
index 00000000..e36a5e5b
--- /dev/null
+++ b/libmath/FPcontrol-MacOSX.c
@@ -0,0 +1,94 @@
+#include "lib9.h"
+#include "fpuctl.h"
+#include "mathi.h"
+
+#include<stdio.h>
+
+void PPC_PrintFPSCR()
+{
+ ppc_fp_scr_t fpscr;
+
+ fpscr = get_fp_scr();
+ fprintf(stderr, "FPSCR = 0x%08x : 0x%08x\n",
+ ((unsigned int *)&fpscr)[0],
+ ((unsigned int *)&fpscr)[1]);
+ fprintf(stderr, "FPSCR[ve] = %d\n", fpscr.ve);
+ fprintf(stderr, "FPSCR[ze] = %d\n", fpscr.ze);
+ fprintf(stderr, "FPSCR[ue] = %d\n", fpscr.ue);
+ fprintf(stderr, "FPSCR[oe] = %d\n", fpscr.oe);
+}
+
+void
+FPinit(void)
+{
+ ulong fcr9 = FPPDBL|FPRNR|FPINVAL|FPZDIV|FPUNFL|FPOVFL;
+ setfsr(0); /* Clear pending exceptions */
+ setfcr(fcr9);
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0, fsr9 = getfsr();
+ /* on specific machines, could be table lookup */
+ if(fsr9&FPAINEX) fsr |= INEX;
+ if(fsr9&FPAOVFL) fsr |= OVFL;
+ if(fsr9&FPAUNFL) fsr |= UNFL;
+ if(fsr9&FPAZDIV) fsr |= ZDIV;
+ if(fsr9&FPAINVAL) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FPAINEX;
+ if(fsr&OVFL) fsr9 |= FPAOVFL;
+ if(fsr&UNFL) fsr9 |= FPAUNFL;
+ if(fsr&ZDIV) fsr9 |= FPAZDIV;
+ if(fsr&INVAL) fsr9 |= FPAINVAL;
+ setfsr(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0, fcr9 = getfcr();
+ switch(fcr9&FPRMASK){
+ case FPRNR: fcr = RND_NR; break;
+ case FPRNINF: fcr = RND_NINF; break;
+ case FPRPINF: fcr = RND_PINF; break;
+ case FPRZ: fcr = RND_Z; break;
+ }
+ if(fcr9&FPINEX) fcr |= INEX;
+ if(fcr9&FPOVFL) fcr |= OVFL;
+ if(fcr9&FPUNFL) fcr |= UNFL;
+ if(fcr9&FPZDIV) fcr |= ZDIV;
+ if(fcr9&FPINVAL) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong fcr9 = FPPDBL;
+ ulong old = getFPcontrol();
+ fcr = (fcr&mask) | (old&~mask);
+ if(fcr&INEX) fcr9 |= FPINEX;
+ if(fcr&OVFL) fcr9 |= FPOVFL;
+ if(fcr&UNFL) fcr9 |= FPUNFL;
+ if(fcr&ZDIV) fcr9 |= FPZDIV;
+ if(fcr&INVAL) fcr9 |= FPINVAL;
+ switch(fcr&RND_MASK){
+ case RND_NR: fcr9 |= FPRNR; break;
+ case RND_NINF: fcr9 |= FPRNINF; break;
+ case RND_PINF: fcr9 |= FPRPINF; break;
+ case RND_Z: fcr9 |= FPRZ; break;
+ }
+ setfcr(fcr9);
+ return(old&mask);
+}
diff --git a/libmath/FPcontrol-Nt.c b/libmath/FPcontrol-Nt.c
new file mode 100644
index 00000000..6a3fb22d
--- /dev/null
+++ b/libmath/FPcontrol-Nt.c
@@ -0,0 +1,82 @@
+#include "lib9.h"
+#include <float.h>
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ _controlfp(_EM_INEXACT,_MCW_EM); // abort on underflow, etc.
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0, fsr32 = _statusfp();
+ if(fsr32&_SW_INEXACT) fsr |= INEX;
+ if(fsr32&_SW_OVERFLOW) fsr |= OVFL;
+ if(fsr32&_SW_UNDERFLOW) fsr |= UNFL;
+ if(fsr32&_SW_ZERODIVIDE) fsr |= ZDIV;
+ if(fsr32&_SW_INVALID) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr!=old){
+ _clearfp();
+ if(fsr){
+ ulong fcr = _controlfp(0,0);
+ double x = 1., y = 1e200, z = 0.;
+ _controlfp(_MCW_EM,_MCW_EM);
+ if(fsr&INEX) z = x + y;
+ if(fsr&OVFL) z = y*y;
+ if(fsr&UNFL) z = (x/y)/y;
+ if(fsr&ZDIV) z = x/z;
+ if(fsr&INVAL) z = z/z;
+ _controlfp(fcr,_MCW_EM);
+ }
+ }
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr, fcr32 = _controlfp(0,0);
+ switch(fcr32&_MCW_RC){
+ case _RC_NEAR: fcr = RND_NR; break;
+ case _RC_DOWN: fcr = RND_NINF; break;
+ case _RC_UP: fcr = RND_PINF; break;
+ case _RC_CHOP: fcr = RND_Z; break;
+ }
+ if(!(fcr32&_EM_INEXACT)) fcr |= INEX;
+ if(!(fcr32&_EM_OVERFLOW)) fcr |= OVFL;
+ if(!(fcr32&_EM_UNDERFLOW)) fcr |= UNFL;
+ if(!(fcr32&_EM_ZERODIVIDE)) fcr |= ZDIV;
+ if(!(fcr32&_EM_INVALID)) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong old = getFPcontrol();
+ ulong fcr32 = _MCW_EM, mask32 = _MCW_RC|_MCW_EM;
+ fcr = (fcr&mask) | (old&~mask);
+ if(fcr&INEX) fcr32 ^= _EM_INEXACT;
+ if(fcr&OVFL) fcr32 ^= _EM_OVERFLOW;
+ if(fcr&UNFL) fcr32 ^= _EM_UNDERFLOW;
+ if(fcr&ZDIV) fcr32 ^= _EM_ZERODIVIDE;
+ if(fcr&INVAL) fcr32 ^= _EM_INVALID;
+ switch(fcr&RND_MASK){
+ case RND_NR: fcr32 |= _RC_NEAR; break;
+ case RND_NINF: fcr32 |= _RC_DOWN; break;
+ case RND_PINF: fcr32 |= _RC_UP; break;
+ case RND_Z: fcr32 |= _RC_CHOP; break;
+ }
+ _controlfp(fcr32,mask32);
+ return(old&mask);
+}
diff --git a/libmath/FPcontrol-Plan9.c b/libmath/FPcontrol-Plan9.c
new file mode 100644
index 00000000..7a0e2fe2
--- /dev/null
+++ b/libmath/FPcontrol-Plan9.c
@@ -0,0 +1 @@
+#include "FPcontrol-Inferno.c"
diff --git a/libmath/FPcontrol-Solaris.c b/libmath/FPcontrol-Solaris.c
new file mode 100644
index 00000000..b7a15ee5
--- /dev/null
+++ b/libmath/FPcontrol-Solaris.c
@@ -0,0 +1,99 @@
+#include <ieeefp.h>
+#include "lib9.h"
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ fpsetsticky(0); /* Clear pending exceptions */
+ fpsetround(FP_RN);
+ fpsetmask(FP_X_INV|FP_X_DZ|FP_X_UFL|FP_X_OFL);
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0;
+ fp_except fsr9=fpgetsticky();
+ if(fsr9&FP_X_IMP) fsr |= INEX;
+ if(fsr9&FP_X_OFL) fsr |= OVFL;
+ if(fsr9&FP_X_UFL) fsr |= UNFL;
+ if(fsr9&FP_X_DZ) fsr |= ZDIV;
+ if(fsr9&FP_X_INV) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FP_X_IMP;
+ if(fsr&OVFL) fsr9 |= FP_X_OFL;
+ if(fsr&UNFL) fsr9 |= FP_X_UFL;
+ if(fsr&ZDIV) fsr9 |= FP_X_DZ;
+ if(fsr&INVAL) fsr9 |= FP_X_INV;
+ /* fpsetmask(fsr9); */
+ fpsetsticky(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0;
+ fp_except fpc = fpgetmask();
+ fp_rnd fpround = fpgetround();
+
+ if(fpc&FP_X_INV)
+ fcr|=INVAL;
+ if(fpc&FP_X_DZ)
+ fcr|=ZDIV;
+ if(fpc&FP_X_OFL)
+ fcr|=OVFL;
+ if(fpc&FP_X_UFL)
+ fcr|=UNFL;
+ if(fpc&FP_X_IMP)
+ fcr|=INEX;
+ switch(fpround){
+ case FP_RZ:
+ fcr|=RND_Z;
+ break;
+ case FP_RN:
+ fcr|=RND_NINF;
+ break;
+ case FP_RP:
+ fcr|=RND_PINF;
+ break;
+ case FP_RM:
+ fcr|=RND_NR;
+ }
+ return fcr;
+}
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ fp_except fc=0;
+ fp_rnd round;
+ ulong old = getFPcontrol();
+ ulong changed = mask&(fcr^old);
+ fcr = (fcr&mask) | (old&~mask);
+
+ if(fcr&INEX) fc |= FP_X_IMP;
+ if(fcr&OVFL) fc |= FP_X_OFL;
+ if(fcr&UNFL) fc |= FP_X_UFL;
+ if(fcr&ZDIV) fc |= FP_X_DZ;
+ if(fcr&INVAL) fc |= FP_X_INV;
+
+ switch(fcr&RND_MASK){
+ case RND_NR: round |= FP_RM; break;
+ case RND_NINF: round |= FP_RN; break;
+ case RND_PINF: round |= FP_RP; break;
+ case RND_Z: round |= FP_RZ; break;
+ }
+
+ fpsetround(round);
+ fpsetmask(fc);
+ return(old&mask);
+}
diff --git a/libmath/FPcontrol-Unixware.c b/libmath/FPcontrol-Unixware.c
new file mode 100644
index 00000000..7d9ed018
--- /dev/null
+++ b/libmath/FPcontrol-Unixware.c
@@ -0,0 +1,77 @@
+#include "lib9.h"
+#include "fpuctl.h"
+#include "mathi.h"
+
+void
+FPinit(void)
+{
+ setfsr(0); /* Clear pending exceptions */
+ setfcr(FPPDBL|FPRNR|FPINVAL|FPZDIV|FPUNFL|FPOVFL);
+}
+
+ulong
+getFPstatus(void)
+{
+ ulong fsr = 0, fsr9 = getfsr();
+ /* on specific machines, could be table lookup */
+ if(fsr9&FPAINEX) fsr |= INEX;
+ if(fsr9&FPAOVFL) fsr |= OVFL;
+ if(fsr9&FPAUNFL) fsr |= UNFL;
+ if(fsr9&FPAZDIV) fsr |= ZDIV;
+ if(fsr9&FPAINVAL) fsr |= INVAL;
+ return fsr;
+}
+
+ulong
+FPstatus(ulong fsr, ulong mask)
+{
+ ulong fsr9 = 0;
+ ulong old = getFPstatus();
+ fsr = (fsr&mask) | (old&~mask);
+ if(fsr&INEX) fsr9 |= FPAINEX;
+ if(fsr&OVFL) fsr9 |= FPAOVFL;
+ if(fsr&UNFL) fsr9 |= FPAUNFL;
+ if(fsr&ZDIV) fsr9 |= FPAZDIV;
+ if(fsr&INVAL) fsr9 |= FPAINVAL;
+ setfsr(fsr9);
+ return(old&mask);
+}
+
+ulong
+getFPcontrol(void)
+{
+ ulong fcr = 0, fcr9 = getfcr();
+ switch(fcr9&FPRMASK){
+ case FPRNR: fcr = RND_NR; break;
+ case FPRNINF: fcr = RND_NINF; break;
+ case FPRPINF: fcr = RND_PINF; break;
+ case FPRZ: fcr = RND_Z; break;
+ }
+ if(fcr9&FPINEX) fcr |= INEX;
+ if(fcr9&FPOVFL) fcr |= OVFL;
+ if(fcr9&FPUNFL) fcr |= UNFL;
+ if(fcr9&FPZDIV) fcr |= ZDIV;
+ if(fcr9&FPINVAL) fcr |= INVAL;
+ return fcr;
+}
+
+ulong
+FPcontrol(ulong fcr, ulong mask)
+{
+ ulong fcr9 = FPPDBL;
+ ulong old = getFPcontrol();
+ fcr = (fcr&mask) | (old&~mask);
+ if(fcr&INEX) fcr9 |= FPINEX;
+ if(fcr&OVFL) fcr9 |= FPOVFL;
+ if(fcr&UNFL) fcr9 |= FPUNFL;
+ if(fcr&ZDIV) fcr9 |= FPZDIV;
+ if(fcr&INVAL) fcr9 |= FPINVAL;
+ switch(fcr&RND_MASK){
+ case RND_NR: fcr9 |= FPRNR; break;
+ case RND_NINF: fcr9 |= FPRNINF; break;
+ case RND_PINF: fcr9 |= FPRPINF; break;
+ case RND_Z: fcr9 |= FPRZ; break;
+ }
+ setfcr(fcr9);
+ return(old&mask);
+}
diff --git a/libmath/NOTICE b/libmath/NOTICE
new file mode 100644
index 00000000..d2099067
--- /dev/null
+++ b/libmath/NOTICE
@@ -0,0 +1,29 @@
+This copyright NOTICE applies to all files in this directory and
+subdirectories, unless another copyright notice appears in a given
+file or subdirectory. If you take substantial code from this software to use in
+other programs, you must somehow include with it an appropriate
+copyright notice that includes the copyright notice and the other
+notices below. It is fine (and often tidier) to do that in a separate
+file such as NOTICE, LICENCE or COPYING.
+
+ Copyright © 1994-1999 Lucent Technologies Inc. All rights reserved.
+ Revisions Copyright © 2000-2006 Vita Nuova Holdings Limited (www.vitanuova.com). All rights reserved.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in
+all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
+THE SOFTWARE.
+
diff --git a/libmath/bin/fdlibm-stubs b/libmath/bin/fdlibm-stubs
new file mode 100644
index 00000000..4b7574f9
--- /dev/null
+++ b/libmath/bin/fdlibm-stubs
@@ -0,0 +1,71 @@
+echo '#include "real.h"' > real.c
+
+for(i in getFPcontrol getFPstatus){
+ echo 'void'
+ echo 'Real_'$i'(void *fp)'
+ echo '{'
+ echo ' F_Real_'$i' *f;'
+ echo ''
+ echo ' f = fp;'
+ echo ''
+ echo ' *f->ret = '$i'(f->x);'
+ echo '}'
+ echo ''
+} >> real.c
+
+for(i in finite ilogb isnan acos acosh asin asinh atan atanh cbrt ceil cos cosh erf erfc exp expm1 fabs floor j0 j1 log log10 log1p rint sin sinh sqrt tan tanh y0 y1){
+ echo 'void'
+ echo 'Real_'$i'(void *fp)'
+ echo '{'
+ echo ' F_Real_'$i' *f;'
+ echo ''
+ echo ' f = fp;'
+ echo ''
+ echo ' *f->ret = '$i'(f->x);'
+ echo '}'
+ echo ''
+} >> real.c
+
+for(i in fdim fmax fmin fmod hypot nextafter pow){
+ echo 'void'
+ echo 'Real_'$i'(void *fp)'
+ echo '{'
+ echo ' F_Real_'$i' *f;'
+ echo ''
+ echo ' f = fp;'
+ echo ''
+ echo ' *f->ret = '$i'(f->x, f->x);'
+ echo '}'
+ echo ''
+} >> real.c
+
+
+FPcontrol fn(r, mask: int) of int;
+FPstatus fn(r, mask: int) of int;
+atan2 fn(y, x: real) of real;
+copysign fn(x, s: real) of real;
+jn fn(n: int; x: real) of real;
+lgamma fn(x: real) of (int,real);
+modf fn(x: real) of (int,real);
+pow10 fn(p: int) of real;
+remainder fn(x, p: real) of real;
+scalbn fn(x: real; n: int) of real;
+yn fn(n: int; x: real) of real;
+
+dot fn(x, y: array of real) of real;
+iamax fn(x: array of real) of int;
+norm1, norm2 fn(x: array of real) of real;
+gemm fn(transa, transb: byte; m, n, k: int; alpha: real; a: array of real; ai0, aj0, lda: int; b: array of real; bi0, bj0, ldb: int; beta: real; c: array of real; ci0, cj0, ldc: int);
+
+for(i in FPcontrol FPstatus atan2 copysign jn lgamma modf pow10 remainder scalbn yn dot iamax norm1, norm2 gemm){
+ echo 'void'
+ echo 'Real_'$i'(void *fp)'
+ echo '{'
+ echo ' F_Real_'$i' *f;'
+ echo ''
+ echo ' f = fp;'
+ echo ''
+ echo ' *f->ret = '$i'(f->x, f->x);'
+ echo '}'
+ echo ''
+} >> real.c
diff --git a/libmath/bin/unif_dtoa b/libmath/bin/unif_dtoa
new file mode 100644
index 00000000..bb365822
--- /dev/null
+++ b/libmath/bin/unif_dtoa
@@ -0,0 +1,37 @@
+#!/bin/rc
+test -d /netlib/fp || 9fs netlib
+test -d /n/hati/usr/ehg || 9fs hati
+
+echo '/* derived from /netlib/fp/dtoa.c assuming IEEE, Standard C */' > dtoa.c
+echo '/* kudos to dmg@research.att.com, gripes to ehg@research.att.com */' >> dtoa.c
+echo '#include "lib9.h"' >> dtoa.c
+
+sed 's/^#if defined.IEEE_8087. . defined.IEEE_MC68k.*!= 1/#ifndef IEEE_Arith/
+ s/^#if defined.IEEE_8087. . defined.IEEE_MC68k.*/#ifdef IEEE_Arith/' \
+ /netlib/fp/dtoa.c > /n/hati/usr/ehg/xxx.c
+# undefine __STDC__ because we can't depend on HUGE_VAL
+rx hati 'unifdef -UIBM -UVAX -UKR_headers -U__cplusplus -U__STDC__ -UDEBUG \
+ -UBad_float_h -UJust_16 -UInaccurate_Divide -UROUND_BIASED \
+ -URND_PRODQUOT -DNo_leftright -UCheck_FLT_ROUNDS -D__MATH_H__ \
+ -DUnsigned_Shifts -DMALLOC=Malloc -DCONST=const \
+ -DPack_32 -DIEEE_Arith xxx.c | cb -s' > xxx.c
+sam -d >> dtoa.c >[2] err <<!
+e xxx.c
+1,/include "float\.h"\n/d
+/The following definition of Storeinc/+-;/^#endif\n/d
+/^#define IEEE_Arith\n/+-d
+/When Pack_32 is not defined/+-;/^\n/d
+,s/\n\n\n+/\n\n/g
+,s/\n\(/(/g
+,s/\\\(/\\\n(/g
+,x/IEEE_8087/ c/__LITTLE_ENDIAN/
+,x/^#if / c/#ifdef /
+,x g/errno/d
+,x/MALLOC/ c/malloc/
+,x/Long/ c/long/
+,x/CONST/ c/const/
+w
+q
+!
+cat xxx.c >> dtoa.c
+rm xxx.c
diff --git a/libmath/bin/unif_fdlibm b/libmath/bin/unif_fdlibm
new file mode 100644
index 00000000..a19b29c4
--- /dev/null
+++ b/libmath/bin/unif_fdlibm
@@ -0,0 +1,20 @@
+#!/bin/rc
+test -d /netlib/fdlibm || 9fs netlib
+test -d /n/hati/usr/ehg || 9fs hati
+
+echo '/* derived from /netlib/fdlibm */' > $1
+if (~ $1 fdlibm.h) echo '#include "lib9.h"' >> $1
+
+cp /netlib/fdlibm/$1 /n/hati/usr/ehg/xxx.c
+rx hati 'unifdef -D__STDC__ -D_IEEE_LIBM -D_SCALB_INT -U__NEWVALID xxx.c' > xxx.c
+> /n/hati/usr/ehg/xxx.c
+sam -d >> $1 >[2] err <<!
+e xxx.c
+/extern int signgam;/,/#define PLOSS/+d
+,x/HUGE_VAL/ c/DBL_MAX/
+,x/huge/ c/Huge/
+w
+q
+!
+cat xxx.c >> $1
+rm xxx.c
diff --git a/libmath/blas.c b/libmath/blas.c
new file mode 100644
index 00000000..a5cc9e0b
--- /dev/null
+++ b/libmath/blas.c
@@ -0,0 +1,61 @@
+#include "lib9.h"
+#include "mathi.h"
+
+double
+dot(int n, double *x, double *y)
+{
+ double sum = 0;
+ if (n <= 0)
+ return 0;
+ while (n--) {
+ sum += *x++ * *y++;
+ }
+ return sum;
+}
+
+
+int
+iamax(int n, double *x)
+{
+ int i, m;
+ double xm, a;
+ if (n <= 0)
+ return 0;
+ m = 0;
+ xm = fabs(*x);
+ for (i = 1; i < n; i++) {
+ a = fabs(*++x);
+ if (xm < a) {
+ m = i;
+ xm = a;
+ }
+ }
+ return m;
+}
+
+
+double
+norm1(int n, double *x)
+{
+ double sum = 0;
+ if (n <= 0)
+ return 0;
+ while (n--) {
+ sum += fabs(*x++);
+ }
+ return sum;
+}
+
+
+double
+norm2(int n, double *x)
+{
+ double sum = 0;
+ if (n <= 0)
+ return 0;
+ while (n--) {
+ sum += *x * *x;
+ x++;
+ }
+ return sum;
+}
diff --git a/libmath/dtoa.c b/libmath/dtoa.c
new file mode 100644
index 00000000..ac4ecee1
--- /dev/null
+++ b/libmath/dtoa.c
@@ -0,0 +1,1807 @@
+/* derived from /netlib/fp/dtoa.c assuming IEEE, Standard C */
+/* kudos to dmg@bell-labs.com, gripes to ehg@bell-labs.com */
+#include "lib9.h"
+#define ACQUIRE_DTOA_LOCK(n) /*nothing*/
+#define FREE_DTOA_LOCK(n) /*nothing*/
+
+/* let's provide reasonable defaults for usual implementation of IEEE f.p. */
+#ifndef DBL_DIG
+#define DBL_DIG 15
+#endif
+#ifndef DBL_MAX_10_EXP
+#define DBL_MAX_10_EXP 308
+#endif
+#ifndef DBL_MAX_EXP
+#define DBL_MAX_EXP 1024
+#endif
+#ifndef FLT_RADIX
+#define FLT_RADIX 2
+#endif
+#ifndef FLT_ROUNDS
+#define FLT_ROUNDS 1
+#endif
+#ifndef Storeinc
+#define Storeinc(a,b,c) (*a++ = b << 16 | c & 0xffff)
+#endif
+
+#define Sign_Extend(a,b) if (b < 0) a |= 0xffff0000;
+
+#ifdef __LITTLE_ENDIAN
+#define word0(x) ((unsigned long *)&x)[1]
+#define word1(x) ((unsigned long *)&x)[0]
+#else
+#define word0(x) ((unsigned long *)&x)[0]
+#define word1(x) ((unsigned long *)&x)[1]
+#endif
+
+/* #define P DBL_MANT_DIG */
+/* Ten_pmax = floor(P*log(2)/log(5)) */
+/* Bletch = (highest power of 2 < DBL_MAX_10_EXP) / 16 */
+/* Quick_max = floor((P-1)*log(FLT_RADIX)/log(10) - 1) */
+/* Int_max = floor(P*log(FLT_RADIX)/log(10) - 1) */
+
+#define Exp_shift 20
+#define Exp_shift1 20
+#define Exp_msk1 0x100000
+#define Exp_msk11 0x100000
+#define Exp_mask 0x7ff00000
+#define P 53
+#define Bias 1023
+#define Emin (-1022)
+#define Exp_1 0x3ff00000
+#define Exp_11 0x3ff00000
+#define Ebits 11
+#define Frac_mask 0xfffff
+#define Frac_mask1 0xfffff
+#define Ten_pmax 22
+#define Bletch 0x10
+#define Bndry_mask 0xfffff
+#define Bndry_mask1 0xfffff
+#define LSB 1
+#define Sign_bit 0x80000000
+#define Log2P 1
+#define Tiny0 0
+#define Tiny1 1
+#define Quick_max 14
+#define Int_max 14
+#define Infinite(x) (word0(x) == 0x7ff00000) /* sufficient test for here */
+#define Avoid_Underflow
+
+#define rounded_product(a,b) a *= b
+#define rounded_quotient(a,b) a /= b
+
+#define Big0 (Frac_mask1 | Exp_msk1*(DBL_MAX_EXP+Bias-1))
+#define Big1 0xffffffff
+
+#define Kmax 15
+
+struct
+Bigint {
+ struct Bigint *next;
+ int k, maxwds, sign, wds;
+ unsigned long x[1];
+};
+
+typedef struct Bigint Bigint;
+
+static Bigint *freelist[Kmax+1];
+
+static Bigint *
+Balloc(int k)
+{
+ int x;
+ Bigint * rv;
+
+ ACQUIRE_DTOA_LOCK(0);
+ if (rv = freelist[k]) {
+ freelist[k] = rv->next;
+ } else {
+ x = 1 << k;
+ rv = (Bigint * )malloc(sizeof(Bigint) + (x - 1) * sizeof(unsigned long));
+ if(rv == nil)
+ return nil;
+ rv->k = k;
+ rv->maxwds = x;
+ }
+ FREE_DTOA_LOCK(0);
+ rv->sign = rv->wds = 0;
+ return rv;
+}
+
+static void
+Bfree(Bigint *v)
+{
+ if (v) {
+ ACQUIRE_DTOA_LOCK(0);
+ v->next = freelist[v->k];
+ freelist[v->k] = v;
+ FREE_DTOA_LOCK(0);
+ }
+}
+
+#define Bcopy(x,y) memcpy((char *)&x->sign, (char *)&y->sign, \
+y->wds*sizeof(long) + 2*sizeof(int))
+
+static Bigint *
+multadd(Bigint *b, int m, int a) /* multiply by m and add a */
+{
+ int i, wds;
+ unsigned long * x, y;
+ unsigned long xi, z;
+ Bigint * b1;
+
+ wds = b->wds;
+ x = b->x;
+ i = 0;
+ do {
+ xi = *x;
+ y = (xi & 0xffff) * m + a;
+ z = (xi >> 16) * m + (y >> 16);
+ a = (int)(z >> 16);
+ *x++ = (z << 16) + (y & 0xffff);
+ } while (++i < wds);
+ if (a) {
+ if (wds >= b->maxwds) {
+ b1 = Balloc(b->k + 1);
+ Bcopy(b1, b);
+ Bfree(b);
+ b = b1;
+ }
+ b->x[wds++] = a;
+ b->wds = wds;
+ }
+ return b;
+}
+
+static Bigint *
+s2b(const char *s, int nd0, int nd, unsigned long y9)
+{
+ Bigint * b;
+ int i, k;
+ long x, y;
+
+ x = (nd + 8) / 9;
+ for (k = 0, y = 1; x > y; y <<= 1, k++)
+ ;
+ b = Balloc(k);
+ b->x[0] = y9;
+ b->wds = 1;
+
+ i = 9;
+ if (9 < nd0) {
+ s += 9;
+ do
+ b = multadd(b, 10, *s++ - '0');
+ while (++i < nd0);
+ s++;
+ } else
+ s += 10;
+ for (; i < nd; i++)
+ b = multadd(b, 10, *s++ - '0');
+ return b;
+}
+
+static int
+hi0bits(register unsigned long x)
+{
+ register int k = 0;
+
+ if (!(x & 0xffff0000)) {
+ k = 16;
+ x <<= 16;
+ }
+ if (!(x & 0xff000000)) {
+ k += 8;
+ x <<= 8;
+ }
+ if (!(x & 0xf0000000)) {
+ k += 4;
+ x <<= 4;
+ }
+ if (!(x & 0xc0000000)) {
+ k += 2;
+ x <<= 2;
+ }
+ if (!(x & 0x80000000)) {
+ k++;
+ if (!(x & 0x40000000))
+ return 32;
+ }
+ return k;
+}
+
+static int
+lo0bits(unsigned long *y)
+{
+ register int k;
+ register unsigned long x = *y;
+
+ if (x & 7) {
+ if (x & 1)
+ return 0;
+ if (x & 2) {
+ *y = x >> 1;
+ return 1;
+ }
+ *y = x >> 2;
+ return 2;
+ }
+ k = 0;
+ if (!(x & 0xffff)) {
+ k = 16;
+ x >>= 16;
+ }
+ if (!(x & 0xff)) {
+ k += 8;
+ x >>= 8;
+ }
+ if (!(x & 0xf)) {
+ k += 4;
+ x >>= 4;
+ }
+ if (!(x & 0x3)) {
+ k += 2;
+ x >>= 2;
+ }
+ if (!(x & 1)) {
+ k++;
+ x >>= 1;
+ if (!x & 1)
+ return 32;
+ }
+ *y = x;
+ return k;
+}
+
+static Bigint *
+i2b(int i)
+{
+ Bigint * b;
+
+ b = Balloc(1);
+ b->x[0] = i;
+ b->wds = 1;
+ return b;
+}
+
+static Bigint *
+mult(Bigint *a, Bigint *b)
+{
+ Bigint * c;
+ int k, wa, wb, wc;
+ unsigned long carry, y, z;
+ unsigned long * x, *xa, *xae, *xb, *xbe, *xc, *xc0;
+ unsigned long z2;
+
+ if (a->wds < b->wds) {
+ c = a;
+ a = b;
+ b = c;
+ }
+ k = a->k;
+ wa = a->wds;
+ wb = b->wds;
+ wc = wa + wb;
+ if (wc > a->maxwds)
+ k++;
+ c = Balloc(k);
+ for (x = c->x, xa = x + wc; x < xa; x++)
+ *x = 0;
+ xa = a->x;
+ xae = xa + wa;
+ xb = b->x;
+ xbe = xb + wb;
+ xc0 = c->x;
+ for (; xb < xbe; xb++, xc0++) {
+ if (y = *xb & 0xffff) {
+ x = xa;
+ xc = xc0;
+ carry = 0;
+ do {
+ z = (*x & 0xffff) * y + (*xc & 0xffff) + carry;
+ carry = z >> 16;
+ z2 = (*x++ >> 16) * y + (*xc >> 16) + carry;
+ carry = z2 >> 16;
+ Storeinc(xc, z2, z);
+ } while (x < xae);
+ *xc = carry;
+ }
+ if (y = *xb >> 16) {
+ x = xa;
+ xc = xc0;
+ carry = 0;
+ z2 = *xc;
+ do {
+ z = (*x & 0xffff) * y + (*xc >> 16) + carry;
+ carry = z >> 16;
+ Storeinc(xc, z, z2);
+ z2 = (*x++ >> 16) * y + (*xc & 0xffff) + carry;
+ carry = z2 >> 16;
+ } while (x < xae);
+ *xc = z2;
+ }
+ }
+ for (xc0 = c->x, xc = xc0 + wc; wc > 0 && !*--xc; --wc)
+ ;
+ c->wds = wc;
+ return c;
+}
+
+static Bigint *p5s;
+
+static Bigint *
+pow5mult(Bigint *b, int k)
+{
+ Bigint * b1, *p5, *p51;
+ int i;
+ static int p05[3] = {
+ 5, 25, 125 };
+
+ if (i = k & 3)
+ b = multadd(b, p05[i-1], 0);
+
+ if (!(k >>= 2))
+ return b;
+ if (!(p5 = p5s)) {
+ /* first time */
+ ACQUIRE_DTOA_LOCK(1);
+ if (!(p5 = p5s)) {
+ p5 = p5s = i2b(625);
+ p5->next = 0;
+ }
+ FREE_DTOA_LOCK(1);
+ }
+ for (; ; ) {
+ if (k & 1) {
+ b1 = mult(b, p5);
+ Bfree(b);
+ b = b1;
+ }
+ if (!(k >>= 1))
+ break;
+ if (!(p51 = p5->next)) {
+ ACQUIRE_DTOA_LOCK(1);
+ if (!(p51 = p5->next)) {
+ p51 = p5->next = mult(p5, p5);
+ p51->next = 0;
+ }
+ FREE_DTOA_LOCK(1);
+ }
+ p5 = p51;
+ }
+ return b;
+}
+
+static Bigint *
+lshift(Bigint *b, int k)
+{
+ int i, k1, n, n1;
+ Bigint * b1;
+ unsigned long * x, *x1, *xe, z;
+
+ n = k >> 5;
+ k1 = b->k;
+ n1 = n + b->wds + 1;
+ for (i = b->maxwds; n1 > i; i <<= 1)
+ k1++;
+ b1 = Balloc(k1);
+ x1 = b1->x;
+ for (i = 0; i < n; i++)
+ *x1++ = 0;
+ x = b->x;
+ xe = x + b->wds;
+ if (k &= 0x1f) {
+ k1 = 32 - k;
+ z = 0;
+ do {
+ *x1++ = *x << k | z;
+ z = *x++ >> k1;
+ } while (x < xe);
+ if (*x1 = z)
+ ++n1;
+ } else
+ do
+ *x1++ = *x++;
+ while (x < xe);
+ b1->wds = n1 - 1;
+ Bfree(b);
+ return b1;
+}
+
+static int
+cmp(Bigint *a, Bigint *b)
+{
+ unsigned long * xa, *xa0, *xb, *xb0;
+ int i, j;
+
+ i = a->wds;
+ j = b->wds;
+ if (i -= j)
+ return i;
+ xa0 = a->x;
+ xa = xa0 + j;
+ xb0 = b->x;
+ xb = xb0 + j;
+ for (; ; ) {
+ if (*--xa != *--xb)
+ return * xa < *xb ? -1 : 1;
+ if (xa <= xa0)
+ break;
+ }
+ return 0;
+}
+
+static Bigint *
+diff(Bigint *a, Bigint *b)
+{
+ Bigint * c;
+ int i, wa, wb;
+ long borrow, y; /* We need signed shifts here. */
+ unsigned long * xa, *xae, *xb, *xbe, *xc;
+ long z;
+
+ i = cmp(a, b);
+ if (!i) {
+ c = Balloc(0);
+ c->wds = 1;
+ c->x[0] = 0;
+ return c;
+ }
+ if (i < 0) {
+ c = a;
+ a = b;
+ b = c;
+ i = 1;
+ } else
+ i = 0;
+ c = Balloc(a->k);
+ c->sign = i;
+ wa = a->wds;
+ xa = a->x;
+ xae = xa + wa;
+ wb = b->wds;
+ xb = b->x;
+ xbe = xb + wb;
+ xc = c->x;
+ borrow = 0;
+ do {
+ y = (*xa & 0xffff) - (*xb & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*xa++ >> 16) - (*xb++ >> 16) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(xc, z, y);
+ } while (xb < xbe);
+ while (xa < xae) {
+ y = (*xa & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*xa++ >> 16) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(xc, z, y);
+ }
+ while (!*--xc)
+ wa--;
+ c->wds = wa;
+ return c;
+}
+
+static double
+ulp(double x)
+{
+ register long L;
+ double a;
+
+ L = (word0(x) & Exp_mask) - (P - 1) * Exp_msk1;
+#ifndef Sudden_Underflow
+ if (L > 0) {
+#endif
+ word0(a) = L;
+ word1(a) = 0;
+#ifndef Sudden_Underflow
+ } else {
+ L = -L >> Exp_shift;
+ if (L < Exp_shift) {
+ word0(a) = 0x80000 >> L;
+ word1(a) = 0;
+ } else {
+ word0(a) = 0;
+ L -= Exp_shift;
+ word1(a) = L >= 31 ? 1 : 1 << 31 - L;
+ }
+ }
+#endif
+ return a;
+}
+
+static double
+b2d(Bigint *a, int *e)
+{
+ unsigned long * xa, *xa0, w, y, z;
+ int k;
+ double d;
+#define d0 word0(d)
+#define d1 word1(d)
+
+ xa0 = a->x;
+ xa = xa0 + a->wds;
+ y = *--xa;
+ k = hi0bits(y);
+ *e = 32 - k;
+ if (k < Ebits) {
+ d0 = Exp_1 | y >> Ebits - k;
+ w = xa > xa0 ? *--xa : 0;
+ d1 = y << (32 - Ebits) + k | w >> Ebits - k;
+ goto ret_d;
+ }
+ z = xa > xa0 ? *--xa : 0;
+ if (k -= Ebits) {
+ d0 = Exp_1 | y << k | z >> 32 - k;
+ y = xa > xa0 ? *--xa : 0;
+ d1 = z << k | y >> 32 - k;
+ } else {
+ d0 = Exp_1 | y;
+ d1 = z;
+ }
+ret_d:
+#undef d0
+#undef d1
+ return d;
+}
+
+static Bigint *
+d2b(double d, int *e, int *bits)
+{
+ Bigint * b;
+ int de, i, k;
+ unsigned long * x, y, z;
+#define d0 word0(d)
+#define d1 word1(d)
+
+ b = Balloc(1);
+ x = b->x;
+
+ z = d0 & Frac_mask;
+ d0 &= 0x7fffffff; /* clear sign bit, which we ignore */
+#ifdef Sudden_Underflow
+ de = (int)(d0 >> Exp_shift);
+ z |= Exp_msk11;
+#else
+ if (de = (int)(d0 >> Exp_shift))
+ z |= Exp_msk1;
+#endif
+ if (y = d1) {
+ if (k = lo0bits(&y)) {
+ x[0] = y | z << 32 - k;
+ z >>= k;
+ } else
+ x[0] = y;
+ i = b->wds = (x[1] = z) ? 2 : 1;
+ } else {
+ k = lo0bits(&z);
+ x[0] = z;
+ i = b->wds = 1;
+ k += 32;
+ }
+#ifndef Sudden_Underflow
+ if (de) {
+#endif
+ *e = de - Bias - (P - 1) + k;
+ *bits = P - k;
+#ifndef Sudden_Underflow
+ } else {
+ *e = de - Bias - (P - 1) + 1 + k;
+ *bits = 32 * i - hi0bits(x[i-1]);
+ }
+#endif
+ return b;
+}
+
+#undef d0
+#undef d1
+
+static double
+ratio(Bigint *a, Bigint *b)
+{
+ double da, db;
+ int k, ka, kb;
+
+ da = b2d(a, &ka);
+ db = b2d(b, &kb);
+ k = ka - kb + 32 * (a->wds - b->wds);
+ if (k > 0)
+ word0(da) += k * Exp_msk1;
+ else {
+ k = -k;
+ word0(db) += k * Exp_msk1;
+ }
+ return da / db;
+}
+
+static const double
+tens[] = {
+ 1e0, 1e1, 1e2, 1e3, 1e4, 1e5, 1e6, 1e7, 1e8, 1e9,
+ 1e10, 1e11, 1e12, 1e13, 1e14, 1e15, 1e16, 1e17, 1e18, 1e19,
+ 1e20, 1e21, 1e22
+};
+
+static const double
+bigtens[] = {
+ 1e16, 1e32, 1e64, 1e128, 1e256 };
+
+static const double tinytens[] = {
+ 1e-16, 1e-32, 1e-64, 1e-128,
+ 9007199254740992.e-256
+};
+
+/* The factor of 2^53 in tinytens[4] helps us avoid setting the underflow */
+/* flag unnecessarily. It leads to a song and dance at the end of strtod. */
+#define Scale_Bit 0x10
+#define n_bigtens 5
+
+#define NAN_WORD0 0x7ff80000
+
+#define NAN_WORD1 0
+
+static int
+match(const char **sp, char *t)
+{
+ int c, d;
+ const char * s = *sp;
+
+ while (d = *t++) {
+ if ((c = *++s) >= 'A' && c <= 'Z')
+ c += 'a' - 'A';
+ if (c != d)
+ return 0;
+ }
+ *sp = s + 1;
+ return 1;
+}
+
+double
+strtod(const char *s00, char **se)
+{
+ int scale;
+ int bb2, bb5, bbe, bd2, bd5, bbbits, bs2, c, dsign,
+ e, e1, esign, i, j, k, nd, nd0, nf, nz, nz0, sign;
+ const char * s, *s0, *s1;
+ double aadj, aadj1, adj, rv, rv0;
+ long L;
+ unsigned long y, z;
+ Bigint * bb, *bb1, *bd, *bd0, *bs, *delta;
+ sign = nz0 = nz = 0;
+ rv = 0.;
+ for (s = s00; ; s++)
+ switch (*s) {
+ case '-':
+ sign = 1;
+ /* no break */
+ case '+':
+ if (*++s)
+ goto break2;
+ /* no break */
+ case 0:
+ s = s00;
+ goto ret;
+ case '\t':
+ case '\n':
+ case '\v':
+ case '\f':
+ case '\r':
+ case ' ':
+ continue;
+ default:
+ goto break2;
+ }
+break2:
+ if (*s == '0') {
+ nz0 = 1;
+ while (*++s == '0')
+ ;
+ if (!*s)
+ goto ret;
+ }
+ s0 = s;
+ y = z = 0;
+ for (nd = nf = 0; (c = *s) >= '0' && c <= '9'; nd++, s++)
+ if (nd < 9)
+ y = 10 * y + c - '0';
+ else if (nd < 16)
+ z = 10 * z + c - '0';
+ nd0 = nd;
+ if (c == '.') {
+ c = *++s;
+ if (!nd) {
+ for (; c == '0'; c = *++s)
+ nz++;
+ if (c > '0' && c <= '9') {
+ s0 = s;
+ nf += nz;
+ nz = 0;
+ goto have_dig;
+ }
+ goto dig_done;
+ }
+ for (; c >= '0' && c <= '9'; c = *++s) {
+have_dig:
+ nz++;
+ if (c -= '0') {
+ nf += nz;
+ for (i = 1; i < nz; i++)
+ if (nd++ < 9)
+ y *= 10;
+ else if (nd <= DBL_DIG + 1)
+ z *= 10;
+ if (nd++ < 9)
+ y = 10 * y + c;
+ else if (nd <= DBL_DIG + 1)
+ z = 10 * z + c;
+ nz = 0;
+ }
+ }
+ }
+dig_done:
+ e = 0;
+ if (c == 'e' || c == 'E') {
+ if (!nd && !nz && !nz0) {
+ s = s00;
+ goto ret;
+ }
+ s00 = s;
+ esign = 0;
+ switch (c = *++s) {
+ case '-':
+ esign = 1;
+ case '+':
+ c = *++s;
+ }
+ if (c >= '0' && c <= '9') {
+ while (c == '0')
+ c = *++s;
+ if (c > '0' && c <= '9') {
+ L = c - '0';
+ s1 = s;
+ while ((c = *++s) >= '0' && c <= '9')
+ L = 10 * L + c - '0';
+ if (s - s1 > 8 || L > 19999)
+ /* Avoid confusion from exponents
+ * so large that e might overflow.
+ */
+ e = 19999; /* safe for 16 bit ints */
+ else
+ e = (int)L;
+ if (esign)
+ e = -e;
+ } else
+ e = 0;
+ } else
+ s = s00;
+ }
+ if (!nd) {
+ if (!nz && !nz0) {
+ /* Check for Nan and Infinity */
+ switch (c) {
+ case 'i':
+ case 'I':
+ if (match(&s, "nfinity")) {
+ word0(rv) = 0x7ff00000;
+ word1(rv) = 0;
+ goto ret;
+ }
+ break;
+ case 'n':
+ case 'N':
+ if (match(&s, "an")) {
+ word0(rv) = NAN_WORD0;
+ word1(rv) = NAN_WORD1;
+ goto ret;
+ }
+ }
+ s = s00;
+ }
+ goto ret;
+ }
+ e1 = e -= nf;
+
+ /* Now we have nd0 digits, starting at s0, followed by a
+ * decimal point, followed by nd-nd0 digits. The number we're
+ * after is the integer represented by those digits times
+ * 10**e */
+
+ if (!nd0)
+ nd0 = nd;
+ k = nd < DBL_DIG + 1 ? nd : DBL_DIG + 1;
+ rv = y;
+ if (k > 9)
+ rv = tens[k - 9] * rv + z;
+ bd0 = 0;
+ if (nd <= DBL_DIG
+ && FLT_ROUNDS == 1
+ ) {
+ if (!e)
+ goto ret;
+ if (e > 0) {
+ if (e <= Ten_pmax) {
+ /* rv = */ rounded_product(rv, tens[e]);
+ goto ret;
+ }
+ i = DBL_DIG - nd;
+ if (e <= Ten_pmax + i) {
+ /* A fancier test would sometimes let us do
+ * this for larger i values.
+ */
+ e -= i;
+ rv *= tens[i];
+ /* rv = */ rounded_product(rv, tens[e]);
+ goto ret;
+ }
+ } else if (e >= -Ten_pmax) {
+ /* rv = */ rounded_quotient(rv, tens[-e]);
+ goto ret;
+ }
+ }
+ e1 += nd - k;
+
+ scale = 0;
+
+ /* Get starting approximation = rv * 10**e1 */
+
+ if (e1 > 0) {
+ if (i = e1 & 15)
+ rv *= tens[i];
+ if (e1 &= ~15) {
+ if (e1 > DBL_MAX_10_EXP) {
+ovfl:
+ /* Can't trust HUGE_VAL */
+ word0(rv) = Exp_mask;
+ word1(rv) = 0;
+ if (bd0)
+ goto retfree;
+ goto ret;
+ }
+ if (e1 >>= 4) {
+ for (j = 0; e1 > 1; j++, e1 >>= 1)
+ if (e1 & 1)
+ rv *= bigtens[j];
+ /* The last multiplication could overflow. */
+ word0(rv) -= P * Exp_msk1;
+ rv *= bigtens[j];
+ if ((z = word0(rv) & Exp_mask)
+ > Exp_msk1 * (DBL_MAX_EXP + Bias - P))
+ goto ovfl;
+ if (z > Exp_msk1 * (DBL_MAX_EXP + Bias - 1 - P)) {
+ /* set to largest number */
+ /* (Can't trust DBL_MAX) */
+ word0(rv) = Big0;
+ word1(rv) = Big1;
+ } else
+ word0(rv) += P * Exp_msk1;
+ }
+
+ }
+ } else if (e1 < 0) {
+ e1 = -e1;
+ if (i = e1 & 15)
+ rv /= tens[i];
+ if (e1 &= ~15) {
+ e1 >>= 4;
+ if (e1 >= 1 << n_bigtens)
+ goto undfl;
+ if (e1 & Scale_Bit)
+ scale = P;
+ for (j = 0; e1 > 0; j++, e1 >>= 1)
+ if (e1 & 1)
+ rv *= tinytens[j];
+ if (!rv) {
+undfl:
+ rv = 0.;
+ if (bd0)
+ goto retfree;
+ goto ret;
+ }
+ }
+ }
+
+ /* Now the hard part -- adjusting rv to the correct value.*/
+
+ /* Put digits into bd: true value = bd * 10^e */
+
+ bd0 = s2b(s0, nd0, nd, y);
+
+ for (; ; ) {
+ bd = Balloc(bd0->k);
+ Bcopy(bd, bd0);
+ bb = d2b(rv, &bbe, &bbbits); /* rv = bb * 2^bbe */
+ bs = i2b(1);
+
+ if (e >= 0) {
+ bb2 = bb5 = 0;
+ bd2 = bd5 = e;
+ } else {
+ bb2 = bb5 = -e;
+ bd2 = bd5 = 0;
+ }
+ if (bbe >= 0)
+ bb2 += bbe;
+ else
+ bd2 -= bbe;
+ bs2 = bb2;
+#ifdef Sudden_Underflow
+ j = P + 1 - bbbits;
+#else
+ i = bbe + bbbits - 1; /* logb(rv) */
+ if (i < Emin) /* denormal */
+ j = bbe + (P - Emin);
+ else
+ j = P + 1 - bbbits;
+#endif
+ bb2 += j;
+ bd2 += j;
+ bd2 += scale;
+ i = bb2 < bd2 ? bb2 : bd2;
+ if (i > bs2)
+ i = bs2;
+ if (i > 0) {
+ bb2 -= i;
+ bd2 -= i;
+ bs2 -= i;
+ }
+ if (bb5 > 0) {
+ bs = pow5mult(bs, bb5);
+ bb1 = mult(bs, bb);
+ Bfree(bb);
+ bb = bb1;
+ }
+ if (bb2 > 0)
+ bb = lshift(bb, bb2);
+ if (bd5 > 0)
+ bd = pow5mult(bd, bd5);
+ if (bd2 > 0)
+ bd = lshift(bd, bd2);
+ if (bs2 > 0)
+ bs = lshift(bs, bs2);
+ delta = diff(bb, bd);
+ dsign = delta->sign;
+ delta->sign = 0;
+ i = cmp(delta, bs);
+ if (i < 0) {
+ /* Error is less than half an ulp -- check for
+ * special case of mantissa a power of two.
+ */
+ if (dsign || word1(rv) || word0(rv) & Bndry_mask
+ || (word0(rv) & Exp_mask) <= Exp_msk1
+ ) {
+ if (!delta->x[0] && delta->wds == 1)
+ dsign = 2;
+ break;
+ }
+ delta = lshift(delta, Log2P);
+ if (cmp(delta, bs) > 0)
+ goto drop_down;
+ break;
+ }
+ if (i == 0) {
+ /* exactly half-way between */
+ if (dsign) {
+ if ((word0(rv) & Bndry_mask1) == Bndry_mask1
+ && word1(rv) == 0xffffffff) {
+ /*boundary case -- increment exponent*/
+ word0(rv) = (word0(rv) & Exp_mask)
+ + Exp_msk1
+ ;
+ word1(rv) = 0;
+ dsign = 0;
+ break;
+ }
+ } else if (!(word0(rv) & Bndry_mask) && !word1(rv)) {
+ dsign = 2;
+drop_down:
+ /* boundary case -- decrement exponent */
+#ifdef Sudden_Underflow
+ L = word0(rv) & Exp_mask;
+ if (L <= Exp_msk1)
+ goto undfl;
+ L -= Exp_msk1;
+#else
+ L = (word0(rv) & Exp_mask) - Exp_msk1;
+#endif
+ word0(rv) = L | Bndry_mask1;
+ word1(rv) = 0xffffffff;
+ break;
+ }
+ if (!(word1(rv) & LSB))
+ break;
+ if (dsign)
+ rv += ulp(rv);
+ else {
+ rv -= ulp(rv);
+#ifndef Sudden_Underflow
+ if (!rv)
+ goto undfl;
+#endif
+ }
+ dsign = 1 - dsign;
+ break;
+ }
+ if ((aadj = ratio(delta, bs)) <= 2.) {
+ if (dsign)
+ aadj = aadj1 = 1.;
+ else if (word1(rv) || word0(rv) & Bndry_mask) {
+#ifndef Sudden_Underflow
+ if (word1(rv) == Tiny1 && !word0(rv))
+ goto undfl;
+#endif
+ aadj = 1.;
+ aadj1 = -1.;
+ } else {
+ /* special case -- power of FLT_RADIX to be */
+ /* rounded down... */
+
+ if (aadj < 2. / FLT_RADIX)
+ aadj = 1. / FLT_RADIX;
+ else
+ aadj *= 0.5;
+ aadj1 = -aadj;
+ }
+ } else {
+ aadj *= 0.5;
+ aadj1 = dsign ? aadj : -aadj;
+ if (FLT_ROUNDS == 0)
+ aadj1 += 0.5;
+ }
+ y = word0(rv) & Exp_mask;
+
+ /* Check for overflow */
+
+ if (y == Exp_msk1 * (DBL_MAX_EXP + Bias - 1)) {
+ rv0 = rv;
+ word0(rv) -= P * Exp_msk1;
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+ if ((word0(rv) & Exp_mask) >=
+ Exp_msk1 * (DBL_MAX_EXP + Bias - P)) {
+ if (word0(rv0) == Big0 && word1(rv0) == Big1)
+ goto ovfl;
+ word0(rv) = Big0;
+ word1(rv) = Big1;
+ goto cont;
+ } else
+ word0(rv) += P * Exp_msk1;
+ } else {
+#ifdef Sudden_Underflow
+ if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
+ rv0 = rv;
+ word0(rv) += P * Exp_msk1;
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+ if ((word0(rv) & Exp_mask) <= P * Exp_msk1) {
+ if (word0(rv0) == Tiny0
+ && word1(rv0) == Tiny1)
+ goto undfl;
+ word0(rv) = Tiny0;
+ word1(rv) = Tiny1;
+ goto cont;
+ } else
+ word0(rv) -= P * Exp_msk1;
+ } else {
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+ }
+#else
+ /* Compute adj so that the IEEE rounding rules will
+ * correctly round rv + adj in some half-way cases.
+ * If rv * ulp(rv) is denormalized (i.e.,
+ * y <= (P-1)*Exp_msk1), we must adjust aadj to avoid
+ * trouble from bits lost to denormalization;
+ * example: 1.2e-307 .
+ */
+ if (y <= (P - 1) * Exp_msk1 && aadj >= 1.) {
+ aadj1 = (double)(int)(aadj + 0.5);
+ if (!dsign)
+ aadj1 = -aadj1;
+ }
+ adj = aadj1 * ulp(rv);
+ rv += adj;
+#endif
+ }
+ z = word0(rv) & Exp_mask;
+ if (!scale)
+ if (y == z) {
+ /* Can we stop now? */
+ L = aadj;
+ aadj -= L;
+ /* The tolerances below are conservative. */
+ if (dsign || word1(rv) || word0(rv) & Bndry_mask) {
+ if (aadj < .4999999 || aadj > .5000001)
+ break;
+ } else if (aadj < .4999999 / FLT_RADIX)
+ break;
+ }
+cont:
+ Bfree(bb);
+ Bfree(bd);
+ Bfree(bs);
+ Bfree(delta);
+ }
+ if (scale) {
+ if ((word0(rv) & Exp_mask) <= P * Exp_msk1
+ && word1(rv) & 1
+ && dsign != 2)
+ if (dsign)
+ rv += ulp(rv);
+ else
+ word1(rv) &= ~1;
+ word0(rv0) = Exp_1 - P * Exp_msk1;
+ word1(rv0) = 0;
+ rv *= rv0;
+ }
+retfree:
+ Bfree(bb);
+ Bfree(bd);
+ Bfree(bs);
+ Bfree(bd0);
+ Bfree(delta);
+ret:
+ if (se)
+ *se = (char *)s;
+ return sign ? -rv : rv;
+}
+
+static int
+quorem(Bigint *b, Bigint *S)
+{
+ int n;
+ long borrow, y;
+ unsigned long carry, q, ys;
+ unsigned long * bx, *bxe, *sx, *sxe;
+ long z;
+ unsigned long si, zs;
+
+ n = S->wds;
+ if (b->wds < n)
+ return 0;
+ sx = S->x;
+ sxe = sx + --n;
+ bx = b->x;
+ bxe = bx + n;
+ q = *bxe / (*sxe + 1); /* ensure q <= true quotient */
+ if (q) {
+ borrow = 0;
+ carry = 0;
+ do {
+ si = *sx++;
+ ys = (si & 0xffff) * q + carry;
+ zs = (si >> 16) * q + (ys >> 16);
+ carry = zs >> 16;
+ y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*bx >> 16) - (zs & 0xffff) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(bx, z, y);
+ } while (sx <= sxe);
+ if (!*bxe) {
+ bx = b->x;
+ while (--bxe > bx && !*bxe)
+ --n;
+ b->wds = n;
+ }
+ }
+ if (cmp(b, S) >= 0) {
+ q++;
+ borrow = 0;
+ carry = 0;
+ bx = b->x;
+ sx = S->x;
+ do {
+ si = *sx++;
+ ys = (si & 0xffff) + carry;
+ zs = (si >> 16) + (ys >> 16);
+ carry = zs >> 16;
+ y = (*bx & 0xffff) - (ys & 0xffff) + borrow;
+ borrow = y >> 16;
+ Sign_Extend(borrow, y);
+ z = (*bx >> 16) - (zs & 0xffff) + borrow;
+ borrow = z >> 16;
+ Sign_Extend(borrow, z);
+ Storeinc(bx, z, y);
+ } while (sx <= sxe);
+ bx = b->x;
+ bxe = bx + n;
+ if (!*bxe) {
+ while (--bxe > bx && !*bxe)
+ --n;
+ b->wds = n;
+ }
+ }
+ return q;
+}
+
+static char *
+rv_alloc(int i)
+{
+ int j, k, *r;
+
+ j = sizeof(unsigned long);
+ for (k = 0;
+ sizeof(Bigint) - sizeof(unsigned long) - sizeof(int) + j <= i;
+ j <<= 1)
+ k++;
+ r = (int * )Balloc(k);
+ *r = k;
+ return
+ (char *)(r + 1);
+}
+
+static char *
+nrv_alloc(char *s, char **rve, int n)
+{
+ char *rv, *t;
+
+ t = rv = rv_alloc(n);
+ while (*t = *s++)
+ t++;
+ if (rve)
+ *rve = t;
+ return rv;
+}
+
+/* freedtoa(s) must be used to free values s returned by dtoa
+ * when MULTIPLE_THREADS is #defined. It should be used in all cases,
+ * but for consistency with earlier versions of dtoa, it is optional
+ * when MULTIPLE_THREADS is not defined.
+ */
+
+void
+freedtoa(char *s)
+{
+ Bigint * b = (Bigint * )((int *)s - 1);
+ b->maxwds = 1 << (b->k = *(int * )b);
+ Bfree(b);
+}
+
+/* dtoa for IEEE arithmetic (dmg): convert double to ASCII string.
+ *
+ * Inspired by "How to Print Floating-Point Numbers Accurately" by
+ * Guy L. Steele, Jr. and Jon L. White [Proc. ACM SIGPLAN '90, pp. 92-101].
+ *
+ * Modifications:
+ * 1. Rather than iterating, we use a simple numeric overestimate
+ * to determine k = floor(log10(d)). We scale relevant
+ * quantities using O(log2(k)) rather than O(k) multiplications.
+ * 2. For some modes > 2 (corresponding to ecvt and fcvt), we don't
+ * try to generate digits strictly left to right. Instead, we
+ * compute with fewer bits and propagate the carry if necessary
+ * when rounding the final digit up. This is often faster.
+ * 3. Under the assumption that input will be rounded nearest,
+ * mode 0 renders 1e23 as 1e23 rather than 9.999999999999999e22.
+ * That is, we allow equality in stopping tests when the
+ * round-nearest rule will give the same floating-point value
+ * as would satisfaction of the stopping test with strict
+ * inequality.
+ * 4. We remove common factors of powers of 2 from relevant
+ * quantities.
+ * 5. When converting floating-point integers less than 1e16,
+ * we use floating-point arithmetic rather than resorting
+ * to multiple-precision integers.
+ * 6. When asked to produce fewer than 15 digits, we first try
+ * to get by with floating-point arithmetic; we resort to
+ * multiple-precision integer arithmetic only if we cannot
+ * guarantee that the floating-point calculation has given
+ * the correctly rounded result. For k requested digits and
+ * "uniformly" distributed input, the probability is
+ * something like 10^(k-15) that we must resort to the long
+ * calculation.
+ */
+
+char *
+dtoa(double d, int mode, int ndigits, int *decpt, int *sign, char **rve)
+{
+ /* Arguments ndigits, decpt, sign are similar to those
+ of ecvt and fcvt; trailing zeros are suppressed from
+ the returned string. If not null, *rve is set to point
+ to the end of the return value. If d is +-Infinity or NaN,
+ then *decpt is set to 9999.
+
+ mode:
+ 0 ==> shortest string that yields d when read in
+ and rounded to nearest.
+ 1 ==> like 0, but with Steele & White stopping rule;
+ e.g. with IEEE P754 arithmetic , mode 0 gives
+ 1e23 whereas mode 1 gives 9.999999999999999e22.
+ 2 ==> max(1,ndigits) significant digits. This gives a
+ return value similar to that of ecvt, except
+ that trailing zeros are suppressed.
+ 3 ==> through ndigits past the decimal point. This
+ gives a return value similar to that from fcvt,
+ except that trailing zeros are suppressed, and
+ ndigits can be negative.
+ 4-9 should give the same return values as 2-3, i.e.,
+ 4 <= mode <= 9 ==> same return as mode
+ 2 + (mode & 1). These modes are mainly for
+ debugging; often they run slower but sometimes
+ faster than modes 2-3.
+ 4,5,8,9 ==> left-to-right digit generation.
+ 6-9 ==> don't try fast floating-point estimate
+ (if applicable).
+
+ Values of mode other than 0-9 are treated as mode 0.
+
+ Sufficient space is allocated to the return value
+ to hold the suppressed trailing zeros.
+ */
+
+ int bbits, b2, b5, be, dig, i, ieps, ilim, ilim0, ilim1,
+ j, j1, k, k0, k_check, leftright, m2, m5, s2, s5,
+ spec_case, try_quick;
+ long L;
+#ifndef Sudden_Underflow
+ int denorm;
+ unsigned long x;
+#endif
+ Bigint * b, *b1, *delta, *mlo, *mhi, *S;
+ double d2, ds, eps;
+ char *s, *s0;
+
+ if (word0(d) & Sign_bit) {
+ /* set sign for everything, including 0's and NaNs */
+ *sign = 1;
+ word0(d) &= ~Sign_bit; /* clear sign bit */
+ } else
+ *sign = 0;
+
+ if ((word0(d) & Exp_mask) == Exp_mask) {
+ /* Infinity or NaN */
+ *decpt = 9999;
+ if (!word1(d) && !(word0(d) & 0xfffff))
+ return nrv_alloc("Infinity", rve, 8);
+ return nrv_alloc("NaN", rve, 3);
+ }
+ if (!d) {
+ *decpt = 1;
+ return nrv_alloc("0", rve, 1);
+ }
+
+ b = d2b(d, &be, &bbits);
+#ifdef Sudden_Underflow
+ i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1));
+#else
+ if (i = (int)(word0(d) >> Exp_shift1 & (Exp_mask >> Exp_shift1))) {
+#endif
+ d2 = d;
+ word0(d2) &= Frac_mask1;
+ word0(d2) |= Exp_11;
+
+ /* log(x) ~=~ log(1.5) + (x-1.5)/1.5
+ * log10(x) = log(x) / log(10)
+ * ~=~ log(1.5)/log(10) + (x-1.5)/(1.5*log(10))
+ * log10(d) = (i-Bias)*log(2)/log(10) + log10(d2)
+ *
+ * This suggests computing an approximation k to log10(d) by
+ *
+ * k = (i - Bias)*0.301029995663981
+ * + ( (d2-1.5)*0.289529654602168 + 0.176091259055681 );
+ *
+ * We want k to be too large rather than too small.
+ * The error in the first-order Taylor series approximation
+ * is in our favor, so we just round up the constant enough
+ * to compensate for any error in the multiplication of
+ * (i - Bias) by 0.301029995663981; since |i - Bias| <= 1077,
+ * and 1077 * 0.30103 * 2^-52 ~=~ 7.2e-14,
+ * adding 1e-13 to the constant term more than suffices.
+ * Hence we adjust the constant term to 0.1760912590558.
+ * (We could get a more accurate k by invoking log10,
+ * but this is probably not worthwhile.)
+ */
+
+ i -= Bias;
+#ifndef Sudden_Underflow
+ denorm = 0;
+ } else {
+ /* d is denormalized */
+
+ i = bbits + be + (Bias + (P - 1) - 1);
+ x = i > 32 ? word0(d) << 64 - i | word1(d) >> i - 32
+ : word1(d) << 32 - i;
+ d2 = x;
+ word0(d2) -= 31 * Exp_msk1; /* adjust exponent */
+ i -= (Bias + (P - 1) - 1) + 1;
+ denorm = 1;
+ }
+#endif
+ ds = (d2 - 1.5) * 0.289529654602168 + 0.1760912590558 + i * 0.301029995663981;
+ k = (int)ds;
+ if (ds < 0. && ds != k)
+ k--; /* want k = floor(ds) */
+ k_check = 1;
+ if (k >= 0 && k <= Ten_pmax) {
+ if (d < tens[k])
+ k--;
+ k_check = 0;
+ }
+ j = bbits - i - 1;
+ if (j >= 0) {
+ b2 = 0;
+ s2 = j;
+ } else {
+ b2 = -j;
+ s2 = 0;
+ }
+ if (k >= 0) {
+ b5 = 0;
+ s5 = k;
+ s2 += k;
+ } else {
+ b2 -= k;
+ b5 = -k;
+ s5 = 0;
+ }
+ if (mode < 0 || mode > 9)
+ mode = 0;
+ try_quick = 1;
+ if (mode > 5) {
+ mode -= 4;
+ try_quick = 0;
+ }
+ leftright = 1;
+ switch (mode) {
+ case 0:
+ case 1:
+ ilim = ilim1 = -1;
+ i = 18;
+ ndigits = 0;
+ break;
+ case 2:
+ leftright = 0;
+ /* no break */
+ case 4:
+ if (ndigits <= 0)
+ ndigits = 1;
+ ilim = ilim1 = i = ndigits;
+ break;
+ case 3:
+ leftright = 0;
+ /* no break */
+ case 5:
+ i = ndigits + k + 1;
+ ilim = i;
+ ilim1 = i - 1;
+ if (i <= 0)
+ i = 1;
+ }
+ s = s0 = rv_alloc(i);
+
+ if (ilim >= 0 && ilim <= Quick_max && try_quick) {
+
+ /* Try to get by with floating-point arithmetic. */
+
+ i = 0;
+ d2 = d;
+ k0 = k;
+ ilim0 = ilim;
+ ieps = 2; /* conservative */
+ if (k > 0) {
+ ds = tens[k&0xf];
+ j = k >> 4;
+ if (j & Bletch) {
+ /* prevent overflows */
+ j &= Bletch - 1;
+ d /= bigtens[n_bigtens-1];
+ ieps++;
+ }
+ for (; j; j >>= 1, i++)
+ if (j & 1) {
+ ieps++;
+ ds *= bigtens[i];
+ }
+ d /= ds;
+ } else if (j1 = -k) {
+ d *= tens[j1 & 0xf];
+ for (j = j1 >> 4; j; j >>= 1, i++)
+ if (j & 1) {
+ ieps++;
+ d *= bigtens[i];
+ }
+ }
+ if (k_check && d < 1. && ilim > 0) {
+ if (ilim1 <= 0)
+ goto fast_failed;
+ ilim = ilim1;
+ k--;
+ d *= 10.;
+ ieps++;
+ }
+ eps = ieps * d + 7.;
+ word0(eps) -= (P - 1) * Exp_msk1;
+ if (ilim == 0) {
+ S = mhi = 0;
+ d -= 5.;
+ if (d > eps)
+ goto one_digit;
+ if (d < -eps)
+ goto no_digits;
+ goto fast_failed;
+ }
+ /* Generate ilim digits, then fix them up. */
+ eps *= tens[ilim-1];
+ for (i = 1; ; i++, d *= 10.) {
+ L = d;
+ d -= L;
+ *s++ = '0' + (int)L;
+ if (i == ilim) {
+ if (d > 0.5 + eps)
+ goto bump_up;
+ else if (d < 0.5 - eps) {
+ while (*--s == '0')
+ ;
+ s++;
+ goto ret1;
+ }
+ break;
+ }
+ }
+fast_failed:
+ s = s0;
+ d = d2;
+ k = k0;
+ ilim = ilim0;
+ }
+
+ /* Do we have a "small" integer? */
+
+ if (be >= 0 && k <= Int_max) {
+ /* Yes. */
+ ds = tens[k];
+ if (ndigits < 0 && ilim <= 0) {
+ S = mhi = 0;
+ if (ilim < 0 || d <= 5 * ds)
+ goto no_digits;
+ goto one_digit;
+ }
+ for (i = 1; ; i++) {
+ L = d / ds;
+ d -= L * ds;
+ *s++ = '0' + (int)L;
+ if (i == ilim) {
+ d += d;
+ if (d > ds || d == ds && L & 1) {
+bump_up:
+ while (*--s == '9')
+ if (s == s0) {
+ k++;
+ *s = '0';
+ break;
+ }
+ ++ * s++;
+ }
+ break;
+ }
+ if (!(d *= 10.))
+ break;
+ }
+ goto ret1;
+ }
+
+ m2 = b2;
+ m5 = b5;
+ mhi = mlo = 0;
+ if (leftright) {
+ if (mode < 2) {
+ i =
+#ifndef Sudden_Underflow
+ denorm ? be + (Bias + (P - 1) - 1 + 1) :
+#endif
+ 1 + P - bbits;
+ } else {
+ j = ilim - 1;
+ if (m5 >= j)
+ m5 -= j;
+ else {
+ s5 += j -= m5;
+ b5 += j;
+ m5 = 0;
+ }
+ if ((i = ilim) < 0) {
+ m2 -= i;
+ i = 0;
+ }
+ }
+ b2 += i;
+ s2 += i;
+ mhi = i2b(1);
+ }
+ if (m2 > 0 && s2 > 0) {
+ i = m2 < s2 ? m2 : s2;
+ b2 -= i;
+ m2 -= i;
+ s2 -= i;
+ }
+ if (b5 > 0) {
+ if (leftright) {
+ if (m5 > 0) {
+ mhi = pow5mult(mhi, m5);
+ b1 = mult(mhi, b);
+ Bfree(b);
+ b = b1;
+ }
+ if (j = b5 - m5)
+ b = pow5mult(b, j);
+ } else
+ b = pow5mult(b, b5);
+ }
+ S = i2b(1);
+ if (s5 > 0)
+ S = pow5mult(S, s5);
+
+ /* Check for special case that d is a normalized power of 2. */
+
+ spec_case = 0;
+ if (mode < 2) {
+ if (!word1(d) && !(word0(d) & Bndry_mask)
+#ifndef Sudden_Underflow
+ && word0(d) & Exp_mask
+#endif
+ ) {
+ /* The special case */
+ b2 += Log2P;
+ s2 += Log2P;
+ spec_case = 1;
+ }
+ }
+
+ /* Arrange for convenient computation of quotients:
+ * shift left if necessary so divisor has 4 leading 0 bits.
+ *
+ * Perhaps we should just compute leading 28 bits of S once
+ * and for all and pass them and a shift to quorem, so it
+ * can do shifts and ors to compute the numerator for q.
+ */
+ if (i = ((s5 ? 32 - hi0bits(S->x[S->wds-1]) : 1) + s2) & 0x1f)
+ i = 32 - i;
+ if (i > 4) {
+ i -= 4;
+ b2 += i;
+ m2 += i;
+ s2 += i;
+ } else if (i < 4) {
+ i += 28;
+ b2 += i;
+ m2 += i;
+ s2 += i;
+ }
+ if (b2 > 0)
+ b = lshift(b, b2);
+ if (s2 > 0)
+ S = lshift(S, s2);
+ if (k_check) {
+ if (cmp(b, S) < 0) {
+ k--;
+ b = multadd(b, 10, 0); /* we botched the k estimate */
+ if (leftright)
+ mhi = multadd(mhi, 10, 0);
+ ilim = ilim1;
+ }
+ }
+ if (ilim <= 0 && mode > 2) {
+ if (ilim < 0 || cmp(b, S = multadd(S, 5, 0)) <= 0) {
+ /* no digits, fcvt style */
+no_digits:
+ k = -1 - ndigits;
+ goto ret;
+ }
+one_digit:
+ *s++ = '1';
+ k++;
+ goto ret;
+ }
+ if (leftright) {
+ if (m2 > 0)
+ mhi = lshift(mhi, m2);
+
+ /* Compute mlo -- check for special case
+ * that d is a normalized power of 2.
+ */
+
+ mlo = mhi;
+ if (spec_case) {
+ mhi = Balloc(mhi->k);
+ Bcopy(mhi, mlo);
+ mhi = lshift(mhi, Log2P);
+ }
+
+ for (i = 1; ; i++) {
+ dig = quorem(b, S) + '0';
+ /* Do we yet have the shortest decimal string
+ * that will round to d?
+ */
+ j = cmp(b, mlo);
+ delta = diff(S, mhi);
+ j1 = delta->sign ? 1 : cmp(b, delta);
+ Bfree(delta);
+ if (j1 == 0 && !mode && !(word1(d) & 1)) {
+ if (dig == '9')
+ goto round_9_up;
+ if (j > 0)
+ dig++;
+ *s++ = dig;
+ goto ret;
+ }
+ if (j < 0 || j == 0 && !mode
+ && !(word1(d) & 1)
+ ) {
+ if (j1 > 0) {
+ b = lshift(b, 1);
+ j1 = cmp(b, S);
+ if ((j1 > 0 || j1 == 0 && dig & 1)
+ && dig++ == '9')
+ goto round_9_up;
+ }
+ *s++ = dig;
+ goto ret;
+ }
+ if (j1 > 0) {
+ if (dig == '9') { /* possible if i == 1 */
+round_9_up:
+ *s++ = '9';
+ goto roundoff;
+ }
+ *s++ = dig + 1;
+ goto ret;
+ }
+ *s++ = dig;
+ if (i == ilim)
+ break;
+ b = multadd(b, 10, 0);
+ if (mlo == mhi)
+ mlo = mhi = multadd(mhi, 10, 0);
+ else {
+ mlo = multadd(mlo, 10, 0);
+ mhi = multadd(mhi, 10, 0);
+ }
+ }
+ } else
+ for (i = 1; ; i++) {
+ *s++ = dig = quorem(b, S) + '0';
+ if (i >= ilim)
+ break;
+ b = multadd(b, 10, 0);
+ }
+
+ /* Round off last digit */
+
+ b = lshift(b, 1);
+ j = cmp(b, S);
+ if (j > 0 || j == 0 && dig & 1) {
+roundoff:
+ while (*--s == '9')
+ if (s == s0) {
+ k++;
+ *s++ = '1';
+ goto ret;
+ }
+ ++ * s++;
+ } else {
+ while (*--s == '0')
+ ;
+ s++;
+ }
+ret:
+ Bfree(S);
+ if (mhi) {
+ if (mlo && mlo != mhi)
+ Bfree(mlo);
+ Bfree(mhi);
+ }
+ret1:
+ Bfree(b);
+ *s = 0;
+ *decpt = k + 1;
+ if (rve)
+ *rve = s;
+ return s0;
+}
+
diff --git a/libmath/fdim.c b/libmath/fdim.c
new file mode 100644
index 00000000..1aec40c9
--- /dev/null
+++ b/libmath/fdim.c
@@ -0,0 +1,30 @@
+#include "lib9.h"
+#include "mathi.h"
+
+double
+fdim(double x, double y)
+{
+ if(x>y)
+ return x-y;
+ else
+ return 0;
+}
+
+double
+fmax(double x, double y)
+{
+ if(x>y)
+ return x;
+ else
+ return y;
+}
+
+double
+fmin(double x, double y)
+{
+ if(x<y)
+ return x;
+ else
+ return y;
+}
+
diff --git a/libmath/fdlibm/e_acos.c b/libmath/fdlibm/e_acos.c
new file mode 100644
index 00000000..284cfb0d
--- /dev/null
+++ b/libmath/fdlibm/e_acos.c
@@ -0,0 +1,97 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_acos.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_acos(x)
+ * Method :
+ * acos(x) = pi/2 - asin(x)
+ * acos(-x) = pi/2 + asin(x)
+ * For |x|<=0.5
+ * acos(x) = pi/2 - (x + x*x^2*R(x^2)) (see asin.c)
+ * For x>0.5
+ * acos(x) = pi/2 - (pi/2 - 2asin(sqrt((1-x)/2)))
+ * = 2asin(sqrt((1-x)/2))
+ * = 2s + 2s*z*R(z) ...z=(1-x)/2, s=sqrt(z)
+ * = 2f + (2c + 2s*z*R(z))
+ * where f=hi part of s, and c = (z-f*f)/(s+f) is the correction term
+ * for f so that f+c ~ sqrt(z).
+ * For x<-0.5
+ * acos(x) = pi - 2asin(sqrt((1-|x|)/2))
+ * = pi - 0.5*(s+s*z*R(z)), where z=(1-|x|)/2,s=sqrt(z)
+ *
+ * Special cases:
+ * if x is NaN, return x itself;
+ * if |x|>1, return NaN with invalid signal.
+ *
+ * Function needed: sqrt
+ */
+
+#include "fdlibm.h"
+
+static const double
+one= 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
+pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
+pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
+pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
+pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
+pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
+pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
+pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
+pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
+qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
+qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
+qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
+qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
+
+ double __ieee754_acos(double x)
+{
+ double z,p,q,r,w,s,c,df;
+ int hx,ix;
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x3ff00000) { /* |x| >= 1 */
+ if(((ix-0x3ff00000)|__LO(x))==0) { /* |x|==1 */
+ if(hx>0) return 0.0; /* acos(1) = 0 */
+ else return pi+2.0*pio2_lo; /* acos(-1)= pi */
+ }
+ return (x-x)/(x-x); /* acos(|x|>1) is NaN */
+ }
+ if(ix<0x3fe00000) { /* |x| < 0.5 */
+ if(ix<=0x3c600000) return pio2_hi+pio2_lo;/*if|x|<2**-57*/
+ z = x*x;
+ p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
+ q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
+ r = p/q;
+ return pio2_hi - (x - (pio2_lo-x*r));
+ } else if (hx<0) { /* x < -0.5 */
+ z = (one+x)*0.5;
+ p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
+ q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
+ s = sqrt(z);
+ r = p/q;
+ w = r*s-pio2_lo;
+ return pi - 2.0*(s+w);
+ } else { /* x > 0.5 */
+ z = (one-x)*0.5;
+ s = sqrt(z);
+ df = s;
+ __LO(df) = 0;
+ c = (z-df*df)/(s+df);
+ p = z*(pS0+z*(pS1+z*(pS2+z*(pS3+z*(pS4+z*pS5)))));
+ q = one+z*(qS1+z*(qS2+z*(qS3+z*qS4)));
+ r = p/q;
+ w = r*s+c;
+ return 2.0*(df+w);
+ }
+}
diff --git a/libmath/fdlibm/e_acosh.c b/libmath/fdlibm/e_acosh.c
new file mode 100644
index 00000000..48fd4faa
--- /dev/null
+++ b/libmath/fdlibm/e_acosh.c
@@ -0,0 +1,57 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_acosh.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+/* __ieee754_acosh(x)
+ * Method :
+ * Based on
+ * acosh(x) = log [ x + sqrt(x*x-1) ]
+ * we have
+ * acosh(x) := log(x)+ln2, if x is large; else
+ * acosh(x) := log(2x-1/(sqrt(x*x-1)+x)) if x>2; else
+ * acosh(x) := log1p(t+sqrt(2.0*t+t*t)); where t=x-1.
+ *
+ * Special cases:
+ * acosh(x) is NaN with signal if x<1.
+ * acosh(NaN) is NaN without signal.
+ */
+
+#include "fdlibm.h"
+
+static const double
+one = 1.0,
+ln2 = 6.93147180559945286227e-01; /* 0x3FE62E42, 0xFEFA39EF */
+
+ double __ieee754_acosh(double x)
+{
+ double t;
+ int hx;
+ hx = __HI(x);
+ if(hx<0x3ff00000) { /* x < 1 */
+ return (x-x)/(x-x);
+ } else if(hx >=0x41b00000) { /* x > 2**28 */
+ if(hx >=0x7ff00000) { /* x is inf of NaN */
+ return x+x;
+ } else
+ return __ieee754_log(x)+ln2; /* acosh(Huge)=log(2x) */
+ } else if(((hx-0x3ff00000)|__LO(x))==0) {
+ return 0.0; /* acosh(1) = 0 */
+ } else if (hx > 0x40000000) { /* 2**28 > x > 2 */
+ t=x*x;
+ return __ieee754_log(2.0*x-one/(x+sqrt(t-one)));
+ } else { /* 1<x<2 */
+ t = x-one;
+ return log1p(t+sqrt(2.0*t+t*t));
+ }
+}
diff --git a/libmath/fdlibm/e_asin.c b/libmath/fdlibm/e_asin.c
new file mode 100644
index 00000000..76b67c0f
--- /dev/null
+++ b/libmath/fdlibm/e_asin.c
@@ -0,0 +1,106 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_asin.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_asin(x)
+ * Method :
+ * Since asin(x) = x + x^3/6 + x^5*3/40 + x^7*15/336 + ...
+ * we approximate asin(x) on [0,0.5] by
+ * asin(x) = x + x*x^2*R(x^2)
+ * where
+ * R(x^2) is a rational approximation of (asin(x)-x)/x^3
+ * and its remez error is bounded by
+ * |(asin(x)-x)/x^3 - R(x^2)| < 2^(-58.75)
+ *
+ * For x in [0.5,1]
+ * asin(x) = pi/2-2*asin(sqrt((1-x)/2))
+ * Let y = (1-x), z = y/2, s := sqrt(z), and pio2_hi+pio2_lo=pi/2;
+ * then for x>0.98
+ * asin(x) = pi/2 - 2*(s+s*z*R(z))
+ * = pio2_hi - (2*(s+s*z*R(z)) - pio2_lo)
+ * For x<=0.98, let pio4_hi = pio2_hi/2, then
+ * f = hi part of s;
+ * c = sqrt(z) - f = (z-f*f)/(s+f) ...f+c=sqrt(z)
+ * and
+ * asin(x) = pi/2 - 2*(s+s*z*R(z))
+ * = pio4_hi+(pio4-2s)-(2s*z*R(z)-pio2_lo)
+ * = pio4_hi+(pio4-2f)-(2s*z*R(z)-(pio2_lo+2c))
+ *
+ * Special cases:
+ * if x is NaN, return x itself;
+ * if |x|>1, return NaN with invalid signal.
+ *
+ */
+
+
+#include "fdlibm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+Huge = 1.000e+300,
+pio2_hi = 1.57079632679489655800e+00, /* 0x3FF921FB, 0x54442D18 */
+pio2_lo = 6.12323399573676603587e-17, /* 0x3C91A626, 0x33145C07 */
+pio4_hi = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */
+ /* coefficient for R(x^2) */
+pS0 = 1.66666666666666657415e-01, /* 0x3FC55555, 0x55555555 */
+pS1 = -3.25565818622400915405e-01, /* 0xBFD4D612, 0x03EB6F7D */
+pS2 = 2.01212532134862925881e-01, /* 0x3FC9C155, 0x0E884455 */
+pS3 = -4.00555345006794114027e-02, /* 0xBFA48228, 0xB5688F3B */
+pS4 = 7.91534994289814532176e-04, /* 0x3F49EFE0, 0x7501B288 */
+pS5 = 3.47933107596021167570e-05, /* 0x3F023DE1, 0x0DFDF709 */
+qS1 = -2.40339491173441421878e+00, /* 0xC0033A27, 0x1C8A2D4B */
+qS2 = 2.02094576023350569471e+00, /* 0x40002AE5, 0x9C598AC8 */
+qS3 = -6.88283971605453293030e-01, /* 0xBFE6066C, 0x1B8D0159 */
+qS4 = 7.70381505559019352791e-02; /* 0x3FB3B8C5, 0xB12E9282 */
+
+ double __ieee754_asin(double x)
+{
+ double t,w,p,q,c,r,s;
+ int hx,ix;
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>= 0x3ff00000) { /* |x|>= 1 */
+ if(((ix-0x3ff00000)|__LO(x))==0)
+ /* asin(1)=+-pi/2 with inexact */
+ return x*pio2_hi+x*pio2_lo;
+ return (x-x)/(x-x); /* asin(|x|>1) is NaN */
+ } else if (ix<0x3fe00000) { /* |x|<0.5 */
+ if(ix<0x3e400000) { /* if |x| < 2**-27 */
+ if(Huge+x>one) return x;/* return x with inexact if x!=0*/
+ } else
+ t = x*x;
+ p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
+ q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
+ w = p/q;
+ return x+x*w;
+ }
+ /* 1> |x|>= 0.5 */
+ w = one-fabs(x);
+ t = w*0.5;
+ p = t*(pS0+t*(pS1+t*(pS2+t*(pS3+t*(pS4+t*pS5)))));
+ q = one+t*(qS1+t*(qS2+t*(qS3+t*qS4)));
+ s = sqrt(t);
+ if(ix>=0x3FEF3333) { /* if |x| > 0.975 */
+ w = p/q;
+ t = pio2_hi-(2.0*(s+s*w)-pio2_lo);
+ } else {
+ w = s;
+ __LO(w) = 0;
+ c = (t-w*w)/(s+w);
+ r = p/q;
+ p = 2.0*s*r-(pio2_lo-2.0*c);
+ q = pio4_hi-2.0*w;
+ t = pio4_hi-(p-q);
+ }
+ if(hx>0) return t; else return -t;
+}
diff --git a/libmath/fdlibm/e_atan2.c b/libmath/fdlibm/e_atan2.c
new file mode 100644
index 00000000..8415e00e
--- /dev/null
+++ b/libmath/fdlibm/e_atan2.c
@@ -0,0 +1,115 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_atan2.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+/* __ieee754_atan2(y,x)
+ * Method :
+ * 1. Reduce y to positive by atan2(y,x)=-atan2(-y,x).
+ * 2. Reduce x to positive by (if x and y are unexceptional):
+ * ARG (x+iy) = arctan(y/x) ... if x > 0,
+ * ARG (x+iy) = pi - arctan[y/(-x)] ... if x < 0,
+ *
+ * Special cases:
+ *
+ * ATAN2((anything), NaN ) is NaN;
+ * ATAN2(NAN , (anything) ) is NaN;
+ * ATAN2(+-0, +(anything but NaN)) is +-0 ;
+ * ATAN2(+-0, -(anything but NaN)) is +-pi ;
+ * ATAN2(+-(anything but 0 and NaN), 0) is +-pi/2;
+ * ATAN2(+-(anything but INF and NaN), +INF) is +-0 ;
+ * ATAN2(+-(anything but INF and NaN), -INF) is +-pi;
+ * ATAN2(+-INF,+INF ) is +-pi/4 ;
+ * ATAN2(+-INF,-INF ) is +-3pi/4;
+ * ATAN2(+-INF, (anything but,0,NaN, and INF)) is +-pi/2;
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const double
+tiny = 1.0e-300,
+zero = 0.0,
+pi_o_4 = 7.8539816339744827900E-01, /* 0x3FE921FB, 0x54442D18 */
+pi_o_2 = 1.5707963267948965580E+00, /* 0x3FF921FB, 0x54442D18 */
+pi = 3.1415926535897931160E+00, /* 0x400921FB, 0x54442D18 */
+pi_lo = 1.2246467991473531772E-16; /* 0x3CA1A626, 0x33145C07 */
+
+ double __ieee754_atan2(double y, double x)
+{
+ double z;
+ int k,m,hx,hy,ix,iy;
+ unsigned lx,ly;
+
+ hx = __HI(x); ix = hx&0x7fffffff;
+ lx = __LO(x);
+ hy = __HI(y); iy = hy&0x7fffffff;
+ ly = __LO(y);
+ if(((ix|((lx|-lx)>>31))>0x7ff00000)||
+ ((iy|((ly|-ly)>>31))>0x7ff00000)) /* x or y is NaN */
+ return x+y;
+ if((hx-0x3ff00000|lx)==0) return atan(y); /* x=1.0 */
+ m = ((hy>>31)&1)|((hx>>30)&2); /* 2*sign(x)+sign(y) */
+
+ /* when y = 0 */
+ if((iy|ly)==0) {
+ switch(m) {
+ case 0:
+ case 1: return y; /* atan(+-0,+anything)=+-0 */
+ case 2: return pi+tiny;/* atan(+0,-anything) = pi */
+ case 3: return -pi-tiny;/* atan(-0,-anything) =-pi */
+ }
+ }
+ /* when x = 0 */
+ if((ix|lx)==0) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny;
+
+ /* when x is INF */
+ if(ix==0x7ff00000) {
+ if(iy==0x7ff00000) {
+ switch(m) {
+ case 0: return pi_o_4+tiny;/* atan(+INF,+INF) */
+ case 1: return -pi_o_4-tiny;/* atan(-INF,+INF) */
+ case 2: return 3.0*pi_o_4+tiny;/*atan(+INF,-INF)*/
+ case 3: return -3.0*pi_o_4-tiny;/*atan(-INF,-INF)*/
+ }
+ } else {
+ switch(m) {
+ case 0: return zero ; /* atan(+...,+INF) */
+ case 1: return -zero ; /* atan(-...,+INF) */
+ case 2: return pi+tiny ; /* atan(+...,-INF) */
+ case 3: return -pi-tiny ; /* atan(-...,-INF) */
+ }
+ }
+ }
+ /* when y is INF */
+ if(iy==0x7ff00000) return (hy<0)? -pi_o_2-tiny: pi_o_2+tiny;
+
+ /* compute y/x */
+ k = (iy-ix)>>20;
+ if(k > 60) z=pi_o_2+0.5*pi_lo; /* |y/x| > 2**60 */
+ else if(hx<0&&k<-60) z=0.0; /* |y|/x < -2**60 */
+ else z=atan(fabs(y/x)); /* safe to do y/x */
+ switch (m) {
+ case 0: return z ; /* atan(+,+) */
+ case 1: __HI(z) ^= 0x80000000;
+ return z ; /* atan(-,+) */
+ case 2: return pi-(z-pi_lo);/* atan(+,-) */
+ default: /* case 3 */
+ return (z-pi_lo)-pi;/* atan(-,-) */
+ }
+}
diff --git a/libmath/fdlibm/e_atanh.c b/libmath/fdlibm/e_atanh.c
new file mode 100644
index 00000000..61f5b489
--- /dev/null
+++ b/libmath/fdlibm/e_atanh.c
@@ -0,0 +1,60 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_atanh.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+/* __ieee754_atanh(x)
+ * Method :
+ * 1.Reduced x to positive by atanh(-x) = -atanh(x)
+ * 2.For x>=0.5
+ * 1 2x x
+ * atanh(x) = --- * log(1 + -------) = 0.5 * log1p(2 * --------)
+ * 2 1 - x 1 - x
+ *
+ * For x<0.5
+ * atanh(x) = 0.5*log1p(2x+2x*x/(1-x))
+ *
+ * Special cases:
+ * atanh(x) is NaN if |x| > 1 with signal;
+ * atanh(NaN) is that NaN with no signal;
+ * atanh(+-1) is +-INF with signal.
+ *
+ */
+
+#include "fdlibm.h"
+
+static const double one = 1.0, Huge = 1e300;
+
+static double zero = 0.0;
+
+ double __ieee754_atanh(double x)
+{
+ double t;
+ int hx,ix;
+ unsigned lx;
+ hx = __HI(x); /* high word */
+ lx = __LO(x); /* low word */
+ ix = hx&0x7fffffff;
+ if ((ix|((lx|(-lx))>>31))>0x3ff00000) /* |x|>1 */
+ return (x-x)/(x-x);
+ if(ix==0x3ff00000)
+ return x/zero;
+ if(ix<0x3e300000&&(Huge+x)>zero) return x; /* x<2**-28 */
+ __HI(x) = ix; /* x <- |x| */
+ if(ix<0x3fe00000) { /* x < 0.5 */
+ t = x+x;
+ t = 0.5*log1p(t+t*x/(one-x));
+ } else
+ t = 0.5*log1p((x+x)/(one-x));
+ if(hx>=0) return t; else return -t;
+}
diff --git a/libmath/fdlibm/e_cosh.c b/libmath/fdlibm/e_cosh.c
new file mode 100644
index 00000000..9274b72e
--- /dev/null
+++ b/libmath/fdlibm/e_cosh.c
@@ -0,0 +1,81 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_cosh.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_cosh(x)
+ * Method :
+ * mathematically cosh(x) if defined to be (exp(x)+exp(-x))/2
+ * 1. Replace x by |x| (cosh(x) = cosh(-x)).
+ * 2.
+ * [ exp(x) - 1 ]^2
+ * 0 <= x <= ln2/2 : cosh(x) := 1 + -------------------
+ * 2*exp(x)
+ *
+ * exp(x) + 1/exp(x)
+ * ln2/2 <= x <= 22 : cosh(x) := -------------------
+ * 2
+ * 22 <= x <= lnovft : cosh(x) := exp(x)/2
+ * lnovft <= x <= ln2ovft: cosh(x) := exp(x/2)/2 * exp(x/2)
+ * ln2ovft < x : cosh(x) := Huge*Huge (overflow)
+ *
+ * Special cases:
+ * cosh(x) is |x| if x is +INF, -INF, or NaN.
+ * only cosh(0)=1 is exact for finite x.
+ */
+
+#include "fdlibm.h"
+
+static const double one = 1.0, half=0.5, Huge = 1.0e300;
+
+ double __ieee754_cosh(double x)
+{
+ double t,w;
+ int ix;
+ unsigned lx;
+
+ /* High word of |x|. */
+ ix = __HI(x);
+ ix &= 0x7fffffff;
+
+ /* x is INF or NaN */
+ if(ix>=0x7ff00000) return x*x;
+
+ /* |x| in [0,0.5*ln2], return 1+expm1(|x|)^2/(2*exp(|x|)) */
+ if(ix<0x3fd62e43) {
+ t = expm1(fabs(x));
+ w = one+t;
+ if (ix<0x3c800000) return w; /* cosh(tiny) = 1 */
+ return one+(t*t)/(w+w);
+ }
+
+ /* |x| in [0.5*ln2,22], return (exp(|x|)+1/exp(|x|)/2; */
+ if (ix < 0x40360000) {
+ t = __ieee754_exp(fabs(x));
+ return half*t+half/t;
+ }
+
+ /* |x| in [22, log(maxdouble)] return half*exp(|x|) */
+ if (ix < 0x40862E42) return half*__ieee754_exp(fabs(x));
+
+ /* |x| in [log(maxdouble), overflowthresold] */
+ lx = *( (((*(unsigned*)&one)>>29)) + (unsigned*)&x);
+ if (ix<0x408633CE ||
+ (ix==0x408633ce)&&(lx<=(unsigned)0x8fb9f87d)) {
+ w = __ieee754_exp(half*fabs(x));
+ t = half*w;
+ return t*w;
+ }
+
+ /* |x| > overflowthresold, cosh(x) overflow */
+ return Huge*Huge;
+}
diff --git a/libmath/fdlibm/e_exp.c b/libmath/fdlibm/e_exp.c
new file mode 100644
index 00000000..f0fbdf7e
--- /dev/null
+++ b/libmath/fdlibm/e_exp.c
@@ -0,0 +1,149 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_exp.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_exp(x)
+ * Returns the exponential of x.
+ *
+ * Method
+ * 1. Argument reduction:
+ * Reduce x to an r so that |r| <= 0.5*ln2 ~ 0.34658.
+ * Given x, find r and integer k such that
+ *
+ * x = k*ln2 + r, |r| <= 0.5*ln2.
+ *
+ * Here r will be represented as r = hi-lo for better
+ * accuracy.
+ *
+ * 2. Approximation of exp(r) by a special rational function on
+ * the interval [0,0.34658]:
+ * Write
+ * R(r**2) = r*(exp(r)+1)/(exp(r)-1) = 2 + r*r/6 - r**4/360 + ...
+ * We use a special Reme algorithm on [0,0.34658] to generate
+ * a polynomial of degree 5 to approximate R. The maximum error
+ * of this polynomial approximation is bounded by 2**-59. In
+ * other words,
+ * R(z) ~ 2.0 + P1*z + P2*z**2 + P3*z**3 + P4*z**4 + P5*z**5
+ * (where z=r*r, and the values of P1 to P5 are listed below)
+ * and
+ * | 5 | -59
+ * | 2.0+P1*z+...+P5*z - R(z) | <= 2
+ * | |
+ * The computation of exp(r) thus becomes
+ * 2*r
+ * exp(r) = 1 + -------
+ * R - r
+ * r*R1(r)
+ * = 1 + r + ----------- (for better accuracy)
+ * 2 - R1(r)
+ * where
+ * 2 4 10
+ * R1(r) = r - (P1*r + P2*r + ... + P5*r ).
+ *
+ * 3. Scale back to obtain exp(x):
+ * From step 1, we have
+ * exp(x) = 2^k * exp(r)
+ *
+ * Special cases:
+ * exp(INF) is INF, exp(NaN) is NaN;
+ * exp(-INF) is 0, and
+ * for finite argument, only exp(0)=1 is exact.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Misc. info.
+ * For IEEE double
+ * if x > 7.09782712893383973096e+02 then exp(x) overflow
+ * if x < -7.45133219101941108420e+02 then exp(x) underflow
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const double
+one = 1.0,
+halF[2] = {0.5,-0.5,},
+Huge = 1.0e+300,
+twom1000= 9.33263618503218878990e-302, /* 2**-1000=0x01700000,0*/
+o_threshold= 7.09782712893383973096e+02, /* 0x40862E42, 0xFEFA39EF */
+u_threshold= -7.45133219101941108420e+02, /* 0xc0874910, 0xD52D3051 */
+ln2HI[2] ={ 6.93147180369123816490e-01, /* 0x3fe62e42, 0xfee00000 */
+ -6.93147180369123816490e-01,},/* 0xbfe62e42, 0xfee00000 */
+ln2LO[2] ={ 1.90821492927058770002e-10, /* 0x3dea39ef, 0x35793c76 */
+ -1.90821492927058770002e-10,},/* 0xbdea39ef, 0x35793c76 */
+invln2 = 1.44269504088896338700e+00, /* 0x3ff71547, 0x652b82fe */
+P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
+P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
+P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
+P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
+P5 = 4.13813679705723846039e-08; /* 0x3E663769, 0x72BEA4D0 */
+
+
+ double __ieee754_exp(double x) /* default IEEE double exp */
+{
+ double y,hi,lo,c,t;
+ int k,xsb;
+ unsigned hx;
+
+ hx = __HI(x); /* high word of x */
+ xsb = (hx>>31)&1; /* sign bit of x */
+ hx &= 0x7fffffff; /* high word of |x| */
+
+ /* filter out non-finite argument */
+ if(hx >= 0x40862E42) { /* if |x|>=709.78... */
+ if(hx>=0x7ff00000) {
+ if(((hx&0xfffff)|__LO(x))!=0)
+ return x+x; /* NaN */
+ else return (xsb==0)? x:0.0; /* exp(+-inf)={inf,0} */
+ }
+ if(x > o_threshold) return Huge*Huge; /* overflow */
+ if(x < u_threshold) return twom1000*twom1000; /* underflow */
+ }
+
+ /* argument reduction */
+ if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
+ if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
+ hi = x-ln2HI[xsb]; lo=ln2LO[xsb]; k = 1-xsb-xsb;
+ } else {
+ k = invln2*x+halF[xsb];
+ t = k;
+ hi = x - t*ln2HI[0]; /* t*ln2HI is exact here */
+ lo = t*ln2LO[0];
+ }
+ x = hi - lo;
+ }
+ else if(hx < 0x3e300000) { /* when |x|<2**-28 */
+ if(Huge+x>one) return one+x;/* trigger inexact */
+ }
+ else k = 0;
+
+ /* x is now in primary range */
+ t = x*x;
+ c = x - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
+ if(k==0) return one-((x*c)/(c-2.0)-x);
+ else y = one-((lo-(x*c)/(2.0-c))-hi);
+ if(k >= -1021) {
+ __HI(y) += (k<<20); /* add k to y's exponent */
+ return y;
+ } else {
+ __HI(y) += ((k+1000)<<20);/* add k to y's exponent */
+ return y*twom1000;
+ }
+}
diff --git a/libmath/fdlibm/e_fmod.c b/libmath/fdlibm/e_fmod.c
new file mode 100644
index 00000000..f6c30fdc
--- /dev/null
+++ b/libmath/fdlibm/e_fmod.c
@@ -0,0 +1,132 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_fmod.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * __ieee754_fmod(x,y)
+ * Return x mod y in exact arithmetic
+ * Method: shift and subtract
+ */
+
+#include "fdlibm.h"
+
+static const double one = 1.0, Zero[] = {0.0, -0.0,};
+
+ double __ieee754_fmod(double x, double y)
+{
+ int n,hx,hy,hz,ix,iy,sx,i;
+ unsigned lx,ly,lz;
+
+ hx = __HI(x); /* high word of x */
+ lx = __LO(x); /* low word of x */
+ hy = __HI(y); /* high word of y */
+ ly = __LO(y); /* low word of y */
+ sx = hx&0x80000000; /* sign of x */
+ hx ^=sx; /* |x| */
+ hy &= 0x7fffffff; /* |y| */
+
+ /* purge off exception values */
+ if((hy|ly)==0||(hx>=0x7ff00000)|| /* y=0,or x not finite */
+ ((hy|((ly|-ly)>>31))>0x7ff00000)) /* or y is NaN */
+ return (x*y)/(x*y);
+ if(hx<=hy) {
+ if((hx<hy)||(lx<ly)) return x; /* |x|<|y| return x */
+ if(lx==ly)
+ return Zero[(unsigned)sx>>31]; /* |x|=|y| return x*0*/
+ }
+
+ /* determine ix = ilogb(x) */
+ if(hx<0x00100000) { /* subnormal x */
+ if(hx==0) {
+ for (ix = -1043, i=lx; i>0; i<<=1) ix -=1;
+ } else {
+ for (ix = -1022,i=(hx<<11); i>0; i<<=1) ix -=1;
+ }
+ } else ix = (hx>>20)-1023;
+
+ /* determine iy = ilogb(y) */
+ if(hy<0x00100000) { /* subnormal y */
+ if(hy==0) {
+ for (iy = -1043, i=ly; i>0; i<<=1) iy -=1;
+ } else {
+ for (iy = -1022,i=(hy<<11); i>0; i<<=1) iy -=1;
+ }
+ } else iy = (hy>>20)-1023;
+
+ /* set up {hx,lx}, {hy,ly} and align y to x */
+ if(ix >= -1022)
+ hx = 0x00100000|(0x000fffff&hx);
+ else { /* subnormal x, shift x to normal */
+ n = -1022-ix;
+ if(n<=31) {
+ hx = (hx<<n)|(lx>>(32-n));
+ lx <<= n;
+ } else {
+ hx = lx<<(n-32);
+ lx = 0;
+ }
+ }
+ if(iy >= -1022)
+ hy = 0x00100000|(0x000fffff&hy);
+ else { /* subnormal y, shift y to normal */
+ n = -1022-iy;
+ if(n<=31) {
+ hy = (hy<<n)|(ly>>(32-n));
+ ly <<= n;
+ } else {
+ hy = ly<<(n-32);
+ ly = 0;
+ }
+ }
+
+ /* fix point fmod */
+ n = ix - iy;
+ while(n--) {
+ hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1;
+ if(hz<0){hx = hx+hx+(lx>>31); lx = lx+lx;}
+ else {
+ if((hz|lz)==0) /* return sign(x)*0 */
+ return Zero[(unsigned)sx>>31];
+ hx = hz+hz+(lz>>31); lx = lz+lz;
+ }
+ }
+ hz=hx-hy;lz=lx-ly; if(lx<ly) hz -= 1;
+ if(hz>=0) {hx=hz;lx=lz;}
+
+ /* convert back to floating value and restore the sign */
+ if((hx|lx)==0) /* return sign(x)*0 */
+ return Zero[(unsigned)sx>>31];
+ while(hx<0x00100000) { /* normalize x */
+ hx = hx+hx+(lx>>31); lx = lx+lx;
+ iy -= 1;
+ }
+ if(iy>= -1022) { /* normalize output */
+ hx = ((hx-0x00100000)|((iy+1023)<<20));
+ __HI(x) = hx|sx;
+ __LO(x) = lx;
+ } else { /* subnormal output */
+ n = -1022 - iy;
+ if(n<=20) {
+ lx = (lx>>n)|((unsigned)hx<<(32-n));
+ hx >>= n;
+ } else if (n<=31) {
+ lx = (hx<<(32-n))|(lx>>n); hx = sx;
+ } else {
+ lx = hx>>(n-32); hx = sx;
+ }
+ __HI(x) = hx|sx;
+ __LO(x) = lx;
+ x *= one; /* create necessary signal */
+ }
+ return x; /* exact output */
+}
diff --git a/libmath/fdlibm/e_hypot.c b/libmath/fdlibm/e_hypot.c
new file mode 100644
index 00000000..bb5c314b
--- /dev/null
+++ b/libmath/fdlibm/e_hypot.c
@@ -0,0 +1,111 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_hypot.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_hypot(x,y)
+ *
+ * Method :
+ * If (assume round-to-nearest) z=x*x+y*y
+ * has error less than sqrt(2)/2 ulp, than
+ * sqrt(z) has error less than 1 ulp (exercise).
+ *
+ * So, compute sqrt(x*x+y*y) with some care as
+ * follows to get the error below 1 ulp:
+ *
+ * Assume x>y>0;
+ * (if possible, set rounding to round-to-nearest)
+ * 1. if x > 2y use
+ * x1*x1+(y*y+(x2*(x+x1))) for x*x+y*y
+ * where x1 = x with lower 32 bits cleared, x2 = x-x1; else
+ * 2. if x <= 2y use
+ * t1*y1+((x-y)*(x-y)+(t1*y2+t2*y))
+ * where t1 = 2x with lower 32 bits cleared, t2 = 2x-t1,
+ * y1= y with lower 32 bits chopped, y2 = y-y1.
+ *
+ * NOTE: scaling may be necessary if some argument is too
+ * large or too tiny
+ *
+ * Special cases:
+ * hypot(x,y) is INF if x or y is +INF or -INF; else
+ * hypot(x,y) is NAN if x or y is NAN.
+ *
+ * Accuracy:
+ * hypot(x,y) returns sqrt(x^2+y^2) with error less
+ * than 1 ulps (units in the last place)
+ */
+
+#include "fdlibm.h"
+
+ double __ieee754_hypot(double x, double y)
+{
+ double a=x,b=y,t1,t2,y1,y2,w;
+ int j,k,ha,hb;
+
+ ha = __HI(x)&0x7fffffff; /* high word of x */
+ hb = __HI(y)&0x7fffffff; /* high word of y */
+ if(hb > ha) {a=y;b=x;j=ha; ha=hb;hb=j;} else {a=x;b=y;}
+ __HI(a) = ha; /* a <- |a| */
+ __HI(b) = hb; /* b <- |b| */
+ if((ha-hb)>0x3c00000) {return a+b;} /* x/y > 2**60 */
+ k=0;
+ if(ha > 0x5f300000) { /* a>2**500 */
+ if(ha >= 0x7ff00000) { /* Inf or NaN */
+ w = a+b; /* for sNaN */
+ if(((ha&0xfffff)|__LO(a))==0) w = a;
+ if(((hb^0x7ff00000)|__LO(b))==0) w = b;
+ return w;
+ }
+ /* scale a and b by 2**-600 */
+ ha -= 0x25800000; hb -= 0x25800000; k += 600;
+ __HI(a) = ha;
+ __HI(b) = hb;
+ }
+ if(hb < 0x20b00000) { /* b < 2**-500 */
+ if(hb <= 0x000fffff) { /* subnormal b or 0 */
+ if((hb|(__LO(b)))==0) return a;
+ t1=0;
+ __HI(t1) = 0x7fd00000; /* t1=2^1022 */
+ b *= t1;
+ a *= t1;
+ k -= 1022;
+ } else { /* scale a and b by 2^600 */
+ ha += 0x25800000; /* a *= 2^600 */
+ hb += 0x25800000; /* b *= 2^600 */
+ k -= 600;
+ __HI(a) = ha;
+ __HI(b) = hb;
+ }
+ }
+ /* medium size a and b */
+ w = a-b;
+ if (w>b) {
+ t1 = 0;
+ __HI(t1) = ha;
+ t2 = a-t1;
+ w = sqrt(t1*t1-(b*(-b)-t2*(a+t1)));
+ } else {
+ a = a+a;
+ y1 = 0;
+ __HI(y1) = hb;
+ y2 = b - y1;
+ t1 = 0;
+ __HI(t1) = ha+0x00100000;
+ t2 = a - t1;
+ w = sqrt(t1*y1-(w*(-w)-(t1*y2+t2*b)));
+ }
+ if(k!=0) {
+ t1 = 1.0;
+ __HI(t1) += (k<<20);
+ return t1*w;
+ } else return w;
+}
diff --git a/libmath/fdlibm/e_j0.c b/libmath/fdlibm/e_j0.c
new file mode 100644
index 00000000..068a6427
--- /dev/null
+++ b/libmath/fdlibm/e_j0.c
@@ -0,0 +1,375 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_j0.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_j0(x), __ieee754_y0(x)
+ * Bessel function of the first and second kinds of order zero.
+ * Method -- j0(x):
+ * 1. For tiny x, we use j0(x) = 1 - x^2/4 + x^4/64 - ...
+ * 2. Reduce x to |x| since j0(x)=j0(-x), and
+ * for x in (0,2)
+ * j0(x) = 1-z/4+ z^2*R0/S0, where z = x*x;
+ * (precision: |j0-1+z/4-z^2R0/S0 |<2**-63.67 )
+ * for x in (2,inf)
+ * j0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)-q0(x)*sin(x0))
+ * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0)
+ * as follow:
+ * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
+ * = 1/sqrt(2) * (cos(x) + sin(x))
+ * sin(x0) = sin(x)cos(pi/4)-cos(x)sin(pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * (To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.)
+ *
+ * 3 Special cases
+ * j0(nan)= nan
+ * j0(0) = 1
+ * j0(inf) = 0
+ *
+ * Method -- y0(x):
+ * 1. For x<2.
+ * Since
+ * y0(x) = 2/pi*(j0(x)*(ln(x/2)+Euler) + x^2/4 - ...)
+ * therefore y0(x)-2/pi*j0(x)*ln(x) is an even function.
+ * We use the following function to approximate y0,
+ * y0(x) = U(z)/V(z) + (2/pi)*(j0(x)*ln(x)), z= x^2
+ * where
+ * U(z) = u00 + u01*z + ... + u06*z^6
+ * V(z) = 1 + v01*z + ... + v04*z^4
+ * with absolute approximation error bounded by 2**-72.
+ * Note: For tiny x, U/V = u0 and j0(x)~1, hence
+ * y0(tiny) = u0 + (2/pi)*ln(tiny), (choose tiny<2**-27)
+ * 2. For x>=2.
+ * y0(x) = sqrt(2/(pi*x))*(p0(x)*cos(x0)+q0(x)*sin(x0))
+ * where x0 = x-pi/4. It is better to compute sin(x0),cos(x0)
+ * by the method mentioned above.
+ * 3. Special cases: y0(0)=-inf, y0(x<0)=NaN, y0(inf)=0.
+ */
+
+#include "fdlibm.h"
+
+static double pzero(double), qzero(double);
+
+static const double
+Huge = 1e300,
+one = 1.0,
+invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
+tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+ /* R0/S0 on [0, 2.00] */
+R02 = 1.56249999999999947958e-02, /* 0x3F8FFFFF, 0xFFFFFFFD */
+R03 = -1.89979294238854721751e-04, /* 0xBF28E6A5, 0xB61AC6E9 */
+R04 = 1.82954049532700665670e-06, /* 0x3EBEB1D1, 0x0C503919 */
+R05 = -4.61832688532103189199e-09, /* 0xBE33D5E7, 0x73D63FCE */
+S01 = 1.56191029464890010492e-02, /* 0x3F8FFCE8, 0x82C8C2A4 */
+S02 = 1.16926784663337450260e-04, /* 0x3F1EA6D2, 0xDD57DBF4 */
+S03 = 5.13546550207318111446e-07, /* 0x3EA13B54, 0xCE84D5A9 */
+S04 = 1.16614003333790000205e-09; /* 0x3E1408BC, 0xF4745D8F */
+
+static double zero = 0.0;
+
+ double __ieee754_j0(double x)
+{
+ double z, s,c,ss,cc,r,u,v;
+ int hx,ix;
+
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x7ff00000) return one/(x*x);
+ x = fabs(x);
+ if(ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sin(x);
+ c = cos(x);
+ ss = s-c;
+ cc = s+c;
+ if(ix<0x7fe00000) { /* make sure x+x not overflow */
+ z = -cos(x+x);
+ if ((s*c)<zero) cc = z/ss;
+ else ss = z/cc;
+ }
+ /*
+ * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
+ * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
+ */
+ if(ix>0x48000000) z = (invsqrtpi*cc)/sqrt(x);
+ else {
+ u = pzero(x); v = qzero(x);
+ z = invsqrtpi*(u*cc-v*ss)/sqrt(x);
+ }
+ return z;
+ }
+ if(ix<0x3f200000) { /* |x| < 2**-13 */
+ if(Huge+x>one) { /* raise inexact if x != 0 */
+ if(ix<0x3e400000) return one; /* |x|<2**-27 */
+ else return one - 0.25*x*x;
+ }
+ }
+ z = x*x;
+ r = z*(R02+z*(R03+z*(R04+z*R05)));
+ s = one+z*(S01+z*(S02+z*(S03+z*S04)));
+ if(ix < 0x3FF00000) { /* |x| < 1.00 */
+ return one + z*(-0.25+(r/s));
+ } else {
+ u = 0.5*x;
+ return((one+u)*(one-u)+z*(r/s));
+ }
+}
+
+static const double
+u00 = -7.38042951086872317523e-02, /* 0xBFB2E4D6, 0x99CBD01F */
+u01 = 1.76666452509181115538e-01, /* 0x3FC69D01, 0x9DE9E3FC */
+u02 = -1.38185671945596898896e-02, /* 0xBF8C4CE8, 0xB16CFA97 */
+u03 = 3.47453432093683650238e-04, /* 0x3F36C54D, 0x20B29B6B */
+u04 = -3.81407053724364161125e-06, /* 0xBECFFEA7, 0x73D25CAD */
+u05 = 1.95590137035022920206e-08, /* 0x3E550057, 0x3B4EABD4 */
+u06 = -3.98205194132103398453e-11, /* 0xBDC5E43D, 0x693FB3C8 */
+v01 = 1.27304834834123699328e-02, /* 0x3F8A1270, 0x91C9C71A */
+v02 = 7.60068627350353253702e-05, /* 0x3F13ECBB, 0xF578C6C1 */
+v03 = 2.59150851840457805467e-07, /* 0x3E91642D, 0x7FF202FD */
+v04 = 4.41110311332675467403e-10; /* 0x3DFE5018, 0x3BD6D9EF */
+
+ double __ieee754_y0(double x)
+{
+ double z, s,c,ss,cc,u,v;
+ int hx,ix,lx;
+
+ hx = __HI(x);
+ ix = 0x7fffffff&hx;
+ lx = __LO(x);
+ /* Y0(NaN) is NaN, y0(-inf) is Nan, y0(inf) is 0 */
+ if(ix>=0x7ff00000) return one/(x+x*x);
+ if((ix|lx)==0) return -one/zero;
+ if(hx<0) return zero/zero;
+ if(ix >= 0x40000000) { /* |x| >= 2.0 */
+ /* y0(x) = sqrt(2/(pi*x))*(p0(x)*sin(x0)+q0(x)*cos(x0))
+ * where x0 = x-pi/4
+ * Better formula:
+ * cos(x0) = cos(x)cos(pi/4)+sin(x)sin(pi/4)
+ * = 1/sqrt(2) * (sin(x) + cos(x))
+ * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.
+ */
+ s = sin(x);
+ c = cos(x);
+ ss = s-c;
+ cc = s+c;
+ /*
+ * j0(x) = 1/sqrt(pi) * (P(0,x)*cc - Q(0,x)*ss) / sqrt(x)
+ * y0(x) = 1/sqrt(pi) * (P(0,x)*ss + Q(0,x)*cc) / sqrt(x)
+ */
+ if(ix<0x7fe00000) { /* make sure x+x not overflow */
+ z = -cos(x+x);
+ if ((s*c)<zero) cc = z/ss;
+ else ss = z/cc;
+ }
+ if(ix>0x48000000) z = (invsqrtpi*ss)/sqrt(x);
+ else {
+ u = pzero(x); v = qzero(x);
+ z = invsqrtpi*(u*ss+v*cc)/sqrt(x);
+ }
+ return z;
+ }
+ if(ix<=0x3e400000) { /* x < 2**-27 */
+ return(u00 + tpi*__ieee754_log(x));
+ }
+ z = x*x;
+ u = u00+z*(u01+z*(u02+z*(u03+z*(u04+z*(u05+z*u06)))));
+ v = one+z*(v01+z*(v02+z*(v03+z*v04)));
+ return(u/v + tpi*(__ieee754_j0(x)*__ieee754_log(x)));
+}
+
+/* The asymptotic expansions of pzero is
+ * 1 - 9/128 s^2 + 11025/98304 s^4 - ..., where s = 1/x.
+ * For x >= 2, We approximate pzero by
+ * pzero(x) = 1 + (R/S)
+ * where R = pR0 + pR1*s^2 + pR2*s^4 + ... + pR5*s^10
+ * S = 1 + pS0*s^2 + ... + pS4*s^10
+ * and
+ * | pzero(x)-1-R/S | <= 2 ** ( -60.26)
+ */
+static const double pR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ -7.03124999999900357484e-02, /* 0xBFB1FFFF, 0xFFFFFD32 */
+ -8.08167041275349795626e+00, /* 0xC02029D0, 0xB44FA779 */
+ -2.57063105679704847262e+02, /* 0xC0701102, 0x7B19E863 */
+ -2.48521641009428822144e+03, /* 0xC0A36A6E, 0xCD4DCAFC */
+ -5.25304380490729545272e+03, /* 0xC0B4850B, 0x36CC643D */
+};
+static const double pS8[5] = {
+ 1.16534364619668181717e+02, /* 0x405D2233, 0x07A96751 */
+ 3.83374475364121826715e+03, /* 0x40ADF37D, 0x50596938 */
+ 4.05978572648472545552e+04, /* 0x40E3D2BB, 0x6EB6B05F */
+ 1.16752972564375915681e+05, /* 0x40FC810F, 0x8F9FA9BD */
+ 4.76277284146730962675e+04, /* 0x40E74177, 0x4F2C49DC */
+};
+
+static const double pR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ -1.14125464691894502584e-11, /* 0xBDA918B1, 0x47E495CC */
+ -7.03124940873599280078e-02, /* 0xBFB1FFFF, 0xE69AFBC6 */
+ -4.15961064470587782438e+00, /* 0xC010A370, 0xF90C6BBF */
+ -6.76747652265167261021e+01, /* 0xC050EB2F, 0x5A7D1783 */
+ -3.31231299649172967747e+02, /* 0xC074B3B3, 0x6742CC63 */
+ -3.46433388365604912451e+02, /* 0xC075A6EF, 0x28A38BD7 */
+};
+static const double pS5[5] = {
+ 6.07539382692300335975e+01, /* 0x404E6081, 0x0C98C5DE */
+ 1.05125230595704579173e+03, /* 0x40906D02, 0x5C7E2864 */
+ 5.97897094333855784498e+03, /* 0x40B75AF8, 0x8FBE1D60 */
+ 9.62544514357774460223e+03, /* 0x40C2CCB8, 0xFA76FA38 */
+ 2.40605815922939109441e+03, /* 0x40A2CC1D, 0xC70BE864 */
+};
+
+static const double pR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
+ -2.54704601771951915620e-09, /* 0xBE25E103, 0x6FE1AA86 */
+ -7.03119616381481654654e-02, /* 0xBFB1FFF6, 0xF7C0E24B */
+ -2.40903221549529611423e+00, /* 0xC00345B2, 0xAEA48074 */
+ -2.19659774734883086467e+01, /* 0xC035F74A, 0x4CB94E14 */
+ -5.80791704701737572236e+01, /* 0xC04D0A22, 0x420A1A45 */
+ -3.14479470594888503854e+01, /* 0xC03F72AC, 0xA892D80F */
+};
+static const double pS3[5] = {
+ 3.58560338055209726349e+01, /* 0x4041ED92, 0x84077DD3 */
+ 3.61513983050303863820e+02, /* 0x40769839, 0x464A7C0E */
+ 1.19360783792111533330e+03, /* 0x4092A66E, 0x6D1061D6 */
+ 1.12799679856907414432e+03, /* 0x40919FFC, 0xB8C39B7E */
+ 1.73580930813335754692e+02, /* 0x4065B296, 0xFC379081 */
+};
+
+static const double pR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ -8.87534333032526411254e-08, /* 0xBE77D316, 0xE927026D */
+ -7.03030995483624743247e-02, /* 0xBFB1FF62, 0x495E1E42 */
+ -1.45073846780952986357e+00, /* 0xBFF73639, 0x8A24A843 */
+ -7.63569613823527770791e+00, /* 0xC01E8AF3, 0xEDAFA7F3 */
+ -1.11931668860356747786e+01, /* 0xC02662E6, 0xC5246303 */
+ -3.23364579351335335033e+00, /* 0xC009DE81, 0xAF8FE70F */
+};
+static const double pS2[5] = {
+ 2.22202997532088808441e+01, /* 0x40363865, 0x908B5959 */
+ 1.36206794218215208048e+02, /* 0x4061069E, 0x0EE8878F */
+ 2.70470278658083486789e+02, /* 0x4070E786, 0x42EA079B */
+ 1.53875394208320329881e+02, /* 0x40633C03, 0x3AB6FAFF */
+ 1.46576176948256193810e+01, /* 0x402D50B3, 0x44391809 */
+};
+
+ static double pzero(double x)
+{
+ const double *p,*q;
+ double z,r,s;
+ int ix;
+ ix = 0x7fffffff&__HI(x);
+ if(ix>=0x40200000) {p = pR8; q= pS8;}
+ else if(ix>=0x40122E8B){p = pR5; q= pS5;}
+ else if(ix>=0x4006DB6D){p = pR3; q= pS3;}
+ else if(ix>=0x40000000){p = pR2; q= pS2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4]))));
+ return one+ r/s;
+}
+
+
+/* For x >= 8, the asymptotic expansions of qzero is
+ * -1/8 s + 75/1024 s^3 - ..., where s = 1/x.
+ * We approximate pzero by
+ * qzero(x) = s*(-1.25 + (R/S))
+ * where R = qR0 + qR1*s^2 + qR2*s^4 + ... + qR5*s^10
+ * S = 1 + qS0*s^2 + ... + qS5*s^12
+ * and
+ * | qzero(x)/s +1.25-R/S | <= 2 ** ( -61.22)
+ */
+static const double qR8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ 7.32421874999935051953e-02, /* 0x3FB2BFFF, 0xFFFFFE2C */
+ 1.17682064682252693899e+01, /* 0x40278952, 0x5BB334D6 */
+ 5.57673380256401856059e+02, /* 0x40816D63, 0x15301825 */
+ 8.85919720756468632317e+03, /* 0x40C14D99, 0x3E18F46D */
+ 3.70146267776887834771e+04, /* 0x40E212D4, 0x0E901566 */
+};
+static const double qS8[6] = {
+ 1.63776026895689824414e+02, /* 0x406478D5, 0x365B39BC */
+ 8.09834494656449805916e+03, /* 0x40BFA258, 0x4E6B0563 */
+ 1.42538291419120476348e+05, /* 0x41016652, 0x54D38C3F */
+ 8.03309257119514397345e+05, /* 0x412883DA, 0x83A52B43 */
+ 8.40501579819060512818e+05, /* 0x4129A66B, 0x28DE0B3D */
+ -3.43899293537866615225e+05, /* 0xC114FD6D, 0x2C9530C5 */
+};
+
+static const double qR5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ 1.84085963594515531381e-11, /* 0x3DB43D8F, 0x29CC8CD9 */
+ 7.32421766612684765896e-02, /* 0x3FB2BFFF, 0xD172B04C */
+ 5.83563508962056953777e+00, /* 0x401757B0, 0xB9953DD3 */
+ 1.35111577286449829671e+02, /* 0x4060E392, 0x0A8788E9 */
+ 1.02724376596164097464e+03, /* 0x40900CF9, 0x9DC8C481 */
+ 1.98997785864605384631e+03, /* 0x409F17E9, 0x53C6E3A6 */
+};
+static const double qS5[6] = {
+ 8.27766102236537761883e+01, /* 0x4054B1B3, 0xFB5E1543 */
+ 2.07781416421392987104e+03, /* 0x40A03BA0, 0xDA21C0CE */
+ 1.88472887785718085070e+04, /* 0x40D267D2, 0x7B591E6D */
+ 5.67511122894947329769e+04, /* 0x40EBB5E3, 0x97E02372 */
+ 3.59767538425114471465e+04, /* 0x40E19118, 0x1F7A54A0 */
+ -5.35434275601944773371e+03, /* 0xC0B4EA57, 0xBEDBC609 */
+};
+
+static const double qR3[6] = {/* for x in [4.547,2.8571]=1/[0.2199,0.35001] */
+ 4.37741014089738620906e-09, /* 0x3E32CD03, 0x6ADECB82 */
+ 7.32411180042911447163e-02, /* 0x3FB2BFEE, 0x0E8D0842 */
+ 3.34423137516170720929e+00, /* 0x400AC0FC, 0x61149CF5 */
+ 4.26218440745412650017e+01, /* 0x40454F98, 0x962DAEDD */
+ 1.70808091340565596283e+02, /* 0x406559DB, 0xE25EFD1F */
+ 1.66733948696651168575e+02, /* 0x4064D77C, 0x81FA21E0 */
+};
+static const double qS3[6] = {
+ 4.87588729724587182091e+01, /* 0x40486122, 0xBFE343A6 */
+ 7.09689221056606015736e+02, /* 0x40862D83, 0x86544EB3 */
+ 3.70414822620111362994e+03, /* 0x40ACF04B, 0xE44DFC63 */
+ 6.46042516752568917582e+03, /* 0x40B93C6C, 0xD7C76A28 */
+ 2.51633368920368957333e+03, /* 0x40A3A8AA, 0xD94FB1C0 */
+ -1.49247451836156386662e+02, /* 0xC062A7EB, 0x201CF40F */
+};
+
+static const double qR2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ 1.50444444886983272379e-07, /* 0x3E84313B, 0x54F76BDB */
+ 7.32234265963079278272e-02, /* 0x3FB2BEC5, 0x3E883E34 */
+ 1.99819174093815998816e+00, /* 0x3FFFF897, 0xE727779C */
+ 1.44956029347885735348e+01, /* 0x402CFDBF, 0xAAF96FE5 */
+ 3.16662317504781540833e+01, /* 0x403FAA8E, 0x29FBDC4A */
+ 1.62527075710929267416e+01, /* 0x403040B1, 0x71814BB4 */
+};
+static const double qS2[6] = {
+ 3.03655848355219184498e+01, /* 0x403E5D96, 0xF7C07AED */
+ 2.69348118608049844624e+02, /* 0x4070D591, 0xE4D14B40 */
+ 8.44783757595320139444e+02, /* 0x408A6645, 0x22B3BF22 */
+ 8.82935845112488550512e+02, /* 0x408B977C, 0x9C5CC214 */
+ 2.12666388511798828631e+02, /* 0x406A9553, 0x0E001365 */
+ -5.31095493882666946917e+00, /* 0xC0153E6A, 0xF8B32931 */
+};
+
+ static double qzero(double x)
+{
+ const double *p,*q;
+ double s,r,z;
+ int ix;
+ ix = 0x7fffffff&__HI(x);
+ if(ix>=0x40200000) {p = qR8; q= qS8;}
+ else if(ix>=0x40122E8B){p = qR5; q= qS5;}
+ else if(ix>=0x4006DB6D){p = qR3; q= qS3;}
+ else if(ix>=0x40000000){p = qR2; q= qS2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5])))));
+ return (-.125 + r/s)/x;
+}
diff --git a/libmath/fdlibm/e_j1.c b/libmath/fdlibm/e_j1.c
new file mode 100644
index 00000000..2b19acf2
--- /dev/null
+++ b/libmath/fdlibm/e_j1.c
@@ -0,0 +1,370 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_j1.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_j1(x), __ieee754_y1(x)
+ * Bessel function of the first and second kinds of order zero.
+ * Method -- j1(x):
+ * 1. For tiny x, we use j1(x) = x/2 - x^3/16 + x^5/384 - ...
+ * 2. Reduce x to |x| since j1(x)=-j1(-x), and
+ * for x in (0,2)
+ * j1(x) = x/2 + x*z*R0/S0, where z = x*x;
+ * (precision: |j1/x - 1/2 - R0/S0 |<2**-61.51 )
+ * for x in (2,inf)
+ * j1(x) = sqrt(2/(pi*x))*(p1(x)*cos(x1)-q1(x)*sin(x1))
+ * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1))
+ * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1)
+ * as follow:
+ * cos(x1) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * sin(x1) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = -1/sqrt(2) * (sin(x) + cos(x))
+ * (To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.)
+ *
+ * 3 Special cases
+ * j1(nan)= nan
+ * j1(0) = 0
+ * j1(inf) = 0
+ *
+ * Method -- y1(x):
+ * 1. screen out x<=0 cases: y1(0)=-inf, y1(x<0)=NaN
+ * 2. For x<2.
+ * Since
+ * y1(x) = 2/pi*(j1(x)*(ln(x/2)+Euler)-1/x-x/2+5/64*x^3-...)
+ * therefore y1(x)-2/pi*j1(x)*ln(x)-1/x is an odd function.
+ * We use the following function to approximate y1,
+ * y1(x) = x*U(z)/V(z) + (2/pi)*(j1(x)*ln(x)-1/x), z= x^2
+ * where for x in [0,2] (abs err less than 2**-65.89)
+ * U(z) = U0[0] + U0[1]*z + ... + U0[4]*z^4
+ * V(z) = 1 + v0[0]*z + ... + v0[4]*z^5
+ * Note: For tiny x, 1/x dominate y1 and hence
+ * y1(tiny) = -2/pi/tiny, (choose tiny<2**-54)
+ * 3. For x>=2.
+ * y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x1)+q1(x)*cos(x1))
+ * where x1 = x-3*pi/4. It is better to compute sin(x1),cos(x1)
+ * by method mentioned above.
+ */
+
+#include "fdlibm.h"
+
+static double pone(double), qone(double);
+
+static const double
+Huge = 1e300,
+one = 1.0,
+invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
+tpi = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+ /* R0/S0 on [0,2] */
+r00 = -6.25000000000000000000e-02, /* 0xBFB00000, 0x00000000 */
+r01 = 1.40705666955189706048e-03, /* 0x3F570D9F, 0x98472C61 */
+r02 = -1.59955631084035597520e-05, /* 0xBEF0C5C6, 0xBA169668 */
+r03 = 4.96727999609584448412e-08, /* 0x3E6AAAFA, 0x46CA0BD9 */
+s01 = 1.91537599538363460805e-02, /* 0x3F939D0B, 0x12637E53 */
+s02 = 1.85946785588630915560e-04, /* 0x3F285F56, 0xB9CDF664 */
+s03 = 1.17718464042623683263e-06, /* 0x3EB3BFF8, 0x333F8498 */
+s04 = 5.04636257076217042715e-09, /* 0x3E35AC88, 0xC97DFF2C */
+s05 = 1.23542274426137913908e-11; /* 0x3DAB2ACF, 0xCFB97ED8 */
+
+static double zero = 0.0;
+
+ double __ieee754_j1(double x)
+{
+ double z, s,c,ss,cc,r,u,v,y;
+ int hx,ix;
+
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x7ff00000) return one/x;
+ y = fabs(x);
+ if(ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sin(y);
+ c = cos(y);
+ ss = -s-c;
+ cc = s-c;
+ if(ix<0x7fe00000) { /* make sure y+y not overflow */
+ z = cos(y+y);
+ if ((s*c)>zero) cc = z/ss;
+ else ss = z/cc;
+ }
+ /*
+ * j1(x) = 1/sqrt(pi) * (P(1,x)*cc - Q(1,x)*ss) / sqrt(x)
+ * y1(x) = 1/sqrt(pi) * (P(1,x)*ss + Q(1,x)*cc) / sqrt(x)
+ */
+ if(ix>0x48000000) z = (invsqrtpi*cc)/sqrt(y);
+ else {
+ u = pone(y); v = qone(y);
+ z = invsqrtpi*(u*cc-v*ss)/sqrt(y);
+ }
+ if(hx<0) return -z;
+ else return z;
+ }
+ if(ix<0x3e400000) { /* |x|<2**-27 */
+ if(Huge+x>one) return 0.5*x;/* inexact if x!=0 necessary */
+ }
+ z = x*x;
+ r = z*(r00+z*(r01+z*(r02+z*r03)));
+ s = one+z*(s01+z*(s02+z*(s03+z*(s04+z*s05))));
+ r *= x;
+ return(x*0.5+r/s);
+}
+
+static const double U0[5] = {
+ -1.96057090646238940668e-01, /* 0xBFC91866, 0x143CBC8A */
+ 5.04438716639811282616e-02, /* 0x3FA9D3C7, 0x76292CD1 */
+ -1.91256895875763547298e-03, /* 0xBF5F55E5, 0x4844F50F */
+ 2.35252600561610495928e-05, /* 0x3EF8AB03, 0x8FA6B88E */
+ -9.19099158039878874504e-08, /* 0xBE78AC00, 0x569105B8 */
+};
+static const double V0[5] = {
+ 1.99167318236649903973e-02, /* 0x3F94650D, 0x3F4DA9F0 */
+ 2.02552581025135171496e-04, /* 0x3F2A8C89, 0x6C257764 */
+ 1.35608801097516229404e-06, /* 0x3EB6C05A, 0x894E8CA6 */
+ 6.22741452364621501295e-09, /* 0x3E3ABF1D, 0x5BA69A86 */
+ 1.66559246207992079114e-11, /* 0x3DB25039, 0xDACA772A */
+};
+
+ double __ieee754_y1(double x)
+{
+ double z, s,c,ss,cc,u,v;
+ int hx,ix,lx;
+
+ hx = __HI(x);
+ ix = 0x7fffffff&hx;
+ lx = __LO(x);
+ /* if Y1(NaN) is NaN, Y1(-inf) is NaN, Y1(inf) is 0 */
+ if(ix>=0x7ff00000) return one/(x+x*x);
+ if((ix|lx)==0) return -one/zero;
+ if(hx<0) return zero/zero;
+ if(ix >= 0x40000000) { /* |x| >= 2.0 */
+ s = sin(x);
+ c = cos(x);
+ ss = -s-c;
+ cc = s-c;
+ if(ix<0x7fe00000) { /* make sure x+x not overflow */
+ z = cos(x+x);
+ if ((s*c)>zero) cc = z/ss;
+ else ss = z/cc;
+ }
+ /* y1(x) = sqrt(2/(pi*x))*(p1(x)*sin(x0)+q1(x)*cos(x0))
+ * where x0 = x-3pi/4
+ * Better formula:
+ * cos(x0) = cos(x)cos(3pi/4)+sin(x)sin(3pi/4)
+ * = 1/sqrt(2) * (sin(x) - cos(x))
+ * sin(x0) = sin(x)cos(3pi/4)-cos(x)sin(3pi/4)
+ * = -1/sqrt(2) * (cos(x) + sin(x))
+ * To avoid cancellation, use
+ * sin(x) +- cos(x) = -cos(2x)/(sin(x) -+ cos(x))
+ * to compute the worse one.
+ */
+ if(ix>0x48000000) z = (invsqrtpi*ss)/sqrt(x);
+ else {
+ u = pone(x); v = qone(x);
+ z = invsqrtpi*(u*ss+v*cc)/sqrt(x);
+ }
+ return z;
+ }
+ if(ix<=0x3c900000) { /* x < 2**-54 */
+ return(-tpi/x);
+ }
+ z = x*x;
+ u = U0[0]+z*(U0[1]+z*(U0[2]+z*(U0[3]+z*U0[4])));
+ v = one+z*(V0[0]+z*(V0[1]+z*(V0[2]+z*(V0[3]+z*V0[4]))));
+ return(x*(u/v) + tpi*(__ieee754_j1(x)*__ieee754_log(x)-one/x));
+}
+
+/* For x >= 8, the asymptotic expansions of pone is
+ * 1 + 15/128 s^2 - 4725/2^15 s^4 - ..., where s = 1/x.
+ * We approximate pone by
+ * pone(x) = 1 + (R/S)
+ * where R = pr0 + pr1*s^2 + pr2*s^4 + ... + pr5*s^10
+ * S = 1 + ps0*s^2 + ... + ps4*s^10
+ * and
+ * | pone(x)-1-R/S | <= 2 ** ( -60.06)
+ */
+
+static const double pr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ 1.17187499999988647970e-01, /* 0x3FBDFFFF, 0xFFFFFCCE */
+ 1.32394806593073575129e+01, /* 0x402A7A9D, 0x357F7FCE */
+ 4.12051854307378562225e+02, /* 0x4079C0D4, 0x652EA590 */
+ 3.87474538913960532227e+03, /* 0x40AE457D, 0xA3A532CC */
+ 7.91447954031891731574e+03, /* 0x40BEEA7A, 0xC32782DD */
+};
+static const double ps8[5] = {
+ 1.14207370375678408436e+02, /* 0x405C8D45, 0x8E656CAC */
+ 3.65093083420853463394e+03, /* 0x40AC85DC, 0x964D274F */
+ 3.69562060269033463555e+04, /* 0x40E20B86, 0x97C5BB7F */
+ 9.76027935934950801311e+04, /* 0x40F7D42C, 0xB28F17BB */
+ 3.08042720627888811578e+04, /* 0x40DE1511, 0x697A0B2D */
+};
+
+static const double pr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ 1.31990519556243522749e-11, /* 0x3DAD0667, 0xDAE1CA7D */
+ 1.17187493190614097638e-01, /* 0x3FBDFFFF, 0xE2C10043 */
+ 6.80275127868432871736e+00, /* 0x401B3604, 0x6E6315E3 */
+ 1.08308182990189109773e+02, /* 0x405B13B9, 0x452602ED */
+ 5.17636139533199752805e+02, /* 0x40802D16, 0xD052D649 */
+ 5.28715201363337541807e+02, /* 0x408085B8, 0xBB7E0CB7 */
+};
+static const double ps5[5] = {
+ 5.92805987221131331921e+01, /* 0x404DA3EA, 0xA8AF633D */
+ 9.91401418733614377743e+02, /* 0x408EFB36, 0x1B066701 */
+ 5.35326695291487976647e+03, /* 0x40B4E944, 0x5706B6FB */
+ 7.84469031749551231769e+03, /* 0x40BEA4B0, 0xB8A5BB15 */
+ 1.50404688810361062679e+03, /* 0x40978030, 0x036F5E51 */
+};
+
+static const double pr3[6] = {
+ 3.02503916137373618024e-09, /* 0x3E29FC21, 0xA7AD9EDD */
+ 1.17186865567253592491e-01, /* 0x3FBDFFF5, 0x5B21D17B */
+ 3.93297750033315640650e+00, /* 0x400F76BC, 0xE85EAD8A */
+ 3.51194035591636932736e+01, /* 0x40418F48, 0x9DA6D129 */
+ 9.10550110750781271918e+01, /* 0x4056C385, 0x4D2C1837 */
+ 4.85590685197364919645e+01, /* 0x4048478F, 0x8EA83EE5 */
+};
+static const double ps3[5] = {
+ 3.47913095001251519989e+01, /* 0x40416549, 0xA134069C */
+ 3.36762458747825746741e+02, /* 0x40750C33, 0x07F1A75F */
+ 1.04687139975775130551e+03, /* 0x40905B7C, 0x5037D523 */
+ 8.90811346398256432622e+02, /* 0x408BD67D, 0xA32E31E9 */
+ 1.03787932439639277504e+02, /* 0x4059F26D, 0x7C2EED53 */
+};
+
+static const double pr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ 1.07710830106873743082e-07, /* 0x3E7CE9D4, 0xF65544F4 */
+ 1.17176219462683348094e-01, /* 0x3FBDFF42, 0xBE760D83 */
+ 2.36851496667608785174e+00, /* 0x4002F2B7, 0xF98FAEC0 */
+ 1.22426109148261232917e+01, /* 0x40287C37, 0x7F71A964 */
+ 1.76939711271687727390e+01, /* 0x4031B1A8, 0x177F8EE2 */
+ 5.07352312588818499250e+00, /* 0x40144B49, 0xA574C1FE */
+};
+static const double ps2[5] = {
+ 2.14364859363821409488e+01, /* 0x40356FBD, 0x8AD5ECDC */
+ 1.25290227168402751090e+02, /* 0x405F5293, 0x14F92CD5 */
+ 2.32276469057162813669e+02, /* 0x406D08D8, 0xD5A2DBD9 */
+ 1.17679373287147100768e+02, /* 0x405D6B7A, 0xDA1884A9 */
+ 8.36463893371618283368e+00, /* 0x4020BAB1, 0xF44E5192 */
+};
+
+ static double pone(double x)
+{
+ const double *p,*q;
+ double z,r,s;
+ int ix;
+ ix = 0x7fffffff&__HI(x);
+ if(ix>=0x40200000) {p = pr8; q= ps8;}
+ else if(ix>=0x40122E8B){p = pr5; q= ps5;}
+ else if(ix>=0x4006DB6D){p = pr3; q= ps3;}
+ else if(ix>=0x40000000){p = pr2; q= ps2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*q[4]))));
+ return one+ r/s;
+}
+
+
+/* For x >= 8, the asymptotic expansions of qone is
+ * 3/8 s - 105/1024 s^3 - ..., where s = 1/x.
+ * We approximate pone by
+ * qone(x) = s*(0.375 + (R/S))
+ * where R = qr1*s^2 + qr2*s^4 + ... + qr5*s^10
+ * S = 1 + qs1*s^2 + ... + qs6*s^12
+ * and
+ * | qone(x)/s -0.375-R/S | <= 2 ** ( -61.13)
+ */
+
+static const double qr8[6] = { /* for x in [inf, 8]=1/[0,0.125] */
+ 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+ -1.02539062499992714161e-01, /* 0xBFBA3FFF, 0xFFFFFDF3 */
+ -1.62717534544589987888e+01, /* 0xC0304591, 0xA26779F7 */
+ -7.59601722513950107896e+02, /* 0xC087BCD0, 0x53E4B576 */
+ -1.18498066702429587167e+04, /* 0xC0C724E7, 0x40F87415 */
+ -4.84385124285750353010e+04, /* 0xC0E7A6D0, 0x65D09C6A */
+};
+static const double qs8[6] = {
+ 1.61395369700722909556e+02, /* 0x40642CA6, 0xDE5BCDE5 */
+ 7.82538599923348465381e+03, /* 0x40BE9162, 0xD0D88419 */
+ 1.33875336287249578163e+05, /* 0x4100579A, 0xB0B75E98 */
+ 7.19657723683240939863e+05, /* 0x4125F653, 0x72869C19 */
+ 6.66601232617776375264e+05, /* 0x412457D2, 0x7719AD5C */
+ -2.94490264303834643215e+05, /* 0xC111F969, 0x0EA5AA18 */
+};
+
+static const double qr5[6] = { /* for x in [8,4.5454]=1/[0.125,0.22001] */
+ -2.08979931141764104297e-11, /* 0xBDB6FA43, 0x1AA1A098 */
+ -1.02539050241375426231e-01, /* 0xBFBA3FFF, 0xCB597FEF */
+ -8.05644828123936029840e+00, /* 0xC0201CE6, 0xCA03AD4B */
+ -1.83669607474888380239e+02, /* 0xC066F56D, 0x6CA7B9B0 */
+ -1.37319376065508163265e+03, /* 0xC09574C6, 0x6931734F */
+ -2.61244440453215656817e+03, /* 0xC0A468E3, 0x88FDA79D */
+};
+static const double qs5[6] = {
+ 8.12765501384335777857e+01, /* 0x405451B2, 0xFF5A11B2 */
+ 1.99179873460485964642e+03, /* 0x409F1F31, 0xE77BF839 */
+ 1.74684851924908907677e+04, /* 0x40D10F1F, 0x0D64CE29 */
+ 4.98514270910352279316e+04, /* 0x40E8576D, 0xAABAD197 */
+ 2.79480751638918118260e+04, /* 0x40DB4B04, 0xCF7C364B */
+ -4.71918354795128470869e+03, /* 0xC0B26F2E, 0xFCFFA004 */
+};
+
+static const double qr3[6] = {
+ -5.07831226461766561369e-09, /* 0xBE35CFA9, 0xD38FC84F */
+ -1.02537829820837089745e-01, /* 0xBFBA3FEB, 0x51AEED54 */
+ -4.61011581139473403113e+00, /* 0xC01270C2, 0x3302D9FF */
+ -5.78472216562783643212e+01, /* 0xC04CEC71, 0xC25D16DA */
+ -2.28244540737631695038e+02, /* 0xC06C87D3, 0x4718D55F */
+ -2.19210128478909325622e+02, /* 0xC06B66B9, 0x5F5C1BF6 */
+};
+static const double qs3[6] = {
+ 4.76651550323729509273e+01, /* 0x4047D523, 0xCCD367E4 */
+ 6.73865112676699709482e+02, /* 0x40850EEB, 0xC031EE3E */
+ 3.38015286679526343505e+03, /* 0x40AA684E, 0x448E7C9A */
+ 5.54772909720722782367e+03, /* 0x40B5ABBA, 0xA61D54A6 */
+ 1.90311919338810798763e+03, /* 0x409DBC7A, 0x0DD4DF4B */
+ -1.35201191444307340817e+02, /* 0xC060E670, 0x290A311F */
+};
+
+static const double qr2[6] = {/* for x in [2.8570,2]=1/[0.3499,0.5] */
+ -1.78381727510958865572e-07, /* 0xBE87F126, 0x44C626D2 */
+ -1.02517042607985553460e-01, /* 0xBFBA3E8E, 0x9148B010 */
+ -2.75220568278187460720e+00, /* 0xC0060484, 0x69BB4EDA */
+ -1.96636162643703720221e+01, /* 0xC033A9E2, 0xC168907F */
+ -4.23253133372830490089e+01, /* 0xC04529A3, 0xDE104AAA */
+ -2.13719211703704061733e+01, /* 0xC0355F36, 0x39CF6E52 */
+};
+static const double qs2[6] = {
+ 2.95333629060523854548e+01, /* 0x403D888A, 0x78AE64FF */
+ 2.52981549982190529136e+02, /* 0x406F9F68, 0xDB821CBA */
+ 7.57502834868645436472e+02, /* 0x4087AC05, 0xCE49A0F7 */
+ 7.39393205320467245656e+02, /* 0x40871B25, 0x48D4C029 */
+ 1.55949003336666123687e+02, /* 0x40637E5E, 0x3C3ED8D4 */
+ -4.95949898822628210127e+00, /* 0xC013D686, 0xE71BE86B */
+};
+
+ static double qone(double x)
+{
+ const double *p,*q;
+ double s,r,z;
+ int ix;
+ ix = 0x7fffffff&__HI(x);
+ if(ix>=0x40200000) {p = qr8; q= qs8;}
+ else if(ix>=0x40122E8B){p = qr5; q= qs5;}
+ else if(ix>=0x4006DB6D){p = qr3; q= qs3;}
+ else if(ix>=0x40000000){p = qr2; q= qs2;}
+ z = one/(x*x);
+ r = p[0]+z*(p[1]+z*(p[2]+z*(p[3]+z*(p[4]+z*p[5]))));
+ s = one+z*(q[0]+z*(q[1]+z*(q[2]+z*(q[3]+z*(q[4]+z*q[5])))));
+ return (.375 + r/s)/x;
+}
diff --git a/libmath/fdlibm/e_jn.c b/libmath/fdlibm/e_jn.c
new file mode 100644
index 00000000..fb17240f
--- /dev/null
+++ b/libmath/fdlibm/e_jn.c
@@ -0,0 +1,259 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_jn.c 1.4 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * __ieee754_jn(n, x), __ieee754_yn(n, x)
+ * floating point Bessel's function of the 1st and 2nd kind
+ * of order n
+ *
+ * Special cases:
+ * y0(0)=y1(0)=yn(n,0) = -inf with division by zero signal;
+ * y0(-ve)=y1(-ve)=yn(n,-ve) are NaN with invalid signal.
+ * Note 2. About jn(n,x), yn(n,x)
+ * For n=0, j0(x) is called,
+ * for n=1, j1(x) is called,
+ * for n<x, forward recursion us used starting
+ * from values of j0(x) and j1(x).
+ * for n>x, a continued fraction approximation to
+ * j(n,x)/j(n-1,x) is evaluated and then backward
+ * recursion is used starting from a supposed value
+ * for j(n,x). The resulting value of j(0,x) is
+ * compared with the actual value to correct the
+ * supposed value of j(n,x).
+ *
+ * yn(n,x) is similar in all respects, except
+ * that forward recursion is used for all
+ * values of n>1.
+ *
+ */
+
+#include "fdlibm.h"
+
+static const double
+invsqrtpi= 5.64189583547756279280e-01, /* 0x3FE20DD7, 0x50429B6D */
+two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
+one = 1.00000000000000000000e+00; /* 0x3FF00000, 0x00000000 */
+
+static double zero = 0.00000000000000000000e+00;
+
+ double __ieee754_jn(int n, double x)
+{
+ int i,hx,ix,lx, sgn;
+ double a, b, temp, di;
+ double z, w;
+
+ /* J(-n,x) = (-1)^n * J(n, x), J(n, -x) = (-1)^n * J(n, x)
+ * Thus, J(-n,x) = J(n,-x)
+ */
+ hx = __HI(x);
+ ix = 0x7fffffff&hx;
+ lx = __LO(x);
+ /* if J(n,NaN) is NaN */
+ if((ix|((unsigned)(lx|-lx))>>31)>0x7ff00000) return x+x;
+ if(n<0){
+ n = -n;
+ x = -x;
+ hx ^= 0x80000000;
+ }
+ if(n==0) return(__ieee754_j0(x));
+ if(n==1) return(__ieee754_j1(x));
+ sgn = (n&1)&(hx>>31); /* even n -- 0, odd n -- sign(x) */
+ x = fabs(x);
+ if((ix|lx)==0||ix>=0x7ff00000) /* if x is 0 or inf */
+ b = zero;
+ else if((double)n<=x) {
+ /* Safe to use J(n+1,x)=2n/x *J(n,x)-J(n-1,x) */
+ if(ix>=0x52D00000) { /* x > 2**302 */
+ /* (x >> n**2)
+ * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Let s=sin(x), c=cos(x),
+ * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then
+ *
+ * n sin(xn)*sqt2 cos(xn)*sqt2
+ * ----------------------------------
+ * 0 s-c c+s
+ * 1 -s-c -c+s
+ * 2 -s+c -c-s
+ * 3 s+c c-s
+ */
+ switch(n&3) {
+ case 0: temp = cos(x)+sin(x); break;
+ case 1: temp = -cos(x)+sin(x); break;
+ case 2: temp = -cos(x)-sin(x); break;
+ case 3: temp = cos(x)-sin(x); break;
+ }
+ b = invsqrtpi*temp/sqrt(x);
+ } else {
+ a = __ieee754_j0(x);
+ b = __ieee754_j1(x);
+ for(i=1;i<n;i++){
+ temp = b;
+ b = b*((double)(i+i)/x) - a; /* avoid underflow */
+ a = temp;
+ }
+ }
+ } else {
+ if(ix<0x3e100000) { /* x < 2**-29 */
+ /* x is tiny, return the first Taylor expansion of J(n,x)
+ * J(n,x) = 1/n!*(x/2)^n - ...
+ */
+ if(n>33) /* underflow */
+ b = zero;
+ else {
+ temp = x*0.5; b = temp;
+ for (a=one,i=2;i<=n;i++) {
+ a *= (double)i; /* a = n! */
+ b *= temp; /* b = (x/2)^n */
+ }
+ b = b/a;
+ }
+ } else {
+ /* use backward recurrence */
+ /* x x^2 x^2
+ * J(n,x)/J(n-1,x) = ---- ------ ------ .....
+ * 2n - 2(n+1) - 2(n+2)
+ *
+ * 1 1 1
+ * (for large x) = ---- ------ ------ .....
+ * 2n 2(n+1) 2(n+2)
+ * -- - ------ - ------ -
+ * x x x
+ *
+ * Let w = 2n/x and h=2/x, then the above quotient
+ * is equal to the continued fraction:
+ * 1
+ * = -----------------------
+ * 1
+ * w - -----------------
+ * 1
+ * w+h - ---------
+ * w+2h - ...
+ *
+ * To determine how many terms needed, let
+ * Q(0) = w, Q(1) = w(w+h) - 1,
+ * Q(k) = (w+k*h)*Q(k-1) - Q(k-2),
+ * When Q(k) > 1e4 good for single
+ * When Q(k) > 1e9 good for double
+ * When Q(k) > 1e17 good for quadruple
+ */
+ /* determine k */
+ double t,v;
+ double q0,q1,h,tmp; int k,m;
+ w = (n+n)/(double)x; h = 2.0/(double)x;
+ q0 = w; z = w+h; q1 = w*z - 1.0; k=1;
+ while(q1<1.0e9) {
+ k += 1; z += h;
+ tmp = z*q1 - q0;
+ q0 = q1;
+ q1 = tmp;
+ }
+ m = n+n;
+ for(t=zero, i = 2*(n+k); i>=m; i -= 2) t = one/(i/x-t);
+ a = t;
+ b = one;
+ /* estimate log((2/x)^n*n!) = n*log(2/x)+n*ln(n)
+ * Hence, if n*(log(2n/x)) > ...
+ * single 8.8722839355e+01
+ * double 7.09782712893383973096e+02
+ * long double 1.1356523406294143949491931077970765006170e+04
+ * then recurrent value may overflow and the result is
+ * likely underflow to zero
+ */
+ tmp = n;
+ v = two/x;
+ tmp = tmp*__ieee754_log(fabs(v*tmp));
+ if(tmp<7.09782712893383973096e+02) {
+ for(i=n-1,di=(double)(i+i);i>0;i--){
+ temp = b;
+ b *= di;
+ b = b/x - a;
+ a = temp;
+ di -= two;
+ }
+ } else {
+ for(i=n-1,di=(double)(i+i);i>0;i--){
+ temp = b;
+ b *= di;
+ b = b/x - a;
+ a = temp;
+ di -= two;
+ /* scale b to avoid spurious overflow */
+ if(b>1e100) {
+ a /= b;
+ t /= b;
+ b = one;
+ }
+ }
+ }
+ b = (t*__ieee754_j0(x)/b);
+ }
+ }
+ if(sgn==1) return -b; else return b;
+}
+
+ double __ieee754_yn(int n, double x)
+{
+ int i,hx,ix,lx;
+ int sign;
+ double a, b, temp;
+
+ hx = __HI(x);
+ ix = 0x7fffffff&hx;
+ lx = __LO(x);
+ /* if Y(n,NaN) is NaN */
+ if((ix|((unsigned)(lx|-lx))>>31)>0x7ff00000) return x+x;
+ if((ix|lx)==0) return -one/zero;
+ if(hx<0) return zero/zero;
+ sign = 1;
+ if(n<0){
+ n = -n;
+ sign = 1 - ((n&1)<<1);
+ }
+ if(n==0) return(__ieee754_y0(x));
+ if(n==1) return(sign*__ieee754_y1(x));
+ if(ix==0x7ff00000) return zero;
+ if(ix>=0x52D00000) { /* x > 2**302 */
+ /* (x >> n**2)
+ * Jn(x) = cos(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Yn(x) = sin(x-(2n+1)*pi/4)*sqrt(2/x*pi)
+ * Let s=sin(x), c=cos(x),
+ * xn=x-(2n+1)*pi/4, sqt2 = sqrt(2),then
+ *
+ * n sin(xn)*sqt2 cos(xn)*sqt2
+ * ----------------------------------
+ * 0 s-c c+s
+ * 1 -s-c -c+s
+ * 2 -s+c -c-s
+ * 3 s+c c-s
+ */
+ switch(n&3) {
+ case 0: temp = sin(x)-cos(x); break;
+ case 1: temp = -sin(x)-cos(x); break;
+ case 2: temp = -sin(x)+cos(x); break;
+ case 3: temp = sin(x)+cos(x); break;
+ }
+ b = invsqrtpi*temp/sqrt(x);
+ } else {
+ a = __ieee754_y0(x);
+ b = __ieee754_y1(x);
+ /* quit if b is -inf */
+ for(i=1;i<n&&(__HI(b) != 0xfff00000);i++){
+ temp = b;
+ b = ((double)(i+i)/x)*b - a;
+ a = temp;
+ }
+ }
+ if(sign>0) return b; else return -b;
+}
diff --git a/libmath/fdlibm/e_lgamma_r.c b/libmath/fdlibm/e_lgamma_r.c
new file mode 100644
index 00000000..2ed6b038
--- /dev/null
+++ b/libmath/fdlibm/e_lgamma_r.c
@@ -0,0 +1,291 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_lgamma_r.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+/* __ieee754_lgamma_r(x, signgamp)
+ * Reentrant version of the logarithm of the Gamma function
+ * with user provide pointer for the sign of Gamma(x).
+ *
+ * Method:
+ * 1. Argument Reduction for 0 < x <= 8
+ * Since gamma(1+s)=s*gamma(s), for x in [0,8], we may
+ * reduce x to a number in [1.5,2.5] by
+ * lgamma(1+s) = log(s) + lgamma(s)
+ * for example,
+ * lgamma(7.3) = log(6.3) + lgamma(6.3)
+ * = log(6.3*5.3) + lgamma(5.3)
+ * = log(6.3*5.3*4.3*3.3*2.3) + lgamma(2.3)
+ * 2. Polynomial approximation of lgamma around its
+ * minimun ymin=1.461632144968362245 to maintain monotonicity.
+ * On [ymin-0.23, ymin+0.27] (i.e., [1.23164,1.73163]), use
+ * Let z = x-ymin;
+ * lgamma(x) = -1.214862905358496078218 + z^2*poly(z)
+ * where
+ * poly(z) is a 14 degree polynomial.
+ * 2. Rational approximation in the primary interval [2,3]
+ * We use the following approximation:
+ * s = x-2.0;
+ * lgamma(x) = 0.5*s + s*P(s)/Q(s)
+ * with accuracy
+ * |P/Q - (lgamma(x)-0.5s)| < 2**-61.71
+ * Our algorithms are based on the following observation
+ *
+ * zeta(2)-1 2 zeta(3)-1 3
+ * lgamma(2+s) = s*(1-Euler) + --------- * s - --------- * s + ...
+ * 2 3
+ *
+ * where Euler = 0.5771... is the Euler constant, which is very
+ * close to 0.5.
+ *
+ * 3. For x>=8, we have
+ * lgamma(x)~(x-0.5)log(x)-x+0.5*log(2pi)+1/(12x)-1/(360x**3)+....
+ * (better formula:
+ * lgamma(x)~(x-0.5)*(log(x)-1)-.5*(log(2pi)-1) + ...)
+ * Let z = 1/x, then we approximation
+ * f(z) = lgamma(x) - (x-0.5)(log(x)-1)
+ * by
+ * 3 5 11
+ * w = w0 + w1*z + w2*z + w3*z + ... + w6*z
+ * where
+ * |w - f(z)| < 2**-58.74
+ *
+ * 4. For negative x, since (G is gamma function)
+ * -x*G(-x)*G(x) = pi/sin(pi*x),
+ * we have
+ * G(x) = pi/(sin(pi*x)*(-x)*G(-x))
+ * since G(-x) is positive, sign(G(x)) = sign(sin(pi*x)) for x<0
+ * Hence, for x<0, signgam = sign(sin(pi*x)) and
+ * lgamma(x) = log(|Gamma(x)|)
+ * = log(pi/(|x*sin(pi*x)|)) - lgamma(-x);
+ * Note: one should avoid compute pi*(-x) directly in the
+ * computation of sin(pi*(-x)).
+ *
+ * 5. Special Cases
+ * lgamma(2+s) ~ s*(1-Euler) for tiny s
+ * lgamma(1)=lgamma(2)=0
+ * lgamma(x) ~ -log(x) for tiny x
+ * lgamma(0) = lgamma(inf) = inf
+ * lgamma(-integer) = +-inf
+ *
+ */
+
+#include "fdlibm.h"
+
+static const double
+two52= 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
+half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+pi = 3.14159265358979311600e+00, /* 0x400921FB, 0x54442D18 */
+a0 = 7.72156649015328655494e-02, /* 0x3FB3C467, 0xE37DB0C8 */
+a1 = 3.22467033424113591611e-01, /* 0x3FD4A34C, 0xC4A60FAD */
+a2 = 6.73523010531292681824e-02, /* 0x3FB13E00, 0x1A5562A7 */
+a3 = 2.05808084325167332806e-02, /* 0x3F951322, 0xAC92547B */
+a4 = 7.38555086081402883957e-03, /* 0x3F7E404F, 0xB68FEFE8 */
+a5 = 2.89051383673415629091e-03, /* 0x3F67ADD8, 0xCCB7926B */
+a6 = 1.19270763183362067845e-03, /* 0x3F538A94, 0x116F3F5D */
+a7 = 5.10069792153511336608e-04, /* 0x3F40B6C6, 0x89B99C00 */
+a8 = 2.20862790713908385557e-04, /* 0x3F2CF2EC, 0xED10E54D */
+a9 = 1.08011567247583939954e-04, /* 0x3F1C5088, 0x987DFB07 */
+a10 = 2.52144565451257326939e-05, /* 0x3EFA7074, 0x428CFA52 */
+a11 = 4.48640949618915160150e-05, /* 0x3F07858E, 0x90A45837 */
+tc = 1.46163214496836224576e+00, /* 0x3FF762D8, 0x6356BE3F */
+tf = -1.21486290535849611461e-01, /* 0xBFBF19B9, 0xBCC38A42 */
+/* tt = -(tail of tf) */
+tt = -3.63867699703950536541e-18, /* 0xBC50C7CA, 0xA48A971F */
+t0 = 4.83836122723810047042e-01, /* 0x3FDEF72B, 0xC8EE38A2 */
+t1 = -1.47587722994593911752e-01, /* 0xBFC2E427, 0x8DC6C509 */
+t2 = 6.46249402391333854778e-02, /* 0x3FB08B42, 0x94D5419B */
+t3 = -3.27885410759859649565e-02, /* 0xBFA0C9A8, 0xDF35B713 */
+t4 = 1.79706750811820387126e-02, /* 0x3F9266E7, 0x970AF9EC */
+t5 = -1.03142241298341437450e-02, /* 0xBF851F9F, 0xBA91EC6A */
+t6 = 6.10053870246291332635e-03, /* 0x3F78FCE0, 0xE370E344 */
+t7 = -3.68452016781138256760e-03, /* 0xBF6E2EFF, 0xB3E914D7 */
+t8 = 2.25964780900612472250e-03, /* 0x3F6282D3, 0x2E15C915 */
+t9 = -1.40346469989232843813e-03, /* 0xBF56FE8E, 0xBF2D1AF1 */
+t10 = 8.81081882437654011382e-04, /* 0x3F4CDF0C, 0xEF61A8E9 */
+t11 = -5.38595305356740546715e-04, /* 0xBF41A610, 0x9C73E0EC */
+t12 = 3.15632070903625950361e-04, /* 0x3F34AF6D, 0x6C0EBBF7 */
+t13 = -3.12754168375120860518e-04, /* 0xBF347F24, 0xECC38C38 */
+t14 = 3.35529192635519073543e-04, /* 0x3F35FD3E, 0xE8C2D3F4 */
+u0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */
+u1 = 6.32827064025093366517e-01, /* 0x3FE4401E, 0x8B005DFF */
+u2 = 1.45492250137234768737e+00, /* 0x3FF7475C, 0xD119BD6F */
+u3 = 9.77717527963372745603e-01, /* 0x3FEF4976, 0x44EA8450 */
+u4 = 2.28963728064692451092e-01, /* 0x3FCD4EAE, 0xF6010924 */
+u5 = 1.33810918536787660377e-02, /* 0x3F8B678B, 0xBF2BAB09 */
+v1 = 2.45597793713041134822e+00, /* 0x4003A5D7, 0xC2BD619C */
+v2 = 2.12848976379893395361e+00, /* 0x40010725, 0xA42B18F5 */
+v3 = 7.69285150456672783825e-01, /* 0x3FE89DFB, 0xE45050AF */
+v4 = 1.04222645593369134254e-01, /* 0x3FBAAE55, 0xD6537C88 */
+v5 = 3.21709242282423911810e-03, /* 0x3F6A5ABB, 0x57D0CF61 */
+s0 = -7.72156649015328655494e-02, /* 0xBFB3C467, 0xE37DB0C8 */
+s1 = 2.14982415960608852501e-01, /* 0x3FCB848B, 0x36E20878 */
+s2 = 3.25778796408930981787e-01, /* 0x3FD4D98F, 0x4F139F59 */
+s3 = 1.46350472652464452805e-01, /* 0x3FC2BB9C, 0xBEE5F2F7 */
+s4 = 2.66422703033638609560e-02, /* 0x3F9B481C, 0x7E939961 */
+s5 = 1.84028451407337715652e-03, /* 0x3F5E26B6, 0x7368F239 */
+s6 = 3.19475326584100867617e-05, /* 0x3F00BFEC, 0xDD17E945 */
+r1 = 1.39200533467621045958e+00, /* 0x3FF645A7, 0x62C4AB74 */
+r2 = 7.21935547567138069525e-01, /* 0x3FE71A18, 0x93D3DCDC */
+r3 = 1.71933865632803078993e-01, /* 0x3FC601ED, 0xCCFBDF27 */
+r4 = 1.86459191715652901344e-02, /* 0x3F9317EA, 0x742ED475 */
+r5 = 7.77942496381893596434e-04, /* 0x3F497DDA, 0xCA41A95B */
+r6 = 7.32668430744625636189e-06, /* 0x3EDEBAF7, 0xA5B38140 */
+w0 = 4.18938533204672725052e-01, /* 0x3FDACFE3, 0x90C97D69 */
+w1 = 8.33333333333329678849e-02, /* 0x3FB55555, 0x5555553B */
+w2 = -2.77777777728775536470e-03, /* 0xBF66C16C, 0x16B02E5C */
+w3 = 7.93650558643019558500e-04, /* 0x3F4A019F, 0x98CF38B6 */
+w4 = -5.95187557450339963135e-04, /* 0xBF4380CB, 0x8C0FE741 */
+w5 = 8.36339918996282139126e-04, /* 0x3F4B67BA, 0x4CDAD5D1 */
+w6 = -1.63092934096575273989e-03; /* 0xBF5AB89D, 0x0B9E43E4 */
+
+static double zero= 0.00000000000000000000e+00;
+
+ static double sin_pi(double x)
+{
+ double y,z;
+ int n,ix;
+
+ ix = 0x7fffffff&__HI(x);
+
+ if(ix<0x3fd00000) return __kernel_sin(pi*x,zero,0);
+ y = -x; /* x is assume negative */
+
+ /*
+ * argument reduction, make sure inexact flag not raised if input
+ * is an integer
+ */
+ z = floor(y);
+ if(z!=y) { /* inexact anyway */
+ y *= 0.5;
+ y = 2.0*(y - floor(y)); /* y = |x| mod 2.0 */
+ n = (int) (y*4.0);
+ } else {
+ if(ix>=0x43400000) {
+ y = zero; n = 0; /* y must be even */
+ } else {
+ if(ix<0x43300000) z = y+two52; /* exact */
+ n = __LO(z)&1; /* lower word of z */
+ y = n;
+ n<<= 2;
+ }
+ }
+ switch (n) {
+ case 0: y = __kernel_sin(pi*y,zero,0); break;
+ case 1:
+ case 2: y = __kernel_cos(pi*(0.5-y),zero); break;
+ case 3:
+ case 4: y = __kernel_sin(pi*(one-y),zero,0); break;
+ case 5:
+ case 6: y = -__kernel_cos(pi*(y-1.5),zero); break;
+ default: y = __kernel_sin(pi*(y-2.0),zero,0); break;
+ }
+ return -y;
+}
+
+
+ double __ieee754_lgamma_r(double x, int *signgamp)
+{
+ double t,y,z,nadj,p,p1,p2,p3,q,r,w;
+ int i,hx,lx,ix;
+
+ hx = __HI(x);
+ lx = __LO(x);
+
+ /* purge off +-inf, NaN, +-0, and negative arguments */
+ *signgamp = 1;
+ ix = hx&0x7fffffff;
+ if(ix>=0x7ff00000) return x*x;
+ if((ix|lx)==0) return one/zero;
+ if(ix<0x3b900000) { /* |x|<2**-70, return -log(|x|) */
+ if(hx<0) {
+ *signgamp = -1;
+ return -__ieee754_log(-x);
+ } else return -__ieee754_log(x);
+ }
+ if(hx<0) {
+ if(ix>=0x43300000) /* |x|>=2**52, must be -integer */
+ return one/zero;
+ t = sin_pi(x);
+ if(t==zero) return one/zero; /* -integer */
+ nadj = __ieee754_log(pi/fabs(t*x));
+ if(t<zero) *signgamp = -1;
+ x = -x;
+ }
+
+ /* purge off 1 and 2 */
+ if((((ix-0x3ff00000)|lx)==0)||(((ix-0x40000000)|lx)==0)) r = 0;
+ /* for x < 2.0 */
+ else if(ix<0x40000000) {
+ if(ix<=0x3feccccc) { /* lgamma(x) = lgamma(x+1)-log(x) */
+ r = -__ieee754_log(x);
+ if(ix>=0x3FE76944) {y = one-x; i= 0;}
+ else if(ix>=0x3FCDA661) {y= x-(tc-one); i=1;}
+ else {y = x; i=2;}
+ } else {
+ r = zero;
+ if(ix>=0x3FFBB4C3) {y=2.0-x;i=0;} /* [1.7316,2] */
+ else if(ix>=0x3FF3B4C4) {y=x-tc;i=1;} /* [1.23,1.73] */
+ else {y=x-one;i=2;}
+ }
+ switch(i) {
+ case 0:
+ z = y*y;
+ p1 = a0+z*(a2+z*(a4+z*(a6+z*(a8+z*a10))));
+ p2 = z*(a1+z*(a3+z*(a5+z*(a7+z*(a9+z*a11)))));
+ p = y*p1+p2;
+ r += (p-0.5*y); break;
+ case 1:
+ z = y*y;
+ w = z*y;
+ p1 = t0+w*(t3+w*(t6+w*(t9 +w*t12))); /* parallel comp */
+ p2 = t1+w*(t4+w*(t7+w*(t10+w*t13)));
+ p3 = t2+w*(t5+w*(t8+w*(t11+w*t14)));
+ p = z*p1-(tt-w*(p2+y*p3));
+ r += (tf + p); break;
+ case 2:
+ p1 = y*(u0+y*(u1+y*(u2+y*(u3+y*(u4+y*u5)))));
+ p2 = one+y*(v1+y*(v2+y*(v3+y*(v4+y*v5))));
+ r += (-0.5*y + p1/p2);
+ }
+ }
+ else if(ix<0x40200000) { /* x < 8.0 */
+ i = (int)x;
+ t = zero;
+ y = x-(double)i;
+ p = y*(s0+y*(s1+y*(s2+y*(s3+y*(s4+y*(s5+y*s6))))));
+ q = one+y*(r1+y*(r2+y*(r3+y*(r4+y*(r5+y*r6)))));
+ r = half*y+p/q;
+ z = one; /* lgamma(1+s) = log(s) + lgamma(s) */
+ switch(i) {
+ case 7: z *= (y+6.0); /* FALLTHRU */
+ case 6: z *= (y+5.0); /* FALLTHRU */
+ case 5: z *= (y+4.0); /* FALLTHRU */
+ case 4: z *= (y+3.0); /* FALLTHRU */
+ case 3: z *= (y+2.0); /* FALLTHRU */
+ r += __ieee754_log(z); break;
+ }
+ /* 8.0 <= x < 2**58 */
+ } else if (ix < 0x43900000) {
+ t = __ieee754_log(x);
+ z = one/x;
+ y = z*z;
+ w = w0+z*(w1+y*(w2+y*(w3+y*(w4+y*(w5+y*w6)))));
+ r = (x-half)*(t-one)+w;
+ } else
+ /* 2**58 <= x <= inf */
+ r = x*(__ieee754_log(x)-one);
+ if(hx<0) r = nadj - r;
+ return r;
+}
diff --git a/libmath/fdlibm/e_log.c b/libmath/fdlibm/e_log.c
new file mode 100644
index 00000000..f5a7bf36
--- /dev/null
+++ b/libmath/fdlibm/e_log.c
@@ -0,0 +1,131 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_log.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_log(x)
+ * Return the logrithm of x
+ *
+ * Method :
+ * 1. Argument Reduction: find k and f such that
+ * x = 2^k * (1+f),
+ * where sqrt(2)/2 < 1+f < sqrt(2) .
+ *
+ * 2. Approximation of log(1+f).
+ * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
+ * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
+ * = 2s + s*R
+ * We use a special Reme algorithm on [0,0.1716] to generate
+ * a polynomial of degree 14 to approximate R The maximum error
+ * of this polynomial approximation is bounded by 2**-58.45. In
+ * other words,
+ * 2 4 6 8 10 12 14
+ * R(z) ~ Lg1*s +Lg2*s +Lg3*s +Lg4*s +Lg5*s +Lg6*s +Lg7*s
+ * (the values of Lg1 to Lg7 are listed in the program)
+ * and
+ * | 2 14 | -58.45
+ * | Lg1*s +...+Lg7*s - R(z) | <= 2
+ * | |
+ * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
+ * In order to guarantee error in log below 1ulp, we compute log
+ * by
+ * log(1+f) = f - s*(f - R) (if f is not too large)
+ * log(1+f) = f - (hfsq - s*(hfsq+R)). (better accuracy)
+ *
+ * 3. Finally, log(x) = k*ln2 + log(1+f).
+ * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
+ * Here ln2 is split into two floating point number:
+ * ln2_hi + ln2_lo,
+ * where n*ln2_hi is always exact for |n| < 2000.
+ *
+ * Special cases:
+ * log(x) is NaN with signal if x < 0 (including -INF) ;
+ * log(+INF) is +INF; log(0) is -INF with signal;
+ * log(NaN) is that NaN with no signal.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const double
+ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
+ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
+two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
+Lg1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
+Lg2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
+Lg3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
+Lg4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
+Lg5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
+Lg6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
+Lg7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
+
+static double zero = 0.0;
+
+ double __ieee754_log(double x)
+{
+ double hfsq,f,s,z,R,w,t1,t2,dk;
+ int k,hx,i,j;
+ unsigned lx;
+
+ hx = __HI(x); /* high word of x */
+ lx = __LO(x); /* low word of x */
+
+ k=0;
+ if (hx < 0x00100000) { /* x < 2**-1022 */
+ if (((hx&0x7fffffff)|lx)==0)
+ return -two54/zero; /* log(+-0)=-inf */
+ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */
+ k -= 54; x *= two54; /* subnormal number, scale up x */
+ hx = __HI(x); /* high word of x */
+ }
+ if (hx >= 0x7ff00000) return x+x;
+ k += (hx>>20)-1023;
+ hx &= 0x000fffff;
+ i = (hx+0x95f64)&0x100000;
+ __HI(x) = hx|(i^0x3ff00000); /* normalize x or x/2 */
+ k += (i>>20);
+ f = x-1.0;
+ if((0x000fffff&(2+hx))<3) { /* |f| < 2**-20 */
+ if(f==zero) if(k==0) return zero; else {dk=(double)k;
+ return dk*ln2_hi+dk*ln2_lo;}
+ R = f*f*(0.5-0.33333333333333333*f);
+ if(k==0) return f-R; else {dk=(double)k;
+ return dk*ln2_hi-((R-dk*ln2_lo)-f);}
+ }
+ s = f/(2.0+f);
+ dk = (double)k;
+ z = s*s;
+ i = hx-0x6147a;
+ w = z*z;
+ j = 0x6b851-hx;
+ t1= w*(Lg2+w*(Lg4+w*Lg6));
+ t2= z*(Lg1+w*(Lg3+w*(Lg5+w*Lg7)));
+ i |= j;
+ R = t2+t1;
+ if(i>0) {
+ hfsq=0.5*f*f;
+ if(k==0) return f-(hfsq-s*(hfsq+R)); else
+ return dk*ln2_hi-((hfsq-(s*(hfsq+R)+dk*ln2_lo))-f);
+ } else {
+ if(k==0) return f-s*(f-R); else
+ return dk*ln2_hi-((s*(f-R)-dk*ln2_lo)-f);
+ }
+}
diff --git a/libmath/fdlibm/e_log10.c b/libmath/fdlibm/e_log10.c
new file mode 100644
index 00000000..454d7b6d
--- /dev/null
+++ b/libmath/fdlibm/e_log10.c
@@ -0,0 +1,83 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_log10.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_log10(x)
+ * Return the base 10 logarithm of x
+ *
+ * Method :
+ * Let log10_2hi = leading 40 bits of log10(2) and
+ * log10_2lo = log10(2) - log10_2hi,
+ * ivln10 = 1/log(10) rounded.
+ * Then
+ * n = ilogb(x),
+ * if(n<0) n = n+1;
+ * x = scalbn(x,-n);
+ * log10(x) := n*log10_2hi + (n*log10_2lo + ivln10*log(x))
+ *
+ * Note 1:
+ * To guarantee log10(10**n)=n, where 10**n is normal, the rounding
+ * mode must set to Round-to-Nearest.
+ * Note 2:
+ * [1/log(10)] rounded to 53 bits has error .198 ulps;
+ * log10 is monotonic at all binary break points.
+ *
+ * Special cases:
+ * log10(x) is NaN with signal if x < 0;
+ * log10(+INF) is +INF with no signal; log10(0) is -INF with signal;
+ * log10(NaN) is that NaN with no signal;
+ * log10(10**N) = N for N=0,1,...,22.
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following constants.
+ * The decimal values may be used, provided that the compiler will convert
+ * from decimal to binary accurately enough to produce the hexadecimal values
+ * shown.
+ */
+
+#include "fdlibm.h"
+
+static const double
+two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
+ivln10 = 4.34294481903251816668e-01, /* 0x3FDBCB7B, 0x1526E50E */
+log10_2hi = 3.01029995663611771306e-01, /* 0x3FD34413, 0x509F6000 */
+log10_2lo = 3.69423907715893078616e-13; /* 0x3D59FEF3, 0x11F12B36 */
+
+static double zero = 0.0;
+
+ double __ieee754_log10(double x)
+{
+ double y,z;
+ int i,k,hx;
+ unsigned lx;
+
+ hx = __HI(x); /* high word of x */
+ lx = __LO(x); /* low word of x */
+
+ k=0;
+ if (hx < 0x00100000) { /* x < 2**-1022 */
+ if (((hx&0x7fffffff)|lx)==0)
+ return -two54/zero; /* log(+-0)=-inf */
+ if (hx<0) return (x-x)/zero; /* log(-#) = NaN */
+ k -= 54; x *= two54; /* subnormal number, scale up x */
+ hx = __HI(x); /* high word of x */
+ }
+ if (hx >= 0x7ff00000) return x+x;
+ k += (hx>>20)-1023;
+ i = ((unsigned)k&0x80000000)>>31;
+ hx = (hx&0x000fffff)|((0x3ff-i)<<20);
+ y = (double)(k+i);
+ __HI(x) = hx;
+ z = y*log10_2lo + ivln10*__ieee754_log(x);
+ return z+y*log10_2hi;
+}
diff --git a/libmath/fdlibm/e_pow.c b/libmath/fdlibm/e_pow.c
new file mode 100644
index 00000000..95762173
--- /dev/null
+++ b/libmath/fdlibm/e_pow.c
@@ -0,0 +1,296 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_pow.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_pow(x,y) return x**y
+ *
+ * n
+ * Method: Let x = 2 * (1+f)
+ * 1. Compute and return log2(x) in two pieces:
+ * log2(x) = w1 + w2,
+ * where w1 has 53-24 = 29 bit trailing zeros.
+ * 2. Perform y*log2(x) = n+y' by simulating muti-precision
+ * arithmetic, where |y'|<=0.5.
+ * 3. Return x**y = 2**n*exp(y'*log2)
+ *
+ * Special cases:
+ * 1. (anything) ** 0 is 1
+ * 2. (anything) ** 1 is itself
+ * 3. (anything) ** NAN is NAN
+ * 4. NAN ** (anything except 0) is NAN
+ * 5. +-(|x| > 1) ** +INF is +INF
+ * 6. +-(|x| > 1) ** -INF is +0
+ * 7. +-(|x| < 1) ** +INF is +0
+ * 8. +-(|x| < 1) ** -INF is +INF
+ * 9. +-1 ** +-INF is NAN
+ * 10. +0 ** (+anything except 0, NAN) is +0
+ * 11. -0 ** (+anything except 0, NAN, odd integer) is +0
+ * 12. +0 ** (-anything except 0, NAN) is +INF
+ * 13. -0 ** (-anything except 0, NAN, odd integer) is +INF
+ * 14. -0 ** (odd integer) = -( +0 ** (odd integer) )
+ * 15. +INF ** (+anything except 0,NAN) is +INF
+ * 16. +INF ** (-anything except 0,NAN) is +0
+ * 17. -INF ** (anything) = -0 ** (-anything)
+ * 18. (-anything) ** (integer) is (-1)**(integer)*(+anything**integer)
+ * 19. (-anything except 0 and inf) ** (non-integer) is NAN
+ *
+ * Accuracy:
+ * pow(x,y) returns x**y nearly rounded. In particular
+ * pow(integer,integer)
+ * always returns the correct integer provided it is
+ * representable.
+ *
+ * Constants :
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const double
+bp[] = {1.0, 1.5,},
+dp_h[] = { 0.0, 5.84962487220764160156e-01,}, /* 0x3FE2B803, 0x40000000 */
+dp_l[] = { 0.0, 1.35003920212974897128e-08,}, /* 0x3E4CFDEB, 0x43CFD006 */
+zero = 0.0,
+one = 1.0,
+two = 2.0,
+two53 = 9007199254740992.0, /* 0x43400000, 0x00000000 */
+Huge = 1.0e300,
+tiny = 1.0e-300,
+ /* poly coefs for (3/2)*(log(x)-2s-2/3*s**3 */
+L1 = 5.99999999999994648725e-01, /* 0x3FE33333, 0x33333303 */
+L2 = 4.28571428578550184252e-01, /* 0x3FDB6DB6, 0xDB6FABFF */
+L3 = 3.33333329818377432918e-01, /* 0x3FD55555, 0x518F264D */
+L4 = 2.72728123808534006489e-01, /* 0x3FD17460, 0xA91D4101 */
+L5 = 2.30660745775561754067e-01, /* 0x3FCD864A, 0x93C9DB65 */
+L6 = 2.06975017800338417784e-01, /* 0x3FCA7E28, 0x4A454EEF */
+P1 = 1.66666666666666019037e-01, /* 0x3FC55555, 0x5555553E */
+P2 = -2.77777777770155933842e-03, /* 0xBF66C16C, 0x16BEBD93 */
+P3 = 6.61375632143793436117e-05, /* 0x3F11566A, 0xAF25DE2C */
+P4 = -1.65339022054652515390e-06, /* 0xBEBBBD41, 0xC5D26BF1 */
+P5 = 4.13813679705723846039e-08, /* 0x3E663769, 0x72BEA4D0 */
+lg2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
+lg2_h = 6.93147182464599609375e-01, /* 0x3FE62E43, 0x00000000 */
+lg2_l = -1.90465429995776804525e-09, /* 0xBE205C61, 0x0CA86C39 */
+ovt = 8.0085662595372944372e-0017, /* -(1024-log2(ovfl+.5ulp)) */
+cp = 9.61796693925975554329e-01, /* 0x3FEEC709, 0xDC3A03FD =2/(3ln2) */
+cp_h = 9.61796700954437255859e-01, /* 0x3FEEC709, 0xE0000000 =(float)cp */
+cp_l = -7.02846165095275826516e-09, /* 0xBE3E2FE0, 0x145B01F5 =tail of cp_h*/
+ivln2 = 1.44269504088896338700e+00, /* 0x3FF71547, 0x652B82FE =1/ln2 */
+ivln2_h = 1.44269502162933349609e+00, /* 0x3FF71547, 0x60000000 =24b 1/ln2*/
+ivln2_l = 1.92596299112661746887e-08; /* 0x3E54AE0B, 0xF85DDF44 =1/ln2 tail*/
+
+ double __ieee754_pow(double x, double y)
+{
+ double z,ax,z_h,z_l,p_h,p_l;
+ double y1,t1,t2,r,s,t,u,v,w;
+ int i,j,k,yisint,n;
+ int hx,hy,ix,iy;
+ unsigned lx,ly;
+
+ hx = __HI(x); lx = __LO(x);
+ hy = __HI(y); ly = __LO(y);
+ ix = hx&0x7fffffff; iy = hy&0x7fffffff;
+
+ /* y==zero: x**0 = 1 */
+ if((iy|ly)==0) return one;
+
+ /* +-NaN return x+y */
+ if(ix > 0x7ff00000 || ((ix==0x7ff00000)&&(lx!=0)) ||
+ iy > 0x7ff00000 || ((iy==0x7ff00000)&&(ly!=0)))
+ return x+y;
+
+ /* determine if y is an odd int when x < 0
+ * yisint = 0 ... y is not an integer
+ * yisint = 1 ... y is an odd int
+ * yisint = 2 ... y is an even int
+ */
+ yisint = 0;
+ if(hx<0) {
+ if(iy>=0x43400000) yisint = 2; /* even integer y */
+ else if(iy>=0x3ff00000) {
+ k = (iy>>20)-0x3ff; /* exponent */
+ if(k>20) {
+ j = ly>>(52-k);
+ if((j<<(52-k))==ly) yisint = 2-(j&1);
+ } else if(ly==0) {
+ j = iy>>(20-k);
+ if((j<<(20-k))==iy) yisint = 2-(j&1);
+ }
+ }
+ }
+
+ /* special value of y */
+ if(ly==0) {
+ if (iy==0x7ff00000) { /* y is +-inf */
+ if(((ix-0x3ff00000)|lx)==0)
+ return y - y; /* inf**+-1 is NaN */
+ else if (ix >= 0x3ff00000)/* (|x|>1)**+-inf = inf,0 */
+ return (hy>=0)? y: zero;
+ else /* (|x|<1)**-,+inf = inf,0 */
+ return (hy<0)?-y: zero;
+ }
+ if(iy==0x3ff00000) { /* y is +-1 */
+ if(hy<0) return one/x; else return x;
+ }
+ if(hy==0x40000000) return x*x; /* y is 2 */
+ if(hy==0x3fe00000) { /* y is 0.5 */
+ if(hx>=0) /* x >= +0 */
+ return sqrt(x);
+ }
+ }
+
+ ax = fabs(x);
+ /* special value of x */
+ if(lx==0) {
+ if(ix==0x7ff00000||ix==0||ix==0x3ff00000){
+ z = ax; /*x is +-0,+-inf,+-1*/
+ if(hy<0) z = one/z; /* z = (1/|x|) */
+ if(hx<0) {
+ if(((ix-0x3ff00000)|yisint)==0) {
+ z = (z-z)/(z-z); /* (-1)**non-int is NaN */
+ } else if(yisint==1)
+ z = -z; /* (x<0)**odd = -(|x|**odd) */
+ }
+ return z;
+ }
+ }
+
+ /* (x<0)**(non-int) is NaN */
+ if((((hx>>31)+1)|yisint)==0) return (x-x)/(x-x);
+
+ /* |y| is Huge */
+ if(iy>0x41e00000) { /* if |y| > 2**31 */
+ if(iy>0x43f00000){ /* if |y| > 2**64, must o/uflow */
+ if(ix<=0x3fefffff) return (hy<0)? Huge*Huge:tiny*tiny;
+ if(ix>=0x3ff00000) return (hy>0)? Huge*Huge:tiny*tiny;
+ }
+ /* over/underflow if x is not close to one */
+ if(ix<0x3fefffff) return (hy<0)? Huge*Huge:tiny*tiny;
+ if(ix>0x3ff00000) return (hy>0)? Huge*Huge:tiny*tiny;
+ /* now |1-x| is tiny <= 2**-20, suffice to compute
+ log(x) by x-x^2/2+x^3/3-x^4/4 */
+ t = x-1; /* t has 20 trailing zeros */
+ w = (t*t)*(0.5-t*(0.3333333333333333333333-t*0.25));
+ u = ivln2_h*t; /* ivln2_h has 21 sig. bits */
+ v = t*ivln2_l-w*ivln2;
+ t1 = u+v;
+ __LO(t1) = 0;
+ t2 = v-(t1-u);
+ } else {
+ double s2,s_h,s_l,t_h,t_l;
+ n = 0;
+ /* take care subnormal number */
+ if(ix<0x00100000)
+ {ax *= two53; n -= 53; ix = __HI(ax); }
+ n += ((ix)>>20)-0x3ff;
+ j = ix&0x000fffff;
+ /* determine interval */
+ ix = j|0x3ff00000; /* normalize ix */
+ if(j<=0x3988E) k=0; /* |x|<sqrt(3/2) */
+ else if(j<0xBB67A) k=1; /* |x|<sqrt(3) */
+ else {k=0;n+=1;ix -= 0x00100000;}
+ __HI(ax) = ix;
+
+ /* compute s = s_h+s_l = (x-1)/(x+1) or (x-1.5)/(x+1.5) */
+ u = ax-bp[k]; /* bp[0]=1.0, bp[1]=1.5 */
+ v = one/(ax+bp[k]);
+ s = u*v;
+ s_h = s;
+ __LO(s_h) = 0;
+ /* t_h=ax+bp[k] High */
+ t_h = zero;
+ __HI(t_h)=((ix>>1)|0x20000000)+0x00080000+(k<<18);
+ t_l = ax - (t_h-bp[k]);
+ s_l = v*((u-s_h*t_h)-s_h*t_l);
+ /* compute log(ax) */
+ s2 = s*s;
+ r = s2*s2*(L1+s2*(L2+s2*(L3+s2*(L4+s2*(L5+s2*L6)))));
+ r += s_l*(s_h+s);
+ s2 = s_h*s_h;
+ t_h = 3.0+s2+r;
+ __LO(t_h) = 0;
+ t_l = r-((t_h-3.0)-s2);
+ /* u+v = s*(1+...) */
+ u = s_h*t_h;
+ v = s_l*t_h+t_l*s;
+ /* 2/(3log2)*(s+...) */
+ p_h = u+v;
+ __LO(p_h) = 0;
+ p_l = v-(p_h-u);
+ z_h = cp_h*p_h; /* cp_h+cp_l = 2/(3*log2) */
+ z_l = cp_l*p_h+p_l*cp+dp_l[k];
+ /* log2(ax) = (s+..)*2/(3*log2) = n + dp_h + z_h + z_l */
+ t = (double)n;
+ t1 = (((z_h+z_l)+dp_h[k])+t);
+ __LO(t1) = 0;
+ t2 = z_l-(((t1-t)-dp_h[k])-z_h);
+ }
+
+ s = one; /* s (sign of result -ve**odd) = -1 else = 1 */
+ if((((hx>>31)+1)|(yisint-1))==0) s = -one;/* (-ve)**(odd int) */
+
+ /* split up y into y1+y2 and compute (y1+y2)*(t1+t2) */
+ y1 = y;
+ __LO(y1) = 0;
+ p_l = (y-y1)*t1+y*t2;
+ p_h = y1*t1;
+ z = p_l+p_h;
+ j = __HI(z);
+ i = __LO(z);
+ if (j>=0x40900000) { /* z >= 1024 */
+ if(((j-0x40900000)|i)!=0) /* if z > 1024 */
+ return s*Huge*Huge; /* overflow */
+ else {
+ if(p_l+ovt>z-p_h) return s*Huge*Huge; /* overflow */
+ }
+ } else if((j&0x7fffffff)>=0x4090cc00 ) { /* z <= -1075 */
+ if(((j-0xc090cc00)|i)!=0) /* z < -1075 */
+ return s*tiny*tiny; /* underflow */
+ else {
+ if(p_l<=z-p_h) return s*tiny*tiny; /* underflow */
+ }
+ }
+ /*
+ * compute 2**(p_h+p_l)
+ */
+ i = j&0x7fffffff;
+ k = (i>>20)-0x3ff;
+ n = 0;
+ if(i>0x3fe00000) { /* if |z| > 0.5, set n = [z+0.5] */
+ n = j+(0x00100000>>(k+1));
+ k = ((n&0x7fffffff)>>20)-0x3ff; /* new k for n */
+ t = zero;
+ __HI(t) = (n&~(0x000fffff>>k));
+ n = ((n&0x000fffff)|0x00100000)>>(20-k);
+ if(j<0) n = -n;
+ p_h -= t;
+ }
+ t = p_l+p_h;
+ __LO(t) = 0;
+ u = t*lg2_h;
+ v = (p_l-(t-p_h))*lg2+t*lg2_l;
+ z = u+v;
+ w = v-(z-u);
+ t = z*z;
+ t1 = z - t*(P1+t*(P2+t*(P3+t*(P4+t*P5))));
+ r = (z*t1)/(t1-two)-(w+z*w);
+ z = one-(r-z);
+ j = __HI(z);
+ j += (n<<20);
+ if((j>>20)<=0) z = scalbn(z,n); /* subnormal output */
+ else __HI(z) += (n<<20);
+ return s*z;
+}
diff --git a/libmath/fdlibm/e_rem_pio2.c b/libmath/fdlibm/e_rem_pio2.c
new file mode 100644
index 00000000..ac11ecf1
--- /dev/null
+++ b/libmath/fdlibm/e_rem_pio2.c
@@ -0,0 +1,159 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_rem_pio2.c 1.4 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+/* __ieee754_rem_pio2(x,y)
+ *
+ * return the remainder of x rem pi/2 in y[0]+y[1]
+ * use __kernel_rem_pio2()
+ */
+
+#include "fdlibm.h"
+
+/*
+ * Table of constants for 2/pi, 396 Hex digits (476 decimal) of 2/pi
+ */
+static const int two_over_pi[] = {
+0xA2F983, 0x6E4E44, 0x1529FC, 0x2757D1, 0xF534DD, 0xC0DB62,
+0x95993C, 0x439041, 0xFE5163, 0xABDEBB, 0xC561B7, 0x246E3A,
+0x424DD2, 0xE00649, 0x2EEA09, 0xD1921C, 0xFE1DEB, 0x1CB129,
+0xA73EE8, 0x8235F5, 0x2EBB44, 0x84E99C, 0x7026B4, 0x5F7E41,
+0x3991D6, 0x398353, 0x39F49C, 0x845F8B, 0xBDF928, 0x3B1FF8,
+0x97FFDE, 0x05980F, 0xEF2F11, 0x8B5A0A, 0x6D1F6D, 0x367ECF,
+0x27CB09, 0xB74F46, 0x3F669E, 0x5FEA2D, 0x7527BA, 0xC7EBE5,
+0xF17B3D, 0x0739F7, 0x8A5292, 0xEA6BFB, 0x5FB11F, 0x8D5D08,
+0x560330, 0x46FC7B, 0x6BABF0, 0xCFBC20, 0x9AF436, 0x1DA9E3,
+0x91615E, 0xE61B08, 0x659985, 0x5F14A0, 0x68408D, 0xFFD880,
+0x4D7327, 0x310606, 0x1556CA, 0x73A8C9, 0x60E27B, 0xC08C6B,
+};
+
+static const int npio2_hw[] = {
+0x3FF921FB, 0x400921FB, 0x4012D97C, 0x401921FB, 0x401F6A7A, 0x4022D97C,
+0x4025FDBB, 0x402921FB, 0x402C463A, 0x402F6A7A, 0x4031475C, 0x4032D97C,
+0x40346B9C, 0x4035FDBB, 0x40378FDB, 0x403921FB, 0x403AB41B, 0x403C463A,
+0x403DD85A, 0x403F6A7A, 0x40407E4C, 0x4041475C, 0x4042106C, 0x4042D97C,
+0x4043A28C, 0x40446B9C, 0x404534AC, 0x4045FDBB, 0x4046C6CB, 0x40478FDB,
+0x404858EB, 0x404921FB,
+};
+
+/*
+ * invpio2: 53 bits of 2/pi
+ * pio2_1: first 33 bit of pi/2
+ * pio2_1t: pi/2 - pio2_1
+ * pio2_2: second 33 bit of pi/2
+ * pio2_2t: pi/2 - (pio2_1+pio2_2)
+ * pio2_3: third 33 bit of pi/2
+ * pio2_3t: pi/2 - (pio2_1+pio2_2+pio2_3)
+ */
+
+static const double
+zero = 0.00000000000000000000e+00, /* 0x00000000, 0x00000000 */
+half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
+invpio2 = 6.36619772367581382433e-01, /* 0x3FE45F30, 0x6DC9C883 */
+pio2_1 = 1.57079632673412561417e+00, /* 0x3FF921FB, 0x54400000 */
+pio2_1t = 6.07710050650619224932e-11, /* 0x3DD0B461, 0x1A626331 */
+pio2_2 = 6.07710050630396597660e-11, /* 0x3DD0B461, 0x1A600000 */
+pio2_2t = 2.02226624879595063154e-21, /* 0x3BA3198A, 0x2E037073 */
+pio2_3 = 2.02226624871116645580e-21, /* 0x3BA3198A, 0x2E000000 */
+pio2_3t = 8.47842766036889956997e-32; /* 0x397B839A, 0x252049C1 */
+
+ int __ieee754_rem_pio2(double x, double *y)
+{
+ double z,w,t,r,fn;
+ double tx[3];
+ int e0,i,j,nx,n,ix,hx;
+
+ hx = __HI(x); /* high word of x */
+ ix = hx&0x7fffffff;
+ if(ix<=0x3fe921fb) /* |x| ~<= pi/4 , no need for reduction */
+ {y[0] = x; y[1] = 0; return 0;}
+ if(ix<0x4002d97c) { /* |x| < 3pi/4, special case with n=+-1 */
+ if(hx>0) {
+ z = x - pio2_1;
+ if(ix!=0x3ff921fb) { /* 33+53 bit pi is good enough */
+ y[0] = z - pio2_1t;
+ y[1] = (z-y[0])-pio2_1t;
+ } else { /* near pi/2, use 33+33+53 bit pi */
+ z -= pio2_2;
+ y[0] = z - pio2_2t;
+ y[1] = (z-y[0])-pio2_2t;
+ }
+ return 1;
+ } else { /* negative x */
+ z = x + pio2_1;
+ if(ix!=0x3ff921fb) { /* 33+53 bit pi is good enough */
+ y[0] = z + pio2_1t;
+ y[1] = (z-y[0])+pio2_1t;
+ } else { /* near pi/2, use 33+33+53 bit pi */
+ z += pio2_2;
+ y[0] = z + pio2_2t;
+ y[1] = (z-y[0])+pio2_2t;
+ }
+ return -1;
+ }
+ }
+ if(ix<=0x413921fb) { /* |x| ~<= 2^19*(pi/2), medium size */
+ t = fabs(x);
+ n = (int) (t*invpio2+half);
+ fn = (double)n;
+ r = t-fn*pio2_1;
+ w = fn*pio2_1t; /* 1st round good to 85 bit */
+ if(n<32&&ix!=npio2_hw[n-1]) {
+ y[0] = r-w; /* quick check no cancellation */
+ } else {
+ j = ix>>20;
+ y[0] = r-w;
+ i = j-(((__HI(y[0]))>>20)&0x7ff);
+ if(i>16) { /* 2nd iteration needed, good to 118 */
+ t = r;
+ w = fn*pio2_2;
+ r = t-w;
+ w = fn*pio2_2t-((t-r)-w);
+ y[0] = r-w;
+ i = j-(((__HI(y[0]))>>20)&0x7ff);
+ if(i>49) { /* 3rd iteration need, 151 bits acc */
+ t = r; /* will cover all possible cases */
+ w = fn*pio2_3;
+ r = t-w;
+ w = fn*pio2_3t-((t-r)-w);
+ y[0] = r-w;
+ }
+ }
+ }
+ y[1] = (r-y[0])-w;
+ if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;}
+ else return n;
+ }
+ /*
+ * all other (large) arguments
+ */
+ if(ix>=0x7ff00000) { /* x is inf or NaN */
+ y[0]=y[1]=x-x; return 0;
+ }
+ /* set z = scalbn(|x|,ilogb(x)-23) */
+ __LO(z) = __LO(x);
+ e0 = (ix>>20)-1046; /* e0 = ilogb(z)-23; */
+ __HI(z) = ix - (e0<<20);
+ for(i=0;i<2;i++) {
+ tx[i] = (double)((int)(z));
+ z = (z-tx[i])*two24;
+ }
+ tx[2] = z;
+ nx = 3;
+ while(tx[nx-1]==zero) nx--; /* skip zero term */
+ n = __kernel_rem_pio2(tx,y,e0,nx,2,two_over_pi);
+ if(hx<0) {y[0] = -y[0]; y[1] = -y[1]; return -n;}
+ return n;
+}
diff --git a/libmath/fdlibm/e_remainder.c b/libmath/fdlibm/e_remainder.c
new file mode 100644
index 00000000..df38e3e5
--- /dev/null
+++ b/libmath/fdlibm/e_remainder.c
@@ -0,0 +1,69 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_remainder.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_remainder(x,p)
+ * Return :
+ * returns x REM p = x - [x/p]*p as if in infinite
+ * precise arithmetic, where [x/p] is the (infinite bit)
+ * integer nearest x/p (in half way case choose the even one).
+ * Method :
+ * Based on fmod() return x-[x/p]chopped*p exactlp.
+ */
+
+#include "fdlibm.h"
+
+static const double zero = 0.0;
+
+
+ double __ieee754_remainder(double x, double p)
+{
+ int hx,hp;
+ unsigned sx,lx,lp;
+ double p_half;
+
+ hx = __HI(x); /* high word of x */
+ lx = __LO(x); /* low word of x */
+ hp = __HI(p); /* high word of p */
+ lp = __LO(p); /* low word of p */
+ sx = hx&0x80000000;
+ hp &= 0x7fffffff;
+ hx &= 0x7fffffff;
+
+ /* purge off exception values */
+ if((hp|lp)==0) return (x*p)/(x*p); /* p = 0 */
+ if((hx>=0x7ff00000)|| /* x not finite */
+ ((hp>=0x7ff00000)&& /* p is NaN */
+ (((hp-0x7ff00000)|lp)!=0)))
+ return (x*p)/(x*p);
+
+
+ if (hp<=0x7fdfffff) x = __ieee754_fmod(x,p+p); /* now x < 2p */
+ if (((hx-hp)|(lx-lp))==0) return zero*x;
+ x = fabs(x);
+ p = fabs(p);
+ if (hp<0x00200000) {
+ if(x+x>p) {
+ x-=p;
+ if(x+x>=p) x -= p;
+ }
+ } else {
+ p_half = 0.5*p;
+ if(x>p_half) {
+ x-=p;
+ if(x>=p_half) x -= p;
+ }
+ }
+ __HI(x) ^= sx;
+ return x;
+}
diff --git a/libmath/fdlibm/e_sinh.c b/libmath/fdlibm/e_sinh.c
new file mode 100644
index 00000000..f60d7798
--- /dev/null
+++ b/libmath/fdlibm/e_sinh.c
@@ -0,0 +1,74 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)e_sinh.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_sinh(x)
+ * Method :
+ * mathematically sinh(x) if defined to be (exp(x)-exp(-x))/2
+ * 1. Replace x by |x| (sinh(-x) = -sinh(x)).
+ * 2.
+ * E + E/(E+1)
+ * 0 <= x <= 22 : sinh(x) := --------------, E=expm1(x)
+ * 2
+ *
+ * 22 <= x <= lnovft : sinh(x) := exp(x)/2
+ * lnovft <= x <= ln2ovft: sinh(x) := exp(x/2)/2 * exp(x/2)
+ * ln2ovft < x : sinh(x) := x*sHuge (overflow)
+ *
+ * Special cases:
+ * sinh(x) is |x| if x is +INF, -INF, or NaN.
+ * only sinh(0)=0 is exact for finite x.
+ */
+
+#include "fdlibm.h"
+
+static const double one = 1.0, sHuge = 1.0e307;
+
+ double __ieee754_sinh(double x)
+{
+ double t,w,h;
+ int ix,jx;
+ unsigned lx;
+
+ /* High word of |x|. */
+ jx = __HI(x);
+ ix = jx&0x7fffffff;
+
+ /* x is INF or NaN */
+ if(ix>=0x7ff00000) return x+x;
+
+ h = 0.5;
+ if (jx<0) h = -h;
+ /* |x| in [0,22], return sign(x)*0.5*(E+E/(E+1))) */
+ if (ix < 0x40360000) { /* |x|<22 */
+ if (ix<0x3e300000) /* |x|<2**-28 */
+ if(sHuge+x>one) return x;/* sinh(tiny) = tiny with inexact */
+ t = expm1(fabs(x));
+ if(ix<0x3ff00000) return h*(2.0*t-t*t/(t+one));
+ return h*(t+t/(t+one));
+ }
+
+ /* |x| in [22, log(maxdouble)] return 0.5*exp(|x|) */
+ if (ix < 0x40862E42) return h*__ieee754_exp(fabs(x));
+
+ /* |x| in [log(maxdouble), overflowthresold] */
+ lx = *( (((*(unsigned*)&one)>>29)) + (unsigned*)&x);
+ if (ix<0x408633CE || (ix==0x408633ce)&&(lx<=(unsigned)0x8fb9f87d)) {
+ w = __ieee754_exp(0.5*fabs(x));
+ t = h*w;
+ return t*w;
+ }
+
+ /* |x| > overflowthresold, sinh(x) overflow */
+ return x*sHuge;
+}
diff --git a/libmath/fdlibm/e_sqrt.c b/libmath/fdlibm/e_sqrt.c
new file mode 100644
index 00000000..94b70840
--- /dev/null
+++ b/libmath/fdlibm/e_sqrt.c
@@ -0,0 +1,442 @@
+/* derived from /netlib/fdlibm */
+/* @(#)e_sqrt.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __ieee754_sqrt(x)
+ * Return correctly rounded sqrt.
+ * ------------------------------------------
+ * | Use the hardware sqrt if you have one |
+ * ------------------------------------------
+ * Method:
+ * Bit by bit method using integer arithmetic. (Slow, but portable)
+ * 1. Normalization
+ * Scale x to y in [1,4) with even powers of 2:
+ * find an integer k such that 1 <= (y=x*2^(2k)) < 4, then
+ * sqrt(x) = 2^k * sqrt(y)
+ * 2. Bit by bit computation
+ * Let q = sqrt(y) truncated to i bit after binary point (q = 1),
+ * i 0
+ * i+1 2
+ * s = 2*q , and y = 2 * ( y - q ). (1)
+ * i i i i
+ *
+ * To compute q from q , one checks whether
+ * i+1 i
+ *
+ * -(i+1) 2
+ * (q + 2 ) <= y. (2)
+ * i
+ * -(i+1)
+ * If (2) is false, then q = q ; otherwise q = q + 2 .
+ * i+1 i i+1 i
+ *
+ * With some algebric manipulation, it is not difficult to see
+ * that (2) is equivalent to
+ * -(i+1)
+ * s + 2 <= y (3)
+ * i i
+ *
+ * The advantage of (3) is that s and y can be computed by
+ * i i
+ * the following recurrence formula:
+ * if (3) is false
+ *
+ * s = s , y = y ; (4)
+ * i+1 i i+1 i
+ *
+ * otherwise,
+ * -i -(i+1)
+ * s = s + 2 , y = y - s - 2 (5)
+ * i+1 i i+1 i i
+ *
+ * One may easily use induction to prove (4) and (5).
+ * Note. Since the left hand side of (3) contain only i+2 bits,
+ * it does not necessary to do a full (53-bit) comparison
+ * in (3).
+ * 3. Final rounding
+ * After generating the 53 bits result, we compute one more bit.
+ * Together with the remainder, we can decide whether the
+ * result is exact, bigger than 1/2ulp, or less than 1/2ulp
+ * (it will never equal to 1/2ulp).
+ * The rounding mode can be detected by checking whether
+ * Huge + tiny is equal to Huge, and whether Huge - tiny is
+ * equal to Huge for some floating point number "Huge" and "tiny".
+ *
+ * Special cases:
+ * sqrt(+-0) = +-0 ... exact
+ * sqrt(inf) = inf
+ * sqrt(-ve) = NaN ... with invalid signal
+ * sqrt(NaN) = NaN ... with invalid signal for signaling NaN
+ *
+ * Other methods : see the appended file at the end of the program below.
+ *---------------
+ */
+
+#include "fdlibm.h"
+
+static const double one = 1.0, tiny=1.0e-300;
+
+ double __ieee754_sqrt(double x)
+{
+ double z;
+ int sign = (int)0x80000000;
+ unsigned r,t1,s1,ix1,q1;
+ int ix0,s0,q,m,t,i;
+
+ ix0 = __HI(x); /* high word of x */
+ ix1 = __LO(x); /* low word of x */
+
+ /* take care of Inf and NaN */
+ if((ix0&0x7ff00000)==0x7ff00000) {
+ return x*x+x; /* sqrt(NaN)=NaN, sqrt(+inf)=+inf
+ sqrt(-inf)=sNaN */
+ }
+ /* take care of zero */
+ if(ix0<=0) {
+ if(((ix0&(~sign))|ix1)==0) return x;/* sqrt(+-0) = +-0 */
+ else if(ix0<0)
+ return (x-x)/(x-x); /* sqrt(-ve) = sNaN */
+ }
+ /* normalize x */
+ m = (ix0>>20);
+ if(m==0) { /* subnormal x */
+ while(ix0==0) {
+ m -= 21;
+ ix0 |= (ix1>>11); ix1 <<= 21;
+ }
+ for(i=0;(ix0&0x00100000)==0;i++) ix0<<=1;
+ m -= i-1;
+ ix0 |= (ix1>>(32-i));
+ ix1 <<= i;
+ }
+ m -= 1023; /* unbias exponent */
+ ix0 = (ix0&0x000fffff)|0x00100000;
+ if(m&1){ /* odd m, double x to make it even */
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ }
+ m >>= 1; /* m = [m/2] */
+
+ /* generate sqrt(x) bit by bit */
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ q = q1 = s0 = s1 = 0; /* [q,q1] = sqrt(x) */
+ r = 0x00200000; /* r = moving bit from right to left */
+
+ while(r!=0) {
+ t = s0+r;
+ if(t<=ix0) {
+ s0 = t+r;
+ ix0 -= t;
+ q += r;
+ }
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ r>>=1;
+ }
+
+ r = sign;
+ while(r!=0) {
+ t1 = s1+r;
+ t = s0;
+ if((t<ix0)||((t==ix0)&&(t1<=ix1))) {
+ s1 = t1+r;
+ if(((t1&sign)==sign)&&(s1&sign)==0) s0 += 1;
+ ix0 -= t;
+ if (ix1 < t1) ix0 -= 1;
+ ix1 -= t1;
+ q1 += r;
+ }
+ ix0 += ix0 + ((ix1&sign)>>31);
+ ix1 += ix1;
+ r>>=1;
+ }
+
+ /* use floating add to find out rounding direction */
+ if((ix0|ix1)!=0) {
+ z = one-tiny; /* trigger inexact flag */
+ if (z>=one) {
+ z = one+tiny;
+ if (q1==(unsigned)0xffffffff) { q1=0; q += 1;}
+ else if (z>one) {
+ if (q1==(unsigned)0xfffffffe) q+=1;
+ q1+=2;
+ } else
+ q1 += (q1&1);
+ }
+ }
+ ix0 = (q>>1)+0x3fe00000;
+ ix1 = q1>>1;
+ if ((q&1)==1) ix1 |= sign;
+ ix0 += (m <<20);
+ __HI(z) = ix0;
+ __LO(z) = ix1;
+ return z;
+}
+
+/*
+Other methods (use floating-point arithmetic)
+-------------
+(This is a copy of a drafted paper by Prof W. Kahan
+and K.C. Ng, written in May, 1986)
+
+ Two algorithms are given here to implement sqrt(x)
+ (IEEE double precision arithmetic) in software.
+ Both supply sqrt(x) correctly rounded. The first algorithm (in
+ Section A) uses newton iterations and involves four divisions.
+ The second one uses reciproot iterations to avoid division, but
+ requires more multiplications. Both algorithms need the ability
+ to chop results of arithmetic operations instead of round them,
+ and the INEXACT flag to indicate when an arithmetic operation
+ is executed exactly with no roundoff error, all part of the
+ standard (IEEE 754-1985). The ability to perform shift, add,
+ subtract and logical AND operations upon 32-bit words is needed
+ too, though not part of the standard.
+
+A. sqrt(x) by Newton Iteration
+
+ (1) Initial approximation
+
+ Let x0 and x1 be the leading and the trailing 32-bit words of
+ a floating point number x (in IEEE double format) respectively
+
+ 1 11 52 ...widths
+ ------------------------------------------------------
+ x: |s| e | f |
+ ------------------------------------------------------
+ msb lsb msb lsb ...order
+
+
+ ------------------------ ------------------------
+ x0: |s| e | f1 | x1: | f2 |
+ ------------------------ ------------------------
+
+ By performing shifts and subtracts on x0 and x1 (both regarded
+ as integers), we obtain an 8-bit approximation of sqrt(x) as
+ follows.
+
+ k := (x0>>1) + 0x1ff80000;
+ y0 := k - T1[31&(k>>15)]. ... y ~ sqrt(x) to 8 bits
+ Here k is a 32-bit integer and T1[] is an integer array containing
+ correction terms. Now magically the floating value of y (y's
+ leading 32-bit word is y0, the value of its trailing word is 0)
+ approximates sqrt(x) to almost 8-bit.
+
+ Value of T1:
+ static int T1[32]= {
+ 0, 1024, 3062, 5746, 9193, 13348, 18162, 23592,
+ 29598, 36145, 43202, 50740, 58733, 67158, 75992, 85215,
+ 83599, 71378, 60428, 50647, 41945, 34246, 27478, 21581,
+ 16499, 12183, 8588, 5674, 3403, 1742, 661, 130,};
+
+ (2) Iterative refinement
+
+ Apply Heron's rule three times to y, we have y approximates
+ sqrt(x) to within 1 ulp (Unit in the Last Place):
+
+ y := (y+x/y)/2 ... almost 17 sig. bits
+ y := (y+x/y)/2 ... almost 35 sig. bits
+ y := y-(y-x/y)/2 ... within 1 ulp
+
+
+ Remark 1.
+ Another way to improve y to within 1 ulp is:
+
+ y := (y+x/y) ... almost 17 sig. bits to 2*sqrt(x)
+ y := y - 0x00100006 ... almost 18 sig. bits to sqrt(x)
+
+ 2
+ (x-y )*y
+ y := y + 2* ---------- ...within 1 ulp
+ 2
+ 3y + x
+
+
+ This formula has one division fewer than the one above; however,
+ it requires more multiplications and additions. Also x must be
+ scaled in advance to avoid spurious overflow in evaluating the
+ expression 3y*y+x. Hence it is not recommended uless division
+ is slow. If division is very slow, then one should use the
+ reciproot algorithm given in section B.
+
+ (3) Final adjustment
+
+ By twiddling y's last bit it is possible to force y to be
+ correctly rounded according to the prevailing rounding mode
+ as follows. Let r and i be copies of the rounding mode and
+ inexact flag before entering the square root program. Also we
+ use the expression y+-ulp for the next representable floating
+ numbers (up and down) of y. Note that y+-ulp = either fixed
+ point y+-1, or multiply y by nextafter(1,+-inf) in chopped
+ mode.
+
+ I := FALSE; ... reset INEXACT flag I
+ R := RZ; ... set rounding mode to round-toward-zero
+ z := x/y; ... chopped quotient, possibly inexact
+ If(not I) then { ... if the quotient is exact
+ if(z=y) {
+ I := i; ... restore inexact flag
+ R := r; ... restore rounded mode
+ return sqrt(x):=y.
+ } else {
+ z := z - ulp; ... special rounding
+ }
+ }
+ i := TRUE; ... sqrt(x) is inexact
+ If (r=RN) then z=z+ulp ... rounded-to-nearest
+ If (r=RP) then { ... round-toward-+inf
+ y = y+ulp; z=z+ulp;
+ }
+ y := y+z; ... chopped sum
+ y0:=y0-0x00100000; ... y := y/2 is correctly rounded.
+ I := i; ... restore inexact flag
+ R := r; ... restore rounded mode
+ return sqrt(x):=y.
+
+ (4) Special cases
+
+ Square root of +inf, +-0, or NaN is itself;
+ Square root of a negative number is NaN with invalid signal.
+
+
+B. sqrt(x) by Reciproot Iteration
+
+ (1) Initial approximation
+
+ Let x0 and x1 be the leading and the trailing 32-bit words of
+ a floating point number x (in IEEE double format) respectively
+ (see section A). By performing shifs and subtracts on x0 and y0,
+ we obtain a 7.8-bit approximation of 1/sqrt(x) as follows.
+
+ k := 0x5fe80000 - (x0>>1);
+ y0:= k - T2[63&(k>>14)]. ... y ~ 1/sqrt(x) to 7.8 bits
+
+ Here k is a 32-bit integer and T2[] is an integer array
+ containing correction terms. Now magically the floating
+ value of y (y's leading 32-bit word is y0, the value of
+ its trailing word y1 is set to zero) approximates 1/sqrt(x)
+ to almost 7.8-bit.
+
+ Value of T2:
+ static int T2[64]= {
+ 0x1500, 0x2ef8, 0x4d67, 0x6b02, 0x87be, 0xa395, 0xbe7a, 0xd866,
+ 0xf14a, 0x1091b,0x11fcd,0x13552,0x14999,0x15c98,0x16e34,0x17e5f,
+ 0x18d03,0x19a01,0x1a545,0x1ae8a,0x1b5c4,0x1bb01,0x1bfde,0x1c28d,
+ 0x1c2de,0x1c0db,0x1ba73,0x1b11c,0x1a4b5,0x1953d,0x18266,0x16be0,
+ 0x1683e,0x179d8,0x18a4d,0x19992,0x1a789,0x1b445,0x1bf61,0x1c989,
+ 0x1d16d,0x1d77b,0x1dddf,0x1e2ad,0x1e5bf,0x1e6e8,0x1e654,0x1e3cd,
+ 0x1df2a,0x1d635,0x1cb16,0x1be2c,0x1ae4e,0x19bde,0x1868e,0x16e2e,
+ 0x1527f,0x1334a,0x11051,0xe951, 0xbe01, 0x8e0d, 0x5924, 0x1edd,};
+
+ (2) Iterative refinement
+
+ Apply Reciproot iteration three times to y and multiply the
+ result by x to get an approximation z that matches sqrt(x)
+ to about 1 ulp. To be exact, we will have
+ -1ulp < sqrt(x)-z<1.0625ulp.
+
+ ... set rounding mode to Round-to-nearest
+ y := y*(1.5-0.5*x*y*y) ... almost 15 sig. bits to 1/sqrt(x)
+ y := y*((1.5-2^-30)+0.5*x*y*y)... about 29 sig. bits to 1/sqrt(x)
+ ... special arrangement for better accuracy
+ z := x*y ... 29 bits to sqrt(x), with z*y<1
+ z := z + 0.5*z*(1-z*y) ... about 1 ulp to sqrt(x)
+
+ Remark 2. The constant 1.5-2^-30 is chosen to bias the error so that
+ (a) the term z*y in the final iteration is always less than 1;
+ (b) the error in the final result is biased upward so that
+ -1 ulp < sqrt(x) - z < 1.0625 ulp
+ instead of |sqrt(x)-z|<1.03125ulp.
+
+ (3) Final adjustment
+
+ By twiddling y's last bit it is possible to force y to be
+ correctly rounded according to the prevailing rounding mode
+ as follows. Let r and i be copies of the rounding mode and
+ inexact flag before entering the square root program. Also we
+ use the expression y+-ulp for the next representable floating
+ numbers (up and down) of y. Note that y+-ulp = either fixed
+ point y+-1, or multiply y by nextafter(1,+-inf) in chopped
+ mode.
+
+ R := RZ; ... set rounding mode to round-toward-zero
+ switch(r) {
+ case RN: ... round-to-nearest
+ if(x<= z*(z-ulp)...chopped) z = z - ulp; else
+ if(x<= z*(z+ulp)...chopped) z = z; else z = z+ulp;
+ break;
+ case RZ:case RM: ... round-to-zero or round-to--inf
+ R:=RP; ... reset rounding mod to round-to-+inf
+ if(x<z*z ... rounded up) z = z - ulp; else
+ if(x>=(z+ulp)*(z+ulp) ...rounded up) z = z+ulp;
+ break;
+ case RP: ... round-to-+inf
+ if(x>(z+ulp)*(z+ulp)...chopped) z = z+2*ulp; else
+ if(x>z*z ...chopped) z = z+ulp;
+ break;
+ }
+
+ Remark 3. The above comparisons can be done in fixed point. For
+ example, to compare x and w=z*z chopped, it suffices to compare
+ x1 and w1 (the trailing parts of x and w), regarding them as
+ two's complement integers.
+
+ ...Is z an exact square root?
+ To determine whether z is an exact square root of x, let z1 be the
+ trailing part of z, and also let x0 and x1 be the leading and
+ trailing parts of x.
+
+ If ((z1&0x03ffffff)!=0) ... not exact if trailing 26 bits of z!=0
+ I := 1; ... Raise Inexact flag: z is not exact
+ else {
+ j := 1 - [(x0>>20)&1] ... j = logb(x) mod 2
+ k := z1 >> 26; ... get z's 25-th and 26-th
+ fraction bits
+ I := i or (k&j) or ((k&(j+j+1))!=(x1&3));
+ }
+ R:= r ... restore rounded mode
+ return sqrt(x):=z.
+
+ If multiplication is cheaper then the foregoing red tape, the
+ Inexact flag can be evaluated by
+
+ I := i;
+ I := (z*z!=x) or I.
+
+ Note that z*z can overwrite I; this value must be sensed if it is
+ True.
+
+ Remark 4. If z*z = x exactly, then bit 25 to bit 0 of z1 must be
+ zero.
+
+ --------------------
+ z1: | f2 |
+ --------------------
+ bit 31 bit 0
+
+ Further more, bit 27 and 26 of z1, bit 0 and 1 of x1, and the odd
+ or even of logb(x) have the following relations:
+
+ -------------------------------------------------
+ bit 27,26 of z1 bit 1,0 of x1 logb(x)
+ -------------------------------------------------
+ 00 00 odd and even
+ 01 01 even
+ 10 10 odd
+ 10 00 even
+ 11 01 even
+ -------------------------------------------------
+
+ (4) Special cases (see (4) of Section A).
+
+ */
+
diff --git a/libmath/fdlibm/fdlibm.h b/libmath/fdlibm/fdlibm.h
new file mode 100644
index 00000000..9bf0727f
--- /dev/null
+++ b/libmath/fdlibm/fdlibm.h
@@ -0,0 +1,153 @@
+/* derived from /netlib/fdlibm */
+#include "lib9.h"
+
+/* @(#)fdlibm.h 1.5 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+
+#ifdef __LITTLE_ENDIAN
+#define __HI(x) *(1+(int*)&x)
+#define __LO(x) *(int*)&x
+#define __HIp(x) *(1+(int*)x)
+#define __LOp(x) *(int*)x
+#else
+#define __HI(x) *(int*)&x
+#define __LO(x) *(1+(int*)&x)
+#define __HIp(x) *(int*)x
+#define __LOp(x) *(1+(int*)x)
+#endif
+
+/* Many GNU includes use the same define */
+#ifndef __P
+#define __P(p) p
+#endif
+
+/*
+ * ANSI/POSIX
+ */
+
+/*
+ * ANSI/POSIX
+ */
+extern double acos __P((double));
+extern double asin __P((double));
+extern double atan __P((double));
+extern double atan2 __P((double, double));
+extern double cos __P((double));
+extern double sin __P((double));
+extern double tan __P((double));
+
+extern double cosh __P((double));
+extern double sinh __P((double));
+extern double tanh __P((double));
+
+extern double exp __P((double));
+extern double frexp __P((double, int *));
+extern double ldexp __P((double, int));
+extern double log __P((double));
+extern double log10 __P((double));
+extern double modf __P((double, double *));
+
+extern double pow __P((double, double));
+extern double sqrt __P((double));
+
+extern double ceil __P((double));
+extern double fabs __P((double));
+extern double floor __P((double));
+extern double fmod __P((double, double));
+
+extern double erf __P((double));
+extern double erfc __P((double));
+extern double gamma __P((double));
+extern double hypot __P((double, double));
+extern int isnan __P((double));
+extern int finite __P((double));
+extern double j0 __P((double));
+extern double j1 __P((double));
+extern double jn __P((int, double));
+extern double lgamma __P((double));
+extern double y0 __P((double));
+extern double y1 __P((double));
+extern double yn __P((int, double));
+
+extern double acosh __P((double));
+extern double asinh __P((double));
+extern double atanh __P((double));
+extern double cbrt __P((double));
+extern double logb __P((double));
+extern double nextafter __P((double, double));
+extern double remainder __P((double, double));
+extern double scalb __P((double, double));
+
+/*
+ * IEEE Test Vector
+ */
+extern double significand __P((double));
+
+/*
+ * Functions callable from C, intended to support IEEE arithmetic.
+ */
+extern double copysign __P((double, double));
+extern int ilogb __P((double));
+extern double rint __P((double));
+extern double scalbn __P((double, int));
+
+/*
+ * BSD math library entry points
+ */
+extern double expm1 __P((double));
+extern double log1p __P((double));
+
+/*
+ * Reentrant version of gamma & lgamma; passes signgam back by reference
+ * as the second argument; user must allocate space for signgam.
+ */
+#ifdef _REENTRANT
+extern double gamma_r __P((double, int *));
+extern double lgamma_r __P((double, int *));
+#endif /* _REENTRANT */
+
+/* ieee style elementary functions */
+extern double __ieee754_sqrt __P((double));
+extern double __ieee754_acos __P((double));
+extern double __ieee754_acosh __P((double));
+extern double __ieee754_log __P((double));
+extern double __ieee754_atanh __P((double));
+extern double __ieee754_asin __P((double));
+extern double __ieee754_atan2 __P((double,double));
+extern double __ieee754_exp __P((double));
+extern double __ieee754_cosh __P((double));
+extern double __ieee754_fmod __P((double,double));
+extern double __ieee754_pow __P((double,double));
+extern double __ieee754_lgamma_r __P((double,int *));
+extern double __ieee754_gamma_r __P((double,int *));
+extern double __ieee754_lgamma __P((double));
+extern double __ieee754_gamma __P((double));
+extern double __ieee754_log10 __P((double));
+extern double __ieee754_sinh __P((double));
+extern double __ieee754_hypot __P((double,double));
+extern double __ieee754_j0 __P((double));
+extern double __ieee754_j1 __P((double));
+extern double __ieee754_y0 __P((double));
+extern double __ieee754_y1 __P((double));
+extern double __ieee754_jn __P((int,double));
+extern double __ieee754_yn __P((int,double));
+extern double __ieee754_remainder __P((double,double));
+extern int __ieee754_rem_pio2 __P((double,double*));
+extern double __ieee754_scalb __P((double,int));
+
+/* fdlibm kernel function */
+extern double __kernel_standard __P((double,double,int));
+extern double __kernel_sin __P((double,double,int));
+extern double __kernel_cos __P((double,double));
+extern double __kernel_tan __P((double,double,int));
+extern int __kernel_rem_pio2 __P((double*,double*,int,int,int,const int*));
diff --git a/libmath/fdlibm/k_cos.c b/libmath/fdlibm/k_cos.c
new file mode 100644
index 00000000..b7cec106
--- /dev/null
+++ b/libmath/fdlibm/k_cos.c
@@ -0,0 +1,84 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)k_cos.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * __kernel_cos( x, y )
+ * kernel cos function on [-pi/4, pi/4], pi/4 ~ 0.785398164
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ *
+ * Algorithm
+ * 1. Since cos(-x) = cos(x), we need only to consider positive x.
+ * 2. if x < 2^-27 (hx<0x3e400000 0), return 1 with inexact if x!=0.
+ * 3. cos(x) is approximated by a polynomial of degree 14 on
+ * [0,pi/4]
+ * 4 14
+ * cos(x) ~ 1 - x*x/2 + C1*x + ... + C6*x
+ * where the remez error is
+ *
+ * | 2 4 6 8 10 12 14 | -58
+ * |cos(x)-(1-.5*x +C1*x +C2*x +C3*x +C4*x +C5*x +C6*x )| <= 2
+ * | |
+ *
+ * 4 6 8 10 12 14
+ * 4. let r = C1*x +C2*x +C3*x +C4*x +C5*x +C6*x , then
+ * cos(x) = 1 - x*x/2 + r
+ * since cos(x+y) ~ cos(x) - sin(x)*y
+ * ~ cos(x) - x*y,
+ * a correction term is necessary in cos(x) and hence
+ * cos(x+y) = 1 - (x*x/2 - (r - x*y))
+ * For better accuracy when x > 0.3, let qx = |x|/4 with
+ * the last 32 bits mask off, and if x > 0.78125, let qx = 0.28125.
+ * Then
+ * cos(x+y) = (1-qx) - ((x*x/2-qx) - (r-x*y)).
+ * Note that 1-qx and (x*x/2-qx) is EXACT here, and the
+ * magnitude of the latter is at least a quarter of x*x/2,
+ * thus, reducing the rounding error in the subtraction.
+ */
+
+#include "fdlibm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+C1 = 4.16666666666666019037e-02, /* 0x3FA55555, 0x5555554C */
+C2 = -1.38888888888741095749e-03, /* 0xBF56C16C, 0x16C15177 */
+C3 = 2.48015872894767294178e-05, /* 0x3EFA01A0, 0x19CB1590 */
+C4 = -2.75573143513906633035e-07, /* 0xBE927E4F, 0x809C52AD */
+C5 = 2.08757232129817482790e-09, /* 0x3E21EE9E, 0xBDB4B1C4 */
+C6 = -1.13596475577881948265e-11; /* 0xBDA8FAE9, 0xBE8838D4 */
+
+ double __kernel_cos(double x, double y)
+{
+ double a,hz,z,r,qx;
+ int ix;
+ ix = __HI(x)&0x7fffffff; /* ix = |x|'s high word*/
+ if(ix<0x3e400000) { /* if x < 2**27 */
+ if(((int)x)==0) return one; /* generate inexact */
+ }
+ z = x*x;
+ r = z*(C1+z*(C2+z*(C3+z*(C4+z*(C5+z*C6)))));
+ if(ix < 0x3FD33333) /* if |x| < 0.3 */
+ return one - (0.5*z - (z*r - x*y));
+ else {
+ if(ix > 0x3fe90000) { /* x > 0.78125 */
+ qx = 0.28125;
+ } else {
+ __HI(qx) = ix-0x00200000; /* x/4 */
+ __LO(qx) = 0;
+ }
+ hz = 0.5*z-qx;
+ a = one-qx;
+ return a - (hz - (z*r-x*y));
+ }
+}
diff --git a/libmath/fdlibm/k_rem_pio2.c b/libmath/fdlibm/k_rem_pio2.c
new file mode 100644
index 00000000..40e52398
--- /dev/null
+++ b/libmath/fdlibm/k_rem_pio2.c
@@ -0,0 +1,300 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)k_rem_pio2.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * __kernel_rem_pio2(x,y,e0,nx,prec,ipio2)
+ * double x[],y[]; int e0,nx,prec; int ipio2[];
+ *
+ * __kernel_rem_pio2 return the last three digits of N with
+ * y = x - N*pi/2
+ * so that |y| < pi/2.
+ *
+ * The method is to compute the integer (mod 8) and fraction parts of
+ * (2/pi)*x without doing the full multiplication. In general we
+ * skip the part of the product that are known to be a Huge integer (
+ * more accurately, = 0 mod 8 ). Thus the number of operations are
+ * independent of the exponent of the input.
+ *
+ * (2/pi) is represented by an array of 24-bit integers in ipio2[].
+ *
+ * Input parameters:
+ * x[] The input value (must be positive) is broken into nx
+ * pieces of 24-bit integers in double precision format.
+ * x[i] will be the i-th 24 bit of x. The scaled exponent
+ * of x[0] is given in input parameter e0 (i.e., x[0]*2^e0
+ * match x's up to 24 bits.
+ *
+ * Example of breaking a double positive z into x[0]+x[1]+x[2]:
+ * e0 = ilogb(z)-23
+ * z = scalbn(z,-e0)
+ * for i = 0,1,2
+ * x[i] = floor(z)
+ * z = (z-x[i])*2**24
+ *
+ *
+ * y[] ouput result in an array of double precision numbers.
+ * The dimension of y[] is:
+ * 24-bit precision 1
+ * 53-bit precision 2
+ * 64-bit precision 2
+ * 113-bit precision 3
+ * The actual value is the sum of them. Thus for 113-bit
+ * precison, one may have to do something like:
+ *
+ * long double t,w,r_head, r_tail;
+ * t = (long double)y[2] + (long double)y[1];
+ * w = (long double)y[0];
+ * r_head = t+w;
+ * r_tail = w - (r_head - t);
+ *
+ * e0 The exponent of x[0]
+ *
+ * nx dimension of x[]
+ *
+ * prec an integer indicating the precision:
+ * 0 24 bits (single)
+ * 1 53 bits (double)
+ * 2 64 bits (extended)
+ * 3 113 bits (quad)
+ *
+ * ipio2[]
+ * integer array, contains the (24*i)-th to (24*i+23)-th
+ * bit of 2/pi after binary point. The corresponding
+ * floating value is
+ *
+ * ipio2[i] * 2^(-24(i+1)).
+ *
+ * External function:
+ * double scalbn(), floor();
+ *
+ *
+ * Here is the description of some local variables:
+ *
+ * jk jk+1 is the initial number of terms of ipio2[] needed
+ * in the computation. The recommended value is 2,3,4,
+ * 6 for single, double, extended,and quad.
+ *
+ * jz local integer variable indicating the number of
+ * terms of ipio2[] used.
+ *
+ * jx nx - 1
+ *
+ * jv index for pointing to the suitable ipio2[] for the
+ * computation. In general, we want
+ * ( 2^e0*x[0] * ipio2[jv-1]*2^(-24jv) )/8
+ * is an integer. Thus
+ * e0-3-24*jv >= 0 or (e0-3)/24 >= jv
+ * Hence jv = max(0,(e0-3)/24).
+ *
+ * jp jp+1 is the number of terms in PIo2[] needed, jp = jk.
+ *
+ * q[] double array with integral value, representing the
+ * 24-bits chunk of the product of x and 2/pi.
+ *
+ * q0 the corresponding exponent of q[0]. Note that the
+ * exponent for q[i] would be q0-24*i.
+ *
+ * PIo2[] double precision array, obtained by cutting pi/2
+ * into 24 bits chunks.
+ *
+ * f[] ipio2[] in floating point
+ *
+ * iq[] integer array by breaking up q[] in 24-bits chunk.
+ *
+ * fq[] final product of x*(2/pi) in fq[0],..,fq[jk]
+ *
+ * ih integer. If >0 it indicates q[] is >= 0.5, hence
+ * it also indicates the *sign* of the result.
+ *
+ */
+
+
+/*
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const int init_jk[] = {2,3,4,6}; /* initial value for jk */
+
+static const double PIo2[] = {
+ 1.57079625129699707031e+00, /* 0x3FF921FB, 0x40000000 */
+ 7.54978941586159635335e-08, /* 0x3E74442D, 0x00000000 */
+ 5.39030252995776476554e-15, /* 0x3CF84698, 0x80000000 */
+ 3.28200341580791294123e-22, /* 0x3B78CC51, 0x60000000 */
+ 1.27065575308067607349e-29, /* 0x39F01B83, 0x80000000 */
+ 1.22933308981111328932e-36, /* 0x387A2520, 0x40000000 */
+ 2.73370053816464559624e-44, /* 0x36E38222, 0x80000000 */
+ 2.16741683877804819444e-51, /* 0x3569F31D, 0x00000000 */
+};
+
+static const double
+zero = 0.0,
+one = 1.0,
+two24 = 1.67772160000000000000e+07, /* 0x41700000, 0x00000000 */
+twon24 = 5.96046447753906250000e-08; /* 0x3E700000, 0x00000000 */
+
+ int __kernel_rem_pio2(double *x, double *y, int e0, int nx, int prec, const int *ipio2)
+{
+ int jz,jx,jv,jp,jk,carry,n,iq[20],i,j,k,m,q0,ih;
+ double z,fw,f[20],fq[20],q[20];
+
+ /* initialize jk*/
+ jk = init_jk[prec];
+ jp = jk;
+
+ /* determine jx,jv,q0, note that 3>q0 */
+ jx = nx-1;
+ jv = (e0-3)/24; if(jv<0) jv=0;
+ q0 = e0-24*(jv+1);
+
+ /* set up f[0] to f[jx+jk] where f[jx+jk] = ipio2[jv+jk] */
+ j = jv-jx; m = jx+jk;
+ for(i=0;i<=m;i++,j++) f[i] = (j<0)? zero : (double) ipio2[j];
+
+ /* compute q[0],q[1],...q[jk] */
+ for (i=0;i<=jk;i++) {
+ for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j]; q[i] = fw;
+ }
+
+ jz = jk;
+recompute:
+ /* distill q[] into iq[] reversingly */
+ for(i=0,j=jz,z=q[jz];j>0;i++,j--) {
+ fw = (double)((int)(twon24* z));
+ iq[i] = (int)(z-two24*fw);
+ z = q[j-1]+fw;
+ }
+
+ /* compute n */
+ z = scalbn(z,q0); /* actual value of z */
+ z -= 8.0*floor(z*0.125); /* trim off integer >= 8 */
+ n = (int) z;
+ z -= (double)n;
+ ih = 0;
+ if(q0>0) { /* need iq[jz-1] to determine n */
+ i = (iq[jz-1]>>(24-q0)); n += i;
+ iq[jz-1] -= i<<(24-q0);
+ ih = iq[jz-1]>>(23-q0);
+ }
+ else if(q0==0) ih = iq[jz-1]>>23;
+ else if(z>=0.5) ih=2;
+
+ if(ih>0) { /* q > 0.5 */
+ n += 1; carry = 0;
+ for(i=0;i<jz ;i++) { /* compute 1-q */
+ j = iq[i];
+ if(carry==0) {
+ if(j!=0) {
+ carry = 1; iq[i] = 0x1000000- j;
+ }
+ } else iq[i] = 0xffffff - j;
+ }
+ if(q0>0) { /* rare case: chance is 1 in 12 */
+ switch(q0) {
+ case 1:
+ iq[jz-1] &= 0x7fffff; break;
+ case 2:
+ iq[jz-1] &= 0x3fffff; break;
+ }
+ }
+ if(ih==2) {
+ z = one - z;
+ if(carry!=0) z -= scalbn(one,q0);
+ }
+ }
+
+ /* check if recomputation is needed */
+ if(z==zero) {
+ j = 0;
+ for (i=jz-1;i>=jk;i--) j |= iq[i];
+ if(j==0) { /* need recomputation */
+ for(k=1;iq[jk-k]==0;k++); /* k = no. of terms needed */
+
+ for(i=jz+1;i<=jz+k;i++) { /* add q[jz+1] to q[jz+k] */
+ f[jx+i] = (double) ipio2[jv+i];
+ for(j=0,fw=0.0;j<=jx;j++) fw += x[j]*f[jx+i-j];
+ q[i] = fw;
+ }
+ jz += k;
+ goto recompute;
+ }
+ }
+
+ /* chop off zero terms */
+ if(z==0.0) {
+ jz -= 1; q0 -= 24;
+ while(iq[jz]==0) { jz--; q0-=24;}
+ } else { /* break z into 24-bit if necessary */
+ z = scalbn(z,-q0);
+ if(z>=two24) {
+ fw = (double)((int)(twon24*z));
+ iq[jz] = (int)(z-two24*fw);
+ jz += 1; q0 += 24;
+ iq[jz] = (int) fw;
+ } else iq[jz] = (int) z ;
+ }
+
+ /* convert integer "bit" chunk to floating-point value */
+ fw = scalbn(one,q0);
+ for(i=jz;i>=0;i--) {
+ q[i] = fw*(double)iq[i]; fw*=twon24;
+ }
+
+ /* compute PIo2[0,...,jp]*q[jz,...,0] */
+ for(i=jz;i>=0;i--) {
+ for(fw=0.0,k=0;k<=jp&&k<=jz-i;k++) fw += PIo2[k]*q[i+k];
+ fq[jz-i] = fw;
+ }
+
+ /* compress fq[] into y[] */
+ switch(prec) {
+ case 0:
+ fw = 0.0;
+ for (i=jz;i>=0;i--) fw += fq[i];
+ y[0] = (ih==0)? fw: -fw;
+ break;
+ case 1:
+ case 2:
+ fw = 0.0;
+ for (i=jz;i>=0;i--) fw += fq[i];
+ y[0] = (ih==0)? fw: -fw;
+ fw = fq[0]-fw;
+ for (i=1;i<=jz;i++) fw += fq[i];
+ y[1] = (ih==0)? fw: -fw;
+ break;
+ case 3: /* painful */
+ for (i=jz;i>0;i--) {
+ fw = fq[i-1]+fq[i];
+ fq[i] += fq[i-1]-fw;
+ fq[i-1] = fw;
+ }
+ for (i=jz;i>1;i--) {
+ fw = fq[i-1]+fq[i];
+ fq[i] += fq[i-1]-fw;
+ fq[i-1] = fw;
+ }
+ for (fw=0.0,i=jz;i>=2;i--) fw += fq[i];
+ if(ih==0) {
+ y[0] = fq[0]; y[1] = fq[1]; y[2] = fw;
+ } else {
+ y[0] = -fq[0]; y[1] = -fq[1]; y[2] = -fw;
+ }
+ }
+ return n&7;
+}
diff --git a/libmath/fdlibm/k_sin.c b/libmath/fdlibm/k_sin.c
new file mode 100644
index 00000000..bf914522
--- /dev/null
+++ b/libmath/fdlibm/k_sin.c
@@ -0,0 +1,66 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)k_sin.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __kernel_sin( x, y, iy)
+ * kernel sin function on [-pi/4, pi/4], pi/4 ~ 0.7854
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ * Input iy indicates whether y is 0. (if iy=0, y assume to be 0).
+ *
+ * Algorithm
+ * 1. Since sin(-x) = -sin(x), we need only to consider positive x.
+ * 2. if x < 2^-27 (hx<0x3e400000 0), return x with inexact if x!=0.
+ * 3. sin(x) is approximated by a polynomial of degree 13 on
+ * [0,pi/4]
+ * 3 13
+ * sin(x) ~ x + S1*x + ... + S6*x
+ * where
+ *
+ * |sin(x) 2 4 6 8 10 12 | -58
+ * |----- - (1+S1*x +S2*x +S3*x +S4*x +S5*x +S6*x )| <= 2
+ * | x |
+ *
+ * 4. sin(x+y) = sin(x) + sin'(x')*y
+ * ~ sin(x) + (1-x*x/2)*y
+ * For better accuracy, let
+ * 3 2 2 2 2
+ * r = x *(S2+x *(S3+x *(S4+x *(S5+x *S6))))
+ * then 3 2
+ * sin(x) = x + (S1*x + (x *(r-y/2)+y))
+ */
+
+#include "fdlibm.h"
+
+static const double
+half = 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+S1 = -1.66666666666666324348e-01, /* 0xBFC55555, 0x55555549 */
+S2 = 8.33333333332248946124e-03, /* 0x3F811111, 0x1110F8A6 */
+S3 = -1.98412698298579493134e-04, /* 0xBF2A01A0, 0x19C161D5 */
+S4 = 2.75573137070700676789e-06, /* 0x3EC71DE3, 0x57B1FE7D */
+S5 = -2.50507602534068634195e-08, /* 0xBE5AE5E6, 0x8A2B9CEB */
+S6 = 1.58969099521155010221e-10; /* 0x3DE5D93A, 0x5ACFD57C */
+
+ double __kernel_sin(double x, double y, int iy)
+{
+ double z,r,v;
+ int ix;
+ ix = __HI(x)&0x7fffffff; /* high word of x */
+ if(ix<0x3e400000) /* |x| < 2**-27 */
+ {if((int)x==0) return x;} /* generate inexact */
+ z = x*x;
+ v = z*x;
+ r = S2+z*(S3+z*(S4+z*(S5+z*S6)));
+ if(iy==0) return x+v*(S1+z*r);
+ else return x-((z*(half*y-v*r)-y)-v*S1);
+}
diff --git a/libmath/fdlibm/k_tan.c b/libmath/fdlibm/k_tan.c
new file mode 100644
index 00000000..7c4ba796
--- /dev/null
+++ b/libmath/fdlibm/k_tan.c
@@ -0,0 +1,117 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)k_tan.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* __kernel_tan( x, y, k )
+ * kernel tan function on [-pi/4, pi/4], pi/4 ~ 0.7854
+ * Input x is assumed to be bounded by ~pi/4 in magnitude.
+ * Input y is the tail of x.
+ * Input k indicates whether tan (if k=1) or
+ * -1/tan (if k= -1) is returned.
+ *
+ * Algorithm
+ * 1. Since tan(-x) = -tan(x), we need only to consider positive x.
+ * 2. if x < 2^-28 (hx<0x3e300000 0), return x with inexact if x!=0.
+ * 3. tan(x) is approximated by a odd polynomial of degree 27 on
+ * [0,0.67434]
+ * 3 27
+ * tan(x) ~ x + T1*x + ... + T13*x
+ * where
+ *
+ * |tan(x) 2 4 26 | -59.2
+ * |----- - (1+T1*x +T2*x +.... +T13*x )| <= 2
+ * | x |
+ *
+ * Note: tan(x+y) = tan(x) + tan'(x)*y
+ * ~ tan(x) + (1+x*x)*y
+ * Therefore, for better accuracy in computing tan(x+y), let
+ * 3 2 2 2 2
+ * r = x *(T2+x *(T3+x *(...+x *(T12+x *T13))))
+ * then
+ * 3 2
+ * tan(x+y) = x + (T1*x + (x *(r+y)+y))
+ *
+ * 4. For x in [0.67434,pi/4], let y = pi/4 - x, then
+ * tan(x) = tan(pi/4-y) = (1-tan(y))/(1+tan(y))
+ * = 1 - 2*(tan(y) - (tan(y)^2)/(1+tan(y)))
+ */
+
+#include "fdlibm.h"
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+pio4 = 7.85398163397448278999e-01, /* 0x3FE921FB, 0x54442D18 */
+pio4lo= 3.06161699786838301793e-17, /* 0x3C81A626, 0x33145C07 */
+T[] = {
+ 3.33333333333334091986e-01, /* 0x3FD55555, 0x55555563 */
+ 1.33333333333201242699e-01, /* 0x3FC11111, 0x1110FE7A */
+ 5.39682539762260521377e-02, /* 0x3FABA1BA, 0x1BB341FE */
+ 2.18694882948595424599e-02, /* 0x3F9664F4, 0x8406D637 */
+ 8.86323982359930005737e-03, /* 0x3F8226E3, 0xE96E8493 */
+ 3.59207910759131235356e-03, /* 0x3F6D6D22, 0xC9560328 */
+ 1.45620945432529025516e-03, /* 0x3F57DBC8, 0xFEE08315 */
+ 5.88041240820264096874e-04, /* 0x3F4344D8, 0xF2F26501 */
+ 2.46463134818469906812e-04, /* 0x3F3026F7, 0x1A8D1068 */
+ 7.81794442939557092300e-05, /* 0x3F147E88, 0xA03792A6 */
+ 7.14072491382608190305e-05, /* 0x3F12B80F, 0x32F0A7E9 */
+ -1.85586374855275456654e-05, /* 0xBEF375CB, 0xDB605373 */
+ 2.59073051863633712884e-05, /* 0x3EFB2A70, 0x74BF7AD4 */
+};
+
+ double __kernel_tan(double x, double y, int iy)
+{
+ double z,r,v,w,s;
+ int ix,hx;
+ hx = __HI(x); /* high word of x */
+ ix = hx&0x7fffffff; /* high word of |x| */
+ if(ix<0x3e300000) /* x < 2**-28 */
+ {if((int)x==0) { /* generate inexact */
+ if(((ix|__LO(x))|(iy+1))==0) return one/fabs(x);
+ else return (iy==1)? x: -one/x;
+ }
+ }
+ if(ix>=0x3FE59428) { /* |x|>=0.6744 */
+ if(hx<0) {x = -x; y = -y;}
+ z = pio4-x;
+ w = pio4lo-y;
+ x = z+w; y = 0.0;
+ }
+ z = x*x;
+ w = z*z;
+ /* Break x^5*(T[1]+x^2*T[2]+...) into
+ * x^5(T[1]+x^4*T[3]+...+x^20*T[11]) +
+ * x^5(x^2*(T[2]+x^4*T[4]+...+x^22*[T12]))
+ */
+ r = T[1]+w*(T[3]+w*(T[5]+w*(T[7]+w*(T[9]+w*T[11]))));
+ v = z*(T[2]+w*(T[4]+w*(T[6]+w*(T[8]+w*(T[10]+w*T[12])))));
+ s = z*x;
+ r = y + z*(s*(r+v)+y);
+ r += T[0]*s;
+ w = x+r;
+ if(ix>=0x3FE59428) {
+ v = (double)iy;
+ return (double)(1-((hx>>30)&2))*(v-2.0*(x-(w*w/(w+v)-r)));
+ }
+ if(iy==1) return w;
+ else { /* if allow error up to 2 ulp,
+ simply return -1.0/(x+r) here */
+ /* compute -1.0/(x+r) accurately */
+ double a,t;
+ z = w;
+ __LO(z) = 0;
+ v = r-(z - x); /* z+v = r+x */
+ t = a = -1.0/w; /* a = -1.0/w */
+ __LO(t) = 0;
+ s = 1.0+t*z;
+ return t+a*(s+t*v);
+ }
+}
diff --git a/libmath/fdlibm/readme b/libmath/fdlibm/readme
new file mode 100644
index 00000000..91ae0c97
--- /dev/null
+++ b/libmath/fdlibm/readme
@@ -0,0 +1,261 @@
+
+ ********************************
+ * Announcing FDLIBM Version 5 *
+ ********************************
+============================================================
+ FDLIBM
+============================================================
+ (developed at SunSoft, a Sun Microsystems, Inc. business.)
+
+What's new in FDLIBM 5.2?
+BUGS FIXED
+ 1. Little endian bug in frexp (affect only little endian machine):
+ in file s_frexp.c, last line of program frexp before exit
+ *(int*)&x = hx;
+ should read
+ *(n0+(int*)&x) = hx;
+
+ 2. jn(-1,x) is three times larger that the actual answer:
+ in file e_jn.c, the line
+ sign = 1 - ((n&1)<<2);
+ should read
+ sign = 1 - ((n&1)<<1);
+
+ 3. Compiler failure on non-standard code
+ J.T. Conklin found that gcc optimizing out the manipulation of doubles
+ via pointer bashing of the form
+ double x = 0;
+ *(((int*)&x)+n0)=0x7fff0000;
+ foo(x);
+ C experts confirmed that the behavior of *(((int*)&x)+n0)=0x7fff0000
+ is undefined. By replacing n0 with a constant 0 or 1, the GCC "knows"
+ that the assignment is modifying the double, and "does the right thing."
+ Thus, in FDLIBM 5.2, we replace n0 with a constant and use a macro
+ __HI() and __LO() with #ifdef __LITTLE_ENDIAN to avoid the above problem.
+
+ 4. Performance issue on rem_pio2
+ An attempt to speed up the argument reduction in the trig function is the
+ consider pi/4 < x < 3pi/4 a special case. This was done in the file
+ e_rem_pio2.c
+
+
+FDLIBM (Freely Distributable LIBM) is a C math library
+for machines that support IEEE 754 floating-point arithmetic.
+In this release, only double precision is supported.
+
+FDLIBM is intended to provide a reasonably portable (see
+assumptions below), reference quality (below one ulp for
+major functions like sin,cos,exp,log) math library
+(libm.a). For a copy of FDLIBM, please send a message "send index from fdlibm"
+to netlib@research.att.com.
+
+--------------
+1. ASSUMPTIONS
+--------------
+FDLIBM (double precision version) assumes:
+ a. IEEE 754 style (if not precise compliance) arithmetic;
+ b. 32 bit 2's complement integer arithmetic;
+ c. Each double precision floating-point number must be in IEEE 754
+ double format, and that each number can be retrieved as two 32-bit
+ integers through the using of pointer bashing as in the example
+ below:
+
+ Example: let y = 2.0
+ double fp number y: 2.0
+ IEEE double format: 0x4000000000000000
+
+ Referencing y as two integers:
+ *(int*)&y,*(1+(int*)&y) = {0x40000000,0x0} (on sparc)
+ {0x0,0x40000000} (on 386)
+
+ Note: Four macros are defined in fdlibm.h to handle this kind of
+ retrieving:
+
+ __HI(x) the high part of a double x
+ (sign,exponent,the first 21 significant bits)
+ __LO(x) the least 32 significant bits of x
+ __HIp(x) same as __HI except that the argument is a pointer
+ to a double
+ __LOp(x) same as __LO except that the argument is a pointer
+ to a double
+
+ To ensure obtaining correct ordering, one must define __LITTLE_ENDIAN
+ during compilation for little endian machine (like 386,486). The
+ default is big endian.
+
+ If the behavior of pointer bashing is undefined, one may hack on the
+ macro in fdlibm.h.
+
+ d. IEEE exceptions may trigger "signals" as is common in Unix
+ implementations.
+
+-------------------
+2. EXCEPTION CASES
+-------------------
+All exception cases in the FDLIBM functions will be mapped
+to one of the following four exceptions:
+
+ +-huge*huge, +-tiny*tiny, +-1.0/0.0, +-0.0/0.0
+ (overflow) (underflow) (divided-by-zero) (invalid)
+
+For example, log(0) is a singularity and is thus mapped to
+ -1.0/0.0 = -infinity.
+That is, FDLIBM's log will compute -one/zero and return the
+computed value. On an IEEE machine, this will trigger the
+divided-by-zero exception and a negative infinity is returned by
+default.
+
+Similarly, exp(-huge) will be mapped to tiny*tiny to generate
+an underflow signal.
+
+
+--------------------------------
+3. STANDARD CONFORMANCE WRAPPER
+--------------------------------
+The default FDLIBM functions (compiled with -D_IEEE_LIBM flag)
+are in "IEEE spirit" (i.e., return the most reasonable result in
+floating-point arithmetic). If one wants FDLIBM to comply with
+standards like SVID, X/OPEN, or POSIX/ANSI, then one can
+create a multi-standard compliant FDLIBM. In this case, each
+function in FDLIBM is actually a standard compliant wrapper
+function.
+
+File organization:
+ 1. For FDLIBM's kernel (internal) function,
+ File name Entry point
+ ---------------------------
+ k_sin.c __kernel_sin
+ k_tan.c __kernel_tan
+ ---------------------------
+ 2. For functions that have no standards conflict
+ File name Entry point
+ ---------------------------
+ s_sin.c sin
+ s_erf.c erf
+ ---------------------------
+ 3. Ieee754 core functions
+ File name Entry point
+ ---------------------------
+ e_exp.c __ieee754_exp
+ e_sinh.c __ieee754_sinh
+ ---------------------------
+ 4. Wrapper functions
+ File name Entry point
+ ---------------------------
+ w_exp.c exp
+ w_sinh.c sinh
+ ---------------------------
+
+Wrapper functions will twist the result of the ieee754
+function to comply to the standard specified by the value
+of _LIB_VERSION
+ if _LIB_VERSION = _IEEE_, return the ieee754 result;
+ if _LIB_VERSION = _SVID_, return SVID result;
+ if _LIB_VERSION = _XOPEN_, return XOPEN result;
+ if _LIB_VERSION = _POSIX_, return POSIX/ANSI result.
+(These are macros, see fdlibm.h for their definition.)
+
+
+--------------------------------
+4. HOW TO CREATE FDLIBM's libm.a
+--------------------------------
+There are two types of libm.a. One is IEEE only, and the other is
+multi-standard compliant (supports IEEE,XOPEN,POSIX/ANSI,SVID).
+
+To create the IEEE only libm.a, use
+ make "CFLAGS = -D_IEEE_LIBM"
+This will create an IEEE libm.a, which is smaller in size, and
+somewhat faster.
+
+To create a multi-standard compliant libm, use
+ make "CFLAGS = -D_IEEE_MODE" --- multi-standard fdlibm: default
+ to IEEE
+ make "CFLAGS = -D_XOPEN_MODE" --- multi-standard fdlibm: default
+ to X/OPEN
+ make "CFLAGS = -D_POSIX_MODE" --- multi-standard fdlibm: default
+ to POSIX/ANSI
+ make "CFLAGS = -D_SVID3_MODE" --- multi-standard fdlibm: default
+ to SVID
+
+
+Here is how one makes a SVID compliant libm.
+ Make the library by
+ make "CFLAGS = -D_SVID3_MODE".
+ The libm.a of FDLIBM will be multi-standard compliant and
+ _LIB_VERSION is initialized to the value _SVID_ .
+
+ example1:
+ ---------
+ main()
+ {
+ double y0();
+ printf("y0(1e300) = %1.20e\n",y0(1e300));
+ exit(0);
+ }
+
+ % cc example1.c libm.a
+ % a.out
+ y0: TLOSS error
+ y0(1e300) = 0.00000000000000000000e+00
+
+
+It is possible to change the default standard in multi-standard
+fdlibm. Here is an example of how to do it:
+ example2:
+ ---------
+ #include "fdlibm.h" /* must include FDLIBM's fdlibm.h */
+ main()
+ {
+ double y0();
+ _LIB_VERSION = _IEEE_;
+ printf("IEEE: y0(1e300) = %1.20e\n",y0(1e300));
+ _LIB_VERSION = _XOPEN_;
+ printf("XOPEN y0(1e300) = %1.20e\n",y0(1e300));
+ _LIB_VERSION = _POSIX_;
+ printf("POSIX y0(1e300) = %1.20e\n",y0(1e300));
+ _LIB_VERSION = _SVID_;
+ printf("SVID y0(1e300) = %1.20e\n",y0(1e300));
+ exit(0);
+ }
+
+ % cc example2.c libm.a
+ % a.out
+ IEEE: y0(1e300) = -1.36813604503424810557e-151
+ XOPEN y0(1e300) = 0.00000000000000000000e+00
+ POSIX y0(1e300) = 0.00000000000000000000e+00
+ y0: TLOSS error
+ SVID y0(1e300) = 0.00000000000000000000e+00
+
+Note: Here _LIB_VERSION is a global variable. If global variables
+ are forbidden, then one should modify fdlibm.h to change
+ _LIB_VERSION to be a global constant. In this case, one
+ may not change the value of _LIB_VERSION as in example2.
+
+---------------------------
+5. NOTES ON PORTING FDLIBM
+---------------------------
+ Care must be taken when installing FDLIBM over existing
+ libm.a.
+ All co-existing function prototypes must agree, otherwise
+ users will encounter mysterious failures.
+
+ So far, the only known likely conflict is the declaration
+ of the IEEE recommended function scalb:
+
+ double scalb(double,double) (1) SVID3 defined
+ double scalb(double,int) (2) IBM,DEC,...
+
+ FDLIBM follows Sun definition and use (1) as default.
+ If one's existing libm.a uses (2), then one may raise
+ the flags _SCALB_INT during the compilation of FDLIBM
+ to get the correct function prototype.
+ (E.g., make "CFLAGS = -D_IEEE_LIBM -D_SCALB_INT".)
+ NOTE that if -D_SCALB_INT is raised, it won't be SVID3
+ conformant.
+
+--------------
+6. PROBLEMS ?
+--------------
+Please send comments and bug report to:
+ fdlibm-comments@sunpro.eng.sun.com
+
diff --git a/libmath/fdlibm/s_asinh.c b/libmath/fdlibm/s_asinh.c
new file mode 100644
index 00000000..3d603a22
--- /dev/null
+++ b/libmath/fdlibm/s_asinh.c
@@ -0,0 +1,53 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_asinh.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* asinh(x)
+ * Method :
+ * Based on
+ * asinh(x) = sign(x) * log [ |x| + sqrt(x*x+1) ]
+ * we have
+ * asinh(x) := x if 1+x*x=1,
+ * := sign(x)*(log(x)+ln2)) for large |x|, else
+ * := sign(x)*log(2|x|+1/(|x|+sqrt(x*x+1))) if|x|>2, else
+ * := sign(x)*log1p(|x| + x^2/(1 + sqrt(1+x^2)))
+ */
+
+#include "fdlibm.h"
+
+static const double
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+ln2 = 6.93147180559945286227e-01, /* 0x3FE62E42, 0xFEFA39EF */
+Huge= 1.00000000000000000000e+300;
+
+ double asinh(double x)
+{
+ double t,w;
+ int hx,ix;
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x7ff00000) return x+x; /* x is inf or NaN */
+ if(ix< 0x3e300000) { /* |x|<2**-28 */
+ if(Huge+x>one) return x; /* return x inexact except 0 */
+ }
+ if(ix>0x41b00000) { /* |x| > 2**28 */
+ w = __ieee754_log(fabs(x))+ln2;
+ } else if (ix>0x40000000) { /* 2**28 > |x| > 2.0 */
+ t = fabs(x);
+ w = __ieee754_log(2.0*t+one/(sqrt(x*x+one)+t));
+ } else { /* 2.0 > |x| > 2**-28 */
+ t = x*x;
+ w =log1p(fabs(x)+t/(one+sqrt(one+t)));
+ }
+ if(hx>0) return w; else return -w;
+}
diff --git a/libmath/fdlibm/s_atan.c b/libmath/fdlibm/s_atan.c
new file mode 100644
index 00000000..26b9be71
--- /dev/null
+++ b/libmath/fdlibm/s_atan.c
@@ -0,0 +1,114 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_atan.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+/* atan(x)
+ * Method
+ * 1. Reduce x to positive by atan(x) = -atan(-x).
+ * 2. According to the integer k=4t+0.25 chopped, t=x, the argument
+ * is further reduced to one of the following intervals and the
+ * arctangent of t is evaluated by the corresponding formula:
+ *
+ * [0,7/16] atan(x) = t-t^3*(a1+t^2*(a2+...(a10+t^2*a11)...)
+ * [7/16,11/16] atan(x) = atan(1/2) + atan( (t-0.5)/(1+t/2) )
+ * [11/16.19/16] atan(x) = atan( 1 ) + atan( (t-1)/(1+t) )
+ * [19/16,39/16] atan(x) = atan(3/2) + atan( (t-1.5)/(1+1.5t) )
+ * [39/16,INF] atan(x) = atan(INF) + atan( -1/t )
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const double atanhi[] = {
+ 4.63647609000806093515e-01, /* atan(0.5)hi 0x3FDDAC67, 0x0561BB4F */
+ 7.85398163397448278999e-01, /* atan(1.0)hi 0x3FE921FB, 0x54442D18 */
+ 9.82793723247329054082e-01, /* atan(1.5)hi 0x3FEF730B, 0xD281F69B */
+ 1.57079632679489655800e+00, /* atan(inf)hi 0x3FF921FB, 0x54442D18 */
+};
+
+static const double atanlo[] = {
+ 2.26987774529616870924e-17, /* atan(0.5)lo 0x3C7A2B7F, 0x222F65E2 */
+ 3.06161699786838301793e-17, /* atan(1.0)lo 0x3C81A626, 0x33145C07 */
+ 1.39033110312309984516e-17, /* atan(1.5)lo 0x3C700788, 0x7AF0CBBD */
+ 6.12323399573676603587e-17, /* atan(inf)lo 0x3C91A626, 0x33145C07 */
+};
+
+static const double aT[] = {
+ 3.33333333333329318027e-01, /* 0x3FD55555, 0x5555550D */
+ -1.99999999998764832476e-01, /* 0xBFC99999, 0x9998EBC4 */
+ 1.42857142725034663711e-01, /* 0x3FC24924, 0x920083FF */
+ -1.11111104054623557880e-01, /* 0xBFBC71C6, 0xFE231671 */
+ 9.09088713343650656196e-02, /* 0x3FB745CD, 0xC54C206E */
+ -7.69187620504482999495e-02, /* 0xBFB3B0F2, 0xAF749A6D */
+ 6.66107313738753120669e-02, /* 0x3FB10D66, 0xA0D03D51 */
+ -5.83357013379057348645e-02, /* 0xBFADDE2D, 0x52DEFD9A */
+ 4.97687799461593236017e-02, /* 0x3FA97B4B, 0x24760DEB */
+ -3.65315727442169155270e-02, /* 0xBFA2B444, 0x2C6A6C2F */
+ 1.62858201153657823623e-02, /* 0x3F90AD3A, 0xE322DA11 */
+};
+
+ static const double
+one = 1.0,
+Huge = 1.0e300;
+
+ double atan(double x)
+{
+ double w,s1,s2,z;
+ int ix,hx,id;
+
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x44100000) { /* if |x| >= 2^66 */
+ if(ix>0x7ff00000||
+ (ix==0x7ff00000&&(__LO(x)!=0)))
+ return x+x; /* NaN */
+ if(hx>0) return atanhi[3]+atanlo[3];
+ else return -atanhi[3]-atanlo[3];
+ } if (ix < 0x3fdc0000) { /* |x| < 0.4375 */
+ if (ix < 0x3e200000) { /* |x| < 2^-29 */
+ if(Huge+x>one) return x; /* raise inexact */
+ }
+ id = -1;
+ } else {
+ x = fabs(x);
+ if (ix < 0x3ff30000) { /* |x| < 1.1875 */
+ if (ix < 0x3fe60000) { /* 7/16 <=|x|<11/16 */
+ id = 0; x = (2.0*x-one)/(2.0+x);
+ } else { /* 11/16<=|x|< 19/16 */
+ id = 1; x = (x-one)/(x+one);
+ }
+ } else {
+ if (ix < 0x40038000) { /* |x| < 2.4375 */
+ id = 2; x = (x-1.5)/(one+1.5*x);
+ } else { /* 2.4375 <= |x| < 2^66 */
+ id = 3; x = -1.0/x;
+ }
+ }}
+ /* end of argument reduction */
+ z = x*x;
+ w = z*z;
+ /* break sum from i=0 to 10 aT[i]z**(i+1) into odd and even poly */
+ s1 = z*(aT[0]+w*(aT[2]+w*(aT[4]+w*(aT[6]+w*(aT[8]+w*aT[10])))));
+ s2 = w*(aT[1]+w*(aT[3]+w*(aT[5]+w*(aT[7]+w*aT[9]))));
+ if (id<0) return x - x*(s1+s2);
+ else {
+ z = atanhi[id] - ((x*(s1+s2) - atanlo[id]) - x);
+ return (hx<0)? -z:z;
+ }
+}
diff --git a/libmath/fdlibm/s_cbrt.c b/libmath/fdlibm/s_cbrt.c
new file mode 100644
index 00000000..9b6ac7ec
--- /dev/null
+++ b/libmath/fdlibm/s_cbrt.c
@@ -0,0 +1,75 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_cbrt.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ *
+ */
+
+#include "fdlibm.h"
+
+/* cbrt(x)
+ * Return cube root of x
+ */
+static const unsigned
+ B1 = 715094163, /* B1 = (682-0.03306235651)*2**20 */
+ B2 = 696219795; /* B2 = (664-0.03306235651)*2**20 */
+
+static const double
+C = 5.42857142857142815906e-01, /* 19/35 = 0x3FE15F15, 0xF15F15F1 */
+D = -7.05306122448979611050e-01, /* -864/1225 = 0xBFE691DE, 0x2532C834 */
+E = 1.41428571428571436819e+00, /* 99/70 = 0x3FF6A0EA, 0x0EA0EA0F */
+F = 1.60714285714285720630e+00, /* 45/28 = 0x3FF9B6DB, 0x6DB6DB6E */
+G = 3.57142857142857150787e-01; /* 5/14 = 0x3FD6DB6D, 0xB6DB6DB7 */
+
+ double cbrt(double x)
+{
+ int hx;
+ double r,s,t=0.0,w;
+ unsigned sign;
+
+
+ hx = __HI(x); /* high word of x */
+ sign=hx&0x80000000; /* sign= sign(x) */
+ hx ^=sign;
+ if(hx>=0x7ff00000) return(x+x); /* cbrt(NaN,INF) is itself */
+ if((hx|__LO(x))==0)
+ return(x); /* cbrt(0) is itself */
+
+ __HI(x) = hx; /* x <- |x| */
+ /* rough cbrt to 5 bits */
+ if(hx<0x00100000) /* subnormal number */
+ {__HI(t)=0x43500000; /* set t= 2**54 */
+ t*=x; __HI(t)=__HI(t)/3+B2;
+ }
+ else
+ __HI(t)=hx/3+B1;
+
+
+ /* new cbrt to 23 bits, may be implemented in single precision */
+ r=t*t/x;
+ s=C+r*t;
+ t*=G+F/(s+E+D/s);
+
+ /* chopped to 20 bits and make it larger than cbrt(x) */
+ __LO(t)=0; __HI(t)+=0x00000001;
+
+
+ /* one step newton iteration to 53 bits with error less than 0.667 ulps */
+ s=t*t; /* t*t is exact */
+ r=x/s;
+ w=t+t;
+ r=(r-t)/(w+r); /* r-s is exact */
+ t=t+t*r;
+
+ /* retore the sign bit */
+ __HI(t) |= sign;
+ return(t);
+}
diff --git a/libmath/fdlibm/s_ceil.c b/libmath/fdlibm/s_ceil.c
new file mode 100644
index 00000000..7bb2a00c
--- /dev/null
+++ b/libmath/fdlibm/s_ceil.c
@@ -0,0 +1,70 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_ceil.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * ceil(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to ceil(x).
+ */
+
+#include "fdlibm.h"
+
+static const double Huge = 1.0e300;
+
+ double ceil(double x)
+{
+ int i0,i1,j0;
+ unsigned i,j;
+ i0 = __HI(x);
+ i1 = __LO(x);
+ j0 = ((i0>>20)&0x7ff)-0x3ff;
+ if(j0<20) {
+ if(j0<0) { /* raise inexact if x != 0 */
+ if(Huge+x>0.0) {/* return 0*sign(x) if |x|<1 */
+ if(i0<0) {i0=0x80000000;i1=0;}
+ else if((i0|i1)!=0) { i0=0x3ff00000;i1=0;}
+ }
+ } else {
+ i = (0x000fffff)>>j0;
+ if(((i0&i)|i1)==0) return x; /* x is integral */
+ if(Huge+x>0.0) { /* raise inexact flag */
+ if(i0>0) i0 += (0x00100000)>>j0;
+ i0 &= (~i); i1=0;
+ }
+ }
+ } else if (j0>51) {
+ if(j0==0x400) return x+x; /* inf or NaN */
+ else return x; /* x is integral */
+ } else {
+ i = ((unsigned)(0xffffffff))>>(j0-20);
+ if((i1&i)==0) return x; /* x is integral */
+ if(Huge+x>0.0) { /* raise inexact flag */
+ if(i0>0) {
+ if(j0==20) i0+=1;
+ else {
+ j = i1 + (1<<(52-j0));
+ if(j<i1) i0+=1; /* got a carry */
+ i1 = j;
+ }
+ }
+ i1 &= (~i);
+ }
+ }
+ __HI(x) = i0;
+ __LO(x) = i1;
+ return x;
+}
diff --git a/libmath/fdlibm/s_copysign.c b/libmath/fdlibm/s_copysign.c
new file mode 100644
index 00000000..5f26eefc
--- /dev/null
+++ b/libmath/fdlibm/s_copysign.c
@@ -0,0 +1,27 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_copysign.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * copysign(double x, double y)
+ * copysign(x,y) returns a value with the magnitude of x and
+ * with the sign bit of y.
+ */
+
+#include "fdlibm.h"
+
+ double copysign(double x, double y)
+{
+ __HI(x) = (__HI(x)&0x7fffffff)|(__HI(y)&0x80000000);
+ return x;
+}
diff --git a/libmath/fdlibm/s_cos.c b/libmath/fdlibm/s_cos.c
new file mode 100644
index 00000000..8b96c555
--- /dev/null
+++ b/libmath/fdlibm/s_cos.c
@@ -0,0 +1,74 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_cos.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* cos(x)
+ * Return cosine function of x.
+ *
+ * kernel function:
+ * __kernel_sin ... sine function on [-pi/4,pi/4]
+ * __kernel_cos ... cosine function on [-pi/4,pi/4]
+ * __ieee754_rem_pio2 ... argument reduction routine
+ *
+ * Method.
+ * Let S,C and T denote the sin, cos and tan respectively on
+ * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
+ * in [-pi/4 , +pi/4], and let n = k mod 4.
+ * We have
+ *
+ * n sin(x) cos(x) tan(x)
+ * ----------------------------------------------------------
+ * 0 S C T
+ * 1 C -S -1/T
+ * 2 -S -C T
+ * 3 -C S -1/T
+ * ----------------------------------------------------------
+ *
+ * Special cases:
+ * Let trig be any of sin, cos, or tan.
+ * trig(+-INF) is NaN, with signals;
+ * trig(NaN) is that NaN;
+ *
+ * Accuracy:
+ * TRIG(x) returns trig(x) nearly rounded
+ */
+
+#include "fdlibm.h"
+
+ double cos(double x)
+{
+ double y[2],z=0.0;
+ int n, ix;
+
+ /* High word of x. */
+ ix = __HI(x);
+
+ /* |x| ~< pi/4 */
+ ix &= 0x7fffffff;
+ if(ix <= 0x3fe921fb) return __kernel_cos(x,z);
+
+ /* cos(Inf or NaN) is NaN */
+ else if (ix>=0x7ff00000) return x-x;
+
+ /* argument reduction needed */
+ else {
+ n = __ieee754_rem_pio2(x,y);
+ switch(n&3) {
+ case 0: return __kernel_cos(y[0],y[1]);
+ case 1: return -__kernel_sin(y[0],y[1],1);
+ case 2: return -__kernel_cos(y[0],y[1]);
+ default:
+ return __kernel_sin(y[0],y[1],1);
+ }
+ }
+}
diff --git a/libmath/fdlibm/s_erf.c b/libmath/fdlibm/s_erf.c
new file mode 100644
index 00000000..bbb860de
--- /dev/null
+++ b/libmath/fdlibm/s_erf.c
@@ -0,0 +1,297 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_erf.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* double erf(double x)
+ * double erfc(double x)
+ * x
+ * 2 |\
+ * erf(x) = --------- | exp(-t*t)dt
+ * sqrt(pi) \|
+ * 0
+ *
+ * erfc(x) = 1-erf(x)
+ * Note that
+ * erf(-x) = -erf(x)
+ * erfc(-x) = 2 - erfc(x)
+ *
+ * Method:
+ * 1. For |x| in [0, 0.84375]
+ * erf(x) = x + x*R(x^2)
+ * erfc(x) = 1 - erf(x) if x in [-.84375,0.25]
+ * = 0.5 + ((0.5-x)-x*R) if x in [0.25,0.84375]
+ * where R = P/Q where P is an odd poly of degree 8 and
+ * Q is an odd poly of degree 10.
+ * -57.90
+ * | R - (erf(x)-x)/x | <= 2
+ *
+ *
+ * Remark. The formula is derived by noting
+ * erf(x) = (2/sqrt(pi))*(x - x^3/3 + x^5/10 - x^7/42 + ....)
+ * and that
+ * 2/sqrt(pi) = 1.128379167095512573896158903121545171688
+ * is close to one. The interval is chosen because the fix
+ * point of erf(x) is near 0.6174 (i.e., erf(x)=x when x is
+ * near 0.6174), and by some experiment, 0.84375 is chosen to
+ * guarantee the error is less than one ulp for erf.
+ *
+ * 2. For |x| in [0.84375,1.25], let s = |x| - 1, and
+ * c = 0.84506291151 rounded to single (24 bits)
+ * erf(x) = sign(x) * (c + P1(s)/Q1(s))
+ * erfc(x) = (1-c) - P1(s)/Q1(s) if x > 0
+ * 1+(c+P1(s)/Q1(s)) if x < 0
+ * |P1/Q1 - (erf(|x|)-c)| <= 2**-59.06
+ * Remark: here we use the taylor series expansion at x=1.
+ * erf(1+s) = erf(1) + s*Poly(s)
+ * = 0.845.. + P1(s)/Q1(s)
+ * That is, we use rational approximation to approximate
+ * erf(1+s) - (c = (single)0.84506291151)
+ * Note that |P1/Q1|< 0.078 for x in [0.84375,1.25]
+ * where
+ * P1(s) = degree 6 poly in s
+ * Q1(s) = degree 6 poly in s
+ *
+ * 3. For x in [1.25,1/0.35(~2.857143)],
+ * erfc(x) = (1/x)*exp(-x*x-0.5625+R1/S1)
+ * erf(x) = 1 - erfc(x)
+ * where
+ * R1(z) = degree 7 poly in z, (z=1/x^2)
+ * S1(z) = degree 8 poly in z
+ *
+ * 4. For x in [1/0.35,28]
+ * erfc(x) = (1/x)*exp(-x*x-0.5625+R2/S2) if x > 0
+ * = 2.0 - (1/x)*exp(-x*x-0.5625+R2/S2) if -6<x<0
+ * = 2.0 - tiny (if x <= -6)
+ * erf(x) = sign(x)*(1.0 - erfc(x)) if x < 6, else
+ * erf(x) = sign(x)*(1.0 - tiny)
+ * where
+ * R2(z) = degree 6 poly in z, (z=1/x^2)
+ * S2(z) = degree 7 poly in z
+ *
+ * Note1:
+ * To compute exp(-x*x-0.5625+R/S), let s be a single
+ * precision number and s := x; then
+ * -x*x = -s*s + (s-x)*(s+x)
+ * exp(-x*x-0.5626+R/S) =
+ * exp(-s*s-0.5625)*exp((s-x)*(s+x)+R/S);
+ * Note2:
+ * Here 4 and 5 make use of the asymptotic series
+ * exp(-x*x)
+ * erfc(x) ~ ---------- * ( 1 + Poly(1/x^2) )
+ * x*sqrt(pi)
+ * We use rational approximation to approximate
+ * g(s)=f(1/x^2) = log(erfc(x)*x) - x*x + 0.5625
+ * Here is the error bound for R1/S1 and R2/S2
+ * |R1/S1 - f(x)| < 2**(-62.57)
+ * |R2/S2 - f(x)| < 2**(-61.52)
+ *
+ * 5. For inf > x >= 28
+ * erf(x) = sign(x) *(1 - tiny) (raise inexact)
+ * erfc(x) = tiny*tiny (raise underflow) if x > 0
+ * = 2 - tiny if x<0
+ *
+ * 7. Special case:
+ * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1,
+ * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2,
+ * erfc/erf(NaN) is NaN
+ */
+
+
+#include "fdlibm.h"
+
+static const double
+tiny = 1e-300,
+half= 5.00000000000000000000e-01, /* 0x3FE00000, 0x00000000 */
+one = 1.00000000000000000000e+00, /* 0x3FF00000, 0x00000000 */
+two = 2.00000000000000000000e+00, /* 0x40000000, 0x00000000 */
+ /* c = (float)0.84506291151 */
+erx = 8.45062911510467529297e-01, /* 0x3FEB0AC1, 0x60000000 */
+/*
+ * Coefficients for approximation to erf on [0,0.84375]
+ */
+efx = 1.28379167095512586316e-01, /* 0x3FC06EBA, 0x8214DB69 */
+efx8= 1.02703333676410069053e+00, /* 0x3FF06EBA, 0x8214DB69 */
+pp0 = 1.28379167095512558561e-01, /* 0x3FC06EBA, 0x8214DB68 */
+pp1 = -3.25042107247001499370e-01, /* 0xBFD4CD7D, 0x691CB913 */
+pp2 = -2.84817495755985104766e-02, /* 0xBF9D2A51, 0xDBD7194F */
+pp3 = -5.77027029648944159157e-03, /* 0xBF77A291, 0x236668E4 */
+pp4 = -2.37630166566501626084e-05, /* 0xBEF8EAD6, 0x120016AC */
+qq1 = 3.97917223959155352819e-01, /* 0x3FD97779, 0xCDDADC09 */
+qq2 = 6.50222499887672944485e-02, /* 0x3FB0A54C, 0x5536CEBA */
+qq3 = 5.08130628187576562776e-03, /* 0x3F74D022, 0xC4D36B0F */
+qq4 = 1.32494738004321644526e-04, /* 0x3F215DC9, 0x221C1A10 */
+qq5 = -3.96022827877536812320e-06, /* 0xBED09C43, 0x42A26120 */
+/*
+ * Coefficients for approximation to erf in [0.84375,1.25]
+ */
+pa0 = -2.36211856075265944077e-03, /* 0xBF6359B8, 0xBEF77538 */
+pa1 = 4.14856118683748331666e-01, /* 0x3FDA8D00, 0xAD92B34D */
+pa2 = -3.72207876035701323847e-01, /* 0xBFD7D240, 0xFBB8C3F1 */
+pa3 = 3.18346619901161753674e-01, /* 0x3FD45FCA, 0x805120E4 */
+pa4 = -1.10894694282396677476e-01, /* 0xBFBC6398, 0x3D3E28EC */
+pa5 = 3.54783043256182359371e-02, /* 0x3FA22A36, 0x599795EB */
+pa6 = -2.16637559486879084300e-03, /* 0xBF61BF38, 0x0A96073F */
+qa1 = 1.06420880400844228286e-01, /* 0x3FBB3E66, 0x18EEE323 */
+qa2 = 5.40397917702171048937e-01, /* 0x3FE14AF0, 0x92EB6F33 */
+qa3 = 7.18286544141962662868e-02, /* 0x3FB2635C, 0xD99FE9A7 */
+qa4 = 1.26171219808761642112e-01, /* 0x3FC02660, 0xE763351F */
+qa5 = 1.36370839120290507362e-02, /* 0x3F8BEDC2, 0x6B51DD1C */
+qa6 = 1.19844998467991074170e-02, /* 0x3F888B54, 0x5735151D */
+/*
+ * Coefficients for approximation to erfc in [1.25,1/0.35]
+ */
+ra0 = -9.86494403484714822705e-03, /* 0xBF843412, 0x600D6435 */
+ra1 = -6.93858572707181764372e-01, /* 0xBFE63416, 0xE4BA7360 */
+ra2 = -1.05586262253232909814e+01, /* 0xC0251E04, 0x41B0E726 */
+ra3 = -6.23753324503260060396e+01, /* 0xC04F300A, 0xE4CBA38D */
+ra4 = -1.62396669462573470355e+02, /* 0xC0644CB1, 0x84282266 */
+ra5 = -1.84605092906711035994e+02, /* 0xC067135C, 0xEBCCABB2 */
+ra6 = -8.12874355063065934246e+01, /* 0xC0545265, 0x57E4D2F2 */
+ra7 = -9.81432934416914548592e+00, /* 0xC023A0EF, 0xC69AC25C */
+sa1 = 1.96512716674392571292e+01, /* 0x4033A6B9, 0xBD707687 */
+sa2 = 1.37657754143519042600e+02, /* 0x4061350C, 0x526AE721 */
+sa3 = 4.34565877475229228821e+02, /* 0x407B290D, 0xD58A1A71 */
+sa4 = 6.45387271733267880336e+02, /* 0x40842B19, 0x21EC2868 */
+sa5 = 4.29008140027567833386e+02, /* 0x407AD021, 0x57700314 */
+sa6 = 1.08635005541779435134e+02, /* 0x405B28A3, 0xEE48AE2C */
+sa7 = 6.57024977031928170135e+00, /* 0x401A47EF, 0x8E484A93 */
+sa8 = -6.04244152148580987438e-02, /* 0xBFAEEFF2, 0xEE749A62 */
+/*
+ * Coefficients for approximation to erfc in [1/.35,28]
+ */
+rb0 = -9.86494292470009928597e-03, /* 0xBF843412, 0x39E86F4A */
+rb1 = -7.99283237680523006574e-01, /* 0xBFE993BA, 0x70C285DE */
+rb2 = -1.77579549177547519889e+01, /* 0xC031C209, 0x555F995A */
+rb3 = -1.60636384855821916062e+02, /* 0xC064145D, 0x43C5ED98 */
+rb4 = -6.37566443368389627722e+02, /* 0xC083EC88, 0x1375F228 */
+rb5 = -1.02509513161107724954e+03, /* 0xC0900461, 0x6A2E5992 */
+rb6 = -4.83519191608651397019e+02, /* 0xC07E384E, 0x9BDC383F */
+sb1 = 3.03380607434824582924e+01, /* 0x403E568B, 0x261D5190 */
+sb2 = 3.25792512996573918826e+02, /* 0x40745CAE, 0x221B9F0A */
+sb3 = 1.53672958608443695994e+03, /* 0x409802EB, 0x189D5118 */
+sb4 = 3.19985821950859553908e+03, /* 0x40A8FFB7, 0x688C246A */
+sb5 = 2.55305040643316442583e+03, /* 0x40A3F219, 0xCEDF3BE6 */
+sb6 = 4.74528541206955367215e+02, /* 0x407DA874, 0xE79FE763 */
+sb7 = -2.24409524465858183362e+01; /* 0xC03670E2, 0x42712D62 */
+
+ double erf(double x)
+{
+ int hx,ix,i;
+ double R,S,P,Q,s,y,z,r;
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x7ff00000) { /* erf(nan)=nan */
+ i = ((unsigned)hx>>31)<<1;
+ return (double)(1-i)+one/x; /* erf(+-inf)=+-1 */
+ }
+
+ if(ix < 0x3feb0000) { /* |x|<0.84375 */
+ if(ix < 0x3e300000) { /* |x|<2**-28 */
+ if (ix < 0x00800000)
+ return 0.125*(8.0*x+efx8*x); /*avoid underflow */
+ return x + efx*x;
+ }
+ z = x*x;
+ r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
+ s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
+ y = r/s;
+ return x + x*y;
+ }
+ if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabs(x)-one;
+ P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
+ Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
+ if(hx>=0) return erx + P/Q; else return -erx - P/Q;
+ }
+ if (ix >= 0x40180000) { /* inf>|x|>=6 */
+ if(hx>=0) return one-tiny; else return tiny-one;
+ }
+ x = fabs(x);
+ s = one/(x*x);
+ if(ix< 0x4006DB6E) { /* |x| < 1/0.35 */
+ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
+ ra5+s*(ra6+s*ra7))))));
+ S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
+ sa5+s*(sa6+s*(sa7+s*sa8)))))));
+ } else { /* |x| >= 1/0.35 */
+ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
+ rb5+s*rb6)))));
+ S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
+ sb5+s*(sb6+s*sb7))))));
+ }
+ z = x;
+ __LO(z) = 0;
+ r = __ieee754_exp(-z*z-0.5625)*__ieee754_exp((z-x)*(z+x)+R/S);
+ if(hx>=0) return one-r/x; else return r/x-one;
+}
+
+ double erfc(double x)
+{
+ int hx,ix;
+ double R,S,P,Q,s,y,z,r;
+ hx = __HI(x);
+ ix = hx&0x7fffffff;
+ if(ix>=0x7ff00000) { /* erfc(nan)=nan */
+ /* erfc(+-inf)=0,2 */
+ return (double)(((unsigned)hx>>31)<<1)+one/x;
+ }
+
+ if(ix < 0x3feb0000) { /* |x|<0.84375 */
+ if(ix < 0x3c700000) /* |x|<2**-56 */
+ return one-x;
+ z = x*x;
+ r = pp0+z*(pp1+z*(pp2+z*(pp3+z*pp4)));
+ s = one+z*(qq1+z*(qq2+z*(qq3+z*(qq4+z*qq5))));
+ y = r/s;
+ if(hx < 0x3fd00000) { /* x<1/4 */
+ return one-(x+x*y);
+ } else {
+ r = x*y;
+ r += (x-half);
+ return half - r ;
+ }
+ }
+ if(ix < 0x3ff40000) { /* 0.84375 <= |x| < 1.25 */
+ s = fabs(x)-one;
+ P = pa0+s*(pa1+s*(pa2+s*(pa3+s*(pa4+s*(pa5+s*pa6)))));
+ Q = one+s*(qa1+s*(qa2+s*(qa3+s*(qa4+s*(qa5+s*qa6)))));
+ if(hx>=0) {
+ z = one-erx; return z - P/Q;
+ } else {
+ z = erx+P/Q; return one+z;
+ }
+ }
+ if (ix < 0x403c0000) { /* |x|<28 */
+ x = fabs(x);
+ s = one/(x*x);
+ if(ix< 0x4006DB6D) { /* |x| < 1/.35 ~ 2.857143*/
+ R=ra0+s*(ra1+s*(ra2+s*(ra3+s*(ra4+s*(
+ ra5+s*(ra6+s*ra7))))));
+ S=one+s*(sa1+s*(sa2+s*(sa3+s*(sa4+s*(
+ sa5+s*(sa6+s*(sa7+s*sa8)))))));
+ } else { /* |x| >= 1/.35 ~ 2.857143 */
+ if(hx<0&&ix>=0x40180000) return two-tiny;/* x < -6 */
+ R=rb0+s*(rb1+s*(rb2+s*(rb3+s*(rb4+s*(
+ rb5+s*rb6)))));
+ S=one+s*(sb1+s*(sb2+s*(sb3+s*(sb4+s*(
+ sb5+s*(sb6+s*sb7))))));
+ }
+ z = x;
+ __LO(z) = 0;
+ r = __ieee754_exp(-z*z-0.5625)*
+ __ieee754_exp((z-x)*(z+x)+R/S);
+ if(hx>0) return r/x; else return two-r/x;
+ } else {
+ if(hx>0) return tiny*tiny; else return two-tiny;
+ }
+}
diff --git a/libmath/fdlibm/s_expm1.c b/libmath/fdlibm/s_expm1.c
new file mode 100644
index 00000000..4ad4c8cf
--- /dev/null
+++ b/libmath/fdlibm/s_expm1.c
@@ -0,0 +1,208 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_expm1.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* expm1(x)
+ * Returns exp(x)-1, the exponential of x minus 1.
+ *
+ * Method
+ * 1. Argument reduction:
+ * Given x, find r and integer k such that
+ *
+ * x = k*ln2 + r, |r| <= 0.5*ln2 ~ 0.34658
+ *
+ * Here a correction term c will be computed to compensate
+ * the error in r when rounded to a floating-point number.
+ *
+ * 2. Approximating expm1(r) by a special rational function on
+ * the interval [0,0.34658]:
+ * Since
+ * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 - r^4/360 + ...
+ * we define R1(r*r) by
+ * r*(exp(r)+1)/(exp(r)-1) = 2+ r^2/6 * R1(r*r)
+ * That is,
+ * R1(r**2) = 6/r *((exp(r)+1)/(exp(r)-1) - 2/r)
+ * = 6/r * ( 1 + 2.0*(1/(exp(r)-1) - 1/r))
+ * = 1 - r^2/60 + r^4/2520 - r^6/100800 + ...
+ * We use a special Reme algorithm on [0,0.347] to generate
+ * a polynomial of degree 5 in r*r to approximate R1. The
+ * maximum error of this polynomial approximation is bounded
+ * by 2**-61. In other words,
+ * R1(z) ~ 1.0 + Q1*z + Q2*z**2 + Q3*z**3 + Q4*z**4 + Q5*z**5
+ * where Q1 = -1.6666666666666567384E-2,
+ * Q2 = 3.9682539681370365873E-4,
+ * Q3 = -9.9206344733435987357E-6,
+ * Q4 = 2.5051361420808517002E-7,
+ * Q5 = -6.2843505682382617102E-9;
+ * (where z=r*r, and the values of Q1 to Q5 are listed below)
+ * with error bounded by
+ * | 5 | -61
+ * | 1.0+Q1*z+...+Q5*z - R1(z) | <= 2
+ * | |
+ *
+ * expm1(r) = exp(r)-1 is then computed by the following
+ * specific way which minimize the accumulation rounding error:
+ * 2 3
+ * r r [ 3 - (R1 + R1*r/2) ]
+ * expm1(r) = r + --- + --- * [--------------------]
+ * 2 2 [ 6 - r*(3 - R1*r/2) ]
+ *
+ * To compensate the error in the argument reduction, we use
+ * expm1(r+c) = expm1(r) + c + expm1(r)*c
+ * ~ expm1(r) + c + r*c
+ * Thus c+r*c will be added in as the correction terms for
+ * expm1(r+c). Now rearrange the term to avoid optimization
+ * screw up:
+ * ( 2 2 )
+ * ({ ( r [ R1 - (3 - R1*r/2) ] ) } r )
+ * expm1(r+c)~r - ({r*(--- * [--------------------]-c)-c} - --- )
+ * ({ ( 2 [ 6 - r*(3 - R1*r/2) ] ) } 2 )
+ * ( )
+ *
+ * = r - E
+ * 3. Scale back to obtain expm1(x):
+ * From step 1, we have
+ * expm1(x) = either 2^k*[expm1(r)+1] - 1
+ * = or 2^k*[expm1(r) + (1-2^-k)]
+ * 4. Implementation notes:
+ * (A). To save one multiplication, we scale the coefficient Qi
+ * to Qi*2^i, and replace z by (x^2)/2.
+ * (B). To achieve maximum accuracy, we compute expm1(x) by
+ * (i) if x < -56*ln2, return -1.0, (raise inexact if x!=inf)
+ * (ii) if k=0, return r-E
+ * (iii) if k=-1, return 0.5*(r-E)-0.5
+ * (iv) if k=1 if r < -0.25, return 2*((r+0.5)- E)
+ * else return 1.0+2.0*(r-E);
+ * (v) if (k<-2||k>56) return 2^k(1-(E-r)) - 1 (or exp(x)-1)
+ * (vi) if k <= 20, return 2^k((1-2^-k)-(E-r)), else
+ * (vii) return 2^k(1-((E+2^-k)-r))
+ *
+ * Special cases:
+ * expm1(INF) is INF, expm1(NaN) is NaN;
+ * expm1(-INF) is -1, and
+ * for finite argument, only expm1(0)=0 is exact.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Misc. info.
+ * For IEEE double
+ * if x > 7.09782712893383973096e+02 then expm1(x) overflow
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ */
+
+#include "fdlibm.h"
+
+static const double
+one = 1.0,
+Huge = 1.0e+300,
+tiny = 1.0e-300,
+o_threshold = 7.09782712893383973096e+02,/* 0x40862E42, 0xFEFA39EF */
+ln2_hi = 6.93147180369123816490e-01,/* 0x3fe62e42, 0xfee00000 */
+ln2_lo = 1.90821492927058770002e-10,/* 0x3dea39ef, 0x35793c76 */
+invln2 = 1.44269504088896338700e+00,/* 0x3ff71547, 0x652b82fe */
+ /* scaled coefficients related to expm1 */
+Q1 = -3.33333333333331316428e-02, /* BFA11111 111110F4 */
+Q2 = 1.58730158725481460165e-03, /* 3F5A01A0 19FE5585 */
+Q3 = -7.93650757867487942473e-05, /* BF14CE19 9EAADBB7 */
+Q4 = 4.00821782732936239552e-06, /* 3ED0CFCA 86E65239 */
+Q5 = -2.01099218183624371326e-07; /* BE8AFDB7 6E09C32D */
+
+ double expm1(double x)
+{
+ double y,hi,lo,c,t,e,hxs,hfx,r1;
+ int k,xsb;
+ unsigned hx;
+
+ hx = __HI(x); /* high word of x */
+ xsb = hx&0x80000000; /* sign bit of x */
+ if(xsb==0) y=x; else y= -x; /* y = |x| */
+ hx &= 0x7fffffff; /* high word of |x| */
+
+ /* filter out Huge and non-finite argument */
+ if(hx >= 0x4043687A) { /* if |x|>=56*ln2 */
+ if(hx >= 0x40862E42) { /* if |x|>=709.78... */
+ if(hx>=0x7ff00000) {
+ if(((hx&0xfffff)|__LO(x))!=0)
+ return x+x; /* NaN */
+ else return (xsb==0)? x:-1.0;/* exp(+-inf)={inf,-1} */
+ }
+ if(x > o_threshold) return Huge*Huge; /* overflow */
+ }
+ if(xsb!=0) { /* x < -56*ln2, return -1.0 with inexact */
+ if(x+tiny<0.0) /* raise inexact */
+ return tiny-one; /* return -1 */
+ }
+ }
+
+ /* argument reduction */
+ if(hx > 0x3fd62e42) { /* if |x| > 0.5 ln2 */
+ if(hx < 0x3FF0A2B2) { /* and |x| < 1.5 ln2 */
+ if(xsb==0)
+ {hi = x - ln2_hi; lo = ln2_lo; k = 1;}
+ else
+ {hi = x + ln2_hi; lo = -ln2_lo; k = -1;}
+ } else {
+ k = invln2*x+((xsb==0)?0.5:-0.5);
+ t = k;
+ hi = x - t*ln2_hi; /* t*ln2_hi is exact here */
+ lo = t*ln2_lo;
+ }
+ x = hi - lo;
+ c = (hi-x)-lo;
+ }
+ else if(hx < 0x3c900000) { /* when |x|<2**-54, return x */
+ t = Huge+x; /* return x with inexact flags when x!=0 */
+ return x - (t-(Huge+x));
+ }
+ else k = 0;
+
+ /* x is now in primary range */
+ hfx = 0.5*x;
+ hxs = x*hfx;
+ r1 = one+hxs*(Q1+hxs*(Q2+hxs*(Q3+hxs*(Q4+hxs*Q5))));
+ t = 3.0-r1*hfx;
+ e = hxs*((r1-t)/(6.0 - x*t));
+ if(k==0) return x - (x*e-hxs); /* c is 0 */
+ else {
+ e = (x*(e-c)-c);
+ e -= hxs;
+ if(k== -1) return 0.5*(x-e)-0.5;
+ if(k==1)
+ if(x < -0.25) return -2.0*(e-(x+0.5));
+ else return one+2.0*(x-e);
+ if (k <= -2 || k>56) { /* suffice to return exp(x)-1 */
+ y = one-(e-x);
+ __HI(y) += (k<<20); /* add k to y's exponent */
+ return y-one;
+ }
+ t = one;
+ if(k<20) {
+ __HI(t) = 0x3ff00000 - (0x200000>>k); /* t=1-2^-k */
+ y = t-(e-x);
+ __HI(y) += (k<<20); /* add k to y's exponent */
+ } else {
+ __HI(t) = ((0x3ff-k)<<20); /* 2^-k */
+ y = x-(e+t);
+ y += one;
+ __HI(y) += (k<<20); /* add k to y's exponent */
+ }
+ }
+ return y;
+}
diff --git a/libmath/fdlibm/s_fabs.c b/libmath/fdlibm/s_fabs.c
new file mode 100644
index 00000000..ed82835a
--- /dev/null
+++ b/libmath/fdlibm/s_fabs.c
@@ -0,0 +1,25 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_fabs.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * fabs(x) returns the absolute value of x.
+ */
+
+#include "fdlibm.h"
+
+ double fabs(double x)
+{
+ __HI(x) &= 0x7fffffff;
+ return x;
+}
diff --git a/libmath/fdlibm/s_finite.c b/libmath/fdlibm/s_finite.c
new file mode 100644
index 00000000..52b36f45
--- /dev/null
+++ b/libmath/fdlibm/s_finite.c
@@ -0,0 +1,27 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_finite.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * finite(x) returns 1 is x is finite, else 0;
+ * no branching!
+ */
+
+#include "fdlibm.h"
+
+ int finite(double x)
+{
+ int hx;
+ hx = __HI(x);
+ return (unsigned)((hx&0x7fffffff)-0x7ff00000)>>31;
+}
diff --git a/libmath/fdlibm/s_floor.c b/libmath/fdlibm/s_floor.c
new file mode 100644
index 00000000..e3d61470
--- /dev/null
+++ b/libmath/fdlibm/s_floor.c
@@ -0,0 +1,71 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_floor.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * floor(x)
+ * Return x rounded toward -inf to integral value
+ * Method:
+ * Bit twiddling.
+ * Exception:
+ * Inexact flag raised if x not equal to floor(x).
+ */
+
+#include "fdlibm.h"
+
+static const double Huge = 1.0e300;
+
+ double floor(double x)
+{
+ int i0,i1,j0;
+ unsigned i,j;
+ i0 = __HI(x);
+ i1 = __LO(x);
+ j0 = ((i0>>20)&0x7ff)-0x3ff;
+ if(j0<20) {
+ if(j0<0) { /* raise inexact if x != 0 */
+ if(Huge+x>0.0) {/* return 0*sign(x) if |x|<1 */
+ if(i0>=0) {i0=i1=0;}
+ else if(((i0&0x7fffffff)|i1)!=0)
+ { i0=0xbff00000;i1=0;}
+ }
+ } else {
+ i = (0x000fffff)>>j0;
+ if(((i0&i)|i1)==0) return x; /* x is integral */
+ if(Huge+x>0.0) { /* raise inexact flag */
+ if(i0<0) i0 += (0x00100000)>>j0;
+ i0 &= (~i); i1=0;
+ }
+ }
+ } else if (j0>51) {
+ if(j0==0x400) return x+x; /* inf or NaN */
+ else return x; /* x is integral */
+ } else {
+ i = ((unsigned)(0xffffffff))>>(j0-20);
+ if((i1&i)==0) return x; /* x is integral */
+ if(Huge+x>0.0) { /* raise inexact flag */
+ if(i0<0) {
+ if(j0==20) i0+=1;
+ else {
+ j = i1+(1<<(52-j0));
+ if(j<i1) i0 +=1 ; /* got a carry */
+ i1=j;
+ }
+ }
+ i1 &= (~i);
+ }
+ }
+ __HI(x) = i0;
+ __LO(x) = i1;
+ return x;
+}
diff --git a/libmath/fdlibm/s_ilogb.c b/libmath/fdlibm/s_ilogb.c
new file mode 100644
index 00000000..97e7b09a
--- /dev/null
+++ b/libmath/fdlibm/s_ilogb.c
@@ -0,0 +1,42 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_ilogb.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* ilogb(double x)
+ * return the binary exponent of non-zero x
+ * ilogb(0) = 0x80000001
+ * ilogb(inf/NaN) = 0x7fffffff (no signal is raised)
+ */
+
+#include "fdlibm.h"
+
+ int ilogb(double x)
+{
+ int hx,lx,ix;
+
+ hx = (__HI(x))&0x7fffffff; /* high word of x */
+ if(hx<0x00100000) {
+ lx = __LO(x);
+ if((hx|lx)==0)
+ return 0x80000001; /* ilogb(0) = 0x80000001 */
+ else /* subnormal x */
+ if(hx==0) {
+ for (ix = -1043; lx>0; lx<<=1) ix -=1;
+ } else {
+ for (ix = -1022,hx<<=11; hx>0; hx<<=1) ix -=1;
+ }
+ return ix;
+ }
+ else if (hx<0x7ff00000) return (hx>>20)-1023;
+ else return 0x7fffffff;
+}
diff --git a/libmath/fdlibm/s_isnan.c b/libmath/fdlibm/s_isnan.c
new file mode 100644
index 00000000..d9a5bf97
--- /dev/null
+++ b/libmath/fdlibm/s_isnan.c
@@ -0,0 +1,30 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_isnan.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * isnan(x) returns 1 is x is nan, else 0;
+ * no branching!
+ */
+
+#include "fdlibm.h"
+
+ int isnan(double x)
+{
+ int hx,lx;
+ hx = (__HI(x)&0x7fffffff);
+ lx = __LO(x);
+ hx |= (unsigned)(lx|(-lx))>>31;
+ hx = 0x7ff00000 - hx;
+ return ((unsigned)(hx))>>31;
+}
diff --git a/libmath/fdlibm/s_log1p.c b/libmath/fdlibm/s_log1p.c
new file mode 100644
index 00000000..21ac9e54
--- /dev/null
+++ b/libmath/fdlibm/s_log1p.c
@@ -0,0 +1,157 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_log1p.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* double log1p(double x)
+ *
+ * Method :
+ * 1. Argument Reduction: find k and f such that
+ * 1+x = 2^k * (1+f),
+ * where sqrt(2)/2 < 1+f < sqrt(2) .
+ *
+ * Note. If k=0, then f=x is exact. However, if k!=0, then f
+ * may not be representable exactly. In that case, a correction
+ * term is need. Let u=1+x rounded. Let c = (1+x)-u, then
+ * log(1+x) - log(u) ~ c/u. Thus, we proceed to compute log(u),
+ * and add back the correction term c/u.
+ * (Note: when x > 2**53, one can simply return log(x))
+ *
+ * 2. Approximation of log1p(f).
+ * Let s = f/(2+f) ; based on log(1+f) = log(1+s) - log(1-s)
+ * = 2s + 2/3 s**3 + 2/5 s**5 + .....,
+ * = 2s + s*R
+ * We use a special Reme algorithm on [0,0.1716] to generate
+ * a polynomial of degree 14 to approximate R The maximum error
+ * of this polynomial approximation is bounded by 2**-58.45. In
+ * other words,
+ * 2 4 6 8 10 12 14
+ * R(z) ~ Lp1*s +Lp2*s +Lp3*s +Lp4*s +Lp5*s +Lp6*s +Lp7*s
+ * (the values of Lp1 to Lp7 are listed in the program)
+ * and
+ * | 2 14 | -58.45
+ * | Lp1*s +...+Lp7*s - R(z) | <= 2
+ * | |
+ * Note that 2s = f - s*f = f - hfsq + s*hfsq, where hfsq = f*f/2.
+ * In order to guarantee error in log below 1ulp, we compute log
+ * by
+ * log1p(f) = f - (hfsq - s*(hfsq+R)).
+ *
+ * 3. Finally, log1p(x) = k*ln2 + log1p(f).
+ * = k*ln2_hi+(f-(hfsq-(s*(hfsq+R)+k*ln2_lo)))
+ * Here ln2 is split into two floating point number:
+ * ln2_hi + ln2_lo,
+ * where n*ln2_hi is always exact for |n| < 2000.
+ *
+ * Special cases:
+ * log1p(x) is NaN with signal if x < -1 (including -INF) ;
+ * log1p(+INF) is +INF; log1p(-1) is -INF with signal;
+ * log1p(NaN) is that NaN with no signal.
+ *
+ * Accuracy:
+ * according to an error analysis, the error is always less than
+ * 1 ulp (unit in the last place).
+ *
+ * Constants:
+ * The hexadecimal values are the intended ones for the following
+ * constants. The decimal values may be used, provided that the
+ * compiler will convert from decimal to binary accurately enough
+ * to produce the hexadecimal values shown.
+ *
+ * Note: Assuming log() return accurate answer, the following
+ * algorithm can be used to compute log1p(x) to within a few ULP:
+ *
+ * u = 1+x;
+ * if(u==1.0) return x ; else
+ * return log(u)*(x/(u-1.0));
+ *
+ * See HP-15C Advanced Functions Handbook, p.193.
+ */
+
+#include "fdlibm.h"
+
+static const double
+ln2_hi = 6.93147180369123816490e-01, /* 3fe62e42 fee00000 */
+ln2_lo = 1.90821492927058770002e-10, /* 3dea39ef 35793c76 */
+two54 = 1.80143985094819840000e+16, /* 43500000 00000000 */
+Lp1 = 6.666666666666735130e-01, /* 3FE55555 55555593 */
+Lp2 = 3.999999999940941908e-01, /* 3FD99999 9997FA04 */
+Lp3 = 2.857142874366239149e-01, /* 3FD24924 94229359 */
+Lp4 = 2.222219843214978396e-01, /* 3FCC71C5 1D8E78AF */
+Lp5 = 1.818357216161805012e-01, /* 3FC74664 96CB03DE */
+Lp6 = 1.531383769920937332e-01, /* 3FC39A09 D078C69F */
+Lp7 = 1.479819860511658591e-01; /* 3FC2F112 DF3E5244 */
+
+static double zero = 0.0;
+
+ double log1p(double x)
+{
+ double hfsq,f,c,s,z,R,u;
+ int k,hx,hu,ax;
+
+ hx = __HI(x); /* high word of x */
+ ax = hx&0x7fffffff;
+
+ k = 1;
+ if (hx < 0x3FDA827A) { /* x < 0.41422 */
+ if(ax>=0x3ff00000) { /* x <= -1.0 */
+ if(x==-1.0) return -two54/zero; /* log1p(-1)=+inf */
+ else return (x-x)/(x-x); /* log1p(x<-1)=NaN */
+ }
+ if(ax<0x3e200000) { /* |x| < 2**-29 */
+ if(two54+x>zero /* raise inexact */
+ &&ax<0x3c900000) /* |x| < 2**-54 */
+ return x;
+ else
+ return x - x*x*0.5;
+ }
+ if(hx>0||hx<=((int)0xbfd2bec3)) {
+ k=0;f=x;hu=1;} /* -0.2929<x<0.41422 */
+ }
+ if (hx >= 0x7ff00000) return x+x;
+ if(k!=0) {
+ if(hx<0x43400000) {
+ u = 1.0+x;
+ hu = __HI(u); /* high word of u */
+ k = (hu>>20)-1023;
+ c = (k>0)? 1.0-(u-x):x-(u-1.0);/* correction term */
+ c /= u;
+ } else {
+ u = x;
+ hu = __HI(u); /* high word of u */
+ k = (hu>>20)-1023;
+ c = 0;
+ }
+ hu &= 0x000fffff;
+ if(hu<0x6a09e) {
+ __HI(u) = hu|0x3ff00000; /* normalize u */
+ } else {
+ k += 1;
+ __HI(u) = hu|0x3fe00000; /* normalize u/2 */
+ hu = (0x00100000-hu)>>2;
+ }
+ f = u-1.0;
+ }
+ hfsq=0.5*f*f;
+ if(hu==0) { /* |f| < 2**-20 */
+ if(f==zero) if(k==0) return zero;
+ else {c += k*ln2_lo; return k*ln2_hi+c;}
+ R = hfsq*(1.0-0.66666666666666666*f);
+ if(k==0) return f-R; else
+ return k*ln2_hi-((R-(k*ln2_lo+c))-f);
+ }
+ s = f/(2.0+f);
+ z = s*s;
+ R = z*(Lp1+z*(Lp2+z*(Lp3+z*(Lp4+z*(Lp5+z*(Lp6+z*Lp7))))));
+ if(k==0) return f-(hfsq-s*(hfsq+R)); else
+ return k*ln2_hi-((hfsq-(s*(hfsq+R)+(k*ln2_lo+c)))-f);
+}
diff --git a/libmath/fdlibm/s_modf.c b/libmath/fdlibm/s_modf.c
new file mode 100644
index 00000000..4549b87b
--- /dev/null
+++ b/libmath/fdlibm/s_modf.c
@@ -0,0 +1,72 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_modf.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * modf(double x, double *iptr)
+ * return fraction part of x, and return x's integral part in *iptr.
+ * Method:
+ * Bit twiddling.
+ *
+ * Exception:
+ * No exception.
+ */
+
+#include "fdlibm.h"
+
+static const double one = 1.0;
+
+ double modf(double x, double *iptr)
+{
+ int i0,i1,j0;
+ unsigned i;
+ i0 = __HI(x); /* high x */
+ i1 = __LO(x); /* low x */
+ j0 = ((i0>>20)&0x7ff)-0x3ff; /* exponent of x */
+ if(j0<20) { /* integer part in high x */
+ if(j0<0) { /* |x|<1 */
+ __HIp(iptr) = i0&0x80000000;
+ __LOp(iptr) = 0; /* *iptr = +-0 */
+ return x;
+ } else {
+ i = (0x000fffff)>>j0;
+ if(((i0&i)|i1)==0) { /* x is integral */
+ *iptr = x;
+ __HI(x) &= 0x80000000;
+ __LO(x) = 0; /* return +-0 */
+ return x;
+ } else {
+ __HIp(iptr) = i0&(~i);
+ __LOp(iptr) = 0;
+ return x - *iptr;
+ }
+ }
+ } else if (j0>51) { /* no fraction part */
+ *iptr = x*one;
+ __HI(x) &= 0x80000000;
+ __LO(x) = 0; /* return +-0 */
+ return x;
+ } else { /* fraction part in low x */
+ i = ((unsigned)(0xffffffff))>>(j0-20);
+ if((i1&i)==0) { /* x is integral */
+ *iptr = x;
+ __HI(x) &= 0x80000000;
+ __LO(x) = 0; /* return +-0 */
+ return x;
+ } else {
+ __HIp(iptr) = i0;
+ __LOp(iptr) = i1&(~i);
+ return x - *iptr;
+ }
+ }
+}
diff --git a/libmath/fdlibm/s_nextafter.c b/libmath/fdlibm/s_nextafter.c
new file mode 100644
index 00000000..8fb56bae
--- /dev/null
+++ b/libmath/fdlibm/s_nextafter.c
@@ -0,0 +1,74 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_nextafter.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* IEEE functions
+ * nextafter(x,y)
+ * return the next machine floating-point number of x in the
+ * direction toward y.
+ * Special cases:
+ */
+
+#include "fdlibm.h"
+
+ double nextafter(double x, double y)
+{
+ int hx,hy,ix,iy;
+ unsigned lx,ly;
+
+ hx = __HI(x); /* high word of x */
+ lx = __LO(x); /* low word of x */
+ hy = __HI(y); /* high word of y */
+ ly = __LO(y); /* low word of y */
+ ix = hx&0x7fffffff; /* |x| */
+ iy = hy&0x7fffffff; /* |y| */
+
+ if(((ix>=0x7ff00000)&&((ix-0x7ff00000)|lx)!=0) || /* x is nan */
+ ((iy>=0x7ff00000)&&((iy-0x7ff00000)|ly)!=0)) /* y is nan */
+ return x+y;
+ if(x==y) return x; /* x=y, return x */
+ if((ix|lx)==0) { /* x == 0 */
+ __HI(x) = hy&0x80000000; /* return +-minsubnormal */
+ __LO(x) = 1;
+ y = x*x;
+ if(y==x) return y; else return x; /* raise underflow flag */
+ }
+ if(hx>=0) { /* x > 0 */
+ if(hx>hy||((hx==hy)&&(lx>ly))) { /* x > y, x -= ulp */
+ if(lx==0) hx -= 1;
+ lx -= 1;
+ } else { /* x < y, x += ulp */
+ lx += 1;
+ if(lx==0) hx += 1;
+ }
+ } else { /* x < 0 */
+ if(hy>=0||hx>hy||((hx==hy)&&(lx>ly))){/* x < y, x -= ulp */
+ if(lx==0) hx -= 1;
+ lx -= 1;
+ } else { /* x > y, x += ulp */
+ lx += 1;
+ if(lx==0) hx += 1;
+ }
+ }
+ hy = hx&0x7ff00000;
+ if(hy>=0x7ff00000) return x+x; /* overflow */
+ if(hy<0x00100000) { /* underflow */
+ y = x*x;
+ if(y!=x) { /* raise underflow flag */
+ __HI(y) = hx; __LO(y) = lx;
+ return y;
+ }
+ }
+ __HI(x) = hx; __LO(x) = lx;
+ return x;
+}
diff --git a/libmath/fdlibm/s_rint.c b/libmath/fdlibm/s_rint.c
new file mode 100644
index 00000000..508ade7a
--- /dev/null
+++ b/libmath/fdlibm/s_rint.c
@@ -0,0 +1,88 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_rint.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* dummy routine to get around over-eager arm compiler optimization.
+ * Calling this causes a store and reload of floating point numbers
+ */
+
+void
+dummy(void)
+{
+}
+
+
+/*
+ * rint(x)
+ * Return x rounded to integral value according to the prevailing
+ * rounding mode.
+ * Method:
+ * Using floating addition.
+ * Exception:
+ * Inexact flag raised if x not equal to rint(x).
+ */
+
+#include "fdlibm.h"
+
+static const double
+TWO52[2]={
+ 4.50359962737049600000e+15, /* 0x43300000, 0x00000000 */
+ -4.50359962737049600000e+15, /* 0xC3300000, 0x00000000 */
+};
+
+ double rint(double x)
+{
+ int i0,j0,sx;
+ unsigned i,i1;
+ double w,t;
+ i0 = __HI(x);
+ sx = (i0>>31)&1;
+ i1 = __LO(x);
+ j0 = ((i0>>20)&0x7ff)-0x3ff;
+ if(j0<20) {
+ if(j0<0) {
+ if(((i0&0x7fffffff)|i1)==0) return x;
+ i1 |= (i0&0x0fffff);
+ i0 &= 0xfffe0000;
+ i0 |= ((i1|-i1)>>12)&0x80000;
+ __HI(x)=i0;
+ w = TWO52[sx]+x;
+ dummy(); /* fix optimiser */
+ t = w-TWO52[sx];
+ i0 = __HI(t);
+ __HI(t) = (i0&0x7fffffff)|(sx<<31);
+ return t;
+ } else {
+ i = (0x000fffff)>>j0;
+ if(((i0&i)|i1)==0) return x; /* x is integral */
+ i>>=1;
+ if(((i0&i)|i1)!=0) {
+ if(j0==19) i1 = 0x40000000; else
+ i0 = (i0&(~i))|((0x20000)>>j0);
+ }
+ }
+ } else if (j0>51) {
+ if(j0==0x400) return x+x; /* inf or NaN */
+ else return x; /* x is integral */
+ } else {
+ i = ((unsigned)(0xffffffff))>>(j0-20);
+ if((i1&i)==0) return x; /* x is integral */
+ i>>=1;
+ if((i1&i)!=0) i1 = (i1&(~i))|((0x40000000)>>(j0-20));
+ }
+ __HI(x) = i0;
+ __LO(x) = i1;
+ w = TWO52[sx]+x;
+ dummy(); /* fix optimiser */
+ return w-TWO52[sx];
+}
diff --git a/libmath/fdlibm/s_scalbn.c b/libmath/fdlibm/s_scalbn.c
new file mode 100644
index 00000000..cb80aecb
--- /dev/null
+++ b/libmath/fdlibm/s_scalbn.c
@@ -0,0 +1,55 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_scalbn.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/*
+ * scalbn (double x, int n)
+ * scalbn(x,n) returns x* 2**n computed by exponent
+ * manipulation rather than by actually performing an
+ * exponentiation or a multiplication.
+ */
+
+#include "fdlibm.h"
+
+static const double
+two54 = 1.80143985094819840000e+16, /* 0x43500000, 0x00000000 */
+twom54 = 5.55111512312578270212e-17, /* 0x3C900000, 0x00000000 */
+Huge = 1.0e+300,
+tiny = 1.0e-300;
+
+ double scalbn (double x, int n)
+{
+ int k,hx,lx;
+ hx = __HI(x);
+ lx = __LO(x);
+ k = (hx&0x7ff00000)>>20; /* extract exponent */
+ if (k==0) { /* 0 or subnormal x */
+ if ((lx|(hx&0x7fffffff))==0) return x; /* +-0 */
+ x *= two54;
+ hx = __HI(x);
+ k = ((hx&0x7ff00000)>>20) - 54;
+ if (n< -50000) return tiny*x; /*underflow*/
+ }
+ if (k==0x7ff) return x+x; /* NaN or Inf */
+ k = k+n;
+ if (k > 0x7fe) return Huge*copysign(Huge,x); /* overflow */
+ if (k > 0) /* normal result */
+ {__HI(x) = (hx&0x800fffff)|(k<<20); return x;}
+ if (k <= -54)
+ if (n > 50000) /* in case integer overflow in n+k */
+ return Huge*copysign(Huge,x); /*overflow*/
+ else return tiny*copysign(tiny,x); /*underflow*/
+ k += 54; /* subnormal result */
+ __HI(x) = (hx&0x800fffff)|(k<<20);
+ return x*twom54;
+}
diff --git a/libmath/fdlibm/s_sin.c b/libmath/fdlibm/s_sin.c
new file mode 100644
index 00000000..ed519c63
--- /dev/null
+++ b/libmath/fdlibm/s_sin.c
@@ -0,0 +1,74 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_sin.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* sin(x)
+ * Return sine function of x.
+ *
+ * kernel function:
+ * __kernel_sin ... sine function on [-pi/4,pi/4]
+ * __kernel_cos ... cose function on [-pi/4,pi/4]
+ * __ieee754_rem_pio2 ... argument reduction routine
+ *
+ * Method.
+ * Let S,C and T denote the sin, cos and tan respectively on
+ * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
+ * in [-pi/4 , +pi/4], and let n = k mod 4.
+ * We have
+ *
+ * n sin(x) cos(x) tan(x)
+ * ----------------------------------------------------------
+ * 0 S C T
+ * 1 C -S -1/T
+ * 2 -S -C T
+ * 3 -C S -1/T
+ * ----------------------------------------------------------
+ *
+ * Special cases:
+ * Let trig be any of sin, cos, or tan.
+ * trig(+-INF) is NaN, with signals;
+ * trig(NaN) is that NaN;
+ *
+ * Accuracy:
+ * TRIG(x) returns trig(x) nearly rounded
+ */
+
+#include "fdlibm.h"
+
+ double sin(double x)
+{
+ double y[2],z=0.0;
+ int n, ix;
+
+ /* High word of x. */
+ ix = __HI(x);
+
+ /* |x| ~< pi/4 */
+ ix &= 0x7fffffff;
+ if(ix <= 0x3fe921fb) return __kernel_sin(x,z,0);
+
+ /* sin(Inf or NaN) is NaN */
+ else if (ix>=0x7ff00000) return x-x;
+
+ /* argument reduction needed */
+ else {
+ n = __ieee754_rem_pio2(x,y);
+ switch(n&3) {
+ case 0: return __kernel_sin(y[0],y[1],1);
+ case 1: return __kernel_cos(y[0],y[1]);
+ case 2: return -__kernel_sin(y[0],y[1],1);
+ default:
+ return -__kernel_cos(y[0],y[1]);
+ }
+ }
+}
diff --git a/libmath/fdlibm/s_tan.c b/libmath/fdlibm/s_tan.c
new file mode 100644
index 00000000..ae89cdb6
--- /dev/null
+++ b/libmath/fdlibm/s_tan.c
@@ -0,0 +1,68 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_tan.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* tan(x)
+ * Return tangent function of x.
+ *
+ * kernel function:
+ * __kernel_tan ... tangent function on [-pi/4,pi/4]
+ * __ieee754_rem_pio2 ... argument reduction routine
+ *
+ * Method.
+ * Let S,C and T denote the sin, cos and tan respectively on
+ * [-PI/4, +PI/4]. Reduce the argument x to y1+y2 = x-k*pi/2
+ * in [-pi/4 , +pi/4], and let n = k mod 4.
+ * We have
+ *
+ * n sin(x) cos(x) tan(x)
+ * ----------------------------------------------------------
+ * 0 S C T
+ * 1 C -S -1/T
+ * 2 -S -C T
+ * 3 -C S -1/T
+ * ----------------------------------------------------------
+ *
+ * Special cases:
+ * Let trig be any of sin, cos, or tan.
+ * trig(+-INF) is NaN, with signals;
+ * trig(NaN) is that NaN;
+ *
+ * Accuracy:
+ * TRIG(x) returns trig(x) nearly rounded
+ */
+
+#include "fdlibm.h"
+
+ double tan(double x)
+{
+ double y[2],z=0.0;
+ int n, ix;
+
+ /* High word of x. */
+ ix = __HI(x);
+
+ /* |x| ~< pi/4 */
+ ix &= 0x7fffffff;
+ if(ix <= 0x3fe921fb) return __kernel_tan(x,z,1);
+
+ /* tan(Inf or NaN) is NaN */
+ else if (ix>=0x7ff00000) return x-x; /* NaN */
+
+ /* argument reduction needed */
+ else {
+ n = __ieee754_rem_pio2(x,y);
+ return __kernel_tan(y[0],y[1],1-((n&1)<<1)); /* 1 -- n even
+ -1 -- n odd */
+ }
+}
diff --git a/libmath/fdlibm/s_tanh.c b/libmath/fdlibm/s_tanh.c
new file mode 100644
index 00000000..e7051c4e
--- /dev/null
+++ b/libmath/fdlibm/s_tanh.c
@@ -0,0 +1,74 @@
+/* derived from /netlib/fdlibm */
+
+/* @(#)s_tanh.c 1.3 95/01/18 */
+/*
+ * ====================================================
+ * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved.
+ *
+ * Developed at SunSoft, a Sun Microsystems, Inc. business.
+ * Permission to use, copy, modify, and distribute this
+ * software is freely granted, provided that this notice
+ * is preserved.
+ * ====================================================
+ */
+
+/* Tanh(x)
+ * Return the Hyperbolic Tangent of x
+ *
+ * Method :
+ * x -x
+ * e - e
+ * 0. tanh(x) is defined to be -----------
+ * x -x
+ * e + e
+ * 1. reduce x to non-negative by tanh(-x) = -tanh(x).
+ * 2. 0 <= x <= 2**-55 : tanh(x) := x*(one+x)
+ * -t
+ * 2**-55 < x <= 1 : tanh(x) := -----; t = expm1(-2x)
+ * t + 2
+ * 2
+ * 1 <= x <= 22.0 : tanh(x) := 1- ----- ; t=expm1(2x)
+ * t + 2
+ * 22.0 < x <= INF : tanh(x) := 1.
+ *
+ * Special cases:
+ * tanh(NaN) is NaN;
+ * only tanh(0)=0 is exact for finite argument.
+ */
+
+#include "fdlibm.h"
+
+static const double one=1.0, two=2.0, tiny = 1.0e-300;
+
+ double tanh(double x)
+{
+ double t,z;
+ int jx,ix;
+
+ /* High word of |x|. */
+ jx = __HI(x);
+ ix = jx&0x7fffffff;
+
+ /* x is INF or NaN */
+ if(ix>=0x7ff00000) {
+ if (jx>=0) return one/x+one; /* tanh(+-inf)=+-1 */
+ else return one/x-one; /* tanh(NaN) = NaN */
+ }
+
+ /* |x| < 22 */
+ if (ix < 0x40360000) { /* |x|<22 */
+ if (ix<0x3c800000) /* |x|<2**-55 */
+ return x*(one+x); /* tanh(small) = small */
+ if (ix>=0x3ff00000) { /* |x|>=1 */
+ t = expm1(two*fabs(x));
+ z = one - two/(t+two);
+ } else {
+ t = expm1(-two*fabs(x));
+ z= -t/(t+two);
+ }
+ /* |x| > 22, return +-1 */
+ } else {
+ z = one - tiny; /* raised inexact flag */
+ }
+ return (jx>=0)? z: -z;
+}
diff --git a/libmath/g_fmt.c b/libmath/g_fmt.c
new file mode 100644
index 00000000..82f5cba1
--- /dev/null
+++ b/libmath/g_fmt.c
@@ -0,0 +1,106 @@
+/****************************************************************
+ *
+ * The author of this software is David M. Gay.
+ *
+ * Copyright (c) 1991, 1996 by Lucent Technologies.
+ *
+ * Permission to use, copy, modify, and distribute this software for any
+ * purpose without fee is hereby granted, provided that this entire notice
+ * is included in all copies of any software which is or includes a copy
+ * or modification of this software and in all copies of the supporting
+ * documentation for such software.
+ *
+ * THIS SOFTWARE IS BEING PROVIDED "AS IS", WITHOUT ANY EXPRESS OR IMPLIED
+ * WARRANTY. IN PARTICULAR, NEITHER THE AUTHOR NOR LUCENT MAKES ANY
+ * REPRESENTATION OR WARRANTY OF ANY KIND CONCERNING THE MERCHANTABILITY
+ * OF THIS SOFTWARE OR ITS FITNESS FOR ANY PARTICULAR PURPOSE.
+ *
+ ***************************************************************/
+
+/* g_fmt(buf,x) stores the closest decimal approximation to x in buf;
+ * it suffices to declare buf
+ * char buf[32];
+ */
+
+#ifdef __cplusplus
+extern "C" {
+#endif
+ extern char *dtoa(double, int, int, int *, int *, char **);
+ extern char *g_fmt(char *, double, int);
+ extern void freedtoa(char*);
+#ifdef __cplusplus
+ }
+#endif
+
+ char *
+g_fmt(register char *b, double x, int echr)
+{
+ register int i, k;
+ register char *s;
+ int decpt, j, sign;
+ char *b0, *s0, *se;
+
+ b0 = b;
+#ifdef IGNORE_ZERO_SIGN
+ if (!x) {
+ *b++ = '0';
+ *b = 0;
+ goto done;
+ }
+#endif
+ s = s0 = dtoa(x, 0, 0, &decpt, &sign, &se);
+ if (sign)
+ *b++ = '-';
+ if (decpt == 9999) /* Infinity or Nan */ {
+ while(*b++ = *s++);
+ goto done0;
+ }
+ if (decpt <= -4 || decpt > se - s + 5) {
+ *b++ = *s++;
+ if (*s) {
+ *b++ = '.';
+ while(*b = *s++)
+ b++;
+ }
+ *b++ = echr;
+ /* sprintf(b, "%+.2d", decpt - 1); */
+ if (--decpt < 0) {
+ *b++ = '-';
+ decpt = -decpt;
+ }
+ else
+ *b++ = '+';
+ for(j = 2, k = 10; 10*k <= decpt; j++, k *= 10);
+ for(;;) {
+ i = decpt / k;
+ *b++ = i + '0';
+ if (--j <= 0)
+ break;
+ decpt -= i*k;
+ decpt *= 10;
+ }
+ *b = 0;
+ }
+ else if (decpt <= 0) {
+ *b++ = '.';
+ for(; decpt < 0; decpt++)
+ *b++ = '0';
+ while(*b++ = *s++);
+ }
+ else {
+ while(*b = *s++) {
+ b++;
+ if (--decpt == 0 && *s)
+ *b++ = '.';
+ }
+ for(; decpt > 0; decpt--)
+ *b++ = '0';
+ *b = 0;
+ }
+ done0:
+ freedtoa(s0);
+#ifdef IGNORE_ZERO_SIGN
+ done:
+#endif
+ return b0;
+ }
diff --git a/libmath/gemm.c b/libmath/gemm.c
new file mode 100644
index 00000000..908a0998
--- /dev/null
+++ b/libmath/gemm.c
@@ -0,0 +1,167 @@
+#include "lib9.h"
+#include "mathi.h"
+void
+gemm(int transa, int transb, int m, int n, int k, double alpha,
+ double *a, int lda,
+ double *b, int ldb, double beta,
+ double *c, int ldc)
+{
+ int i1, i2, i3, nota, notb, i, j, jb, jc, l, la;
+ double temp;
+
+ nota = transa=='N';
+ notb = transb=='N';
+
+ if(m == 0 || n == 0 || (alpha == 0. || k == 0) && beta == 1.){
+ return;
+ }
+ if(alpha == 0.){
+ if(beta == 0.){
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = 0.;
+ }
+ }
+ }else{
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = beta * c[i + jc];
+ }
+ }
+ }
+ return;
+ }
+
+ if(!a){
+ if(notb){ /* C := alpha*B + beta*C. */
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jb = j*ldb;
+ jc = j*ldc;
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = alpha*b[i+jb] + beta*c[i+jc];
+ }
+ }
+ }else{ /* C := alpha*B' + beta*C. */
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = alpha*b[j+i*ldb] + beta*c[i+jc];
+ }
+ }
+ }
+ return;
+ }
+
+ if(notb){
+ if(nota){
+
+/* Form C := alpha*A*B + beta*C. */
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ if(beta == 0.){
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = 0.;
+ }
+ }else if(beta != 1.){
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = beta * c[i + jc];
+ }
+ }
+ i2 = k;
+ for(l = 0; l < i2; ++l){
+ la = l*lda;
+ if(b[l + j*ldb] != 0.){
+ temp = alpha * b[l + j*ldb];
+ i3 = m;
+ for(i = 0; i < i3; ++i){
+ c[i + jc] += temp * a[i + la];
+ }
+ }
+ }
+ }
+ }else{
+
+/* Form C := alpha*A'*B + beta*C */
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ temp = 0.;
+ i3 = k;
+ for(l = 0; l < i3; ++l){
+ temp += a[l + i*lda] * b[l + j*ldb];
+ }
+ if(beta == 0.){
+ c[i + jc] = alpha * temp;
+ }else{
+ c[i + jc] = alpha * temp + beta * c[i + jc];
+ }
+ }
+ }
+ }
+ }else{
+ if(nota){
+
+/* Form C := alpha*A*B' + beta*C */
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ if(beta == 0.){
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = 0.;
+ }
+ }else if(beta != 1.){
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ c[i + jc] = beta * c[i + jc];
+ }
+ }
+ i2 = k;
+ for(l = 0; l < i2; ++l){
+ if(b[j + l*ldb] != 0.){
+ temp = alpha * b[j + l*ldb];
+ i3 = m;
+ for(i = 0; i < i3; ++i){
+ c[i + jc] += temp * a[i + l*lda];
+ }
+ }
+ }
+ }
+ }else{
+
+/* Form C := alpha*A'*B' + beta*C */
+ i1 = n;
+ for(j = 0; j < i1; ++j){
+ jc = j*ldc;
+ i2 = m;
+ for(i = 0; i < i2; ++i){
+ temp = 0.;
+ i3 = k;
+ for(l = 0; l < i3; ++l){
+ temp += a[l + i*lda] * b[j + l*ldb];
+ }
+ if(beta == 0.){
+ c[i + jc] = alpha * temp;
+ }else{
+ c[i + jc] = alpha * temp + beta * c[i + jc];
+ }
+ }
+ }
+ }
+ }
+}
diff --git a/libmath/gfltconv.c b/libmath/gfltconv.c
new file mode 100644
index 00000000..497b71f9
--- /dev/null
+++ b/libmath/gfltconv.c
@@ -0,0 +1,123 @@
+#include "lib9.h"
+#include "mathi.h"
+extern char *dtoa(double, int, int, int *, int *, char **);
+extern void freedtoa(char*);
+extern int _fmtcpy(Fmt*, void*, int, int);
+
+enum
+{
+ NONE = -1000,
+ FDIGIT = 20,
+ FDEFLT = 6,
+ NSIGNIF = 17
+};
+
+int
+gfltconv(Fmt *f)
+{
+ int flags = f->flags;
+ int precision;
+ int fmt = f->r;
+ double d;
+ int echr, exponent, sign, ndig, nout, i;
+ char *digits, *edigits, ebuf[32], *eptr;
+ char out[64], *pout;
+
+ d = va_arg(f->args, double);
+ echr = 'e';
+ precision = FDEFLT;
+ if(f->flags & FmtPrec)
+ precision = f->prec;
+ if(precision > FDIGIT)
+ precision = FDIGIT;
+ switch(fmt){
+ case 'f':
+ digits = dtoa(d, 3, precision, &exponent, &sign, &edigits);
+ break;
+ case 0x00c9: /* L'É' */
+ case 'E':
+ echr = 'E';
+ fmt = 'e';
+ /* fall through */
+ case 'e':
+ digits = dtoa(d, 2, 1+precision, &exponent, &sign, &edigits);
+ break;
+ case 'G':
+ echr = 'E';
+ /* fall through */
+ default:
+ case 'g':
+ if((flags&(FmtWidth|FmtPrec)) == 0){
+ g_fmt(out, d, echr);
+ f->flags &= FmtWidth|FmtLeft;
+ return _fmtcpy(f, out, strlen(out), strlen(out));
+ }
+ if (precision > 0)
+ digits = dtoa(d, 2, precision, &exponent, &sign, &edigits);
+ else {
+ digits = dtoa(d, 0, precision, &exponent, &sign, &edigits);
+ precision = edigits - digits;
+ if (exponent > precision && exponent <= precision + 4)
+ precision = exponent;
+ }
+ if(exponent >= -3 && exponent <= precision){
+ fmt = 'f';
+ precision -= exponent;
+ }else{
+ fmt = 'e';
+ --precision;
+ }
+ break;
+ }
+ if (exponent == 9999) {
+ /* Infinity or Nan */
+ precision = 0;
+ exponent = edigits - digits;
+ fmt = 'f';
+ }
+ ndig = edigits-digits;
+ if((f->r=='g' || f->r=='G') && !(flags&FmtSharp)){ /* knock off trailing zeros */
+ if(fmt == 'f'){
+ if(precision+exponent > ndig) {
+ precision = ndig - exponent;
+ if(precision < 0)
+ precision = 0;
+ }
+ }
+ else{
+ if(precision > ndig-1) precision = ndig-1;
+ }
+ }
+ eptr = ebuf;
+ if(fmt != 'f'){ /* exponent */
+ for(i=exponent<=0?1-exponent:exponent-1; i; i/=10)
+ *eptr++ = '0' + i%10;
+ while(eptr<ebuf+2) *eptr++ = '0';
+ }
+ pout = out;
+ if(sign) *pout++ = '-';
+ else if(flags&FmtSign) *pout++ = '+';
+ else if(flags&FmtSpace) *pout++ = ' ';
+ if(fmt == 'f'){
+ for(i=0; i<exponent; i++) *pout++ = i<ndig?digits[i]:'0';
+ if(i == 0) *pout++ = '0';
+ if(precision>0 || flags&FmtSharp) *pout++ = '.';
+ for(i=0; i!=precision; i++)
+ *pout++ = 0<=i+exponent && i+exponent<ndig?digits[i+exponent]:'0';
+ }
+ else{
+ *pout++ = digits[0];
+ if(precision>0 || flags&FmtSharp) *pout++ = '.';
+ for(i=0; i!=precision; i++) *pout++ = i<ndig-1?digits[i+1]:'0';
+ }
+ if(fmt != 'f'){
+ *pout++ = echr;
+ *pout++ = exponent<=0?'-':'+';
+ while(eptr>ebuf) *pout++ = *--eptr;
+ }
+ *pout = 0;
+ freedtoa(digits);
+ f->flags &= FmtWidth|FmtLeft;
+ nout = pout-out;
+ return _fmtcpy(f, out, nout, nout);
+}
diff --git a/libmath/mkfile b/libmath/mkfile
new file mode 100644
index 00000000..5c668951
--- /dev/null
+++ b/libmath/mkfile
@@ -0,0 +1,67 @@
+<../mkconfig
+
+TARGTYPE=${SYSTARG:os%=Inferno%} # maps 'os' into 'Inferno'
+
+LIB=libmath.a
+OFILES=\
+ blas.$O\
+ dtoa.$O\
+ fdim.$O\
+ FPcontrol-$TARGTYPE.$O\
+ gemm.$O\
+ g_fmt.$O\
+ gfltconv.$O\
+ pow10.$O\
+ e_acos.$O\
+ e_acosh.$O\
+ e_asin.$O\
+ e_atan2.$O\
+ e_atanh.$O\
+ e_cosh.$O\
+ e_exp.$O\
+ e_fmod.$O\
+ e_hypot.$O\
+ e_j0.$O\
+ e_j1.$O\
+ e_jn.$O\
+ e_lgamma_r.$O\
+ e_log.$O\
+ e_log10.$O\
+ e_pow.$O\
+ e_rem_pio2.$O\
+ e_remainder.$O\
+ e_sinh.$O\
+ e_sqrt.$O\
+ k_cos.$O\
+ k_rem_pio2.$O\
+ k_sin.$O\
+ k_tan.$O\
+ s_asinh.$O\
+ s_atan.$O\
+ s_cbrt.$O\
+ s_ceil.$O\
+ s_copysign.$O\
+ s_cos.$O\
+ s_erf.$O\
+ s_expm1.$O\
+ s_fabs.$O\
+ s_finite.$O\
+ s_floor.$O\
+ s_ilogb.$O\
+ s_isnan.$O\
+ s_log1p.$O\
+ s_nextafter.$O\
+ s_rint.$O\
+ s_scalbn.$O\
+ s_sin.$O\
+ s_tan.$O\
+ s_tanh.$O\
+
+HFILES=\
+ $ROOT/include/mathi.h\
+ fdlibm/fdlibm.h\
+
+<$ROOT/mkfiles/mksyslib-$SHELLTYPE
+
+%.$O: fdlibm/%.c
+ $CC $CFLAGS -o $target -Ifdlibm fdlibm/$stem.c
diff --git a/libmath/pow10.c b/libmath/pow10.c
new file mode 100644
index 00000000..46bf5c31
--- /dev/null
+++ b/libmath/pow10.c
@@ -0,0 +1,8 @@
+#include "lib9.h"
+#include "mathi.h"
+
+double
+ipow10(int n)
+{
+ return pow(10.,n);
+}