diff options
| author | shaolin <[email protected]> | 2014-03-04 09:14:48 +0800 |
|---|---|---|
| committer | shaolin <[email protected]> | 2014-03-04 09:14:48 +0800 |
| commit | 020e95d91b5e1d7f902674a320e42657bee3ebfe (patch) | |
| tree | 65b65bfa527e0e8670dc807a8fee8d507d67ca48 /components/external/espruino/libs/math | |
| parent | 0fb9c54efda7fef4346523fdc4b92512a0441ee1 (diff) | |
| parent | 738871fd9ebbd53da6cfcc429dfdd5ffc17fd685 (diff) | |
Merge branch 'master' of https://github.com/RT-Thread/rt-thread
Diffstat (limited to 'components/external/espruino/libs/math')
53 files changed, 12052 insertions, 0 deletions
diff --git a/components/external/espruino/libs/math/README b/components/external/espruino/libs/math/README new file mode 100644 index 0000000000..97f3586c52 --- /dev/null +++ b/components/external/espruino/libs/math/README @@ -0,0 +1,32 @@ + +This suite of C language elementary functions offers support for +not-a-number (NaN) and infinity rules, subnormal numbers, and minus +zero as described by IEEE standard 754 and the Numerical C Extensions +Group (NCEG). For a variety of reasons, many computers cannot take +advantage of these features. You can disable any or all of them by +removing the corresponding preprocessor macros. Check the files +mconf.h and const.c carefully to be sure they are appropriate for your +system. + + + +------------------------------------------ + +http://www.netlib.org/cephes/readme + + Some software in this archive may be from the book _Methods and +Programs for Mathematical Functions_ (Prentice-Hall or Simon & Schuster +International, 1989) or from the Cephes Mathematical Library, a +commercial product. In either event, it is copyrighted by the author. +What you see here may be used freely but it comes with no support or +guarantee. + + The two known misprints in the book are repaired here in the +source listings for the gamma function and the incomplete beta +integral. + + + Stephen L. Moshier + + diff --git a/components/external/espruino/libs/math/acosh.c b/components/external/espruino/libs/math/acosh.c new file mode 100644 index 0000000000..216e00d60b --- /dev/null +++ b/components/external/espruino/libs/math/acosh.c @@ -0,0 +1,167 @@ +/* acosh.c + * + * Inverse hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * double x, y, acosh(); + * + * y = acosh( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic cosine of argument. + * + * If 1 <= x < 1.5, a rational approximation + * + * sqrt(z) * P(z)/Q(z) + * + * where z = x-1, is used. Otherwise, + * + * acosh(x) = log( x + sqrt( (x-1)(x+1) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC 1,3 30000 4.2e-17 1.1e-17 + * IEEE 1,3 30000 4.6e-16 8.7e-17 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * acosh domain |x| < 1 NAN + * + */ + +/* acosh.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +/* acosh(z) = sqrt(x) * R(x), z = x + 1, interval 0 < x < 0.5 */ + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { + 1.18801130533544501356E2, + 3.94726656571334401102E3, + 3.43989375926195455866E4, + 1.08102874834699867335E5, + 1.10855947270161294369E5 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 1.86145380837903397292E2, + 4.15352677227719831579E3, + 2.97683430363289370382E4, + 8.29725251988426222434E4, + 7.83869920495893927727E4 +}; +#endif + +#ifdef DEC +static unsigned short P[] = { +0041755,0115055,0144002,0146444, +0043166,0132103,0155150,0150302, +0044006,0057360,0003021,0162753, +0044323,0021557,0175225,0056253, +0044330,0101771,0040046,0006636 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0042072,0022467,0126670,0041232, +0043201,0146066,0152142,0034015, +0043750,0110257,0121165,0026100, +0044242,0007103,0034667,0033173, +0044231,0014576,0175573,0017472 +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x59a4,0xb900,0xb345,0x405d, +0x1a18,0x7b4d,0xd688,0x40ae, +0x3cbd,0x00c2,0xcbde,0x40e0, +0xab95,0xff52,0x646d,0x40fa, +0xc1b4,0x2804,0x107f,0x40fb +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x0853,0xf5b7,0x44a6,0x4067, +0x4702,0xda8c,0x3986,0x40b0, +0xa588,0xf44e,0x1215,0x40dd, +0xe6cf,0x6736,0x41c8,0x40f4, +0x63e7,0xdf6f,0x232f,0x40f3 +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x405d,0xb345,0xb900,0x59a4, +0x40ae,0xd688,0x7b4d,0x1a18, +0x40e0,0xcbde,0x00c2,0x3cbd, +0x40fa,0x646d,0xff52,0xab95, +0x40fb,0x107f,0x2804,0xc1b4 +}; +static unsigned short Q[] = { +0x4067,0x44a6,0xf5b7,0x0853, +0x40b0,0x3986,0xda8c,0x4702, +0x40dd,0x1215,0xf44e,0xa588, +0x40f4,0x41c8,0x6736,0xe6cf, +0x40f3,0x232f,0xdf6f,0x63e7, +}; +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double log ( double ); +extern double sqrt ( double ); +#else +double log(), sqrt(), polevl(), p1evl(); +#endif +extern double LOGE2, INFINITY, NAN; + +double acosh(x) +double x; +{ +double a, z; + +if( x < 1.0 ) + { + mtherr( "acosh", DOMAIN ); + return(NAN); + } + +if( x > 1.0e8 ) + { +#ifdef INFINITIES + if( x == INFINITY ) + return( INFINITY ); +#endif + return( log(x) + LOGE2 ); + } + +z = x - 1.0; + +if( z < 0.5 ) + { + a = sqrt(z) * (polevl(z, P, 4) / p1evl(z, Q, 5) ); + return( a ); + } + +a = sqrt( z*(x+1.0) ); +return( log(x + a) ); +} diff --git a/components/external/espruino/libs/math/asin.c b/components/external/espruino/libs/math/asin.c new file mode 100644 index 0000000000..1a4cea33e0 --- /dev/null +++ b/components/external/espruino/libs/math/asin.c @@ -0,0 +1,324 @@ +/* asin.c + * + * Inverse circular sine + * + * + * + * SYNOPSIS: + * + * double x, y, asin(); + * + * y = asin( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose sine is x. + * + * A rational function of the form x + x**3 P(x**2)/Q(x**2) + * is used for |x| in the interval [0, 0.5]. If |x| > 0.5 it is + * transformed by the identity + * + * asin(x) = pi/2 - 2 asin( sqrt( (1-x)/2 ) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -1, 1 40000 2.6e-17 7.1e-18 + * IEEE -1, 1 10^6 1.9e-16 5.4e-17 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * asin domain |x| > 1 NAN + * + */ + /* acos() + * + * Inverse circular cosine + * + * + * + * SYNOPSIS: + * + * double x, y, acos(); + * + * y = acos( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between 0 and pi whose cosine + * is x. + * + * Analytically, acos(x) = pi/2 - asin(x). However if |x| is + * near 1, there is cancellation error in subtracting asin(x) + * from pi/2. Hence if x < -0.5, + * + * acos(x) = pi - 2.0 * asin( sqrt((1+x)/2) ); + * + * or if x > +0.5, + * + * acos(x) = 2.0 * asin( sqrt((1-x)/2) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -1, 1 50000 3.3e-17 8.2e-18 + * IEEE -1, 1 10^6 2.2e-16 6.5e-17 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * asin domain |x| > 1 NAN + */ + +/* asin.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +/* arcsin(x) = x + x^3 P(x^2)/Q(x^2) + 0 <= x <= 0.625 + Peak relative error = 1.2e-18 */ +#if UNK +const static double P[6] = { + 4.253011369004428248960E-3, +-6.019598008014123785661E-1, + 5.444622390564711410273E0, +-1.626247967210700244449E1, + 1.956261983317594739197E1, +-8.198089802484824371615E0, +}; +const static double Q[5] = { +/* 1.000000000000000000000E0, */ +-1.474091372988853791896E1, + 7.049610280856842141659E1, +-1.471791292232726029859E2, + 1.395105614657485689735E2, +-4.918853881490881290097E1, +}; +#endif +#if DEC +static short P[24] = { +0036213,0056330,0057244,0053234, +0140032,0015011,0114762,0160255, +0040656,0035130,0136121,0067313, +0141202,0014616,0170474,0101731, +0041234,0100076,0151674,0111310, +0141003,0025540,0033165,0077246, +}; +static short Q[20] = { +/* 0040200,0000000,0000000,0000000, */ +0141153,0155310,0055360,0072530, +0041614,0177001,0027764,0101237, +0142023,0026733,0064653,0133266, +0042013,0101264,0023775,0176351, +0141504,0140420,0050660,0036543, +}; +#endif +#if IBMPC +static short P[24] = { +0x8ad3,0x0bd4,0x6b9b,0x3f71, +0x5c16,0x333e,0x4341,0xbfe3, +0x2dd9,0x178a,0xc74b,0x4015, +0x907b,0xde27,0x4331,0xc030, +0x9259,0xda77,0x9007,0x4033, +0xafd5,0x06ce,0x656c,0xc020, +}; +static short Q[20] = { +/* 0x0000,0x0000,0x0000,0x3ff0, */ +0x0eab,0x0b5e,0x7b59,0xc02d, +0x9054,0x25fe,0x9fc0,0x4051, +0x76d7,0x6d35,0x65bb,0xc062, +0xbf9d,0x84ff,0x7056,0x4061, +0x07ac,0x0a36,0x9822,0xc048, +}; +#endif +#if MIEEE +static short P[24] = { +0x3f71,0x6b9b,0x0bd4,0x8ad3, +0xbfe3,0x4341,0x333e,0x5c16, +0x4015,0xc74b,0x178a,0x2dd9, +0xc030,0x4331,0xde27,0x907b, +0x4033,0x9007,0xda77,0x9259, +0xc020,0x656c,0x06ce,0xafd5, +}; +static short Q[20] = { +/* 0x3ff0,0x0000,0x0000,0x0000, */ +0xc02d,0x7b59,0x0b5e,0x0eab, +0x4051,0x9fc0,0x25fe,0x9054, +0xc062,0x65bb,0x6d35,0x76d7, +0x4061,0x7056,0x84ff,0xbf9d, +0xc048,0x9822,0x0a36,0x07ac, +}; +#endif + +/* arcsin(1-x) = pi/2 - sqrt(2x)(1+R(x)) + 0 <= x <= 0.5 + Peak relative error = 4.2e-18 */ +#if UNK +const static double R[5] = { + 2.967721961301243206100E-3, +-5.634242780008963776856E-1, + 6.968710824104713396794E0, +-2.556901049652824852289E1, + 2.853665548261061424989E1, +}; +const static double S[4] = { +/* 1.000000000000000000000E0, */ +-2.194779531642920639778E1, + 1.470656354026814941758E2, +-3.838770957603691357202E2, + 3.424398657913078477438E2, +}; +#endif +#if DEC +static short R[20] = { +0036102,0077034,0142164,0174103, +0140020,0036222,0147711,0044173, +0040736,0177655,0153631,0171523, +0141314,0106525,0060015,0055474, +0041344,0045422,0003630,0040344, +}; +static short S[16] = { +/* 0040200,0000000,0000000,0000000, */ +0141257,0112425,0132772,0166136, +0042023,0010315,0075523,0175020, +0142277,0170104,0126203,0017563, +0042253,0034115,0102662,0022757, +}; +#endif +#if IBMPC +static short R[20] = { +0x9f08,0x988e,0x4fc3,0x3f68, +0x290f,0x59f9,0x0792,0xbfe2, +0x3e6a,0xbaf3,0xdff5,0x401b, +0xab68,0xac01,0x91aa,0xc039, +0x081d,0x40f3,0x8962,0x403c, +}; +static short S[16] = { +/* 0x0000,0x0000,0x0000,0x3ff0, */ +0x5d8c,0xb6bf,0xf2a2,0xc035, +0x7f42,0xaf6a,0x6219,0x4062, +0x63ee,0x9590,0xfe08,0xc077, +0x44be,0xb0b6,0x6709,0x4075, +}; +#endif +#if MIEEE +static short R[20] = { +0x3f68,0x4fc3,0x988e,0x9f08, +0xbfe2,0x0792,0x59f9,0x290f, +0x401b,0xdff5,0xbaf3,0x3e6a, +0xc039,0x91aa,0xac01,0xab68, +0x403c,0x8962,0x40f3,0x081d, +}; +static short S[16] = { +/* 0x3ff0,0x0000,0x0000,0x0000, */ +0xc035,0xf2a2,0xb6bf,0x5d8c, +0x4062,0x6219,0xaf6a,0x7f42, +0xc077,0xfe08,0x9590,0x63ee, +0x4075,0x6709,0xb0b6,0x44be, +}; +#endif + +/* pi/2 = PIO2 + MOREBITS. */ +#ifdef DEC +#define MOREBITS 5.721188726109831840122E-18 +#else +#define MOREBITS 6.123233995736765886130E-17 +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double sqrt ( double ); +double asin ( double ); +#else +double sqrt(), polevl(), p1evl(); +double asin(); +#endif +extern double PIO2, PIO4, NAN; + +double asin(x) +double x; +{ +double a, p, z, zz; +short sign; + +if( x > 0 ) + { + sign = 1; + a = x; + } +else + { + sign = -1; + a = -x; + } + +if( a > 1.0 ) + { + mtherr( "asin", DOMAIN ); + return( NAN ); + } + +if( a > 0.625 ) + { + /* arcsin(1-x) = pi/2 - sqrt(2x)(1+R(x)) */ + zz = 1.0 - a; + p = zz * polevl( zz, R, 4)/p1evl( zz, S, 4); + zz = sqrt(zz+zz); + z = PIO4 - zz; + zz = zz * p - MOREBITS; + z = z - zz; + z = z + PIO4; + } +else + { + if( a < 1.0e-8 ) + { + return(x); + } + zz = a * a; + z = zz * polevl( zz, P, 5)/p1evl( zz, Q, 5); + z = a * z + a; + } +if( sign < 0 ) + z = -z; +return(z); +} + + + +double acos(x) +double x; +{ +double z; + +if( (x < -1.0) || (x > 1.0) ) + { + mtherr( "acos", DOMAIN ); + return( NAN ); + } +if( x > 0.5 ) + { + return( 2.0 * asin( sqrt(0.5 - 0.5*x) ) ); + } +z = PIO4 - asin(x); +z = z + MOREBITS; +z = z + PIO4; +return( z ); +} diff --git a/components/external/espruino/libs/math/asinh.c b/components/external/espruino/libs/math/asinh.c new file mode 100644 index 0000000000..e0caecab70 --- /dev/null +++ b/components/external/espruino/libs/math/asinh.c @@ -0,0 +1,165 @@ +/* asinh.c + * + * Inverse hyperbolic sine + * + * + * + * SYNOPSIS: + * + * double x, y, asinh(); + * + * y = asinh( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic sine of argument. + * + * If |x| < 0.5, the function is approximated by a rational + * form x + x**3 P(x)/Q(x). Otherwise, + * + * asinh(x) = log( x + sqrt(1 + x*x) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -3,3 75000 4.6e-17 1.1e-17 + * IEEE -1,1 30000 3.7e-16 7.8e-17 + * IEEE 1,3 30000 2.5e-16 6.7e-17 + * + */ + +/* asinh.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { +-4.33231683752342103572E-3, +-5.91750212056387121207E-1, +-4.37390226194356683570E0, +-9.09030533308377316566E0, +-5.56682227230859640450E0 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 1.28757002067426453537E1, + 4.86042483805291788324E1, + 6.95722521337257608734E1, + 3.34009336338516356383E1 +}; +#endif + +#ifdef DEC +static unsigned short P[] = { +0136215,0173033,0110410,0105475, +0140027,0076361,0020056,0164520, +0140613,0173401,0160136,0053142, +0141021,0070744,0000503,0176261, +0140662,0021550,0073106,0133351 +}; +static unsigned short Q[] = { +/* 0040200,0000000,0000000,0000000,*/ +0041116,0001336,0034120,0173054, +0041502,0065300,0013144,0021231, +0041613,0022376,0035516,0153063, +0041405,0115216,0054265,0004557 +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x1168,0x7221,0xbec3,0xbf71, +0xdd2a,0x2405,0xef9e,0xbfe2, +0xcacc,0x3c0b,0x7ee0,0xc011, +0x7f96,0x8028,0x2e3c,0xc022, +0xd6dd,0x0ec8,0x446d,0xc016 +}; +static unsigned short Q[] = { +/* 0x0000,0x0000,0x0000,0x3ff0,*/ +0x1ec5,0xc70a,0xc05b,0x4029, +0x8453,0x02cc,0x4d58,0x4048, +0xdac6,0xc769,0x649f,0x4051, +0xa12e,0xcb16,0xb351,0x4040 +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0xbf71,0xbec3,0x7221,0x1168, +0xbfe2,0xef9e,0x2405,0xdd2a, +0xc011,0x7ee0,0x3c0b,0xcacc, +0xc022,0x2e3c,0x8028,0x7f96, +0xc016,0x446d,0x0ec8,0xd6dd +}; +static unsigned short Q[] = { +0x4029,0xc05b,0xc70a,0x1ec5, +0x4048,0x4d58,0x02cc,0x8453, +0x4051,0x649f,0xc769,0xdac6, +0x4040,0xb351,0xcb16,0xa12e +}; +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double sqrt ( double ); +extern double log ( double ); +#else +double log(), sqrt(), polevl(), p1evl(); +#endif +extern double LOGE2, INFINITY; + +double asinh(xx) +double xx; +{ +double a, z, x; +int sign; + +#ifdef MINUSZERO +if( xx == 0.0 ) + return(xx); +#endif +if( xx < 0.0 ) + { + sign = -1; + x = -xx; + } +else + { + sign = 1; + x = xx; + } + +if( x > 1.0e8 ) + { +#ifdef INFINITIES + if( x == INFINITY ) + return(xx); +#endif + return( sign * (log(x) + LOGE2) ); + } + +z = x * x; +if( x < 0.5 ) + { + a = ( polevl(z, P, 4)/p1evl(z, Q, 4) ) * z; + a = a * x + x; + if( sign < 0 ) + a = -a; + return(a); + } + +a = sqrt( z + 1.0 ); +return( sign * log(x + a) ); +} diff --git a/components/external/espruino/libs/math/atan.c b/components/external/espruino/libs/math/atan.c new file mode 100644 index 0000000000..4d5a5db4a6 --- /dev/null +++ b/components/external/espruino/libs/math/atan.c @@ -0,0 +1,393 @@ +/* atan.c + * + * Inverse circular tangent + * (arctangent) + * + * + * + * SYNOPSIS: + * + * double x, y, atan(); + * + * y = atan( x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle between -pi/2 and +pi/2 whose tangent + * is x. + * + * Range reduction is from three intervals into the interval + * from zero to 0.66. The approximant uses a rational + * function of degree 4/5 of the form x + x**3 P(x)/Q(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10, 10 50000 2.4e-17 8.3e-18 + * IEEE -10, 10 10^6 1.8e-16 5.0e-17 + * + */ + /* atan2() + * + * Quadrant correct inverse circular tangent + * + * + * + * SYNOPSIS: + * + * double x, y, z, atan2(); + * + * z = atan2( y, x ); + * + * + * + * DESCRIPTION: + * + * Returns radian angle whose tangent is y/x. + * Define compile time symbol ANSIC = 1 for ANSI standard, + * range -PI < z <= +PI, args (y,x); else ANSIC = 0 for range + * 0 to 2PI, args (x,y). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10, 10 10^6 2.5e-16 6.9e-17 + * See atan.c. + * + */ + +/* atan.c */ + + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +/* arctan(x) = x + x^3 P(x^2)/Q(x^2) + 0 <= x <= 0.66 + Peak relative error = 2.6e-18 */ +#ifdef UNK +const static double P[5] = { +-8.750608600031904122785E-1, +-1.615753718733365076637E1, +-7.500855792314704667340E1, +-1.228866684490136173410E2, +-6.485021904942025371773E1, +}; +const static double Q[5] = { +/* 1.000000000000000000000E0, */ + 2.485846490142306297962E1, + 1.650270098316988542046E2, + 4.328810604912902668951E2, + 4.853903996359136964868E2, + 1.945506571482613964425E2, +}; + +/* tan( 3*pi/8 ) */ +const static double T3P8 = 2.41421356237309504880; +#endif + +#ifdef DEC +static short P[20] = { +0140140,0001775,0007671,0026242, +0141201,0041242,0155534,0001715, +0141626,0002141,0132100,0011625, +0141765,0142771,0064055,0150453, +0141601,0131517,0164507,0062164, +}; +static short Q[20] = { +/* 0040200,0000000,0000000,0000000, */ +0041306,0157042,0154243,0000742, +0042045,0003352,0016707,0150452, +0042330,0070306,0113425,0170730, +0042362,0130770,0116602,0047520, +0042102,0106367,0156753,0013541, +}; + +/* tan( 3*pi/8 ) = 2.41421356237309504880 */ +static unsigned short T3P8A[] = {040432,0101171,0114774,0167462,}; +#define T3P8 *(double *)T3P8A +#endif + +#ifdef IBMPC +static short P[20] = { +0x2594,0xa1f7,0x007f,0xbfec, +0x807a,0x5b6b,0x2854,0xc030, +0x0273,0x3688,0xc08c,0xc052, +0xba25,0x2d05,0xb8bf,0xc05e, +0xec8e,0xfd28,0x3669,0xc050, +}; +static short Q[20] = { +/* 0x0000,0x0000,0x0000,0x3ff0, */ +0x603c,0x5b14,0xdbc4,0x4038, +0xfa25,0x43b8,0xa0dd,0x4064, +0xbe3b,0xd2e2,0x0e18,0x407b, +0x49ea,0x13b0,0x563f,0x407e, +0x62ec,0xfbbd,0x519e,0x4068, +}; + +/* tan( 3*pi/8 ) = 2.41421356237309504880 */ +static unsigned short T3P8A[] = {0x9de6,0x333f,0x504f,0x4003}; +#define T3P8 *(double *)T3P8A +#endif + +#ifdef MIEEE +static short P[20] = { +0xbfec,0x007f,0xa1f7,0x2594, +0xc030,0x2854,0x5b6b,0x807a, +0xc052,0xc08c,0x3688,0x0273, +0xc05e,0xb8bf,0x2d05,0xba25, +0xc050,0x3669,0xfd28,0xec8e, +}; +static short Q[20] = { +/* 0x3ff0,0x0000,0x0000,0x0000, */ +0x4038,0xdbc4,0x5b14,0x603c, +0x4064,0xa0dd,0x43b8,0xfa25, +0x407b,0x0e18,0xd2e2,0xbe3b, +0x407e,0x563f,0x13b0,0x49ea, +0x4068,0x519e,0xfbbd,0x62ec, +}; + +/* tan( 3*pi/8 ) = 2.41421356237309504880 */ +static unsigned short T3P8A[] = { +0x4003,0x504f,0x333f,0x9de6 +}; +#define T3P8 *(double *)T3P8A +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double atan ( double ); +extern double fabs ( double ); +extern int signbit ( double ); +extern int isnan ( double ); +#else +double polevl(), p1evl(), atan(), fabs(); +int signbit(), isnan(); +#endif +extern double PI, PIO2, PIO4, INFINITY, NEGZERO, MAXNUM; + +/* pi/2 = PIO2 + MOREBITS. */ +#ifdef DEC +#define MOREBITS 5.721188726109831840122E-18 +#else +#define MOREBITS 6.123233995736765886130E-17 +#endif + + +double atan(x) +double x; +{ +double y, z; +short sign, flag; + +#ifdef MINUSZERO +if( x == 0.0 ) + return(x); +#endif +#ifdef INFINITIES +if(x == INFINITY) + return(PIO2); +if(x == -INFINITY) + return(-PIO2); +#endif +/* make argument positive and save the sign */ +sign = 1; +if( x < 0.0 ) + { + sign = -1; + x = -x; + } +/* range reduction */ +flag = 0; +if( x > T3P8 ) + { + y = PIO2; + flag = 1; + x = -( 1.0/x ); + } +else if( x <= 0.66 ) + { + y = 0.0; + } +else + { + y = PIO4; + flag = 2; + x = (x-1.0)/(x+1.0); + } +z = x * x; +z = z * polevl( z, P, 4 ) / p1evl( z, Q, 5 ); +z = x * z + x; +if( flag == 2 ) + z += 0.5 * MOREBITS; +else if( flag == 1 ) + z += MOREBITS; +y = y + z; +if( sign < 0 ) + y = -y; +return(y); +} + +/* atan2 */ + +#ifdef ANSIC +double atan2( y, x ) +#else +double atan2( x, y ) +#endif +double x, y; +{ +double z, w; +short code; + +code = 0; + +#ifdef NANS +if( isnan(x) ) + return(x); +if( isnan(y) ) + return(y); +#endif +#ifdef MINUSZERO +if( y == 0.0 ) + { + if( signbit(y) ) + { + if( x > 0.0 ) + z = y; + else if( x < 0.0 ) + z = -PI; + else + { + if( signbit(x) ) + z = -PI; + else + z = y; + } + } + else /* y is +0 */ + { + if( x == 0.0 ) + { + if( signbit(x) ) + z = PI; + else + z = 0.0; + } + else if( x > 0.0 ) + z = 0.0; + else + z = PI; + } + return z; + } +if( x == 0.0 ) + { + if( y > 0.0 ) + z = PIO2; + else + z = -PIO2; + return z; + } +#endif /* MINUSZERO */ +#ifdef INFINITIES +if( x == INFINITY ) + { + if( y == INFINITY ) + z = 0.25 * PI; + else if( y == -INFINITY ) + z = -0.25 * PI; + else if( y < 0.0 ) + z = NEGZERO; + else + z = 0.0; + return z; + } +if( x == -INFINITY ) + { + if( y == INFINITY ) + z = 0.75 * PI; + else if( y <= -INFINITY ) + z = -0.75 * PI; + else if( y >= 0.0 ) + z = PI; + else + z = -PI; + return z; + } +if( y == INFINITY ) + return( PIO2 ); +if( y == -INFINITY ) + return( -PIO2 ); +#endif + +if( x < 0.0 ) + code = 2; +if( y < 0.0 ) + code |= 1; + +#ifdef INFINITIES +if( x == 0.0 ) +#else +if( fabs(x) <= (fabs(y) / MAXNUM) ) +#endif + { + if( code & 1 ) + { +#if ANSIC + return( -PIO2 ); +#else + return( 3.0*PIO2 ); +#endif + } + if( y == 0.0 ) + return( 0.0 ); + return( PIO2 ); + } + +if( y == 0.0 ) + { + if( code & 2 ) + return( PI ); + return( 0.0 ); + } + + +switch( code ) + { +#if ANSIC + default: + case 0: + case 1: w = 0.0; break; + case 2: w = PI; break; + case 3: w = -PI; break; +#else + default: + case 0: w = 0.0; break; + case 1: w = 2.0 * PI; break; + case 2: + case 3: w = PI; break; +#endif + } + +z = w + atan( y/x ); +#ifdef MINUSZERO +if( z == 0.0 && y < 0 ) + z = NEGZERO; +#endif +return( z ); +} diff --git a/components/external/espruino/libs/math/atanh.c b/components/external/espruino/libs/math/atanh.c new file mode 100644 index 0000000000..9b0cf4c266 --- /dev/null +++ b/components/external/espruino/libs/math/atanh.c @@ -0,0 +1,156 @@ +/* atanh.c + * + * Inverse hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * double x, y, atanh(); + * + * y = atanh( x ); + * + * + * + * DESCRIPTION: + * + * Returns inverse hyperbolic tangent of argument in the range + * MINLOG to MAXLOG. + * + * If |x| < 0.5, the rational form x + x**3 P(x)/Q(x) is + * employed. Otherwise, + * atanh(x) = 0.5 * log( (1+x)/(1-x) ). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -1,1 50000 2.4e-17 6.4e-18 + * IEEE -1,1 30000 1.9e-16 5.2e-17 + * + */ + +/* atanh.c */ + + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright (C) 1987, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { +-8.54074331929669305196E-1, + 1.20426861384072379242E1, +-4.61252884198732692637E1, + 6.54566728676544377376E1, +-3.09092539379866942570E1 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ +-1.95638849376911654834E1, + 1.08938092147140262656E2, +-2.49839401325893582852E2, + 2.52006675691344555838E2, +-9.27277618139601130017E1 +}; +#endif +#ifdef DEC +static unsigned short P[] = { +0140132,0122235,0105775,0130300, +0041100,0127327,0124407,0034722, +0141470,0100113,0115607,0130535, +0041602,0164721,0003257,0013673, +0141367,0043046,0166673,0045750 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0141234,0101326,0015460,0134564, +0041731,0160115,0116451,0032045, +0142171,0153343,0000532,0167226, +0042174,0000665,0077604,0000310, +0141671,0072235,0031114,0074377 +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0xb618,0xb17f,0x5493,0xbfeb, +0xe73a,0xf520,0x15da,0x4028, +0xf62c,0x7370,0x1009,0xc047, +0xe2f7,0x20d5,0x5d3a,0x4050, +0x697d,0xddb7,0xe8c4,0xc03e +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x172f,0xc366,0x905a,0xc033, +0x2685,0xb3a5,0x3c09,0x405b, +0x5dd3,0x602b,0x3adc,0xc06f, +0x8019,0xaff0,0x8036,0x406f, +0x8f20,0xa649,0x2e93,0xc057 +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0xbfeb,0x5493,0xb17f,0xb618, +0x4028,0x15da,0xf520,0xe73a, +0xc047,0x1009,0x7370,0xf62c, +0x4050,0x5d3a,0x20d5,0xe2f7, +0xc03e,0xe8c4,0xddb7,0x697d +}; +static unsigned short Q[] = { +0xc033,0x905a,0xc366,0x172f, +0x405b,0x3c09,0xb3a5,0x2685, +0xc06f,0x3adc,0x602b,0x5dd3, +0x406f,0x8036,0xaff0,0x8019, +0xc057,0x2e93,0xa649,0x8f20 +}; +#endif + +#ifdef ANSIPROT +extern double fabs ( double ); +extern double log ( double x ); +extern double polevl ( double x, void *P, int N ); +extern double p1evl ( double x, void *P, int N ); +#else +double fabs(), log(), polevl(), p1evl(); +#endif +extern double INFINITY, NAN; + +double atanh(x) +double x; +{ +double s, z; + +#ifdef MINUSZERO +if( x == 0.0 ) + return(x); +#endif +z = fabs(x); +if( z >= 1.0 ) + { + if( x == 1.0 ) + return( INFINITY ); + if( x == -1.0 ) + return( -INFINITY ); + mtherr( "atanh", DOMAIN ); + return( NAN ); + } + +if( z < 1.0e-7 ) + return(x); + +if( z < 0.5 ) + { + z = x * x; + s = x + x * z * (polevl(z, P, 4) / p1evl(z, Q, 5)); + return(s); + } + +return( 0.5 * log((1.0+x)/(1.0-x)) ); +} diff --git a/components/external/espruino/libs/math/cbrt.c b/components/external/espruino/libs/math/cbrt.c new file mode 100644 index 0000000000..82c02e6862 --- /dev/null +++ b/components/external/espruino/libs/math/cbrt.c @@ -0,0 +1,142 @@ +/* cbrt.c + * + * Cube root + * + * + * + * SYNOPSIS: + * + * double x, y, cbrt(); + * + * y = cbrt( x ); + * + * + * + * DESCRIPTION: + * + * Returns the cube root of the argument, which may be negative. + * + * Range reduction involves determining the power of 2 of + * the argument. A polynomial of degree 2 applied to the + * mantissa, and multiplication by the cube root of 1, 2, or 4 + * approximates the root to within about 0.1%. Then Newton's + * iteration is used three times to converge to an accurate + * result. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,10 200000 1.8e-17 6.2e-18 + * IEEE 0,1e308 30000 1.5e-16 5.0e-17 + * + */ + /* cbrt.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1991, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +const static double CBRT2 = 1.2599210498948731647672; +const static double CBRT4 = 1.5874010519681994747517; +const static double CBRT2I = 0.79370052598409973737585; +const static double CBRT4I = 0.62996052494743658238361; + +#ifdef ANSIPROT +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double frexp(), ldexp(); +int isnan(), isfinite(); +#endif + +double cbrt(x) +double x; +{ +int e, rem, sign; +double z; + +#ifdef NANS +if( isnan(x) ) + return x; +#endif +#ifdef INFINITIES +if( !isfinite(x) ) + return x; +#endif +if( x == 0 ) + return( x ); +if( x > 0 ) + sign = 1; +else + { + sign = -1; + x = -x; + } + +z = x; +/* extract power of 2, leaving + * mantissa between 0.5 and 1 + */ +x = frexp( x, &e ); + +/* Approximate cube root of number between .5 and 1, + * peak relative error = 9.2e-6 + */ +x = (((-1.3466110473359520655053e-1 * x + + 5.4664601366395524503440e-1) * x + - 9.5438224771509446525043e-1) * x + + 1.1399983354717293273738e0 ) * x + + 4.0238979564544752126924e-1; + +/* exponent divided by 3 */ +if( e >= 0 ) + { + rem = e; + e /= 3; + rem -= 3*e; + if( rem == 1 ) + x *= CBRT2; + else if( rem == 2 ) + x *= CBRT4; + } + + +/* argument less than 1 */ + +else + { + e = -e; + rem = e; + e /= 3; + rem -= 3*e; + if( rem == 1 ) + x *= CBRT2I; + else if( rem == 2 ) + x *= CBRT4I; + e = -e; + } + +/* multiply by power of 2 */ +x = ldexp( x, e ); + +/* Newton iteration */ +x -= ( x - (z/(x*x)) )*0.33333333333333333333; +#ifdef DEC +x -= ( x - (z/(x*x)) )/3.0; +#else +x -= ( x - (z/(x*x)) )*0.33333333333333333333; +#endif + +if( sign < 0 ) + x = -x; +return(x); +} diff --git a/components/external/espruino/libs/math/chbevl.c b/components/external/espruino/libs/math/chbevl.c new file mode 100644 index 0000000000..5393881649 --- /dev/null +++ b/components/external/espruino/libs/math/chbevl.c @@ -0,0 +1,82 @@ +/* chbevl.c + * + * Evaluate Chebyshev series + * + * + * + * SYNOPSIS: + * + * int N; + * double x, y, coef[N], chebevl(); + * + * y = chbevl( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates the series + * + * N-1 + * - ' + * y = > coef[i] T (x/2) + * - i + * i=0 + * + * of Chebyshev polynomials Ti at argument x/2. + * + * Coefficients are stored in reverse order, i.e. the zero + * order term is last in the array. Note N is the number of + * coefficients, not the order. + * + * If coefficients are for the interval a to b, x must + * have been transformed to x -> 2(2x - b - a)/(b-a) before + * entering the routine. This maps x from (a, b) to (-1, 1), + * over which the Chebyshev polynomials are defined. + * + * If the coefficients are for the inverted interval, in + * which (a, b) is mapped to (1/b, 1/a), the transformation + * required is x -> 2(2ab/x - b - a)/(b-a). If b is infinity, + * this becomes x -> 4a/x - 1. + * + * + * + * SPEED: + * + * Taking advantage of the recurrence properties of the + * Chebyshev polynomials, the routine requires one more + * addition per loop than evaluating a nested polynomial of + * the same degree. + * + */ + /* chbevl.c */ + +/* +Cephes Math Library Release 2.0: April, 1987 +Copyright 1985, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + +double chbevl( x, array, n ) +double x; +double array[]; +int n; +{ +double b0, b1, b2, *p; +int i; + +p = array; +b0 = *p++; +b1 = 0.0; +i = n - 1; + +do + { + b2 = b1; + b1 = b0; + b0 = x * b1 - b2 + *p++; + } +while( --i ); + +return( 0.5*(b0-b2) ); +} diff --git a/components/external/espruino/libs/math/clog.c b/components/external/espruino/libs/math/clog.c new file mode 100644 index 0000000000..1f5e77611d --- /dev/null +++ b/components/external/espruino/libs/math/clog.c @@ -0,0 +1,1043 @@ +/* clog.c + * + * Complex natural logarithm + * + * + * + * SYNOPSIS: + * + * void clog(); + * cmplx z, w; + * + * clog( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Returns complex logarithm to the base e (2.718...) of + * the complex argument x. + * + * If z = x + iy, r = sqrt( x**2 + y**2 ), + * then + * w = log(r) + i arctan(y/x). + * + * The arctangent ranges from -PI to +PI. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 7000 8.5e-17 1.9e-17 + * IEEE -10,+10 30000 5.0e-15 1.1e-16 + * + * Larger relative error can be observed for z near 1 +i0. + * In IEEE arithmetic the peak absolute error is 5.2e-16, rms + * absolute error 1.0e-16. + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ +#include "mconf.h" +#ifdef ANSIPROT +static void cchsh ( double x, double *c, double *s ); +const static double redupi ( double x ); +const static double ctans ( cmplx *z ); +/* These are supposed to be in some standard place. */ +double fabs (double); +double sqrt (double); +double pow (double, double); +double log (double); +double exp (double); +double atan2 (double, double); +double cosh (double); +double sinh (double); +double asin (double); +double sin (double); +double cos (double); +double cabs (cmplx *); +void cadd ( cmplx *, cmplx *, cmplx * ); +void cmul ( cmplx *, cmplx *, cmplx * ); +void csqrt ( cmplx *, cmplx * ); +static void cchsh ( double, double *, double * ); +const static double redupi ( double ); +const static double ctans ( cmplx * ); +void clog ( cmplx *, cmplx * ); +void casin ( cmplx *, cmplx * ); +void cacos ( cmplx *, cmplx * ); +void catan ( cmplx *, cmplx * ); +#else +static void cchsh(); +const static double redupi(); +const static double ctans(); +double cabs(), fabs(), sqrt(), pow(); +double log(), exp(), atan2(), cosh(), sinh(); +double asin(), sin(), cos(); +void cadd(), cmul(), csqrt(); +void clog(), casin(), cacos(), catan(); +#endif + + +extern double MAXNUM, MACHEP, PI, PIO2; + +void clog( z, w ) +register cmplx *z, *w; +{ +double p, rr; + +/*rr = sqrt( z->r * z->r + z->i * z->i );*/ +rr = cabs(z); +p = log(rr); +#if ANSIC +rr = atan2( z->i, z->r ); +#else +rr = atan2( z->r, z->i ); +if( rr > PI ) + rr -= PI + PI; +#endif +w->i = rr; +w->r = p; +} + /* cexp() + * + * Complex exponential function + * + * + * + * SYNOPSIS: + * + * void cexp(); + * cmplx z, w; + * + * cexp( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Returns the exponential of the complex argument z + * into the complex result w. + * + * If + * z = x + iy, + * r = exp(x), + * + * then + * + * w = r cos y + i r sin y. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 8700 3.7e-17 1.1e-17 + * IEEE -10,+10 30000 3.0e-16 8.7e-17 + * + */ + +void cexp( z, w ) +register cmplx *z, *w; +{ +double r; + +r = exp( z->r ); +w->r = r * cos( z->i ); +w->i = r * sin( z->i ); +} + /* csin() + * + * Complex circular sine + * + * + * + * SYNOPSIS: + * + * void csin(); + * cmplx z, w; + * + * csin( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * w = sin x cosh y + i cos x sinh y. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 8400 5.3e-17 1.3e-17 + * IEEE -10,+10 30000 3.8e-16 1.0e-16 + * Also tested by csin(casin(z)) = z. + * + */ + +void csin( z, w ) +register cmplx *z, *w; +{ +double ch, sh; + +cchsh( z->i, &ch, &sh ); +w->r = sin( z->r ) * ch; +w->i = cos( z->r ) * sh; +} + + + +/* calculate cosh and sinh */ + +static void cchsh( x, c, s ) +double x, *c, *s; +{ +double e, ei; + +if( fabs(x) <= 0.5 ) + { + *c = cosh(x); + *s = sinh(x); + } +else + { + e = exp(x); + ei = 0.5/e; + e = 0.5 * e; + *s = e - ei; + *c = e + ei; + } +} + + /* ccos() + * + * Complex circular cosine + * + * + * + * SYNOPSIS: + * + * void ccos(); + * cmplx z, w; + * + * ccos( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * w = cos x cosh y - i sin x sinh y. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 8400 4.5e-17 1.3e-17 + * IEEE -10,+10 30000 3.8e-16 1.0e-16 + */ + +void ccos( z, w ) +register cmplx *z, *w; +{ +double ch, sh; + +cchsh( z->i, &ch, &sh ); +w->r = cos( z->r ) * ch; +w->i = -sin( z->r ) * sh; +} + /* ctan() + * + * Complex circular tangent + * + * + * + * SYNOPSIS: + * + * void ctan(); + * cmplx z, w; + * + * ctan( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * sin 2x + i sinh 2y + * w = --------------------. + * cos 2x + cosh 2y + * + * On the real axis the denominator is zero at odd multiples + * of PI/2. The denominator is evaluated by its Taylor + * series near these points. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 5200 7.1e-17 1.6e-17 + * IEEE -10,+10 30000 7.2e-16 1.2e-16 + * Also tested by ctan * ccot = 1 and catan(ctan(z)) = z. + */ + +void ctan( z, w ) +register cmplx *z, *w; +{ +double d; + +d = cos( 2.0 * z->r ) + cosh( 2.0 * z->i ); + +if( fabs(d) < 0.25 ) + d = ctans(z); + +if( d == 0.0 ) + { + mtherr( "ctan", OVERFLOW ); + w->r = MAXNUM; + w->i = MAXNUM; + return; + } + +w->r = sin( 2.0 * z->r ) / d; +w->i = sinh( 2.0 * z->i ) / d; +} + /* ccot() + * + * Complex circular cotangent + * + * + * + * SYNOPSIS: + * + * void ccot(); + * cmplx z, w; + * + * ccot( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * + * sin 2x - i sinh 2y + * w = --------------------. + * cosh 2y - cos 2x + * + * On the real axis, the denominator has zeros at even + * multiples of PI/2. Near these points it is evaluated + * by a Taylor series. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 3000 6.5e-17 1.6e-17 + * IEEE -10,+10 30000 9.2e-16 1.2e-16 + * Also tested by ctan * ccot = 1 + i0. + */ + +void ccot( z, w ) +register cmplx *z, *w; +{ +double d; + +d = cosh(2.0 * z->i) - cos(2.0 * z->r); + +if( fabs(d) < 0.25 ) + d = ctans(z); + +if( d == 0.0 ) + { + mtherr( "ccot", OVERFLOW ); + w->r = MAXNUM; + w->i = MAXNUM; + return; + } + +w->r = sin( 2.0 * z->r ) / d; +w->i = -sinh( 2.0 * z->i ) / d; +} + +/* Program to subtract nearest integer multiple of PI */ +/* extended precision value of PI: */ +#ifdef UNK +const static double DP1 = 3.14159265160560607910E0; +const static double DP2 = 1.98418714791870343106E-9; +const static double DP3 = 1.14423774522196636802E-17; +#endif + +#ifdef DEC +static unsigned short P1[] = {0040511,0007732,0120000,0000000,}; +static unsigned short P2[] = {0031010,0055060,0100000,0000000,}; +static unsigned short P3[] = {0022123,0011431,0105056,0001560,}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +#endif + +#ifdef IBMPC +static unsigned short P1[] = {0x0000,0x5400,0x21fb,0x4009}; +static unsigned short P2[] = {0x0000,0x1000,0x0b46,0x3e21}; +static unsigned short P3[] = {0xc06e,0x3145,0x6263,0x3c6a}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +#endif + +#ifdef MIEEE +static unsigned short P1[] = { +0x4009,0x21fb,0x5400,0x0000 +}; +static unsigned short P2[] = { +0x3e21,0x0b46,0x1000,0x0000 +}; +static unsigned short P3[] = { +0x3c6a,0x6263,0x3145,0xc06e +}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +#endif + +const static double redupi(x) +double x; +{ +double t; +long i; + +t = x/PI; +if( t >= 0.0 ) + t += 0.5; +else + t -= 0.5; + +i = t; /* the multiple */ +t = i; +t = ((x - t * DP1) - t * DP2) - t * DP3; +return(t); +} + +/* Taylor series expansion for cosh(2y) - cos(2x) */ + +const static double ctans(z) +cmplx *z; +{ +double f, x, x2, y, y2, rn, t; +double d; + +x = fabs( 2.0 * z->r ); +y = fabs( 2.0 * z->i ); + +x = redupi(x); + +x = x * x; +y = y * y; +x2 = 1.0; +y2 = 1.0; +f = 1.0; +rn = 0.0; +d = 0.0; +do + { + rn += 1.0; + f *= rn; + rn += 1.0; + f *= rn; + x2 *= x; + y2 *= y; + t = y2 + x2; + t /= f; + d += t; + + rn += 1.0; + f *= rn; + rn += 1.0; + f *= rn; + x2 *= x; + y2 *= y; + t = y2 - x2; + t /= f; + d += t; + } +while( fabs(t/d) > MACHEP ); +return(d); +} + /* casin() + * + * Complex circular arc sine + * + * + * + * SYNOPSIS: + * + * void casin(); + * cmplx z, w; + * + * casin( &z, &w ); + * + * + * + * DESCRIPTION: + * + * Inverse complex sine: + * + * 2 + * w = -i clog( iz + csqrt( 1 - z ) ). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 10100 2.1e-15 3.4e-16 + * IEEE -10,+10 30000 2.2e-14 2.7e-15 + * Larger relative error can be observed for z near zero. + * Also tested by csin(casin(z)) = z. + */ + +void casin( z, w ) +cmplx *z, *w; +{ +static cmplx ca, ct, zz, z2; +double x, y; + +x = z->r; +y = z->i; + +if( y == 0.0 ) + { + if( fabs(x) > 1.0 ) + { + w->r = PIO2; + w->i = 0.0; + mtherr( "casin", DOMAIN ); + } + else + { + w->r = asin(x); + w->i = 0.0; + } + return; + } + +/* Power series expansion */ +/* +b = cabs(z); +if( b < 0.125 ) +{ +z2.r = (x - y) * (x + y); +z2.i = 2.0 * x * y; + +cn = 1.0; +n = 1.0; +ca.r = x; +ca.i = y; +sum.r = x; +sum.i = y; +do + { + ct.r = z2.r * ca.r - z2.i * ca.i; + ct.i = z2.r * ca.i + z2.i * ca.r; + ca.r = ct.r; + ca.i = ct.i; + + cn *= n; + n += 1.0; + cn /= n; + n += 1.0; + b = cn/n; + + ct.r *= b; + ct.i *= b; + sum.r += ct.r; + sum.i += ct.i; + b = fabs(ct.r) + fabs(ct.i); + } +while( b > MACHEP ); +w->r = sum.r; +w->i = sum.i; +return; +} +*/ + + +ca.r = x; +ca.i = y; + +ct.r = -ca.i; /* iz */ +ct.i = ca.r; + + /* sqrt( 1 - z*z) */ +/* cmul( &ca, &ca, &zz ) */ +zz.r = (ca.r - ca.i) * (ca.r + ca.i); /*x * x - y * y */ +zz.i = 2.0 * ca.r * ca.i; + +zz.r = 1.0 - zz.r; +zz.i = -zz.i; +csqrt( &zz, &z2 ); + +cadd( &z2, &ct, &zz ); +clog( &zz, &zz ); +w->r = zz.i; /* mult by 1/i = -i */ +w->i = -zz.r; +return; +} + /* cacos() + * + * Complex circular arc cosine + * + * + * + * SYNOPSIS: + * + * void cacos(); + * cmplx z, w; + * + * cacos( &z, &w ); + * + * + * + * DESCRIPTION: + * + * + * w = arccos z = PI/2 - arcsin z. + * + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 5200 1.6e-15 2.8e-16 + * IEEE -10,+10 30000 1.8e-14 2.2e-15 + */ + +void cacos( z, w ) +cmplx *z, *w; +{ + +casin( z, w ); +w->r = PIO2 - w->r; +w->i = -w->i; +} + /* catan() + * + * Complex circular arc tangent + * + * + * + * SYNOPSIS: + * + * void catan(); + * cmplx z, w; + * + * catan( &z, &w ); + * + * + * + * DESCRIPTION: + * + * If + * z = x + iy, + * + * then + * 1 ( 2x ) + * Re w = - arctan(-----------) + k PI + * 2 ( 2 2) + * (1 - x - y ) + * + * ( 2 2) + * 1 (x + (y+1) ) + * Im w = - log(------------) + * 4 ( 2 2) + * (x + (y-1) ) + * + * Where k is an arbitrary integer. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 5900 1.3e-16 7.8e-18 + * IEEE -10,+10 30000 2.3e-15 8.5e-17 + * The check catan( ctan(z) ) = z, with |x| and |y| < PI/2, + * had peak relative error 1.5e-16, rms relative error + * 2.9e-17. See also clog(). + */ + +void catan( z, w ) +cmplx *z, *w; +{ +double a, t, x, x2, y; + +x = z->r; +y = z->i; + +if( (x == 0.0) && (y > 1.0) ) + goto ovrf; + +x2 = x * x; +a = 1.0 - x2 - (y * y); +if( a == 0.0 ) + goto ovrf; + +#if ANSIC +t = atan2( 2.0 * x, a )/2.0; +#else +t = atan2( a, 2.0 * x )/2.0; +#endif +w->r = redupi( t ); + +t = y - 1.0; +a = x2 + (t * t); +if( a == 0.0 ) + goto ovrf; + +t = y + 1.0; +a = (x2 + (t * t))/a; +w->i = log(a)/4.0; +return; + +ovrf: +mtherr( "catan", OVERFLOW ); +w->r = MAXNUM; +w->i = MAXNUM; +} + + +/* csinh + * + * Complex hyperbolic sine + * + * + * + * SYNOPSIS: + * + * void csinh(); + * cmplx z, w; + * + * csinh( &z, &w ); + * + * + * DESCRIPTION: + * + * csinh z = (cexp(z) - cexp(-z))/2 + * = sinh x * cos y + i cosh x * sin y . + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 3.1e-16 8.2e-17 + * + */ + +void +csinh (z, w) + cmplx *z, *w; +{ + double x, y; + + x = z->r; + y = z->i; + w->r = sinh (x) * cos (y); + w->i = cosh (x) * sin (y); +} + + +/* casinh + * + * Complex inverse hyperbolic sine + * + * + * + * SYNOPSIS: + * + * void casinh(); + * cmplx z, w; + * + * casinh (&z, &w); + * + * + * + * DESCRIPTION: + * + * casinh z = -i casin iz . + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.8e-14 2.6e-15 + * + */ + +void +casinh (z, w) + cmplx *z, *w; +{ + cmplx u; + + u.r = 0.0; + u.i = 1.0; + cmul( z, &u, &u ); + casin( &u, w ); + u.r = 0.0; + u.i = -1.0; + cmul( &u, w, w ); +} + +/* ccosh + * + * Complex hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * void ccosh(); + * cmplx z, w; + * + * ccosh (&z, &w); + * + * + * + * DESCRIPTION: + * + * ccosh(z) = cosh x cos y + i sinh x sin y . + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 2.9e-16 8.1e-17 + * + */ + +void +ccosh (z, w) + cmplx *z, *w; +{ + double x, y; + + x = z->r; + y = z->i; + w->r = cosh (x) * cos (y); + w->i = sinh (x) * sin (y); +} + + +/* cacosh + * + * Complex inverse hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * void cacosh(); + * cmplx z, w; + * + * cacosh (&z, &w); + * + * + * + * DESCRIPTION: + * + * acosh z = i acos z . + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.6e-14 2.1e-15 + * + */ + +void +cacosh (z, w) + cmplx *z, *w; +{ + cmplx u; + + cacos( z, w ); + u.r = 0.0; + u.i = 1.0; + cmul( &u, w, w ); +} + + +/* ctanh + * + * Complex hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * void ctanh(); + * cmplx z, w; + * + * ctanh (&z, &w); + * + * + * + * DESCRIPTION: + * + * tanh z = (sinh 2x + i sin 2y) / (cosh 2x + cos 2y) . + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 1.7e-14 2.4e-16 + * + */ + +/* 5.253E-02,1.550E+00 1.643E+01,6.553E+00 1.729E-14 21355 */ + +void +ctanh (z, w) + cmplx *z, *w; +{ + double x, y, d; + + x = z->r; + y = z->i; + d = cosh (2.0 * x) + cos (2.0 * y); + w->r = sinh (2.0 * x) / d; + w->i = sin (2.0 * y) / d; + return; +} + + +/* catanh + * + * Complex inverse hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * void catanh(); + * cmplx z, w; + * + * catanh (&z, &w); + * + * + * + * DESCRIPTION: + * + * Inverse tanh, equal to -i catan (iz); + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 2.3e-16 6.2e-17 + * + */ + +void +catanh (z, w) + cmplx *z, *w; +{ + cmplx u; + + u.r = 0.0; + u.i = 1.0; + cmul (z, &u, &u); /* i z */ + catan (&u, w); + u.r = 0.0; + u.i = -1.0; + cmul (&u, w, w); /* -i catan iz */ + return; +} + + +/* cpow + * + * Complex power function + * + * + * + * SYNOPSIS: + * + * void cpow(); + * cmplx a, z, w; + * + * cpow (&a, &z, &w); + * + * + * + * DESCRIPTION: + * + * Raises complex A to the complex Zth power. + * Definition is per AMS55 # 4.2.8, + * analytically equivalent to cpow(a,z) = cexp(z clog(a)). + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -10,+10 30000 9.4e-15 1.5e-15 + * + */ + + +void +cpow (a, z, w) + cmplx *a, *z, *w; +{ + double x, y, r, theta, absa, arga; + + x = z->r; + y = z->i; + absa = cabs (a); + if (absa == 0.0) + { + w->r = 0.0; + w->i = 0.0; + return; + } + arga = atan2 (a->i, a->r); + r = pow (absa, x); + theta = x * arga; + if (y != 0.0) + { + r = r * exp (-y * arga); + theta = theta + y * log (absa); + } + w->r = r * cos (theta); + w->i = r * sin (theta); + return; +} diff --git a/components/external/espruino/libs/math/cmplx.c b/components/external/espruino/libs/math/cmplx.c new file mode 100644 index 0000000000..fbe70000bd --- /dev/null +++ b/components/external/espruino/libs/math/cmplx.c @@ -0,0 +1,461 @@ +/* cmplx.c + * + * Complex number arithmetic + * + * + * + * SYNOPSIS: + * + * typedef struct { + * double r; real part + * double i; imaginary part + * }cmplx; + * + * cmplx *a, *b, *c; + * + * cadd( a, b, c ); c = b + a + * csub( a, b, c ); c = b - a + * cmul( a, b, c ); c = b * a + * cdiv( a, b, c ); c = b / a + * cneg( c ); c = -c + * cmov( b, c ); c = b + * + * + * + * DESCRIPTION: + * + * Addition: + * c.r = b.r + a.r + * c.i = b.i + a.i + * + * Subtraction: + * c.r = b.r - a.r + * c.i = b.i - a.i + * + * Multiplication: + * c.r = b.r * a.r - b.i * a.i + * c.i = b.r * a.i + b.i * a.r + * + * Division: + * d = a.r * a.r + a.i * a.i + * c.r = (b.r * a.r + b.i * a.i)/d + * c.i = (b.i * a.r - b.r * a.i)/d + * ACCURACY: + * + * In DEC arithmetic, the test (1/z) * z = 1 had peak relative + * error 3.1e-17, rms 1.2e-17. The test (y/z) * (z/y) = 1 had + * peak relative error 8.3e-17, rms 2.1e-17. + * + * Tests in the rectangle {-10,+10}: + * Relative error: + * arithmetic function # trials peak rms + * DEC cadd 10000 1.4e-17 3.4e-18 + * IEEE cadd 100000 1.1e-16 2.7e-17 + * DEC csub 10000 1.4e-17 4.5e-18 + * IEEE csub 100000 1.1e-16 3.4e-17 + * DEC cmul 3000 2.3e-17 8.7e-18 + * IEEE cmul 100000 2.1e-16 6.9e-17 + * DEC cdiv 18000 4.9e-17 1.3e-17 + * IEEE cdiv 100000 3.7e-16 1.1e-16 + */ + /* cmplx.c + * complex number arithmetic + */ + + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +#ifdef ANSIPROT +extern double fabs ( double ); +extern double cabs ( cmplx * ); +extern double sqrt ( double ); +extern double atan2 ( double, double ); +extern double cos ( double ); +extern double sin ( double ); +extern double sqrt ( double ); +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +int isnan ( double ); +void cdiv ( cmplx *, cmplx *, cmplx * ); +void cadd ( cmplx *, cmplx *, cmplx * ); +#else +double fabs(), cabs(), sqrt(), atan2(), cos(), sin(); +double sqrt(), frexp(), ldexp(); +int isnan(); +void cdiv(), cadd(); +#endif + +extern double MAXNUM, MACHEP, PI, PIO2, INFINITY, NAN; +/* +typedef struct + { + double r; + double i; + }cmplx; +*/ +cmplx czero = {0.0, 0.0}; +extern cmplx czero; +cmplx cone = {1.0, 0.0}; +extern cmplx cone; + +/* c = b + a */ + +void cadd( a, b, c ) +register cmplx *a, *b; +cmplx *c; +{ + +c->r = b->r + a->r; +c->i = b->i + a->i; +} + + +/* c = b - a */ + +void csub( a, b, c ) +register cmplx *a, *b; +cmplx *c; +{ + +c->r = b->r - a->r; +c->i = b->i - a->i; +} + +/* c = b * a */ + +void cmul( a, b, c ) +register cmplx *a, *b; +cmplx *c; +{ +double y; + +y = b->r * a->r - b->i * a->i; +c->i = b->r * a->i + b->i * a->r; +c->r = y; +} + + + +/* c = b / a */ + +void cdiv( a, b, c ) +register cmplx *a, *b; +cmplx *c; +{ +double y, p, q, w; + + +y = a->r * a->r + a->i * a->i; +p = b->r * a->r + b->i * a->i; +q = b->i * a->r - b->r * a->i; + +if( y < 1.0 ) + { + w = MAXNUM * y; + if( (fabs(p) > w) || (fabs(q) > w) || (y == 0.0) ) + { + c->r = MAXNUM; + c->i = MAXNUM; + mtherr( "cdiv", OVERFLOW ); + return; + } + } +c->r = p/y; +c->i = q/y; +} + + +/* b = a + Caution, a `short' is assumed to be 16 bits wide. */ + +void cmov( a, b ) +void *a, *b; +{ +register short *pa, *pb; +int i; + +pa = (short *) a; +pb = (short *) b; +i = 8; +do + *pb++ = *pa++; +while( --i ); +} + + +void cneg( a ) +register cmplx *a; +{ + +a->r = -a->r; +a->i = -a->i; +} + +/* cabs() + * + * Complex absolute value + * + * + * + * SYNOPSIS: + * + * double cabs(); + * cmplx z; + * double a; + * + * a = cabs( &z ); + * + * + * + * DESCRIPTION: + * + * + * If z = x + iy + * + * then + * + * a = sqrt( x**2 + y**2 ). + * + * Overflow and underflow are avoided by testing the magnitudes + * of x and y before squaring. If either is outside half of + * the floating point full scale range, both are rescaled. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -30,+30 30000 3.2e-17 9.2e-18 + * IEEE -10,+10 100000 2.7e-16 6.9e-17 + */ + + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +/* +typedef struct + { + double r; + double i; + }cmplx; +*/ + +#ifdef UNK +#define PREC 27 +#define MAXEXP 1024 +#define MINEXP -1077 +#endif +#ifdef DEC +#define PREC 29 +#define MAXEXP 128 +#define MINEXP -128 +#endif +#ifdef IBMPC +#define PREC 27 +#define MAXEXP 1024 +#define MINEXP -1077 +#endif +#ifdef MIEEE +#define PREC 27 +#define MAXEXP 1024 +#define MINEXP -1077 +#endif + + +double cabs( z ) +register cmplx *z; +{ +double x, y, b, re, im; +int ex, ey, e; + +#ifdef INFINITIES +/* Note, cabs(INFINITY,NAN) = INFINITY. */ +if( z->r == INFINITY || z->i == INFINITY + || z->r == -INFINITY || z->i == -INFINITY ) + return( INFINITY ); +#endif + +#ifdef NANS +if( isnan(z->r) ) + return(z->r); +if( isnan(z->i) ) + return(z->i); +#endif + +re = fabs( z->r ); +im = fabs( z->i ); + +if( re == 0.0 ) + return( im ); +if( im == 0.0 ) + return( re ); + +/* Get the exponents of the numbers */ +x = frexp( re, &ex ); +y = frexp( im, &ey ); + +/* Check if one number is tiny compared to the other */ +e = ex - ey; +if( e > PREC ) + return( re ); +if( e < -PREC ) + return( im ); + +/* Find approximate exponent e of the geometric mean. */ +e = (ex + ey) >> 1; + +/* Rescale so mean is about 1 */ +x = ldexp( re, -e ); +y = ldexp( im, -e ); + +/* Hypotenuse of the right triangle */ +b = sqrt( x * x + y * y ); + +/* Compute the exponent of the answer. */ +y = frexp( b, &ey ); +ey = e + ey; + +/* Check it for overflow and underflow. */ +if( ey > MAXEXP ) + { + mtherr( "cabs", OVERFLOW ); + return( INFINITY ); + } +if( ey < MINEXP ) + return(0.0); + +/* Undo the scaling */ +b = ldexp( b, e ); +return( b ); +} + /* csqrt() + * + * Complex square root + * + * + * + * SYNOPSIS: + * + * void csqrt(); + * cmplx z, w; + * + * csqrt( &z, &w ); + * + * + * + * DESCRIPTION: + * + * + * If z = x + iy, r = |z|, then + * + * 1/2 + * Im w = [ (r - x)/2 ] , + * + * Re w = y / 2 Im w. + * + * + * Note that -w is also a square root of z. The root chosen + * is always in the upper half plane. + * + * Because of the potential for cancellation error in r - x, + * the result is sharpened by doing a Heron iteration + * (see sqrt.c) in complex arithmetic. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -10,+10 25000 3.2e-17 9.6e-18 + * IEEE -10,+10 100000 3.2e-16 7.7e-17 + * + * 2 + * Also tested by csqrt( z ) = z, and tested by arguments + * close to the real axis. + */ + + +void csqrt( z, w ) +cmplx *z, *w; +{ +cmplx q, s; +double x, y, r, t; + +x = z->r; +y = z->i; + +if( y == 0.0 ) + { + if( x < 0.0 ) + { + w->r = 0.0; + w->i = sqrt(-x); + return; + } + else + { + w->r = sqrt(x); + w->i = 0.0; + return; + } + } + + +if( x == 0.0 ) + { + r = fabs(y); + r = sqrt(0.5*r); + if( y > 0 ) + w->r = r; + else + w->r = -r; + w->i = r; + return; + } + +/* Approximate sqrt(x^2+y^2) - x = y^2/2x - y^4/24x^3 + ... . + * The relative error in the first term is approximately y^2/12x^2 . + */ +if( (fabs(y) < 2.e-4 * fabs(x)) + && (x > 0) ) + { + t = 0.25*y*(y/x); + } +else + { + r = cabs(z); + t = 0.5*(r - x); + } + +r = sqrt(t); +q.i = r; +q.r = y/(2.0*r); +/* Heron iteration in complex arithmetic */ +cdiv( &q, z, &s ); +cadd( &q, &s, w ); +w->r *= 0.5; +w->i *= 0.5; +} + + +double hypot( x, y ) +double x, y; +{ +cmplx z; + +z.r = x; +z.i = y; +return( cabs(&z) ); +} diff --git a/components/external/espruino/libs/math/const.c b/components/external/espruino/libs/math/const.c new file mode 100644 index 0000000000..834e106cc8 --- /dev/null +++ b/components/external/espruino/libs/math/const.c @@ -0,0 +1,252 @@ +/* const.c + * + * Globally declared constants + * + * + * + * SYNOPSIS: + * + * extern const double nameofconstant; + * + * + * + * + * DESCRIPTION: + * + * This file contains a number of mathematical constants and + * also some needed size parameters of the computer arithmetic. + * The values are supplied as arrays of hexadecimal integers + * for IEEE arithmetic; arrays of octal constants for DEC + * arithmetic; and in a normal decimal scientific notation for + * other machines. The particular notation used is determined + * by a symbol (DEC, IBMPC, or UNK) defined in the include file + * mconf.h. + * + * The default size parameters are as follows. + * + * For DEC and UNK modes: + * MACHEP = 1.38777878078144567553E-17 2**-56 + * MAXLOG = 8.8029691931113054295988E1 log(2**127) + * MINLOG = -8.872283911167299960540E1 log(2**-128) + * MAXNUM = 1.701411834604692317316873e38 2**127 + * + * For IEEE arithmetic (IBMPC): + * MACHEP = 1.11022302462515654042E-16 2**-53 + * MAXLOG = 7.09782712893383996843E2 log(2**1024) + * MINLOG = -7.08396418532264106224E2 log(2**-1022) + * MAXNUM = 1.7976931348623158E308 2**1024 + * + * The global symbols for mathematical constants are + * PI = 3.14159265358979323846 pi + * PIO2 = 1.57079632679489661923 pi/2 + * PIO4 = 7.85398163397448309616E-1 pi/4 + * SQRT2 = 1.41421356237309504880 sqrt(2) + * SQRTH = 7.07106781186547524401E-1 sqrt(2)/2 + * LOG2E = 1.4426950408889634073599 1/log(2) + * SQ2OPI = 7.9788456080286535587989E-1 sqrt( 2/pi ) + * LOGE2 = 6.93147180559945309417E-1 log(2) + * LOGSQ2 = 3.46573590279972654709E-1 log(2)/2 + * THPIO4 = 2.35619449019234492885 3*pi/4 + * TWOOPI = 6.36619772367581343075535E-1 2/pi + * + * These lists are subject to change. + */ + +/* const.c */ + +/* +Cephes Math Library Release 2.3: March, 1995 +Copyright 1984, 1995 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +#if 1 +const double MACHEP = 1.11022302462515654042E-16; /* 2**-53 */ +#else +const double MACHEP = 1.38777878078144567553E-17; /* 2**-56 */ +#endif +const double UFLOWTHRESH = 2.22507385850720138309E-308; /* 2**-1022 */ +#ifdef DENORMAL +const double MAXLOG = 7.09782712893383996732E2; /* log(MAXNUM) */ +/* const double MINLOG = -7.44440071921381262314E2; */ /* log(2**-1074) */ +const double MINLOG = -7.451332191019412076235E2; /* log(2**-1075) */ +#else +const double MAXLOG = 7.08396418532264106224E2; /* log 2**1022 */ +const double MINLOG = -7.08396418532264106224E2; /* log 2**-1022 */ +#endif +const double MAXNUM = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */ +const double PI = 3.14159265358979323846; /* pi */ +const double PIO2 = 1.57079632679489661923; /* pi/2 */ +const double PIO4 = 7.85398163397448309616E-1; /* pi/4 */ +const double SQRT2 = 1.41421356237309504880; /* sqrt(2) */ +const double SQRTH = 7.07106781186547524401E-1; /* sqrt(2)/2 */ +const double LOG2E = 1.4426950408889634073599; /* 1/log(2) */ +const double SQ2OPI = 7.9788456080286535587989E-1; /* sqrt( 2/pi ) */ +const double LOGE2 = 6.93147180559945309417E-1; /* log(2) */ +const double LOGSQ2 = 3.46573590279972654709E-1; /* log(2)/2 */ +const double THPIO4 = 2.35619449019234492885; /* 3*pi/4 */ +const double TWOOPI = 6.36619772367581343075535E-1; /* 2/pi */ +#ifdef INFINITIES +const double INFINITY = 1.0/0.0; /* 99e999; */ +#else +const double INFINITY = 1.79769313486231570815E308; /* 2**1024*(1-MACHEP) */ +#endif +#ifdef NANS +const double NAN = 1.0/0.0 - 1.0/0.0; +#else +const double NAN = 0.0; +#endif +#ifdef MINUSZERO +const double NEGZERO = -0.0; +#else +const double NEGZERO = 0.0; +#endif +#endif + +#ifdef IBMPC + /* 2**-53 = 1.11022302462515654042E-16 */ +const unsigned short MACHEP[4] = {0x0000,0x0000,0x0000,0x3ca0}; +const unsigned short UFLOWTHRESH[4] = {0x0000,0x0000,0x0000,0x0010}; +#ifdef DENORMAL + /* log(MAXNUM) = 7.09782712893383996732224E2 */ +const unsigned short MAXLOG[4] = {0x39ef,0xfefa,0x2e42,0x4086}; + /* log(2**-1074) = - -7.44440071921381262314E2 */ +/*const unsigned short MINLOG[4] = {0x71c3,0x446d,0x4385,0xc087};*/ +const unsigned short MINLOG[4] = {0x3052,0xd52d,0x4910,0xc087}; +#else + /* log(2**1022) = 7.08396418532264106224E2 */ +const unsigned short MAXLOG[4] = {0xbcd2,0xdd7a,0x232b,0x4086}; + /* log(2**-1022) = - 7.08396418532264106224E2 */ +const unsigned short MINLOG[4] = {0xbcd2,0xdd7a,0x232b,0xc086}; +#endif + /* 2**1024*(1-MACHEP) = 1.7976931348623158E308 */ +const unsigned short MAXNUM[4] = {0xffff,0xffff,0xffff,0x7fef}; +const unsigned short PI[4] = {0x2d18,0x5444,0x21fb,0x4009}; +const unsigned short PIO2[4] = {0x2d18,0x5444,0x21fb,0x3ff9}; +const unsigned short PIO4[4] = {0x2d18,0x5444,0x21fb,0x3fe9}; +const unsigned short SQRT2[4] = {0x3bcd,0x667f,0xa09e,0x3ff6}; +const unsigned short SQRTH[4] = {0x3bcd,0x667f,0xa09e,0x3fe6}; +const unsigned short LOG2E[4] = {0x82fe,0x652b,0x1547,0x3ff7}; +const unsigned short SQ2OPI[4] = {0x3651,0x33d4,0x8845,0x3fe9}; +const unsigned short LOGE2[4] = {0x39ef,0xfefa,0x2e42,0x3fe6}; +const unsigned short LOGSQ2[4] = {0x39ef,0xfefa,0x2e42,0x3fd6}; +const unsigned short THPIO4[4] = {0x21d2,0x7f33,0xd97c,0x4002}; +const unsigned short TWOOPI[4] = {0xc883,0x6dc9,0x5f30,0x3fe4}; +#ifdef INFINITIES +const unsigned short INFINITY[4] = {0x0000,0x0000,0x0000,0x7ff0}; +#else +const unsigned short INFINITY[4] = {0xffff,0xffff,0xffff,0x7fef}; +#endif +#ifdef NANS +const unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x7ffc}; +#else +const unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x0000}; +#endif +#ifdef MINUSZERO +const unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x8000}; +#else +const unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x0000}; +#endif +#endif + +#ifdef MIEEE + /* 2**-53 = 1.11022302462515654042E-16 */ +const unsigned short MACHEP[4] = {0x3ca0,0x0000,0x0000,0x0000}; +const unsigned short UFLOWTHRESH[4] = {0x0010,0x0000,0x0000,0x0000}; +#ifdef DENORMAL + /* log(2**1024) = 7.09782712893383996843E2 */ +const unsigned short MAXLOG[4] = {0x4086,0x2e42,0xfefa,0x39ef}; + /* log(2**-1074) = - -7.44440071921381262314E2 */ +/* const unsigned short MINLOG[4] = {0xc087,0x4385,0x446d,0x71c3}; */ +const unsigned short MINLOG[4] = {0xc087,0x4910,0xd52d,0x3052}; +#else + /* log(2**1022) = 7.08396418532264106224E2 */ +const unsigned short MAXLOG[4] = {0x4086,0x232b,0xdd7a,0xbcd2}; + /* log(2**-1022) = - 7.08396418532264106224E2 */ +const unsigned short MINLOG[4] = {0xc086,0x232b,0xdd7a,0xbcd2}; +#endif + /* 2**1024*(1-MACHEP) = 1.7976931348623158E308 */ +const unsigned short MAXNUM[4] = {0x7fef,0xffff,0xffff,0xffff}; +const unsigned short PI[4] = {0x4009,0x21fb,0x5444,0x2d18}; +const unsigned short PIO2[4] = {0x3ff9,0x21fb,0x5444,0x2d18}; +const unsigned short PIO4[4] = {0x3fe9,0x21fb,0x5444,0x2d18}; +const unsigned short SQRT2[4] = {0x3ff6,0xa09e,0x667f,0x3bcd}; +const unsigned short SQRTH[4] = {0x3fe6,0xa09e,0x667f,0x3bcd}; +const unsigned short LOG2E[4] = {0x3ff7,0x1547,0x652b,0x82fe}; +const unsigned short SQ2OPI[4] = {0x3fe9,0x8845,0x33d4,0x3651}; +const unsigned short LOGE2[4] = {0x3fe6,0x2e42,0xfefa,0x39ef}; +const unsigned short LOGSQ2[4] = {0x3fd6,0x2e42,0xfefa,0x39ef}; +const unsigned short THPIO4[4] = {0x4002,0xd97c,0x7f33,0x21d2}; +const unsigned short TWOOPI[4] = {0x3fe4,0x5f30,0x6dc9,0xc883}; +#ifdef INFINITIES +const unsigned short INFINITY[4] = {0x7ff0,0x0000,0x0000,0x0000}; +#else +const unsigned short INFINITY[4] = {0x7fef,0xffff,0xffff,0xffff}; +#endif +#ifdef NANS +const unsigned short NAN[4] = {0x7ff8,0x0000,0x0000,0x0000}; +#else +const unsigned short NAN[4] = {0x0000,0x0000,0x0000,0x0000}; +#endif +#ifdef MINUSZERO +const unsigned short NEGZERO[4] = {0x8000,0x0000,0x0000,0x0000}; +#else +const unsigned short NEGZERO[4] = {0x0000,0x0000,0x0000,0x0000}; +#endif +#endif + +#ifdef DEC + /* 2**-56 = 1.38777878078144567553E-17 */ +const unsigned short MACHEP[4] = {0022200,0000000,0000000,0000000}; +const unsigned short UFLOWTHRESH[4] = {0x0080,0x0000,0x0000,0x0000}; + /* log 2**127 = 88.029691931113054295988 */ +const unsigned short MAXLOG[4] = {041660,007463,0143742,025733,}; + /* log 2**-128 = -88.72283911167299960540 */ +const unsigned short MINLOG[4] = {0141661,071027,0173721,0147572,}; + /* 2**127 = 1.701411834604692317316873e38 */ +const unsigned short MAXNUM[4] = {077777,0177777,0177777,0177777,}; +const unsigned short PI[4] = {040511,007732,0121041,064302,}; +const unsigned short PIO2[4] = {040311,007732,0121041,064302,}; +const unsigned short PIO4[4] = {040111,007732,0121041,064302,}; +const unsigned short SQRT2[4] = {040265,002363,031771,0157145,}; +const unsigned short SQRTH[4] = {040065,002363,031771,0157144,}; +const unsigned short LOG2E[4] = {040270,0125073,024534,013761,}; +const unsigned short SQ2OPI[4] = {040114,041051,0117241,0131204,}; +const unsigned short LOGE2[4] = {040061,071027,0173721,0147572,}; +const unsigned short LOGSQ2[4] = {037661,071027,0173721,0147572,}; +const unsigned short THPIO4[4] = {040426,0145743,0174631,007222,}; +const unsigned short TWOOPI[4] = {040042,0174603,067116,042025,}; +/* Approximate infinity by MAXNUM. */ +const unsigned short INFINITY[4] = {077777,0177777,0177777,0177777,}; +const unsigned short NAN[4] = {0000000,0000000,0000000,0000000}; +#ifdef MINUSZERO +const unsigned short NEGZERO[4] = {0000000,0000000,0000000,0100000}; +#else +const unsigned short NEGZERO[4] = {0000000,0000000,0000000,0000000}; +#endif +#endif + +#ifndef UNK +extern const unsigned short MACHEP[]; +extern const unsigned short UFLOWTHRESH[]; +extern const unsigned short MAXLOG[]; +extern const unsigned short UNDLOG[]; +extern const unsigned short MINLOG[]; +extern const unsigned short MAXNUM[]; +extern const unsigned short PI[]; +extern const unsigned short PIO2[]; +extern const unsigned short PIO4[]; +extern const unsigned short SQRT2[]; +extern const unsigned short SQRTH[]; +extern const unsigned short LOG2E[]; +extern const unsigned short SQ2OPI[]; +extern const unsigned short LOGE2[]; +extern const unsigned short LOGSQ2[]; +extern const unsigned short THPIO4[]; +extern const unsigned short TWOOPI[]; +extern const unsigned short INFINITY[]; +extern const unsigned short NAN[]; +extern const unsigned short NEGZERO[]; +#endif diff --git a/components/external/espruino/libs/math/cosh.c b/components/external/espruino/libs/math/cosh.c new file mode 100644 index 0000000000..75c09d397e --- /dev/null +++ b/components/external/espruino/libs/math/cosh.c @@ -0,0 +1,83 @@ +/* cosh.c + * + * Hyperbolic cosine + * + * + * + * SYNOPSIS: + * + * double x, y, cosh(); + * + * y = cosh( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic cosine of argument in the range MINLOG to + * MAXLOG. + * + * cosh(x) = ( exp(x) + exp(-x) )/2. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC +- 88 50000 4.0e-17 7.7e-18 + * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cosh overflow |x| > MAXLOG MAXNUM + * + * + */ + +/* cosh.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" +#ifdef ANSIPROT +extern double exp ( double ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double exp(); +int isnan(), isfinite(); +#endif +extern double MAXLOG, INFINITY, LOGE2; + +double cosh(x) +double x; +{ +double y; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +if( x < 0 ) + x = -x; +if( x > (MAXLOG + LOGE2) ) + { + mtherr( "cosh", OVERFLOW ); + return( INFINITY ); + } +if( x >= (MAXLOG - LOGE2) ) + { + y = exp(0.5 * x); + y = (0.5 * y) * y; + return(y); + } +y = exp(x); +y = 0.5 * (y + 1.0 / y); +return( y ); +} diff --git a/components/external/espruino/libs/math/descrip.mms b/components/external/espruino/libs/math/descrip.mms new file mode 100644 index 0000000000..c68f38e2e3 --- /dev/null +++ b/components/external/espruino/libs/math/descrip.mms @@ -0,0 +1,99 @@ +CFLAGS= /DEBUG/NOLIST +hfiles= mconf.h- + +ofiles= acosh.obj- + asin.obj- + asinh.obj- + atan.obj- + atanh.obj- + cbrt.obj- + chbevl.obj- + const.obj- + cosh.obj- + drand.obj- + exp.obj- + exp10.obj- + fabs.obj- + floor.obj- + log.obj- + log10.obj- + polevl.obj- + pow.obj- + powi.obj- + round.obj- + sin.obj- + sinh.obj- + tan.obj- + tanh.obj- + unity.obj- + sqrt.obj- + floor.obj- + polevl.obj- + mtherr.obj + +mtst.exe : $(ofiles) + LINK mtst/option +acosh.obj : acosh.c,$(HFILES) + CC $(CFLAGS) acosh +asin.obj : asin.c,$(HFILES) + CC $(CFLAGS) asin +asinh.obj : asinh.c,$(HFILES) + CC $(CFLAGS) asinh +atan.obj : atan.c,$(HFILES) + CC $(CFLAGS) atan +atan.obj : atan.c,$(HFILES) + CC $(CFLAGS) atan +atanh.obj : atanh.c,$(HFILES) + CC $(CFLAGS) atanh +cbrt.obj : cbrt.c,$(HFILES) + CC $(CFLAGS) cbrt +chbevl.obj : chbevl.c,$(HFILES) + CC $(CFLAGS) chbevl +const.obj : const.c,$(HFILES) + CC $(CFLAGS) const +cosh.obj : cosh.c,$(HFILES) + CC $(CFLAGS) cosh +drand.obj : drand.c,$(HFILES) + CC $(CFLAGS) drand +exp.obj : exp.c,$(HFILES) + CC $(CFLAGS) exp +exp10.obj : exp10.c,$(HFILES) + CC $(CFLAGS) exp10 +fabs.obj : fabs.c,$(HFILES) + CC $(CFLAGS) fabs +floor.obj : floor.c,$(HFILES) + CC $(CFLAGS) floor +log.obj : log.c,$(HFILES) + CC $(CFLAGS) log +log10.obj : log10.c,$(HFILES) + CC $(CFLAGS) log10 +polevl.obj : polevl.c,$(HFILES) + CC $(CFLAGS) polevl +pow.obj : pow.c,$(HFILES) + CC $(CFLAGS) pow +powi.obj : powi.c,$(HFILES) + CC $(CFLAGS) powi +round.obj : round.c,$(HFILES) + CC $(CFLAGS) round +sin.obj : sin.c,$(HFILES) + CC $(CFLAGS) sin +sinh.obj : sinh.c,$(HFILES) + CC $(CFLAGS) sinh +tan.obj : tan.c,$(HFILES) + CC $(CFLAGS) tan +tanh.obj : tanh.c,$(HFILES) + CC $(CFLAGS) tanh +unity.obj : unity.c,$(HFILES) + CC $(CFLAGS) unity +sqrt.obj : sqrt.c,$(HFILES) + CC $(CFLAGS) sqrt +mtherr.obj : mtherr.c,$(HFILES) + CC $(CFLAGS) mtherr + + + + + + + + diff --git a/components/external/espruino/libs/math/drand.c b/components/external/espruino/libs/math/drand.c new file mode 100644 index 0000000000..07bd3261b9 --- /dev/null +++ b/components/external/espruino/libs/math/drand.c @@ -0,0 +1,161 @@ +/* drand.c + * + * Pseudorandom number generator + * + * + * + * SYNOPSIS: + * + * double y, drand(); + * + * drand( &y ); + * + * + * + * DESCRIPTION: + * + * Yields a random number 1.0 <= y < 2.0. + * + * The three-generator congruential algorithm by Brian + * Wichmann and David Hill (BYTE magazine, March, 1987, + * pp 127-8) is used. The period, given by them, is + * 6953607871644. + * + * Versions invoked by the different arithmetic compile + * time options DEC, IBMPC, and MIEEE, produce + * approximately the same sequences, differing only in the + * least significant bits of the numbers. The UNK option + * implements the algorithm as recommended in the BYTE + * article. It may be used on all computers. However, + * the low order bits of a double precision number may + * not be adequately random, and may vary due to arithmetic + * implementation details on different computers. + * + * The other compile options generate an additional random + * integer that overwrites the low order bits of the double + * precision number. This reduces the period by a factor of + * two but tends to overcome the problems mentioned. + * + */ + + +/* Three-generator random number algorithm + * of Brian Wichmann and David Hill + * BYTE magazine, March, 1987 pp 127-8 + * + * The period, given by them, is (p-1)(q-1)(r-1)/4 = 6.95e12. + */ + +#include "mconf.h" +#ifdef ANSIPROT +static int ranwh ( void ); +#else +static int ranwh(); +#endif + +static int sx = 1; +static int sy = 10000; +static int sz = 3000; + +static union { + double d; + unsigned short s[4]; +} unkans; + +/* This function implements the three + * congruential generators. + */ + +static int ranwh() +{ +int r, s; + +/* sx = sx * 171 mod 30269 */ +r = sx/177; +s = sx - 177 * r; +sx = 171 * s - 2 * r; +if( sx < 0 ) + sx += 30269; + + +/* sy = sy * 172 mod 30307 */ +r = sy/176; +s = sy - 176 * r; +sy = 172 * s - 35 * r; +if( sy < 0 ) + sy += 30307; + +/* sz = 170 * sz mod 30323 */ +r = sz/178; +s = sz - 178 * r; +sz = 170 * s - 63 * r; +if( sz < 0 ) + sz += 30323; +/* The results are in static sx, sy, sz. */ +return 0; +} + +/* drand.c + * + * Random double precision floating point number between 1 and 2. + * + * C callable: + * drand( &x ); + */ + +int drand( a ) +double *a; +{ +unsigned short r; +#ifdef DEC +unsigned short s, t; +#endif + +/* This algorithm of Wichmann and Hill computes a floating point + * result: + */ +ranwh(); +unkans.d = sx/30269.0 + sy/30307.0 + sz/30323.0; +r = unkans.d; +unkans.d -= r; +unkans.d += 1.0; + +/* if UNK option, do nothing further. + * Otherwise, make a random 16 bit integer + * to overwrite the least significant word + * of unkans. + */ +#ifdef UNK +/* do nothing */ +#else +ranwh(); +r = sx * sy + sz; +#endif + +#ifdef DEC +/* To make the numbers as similar as possible + * in all arithmetics, the random integer has + * to be inserted 3 bits higher up in a DEC number. + * An alternative would be put it 3 bits lower down + * in all the other number types. + */ +s = unkans.s[2]; +t = s & 07; /* save these bits to put in at the bottom */ +s &= 0177770; +s |= (r >> 13) & 07; +unkans.s[2] = s; +t |= r << 3; +unkans.s[3] = t; +#endif + +#ifdef IBMPC +unkans.s[0] = r; +#endif + +#ifdef MIEEE +unkans.s[3] = r; +#endif + +*a = unkans.d; +return 0; +} diff --git a/components/external/espruino/libs/math/dtestvec.c b/components/external/espruino/libs/math/dtestvec.c new file mode 100644 index 0000000000..37901e3721 --- /dev/null +++ b/components/external/espruino/libs/math/dtestvec.c @@ -0,0 +1,543 @@ + +/* Test vectors for math functions. + See C9X section F.9. */ +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1998, 2000 by Stephen L. Moshier +*/ + +#include <stdio.h> +#include <stdlib.h> +#include <string.h> +int isfinite (double); + +/* C9X spells lgam lgamma. */ +#define GLIBC2 0 + +extern double PI; +const static double MPI, PIO2, MPIO2, PIO4, MPIO4, THPIO4, MTHPIO4; + +#if 0 +#define PI 3.141592653589793238463E0 +#define PIO2 1.570796326794896619231E0 +#define PIO4 7.853981633974483096157E-1 +#define THPIO4 2.35619449019234492884698 +#define SQRT2 1.414213562373095048802E0 +#define SQRTH 7.071067811865475244008E-1 +#define INF (1.0/0.0) +#define MINF (-1.0/0.0) +#endif + +extern double MACHEP, SQRTH, SQRT2; +extern double NAN, INFINITY, NEGZERO; +const static double INF, MINF; +const static double ZERO, MZERO, HALF, MHALF, ONE, MONE, TWO, MTWO, THREE, MTHREE; +/* #define NAN (1.0/0.0 - 1.0/0.0) */ + +/* Functions of one variable. */ +double log (double); +double exp ( double); +double atan (double); +double sin (double); +double cos (double); +double tan (double); +double acos (double); +double asin (double); +double acosh (double); +double asinh (double); +double atanh (double); +double sinh (double); +double cosh (double); +double tanh (double); +double exp2 (double); +double expm1 (double); +double log10 (double); +double log1p (double); +double log2 (double); +double fabs (double); +double erf (double); +double erfc (double); +double gamma (double); +double floor (double); +double ceil (double); +double cbrt (double); +#if GLIBC2 +double lgamma (double); +#else +double lgam (double); +#endif + +struct oneargument + { + char *name; /* Name of the function. */ + double (*func) (double); + double *arg1; + double *answer; + int thresh; /* Error report threshold. */ + }; + +struct oneargument test1[] = +{ + {"atan", atan, &ONE, &PIO4, 0}, + {"sin", sin, &PIO2, &ONE, 0}, +#if 0 + {"cos", cos, &PIO4, &SQRTH, 0}, + {"sin", sin, 32767., 1.8750655394138942394239E-1, 0}, + {"cos", cos, 32767., 9.8226335176928229845654E-1, 0}, + {"tan", tan, 32767., 1.9089234430221485740826E-1, 0}, + {"sin", sin, 8388607., 9.9234509376961249835628E-1, 0}, + {"cos", cos, 8388607., -1.2349580912475928183718E-1, 0}, + {"tan", tan, 8388607., -8.0354556223613614748329E0, 0}, + /* + {"sin", sin, 2147483647., -7.2491655514455639054829E-1, 0}, + {"cos", cos, 2147483647., -6.8883669187794383467976E-1, 0}, + {"tan", tan, 2147483647., 1.0523779637351339136698E0, 0}, + */ + {"cos", cos, &PIO2, 6.1232339957367574e-17, 1}, + {"sin", sin, &PIO4, &SQRTH, 1}, +#endif + {"acos", acos, &NAN, &NAN, 0}, + {"acos", acos, &ONE, &ZERO, 0}, + {"acos", acos, &TWO, &NAN, 0}, + {"acos", acos, &MTWO, &NAN, 0}, + {"asin", asin, &NAN, &NAN, 0}, + {"asin", asin, &ZERO, &ZERO, 0}, + {"asin", asin, &MZERO, &MZERO, 0}, + {"asin", asin, &TWO, &NAN, 0}, + {"asin", asin, &MTWO, &NAN, 0}, + {"atan", atan, &NAN, &NAN, 0}, + {"atan", atan, &ZERO, &ZERO, 0}, + {"atan", atan, &MZERO, &MZERO, 0}, + {"atan", atan, &INF, &PIO2, 0}, + {"atan", atan, &MINF, &MPIO2, 0}, + {"cos", cos, &NAN, &NAN, 0}, + {"cos", cos, &ZERO, &ONE, 0}, + {"cos", cos, &MZERO, &ONE, 0}, + {"cos", cos, &INF, &NAN, 0}, + {"cos", cos, &MINF, &NAN, 0}, + {"sin", sin, &NAN, &NAN, 0}, + {"sin", sin, &MZERO, &MZERO, 0}, + {"sin", sin, &ZERO, &ZERO, 0}, + {"sin", sin, &INF, &NAN, 0}, + {"sin", sin, &MINF, &NAN, 0}, + {"tan", tan, &NAN, &NAN, 0}, + {"tan", tan, &ZERO, &ZERO, 0}, + {"tan", tan, &MZERO, &MZERO, 0}, + {"tan", tan, &INF, &NAN, 0}, + {"tan", tan, &MINF, &NAN, 0}, + {"acosh", acosh, &NAN, &NAN, 0}, + {"acosh", acosh, &ONE, &ZERO, 0}, + {"acosh", acosh, &INF, &INF, 0}, + {"acosh", acosh, &HALF, &NAN, 0}, + {"acosh", acosh, &MONE, &NAN, 0}, + {"asinh", asinh, &NAN, &NAN, 0}, + {"asinh", asinh, &ZERO, &ZERO, 0}, + {"asinh", asinh, &MZERO, &MZERO, 0}, + {"asinh", asinh, &INF, &INF, 0}, + {"asinh", asinh, &MINF, &MINF, 0}, + {"atanh", atanh, &NAN, &NAN, 0}, + {"atanh", atanh, &ZERO, &ZERO, 0}, + {"atanh", atanh, &MZERO, &MZERO, 0}, + {"atanh", atanh, &ONE, &INF, 0}, + {"atanh", atanh, &MONE, &MINF, 0}, + {"atanh", atanh, &TWO, &NAN, 0}, + {"atanh", atanh, &MTWO, &NAN, 0}, + {"cosh", cosh, &NAN, &NAN, 0}, + {"cosh", cosh, &ZERO, &ONE, 0}, + {"cosh", cosh, &MZERO, &ONE, 0}, + {"cosh", cosh, &INF, &INF, 0}, + {"cosh", cosh, &MINF, &INF, 0}, + {"sinh", sinh, &NAN, &NAN, 0}, + {"sinh", sinh, &ZERO, &ZERO, 0}, + {"sinh", sinh, &MZERO, &MZERO, 0}, + {"sinh", sinh, &INF, &INF, 0}, + {"sinh", sinh, &MINF, &MINF, 0}, + {"tanh", tanh, &NAN, &NAN, 0}, + {"tanh", tanh, &ZERO, &ZERO, 0}, + {"tanh", tanh, &MZERO, &MZERO, 0}, + {"tanh", tanh, &INF, &ONE, 0}, + {"tanh", tanh, &MINF, &MONE, 0}, + {"exp", exp, &NAN, &NAN, 0}, + {"exp", exp, &ZERO, &ONE, 0}, + {"exp", exp, &MZERO, &ONE, 0}, + {"exp", exp, &INF, &INF, 0}, + {"exp", exp, &MINF, &ZERO, 0}, +#if !GLIBC2 + {"exp2", exp2, &NAN, &NAN, 0}, + {"exp2", exp2, &ZERO, &ONE, 0}, + {"exp2", exp2, &MZERO, &ONE, 0}, + {"exp2", exp2, &INF, &INF, 0}, + {"exp2", exp2, &MINF, &ZERO, 0}, +#endif + {"expm1", expm1, &NAN, &NAN, 0}, + {"expm1", expm1, &ZERO, &ZERO, 0}, + {"expm1", expm1, &MZERO, &MZERO, 0}, + {"expm1", expm1, &INF, &INF, 0}, + {"expm1", expm1, &MINF, &MONE, 0}, + {"log", log, &NAN, &NAN, 0}, + {"log", log, &ZERO, &MINF, 0}, + {"log", log, &MZERO, &MINF, 0}, + {"log", log, &ONE, &ZERO, 0}, + {"log", log, &MONE, &NAN, 0}, + {"log", log, &INF, &INF, 0}, + {"log10", log10, &NAN, &NAN, 0}, + {"log10", log10, &ZERO, &MINF, 0}, + {"log10", log10, &MZERO, &MINF, 0}, + {"log10", log10, &ONE, &ZERO, 0}, + {"log10", log10, &MONE, &NAN, 0}, + {"log10", log10, &INF, &INF, 0}, + {"log1p", log1p, &NAN, &NAN, 0}, + {"log1p", log1p, &ZERO, &ZERO, 0}, + {"log1p", log1p, &MZERO, &MZERO, 0}, + {"log1p", log1p, &MONE, &MINF, 0}, + {"log1p", log1p, &MTWO, &NAN, 0}, + {"log1p", log1p, &INF, &INF, 0}, +#if !GLIBC2 + {"log2", log2, &NAN, &NAN, 0}, + {"log2", log2, &ZERO, &MINF, 0}, + {"log2", log2, &MZERO, &MINF, 0}, + {"log2", log2, &MONE, &NAN, 0}, + {"log2", log2, &INF, &INF, 0}, +#endif + /* {"fabs", fabs, NAN, NAN, 0}, */ + {"fabs", fabs, &ONE, &ONE, 0}, + {"fabs", fabs, &MONE, &ONE, 0}, + {"fabs", fabs, &ZERO, &ZERO, 0}, + {"fabs", fabs, &MZERO, &ZERO, 0}, + {"fabs", fabs, &INF, &INF, 0}, + {"fabs", fabs, &MINF, &INF, 0}, + {"cbrt", cbrt, &NAN, &NAN, 0}, + {"cbrt", cbrt, &ZERO, &ZERO, 0}, + {"cbrt", cbrt, &MZERO, &MZERO, 0}, + {"cbrt", cbrt, &INF, &INF, 0}, + {"cbrt", cbrt, &MINF, &MINF, 0}, + {"erf", erf, &NAN, &NAN, 0}, + {"erf", erf, &ZERO, &ZERO, 0}, + {"erf", erf, &MZERO, &MZERO, 0}, + {"erf", erf, &INF, &ONE, 0}, + {"erf", erf, &MINF, &MONE, 0}, + {"erfc", erfc, &NAN, &NAN, 0}, + {"erfc", erfc, &INF, &ZERO, 0}, + {"erfc", erfc, &MINF, &TWO, 0}, + {"gamma", gamma, &NAN, &NAN, 0}, + {"gamma", gamma, &INF, &INF, 0}, + {"gamma", gamma, &MONE, &NAN, 0}, + {"gamma", gamma, &ZERO, &NAN, 0}, + {"gamma", gamma, &MINF, &NAN, 0}, +#if GLIBC2 + {"lgamma", lgamma, &NAN, &NAN, 0}, + {"lgamma", lgamma, &INF, &INF, 0}, + {"lgamma", lgamma, &MONE, &INF, 0}, + {"lgamma", lgamma, &ZERO, &INF, 0}, + {"lgamma", lgamma, &MINF, &INF, 0}, +#else + {"lgam", lgam, &NAN, &NAN, 0}, + {"lgam", lgam, &INF, &INF, 0}, + {"lgam", lgam, &MONE, &INF, 0}, + {"lgam", lgam, &ZERO, &INF, 0}, + {"lgam", lgam, &MINF, &INF, 0}, +#endif + {"ceil", ceil, &NAN, &NAN, 0}, + {"ceil", ceil, &ZERO, &ZERO, 0}, + {"ceil", ceil, &MZERO, &MZERO, 0}, + {"ceil", ceil, &INF, &INF, 0}, + {"ceil", ceil, &MINF, &MINF, 0}, + {"floor", floor, &NAN, &NAN, 0}, + {"floor", floor, &ZERO, &ZERO, 0}, + {"floor", floor, &MZERO, &MZERO, 0}, + {"floor", floor, &INF, &INF, 0}, + {"floor", floor, &MINF, &MINF, 0}, + {"null", NULL, &ZERO, &ZERO, 0}, +}; + +/* Functions of two variables. */ +double atan2 (double, double); +double pow (double, double); + +struct twoarguments + { + char *name; /* Name of the function. */ + double (*func) (double, double); + double *arg1; + double *arg2; + double *answer; + int thresh; + }; + +struct twoarguments test2[] = +{ + {"atan2", atan2, &ZERO, &ONE, &ZERO, 0}, + {"atan2", atan2, &MZERO, &ONE, &MZERO, 0}, + {"atan2", atan2, &ZERO, &ZERO, &ZERO, 0}, + {"atan2", atan2, &MZERO, &ZERO, &MZERO, 0}, + {"atan2", atan2, &ZERO, &MONE, &PI, 0}, + {"atan2", atan2, &MZERO, &MONE, &MPI, 0}, + {"atan2", atan2, &ZERO, &MZERO, &PI, 0}, + {"atan2", atan2, &MZERO, &MZERO, &MPI, 0}, + {"atan2", atan2, &ONE, &ZERO, &PIO2, 0}, + {"atan2", atan2, &ONE, &MZERO, &PIO2, 0}, + {"atan2", atan2, &MONE, &ZERO, &MPIO2, 0}, + {"atan2", atan2, &MONE, &MZERO, &MPIO2, 0}, + {"atan2", atan2, &ONE, &INF, &ZERO, 0}, + {"atan2", atan2, &MONE, &INF, &MZERO, 0}, + {"atan2", atan2, &INF, &ONE, &PIO2, 0}, + {"atan2", atan2, &INF, &MONE, &PIO2, 0}, + {"atan2", atan2, &MINF, &ONE, &MPIO2, 0}, + {"atan2", atan2, &MINF, &MONE, &MPIO2, 0}, + {"atan2", atan2, &ONE, &MINF, &PI, 0}, + {"atan2", atan2, &MONE, &MINF, &MPI, 0}, + {"atan2", atan2, &INF, &INF, &PIO4, 0}, + {"atan2", atan2, &MINF, &INF, &MPIO4, 0}, + {"atan2", atan2, &INF, &MINF, &THPIO4, 0}, + {"atan2", atan2, &MINF, &MINF, &MTHPIO4, 0}, + {"atan2", atan2, &ONE, &ONE, &PIO4, 0}, + {"atan2", atan2, &NAN, &ONE, &NAN, 0}, + {"atan2", atan2, &ONE, &NAN, &NAN, 0}, + {"atan2", atan2, &NAN, &NAN, &NAN, 0}, + {"pow", pow, &ONE, &ZERO, &ONE, 0}, + {"pow", pow, &ONE, &MZERO, &ONE, 0}, + {"pow", pow, &MONE, &ZERO, &ONE, 0}, + {"pow", pow, &MONE, &MZERO, &ONE, 0}, + {"pow", pow, &INF, &ZERO, &ONE, 0}, + {"pow", pow, &INF, &MZERO, &ONE, 0}, + {"pow", pow, &NAN, &ZERO, &ONE, 0}, + {"pow", pow, &NAN, &MZERO, &ONE, 0}, + {"pow", pow, &TWO, &INF, &INF, 0}, + {"pow", pow, &MTWO, &INF, &INF, 0}, + {"pow", pow, &HALF, &INF, &ZERO, 0}, + {"pow", pow, &MHALF, &INF, &ZERO, 0}, + {"pow", pow, &TWO, &MINF, &ZERO, 0}, + {"pow", pow, &MTWO, &MINF, &ZERO, 0}, + {"pow", pow, &HALF, &MINF, &INF, 0}, + {"pow", pow, &MHALF, &MINF, &INF, 0}, + {"pow", pow, &INF, &HALF, &INF, 0}, + {"pow", pow, &INF, &TWO, &INF, 0}, + {"pow", pow, &INF, &MHALF, &ZERO, 0}, + {"pow", pow, &INF, &MTWO, &ZERO, 0}, + {"pow", pow, &MINF, &THREE, &MINF, 0}, + {"pow", pow, &MINF, &TWO, &INF, 0}, + {"pow", pow, &MINF, &MTHREE, &MZERO, 0}, + {"pow", pow, &MINF, &MTWO, &ZERO, 0}, + {"pow", pow, &NAN, &ONE, &NAN, 0}, + {"pow", pow, &ONE, &NAN, &NAN, 0}, + {"pow", pow, &NAN, &NAN, &NAN, 0}, + {"pow", pow, &ONE, &INF, &NAN, 0}, + {"pow", pow, &MONE, &INF, &NAN, 0}, + {"pow", pow, &ONE, &MINF, &NAN, 0}, + {"pow", pow, &MONE, &MINF, &NAN, 0}, + {"pow", pow, &MTWO, &HALF, &NAN, 0}, + {"pow", pow, &ZERO, &MTHREE, &INF, 0}, + {"pow", pow, &MZERO, &MTHREE, &MINF, 0}, + {"pow", pow, &ZERO, &MHALF, &INF, 0}, + {"pow", pow, &MZERO, &MHALF, &INF, 0}, + {"pow", pow, &ZERO, &THREE, &ZERO, 0}, + {"pow", pow, &MZERO, &THREE, &MZERO, 0}, + {"pow", pow, &ZERO, &HALF, &ZERO, 0}, + {"pow", pow, &MZERO, &HALF, &ZERO, 0}, + {"null", NULL, &ZERO, &ZERO, &ZERO, 0}, +}; + +/* Integer functions of one variable. */ + +int isnan (double); +int signbit (double); + +struct intans + { + char *name; /* Name of the function. */ + int (*func) (double); + double *arg1; + int ianswer; + }; + +struct intans test3[] = +{ + {"isfinite", isfinite, &ZERO, 1}, + {"isfinite", isfinite, &INF, 0}, + {"isfinite", isfinite, &MINF, 0}, + {"isnan", isnan, &NAN, 1}, + {"isnan", isnan, &INF, 0}, + {"isnan", isnan, &ZERO, 0}, + {"isnan", isnan, &MZERO, 0}, + {"signbit", signbit, &MZERO, 1}, + {"signbit", signbit, &MONE, 1}, + {"signbit", signbit, &ZERO, 0}, + {"signbit", signbit, &ONE, 0}, + {"signbit", signbit, &MINF, 1}, + {"signbit", signbit, &INF, 0}, + {"null", NULL, &ZERO, 0}, +}; + +static volatile double x1; +static volatile double x2; +static volatile double y; +static volatile double answer; + +void +pvec(x) +double x; +{ + union + { + double d; + unsigned short s[4]; + } u; + int i; + + u.d = x; + for (i = 0; i < 4; i++) + printf ("0x%04x ", u.s[i]); + printf ("\n"); +} + + +int +main () +{ + int i, nerrors, k, ianswer, ntests; + double (*fun1) (double); + double (*fun2) (double, double); + int (*fun3) (double); + double e; + union + { + double d; + char c[8]; + } u, v; + + ZERO = 0.0; + MZERO = NEGZERO; + HALF = 0.5; + MHALF = -HALF; + ONE = 1.0; + MONE = -ONE; + TWO = 2.0; + MTWO = -TWO; + THREE = 3.0; + MTHREE = -THREE; + INF = INFINITY; + MINF = -INFINITY; + MPI = -PI; + PIO2 = 0.5 * PI; + MPIO2 = -PIO2; + PIO4 = 0.5 * PIO2; + MPIO4 = -PIO4; + THPIO4 = 3.0 * PIO4; + MTHPIO4 = -THPIO4; + + nerrors = 0; + ntests = 0; + i = 0; + for (;;) + { + fun1 = test1[i].func; + if (fun1 == NULL) + break; + x1 = *(test1[i].arg1); + y = (*(fun1)) (x1); + answer = *(test1[i].answer); + if (test1[i].thresh == 0) + { + v.d = answer; + u.d = y; + if (memcmp(u.c, v.c, 8) != 0) + { + if( isnan(v.d) && isnan(u.d) ) + goto nxttest1; + goto wrongone; + } + else + goto nxttest1; + } + if (y != answer) + { + e = y - answer; + if (answer != 0.0) + e = e / answer; + if (e < 0) + e = -e; + if (e > test1[i].thresh * MACHEP) + { +wrongone: + printf ("%s (%.16e) = %.16e\n should be %.16e\n", + test1[i].name, x1, y, answer); + nerrors += 1; + } + } +nxttest1: + ntests += 1; + i += 1; + } + + i = 0; + for (;;) + { + fun2 = test2[i].func; + if (fun2 == NULL) + break; + x1 = *(test2[i].arg1); + x2 = *(test2[i].arg2); + y = (*(fun2)) (x1, x2); + answer = *(test2[i].answer); + if (test2[i].thresh == 0) + { + v.d = answer; + u.d = y; + if (memcmp(u.c, v.c, 8) != 0) + { + if( isnan(v.d) && isnan(u.d) ) + goto nxttest2; +#if 0 + if( isnan(v.d) ) + pvec(v.d); + if( isnan(u.d) ) + pvec(u.d); +#endif + goto wrongtwo; + } + else + goto nxttest2; + } + if (y != answer) + { + e = y - answer; + if (answer != 0.0) + e = e / answer; + if (e < 0) + e = -e; + if (e > test2[i].thresh * MACHEP) + { +wrongtwo: + printf ("%s (%.16e, %.16e) = %.16e\n should be %.16e\n", + test2[i].name, x1, x2, y, answer); + nerrors += 1; + } + } +nxttest2: + ntests += 1; + i += 1; + } + + + i = 0; + for (;;) + { + fun3 = test3[i].func; + if (fun3 == NULL) + break; + x1 = *(test3[i].arg1); + k = (*(fun3)) (x1); + ianswer = test3[i].ianswer; + if (k != ianswer) + { + printf ("%s (%.16e) = %d\n should be. %d\n", + test3[i].name, x1, k, ianswer); + nerrors += 1; + } + ntests += 1; + i += 1; + } + + printf ("testvect: %d errors in %d tests\n", nerrors, ntests); + exit (0); +} diff --git a/components/external/espruino/libs/math/exp.c b/components/external/espruino/libs/math/exp.c new file mode 100644 index 0000000000..aaababd468 --- /dev/null +++ b/components/external/espruino/libs/math/exp.c @@ -0,0 +1,203 @@ +/* exp.c + * + * Exponential function + * + * + * + * SYNOPSIS: + * + * double x, y, exp(); + * + * y = exp( x ); + * + * + * + * DESCRIPTION: + * + * Returns e (2.71828...) raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * + * x k f + * e = 2 e. + * + * A Pade' form 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) + * of degree 2/3 is used to approximate exp(f) in the basic + * interval [-0.5, 0.5]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC +- 88 50000 2.8e-17 7.0e-18 + * IEEE +- 708 40000 2.0e-16 5.6e-17 + * + * + * Error amplification in the exponential function can be + * a serious matter. The error propagation involves + * exp( X(1+delta) ) = exp(X) ( 1 + X*delta + ... ), + * which shows that a 1 lsb error in representing X produces + * a relative error of X times 1 lsb in the function. + * While the routine gives an accurate result for arguments + * that are exactly represented by a double precision + * computer number, the result contains amplified roundoff + * error for large arguments not exactly represented. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * exp underflow x < MINLOG 0.0 + * exp overflow x > MAXLOG INFINITY + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +/* Exponential function */ + +#include "mconf.h" + +#ifdef UNK + +const static double P[] = { + 1.26177193074810590878E-4, + 3.02994407707441961300E-2, + 9.99999999999999999910E-1, +}; +const static double Q[] = { + 3.00198505138664455042E-6, + 2.52448340349684104192E-3, + 2.27265548208155028766E-1, + 2.00000000000000000009E0, +}; +const static double C1 = 6.93145751953125E-1; +const static double C2 = 1.42860682030941723212E-6; +#endif + +#ifdef DEC +static unsigned short P[] = { +0035004,0047156,0127442,0057502, +0036770,0033210,0063121,0061764, +0040200,0000000,0000000,0000000, +}; +static unsigned short Q[] = { +0033511,0072665,0160662,0176377, +0036045,0070715,0124105,0132777, +0037550,0134114,0142077,0001637, +0040400,0000000,0000000,0000000, +}; +static unsigned short sc1[] = {0040061,0071000,0000000,0000000}; +#define C1 (*(double *)sc1) +static unsigned short sc2[] = {0033277,0137216,0075715,0057117}; +#define C2 (*(double *)sc2) +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x4be8,0xd5e4,0x89cd,0x3f20, +0x2c7e,0x0cca,0x06d1,0x3f9f, +0x0000,0x0000,0x0000,0x3ff0, +}; +static unsigned short Q[] = { +0x5fa0,0xbc36,0x2eb6,0x3ec9, +0xb6c0,0xb508,0xae39,0x3f64, +0xe074,0x9887,0x1709,0x3fcd, +0x0000,0x0000,0x0000,0x4000, +}; +static unsigned short sc1[] = {0x0000,0x0000,0x2e40,0x3fe6}; +#define C1 (*(double *)sc1) +static unsigned short sc2[] = {0xabca,0xcf79,0xf7d1,0x3eb7}; +#define C2 (*(double *)sc2) +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3f20,0x89cd,0xd5e4,0x4be8, +0x3f9f,0x06d1,0x0cca,0x2c7e, +0x3ff0,0x0000,0x0000,0x0000, +}; +static unsigned short Q[] = { +0x3ec9,0x2eb6,0xbc36,0x5fa0, +0x3f64,0xae39,0xb508,0xb6c0, +0x3fcd,0x1709,0x9887,0xe074, +0x4000,0x0000,0x0000,0x0000, +}; +static unsigned short sc1[] = {0x3fe6,0x2e40,0x0000,0x0000}; +#define C1 (*(double *)sc1) +static unsigned short sc2[] = {0x3eb7,0xf7d1,0xcf79,0xabca}; +#define C2 (*(double *)sc2) +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double floor ( double ); +extern double ldexp ( double, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double polevl(), p1evl(), floor(), ldexp(); +int isnan(), isfinite(); +#endif +extern double LOGE2, LOG2E, MAXLOG, MINLOG, MAXNUM; +#ifdef INFINITIES +extern double INFINITY; +#endif + +double exp(x) +double x; +{ +double px, xx; +int n; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +if( x > MAXLOG) + { +#ifdef INFINITIES + return( INFINITY ); +#else + mtherr( "exp", OVERFLOW ); + return( MAXNUM ); +#endif + } + +if( x < MINLOG ) + { +#ifndef INFINITIES + mtherr( "exp", UNDERFLOW ); +#endif + return(0.0); + } + +/* Express e**x = e**g 2**n + * = e**g e**( n loge(2) ) + * = e**( g + n loge(2) ) + */ +px = floor( LOG2E * x + 0.5 ); /* floor() truncates toward -infinity. */ +n = px; +x -= px * C1; +x -= px * C2; + +/* rational approximation for exponential + * of the fractional part: + * e**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) + */ +xx = x * x; +px = x * polevl( xx, P, 2 ); +x = px/( polevl( xx, Q, 3 ) - px ); +x = 1.0 + 2.0 * x; + +/* multiply by power of 2 */ +x = ldexp( x, n ); +return(x); +} diff --git a/components/external/espruino/libs/math/exp10.c b/components/external/espruino/libs/math/exp10.c new file mode 100644 index 0000000000..955608a3ba --- /dev/null +++ b/components/external/espruino/libs/math/exp10.c @@ -0,0 +1,223 @@ +/* exp10.c + * + * Base 10 exponential function + * (Common antilogarithm) + * + * + * + * SYNOPSIS: + * + * double x, y, exp10(); + * + * y = exp10( x ); + * + * + * + * DESCRIPTION: + * + * Returns 10 raised to the x power. + * + * Range reduction is accomplished by expressing the argument + * as 10**x = 2**n 10**f, with |f| < 0.5 log10(2). + * The Pade' form + * + * 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) + * + * is used to approximate 10**f. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -307,+307 30000 2.2e-16 5.5e-17 + * Test result from an earlier version (2.1): + * DEC -38,+38 70000 3.1e-17 7.0e-18 + * + * ERROR MESSAGES: + * + * message condition value returned + * exp10 underflow x < -MAXL10 0.0 + * exp10 overflow x > MAXL10 MAXNUM + * + * DEC arithmetic: MAXL10 = 38.230809449325611792. + * IEEE arithmetic: MAXL10 = 308.2547155599167. + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1991, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { + 4.09962519798587023075E-2, + 1.17452732554344059015E1, + 4.06717289936872725516E2, + 2.39423741207388267439E3, +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 8.50936160849306532625E1, + 1.27209271178345121210E3, + 2.07960819286001865907E3, +}; +/* const static double LOG102 = 3.01029995663981195214e-1; */ +const static double LOG210 = 3.32192809488736234787e0; +const static double LG102A = 3.01025390625000000000E-1; +const static double LG102B = 4.60503898119521373889E-6; +/* const static double MAXL10 = 38.230809449325611792; */ +const static double MAXL10 = 308.2547155599167; +#endif + +#ifdef DEC +static unsigned short P[] = { +0037047,0165657,0114061,0067234, +0041073,0166243,0123052,0144643, +0042313,0055720,0024032,0047443, +0043025,0121714,0070232,0050007, +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0041652,0027756,0071216,0050075, +0042637,0001367,0077263,0136017, +0043001,0174673,0024157,0133416, +}; +/* +static unsigned short L102[] = {0037632,0020232,0102373,0147770}; +#define LOG102 *(double *)L102 +*/ +static unsigned short L210[] = {0040524,0115170,0045715,0015613}; +#define LOG210 *(double *)L210 +static unsigned short L102A[] = {0037632,0020000,0000000,0000000,}; +#define LG102A *(double *)L102A +static unsigned short L102B[] = {0033632,0102373,0147767,0114220,}; +#define LG102B *(double *)L102B +static unsigned short MXL[] = {0041430,0166131,0047761,0154130,}; +#define MAXL10 ( *(double *)MXL ) +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x2dd4,0xf306,0xfd75,0x3fa4, +0x5934,0x74c5,0x7d94,0x4027, +0x49e4,0x0503,0x6b7a,0x4079, +0x4a01,0x8e13,0xb479,0x40a2, +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0xca08,0xce51,0x45fd,0x4055, +0x7782,0xefd6,0xe05e,0x4093, +0xf6e2,0x650d,0x3f37,0x40a0, +}; +/* +static unsigned short L102[] = {0x79ff,0x509f,0x4413,0x3fd3}; +#define LOG102 *(double *)L102 +*/ +static unsigned short L210[] = {0xa371,0x0979,0x934f,0x400a}; +#define LOG210 *(double *)L210 +static unsigned short L102A[] = {0x0000,0x0000,0x4400,0x3fd3,}; +#define LG102A *(double *)L102A +static unsigned short L102B[] = {0xf312,0x79fe,0x509f,0x3ed3,}; +#define LG102B *(double *)L102B +const static double MAXL10 = 308.2547155599167; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3fa4,0xfd75,0xf306,0x2dd4, +0x4027,0x7d94,0x74c5,0x5934, +0x4079,0x6b7a,0x0503,0x49e4, +0x40a2,0xb479,0x8e13,0x4a01, +}; +static unsigned short Q[] = { +/*0x3ff0,0x0000,0x0000,0x0000,*/ +0x4055,0x45fd,0xce51,0xca08, +0x4093,0xe05e,0xefd6,0x7782, +0x40a0,0x3f37,0x650d,0xf6e2, +}; +/* +static unsigned short L102[] = {0x3fd3,0x4413,0x509f,0x79ff}; +#define LOG102 *(double *)L102 +*/ +static unsigned short L210[] = {0x400a,0x934f,0x0979,0xa371}; +#define LOG210 *(double *)L210 +static unsigned short L102A[] = {0x3fd3,0x4400,0x0000,0x0000,}; +#define LG102A *(double *)L102A +static unsigned short L102B[] = {0x3ed3,0x509f,0x79fe,0xf312,}; +#define LG102B *(double *)L102B +const static double MAXL10 = 308.2547155599167; +#endif + +#ifdef ANSIPROT +extern double floor ( double ); +extern double ldexp ( double, int ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double floor(), ldexp(), polevl(), p1evl(); +int isnan(), isfinite(); +#endif +extern double MAXNUM; +#ifdef INFINITIES +extern double INFINITY; +#endif + +double exp10(x) +double x; +{ +double px, xx; +short n; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +if( x > MAXL10 ) + { +#ifdef INFINITIES + return( INFINITY ); +#else + mtherr( "exp10", OVERFLOW ); + return( MAXNUM ); +#endif + } + +if( x < -MAXL10 ) /* Would like to use MINLOG but can't */ + { +#ifndef INFINITIES + mtherr( "exp10", UNDERFLOW ); +#endif + return(0.0); + } + +/* Express 10**x = 10**g 2**n + * = 10**g 10**( n log10(2) ) + * = 10**( g + n log10(2) ) + */ +px = floor( LOG210 * x + 0.5 ); +n = px; +x -= px * LG102A; +x -= px * LG102B; + +/* rational approximation for exponential + * of the fractional part: + * 10**x = 1 + 2x P(x**2)/( Q(x**2) - P(x**2) ) + */ +xx = x * x; +px = x * polevl( xx, P, 3 ); +x = px/( p1evl( xx, Q, 3 ) - px ); +x = 1.0 + ldexp( x, 1 ); + +/* multiply by power of 2 */ +x = ldexp( x, n ); + +return(x); +} diff --git a/components/external/espruino/libs/math/exp2.c b/components/external/espruino/libs/math/exp2.c new file mode 100644 index 0000000000..ad619cf82c --- /dev/null +++ b/components/external/espruino/libs/math/exp2.c @@ -0,0 +1,183 @@ +/* exp2.c + * + * Base 2 exponential function + * + * + * + * SYNOPSIS: + * + * double x, y, exp2(); + * + * y = exp2( x ); + * + * + * + * DESCRIPTION: + * + * Returns 2 raised to the x power. + * + * Range reduction is accomplished by separating the argument + * into an integer k and fraction f such that + * x k f + * 2 = 2 2. + * + * A Pade' form + * + * 1 + 2x P(x**2) / (Q(x**2) - x P(x**2) ) + * + * approximates 2**x in the basic range [-0.5, 0.5]. + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1022,+1024 30000 1.8e-16 5.4e-17 + * + * + * See exp.c for comments on error amplification. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * exp underflow x < -MAXL2 0.0 + * exp overflow x > MAXL2 MAXNUM + * + * For DEC arithmetic, MAXL2 = 127. + * For IEEE arithmetic, MAXL2 = 1024. + */ + + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { + 2.30933477057345225087E-2, + 2.02020656693165307700E1, + 1.51390680115615096133E3, +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 2.33184211722314911771E2, + 4.36821166879210612817E3, +}; +#define MAXL2 1024.0 +#define MINL2 -1024.0 +#endif + +#ifdef DEC +static unsigned short P[] = { +0036675,0027102,0122327,0053227, +0041241,0116724,0115412,0157355, +0042675,0036404,0101733,0132226, +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0042151,0027450,0077732,0160744, +0043210,0100661,0077550,0056560, +}; +#define MAXL2 127.0 +#define MINL2 -127.0 +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0xead3,0x549a,0xa5c8,0x3f97, +0x5bde,0x9361,0x33ba,0x4034, +0x7693,0x907b,0xa7a0,0x4097, +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x5c3c,0x0ffb,0x25e5,0x406d, +0x0bae,0x2fed,0x1036,0x40b1, +}; +#define MAXL2 1024.0 +#define MINL2 -1022.0 +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3f97,0xa5c8,0x549a,0xead3, +0x4034,0x33ba,0x9361,0x5bde, +0x4097,0xa7a0,0x907b,0x7693, +}; +static unsigned short Q[] = { +/*0x3ff0,0x0000,0x0000,0x0000,*/ +0x406d,0x25e5,0x0ffb,0x5c3c, +0x40b1,0x1036,0x2fed,0x0bae, +}; +#define MAXL2 1024.0 +#define MINL2 -1022.0 +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double floor ( double ); +extern double ldexp ( double, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double polevl(), p1evl(), floor(), ldexp(); +int isnan(), isfinite(); +#endif +#ifdef INFINITIES +extern double INFINITY; +#endif +extern double MAXNUM; + +double exp2(x) +double x; +{ +double px, xx; +short n; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +if( x > MAXL2) + { +#ifdef INFINITIES + return( INFINITY ); +#else + mtherr( "exp2", OVERFLOW ); + return( MAXNUM ); +#endif + } + +if( x < MINL2 ) + { +#ifndef INFINITIES + mtherr( "exp2", UNDERFLOW ); +#endif + return(0.0); + } + +xx = x; /* save x */ +/* separate into integer and fractional parts */ +px = floor(x+0.5); +n = px; +x = x - px; + +/* rational approximation + * exp2(x) = 1 + 2xP(xx)/(Q(xx) - P(xx)) + * where xx = x**2 + */ +xx = x * x; +px = x * polevl( xx, P, 2 ); +x = px / ( p1evl( xx, Q, 2 ) - px ); +x = 1.0 + ldexp( x, 1 ); + +/* scale by power of 2 */ +x = ldexp( x, n ); +return(x); +} diff --git a/components/external/espruino/libs/math/fabs.c b/components/external/espruino/libs/math/fabs.c new file mode 100644 index 0000000000..f674c6142d --- /dev/null +++ b/components/external/espruino/libs/math/fabs.c @@ -0,0 +1,56 @@ +/* fabs.c + * + * Absolute value + * + * + * + * SYNOPSIS: + * + * double x, y; + * + * y = fabs( x ); + * + * + * + * DESCRIPTION: + * + * Returns the absolute value of the argument. + * + */ + + +#include "mconf.h" +/* Avoid using UNK if possible. */ +#ifdef UNK +#if BIGENDIAN +#define MIEEE 1 +#else +#define IBMPC 1 +#endif +#endif + +double fabs(x) +double x; +{ +union + { + double d; + short i[4]; + } u; + +u.d = x; +#ifdef IBMPC + u.i[3] &= 0x7fff; +#endif +#ifdef MIEEE + u.i[0] &= 0x7fff; +#endif +#ifdef DEC + u.i[3] &= 0x7fff; +#endif +#ifdef UNK +if( u.d < 0 ) + u.d = -u.d; +#endif +return( u.d ); +} diff --git a/components/external/espruino/libs/math/floor.c b/components/external/espruino/libs/math/floor.c new file mode 100644 index 0000000000..1df98b1e79 --- /dev/null +++ b/components/external/espruino/libs/math/floor.c @@ -0,0 +1,453 @@ +/* ceil() + * floor() + * frexp() + * ldexp() + * signbit() + * isnan() + * isfinite() + * + * Floating point numeric utilities + * + * + * + * SYNOPSIS: + * + * double ceil(), floor(), frexp(), ldexp(); + * int signbit(), isnan(), isfinite(); + * double x, y; + * int expnt, n; + * + * y = floor(x); + * y = ceil(x); + * y = frexp( x, &expnt ); + * y = ldexp( x, n ); + * n = signbit(x); + * n = isnan(x); + * n = isfinite(x); + * + * + * + * DESCRIPTION: + * + * All four routines return a double precision floating point + * result. + * + * floor() returns the largest integer less than or equal to x. + * It truncates toward minus infinity. + * + * ceil() returns the smallest integer greater than or equal + * to x. It truncates toward plus infinity. + * + * frexp() extracts the exponent from x. It returns an integer + * power of two to expnt and the significand between 0.5 and 1 + * to y. Thus x = y * 2**expn. + * + * ldexp() multiplies x by 2**n. + * + * signbit(x) returns 1 if the sign bit of x is 1, else 0. + * + * These functions are part of the standard C run time library + * for many but not all C compilers. The ones supplied are + * written in C for either DEC or IEEE arithmetic. They should + * be used only if your compiler library does not already have + * them. + * + * The IEEE versions assume that denormal numbers are implemented + * in the arithmetic. Some modifications will be required if + * the arithmetic has abrupt rather than gradual underflow. + */ + + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +#ifdef UNK +/* ceil(), floor(), frexp(), ldexp() may need to be rewritten. */ +#undef UNK +#if BIGENDIAN +#define MIEEE 1 +#else +#define IBMPC 1 +#endif +#endif + +#ifdef DEC +#define EXPMSK 0x807f +#define MEXP 255 +#define NBITS 56 +#endif + +#ifdef IBMPC +#define EXPMSK 0x800f +#define MEXP 0x7ff +#define NBITS 53 +#endif + +#ifdef MIEEE +#define EXPMSK 0x800f +#define MEXP 0x7ff +#define NBITS 53 +#endif + +extern double MAXNUM, NEGZERO; +#ifdef ANSIPROT +double floor ( double ); +int isnan ( double ); +int isfinite ( double ); +double ldexp ( double, int ); +#else +double floor(); +int isnan(), isfinite(); +double ldexp(); +#endif + +double ceil(x) +double x; +{ +double y; + +#ifdef UNK +mtherr( "ceil", DOMAIN ); +return(0.0); +#endif +#ifdef NANS +if( isnan(x) ) + return( x ); +#endif +#ifdef INFINITIES +if(!isfinite(x)) + return(x); +#endif + +y = floor(x); +if( y < x ) + y += 1.0; +#ifdef MINUSZERO +if( y == 0.0 && x < 0.0 ) + return( NEGZERO ); +#endif +return(y); +} + + + + +/* Bit clearing masks: */ + +static unsigned short bmask[] = { +0xffff, +0xfffe, +0xfffc, +0xfff8, +0xfff0, +0xffe0, +0xffc0, +0xff80, +0xff00, +0xfe00, +0xfc00, +0xf800, +0xf000, +0xe000, +0xc000, +0x8000, +0x0000, +}; + + + + + +double floor(x) +double x; +{ +union + { + double y; + unsigned short sh[4]; + } u; +unsigned short *p; +int e; + +#ifdef UNK +mtherr( "floor", DOMAIN ); +return(0.0); +#endif +#ifdef NANS +if( isnan(x) ) + return( x ); +#endif +#ifdef INFINITIES +if(!isfinite(x)) + return(x); +#endif +#ifdef MINUSZERO +if(x == 0.0L) + return(x); +#endif +u.y = x; +/* find the exponent (power of 2) */ +#ifdef DEC +p = (unsigned short *)&u.sh[0]; +e = (( *p >> 7) & 0377) - 0201; +p += 3; +#endif + +#ifdef IBMPC +p = (unsigned short *)&u.sh[3]; +e = (( *p >> 4) & 0x7ff) - 0x3ff; +p -= 3; +#endif + +#ifdef MIEEE +p = (unsigned short *)&u.sh[0]; +e = (( *p >> 4) & 0x7ff) - 0x3ff; +p += 3; +#endif + +if( e < 0 ) + { + if( u.y < 0.0 ) + return( -1.0 ); + else + return( 0.0 ); + } + +e = (NBITS -1) - e; +/* clean out 16 bits at a time */ +while( e >= 16 ) + { +#ifdef IBMPC + *p++ = 0; +#endif + +#ifdef DEC + *p-- = 0; +#endif + +#ifdef MIEEE + *p-- = 0; +#endif + e -= 16; + } + +/* clear the remaining bits */ +if( e > 0 ) + *p &= bmask[e]; + +if( (x < 0) && (u.y != x) ) + u.y -= 1.0; + +return(u.y); +} + + + + +double frexp( x, pw2 ) +double x; +int *pw2; +{ +union + { + double y; + unsigned short sh[4]; + } u; +int i; +#ifdef DENORMAL +int k; +#endif +short *q; + +u.y = x; + +#ifdef UNK +mtherr( "frexp", DOMAIN ); +return(0.0); +#endif + +#ifdef IBMPC +q = (short *)&u.sh[3]; +#endif + +#ifdef DEC +q = (short *)&u.sh[0]; +#endif + +#ifdef MIEEE +q = (short *)&u.sh[0]; +#endif + +/* find the exponent (power of 2) */ +#ifdef DEC +i = ( *q >> 7) & 0377; +if( i == 0 ) + { + *pw2 = 0; + return(0.0); + } +i -= 0200; +*pw2 = i; +*q &= 0x807f; /* strip all exponent bits */ +*q |= 040000; /* mantissa between 0.5 and 1 */ +return(u.y); +#endif + +#ifdef IBMPC +i = ( *q >> 4) & 0x7ff; +if( i != 0 ) + goto ieeedon; +#endif + +#ifdef MIEEE +i = *q >> 4; +i &= 0x7ff; +if( i != 0 ) + goto ieeedon; +#ifdef DENORMAL + +#else +*pw2 = 0; +return(0.0); +#endif + +#endif + + +#ifndef DEC +/* Number is denormal or zero */ +#ifdef DENORMAL +if( u.y == 0.0 ) + { + *pw2 = 0; + return( 0.0 ); + } + + +/* Handle denormal number. */ +do + { + u.y *= 2.0; + i -= 1; + k = ( *q >> 4) & 0x7ff; + } +while( k == 0 ); +i = i + k; +#endif /* DENORMAL */ + +ieeedon: + +i -= 0x3fe; +*pw2 = i; +*q &= 0x800f; +*q |= 0x3fe0; +return( u.y ); +#endif +} + + + + + + + +double ldexp( x, pw2 ) +double x; +int pw2; +{ +union + { + double y; + unsigned short sh[4]; + } u; +short *q; +int e; + +#ifdef UNK +mtherr( "ldexp", DOMAIN ); +return(0.0); +#endif + +u.y = x; +#ifdef DEC +q = (short *)&u.sh[0]; +e = ( *q >> 7) & 0377; +if( e == 0 ) + return(0.0); +#else + +#ifdef IBMPC +q = (short *)&u.sh[3]; +#endif +#ifdef MIEEE +q = (short *)&u.sh[0]; +#endif +while( (e = (*q & 0x7ff0) >> 4) == 0 ) + { + if( u.y == 0.0 ) + { + return( 0.0 ); + } +/* Input is denormal. */ + if( pw2 > 0 ) + { + u.y *= 2.0; + pw2 -= 1; + } + if( pw2 < 0 ) + { + if( pw2 < -53 ) + return(0.0); + u.y /= 2.0; + pw2 += 1; + } + if( pw2 == 0 ) + return(u.y); + } +#endif /* not DEC */ + +e += pw2; + +/* Handle overflow */ +#ifdef DEC +if( e > MEXP ) + return( MAXNUM ); +#else +if( e >= MEXP ) + return( 2.0*MAXNUM ); +#endif + +/* Handle denormalized results */ +if( e < 1 ) + { +#ifdef DENORMAL + if( e < -53 ) + return(0.0); + *q &= 0x800f; + *q |= 0x10; + /* For denormals, significant bits may be lost even + when dividing by 2. Construct 2^-(1-e) so the result + is obtained with only one multiplication. */ + u.y *= ldexp(1.0, e-1); + return(u.y); +#else + return(0.0); +#endif + } +else + { +#ifdef DEC + *q &= 0x807f; /* strip all exponent bits */ + *q |= (e & 0xff) << 7; +#else + *q &= 0x800f; + *q |= (e & 0x7ff) << 4; +#endif + return(u.y); + } +} diff --git a/components/external/espruino/libs/math/ftilib.mak b/components/external/espruino/libs/math/ftilib.mak new file mode 100644 index 0000000000..80cc596572 --- /dev/null +++ b/components/external/espruino/libs/math/ftilib.mak @@ -0,0 +1,289 @@ +# MSDOS Microsoft C makefile for Cephes library +CFLAGS=/c +# For large memory model: +#CFLAGS=/c /AL +# Add /FPa to the CFLAGS if you want to use the fast software FPa arithmetic. +# +# Use the following with /FPa if you do not want to use the 80x87 coprocessor +# or software emulator. +#polevl.obj: polevl.c mconf.h +# cl /c /Ox polevl.c +# +# Use the following instead if you want to use an 80x87 chip or +# software emulator for maximum accuracy computation of the +# polynomial expansions: +polevl.obj: polevl.asm mconf.h + masm polevl.asm/r; + +floor.obj: floor.asm + masm floor.asm; + +#floor.obj: floor.c mconf.h +# cl $(CFLAGS) floor.c + +acosh.obj: acosh.c mconf.h + cl $(CFLAGS) acosh.c + +airy.obj: airy.c mconf.h + cl $(CFLAGS) airy.c + +asin.obj: asin.c mconf.h + cl $(CFLAGS) asin.c + +asinh.obj: asinh.c mconf.h + cl $(CFLAGS) asinh.c + +atan.obj: atan.c mconf.h + cl $(CFLAGS) atan.c + +atanh.obj: atanh.c mconf.h + cl $(CFLAGS) atanh.c + +asinh.obj: asinh.c mconf.h + cl $(CFLAGS) asinh.c + +bdtr.obj: bdtr.c mconf.h + cl $(CFLAGS) bdtr.c + +beta.obj: beta.c mconf.h + cl $(CFLAGS) beta.c + +btdtr.obj: btdtr.c mconf.h + cl $(CFLAGS) btdtr.c + +cbrt.obj: cbrt.c mconf.h + cl $(CFLAGS) cbrt.c + +chbevl.obj: chbevl.c mconf.h + cl $(CFLAGS) chbevl.c + +chdtr.obj: chdtr.c mconf.h + cl $(CFLAGS) chdtr.c + +clog.obj: clog.c mconf.h + cl $(CFLAGS) clog.c + +cmplx.obj: cmplx.c mconf.h + cl $(CFLAGS) cmplx.c + +const.obj: const.c mconf.h + cl $(CFLAGS) const.c + +cosh.obj: cosh.c mconf.h + cl $(CFLAGS) cosh.c + +dawsn.obj: dawsn.c mconf.h + cl $(CFLAGS) dawsn.c + +drand.obj: drand.c mconf.h + cl $(CFLAGS) drand.c + +ellie.obj: ellie.c mconf.h + cl $(CFLAGS) ellie.c + +ellik.obj: ellik.c mconf.h + cl $(CFLAGS) ellik.c + +ellpe.obj: ellpe.c mconf.h + cl $(CFLAGS) ellpe.c + +ellpj.obj: ellpj.c mconf.h + cl $(CFLAGS) ellpj.c + +ellpk.obj: ellpk.c mconf.h + cl $(CFLAGS) ellpk.c + +exp.obj: exp.c mconf.h + cl $(CFLAGS) exp.c + +exp10.obj: exp10.c mconf.h + cl $(CFLAGS) exp10.c + +exp2.obj: exp2.c mconf.h + cl $(CFLAGS) exp2.c + +expn.obj: expn.c mconf.h + cl $(CFLAGS) expn.c + +fabs.obj: fabs.c mconf.h + cl $(CFLAGS) fabs.c + +fac.obj: fac.c mconf.h + cl $(CFLAGS) fac.c + +fdtr.obj: fdtr.c mconf.h + cl $(CFLAGS) fdtr.c + +fresnl.obj: fresnl.c mconf.h + cl $(CFLAGS) fresnl.c + +gamma.obj: gamma.c mconf.h + cl $(CFLAGS) gamma.c + +gdtr.obj: gdtr.c mconf.h + cl $(CFLAGS) gdtr.c + +hyp2f1.obj: hyp2f1.c mconf.h + cl $(CFLAGS) hyp2f1.c + +hyperg.obj: hyperg.c mconf.h + cl $(CFLAGS) hyperg.c + +i0.obj: i0.c mconf.h + cl $(CFLAGS) i0.c + +i1.obj: i1.c mconf.h + cl $(CFLAGS) i1.c + +igam.obj: igam.c mconf.h + cl $(CFLAGS) igam.c + +igami.obj: igami.c mconf.h + cl $(CFLAGS) igami.c + +incbet.obj: incbet.c mconf.h + cl $(CFLAGS) incbet.c + +incbi.obj: incbi.c mconf.h + cl $(CFLAGS) incbi.c + +isnan.obj: isnan.c mconf.h + cl $(CFLAGS) isnan.c + +iv.obj: iv.c mconf.h + cl $(CFLAGS) iv.c + +j0.obj: j0.c mconf.h + cl $(CFLAGS) j0.c + +j1.obj: j1.c mconf.h + cl $(CFLAGS) j1.c + +jn.obj: jn.c mconf.h + cl $(CFLAGS) jn.c + +jv.obj: jv.c mconf.h + cl $(CFLAGS) jv.c + +k0.obj: k0.c mconf.h + cl $(CFLAGS) k0.c + +k1.obj: k1.c mconf.h + cl $(CFLAGS) k1.c + +kn.obj: kn.c mconf.h + cl $(CFLAGS) kn.c + +log.obj: log.c mconf.h + cl $(CFLAGS) log.c + +log2.obj: log2.c mconf.h + cl $(CFLAGS) log2.c + +log10.obj: log10.c mconf.h + cl $(CFLAGS) log10.c + +mtherr.obj: mtherr.c mconf.h + cl $(CFLAGS) mtherr.c + +nbdtr.obj: nbdtr.c mconf.h + cl $(CFLAGS) nbdtr.c + +ndtr.obj: ndtr.c mconf.h + cl $(CFLAGS) ndtr.c + +ndtri.obj: ndtri.c mconf.h + cl $(CFLAGS) ndtri.c + +pdtr.obj: pdtr.c mconf.h + cl $(CFLAGS) pdtr.c + +pow.obj: pow.c mconf.h + cl $(CFLAGS) pow.c + +powi.obj: powi.c mconf.h + cl $(CFLAGS) powi.c + +psi.obj: psi.c mconf.h + cl $(CFLAGS) psi.c + +rgamma.obj: rgamma.c mconf.h + cl $(CFLAGS) rgamma.c + +round.obj: round.c mconf.h + cl $(CFLAGS) round.c + +setprec.obj: setprec.87 + masm setprec.87; + +shichi.obj: shichi.c mconf.h + cl $(CFLAGS) shichi.c + +sici.obj: sici.c mconf.h + cl $(CFLAGS) sici.c + +sin.obj: sin.c mconf.h + cl $(CFLAGS) sin.c + +sindg.obj: sindg.c mconf.h + cl $(CFLAGS) sindg.c + +sinh.obj: sinh.c mconf.h + cl $(CFLAGS) sinh.c + +spence.obj: spence.c mconf.h + cl $(CFLAGS) spence.c + +sqrt.obj: sqrt.87 + masm sqrt.87; + +#sqrt.obj: sqrt.c +# cl $(CFLAGS) sqrt.c + +stdtr.obj: stdtr.c mconf.h + cl $(CFLAGS) stdtr.c + +struve.obj: struve.c mconf.h + cl $(CFLAGS) struve.c + +tan.obj: tan.c mconf.h + cl $(CFLAGS) tan.c + +tandg.obj: tandg.c mconf.h + cl $(CFLAGS) tandg.c + +tanh.obj: tanh.c mconf.h + cl $(CFLAGS) tanh.c + +yn.obj: yn.c mconf.h + cl $(CFLAGS) yn.c + +zeta.obj: zeta.c mconf.h + cl $(CFLAGS) zeta.c + +zetac.obj: zetac.c mconf.h + cl $(CFLAGS) zetac.c + +polyn.obj: polyn.c mconf.h + cl $(CFLAGS) polyn.c + +polmisc.obj: polmisc.c mconf.h + cl $(CFLAGS) polmisc.c + +unity.obj: unity.c mconf.h + cl $(CFLAGS) unity.c + +fti.lib: acosh.obj airy.obj asin.obj asinh.obj atan.obj atanh.obj bdtr.obj \ +beta.obj btdtr.obj cbrt.obj chbevl.obj chdtr.obj clog.obj \ +cmplx.obj const.obj cosh.obj dawsn.obj drand.obj ellie.obj ellik.obj \ +ellpe.obj ellpj.obj ellpk.obj exp.obj exp10.obj \ +exp2.obj expn.obj fabs.obj fac.obj fdtr.obj floor.obj fresnl.obj gamma.obj \ +gdtr.obj hyp2f1.obj hyperg.obj i0.c i1.c igam.c igami.obj incbet.obj \ +incbi.obj isnan.obj iv.obj j0.obj j1.obj jn.obj jv.obj k0.obj k1.obj \ +kn.obj log.obj log2.obj log10.obj mtherr.obj nbdtr.obj ndtr.obj ndtri.obj \ +pdtr.obj polevl.obj polmisc.obj polyn.obj pow.obj powi.obj psi.obj \ +rgamma.obj round.obj shichi.obj sici.obj sin.obj sindg.obj sinh.obj \ +spence.obj sqrt.obj stdtr.obj setprec.obj struve.obj tan.obj \ +tandg.obj tanh.obj unity.obj yn.obj zeta.obj zetac.obj \ +mconf.h + lib @ftilib.rsp diff --git a/components/external/espruino/libs/math/ftilib.rsp b/components/external/espruino/libs/math/ftilib.rsp new file mode 100644 index 0000000000..aa475164a3 --- /dev/null +++ b/components/external/espruino/libs/math/ftilib.rsp @@ -0,0 +1,17 @@ +fti +y +acosh airy asin asinh atan & +atanh bdtr beta btdtr cbrt chbevl & +chdtr clog cmplx const & +cosh dawsn drand ellie ellik ellpe ellpk & +ellpj exp exp2 exp10 expn fac & +fdtr fresnl gamma gdtr & +hyperg hyp2f1 incbet incbi igam igami isnan & +iv i0 i1 jn jv j0 j1 k0 k1 kn log log2 log10 & +mtherr nbdtr ndtr ndtri pdtr & +polmisc polyn pow powi psi & +rgamma round shichi sici sin sindg & +sinh spence sqrt stdtr struve tan tandg & +tanh unity yn zeta zetac floor fabs polevl +fti.lst +fti diff --git a/components/external/espruino/libs/math/isnan.c b/components/external/espruino/libs/math/isnan.c new file mode 100644 index 0000000000..b5341e6505 --- /dev/null +++ b/components/external/espruino/libs/math/isnan.c @@ -0,0 +1,237 @@ +/* isnan() + * signbit() + * isfinite() + * + * Floating point numeric utilities + * + * + * + * SYNOPSIS: + * + * double ceil(), floor(), frexp(), ldexp(); + * int signbit(), isnan(), isfinite(); + * double x, y; + * int expnt, n; + * + * y = floor(x); + * y = ceil(x); + * y = frexp( x, &expnt ); + * y = ldexp( x, n ); + * n = signbit(x); + * n = isnan(x); + * n = isfinite(x); + * + * + * + * DESCRIPTION: + * + * All four routines return a double precision floating point + * result. + * + * floor() returns the largest integer less than or equal to x. + * It truncates toward minus infinity. + * + * ceil() returns the smallest integer greater than or equal + * to x. It truncates toward plus infinity. + * + * frexp() extracts the exponent from x. It returns an integer + * power of two to expnt and the significand between 0.5 and 1 + * to y. Thus x = y * 2**expn. + * + * ldexp() multiplies x by 2**n. + * + * signbit(x) returns 1 if the sign bit of x is 1, else 0. + * + * These functions are part of the standard C run time library + * for many but not all C compilers. The ones supplied are + * written in C for either DEC or IEEE arithmetic. They should + * be used only if your compiler library does not already have + * them. + * + * The IEEE versions assume that denormal numbers are implemented + * in the arithmetic. Some modifications will be required if + * the arithmetic has abrupt rather than gradual underflow. + */ + + +/* +Cephes Math Library Release 2.3: March, 1995 +Copyright 1984, 1995 by Stephen L. Moshier +*/ + + +#include "mconf.h" + +#ifdef UNK +/* ceil(), floor(), frexp(), ldexp() may need to be rewritten. */ +#undef UNK +#if BIGENDIAN +#define MIEEE 1 +#else +#define IBMPC 1 +#endif +#endif + + +/* Return 1 if the sign bit of x is 1, else 0. */ + +int signbit(x) +double x; +{ +union + { + double d; + short s[4]; + int i[2]; + } u; + +u.d = x; + +if( sizeof(int) == 4 ) + { +#ifdef IBMPC + return( u.i[1] < 0 ); +#endif +#ifdef DEC + return( u.s[3] < 0 ); +#endif +#ifdef MIEEE + return( u.i[0] < 0 ); +#endif + } +else + { +#ifdef IBMPC + return( u.s[3] < 0 ); +#endif +#ifdef DEC + return( u.s[3] < 0 ); +#endif +#ifdef MIEEE + return( u.s[0] < 0 ); +#endif + } +} + + +/* Return 1 if x is a number that is Not a Number, else return 0. */ + +int isnan(x) +double x; +{ +#ifdef NANS +union + { + double d; + unsigned short s[4]; + unsigned int i[2]; + } u; + +u.d = x; + +if( sizeof(int) == 4 ) + { +#ifdef IBMPC + if( ((u.i[1] & 0x7ff00000) == 0x7ff00000) + && (((u.i[1] & 0x000fffff) != 0) || (u.i[0] != 0))) + return 1; +#endif +#ifdef DEC + if( (u.s[1] & 0x7fff) == 0) + { + if( (u.s[2] | u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef MIEEE + if( ((u.i[0] & 0x7ff00000) == 0x7ff00000) + && (((u.i[0] & 0x000fffff) != 0) || (u.i[1] != 0))) + return 1; +#endif + return(0); + } +else + { /* size int not 4 */ +#ifdef IBMPC + if( (u.s[3] & 0x7ff0) == 0x7ff0) + { + if( ((u.s[3] & 0x000f) | u.s[2] | u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef DEC + if( (u.s[3] & 0x7fff) == 0) + { + if( (u.s[2] | u.s[1] | u.s[0]) != 0 ) + return(1); + } +#endif +#ifdef MIEEE + if( (u.s[0] & 0x7ff0) == 0x7ff0) + { + if( ((u.s[0] & 0x000f) | u.s[1] | u.s[2] | u.s[3]) != 0 ) + return(1); + } +#endif + return(0); + } /* size int not 4 */ + +#else +/* No NANS. */ +return(0); +#endif +} + + +/* Return 1 if x is not infinite and is not a NaN. */ + +int isfinite(x) +double x; +{ +#ifdef INFINITIES +union + { + double d; + unsigned short s[4]; + unsigned int i[2]; + } u; + +u.d = x; + +if( sizeof(int) == 4 ) + { +#ifdef IBMPC + if( (u.i[1] & 0x7ff00000) != 0x7ff00000) + return 1; +#endif +#ifdef DEC + if( (u.s[3] & 0x7fff) != 0) + return 1; +#endif +#ifdef MIEEE + if( (u.i[0] & 0x7ff00000) != 0x7ff00000) + return 1; +#endif + return(0); + } +else + { +#ifdef IBMPC + if( (u.s[3] & 0x7ff0) != 0x7ff0) + return 1; +#endif +#ifdef DEC + if( (u.s[3] & 0x7fff) != 0) + return 1; +#endif +#ifdef MIEEE + if( (u.s[0] & 0x7ff0) != 0x7ff0) + return 1; +#endif + return(0); + } +#else +/* No INFINITY. */ +return(1); +#endif +} diff --git a/components/external/espruino/libs/math/log.c b/components/external/espruino/libs/math/log.c new file mode 100644 index 0000000000..da42a66a7c --- /dev/null +++ b/components/external/espruino/libs/math/log.c @@ -0,0 +1,341 @@ +/* log.c + * + * Natural logarithm + * + * + * + * SYNOPSIS: + * + * double x, y, log(); + * + * y = log( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base e (2.718...) logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the logarithm + * of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 150000 1.44e-16 5.06e-17 + * IEEE +-MAXNUM 30000 1.20e-16 4.78e-17 + * DEC 0, 10 170000 1.8e-17 6.3e-18 + * + * In the tests over the interval [+-MAXNUM], the logarithms + * of the random arguments were uniformly distributed over + * [0, MAXLOG]. + * + * ERROR MESSAGES: + * + * log singularity: x = 0; returns -INFINITY + * log domain: x < 0; returns NAN + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" +static char fname[] = {"log"}; + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + */ +#ifdef UNK +const static double P[] = { + 1.01875663804580931796E-4, + 4.97494994976747001425E-1, + 4.70579119878881725854E0, + 1.44989225341610930846E1, + 1.79368678507819816313E1, + 7.70838733755885391666E0, +}; +const static double Q[] = { +/* 1.00000000000000000000E0, */ + 1.12873587189167450590E1, + 4.52279145837532221105E1, + 8.29875266912776603211E1, + 7.11544750618563894466E1, + 2.31251620126765340583E1, +}; +#endif + +#ifdef DEC +static unsigned short P[] = { +0037777,0127270,0162547,0057274, +0041001,0054665,0164317,0005341, +0041451,0034104,0031640,0105773, +0041677,0011276,0123617,0160135, +0041701,0126603,0053215,0117250, +0041420,0115777,0135206,0030232, +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0041220,0144332,0045272,0174241, +0041742,0164566,0035720,0130431, +0042246,0126327,0166065,0116357, +0042372,0033420,0157525,0124560, +0042271,0167002,0066537,0172303, +0041730,0164777,0113711,0044407, +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x1bb0,0x93c3,0xb4c2,0x3f1a, +0x52f2,0x3f56,0xd6f5,0x3fdf, +0x6911,0xed92,0xd2ba,0x4012, +0xeb2e,0xc63e,0xff72,0x402c, +0xc84d,0x924b,0xefd6,0x4031, +0xdcf8,0x7d7e,0xd563,0x401e, +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0xef8e,0xae97,0x9320,0x4026, +0xc033,0x4e19,0x9d2c,0x4046, +0xbdbd,0xa326,0xbf33,0x4054, +0xae21,0xeb5e,0xc9e2,0x4051, +0x25b2,0x9e1f,0x200a,0x4037, +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3f1a,0xb4c2,0x93c3,0x1bb0, +0x3fdf,0xd6f5,0x3f56,0x52f2, +0x4012,0xd2ba,0xed92,0x6911, +0x402c,0xff72,0xc63e,0xeb2e, +0x4031,0xefd6,0x924b,0xc84d, +0x401e,0xd563,0x7d7e,0xdcf8, +}; +static unsigned short Q[] = { +/*0x3ff0,0x0000,0x0000,0x0000,*/ +0x4026,0x9320,0xae97,0xef8e, +0x4046,0x9d2c,0x4e19,0xc033, +0x4054,0xbf33,0xa326,0xbdbd, +0x4051,0xc9e2,0xeb5e,0xae21, +0x4037,0x200a,0x9e1f,0x25b2, +}; +#endif + +/* Coefficients for log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + */ + +#ifdef UNK +const static double R[3] = { +-7.89580278884799154124E-1, + 1.63866645699558079767E1, +-6.41409952958715622951E1, +}; +const static double S[3] = { +/* 1.00000000000000000000E0,*/ +-3.56722798256324312549E1, + 3.12093766372244180303E2, +-7.69691943550460008604E2, +}; +#endif +#ifdef DEC +static unsigned short R[12] = { +0140112,0020756,0161540,0072035, +0041203,0013743,0114023,0155527, +0141600,0044060,0104421,0050400, +}; +static unsigned short S[12] = { +/*0040200,0000000,0000000,0000000,*/ +0141416,0130152,0017543,0064122, +0042234,0006000,0104527,0020155, +0142500,0066110,0146631,0174731, +}; +#endif +#ifdef IBMPC +static unsigned short R[12] = { +0x0e84,0xdc6c,0x443d,0xbfe9, +0x7b6b,0x7302,0x62fc,0x4030, +0x2a20,0x1122,0x0906,0xc050, +}; +static unsigned short S[12] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x6d0a,0x43ec,0xd60d,0xc041, +0xe40e,0x112a,0x8180,0x4073, +0x3f3b,0x19b3,0x0d89,0xc088, +}; +#endif +#ifdef MIEEE +static unsigned short R[12] = { +0xbfe9,0x443d,0xdc6c,0x0e84, +0x4030,0x62fc,0x7302,0x7b6b, +0xc050,0x0906,0x1122,0x2a20, +}; +static unsigned short S[12] = { +/*0x3ff0,0x0000,0x0000,0x0000,*/ +0xc041,0xd60d,0x43ec,0x6d0a, +0x4073,0x8180,0x112a,0xe40e, +0xc088,0x0d89,0x19b3,0x3f3b, +}; +#endif + +#ifdef ANSIPROT +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double frexp(), ldexp(), polevl(), p1evl(); +int isnan(), isfinite(); +#endif +#define SQRTH 0.70710678118654752440 +extern double INFINITY, NAN; + +double log(x) +double x; +{ +int e; +#ifdef DEC +short *q; +#endif +double y, z; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +#ifdef INFINITIES +if( x == INFINITY ) + return(x); +#endif +/* Test for domain */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + { + mtherr( fname, SING ); + return( -INFINITY ); + } + else + { + mtherr( fname, DOMAIN ); + return( NAN ); + } + } + +/* separate mantissa from exponent */ + +#ifdef DEC +q = (short *)&x; +e = *q; /* short containing exponent */ +e = ((e >> 7) & 0377) - 0200; /* the exponent */ +*q &= 0177; /* strip exponent from x */ +*q |= 040000; /* x now between 0.5 and 1 */ +#endif + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ +#ifdef IBMPC +x = frexp( x, &e ); +/* +q = (short *)&x; +q += 3; +e = *q; +e = ((e >> 4) & 0x0fff) - 0x3fe; +*q &= 0x0f; +*q |= 0x3fe0; +*/ +#endif + +/* Equivalent C language standard library function: */ +#ifdef UNK +x = frexp( x, &e ); +#endif + +#ifdef MIEEE +x = frexp( x, &e ); +#endif + + + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + +if( (e > 2) || (e < -2) ) +{ +if( x < SQRTH ) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5; + y = 0.5 * z + 0.5; + } +else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5; + z -= 0.5; + y = 0.5 * x + 0.5; + } + +x = z / y; + + +/* rational form */ +z = x*x; +z = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) ); +y = e; +z = z - y * 2.121944400546905827679e-4; +z = z + x; +z = z + e * 0.693359375; +goto ldone; +} + + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */ + } +else + { + x = x - 1.0; + } + + +/* rational form */ +z = x*x; +#if DEC +y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) ); +#else +y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) ); +#endif +if( e ) + y = y - e * 2.121944400546905827679e-4; +y = y - ldexp( z, -1 ); /* y - 0.5 * z */ +z = x + y; +if( e ) + z = z + e * 0.693359375; + +ldone: + +return( z ); +} diff --git a/components/external/espruino/libs/math/log10.c b/components/external/espruino/libs/math/log10.c new file mode 100644 index 0000000000..473af4a169 --- /dev/null +++ b/components/external/espruino/libs/math/log10.c @@ -0,0 +1,250 @@ +/* log10.c + * + * Common logarithm + * + * + * + * SYNOPSIS: + * + * double x, y, log10(); + * + * y = log10( x ); + * + * + * + * DESCRIPTION: + * + * Returns logarithm to the base 10 of x. + * + * The argument is separated into its exponent and fractional + * parts. The logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 1.5e-16 5.0e-17 + * IEEE 0, MAXNUM 30000 1.4e-16 4.8e-17 + * DEC 1, MAXNUM 50000 2.5e-17 6.0e-18 + * + * In the tests over the interval [1, MAXNUM], the logarithms + * of the random arguments were uniformly distributed over + * [0, MAXLOG]. + * + * ERROR MESSAGES: + * + * log10 singularity: x = 0; returns -INFINITY + * log10 domain: x < 0; returns NAN + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" +static char fname[] = {"log10"}; + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + */ +#ifdef UNK +const static double P[] = { + 4.58482948458143443514E-5, + 4.98531067254050724270E-1, + 6.56312093769992875930E0, + 2.97877425097986925891E1, + 6.06127134467767258030E1, + 5.67349287391754285487E1, + 1.98892446572874072159E1 +}; +const static double Q[] = { +/* 1.00000000000000000000E0, */ + 1.50314182634250003249E1, + 8.27410449222435217021E1, + 2.20664384982121929218E2, + 3.07254189979530058263E2, + 2.14955586696422947765E2, + 5.96677339718622216300E1 +}; +#endif + +#ifdef DEC +static unsigned short P[] = { +0034500,0046473,0051374,0135174, +0037777,0037566,0145712,0150321, +0040722,0002426,0031543,0123107, +0041356,0046513,0170752,0004346, +0041562,0071553,0023536,0163343, +0041542,0170221,0024316,0114216, +0041237,0016454,0046611,0104602 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0041160,0100260,0067736,0102424, +0041645,0075552,0036563,0147072, +0042134,0125025,0021132,0025320, +0042231,0120211,0046030,0103271, +0042126,0172241,0052151,0120426, +0041556,0125702,0072116,0047103 +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x974f,0x6a5f,0x09a7,0x3f08, +0x5a1a,0xd979,0xe7ee,0x3fdf, +0x74c9,0xc66c,0x40a2,0x401a, +0x411d,0x7e3d,0xc9a9,0x403d, +0xdcdc,0x64eb,0x4e6d,0x404e, +0xd312,0x2519,0x5e12,0x404c, +0x3130,0x89b1,0xe3a5,0x4033 +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0xd0a2,0x0dfb,0x1016,0x402e, +0x79c7,0x47ae,0xaf6d,0x4054, +0x455a,0xa44b,0x9542,0x406b, +0x10d7,0x2983,0x3411,0x4073, +0x3423,0x2a8d,0xde94,0x406a, +0xc9c8,0x4e89,0xd578,0x404d +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3f08,0x09a7,0x6a5f,0x974f, +0x3fdf,0xe7ee,0xd979,0x5a1a, +0x401a,0x40a2,0xc66c,0x74c9, +0x403d,0xc9a9,0x7e3d,0x411d, +0x404e,0x4e6d,0x64eb,0xdcdc, +0x404c,0x5e12,0x2519,0xd312, +0x4033,0xe3a5,0x89b1,0x3130 +}; +static unsigned short Q[] = { +0x402e,0x1016,0x0dfb,0xd0a2, +0x4054,0xaf6d,0x47ae,0x79c7, +0x406b,0x9542,0xa44b,0x455a, +0x4073,0x3411,0x2983,0x10d7, +0x406a,0xde94,0x2a8d,0x3423, +0x404d,0xd578,0x4e89,0xc9c8 +}; +#endif + +#define SQRTH 0.70710678118654752440 +#define L102A 3.0078125E-1 +#define L102B 2.48745663981195213739E-4 +#define L10EA 4.3359375E-1 +#define L10EB 7.00731903251827651129E-4 + +#ifdef ANSIPROT +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double frexp(), ldexp(), polevl(), p1evl(); +int isnan(), isfinite(); +#endif +extern double LOGE2, SQRT2, INFINITY, NAN; + +double log10(x) +double x; +{ +VOLATILE double z; +double y; +#ifdef DEC +short *q; +#endif +int e; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +#ifdef INFINITIES +if( x == INFINITY ) + return(x); +#endif +/* Test for domain */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + { + mtherr( fname, SING ); + return( -INFINITY ); + } + else + { + mtherr( fname, DOMAIN ); + return( NAN ); + } + } + +/* separate mantissa from exponent */ + +#ifdef DEC +q = (short *)&x; +e = *q; /* short containing exponent */ +e = ((e >> 7) & 0377) - 0200; /* the exponent */ +*q &= 0177; /* strip exponent from x */ +*q |= 040000; /* x now between 0.5 and 1 */ +#endif + +#ifdef IBMPC +x = frexp( x, &e ); +/* +q = (short *)&x; +q += 3; +e = *q; +e = ((e >> 4) & 0x0fff) - 0x3fe; +*q &= 0x0f; +*q |= 0x3fe0; +*/ +#endif + +/* Equivalent C language standard library function: */ +#ifdef UNK +x = frexp( x, &e ); +#endif + +#ifdef MIEEE +x = frexp( x, &e ); +#endif + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */ + } +else + { + x = x - 1.0; + } + + +/* rational form */ +z = x*x; +y = x * ( z * polevl( x, P, 6 ) / p1evl( x, Q, 6 ) ); +y = y - ldexp( z, -1 ); /* y - 0.5 * x**2 */ + +/* multiply log of fraction by log10(e) + * and base 2 exponent by log10(2) + */ +z = (x + y) * L10EB; /* accumulate terms in order of size */ +z += y * L10EA; +z += x * L10EA; +z += e * L102B; +z += e * L102A; + + +return( z ); +} diff --git a/components/external/espruino/libs/math/log2.c b/components/external/espruino/libs/math/log2.c new file mode 100644 index 0000000000..5cf64a67b6 --- /dev/null +++ b/components/external/espruino/libs/math/log2.c @@ -0,0 +1,348 @@ +/* log2.c + * + * Base 2 logarithm + * + * + * + * SYNOPSIS: + * + * double x, y, log2(); + * + * y = log2( x ); + * + * + * + * DESCRIPTION: + * + * Returns the base 2 logarithm of x. + * + * The argument is separated into its exponent and fractional + * parts. If the exponent is between -1 and +1, the base e + * logarithm of the fraction is approximated by + * + * log(1+x) = x - 0.5 x**2 + x**3 P(x)/Q(x). + * + * Otherwise, setting z = 2(x-1)/x+1), + * + * log(x) = z + z**3 P(z)/Q(z). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE 0.5, 2.0 30000 2.0e-16 5.5e-17 + * IEEE exp(+-700) 40000 1.3e-16 4.6e-17 + * + * In the tests over the interval [exp(+-700)], the logarithms + * of the random arguments were uniformly distributed. + * + * ERROR MESSAGES: + * + * log2 singularity: x = 0; returns -INFINITY + * log2 domain: x < 0; returns NAN + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" +static char fname[] = {"log2"}; + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + */ +#ifdef UNK +const static double P[] = { + 1.01875663804580931796E-4, + 4.97494994976747001425E-1, + 4.70579119878881725854E0, + 1.44989225341610930846E1, + 1.79368678507819816313E1, + 7.70838733755885391666E0, +}; +const static double Q[] = { +/* 1.00000000000000000000E0, */ + 1.12873587189167450590E1, + 4.52279145837532221105E1, + 8.29875266912776603211E1, + 7.11544750618563894466E1, + 2.31251620126765340583E1, +}; +#define LOG2EA 0.44269504088896340735992 +#endif + +#ifdef DEC +static unsigned short P[] = { +0037777,0127270,0162547,0057274, +0041001,0054665,0164317,0005341, +0041451,0034104,0031640,0105773, +0041677,0011276,0123617,0160135, +0041701,0126603,0053215,0117250, +0041420,0115777,0135206,0030232, +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0041220,0144332,0045272,0174241, +0041742,0164566,0035720,0130431, +0042246,0126327,0166065,0116357, +0042372,0033420,0157525,0124560, +0042271,0167002,0066537,0172303, +0041730,0164777,0113711,0044407, +}; +static unsigned short L[5] = {0037742,0124354,0122560,0057703}; +#define LOG2EA (*(double *)(&L[0])) +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x1bb0,0x93c3,0xb4c2,0x3f1a, +0x52f2,0x3f56,0xd6f5,0x3fdf, +0x6911,0xed92,0xd2ba,0x4012, +0xeb2e,0xc63e,0xff72,0x402c, +0xc84d,0x924b,0xefd6,0x4031, +0xdcf8,0x7d7e,0xd563,0x401e, +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0xef8e,0xae97,0x9320,0x4026, +0xc033,0x4e19,0x9d2c,0x4046, +0xbdbd,0xa326,0xbf33,0x4054, +0xae21,0xeb5e,0xc9e2,0x4051, +0x25b2,0x9e1f,0x200a,0x4037, +}; +static unsigned short L[5] = {0x0bf8,0x94ae,0x551d,0x3fdc}; +#define LOG2EA (*(double *)(&L[0])) +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3f1a,0xb4c2,0x93c3,0x1bb0, +0x3fdf,0xd6f5,0x3f56,0x52f2, +0x4012,0xd2ba,0xed92,0x6911, +0x402c,0xff72,0xc63e,0xeb2e, +0x4031,0xefd6,0x924b,0xc84d, +0x401e,0xd563,0x7d7e,0xdcf8, +}; +static unsigned short Q[] = { +/*0x3ff0,0x0000,0x0000,0x0000,*/ +0x4026,0x9320,0xae97,0xef8e, +0x4046,0x9d2c,0x4e19,0xc033, +0x4054,0xbf33,0xa326,0xbdbd, +0x4051,0xc9e2,0xeb5e,0xae21, +0x4037,0x200a,0x9e1f,0x25b2, +}; +static unsigned short L[5] = {0x3fdc,0x551d,0x94ae,0x0bf8}; +#define LOG2EA (*(double *)(&L[0])) +#endif + +/* Coefficients for log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/(x+1) + * 1/sqrt(2) <= x < sqrt(2) + */ + +#ifdef UNK +const static double R[3] = { +-7.89580278884799154124E-1, + 1.63866645699558079767E1, +-6.41409952958715622951E1, +}; +const static double S[3] = { +/* 1.00000000000000000000E0,*/ +-3.56722798256324312549E1, + 3.12093766372244180303E2, +-7.69691943550460008604E2, +}; +/* log2(e) - 1 */ +#define LOG2EA 0.44269504088896340735992 +#endif +#ifdef DEC +static unsigned short R[12] = { +0140112,0020756,0161540,0072035, +0041203,0013743,0114023,0155527, +0141600,0044060,0104421,0050400, +}; +static unsigned short S[12] = { +/*0040200,0000000,0000000,0000000,*/ +0141416,0130152,0017543,0064122, +0042234,0006000,0104527,0020155, +0142500,0066110,0146631,0174731, +}; +/* log2(e) - 1 */ +#define LOG2EA 0.44269504088896340735992L +#endif +#ifdef IBMPC +static unsigned short R[12] = { +0x0e84,0xdc6c,0x443d,0xbfe9, +0x7b6b,0x7302,0x62fc,0x4030, +0x2a20,0x1122,0x0906,0xc050, +}; +static unsigned short S[12] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x6d0a,0x43ec,0xd60d,0xc041, +0xe40e,0x112a,0x8180,0x4073, +0x3f3b,0x19b3,0x0d89,0xc088, +}; +#endif +#ifdef MIEEE +static unsigned short R[12] = { +0xbfe9,0x443d,0xdc6c,0x0e84, +0x4030,0x62fc,0x7302,0x7b6b, +0xc050,0x0906,0x1122,0x2a20, +}; +static unsigned short S[12] = { +/*0x3ff0,0x0000,0x0000,0x0000,*/ +0xc041,0xd60d,0x43ec,0x6d0a, +0x4073,0x8180,0x112a,0xe40e, +0xc088,0x0d89,0x19b3,0x3f3b, +}; +#endif + +#ifdef ANSIPROT +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double frexp(), ldexp(), polevl(), p1evl(); +int isnan(), isfinite(); +#endif +#define SQRTH 0.70710678118654752440 +extern double LOGE2, INFINITY, NAN; + +double log2(x) +double x; +{ +int e; +double y; +VOLATILE double z; +#ifdef DEC +short *q; +#endif + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +#ifdef INFINITIES +if( x == INFINITY ) + return(x); +#endif +/* Test for domain */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + { + mtherr( fname, SING ); + return( -INFINITY ); + } + else + { + mtherr( fname, DOMAIN ); + return( NAN ); + } + } + +/* separate mantissa from exponent */ + +#ifdef DEC +q = (short *)&x; +e = *q; /* short containing exponent */ +e = ((e >> 7) & 0377) - 0200; /* the exponent */ +*q &= 0177; /* strip exponent from x */ +*q |= 040000; /* x now between 0.5 and 1 */ +#endif + +/* Note, frexp is used so that denormal numbers + * will be handled properly. + */ +#ifdef IBMPC +x = frexp( x, &e ); +/* +q = (short *)&x; +q += 3; +e = *q; +e = ((e >> 4) & 0x0fff) - 0x3fe; +*q &= 0x0f; +*q |= 0x3fe0; +*/ +#endif + +/* Equivalent C language standard library function: */ +#ifdef UNK +x = frexp( x, &e ); +#endif + +#ifdef MIEEE +x = frexp( x, &e ); +#endif + + +/* logarithm using log(x) = z + z**3 P(z)/Q(z), + * where z = 2(x-1)/x+1) + */ + +if( (e > 2) || (e < -2) ) +{ +if( x < SQRTH ) + { /* 2( 2x-1 )/( 2x+1 ) */ + e -= 1; + z = x - 0.5; + y = 0.5 * z + 0.5; + } +else + { /* 2 (x-1)/(x+1) */ + z = x - 0.5; + z -= 0.5; + y = 0.5 * x + 0.5; + } + +x = z / y; +z = x*x; +y = x * ( z * polevl( z, R, 2 ) / p1evl( z, S, 3 ) ); +goto ldone; +} + + + +/* logarithm using log(1+x) = x - .5x**2 + x**3 P(x)/Q(x) */ + +if( x < SQRTH ) + { + e -= 1; + x = ldexp( x, 1 ) - 1.0; /* 2x - 1 */ + } +else + { + x = x - 1.0; + } + +z = x*x; +#if DEC +y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 6 ) ) - ldexp( z, -1 ); +#else +y = x * ( z * polevl( x, P, 5 ) / p1evl( x, Q, 5 ) ) - ldexp( z, -1 ); +#endif + +ldone: + +/* Multiply log of fraction by log2(e) + * and base 2 exponent by 1 + * + * ***CAUTION*** + * + * This sequence of operations is critical and it may + * be horribly defeated by some compiler optimizers. + */ +z = y * LOG2EA; +z += x * LOG2EA; +z += y; +z += x; +z += e; +return( z ); +} diff --git a/components/external/espruino/libs/math/mconf.h b/components/external/espruino/libs/math/mconf.h new file mode 100644 index 0000000000..83539f9bc6 --- /dev/null +++ b/components/external/espruino/libs/math/mconf.h @@ -0,0 +1,199 @@ +/* mconf.h + * + * Common include file for math routines + * + * + * + * SYNOPSIS: + * + * #include "mconf.h" + * + * + * + * DESCRIPTION: + * + * This file contains definitions for error codes that are + * passed to the common error handling routine mtherr() + * (which see). + * + * The file also includes a conditional assembly definition + * for the type of computer arithmetic (IEEE, DEC, Motorola + * IEEE, or UNKnown). + * + * For Digital Equipment PDP-11 and VAX computers, certain + * IBM systems, and others that use numbers with a 56-bit + * significand, the symbol DEC should be defined. In this + * mode, most floating point constants are given as arrays + * of octal integers to eliminate decimal to binary conversion + * errors that might be introduced by the compiler. + * + * For little-endian computers, such as IBM PC, that follow the + * IEEE Standard for Binary Floating Point Arithmetic (ANSI/IEEE + * Std 754-1985), the symbol IBMPC should be defined. These + * numbers have 53-bit significands. In this mode, constants + * are provided as arrays of hexadecimal 16 bit integers. + * + * Big-endian IEEE format is denoted MIEEE. On some RISC + * systems such as Sun SPARC, double precision constants + * must be stored on 8-byte address boundaries. Since integer + * arrays may be aligned differently, the MIEEE configuration + * may fail on such machines. + * + * To accommodate other types of computer arithmetic, all + * constants are also provided in a normal decimal radix + * which one can hope are correctly converted to a suitable + * format by the available C language compiler. To invoke + * this mode, define the symbol UNK. + * + * An important difference among these modes is a predefined + * set of machine arithmetic constants for each. The numbers + * MACHEP (the machine roundoff error), MAXNUM (largest number + * represented), and several other parameters are preset by + * the configuration symbol. Check the file const.c to + * ensure that these values are correct for your computer. + * + * Configurations NANS, INFINITIES, MINUSZERO, and DENORMAL + * may fail on many systems. Verify that they are supposed + * to work on your computer. + */ +/* +Cephes Math Library Release 2.3: June, 1995 +Copyright 1984, 1987, 1989, 1995 by Stephen L. Moshier +*/ + + +/* Define if the `long double' type works. */ +#define HAVE_LONG_DOUBLE 1 + +/* Define as the return type of signal handlers (int or void). */ +#define RETSIGTYPE void + +/* Define if you have the ANSI C header files. */ +#define STDC_HEADERS 1 + +/* Define if your processor stores words with the most significant + byte first (like Motorola and SPARC, unlike Intel and VAX). */ +/* #undef WORDS_BIGENDIAN */ + +/* Define if floating point words are bigendian. */ +/* #undef FLOAT_WORDS_BIGENDIAN */ + +/* The number of bytes in a int. */ +#define SIZEOF_INT 4 + +/* Define if you have the <string.h> header file. */ +#define HAVE_STRING_H 1 + +/* Name of package */ +#define PACKAGE "cephes" + +/* Version number of package */ +#define VERSION "2.7" + +/* Constant definitions for math error conditions + */ + +#define DOMAIN 1 /* argument domain error */ +#define SING 2 /* argument singularity */ +#define OVERFLOW 3 /* overflow range error */ +#define UNDERFLOW 4 /* underflow range error */ +#define TLOSS 5 /* total loss of precision */ +#define PLOSS 6 /* partial loss of precision */ + +#define EDOM 33 +#define ERANGE 34 +/* Complex numeral. */ +typedef struct + { + double r; + double i; + } cmplx; + +#ifdef HAVE_LONG_DOUBLE +/* Long double complex numeral. */ +typedef struct + { + long double r; + long double i; + } cmplxl; +#endif + + +/* Type of computer arithmetic */ + +/* PDP-11, Pro350, VAX: + */ +/* #define DEC 1 */ + +/* Intel IEEE, low order words come first: + */ +/* #define IBMPC 1 */ + +/* Motorola IEEE, high order words come first + * (Sun 680x0 workstation): + */ +/* #define MIEEE 1 */ + +/* UNKnown arithmetic, invokes coefficients given in + * normal decimal format. Beware of range boundary + * problems (MACHEP, MAXLOG, etc. in const.c) and + * roundoff problems in pow.c: + * (Sun SPARCstation) + */ +#define UNK 1 + +/* If you define UNK, then be sure to set BIGENDIAN properly. */ +#ifdef FLOAT_WORDS_BIGENDIAN +#define BIGENDIAN 1 +#else +#define BIGENDIAN 0 +#endif +/* Define this `volatile' if your compiler thinks + * that floating point arithmetic obeys the associative + * and distributive laws. It will defeat some optimizations + * (but probably not enough of them). + * + * #define VOLATILE volatile + */ +#define VOLATILE + +/* For 12-byte long doubles on an i386, pad a 16-bit short 0 + * to the end of real constants initialized by integer arrays. + * + * #define XPD 0, + * + * Otherwise, the type is 10 bytes long and XPD should be + * defined blank (e.g., Microsoft C). + * + * #define XPD + */ +#define XPD 0, + +/* Define to support tiny denormal numbers, else undefine. */ +#define DENORMAL 1 + +/* Define to ask for infinity support, else undefine. */ +#define INFINITIES 1 + +/* Define to ask for support of numbers that are Not-a-Number, + else undefine. This may automatically define INFINITIES in some files. */ +#define NANS 1 + +/* Define to distinguish between -0.0 and +0.0. */ +#define MINUSZERO 1 + +/* Define 1 for ANSI C atan2() function + See atan.c and clog.c. */ +#define ANSIC 1 + +/* Get ANSI function prototypes, if you want them. */ +#if 1 +/* #ifdef __STDC__ */ +#define ANSIPROT 1 +int mtherr ( char *, int ); +#else +int mtherr(); +#endif + +/* Variable for error reporting. See mtherr.c. */ +extern int merror; diff --git a/components/external/espruino/libs/math/mod2pi.c b/components/external/espruino/libs/math/mod2pi.c new file mode 100644 index 0000000000..88341a68bd --- /dev/null +++ b/components/external/espruino/libs/math/mod2pi.c @@ -0,0 +1,122 @@ +/* Program to test range reduction of trigonometry functions + * + * -- Steve Moshier + */ + +#include "mconf.h" +#ifdef ANSIPROT +extern double floor ( double ); +extern double ldexp ( double, int ); +extern double sin ( double ); +#else +double floor(), ldexp(), sin(); +#endif + +#define TPI 6.283185307179586476925 + +main() +{ +char s[40]; +double a, n, t, x, y, z; +int lflg; + +x = TPI/4.0; +t = 1.0; + +loop: + +t = 2.0 * t; + +/* Stop testing at a point beyond which the integer part of + * x/2pi cannot be represented exactly by a double precision number. + * The library trigonometry functions will probably give up long before + * this point is reached. + */ +if( t > 1.0e16 ) + exit(0); + +/* Adjust the following to choose a nontrivial x + * where test function(x) has a slope of about 1 or more. + */ +x = TPI * t + 0.5; + +z = x; +lflg = 0; + +inlup: + +/* floor() returns the largest integer less than its argument. + * If you do not have this, or AINT(), then you may convert x/TPI + * to a long integer and then back to double; but in that case + * x will be limited to the largest value that will fit into a + * long integer. + */ +n = floor( z/TPI ); + +/* Carefully subtract 2 pi n from x. + * This is done by subtracting n * 2**k in such a way that there + * is no arithmetic cancellation error at any step. The k are the + * bits in the number 2 pi. + * + * If you do not have ldexp(), then you may multiply or + * divide n by an appropriate power of 2 after each step. + * For example: + * a = z - 4*n; + * a -= 2*n; + * n /= 4; + * a -= n; n/4 + * n /= 8; + * a -= n; n/32 + * etc. + * This will only work if division by a power of 2 is exact. + */ + +a = z - ldexp(n, 2); /* 4n */ +a -= ldexp( n, 1); /* 2n */ +a -= ldexp( n, -2 ); /* n/4 */ +a -= ldexp( n, -5 ); /* n/32 */ +a -= ldexp( n, -9 ); /* n/512 */ +a += ldexp( n, -15 ); /* add n/32768 */ +a -= ldexp( n, -17 ); /* n/131072 */ +a -= ldexp( n, -18 ); +a -= ldexp( n, -20 ); +a -= ldexp( n, -22 ); +a -= ldexp( n, -24 ); +a -= ldexp( n, -28 ); +a -= ldexp( n, -32 ); +a -= ldexp( n, -37 ); +a -= ldexp( n, -39 ); +a -= ldexp( n, -40 ); +a -= ldexp( n, -42 ); +a -= ldexp( n, -46 ); +a -= ldexp( n, -47 ); + +/* Subtract what is left of 2 pi n after all the above reductions. + */ +a -= 2.44929359829470635445e-16 * n; + +/* If the test is extended too far, it is possible + * to have chosen the wrong value of n. The following + * will fix that, but at some reduction in accuracy. + */ +if( (a > TPI) || (a < -1e-11) ) + { + z = a; + lflg += 1; + printf( "Warning! Reduction failed on first try.\n" ); + goto inlup; + } +if( a < 0.0 ) + { + printf( "Warning! Reduced value < 0\n" ); + a += TPI; + } + +/* Compute the test function at x and at a = x mod 2 pi. + */ +y = sin(x); +z = sin(a); +printf( "sin(%.15e) error = %.3e\n", x, y-z ); +goto loop; +} + diff --git a/components/external/espruino/libs/math/mtherr.c b/components/external/espruino/libs/math/mtherr.c new file mode 100644 index 0000000000..9f44660c7b --- /dev/null +++ b/components/external/espruino/libs/math/mtherr.c @@ -0,0 +1,103 @@ +/* mtherr.c + * + * Library common error handling routine + * + * + * + * SYNOPSIS: + * + * char *fctnam; + * int code; + * int mtherr(); + * + * mtherr( fctnam, code ); + * + * + * + * DESCRIPTION: + * + * This routine may be called to report one of the following + * error conditions (in the include file mconf.h). + * + * Mnemonic Value Significance + * + * DOMAIN 1 argument domain error + * SING 2 function singularity + * OVERFLOW 3 overflow range error + * UNDERFLOW 4 underflow range error + * TLOSS 5 total loss of precision + * PLOSS 6 partial loss of precision + * EDOM 33 Unix domain error code + * ERANGE 34 Unix range error code + * + * The default version of the file prints the function name, + * passed to it by the pointer fctnam, followed by the + * error condition. The display is directed to the standard + * output device. The routine then returns to the calling + * program. Users may wish to modify the program to abort by + * calling exit() under severe error conditions such as domain + * errors. + * + * Since all error conditions pass control to this function, + * the display may be easily changed, eliminated, or directed + * to an error logging device. + * + * SEE ALSO: + * + * mconf.h + * + */ + +/* +Cephes Math Library Release 2.0: April, 1987 +Copyright 1984, 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ +#if 0 +#include <stdio.h> +#endif +#include "mconf.h" + +int merror = 0; + +/* Notice: the order of appearance of the following + * messages is bound to the error codes defined + * in mconf.h. + */ +static char *ermsg[7] = { +"unknown", /* error code 0 */ +"domain", /* error code 1 */ +"singularity", /* et seq. */ +"overflow", +"underflow", +"total loss of precision", +"partial loss of precision" +}; + + +int mtherr( name, code ) +char *name; +int code; +{ +#if 0 +/* Display string passed by calling program, + * which is supposed to be the name of the + * function in which the error occurred: + */ +printf( "\n%s ", name ); + +/* Set global error message word */ +merror = code; + +/* Display error message defined + * by the code argument. + */ +if( (code <= 0) || (code >= 7) ) + code = 0; +printf( "%s error\n", ermsg[code] ); +#endif +/* Return to calling + * program + */ +return( 0 ); +} diff --git a/components/external/espruino/libs/math/mtst.c b/components/external/espruino/libs/math/mtst.c new file mode 100644 index 0000000000..fbc392e98b --- /dev/null +++ b/components/external/espruino/libs/math/mtst.c @@ -0,0 +1,518 @@ +/* mtst.c + Consistency tests for math functions. + To get strict rounding rules on a 386 or 68000 computer, + define SETPREC to 1. + + With NTRIALS=10000, the following are typical results for + IEEE double precision arithmetic. + +Consistency test of math functions. +Max and rms relative errors for 10000 random arguments. +x = cbrt( cube(x) ): max = 0.00E+00 rms = 0.00E+00 +x = atan( tan(x) ): max = 2.21E-16 rms = 3.27E-17 +x = sin( asin(x) ): max = 2.13E-16 rms = 2.95E-17 +x = sqrt( square(x) ): max = 0.00E+00 rms = 0.00E+00 +x = log( exp(x) ): max = 1.11E-16 A rms = 4.35E-18 A +x = tanh( atanh(x) ): max = 2.22E-16 rms = 2.43E-17 +x = asinh( sinh(x) ): max = 2.05E-16 rms = 3.49E-18 +x = acosh( cosh(x) ): max = 1.43E-15 A rms = 1.54E-17 A +x = log10( exp10(x) ): max = 5.55E-17 A rms = 1.27E-18 A +x = pow( pow(x,a),1/a ): max = 7.60E-14 rms = 1.05E-15 +x = cos( acos(x) ): max = 2.22E-16 A rms = 6.90E-17 A +*/ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier +*/ + + +#include <stdio.h> +#include <stdlib.h> +#include "mconf.h" + +#ifndef NTRIALS +#define NTRIALS 10000 +#endif + +/* C9X spells lgam lgamma. */ +#define GLIBC2 0 +#define GLIBC2r1 0 + +#define SETPREC 1 +#define STRTST 0 + +#define WTRIALS (NTRIALS/5) + +#if GLIBC2 +double PI = 3.141592653589793238462643; +double PIO2 = 3.141592653589793238462643 * 0.5; +double MAXLOG = 7.09782712893383996732224E2; +#else +extern double PI; +extern double PIO2; +extern double MAXLOG; +#endif + +extern double MINLOG; +/* +define MINLOG -170.0 +define MAXLOG +170.0 +define PI 3.14159265358979323846 +define PIO2 1.570796326794896619 +*/ + +#ifdef ANSIPROT +extern double fabs ( double ); +extern double sqrt ( double ); +extern double cbrt ( double ); +extern double exp ( double ); +extern double log ( double ); +extern double exp10 ( double ); +extern double log10 ( double ); +extern double tan ( double ); +extern double atan ( double ); +extern double sin ( double ); +extern double asin ( double ); +extern double cos ( double ); +extern double acos ( double ); +extern double pow ( double, double ); +extern double tanh ( double ); +extern double atanh ( double ); +extern double sinh ( double ); +extern double asinh ( double x ); +extern double cosh ( double ); +extern double acosh ( double ); +extern double gamma ( double ); +extern double lgam ( double ); +extern double jn ( int, double ); +extern double yn ( int, double ); +extern double ndtr ( double ); +extern double ndtri ( double ); +extern double stdtr ( int, double ); +extern double stdtri ( int, double ); +extern double ellpe ( double ); +extern double ellpk ( double ); +#else +double fabs(), sqrt(), cbrt(), exp(), log(); +double exp10(), log10(), tan(), atan(); +double sin(), asin(), cos(), acos(), pow(); +double tanh(), atanh(), sinh(), asinh(), cosh(), acosh(); +double gamma(), lgam(), jn(), yn(), ndtrl(), ndtril(); +double stdtrl(), stdtril(), ellpel(), ellpkl(); +#endif + +#if GLIBC2 +extern double lgamma (double); +extern double tgamma ( double ); +#endif + +#if SETPREC +int dprec(); +#endif + +int drand(); +/* void exit(); */ +/* int printf(); */ + + +/* Provide inverses for square root and cube root: */ +double square(x) +double x; +{ +return( x * x ); +} + +double cube(x) +double x; +{ +return( x * x * x ); +} + +/* lookup table for each function */ +struct fundef + { + char *nam1; /* the function */ + double (*name )(); + char *nam2; /* its inverse */ + double (*inv )(); + int nargs; /* number of function arguments */ + int tstyp; /* type code of the function */ + long ctrl; /* relative error flag */ + double arg1w; /* width of domain for 1st arg */ + double arg1l; /* lower bound domain 1st arg */ + long arg1f; /* flags, e.g. integer arg */ + double arg2w; /* same info for args 2, 3, 4 */ + double arg2l; + long arg2f; +/* + double arg3w; + double arg3l; + long arg3f; + double arg4w; + double arg4l; + long arg4f; +*/ + }; + + +/* fundef.ctrl bits: */ +#define RELERR 1 + +/* fundef.tstyp test types: */ +#define POWER 1 +#define ELLIP 2 +#define GAMMA 3 +#define WRONK1 4 +#define WRONK2 5 +#define WRONK3 6 +#define STDTR 7 + +/* fundef.argNf argument flag bits: */ +#define INT 2 +#define EXPSCAL 4 + +#if GLIBC2r1 +#define NTESTS 12 +#else +#if GLIBC2 +#define NTESTS 13 +#else +#define NTESTS 17 +#endif +#endif + +struct fundef defs[NTESTS] = { +{" cube", cube, " cbrt", cbrt, 1, 0, 1, 2002.0, -1001.0, 0, +0.0, 0.0, 0}, +{" tan", tan, " atan", atan, 1, 0, 1, 0.0, 0.0, 0, +0.0, 0.0, 0}, +{" asin", asin, " sin", sin, 1, 0, 1, 2.0, -1.0, 0, +0.0, 0.0, 0}, +{"square", square, " sqrt", sqrt, 1, 0, 1, 170.0, -85.0, EXPSCAL, +0.0, 0.0, 0}, +{" exp", exp, " log", log, 1, 0, 0, 340.0, -170.0, 0, +0.0, 0.0, 0}, +{" atanh", atanh, " tanh", tanh, 1, 0, 1, 2.0, -1.0, 0, +0.0, 0.0, 0}, +{" sinh", sinh, " asinh", asinh, 1, 0, 1, 340.0, 0.0, 0, +0.0, 0.0, 0}, +{" cosh", cosh, " acosh", acosh, 1, 0, 0, 340.0, 0.0, 0, +0.0, 0.0, 0}, +#if !GLIBC2r1 +{" exp10", exp10, " log10", log10, 1, 0, 0, 340.0, -170.0, 0, +0.0, 0.0, 0}, +#endif +{"pow", pow, "pow", pow, 2, POWER, 1, 21.0, 0.0, 0, +42.0, -21.0, 0}, +{" acos", acos, " cos", cos, 1, 0, 0, 2.0, -1.0, 0, +0.0, 0.0, 0}, +#if GLIBC2 +#if !GLIBC2r1 +{ "tgamma", tgamma, "lgamma", lgamma, 1, GAMMA, 0, 34.0, 0.0, 0, +0.0, 0.0, 0}, +#endif +#else +{ "gamma", gamma, "lgam", lgam, 1, GAMMA, 0, 34.0, 0.0, 0, +0.0, 0.0, 0}, +#endif +{ " Jn", jn, " Yn", yn, 2, WRONK1, 0, 30.0, 0.1, 0, +40.0, -20.0, INT}, +#if !GLIBC2 +{ " ndtr", ndtr, " ndtri", ndtri, 1, 0, 1, 10.0L, -10.0L, 0, +0.0, 0.0, 0}, +{ " ndtri", ndtri, " ndtr", ndtr, 1, 0, 1, 1.0L, 0.0L, 0, +0.0, 0.0, 0}, +{" ellpe", ellpe, " ellpk", ellpk, 1, ELLIP, 0, 1.0L, 0.0L, 0, +0.0, 0.0, 0}, +{ "stdtr", stdtr, "stdtri", stdtri, 2, STDTR, 1, 4.0L, -2.0L, 0, +30.0, 1.0, INT}, +#endif +}; + +static char *headrs[] = { +"x = %s( %s(x) ): ", +"x = %s( %s(x,a),1/a ): ", /* power */ +"Legendre %s, %s: ", /* ellip */ +"%s(x) = log(%s(x)): ", /* gamma */ +"Wronksian of %s, %s: ", +"Wronksian of %s, %s: ", +"Wronksian of %s, %s: ", +"x = %s(%s(k,x) ): ", /* stdtr */ +}; + +const static double yy1 = 0.0; +const static double y2 = 0.0; +const static double y3 = 0.0; +const static double y4 = 0.0; +const static double a = 0.0; +const static double x = 0.0; +const static double y = 0.0; +const static double z = 0.0; +const static double e = 0.0; +const static double max = 0.0; +const static double rmsa = 0.0; +const static double rms = 0.0; +const static double ave = 0.0; + + +int main() +{ +double (*fun )(); +double (*ifun )(); +struct fundef *d; +int i, k, itst; +int m, ntr; + +#if SETPREC +dprec(); /* set coprocessor precision */ +#endif +ntr = NTRIALS; +printf( "Consistency test of math functions.\n" ); +printf( "Max and rms relative errors for %d random arguments.\n", + ntr ); + +/* Initialize machine dependent parameters: */ +defs[1].arg1w = PI; +defs[1].arg1l = -PI/2.0; +/* Microsoft C has trouble with denormal numbers. */ +#if 0 +defs[3].arg1w = MAXLOG; +defs[3].arg1l = -MAXLOG/2.0; +defs[4].arg1w = 2*MAXLOG; +defs[4].arg1l = -MAXLOG; +#endif +defs[6].arg1w = 2.0*MAXLOG; +defs[6].arg1l = -MAXLOG; +defs[7].arg1w = MAXLOG; +defs[7].arg1l = 0.0; + + +/* Outer loop, on the test number: */ + +for( itst=STRTST; itst<NTESTS; itst++ ) +{ +d = &defs[itst]; +k = 0; +m = 0; +max = 0.0; +rmsa = 0.0; +ave = 0.0; +fun = d->name; +ifun = d->inv; + +/* Absolute error criterion starts with gamma function + * (put all such at end of table) + */ +#if 0 +if( d->tstyp == GAMMA ) + printf( "Absolute error criterion (but relative if >1):\n" ); +#endif + +/* Smaller number of trials for Wronksians + * (put them at end of list) + */ +#if 0 +if( d->tstyp == WRONK1 ) + { + ntr = WTRIALS; + printf( "Absolute error and only %d trials:\n", ntr ); + } +#endif +if( d->tstyp == STDTR ) + { + ntr = NTRIALS/10; + printf( "Relative error and only %d trials:\n", ntr ); + } +printf( headrs[d->tstyp], d->nam2, d->nam1 ); + +for( i=0; i<ntr; i++ ) +{ +m++; + +/* make random number(s) in desired range(s) */ +switch( d->nargs ) +{ + +default: +goto illegn; + +case 2: +drand( &a ); +a = d->arg2w * ( a - 1.0 ) + d->arg2l; +if( d->arg2f & EXPSCAL ) + { + a = exp(a); + drand( &y2 ); + a -= 1.0e-13 * a * y2; + } +if( d->arg2f & INT ) + { + k = a + 0.25; + a = k; + } + +case 1: +drand( &x ); +x = d->arg1w * ( x - 1.0 ) + d->arg1l; +if( d->arg1f & EXPSCAL ) + { + x = exp(x); + drand( &a ); + x += 1.0e-13 * x * a; + } +} + + +/* compute function under test */ +switch( d->nargs ) + { + case 1: + switch( d->tstyp ) + { + case ELLIP: + yy1 = ( *(fun) )(x); + y2 = ( *(fun) )(1.0-x); + y3 = ( *(ifun) )(x); + y4 = ( *(ifun) )(1.0-x); + break; + + case GAMMA: +#if GLIBC2 + y = lgamma(x); + x = log( tgamma(x) ); +#else + y = lgam(x); + x = log( gamma(x) ); +#endif + break; + + default: + z = ( *(fun) )(x); + y = ( *(ifun) )(z); + } + break; + + case 2: + if( d->arg2f & INT ) + { + switch( d->tstyp ) + { + case WRONK1: + yy1 = (*fun)( k, x ); /* jn */ + y2 = (*fun)( k+1, x ); + y3 = (*ifun)( k, x ); /* yn */ + y4 = (*ifun)( k+1, x ); + break; + + case WRONK2: + yy1 = (*fun)( a, x ); /* iv */ + y2 = (*fun)( a+1.0, x ); + y3 = (*ifun)( k, x ); /* kn */ + y4 = (*ifun)( k+1, x ); + break; + + default: + z = (*fun)( k, x ); + y = (*ifun)( k, z ); + } + } + else + { + if( d->tstyp == POWER ) + { + z = (*fun)( x, a ); + y = (*ifun)( z, 1.0/a ); + } + else + { + z = (*fun)( a, x ); + y = (*ifun)( a, z ); + } + } + break; + + + default: +illegn: + printf( "Illegal nargs= %d", d->nargs ); + exit(1); + } + +switch( d->tstyp ) + { + case WRONK1: + e = (y2*y3 - yy1*y4) - 2.0/(PI*x); /* Jn, Yn */ + break; + + case WRONK2: + e = (y2*y3 + yy1*y4) - 1.0/x; /* In, Kn */ + break; + + case ELLIP: + e = (yy1-y3)*y4 + y3*y2 - PIO2; + break; + + default: + e = y - x; + break; + } + +if( d->ctrl & RELERR ) + e /= x; +else + { + if( fabs(x) > 1.0 ) + e /= x; + } + +ave += e; +/* absolute value of error */ +if( e < 0 ) + e = -e; + +/* peak detect the error */ +if( e > max ) + { + max = e; + + if( e > 1.0e-10 ) + { + printf("x %.6E z %.6E y %.6E max %.4E\n", + x, z, y, max); + if( d->tstyp == POWER ) + { + printf( "a %.6E\n", a ); + } + if( d->tstyp >= WRONK1 ) + { + printf( "yy1 %.4E y2 %.4E y3 %.4E y4 %.4E k %d x %.4E\n", + yy1, y2, y3, y4, k, x ); + } + } + +/* + printf("%.8E %.8E %.4E %6ld \n", x, y, max, n); + printf("%d %.8E %.8E %.4E %6ld \n", k, x, y, max, n); + printf("%.6E %.6E %.6E %.4E %6ld \n", a, x, y, max, n); + printf("%.6E %.6E %.6E %.6E %.4E %6ld \n", a, b, x, y, max, n); + printf("%.4E %.4E %.4E %.4E %.4E %.4E %6ld \n", + a, b, c, x, y, max, n); +*/ + } + +/* accumulate rms error */ +e *= 1.0e16; /* adjust range */ +rmsa += e * e; /* accumulate the square of the error */ +} + +/* report after NTRIALS trials */ +rms = 1.0e-16 * sqrt( rmsa/m ); +if(d->ctrl & RELERR) + printf(" max = %.2E rms = %.2E\n", max, rms ); +else + printf(" max = %.2E A rms = %.2E A\n", max, rms ); +} /* loop on itst */ + +exit(0); +} diff --git a/components/external/espruino/libs/math/mtst.opt b/components/external/espruino/libs/math/mtst.opt new file mode 100644 index 0000000000..2276dbac6e --- /dev/null +++ b/components/external/espruino/libs/math/mtst.opt @@ -0,0 +1,30 @@ +acosh.obj,- +asin.obj,- +asinh.obj,- +atan.obj,- +atanh.obj,- +cbrt.obj,- +chbevl.obj,- +const.obj,- +cosh.obj,- +drand.obj,- +exp.obj,- +exp10.obj,- +fabs.obj,- +floor.obj,- +log.obj,- +log10.obj,- +polevl.obj,- +pow.obj,- +powi.obj,- +round.obj,- +sin.obj,- +sinh.obj,- +tan.obj,- +tanh.obj,- +unity.obj,- +sqrt.obj,- +floor.obj,- +polevl.obj,- +mtherr.obj,- +sys$library:vaxcrtl/lib diff --git a/components/external/espruino/libs/math/polevl.asm b/components/external/espruino/libs/math/polevl.asm new file mode 100644 index 0000000000..47aa7ff70a --- /dev/null +++ b/components/external/espruino/libs/math/polevl.asm @@ -0,0 +1,116 @@ +; Static Name Aliases +; + TITLE polevl + +_TEXT SEGMENT BYTE PUBLIC 'CODE' +_TEXT ENDS +CONST SEGMENT WORD PUBLIC 'CONST' +CONST ENDS +_BSS SEGMENT WORD PUBLIC 'BSS' +_BSS ENDS +_DATA SEGMENT WORD PUBLIC 'DATA' +_DATA ENDS +DGROUP GROUP CONST, _BSS, _DATA + ASSUME CS: _TEXT, DS: DGROUP, SS: DGROUP, ES: DGROUP +PUBLIC _polevl +PUBLIC _p1evl +_DATA SEGMENT +EXTRN __chkstk:NEAR +EXTRN __fac:NEAR +EXTRN __fltused:NEAR +$T20001 DQ 0000000000H ; .0000000000000000 +ans DQ 0 +ctrlw DW 0 +_DATA ENDS +_TEXT SEGMENT + PUBLIC _polevl +_polevl PROC NEAR + push bp + mov bp,sp + mov ax,12 + call __chkstk + push si + mov si,[bp+12] +; fstcw ctrlw +; fwait +; mov ax,ctrlw +; or ax,00100h +; mov ctrlw,ax +; fldcw ctrlw + + fldz + fwait + mov ax,[bp+14] + inc ax + mov [bp-12],ax +$D15: + fmul QWORD PTR [bp+4] + add si,8 + fwait + fadd QWORD PTR [si-8] + fwait + dec WORD PTR [bp-12] + jne $D15 + fstp ans +; fstcw ctrlw +; fwait +; mov ax,ctrlw +; and ax,0feffh +; mov ctrlw,ax +; fldcw ctrlw + + lea ax, ans + fwait + pop si + mov sp,bp + pop bp + ret +_polevl ENDP + + PUBLIC _p1evl +_p1evl PROC NEAR + push bp + mov bp,sp + mov ax,12 + call __chkstk + push si + +; fstcw ctrlw +; fwait +; mov ax,ctrlw +; or ax,00100h +; mov ctrlw,ax +; fldcw ctrlw + + mov si,[bp+12] + fld QWORD PTR [bp+4] + add si,8 + fadd QWORD PTR [si-8] + fwait + mov ax,[bp+14] + dec ax + mov [bp-12],ax +$D26: + fmul QWORD PTR [bp+4] + add si,8 + fadd QWORD PTR [si-8] + fwait + dec WORD PTR [bp-12] + jne $D26 + fstp ans + lea ax, ans +; fstcw ctrlw +; fwait +; mov ax,ctrlw +; and ax,0feffh +; mov ctrlw,ax +; fldcw ctrlw + fwait + pop si + mov sp,bp + pop bp + ret +_p1evl ENDP + +_TEXT ENDS +END diff --git a/components/external/espruino/libs/math/polevl.c b/components/external/espruino/libs/math/polevl.c new file mode 100644 index 0000000000..4d050fbfc5 --- /dev/null +++ b/components/external/espruino/libs/math/polevl.c @@ -0,0 +1,97 @@ +/* polevl.c + * p1evl.c + * + * Evaluate polynomial + * + * + * + * SYNOPSIS: + * + * int N; + * double x, y, coef[N+1], polevl[]; + * + * y = polevl( x, coef, N ); + * + * + * + * DESCRIPTION: + * + * Evaluates polynomial of degree N: + * + * 2 N + * y = C + C x + C x +...+ C x + * 0 1 2 N + * + * Coefficients are stored in reverse order: + * + * coef[0] = C , ..., coef[N] = C . + * N 0 + * + * The function p1evl() assumes that coef[N] = 1.0 and is + * omitted from the array. Its calling arguments are + * otherwise the same as polevl(). + * + * + * SPEED: + * + * In the interest of speed, there are no checks for out + * of bounds arithmetic. This routine is used by most of + * the functions in the library. Depending on available + * equipment features, the user may wish to rewrite the + * program in microcode or assembly language. + * + */ + + +/* +Cephes Math Library Release 2.1: December, 1988 +Copyright 1984, 1987, 1988 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +double polevl( x, coef, N ) +double x; +double coef[]; +int N; +{ +double ans; +int i; +double *p; + +p = coef; +ans = *p++; +i = N; + +do + ans = ans * x + *p++; +while( --i ); + +return( ans ); +} + +/* p1evl() */ +/* N + * Evaluate polynomial when coefficient of x is 1.0. + * Otherwise same as polevl. + */ + +double p1evl( x, coef, N ) +double x; +double coef[]; +int N; +{ +double ans; +double *p; +int i; + +p = coef; +ans = x + *p++; +i = N-1; + +do + ans = ans * x + *p++; +while( --i ); + +return( ans ); +} diff --git a/components/external/espruino/libs/math/pow.c b/components/external/espruino/libs/math/pow.c new file mode 100644 index 0000000000..d481f7c626 --- /dev/null +++ b/components/external/espruino/libs/math/pow.c @@ -0,0 +1,756 @@ +/* pow.c + * + * Power function + * + * + * + * SYNOPSIS: + * + * double x, y, z, pow(); + * + * z = pow( x, y ); + * + * + * + * DESCRIPTION: + * + * Computes x raised to the yth power. Analytically, + * + * x**y = exp( y log(x) ). + * + * Following Cody and Waite, this program uses a lookup table + * of 2**-i/16 and pseudo extended precision arithmetic to + * obtain an extra three bits of accuracy in both the logarithm + * and the exponential. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -26,26 30000 4.2e-16 7.7e-17 + * DEC -26,26 60000 4.8e-17 9.1e-18 + * 1/26 < x < 26, with log(x) uniformly distributed. + * -26 < y < 26, y uniformly distributed. + * IEEE 0,8700 30000 1.5e-14 2.1e-15 + * 0.99 < x < 1.01, 0 < y < 8700, uniformly distributed. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * pow overflow x**y > MAXNUM INFINITY + * pow underflow x**y < 1/MAXNUM 0.0 + * pow domain x<0 and y noninteger 0.0 + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" +static char fname[] = {"pow"}; + +#define SQRTH 0.70710678118654752440 + +#ifdef UNK +const static double P[] = { + 4.97778295871696322025E-1, + 3.73336776063286838734E0, + 7.69994162726912503298E0, + 4.66651806774358464979E0 +}; +const static double Q[] = { +/* 1.00000000000000000000E0, */ + 9.33340916416696166113E0, + 2.79999886606328401649E1, + 3.35994905342304405431E1, + 1.39995542032307539578E1 +}; +/* 2^(-i/16), IEEE precision */ +const static double A[] = { + 1.00000000000000000000E0, + 9.57603280698573700036E-1, + 9.17004043204671215328E-1, + 8.78126080186649726755E-1, + 8.40896415253714502036E-1, + 8.05245165974627141736E-1, + 7.71105412703970372057E-1, + 7.38413072969749673113E-1, + 7.07106781186547572737E-1, + 6.77127773468446325644E-1, + 6.48419777325504820276E-1, + 6.20928906036742001007E-1, + 5.94603557501360513449E-1, + 5.69394317378345782288E-1, + 5.45253866332628844837E-1, + 5.22136891213706877402E-1, + 5.00000000000000000000E-1 +}; +const static double B[] = { + 0.00000000000000000000E0, + 1.64155361212281360176E-17, + 4.09950501029074826006E-17, + 3.97491740484881042808E-17, +-4.83364665672645672553E-17, + 1.26912513974441574796E-17, + 1.99100761573282305549E-17, +-1.52339103990623557348E-17, + 0.00000000000000000000E0 +}; +const static double R[] = { + 1.49664108433729301083E-5, + 1.54010762792771901396E-4, + 1.33335476964097721140E-3, + 9.61812908476554225149E-3, + 5.55041086645832347466E-2, + 2.40226506959099779976E-1, + 6.93147180559945308821E-1 +}; + +#define douba(k) A[k] +#define doubb(k) B[k] +#define MEXP 16383.0 +#ifdef DENORMAL +#define MNEXP -17183.0 +#else +#define MNEXP -16383.0 +#endif +#endif + +#ifdef DEC +static unsigned short P[] = { +0037776,0156313,0175332,0163602, +0040556,0167577,0052366,0174245, +0040766,0062753,0175707,0055564, +0040625,0052035,0131344,0155636, +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0041025,0052644,0154404,0105155, +0041337,0177772,0007016,0047646, +0041406,0062740,0154273,0020020, +0041137,0177054,0106127,0044555, +}; +static unsigned short A[] = { +0040200,0000000,0000000,0000000, +0040165,0022575,0012444,0103314, +0040152,0140306,0163735,0022071, +0040140,0146336,0166052,0112341, +0040127,0042374,0145326,0116553, +0040116,0022214,0012437,0102201, +0040105,0063452,0010525,0003333, +0040075,0004243,0117530,0006067, +0040065,0002363,0031771,0157145, +0040055,0054076,0165102,0120513, +0040045,0177326,0124661,0050471, +0040036,0172462,0060221,0120422, +0040030,0033760,0050615,0134251, +0040021,0141723,0071653,0010703, +0040013,0112701,0161752,0105727, +0040005,0125303,0063714,0044173, +0040000,0000000,0000000,0000000 +}; +static unsigned short B[] = { +0000000,0000000,0000000,0000000, +0021473,0040265,0153315,0140671, +0121074,0062627,0042146,0176454, +0121413,0003524,0136332,0066212, +0121767,0046404,0166231,0012553, +0121257,0015024,0002357,0043574, +0021736,0106532,0043060,0056206, +0121310,0020334,0165705,0035326, +0000000,0000000,0000000,0000000 +}; + +static unsigned short R[] = { +0034173,0014076,0137624,0115771, +0035041,0076763,0003744,0111311, +0035656,0141766,0041127,0074351, +0036435,0112533,0073611,0116664, +0037143,0054106,0134040,0152223, +0037565,0176757,0176026,0025551, +0040061,0071027,0173721,0147572 +}; + +/* +const static double R[] = { +0.14928852680595608186e-4, +0.15400290440989764601e-3, +0.13333541313585784703e-2, +0.96181290595172416964e-2, +0.55504108664085595326e-1, +0.24022650695909537056e0, +0.69314718055994529629e0 +}; +*/ +#define douba(k) (*(double *)&A[(k)<<2]) +#define doubb(k) (*(double *)&B[(k)<<2]) +#define MEXP 2031.0 +#define MNEXP -2031.0 +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x5cf0,0x7f5b,0xdb99,0x3fdf, +0xdf15,0xea9e,0xddef,0x400d, +0xeb6f,0x7f78,0xccbd,0x401e, +0x9b74,0xb65c,0xaa83,0x4012, +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x914e,0x9b20,0xaab4,0x4022, +0xc9f5,0x41c1,0xffff,0x403b, +0x6402,0x1b17,0xccbc,0x4040, +0xe92e,0x918a,0xffc5,0x402b, +}; +static unsigned short A[] = { +0x0000,0x0000,0x0000,0x3ff0, +0x90da,0xa2a4,0xa4af,0x3fee, +0xa487,0xdcfb,0x5818,0x3fed, +0x529c,0xdd85,0x199b,0x3fec, +0xd3ad,0x995a,0xe89f,0x3fea, +0xf090,0x82a3,0xc491,0x3fe9, +0xa0db,0x422a,0xace5,0x3fe8, +0x0187,0x73eb,0xa114,0x3fe7, +0x3bcd,0x667f,0xa09e,0x3fe6, +0x5429,0xdd48,0xab07,0x3fe5, +0x2a27,0xd536,0xbfda,0x3fe4, +0x3422,0x4c12,0xdea6,0x3fe3, +0xb715,0x0a31,0x06fe,0x3fe3, +0x6238,0x6e75,0x387a,0x3fe2, +0x517b,0x3c7d,0x72b8,0x3fe1, +0x890f,0x6cf9,0xb558,0x3fe0, +0x0000,0x0000,0x0000,0x3fe0 +}; +static unsigned short B[] = { +0x0000,0x0000,0x0000,0x0000, +0x3707,0xd75b,0xed02,0x3c72, +0xcc81,0x345d,0xa1cd,0x3c87, +0x4b27,0x5686,0xe9f1,0x3c86, +0x6456,0x13b2,0xdd34,0xbc8b, +0x42e2,0xafec,0x4397,0x3c6d, +0x82e4,0xd231,0xf46a,0x3c76, +0x8a76,0xb9d7,0x9041,0xbc71, +0x0000,0x0000,0x0000,0x0000 +}; +static unsigned short R[] = { +0x937f,0xd7f2,0x6307,0x3eef, +0x9259,0x60fc,0x2fbe,0x3f24, +0xef1d,0xc84a,0xd87e,0x3f55, +0x33b7,0x6ef1,0xb2ab,0x3f83, +0x1a92,0xd704,0x6b08,0x3fac, +0xc56d,0xff82,0xbfbd,0x3fce, +0x39ef,0xfefa,0x2e42,0x3fe6 +}; + +#define douba(k) (*(double *)&A[(k)<<2]) +#define doubb(k) (*(double *)&B[(k)<<2]) +#define MEXP 16383.0 +#ifdef DENORMAL +#define MNEXP -17183.0 +#else +#define MNEXP -16383.0 +#endif +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0x3fdf,0xdb99,0x7f5b,0x5cf0, +0x400d,0xddef,0xea9e,0xdf15, +0x401e,0xccbd,0x7f78,0xeb6f, +0x4012,0xaa83,0xb65c,0x9b74 +}; +static unsigned short Q[] = { +0x4022,0xaab4,0x9b20,0x914e, +0x403b,0xffff,0x41c1,0xc9f5, +0x4040,0xccbc,0x1b17,0x6402, +0x402b,0xffc5,0x918a,0xe92e +}; +static unsigned short A[] = { +0x3ff0,0x0000,0x0000,0x0000, +0x3fee,0xa4af,0xa2a4,0x90da, +0x3fed,0x5818,0xdcfb,0xa487, +0x3fec,0x199b,0xdd85,0x529c, +0x3fea,0xe89f,0x995a,0xd3ad, +0x3fe9,0xc491,0x82a3,0xf090, +0x3fe8,0xace5,0x422a,0xa0db, +0x3fe7,0xa114,0x73eb,0x0187, +0x3fe6,0xa09e,0x667f,0x3bcd, +0x3fe5,0xab07,0xdd48,0x5429, +0x3fe4,0xbfda,0xd536,0x2a27, +0x3fe3,0xdea6,0x4c12,0x3422, +0x3fe3,0x06fe,0x0a31,0xb715, +0x3fe2,0x387a,0x6e75,0x6238, +0x3fe1,0x72b8,0x3c7d,0x517b, +0x3fe0,0xb558,0x6cf9,0x890f, +0x3fe0,0x0000,0x0000,0x0000 +}; +static unsigned short B[] = { +0x0000,0x0000,0x0000,0x0000, +0x3c72,0xed02,0xd75b,0x3707, +0x3c87,0xa1cd,0x345d,0xcc81, +0x3c86,0xe9f1,0x5686,0x4b27, +0xbc8b,0xdd34,0x13b2,0x6456, +0x3c6d,0x4397,0xafec,0x42e2, +0x3c76,0xf46a,0xd231,0x82e4, +0xbc71,0x9041,0xb9d7,0x8a76, +0x0000,0x0000,0x0000,0x0000 +}; +static unsigned short R[] = { +0x3eef,0x6307,0xd7f2,0x937f, +0x3f24,0x2fbe,0x60fc,0x9259, +0x3f55,0xd87e,0xc84a,0xef1d, +0x3f83,0xb2ab,0x6ef1,0x33b7, +0x3fac,0x6b08,0xd704,0x1a92, +0x3fce,0xbfbd,0xff82,0xc56d, +0x3fe6,0x2e42,0xfefa,0x39ef +}; + +#define douba(k) (*(double *)&A[(k)<<2]) +#define doubb(k) (*(double *)&B[(k)<<2]) +#define MEXP 16383.0 +#ifdef DENORMAL +#define MNEXP -17183.0 +#else +#define MNEXP -16383.0 +#endif +#endif + +/* log2(e) - 1 */ +#define LOG2EA 0.44269504088896340736 + +#define F W +#define Fa Wa +#define Fb Wb +#define G W +#define Ga Wa +#define Gb u +#define H W +#define Ha Wb +#define Hb Wb + +#ifdef ANSIPROT +extern double floor ( double ); +extern double fabs ( double ); +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double powi ( double, int ); +extern int signbit ( double ); +extern int isnan ( double ); +extern int isfinite ( double ); +const static double reduc ( double ); +#else +double floor(), fabs(), frexp(), ldexp(); +double polevl(), p1evl(), powi(); +int signbit(), isnan(), isfinite(); +const static double reduc(); +#endif +extern double MAXNUM; +#ifdef INFINITIES +extern double INFINITY; +#endif +#ifdef NANS +extern double NAN; +#endif +#ifdef MINUSZERO +extern double NEGZERO; +#endif + +double pow( x, y ) +double x, y; +{ +double w, z, W, Wa, Wb, ya, yb, u; +/* double F, Fa, Fb, G, Ga, Gb, H, Ha, Hb */ +double aw, ay, wy; +int e, i, nflg, iyflg, yoddint; + +if( y == 0.0 ) + return( 1.0 ); +#ifdef NANS +if( isnan(x) ) + return( x ); +if( isnan(y) ) + return( y ); +#endif +if( y == 1.0 ) + return( x ); + + +#ifdef INFINITIES +if( !isfinite(y) && (x == 1.0 || x == -1.0) ) + { + mtherr( "pow", DOMAIN ); +#ifdef NANS + return( NAN ); +#else + return( INFINITY ); +#endif + } +#endif + +if( x == 1.0 ) + return( 1.0 ); + +if( y >= MAXNUM ) + { +#ifdef INFINITIES + if( x > 1.0 ) + return( INFINITY ); +#else + if( x > 1.0 ) + return( MAXNUM ); +#endif + if( x > 0.0 && x < 1.0 ) + return( 0.0); + if( x < -1.0 ) + { +#ifdef INFINITIES + return( INFINITY ); +#else + return( MAXNUM ); +#endif + } + if( x > -1.0 && x < 0.0 ) + return( 0.0 ); + } +if( y <= -MAXNUM ) + { + if( x > 1.0 ) + return( 0.0 ); +#ifdef INFINITIES + if( x > 0.0 && x < 1.0 ) + return( INFINITY ); +#else + if( x > 0.0 && x < 1.0 ) + return( MAXNUM ); +#endif + if( x < -1.0 ) + return( 0.0 ); +#ifdef INFINITIES + if( x > -1.0 && x < 0.0 ) + return( INFINITY ); +#else + if( x > -1.0 && x < 0.0 ) + return( MAXNUM ); +#endif + } +if( x >= MAXNUM ) + { +#if INFINITIES + if( y > 0.0 ) + return( INFINITY ); +#else + if( y > 0.0 ) + return( MAXNUM ); +#endif + return(0.0); + } +/* Set iyflg to 1 if y is an integer. */ +iyflg = 0; +w = floor(y); +if( w == y ) + iyflg = 1; + +/* Test for odd integer y. */ +yoddint = 0; +if( iyflg ) + { + ya = fabs(y); + ya = floor(0.5 * ya); + yb = 0.5 * fabs(w); + if( ya != yb ) + yoddint = 1; + } + +if( x <= -MAXNUM ) + { + if( y > 0.0 ) + { +#ifdef INFINITIES + if( yoddint ) + return( -INFINITY ); + return( INFINITY ); +#else + if( yoddint ) + return( -MAXNUM ); + return( MAXNUM ); +#endif + } + if( y < 0.0 ) + { +#ifdef MINUSZERO + if( yoddint ) + return( NEGZERO ); +#endif + return( 0.0 ); + } + } + +nflg = 0; /* flag = 1 if x<0 raised to integer power */ +if( x <= 0.0 ) + { + if( x == 0.0 ) + { + if( y < 0.0 ) + { +#ifdef MINUSZERO + if( signbit(x) && yoddint ) + return( -INFINITY ); +#endif +#ifdef INFINITIES + return( INFINITY ); +#else + return( MAXNUM ); +#endif + } + if( y > 0.0 ) + { +#ifdef MINUSZERO + if( signbit(x) && yoddint ) + return( NEGZERO ); +#endif + return( 0.0 ); + } + return( 1.0 ); + } + else + { + if( iyflg == 0 ) + { /* noninteger power of negative number */ + mtherr( fname, DOMAIN ); +#ifdef NANS + return(NAN); +#else + return(0.0L); +#endif + } + nflg = 1; + } + } + +/* Integer power of an integer. */ + +if( iyflg ) + { + i = w; + w = floor(x); + if( (w == x) && (fabs(y) < 32768.0) ) + { + w = powi( x, (int) y ); + return( w ); + } + } + +if( nflg ) + x = fabs(x); + +/* For results close to 1, use a series expansion. */ +w = x - 1.0; +aw = fabs(w); +ay = fabs(y); +wy = w * y; +ya = fabs(wy); +if((aw <= 1.0e-3 && ay <= 1.0) + || (ya <= 1.0e-3 && ay >= 1.0)) + { + z = (((((w*(y-5.)/720. + 1./120.)*w*(y-4.) + 1./24.)*w*(y-3.) + + 1./6.)*w*(y-2.) + 0.5)*w*(y-1.) )*wy + wy + 1.; + goto done; + } +/* These are probably too much trouble. */ +#if 0 +w = y * log(x); +if (aw > 1.0e-3 && fabs(w) < 1.0e-3) + { + z = (((((( + w/7. + 1.)*w/6. + 1.)*w/5. + 1.)*w/4. + 1.)*w/3. + 1.)*w/2. + 1.)*w + 1.; + goto done; + } + +if(ya <= 1.0e-3 && aw <= 1.0e-4) + { + z = ((((( + wy*1./720. + + (-w*1./48. + 1./120.) )*wy + + ((w*17./144. - 1./12.)*w + 1./24.) )*wy + + (((-w*5./16. + 7./24.)*w - 1./4.)*w + 1./6.) )*wy + + ((((w*137./360. - 5./12.)*w + 11./24.)*w - 1./2.)*w + 1./2.) )*wy + + (((((-w*1./6. + 1./5.)*w - 1./4)*w + 1./3.)*w -1./2.)*w ) )*wy + + wy + 1.0; + goto done; + } +#endif + +/* separate significand from exponent */ +x = frexp( x, &e ); + +#if 0 +/* For debugging, check for gross overflow. */ +if( (e * y) > (MEXP + 1024) ) + goto overflow; +#endif + +/* Find significand of x in antilog table A[]. */ +i = 1; +if( x <= douba(9) ) + i = 9; +if( x <= douba(i+4) ) + i += 4; +if( x <= douba(i+2) ) + i += 2; +if( x >= douba(1) ) + i = -1; +i += 1; + + +/* Find (x - A[i])/A[i] + * in order to compute log(x/A[i]): + * + * log(x) = log( a x/a ) = log(a) + log(x/a) + * + * log(x/a) = log(1+v), v = x/a - 1 = (x-a)/a + */ +x -= douba(i); +x -= doubb(i/2); +x /= douba(i); + + +/* rational approximation for log(1+v): + * + * log(1+v) = v - v**2/2 + v**3 P(v) / Q(v) + */ +z = x*x; +w = x * ( z * polevl( x, P, 3 ) / p1evl( x, Q, 4 ) ); +w = w - ldexp( z, -1 ); /* w - 0.5 * z */ + +/* Convert to base 2 logarithm: + * multiply by log2(e) + */ +w = w + LOG2EA * w; +/* Note x was not yet added in + * to above rational approximation, + * so do it now, while multiplying + * by log2(e). + */ +z = w + LOG2EA * x; +z = z + x; + +/* Compute exponent term of the base 2 logarithm. */ +w = -i; +w = ldexp( w, -4 ); /* divide by 16 */ +w += e; +/* Now base 2 log of x is w + z. */ + +/* Multiply base 2 log by y, in extended precision. */ + +/* separate y into large part ya + * and small part yb less than 1/16 + */ +ya = reduc(y); +yb = y - ya; + + +F = z * y + w * yb; +Fa = reduc(F); +Fb = F - Fa; + +G = Fa + w * ya; +Ga = reduc(G); +Gb = G - Ga; + +H = Fb + Gb; +Ha = reduc(H); +w = ldexp( Ga+Ha, 4 ); + +/* Test the power of 2 for overflow */ +if( w > MEXP ) + { +#ifndef INFINITIES + mtherr( fname, OVERFLOW ); +#endif +#ifdef INFINITIES + if( nflg && yoddint ) + return( -INFINITY ); + return( INFINITY ); +#else + if( nflg && yoddint ) + return( -MAXNUM ); + return( MAXNUM ); +#endif + } + +if( w < (MNEXP - 1) ) + { +#ifndef DENORMAL + mtherr( fname, UNDERFLOW ); +#endif +#ifdef MINUSZERO + if( nflg && yoddint ) + return( NEGZERO ); +#endif + return( 0.0 ); + } + +e = w; +Hb = H - Ha; + +if( Hb > 0.0 ) + { + e += 1; + Hb -= 0.0625; + } + +/* Now the product y * log2(x) = Hb + e/16.0. + * + * Compute base 2 exponential of Hb, + * where -0.0625 <= Hb <= 0. + */ +z = Hb * polevl( Hb, R, 6 ); /* z = 2**Hb - 1 */ + +/* Express e/16 as an integer plus a negative number of 16ths. + * Find lookup table entry for the fractional power of 2. + */ +if( e < 0 ) + i = 0; +else + i = 1; +i = e/16 + i; +e = 16*i - e; +w = douba( e ); +z = w + w * z; /* 2**-e * ( 1 + (2**Hb-1) ) */ +z = ldexp( z, i ); /* multiply by integer power of 2 */ + +done: + +/* Negate if odd integer power of negative number */ +if( nflg && yoddint ) + { +#ifdef MINUSZERO + if( z == 0.0 ) + z = NEGZERO; + else +#endif + z = -z; + } +return( z ); +} + + +/* Find a multiple of 1/16 that is within 1/16 of x. */ +const static double reduc(x) +double x; +{ +double t; + +t = ldexp( x, 4 ); +t = floor( t ); +t = ldexp( t, -4 ); +return(t); +} diff --git a/components/external/espruino/libs/math/powi.c b/components/external/espruino/libs/math/powi.c new file mode 100644 index 0000000000..19fe7829f6 --- /dev/null +++ b/components/external/espruino/libs/math/powi.c @@ -0,0 +1,186 @@ +/* powi.c + * + * Real raised to integer power + * + * + * + * SYNOPSIS: + * + * double x, y, powi(); + * int n; + * + * y = powi( x, n ); + * + * + * + * DESCRIPTION: + * + * Returns argument x raised to the nth power. + * The routine efficiently decomposes n as a sum of powers of + * two. The desired power is a product of two-to-the-kth + * powers of x. Thus to compute the 32767 power of x requires + * 28 multiplications instead of 32767 multiplications. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic x domain n domain # trials peak rms + * DEC .04,26 -26,26 100000 2.7e-16 4.3e-17 + * IEEE .04,26 -26,26 50000 2.0e-15 3.8e-16 + * IEEE 1,2 -1022,1023 50000 8.6e-14 1.6e-14 + * + * Returns MAXNUM on overflow, zero on underflow. + * + */ + +/* powi.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" +#ifdef ANSIPROT +extern double log ( double ); +extern double frexp ( double, int * ); +extern int signbit ( double ); +#else +double log(), frexp(); +int signbit(); +#endif +extern double NEGZERO, INFINITY, MAXNUM, MAXLOG, MINLOG, LOGE2; + +double powi( x, nn ) +double x; +int nn; +{ +int n, e, sign, asign, lx; +double w, y, s; + +/* See pow.c for these tests. */ +if( x == 0.0 ) + { + if( nn == 0 ) + return( 1.0 ); + else if( nn < 0 ) + return( INFINITY ); + else + { + if( nn & 1 ) + return( x ); + else + return( 0.0 ); + } + } + +if( nn == 0 ) + return( 1.0 ); + +if( nn == -1 ) + return( 1.0/x ); + +if( x < 0.0 ) + { + asign = -1; + x = -x; + } +else + asign = 0; + + +if( nn < 0 ) + { + sign = -1; + n = -nn; + } +else + { + sign = 1; + n = nn; + } + +/* Even power will be positive. */ +if( (n & 1) == 0 ) + asign = 0; + +/* Overflow detection */ + +/* Calculate approximate logarithm of answer */ +s = frexp( x, &lx ); +e = (lx - 1)*n; +if( (e == 0) || (e > 64) || (e < -64) ) + { + s = (s - 7.0710678118654752e-1) / (s + 7.0710678118654752e-1); + s = (2.9142135623730950 * s - 0.5 + lx) * nn * LOGE2; + } +else + { + s = LOGE2 * e; + } + +if( s > MAXLOG ) + { + mtherr( "powi", OVERFLOW ); + y = INFINITY; + goto done; + } + +#if DENORMAL +if( s < MINLOG ) + { + y = 0.0; + goto done; + } + +/* Handle tiny denormal answer, but with less accuracy + * since roundoff error in 1.0/x will be amplified. + * The precise demarcation should be the gradual underflow threshold. + */ +if( (s < (-MAXLOG+2.0)) && (sign < 0) ) + { + x = 1.0/x; + sign = -sign; + } +#else +/* do not produce denormal answer */ +if( s < -MAXLOG ) + return(0.0); +#endif + + +/* First bit of the power */ +if( n & 1 ) + y = x; + +else + y = 1.0; + +w = x; +n >>= 1; +while( n ) + { + w = w * w; /* arg to the 2-to-the-kth power */ + if( n & 1 ) /* if that bit is set, then include in product */ + y *= w; + n >>= 1; + } + +if( sign < 0 ) + y = 1.0/y; + +done: + +if( asign ) + { + /* odd power of negative number */ + if( y == 0.0 ) + y = NEGZERO; + else + y = -y; + } +return(y); +} diff --git a/components/external/espruino/libs/math/protos.h b/components/external/espruino/libs/math/protos.h new file mode 100644 index 0000000000..11a9c0d52f --- /dev/null +++ b/components/external/espruino/libs/math/protos.h @@ -0,0 +1,184 @@ +/* + * This file was automatically generated by version 1.7 of cextract. + * Manual editing not recommended. + * + * Created: Fri Mar 31 19:17:33 1995 + */ +extern double acosh ( double x ); +extern int airy ( double, double *, double *, double *, double * ); +extern double asin ( double ); +extern double acos ( double ); +extern double asinh ( double x ); +extern double atan ( double ); +extern double atan2 ( double y, double x ); +extern double atanh ( double ); +extern double bdtrc ( int k, int n, double p ); +extern double bdtr ( int k, int n, double p ); +extern double bdtri ( int k, int n, double y ); +extern double beta ( double a, double b ); +extern double lbeta ( double a, double b ); +extern double btdtr ( double a, double b, double x ); +extern double cbrt ( double ); +extern double chbevl ( double, void *, int ); +extern double chdtrc ( double df, double x ); +extern double chdtr ( double df, double x ); +extern double chdtri ( double df, double y ); +//extern void clog ( cmplx *z, cmplx *w ); +//extern void cexp ( cmplx *z, cmplx *w ); +//extern void csin ( cmplx *z, cmplx *w ); +//extern void ccos ( cmplx *z, cmplx *w ); +//extern void ctan ( cmplx *z, cmplx *w ); +extern void ccot ( cmplx *z, cmplx *w ); +//extern void casin ( cmplx *z, cmplx *w ); +//extern void cacos ( cmplx *z, cmplx *w ); +//extern void catan ( cmplx *z, cmplx *w ); +extern void cadd ( cmplx *a, cmplx *b, cmplx *c ); +extern void csub ( cmplx *a, cmplx *b, cmplx *c ); +extern void cmul ( cmplx *a, cmplx *b, cmplx *c ); +extern void cdiv ( cmplx *a, cmplx *b, cmplx *c ); +extern void cmov ( void *a, void *b ); +extern void cneg ( cmplx *a ); +//extern double cabs ( cmplx *z ); +//extern void csqrt ( cmplx *z, cmplx *w ); +extern double hypot ( double, double ); +extern double cosh ( double ); +extern double dawsn ( double xx ); +extern void eigens ( double A[], double RR[], double E[], int N ); +extern double ellie ( double, double ); +extern double ellik ( double, double ); +extern double ellpe ( double ); +extern int ellpj ( double u, double m, double *sn, double *cn, double *dn, double *ph ); +extern double ellpk ( double ); +extern double exp10 ( double ); +extern double exp1m ( double ); +extern double exp2 ( double ); +extern double expn ( int n, double x ); +extern double fac ( int i ); +extern double fdtrc ( int ia, int ib, double x ); +extern double fdtr ( int ia, int ib, double x ); +extern double fdtri ( int ia, int ib, double y ); +extern int fftr ( double x[], int m0, double sine[] ); +extern double ceil ( double x ); +extern double fabs ( double ); +extern double floor ( double ); +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +extern int signbit ( double ); +extern int isnan ( double ); +extern int isfinite ( double ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double exp ( double ); +extern double log ( double ); +extern double sin ( double ); +extern double cos ( double ); +extern double sqrt ( double ); +extern int fresnl ( double xxa, double *ssa, double *cca ); +extern double gamma ( double ); +extern double lgam ( double ); +extern double gdtr ( double a, double b, double x ); +extern double gdtrc ( double a, double b, double x ); +extern int gels ( double A[], double R[], int M, double EPS, double AUX[] ); +extern double hyp2f1 ( double a, double b, double c, double x ); +extern double hyperg ( double, double, double ); +extern double hyp2f0 ( double a, double b, double x, int type, double *err ); +extern double i0 ( double ); +extern double i0e ( double x ); +extern double i1 ( double ); +extern double i1e ( double x ); +extern double igamc ( double, double ); +extern double igam ( double, double ); +extern double igami ( double, double ); +extern double incbet ( double, double, double ); +extern double incbi ( double, double, double ); +extern double iv ( double v, double x ); +extern double j0 ( double ); +extern double y0 ( double ); +extern double j1 ( double ); +extern double y1 ( double ); +extern double jn ( int n, double x ); +extern double jv ( double, double ); +extern double k0 ( double x ); +extern double k0e ( double x ); +extern double k1 ( double x ); +extern double k1e ( double x ); +extern double kn ( int nn, double x ); +extern int levnsn ( int n, double r[], double a[], double e[], double refl[] ); +extern double log10 ( double ); +extern double log2 ( double ); +extern long lrand ( void ); +extern long lsqrt ( long x ); +extern int minv ( double A[], double X[], int n, double B[], int IPS[] ); +extern int mmmpy ( int r, int c, double *A, double *B, double *Y ); +extern int mtherr ( char *name, int code ); +extern int mtransp ( int n, double *A, double *T ); +extern int mvmpy ( int r, int c, double *A, double *V, double *Y ); +extern double nbdtrc ( int k, int n, double p ); +extern double nbdtr ( int k, int n, double p ); +extern double nbdtri ( int k, int n, double p ); +extern double ndtr ( double a ); +extern double erfc ( double ); +extern double erf ( double ); +extern double ndtri ( double ); +extern double pdtrc ( int k, double m ); +extern double pdtr ( int k, double m ); +extern double pdtri ( int k, double y ); +extern double pow ( double, double ); +extern double powi ( double, int ); +extern double psi ( double ); +extern void revers ( double y[], double x[], int n ); +extern double rgamma ( double x ); +extern double round ( double ); +extern int sprec ( void ); +extern int dprec ( void ); +extern int ldprec ( void ); +extern int shichi ( double x, double *si, double *ci ); +extern int sici ( double x, double *si, double *ci ); +extern double simpsn ( double f[], double delta ); +extern int simq ( double A[], double B[], double X[], int n, int flag, int IPS[] ); +extern double radian ( double d, double m, double s ); +/* +extern int sincos ( double x, double *s, double *c, int flg ); +*/ +extern double sindg ( double x ); +extern double cosdg ( double x ); +extern double sinh ( double ); +extern double spence ( double ); +extern double stdtr ( int k, double t ); +extern double stdtri ( int k, double p ); +extern double onef2 ( double a, double b, double c, double x, double *err ); +extern double threef0 ( double a, double b, double c, double x, double *err ); +extern double struve ( double v, double x ); +extern double tan ( double ); +extern double cot ( double ); +extern double tandg ( double x ); +extern double cotdg ( double x ); +extern double tanh ( double ); +extern double log1p ( double ); +extern double exmp1 ( double ); +extern double cosm1 ( double x ); +extern double yn ( int, double ); +extern double zeta ( double x, double q ); +extern double zetac ( double ); +extern int drand ( double *a ); +double smirnov ( int, double ); +double smirnovi ( int, double ); +double kolmogorov ( double ); +double kolmogi ( double ); + +/* polyn.c */ +extern void polini ( int maxdeg ); +extern void polprt ( double a[], int na, int d ); +extern void polclr ( double *a, int n ); +extern void polmov ( double *a, int na, double *b ); +extern void polmul ( double a[], int na, double b[], int nb, double c[] ); +extern void poladd ( double a[], int na, double b[], int nb, double c[] ); +extern void polsub ( double a[], int na, double b[], int nb, double c[] ); +extern int poldiv ( double a[], int na, double b[], int nb, double c[] ); +extern void polsbt ( double a[], int na, double b[], int nb, double c[] ); +extern double poleva ( double a[], int na, double x ); +/* polmisc.c */ +extern void polatn ( double num[], double den[], double ans[], int nn ); +extern void polsqt ( double pol[], double ans[], int nn ); +extern void polsin ( double x[], double y[], int nn ); +extern void polcos ( double x[], double y[], int nn ); diff --git a/components/external/espruino/libs/math/round.c b/components/external/espruino/libs/math/round.c new file mode 100644 index 0000000000..9197a2222c --- /dev/null +++ b/components/external/espruino/libs/math/round.c @@ -0,0 +1,70 @@ +/* round.c + * + * Round double to nearest or even integer valued double + * + * + * + * SYNOPSIS: + * + * double x, y, round(); + * + * y = round(x); + * + * + * + * DESCRIPTION: + * + * Returns the nearest integer to x as a double precision + * floating point result. If x ends in 0.5 exactly, the + * nearest even integer is chosen. + * + * + * + * ACCURACY: + * + * If x is greater than 1/(2*MACHEP), its closest machine + * representation is already an integer, so rounding does + * not change it. + */ + +/* +Cephes Math Library Release 2.1: January, 1989 +Copyright 1984, 1987, 1989 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ +#include "mconf.h" +#ifdef ANSIPROT +double floor ( double ); +#else +double floor(); +#endif + +double round(x) +double x; +{ +double y, r; + +/* Largest integer <= x */ +y = floor(x); + +/* Fractional part */ +r = x - y; + +/* Round up to nearest. */ +if( r > 0.5 ) + goto rndup; + +/* Round to even */ +if( r == 0.5 ) + { + r = y - 2.0 * floor( 0.5 * y ); + if( r == 1.0 ) + { +rndup: + y += 1.0; + } + } + +/* Else round down. */ +return(y); +} diff --git a/components/external/espruino/libs/math/setprbor.asm b/components/external/espruino/libs/math/setprbor.asm new file mode 100644 index 0000000000..8aaf1f6d3f --- /dev/null +++ b/components/external/espruino/libs/math/setprbor.asm @@ -0,0 +1,207 @@ +; +; Borland assembler header +; +; Microsoft MASM subroutines for setting coprocessor precision +; +.286 +.287 +PREC_TEXT SEGMENT BYTE PUBLIC 'CODE' +PREC_TEXT ENDS +DGROUP group _DATA,_BSS + assume cs:PREC_TEXT,ds:DGROUP +_DATA segment word public 'DATA' +d@ label byte +d@w label word +_DATA ends +_BSS segment word public 'BSS' +b@ label byte +b@w label word +_BSS ends + +; exception masks (1 = masked) +; 1 invalid operation +; 2 denormalized operand +; 4 zero divide +; 8 overflow +; 10 underflow +; 20 precision + +_DATA SEGMENT + +; double precision setting +;;ctlwrd dw 01230h ; note this traps on denormal operands! +;;ctld dw 0133fh ; this doesn't trap +ctld dw 01230h + +; single precision +ctls dw 01030h + +; long double precision +ctlld dw 01320h + +_DATA ENDS + +PREC_TEXT segment byte public 'CODE' + assume cs:PREC_TEXT,ds:DGROUP +; Set coprocessor to single precision float + PUBLIC _sprec +_sprec PROC FAR + fclex + fwait + finit + fwait + fldcw word ptr ctls + fwait + ret +_sprec ENDP + +; set coprocessor to long double precision + PUBLIC _ldprec +_ldprec PROC far + fclex + fwait + finit + fwait + fldcw word ptr ctlld + fwait + ret +_ldprec ENDP + +; set coprocessor to double precision + PUBLIC _dprec +_dprec PROC far + fclex + fwait + finit + fwait + fldcw word ptr ctld + fwait + ret +_dprec ENDP + + +; get a double promoted to long double size +; getld( &doub, &ldoub ); + PUBLIC _getld +_getld PROC far + push bp + mov bp,sp + push bx + mov bx, word ptr [bp+4] +; fld st(0) + fld qword ptr [bx] + mov bx, word ptr [bp+6] + fstp tbyte ptr [bx] + mov bx, word ptr [bp+4] + fld qword ptr [bx] + mov bx, word ptr [bp+8] + fstp qword ptr [bx] + pop bx + pop bp + ret +_getld ENDP + + PUBLIC _getprec +_getprec PROC far + push bp + mov bp,sp + sub sp,4 + fstcw [bp-4] + fwait + mov ax,[bp-4] + add sp,4 + pop bp + ret +_getprec ENDP + + + PUBLIC _fpclear +_fpclear PROC far + push bp + mov bp,sp + fnclex + fwait + pop bp + ret +_fpclear ENDP + + + PUBLIC _noexcept +_noexcept PROC far + push bp + mov bp,sp + push ax + sub sp,4 + fnclex + fwait + fstcw [bp-4] + fwait + mov ax,[bp-4] + and ax,0FFC0h + or ax,003fh + mov [bp-4],ax + fldcw [bp-4] + add sp,4 + pop ax + pop bp + ret +_noexcept ENDP + +; single precision square root +; assumes coprocessor precision already set up +; return value in static __fac + PUBLIC _sqrtf +_sqrtf PROC FAR + push bp + mov bp,sp + fld DWORD PTR [bp+6] + fsqrt + fwait + mov sp,bp + pop bp + ret +_sqrtf ENDP + +; double precision square root +; assumes coprocessor precision already set up +; return value in static __fac + PUBLIC _sqrt +_sqrt PROC FAR + push bp + mov bp,sp + fld QWORD PTR [bp+6] + fsqrt + fwait + mov sp,bp + pop bp + ret +_sqrt ENDP + + +; long double precision square root +; assumes coprocessor precision already set up +; return value in fp register + PUBLIC _sqrtl +_sqrtl PROC FAR + push bp + mov bp,sp + fld tbyte ptr [bp+6] + fsqrt + fwait + mov sp,bp + pop bp + ret +_sqrtl ENDP + + +PREC_TEXT ends +_DATA segment word public 'DATA' +s@ label byte +_DATA ends +PREC_TEXT segment byte public 'CODE' +PREC_TEXT ends +_s@ equ s@ + public _sprec + public _dprec + public _ldprec + end diff --git a/components/external/espruino/libs/math/setprec.387 b/components/external/espruino/libs/math/setprec.387 new file mode 100644 index 0000000000..f64bf3d2f4 --- /dev/null +++ b/components/external/espruino/libs/math/setprec.387 @@ -0,0 +1,87 @@ +/* Set 80387 floating point hardware rounding precision */ + + .file "setprec.387" +.text + .align 2 + +.globl _sprec +_sprec: + pushl %ebp + movl %esp,%ebp + pushl %eax + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + andl $0xfcff,%eax + movl %eax,(%esp) + fldcw (%esp) + popl %eax + popl %eax + leave + ret + + .align 2 + +.globl _dprec +_dprec: + pushl %ebp + movl %esp,%ebp + pushl %eax + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax +/* andl $0xfcff,%eax */ +/* exception on overflow */ + andl $0xfcf7,%eax + orl $0x200,%eax + movl %eax,(%esp) + fldcw (%esp) + popl %eax + popl %eax + leave + ret + + .align 2 + +.globl _ldprec +_ldprec: + pushl %ebp + movl %esp,%ebp + pushl %eax + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + orl $0x300,%eax + movl %eax,(%esp) + fldcw (%esp) + popl %eax + popl %eax + leave + ret + + +.globl _getprec +_getprec: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + leave + ret + +.globl _setfpu +_setfpu: + pushl %ebp + movl %esp,%ebp + movl 8(%ebp),%eax + pushl %eax + fldcw (%esp) + fwait + movl %ebp,%esp + popl %ebp + ret diff --git a/components/external/espruino/libs/math/setprec.688 b/components/external/espruino/libs/math/setprec.688 new file mode 100644 index 0000000000..104c5b7b16 --- /dev/null +++ b/components/external/espruino/libs/math/setprec.688 @@ -0,0 +1,35 @@ +/* Set 68881/2 floating point rounding precision */ +/* Reference: MC68881/MC68882 Floating-Point Coprocessor */ +/* User's Manual, Motorola, Prentice-Hall, 1987 (First Edition) */ +/* Pages 1-14, 2-3, 4-68. */ +/* FPcr code $80 sets the 68882 coprocessor to */ +/* rounding precision = 53 bits */ +/* rounding mode = nearest or even */ +/* all exceptions (bits 8-15) disabled */ +/* The instruction is */ +/* FMOVE.L #$80,Fcr */ +/* if the assembler will understand it. */ + + .align 2 +.text + +/* set to single precision */ +.globl _sprec +_sprec + .word 0xf23c,0x9000,0x0000,0x0040 + rts + +/* set to double precision */ +.globl _dprec + +_dprec: + .word 0xf23c,0x9000,0x0000,0x0080 + rts + +/* set to extended (long double) precision */ +.globl _ldprec + +_ldprec: + .word 0xf23c,0x9000,0x0000,0x0000 + rts + diff --git a/components/external/espruino/libs/math/setprec.87 b/components/external/espruino/libs/math/setprec.87 new file mode 100644 index 0000000000..e9e2b081a1 --- /dev/null +++ b/components/external/espruino/libs/math/setprec.87 @@ -0,0 +1,208 @@ +; +; Microsoft MASM subroutines for setting coprocessor precision +; +.286 +.287 +_TEXT SEGMENT BYTE PUBLIC 'CODE' +_TEXT ENDS +CONST SEGMENT WORD PUBLIC 'CONST' +CONST ENDS +_BSS SEGMENT WORD PUBLIC 'BSS' +_BSS ENDS +_DATA SEGMENT WORD PUBLIC 'DATA' +_DATA ENDS +DGROUP GROUP CONST, _BSS, _DATA + ASSUME CS: _TEXT, DS: DGROUP, SS: DGROUP, ES: DGROUP +EXTRN __fac:QWORD + +_BSS SEGMENT +EXTRN __fltused:NEAR +_BSS ENDS + + +; exception masks (1 = masked) +; 1 invalid operation +; 2 denormalized operand +; 4 zero divide +; 8 overflow +; 10 underflow +; 20 precision + +_DATA SEGMENT + +; double precision setting +;;ctlwrd dw 01230h ; note this traps on denormal operands! +;;ctld dw 0133fh ; this doesn't trap +ctld dw 01230h + +; single precision +ctls dw 01030h + +; long double precision +ctlld dw 01320h + +_DATA ENDS + + ASSUME CS: _TEXT + +_TEXT SEGMENT +; Set coprocessor to single precision float + PUBLIC _sprec +_sprec PROC NEAR + fclex + fwait + finit + fwait + fldcw word ptr ctls + fwait + ret +_sprec ENDP + +; set coprocessor to long double precision + PUBLIC _ldprec +_ldprec PROC NEAR + fclex + fwait + finit + fwait + fldcw word ptr ctlld + fwait + ret +_ldprec ENDP + +; set coprocessor to double precision + PUBLIC _dprec +_dprec PROC NEAR + fclex + fwait + finit + fwait + fldcw word ptr ctld + fwait + ret +_dprec ENDP + + +; get a double promoted to long double size +; getld( &doub, &ldoub ); + PUBLIC _getld +_getld PROC NEAR + push bp + mov bp,sp + push bx + mov bx, word ptr [bp+4] +; fld st(0) + fld qword ptr [bx] + mov bx, word ptr [bp+6] + fstp tbyte ptr [bx] + mov bx, word ptr [bp+4] + fld qword ptr [bx] + mov bx, word ptr [bp+8] + fstp qword ptr [bx] + pop bx + pop bp + ret +_getld ENDP + + PUBLIC _getprec +_getprec PROC NEAR + push bp + mov bp,sp + sub sp,4 + fstcw [bp-4] + fwait + mov ax,[bp-4] + add sp,4 + pop bp + ret +_getprec ENDP + + + PUBLIC _fpclear +_fpclear PROC NEAR + push bp + mov bp,sp + fnclex + fwait + pop bp + ret +_fpclear ENDP + + + PUBLIC _noexcept +_noexcept PROC NEAR + push bp + mov bp,sp + push ax + sub sp,4 + fnclex + fwait + fstcw [bp-4] + fwait + mov ax,[bp-4] + and ax,0FFC0h + or ax,003fh + mov [bp-4],ax + fldcw [bp-4] + add sp,4 + pop ax + pop bp + ret +_noexcept ENDP + +;; single precision square root +;; assumes coprocessor precision already set up +;; return value in static __fac +; PUBLIC _sqrtf +;_sqrtf PROC NEAR +; push bp +; mov bp,sp +; fld DWORD PTR [bp+4] +; fsqrt +; fwait +; fstp DWORD PTR __fac +; mov ax,OFFSET __fac +; mov sp,bp +; pop bp +; ret +;_sqrtf ENDP +; +; +;; double precision square root +;; assumes coprocessor precision already set up +;; return value in static __fac +; PUBLIC _sqrt +;_sqrt PROC NEAR +; push bp +; mov bp,sp +; fld QWORD PTR [bp+4] +; fsqrt +; fwait +; fstp QWORD PTR __fac +; mov ax,OFFSET __fac +; mov sp,bp +; pop bp +; ret +;_sqrt ENDP +; +; +;; long double precision square root +;; assumes coprocessor precision already set up +;; return value in fp register +; PUBLIC _sqrtl +;_sqrtl PROC NEAR +; push bp +; mov bp,sp +; fld tbyte ptr [bp+4] +; fsqrt +; fwait +; mov sp,bp +; pop bp +; ret +;_sqrtl ENDP +; + +_TEXT ENDS +END + + diff --git a/components/external/espruino/libs/math/setprec.c b/components/external/espruino/libs/math/setprec.c new file mode 100644 index 0000000000..a5222ae733 --- /dev/null +++ b/components/external/espruino/libs/math/setprec.c @@ -0,0 +1,10 @@ +/* Null stubs for coprocessor precision settings */ + +int +sprec() {return 0; } + +int +dprec() {return 0; } + +int +ldprec() {return 0; } diff --git a/components/external/espruino/libs/math/setprelf.387 b/components/external/espruino/libs/math/setprelf.387 new file mode 100644 index 0000000000..e0492643fb --- /dev/null +++ b/components/external/espruino/libs/math/setprelf.387 @@ -0,0 +1,83 @@ +/* Set 80387 floating point hardware rounding precision */ + + .file "setprec.387" + .version "01.01" +.text + .align 16 + +.globl sprec +sprec: + pushl %ebp + movl %esp,%ebp + pushl %eax + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + andl $0xfcff,%eax + movl %eax,(%esp) + fldcw (%esp) + popl %eax + popl %eax + leave + ret +.Lfe1: + .size sprec,.Lfe1-sprec + .align 16 + +.globl dprec +dprec: + pushl %ebp + movl %esp,%ebp + pushl %eax + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + andl $0xfcff,%eax +/* trap on overflow */ +/* andl $0xfcf7,%eax */ + orl $0x200,%eax + movl %eax,(%esp) + fldcw (%esp) + popl %eax + popl %eax + leave + ret +.Lfe2: + .size dprec,.Lfe2-dprec + .align 16 + +.globl ldprec +ldprec: + pushl %ebp + movl %esp,%ebp + pushl %eax + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + orl $0x300,%eax + movl %eax,(%esp) + fldcw (%esp) + popl %eax + popl %eax + leave + ret +.Lfe3: + .size ldprec,.Lfe3-ldprec + + .align 16 +.globl getprec +getprec: + pushl %ebp + movl %esp,%ebp + subl $4,%esp + fstcw (%esp) + fwait + movl (%esp),%eax + leave + ret +.Lfe4: + .size getprec,.Lfe4-getprec + diff --git a/components/external/espruino/libs/math/sin.c b/components/external/espruino/libs/math/sin.c new file mode 100644 index 0000000000..014f75f31d --- /dev/null +++ b/components/external/espruino/libs/math/sin.c @@ -0,0 +1,387 @@ +/* sin.c + * + * Circular sine + * + * + * + * SYNOPSIS: + * + * double x, y, sin(); + * + * y = sin( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of pi/4. The reduction + * error is nearly eliminated by contriving an extended precision + * modular arithmetic. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the sine is approximated by + * x + x**3 P(x**2). + * Between pi/4 and pi/2 the cosine is represented as + * 1 - x**2 Q(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC 0, 10 150000 3.0e-17 7.8e-18 + * IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 + * + * ERROR MESSAGES: + * + * message condition value returned + * sin total loss x > 1.073741824e9 0.0 + * + * Partial loss of accuracy begins to occur at x = 2**30 + * = 1.074e9. The loss is not gradual, but jumps suddenly to + * about 1 part in 10e7. Results may be meaningless for + * x > 2**49 = 5.6e14. The routine as implemented flags a + * TLOSS error for x > 2**30 and returns 0.0. + */ + /* cos.c + * + * Circular cosine + * + * + * + * SYNOPSIS: + * + * double x, y, cos(); + * + * y = cos( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of pi/4. The reduction + * error is nearly eliminated by contriving an extended precision + * modular arithmetic. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the cosine is approximated by + * 1 - x**2 Q(x**2). + * Between pi/4 and pi/2 the sine is represented as + * x + x**3 P(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE -1.07e9,+1.07e9 130000 2.1e-16 5.4e-17 + * DEC 0,+1.07e9 17000 3.0e-17 7.2e-18 + */ + +/* sin.c */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1985, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +const static double sincof[] = { + 1.58962301576546568060E-10, +-2.50507477628578072866E-8, + 2.75573136213857245213E-6, +-1.98412698295895385996E-4, + 8.33333333332211858878E-3, +-1.66666666666666307295E-1, +}; +const static double coscof[6] = { +-1.13585365213876817300E-11, + 2.08757008419747316778E-9, +-2.75573141792967388112E-7, + 2.48015872888517045348E-5, +-1.38888888888730564116E-3, + 4.16666666666665929218E-2, +}; +const static double DP1 = 7.85398125648498535156E-1; +const static double DP2 = 3.77489470793079817668E-8; +const static double DP3 = 2.69515142907905952645E-15; +/* const static double lossth = 1.073741824e9; */ +#endif + +#ifdef DEC +static unsigned short sincof[] = { +0030056,0143750,0177214,0163153, +0131727,0027455,0044510,0175352, +0033470,0167432,0131752,0042414, +0135120,0006400,0146776,0174027, +0036410,0104210,0104207,0137202, +0137452,0125252,0125252,0125103, +}; +static unsigned short coscof[24] = { +0127107,0151115,0002060,0152325, +0031017,0072353,0155161,0174053, +0132623,0171173,0172542,0057056, +0034320,0006400,0147102,0023652, +0135666,0005540,0133012,0076213, +0037052,0125252,0125252,0125126, +}; +/* 7.853981629014015197753906250000E-1 */ +static unsigned short P1[] = {0040111,0007732,0120000,0000000,}; +/* 4.960467869796758577649598009884E-10 */ +static unsigned short P2[] = {0030410,0055060,0100000,0000000,}; +/* 2.860594363054915898381331279295E-18 */ +static unsigned short P3[] = {0021523,0011431,0105056,0001560,}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +#endif + +#ifdef IBMPC +static unsigned short sincof[] = { +0x9ccd,0x1fd1,0xd8fd,0x3de5, +0x1f5d,0xa929,0xe5e5,0xbe5a, +0x48a1,0x567d,0x1de3,0x3ec7, +0xdf03,0x19bf,0x01a0,0xbf2a, +0xf7d0,0x1110,0x1111,0x3f81, +0x5548,0x5555,0x5555,0xbfc5, +}; +static unsigned short coscof[24] = { +0x1a9b,0xa086,0xfa49,0xbda8, +0x3f05,0x7b4e,0xee9d,0x3e21, +0x4bc6,0x7eac,0x7e4f,0xbe92, +0x44f5,0x19c8,0x01a0,0x3efa, +0x4f91,0x16c1,0xc16c,0xbf56, +0x554b,0x5555,0x5555,0x3fa5, +}; +/* + 7.85398125648498535156E-1, + 3.77489470793079817668E-8, + 2.69515142907905952645E-15, +*/ +static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9}; +static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64}; +static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +#endif + +#ifdef MIEEE +static unsigned short sincof[] = { +0x3de5,0xd8fd,0x1fd1,0x9ccd, +0xbe5a,0xe5e5,0xa929,0x1f5d, +0x3ec7,0x1de3,0x567d,0x48a1, +0xbf2a,0x01a0,0x19bf,0xdf03, +0x3f81,0x1111,0x1110,0xf7d0, +0xbfc5,0x5555,0x5555,0x5548, +}; +static unsigned short coscof[24] = { +0xbda8,0xfa49,0xa086,0x1a9b, +0x3e21,0xee9d,0x7b4e,0x3f05, +0xbe92,0x7e4f,0x7eac,0x4bc6, +0x3efa,0x01a0,0x19c8,0x44f5, +0xbf56,0xc16c,0x16c1,0x4f91, +0x3fa5,0x5555,0x5555,0x554b, +}; +static unsigned short P1[] = {0x3fe9,0x21fb,0x4000,0x0000}; +static unsigned short P2[] = {0x3e64,0x442d,0x0000,0x0000}; +static unsigned short P3[] = {0x3ce8,0x4698,0x98cc,0x5170}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double floor ( double ); +extern double ldexp ( double, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +#else +double polevl(), floor(), ldexp(); +int isnan(), isfinite(); +#endif +extern double PIO4; +const static double lossth = 1.073741824e9; +#ifdef NANS +extern double NAN; +#endif +#ifdef INFINITIES +extern double INFINITY; +#endif + + +double sin(x) +double x; +{ +double y, z, zz; +int j, sign; + +#ifdef MINUSZERO +if( x == 0.0 ) + return(x); +#endif +#ifdef NANS +if( isnan(x) ) + return(x); +if( !isfinite(x) ) + { + mtherr( "sin", DOMAIN ); + return(NAN); + } +#endif +/* make argument positive but save the sign */ +sign = 1; +if( x < 0 ) + { + x = -x; + sign = -1; + } + +if( x > lossth ) + { + mtherr( "sin", TLOSS ); + return(0.0); + } + +y = floor( x/PIO4 ); /* integer part of x/PIO4 */ + +/* strip high bits of integer part to prevent integer overflow */ +z = ldexp( y, -4 ); +z = floor(z); /* integer part of y/8 */ +z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */ + +j = z; /* convert to integer for tests on the phase angle */ +/* map zeros to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } +j = j & 07; /* octant modulo 360 degrees */ +/* reflect in x axis */ +if( j > 3) + { + sign = -sign; + j -= 4; + } + +/* Extended precision modular arithmetic */ +z = ((x - y * DP1) - y * DP2) - y * DP3; + +zz = z * z; + +if( (j==1) || (j==2) ) + { + y = 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 ); + } +else + { +/* y = z + z * (zz * polevl( zz, sincof, 5 ));*/ + y = z + z * z * z * polevl( zz, sincof, 5 ); + } + +if(sign < 0) + y = -y; + +return(y); +} + + + + + +double cos(x) +double x; +{ +double y, z, zz; +long i; +int j, sign; + +#ifdef NANS +if( isnan(x) ) + return(x); +if( !isfinite(x) ) + { + mtherr( "cos", DOMAIN ); + return(NAN); + } +#endif + +/* make argument positive */ +sign = 1; +if( x < 0 ) + x = -x; + +if( x > lossth ) + { + mtherr( "cos", TLOSS ); + return(0.0); + } + +y = floor( x/PIO4 ); +z = ldexp( y, -4 ); +z = floor(z); /* integer part of y/8 */ +z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */ + +/* integer and fractional part modulo one octant */ +i = z; +if( i & 1 ) /* map zeros to origin */ + { + i += 1; + y += 1.0; + } +j = i & 07; +if( j > 3) + { + j -=4; + sign = -sign; + } + +if( j > 1 ) + sign = -sign; + +/* Extended precision modular arithmetic */ +z = ((x - y * DP1) - y * DP2) - y * DP3; + +zz = z * z; + +if( (j==1) || (j==2) ) + { +/* y = z + z * (zz * polevl( zz, sincof, 5 ));*/ + y = z + z * z * z * polevl( zz, sincof, 5 ); + } +else + { + y = 1.0 - ldexp(zz,-1) + zz * zz * polevl( zz, coscof, 5 ); + } + +if(sign < 0) + y = -y; + +return(y); +} + + + + + +/* Degrees, minutes, seconds to radians: */ + +/* 1 arc second, in radians = 4.8481368110953599358991410e-5 */ +#ifdef DEC +static unsigned short P648[] = {034513,054170,0176773,0116043,}; +#define P64800 *(double *)P648 +#else +const static double P64800 = 4.8481368110953599358991410e-5; +#endif + +double radian(d,m,s) +double d,m,s; +{ + +return( ((d*60.0 + m)*60.0 + s)*P64800 ); +} diff --git a/components/external/espruino/libs/math/sincos.c b/components/external/espruino/libs/math/sincos.c new file mode 100644 index 0000000000..a50f7421dc --- /dev/null +++ b/components/external/espruino/libs/math/sincos.c @@ -0,0 +1,358 @@ +/* sincos.c + * + * Circular sine and cosine of argument in degrees + * Table lookup and interpolation algorithm + * + * + * + * SYNOPSIS: + * + * double x, sine, cosine, flg, sincos(); + * + * sincos( x, &sine, &cosine, flg ); + * + * + * + * DESCRIPTION: + * + * Returns both the sine and the cosine of the argument x. + * Several different compile time options and minimax + * approximations are supplied to permit tailoring the + * tradeoff between computation speed and accuracy. + * + * Since range reduction is time consuming, the reduction + * of x modulo 360 degrees is also made optional. + * + * sin(i) is internally tabulated for 0 <= i <= 90 degrees. + * Approximation polynomials, ranging from linear interpolation + * to cubics in (x-i)**2, compute the sine and cosine + * of the residual x-i which is between -0.5 and +0.5 degree. + * In the case of the high accuracy options, the residual + * and the tabulated values are combined using the trigonometry + * formulas for sin(A+B) and cos(A+B). + * + * Compile time options are supplied for 5, 11, or 17 decimal + * relative accuracy (ACC5, ACC11, ACC17 respectively). + * A subroutine flag argument "flg" chooses betwen this + * accuracy and table lookup only (peak absolute error + * = 0.0087). + * + * If the argument flg = 1, then the tabulated value is + * returned for the nearest whole number of degrees. The + * approximation polynomials are not computed. At + * x = 0.5 deg, the absolute error is then sin(0.5) = 0.0087. + * + * An intermediate speed and precision can be obtained using + * the compile time option LINTERP and flg = 1. This yields + * a linear interpolation using a slope estimated from the sine + * or cosine at the nearest integer argument. The peak absolute + * error with this option is 3.8e-5. Relative error at small + * angles is about 1e-5. + * + * If flg = 0, then the approximation polynomials are computed + * and applied. + * + * + * + * SPEED: + * + * Relative speed comparisons follow for 6MHz IBM AT clone + * and Microsoft C version 4.0. These figures include + * software overhead of do loop and function calls. + * Since system hardware and software vary widely, the + * numbers should be taken as representative only. + * + * flg=0 flg=0 flg=1 flg=1 + * ACC11 ACC5 LINTERP Lookup only + * In-line 8087 (/FPi) + * sin(), cos() 1.0 1.0 1.0 1.0 + * + * In-line 8087 (/FPi) + * sincos() 1.1 1.4 1.9 3.0 + * + * Software (/FPa) + * sin(), cos() 0.19 0.19 0.19 0.19 + * + * Software (/FPa) + * sincos() 0.39 0.50 0.73 1.7 + * + * + * + * ACCURACY: + * + * The accurate approximations are designed with a relative error + * criterion. The absolute error is greatest at x = 0.5 degree. + * It decreases from a local maximum at i+0.5 degrees to full + * machine precision at each integer i degrees. With the + * ACC5 option, the relative error of 6.3e-6 is equivalent to + * an absolute angular error of 0.01 arc second in the argument + * at x = i+0.5 degrees. For small angles < 0.5 deg, the ACC5 + * accuracy is 6.3e-6 (.00063%) of reading; i.e., the absolute + * error decreases in proportion to the argument. This is true + * for both the sine and cosine approximations, since the latter + * is for the function 1 - cos(x). + * + * If absolute error is of most concern, use the compile time + * option ABSERR to obtain an absolute error of 2.7e-8 for ACC5 + * precision. This is about half the absolute error of the + * relative precision option. In this case the relative error + * for small angles will increase to 9.5e-6 -- a reasonable + * tradeoff. + */ + + +#include "mconf.h" + +/* Define one of the following to be 1: + */ +#define ACC5 1 +#define ACC11 0 +#define ACC17 0 + +/* Option for linear interpolation when flg = 1 + */ +#define LINTERP 1 + +/* Option for absolute error criterion + */ +#define ABSERR 1 + +/* Option to include modulo 360 function: + */ +#define MOD360 1 + +/* +Cephes Math Library Release 2.1 +Copyright 1987 by Stephen L. Moshier +Direct inquiries to 30 Frost Street, Cambridge, MA 02140 +*/ + + +/* Table of sin(i degrees) + * for 0 <= i <= 90 + */ +const static double sintbl[92] = { + 0.00000000000000000000E0, + 1.74524064372835128194E-2, + 3.48994967025009716460E-2, + 5.23359562429438327221E-2, + 6.97564737441253007760E-2, + 8.71557427476581735581E-2, + 1.04528463267653471400E-1, + 1.21869343405147481113E-1, + 1.39173100960065444112E-1, + 1.56434465040230869010E-1, + 1.73648177666930348852E-1, + 1.90808995376544812405E-1, + 2.07911690817759337102E-1, + 2.24951054343864998051E-1, + 2.41921895599667722560E-1, + 2.58819045102520762349E-1, + 2.75637355816999185650E-1, + 2.92371704722736728097E-1, + 3.09016994374947424102E-1, + 3.25568154457156668714E-1, + 3.42020143325668733044E-1, + 3.58367949545300273484E-1, + 3.74606593415912035415E-1, + 3.90731128489273755062E-1, + 4.06736643075800207754E-1, + 4.22618261740699436187E-1, + 4.38371146789077417453E-1, + 4.53990499739546791560E-1, + 4.69471562785890775959E-1, + 4.84809620246337029075E-1, + 5.00000000000000000000E-1, + 5.15038074910054210082E-1, + 5.29919264233204954047E-1, + 5.44639035015027082224E-1, + 5.59192903470746830160E-1, + 5.73576436351046096108E-1, + 5.87785252292473129169E-1, + 6.01815023152048279918E-1, + 6.15661475325658279669E-1, + 6.29320391049837452706E-1, + 6.42787609686539326323E-1, + 6.56059028990507284782E-1, + 6.69130606358858213826E-1, + 6.81998360062498500442E-1, + 6.94658370458997286656E-1, + 7.07106781186547524401E-1, + 7.19339800338651139356E-1, + 7.31353701619170483288E-1, + 7.43144825477394235015E-1, + 7.54709580222771997943E-1, + 7.66044443118978035202E-1, + 7.77145961456970879980E-1, + 7.88010753606721956694E-1, + 7.98635510047292846284E-1, + 8.09016994374947424102E-1, + 8.19152044288991789684E-1, + 8.29037572555041692006E-1, + 8.38670567945424029638E-1, + 8.48048096156425970386E-1, + 8.57167300702112287465E-1, + 8.66025403784438646764E-1, + 8.74619707139395800285E-1, + 8.82947592858926942032E-1, + 8.91006524188367862360E-1, + 8.98794046299166992782E-1, + 9.06307787036649963243E-1, + 9.13545457642600895502E-1, + 9.20504853452440327397E-1, + 9.27183854566787400806E-1, + 9.33580426497201748990E-1, + 9.39692620785908384054E-1, + 9.45518575599316810348E-1, + 9.51056516295153572116E-1, + 9.56304755963035481339E-1, + 9.61261695938318861916E-1, + 9.65925826289068286750E-1, + 9.70295726275996472306E-1, + 9.74370064785235228540E-1, + 9.78147600733805637929E-1, + 9.81627183447663953497E-1, + 9.84807753012208059367E-1, + 9.87688340595137726190E-1, + 9.90268068741570315084E-1, + 9.92546151641322034980E-1, + 9.94521895368273336923E-1, + 9.96194698091745532295E-1, + 9.97564050259824247613E-1, + 9.98629534754573873784E-1, + 9.99390827019095730006E-1, + 9.99847695156391239157E-1, + 1.00000000000000000000E0, + 9.99847695156391239157E-1, +}; + +#ifdef ANSIPROT +double floor ( double ); +#else +double floor(); +#endif + +int sincos(x, s, c, flg) +double x; +double *s, *c; +int flg; +{ +int ix, ssign, csign, xsign; +double y, z, sx, sz, cx, cz; + +/* Make argument nonnegative. + */ +xsign = 1; +if( x < 0.0 ) + { + xsign = -1; + x = -x; + } + + +#if MOD360 +x = x - 360.0 * floor( x/360.0 ); +#endif + +/* Find nearest integer to x. + * Note there should be a domain error test here, + * but this is omitted to gain speed. + */ +ix = x + 0.5; +z = x - ix; /* the residual */ + +/* Look up the sine and cosine of the integer. + */ +if( ix <= 180 ) + { + ssign = 1; + csign = 1; + } +else + { + ssign = -1; + csign = -1; + ix -= 180; + } + +if( ix > 90 ) + { + csign = -csign; + ix = 180 - ix; + } + +sx = sintbl[ix]; +if( ssign < 0 ) + sx = -sx; +cx = sintbl[ 90-ix ]; +if( csign < 0 ) + cx = -cx; + +/* If the flag argument is set, then just return + * the tabulated values for arg to the nearest whole degree. + */ +if( flg ) + { +#if LINTERP + y = sx + 1.74531263774940077459e-2 * z * cx; + cx -= 1.74531263774940077459e-2 * z * sx; + sx = y; +#endif + if( xsign < 0 ) + sx = -sx; + *s = sx; /* sine */ + *c = cx; /* cosine */ + return 0; + } + +/* Find sine and cosine + * of the residual angle between -0.5 and +0.5 degree. + */ +#if ACC5 +#if ABSERR +/* absolute error = 2.769e-8: */ +sz = 1.74531263774940077459e-2 * z; +/* absolute error = 4.146e-11: */ +cz = 1.0 - 1.52307909153324666207e-4 * z * z; +#else +/* relative error = 6.346e-6: */ +sz = 1.74531817576426662296e-2 * z; +/* relative error = 3.173e-6: */ +cz = 1.0 - 1.52308226602566149927e-4 * z * z; +#endif +#else +y = z * z; +#endif + + +#if ACC11 +sz = ( -8.86092781698004819918e-7 * y + + 1.74532925198378577601e-2 ) * z; + +cz = 1.0 - ( -3.86631403698859047896e-9 * y + + 1.52308709893047593702e-4 ) * y; +#endif + + +#if ACC17 +sz = (( 1.34959795251974073996e-11 * y + - 8.86096155697856783296e-7 ) * y + + 1.74532925199432957214e-2 ) * z; + +cz = 1.0 - (( 3.92582397764340914444e-14 * y + - 3.86632385155548605680e-9 ) * y + + 1.52308709893354299569e-4 ) * y; +#endif + + +/* Combine the tabulated part and the calculated part + * by trigonometry. + */ +y = sx * cz + cx * sz; +if( xsign < 0 ) + y = - y; +*s = y; /* sine */ + +*c = cx * cz - sx * sz; /* cosine */ +return 0; +} diff --git a/components/external/espruino/libs/math/sindg.c b/components/external/espruino/libs/math/sindg.c new file mode 100644 index 0000000000..7b2be4b452 --- /dev/null +++ b/components/external/espruino/libs/math/sindg.c @@ -0,0 +1,308 @@ +/* sindg.c + * + * Circular sine of angle in degrees + * + * + * + * SYNOPSIS: + * + * double x, y, sindg(); + * + * y = sindg( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the sine is approximated by + * x + x**3 P(x**2). + * Between pi/4 and pi/2 the cosine is represented as + * 1 - x**2 P(x**2). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC +-1000 3100 3.3e-17 9.0e-18 + * IEEE +-1000 30000 2.3e-16 5.6e-17 + * + * ERROR MESSAGES: + * + * message condition value returned + * sindg total loss x > 8.0e14 (DEC) 0.0 + * x > 1.0e14 (IEEE) + * + */ + /* cosdg.c + * + * Circular cosine of angle in degrees + * + * + * + * SYNOPSIS: + * + * double x, y, cosdg(); + * + * y = cosdg( x ); + * + * + * + * DESCRIPTION: + * + * Range reduction is into intervals of 45 degrees. + * + * Two polynomial approximating functions are employed. + * Between 0 and pi/4 the cosine is approximated by + * 1 - x**2 P(x**2). + * Between pi/4 and pi/2 the sine is represented as + * x + x**3 P(x**2). + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC +-1000 3400 3.5e-17 9.1e-18 + * IEEE +-1000 30000 2.1e-16 5.7e-17 + * See also sin(). + * + */ + +/* Cephes Math Library Release 2.0: April, 1987 + * Copyright 1985, 1987 by Stephen L. Moshier + * Direct inquiries to 30 Frost Street, Cambridge, MA 02140 */ + +#include "mconf.h" + +#ifdef UNK +const static double sincof[] = { + 1.58962301572218447952E-10, +-2.50507477628503540135E-8, + 2.75573136213856773549E-6, +-1.98412698295895384658E-4, + 8.33333333332211858862E-3, +-1.66666666666666307295E-1 +}; +const static double coscof[] = { + 1.13678171382044553091E-11, +-2.08758833757683644217E-9, + 2.75573155429816611547E-7, +-2.48015872936186303776E-5, + 1.38888888888806666760E-3, +-4.16666666666666348141E-2, + 4.99999999999999999798E-1 +}; +const static double PI180 = 1.74532925199432957692E-2; /* pi/180 */ +const static double lossth = 1.0e14; +#endif + +#ifdef DEC +static unsigned short sincof[] = { +0030056,0143750,0177170,0073013, +0131727,0027455,0044510,0132205, +0033470,0167432,0131752,0042263, +0135120,0006400,0146776,0174027, +0036410,0104210,0104207,0137202, +0137452,0125252,0125252,0125103 +}; +static unsigned short coscof[] = { +0027107,0176030,0153315,0110312, +0131017,0072476,0007450,0123243, +0032623,0171174,0070066,0146445, +0134320,0006400,0147355,0163313, +0035666,0005540,0133012,0165067, +0137052,0125252,0125252,0125206, +0040000,0000000,0000000,0000000 +}; +static unsigned short P1[] = {0036616,0175065,0011224,0164711}; +#define PI180 *(double *)P1 +const static double lossth = 8.0e14; +#endif + +#ifdef IBMPC +static unsigned short sincof[] = { +0x0ec1,0x1fcf,0xd8fd,0x3de5, +0x1691,0xa929,0xe5e5,0xbe5a, +0x4896,0x567d,0x1de3,0x3ec7, +0xdf03,0x19bf,0x01a0,0xbf2a, +0xf7d0,0x1110,0x1111,0x3f81, +0x5548,0x5555,0x5555,0xbfc5 +}; +static unsigned short coscof[] = { +0xb219,0x1ad9,0xff83,0x3da8, +0x14d4,0xc1e5,0xeea7,0xbe21, +0xd9a5,0x8e06,0x7e4f,0x3e92, +0xbcd9,0x19dd,0x01a0,0xbefa, +0x5d47,0x16c1,0xc16c,0x3f56, +0x5551,0x5555,0x5555,0xbfa5, +0x0000,0x0000,0x0000,0x3fe0 +}; + +static unsigned short P1[] = {0x9d39,0xa252,0xdf46,0x3f91}; +#define PI180 *(double *)P1 +const static double lossth = 1.0e14; +#endif + +#ifdef MIEEE +static unsigned short sincof[] = { +0x3de5,0xd8fd,0x1fcf,0x0ec1, +0xbe5a,0xe5e5,0xa929,0x1691, +0x3ec7,0x1de3,0x567d,0x4896, +0xbf2a,0x01a0,0x19bf,0xdf03, +0x3f81,0x1111,0x1110,0xf7d0, +0xbfc5,0x5555,0x5555,0x5548 +}; +static unsigned short coscof[] = { +0x3da8,0xff83,0x1ad9,0xb219, +0xbe21,0xeea7,0xc1e5,0x14d4, +0x3e92,0x7e4f,0x8e06,0xd9a5, +0xbefa,0x01a0,0x19dd,0xbcd9, +0x3f56,0xc16c,0x16c1,0x5d47, +0xbfa5,0x5555,0x5555,0x5551, +0x3fe0,0x0000,0x0000,0x0000 +}; + +static unsigned short P1[] = { +0x3f91,0xdf46,0xa252,0x9d39 +}; +#define PI180 *(double *)P1 +const static double lossth = 1.0e14; +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double floor ( double ); +extern double ldexp ( double, int ); +#else +double polevl(), floor(), ldexp(); +#endif +extern double PIO4; + +double sindg(x) +double x; +{ +double y, z, zz; +int j, sign; + +/* make argument positive but save the sign */ +sign = 1; +if( x < 0 ) + { + x = -x; + sign = -1; + } + +if( x > lossth ) + { + mtherr( "sindg", TLOSS ); + return(0.0); + } + +y = floor( x/45.0 ); /* integer part of x/PIO4 */ + +/* strip high bits of integer part to prevent integer overflow */ +z = ldexp( y, -4 ); +z = floor(z); /* integer part of y/8 */ +z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */ + +j = z; /* convert to integer for tests on the phase angle */ +/* map zeros to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } +j = j & 07; /* octant modulo 360 degrees */ +/* reflect in x axis */ +if( j > 3) + { + sign = -sign; + j -= 4; + } + +z = x - y * 45.0; /* x mod 45 degrees */ +z *= PI180; /* multiply by pi/180 to convert to radians */ +zz = z * z; + +if( (j==1) || (j==2) ) + { + y = 1.0 - zz * polevl( zz, coscof, 6 ); + } +else + { + y = z + z * (zz * polevl( zz, sincof, 5 )); + } + +if(sign < 0) + y = -y; + +return(y); +} + + + + + +double cosdg(x) +double x; +{ +double y, z, zz; +int j, sign; + +/* make argument positive */ +sign = 1; +if( x < 0 ) + x = -x; + +if( x > lossth ) + { + mtherr( "cosdg", TLOSS ); + return(0.0); + } + +y = floor( x/45.0 ); +z = ldexp( y, -4 ); +z = floor(z); /* integer part of y/8 */ +z = y - ldexp( z, 4 ); /* y - 16 * (y/16) */ + +/* integer and fractional part modulo one octant */ +j = z; +if( j & 1 ) /* map zeros to origin */ + { + j += 1; + y += 1.0; + } +j = j & 07; +if( j > 3) + { + j -=4; + sign = -sign; + } + +if( j > 1 ) + sign = -sign; + +z = x - y * 45.0; /* x mod 45 degrees */ +z *= PI180; /* multiply by pi/180 to convert to radians */ + +zz = z * z; + +if( (j==1) || (j==2) ) + { + y = z + z * (zz * polevl( zz, sincof, 5 )); + } +else + { + y = 1.0 - zz * polevl( zz, coscof, 6 ); + } + +if(sign < 0) + y = -y; + +return(y); +} diff --git a/components/external/espruino/libs/math/sinh.c b/components/external/espruino/libs/math/sinh.c new file mode 100644 index 0000000000..40ebb3d945 --- /dev/null +++ b/components/external/espruino/libs/math/sinh.c @@ -0,0 +1,148 @@ +/* sinh.c + * + * Hyperbolic sine + * + * + * + * SYNOPSIS: + * + * double x, y, sinh(); + * + * y = sinh( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic sine of argument in the range MINLOG to + * MAXLOG. + * + * The range is partitioned into two segments. If |x| <= 1, a + * rational function of the form x + x**3 P(x)/Q(x) is employed. + * Otherwise the calculation is sinh(x) = ( exp(x) - exp(-x) )/2. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC +- 88 50000 4.0e-17 7.7e-18 + * IEEE +-MAXLOG 30000 2.6e-16 5.7e-17 + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { +-7.89474443963537015605E-1, +-1.63725857525983828727E2, +-1.15614435765005216044E4, +-3.51754964808151394800E5 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ +-2.77711081420602794433E2, + 3.61578279834431989373E4, +-2.11052978884890840399E6 +}; +#endif + +#ifdef DEC +static unsigned short P[] = { +0140112,0015377,0042731,0163255, +0142043,0134721,0146177,0123761, +0143464,0122706,0034353,0006017, +0144653,0140536,0157665,0054045 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0142212,0155404,0133513,0022040, +0044015,0036723,0173271,0011053, +0145400,0150407,0023710,0001034 +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x3cd6,0xe8bb,0x435f,0xbfe9, +0xf4fe,0x398f,0x773a,0xc064, +0x6182,0xc71d,0x94b8,0xc0c6, +0xab05,0xdbf6,0x782b,0xc115 +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x6484,0x96e9,0x5b60,0xc071, +0x2245,0x7ed7,0xa7ba,0x40e1, +0x0044,0xe4f9,0x1a20,0xc140 +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0xbfe9,0x435f,0xe8bb,0x3cd6, +0xc064,0x773a,0x398f,0xf4fe, +0xc0c6,0x94b8,0xc71d,0x6182, +0xc115,0x782b,0xdbf6,0xab05 +}; +static unsigned short Q[] = { +0xc071,0x5b60,0x96e9,0x6484, +0x40e1,0xa7ba,0x7ed7,0x2245, +0xc140,0x1a20,0xe4f9,0x0044 +}; +#endif + +#ifdef ANSIPROT +extern double fabs ( double ); +extern double exp ( double ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +#else +double fabs(), exp(), polevl(), p1evl(); +#endif +extern double INFINITY, MINLOG, MAXLOG, LOGE2; + +double sinh(x) +double x; +{ +double a; + +#ifdef MINUSZERO +if( x == 0.0 ) + return(x); +#endif +a = fabs(x); +if( (x > (MAXLOG + LOGE2)) || (x > -(MINLOG-LOGE2) ) ) + { + mtherr( "sinh", DOMAIN ); + if( x > 0 ) + return( INFINITY ); + else + return( -INFINITY ); + } +if( a > 1.0 ) + { + if( a >= (MAXLOG - LOGE2) ) + { + a = exp(0.5*a); + a = (0.5 * a) * a; + if( x < 0 ) + a = -a; + return(a); + } + a = exp(a); + a = 0.5*a - (0.5/a); + if( x < 0 ) + a = -a; + return(a); + } + +a *= a; +return( x + x * a * (polevl(a,P,3)/p1evl(a,Q,3)) ); +} diff --git a/components/external/espruino/libs/math/sqrt.c b/components/external/espruino/libs/math/sqrt.c new file mode 100644 index 0000000000..8ff5d050a2 --- /dev/null +++ b/components/external/espruino/libs/math/sqrt.c @@ -0,0 +1,178 @@ +/* sqrt.c + * + * Square root + * + * + * + * SYNOPSIS: + * + * double x, y, sqrt(); + * + * y = sqrt( x ); + * + * + * + * DESCRIPTION: + * + * Returns the square root of x. + * + * Range reduction involves isolating the power of two of the + * argument and using a polynomial approximation to obtain + * a rough value for the square root. Then Heron's iteration + * is used three times to converge to an accurate value. + * + * + * + * ACCURACY: + * + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC 0, 10 60000 2.1e-17 7.9e-18 + * IEEE 0,1.7e308 30000 1.7e-16 6.3e-17 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * sqrt domain x < 0 0.0 + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 1988, 2000 by Stephen L. Moshier +*/ + + +#include "mconf.h" +#ifdef ANSIPROT +extern double frexp ( double, int * ); +extern double ldexp ( double, int ); +#else +double frexp(), ldexp(); +#endif +extern double SQRT2; /* SQRT2 = 1.41421356237309504880 */ + +double sqrt(x) +double x; +{ +int e; +#ifndef UNK +short *q; +#endif +double z, w; + +if( x <= 0.0 ) + { + if( x < 0.0 ) + mtherr( "sqrt", DOMAIN ); + return( 0.0 ); + } +w = x; +/* separate exponent and significand */ +#ifdef UNK +z = frexp( x, &e ); +#endif +#ifdef DEC +q = (short *)&x; +e = ((*q >> 7) & 0377) - 0200; +*q &= 0177; +*q |= 040000; +z = x; +#endif + +/* Note, frexp and ldexp are used in order to + * handle denormal numbers properly. + */ +#ifdef IBMPC +z = frexp( x, &e ); +q = (short *)&x; +q += 3; +/* +e = ((*q >> 4) & 0x0fff) - 0x3fe; +*q &= 0x000f; +*q |= 0x3fe0; +z = x; +*/ +#endif +#ifdef MIEEE +z = frexp( x, &e ); +q = (short *)&x; +/* +e = ((*q >> 4) & 0x0fff) - 0x3fe; +*q &= 0x000f; +*q |= 0x3fe0; +z = x; +*/ +#endif + +/* approximate square root of number between 0.5 and 1 + * relative error of approximation = 7.47e-3 + */ +x = 4.173075996388649989089E-1 + 5.9016206709064458299663E-1 * z; + +/* adjust for odd powers of 2 */ +if( (e & 1) != 0 ) + x *= SQRT2; + +/* re-insert exponent */ +#ifdef UNK +x = ldexp( x, (e >> 1) ); +#endif +#ifdef DEC +*q += ((e >> 1) & 0377) << 7; +*q &= 077777; +#endif +#ifdef IBMPC +x = ldexp( x, (e >> 1) ); +/* +*q += ((e >>1) & 0x7ff) << 4; +*q &= 077777; +*/ +#endif +#ifdef MIEEE +x = ldexp( x, (e >> 1) ); +/* +*q += ((e >>1) & 0x7ff) << 4; +*q &= 077777; +*/ +#endif + +/* Newton iterations: */ +#ifdef UNK +x = 0.5*(x + w/x); +x = 0.5*(x + w/x); +x = 0.5*(x + w/x); +#endif + +/* Note, assume the square root cannot be denormal, + * so it is safe to use integer exponent operations here. + */ +#ifdef DEC +x += w/x; +*q -= 0200; +x += w/x; +*q -= 0200; +x += w/x; +*q -= 0200; +#endif +#ifdef IBMPC +x += w/x; +*q -= 0x10; +x += w/x; +*q -= 0x10; +x += w/x; +*q -= 0x10; +#endif +#ifdef MIEEE +x += w/x; +*q -= 0x10; +x += w/x; +*q -= 0x10; +x += w/x; +*q -= 0x10; +#endif + +return(x); +} diff --git a/components/external/espruino/libs/math/tan.c b/components/external/espruino/libs/math/tan.c new file mode 100644 index 0000000000..b2578ca7a6 --- /dev/null +++ b/components/external/espruino/libs/math/tan.c @@ -0,0 +1,304 @@ +/* tan.c + * + * Circular tangent + * + * + * + * SYNOPSIS: + * + * double x, y, tan(); + * + * y = tan( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular tangent of the radian argument x. + * + * Range reduction is modulo pi/4. A rational function + * x + x**3 P(x**2)/Q(x**2) + * is employed in the basic interval [0, pi/4]. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC +-1.07e9 44000 4.1e-17 1.0e-17 + * IEEE +-1.07e9 30000 2.9e-16 8.1e-17 + * + * ERROR MESSAGES: + * + * message condition value returned + * tan total loss x > 1.073741824e9 0.0 + * + */ + /* cot.c + * + * Circular cotangent + * + * + * + * SYNOPSIS: + * + * double x, y, cot(); + * + * y = cot( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular cotangent of the radian argument x. + * + * Range reduction is modulo pi/4. A rational function + * x + x**3 P(x**2)/Q(x**2) + * is employed in the basic interval [0, pi/4]. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * IEEE +-1.07e9 30000 2.9e-16 8.2e-17 + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cot total loss x > 1.073741824e9 0.0 + * cot singularity x = 0 INFINITY + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +yright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { +-1.30936939181383777646E4, + 1.15351664838587416140E6, +-1.79565251976484877988E7 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 1.36812963470692954678E4, +-1.32089234440210967447E6, + 2.50083801823357915839E7, +-5.38695755929454629881E7 +}; +const static double DP1 = 7.853981554508209228515625E-1; +const static double DP2 = 7.94662735614792836714E-9; +const static double DP3 = 3.06161699786838294307E-17; +const static double lossth = 1.073741824e9; +#endif + +#ifdef DEC +static unsigned short P[] = { +0143514,0113306,0111171,0174674, +0045214,0147545,0027744,0167346, +0146210,0177526,0114514,0105660 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0043525,0142457,0072633,0025617, +0145241,0036742,0140525,0162256, +0046276,0146176,0013526,0143573, +0146515,0077401,0162762,0150607 +}; +/* 7.853981629014015197753906250000E-1 */ +static unsigned short P1[] = {0040111,0007732,0120000,0000000,}; +/* 4.960467869796758577649598009884E-10 */ +static unsigned short P2[] = {0030410,0055060,0100000,0000000,}; +/* 2.860594363054915898381331279295E-18 */ +static unsigned short P3[] = {0021523,0011431,0105056,0001560,}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +const static double lossth = 1.073741824e9; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x3f38,0xd24f,0x92d8,0xc0c9, +0x9ddd,0xa5fc,0x99ec,0x4131, +0x9176,0xd329,0x1fea,0xc171 +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x6572,0xeeb3,0xb8a5,0x40ca, +0xbc96,0x582a,0x27bc,0xc134, +0xd8ef,0xc2ea,0xd98f,0x4177, +0x5a31,0x3cbe,0xafe0,0xc189 +}; +/* + 7.85398125648498535156E-1, + 3.77489470793079817668E-8, + 2.69515142907905952645E-15, +*/ +static unsigned short P1[] = {0x0000,0x4000,0x21fb,0x3fe9}; +static unsigned short P2[] = {0x0000,0x0000,0x442d,0x3e64}; +static unsigned short P3[] = {0x5170,0x98cc,0x4698,0x3ce8}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +const static double lossth = 1.073741824e9; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0xc0c9,0x92d8,0xd24f,0x3f38, +0x4131,0x99ec,0xa5fc,0x9ddd, +0xc171,0x1fea,0xd329,0x9176 +}; +static unsigned short Q[] = { +0x40ca,0xb8a5,0xeeb3,0x6572, +0xc134,0x27bc,0x582a,0xbc96, +0x4177,0xd98f,0xc2ea,0xd8ef, +0xc189,0xafe0,0x3cbe,0x5a31 +}; +static unsigned short P1[] = { +0x3fe9,0x21fb,0x4000,0x0000 +}; +static unsigned short P2[] = { +0x3e64,0x442d,0x0000,0x0000 +}; +static unsigned short P3[] = { +0x3ce8,0x4698,0x98cc,0x5170, +}; +#define DP1 *(double *)P1 +#define DP2 *(double *)P2 +#define DP3 *(double *)P3 +const static double lossth = 1.073741824e9; +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double floor ( double ); +extern double ldexp ( double, int ); +extern int isnan ( double ); +extern int isfinite ( double ); +const static double tancot(double, int); +#else +double polevl(), p1evl(), floor(), ldexp(); +const static double tancot(); +int isnan(), isfinite(); +#endif +extern double PIO4; +extern double INFINITY; +extern double NAN; + +double tan(x) +double x; +{ +#ifdef MINUSZERO +if( x == 0.0 ) + return(x); +#endif +#ifdef NANS +if( isnan(x) ) + return(x); +if( !isfinite(x) ) + { + mtherr( "tan", DOMAIN ); + return(NAN); + } +#endif +return( tancot(x,0) ); +} + + +double cot(x) +double x; +{ + +if( x == 0.0 ) + { + mtherr( "cot", SING ); + return( INFINITY ); + } +return( tancot(x,1) ); +} + + +const static double tancot( xx, cotflg ) +double xx; +int cotflg; +{ +double x, y, z, zz; +int j, sign; + +/* make argument positive but save the sign */ +if( xx < 0 ) + { + x = -xx; + sign = -1; + } +else + { + x = xx; + sign = 1; + } + +if( x > lossth ) + { + if( cotflg ) + mtherr( "cot", TLOSS ); + else + mtherr( "tan", TLOSS ); + return(0.0); + } + +/* compute x mod PIO4 */ +y = floor( x/PIO4 ); + +/* strip high bits of integer part */ +z = ldexp( y, -3 ); +z = floor(z); /* integer part of y/8 */ +z = y - ldexp( z, 3 ); /* y - 16 * (y/16) */ + +/* integer and fractional part modulo one octant */ +j = z; + +/* map zeros and singularities to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } + +z = ((x - y * DP1) - y * DP2) - y * DP3; + +zz = z * z; + +if( zz > 1.0e-14 ) + y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4)); +else + y = z; + +if( j & 2 ) + { + if( cotflg ) + y = -y; + else + y = -1.0/y; + } +else + { + if( cotflg ) + y = 1.0/y; + } + +if( sign < 0 ) + y = -y; + +return( y ); +} diff --git a/components/external/espruino/libs/math/tandg.c b/components/external/espruino/libs/math/tandg.c new file mode 100644 index 0000000000..8bbd11d478 --- /dev/null +++ b/components/external/espruino/libs/math/tandg.c @@ -0,0 +1,267 @@ +/* tandg.c + * + * Circular tangent of argument in degrees + * + * + * + * SYNOPSIS: + * + * double x, y, tandg(); + * + * y = tandg( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular tangent of the argument x in degrees. + * + * Range reduction is modulo pi/4. A rational function + * x + x**3 P(x**2)/Q(x**2) + * is employed in the basic interval [0, pi/4]. + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC 0,10 8000 3.4e-17 1.2e-17 + * IEEE 0,10 30000 3.2e-16 8.4e-17 + * + * ERROR MESSAGES: + * + * message condition value returned + * tandg total loss x > 8.0e14 (DEC) 0.0 + * x > 1.0e14 (IEEE) + * tandg singularity x = 180 k + 90 MAXNUM + */ + /* cotdg.c + * + * Circular cotangent of argument in degrees + * + * + * + * SYNOPSIS: + * + * double x, y, cotdg(); + * + * y = cotdg( x ); + * + * + * + * DESCRIPTION: + * + * Returns the circular cotangent of the argument x in degrees. + * + * Range reduction is modulo pi/4. A rational function + * x + x**3 P(x**2)/Q(x**2) + * is employed in the basic interval [0, pi/4]. + * + * + * ERROR MESSAGES: + * + * message condition value returned + * cotdg total loss x > 8.0e14 (DEC) 0.0 + * x > 1.0e14 (IEEE) + * cotdg singularity x = 180 k MAXNUM + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1987, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { +-1.30936939181383777646E4, + 1.15351664838587416140E6, +-1.79565251976484877988E7 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 1.36812963470692954678E4, +-1.32089234440210967447E6, + 2.50083801823357915839E7, +-5.38695755929454629881E7 +}; +const static double PI180 = 1.74532925199432957692E-2; +const static double lossth = 1.0e14; +#endif + +#ifdef DEC +static unsigned short P[] = { +0143514,0113306,0111171,0174674, +0045214,0147545,0027744,0167346, +0146210,0177526,0114514,0105660 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0043525,0142457,0072633,0025617, +0145241,0036742,0140525,0162256, +0046276,0146176,0013526,0143573, +0146515,0077401,0162762,0150607 +}; +static unsigned short P1[] = {0036616,0175065,0011224,0164711}; +#define PI180 *(double *)P1 +const static double lossth = 8.0e14; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x3f38,0xd24f,0x92d8,0xc0c9, +0x9ddd,0xa5fc,0x99ec,0x4131, +0x9176,0xd329,0x1fea,0xc171 +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x6572,0xeeb3,0xb8a5,0x40ca, +0xbc96,0x582a,0x27bc,0xc134, +0xd8ef,0xc2ea,0xd98f,0x4177, +0x5a31,0x3cbe,0xafe0,0xc189 +}; +static unsigned short P1[] = {0x9d39,0xa252,0xdf46,0x3f91}; +#define PI180 *(double *)P1 +const static double lossth = 1.0e14; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0xc0c9,0x92d8,0xd24f,0x3f38, +0x4131,0x99ec,0xa5fc,0x9ddd, +0xc171,0x1fea,0xd329,0x9176 +}; +static unsigned short Q[] = { +0x40ca,0xb8a5,0xeeb3,0x6572, +0xc134,0x27bc,0x582a,0xbc96, +0x4177,0xd98f,0xc2ea,0xd8ef, +0xc189,0xafe0,0x3cbe,0x5a31 +}; +static unsigned short P1[] = { +0x3f91,0xdf46,0xa252,0x9d39 +}; +#define PI180 *(double *)P1 +const static double lossth = 1.0e14; +#endif + +#ifdef ANSIPROT +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double floor ( double ); +extern double ldexp ( double, int ); +const static double tancot( double, int ); +#else +double polevl(), p1evl(), floor(), ldexp(); +const static double tancot(); +#endif +extern double MAXNUM; +extern double PIO4; + + +double tandg(x) +double x; +{ + +return( tancot(x,0) ); +} + + +double cotdg(x) +double x; +{ + +return( tancot(x,1) ); +} + + +const static double tancot( xx, cotflg ) +double xx; +int cotflg; +{ +double x, y, z, zz; +int j, sign; + +/* make argument positive but save the sign */ +if( xx < 0 ) + { + x = -xx; + sign = -1; + } +else + { + x = xx; + sign = 1; + } + +if( x > lossth ) + { + mtherr( "tandg", TLOSS ); + return(0.0); + } + +/* compute x mod PIO4 */ +y = floor( x/45.0 ); + +/* strip high bits of integer part */ +z = ldexp( y, -3 ); +z = floor(z); /* integer part of y/8 */ +z = y - ldexp( z, 3 ); /* y - 16 * (y/16) */ + +/* integer and fractional part modulo one octant */ +j = z; + +/* map zeros and singularities to origin */ +if( j & 1 ) + { + j += 1; + y += 1.0; + } + +z = x - y * 45.0; +z *= PI180; + +zz = z * z; + +if( zz > 1.0e-14 ) + y = z + z * (zz * polevl( zz, P, 2 )/p1evl(zz, Q, 4)); +else + y = z; + +if( j & 2 ) + { + if( cotflg ) + y = -y; + else + { + if( y != 0.0 ) + { + y = -1.0/y; + } + else + { + mtherr( "tandg", SING ); + y = MAXNUM; + } + } + } +else + { + if( cotflg ) + { + if( y != 0.0 ) + y = 1.0/y; + else + { + mtherr( "cotdg", SING ); + y = MAXNUM; + } + } + } + +if( sign < 0 ) + y = -y; + +return( y ); +} diff --git a/components/external/espruino/libs/math/tanh.c b/components/external/espruino/libs/math/tanh.c new file mode 100644 index 0000000000..ec4a5296b8 --- /dev/null +++ b/components/external/espruino/libs/math/tanh.c @@ -0,0 +1,141 @@ +/* tanh.c + * + * Hyperbolic tangent + * + * + * + * SYNOPSIS: + * + * double x, y, tanh(); + * + * y = tanh( x ); + * + * + * + * DESCRIPTION: + * + * Returns hyperbolic tangent of argument in the range MINLOG to + * MAXLOG. + * + * A rational function is used for |x| < 0.625. The form + * x + x**3 P(x)/Q(x) of Cody _& Waite is employed. + * Otherwise, + * tanh(x) = sinh(x)/cosh(x) = 1 - 2/(exp(2x) + 1). + * + * + * + * ACCURACY: + * + * Relative error: + * arithmetic domain # trials peak rms + * DEC -2,2 50000 3.3e-17 6.4e-18 + * IEEE -2,2 30000 2.5e-16 5.8e-17 + * + */ + +/* +Cephes Math Library Release 2.8: June, 2000 +Copyright 1984, 1995, 2000 by Stephen L. Moshier +*/ + +#include "mconf.h" + +#ifdef UNK +const static double P[] = { +-9.64399179425052238628E-1, +-9.92877231001918586564E1, +-1.61468768441708447952E3 +}; +const static double Q[] = { +/* 1.00000000000000000000E0,*/ + 1.12811678491632931402E2, + 2.23548839060100448583E3, + 4.84406305325125486048E3 +}; +#endif +#ifdef DEC +static unsigned short P[] = { +0140166,0161335,0053753,0075126, +0141706,0111520,0070463,0040552, +0142711,0153001,0101300,0025430 +}; +static unsigned short Q[] = { +/*0040200,0000000,0000000,0000000,*/ +0041741,0117624,0051300,0156060, +0043013,0133720,0071251,0127717, +0043227,0060201,0021020,0020136 +}; +#endif + +#ifdef IBMPC +static unsigned short P[] = { +0x6f4b,0xaafd,0xdc5b,0xbfee, +0x682d,0x0e26,0xd26a,0xc058, +0x0563,0x3058,0x3ac0,0xc099 +}; +static unsigned short Q[] = { +/*0x0000,0x0000,0x0000,0x3ff0,*/ +0x1b86,0x8a58,0x33f2,0x405c, +0x35fa,0x0e55,0x76fa,0x40a1, +0x040c,0x2442,0xec10,0x40b2 +}; +#endif + +#ifdef MIEEE +static unsigned short P[] = { +0xbfee,0xdc5b,0xaafd,0x6f4b, +0xc058,0xd26a,0x0e26,0x682d, +0xc099,0x3ac0,0x3058,0x0563 +}; +static unsigned short Q[] = { +0x405c,0x33f2,0x8a58,0x1b86, +0x40a1,0x76fa,0x0e55,0x35fa, +0x40b2,0xec10,0x2442,0x040c +}; +#endif + +#ifdef ANSIPROT +extern double fabs ( double ); +extern double exp ( double ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +#else +double fabs(), exp(), polevl(), p1evl(); +#endif +extern double MAXLOG; + +double tanh(x) +double x; +{ +double s, z; + +#ifdef MINUSZERO +if( x == 0.0 ) + return(x); +#endif +z = fabs(x); +if( z > 0.5 * MAXLOG ) + { + if( x > 0 ) + return( 1.0 ); + else + return( -1.0 ); + } +if( z >= 0.625 ) + { + s = exp(2.0*z); + z = 1.0 - 2.0/(s + 1.0); + if( x < 0 ) + z = -z; + } +else + { + if( x == 0.0 ) + return(x); + s = x * x; + z = polevl( s, P, 2 )/p1evl(s, Q, 3); + z = x * s * z; + z = x + z; + } +return( z ); +} diff --git a/components/external/espruino/libs/math/unity.c b/components/external/espruino/libs/math/unity.c new file mode 100644 index 0000000000..c0de1c3a9f --- /dev/null +++ b/components/external/espruino/libs/math/unity.c @@ -0,0 +1,138 @@ +/* unity.c + * + * Relative error approximations for function arguments near + * unity. + * + * log1p(x) = log(1+x) + * expm1(x) = exp(x) - 1 + * cosm1(x) = cos(x) - 1 + * + */ + +#include "mconf.h" + +#ifdef ANSIPROT +extern int isnan (double); +extern int isfinite (double); +extern double log ( double ); +extern double polevl ( double, void *, int ); +extern double p1evl ( double, void *, int ); +extern double exp ( double ); +extern double cos ( double ); +#else +double log(), polevl(), p1evl(), exp(), cos(); +int isnan(), isfinite(); +#endif +extern double INFINITY; + +/* log1p(x) = log(1 + x) */ + +/* Coefficients for log(1+x) = x - x**2/2 + x**3 P(x)/Q(x) + * 1/sqrt(2) <= x < sqrt(2) + * Theoretical peak relative error = 2.32e-20 + */ +const static double LP[] = { + 4.5270000862445199635215E-5, + 4.9854102823193375972212E-1, + 6.5787325942061044846969E0, + 2.9911919328553073277375E1, + 6.0949667980987787057556E1, + 5.7112963590585538103336E1, + 2.0039553499201281259648E1, +}; +const static double LQ[] = { +/* 1.0000000000000000000000E0,*/ + 1.5062909083469192043167E1, + 8.3047565967967209469434E1, + 2.2176239823732856465394E2, + 3.0909872225312059774938E2, + 2.1642788614495947685003E2, + 6.0118660497603843919306E1, +}; + +#define SQRTH 0.70710678118654752440 +#define SQRT2 1.41421356237309504880 + +double log1p(x) +double x; +{ +double z; + +z = 1.0 + x; +if( (z < SQRTH) || (z > SQRT2) ) + return( log(z) ); +z = x*x; +z = -0.5 * z + x * ( z * polevl( x, LP, 6 ) / p1evl( x, LQ, 6 ) ); +return (x + z); +} + + + +/* expm1(x) = exp(x) - 1 */ + +/* e^x = 1 + 2x P(x^2)/( Q(x^2) - P(x^2) ) + * -0.5 <= x <= 0.5 + */ + +const static double EP[3] = { + 1.2617719307481059087798E-4, + 3.0299440770744196129956E-2, + 9.9999999999999999991025E-1, +}; +const static double EQ[4] = { + 3.0019850513866445504159E-6, + 2.5244834034968410419224E-3, + 2.2726554820815502876593E-1, + 2.0000000000000000000897E0, +}; + +double expm1(x) +double x; +{ +double r, xx; + +#ifdef NANS +if( isnan(x) ) + return(x); +#endif +#ifdef INFINITIES +if( x == INFINITY ) + return(INFINITY); +if( x == -INFINITY ) + return(-1.0); +#endif +if( (x < -0.5) || (x > 0.5) ) + return( exp(x) - 1.0 ); +xx = x * x; +r = x * polevl( xx, EP, 2 ); +r = r/( polevl( xx, EQ, 3 ) - r ); +return (r + r); +} + + + +/* cosm1(x) = cos(x) - 1 */ + +const static double coscof[7] = { + 4.7377507964246204691685E-14, +-1.1470284843425359765671E-11, + 2.0876754287081521758361E-9, +-2.7557319214999787979814E-7, + 2.4801587301570552304991E-5, +-1.3888888888888872993737E-3, + 4.1666666666666666609054E-2, +}; + +extern double PIO4; + +double cosm1(x) +double x; +{ +double xx; + +if( (x < -PIO4) || (x > PIO4) ) + return( cos(x) - 1.0 ); +xx = x * x; +xx = -0.5*xx + xx * xx * polevl( xx, coscof, 6 ); +return xx; +} diff --git a/components/external/espruino/libs/math/unix.mak b/components/external/espruino/libs/math/unix.mak new file mode 100644 index 0000000000..e6e7da5484 --- /dev/null +++ b/components/external/espruino/libs/math/unix.mak @@ -0,0 +1,109 @@ +# Double precision Cephes library +# Makefile for unix or GCC + +CC = gcc +CFLAGS = -g -O2 -Wall -fno-builtin +AR = ar +RANLIB = ranlib +INCS = mconf.h +AS = as + +OBJS = acosh.o airy.o asin.o asinh.o atan.o atanh.o bdtr.o beta.o \ +btdtr.o cbrt.o chbevl.o chdtr.o clog.o cmplx.o const.o \ +cosh.o dawsn.o drand.o ellie.o ellik.o ellpe.o ellpj.o ellpk.o \ +exp.o exp10.o exp2.o expn.o fabs.o fac.o fdtr.o \ +fresnl.o gamma.o gdtr.o hyp2f1.o hyperg.o i0.o i1.o igami.o \ +incbet.o incbi.o igam.o isnan.o iv.o j0.o j1.o jn.o jv.o k0.o k1.o \ +kn.o log.o log2.o log10.o lrand.o nbdtr.o ndtr.o ndtri.o pdtr.o \ +polevl.o polmisc.o polyn.o pow.o powi.o psi.o rgamma.o round.o \ +shichi.o sici.o sin.o sindg.o sinh.o spence.o stdtr.o struve.o \ +tan.o tandg.o tanh.o unity.o yn.o zeta.o zetac.o \ +sqrt.o floor.o setprec.o mtherr.o + +all: libmd.a mtst dtestvec dcalc paranoia # stamp-timing + +stamp-timing: libmd.a mtst time-it + time-it "mtst > /dev/null" + touch stamp-timing + +time-it: time-it.o + $(CC) -o time-it time-it.o + +time-it.o: time-it.c + $(CC) -O2 -c time-it.c + +dcalc: dcalc.o libmd.a + $(CC) -o dcalc dcalc.o libmd.a +# aout2exe mtst + +mtst: mtst.o libmd.a + $(CC) -v -o mtst mtst.o libmd.a +# gcc -Wl,-verbose -b i486-linuxaout -v -o mtst mtst.o libmd.a +# coff2exe mtst + +mtst.o: mtst.c + $(CC) -O2 -Wall -c mtst.c + +dtestvec: dtestvec.o libmd.a + $(CC) -o dtestvec dtestvec.o libmd.a + +dtestvec.o: dtestvec.c + $(CC) -g -c dtestvec.c + +paranoia: paranoia.o setprec.o libmd.a + $(CC) -o paranoia paranoia.o setprec.o libmd.a + +paranoia.o: paranoia.c + $(CC) $(CFLAGS) -c paranoia.c + +libmd.a: $(OBJS) $(INCS) +# for real Unix: + $(AR) rv libmd.a $(OBJS) +# for djgcc MSDOS: +# >libmd.rf -rv libmd.a $(OBJS) +# $(AR) @libmd.rf + $(RANLIB) libmd.a + +# If the following are all commented out, the C versions +# will be used by default. + +# IBM PC: +#sqrt.o: sqrt.387 +# $(AS) -o sqrt.o sqrt.387 +# +#floor.o: floor.387 +# $(AS) -o floor.o floor.387 +# +#setprec.o: setprec.387 +# $(AS) -o setprec.o setprec.387 + +# ELF versions for linux (no underscores) +sqrt.o: sqrtelf.387 + $(AS) -o sqrt.o sqrtelf.387 + +#floor.o: floorelf.387 +# $(AS) -o floor.o floorelf.387 + +setprec.o: setprelf.387 + $(AS) -o setprec.o setprelf.387 + +# Motorola 68881. Caution, subroutine return conventions vary. +#sqrt.o: sqrt.688 +# $(AS) -o sqrt.o sqrt.688 +# +#setprec.o: setprec.688 +# $(AS) -o setprec.o setprec.688 + +# SPARC: +#sqrt.o: sqrt.spa +# $(AS) -o sqrt.o sqrt.spa + +clean: + rm -f *.o + rm -f mtst + rm -f paranoia + rm -f dcalc + rm -f libmd.a + rm -f time-it + rm -f dtestvec + |