Mercurial > emacs
annotate src/floatfns.c @ 18989:6253a99afd95
(rmail-pop-password-error): New variable.
(rmail-insert-inbox-text): If there's an error getting mail from
the POP server, and the error matches rmail-pop-password-error or
we prompted for the POP password, assume that the password is
incorrect and erase it so that the user will be prompted again the
next time he gets mail.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 25 Jul 1997 22:08:24 +0000 |
parents | c372b7e6669b |
children | cad2a27d4451 |
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> |
18627
c372b7e6669b
Include float.h before lisp.h.
Richard M. Stallman <rms@gnu.org>
parents:
16956
diff
changeset
|
50 |
c372b7e6669b
Include float.h before lisp.h.
Richard M. Stallman <rms@gnu.org>
parents:
16956
diff
changeset
|
51 /* Put this before lisp.h so that lisp.h can define DBL_DIG if not defined. */ |
c372b7e6669b
Include float.h before lisp.h.
Richard M. Stallman <rms@gnu.org>
parents:
16956
diff
changeset
|
52 #if STDC_HEADERS |
c372b7e6669b
Include float.h before lisp.h.
Richard M. Stallman <rms@gnu.org>
parents:
16956
diff
changeset
|
53 #include <float.h> |
c372b7e6669b
Include float.h before lisp.h.
Richard M. Stallman <rms@gnu.org>
parents:
16956
diff
changeset
|
54 #endif |
c372b7e6669b
Include float.h before lisp.h.
Richard M. Stallman <rms@gnu.org>
parents:
16956
diff
changeset
|
55 |
102 | 56 #include "lisp.h" |
638 | 57 #include "syssignal.h" |
102 | 58 |
59 #ifdef LISP_FLOAT_TYPE | |
485 | 60 |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
61 /* 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
|
62 #ifndef IEEE_FLOATING_POINT |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
63 #if (FLT_RADIX == 2 && FLT_MANT_DIG == 24 \ |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
64 && FLT_MIN_EXP == -125 && FLT_MAX_EXP == 128) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
65 #define IEEE_FLOATING_POINT 1 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
66 #else |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
67 #define IEEE_FLOATING_POINT 0 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
68 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
69 #endif |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
70 |
4843
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
71 /* 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
|
72 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
|
73 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
|
74 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
|
75 These macros prevent the name conflict. */ |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
76 #if defined (HPUX) && !defined (HPUX8) |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
77 #define _MAXLDBL floatfns_maxldbl |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
78 #define _NMAXLDBL floatfns_nmaxldbl |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
79 #endif |
136e32c763e3
[hpux 7] (_MAXLDBL, _NMAXLDBL): New macro definitions.
Richard M. Stallman <rms@gnu.org>
parents:
4696
diff
changeset
|
80 |
102 | 81 #include <math.h> |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
82 |
4881
e53d4ae93675
Declare `logb' only if HAVE_LOGB is defined.
Brian Fox <bfox@gnu.org>
parents:
4843
diff
changeset
|
83 /* 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
|
84 #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
|
85 extern double logb (); |
7448
bf93ac2d8409
Don't declare logb if it is a macro.
Richard M. Stallman <rms@gnu.org>
parents:
7361
diff
changeset
|
86 #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
|
87 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
88 #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
|
89 /* 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
|
90 # ifndef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
91 # define HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
92 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
93 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
94 |
3027
7ed290bef028
Fix typo in last change.
Richard M. Stallman <rms@gnu.org>
parents:
3025
diff
changeset
|
95 #ifdef NO_MATHERR |
3025
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
96 #undef HAVE_MATHERR |
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
97 #endif |
d09f68ccd145
[NO_MATHERR]: Undef HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
2961
diff
changeset
|
98 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
99 #ifdef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
100 # ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
101 # undef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
102 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
103 # ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
104 # undef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
105 # endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
106 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
107 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
108 #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
|
109 #define FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
110 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
111 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
112 #ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
113 # include <errno.h> |
485 | 114 |
115 extern int errno; | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
116 #endif |
485 | 117 |
118 /* Avoid traps on VMS from sinh and cosh. | |
119 All the other functions set errno instead. */ | |
120 | |
121 #ifdef VMS | |
122 #undef cosh | |
123 #undef sinh | |
124 #define cosh(x) ((exp(x)+exp(-x))*0.5) | |
125 #define sinh(x) ((exp(x)-exp(-x))*0.5) | |
126 #endif /* VMS */ | |
127 | |
621 | 128 static SIGTYPE float_error (); |
102 | 129 |
130 /* Nonzero while executing in floating point. | |
131 This tells float_error what to do. */ | |
132 | |
133 static int in_float; | |
134 | |
135 /* If an argument is out of range for a mathematical function, | |
16207 | 136 here is the actual argument value to use in the error message. |
137 These variables are used only across the floating point library call | |
138 so there is no need to staticpro them. */ | |
102 | 139 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
140 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
|
141 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
142 static char *float_error_fn_name; |
102 | 143 |
485 | 144 /* Evaluate the floating point expression D, recording NUM |
145 as the original argument for error messages. | |
146 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
|
147 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
|
148 |
699ae3079c09
* floatfns.c (Flogb): Always implement this by calling Flog, even
Jim Blandy <jimb@redhat.com>
parents:
1715
diff
changeset
|
149 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
|
150 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
|
151 check properly. */ |
485 | 152 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
153 #ifdef FLOAT_CHECK_ERRNO |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
154 #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
|
155 do { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
156 float_error_arg = num; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
157 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
|
158 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
|
159 switch (errno) { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
160 case 0: break; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
161 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
|
162 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
|
163 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
|
164 } \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
165 } while (0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
166 #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
|
167 do { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
168 float_error_arg = num; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
169 float_error_arg2 = num2; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
170 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
|
171 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
|
172 switch (errno) { \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
173 case 0: break; \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
174 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
|
175 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
|
176 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
|
177 } \ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
178 } while (0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
179 #else |
3407
d00aaf536bfd
[!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition.
Richard M. Stallman <rms@gnu.org>
parents:
3094
diff
changeset
|
180 #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
|
181 #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
|
182 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
183 |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
184 /* 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
|
185 using the given arguments. */ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
186 #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
|
187 do \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
188 { \ |
8825
5e5f6d06fb5b
(FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7448
diff
changeset
|
189 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
|
190 (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
|
191 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
|
192 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
|
193 } \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
194 while (0) |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
195 #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
|
196 do \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
197 { \ |
8825
5e5f6d06fb5b
(FLOAT_TO_INT, FLOAT_TO_INT2): Use EMACS_INT.
Richard M. Stallman <rms@gnu.org>
parents:
7448
diff
changeset
|
198 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
|
199 (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
|
200 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
|
201 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
|
202 } \ |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
203 while (0) |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
204 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
205 #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
|
206 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
|
207 #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
|
208 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
|
209 #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
|
210 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
|
211 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
|
212 #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
|
213 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
|
214 #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
|
215 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
|
216 Fcons ((a1), Fcons ((a2), Qnil)))) |
102 | 217 |
218 /* Extract a Lisp number as a `double', or signal an error. */ | |
219 | |
220 double | |
221 extract_float (num) | |
222 Lisp_Object num; | |
223 { | |
224 CHECK_NUMBER_OR_FLOAT (num, 0); | |
225 | |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
226 if (FLOATP (num)) |
102 | 227 return XFLOAT (num)->data; |
228 return (double) XINT (num); | |
229 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
230 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
231 /* Trig functions. */ |
102 | 232 |
233 DEFUN ("acos", Facos, Sacos, 1, 1, 0, | |
234 "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
|
235 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
236 register Lisp_Object arg; |
102 | 237 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
238 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
|
239 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
240 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
|
241 domain_error ("acos", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
242 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
243 IN_FLOAT (d = acos (d), "acos", arg); |
102 | 244 return make_float (d); |
245 } | |
246 | |
247 DEFUN ("asin", Fasin, Sasin, 1, 1, 0, | |
248 "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
|
249 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
250 register Lisp_Object arg; |
102 | 251 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
252 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
|
253 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
254 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
|
255 domain_error ("asin", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
256 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
257 IN_FLOAT (d = asin (d), "asin", arg); |
102 | 258 return make_float (d); |
259 } | |
260 | |
261 DEFUN ("atan", Fatan, Satan, 1, 1, 0, | |
262 "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
|
263 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
264 register Lisp_Object arg; |
102 | 265 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
266 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
|
267 IN_FLOAT (d = atan (d), "atan", arg); |
102 | 268 return make_float (d); |
269 } | |
270 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
271 DEFUN ("cos", Fcos, Scos, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
272 "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
|
273 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
274 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
275 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
276 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
|
277 IN_FLOAT (d = cos (d), "cos", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
278 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
279 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
280 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
281 DEFUN ("sin", Fsin, Ssin, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
282 "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
|
283 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
284 register Lisp_Object arg; |
102 | 285 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
286 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
|
287 IN_FLOAT (d = sin (d), "sin", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
288 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
289 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
290 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
291 DEFUN ("tan", Ftan, Stan, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
292 "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
|
293 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
294 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
295 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
296 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
|
297 double c = cos (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
298 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
299 if (c == 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
300 domain_error ("tan", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
301 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
302 IN_FLOAT (d = sin (d) / c, "tan", arg); |
102 | 303 return make_float (d); |
304 } | |
305 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
306 #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
|
307 |
102 | 308 DEFUN ("bessel-j0", Fbessel_j0, Sbessel_j0, 1, 1, 0, |
309 "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
|
310 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
311 register Lisp_Object arg; |
102 | 312 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
313 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
|
314 IN_FLOAT (d = j0 (d), "bessel-j0", arg); |
102 | 315 return make_float (d); |
316 } | |
317 | |
318 DEFUN ("bessel-j1", Fbessel_j1, Sbessel_j1, 1, 1, 0, | |
319 "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
|
320 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
321 register Lisp_Object arg; |
102 | 322 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
323 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
|
324 IN_FLOAT (d = j1 (d), "bessel-j1", arg); |
102 | 325 return make_float (d); |
326 } | |
327 | |
328 DEFUN ("bessel-jn", Fbessel_jn, Sbessel_jn, 2, 2, 0, | |
329 "Return the order N bessel function output jn of ARG.\n\ | |
330 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
|
331 (n, arg) |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
332 register Lisp_Object n, arg; |
102 | 333 { |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
334 int i1 = extract_float (n); |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
335 double f2 = extract_float (arg); |
102 | 336 |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
337 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", n); |
102 | 338 return make_float (f2); |
339 } | |
340 | |
341 DEFUN ("bessel-y0", Fbessel_y0, Sbessel_y0, 1, 1, 0, | |
342 "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
|
343 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
344 register Lisp_Object arg; |
102 | 345 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
346 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
|
347 IN_FLOAT (d = y0 (d), "bessel-y0", arg); |
102 | 348 return make_float (d); |
349 } | |
350 | |
351 DEFUN ("bessel-y1", Fbessel_y1, Sbessel_y1, 1, 1, 0, | |
352 "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
|
353 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
354 register Lisp_Object arg; |
102 | 355 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
356 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
|
357 IN_FLOAT (d = y1 (d), "bessel-y0", arg); |
102 | 358 return make_float (d); |
359 } | |
360 | |
361 DEFUN ("bessel-yn", Fbessel_yn, Sbessel_yn, 2, 2, 0, | |
362 "Return the order N bessel function output yn of ARG.\n\ | |
363 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
|
364 (n, arg) |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
365 register Lisp_Object n, arg; |
102 | 366 { |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
367 int i1 = extract_float (n); |
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
368 double f2 = extract_float (arg); |
102 | 369 |
14076
b339e9aaea4b
(Fbessel_jn, Fbessel_yn): Harmonize arguments with documentation.
Erik Naggum <erik@naggum.no>
parents:
14036
diff
changeset
|
370 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", n); |
102 | 371 return make_float (f2); |
372 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
373 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
374 #endif |
102 | 375 |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
376 #if 0 /* Leave these out unless we see they are worth having. */ |
102 | 377 |
378 DEFUN ("erf", Ferf, Serf, 1, 1, 0, | |
379 "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
|
380 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
381 register Lisp_Object arg; |
102 | 382 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
383 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
|
384 IN_FLOAT (d = erf (d), "erf", arg); |
102 | 385 return make_float (d); |
386 } | |
387 | |
388 DEFUN ("erfc", Ferfc, Serfc, 1, 1, 0, | |
389 "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
|
390 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
391 register Lisp_Object arg; |
102 | 392 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
393 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
|
394 IN_FLOAT (d = erfc (d), "erfc", arg); |
102 | 395 return make_float (d); |
396 } | |
397 | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
398 DEFUN ("log-gamma", Flog_gamma, Slog_gamma, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
399 "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
|
400 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
401 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
402 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
403 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
|
404 IN_FLOAT (d = lgamma (d), "log-gamma", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
405 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
406 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
407 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
408 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
|
409 "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
|
410 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
411 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
412 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
413 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
|
414 #ifdef HAVE_CBRT |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
415 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
|
416 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
417 if (d >= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
418 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
|
419 else |
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 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
422 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
423 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
424 |
694 | 425 #endif |
426 | |
102 | 427 DEFUN ("exp", Fexp, Sexp, 1, 1, 0, |
428 "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
|
429 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
430 register Lisp_Object arg; |
102 | 431 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
432 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
|
433 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
434 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
|
435 range_error ("exp", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
436 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
|
437 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
|
438 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
439 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
440 IN_FLOAT (d = exp (d), "exp", arg); |
102 | 441 return make_float (d); |
442 } | |
443 | |
444 DEFUN ("expt", Fexpt, Sexpt, 2, 2, 0, | |
13442 | 445 "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
|
446 (arg1, arg2) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
447 register Lisp_Object arg1, arg2; |
102 | 448 { |
449 double f1, f2; | |
450 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
451 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
|
452 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
|
453 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
|
454 && INTEGERP (arg2)) /* don't promote, if both are ints */ |
102 | 455 { /* 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
|
456 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
|
457 Lisp_Object val; |
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
458 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
459 x = XINT (arg1); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
460 y = XINT (arg2); |
102 | 461 acc = 1; |
462 | |
463 if (y < 0) | |
464 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
465 if (x == 1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
466 acc = 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
467 else 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 = (y & 1) ? -1 : 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
469 else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
470 acc = 0; |
102 | 471 } |
472 else | |
473 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
474 while (y > 0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
475 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
476 if (y & 1) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
477 acc *= x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
478 x *= x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
479 y = (unsigned)y >> 1; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
480 } |
102 | 481 } |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
482 XSETINT (val, acc); |
3673
8ab0a7453577
(Fexpt): New local `val' for making integer to return.
Richard M. Stallman <rms@gnu.org>
parents:
3591
diff
changeset
|
483 return val; |
102 | 484 } |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
485 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
|
486 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
|
487 /* 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
|
488 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
|
489 f1 = 1.0; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
490 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
491 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
|
492 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
|
493 #endif |
4529 | 494 IN_FLOAT2 (f1 = pow (f1, f2), "expt", arg1, arg2); |
102 | 495 return make_float (f1); |
496 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
497 |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
498 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
|
499 "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
|
500 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
|
501 (arg, base) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
502 register Lisp_Object arg, base; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
503 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
504 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
|
505 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
506 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
507 if (d <= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
508 domain_error2 ("log", arg, base); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
509 #endif |
1005
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
510 if (NILP (base)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
511 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
|
512 else |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
513 { |
70ed307d9047
* floatfns.c (Fexpm1, Flog1p): Function removed; it's not widely
Jim Blandy <jimb@redhat.com>
parents:
694
diff
changeset
|
514 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
|
515 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
516 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
517 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
|
518 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
|
519 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
520 if (b == 10.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
521 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
|
522 else |
3407
d00aaf536bfd
[!FLOAT_CHECK_ERRNO] (IN_FLOAT): New definition.
Richard M. Stallman <rms@gnu.org>
parents:
3094
diff
changeset
|
523 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
|
524 } |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
525 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
526 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
527 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
528 DEFUN ("log10", Flog10, Slog10, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
529 "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
|
530 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
531 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
532 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
533 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
|
534 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
535 if (d <= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
536 domain_error ("log10", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
537 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
538 IN_FLOAT (d = log10 (d), "log10", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
539 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
540 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
541 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
542 DEFUN ("sqrt", Fsqrt, Ssqrt, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
543 "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
|
544 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
545 register Lisp_Object arg; |
102 | 546 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
547 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
|
548 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
549 if (d < 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
550 domain_error ("sqrt", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
551 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
552 IN_FLOAT (d = sqrt (d), "sqrt", arg); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
553 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
554 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
555 |
694 | 556 #if 0 /* Not clearly worth adding. */ |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
557 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
558 DEFUN ("acosh", Facosh, Sacosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
559 "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
|
560 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
561 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
562 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
563 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
|
564 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
565 if (d < 1.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
566 domain_error ("acosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
567 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
568 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
569 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
|
570 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
571 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
|
572 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
573 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
574 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
575 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
576 DEFUN ("asinh", Fasinh, Sasinh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
577 "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
|
578 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
579 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
580 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
581 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
|
582 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
583 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
|
584 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
585 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
|
586 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
587 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
588 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
589 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
590 DEFUN ("atanh", Fatanh, Satanh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
591 "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
|
592 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
593 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
594 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
595 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
|
596 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
597 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
|
598 domain_error ("atanh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
599 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
600 #ifdef HAVE_INVERSE_HYPERBOLIC |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
601 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
|
602 #else |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
603 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
|
604 #endif |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
605 return make_float (d); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
606 } |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
607 |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
608 DEFUN ("cosh", Fcosh, Scosh, 1, 1, 0, |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
609 "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
|
610 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
611 register Lisp_Object arg; |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
612 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
613 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
|
614 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
615 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
|
616 range_error ("cosh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
617 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
618 IN_FLOAT (d = cosh (d), "cosh", arg); |
102 | 619 return make_float (d); |
620 } | |
621 | |
622 DEFUN ("sinh", Fsinh, Ssinh, 1, 1, 0, | |
623 "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
|
624 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
625 register Lisp_Object arg; |
102 | 626 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
627 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
|
628 #ifdef FLOAT_CHECK_DOMAIN |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
629 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
|
630 range_error ("sinh", arg); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
631 #endif |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
632 IN_FLOAT (d = sinh (d), "sinh", arg); |
102 | 633 return make_float (d); |
634 } | |
635 | |
636 DEFUN ("tanh", Ftanh, Stanh, 1, 1, 0, | |
637 "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
|
638 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
639 register Lisp_Object arg; |
102 | 640 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
641 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
|
642 IN_FLOAT (d = tanh (d), "tanh", arg); |
102 | 643 return make_float (d); |
644 } | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
645 #endif |
102 | 646 |
647 DEFUN ("abs", Fabs, Sabs, 1, 1, 0, | |
648 "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
|
649 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
650 register Lisp_Object arg; |
102 | 651 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
652 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 653 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
654 if (FLOATP (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
655 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
|
656 else if (XINT (arg) < 0) |
9365
0b431684f97b
(Fabs): Don't use XFASTINT when negative.
Karl Heuer <kwzh@gnu.org>
parents:
9267
diff
changeset
|
657 XSETINT (arg, - XINT (arg)); |
102 | 658 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
659 return arg; |
102 | 660 } |
661 | |
662 DEFUN ("float", Ffloat, Sfloat, 1, 1, 0, | |
663 "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
|
664 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
665 register Lisp_Object arg; |
102 | 666 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
667 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 668 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
669 if (INTEGERP (arg)) |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
670 return make_float ((double) XINT (arg)); |
102 | 671 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
|
672 return arg; |
102 | 673 } |
674 | |
675 DEFUN ("logb", Flogb, Slogb, 1, 1, 0, | |
4590 | 676 "Returns largest integer <= the base 2 log of the magnitude of ARG.\n\ |
102 | 677 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
|
678 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
679 Lisp_Object arg; |
102 | 680 { |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
681 Lisp_Object val; |
11265
b2291296ec87
(Flogb): Use EMACS_INT for `value'.
Richard M. Stallman <rms@gnu.org>
parents:
9365
diff
changeset
|
682 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
|
683 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
|
684 |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
685 if (f == 0.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
686 value = -(VALMASK >> 1); |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
687 else |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
688 { |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
689 #ifdef HAVE_LOGB |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
690 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
|
691 #else |
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
692 #ifdef HAVE_FREXP |
11859
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
693 int ivalue; |
8d57babf4b36
(Flogb): frexp needs a pointer to int, not EMACS_INT.
Karl Heuer <kwzh@gnu.org>
parents:
11265
diff
changeset
|
694 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
|
695 value = ivalue - 1; |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
696 #else |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
697 int i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
698 double d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
699 if (f < 0.0) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
700 f = -f; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
701 value = -1; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
702 while (f < 0.5) |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
703 { |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
704 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
|
705 d *= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
706 f /= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
707 value -= i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
708 } |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
709 while (f >= 1.0) |
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 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
|
712 d *= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
713 f /= d; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
714 value += i; |
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
715 } |
4501
9352d7d021c2
* config.h.in (HAVE_LOGB, HAVE_FREXP): Add #undefs for the
Jim Blandy <jimb@redhat.com>
parents:
3673
diff
changeset
|
716 #endif |
2205
c021f53fe7e5
* floatfns.c (logb): Add extern declaration for this.
Jim Blandy <jimb@redhat.com>
parents:
2129
diff
changeset
|
717 #endif |
6359
800c035273e9
(Flogb): Check for 0.0. Emulate logb if needed.
Karl Heuer <kwzh@gnu.org>
parents:
6314
diff
changeset
|
718 } |
9267
1b685d477c10
(FLOAT_TO_INT, FLOAT_TO_INT2, Fexpt, Flogb, Ffloor): Use new accessor macros
Karl Heuer <kwzh@gnu.org>
parents:
9129
diff
changeset
|
719 XSETINT (val, value); |
2119
4077ef8ad483
* floatfns.c (Flogb): Undo the change of Feb 22.
Jim Blandy <jimb@redhat.com>
parents:
2094
diff
changeset
|
720 return val; |
102 | 721 } |
722 | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
723 #endif /* LISP_FLOAT_TYPE */ |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
724 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
725 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
726 /* the rounding functions */ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
727 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
728 static Lisp_Object |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
729 rounding_driver (arg, divisor, double_round, int_round2, name) |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
730 register Lisp_Object arg, divisor; |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
731 double (*double_round) (); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
732 EMACS_INT (*int_round2) (); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
733 char *name; |
102 | 734 { |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
735 CHECK_NUMBER_OR_FLOAT (arg, 0); |
102 | 736 |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
737 if (! NILP (divisor)) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
738 { |
12537
476296adb950
(Fexpt): Use EMACS_INT for integer calculation.
Karl Heuer <kwzh@gnu.org>
parents:
11859
diff
changeset
|
739 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
|
740 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
741 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
|
742 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
743 #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
|
744 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
|
745 { |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
746 double f1, f2; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
747 |
9129
b2d1d925d5cc
(extract_float, Fexpt, Fabs, Ffloat, Fceiling, Ffloor, Fround, Ftruncate): Use
Karl Heuer <kwzh@gnu.org>
parents:
8825
diff
changeset
|
748 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
|
749 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
|
750 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
|
751 Fsignal (Qarith_error, Qnil); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
752 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
753 IN_FLOAT2 (f1 = (*double_round) (f1 / f2), name, arg, divisor); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
754 FLOAT_TO_INT2 (f1, arg, name, arg, divisor); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
755 return arg; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
756 } |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
757 #endif |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
758 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
759 i1 = XINT (arg); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
760 i2 = XINT (divisor); |
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 if (i2 == 0) |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
763 Fsignal (Qarith_error, Qnil); |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
764 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
765 XSETINT (arg, (*int_round2) (i1, i2)); |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
766 return arg; |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
767 } |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
768 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
769 #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
|
770 if (FLOATP (arg)) |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
771 { |
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
772 double d; |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
773 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
774 IN_FLOAT (d = (*double_round) (XFLOAT (arg)->data), name, arg); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
775 FLOAT_TO_INT (d, arg, name, arg); |
6375
212dcd2c06e4
(FLOAT_TO_INT, FLOAT_TO_INT2, range_error2): New macros.
Karl Heuer <kwzh@gnu.org>
parents:
6359
diff
changeset
|
776 } |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
777 #endif |
102 | 778 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
779 return arg; |
102 | 780 } |
781 | |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
782 /* With C's /, the result is implementation-defined if either operand |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
783 is negative, so take care with negative operands in the following |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
784 integer functions. */ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
785 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
786 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
787 ceiling2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
788 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
789 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
790 return (i2 < 0 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
791 ? (i1 < 0 ? ((-1 - i1) / -i2) + 1 : - (i1 / -i2)) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
792 : (i1 <= 0 ? - (-i1 / i2) : ((i1 - 1) / i2) + 1)); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
793 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
794 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
795 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
796 floor2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
797 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
798 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
799 return (i2 < 0 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
800 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2)) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
801 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2)); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
802 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
803 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
804 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
805 truncate2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
806 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
807 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
808 return (i2 < 0 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
809 ? (i1 < 0 ? -i1 / -i2 : - (i1 / -i2)) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
810 : (i1 < 0 ? - (-i1 / i2) : i1 / i2)); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
811 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
812 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
813 static EMACS_INT |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
814 round2 (i1, i2) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
815 EMACS_INT i1, i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
816 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
817 /* The C language's division operator gives us one remainder R, but |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
818 we want the remainder R1 on the other side of 0 if R1 is closer |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
819 to 0 than R is; because we want to round to even, we also want R1 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
820 if R and R1 are the same distance from 0 and if C's quotient is |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
821 odd. */ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
822 EMACS_INT q = i1 / i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
823 EMACS_INT r = i1 % i2; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
824 EMACS_INT abs_r = r < 0 ? -r : r; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
825 EMACS_INT abs_r1 = (i2 < 0 ? -i2 : i2) - abs_r; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
826 return q + (abs_r + (q & 1) <= abs_r1 ? 0 : (i2 ^ r) < 0 ? -1 : 1); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
827 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
828 |
16929
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
829 #ifndef HAVE_RINT |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
830 static double |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
831 rint (d) |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
832 double d; |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
833 { |
16956 | 834 return floor (d + 0.5); |
16929
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
835 } |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
836 #endif |
a6b5ec9a51b4
[!HAVE_RINT] (rint): Convert macro to an actual
Karl Heuer <kwzh@gnu.org>
parents:
16857
diff
changeset
|
837 |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
838 static double |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
839 double_identity (d) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
840 double d; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
841 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
842 return d; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
843 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
844 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
845 DEFUN ("ceiling", Fceiling, Sceiling, 1, 2, 0, |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
846 "Return the smallest integer no less than ARG. (Round toward +inf.)\n\ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
847 With optional DIVISOR, return the smallest integer no less than ARG/DIVISOR.") |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
848 (arg, divisor) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
849 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
850 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
851 return rounding_driver (arg, divisor, ceil, ceiling2, "ceiling"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
852 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
853 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
854 DEFUN ("floor", Ffloor, Sfloor, 1, 2, 0, |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
855 "Return the largest integer no greater than ARG. (Round towards -inf.)\n\ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
856 With optional DIVISOR, return the largest integer no greater than ARG/DIVISOR.") |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
857 (arg, divisor) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
858 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
859 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
860 return rounding_driver (arg, divisor, floor, floor2, "floor"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
861 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
862 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
863 DEFUN ("round", Fround, Sround, 1, 2, 0, |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
864 "Return the nearest integer to ARG.\n\ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
865 With optional DIVISOR, return the nearest integer to ARG/DIVISOR.") |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
866 (arg, divisor) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
867 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
868 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
869 return rounding_driver (arg, divisor, rint, round2, "round"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
870 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
871 |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
872 DEFUN ("truncate", Ftruncate, Struncate, 1, 2, 0, |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
873 "Truncate a floating point number to an int.\n\ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
874 Rounds ARG toward zero.\n\ |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
875 With optional DIVISOR, truncate ARG/DIVISOR.") |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
876 (arg, divisor) |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
877 Lisp_Object arg, divisor; |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
878 { |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
879 return rounding_driver (arg, divisor, double_identity, truncate2, |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
880 "truncate"); |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
881 } |
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
882 |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
883 #ifdef LISP_FLOAT_TYPE |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
884 |
16786
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
885 Lisp_Object |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
886 fmod_float (x, y) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
887 register Lisp_Object x, y; |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
888 { |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
889 double f1, f2; |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
890 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
891 f1 = FLOATP (x) ? XFLOAT (x)->data : XINT (x); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
892 f2 = FLOATP (y) ? XFLOAT (y)->data : XINT (y); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
893 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
894 if (! IEEE_FLOATING_POINT && f2 == 0) |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
895 Fsignal (Qarith_error, Qnil); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
896 |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
897 /* 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
|
898 IN_FLOAT2 ((f1 = fmod (f1, f2), |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
899 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
|
900 "mod", x, y); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
901 return make_float (f1); |
8907c00c0cc6
<float.h>: Include if STDC_HEADERS.
Paul Eggert <eggert@twinsun.com>
parents:
16220
diff
changeset
|
902 } |
102 | 903 |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
904 /* 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
|
905 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
906 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
|
907 "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
|
908 \(Round toward +inf.\)") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
909 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
910 register Lisp_Object arg; |
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 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
|
913 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
|
914 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
915 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
916 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
917 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
|
918 "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
|
919 \(Round towards -inf.\)") |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
920 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
921 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
922 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
923 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
|
924 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
|
925 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
926 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
927 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
928 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
|
929 "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
|
930 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
931 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
932 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
933 double d = extract_float (arg); |
5595
63bc8a14a073
(Fffloor, Ffceil, Ffround, Fftruncate): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
5495
diff
changeset
|
934 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
|
935 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
936 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
937 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
938 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
|
939 "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
|
940 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
|
941 (arg) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
942 register Lisp_Object arg; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
943 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
944 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
|
945 if (d >= 0.0) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
946 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
|
947 else |
5495
87f9165f5b14
[MSDOS]: Don't define HAVE_MATHERR.
Richard M. Stallman <rms@gnu.org>
parents:
4881
diff
changeset
|
948 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
|
949 return make_float (d); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
950 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
951 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
952 #ifdef FLOAT_CATCH_SIGILL |
621 | 953 static SIGTYPE |
102 | 954 float_error (signo) |
955 int signo; | |
956 { | |
957 if (! in_float) | |
958 fatal_error_signal (signo); | |
959 | |
16220
02044b05d8e0
Replaced symbol BSD with BSD_SYSTEM.
Karl Heuer <kwzh@gnu.org>
parents:
16207
diff
changeset
|
960 #ifdef BSD_SYSTEM |
102 | 961 #ifdef BSD4_1 |
962 sigrelse (SIGILL); | |
963 #else /* not BSD4_1 */ | |
638 | 964 sigsetmask (SIGEMPTYMASK); |
102 | 965 #endif /* not BSD4_1 */ |
485 | 966 #else |
967 /* Must reestablish handler each time it is called. */ | |
968 signal (SIGILL, float_error); | |
16220
02044b05d8e0
Replaced symbol BSD with BSD_SYSTEM.
Karl Heuer <kwzh@gnu.org>
parents:
16207
diff
changeset
|
969 #endif /* BSD_SYSTEM */ |
102 | 970 |
971 in_float = 0; | |
972 | |
973 Fsignal (Qarith_error, Fcons (float_error_arg, Qnil)); | |
974 } | |
975 | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
976 /* 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
|
977 where SIGILL is signaled. */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
978 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
979 #endif /* FLOAT_CATCH_SIGILL */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
980 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
981 #ifdef HAVE_MATHERR |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
982 int |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
983 matherr (x) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
984 struct exception *x; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
985 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
986 Lisp_Object args; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
987 if (! in_float) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
988 /* 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
|
989 return 0; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
990 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
|
991 x->name = "expt"; |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
992 |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
993 args |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
994 = 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
|
995 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
|
996 ((!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
|
997 ? 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
|
998 : Qnil))); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
999 switch (x->type) |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1000 { |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1001 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
|
1002 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
|
1003 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
|
1004 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
|
1005 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
|
1006 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1007 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
|
1008 } |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1009 #endif /* HAVE_MATHERR */ |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1010 |
102 | 1011 init_floatfns () |
1012 { | |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1013 #ifdef FLOAT_CATCH_SIGILL |
102 | 1014 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
|
1015 #endif |
102 | 1016 in_float = 0; |
1017 } | |
1018 | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1019 #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
|
1020 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1021 init_floatfns () |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1022 {} |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1023 |
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1024 #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
|
1025 |
102 | 1026 syms_of_floatfns () |
1027 { | |
4506
6131dad14f6f
(Ffloor): Optional second operand specifies divisor, as in Common Lisp.
Paul Eggert <eggert@twinsun.com>
parents:
4501
diff
changeset
|
1028 #ifdef LISP_FLOAT_TYPE |
102 | 1029 defsubr (&Sacos); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1030 defsubr (&Sasin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1031 defsubr (&Satan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1032 defsubr (&Scos); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1033 defsubr (&Ssin); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1034 defsubr (&Stan); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1035 #if 0 |
102 | 1036 defsubr (&Sacosh); |
1037 defsubr (&Sasinh); | |
1038 defsubr (&Satanh); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1039 defsubr (&Scosh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1040 defsubr (&Ssinh); |
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1041 defsubr (&Stanh); |
102 | 1042 defsubr (&Sbessel_y0); |
1043 defsubr (&Sbessel_y1); | |
1044 defsubr (&Sbessel_yn); | |
1045 defsubr (&Sbessel_j0); | |
1046 defsubr (&Sbessel_j1); | |
1047 defsubr (&Sbessel_jn); | |
1048 defsubr (&Serf); | |
1049 defsubr (&Serfc); | |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1050 defsubr (&Slog_gamma); |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1051 defsubr (&Scube_root); |
5595
63bc8a14a073
(Fffloor, Ffceil, Ffround, Fftruncate): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
5495
diff
changeset
|
1052 #endif |
2094
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1053 defsubr (&Sfceiling); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1054 defsubr (&Sffloor); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1055 defsubr (&Sfround); |
c77607f8e32d
(FLOAT_CHECK_ERRNO): Define unless NO_FLOAT_CHECK_ERRNO.
Richard M. Stallman <rms@gnu.org>
parents:
1918
diff
changeset
|
1056 defsubr (&Sftruncate); |
102 | 1057 defsubr (&Sexp); |
683
7f4d77d29804
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
638
diff
changeset
|
1058 defsubr (&Sexpt); |
102 | 1059 defsubr (&Slog); |
1060 defsubr (&Slog10); | |
1061 defsubr (&Ssqrt); | |
1062 | |
1063 defsubr (&Sabs); | |
1064 defsubr (&Sfloat); | |
1065 defsubr (&Slogb); | |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
1066 #endif /* LISP_FLOAT_TYPE */ |
102 | 1067 defsubr (&Sceiling); |
16857
bdafa1f28a64
(rounding_driver): New function for systematic support of
Paul Eggert <eggert@twinsun.com>
parents:
16786
diff
changeset
|
1068 defsubr (&Sfloor); |
102 | 1069 defsubr (&Sround); |
1070 defsubr (&Struncate); | |
1071 } |