Mercurial > emacs
annotate src/floatfns.c @ 16842:72276b334084 before-thomas-posix1996 glibc-2_0_2 libc-970108 libc-970109 libc-970110 libc-970111 libc-970112 libc-970113 libc-970114 libc-970115 libc-970116 libc-970117 libc-970118 libc-970119 libc-970120 libc-970121 libc-970122 libc-970123 libc-970124 libc-970125 libc-970126 libc-970127 libc-970128 libc-970129 libc-970130 libc-970131 libc-970201 libc-970202 libc-970203 libc-970204 libc-970205 libc-970206 libc-970207 libc-970208 libc-970209 libc-970210 libc-970211 libc-970212 libc-970213 libc-970214 libc-970215 libc-970216 libc-970217 libc-970218 libc-970219 libc-970220 libc-970221 libc-970222 libc-970223 libc-970224 libc-970225 libc-970226 libc-970227 libc-970228 libc-970301 libc-970302 libc-970303 libc-970304 libc-970305 libc-970306 libc-970307 libc-970308 libc-970309 libc-970310 libc-970311 libc-970312 libc-970313 libc-970314 libc-970315 libc-970316 libc-970317 libc-970318 libc-970319 libc-970320 libc-970321 libc-970322 libc-970323 libc-970324 libc20x-970306 libc20x-97031 libc20x-970316 libc20x-970318 libc20x-970319 libc20x-970404 root-libc-2_0_x-branch
Add hppa1.1-hitachi-hiuxmpp support, passed along by rms.
author | David J. MacKenzie <djm@gnu.org> |
---|---|
date | Tue, 07 Jan 1997 19:29:28 +0000 |
parents | 8907c00c0cc6 |
children | bdafa1f28a64 |
rev | line source |
---|---|
102 | 1 /* Primitive operations on floating point for GNU Emacs Lisp interpreter. |
7307 | 2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc. |
102 | 3 |
4 This file is part of GNU Emacs. | |
5 | |
6 GNU Emacs is free software; you can redistribute it and/or modify | |
7 it under the terms of the GNU General Public License as published by | |
621 | 8 the Free Software Foundation; either version 2, or (at your option) |
102 | 9 any later version. |
10 | |
11 GNU Emacs is distributed in the hope that it will be useful, | |
12 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 GNU General Public License for more details. | |
15 | |
16 You should have received a copy of the GNU General Public License | |
17 along with GNU Emacs; see the file COPYING. If not, write to | |
14186
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14076
diff
changeset
|
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
ee40177f6c68
Update FSF's address in the preamble.
Erik Naggum <erik@naggum.no>
parents:
14076
diff
changeset
|
19 Boston, MA 02111-1307, USA. */ |
102 | 20 |
21 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
22 /* 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
|
23 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
|
24 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
|
25 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
26 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
|
27 Define HAVE_CBRT if you have cbrt. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
28 Define HAVE_RINT if you have rint. |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
29 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
|
30 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
31 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
|
32 (This should happen automatically.) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
33 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
34 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
|
35 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
|
36 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
37 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
|
38 (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
|
39 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
40 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by |
14036 | 41 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
|
42 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
|
43 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
|
44 a domain error occurs.) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
45 */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
46 |
102 | 47 #include <signal.h> |
48 | |
4696
1fc792473491
Include <config.h> instead of "config.h".
Roland McGrath <roland@gnu.org>
parents:
4594
diff
changeset
|
49 #include <config.h> |
102 | 50 #include "lisp.h" |
638 | 51 #include "syssignal.h" |
102 | 52 |
53 #ifdef LISP_FLOAT_TYPE | |
485 | 54 |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
55 #if STDC_HEADERS |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
56 #include <float.h> |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
57 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
58 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
59 /* 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
|
60 #ifndef IEEE_FLOATING_POINT |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
61 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
62 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
63 #define IEEE_FLOATING_POINT 1 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
64 #else |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
65 #define IEEE_FLOATING_POINT 0 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
66 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
67 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
68 |
4843
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
69 /* Work around a problem that happens because math.h on hpux 7 |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
70 defines two static variables--which, in Emacs, are not really static, |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
71 because `static' is defined as nothing. The problem is that they are |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
72 defined both here and in lread.c. |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
73 These macros prevent the name conflict. */ |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
74 #if defined (HPUX) && !defined (HPUX8) |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
75 #define _MAXLDBL floatfns_maxldbl |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
76 #define _NMAXLDBL floatfns_nmaxldbl |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
77 #endif |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
78 |
102 | 79 #include <math.h> |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
80 |
4881
e53d4ae93675
Declare `logb' only if HAVE_LOGB is defined.
Brian Fox <bfox@gnu.org>
parents:
4843
diff
changeset
|
81 /* 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
|
82 #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
|
83 extern double logb (); |
7448
bf93ac2d8409
Don't declare logb if it is a macro.
Richard M. Stallman <rms@gnu.org>
parents:
7361
diff
changeset
|
84 #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
|
85 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
86 #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
|
87 /* 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
|
88 # ifndef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
89 # define HAVE_MATHERR |
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 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
92 |
3027
7ed290bef028
Fix typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
3025
diff
changeset
|
93 #ifdef NO_MATHERR |
3025
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
94 #undef HAVE_MATHERR |
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
95 #endif |
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
96 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
97 #ifdef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
98 # ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
99 # undef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
100 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
101 # ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
102 # undef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
103 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
104 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
105 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
106 #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
|
107 #define FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
108 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
109 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
110 #ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
111 # include <errno.h> |
485 | 112 |
113 extern int errno; | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
114 #endif |
485 | 115 |
116 /* Avoid traps on VMS from sinh and cosh. | |
117 All the other functions set errno instead. */ | |
118 | |
119 #ifdef VMS | |
120 #undef cosh | |
121 #undef sinh | |
122 #define cosh(x) ((exp(x)+exp(-x))*0.5) | |
123 #define sinh(x) ((exp(x)-exp(-x))*0.5) | |
124 #endif /* VMS */ | |
125 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
126 #ifndef HAVE_RINT |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
127 #define rint(x) (floor((x)+0.5)) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
128 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
129 |
621 | 130 static SIGTYPE float_error (); |
102 | 131 |
132 /* Nonzero while executing in floating point. | |
133 This tells float_error what to do. */ | |
134 | |
135 static int in_float; | |
136 | |
137 /* If an argument is out of range for a mathematical function, | |
16207 | 138 here is the actual argument value to use in the error message. |
139 These variables are used only across the floating point library call | |
140 so there is no need to staticpro them. */ | |
102 | 141 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
142 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
|
143 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
144 static char *float_error_fn_name; |
102 | 145 |
485 | 146 /* Evaluate the floating point expression D, recording NUM |
147 as the original argument for error messages. | |
148 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
|
149 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
|
150 |
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
151 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
|
152 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
|
153 check properly. */ |
485 | 154 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
155 #ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
156 #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
|
157 do { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
158 float_error_arg = num; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
159 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
|
160 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
|
161 switch (errno) { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
162 case 0: break; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
163 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
|
164 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
|
165 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
|
166 } \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
167 } while (0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
168 #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
|
169 do { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
170 float_error_arg = num; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
171 float_error_arg2 = num2; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
172 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
|
173 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
|
174 switch (errno) { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
175 case 0: break; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
176 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
|
177 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
|
178 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
|
179 } \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
180 } while (0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
181 #else |
3407
d00aaf536bfd
[!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition.
Richard M. Stallman <rms@gnu.org>
parents:
3094
diff
changeset
|
182 #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
|
183 #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
|
184 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
185 |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
186 /* 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
|
187 using the given arguments. */ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
188 #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
|
189 do \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
190 { \ |
8825
5e5f6d06fb5b
(FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7448
diff
changeset
|
191 if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \ |
5e5f6d06fb5b
(FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7448
diff
changeset
|
192 (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
193 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
|
194 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
|
195 } \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
196 while (0) |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
197 #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
|
198 do \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
199 { \ |
8825
5e5f6d06fb5b
(FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7448
diff
changeset
|
200 if ((x) >= (((EMACS_INT) 1) << (VALBITS-1)) || \ |
5e5f6d06fb5b
(FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7448
diff
changeset
|
201 (x) <= - (((EMACS_INT) 1) << (VALBITS-1)) - 1) \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
202 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
|
203 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
|
204 } \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
205 while (0) |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
206 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
207 #define arith_error(op,arg) \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
208 Fsignal (Qarith_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
209 #define range_error(op,arg) \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
210 Fsignal (Qrange_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
211 #define range_error2(op,a1,a2) \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
212 Fsignal (Qrange_error, Fcons (build_string ((op)), \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
213 Fcons ((a1), Fcons ((a2), Qnil)))) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
214 #define domain_error(op,arg) \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
215 Fsignal (Qdomain_error, Fcons (build_string ((op)), Fcons ((arg), Qnil))) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
216 #define domain_error2(op,a1,a2) \ |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
217 Fsignal (Qdomain_error, Fcons (build_string ((op)), \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
218 Fcons ((a1), Fcons ((a2), Qnil)))) |
102 | 219 |
220 /* Extract a Lisp number as a `double', or signal an error. */ | |
221 | |
222 double | |
223 extract_float (num) | |
224 Lisp_Object num; | |
225 { | |
226 CHECK_NUMBER_OR_FLOAT (num, 0); | |
227 | |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
228 if (FLOATP (num)) |
102 | 229 return XFLOAT (num)->data; |
230 return (double) XINT (num); | |
231 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
232 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
233 /* Trig functions. */ |
102 | 234 |
235 DEFUN ("acos", Facos, Sacos, 1, 1, 0, | |
236 "Return the inverse cosine of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
237 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
238 register Lisp_Object arg; |
102 | 239 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
240 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
|
241 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
242 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
|
243 domain_error ("acos", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
244 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
245 IN_FLOAT (d = acos (d), "acos", arg); |
102 | 246 return make_float (d); |
247 } | |
248 | |
249 DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | |
250 "Return the inverse sine of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
251 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
252 register Lisp_Object arg; |
102 | 253 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
254 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
|
255 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
256 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
|
257 domain_error ("asin", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
258 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
259 IN_FLOAT (d = asin (d), "asin", arg); |
102 | 260 return make_float (d); |
261 } | |
262 | |
263 DEFUN ("atan", Fatan, Satan, 1, 1, 0, | |
264 "Return the inverse tangent of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
265 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
266 register Lisp_Object arg; |
102 | 267 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
268 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
|
269 IN_FLOAT (d = atan (d), "atan", arg); |
102 | 270 return make_float (d); |
271 } | |
272 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
273 DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
274 "Return the cosine of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
275 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
276 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
277 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
278 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
|
279 IN_FLOAT (d = cos (d), "cos", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
280 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
281 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
282 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
283 DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
284 "Return the sine of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
285 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
286 register Lisp_Object arg; |
102 | 287 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
288 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
|
289 IN_FLOAT (d = sin (d), "sin", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
290 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
291 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
292 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
293 DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
294 "Return the tangent of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
295 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
296 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
297 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
298 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
|
299 double c = cos (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
300 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
301 if (c == 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
302 domain_error ("tan", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
303 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
304 IN_FLOAT (d = sin (d) / c, "tan", arg); |
102 | 305 return make_float (d); |
306 } | |
307 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
308 #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
|
309 |
102 | 310 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, |
311 "Return the bessel function j0 of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
312 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
313 register Lisp_Object arg; |
102 | 314 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
315 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
|
316 IN_FLOAT (d = j0 (d), "bessel-j0", arg); |
102 | 317 return make_float (d); |
318 } | |
319 | |
320 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | |
321 "Return the bessel function j1 of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
322 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
323 register Lisp_Object arg; |
102 | 324 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
325 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
|
326 IN_FLOAT (d = j1 (d), "bessel-j1", arg); |
102 | 327 return make_float (d); |
328 } | |
329 | |
330 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | |
331 "Return the order N bessel function output jn of ARG.\n\ | |
332 The first arg (the order) is truncated to an integer.") | |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
333 (n, arg) |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
334 register Lisp_Object n, arg; |
102 | 335 { |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
336 int i1 = extract_float (n); |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
337 double f2 = extract_float (arg); |
102 | 338 |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
339 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); |
102 | 340 return make_float (f2); |
341 } | |
342 | |
343 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | |
344 "Return the bessel function y0 of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
345 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
346 register Lisp_Object arg; |
102 | 347 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
348 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
|
349 IN_FLOAT (d = y0 (d), "bessel-y0", arg); |
102 | 350 return make_float (d); |
351 } | |
352 | |
353 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | |
354 "Return the bessel function y1 of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
355 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
356 register Lisp_Object arg; |
102 | 357 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
358 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
|
359 IN_FLOAT (d = y1 (d), "bessel-y0", arg); |
102 | 360 return make_float (d); |
361 } | |
362 | |
363 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | |
364 "Return the order N bessel function output yn of ARG.\n\ | |
365 The first arg (the order) is truncated to an integer.") | |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
366 (n, arg) |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
367 register Lisp_Object n, arg; |
102 | 368 { |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
369 int i1 = extract_float (n); |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
370 double f2 = extract_float (arg); |
102 | 371 |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
372 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); |
102 | 373 return make_float (f2); |
374 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
375 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
376 #endif |
102 | 377 |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
378 #if 0 /* Leave these out unless we see they are worth having. */ |
102 | 379 |
380 DEFUN ("erf", Ferf, Serf, 1, 1, 0, | |
381 "Return the mathematical error function of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
382 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
383 register Lisp_Object arg; |
102 | 384 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
385 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
|
386 IN_FLOAT (d = erf (d), "erf", arg); |
102 | 387 return make_float (d); |
388 } | |
389 | |
390 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | |
391 "Return the complementary error function of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
392 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
393 register Lisp_Object arg; |
102 | 394 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
395 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
|
396 IN_FLOAT (d = erfc (d), "erfc", arg); |
102 | 397 return make_float (d); |
398 } | |
399 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
400 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
401 "Return the log gamma of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
402 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
403 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
404 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
405 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
|
406 IN_FLOAT (d = lgamma (d), "log-gamma", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
407 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
408 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
409 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
410 DEFUN ("cube-root", Fcube_root, Scube_root, 1, 1, 0, |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
411 "Return the cube root of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
412 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
413 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
414 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
415 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
|
416 #ifdef HAVE_CBRT |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
417 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
|
418 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
419 if (d >= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
420 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
|
421 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
422 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
|
423 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
424 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
425 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
426 |
694 | 427 #endif |
428 | |
102 | 429 DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
430 "Return the exponential base e of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
431 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
432 register Lisp_Object arg; |
102 | 433 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
434 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
|
435 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
436 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
|
437 range_error ("exp", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
438 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
|
439 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
|
440 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
441 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
442 IN_FLOAT (d = exp (d), "exp", arg); |
102 | 443 return make_float (d); |
444 } | |
445 | |
446 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |
13442 | 447 "Return the exponential ARG1 ** ARG2.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
448 (arg1, arg2) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
449 register Lisp_Object arg1, arg2; |
102 | 450 { |
451 double f1, f2; | |
452 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
453 CHECK_NUMBER_OR_FLOAT (arg1, 0); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
454 CHECK_NUMBER_OR_FLOAT (arg2, 0); |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
455 if (INTEGERP (arg1) /* common lisp spec */ |
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
456 && INTEGERP (arg2)) /* don't promote, if both are ints */ |
102 | 457 { /* 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
|
458 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
|
459 Lisp_Object val; |
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
460 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
461 x = XINT (arg1); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
462 y = XINT (arg2); |
102 | 463 acc = 1; |
464 | |
465 if (y < 0) | |
466 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
467 if (x == 1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
468 acc = 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
469 else if (x == -1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
470 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
|
471 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
472 acc = 0; |
102 | 473 } |
474 else | |
475 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
476 while (y > 0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
477 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
478 if (y & 1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
479 acc *= x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
480 x *= x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
481 y = (unsigned)y >> 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
482 } |
102 | 483 } |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
484 XSETINT (val, acc); |
3673
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
485 return val; |
102 | 486 } |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
487 f1 = FLOATP (arg1) ? XFLOAT (arg1)->data : XINT (arg1); |
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
488 f2 = FLOATP (arg2) ? XFLOAT (arg2)->data : XINT (arg2); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
489 /* 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
|
490 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
|
491 f1 = 1.0; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
492 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
493 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
|
494 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
|
495 #endif |
4529 | 496 IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2); |
102 | 497 return make_float (f1); |
498 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
499 |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
500 DEFUN ("log", Flog, Slog, 1, 2, 0, |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
501 "Return the natural logarithm of ARG.\n\ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
502 If second optional argument BASE is given, return log ARG using that base.") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
503 (arg, base) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
504 register Lisp_Object arg, base; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
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 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
|
507 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
508 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
509 if (d <= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
510 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
|
511 #endif |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
512 if (NILP (base)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
513 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
|
514 else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
515 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
516 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
|
517 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
518 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
519 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
|
520 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
|
521 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
522 if (b == 10.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
523 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
|
524 else |
3407
d00aaf536bfd
[!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition.
Richard M. Stallman <rms@gnu.org>
parents:
3094
diff
changeset
|
525 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
|
526 } |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
527 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
528 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
529 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
530 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
531 "Return the logarithm base 10 of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
532 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
533 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
534 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
535 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
|
536 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
537 if (d <= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
538 domain_error ("log10", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
539 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
540 IN_FLOAT (d = log10 (d), "log10", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
541 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
542 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
543 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
544 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
545 "Return the square root of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
546 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
547 register Lisp_Object arg; |
102 | 548 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
549 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
|
550 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
551 if (d < 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
552 domain_error ("sqrt", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
553 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
554 IN_FLOAT (d = sqrt (d), "sqrt", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
555 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
556 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
557 |
694 | 558 #if 0 /* Not clearly worth adding. */ |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
559 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
560 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
561 "Return the inverse hyperbolic cosine of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
562 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
563 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
564 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
565 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
|
566 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
567 if (d < 1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
568 domain_error ("acosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
569 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
570 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
571 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
|
572 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
573 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
|
574 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
575 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
576 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
577 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
578 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
579 "Return the inverse hyperbolic sine of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
580 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
581 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
582 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
583 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
|
584 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
585 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
|
586 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
587 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
|
588 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
589 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
590 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
591 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
592 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
593 "Return the inverse hyperbolic tangent of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
594 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
595 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
596 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
597 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
|
598 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
599 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
|
600 domain_error ("atanh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
601 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
602 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
603 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
|
604 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
605 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
|
606 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
607 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
608 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
609 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
610 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
611 "Return the hyperbolic cosine of ARG.") |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
612 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
613 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
614 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
615 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
|
616 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
617 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
|
618 range_error ("cosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
619 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
620 IN_FLOAT (d = cosh (d), "cosh", arg); |
102 | 621 return make_float (d); |
622 } | |
623 | |
624 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | |
625 "Return the hyperbolic sine of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
626 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
627 register Lisp_Object arg; |
102 | 628 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
629 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
|
630 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
631 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
|
632 range_error ("sinh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
633 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
634 IN_FLOAT (d = sinh (d), "sinh", arg); |
102 | 635 return make_float (d); |
636 } | |
637 | |
638 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | |
639 "Return the hyperbolic tangent of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
640 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
641 register Lisp_Object arg; |
102 | 642 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
643 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
|
644 IN_FLOAT (d = tanh (d), "tanh", arg); |
102 | 645 return make_float (d); |
646 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
647 #endif |
102 | 648 |
649 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | |
650 "Return the absolute value of ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
651 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
652 register Lisp_Object arg; |
102 | 653 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
654 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 655 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
656 if (FLOATP (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
657 IN_FLOAT (arg = make_float (fabs (XFLOAT (arg)->data)), "abs", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
658 else if (XINT (arg) < 0) |
9365
0b431684f97b
(Fabs): Don't use XFASTINT when negative.
Karl Heuer <kwzh@gnu.org>
parents:
9267
diff
changeset
|
659 XSETINT (arg, - XINT (arg)); |
102 | 660 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
661 return arg; |
102 | 662 } |
663 | |
664 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | |
665 "Return the floating point number equal to ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
666 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
667 register Lisp_Object arg; |
102 | 668 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
669 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 670 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
671 if (INTEGERP (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
672 return make_float ((double) XINT (arg)); |
102 | 673 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
|
674 return arg; |
102 | 675 } |
676 | |
677 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | |
4590 | 678 "Returns largest integer <= the base 2 log of the magnitude of ARG.\n\ |
102 | 679 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
|
680 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
681 Lisp_Object arg; |
102 | 682 { |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
683 Lisp_Object val; |
11265
b2291296ec87
(Flogb): Use EMACS_INT for `value'.
Richard M. Stallman <rms@gnu.org>
parents:
9365
diff
changeset
|
684 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
|
685 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
|
686 |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
687 if (f == 0.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
688 value = -(VALMASK >> 1); |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
689 else |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
690 { |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
691 #ifdef HAVE_LOGB |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
692 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
|
693 #else |
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
694 #ifdef HAVE_FREXP |
11859
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
695 int ivalue; |
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
696 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
|
697 value = ivalue - 1; |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
698 #else |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
699 int i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
700 double d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
701 if (f < 0.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
702 f = -f; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
703 value = -1; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
704 while (f < 0.5) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
705 { |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
706 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
|
707 d *= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
708 f /= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
709 value -= i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
710 } |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
711 while (f >= 1.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
712 { |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
713 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
|
714 d *= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
715 f /= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
716 value += i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
717 } |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
718 #endif |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
719 #endif |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
720 } |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
721 XSETINT (val, value); |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
722 return val; |
102 | 723 } |
724 | |
725 /* the rounding functions */ | |
726 | |
727 DEFUN ("ceiling", Fceiling, Sceiling, 1, 1, 0, | |
728 "Return the smallest integer no less than ARG. (Round toward +inf.)") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
729 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
730 register Lisp_Object arg; |
102 | 731 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
732 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 733 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
734 if (FLOATP (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
735 { |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
736 double d; |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
737 |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
738 IN_FLOAT (d = ceil (XFLOAT (arg)->data), "ceiling", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
739 FLOAT_TO_INT (d, arg, "ceiling", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
740 } |
102 | 741 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
742 return arg; |
102 | 743 } |
744 | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
745 #endif /* LISP_FLOAT_TYPE */ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
746 |
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 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
749 "Return the largest integer no greater than ARG. (Round towards -inf.)\n\ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
750 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
751 (arg, divisor) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
752 register Lisp_Object arg, divisor; |
102 | 753 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
754 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 755 |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
756 if (! NILP (divisor)) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
757 { |
12537
476296adb950
(Fexpt): Use EMACS_INT for integer calculation.
Karl Heuer <kwzh@gnu.org>
parents:
11859
diff
changeset
|
758 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
|
759 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
760 CHECK_NUMBER_OR_FLOAT (divisor, 1); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
761 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
762 #ifdef LISP_FLOAT_TYPE |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
763 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
|
764 { |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
765 double f1, f2; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
766 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
767 f1 = FLOATP (arg) ? XFLOAT (arg)->data : XINT (arg); |
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
768 f2 = (FLOATP (divisor) ? XFLOAT (divisor)->data : XINT (divisor)); |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
769 if (! IEEE_FLOATING_POINT && f2 == 0) |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
770 Fsignal (Qarith_error, Qnil); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
771 |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
772 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", arg, divisor); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
773 FLOAT_TO_INT2 (f1, arg, "floor", arg, divisor); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
774 return arg; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
775 } |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
776 #endif |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
777 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
778 i1 = XINT (arg); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
779 i2 = XINT (divisor); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
780 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
781 if (i2 == 0) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
782 Fsignal (Qarith_error, Qnil); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
783 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
784 /* With C's /, the result is implementation-defined if either operand |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
785 is negative, so use only nonnegative operands. */ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
786 i1 = (i2 < 0 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
787 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
788 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
789 |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
790 XSETINT (arg, i1); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
791 return arg; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
792 } |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
793 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
794 #ifdef LISP_FLOAT_TYPE |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
795 if (FLOATP (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
796 { |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
797 double d; |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
798 IN_FLOAT (d = floor (XFLOAT (arg)->data), "floor", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
799 FLOAT_TO_INT (d, arg, "floor", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
800 } |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
801 #endif |
102 | 802 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
803 return arg; |
102 | 804 } |
805 | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
806 #ifdef LISP_FLOAT_TYPE |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
807 |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
808 Lisp_Object |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
809 fmod_float (x, y) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
810 register Lisp_Object x, y; |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
811 { |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
812 double f1, f2; |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
813 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
814 f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
815 f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
816 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
817 if (! IEEE_FLOATING_POINT && f2 == 0) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
818 Fsignal (Qarith_error, Qnil); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
819 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
820 /* 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
|
821 IN_FLOAT2 ((f1 = fmod (f1, f2), |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
822 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
|
823 "mod", x, y); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
824 return make_float (f1); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
825 } |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
826 |
102 | 827 DEFUN ("round", Fround, Sround, 1, 1, 0, |
828 "Return the nearest integer to ARG.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
829 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
830 register Lisp_Object arg; |
102 | 831 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
832 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 833 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
834 if (FLOATP (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
835 { |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
836 double d; |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
837 |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
838 /* Screw the prevailing rounding mode. */ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
839 IN_FLOAT (d = rint (XFLOAT (arg)->data), "round", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
840 FLOAT_TO_INT (d, arg, "round", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
841 } |
1918
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
842 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
843 return arg; |
102 | 844 } |
845 | |
846 DEFUN ("truncate", Ftruncate, Struncate, 1, 1, 0, | |
847 "Truncate a floating point number to an int.\n\ | |
848 Rounds the value toward zero.") | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
849 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
850 register Lisp_Object arg; |
102 | 851 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
852 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 853 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
854 if (FLOATP (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
855 { |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
856 double d; |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
857 |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
858 d = XFLOAT (arg)->data; |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
859 FLOAT_TO_INT (d, arg, "truncate", arg); |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
860 } |
102 | 861 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
862 return arg; |
102 | 863 } |
864 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
865 /* 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
|
866 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
867 DEFUN ("fceiling", Ffceiling, Sfceiling, 1, 1, 0, |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
868 "Return the smallest integer no less than ARG, as a float.\n\ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
869 \(Round toward +inf.\)") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
870 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
871 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
872 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
873 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
|
874 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
|
875 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
876 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
877 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
878 DEFUN ("ffloor", Fffloor, Sffloor, 1, 1, 0, |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
879 "Return the largest integer no greater than ARG, as a float.\n\ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
880 \(Round towards -inf.\)") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
881 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
882 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
883 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
884 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
|
885 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
|
886 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
887 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
888 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
889 DEFUN ("fround", Ffround, Sfround, 1, 1, 0, |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
890 "Return the nearest integer to ARG, as a float.") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
891 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
892 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
893 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
894 double d = extract_float (arg); |
5595
63bc8a14a073
(Fffloor, Ffceil, Ffround, Fftruncate): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
5495
diff
changeset
|
895 IN_FLOAT (d = 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
|
896 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
897 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
898 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
899 DEFUN ("ftruncate", Fftruncate, Sftruncate, 1, 1, 0, |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
900 "Truncate a floating point number to an integral float value.\n\ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
901 Rounds the value toward zero.") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
902 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
903 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
904 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
905 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
|
906 if (d >= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
907 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
|
908 else |
5495
87f9165f5b14
[MSDOS]: Don't define HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
4881
diff
changeset
|
909 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
|
910 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
911 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
912 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
913 #ifdef FLOAT_CATCH_SIGILL |
621 | 914 static SIGTYPE |
102 | 915 float_error (signo) |
916 int signo; | |
917 { | |
918 if (! in_float) | |
919 fatal_error_signal (signo); | |
920 | |
16220
02044b05d8e0
Replaced symbol BSD with BSD_SYSTEM.
Karl Heuer <kwzh@gnu.org>
parents:
16207
diff
changeset
|
921 #ifdef BSD_SYSTEM |
102 | 922 #ifdef BSD4_1 |
923 sigrelse (SIGILL); | |
924 #else /* not BSD4_1 */ | |
638 | 925 sigsetmask (SIGEMPTYMASK); |
102 | 926 #endif /* not BSD4_1 */ |
485 | 927 #else |
928 /* Must reestablish handler each time it is called. */ | |
929 signal (SIGILL, float_error); | |
16220
02044b05d8e0
Replaced symbol BSD with BSD_SYSTEM.
Karl Heuer <kwzh@gnu.org>
parents:
16207
diff
changeset
|
930 #endif /* BSD_SYSTEM */ |
102 | 931 |
932 in_float = 0; | |
933 | |
934 Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); | |
935 } | |
936 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
937 /* 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
|
938 where SIGILL is signaled. */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
939 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
940 #endif /* FLOAT_CATCH_SIGILL */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
941 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
942 #ifdef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
943 int |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
944 matherr (x) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
945 struct exception *x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
946 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
947 Lisp_Object args; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
948 if (! in_float) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
949 /* 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
|
950 return 0; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
951 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
|
952 x->name = "expt"; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
953 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
954 args |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
955 = 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
|
956 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
|
957 ((!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
|
958 ? 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
|
959 : Qnil))); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
960 switch (x->type) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
961 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
962 case DOMAIN: Fsignal (Qdomain_error, args); break; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
963 case SING: Fsignal (Qsingularity_error, args); break; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
964 case OVERFLOW: Fsignal (Qoverflow_error, args); break; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
965 case UNDERFLOW: Fsignal (Qunderflow_error, args); break; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
966 default: Fsignal (Qarith_error, args); break; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
967 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
968 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
|
969 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
970 #endif /* HAVE_MATHERR */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
971 |
102 | 972 init_floatfns () |
973 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
974 #ifdef FLOAT_CATCH_SIGILL |
102 | 975 signal (SIGILL, float_error); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
976 #endif |
102 | 977 in_float = 0; |
978 } | |
979 | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
980 #else /* not LISP_FLOAT_TYPE */ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
981 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
982 init_floatfns () |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
983 {} |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
984 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
985 #endif /* not LISP_FLOAT_TYPE */ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
986 |
102 | 987 syms_of_floatfns () |
988 { | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
989 #ifdef LISP_FLOAT_TYPE |
102 | 990 defsubr (&Sacos); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
991 defsubr (&Sasin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
992 defsubr (&Satan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
993 defsubr (&Scos); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
994 defsubr (&Ssin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
995 defsubr (&Stan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
996 #if 0 |
102 | 997 defsubr (&Sacosh); |
998 defsubr (&Sasinh); | |
999 defsubr (&Satanh); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1000 defsubr (&Scosh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1001 defsubr (&Ssinh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1002 defsubr (&Stanh); |
102 | 1003 defsubr (&Sbessel_y0); |
1004 defsubr (&Sbessel_y1); | |
1005 defsubr (&Sbessel_yn); | |
1006 defsubr (&Sbessel_j0); | |
1007 defsubr (&Sbessel_j1); | |
1008 defsubr (&Sbessel_jn); | |
1009 defsubr (&Serf); | |
1010 defsubr (&Serfc); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1011 defsubr (&Slog_gamma); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1012 defsubr (&Scube_root); |
5595
63bc8a14a073
(Fffloor, Ffceil, Ffround, Fftruncate): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
5495
diff
changeset
|
1013 #endif |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1014 defsubr (&Sfceiling); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1015 defsubr (&Sffloor); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1016 defsubr (&Sfround); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1017 defsubr (&Sftruncate); |
102 | 1018 defsubr (&Sexp); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1019 defsubr (&Sexpt); |
102 | 1020 defsubr (&Slog); |
1021 defsubr (&Slog10); | |
1022 defsubr (&Ssqrt); | |
1023 | |
1024 defsubr (&Sabs); | |
1025 defsubr (&Sfloat); | |
1026 defsubr (&Slogb); | |
1027 defsubr (&Sceiling); | |
1028 defsubr (&Sround); | |
1029 defsubr (&Struncate); | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1030 #endif /* LISP_FLOAT_TYPE */ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1031 defsubr (&Sfloor); |
102 | 1032 } |