annotate src/floatfns.c @ 665:fdefd0186b75

[xemacs-hg @ 2001-09-20 06:28:42 by ben] The great integral types renaming. The purpose of this is to rationalize the names used for various integral types, so that they match their intended uses and follow consist conventions, and eliminate types that were not semantically different from each other. The conventions are: -- All integral types that measure quantities of anything are signed. Some people disagree vociferously with this, but their arguments are mostly theoretical, and are vastly outweighed by the practical headaches of mixing signed and unsigned values, and more importantly by the far increased likelihood of inadvertent bugs: Because of the broken "viral" nature of unsigned quantities in C (operations involving mixed signed/unsigned are done unsigned, when exactly the opposite is nearly always wanted), even a single error in declaring a quantity unsigned that should be signed, or even the even more subtle error of comparing signed and unsigned values and forgetting the necessary cast, can be catastrophic, as comparisons will yield wrong results. -Wsign-compare is turned on specifically to catch this, but this tends to result in a great number of warnings when mixing signed and unsigned, and the casts are annoying. More has been written on this elsewhere. -- All such quantity types just mentioned boil down to EMACS_INT, which is 32 bits on 32-bit machines and 64 bits on 64-bit machines. This is guaranteed to be the same size as Lisp objects of type `int', and (as far as I can tell) of size_t (unsigned!) and ssize_t. The only type below that is not an EMACS_INT is Hashcode, which is an unsigned value of the same size as EMACS_INT. -- Type names should be relatively short (no more than 10 characters or so), with the first letter capitalized and no underscores if they can at all be avoided. -- "count" == a zero-based measurement of some quantity. Includes sizes, offsets, and indexes. -- "bpos" == a one-based measurement of a position in a buffer. "Charbpos" and "Bytebpos" count text in the buffer, rather than bytes in memory; thus Bytebpos does not directly correspond to the memory representation. Use "Membpos" for this. -- "Char" refers to internal-format characters, not to the C type "char", which is really a byte. -- For the actual name changes, see the script below. I ran the following script to do the conversion. (NOTE: This script is idempotent. You can safely run it multiple times and it will not screw up previous results -- in fact, it will do nothing if nothing has changed. Thus, it can be run repeatedly as necessary to handle patches coming in from old workspaces, or old branches.) There are two tags, just before and just after the change: `pre-integral-type-rename' and `post-integral-type-rename'. When merging code from the main trunk into a branch, the best thing to do is first merge up to `pre-integral-type-rename', then apply the script and associated changes, then merge from `post-integral-type-change' to the present. (Alternatively, just do the merging in one operation; but you may then have a lot of conflicts needing to be resolved by hand.) Script `fixtypes.sh' follows: ----------------------------------- cut ------------------------------------ files="*.[ch] s/*.h m/*.h config.h.in ../configure.in Makefile.in.in ../lib-src/*.[ch] ../lwlib/*.[ch]" gr Memory_Count Bytecount $files gr Lstream_Data_Count Bytecount $files gr Element_Count Elemcount $files gr Hash_Code Hashcode $files gr extcount bytecount $files gr bufpos charbpos $files gr bytind bytebpos $files gr memind membpos $files gr bufbyte intbyte $files gr Extcount Bytecount $files gr Bufpos Charbpos $files gr Bytind Bytebpos $files gr Memind Membpos $files gr Bufbyte Intbyte $files gr EXTCOUNT BYTECOUNT $files gr BUFPOS CHARBPOS $files gr BYTIND BYTEBPOS $files gr MEMIND MEMBPOS $files gr BUFBYTE INTBYTE $files gr MEMORY_COUNT BYTECOUNT $files gr LSTREAM_DATA_COUNT BYTECOUNT $files gr ELEMENT_COUNT ELEMCOUNT $files gr HASH_CODE HASHCODE $files ----------------------------------- cut ------------------------------------ `fixtypes.sh' is a Bourne-shell script; it uses 'gr': ----------------------------------- cut ------------------------------------ #!/bin/sh # Usage is like this: # gr FROM TO FILES ... # globally replace FROM with TO in FILES. FROM and TO are regular expressions. # backup files are stored in the `backup' directory. from="$1" to="$2" shift 2 echo ${1+"$@"} | xargs global-replace "s/$from/$to/g" ----------------------------------- cut ------------------------------------ `gr' in turn uses a Perl script to do its real work, `global-replace', which follows: ----------------------------------- cut ------------------------------------ : #-*- Perl -*- ### global-modify --- modify the contents of a file by a Perl expression ## Copyright (C) 1999 Martin Buchholz. ## Copyright (C) 2001 Ben Wing. ## Authors: Martin Buchholz <martin@xemacs.org>, Ben Wing <ben@xemacs.org> ## Maintainer: Ben Wing <ben@xemacs.org> ## Current Version: 1.0, May 5, 2001 # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2, or (at your option) # any later version. # # This program is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # General Public License for more details. # # You should have received a copy of the GNU General Public License # along with XEmacs; see the file COPYING. If not, write to the Free # Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA # 02111-1307, USA. eval 'exec perl -w -S $0 ${1+"$@"}' if 0; use strict; use FileHandle; use Carp; use Getopt::Long; use File::Basename; (my $myName = $0) =~ s@.*/@@; my $usage=" Usage: $myName [--help] [--backup-dir=DIR] [--line-mode] [--hunk-mode] PERLEXPR FILE ... Globally modify a file, either line by line or in one big hunk. Typical usage is like this: [with GNU print, GNU xargs: guaranteed to handle spaces, quotes, etc. in file names] find . -name '*.[ch]' -print0 | xargs -0 $0 's/\bCONST\b/const/g'\n [with non-GNU print, xargs] find . -name '*.[ch]' -print | xargs $0 's/\bCONST\b/const/g'\n The file is read in, either line by line (with --line-mode specified) or in one big hunk (with --hunk-mode specified; it's the default), and the Perl expression is then evalled with \$_ set to the line or hunk of text, including the terminating newline if there is one. It should destructively modify the value there, storing the changed result in \$_. Files in which any modifications are made are backed up to the directory specified using --backup-dir, or to `backup' by default. To disable this, use --backup-dir= with no argument. Hunk mode is the default because it is MUCH MUCH faster than line-by-line. Use line-by-line only when it matters, e.g. you want to do a replacement only once per line (the default without the `g' argument). Conversely, when using hunk mode, *ALWAYS* use `g'; otherwise, you will only make one replacement in the entire file! "; my %options = (); $Getopt::Long::ignorecase = 0; &GetOptions ( \%options, 'help', 'backup-dir=s', 'line-mode', 'hunk-mode', ); die $usage if $options{"help"} or @ARGV <= 1; my $code = shift; die $usage if grep (-d || ! -w, @ARGV); sub SafeOpen { open ((my $fh = new FileHandle), $_[0]); confess "Can't open $_[0]: $!" if ! defined $fh; return $fh; } sub SafeClose { close $_[0] or confess "Can't close $_[0]: $!"; } sub FileContents { my $fh = SafeOpen ("< $_[0]"); my $olddollarslash = $/; local $/ = undef; my $contents = <$fh>; $/ = $olddollarslash; return $contents; } sub WriteStringToFile { my $fh = SafeOpen ("> $_[0]"); binmode $fh; print $fh $_[1] or confess "$_[0]: $!\n"; SafeClose $fh; } foreach my $file (@ARGV) { my $changed_p = 0; my $new_contents = ""; if ($options{"line-mode"}) { my $fh = SafeOpen $file; while (<$fh>) { my $save_line = $_; eval $code; $changed_p = 1 if $save_line ne $_; $new_contents .= $_; } } else { my $orig_contents = $_ = FileContents $file; eval $code; if ($_ ne $orig_contents) { $changed_p = 1; $new_contents = $_; } } if ($changed_p) { my $backdir = $options{"backup-dir"}; $backdir = "backup" if !defined ($backdir); if ($backdir) { my ($name, $path, $suffix) = fileparse ($file, ""); my $backfulldir = $path . $backdir; my $backfile = "$backfulldir/$name"; mkdir $backfulldir, 0755 unless -d $backfulldir; print "modifying $file (original saved in $backfile)\n"; rename $file, $backfile; } WriteStringToFile ($file, $new_contents); } } ----------------------------------- cut ------------------------------------ In addition to those programs, I needed to fix up a few other things, particularly relating to the duplicate definitions of types, now that some types merged with others. Specifically: 1. in lisp.h, removed duplicate declarations of Bytecount. The changed code should now look like this: (In each code snippet below, the first and last lines are the same as the original, as are all lines outside of those lines. That allows you to locate the section to be replaced, and replace the stuff in that section, verifying that there isn't anything new added that would need to be kept.) --------------------------------- snip ------------------------------------- /* Counts of bytes or chars */ typedef EMACS_INT Bytecount; typedef EMACS_INT Charcount; /* Counts of elements */ typedef EMACS_INT Elemcount; /* Hash codes */ typedef unsigned long Hashcode; /* ------------------------ dynamic arrays ------------------- */ --------------------------------- snip ------------------------------------- 2. in lstream.h, removed duplicate declaration of Bytecount. Rewrote the comment about this type. The changed code should now look like this: --------------------------------- snip ------------------------------------- #endif /* The have been some arguments over the what the type should be that specifies a count of bytes in a data block to be written out or read in, using Lstream_read(), Lstream_write(), and related functions. Originally it was long, which worked fine; Martin "corrected" these to size_t and ssize_t on the grounds that this is theoretically cleaner and is in keeping with the C standards. Unfortunately, this practice is horribly error-prone due to design flaws in the way that mixed signed/unsigned arithmetic happens. In fact, by doing this change, Martin introduced a subtle but fatal error that caused the operation of sending large mail messages to the SMTP server under Windows to fail. By putting all values back to be signed, avoiding any signed/unsigned mixing, the bug immediately went away. The type then in use was Lstream_Data_Count, so that it be reverted cleanly if a vote came to that. Now it is Bytecount. Some earlier comments about why the type must be signed: This MUST BE SIGNED, since it also is used in functions that return the number of bytes actually read to or written from in an operation, and these functions can return -1 to signal error. Note that the standard Unix read() and write() functions define the count going in as a size_t, which is UNSIGNED, and the count going out as an ssize_t, which is SIGNED. This is a horrible design flaw. Not only is it highly likely to lead to logic errors when a -1 gets interpreted as a large positive number, but operations are bound to fail in all sorts of horrible ways when a number in the upper-half of the size_t range is passed in -- this number is unrepresentable as an ssize_t, so code that checks to see how many bytes are actually written (which is mandatory if you are dealing with certain types of devices) will get completely screwed up. --ben */ typedef enum lstream_buffering --------------------------------- snip ------------------------------------- 3. in dumper.c, there are four places, all inside of switch() statements, where XD_BYTECOUNT appears twice as a case tag. In each case, the two case blocks contain identical code, and you should *REMOVE THE SECOND* and leave the first.
author ben
date Thu, 20 Sep 2001 06:31:11 +0000
parents b39c14581166
children 943eaba38521
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 /* Need to define a differentiating symbol -- see sysfloat.h */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 #define THIS_FILENAME floatfns
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 #include "sysfloat.h"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
58 /* 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
59 if `rint' exists but does not work right. */
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
60 #ifdef HAVE_RINT
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
61 #define emacs_rint rint
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
62 #else
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 static double
430
a5df635868b2 Import from CVS: tag r21-2-23
cvs
parents: 428
diff changeset
64 emacs_rint (double x)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 double r = floor (x + 0.5);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67 double diff = fabs (r - x);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 /* Round to even and correct for any roundoff errors. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 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
70 r += r < x ? 1.0 : -1.0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 return r;
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 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75 /* Nonzero while executing in floating point.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 This tells float_error what to do. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 static int in_float;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 /* If an argument is out of range for a mathematical function,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80 here is the actual argument value to use in the error message. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 static Lisp_Object float_error_arg, float_error_arg2;
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
82 static const char *float_error_fn_name;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 /* Evaluate the floating point expression D, recording NUM
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85 as the original argument for error messages.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 D is normally an assignment expression.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87 Handle errors which may result in signals or may set errno.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 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
90 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
91 check properly. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 #ifdef FLOAT_CHECK_ERRNO
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 #define IN_FLOAT(d, name, num) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 float_error_arg = num; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 float_error_fn_name = name; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 in_float = 1; errno = 0; (d); in_float = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98 if (errno != 0) in_float_error (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 #define IN_FLOAT2(d, name, num, num2) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101 do { \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 float_error_arg = num; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103 float_error_arg2 = num2; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 float_error_fn_name = name; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 in_float = 2; errno = 0; (d); in_float = 0; \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 if (errno != 0) in_float_error (); \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 } while (0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 #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
110 #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
111 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 #define arith_error(op,arg) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 Fsignal (Qarith_error, list2 (build_string (op), arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 #define range_error(op,arg) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117 Fsignal (Qrange_error, list2 (build_string (op), arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 #define range_error2(op,a1,a2) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 Fsignal (Qrange_error, list3 (build_string (op), a1, a2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120 #define domain_error(op,arg) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
121 Fsignal (Qdomain_error, list2 (build_string (op), arg))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
122 #define domain_error2(op,a1,a2) \
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
123 Fsignal (Qdomain_error, list3 (build_string (op), a1, a2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 /* Convert float to Lisp Integer if it fits, else signal a range
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 error using the given arguments. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 static Lisp_Object
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
129 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
130 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 if (x >= ((EMACS_INT) 1 << (VALBITS-1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 if (!UNBOUNDP (num2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 range_error2 (name, num, num2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 range_error (name, num);
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 return (make_int ((EMACS_INT) x));
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 static void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 in_float_error (void)
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 switch (errno)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
147 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
148 case 0:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
149 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 case EDOM:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 if (in_float == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 domain_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 case ERANGE:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 range_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 default:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 arith_error (float_error_fn_name, float_error_arg);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 break;
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 static Lisp_Object
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 mark_float (Lisp_Object obj)
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 return Qnil;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 static int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 float_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
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 return (extract_float (obj1) == extract_float (obj2));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177
665
fdefd0186b75 [xemacs-hg @ 2001-09-20 06:28:42 by ben]
ben
parents: 647
diff changeset
178 static Hashcode
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 float_hash (Lisp_Object obj, int depth)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 /* mod the value down to 32-bit range */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 /* #### change for 64-bit machines */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 return (unsigned long) fmod (extract_float (obj), 4e9);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 static const struct lrecord_description float_description[] = {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 { XD_END }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 };
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 mark_float, print_float, 0, float_equal,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 float_hash, float_description,
440
8de8e3f6228a Import from CVS: tag r21-2-28
cvs
parents: 434
diff changeset
193 Lisp_Float);
428
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 /* Extract a Lisp number as a `double', or signal an error. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
196
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
197 double
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
198 extract_float (Lisp_Object num)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
199 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
200 if (FLOATP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
201 return XFLOAT_DATA (num);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
202
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
203 if (INTP (num))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
204 return (double) XINT (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 return extract_float (wrong_type_argument (Qnumberp, num));
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 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
209
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
210
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
211 /* Trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
212 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
213
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
214 DEFUN ("acos", Facos, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
215 Return the inverse cosine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
218 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
219 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
220 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
221 if (d > 1.0 || d < -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
222 domain_error ("acos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
223 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
224 IN_FLOAT (d = acos (d), "acos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
225 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
226 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
227
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
228 DEFUN ("asin", Fasin, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
229 Return the inverse sine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
232 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
233 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
234 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
235 if (d > 1.0 || d < -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
236 domain_error ("asin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
237 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
238 IN_FLOAT (d = asin (d), "asin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
239 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
240 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
241
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
242 DEFUN ("atan", Fatan, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
243 Return the inverse tangent of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
244 If optional second argument NUMBER2 is provided,
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
245 return atan2 (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 (number, number2))
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 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
250
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
251 if (NILP (number2))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
252 IN_FLOAT (d = atan (d), "atan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
253 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
254 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
255 double d2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
256 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
257 if (d == 0.0 && d2 == 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
258 domain_error2 ("atan", number, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
259 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
260 IN_FLOAT2 (d = atan2 (d, d2), "atan", number, number2);
428
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 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
263 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
264
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
265 DEFUN ("cos", Fcos, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
266 Return the cosine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
269 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
270 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
271 IN_FLOAT (d = cos (d), "cos", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
272 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
273 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
274
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
275 DEFUN ("sin", Fsin, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
276 Return the sine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
279 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
280 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
281 IN_FLOAT (d = sin (d), "sin", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
282 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
283 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
284
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
285 DEFUN ("tan", Ftan, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
286 Return the tangent of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
289 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
290 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
291 double c = cos (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
292 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
293 if (c == 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
294 domain_error ("tan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
295 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
296 IN_FLOAT (d = (sin (d) / c), "tan", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
297 return make_float (d);
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 #endif /* LISP_FLOAT_TYPE (trig functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
300
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
301
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
302 /* Bessel functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303 #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
304 /* #ifdef LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 DEFUN ("bessel-j0", Fbessel_j0, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
307 Return the bessel function j0 of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
311 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
312 IN_FLOAT (d = j0 (d), "bessel-j0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 DEFUN ("bessel-j1", Fbessel_j1, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
317 Return the bessel function j1 of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
321 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
322 IN_FLOAT (d = j1 (d), "bessel-j1", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326 DEFUN ("bessel-jn", Fbessel_jn, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
327 Return the order N bessel function output jn of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
328 The first number (the order) is truncated to an integer.
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 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
332 int i1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
333 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
335 IN_FLOAT (f2 = jn (i1, f2), "bessel-jn", number1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 return make_float (f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 DEFUN ("bessel-y0", Fbessel_y0, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
340 Return the bessel function y0 of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
344 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
345 IN_FLOAT (d = y0 (d), "bessel-y0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 DEFUN ("bessel-y1", Fbessel_y1, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
350 Return the bessel function y1 of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
354 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
355 IN_FLOAT (d = y1 (d), "bessel-y0", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
356 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
357 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
358
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
359 DEFUN ("bessel-yn", Fbessel_yn, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
360 Return the order N bessel function output yn of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
361 The first number (the order) is truncated to an integer.
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 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
365 int i1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
366 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
368 IN_FLOAT (f2 = yn (i1, f2), "bessel-yn", number1);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 return make_float (f2);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
370 }
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 #endif /* 0 (bessel functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
373
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
374 /* Error functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
375 #if 0 /* Leave these out unless we see they are worth having. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
376 /* #ifdef LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
377
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
378 DEFUN ("erf", Ferf, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
379 Return the mathematical error function of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
382 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
383 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
384 IN_FLOAT (d = erf (d), "erf", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
385 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
386 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
387
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
388 DEFUN ("erfc", Ferfc, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
389 Return the complementary error function of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
392 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
393 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
394 IN_FLOAT (d = erfc (d), "erfc", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 DEFUN ("log-gamma", Flog_gamma, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
399 Return the log gamma of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
403 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
404 IN_FLOAT (d = lgamma (d), "log-gamma", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 }
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 #endif /* 0 (error functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409
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 /* Root and Log functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 DEFUN ("exp", Fexp, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
415 Return the exponential base e of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
419 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 if (d > 709.7827) /* Assume IEEE doubles here */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
422 range_error ("exp", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 else if (d < -709.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 return make_float (0.0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
427 IN_FLOAT (d = exp (d), "exp", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 return make_float (d);
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 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
431
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 DEFUN ("expt", Fexpt, 2, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
434 Return the exponential 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 (number1, number2))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
438 if (INTP (number1) && /* common lisp spec */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
439 INTP (number2)) /* don't promote, if both are ints */
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 EMACS_INT retval;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
442 EMACS_INT x = XINT (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
443 EMACS_INT y = XINT (number2);
428
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 (y < 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 if (x == 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
449 else if (x == -1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
450 retval = (y & 1) ? -1 : 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 retval = 0;
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 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
455 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 retval = 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 while (y > 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 if (y & 1)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 retval *= x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 x *= x;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 y = (EMACS_UINT) y >> 1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 }
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 return make_int (retval);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
470 double f1 = extract_float (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
471 double f2 = extract_float (number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 /* Really should check for overflow, too */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 if (f1 == 0.0 && f2 == 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 f1 = 1.0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 # ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 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
477 domain_error2 ("expt", number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 # endif /* FLOAT_CHECK_DOMAIN */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
479 IN_FLOAT2 (f1 = pow (f1, f2), "expt", number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 return make_float (f1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
483 CHECK_INT_OR_FLOAT (number1);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
484 CHECK_INT_OR_FLOAT (number2);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
485 return Fexpt (number1, number2);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
486 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
487 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
488
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 DEFUN ("log", Flog, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
491 Return the natural logarithm of NUMBER.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
492 If second optional argument BASE is given, return the logarithm of
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
493 NUMBER using that 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 (number, base))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
497 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 if (d <= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
500 domain_error2 ("log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 if (NILP (base))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
503 IN_FLOAT (d = log (d), "log", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 double b = extract_float (base);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508 if (b <= 0.0 || b == 1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
509 domain_error2 ("log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 if (b == 10.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
512 IN_FLOAT2 (d = log10 (d), "log", number, base);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
514 IN_FLOAT2 (d = (log (d) / log (b)), "log", number, base);
428
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 return make_float (d);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520 DEFUN ("log10", Flog10, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
521 Return the logarithm base 10 of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
525 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527 if (d <= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
528 domain_error ("log10", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
530 IN_FLOAT (d = log10 (d), "log10", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531 return make_float (d);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535 DEFUN ("sqrt", Fsqrt, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
536 Return the square root of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
540 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 if (d < 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
543 domain_error ("sqrt", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
545 IN_FLOAT (d = sqrt (d), "sqrt", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 return make_float (d);
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 DEFUN ("cube-root", Fcube_root, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
551 Return the cube root of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
555 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 #ifdef HAVE_CBRT
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
557 IN_FLOAT (d = cbrt (d), "cube-root", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559 if (d >= 0.0)
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 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
562 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
563 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 return make_float (d);
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 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 /* Inverse trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571 /* #if 0 Not clearly worth adding... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573 DEFUN ("acosh", Facosh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
574 Return the inverse hyperbolic cosine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
577 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
578 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
579 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
580 if (d < 1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
581 domain_error ("acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
582 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
584 IN_FLOAT (d = acosh (d), "acosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
585 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
586 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
587 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
591 DEFUN ("asinh", Fasinh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
592 Return the inverse hyperbolic sine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
595 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
596 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
598 IN_FLOAT (d = asinh (d), "asinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
599 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
600 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
601 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
602 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
603 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
604
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
605 DEFUN ("atanh", Fatanh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
606 Return the inverse hyperbolic tangent of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
609 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
610 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
611 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
612 if (d >= 1.0 || d <= -1.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
613 domain_error ("atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
614 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
615 #ifdef HAVE_INVERSE_HYPERBOLIC
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
616 IN_FLOAT (d = atanh (d), "atanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
617 #else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
618 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
619 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
620 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
621 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
622
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
623 DEFUN ("cosh", Fcosh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
624 Return the hyperbolic cosine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
627 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
628 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
629 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
630 if (d > 710.0 || d < -710.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
631 range_error ("cosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
632 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
633 IN_FLOAT (d = cosh (d), "cosh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
634 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
635 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
636
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
637 DEFUN ("sinh", Fsinh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
638 Return the hyperbolic sine of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
641 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
642 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643 #ifdef FLOAT_CHECK_DOMAIN
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
644 if (d > 710.0 || d < -710.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
645 range_error ("sinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
646 #endif
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
647 IN_FLOAT (d = sinh (d), "sinh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
648 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
649 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
650
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
651 DEFUN ("tanh", Ftanh, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
652 Return the hyperbolic tangent of 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
655 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
656 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
657 IN_FLOAT (d = tanh (d), "tanh", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
658 return make_float (d);
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 #endif /* LISP_FLOAT_TYPE (inverse trig 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 /* Rounding functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
663
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
664 DEFUN ("abs", Fabs, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
665 Return the absolute value of NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
666 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
667 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
668 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
669 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
670 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
671 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
672 IN_FLOAT (number = make_float (fabs (XFLOAT_DATA (number))),
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
673 "abs", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
674 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
675 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
676 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
677
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
678 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
679 return (XINT (number) >= 0) ? number : make_int (- XINT (number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
680
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
681 return Fabs (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
682 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
683
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
684 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
685 DEFUN ("float", Ffloat, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
686 Return the floating point number numerically equal to 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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
689 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
690 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
691 return make_float ((double) XINT (number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
692
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
693 if (FLOATP (number)) /* give 'em the same float back */
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
694 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
695
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
696 return Ffloat (wrong_type_argument (Qnumberp, number));
428
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 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
700
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
701 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
702 DEFUN ("logb", Flogb, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
703 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
704 This is the same as the exponent of a float.
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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
707 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
708 double f = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
709
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
710 if (f == 0.0)
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
711 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
712 #ifdef HAVE_LOGB
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 Lisp_Object val;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
715 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
716 return val;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 #ifdef HAVE_FREXP
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721 int exqp;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
722 IN_FLOAT (frexp (f, &exqp), "logb", number);
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
723 return make_int (exqp - 1);
428
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 #else
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727 int i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 double d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 EMACS_INT val;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 if (f < 0.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 f = -f;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 val = -1;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 while (f < 0.5)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 for (i = 1, d = 0.5; d * d >= f; i += i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 d *= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 f /= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 val -= i;
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 while (f >= 1.0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
742 for (i = 1, d = 2.0; d * d <= f; i += i)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
743 d *= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
744 f /= d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
745 val += i;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 }
434
9d177e8d4150 Import from CVS: tag r21-2-25
cvs
parents: 430
diff changeset
747 return make_int (val);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
749 #endif /* ! HAVE_FREXP */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
750 #endif /* ! HAVE_LOGB */
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 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 DEFUN ("ceiling", Fceiling, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
756 Return the smallest integer no less than NUMBER. (Round toward +inf.)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
758 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
761 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 double d;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
764 IN_FLOAT ((d = ceil (XFLOAT_DATA (number))), "ceiling", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
765 return (float_to_int (d, "ceiling", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
769 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
770 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
772 return Fceiling (wrong_type_argument (Qnumberp, number));
428
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
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 DEFUN ("floor", Ffloor, 1, 2, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
777 Return the largest integer no greater than NUMBER. (Round towards -inf.)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
778 With optional second argument DIVISOR, return the largest integer no
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
779 greater than 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 (number, divisor))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
783 CHECK_INT_OR_FLOAT (number);
428
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 if (! NILP (divisor))
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 EMACS_INT i1, i2;
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 CHECK_INT_OR_FLOAT (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
792 if (FLOATP (number) || FLOATP (divisor))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
794 double f1 = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 double f2 = extract_float (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 if (f2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
800 IN_FLOAT2 (f1 = floor (f1 / f2), "floor", number, divisor);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
801 return float_to_int (f1, "floor", number, divisor);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
805 i1 = XINT (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 i2 = XINT (divisor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 if (i2 == 0)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 Fsignal (Qarith_error, Qnil);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 /* With C's /, the result is implementation-defined if either operand
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 is negative, so use only nonnegative operands. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 i1 = (i2 < 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 ? (i1 <= 0 ? -i1 / -i2 : -1 - ((i1 - 1) / -i2))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 : (i1 < 0 ? -1 - ((-1 - i1) / i2) : i1 / i2));
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 return (make_int (i1));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
821 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
822 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
823 double d;
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
824 IN_FLOAT ((d = floor (XFLOAT_DATA (number))), "floor", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
825 return (float_to_int (d, "floor", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
826 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
827 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
829 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 DEFUN ("round", Fround, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
833 Return the nearest integer to NUMBER.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
835 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
838 if (FLOATP (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 double d;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 /* Screw the prevailing rounding mode. */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
842 IN_FLOAT ((d = emacs_rint (XFLOAT_DATA (number))), "round", number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
843 return (float_to_int (d, "round", number, Qunbound));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
847 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
848 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
850 return Fround (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853 DEFUN ("truncate", Ftruncate, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 Truncate a floating point number to an integer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 Rounds the value toward zero.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856 */
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
857 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 #ifdef LISP_FLOAT_TYPE
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
860 if (FLOATP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
861 return float_to_int (XFLOAT_DATA (number), "truncate", number, Qunbound);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
864 if (INTP (number))
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
865 return number;
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
867 return Ftruncate (wrong_type_argument (Qnumberp, number));
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 /* Float-rounding functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 /* #if 1 It's not clear these are worth adding... */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 DEFUN ("fceiling", Ffceiling, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
875 Return the smallest integer no less than NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 \(Round toward +inf.\)
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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
880 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
881 IN_FLOAT (d = ceil (d), "fceiling", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 DEFUN ("ffloor", Fffloor, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
886 Return the largest integer no greater than NUMBER, as a float.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 \(Round towards -inf.\)
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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
891 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
892 IN_FLOAT (d = floor (d), "ffloor", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 DEFUN ("fround", Ffround, 1, 1, 0, /*
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
897 Return the nearest integer to NUMBER, as a float.
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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
901 double d = extract_float (number);
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
902 IN_FLOAT (d = emacs_rint (d), "fround", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 DEFUN ("ftruncate", Fftruncate, 1, 1, 0, /*
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907 Truncate a floating point number to an integral float value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 Rounds the value toward zero.
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 (number))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
911 {
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
912 double d = extract_float (number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
913 if (d >= 0.0)
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
914 IN_FLOAT (d = floor (d), "ftruncate", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
915 else
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
916 IN_FLOAT (d = ceil (d), "ftruncate", number);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
917 return make_float (d);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
918 }
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 #endif /* LISP_FLOAT_TYPE (float-rounding functions) */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
921
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
922
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
923 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
924 #ifdef FLOAT_CATCH_SIGILL
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
925 static SIGTYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
926 float_error (int signo)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
927 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
928 if (! in_float)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
929 fatal_error_signal (signo);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
930
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
931 EMACS_REESTABLISH_SIGNAL (signo, arith_error);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
932 EMACS_UNBLOCK_SIGNAL (signo);
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 in_float = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
935
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
936 /* Was Fsignal(), but it just doesn't make sense for an error
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
937 occurring inside a signal handler to be restartable, considering
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
938 that anything could happen when the error is signaled and trapped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
939 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
940 signal_error (Qarith_error, 0, float_error_arg);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
941 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
942
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
943 /* Another idea was to replace the library function `infnan'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
944 where SIGILL is signaled. */
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 #endif /* FLOAT_CATCH_SIGILL */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
947
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
948 /* In C++, it is impossible to determine what type matherr expects
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
949 without some more configure magic.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
950 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
951 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
952 int
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
953 matherr (struct exception *x)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
954 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
955 Lisp_Object args;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
956 if (! in_float)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
957 /* Not called from emacs-lisp float routines; do the default thing. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
958 return 0;
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 /* if (!strcmp (x->name, "pow")) x->name = "expt"; */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
961
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
962 args = Fcons (build_string (x->name),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
963 Fcons (make_float (x->arg1),
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
964 ((in_float == 2)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
965 ? Fcons (make_float (x->arg2), Qnil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
966 : Qnil)));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
967 switch (x->type)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
968 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
969 case DOMAIN: Fsignal (Qdomain_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
970 case SING: Fsignal (Qsingularity_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
971 case OVERFLOW: Fsignal (Qoverflow_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
972 case UNDERFLOW: Fsignal (Qunderflow_error, args); break;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
973 default: Fsignal (Qarith_error, args); break;
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 return 1; /* don't set errno or print a message */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
976 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
977 #endif /* HAVE_MATHERR */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
978 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
979
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
980
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
981 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
982 init_floatfns_very_early (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
983 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
984 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
985 # ifdef FLOAT_CATCH_SIGILL
613
023b83f4e54b [xemacs-hg @ 2001-06-10 10:42:16 by ben]
ben
parents: 563
diff changeset
986 EMACS_SIGNAL (SIGILL, float_error);
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
987 # endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
988 in_float = 0;
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
989 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
990 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
991
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
992 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
993 syms_of_floatfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
994 {
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 440
diff changeset
995 INIT_LRECORD_IMPLEMENTATION (float);
428
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 /* Trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
998
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
999 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1000 DEFSUBR (Facos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1001 DEFSUBR (Fasin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1002 DEFSUBR (Fatan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1003 DEFSUBR (Fcos);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1004 DEFSUBR (Fsin);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1005 DEFSUBR (Ftan);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1006 #endif /* LISP_FLOAT_TYPE */
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 /* Bessel functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1009
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1010 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1011 DEFSUBR (Fbessel_y0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1012 DEFSUBR (Fbessel_y1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1013 DEFSUBR (Fbessel_yn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1014 DEFSUBR (Fbessel_j0);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1015 DEFSUBR (Fbessel_j1);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1016 DEFSUBR (Fbessel_jn);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1017 #endif /* 0 */
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 /* Error functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1020
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1021 #if 0
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1022 DEFSUBR (Ferf);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1023 DEFSUBR (Ferfc);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1024 DEFSUBR (Flog_gamma);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1025 #endif /* 0 */
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 /* Root and Log functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1028
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1029 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1030 DEFSUBR (Fexp);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1031 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1032 DEFSUBR (Fexpt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1033 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1034 DEFSUBR (Flog);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1035 DEFSUBR (Flog10);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1036 DEFSUBR (Fsqrt);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1037 DEFSUBR (Fcube_root);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1038 #endif /* LISP_FLOAT_TYPE */
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 /* Inverse trig functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1041
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1042 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1043 DEFSUBR (Facosh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1044 DEFSUBR (Fasinh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1045 DEFSUBR (Fatanh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1046 DEFSUBR (Fcosh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1047 DEFSUBR (Fsinh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1048 DEFSUBR (Ftanh);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1049 #endif /* LISP_FLOAT_TYPE */
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 /* Rounding functions */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1052
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1053 DEFSUBR (Fabs);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1054 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1055 DEFSUBR (Ffloat);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1056 DEFSUBR (Flogb);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1057 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1058 DEFSUBR (Fceiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1059 DEFSUBR (Ffloor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1060 DEFSUBR (Fround);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1061 DEFSUBR (Ftruncate);
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 /* Float-rounding functions. */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1064
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1065 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1066 DEFSUBR (Ffceiling);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1067 DEFSUBR (Fffloor);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1068 DEFSUBR (Ffround);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1069 DEFSUBR (Fftruncate);
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1070 #endif /* LISP_FLOAT_TYPE */
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1071 }
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1072
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1073 void
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1074 vars_of_floatfns (void)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1075 {
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1076 #ifdef LISP_FLOAT_TYPE
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1077 Fprovide (intern ("lisp-float-type"));
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1078 #endif
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1079 }