Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 5125:b5df3737028a ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 e813cf16c015
children 71ee43b8a74d
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
24 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, 24 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
25 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. 25 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
26 26
27 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. 27 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
28 Define HAVE_CBRT if you have cbrt(). 28 Define HAVE_CBRT if you have cbrt().
29 Define HAVE_RINT if you have rint().
30 If you don't define these, then the appropriate routines will be simulated. 29 If you don't define these, then the appropriate routines will be simulated.
31 30
32 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback. 31 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback.
33 (This should happen automatically.) 32 (This should happen automatically.)
34 33
48 #include <config.h> 47 #include <config.h>
49 #include "lisp.h" 48 #include "lisp.h"
50 #include "syssignal.h" 49 #include "syssignal.h"
51 #include "sysfloat.h" 50 #include "sysfloat.h"
52 51
53 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT 52 /* An implementation of rint that always rounds towards the even number in
54 if `rint' exists but does not work right. */ 53 the case of ambiguity. */
55 #ifdef HAVE_RINT
56 #define emacs_rint rint
57 #else
58 static double 54 static double
59 emacs_rint (double x) 55 emacs_rint (double x)
60 { 56 {
61 double r = floor (x + 0.5); 57 double r = floor (x + 0.5);
62 double diff = fabs (r - x); 58 double diff = fabs (r - x);
63 /* Round to even and correct for any roundoff errors. */ 59 /* Round to even and correct for any roundoff errors. */
64 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0))) 60 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0)))
65 r += r < x ? 1.0 : -1.0; 61 r += r < x ? 1.0 : -1.0;
66 return r; 62 return r;
67 } 63 }
68 #endif
69 64
70 /* Nonzero while executing in floating point. 65 /* Nonzero while executing in floating point.
71 This tells float_error what to do. */ 66 This tells float_error what to do. */
72 static int in_float; 67 static int in_float;
73 68
179 { 174 {
180 return Qnil; 175 return Qnil;
181 } 176 }
182 177
183 static int 178 static int
184 float_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth)) 179 float_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
180 int UNUSED (foldcase))
185 { 181 {
186 return (extract_float (obj1) == extract_float (obj2)); 182 return (extract_float (obj1) == extract_float (obj2));
187 } 183 }
188 184
189 static Hashcode 185 static Hashcode
1758 round_one_bigfloat_1 (bigfloat number) 1754 round_one_bigfloat_1 (bigfloat number)
1759 { 1755 {
1760 Lisp_Object res0; 1756 Lisp_Object res0;
1761 unsigned long prec = bigfloat_get_prec (number); 1757 unsigned long prec = bigfloat_get_prec (number);
1762 1758
1759 #if 0
1760 /* This causes the following GCC warning:
1761
1762 /xemacs/latest-fix/src/floatfns.c:1764: warning: dereferencing type-punned pointer will break strict-aliasing rules
1763
1764 and furthermore, it's a useless assert, since `number' is stored on
1765 the stack and so its address can never be the same as `scratch_bigfloat'
1766 or `scratch_bigfloat2', which are stored in the data segment.
1767
1768 -- ben */
1763 assert ((bigfloat *)(&number) != (bigfloat *)&scratch_bigfloat 1769 assert ((bigfloat *)(&number) != (bigfloat *)&scratch_bigfloat
1764 && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2)); 1770 && (bigfloat *)(&number) != (bigfloat *)(&scratch_bigfloat2));
1771 #endif
1765 1772
1766 bigfloat_set_prec (scratch_bigfloat, prec); 1773 bigfloat_set_prec (scratch_bigfloat, prec);
1767 bigfloat_set_prec (scratch_bigfloat2, prec); 1774 bigfloat_set_prec (scratch_bigfloat2, prec);
1768 1775
1769 bigfloat_set_double (scratch_bigfloat, 0.5); 1776 bigfloat_set_double (scratch_bigfloat, 0.5);
2444 /* Not called from emacs-lisp float routines; do the default thing. */ 2451 /* Not called from emacs-lisp float routines; do the default thing. */
2445 return 0; 2452 return 0;
2446 2453
2447 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */ 2454 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
2448 2455
2449 args = Fcons (build_string (x->name), 2456 args = Fcons (build_extstring (x->name, Qerror_message_encoding),
2450 Fcons (make_float (x->arg1), 2457 Fcons (make_float (x->arg1),
2451 ((in_float == 2) 2458 ((in_float == 2)
2452 ? Fcons (make_float (x->arg2), Qnil) 2459 ? Fcons (make_float (x->arg2), Qnil)
2453 : Qnil))); 2460 : Qnil)));
2454 switch (x->type) 2461 switch (x->type)