annotate src/number.c @ 4885:6772ce4d982b

Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums lisp/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Correct the semantics of #'member*, #'eql, #'assoc* in the presence of bignums; change the integerp byte code to fixnump semantics. * bytecomp.el (fixnump, integerp, byte-compile-integerp): Change the integerp byte code to fixnump; add a byte-compile method to integerp using fixnump and numberp and avoiding a funcall most of the time, since in the non-core contexts where integerp is used, it's mostly distinguishing between fixnums and things that are not numbers at all. * byte-optimize.el (side-effect-free-fns, byte-after-unbind-ops) (byte-compile-side-effect-and-error-free-ops): Replace the integerp bytecode with fixnump; add fixnump to the side-effect-free-fns. Add the other extended number type predicates to the list in passing. * obsolete.el (floatp-safe): Mark this as obsolete. * cl.el (eql): Go into more detail in the docstring here. Don't bother checking whether both arguments are numbers; one is enough, #'equal will fail correctly if they have distinct types. (subst): Replace a call to #'integerp (deciding whether to use #'memq or not) with one to #'fixnump. Delete most-positive-fixnum, most-negative-fixnum from this file; they're now always in C, so they can't be modified from Lisp. * cl-seq.el (member*, assoc*, rassoc*): Correct these functions in the presence of bignums. * cl-macs.el (cl-make-type-test): The type test for a fixnum is now fixnump. Ditch floatp-safe, use floatp instead. (eql): Correct this compiler macro in the presence of bignums. (assoc*): Correct this compiler macro in the presence of bignums. * simple.el (undo): Change #'integerp to #'fixnump here, since we use #'delq with the same value as ELT a few lines down. src/ChangeLog addition: 2010-01-24 Aidan Kehoe <kehoea@parhasard.net> Fix problems with #'eql, extended number types, and the hash table implementation; change the Bintegerp bytecode to fixnump semantics even on bignum builds, since #'integerp can have a fast implementation in terms of #'fixnump for most of its extant uses, but not vice-versa. * lisp.h: Always #include number.h; we want the macros provided in it, even if the various number types are not available. * number.h (NON_FIXNUM_NUMBER_P): New macro, giving 1 when its argument is of non-immediate number type. Equivalent to FLOATP if WITH_NUMBER_TYPES is not defined. * elhash.c (lisp_object_eql_equal, lisp_object_eql_hash): Use NON_FIXNUM_NUMBER_P in these functions, instead of FLOATP, giving more correct behaviour in the presence of the extended number types. * bytecode.c (Bfixnump, execute_optimized_program): Rename Bintegerp to Bfixnump; change its semantics to reflect the new name on builds with bignum support. * data.c (Ffixnump, Fintegerp, syms_of_data, vars_of_data): Always make #'fixnump available, even on non-BIGNUM builds; always implement #'integerp in this file, even on BIGNUM builds. Move most-positive-fixnum, most-negative-fixnum here from number.c, so they are Lisp constants even on builds without number types, and attempts to change or bind them error. Use the NUMBERP and INTEGERP macros even on builds without extended number types. * data.c (fixnum_char_or_marker_to_int): Rename this function from integer_char_or_marker_to_int, to better reflect the arguments it accepts. * number.c (Fevenp, Foddp, syms_of_number): Never provide #'integerp in this file. Remove #'oddp, #'evenp; their implementations are overridden by those in cl.el. * number.c (vars_of_number): most-positive-fixnum, most-negative-fixnum are no longer here. man/ChangeLog addition: 2010-01-23 Aidan Kehoe <kehoea@parhasard.net> Generally: be careful to say fixnum, not integer, when talking about fixed-precision integral types. I'm sure I've missed instances, both here and in the docstrings, but this is a decent start. * lispref/text.texi (Columns): Document where only fixnums, not integers generally, are accepted. (Registers): Remove some ancient char-int confoundance here. * lispref/strings.texi (Creating Strings, Creating Strings): Be more exact in describing where fixnums but not integers in general are accepted. (Creating Strings): Use a more contemporary example to illustrate how concat deals with lists including integers about #xFF. Delete some obsolete documentation on same. (Char Table Types): Document that only fixnums are accepted as values in syntax tables. * lispref/searching.texi (String Search, Search and Replace): Be exact in describing where fixnums but not integers in general are accepted. * lispref/range-tables.texi (Range Tables): Be exact in describing them; only fixnums are accepted to describe ranges. * lispref/os.texi (Killing XEmacs, User Identification) (Time of Day, Time Conversion): Be more exact about using fixnum where only fixed-precision integers are accepted. * lispref/objects.texi (Integer Type): Be more exact (and up-to-date) about the possible values for integers. Cross-reference to documentation of the bignum extension. (Equality Predicates): (Range Table Type): (Array Type): Use fixnum, not integer, to describe a fixed-precision integer. (Syntax Table Type): Correct some English syntax here. * lispref/numbers.texi (Numbers): Change the phrasing here to use fixnum to mean the fixed-precision integers normal in emacs. Document that our terminology deviates from that of Common Lisp, and that we're working on it. (Compatibility Issues): Reiterate the Common Lisp versus Emacs Lisp compatibility issues. (Comparison of Numbers, Arithmetic Operations): * lispref/commands.texi (Command Loop Info, Working With Events): * lispref/buffers.texi (Modification Time): Be more exact in describing where fixnums but not integers in general are accepted.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 24 Jan 2010 15:21:27 +0000
parents 2fc0e2f18322
children 1e9078742fa7
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
1 /* Numeric types for XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
2 Copyright (C) 2004 Jerry James.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
3
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
4 This file is part of XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
5
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
6 XEmacs is free software; you can redistribute it and/or modify it
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
7 under the terms of the GNU General Public License as published by the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
8 Free Software Foundation; either version 2, or (at your option) any
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
9 later version.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
10
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
14 for more details.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
15
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
17 along with XEmacs; see the file COPYING. If not, write to
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
18 the Free Software Foundation, Inc., 51 Franklin St - Fifth Floor,
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
19 Boston, MA 02111-1301, USA. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
20
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
21 /* Synched up with: Not in FSF. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
22
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
23 #include <config.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
24 #include <limits.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
25 #include "lisp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
26
2595
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
27 #ifdef HAVE_BIGFLOAT
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
28 #define USED_IF_BIGFLOAT(decl) decl
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
29 #else
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
30 #define USED_IF_BIGFLOAT(decl) UNUSED (decl)
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
31 #endif
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
32
2001
cc5b615380f8 [xemacs-hg @ 2004-04-08 15:23:07 by james]
james
parents: 1996
diff changeset
33 Lisp_Object Qrationalp, Qfloatingp, Qrealp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
34 Lisp_Object Vdefault_float_precision;
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
35
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
36 static Lisp_Object Qunsupported_type;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
37 static Lisp_Object Vbigfloat_max_prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
38 static int number_initialized;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
39
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
40 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
41 bignum scratch_bignum, scratch_bignum2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
42 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
43 #ifdef HAVE_RATIO
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
44 ratio scratch_ratio, scratch_ratio2;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
45 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
46 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
47 bigfloat scratch_bigfloat, scratch_bigfloat2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
48 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
49
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
50 /********************************* Bignums **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
51 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
52 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
53 bignum_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
54 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
55 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
56 CIbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
57 write_c_string (printcharfun, bstr);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
58 xfree (bstr, CIbyte *);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
59 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
60
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
61 #ifdef NEW_GC
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
62 static void
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
63 bignum_finalize (void *header, int for_disksave)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
64 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
65 if (!for_disksave)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
66 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
67 struct Lisp_Bignum *num = (struct Lisp_Bignum *) header;
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
68 bignum_fini (num->data);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
69 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
70 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
71 #define BIGNUM_FINALIZE bignum_finalize
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
72 #else
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
73 #define BIGNUM_FINALIZE 0
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
74 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
75
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
76 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
77 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
78 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
79 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
80 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
81
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
82 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
83 bignum_hash (Lisp_Object obj, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
84 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
85 return bignum_hashcode (XBIGNUM_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
86 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
87
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
88 static void
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
89 bignum_convert (const void *object, void **data, Bytecount *size)
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
90 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
91 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
92 *data = bstr;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
93 *size = strlen(bstr)+1;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
94 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
95
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
96 static void
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
97 bignum_convfree (const void * UNUSED (object), void *data,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
98 Bytecount UNUSED (size))
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
99 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
100 xfree (data, void *);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
101 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
102
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
103 static void *
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
104 bignum_deconvert (void *object, void *data, Bytecount UNUSED (size))
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
105 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
106 bignum *b = (bignum *) object;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
107 bignum_init(*b);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
108 bignum_set_string(*b, (const char *) data, 10);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
109 return object;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
110 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
111
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
112 static const struct opaque_convert_functions bignum_opc = {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
113 bignum_convert,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
114 bignum_convfree,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
115 bignum_deconvert
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
116 };
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
117
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
118 static const struct memory_description bignum_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
119 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data),
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
120 0, { &bignum_opc }, XD_FLAG_NO_KKCC },
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
121 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
122 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
123
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
124 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bignum", bignum, 1, 0, bignum_print,
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
125 BIGNUM_FINALIZE, bignum_equal,
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
126 bignum_hash, bignum_description,
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
127 Lisp_Bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
128
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
129 #endif /* HAVE_BIGNUM */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
130
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
131 Lisp_Object Qbignump;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
132
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
133 DEFUN ("bignump", Fbignump, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
134 Return t if OBJECT is a bignum, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
135 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
136 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
137 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
138 return BIGNUMP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
139 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
140
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
141
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
142 /********************************** Ratios **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
143 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
144 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
145 ratio_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
146 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
147 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
148 CIbyte *rstr = ratio_to_string (XRATIO_DATA (obj), 10);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
149 write_c_string (printcharfun, rstr);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
150 xfree (rstr, CIbyte *);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
151 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
152
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
153 #ifdef NEW_GC
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
154 static void
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
155 ratio_finalize (void *header, int for_disksave)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
156 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
157 if (!for_disksave)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
158 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
159 struct Lisp_Ratio *num = (struct Lisp_Ratio *) header;
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
160 ratio_fini (num->data);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
161 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
162 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
163 #define RATIO_FINALIZE ratio_finalize
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
164 #else
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
165 #define RATIO_FINALIZE 0
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
166 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
167
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
168 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
169 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
170 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
171 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
172 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
173
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
174 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
175 ratio_hash (Lisp_Object obj, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
176 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
177 return ratio_hashcode (XRATIO_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
178 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
179
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
180 static const struct memory_description ratio_description[] = {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
181 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) },
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
182 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
183 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
184
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
185 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0, ratio_print,
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
186 RATIO_FINALIZE, ratio_equal, ratio_hash,
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
187 ratio_description, Lisp_Ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
188
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
189 #endif /* HAVE_RATIO */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
190
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
191 Lisp_Object Qratiop;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
192
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
193 DEFUN ("ratiop", Fratiop, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
194 Return t if OBJECT is a ratio, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
195 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
196 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
197 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
198 return RATIOP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
199 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
200
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
201
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
202 /******************************** Rationals *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
203 DEFUN ("rationalp", Frationalp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
204 Return t if OBJECT is a rational, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
205 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
206 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
207 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
208 return RATIONALP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
209 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
210
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
211 DEFUN ("numerator", Fnumerator, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
212 Return the numerator of the canonical form of RATIONAL.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
213 If RATIONAL is an integer, RATIONAL is returned.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
214 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
215 (rational))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
216 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
217 CONCHECK_RATIONAL (rational);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
218 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
219 return RATIOP (rational)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
220 ? make_bignum_bg (XRATIO_NUMERATOR (rational))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
221 : rational;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
222 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
223 return rational;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
224 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
225 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
226
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
227 DEFUN ("denominator", Fdenominator, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
228 Return the denominator of the canonical form of RATIONAL.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
229 If RATIONAL is an integer, 1 is returned.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
230 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
231 (rational))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
232 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
233 CONCHECK_RATIONAL (rational);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
234 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
235 return RATIOP (rational)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
236 ? make_bignum_bg (XRATIO_DENOMINATOR (rational))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
237 : make_int (1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
238 #else
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
239 return make_int (1);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
240 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
241 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
242
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
243
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
244 /******************************** Bigfloats *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
245 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
246 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
247 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
248 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
249 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
250 CIbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
251 write_c_string (printcharfun, fstr);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
252 xfree (fstr, CIbyte *);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
253 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
254
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
255 #ifdef NEW_GC
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
256 static void
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
257 bigfloat_finalize (void *header, int for_disksave)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
258 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
259 if (!for_disksave)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
260 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
261 struct Lisp_Bigfloat *num = (struct Lisp_Bigfloat *) header;
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
262 bigfloat_fini (num->bf);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
263 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
264 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
265 #define BIGFLOAT_FINALIZE bigfloat_finalize
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
266 #else
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
267 #define BIGFLOAT_FINALIZE 0
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
268 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
269
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
270 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
271 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
272 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
273 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
274 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
275
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
276 static Hashcode
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
277 bigfloat_hash (Lisp_Object obj, int UNUSED (depth))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
278 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
279 return bigfloat_hashcode (XBIGFLOAT_DATA (obj));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
280 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
281
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
282 static const struct memory_description bigfloat_description[] = {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
283 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) },
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
284 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
285 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
286
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
287 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0,
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
288 bigfloat_print, BIGFLOAT_FINALIZE,
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
289 bigfloat_equal, bigfloat_hash,
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
290 bigfloat_description, Lisp_Bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
291
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
292 #endif /* HAVE_BIGFLOAT */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
293
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
294 Lisp_Object Qbigfloatp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
295
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
296 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
297 Return t if OBJECT is a bigfloat, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
298 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
299 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
300 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
301 return BIGFLOATP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
302 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
303
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
304 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /*
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
305 Return the precision of bigfloat F as an integer.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
306 */
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
307 (f))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
308 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
309 CHECK_BIGFLOAT (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
310 #ifdef HAVE_BIGNUM
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
311 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
312 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
313 #else
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
314 return make_int ((int) XBIGFLOAT_GET_PREC (f));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
315 #endif
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
316 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
317
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
318 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /*
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
319 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
320 The new precision of F is returned. Note that the return value may differ
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
321 from PRECISION if the underlying library is unable to support exactly
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
322 PRECISION bits of precision.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
323 */
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
324 (f, precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
325 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
326 unsigned long prec;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
327
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
328 CHECK_BIGFLOAT (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
329 if (INTP (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
330 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
331 prec = (XINT (precision) <= 0) ? 1UL : (unsigned long) XINT (precision);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
332 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
333 #ifdef HAVE_BIGNUM
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
334 else if (BIGNUMP (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
335 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
336 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
337 ? bignum_to_ulong (XBIGNUM_DATA (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
338 : UINT_MAX;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
339 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
340 #endif
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
341 else
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
342 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
343 dead_wrong_type_argument (Qintegerp, f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
344 return Qnil;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
345 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
346
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
347 XBIGFLOAT_SET_PREC (f, prec);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
348 return Fbigfloat_get_precision (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
349 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
350
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
351 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
352 default_float_precision_changed (Lisp_Object UNUSED (sym), Lisp_Object *val,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
353 Lisp_Object UNUSED (in_object),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
354 int UNUSED (flags))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
355 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
356 unsigned long prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
357
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
358 CONCHECK_INTEGER (*val);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
359 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
360 if (INTP (*val))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
361 prec = XINT (*val);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
362 else
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
363 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
364 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
365 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
366 prec = bignum_to_ulong (XBIGNUM_DATA (*val));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
367 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
368 if (prec != 0UL)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
369 bigfloat_set_default_prec (prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
370 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
371 return 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
372 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
373
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
374
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
375 /********************************* Floating *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
376 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
377 make_floating (double d)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
378 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
379 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
380 if (ZEROP (Vdefault_float_precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
381 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
382 return make_float (d);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
383 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
384 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
385 return make_bigfloat (d, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
386 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
387 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
388
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
389 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
390 Return t if OBJECT is a floating point number of any kind, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
391 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
392 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
393 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
394 return FLOATINGP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
395 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
396
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
397
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
398 /********************************** Reals ***********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
399 DEFUN ("realp", Frealp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
400 Return t if OBJECT is a real, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
401 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
402 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
403 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
404 return REALP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
405 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
406
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
407
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
408 /********************************* Numbers **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
409 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
410 Return the canonical form of NUMBER.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
411 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
412 (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
413 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
414 /* The tests should go in order from larger, more expressive, or more
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
415 complex types to smaller, less expressive, or simpler types so that a
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
416 number can cascade all the way down to the simplest type if
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
417 appropriate. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
418 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
419 if (RATIOP (number) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
420 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
421 bignum_to_long (XRATIO_DENOMINATOR (number)) == 1L)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
422 number = make_bignum_bg (XRATIO_NUMERATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
423 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
424 #ifdef HAVE_BIGNUM
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 3025
diff changeset
425 if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number)))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
426 {
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 3025
diff changeset
427 EMACS_INT n = bignum_to_emacs_int (XBIGNUM_DATA (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
428 if (NUMBER_FITS_IN_AN_EMACS_INT (n))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
429 number = make_int (n);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
430 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
431 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
432 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
433 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
434
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
435 enum number_type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
436 get_number_type (Lisp_Object arg)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
437 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
438 if (INTP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
439 return FIXNUM_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
440 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
441 if (BIGNUMP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
442 return BIGNUM_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
443 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
444 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
445 if (RATIOP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
446 return RATIO_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
447 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
448 if (FLOATP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
449 return FLOAT_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
450 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
451 if (BIGFLOATP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
452 return BIGFLOAT_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
453 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
454 /* Catch unintentional bad uses of this function */
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
455 ABORT ();
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
456 /* NOTREACHED */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
457 return FIXNUM_T;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
458 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
459
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
460 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
461 PRECISION; otherwise, PRECISION is ignored. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
462 static Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
463 internal_coerce_number (Lisp_Object number, enum number_type type,
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
464 #ifdef HAVE_BIGFLOAT
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
465 unsigned long precision
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
466 #else
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
467 unsigned long UNUSED (precision)
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
468 #endif
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
469 )
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
470 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
471 enum number_type current_type;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
472
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
473 if (CHARP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
474 number = make_int (XCHAR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
475 else if (MARKERP (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
476 number = make_int (marker_position (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
477
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
478 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence,
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
479 we ABORT() in the #else sections below, because it shouldn't be possible
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
480 to arrive there. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
481 CHECK_NUMBER (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
482 current_type = get_number_type (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
483 switch (current_type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
484 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
485 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
486 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
487 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
488 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
489 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
490 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
491 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
492 return make_bignum (XREALINT (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
493 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
494 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
495 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
496 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
497 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
498 return make_ratio (XREALINT (number), 1UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
499 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
500 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
501 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
502 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
503 return make_float (XREALINT (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
504 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
505 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
506 return make_bigfloat (XREALINT (number), precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
507 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
508 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
509 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
510 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
511 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
512 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
513 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
514 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
515 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
516 return make_int (bignum_to_long (XBIGNUM_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
517 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
518 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
519 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
520 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
521 bignum_set_long (scratch_bignum, 1L);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
522 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
523 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
524 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
525 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
526 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
527 return make_float (bignum_to_double (XBIGNUM_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
528 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
529 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
530 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
531 Lisp_Object temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
532 temp = make_bigfloat (0.0, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
533 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
534 return temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
535 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
536 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
537 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
538 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
539 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
540 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
541 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
542 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
543 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
544 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
545 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
546 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
547 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
548 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
549 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
550 return make_int (bignum_to_long (scratch_bignum));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
551 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
552 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
553 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
554 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
555 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
556 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
557 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
558 return make_float (ratio_to_double (XRATIO_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
559 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
560 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
561 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
562 Lisp_Object temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
563 temp = make_bigfloat (0.0, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
564 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
565 return temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
566 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
567 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
568 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
569 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
570 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
571 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
572 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
573 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
574 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
575 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
576 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
577 case FIXNUM_T:
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
578 return Ftruncate (number, Qnil);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
579 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
580 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
581 bignum_set_double (scratch_bignum, XFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
582 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
583 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
584 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
585 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
586 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
587 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
588 ratio_set_double (scratch_ratio, XFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
589 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
590 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
591 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
592 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
593 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
594 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
595 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
596 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
597 bigfloat_set_prec (scratch_bigfloat, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
598 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
599 return make_bigfloat_bf (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
600 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
601 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
602 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
603 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
604 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
605 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
606 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
607 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
608 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
609 return make_int (bigfloat_to_long (XBIGFLOAT_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
610 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
611 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
612 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
613 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
614 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
615 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
616 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
617 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
618 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
619 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
620 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
621 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
622 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
623 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
624 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
625 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
626 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
627 /* FIXME: Do we need to change the precision? */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
628 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
629 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
630 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
631 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
632 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
633 }
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
634 ABORT ();
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
635 /* NOTREACHED */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
636 return Qzero;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
637 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
638
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
639 /* This function promotes its arguments as necessary to make them both the
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
640 same type. It destructively modifies its arguments to do so. Characters
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
641 and markers are ALWAYS converted to integers. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
642 enum number_type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
643 promote_args (Lisp_Object *arg1, Lisp_Object *arg2)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
644 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
645 enum number_type type1, type2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
646
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
647 if (CHARP (*arg1))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
648 *arg1 = make_int (XCHAR (*arg1));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
649 else if (MARKERP (*arg1))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
650 *arg1 = make_int (marker_position (*arg1));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
651 if (CHARP (*arg2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
652 *arg2 = make_int (XCHAR (*arg2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
653 else if (MARKERP (*arg2))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
654 *arg2 = make_int (marker_position (*arg2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
655
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
656 CHECK_NUMBER (*arg1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
657 CHECK_NUMBER (*arg2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
658
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
659 type1 = get_number_type (*arg1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
660 type2 = get_number_type (*arg2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
661
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
662 if (type1 < type2)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
663 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
664 *arg1 = internal_coerce_number (*arg1, type2,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
665 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
666 type2 == BIGFLOAT_T
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
667 ? XBIGFLOAT_GET_PREC (*arg2) :
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
668 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
669 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
670 return type2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
671 }
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
672
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
673 if (type2 < type1)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
674 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
675 *arg2 = internal_coerce_number (*arg2, type1,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
676 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
677 type1 == BIGFLOAT_T
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
678 ? XBIGFLOAT_GET_PREC (*arg1) :
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
679 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
680 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
681 return type1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
682 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
683
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
684 /* No conversion necessary */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
685 return type1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
686 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
687
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
688 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
689 Convert NUMBER to the indicated type, possibly losing information.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
690 Do not call this function. Use `coerce' instead.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
691
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2595
diff changeset
692 TYPE is one of the symbols `fixnum', `integer', `ratio', `float', or
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2595
diff changeset
693 `bigfloat'. Not all of these types may be supported.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
694
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
695 PRECISION is the number of bits of precision to use when converting to
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
696 bigfloat; it is ignored otherwise. If nil, the default precision is used.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
697
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
698 Note that some conversions lose information. No error is signaled in such
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
699 cases; the information is silently lost.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
700 */
2595
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
701 (number, type, USED_IF_BIGFLOAT (precision)))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
702 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
703 CHECK_SYMBOL (type);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
704 if (EQ (type, Qfixnum))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
705 return internal_coerce_number (number, FIXNUM_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
706 else if (EQ (type, Qinteger))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
707 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
708 /* If bignums are available, we always convert to one first, then
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
709 downgrade to a fixnum if possible. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
710 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
711 return Fcanonicalize_number
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
712 (internal_coerce_number (number, BIGNUM_T, 0UL));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
713 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
714 return internal_coerce_number (number, FIXNUM_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
715 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
716 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
717 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
718 else if (EQ (type, Qratio))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
719 return internal_coerce_number (number, RATIO_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
720 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
721 else if (EQ (type, Qfloat))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
722 return internal_coerce_number (number, FLOAT_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
723 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
724 else if (EQ (type, Qbigfloat))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
725 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
726 unsigned long prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
727
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
728 if (NILP (precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
729 prec = bigfloat_get_default_prec ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
730 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
731 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
732 CHECK_INTEGER (precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
733 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
734 if (INTP (precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
735 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
736 prec = (unsigned long) XREALINT (precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
737 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
738 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
739 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
740 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
741 args_out_of_range (precision, Vbigfloat_max_prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
742 prec = bignum_to_ulong (XBIGNUM_DATA (precision));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
743 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
744 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
745 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
746 return internal_coerce_number (number, BIGFLOAT_T, prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
747 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
748 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
749
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
750 Fsignal (Qunsupported_type, type);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
751 /* NOTREACHED */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
752 return Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
753 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
754
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
755
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
756 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
757 syms_of_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
758 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
759 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
760 INIT_LRECORD_IMPLEMENTATION (bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
761 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
762 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
763 INIT_LRECORD_IMPLEMENTATION (ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
764 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
765 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
766 INIT_LRECORD_IMPLEMENTATION (bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
767 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
768
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
769 /* Type predicates */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
770 DEFSYMBOL (Qrationalp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
771 DEFSYMBOL (Qfloatingp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
772 DEFSYMBOL (Qrealp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
773 DEFSYMBOL (Qbignump);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
774 DEFSYMBOL (Qratiop);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
775 DEFSYMBOL (Qbigfloatp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
776
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
777 /* Functions */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
778 DEFSUBR (Fbignump);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
779 DEFSUBR (Fratiop);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
780 DEFSUBR (Frationalp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
781 DEFSUBR (Fnumerator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
782 DEFSUBR (Fdenominator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
783 DEFSUBR (Fbigfloatp);
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
784 DEFSUBR (Fbigfloat_get_precision);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
785 DEFSUBR (Fbigfloat_set_precision);
2001
cc5b615380f8 [xemacs-hg @ 2004-04-08 15:23:07 by james]
james
parents: 1996
diff changeset
786 DEFSUBR (Ffloatingp);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
787 DEFSUBR (Frealp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
788 DEFSUBR (Fcanonicalize_number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
789 DEFSUBR (Fcoerce_number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
790
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
791 /* Errors */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
792 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
793 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
794
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
795 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
796 vars_of_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
797 {
2051
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
798 /* These variables are Lisp variables rather than number variables so that
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
799 we can put bignums in them. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
800 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
801 The default floating-point precision for newly created floating point values.
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
802 This should be 0 to create Lisp float types, or an unsigned integer no greater
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
803 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
804 indicated precision.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
805 */ default_float_precision_changed);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
806 Vdefault_float_precision = make_int (0);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
807
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
808 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /*
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
809 The maximum number of bits of precision a bigfloat can have.
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
810 This is determined by the underlying library used to implement bigfloats.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
811 */);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
812
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
813 #ifdef HAVE_BIGFLOAT
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
814 /* Don't create a bignum here. Otherwise, we lose with NEW_GC + pdump.
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
815 See reinit_vars_of_number(). */
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
816 Vbigfloat_max_prec = make_int (EMACS_INT_MAX);
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
817 #else
2051
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
818 Vbigfloat_max_prec = make_int (0);
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
819 #endif /* HAVE_BIGFLOAT */
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
820
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
821 Fprovide (intern ("number-types"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
822 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
823 Fprovide (intern ("bignum"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
824 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
825 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
826 Fprovide (intern ("ratio"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
827 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
828 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
829 Fprovide (intern ("bigfloat"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
830 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
831 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
832
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
833 void
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
834 reinit_vars_of_number (void)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
835 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
836 #if defined(HAVE_BIGFLOAT) && defined(HAVE_BIGNUM)
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
837 Vbigfloat_max_prec = make_bignum (0L);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
838 bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX);
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
839 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
840 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
841
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
842 void
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
843 init_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
844 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
845 if (!number_initialized)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
846 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
847 number_initialized = 1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
848
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
849 #ifdef WITH_GMP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
850 init_number_gmp ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
851 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
852 #ifdef WITH_MP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
853 init_number_mp ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
854 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
855
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
856 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
857 bignum_init (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
858 bignum_init (scratch_bignum2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
859 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
860
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
861 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
862 ratio_init (scratch_ratio);
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
863 ratio_init (scratch_ratio2);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
864 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
865
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
866 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
867 bigfloat_init (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
868 bigfloat_init (scratch_bigfloat2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
869 #endif
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
870
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
871 #ifndef PDUMP
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
872 reinit_vars_of_number ();
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
873 #endif
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
874 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
875 }