Mercurial > emacs
annotate src/floatfns.c @ 97722:38eecdd090f7
(calendar-holidays): Doc fix.
author | Glenn Morris <rgm@gnu.org> |
---|---|
date | Tue, 26 Aug 2008 05:39:19 +0000 |
parents | c3512b2085a0 |
children | e038c1a8307c |
rev | line source |
---|---|
102 | 1 /* Primitive operations on floating point for GNU Emacs Lisp interpreter. |
75227
e90d04cd455a
Update copyright for years from Emacs 21 to present (mainly adding
Glenn Morris <rgm@gnu.org>
parents:
71978
diff
changeset
|
2 Copyright (C) 1988, 1993, 1994, 1999, 2001, 2002, 2003, 2004, |
79759 | 3 2005, 2006, 2007, 2008 Free Software Foundation, Inc. |
102 | 4 |
5 This file is part of GNU Emacs. | |
6 | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
7 GNU Emacs is free software: you can redistribute it and/or modify |
102 | 8 it under the terms of the GNU General Public License as published by |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
9 the Free Software Foundation, either version 3 of the License, or |
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
10 (at your option) any later version. |
102 | 11 |
12 GNU Emacs is distributed in the hope that it will be useful, | |
13 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
15 GNU General Public License for more details. | |
16 | |
17 You should have received a copy of the GNU General Public License | |
94963
8971ddf55736
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
87649
diff
changeset
|
18 along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ |
102 | 19 |
20 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
21 /* ANSI C requires only these float functions: |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
22 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod, |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
23 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
24 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
25 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
26 Define HAVE_CBRT if you have cbrt. |
19737
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
27 Define HAVE_RINT if you have a working rint. |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
28 If you don't define these, then the appropriate routines will be simulated. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
29 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
30 Define HAVE_MATHERR if on a system supporting the SysV matherr callback. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
31 (This should happen automatically.) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
32 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
33 Define FLOAT_CHECK_ERRNO if the float library routines set errno. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
34 This has no effect if HAVE_MATHERR is defined. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
35 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
36 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
37 (What systems actually do this? Please let us know.) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
38 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
39 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by |
14036 | 40 either setting errno, or signaling SIGFPE/SIGILL. Otherwise, domain and |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
41 range checking will happen before calling the float routines. This has |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
42 no effect if HAVE_MATHERR is defined (since matherr will be called when |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
43 a domain error occurs.) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
44 */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
45 |
26088
b7aa6ac26872
Add support for large files, 64-bit Solaris, system locale codings.
Paul Eggert <eggert@twinsun.com>
parents:
25645
diff
changeset
|
46 #include <config.h> |
102 | 47 #include <signal.h> |
48 #include "lisp.h" | |
638 | 49 #include "syssignal.h" |
102 | 50 |
20122
923e1f635ace
No need to include <float.h> before "lisp.h",
Paul Eggert <eggert@twinsun.com>
parents:
19737
diff
changeset
|
51 #if STDC_HEADERS |
923e1f635ace
No need to include <float.h> before "lisp.h",
Paul Eggert <eggert@twinsun.com>
parents:
19737
diff
changeset
|
52 #include <float.h> |
923e1f635ace
No need to include <float.h> before "lisp.h",
Paul Eggert <eggert@twinsun.com>
parents:
19737
diff
changeset
|
53 #endif |
923e1f635ace
No need to include <float.h> before "lisp.h",
Paul Eggert <eggert@twinsun.com>
parents:
19737
diff
changeset
|
54 |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
55 /* If IEEE_FLOATING_POINT isn't defined, default it from FLT_*. */ |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
56 #ifndef IEEE_FLOATING_POINT |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
57 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
58 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
59 #define IEEE_FLOATING_POINT 1 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
60 #else |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
61 #define IEEE_FLOATING_POINT 0 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
62 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
63 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
64 |
102 | 65 #include <math.h> |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
66 |
4881
e53d4ae93675
Declare `logb' only if HAVE_LOGB is defined.
Brian Fox <bfox@gnu.org>
parents:
4843
diff
changeset
|
67 /* This declaration is omitted on some systems, like Ultrix. */ |
7448
bf93ac2d8409
Don't declare logb if it is a macro.
Richard M. Stallman <rms@gnu.org>
parents:
7361
diff
changeset
|
68 #if !defined (HPUX) && defined (HAVE_LOGB) && !defined (logb) |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
69 extern double logb (); |
7448
bf93ac2d8409
Don't declare logb if it is a macro.
Richard M. Stallman <rms@gnu.org>
parents:
7361
diff
changeset
|
70 #endif /* not HPUX and HAVE_LOGB and no logb macro */ |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
71 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
72 #if defined(DOMAIN) && defined(SING) && defined(OVERFLOW) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
73 /* If those are defined, then this is probably a `matherr' machine. */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
74 # ifndef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
75 # define HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
76 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
77 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
78 |
3027
7ed290bef028
Fix typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
3025
diff
changeset
|
79 #ifdef NO_MATHERR |
3025
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
80 #undef HAVE_MATHERR |
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
81 #endif |
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
82 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
83 #ifdef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
84 # ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
85 # undef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
86 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
87 # ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
88 # undef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
89 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
90 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
91 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
92 #ifndef NO_FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
93 #define FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
94 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
95 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
96 #ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
97 # include <errno.h> |
485 | 98 |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
27727
diff
changeset
|
99 #ifndef USE_CRT_DLL |
485 | 100 extern int errno; |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
101 #endif |
31095
e19d38e14720
[USE_CRT_DLL]: Remove unnecessary extern, which screws
Andrew Innes <andrewi@gnu.org>
parents:
27727
diff
changeset
|
102 #endif |
485 | 103 |
39814
a9c8422074c9
float_error() is defined iff FLOAT_CATCH_SIGILL is defined.
Pavel Janík <Pavel@Janik.cz>
parents:
39638
diff
changeset
|
104 #ifdef FLOAT_CATCH_SIGILL |
621 | 105 static SIGTYPE float_error (); |
39814
a9c8422074c9
float_error() is defined iff FLOAT_CATCH_SIGILL is defined.
Pavel Janík <Pavel@Janik.cz>
parents:
39638
diff
changeset
|
106 #endif |
102 | 107 |
108 /* Nonzero while executing in floating point. | |
109 This tells float_error what to do. */ | |
110 | |
111 static int in_float; | |
112 | |
113 /* If an argument is out of range for a mathematical function, | |
16207 | 114 here is the actual argument value to use in the error message. |
115 These variables are used only across the floating point library call | |
116 so there is no need to staticpro them. */ | |
102 | 117 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
118 static Lisp_Object float_error_arg, float_error_arg2; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
119 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
120 static char *float_error_fn_name; |
102 | 121 |
485 | 122 /* Evaluate the floating point expression D, recording NUM |
123 as the original argument for error messages. | |
124 D is normally an assignment expression. | |
1918
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
125 Handle errors which may result in signals or may set errno. |
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
126 |
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
127 Note that float_error may be declared to return void, so you can't |
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
128 just cast the zero after the colon to (SIGTYPE) to make the types |
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
129 check properly. */ |
485 | 130 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
131 #ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
132 #define IN_FLOAT(d, name, num) \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
133 do { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
134 float_error_arg = num; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
135 float_error_fn_name = name; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
136 in_float = 1; errno = 0; (d); in_float = 0; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
137 switch (errno) { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
138 case 0: break; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
139 case EDOM: domain_error (float_error_fn_name, float_error_arg); \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
140 case ERANGE: range_error (float_error_fn_name, float_error_arg); \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
141 default: arith_error (float_error_fn_name, float_error_arg); \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
142 } \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
143 } while (0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
144 #define IN_FLOAT2(d, name, num, num2) \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
145 do { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
146 float_error_arg = num; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
147 float_error_arg2 = num2; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
148 float_error_fn_name = name; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
149 in_float = 1; errno = 0; (d); in_float = 0; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
150 switch (errno) { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
151 case 0: break; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
152 case EDOM: domain_error (float_error_fn_name, float_error_arg); \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
153 case ERANGE: range_error (float_error_fn_name, float_error_arg); \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
154 default: arith_error (float_error_fn_name, float_error_arg); \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
155 } \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
156 } while (0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
157 #else |
3407
d00aaf536bfd
[!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition.
Richard M. Stallman <rms@gnu.org>
parents:
3094
diff
changeset
|
158 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
159 #define IN_FLOAT2(d, name, num, num2) (in_float = 1, (d), in_float = 0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
160 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
161 |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
162 /* Convert float to Lisp_Int if it fits, else signal a range error |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
163 using the given arguments. */ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
164 #define FLOAT_TO_INT(x, i, name, num) \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
165 do \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
166 { \ |
39638
911382113c16
(FLOAT_TO_INT2, FLOAT_TO_INT): Use FIXNUM_OVERFLOW_P.
Gerd Moellmann <gerd@gnu.org>
parents:
31095
diff
changeset
|
167 if (FIXNUM_OVERFLOW_P (x)) \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
168 range_error (name, num); \ |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
169 XSETINT (i, (EMACS_INT)(x)); \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
170 } \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
171 while (0) |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
172 #define FLOAT_TO_INT2(x, i, name, num1, num2) \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
173 do \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
174 { \ |
39638
911382113c16
(FLOAT_TO_INT2, FLOAT_TO_INT): Use FIXNUM_OVERFLOW_P.
Gerd Moellmann <gerd@gnu.org>
parents:
31095
diff
changeset
|
175 if (FIXNUM_OVERFLOW_P (x)) \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
176 range_error2 (name, num1, num2); \ |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
177 XSETINT (i, (EMACS_INT)(x)); \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
178 } \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
179 while (0) |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
180 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
181 #define arith_error(op,arg) \ |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
182 xsignal2 (Qarith_error, build_string ((op)), (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
183 #define range_error(op,arg) \ |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
184 xsignal2 (Qrange_error, build_string ((op)), (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
185 #define range_error2(op,a1,a2) \ |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
186 xsignal3 (Qrange_error, build_string ((op)), (a1), (a2)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
187 #define domain_error(op,arg) \ |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
188 xsignal2 (Qdomain_error, build_string ((op)), (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
189 #define domain_error2(op,a1,a2) \ |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
190 xsignal3 (Qdomain_error, build_string ((op)), (a1), (a2)) |
102 | 191 |
192 /* Extract a Lisp number as a `double', or signal an error. */ | |
193 | |
194 double | |
195 extract_float (num) | |
196 Lisp_Object num; | |
197 { | |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
198 CHECK_NUMBER_OR_FLOAT (num); |
102 | 199 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
200 if (FLOATP (num)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
201 return XFLOAT_DATA (num); |
102 | 202 return (double) XINT (num); |
203 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
204 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
205 /* Trig functions. */ |
102 | 206 |
207 DEFUN ("acos", Facos, Sacos, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
208 doc: /* Return the inverse cosine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
209 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
210 register Lisp_Object arg; |
102 | 211 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
212 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
213 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
214 if (d > 1.0 || d < -1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
215 domain_error ("acos", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
216 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
217 IN_FLOAT (d = acos (d), "acos", arg); |
102 | 218 return make_float (d); |
219 } | |
220 | |
221 DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
222 doc: /* Return the inverse sine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
223 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
224 register Lisp_Object arg; |
102 | 225 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
226 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
227 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
228 if (d > 1.0 || d < -1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
229 domain_error ("asin", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
230 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
231 IN_FLOAT (d = asin (d), "asin", arg); |
102 | 232 return make_float (d); |
233 } | |
234 | |
43413
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
235 DEFUN ("atan", Fatan, Satan, 1, 2, 0, |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
236 doc: /* Return the inverse tangent of the arguments. |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
237 If only one argument Y is given, return the inverse tangent of Y. |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
238 If two arguments Y and X are given, return the inverse tangent of Y |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
239 divided by X, i.e. the angle in radians between the vector (X, Y) |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
240 and the x-axis. */) |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
241 (y, x) |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
242 register Lisp_Object y, x; |
102 | 243 { |
43413
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
244 double d = extract_float (y); |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
245 |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
246 if (NILP (x)) |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
247 IN_FLOAT (d = atan (d), "atan", y); |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
248 else |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
249 { |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
250 double d2 = extract_float (x); |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
251 |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
252 IN_FLOAT2 (d = atan2 (d, d2), "atan", y, x); |
0f448bd1bf9a
(Fatan): Accept an optional second arg and call atan2 if passed 2 args.
Eli Zaretskii <eliz@gnu.org>
parents:
43189
diff
changeset
|
253 } |
102 | 254 return make_float (d); |
255 } | |
256 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
257 DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
258 doc: /* Return the cosine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
259 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
260 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
261 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
262 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
263 IN_FLOAT (d = cos (d), "cos", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
264 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
265 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
266 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
267 DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
268 doc: /* Return the sine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
269 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
270 register Lisp_Object arg; |
102 | 271 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
272 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
273 IN_FLOAT (d = sin (d), "sin", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
274 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
275 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
276 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
277 DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
278 doc: /* Return the tangent of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
279 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
280 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
281 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
282 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
283 double c = cos (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
284 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
285 if (c == 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
286 domain_error ("tan", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
287 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
288 IN_FLOAT (d = sin (d) / c, "tan", arg); |
102 | 289 return make_float (d); |
290 } | |
291 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
292 #if 0 /* Leave these out unless we find there's a reason for them. */ |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
293 |
102 | 294 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
295 doc: /* Return the bessel function j0 of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
296 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
297 register Lisp_Object arg; |
102 | 298 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
299 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
300 IN_FLOAT (d = j0 (d), "bessel-j0", arg); |
102 | 301 return make_float (d); |
302 } | |
303 | |
304 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
305 doc: /* Return the bessel function j1 of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
306 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
307 register Lisp_Object arg; |
102 | 308 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
309 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
310 IN_FLOAT (d = j1 (d), "bessel-j1", arg); |
102 | 311 return make_float (d); |
312 } | |
313 | |
314 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
315 doc: /* Return the order N bessel function output jn of ARG. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
316 The first arg (the order) is truncated to an integer. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
317 (n, arg) |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
318 register Lisp_Object n, arg; |
102 | 319 { |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
320 int i1 = extract_float (n); |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
321 double f2 = extract_float (arg); |
102 | 322 |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
323 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); |
102 | 324 return make_float (f2); |
325 } | |
326 | |
327 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
328 doc: /* Return the bessel function y0 of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
329 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
330 register Lisp_Object arg; |
102 | 331 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
332 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
333 IN_FLOAT (d = y0 (d), "bessel-y0", arg); |
102 | 334 return make_float (d); |
335 } | |
336 | |
337 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
338 doc: /* Return the bessel function y1 of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
339 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
340 register Lisp_Object arg; |
102 | 341 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
342 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
343 IN_FLOAT (d = y1 (d), "bessel-y0", arg); |
102 | 344 return make_float (d); |
345 } | |
346 | |
347 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
348 doc: /* Return the order N bessel function output yn of ARG. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
349 The first arg (the order) is truncated to an integer. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
350 (n, arg) |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
351 register Lisp_Object n, arg; |
102 | 352 { |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
353 int i1 = extract_float (n); |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
354 double f2 = extract_float (arg); |
102 | 355 |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
356 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); |
102 | 357 return make_float (f2); |
358 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
359 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
360 #endif |
102 | 361 |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
362 #if 0 /* Leave these out unless we see they are worth having. */ |
102 | 363 |
364 DEFUN ("erf", Ferf, Serf, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
365 doc: /* Return the mathematical error function of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
366 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
367 register Lisp_Object arg; |
102 | 368 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
369 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
370 IN_FLOAT (d = erf (d), "erf", arg); |
102 | 371 return make_float (d); |
372 } | |
373 | |
374 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
375 doc: /* Return the complementary error function of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
376 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
377 register Lisp_Object arg; |
102 | 378 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
379 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
380 IN_FLOAT (d = erfc (d), "erfc", arg); |
102 | 381 return make_float (d); |
382 } | |
383 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
384 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
385 doc: /* Return the log gamma of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
386 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
387 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
388 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
389 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
390 IN_FLOAT (d = lgamma (d), "log-gamma", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
391 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
392 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
393 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
394 DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
395 doc: /* Return the cube root of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
396 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
397 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
398 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
399 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
400 #ifdef HAVE_CBRT |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
401 IN_FLOAT (d = cbrt (d), "cube-root", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
402 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
403 if (d >= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
404 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
405 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
406 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
407 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
408 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
409 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
410 |
694 | 411 #endif |
412 | |
102 | 413 DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
414 doc: /* Return the exponential base e of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
415 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
416 register Lisp_Object arg; |
102 | 417 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
418 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
419 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
420 if (d > 709.7827) /* Assume IEEE doubles here */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
421 range_error ("exp", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
422 else if (d < -709.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
423 return make_float (0.0); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
424 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
425 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
426 IN_FLOAT (d = exp (d), "exp", arg); |
102 | 427 return make_float (d); |
428 } | |
429 | |
430 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
431 doc: /* Return the exponential ARG1 ** ARG2. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
432 (arg1, arg2) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
433 register Lisp_Object arg1, arg2; |
102 | 434 { |
84998
259a9fdd1450
(Fexpt): Manually check for overflows, so that a power
Michaël Cadilhac <michael.cadilhac@lrde.org>
parents:
78260
diff
changeset
|
435 double f1, f2, f3; |
102 | 436 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
437 CHECK_NUMBER_OR_FLOAT (arg1); |
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
438 CHECK_NUMBER_OR_FLOAT (arg2); |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
439 if (INTEGERP (arg1) /* common lisp spec */ |
64810
3529fe766935
(Fexpt): Use floats for negative exponent.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64778
diff
changeset
|
440 && INTEGERP (arg2) /* don't promote, if both are ints, and */ |
3529fe766935
(Fexpt): Use floats for negative exponent.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
64778
diff
changeset
|
441 && 0 <= XINT (arg2)) /* we are sure the result is not fractional */ |
102 | 442 { /* this can be improved by pre-calculating */ |
12537
476296adb950
(Fexpt): Use EMACS_INT for integer calculation.
Karl Heuer <kwzh@gnu.org>
parents:
11859
diff
changeset
|
443 EMACS_INT acc, x, y; /* some binary powers of x then accumulating */ |
3673
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
444 Lisp_Object val; |
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
445 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
446 x = XINT (arg1); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
447 y = XINT (arg2); |
102 | 448 acc = 1; |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43413
diff
changeset
|
449 |
102 | 450 if (y < 0) |
451 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
452 if (x == 1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
453 acc = 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
454 else if (x == -1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
455 acc = (y & 1) ? -1 : 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
456 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
457 acc = 0; |
102 | 458 } |
459 else | |
460 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
461 while (y > 0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
462 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
463 if (y & 1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
464 acc *= x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
465 x *= x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
466 y = (unsigned)y >> 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
467 } |
102 | 468 } |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
469 XSETINT (val, acc); |
3673
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
470 return val; |
102 | 471 } |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
472 f1 = FLOATP (arg1) ? XFLOAT_DATA (arg1) : XINT (arg1); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
473 f2 = FLOATP (arg2) ? XFLOAT_DATA (arg2) : XINT (arg2); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
474 /* Really should check for overflow, too */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
475 if (f1 == 0.0 && f2 == 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
476 f1 = 1.0; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
477 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
478 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2))) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
479 domain_error2 ("expt", arg1, arg2); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
480 #endif |
84998
259a9fdd1450
(Fexpt): Manually check for overflows, so that a power
Michaël Cadilhac <michael.cadilhac@lrde.org>
parents:
78260
diff
changeset
|
481 IN_FLOAT2 (f3 = pow (f1, f2), "expt", arg1, arg2); |
259a9fdd1450
(Fexpt): Manually check for overflows, so that a power
Michaël Cadilhac <michael.cadilhac@lrde.org>
parents:
78260
diff
changeset
|
482 /* Check for overflow in the result. */ |
259a9fdd1450
(Fexpt): Manually check for overflows, so that a power
Michaël Cadilhac <michael.cadilhac@lrde.org>
parents:
78260
diff
changeset
|
483 if (f1 != 0.0 && f3 == 0.0) |
259a9fdd1450
(Fexpt): Manually check for overflows, so that a power
Michaël Cadilhac <michael.cadilhac@lrde.org>
parents:
78260
diff
changeset
|
484 range_error ("expt", arg1); |
259a9fdd1450
(Fexpt): Manually check for overflows, so that a power
Michaël Cadilhac <michael.cadilhac@lrde.org>
parents:
78260
diff
changeset
|
485 return make_float (f3); |
102 | 486 } |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
487 |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
488 DEFUN ("log", Flog, Slog, 1, 2, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
489 doc: /* Return the natural logarithm of ARG. |
67496 | 490 If the optional argument BASE is given, return log ARG using that base. */) |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
491 (arg, base) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
492 register Lisp_Object arg, base; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
493 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
494 double d = extract_float (arg); |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
495 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
496 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
497 if (d <= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
498 domain_error2 ("log", arg, base); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
499 #endif |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
500 if (NILP (base)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
501 IN_FLOAT (d = log (d), "log", arg); |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
502 else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
503 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
504 double b = extract_float (base); |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
505 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
506 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
507 if (b <= 0.0 || b == 1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
508 domain_error2 ("log", arg, base); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
509 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
510 if (b == 10.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
511 IN_FLOAT2 (d = log10 (d), "log", arg, base); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
512 else |
3407
d00aaf536bfd
[!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition.
Richard M. Stallman <rms@gnu.org>
parents:
3094
diff
changeset
|
513 IN_FLOAT2 (d = log (d) / log (b), "log", arg, base); |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
514 } |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
515 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
516 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
517 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
518 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
519 doc: /* Return the logarithm base 10 of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
520 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
521 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
522 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
523 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
524 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
525 if (d <= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
526 domain_error ("log10", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
527 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
528 IN_FLOAT (d = log10 (d), "log10", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
529 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
530 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
531 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
532 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
533 doc: /* Return the square root of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
534 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
535 register Lisp_Object arg; |
102 | 536 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
537 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
538 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
539 if (d < 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
540 domain_error ("sqrt", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
541 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
542 IN_FLOAT (d = sqrt (d), "sqrt", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
543 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
544 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
545 |
694 | 546 #if 0 /* Not clearly worth adding. */ |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
547 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
548 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
549 doc: /* Return the inverse hyperbolic cosine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
550 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
551 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
552 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
553 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
554 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
555 if (d < 1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
556 domain_error ("acosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
557 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
558 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
559 IN_FLOAT (d = acosh (d), "acosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
560 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
561 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
562 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
563 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
564 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
565 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
566 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
567 doc: /* Return the inverse hyperbolic sine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
568 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
569 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
570 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
571 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
572 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
573 IN_FLOAT (d = asinh (d), "asinh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
574 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
575 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
576 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
577 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
578 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
579 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
580 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
581 doc: /* Return the inverse hyperbolic tangent of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
582 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
583 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
584 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
585 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
586 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
587 if (d >= 1.0 || d <= -1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
588 domain_error ("atanh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
589 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
590 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
591 IN_FLOAT (d = atanh (d), "atanh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
592 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
593 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
594 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
595 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
596 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
597 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
598 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
599 doc: /* Return the hyperbolic cosine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
600 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
601 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
602 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
603 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
604 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
605 if (d > 710.0 || d < -710.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
606 range_error ("cosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
607 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
608 IN_FLOAT (d = cosh (d), "cosh", arg); |
102 | 609 return make_float (d); |
610 } | |
611 | |
612 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
613 doc: /* Return the hyperbolic sine of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
614 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
615 register Lisp_Object arg; |
102 | 616 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
617 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
618 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
619 if (d > 710.0 || d < -710.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
620 range_error ("sinh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
621 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
622 IN_FLOAT (d = sinh (d), "sinh", arg); |
102 | 623 return make_float (d); |
624 } | |
625 | |
626 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
627 doc: /* Return the hyperbolic tangent of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
628 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
629 register Lisp_Object arg; |
102 | 630 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
631 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
632 IN_FLOAT (d = tanh (d), "tanh", arg); |
102 | 633 return make_float (d); |
634 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
635 #endif |
102 | 636 |
637 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
638 doc: /* Return the absolute value of ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
639 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
640 register Lisp_Object arg; |
102 | 641 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
642 CHECK_NUMBER_OR_FLOAT (arg); |
102 | 643 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
644 if (FLOATP (arg)) |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
645 IN_FLOAT (arg = make_float (fabs (XFLOAT_DATA (arg))), "abs", arg); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
646 else if (XINT (arg) < 0) |
9365
0b431684f97b
(Fabs): Don't use XFASTINT when negative.
Karl Heuer <kwzh@gnu.org>
parents:
9267
diff
changeset
|
647 XSETINT (arg, - XINT (arg)); |
102 | 648 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
649 return arg; |
102 | 650 } |
651 | |
652 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
653 doc: /* Return the floating point number equal to ARG. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
654 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
655 register Lisp_Object arg; |
102 | 656 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
657 CHECK_NUMBER_OR_FLOAT (arg); |
102 | 658 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
659 if (INTEGERP (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
660 return make_float ((double) XINT (arg)); |
102 | 661 else /* give 'em the same float back */ |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
662 return arg; |
102 | 663 } |
664 | |
665 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
666 doc: /* Returns largest integer <= the base 2 log of the magnitude of ARG. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
667 This is the same as the exponent of a float. */) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
668 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
669 Lisp_Object arg; |
102 | 670 { |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
671 Lisp_Object val; |
11265
b2291296ec87
(Flogb): Use EMACS_INT for `value'.
Richard M. Stallman <rms@gnu.org>
parents:
9365
diff
changeset
|
672 EMACS_INT value; |
2129
6741f5f8ed54
(Flogb): Fix arg names. Don't confuse Lisp_Object with integer.
Richard M. Stallman <rms@gnu.org>
parents:
2128
diff
changeset
|
673 double f = extract_float (arg); |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
674 |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
675 if (f == 0.0) |
53002
3e336113348d
(Flogb): Don't use VALMASK.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
52401
diff
changeset
|
676 value = MOST_NEGATIVE_FIXNUM; |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
677 else |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
678 { |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
679 #ifdef HAVE_LOGB |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
680 IN_FLOAT (value = logb (f), "logb", arg); |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
681 #else |
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
682 #ifdef HAVE_FREXP |
11859
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
683 int ivalue; |
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
684 IN_FLOAT (frexp (f, &ivalue), "logb", arg); |
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
685 value = ivalue - 1; |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
686 #else |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
687 int i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
688 double d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
689 if (f < 0.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
690 f = -f; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
691 value = -1; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
692 while (f < 0.5) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
693 { |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
694 for (i = 1, d = 0.5; d * d >= f; i += i) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
695 d *= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
696 f /= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
697 value -= i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
698 } |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
699 while (f >= 1.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
700 { |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
701 for (i = 1, d = 2.0; d * d <= f; i += i) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
702 d *= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
703 f /= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
704 value += i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
705 } |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
706 #endif |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
707 #endif |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
708 } |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
709 XSETINT (val, value); |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
710 return val; |
102 | 711 } |
712 | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
713 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
714 /* the rounding functions */ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
715 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
716 static Lisp_Object |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
717 rounding_driver (arg, divisor, double_round, int_round2, name) |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
718 register Lisp_Object arg, divisor; |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
719 double (*double_round) (); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
720 EMACS_INT (*int_round2) (); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
721 char *name; |
102 | 722 { |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
723 CHECK_NUMBER_OR_FLOAT (arg); |
102 | 724 |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
725 if (! NILP (divisor)) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
726 { |
12537
476296adb950
(Fexpt): Use EMACS_INT for integer calculation.
Karl Heuer <kwzh@gnu.org>
parents:
11859
diff
changeset
|
727 EMACS_INT i1, i2; |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
728 |
40656
cdfd4d09b79a
Update usage of CHECK_ macros (remove unused second argument).
Pavel Janík <Pavel@Janik.cz>
parents:
39814
diff
changeset
|
729 CHECK_NUMBER_OR_FLOAT (divisor); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
730 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
731 if (FLOATP (arg) || FLOATP (divisor)) |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
732 { |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
733 double f1, f2; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
734 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
735 f1 = FLOATP (arg) ? XFLOAT_DATA (arg) : XINT (arg); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
736 f2 = (FLOATP (divisor) ? XFLOAT_DATA (divisor) : XINT (divisor)); |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
737 if (! IEEE_FLOATING_POINT && f2 == 0) |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
738 xsignal0 (Qarith_error); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
739 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
740 IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
741 FLOAT_TO_INT2 (f1, arg, name, arg, divisor); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
742 return arg; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
743 } |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
744 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
745 i1 = XINT (arg); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
746 i2 = XINT (divisor); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
747 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
748 if (i2 == 0) |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
749 xsignal0 (Qarith_error); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
750 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
751 XSETINT (arg, (*int_round2) (i1, i2)); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
752 return arg; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
753 } |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
754 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
755 if (FLOATP (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
756 { |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
757 double d; |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
758 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
759 IN_FLOAT (d = (*double_round) (XFLOAT_DATA (arg)), name, arg); |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
760 FLOAT_TO_INT (d, arg, name, arg); |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
761 } |
102 | 762 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
763 return arg; |
102 | 764 } |
765 | |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
766 /* With C's /, the result is implementation-defined if either operand |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
767 is negative, so take care with negative operands in the following |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
768 integer functions. */ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
769 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
770 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
771 ceiling2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
772 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
773 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
774 return (i2 < 0 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
775 ? (i1 < 0 ? ((-1 - i1) / -i2) + 1 : - (i1 / -i2)) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
776 : (i1 <= 0 ? - (-i1 / i2) : ((i1 - 1) / i2) + 1)); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
777 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
778 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
779 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
780 floor2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
781 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
782 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
783 return (i2 < 0 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
784 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
785 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
786 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
787 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
788 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
789 truncate2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
790 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
791 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
792 return (i2 < 0 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
793 ? (i1 < 0 ? -i1 / -i2 : - (i1 / -i2)) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
794 : (i1 < 0 ? - (-i1 / i2) : i1 / i2)); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
795 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
796 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
797 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
798 round2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
799 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
800 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
801 /* The C language's division operator gives us one remainder R, but |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
802 we want the remainder R1 on the other side of 0 if R1 is closer |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
803 to 0 than R is; because we want to round to even, we also want R1 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
804 if R and R1 are the same distance from 0 and if C's quotient is |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
805 odd. */ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
806 EMACS_INT q = i1 / i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
807 EMACS_INT r = i1 % i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
808 EMACS_INT abs_r = r < 0 ? -r : r; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
809 EMACS_INT abs_r1 = (i2 < 0 ? -i2 : i2) - abs_r; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
810 return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
811 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
812 |
19737
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
813 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT |
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
814 if `rint' exists but does not work right. */ |
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
815 #ifdef HAVE_RINT |
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
816 #define emacs_rint rint |
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
817 #else |
16929
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
818 static double |
19737
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
819 emacs_rint (d) |
16929
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
820 double d; |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
821 { |
16956 | 822 return floor (d + 0.5); |
16929
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
823 } |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
824 #endif |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
825 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
826 static double |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
827 double_identity (d) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
828 double d; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
829 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
830 return d; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
831 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
832 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
833 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, |
41028
e4bce1db7f77
(Fceiling, Ffloor): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
41001
diff
changeset
|
834 doc: /* Return the smallest integer no less than ARG. |
e4bce1db7f77
(Fceiling, Ffloor): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
41001
diff
changeset
|
835 This rounds the value towards +inf. |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
836 With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
837 (arg, divisor) |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
838 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
839 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
840 return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
841 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
842 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
843 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, |
41028
e4bce1db7f77
(Fceiling, Ffloor): Doc fixes.
Richard M. Stallman <rms@gnu.org>
parents:
41001
diff
changeset
|
844 doc: /* Return the largest integer no greater than ARG. |
60651 | 845 This rounds the value towards -inf. |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
846 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
847 (arg, divisor) |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
848 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
849 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
850 return rounding_driver (arg, divisor, floor, floor2, "floor"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
851 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
852 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
853 DEFUN ("round", Fround, Sround, 1, 2, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
854 doc: /* Return the nearest integer to ARG. |
43179 | 855 With optional DIVISOR, return the nearest integer to ARG/DIVISOR. |
856 | |
43181 | 857 Rounding a value equidistant between two integers may choose the |
858 integer closer to zero, or it may prefer an even integer, depending on | |
859 your machine. For example, \(round 2.5\) can return 3 on some | |
43189 | 860 systems, but 2 on others. */) |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
861 (arg, divisor) |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
862 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
863 { |
19737
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
864 return rounding_driver (arg, divisor, emacs_rint, round2, "round"); |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
865 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
866 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
867 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
868 doc: /* Truncate a floating point number to an int. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
869 Rounds ARG toward zero. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
870 With optional DIVISOR, truncate ARG/DIVISOR. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
871 (arg, divisor) |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
872 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
873 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
874 return rounding_driver (arg, divisor, double_identity, truncate2, |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
875 "truncate"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
876 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
877 |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
878 |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
879 Lisp_Object |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
880 fmod_float (x, y) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
881 register Lisp_Object x, y; |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
882 { |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
883 double f1, f2; |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
884 |
25645
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
885 f1 = FLOATP (x) ? XFLOAT_DATA (x) : XINT (x); |
a14111a2a100
Use XCAR, XCDR, XFLOAT_DATA instead of explicit member access.
Ken Raeburn <raeburn@raeburn.org>
parents:
21514
diff
changeset
|
886 f2 = FLOATP (y) ? XFLOAT_DATA (y) : XINT (y); |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
887 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
888 if (! IEEE_FLOATING_POINT && f2 == 0) |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
889 xsignal0 (Qarith_error); |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
890 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
891 /* If the "remainder" comes out with the wrong sign, fix it. */ |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
892 IN_FLOAT2 ((f1 = fmod (f1, f2), |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
893 f1 = (f2 < 0 ? f1 > 0 : f1 < 0) ? f1 + f2 : f1), |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
894 "mod", x, y); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
895 return make_float (f1); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
896 } |
102 | 897 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
898 /* It's not clear these are worth adding. */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
899 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
900 DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
901 doc: /* Return the smallest integer no less than ARG, as a float. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
902 \(Round toward +inf.\) */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
903 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
904 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
905 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
906 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
907 IN_FLOAT (d = ceil (d), "fceiling", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
908 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
909 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
910 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
911 DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
912 doc: /* Return the largest integer no greater than ARG, as a float. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
913 \(Round towards -inf.\) */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
914 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
915 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
916 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
917 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
918 IN_FLOAT (d = floor (d), "ffloor", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
919 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
920 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
921 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
922 DEFUN ("fround", Ffround, Sfround, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
923 doc: /* Return the nearest integer to ARG, as a float. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
924 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
925 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
926 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
927 double d = extract_float (arg); |
19737
cad2a27d4451
(emacs_rint): Define this,
Richard M. Stallman <rms@gnu.org>
parents:
18627
diff
changeset
|
928 IN_FLOAT (d = emacs_rint (d), "fround", arg); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
929 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
930 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
931 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
932 DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, |
41001
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
933 doc: /* Truncate a floating point number to an integral float value. |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
934 Rounds the value toward zero. */) |
a17c8b15ef1b
Change doc-string comments to `new style' [w/`doc:' keyword].
Pavel Janík <Pavel@Janik.cz>
parents:
40656
diff
changeset
|
935 (arg) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
936 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
937 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
938 double d = extract_float (arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
939 if (d >= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
940 IN_FLOAT (d = floor (d), "ftruncate", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
941 else |
5495
87f9165f5b14
[MSDOS]: Don't define HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
4881
diff
changeset
|
942 IN_FLOAT (d = ceil (d), "ftruncate", arg); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
943 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
944 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
945 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
946 #ifdef FLOAT_CATCH_SIGILL |
621 | 947 static SIGTYPE |
102 | 948 float_error (signo) |
949 int signo; | |
950 { | |
951 if (! in_float) | |
952 fatal_error_signal (signo); | |
953 | |
16220
02044b05d8e0
Replaced symbol BSD with BSD_SYSTEM.
Karl Heuer <kwzh@gnu.org>
parents:
16207
diff
changeset
|
954 #ifdef BSD_SYSTEM |
638 | 955 sigsetmask (SIGEMPTYMASK); |
485 | 956 #else |
957 /* Must reestablish handler each time it is called. */ | |
958 signal (SIGILL, float_error); | |
16220
02044b05d8e0
Replaced symbol BSD with BSD_SYSTEM.
Karl Heuer <kwzh@gnu.org>
parents:
16207
diff
changeset
|
959 #endif /* BSD_SYSTEM */ |
102 | 960 |
58986
59945307b86b
* syssignal.h: Declare main_thread.
Jan Djärv <jan.h.d@swipnet.se>
parents:
53002
diff
changeset
|
961 SIGNAL_THREAD_CHECK (signo); |
102 | 962 in_float = 0; |
963 | |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
964 xsignal1 (Qarith_error, float_error_arg); |
102 | 965 } |
966 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
967 /* Another idea was to replace the library function `infnan' |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
968 where SIGILL is signaled. */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
969 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
970 #endif /* FLOAT_CATCH_SIGILL */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
971 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
972 #ifdef HAVE_MATHERR |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43413
diff
changeset
|
973 int |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
974 matherr (x) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
975 struct exception *x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
976 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
977 Lisp_Object args; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
978 if (! in_float) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
979 /* Not called from emacs-lisp float routines; do the default thing. */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
980 return 0; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
981 if (!strcmp (x->name, "pow")) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
982 x->name = "expt"; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
983 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
984 args |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
985 = Fcons (build_string (x->name), |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
986 Fcons (make_float (x->arg1), |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
987 ((!strcmp (x->name, "log") || !strcmp (x->name, "pow")) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
988 ? Fcons (make_float (x->arg2), Qnil) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
989 : Qnil))); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
990 switch (x->type) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
991 { |
71978
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
992 case DOMAIN: xsignal (Qdomain_error, args); break; |
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
993 case SING: xsignal (Qsingularity_error, args); break; |
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
994 case OVERFLOW: xsignal (Qoverflow_error, args); break; |
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
995 case UNDERFLOW: xsignal (Qunderflow_error, args); break; |
6b2f430f5341
(arith_error, range_error, domain_error): Use xsignal2.
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
996 default: xsignal (Qarith_error, args); break; |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
997 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
998 return (1); /* don't set errno or print a message */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
999 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1000 #endif /* HAVE_MATHERR */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1001 |
21514 | 1002 void |
102 | 1003 init_floatfns () |
1004 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1005 #ifdef FLOAT_CATCH_SIGILL |
102 | 1006 signal (SIGILL, float_error); |
49600
23a1cea22d13
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
43413
diff
changeset
|
1007 #endif |
102 | 1008 in_float = 0; |
1009 } | |
1010 | |
21514 | 1011 void |
102 | 1012 syms_of_floatfns () |
1013 { | |
1014 defsubr (&Sacos); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1015 defsubr (&Sasin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1016 defsubr (&Satan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1017 defsubr (&Scos); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1018 defsubr (&Ssin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1019 defsubr (&Stan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1020 #if 0 |
102 | 1021 defsubr (&Sacosh); |
1022 defsubr (&Sasinh); | |
1023 defsubr (&Satanh); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1024 defsubr (&Scosh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1025 defsubr (&Ssinh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1026 defsubr (&Stanh); |
102 | 1027 defsubr (&Sbessel_y0); |
1028 defsubr (&Sbessel_y1); | |
1029 defsubr (&Sbessel_yn); | |
1030 defsubr (&Sbessel_j0); | |
1031 defsubr (&Sbessel_j1); | |
1032 defsubr (&Sbessel_jn); | |
1033 defsubr (&Serf); | |
1034 defsubr (&Serfc); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1035 defsubr (&Slog_gamma); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1036 defsubr (&Scube_root); |
5595
63bc8a14a073
(Fffloor, Ffceil, Ffround, Fftruncate): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
5495
diff
changeset
|
1037 #endif |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1038 defsubr (&Sfceiling); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1039 defsubr (&Sffloor); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1040 defsubr (&Sfround); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1041 defsubr (&Sftruncate); |
102 | 1042 defsubr (&Sexp); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1043 defsubr (&Sexpt); |
102 | 1044 defsubr (&Slog); |
1045 defsubr (&Slog10); | |
1046 defsubr (&Ssqrt); | |
1047 | |
1048 defsubr (&Sabs); | |
1049 defsubr (&Sfloat); | |
1050 defsubr (&Slogb); | |
1051 defsubr (&Sceiling); | |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
1052 defsubr (&Sfloor); |
102 | 1053 defsubr (&Sround); |
1054 defsubr (&Struncate); | |
1055 } | |
52401 | 1056 |
1057 /* arch-tag: be05bf9d-049e-4e31-91b9-e6153d483ae7 | |
1058 (do not change this comment) */ |