annotate src/floatfns.c @ 872:79c6ff3eef26

[xemacs-hg @ 2002-06-20 21:18:01 by ben] font changes etc.; some 21.4 changes mule/mule-msw-init-late.el: Specify charset->windows-registry conversion. mule/mule-x-init.el: Delete extra mule font additions here. Put them in faces.c. cl-macs.el: Document better. font-lock.el: Move Lisp function regexp to lisp-mode.el. lisp-mode.el: Various indentation fixes: Handle flet functions better. Handle argument lists in defuns and flets. Handle quoted lists, e.g. property lists -- don't indent like function calls. Distinguish between lambdas and other lists. lisp-mode.el: Handle this form. faces.el, font-menu.el, font.el, gtk-faces.el, msw-faces.el, msw-font-menu.el, x-faces.el, x-init.el: Major overhaul of face-handling code: -- Fix lots of bogus code in msw-faces.el, msw-font-menu.el, font-menu.el that was "truenaming" font specs -- i.e. in the process of frobbing a particular field in a general user-specified font spec with wildcarded fields, sticking in particular values for all the remaining wildcarded fields. This bug was rampant everywhere except in x-faces.el (the oldest and only correctly written code). This also means that we need to work with font names at all times and not font instances, because a font instance is essentially a truenamed font. -- Total rewrite of extremely junky code in msw-faces.el. Work with names as well as font instances, and return names; stop truenaming when canonicalizing and frobbing; fix handling of the combined style field, i.e. weight/slant (also fixed in font.el). -- Totally rewrite the frobbing functions in faces.el. This time, we frob all the instantiators rather than just computing a single instance value and working backwards. That way, e.g., `bold' will work for all charsets that have bold available, rather than only for whatever charset was part of the computed font instance (another example of the truename virus). Also fix up code to look at the fallbacks (all of them) when no global value present, so we don't need to put something in the global value. Intelligently handle a request to frob a buffer locale, rather than signalling an error. When frobbing instantiators, try hard to figure out what device type is associated with them, and frob each according to its own proper device type. Correctly handle inheritance vectors given as instantiators. Preserve existing tags when putting back frobbed instantiators. Extract out general specifier-frobbing code into specifier.el. Document everything cleanly. Do lots of other things better, etc. -- Don't duplicatively set a global specification for the default font -- it's already in the fallback and we no longer need a default global specification present. Delete various code in x-faces.el and msw-faces.el that duplicated the lists of fonts in faces.c. -- init-global-faces was not being called at all under MS Windows! Major bogosity. That caused device-specific values to get stuck into all the fonts, making it very hard to change them -- setting global specs caused nothing to happen. -- Correct weight names in font.el. -- Lots more font fixups in objects*.c. Printer.el: Warning fix. specifier.el: Add more args to map-specifier. Add various "heuristic" specifier functions to aid in creation of specifier-munging code such as in faces.el. subr.el: New functions. lwlib.c: Fix warning. config.inc.samp: Clean up, add args to control fastcall (not yet supported! the changes needed are in another ws of mine), profile support, vc6 support, union-type. xemacs.dsp, xemacs.mak: Semi-major overhaul. Fix bug where dump-id was always getting recomputed, forcing a redump even when nothing changed. Add support for fastcall. Support edit-and-continue (on by default) with vc6. Use incremental linking when doing a debug compilation. Add support for profiling. Consolidate the various debug flags. Partial support for "batch-compiling" -- compiling many files on a single invocation of the compiler. Doesn't seem to help that much for me, so it's not finished or enabled by default. Remove HAVE_MSW_C_DIRED, we always do. Correct some sloppy use of directories. s/cygwin32.h: Allow pdump to work under Cygwin (mmap is broken, so need to undefine HAVE_MMAP). s/win32-common.h, s/windowsnt.h: Support for fastcall. Add WIN32_ANY for identifying all Win32 variants (Cygwin, native, MinGW). Both of these are properly used in another ws. alloc.c, balloon-x.c, buffer.c, bytecode.c, callint.c, cm.c, cmdloop.c, cmds.c, console-gtk.c, console-gtk.h, console-msw.c, console-msw.h, console-stream.c, console-stream.h, console-tty.c, console-tty.h, console-x.c, console-x.h, console.c, console.h, device-gtk.c, device-msw.c, device-tty.c, device-x.c, device.c, device.h, devslots.h, dialog-gtk.c, dialog-msw.c, dialog-x.c, dialog.c, dired-msw.c, editfns.c, emacs.c, event-Xt.c, event-gtk.c, event-msw.c, event-stream.c, event-tty.c, event-unixoid.c, events.c, extents.c, extents.h, faces.c, fileio.c, fns.c, frame-gtk.c, frame-msw.c, frame-tty.c, frame-x.c, frame.c, frame.h, glyphs-eimage.c, glyphs-gtk.c, glyphs-msw.c, glyphs-widget.c, glyphs-x.c, glyphs.c, glyphs.h, gui-gtk.c, gui-msw.c, gui-x.c, gui.c, gutter.c, input-method-xlib.c, intl-encap-win32.c, intl-win32.c, keymap.c, lisp.h, macros.c, menubar-gtk.c, menubar-msw.c, menubar-x.c, menubar.c, menubar.h, minibuf.c, mule-charset.c, nt.c, objects-gtk.c, objects-gtk.h, objects-msw.c, objects-msw.h, objects-tty.c, objects-tty.h, objects-x.c, objects-x.h, objects.c, objects.h, postgresql.c, print.c, process.h, redisplay-gtk.c, redisplay-msw.c, redisplay-output.c, redisplay-tty.c, redisplay-x.c, redisplay.c, redisplay.h, scrollbar-gtk.c, scrollbar-msw.c, scrollbar-x.c, scrollbar.c, select-gtk.c, select-msw.c, select-x.c, select.c, signal.c, sound.c, specifier.c, symbols.c, syntax.c, sysdep.c, syssignal.h, syswindows.h, toolbar-common.c, toolbar-gtk.c, toolbar-msw.c, toolbar-x.c, toolbar.c, unicode.c, window.c, window.h: The following are the major changes made: (1) Separation of various header files into an external and an internal version, similar to the existing separation of process.h and procimpl.h. Eventually this should be done for all Lisp objects. The external version has the same name as currently; the internal adds -impl. The external file has XFOO() macros for objects, but the structure is opaque and defined only in the internal file. It's now reasonable to move all prototypes in lisp.h into the appropriate external file, and this should be done. Currently, separation has been done on extents.h, objects*.h, console.h, device.h, frame.h, and window.h. For c/d/f/w, the most basic properties are available in the external header file, with the macros resolving to functions. In the internal header file, the macros are redefined to directly access the structure. Also, the global MARK_FOO_CHANGED macros have been made into functions so that they can be accessed without needing to include lots of -impl headers -- they are used in almost exclusively in non-time-critical functions, and take up enough time that the function overhead will be negligible. Similarly, the function overhead from making the basic properties mentioned above into functions is negligible, and code that does heavy accessing of c/d/f/w structures inevitably ends up needing the internal header files, anyway. (2) More face changes. -- Major rewrite of objects-msw.c. Now handles wildcard specs properly, rather than "truenaming" (or even worse, signalling an error, which previously happened with some of the fallbacks if you tried to use them in make-font-instance!). -- Split charset matching of fonts into two stages -- one to find a font specifically designed for a particular charset (by examining its registry), the second to find a Unicode font that can support the charset. This needs to proceed as two complete, separate instantiations in order to work properly (otherwise many of the fonts in the HELLO page look wrong). This should also make it easy to support iso10646 (Unicode) fonts under X. -- All default values for fonts are now completely specified in the fallbacks. Stuff from mule-x-init.el has all been moved here, merged with the existing specs, and totally rethought so you get sensible results. (HELLO now looks much better!). -- Generalize the "default X/GTK device" stuff into a per-device-type "default device". -- Add mswindows-{set-}charset-registry. In time, charset<->code-page conversion functions will be removed. -- Wrap protective code around calls to compute device specifier tags, and do this computation before calling the face initialization code because the latter may need these tags to be correctly updated. (3) Other changes. EmacsFrame.c, glyphs-msw.c, eval.c, gui-x.c, intl-encap-win32.c, search.c, signal.c, toolbar-msw.c, unicode.c: Warning fixes. config.h.in: #undefs meant to be frobbed by configure *MUST* go inside of #ifndef WIN32_NO_CONFIGURE, and everything else *MUST* go outside! eval.c: Let detailed backtraces be detailed. specifier.c: Don't override user's print-string-length/print-length settings. glyphs.c: New function image-instance-instantiator. config.h.in, sysdep.c: Changes for fastcall. sysdep.c, nt.c: Fix up a previous botched patch that tried to add support for both EEXIST and EACCES. IF THE BOTCHED PATCH WENT INTO 21.4, THIS FIXUP NEEDS TO GO IN, TOO. search.c: Fix *evil* crash due to incorrect synching of syntax-cache code with 21.1. THIS SHOULD GO INTO 21.4.
author ben
date Thu, 20 Jun 2002 21:19:10 +0000
parents 943eaba38521
children c925bacdda60
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 /* Primitive operations on floating point for XEmacs Lisp interpreter.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2 Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 Boston, MA 02111-1307, USA. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 /* Synched up with: FSF 19.30. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 /* ANSI C requires only these float functions:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 acos, asin, atan, atan2, ceil, cos, cosh, exp, fabs, floor, fmod,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 frexp, ldexp, log, log10, modf, pow, sin, sinh, sqrt, tan, tanh.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27 Define HAVE_INVERSE_HYPERBOLIC if you have acosh, asinh, and atanh.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 Define HAVE_CBRT if you have cbrt().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29 Define HAVE_RINT if you have rint().
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 If you don't define these, then the appropriate routines will be simulated.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 Define HAVE_MATHERR if on a system supporting the SysV matherr() callback.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33 (This should happen automatically.)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 Define FLOAT_CHECK_ERRNO if the float library routines set errno.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 This has no effect if HAVE_MATHERR is defined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38 Define FLOAT_CATCH_SIGILL if the float library routines signal SIGILL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 (What systems actually do this? Let me know. -jwz)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41 Define FLOAT_CHECK_DOMAIN if the float library doesn't handle errors by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 either setting errno, or signalling SIGFPE/SIGILL. Otherwise, domain and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43 range checking will happen before calling the float routines. This has
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 no effect if HAVE_MATHERR is defined (since matherr will be called when
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 a domain error occurs).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 #include <config.h>
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 #include "lisp.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 #include "syssignal.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 #include "sysfloat.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
56 /* The code uses emacs_rint, so that it works to undefine HAVE_RINT
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
57 if `rint' exists but does not work right. */
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
58 #ifdef HAVE_RINT
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
59 #define emacs_rint rint
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
60 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 static double
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
62 emacs_rint (double x)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 double r = floor (x + 0.5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 double diff = fabs (r - x);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 /* Round to even and correct for any roundoff errors. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 if (diff >= 0.5 && (diff > 0.5 || r != 2.0 * floor (r / 2.0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 r += r < x ? 1.0 : -1.0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 return r;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 /* Nonzero while executing in floating point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74 This tells float_error what to do. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 static int in_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 /* If an argument is out of range for a mathematical function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78 here is the actual argument value to use in the error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 static Lisp_Object float_error_arg, float_error_arg2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
80 static const char *float_error_fn_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 /* Evaluate the floating point expression D, recording NUM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83 as the original argument for error messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 D is normally an assignment expression.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 Handle errors which may result in signals or may set errno.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Note that float_error may be declared to return void, so you can't
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 just cast the zero after the colon to (SIGTYPE) to make the types
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 check properly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90 #ifdef FLOAT_CHECK_ERRNO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 #define IN_FLOAT(d, name, num) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 float_error_arg = num; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 float_error_fn_name = name; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 in_float = 1; errno = 0; (d); in_float = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 if (errno != 0) in_float_error (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 #define IN_FLOAT2(d, name, num, num2) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 float_error_arg = num; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 float_error_arg2 = num2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 float_error_fn_name = name; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 in_float = 2; errno = 0; (d); in_float = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 if (errno != 0) in_float_error (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 #define IN_FLOAT(d, name, num) (in_float = 1, (d), in_float = 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 #define IN_FLOAT2(d, name, num, num2) (in_float = 2, (d), in_float = 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 #define arith_error(op,arg) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
113 Fsignal (Qarith_error, list2 (build_msg_string (op), arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 #define range_error(op,arg) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
115 Fsignal (Qrange_error, list2 (build_msg_string (op), arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 #define range_error2(op,a1,a2) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
117 Fsignal (Qrange_error, list3 (build_msg_string (op), a1, a2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #define domain_error(op,arg) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
119 Fsignal (Qdomain_error, list2 (build_msg_string (op), arg))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 #define domain_error2(op,a1,a2) \
771
943eaba38521 [xemacs-hg @ 2002-03-13 08:51:24 by ben]
ben
parents: 665
diff changeset
121 Fsignal (Qdomain_error, list3 (build_msg_string (op), a1, a2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 /* Convert float to Lisp Integer if it fits, else signal a range
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 error using the given arguments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
127 float_to_int (double x, const char *name, Lisp_Object num, Lisp_Object num2)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129 if (x >= ((EMACS_INT) 1 << (VALBITS-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 if (!UNBOUNDP (num2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 range_error2 (name, num, num2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 range_error (name, num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 return (make_int ((EMACS_INT) x));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142 in_float_error (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 switch (errno)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
145 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
146 case 0:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 case EDOM:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 if (in_float == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 domain_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 case ERANGE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 range_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 arith_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 mark_float (Lisp_Object obj)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 float_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 return (extract_float (obj1) == extract_float (obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
176 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 float_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 /* mod the value down to 32-bit range */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 /* #### change for 64-bit machines */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 return (unsigned long) fmod (extract_float (obj), 4e9);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 static const struct lrecord_description float_description[] = {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 mark_float, print_float, 0, float_equal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 float_hash, float_description,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
191 Lisp_Float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 /* Extract a Lisp number as a `double', or signal an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
195 double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196 extract_float (Lisp_Object num)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 if (FLOATP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 return XFLOAT_DATA (num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 if (INTP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202 return (double) XINT (num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 return extract_float (wrong_type_argument (Qnumberp, num));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
205 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
206 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
207
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
208
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209 /* Trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 DEFUN ("acos", Facos, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
213 Return the inverse cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
215 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
216 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
217 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
219 if (d > 1.0 || d < -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
220 domain_error ("acos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
222 IN_FLOAT (d = acos (d), "acos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
224 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 DEFUN ("asin", Fasin, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
227 Return the inverse sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
229 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
230 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
231 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
233 if (d > 1.0 || d < -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
234 domain_error ("asin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
236 IN_FLOAT (d = asin (d), "asin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
238 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 DEFUN ("atan", Fatan, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
241 Return the inverse tangent of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
242 If optional second argument NUMBER2 is provided,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
243 return atan2 (NUMBER, NUMBER2).
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
244 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
245 (number, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
246 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
247 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
248
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
249 if (NILP (number2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
250 IN_FLOAT (d = atan (d), "atan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
251 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
252 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
253 double d2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
255 if (d == 0.0 && d2 == 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
256 domain_error2 ("atan", number, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
258 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
260 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
261 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
262
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 DEFUN ("cos", Fcos, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
264 Return the cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
266 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
267 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
268 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
269 IN_FLOAT (d = cos (d), "cos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
270 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
271 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 DEFUN ("sin", Fsin, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
274 Return the sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
276 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
277 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
278 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
279 IN_FLOAT (d = sin (d), "sin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
280 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
281 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 DEFUN ("tan", Ftan, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
284 Return the tangent of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
286 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
287 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
288 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 double c = cos (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
290 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 if (c == 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
292 domain_error ("tan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
294 IN_FLOAT (d = (sin (d) / c), "tan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
296 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 #endif /* LISP_FLOAT_TYPE (trig functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
298
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
299
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300 /* Bessel functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301 #if 0 /* Leave these out unless we find there's a reason for them. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /* #ifdef LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
305 Return the bessel function j0 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
307 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
309 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
310 IN_FLOAT (d = j0 (d), "bessel-j0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
315 Return the bessel function j1 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
317 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
319 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
320 IN_FLOAT (d = j1 (d), "bessel-j1", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
325 Return the order N bessel function output jn of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
326 The first number (the order) is truncated to an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
328 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
330 int i1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
331 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
333 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 return make_float (f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
338 Return the bessel function y0 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
340 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
342 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
343 IN_FLOAT (d = y0 (d), "bessel-y0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
348 Return the bessel function y1 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
350 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
352 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
353 IN_FLOAT (d = y1 (d), "bessel-y0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
354 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
355 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
358 Return the order N bessel function output yn of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
359 The first number (the order) is truncated to an integer.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
360 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
361 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
362 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
363 int i1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
364 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
366 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 return make_float (f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 #endif /* 0 (bessel functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
371
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
372 /* Error functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373 #if 0 /* Leave these out unless we see they are worth having. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 /* #ifdef LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 DEFUN ("erf", Ferf, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
377 Return the mathematical error function of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
379 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
381 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
382 IN_FLOAT (d = erf (d), "erf", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
383 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
384 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 DEFUN ("erfc", Ferfc, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
387 Return the complementary error function of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
389 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
390 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
391 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
392 IN_FLOAT (d = erfc (d), "erfc", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
393 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
394 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
397 Return the log gamma of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
399 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
401 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
402 IN_FLOAT (d = lgamma (d), "log-gamma", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 #endif /* 0 (error functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 /* Root and Log functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412 DEFUN ("exp", Fexp, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
413 Return the exponential base e of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
415 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
417 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 if (d > 709.7827) /* Assume IEEE doubles here */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
420 range_error ("exp", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 else if (d < -709.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 return make_float (0.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
425 IN_FLOAT (d = exp (d), "exp", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
430
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431 DEFUN ("expt", Fexpt, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
432 Return the exponential NUMBER1 ** NUMBER2.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
434 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
436 if (INTP (number1) && /* common lisp spec */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
437 INTP (number2)) /* don't promote, if both are ints */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 EMACS_INT retval;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
440 EMACS_INT x = XINT (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
441 EMACS_INT y = XINT (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 if (y < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 if (x == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 else if (x == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 retval = (y & 1) ? -1 : 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 retval = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 while (y > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 if (y & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 retval *= x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 x *= x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 y = (EMACS_UINT) y >> 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 return make_int (retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
468 double f1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
469 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 /* Really should check for overflow, too */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 if (f1 == 0.0 && f2 == 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 f1 = 1.0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 # ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 else if ((f1 == 0.0 && f2 < 0.0) || (f1 < 0 && f2 != floor(f2)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
475 domain_error2 ("expt", number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 # endif /* FLOAT_CHECK_DOMAIN */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
477 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 return make_float (f1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
481 CHECK_INT_OR_FLOAT (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
482 CHECK_INT_OR_FLOAT (number2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
483 return Fexpt (number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
485 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488 DEFUN ("log", Flog, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
489 Return the natural logarithm of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
490 If second optional argument BASE is given, return the logarithm of
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
491 NUMBER using that base.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
493 (number, base))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
495 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497 if (d <= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
498 domain_error2 ("log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 if (NILP (base))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
501 IN_FLOAT (d = log (d), "log", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 double b = extract_float (base);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 if (b <= 0.0 || b == 1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
507 domain_error2 ("log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509 if (b == 10.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
510 IN_FLOAT2 (d = log10 (d), "log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
512 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518 DEFUN ("log10", Flog10, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
519 Return the logarithm base 10 of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
521 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
523 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 if (d <= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
526 domain_error ("log10", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
528 IN_FLOAT (d = log10 (d), "log10", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
534 Return the square root of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
536 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
538 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 if (d < 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
541 domain_error ("sqrt", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
543 IN_FLOAT (d = sqrt (d), "sqrt", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
549 Return the cube root of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
551 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
553 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 #ifdef HAVE_CBRT
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
555 IN_FLOAT (d = cbrt (d), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557 if (d >= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
558 IN_FLOAT (d = pow (d, 1.0/3.0), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
560 IN_FLOAT (d = -pow (-d, 1.0/3.0), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 /* Inverse trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 /* #if 0 Not clearly worth adding... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 DEFUN ("acosh", Facosh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
572 Return the inverse hyperbolic cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
574 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
575 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
576 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578 if (d < 1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
579 domain_error ("acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
581 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
582 IN_FLOAT (d = acosh (d), "acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
584 IN_FLOAT (d = log (d + sqrt (d*d - 1.0)), "acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
586 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
587 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 DEFUN ("asinh", Fasinh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
590 Return the inverse hyperbolic sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
592 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
593 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
594 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
596 IN_FLOAT (d = asinh (d), "asinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
598 IN_FLOAT (d = log (d + sqrt (d*d + 1.0)), "asinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
600 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
601 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 DEFUN ("atanh", Fatanh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
604 Return the inverse hyperbolic tangent of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
606 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
607 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
608 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
610 if (d >= 1.0 || d <= -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
611 domain_error ("atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
613 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
614 IN_FLOAT (d = atanh (d), "atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
616 IN_FLOAT (d = 0.5 * log ((1.0 + d) / (1.0 - d)), "atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
618 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
619 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 DEFUN ("cosh", Fcosh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
622 Return the hyperbolic cosine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
624 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
625 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
626 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
628 if (d > 710.0 || d < -710.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
629 range_error ("cosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
631 IN_FLOAT (d = cosh (d), "cosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
633 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 DEFUN ("sinh", Fsinh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
636 Return the hyperbolic sine of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
638 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
639 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
640 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
642 if (d > 710.0 || d < -710.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
643 range_error ("sinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
645 IN_FLOAT (d = sinh (d), "sinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
647 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 DEFUN ("tanh", Ftanh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
650 Return the hyperbolic tangent of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
652 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
653 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
654 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
655 IN_FLOAT (d = tanh (d), "tanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
656 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
657 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 #endif /* LISP_FLOAT_TYPE (inverse trig functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
659
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
660 /* Rounding functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
661
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
662 DEFUN ("abs", Fabs, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
663 Return the absolute value of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
665 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
667 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
668 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
670 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))),
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
671 "abs", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
672 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
673 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
674 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
676 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
677 return (XINT (number) >= 0) ? number : make_int (- XINT (number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
678
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
679 return Fabs (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
681
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683 DEFUN ("float", Ffloat, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
684 Return the floating point number numerically equal to NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
686 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
687 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
688 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
689 return make_float ((double) XINT (number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
691 if (FLOATP (number)) /* give 'em the same float back */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
692 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
693
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
694 return Ffloat (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
696 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700 DEFUN ("logb", Flogb, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
701 Return largest integer <= the base 2 log of the magnitude of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 This is the same as the exponent of a float.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
703 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
704 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
705 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
706 double f = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
708 if (f == 0.0)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
709 return make_int (- (EMACS_INT)(((EMACS_UINT) 1) << (VALBITS - 1))); /* most-negative-fixnum */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 #ifdef HAVE_LOGB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 Lisp_Object val;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
713 IN_FLOAT (val = make_int ((EMACS_INT) logb (f)), "logb", number);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
714 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 #ifdef HAVE_FREXP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 int exqp;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
720 IN_FLOAT (frexp (f, &exqp), "logb", number);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
721 return make_int (exqp - 1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 double d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 EMACS_INT val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 if (f < 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 f = -f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 val = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 while (f < 0.5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 for (i = 1, d = 0.5; d * d >= f; i += i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 d *= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 f /= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 val -= i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 while (f >= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 for (i = 1, d = 2.0; d * d <= f; i += i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 d *= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 f /= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 val += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
745 return make_int (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747 #endif /* ! HAVE_FREXP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 #endif /* ! HAVE_LOGB */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
751
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
754 Return the smallest integer no less than NUMBER. (Round toward +inf.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
756 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
759 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 double d;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
762 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
763 return (float_to_int (d, "ceiling", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
767 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
768 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
770 return Fceiling (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 DEFUN ("floor", Ffloor, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
775 Return the largest integer no greater than NUMBER. (Round towards -inf.)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
776 With optional second argument DIVISOR, return the largest integer no
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
777 greater than NUMBER/DIVISOR.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
779 (number, divisor))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
781 CHECK_INT_OR_FLOAT (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 if (! NILP (divisor))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 EMACS_INT i1, i2;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 CHECK_INT_OR_FLOAT (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
790 if (FLOATP (number) || FLOATP (divisor))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
792 double f1 = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 double f2 = extract_float (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 if (f2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
798 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
799 return float_to_int (f1, "floor", number, divisor);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
803 i1 = XINT (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 i2 = XINT (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 if (i2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 /* With C's /, the result is implementation-defined if either operand
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 is negative, so use only nonnegative operands. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 i1 = (i2 < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 return (make_int (i1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
819 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821 double d;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
822 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
823 return (float_to_int (d, "floor", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
824 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
825 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
827 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 DEFUN ("round", Fround, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
831 Return the nearest integer to NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
833 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
836 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838 double d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 /* Screw the prevailing rounding mode. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
840 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
841 return (float_to_int (d, "round", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
845 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
846 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 return Fround (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 Truncate a floating point number to an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 Rounds the value toward zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
855 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
858 if (FLOATP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
859 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
862 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
863 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
865 return Ftruncate (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 /* Float-rounding functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 /* #if 1 It's not clear these are worth adding... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
873 Return the smallest integer no less than NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 \(Round toward +inf.\)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
876 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
878 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
879 IN_FLOAT (d = ceil (d), "fceiling", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 DEFUN ("ffloor", Fffloor, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
884 Return the largest integer no greater than NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 \(Round towards -inf.\)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
887 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
889 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
890 IN_FLOAT (d = floor (d), "ffloor", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 DEFUN ("fround", Ffround, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
895 Return the nearest integer to NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
897 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
899 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
900 IN_FLOAT (d = emacs_rint (d), "fround", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 Truncate a floating point number to an integral float value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 Rounds the value toward zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
908 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
909 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
910 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 if (d >= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
912 IN_FLOAT (d = floor (d), "ftruncate", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
914 IN_FLOAT (d = ceil (d), "ftruncate", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
916 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 #endif /* LISP_FLOAT_TYPE (float-rounding functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
919
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
920
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922 #ifdef FLOAT_CATCH_SIGILL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 static SIGTYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 float_error (int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 if (! in_float)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 fatal_error_signal (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 EMACS_REESTABLISH_SIGNAL (signo, arith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930 EMACS_UNBLOCK_SIGNAL (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 in_float = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
933
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
934 /* Was Fsignal(), but it just doesn't make sense for an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935 occurring inside a signal handler to be restartable, considering
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 that anything could happen when the error is signaled and trapped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 and considering the asynchronous nature of signal handlers. */
563
183866b06e0b [xemacs-hg @ 2001-05-24 07:50:48 by ben]
ben
parents: 444
diff changeset
938 signal_error (Qarith_error, 0, float_error_arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
940
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 /* Another idea was to replace the library function `infnan'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942 where SIGILL is signaled. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 #endif /* FLOAT_CATCH_SIGILL */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
945
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
946 /* In C++, it is impossible to determine what type matherr expects
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947 without some more configure magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 We shouldn't be using matherr anyways - it's a non-standard SYSVism. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
951 matherr (struct exception *x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 Lisp_Object args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 if (! in_float)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 /* Not called from emacs-lisp float routines; do the default thing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 return 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
959
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
960 args = Fcons (build_string (x->name),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961 Fcons (make_float (x->arg1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 ((in_float == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 ? Fcons (make_float (x->arg2), Qnil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 : Qnil)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 switch (x->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 case DOMAIN: Fsignal (Qdomain_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 case SING: Fsignal (Qsingularity_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 case OVERFLOW: Fsignal (Qoverflow_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 case UNDERFLOW: Fsignal (Qunderflow_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 default: Fsignal (Qarith_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 return 1; /* don't set errno or print a message */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
974 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
975 #endif /* HAVE_MATHERR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980 init_floatfns_very_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 # ifdef FLOAT_CATCH_SIGILL
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
984 EMACS_SIGNAL (SIGILL, float_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
986 in_float = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991 syms_of_floatfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
993 INIT_LRECORD_IMPLEMENTATION (float);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
995 /* Trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
996
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
997 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998 DEFSUBR (Facos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 DEFSUBR (Fasin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 DEFSUBR (Fatan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 DEFSUBR (Fcos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 DEFSUBR (Fsin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 DEFSUBR (Ftan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 /* Bessel functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1007
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1008 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009 DEFSUBR (Fbessel_y0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 DEFSUBR (Fbessel_y1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 DEFSUBR (Fbessel_yn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 DEFSUBR (Fbessel_j0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 DEFSUBR (Fbessel_j1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 DEFSUBR (Fbessel_jn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 /* Error functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1018
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1019 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020 DEFSUBR (Ferf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 DEFSUBR (Ferfc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 DEFSUBR (Flog_gamma);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 #endif /* 0 */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 /* Root and Log functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1026
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1027 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028 DEFSUBR (Fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 DEFSUBR (Fexpt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 DEFSUBR (Flog);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 DEFSUBR (Flog10);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 DEFSUBR (Fsqrt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 DEFSUBR (Fcube_root);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 /* Inverse trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1039
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1040 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041 DEFSUBR (Facosh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 DEFSUBR (Fasinh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 DEFSUBR (Fatanh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 DEFSUBR (Fcosh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 DEFSUBR (Fsinh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 DEFSUBR (Ftanh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 /* Rounding functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1050
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1051 DEFSUBR (Fabs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 DEFSUBR (Ffloat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 DEFSUBR (Flogb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 DEFSUBR (Fceiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 DEFSUBR (Ffloor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 DEFSUBR (Fround);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 DEFSUBR (Ftruncate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 /* Float-rounding functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1062
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1063 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064 DEFSUBR (Ffceiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 DEFSUBR (Fffloor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 DEFSUBR (Ffround);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 DEFSUBR (Fftruncate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072 vars_of_floatfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 Fprovide (intern ("lisp-float-type"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 }