From f75d7a913dd0fae7a739d12f704fca024c065c3e Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 5 Sep 2012 00:18:46 -0700 Subject: * fileio.c, filelock.c, floatfns.c, fns.c: Use bool for boolean. * fileio.c (auto_saving, auto_save_error_occurred, make_temp_name) (Fexpand_file_name, barf_or_query_if_file_exists, Fcopy_file) (file_name_absolute_p, Fsubstitute_in_file_name): (check_executable, check_writable, Ffile_accessible_directory_p) (Fset_file_selinux_context, Fdefault_file_modes) (Finsert_file_contents, choose_write_coding_system) (Fwrite_region, build_annotations, a_write, e_write) (Fdo_auto_save): * filelock.c (boot_time_initialized, get_boot_time) (get_boot_time_1, lock_file_1, within_one_second): * floatfns.c (in_float): * fns.c (concat, internal_equal, Frequire, base64_encode_1) (base64_decode_1, cmpfn_eql, cmpfn_user_defined) (sweep_weak_table, sweep_weak_hash_tables, secure_hash): * lisp.h (struct Lisp_Hash_Table.cmpfn): * window.c (compare_window_configurations): Use bool for booleans. * fileio.c (auto_saving_dir_umask, auto_saving_mode_bits) (Fdefault_file_modes): Now mode_t, not int, for modes. (Fdo_auto_save): Set a boolean to 1 rather than using ++. (internal_delete_file): Now returns void, not a (boolean) int, since nobody was looking at the return value. * lisp.h, window.h: Adjust to above API changes. --- src/floatfns.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/floatfns.c') diff --git a/src/floatfns.c b/src/floatfns.c index cad071f1e15..706fe7ae1a0 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -103,10 +103,10 @@ extern double logb (double); static void float_error (); #endif -/* Nonzero while executing in floating point. +/* True while executing in floating point. This tells float_error what to do. */ -static int in_float; +static bool in_float; /* If an argument is out of range for a mathematical function, here is the actual argument value to use in the error message. -- cgit v1.2.1 From 20ef56dbc88f517ebf60d89577fc89870d9fe888 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Wed, 5 Sep 2012 14:33:53 -0700 Subject: Fix race conditions with signal handlers and errno. Be more systematic about preserving errno whenever a signal handler returns, even if it's not in the main thread. Do this by renaming signal handlers to distinguish between signal delivery and signal handling. All uses changed. * atimer.c (deliver_alarm_signal): Rename from alarm_signal_handler. * data.c (deliver_arith_signal): Rename from arith_error. * dispnew.c (deliver_window_change_signal): Rename from window_change_signal. * emacs.c (deliver_error_signal): Rename from fatal_error_signal. (deliver_danger_signal) [SIGDANGER]: Rename from memory_warning_signal. * keyboard.c (deliver_input_available_signal): Rename from input_available_signal. (deliver_user_signal): Rename from handle_user_signal. (deliver_interrupt_signal): Rename from interrupt_signal. * process.c (deliver_pipe_signal): Rename from send_process_trap. (deliver_child_signal): Rename from sigchld_handler. * atimer.c (handle_alarm_signal): * data.c (handle_arith_signal): * dispnew.c (handle_window_change_signal): * emacs.c (handle_fatal_signal, handle_danger_signal): * keyboard.c (handle_input_available_signal): * keyboard.c (handle_user_signal, handle_interrupt_signal): * process.c (handle_pipe_signal, handle_child_signal): New functions, with the actual signal-handling code taken from the original respective signal handlers, sans the sporadic attempts to preserve errno, since that's now done by handle_on_main_thread. * atimer.c (alarm_signal_handler): Remove unnecessary decl. * emacs.c, floatfns.c, lisp.h: Remove unused FLOAT_CATCH_SIGKILL cruft. * emacs.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Move to sysdep.c. (main) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Move initialization of main_thread to sysdep.c's init_signals. * process.c (waitpid) [!WNOHANG]: #define to wait; that's good enough for our usage, and simplifies the mainline code. (record_child_status_change): New static function, as a helper for handle_child_signal, and with most of the old child handler's contents. (CAN_HANDLE_MULTIPLE_CHILDREN): New constant. (handle_child_signal): Use the above. * sysdep.c (main_thread) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Moved here from emacs.c. (init_signals) [FORWARD_SIGNAL_TO_MAIN_THREAD]: Initialize it; code moved here from emacs.c's main function. * sysdep.c, syssignal.h (handle_on_main_thread): New function, replacing the old SIGNAL_THREAD_CHECK. All uses changed. This lets callers save and restore errno properly. --- src/floatfns.c | 35 ----------------------------------- 1 file changed, 35 deletions(-) (limited to 'src/floatfns.c') diff --git a/src/floatfns.c b/src/floatfns.c index 706fe7ae1a0..f59cf58228a 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -37,9 +37,6 @@ along with GNU Emacs. If not, see . */ Define FLOAT_CHECK_ERRNO if the float library routines set errno. This has no effect if HAVE_MATHERR is defined. - Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. - (What systems actually do this? Please let us know.) - Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and range checking will happen before calling the float routines. This has @@ -99,10 +96,6 @@ extern double logb (double); # include #endif -#ifdef FLOAT_CATCH_SIGILL -static void float_error (); -#endif - /* True while executing in floating point. This tells float_error what to do. */ @@ -947,31 +940,6 @@ Rounds the value toward zero. */) return make_float (d); } -#ifdef FLOAT_CATCH_SIGILL -static void -float_error (int signo) -{ - if (! in_float) - fatal_error_signal (signo); - -#ifdef BSD_SYSTEM - sigsetmask (SIGEMPTYMASK); -#else - /* Must reestablish handler each time it is called. */ - signal (SIGILL, float_error); -#endif /* BSD_SYSTEM */ - - SIGNAL_THREAD_CHECK (signo); - in_float = 0; - - xsignal1 (Qarith_error, float_error_arg); -} - -/* Another idea was to replace the library function `infnan' - where SIGILL is signaled. */ - -#endif /* FLOAT_CATCH_SIGILL */ - #ifdef HAVE_MATHERR int matherr (struct exception *x) @@ -1006,9 +974,6 @@ matherr (struct exception *x) void init_floatfns (void) { -#ifdef FLOAT_CATCH_SIGILL - signal (SIGILL, float_error); -#endif in_float = 0; } -- cgit v1.2.1 From 2fe282993cf9c84f5be424dc93d03f9705a7edd8 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Thu, 6 Sep 2012 18:27:44 -0700 Subject: Signal-handler cleanup. Emacs's signal handlers were written in the old 4.2BSD style with sigblock and sigmask and so forth, and this led to some inefficiencies and confusion. Rewrite these to use pthread_sigmask etc. without copying signal sets around. Also, get rid of the confusing macros 'SIGNAL_THREAD_CHECK' and 'signal', and instead use functions that do not attempt to take over the system name space. This patch causes Emacs's text segment to shrink by 0.7% on my platform, Fedora 17 x86-64. * configure.ac (PTY_OPEN, PTY_TTY_NAME_SPRINTF): Adjust to syssignal.h changes. (SIGNAL_H_AB): Remove; no longer needed. * src/alloc.c, src/emacsgtkfixed.c, src/nsfns.m, src/widget.c, src/xmenu.c: Do not include or "syssignal.h", as these modules do not use signals. * src/atimer.c, src/callproc.c, src/data.c, src/dispnew.c, src/emacs.c: * src/floatfns.c, src/gtkutil.c, src/keyboard.c, src/process.c, src/sound.c: * src/sysdep.c, src/term.c, src/xterm.c: Do not include , as "syssignal.h" does that for us now. * src/atimer.c (sigmask_atimers): New function. (block_atimers, unblock_atimers): New functions, replacing the old macros BLOCK_ATIMERS and UNBLOCK_ATIMERS. All uses replaced. * src/conf_post.h [SIGNAL_H_AHB]: Do not include ; no longer needed here. * src/emacs.c (main): Inspect existing signal handler with sigaction, so that there's no need to block and unblock SIGHUP. * src/sysdep.c (struct save_signal): New member 'action', replacing old member 'handler'. (save_signal_handlers, restore_signal_handlers): Use sigaction instead of 'signal' to save and restore. (get_set_sighandler, set_sighandler) [!WINDOWSNT]: New function. All users of 'signal' modified to use set_sighandler if they're writeonly, and to use sys_signal if they're read+write. (emacs_sigaction_init, forwarded_signal): New functions. (sys_signal): Remove. All uses replaced by calls to sigaction and emacs_sigaction_init, or by direct calls to 'signal'. (sys_sigmask) [!__GNUC__]: Remove; no longer needed. (sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove; all uses replaced by pthread_sigmask etc. calls. * src/syssignal.h: Include . (emacs_sigaction_init, forwarded_signal): New decls. (SIGMASKTYPE): Remove. All uses replaced by its definiens, sigset_t. (SIGEMPTYMASK): Remove; all uses replaced by its definiens, empty_mask. (sigmask, sys_sigmask): Remove; no longer needed. (sigpause): Remove. All uses replaced by its definiens, sigsuspend. (sigblock, sigunblock, sigfree): (sigsetmask) [!defined sigsetmask]: Remove. All uses replaced by pthread_sigmask. (signal): Remove. Its remaining uses (with SIG_DFL and SIG_IGN) no longer need to be replaced, and its typical old uses are now done via emacs_sigaction_init and sigaction. (sys_sigblock, sys_sigunblock, sys_sigsetmask): Remove decls. (sys_sigdel): Remove; unused. (NSIG): Remove a FIXME; the code's fine. Remove an unnecessary ifdef. Fixes: debbugs:12327 --- src/floatfns.c | 1 - 1 file changed, 1 deletion(-) (limited to 'src/floatfns.c') diff --git a/src/floatfns.c b/src/floatfns.c index f59cf58228a..e956dc22353 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -45,7 +45,6 @@ along with GNU Emacs. If not, see . */ */ #include -#include #include #include "lisp.h" #include "syssignal.h" -- cgit v1.2.1 From 1a4f1e9b4805cd80952946b5f4461eeb467d9509 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Fri, 7 Sep 2012 01:46:44 -0700 Subject: More signal-handler cleanup. * configure.ac (FLOAT_CHECK_DOMAIN): Comment fix (Bug#12327). * src/floatfns.c: Comment fix. * src/lisp.h (force_auto_save_soon): Declare regardless of SIGDANGER. SIGDANGER might not be in scope so "#ifdef SIGDANGER" is not right, and anyway the declaration is harmless even if SIGDANGER is not defined. * src/syssignal.h (SIGIO): Also #undef if (! defined FIONREAD || defined BROKEN_FIONREAD). systty.h formerly did this, but other source files not surprisingly expected syssignal.h to define, or not define, SIGIO, and it's cleaner to do it that way, for consistency. Include , for FIONREAD. * src/systty.h (SIGIO): Do not #undef here; it's now syssignal.h's job. This eliminates a problem whereby other files mysteriously had to include "syssignal.h" before including "systty.h" if they wanted to use "#ifdef SIGIO". --- src/floatfns.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/floatfns.c') diff --git a/src/floatfns.c b/src/floatfns.c index e956dc22353..3a95d828c0c 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -38,7 +38,7 @@ along with GNU Emacs. If not, see . */ This has no effect if HAVE_MATHERR is defined. Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by - either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and + either setting errno, or signaling SIGFPE. Otherwise, domain and range checking will happen before calling the float routines. This has no effect if HAVE_MATHERR is defined (since matherr will be called when a domain error occurs.) -- cgit v1.2.1 From eabf0404414f2828c08d1d5d8fab4740670e7541 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sat, 8 Sep 2012 12:57:32 -0700 Subject: * floatfns.c (Ftan): Use tan (x), not (sin (x) / cos (x)). This produces more-accurate results. --- src/floatfns.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/floatfns.c') diff --git a/src/floatfns.c b/src/floatfns.c index 3a95d828c0c..dfe063b152f 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -265,12 +265,12 @@ DEFUN ("tan", Ftan, Stan, 1, 1, 0, (register Lisp_Object arg) { double d = extract_float (arg); - double c = cos (d); #ifdef FLOAT_CHECK_DOMAIN + double c = cos (d); if (c == 0.0) domain_error ("tan", arg); #endif - IN_FLOAT (d = sin (d) / c, "tan", arg); + IN_FLOAT (d = tan (d), "tan", arg); return make_float (d); } -- cgit v1.2.1 From f6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0 Mon Sep 17 00:00:00 2001 From: Paul Eggert Date: Sun, 9 Sep 2012 09:06:33 -0700 Subject: Assume C89 or later for math functions. This simplifies the code, and makes it a bit smaller and faster, and (most important) makes it easier to clean up signal handling since we can stop worring about floating-point exceptions in library code. That was a problem before C89, but the problem went away many years ago on all practical Emacs targets. * configure.ac (frexp, fmod): Remove checks for these functions, as we now assume them. (FLOAT_CHECK_DOMAIN, HAVE_INVERSE_HYPERBOLIC, NO_MATHERR) (HAVE_EXCEPTION): Remove; no longer needed. * admin/CPP-DEFINES (HAVE_FMOD, HAVE_FREXP, FLOAT_CHECK_DOMAIN) (HAVE_INVERSE_HYPERBOLIC, NO_MATHERR): Remove. * src/data.c, src/image.c, src/lread.c, src/print.c: Don't include ; no longer needed. * src/data.c, src/floatfns.c (IEEE_FLOATING_POINT): Don't worry that it might be autoconfigured, as that never happens. * src/data.c (fmod): * src/doprnt.c (DBL_MAX_10_EXP): * src/print.c (DBL_DIG): Remove. C89 or later always defines these. * src/floatfns.c (HAVE_MATHERR, FLOAT_CHECK_ERRNO, FLOAT_CHECK_DOMAIN) (in_float, float_error_arg, float_error_arg2, float_error_fn_name) (arith_error, domain_error, domain_error2): Remove all this pre-C89 cruft. Do not include as that's no longer needed -- we simply return what C returns. All uses removed. (IN_FLOAT, IN_FLOAT2): Remove. All uses replaced with the wrapped code. (FLOAT_TO_INT, FLOAT_TO_INT2, range_error, range_error2): Remove. All uses expanded, as these macros are no longer used more than once and are now more trouble than they're worth. (Ftan): Use tan, not sin / cos. (Flogb): Assume C89 frexp. (fmod_float): Assume C89 fmod. (matherr) [HAVE_MATHERR]: Remove; no longer needed. (init_floatfns): Remove. All uses removed. --- src/floatfns.c | 435 +++++++++++---------------------------------------------- 1 file changed, 83 insertions(+), 352 deletions(-) (limited to 'src/floatfns.c') diff --git a/src/floatfns.c b/src/floatfns.c index dfe063b152f..8a9a9fd0886 100644 --- a/src/floatfns.c +++ b/src/floatfns.c @@ -22,26 +22,9 @@ You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ -/* ANSI C requires only these float functions: +/* C89 requires only these math.h functions: acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. - - Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. - Define HAVE_CBRT if you have cbrt. - Define HAVE_RINT if you have a working rint. - If you don't define these, then the appropriate routines will be simulated. - - Define HAVE_MATHERR if on a system supporting the SysV matherr callback. - (This should happen automatically.) - - Define FLOAT_CHECK_ERRNO if the float library routines set errno. - This has no effect if HAVE_MATHERR is defined. - - Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by - either setting errno, or signaling SIGFPE. Otherwise, domain and - range checking will happen before calling the float routines. This has - no effect if HAVE_MATHERR is defined (since matherr will be called when - a domain error occurs.) */ #include @@ -50,15 +33,12 @@ along with GNU Emacs. If not, see . */ #include "syssignal.h" #include -/* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ -#ifndef IEEE_FLOATING_POINT #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) #define IEEE_FLOATING_POINT 1 #else #define IEEE_FLOATING_POINT 0 #endif -#endif #include @@ -67,120 +47,6 @@ along with GNU Emacs. If not, see . */ extern double logb (double); #endif /* not HPUX and HAVE_LOGB and no logb macro */ -#if defined (DOMAIN) && defined (SING) && defined (OVERFLOW) - /* If those are defined, then this is probably a `matherr' machine. */ -# ifndef HAVE_MATHERR -# define HAVE_MATHERR -# endif -#endif - -#ifdef NO_MATHERR -#undef HAVE_MATHERR -#endif - -#ifdef HAVE_MATHERR -# ifdef FLOAT_CHECK_ERRNO -# undef FLOAT_CHECK_ERRNO -# endif -# ifdef FLOAT_CHECK_DOMAIN -# undef FLOAT_CHECK_DOMAIN -# endif -#endif - -#ifndef NO_FLOAT_CHECK_ERRNO -#define FLOAT_CHECK_ERRNO -#endif - -#ifdef FLOAT_CHECK_ERRNO -# include -#endif - -/* True while executing in floating point. - This tells float_error what to do. */ - -static bool in_float; - -/* If an argument is out of range for a mathematical function, - here is the actual argument value to use in the error message. - These variables are used only across the floating point library call - so there is no need to staticpro them. */ - -static Lisp_Object float_error_arg, float_error_arg2; - -static const char *float_error_fn_name; - -/* Evaluate the floating point expression D, recording NUM - as the original argument for error messages. - D is normally an assignment expression. - Handle errors which may result in signals or may set errno. - - Note that float_error may be declared to return void, so you can't - just cast the zero after the colon to (void) to make the types - check properly. */ - -#ifdef FLOAT_CHECK_ERRNO -#define IN_FLOAT(d, name, num) \ - do { \ - float_error_arg = num; \ - float_error_fn_name = name; \ - in_float = 1; errno = 0; (d); in_float = 0; \ - switch (errno) { \ - case 0: break; \ - case EDOM: domain_error (float_error_fn_name, float_error_arg); \ - case ERANGE: range_error (float_error_fn_name, float_error_arg); \ - default: arith_error (float_error_fn_name, float_error_arg); \ - } \ - } while (0) -#define IN_FLOAT2(d, name, num, num2) \ - do { \ - float_error_arg = num; \ - float_error_arg2 = num2; \ - float_error_fn_name = name; \ - in_float = 1; errno = 0; (d); in_float = 0; \ - switch (errno) { \ - case 0: break; \ - case EDOM: domain_error (float_error_fn_name, float_error_arg); \ - case ERANGE: range_error (float_error_fn_name, float_error_arg); \ - default: arith_error (float_error_fn_name, float_error_arg); \ - } \ - } while (0) -#else -#define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) -#define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0) -#endif - -/* Convert float to Lisp_Int if it fits, else signal a range error - using the given arguments. */ -#define FLOAT_TO_INT(x, i, name, num) \ - do \ - { \ - if (FIXNUM_OVERFLOW_P (x)) \ - range_error (name, num); \ - XSETINT (i, (EMACS_INT)(x)); \ - } \ - while (0) -#define FLOAT_TO_INT2(x, i, name, num1, num2) \ - do \ - { \ - if (FIXNUM_OVERFLOW_P (x)) \ - range_error2 (name, num1, num2); \ - XSETINT (i, (EMACS_INT)(x)); \ - } \ - while (0) - -#define arith_error(op,arg) \ - xsignal2 (Qarith_error, build_string ((op)), (arg)) -#define range_error(op,arg) \ - xsignal2 (Qrange_error, build_string ((op)), (arg)) -#define range_error2(op,a1,a2) \ - xsignal3 (Qrange_error, build_string ((op)), (a1), (a2)) -#define domain_error(op,arg) \ - xsignal2 (Qdomain_error, build_string ((op)), (arg)) -#ifdef FLOAT_CHECK_DOMAIN -#define domain_error2(op,a1,a2) \ - xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2)) -#endif - /* Extract a Lisp number as a `double', or signal an error. */ double @@ -197,27 +63,19 @@ extract_float (Lisp_Object num) DEFUN ("acos", Facos, Sacos, 1, 1, 0, doc: /* Return the inverse cosine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 1.0 || d < -1.0) - domain_error ("acos", arg); -#endif - IN_FLOAT (d = acos (d), "acos", arg); + d = acos (d); return make_float (d); } DEFUN ("asin", Fasin, Sasin, 1, 1, 0, doc: /* Return the inverse sine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 1.0 || d < -1.0) - domain_error ("asin", arg); -#endif - IN_FLOAT (d = asin (d), "asin", arg); + d = asin (d); return make_float (d); } @@ -227,50 +85,44 @@ If only one argument Y is given, return the inverse tangent of Y. If two arguments Y and X are given, return the inverse tangent of Y divided by X, i.e. the angle in radians between the vector (X, Y) and the x-axis. */) - (register Lisp_Object y, Lisp_Object x) + (Lisp_Object y, Lisp_Object x) { double d = extract_float (y); if (NILP (x)) - IN_FLOAT (d = atan (d), "atan", y); + d = atan (d); else { double d2 = extract_float (x); - - IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x); + d = atan2 (d, d2); } return make_float (d); } DEFUN ("cos", Fcos, Scos, 1, 1, 0, doc: /* Return the cosine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = cos (d), "cos", arg); + d = cos (d); return make_float (d); } DEFUN ("sin", Fsin, Ssin, 1, 1, 0, doc: /* Return the sine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = sin (d), "sin", arg); + d = sin (d); return make_float (d); } DEFUN ("tan", Ftan, Stan, 1, 1, 0, doc: /* Return the tangent of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - double c = cos (d); - if (c == 0.0) - domain_error ("tan", arg); -#endif - IN_FLOAT (d = tan (d), "tan", arg); + d = tan (d); return make_float (d); } @@ -341,61 +193,61 @@ Returns the floating point value resulting from multiplying SGNFCAND DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, doc: /* Return the bessel function j0 of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = j0 (d), "bessel-j0", arg); + d = j0 (d); return make_float (d); } DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, doc: /* Return the bessel function j1 of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = j1 (d), "bessel-j1", arg); + d = j1 (d); return make_float (d); } DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, doc: /* Return the order N bessel function output jn of ARG. The first arg (the order) is truncated to an integer. */) - (register Lisp_Object n, Lisp_Object arg) + (Lisp_Object n, Lisp_Object arg) { int i1 = extract_float (n); double f2 = extract_float (arg); - IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); + f2 = jn (i1, f2); return make_float (f2); } DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, doc: /* Return the bessel function y0 of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = y0 (d), "bessel-y0", arg); + d = y0 (d); return make_float (d); } DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, doc: /* Return the bessel function y1 of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = y1 (d), "bessel-y0", arg); + d = y1 (d); return make_float (d); } DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, doc: /* Return the order N bessel function output yn of ARG. The first arg (the order) is truncated to an integer. */) - (register Lisp_Object n, Lisp_Object arg) + (Lisp_Object n, Lisp_Object arg) { int i1 = extract_float (n); double f2 = extract_float (arg); - IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); + f2 = yn (i1, f2); return make_float (f2); } @@ -405,43 +257,43 @@ The first arg (the order) is truncated to an integer. */) DEFUN ("erf", Ferf, Serf, 1, 1, 0, doc: /* Return the mathematical error function of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = erf (d), "erf", arg); + d = erf (d); return make_float (d); } DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, doc: /* Return the complementary error function of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = erfc (d), "erfc", arg); + d = erfc (d); return make_float (d); } DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, doc: /* Return the log gamma of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = lgamma (d), "log-gamma", arg); + d = lgamma (d); return make_float (d); } DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, doc: /* Return the cube root of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); #ifdef HAVE_CBRT - IN_FLOAT (d = cbrt (d), "cube-root", arg); + d = cbrt (d); #else if (d >= 0.0) - IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); + d = pow (d, 1.0/3.0); else - IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); + d = -pow (-d, 1.0/3.0); #endif return make_float (d); } @@ -450,23 +302,16 @@ DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, DEFUN ("exp", Fexp, Sexp, 1, 1, 0, doc: /* Return the exponential base e of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 709.7827) /* Assume IEEE doubles here */ - range_error ("exp", arg); - else if (d < -709.0) - return make_float (0.0); - else -#endif - IN_FLOAT (d = exp (d), "exp", arg); + d = exp (d); return make_float (d); } DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, doc: /* Return the exponential ARG1 ** ARG2. */) - (register Lisp_Object arg1, Lisp_Object arg2) + (Lisp_Object arg1, Lisp_Object arg2) { double f1, f2, f3; @@ -495,72 +340,46 @@ DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, } f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1); f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2); - /* Really should check for overflow, too */ - if (f1 == 0.0 && f2 == 0.0) - f1 = 1.0; -#ifdef FLOAT_CHECK_DOMAIN - else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor (f2))) - domain_error2 ("expt", arg1, arg2); -#endif - IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2); - /* Check for overflow in the result. */ - if (f1 != 0.0 && f3 == 0.0) - range_error ("expt", arg1); + f3 = pow (f1, f2); return make_float (f3); } DEFUN ("log", Flog, Slog, 1, 2, 0, doc: /* Return the natural logarithm of ARG. If the optional argument BASE is given, return log ARG using that base. */) - (register Lisp_Object arg, Lisp_Object base) + (Lisp_Object arg, Lisp_Object base) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d <= 0.0) - domain_error2 ("log", arg, base); -#endif if (NILP (base)) - IN_FLOAT (d = log (d), "log", arg); + d = log (d); else { double b = extract_float (base); -#ifdef FLOAT_CHECK_DOMAIN - if (b <= 0.0 || b == 1.0) - domain_error2 ("log", arg, base); -#endif if (b == 10.0) - IN_FLOAT2 (d = log10 (d), "log", arg, base); + d = log10 (d); else - IN_FLOAT2 (d = log (d) / log (b), "log", arg, base); + d = log (d) / log (b); } return make_float (d); } DEFUN ("log10", Flog10, Slog10, 1, 1, 0, doc: /* Return the logarithm base 10 of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d <= 0.0) - domain_error ("log10", arg); -#endif - IN_FLOAT (d = log10 (d), "log10", arg); + d = log10 (d); return make_float (d); } DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, doc: /* Return the square root of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d < 0.0) - domain_error ("sqrt", arg); -#endif - IN_FLOAT (d = sqrt (d), "sqrt", arg); + d = sqrt (d); return make_float (d); } @@ -568,83 +387,55 @@ DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, doc: /* Return the inverse hyperbolic cosine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d < 1.0) - domain_error ("acosh", arg); -#endif -#ifdef HAVE_INVERSE_HYPERBOLIC - IN_FLOAT (d = acosh (d), "acosh", arg); -#else - IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg); -#endif + d = acosh (d); return make_float (d); } DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, doc: /* Return the inverse hyperbolic sine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef HAVE_INVERSE_HYPERBOLIC - IN_FLOAT (d = asinh (d), "asinh", arg); -#else - IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg); -#endif + d = asinh (d); return make_float (d); } DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, doc: /* Return the inverse hyperbolic tangent of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d >= 1.0 || d <= -1.0) - domain_error ("atanh", arg); -#endif -#ifdef HAVE_INVERSE_HYPERBOLIC - IN_FLOAT (d = atanh (d), "atanh", arg); -#else - IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg); -#endif + d = atanh (d); return make_float (d); } DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, doc: /* Return the hyperbolic cosine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 710.0 || d < -710.0) - range_error ("cosh", arg); -#endif - IN_FLOAT (d = cosh (d), "cosh", arg); + d = cosh (d); return make_float (d); } DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, doc: /* Return the hyperbolic sine of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); -#ifdef FLOAT_CHECK_DOMAIN - if (d > 710.0 || d < -710.0) - range_error ("sinh", arg); -#endif - IN_FLOAT (d = sinh (d), "sinh", arg); + d = sinh (d); return make_float (d); } DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, doc: /* Return the hyperbolic tangent of ARG. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = tanh (d), "tanh", arg); + d = tanh (d); return make_float (d); } #endif @@ -689,33 +480,11 @@ This is the same as the exponent of a float. */) else { #ifdef HAVE_LOGB - IN_FLOAT (value = logb (f), "logb", arg); + value = logb (f); #else -#ifdef HAVE_FREXP int ivalue; - IN_FLOAT (frexp (f, &ivalue), "logb", arg); + frexp (f, &ivalue); value = ivalue - 1; -#else - int i; - double d; - if (f < 0.0) - f = -f; - value = -1; - while (f < 0.5) - { - for (i = 1, d = 0.5; d * d >= f; i += i) - d *= d; - f /= d; - value -= i; - } - while (f >= 1.0) - { - for (i = 1, d = 2.0; d * d <= f; i += i) - d *= d; - f /= d; - value += i; - } -#endif #endif } XSETINT (val, value); @@ -748,8 +517,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (! IEEE_FLOATING_POINT && f2 == 0) xsignal0 (Qarith_error); - IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); - FLOAT_TO_INT2 (f1, arg, name, arg, divisor); + f1 = (*double_round) (f1 / f2); + if (FIXNUM_OVERFLOW_P (f1)) + xsignal3 (Qrange_error, build_string (name), arg, divisor); + arg = make_number (f1); return arg; } @@ -765,10 +536,10 @@ rounding_driver (Lisp_Object arg, Lisp_Object divisor, if (FLOATP (arg)) { - double d; - - IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg); - FLOAT_TO_INT (d, arg, name, arg); + double d = (*double_round) (XFLOAT_DATA (arg)); + if (FIXNUM_OVERFLOW_P (d)) + xsignal2 (Qrange_error, build_string (name), arg); + arg = make_number (d); } return arg; @@ -885,97 +656,57 @@ fmod_float (Lisp_Object x, Lisp_Object y) f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); - if (! IEEE_FLOATING_POINT && f2 == 0) - xsignal0 (Qarith_error); + f1 = fmod (f1, f2); /* If the "remainder" comes out with the wrong sign, fix it. */ - IN_FLOAT2 ((f1 = fmod (f1, f2), - f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1), - "mod", x, y); + if (f2 < 0 ? 0 < f1 : f1 < 0) + f1 += f2; + return make_float (f1); } -/* It's not clear these are worth adding. */ - DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, doc: /* Return the smallest integer no less than ARG, as a float. \(Round toward +inf.\) */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = ceil (d), "fceiling", arg); + d = ceil (d); return make_float (d); } DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, doc: /* Return the largest integer no greater than ARG, as a float. \(Round towards -inf.\) */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = floor (d), "ffloor", arg); + d = floor (d); return make_float (d); } DEFUN ("fround", Ffround, Sfround, 1, 1, 0, doc: /* Return the nearest integer to ARG, as a float. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); - IN_FLOAT (d = emacs_rint (d), "fround", arg); + d = emacs_rint (d); return make_float (d); } DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, doc: /* Truncate a floating point number to an integral float value. Rounds the value toward zero. */) - (register Lisp_Object arg) + (Lisp_Object arg) { double d = extract_float (arg); if (d >= 0.0) - IN_FLOAT (d = floor (d), "ftruncate", arg); + d = floor (d); else - IN_FLOAT (d = ceil (d), "ftruncate", arg); + d = ceil (d); return make_float (d); } -#ifdef HAVE_MATHERR -int -matherr (struct exception *x) -{ - Lisp_Object args; - const char *name = x->name; - - if (! in_float) - /* Not called from emacs-lisp float routines; do the default thing. */ - return 0; - if (!strcmp (x->name, "pow")) - name = "expt"; - - args - = Fcons (build_string (name), - Fcons (make_float (x->arg1), - ((!strcmp (name, "log") || !strcmp (name, "pow")) - ? Fcons (make_float (x->arg2), Qnil) - : Qnil))); - switch (x->type) - { - case DOMAIN: xsignal (Qdomain_error, args); break; - case SING: xsignal (Qsingularity_error, args); break; - case OVERFLOW: xsignal (Qoverflow_error, args); break; - case UNDERFLOW: xsignal (Qunderflow_error, args); break; - default: xsignal (Qarith_error, args); break; - } - return (1); /* don't set errno or print a message */ -} -#endif /* HAVE_MATHERR */ - -void -init_floatfns (void) -{ - in_float = 0; -} - void syms_of_floatfns (void) { -- cgit v1.2.1