annotate src/number.c @ 5911:48386fd60fd0

GMP functions that take doubles choke on non-finite values, avoid that. src/ChangeLog addition: 2015-05-10 Aidan Kehoe <kehoea@parhasard.net> * floatfns.c (double_to_integer): Rename this from float_to_int to fit our newer, bignum-compatible terminology. GMP can signal SIGFPE when asked to turn NaN or infinity into a bignum, and we're not prepared to handle that signal if the OS float library routines don't do that, so check for those values explicitly. * floatfns.c (ceiling_two_float): * floatfns.c (ceiling_one_float): * floatfns.c (floor_two_float): * floatfns.c (floor_one_float): * floatfns.c (round_two_float): * floatfns.c (round_one_float): * floatfns.c (truncate_two_float): * floatfns.c (truncate_one_float): Call double_to_integer() with its new name. * number.c: Don't use the {bignum,ratio,bigfloat}_set_double functions directly here, with GMP they can choke when handed non-finite C doubles, call Ftruncate() and the new float_to_bigfloat() from floatfns.c. Maybe we should extend number-gmp.c with GMP-specific implementations that check for non-finite values. tests/ChangeLog addition: 2015-05-10 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: Backslash a few parentheses in the first column for the sake of fontification. * automated/lisp-tests.el: Check that the rounding functions signal Lisp errors correctly when handed positive and negative infinity and NaN.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 10 May 2015 19:07:09 +0100
parents 6174848f3e6c
children
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.
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
3 Copyright (C) 2010 Ben Wing.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
4
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
5 This file is part of XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
6
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5231
diff changeset
7 XEmacs is free software: you can redistribute it and/or modify it
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
8 under the terms of the GNU General Public License as published by the
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5231
diff changeset
9 Free Software Foundation, either version 3 of the License, or (at your
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5231
diff changeset
10 option) any later version.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
11
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
12 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
13 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
14 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
15 for more details.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
16
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
17 You should have received a copy of the GNU General Public License
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5231
diff changeset
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
19
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
20 /* Synched up with: Not in FSF. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
21
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
22 #include <config.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
23 #include <limits.h>
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
24 #include "lisp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
25
2595
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
26 #ifdef HAVE_BIGFLOAT
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
27 #define USED_IF_BIGFLOAT(decl) decl
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
28 #else
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
29 #define USED_IF_BIGFLOAT(decl) UNUSED (decl)
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
30 #endif
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
31
2001
cc5b615380f8 [xemacs-hg @ 2004-04-08 15:23:07 by james]
james
parents: 1996
diff changeset
32 Lisp_Object Qrationalp, Qfloatingp, Qrealp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
33 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
34
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
35 static Lisp_Object Vbigfloat_max_prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
36 static int number_initialized;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
37
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
38 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
39 bignum scratch_bignum, scratch_bignum2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
40 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
41 #ifdef HAVE_RATIO
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
42 ratio scratch_ratio, scratch_ratio2;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
43 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
44 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
45 bigfloat scratch_bigfloat, scratch_bigfloat2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
46 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
47
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
48 /********************************* Bignums **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
49 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
50 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
51 bignum_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
52 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
53 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
54 Ascbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
55 write_ascstring (printcharfun, bstr);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
56 xfree (bstr);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
57 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
58
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
59 #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
60 static void
5141
0dcd22290039 fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
61 bignum_finalize (Lisp_Object obj)
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
62 {
5141
0dcd22290039 fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
63 struct Lisp_Bignum *num = XBIGNUM (obj);
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
64 /* #### WARNING: It would be better to put some sort of check to make
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
65 sure this doesn't happen more than once, just in case ---
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
66 e.g. checking if it's zero before finalizing and then setting it to
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
67 zero after finalizing. */
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
68 bignum_fini (num->data);
4802
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 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
71
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
72 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
73 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
74 int UNUSED (foldcase))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
75 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
76 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
77 }
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 static Hashcode
5191
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
80 bignum_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
81 {
5191
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
82 if (equalp)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
83 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
84 return FLOAT_HASHCODE_FROM_DOUBLE (bignum_to_double (XBIGNUM_DATA (obj)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
85 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
86 else
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
87 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
88 return bignum_hashcode (XBIGNUM_DATA (obj));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
89 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
90 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
91
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
92 static void
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
93 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
94 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
95 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
96 *data = bstr;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
97 *size = strlen(bstr)+1;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
98 }
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 static void
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
101 bignum_convfree (const void * UNUSED (object), void *data,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
102 Bytecount UNUSED (size))
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
103 {
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
104 xfree (data);
2551
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
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
107 static void *
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
108 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
109 {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
110 bignum *b = (bignum *) object;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
111 bignum_init(*b);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
112 bignum_set_string(*b, (const char *) data, 10);
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
113 return object;
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
114 }
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
115
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
116 static const struct opaque_convert_functions bignum_opc = {
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
117 bignum_convert,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
118 bignum_convfree,
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
119 bignum_deconvert
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
120 };
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
121
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
122 static const struct memory_description bignum_description[] = {
2551
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
123 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data),
9f70af3ac939 [xemacs-hg @ 2005-02-03 16:14:02 by james]
james
parents: 2500
diff changeset
124 0, { &bignum_opc }, XD_FLAG_NO_KKCC },
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
125 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
126 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
127
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
128 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bignum", bignum, 0, bignum_print,
5169
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
129 IF_NEW_GC (bignum_finalize),
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
130 bignum_equal, bignum_hash,
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
131 bignum_description, Lisp_Bignum);
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
132 #endif /* HAVE_BIGNUM */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
133
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
134 Lisp_Object Qbignump;
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 DEFUN ("bignump", Fbignump, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
137 Return t if OBJECT is a bignum, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
138 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
139 (object))
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 return BIGNUMP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
142 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
143
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
144
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
145 /********************************** Ratios **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
146 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
147 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
148 ratio_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
149 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
150 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
151 CIbyte *rstr = ratio_to_string (XRATIO_DATA (obj), 10);
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
152 write_ascstring (printcharfun, rstr);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
153 xfree (rstr);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
154 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
155
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
156 #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
157 static void
5141
0dcd22290039 fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
158 ratio_finalize (Lisp_Object obj)
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
159 {
5141
0dcd22290039 fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
160 struct Lisp_Ratio *num = XRATIO (obj);
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
161 /* #### WARNING: It would be better to put some sort of check to make
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
162 sure this doesn't happen more than once, just in case ---
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
163 e.g. checking if it's zero before finalizing and then setting it to
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
164 zero after finalizing. */
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
165 ratio_fini (num->data);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
166 }
5169
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
167 #endif /* not NEW_GC */
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
168
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
169 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
170 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
171 int UNUSED (foldcase))
1983
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 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
174 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
175
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
176 static Hashcode
5191
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
177 ratio_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
178 {
5191
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
179 if (equalp)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
180 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
181 return FLOAT_HASHCODE_FROM_DOUBLE (ratio_to_double (XRATIO_DATA (obj)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
182 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
183 else
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
184 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
185 return ratio_hashcode (XRATIO_DATA (obj));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
186 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
187 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
188
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
189 static const struct memory_description ratio_description[] = {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
190 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) },
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
191 { XD_END }
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
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
194 DEFINE_NODUMP_FROB_BLOCK_LISP_OBJECT ("ratio", ratio, 0, ratio_print,
5169
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
195 IF_NEW_GC (ratio_finalize),
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
196 ratio_equal, ratio_hash,
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
197 ratio_description, Lisp_Ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
198
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
199 #endif /* HAVE_RATIO */
1983
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 Lisp_Object Qratiop;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
202
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
203 DEFUN ("ratiop", Fratiop, 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 ratio, 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 RATIOP (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
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
212 /******************************** Rationals *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
213 DEFUN ("rationalp", Frationalp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
214 Return t if OBJECT is a rational, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
215 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
216 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
217 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
218 return RATIONALP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
219 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
220
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
221 DEFUN ("numerator", Fnumerator, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
222 Return the numerator of the canonical form of RATIONAL.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
223 If RATIONAL is an integer, RATIONAL is returned.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
224 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
225 (rational))
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 CONCHECK_RATIONAL (rational);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
228 #ifdef HAVE_RATIO
4883
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
229 if (RATIOP (rational))
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
230 {
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
231 return
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
232 Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (rational)));
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
233 }
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
234 #endif
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
235 return rational;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
236 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
237
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
238 DEFUN ("denominator", Fdenominator, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
239 Return the denominator of the canonical form of RATIONAL.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
240 If RATIONAL is an integer, 1 is returned.
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 (rational))
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 CONCHECK_RATIONAL (rational);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
245 #ifdef HAVE_RATIO
4883
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
246 if (RATIOP (rational))
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
247 {
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
248 return Fcanonicalize_number (make_bignum_bg
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
249 (XRATIO_DENOMINATOR (rational)));
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
250 }
4892
d1d4ce10c7b4 Fix the build problem in number.c
Aidan Kehoe <kehoea@parhasard.net>
parents: 4886
diff changeset
251 #endif
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
252 return make_fixnum (1);
1983
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
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
255
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
256 /******************************** Bigfloats *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
257 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
258 static void
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
259 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun,
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
260 int UNUSED (escapeflag))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
261 {
4952
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
262 Ascbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10);
19a72041c5ed Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents: 4883
diff changeset
263 write_ascstring (printcharfun, fstr);
4976
16112448d484 Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents: 4962
diff changeset
264 xfree (fstr);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
265 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
266
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
267 #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
268 static void
5141
0dcd22290039 fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
269 bigfloat_finalize (Lisp_Object obj)
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
270 {
5141
0dcd22290039 fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents: 5125
diff changeset
271 struct Lisp_Bigfloat *num = XBIGFLOAT (obj);
5125
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
272 /* #### WARNING: It would be better to put some sort of check to make
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
273 sure this doesn't happen more than once, just in case ---
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
274 e.g. checking if it's zero before finalizing and then setting it to
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
275 zero after finalizing. */
Ben Wing <ben@xemacs.org>
parents: 5124 4976
diff changeset
276 bigfloat_fini (num->bf);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
277 }
5169
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
278 #endif /* not NEW_GC */
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
279
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
280 static int
4906
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
281 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth),
6ef8256a020a implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents: 4892
diff changeset
282 int UNUSED (foldcase))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
283 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
284 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
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
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
287 static Hashcode
5191
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
288 bigfloat_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
289 {
5191
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
290 if (equalp)
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
291 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
292 return
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
293 FLOAT_HASHCODE_FROM_DOUBLE (bigfloat_to_double (XBIGFLOAT_DATA (obj)));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
294 }
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
295 else
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
296 {
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
297 return bigfloat_hashcode (XBIGFLOAT_DATA (obj));
71ee43b8a74d Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents: 5169
diff changeset
298 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
299 }
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 static const struct memory_description bigfloat_description[] = {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
302 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) },
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
303 { XD_END }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
304 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
305
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 5117 4678
diff changeset
306 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("bigfloat", bigfloat, 0,
5169
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
307 bigfloat_print,
6c6d78781d59 cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents: 5141
diff changeset
308 IF_NEW_GC (bigfloat_finalize),
5124
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
309 bigfloat_equal, bigfloat_hash,
623d57b7fbe8 separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
310 bigfloat_description, Lisp_Bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
311
5911
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
312 extern Lisp_Object float_to_bigfloat (const Ascbyte *, Lisp_Object,
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
313 unsigned long);
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
314
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
315 #endif /* HAVE_BIGFLOAT */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
316
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
317 Lisp_Object Qbigfloatp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
318
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
319 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
320 Return t if OBJECT is a bigfloat, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
321 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
322 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
323 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
324 return BIGFLOATP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
325 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
326
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
327 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
328 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
329 */
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
330 (f))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
331 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
332 CHECK_BIGFLOAT (f);
5602
c9e5612f5424 Support the MP library on recent FreeBSD, have it pass relevant tests.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5581
diff changeset
333 #ifdef HAVE_BIGFLOAT
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
334 #ifdef HAVE_BIGNUM
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
335 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
336 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
337 #else
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
338 return make_fixnum ((int) XBIGFLOAT_GET_PREC (f));
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
339 #endif
5602
c9e5612f5424 Support the MP library on recent FreeBSD, have it pass relevant tests.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5581
diff changeset
340 #endif
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
341 }
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 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
344 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
345 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
346 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
347 PRECISION bits of precision.
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
348 */
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
349 (f, precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
350 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
351 unsigned long prec;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
352
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
353 CHECK_BIGFLOAT (f);
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
354 if (FIXNUMP (precision))
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
355 {
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
356 prec = (XFIXNUM (precision) <= 0) ? 1UL : (unsigned long) XFIXNUM (precision);
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
357 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
358 #ifdef HAVE_BIGNUM
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
359 else if (BIGNUMP (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
360 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
361 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
362 ? bignum_to_ulong (XBIGNUM_DATA (precision))
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
363 : UINT_MAX;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
364 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
365 #endif
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
366 else
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
367 {
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
368 dead_wrong_type_argument (Qintegerp, f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
369 return Qnil;
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
370 }
5602
c9e5612f5424 Support the MP library on recent FreeBSD, have it pass relevant tests.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5581
diff changeset
371 #ifdef HAVE_BIGFLOAT
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
372 XBIGFLOAT_SET_PREC (f, prec);
5602
c9e5612f5424 Support the MP library on recent FreeBSD, have it pass relevant tests.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5581
diff changeset
373 #endif
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
374 return Fbigfloat_get_precision (f);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
375 }
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
376
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
377 static int
2286
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
378 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
379 Lisp_Object UNUSED (in_object),
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
380 int UNUSED (flags))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
381 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
382 unsigned long prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
383
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
384 CONCHECK_INTEGER (*val);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
385 #ifdef HAVE_BIGFLOAT
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
386 if (FIXNUMP (*val))
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
387 prec = XFIXNUM (*val);
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
388 else
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
389 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
390 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
391 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
392 prec = bignum_to_ulong (XBIGNUM_DATA (*val));
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 if (prec != 0UL)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
395 bigfloat_set_default_prec (prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
396 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
397 return 0;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
398 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
399
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
400
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
401 /********************************* Floating *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
402 Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
403 make_floating (double d)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
404 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
405 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
406 if (ZEROP (Vdefault_float_precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
407 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
408 return make_float (d);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
409 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
410 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
411 return make_bigfloat (d, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
412 #endif
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
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
415 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
416 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
417 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
418 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
419 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
420 return FLOATINGP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
421 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
422
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
423
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
424 /********************************** Reals ***********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
425 DEFUN ("realp", Frealp, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
426 Return t if OBJECT is a real, nil otherwise.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
427 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
428 (object))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
429 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
430 return REALP (object) ? Qt : Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
431 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
432
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 /********************************* Numbers **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
435 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
436 Return the canonical form of NUMBER.
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 (number))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
439 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
440 /* 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
441 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
442 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
443 appropriate. */
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 (number) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
446 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) &&
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
447 bignum_to_long (XRATIO_DENOMINATOR (number)) == 1L)
4883
f730384b8ddf Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
448 number = Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (number)));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
449 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
450 #ifdef HAVE_BIGNUM
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 3025
diff changeset
451 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
452 {
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 3025
diff changeset
453 EMACS_INT n = bignum_to_emacs_int (XBIGNUM_DATA (number));
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
454 if (NUMBER_FITS_IN_A_FIXNUM (n))
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
455 number = make_fixnum (n);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
456 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
457 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
458 return number;
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
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
461 enum number_type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
462 get_number_type (Lisp_Object arg)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
463 {
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
464 if (FIXNUMP (arg))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
465 return FIXNUM_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
466 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
467 if (BIGNUMP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
468 return BIGNUM_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
469 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
470 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
471 if (RATIOP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
472 return RATIO_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
473 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
474 if (FLOATP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
475 return FLOAT_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
476 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
477 if (BIGFLOATP (arg))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
478 return BIGFLOAT_T;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
479 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
480 /* Catch unintentional bad uses of this function */
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
481 ABORT ();
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
482 /* NOTREACHED */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
483 return FIXNUM_T;
1983
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
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
486 /* 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
487 PRECISION; otherwise, PRECISION is ignored. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
488 static Lisp_Object
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
489 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
490 #ifdef HAVE_BIGFLOAT
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
491 unsigned long precision
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
492 #else
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
493 unsigned long UNUSED (precision)
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
494 #endif
04bc9d2f42c7 [xemacs-hg @ 2004-09-20 19:18:55 by james]
james
parents: 2092
diff changeset
495 )
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
496 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
497 enum number_type current_type;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
498
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
499 if (CHARP (number))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
500 number = make_fixnum (XCHAR (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
501 else if (MARKERP (number))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
502 number = make_fixnum (marker_position (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
503
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
504 /* 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
505 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
506 to arrive there. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
507 CHECK_NUMBER (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
508 current_type = get_number_type (number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
509 switch (current_type)
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 FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
512 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
513 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
514 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
515 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
516 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
517 #ifdef HAVE_BIGNUM
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
518 return make_bignum (XREALFIXNUM (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
519 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
520 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
521 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
522 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
523 #ifdef HAVE_RATIO
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
524 return make_ratio (XREALFIXNUM (number), 1UL);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
525 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
526 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
527 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
528 case FLOAT_T:
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
529 return make_float (XREALFIXNUM (number));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
530 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
531 #ifdef HAVE_BIGFLOAT
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
532 return make_bigfloat (XREALFIXNUM (number), precision);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
533 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
534 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
535 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
536 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
537 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
538 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
539 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
540 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
541 case FIXNUM_T:
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
542 return make_fixnum (bignum_to_long (XBIGNUM_DATA (number)));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
543 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
544 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
545 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
546 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
547 bignum_set_long (scratch_bignum, 1L);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
548 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
549 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
550 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
551 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
552 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
553 return make_float (bignum_to_double (XBIGNUM_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
554 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
555 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
556 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
557 Lisp_Object temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
558 temp = make_bigfloat (0.0, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
559 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
560 return temp;
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 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
563 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
564 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
565 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
566 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
567 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
568 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
569 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
570 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
571 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
572 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
573 case FIXNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
574 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
575 XRATIO_DENOMINATOR (number));
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
576 return make_fixnum (bignum_to_long (scratch_bignum));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
577 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
578 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
579 XRATIO_DENOMINATOR (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
580 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
581 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
582 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
583 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
584 return make_float (ratio_to_double (XRATIO_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
585 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
586 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
587 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
588 Lisp_Object temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
589 temp = make_bigfloat (0.0, precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
590 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
591 return temp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
592 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
593 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
594 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
595 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
596 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
597 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
598 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
599 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
600 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
601 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
602 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
603 case FIXNUM_T:
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
604 return Ftruncate (number, Qnil);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
605 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
606 #ifdef HAVE_BIGNUM
5911
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
607 {
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
608 Lisp_Object truncate = Ftruncate (number, Qnil);
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
609 return FIXNUMP (truncate) ?
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
610 make_bignum (XREALFIXNUM (truncate)) : truncate;
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
611 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
612 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
613 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
614 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
615 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
616 #ifdef HAVE_RATIO
5911
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
617 {
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
618 Lisp_Object truncate = Ftruncate (number, Qnil);
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
619 if (FIXNUMP (truncate))
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
620 {
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
621 return make_ratio (XREALFIXNUM (truncate), 1UL);
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
622 }
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
623
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
624 bignum_set_long (scratch_bignum, 1L);
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
625 return make_ratio_bg (XBIGNUM_DATA (truncate), scratch_bignum);
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
626 }
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
627 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
628 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
629 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
630 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
631 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
632 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
633 #ifdef HAVE_BIGFLOAT
5911
48386fd60fd0 GMP functions that take doubles choke on non-finite values, avoid that.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5908
diff changeset
634 return float_to_bigfloat ("coerce-number", number, precision);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
635 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
636 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
637 #endif /* HAVE_BIGFLOAT */
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 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
640 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
641 switch (type)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
642 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
643 case FIXNUM_T:
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
644 return make_fixnum (bigfloat_to_long (XBIGFLOAT_DATA (number)));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
645 case BIGNUM_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
646 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
647 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
648 return make_bignum_bg (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
649 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
650 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
651 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
652 case RATIO_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
653 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
654 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
655 return make_ratio_rt (scratch_ratio);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
656 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
657 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
658 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
659 case FLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
660 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number)));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
661 case BIGFLOAT_T:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
662 /* FIXME: Do we need to change the precision? */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
663 return number;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
664 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
665 #else
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
666 ABORT ();
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
667 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
668 }
2500
3d8143fc88e1 [xemacs-hg @ 2005-01-24 23:33:30 by ben]
ben
parents: 2286
diff changeset
669 ABORT ();
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
670 /* NOTREACHED */
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
671 return Qzero;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
672 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
673
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
674 /* 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
675 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
676 and markers are ALWAYS converted to integers. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
677 enum number_type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
678 promote_args (Lisp_Object *arg1, Lisp_Object *arg2)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
679 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
680 enum number_type type1, type2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
681
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
682 if (CHARP (*arg1))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
683 *arg1 = make_fixnum (XCHAR (*arg1));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
684 else if (MARKERP (*arg1))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
685 *arg1 = make_fixnum (marker_position (*arg1));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
686 if (CHARP (*arg2))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
687 *arg2 = make_fixnum (XCHAR (*arg2));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
688 else if (MARKERP (*arg2))
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
689 *arg2 = make_fixnum (marker_position (*arg2));
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
690
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
691 CHECK_NUMBER (*arg1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
692 CHECK_NUMBER (*arg2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
693
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
694 type1 = get_number_type (*arg1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
695 type2 = get_number_type (*arg2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
696
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
697 if (type1 < type2)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
698 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
699 *arg1 = internal_coerce_number (*arg1, type2,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
700 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
701 type2 == BIGFLOAT_T
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
702 ? XBIGFLOAT_GET_PREC (*arg2) :
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
703 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
704 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
705 return type2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
706 }
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
707
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
708 if (type2 < type1)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
709 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
710 *arg2 = internal_coerce_number (*arg2, type1,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
711 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
712 type1 == BIGFLOAT_T
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
713 ? XBIGFLOAT_GET_PREC (*arg1) :
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
714 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
715 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
716 return type1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
717 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
718
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
719 /* No conversion necessary */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
720 return type1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
721 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
722
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
723 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
724 Convert NUMBER to the indicated type, possibly losing information.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
725 Do not call this function. Use `coerce' instead.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
726
3025
facf3239ba30 [xemacs-hg @ 2005-10-25 11:16:19 by ben]
ben
parents: 2595
diff changeset
727 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
728 `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
729
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
730 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
731 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
732
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
733 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
734 cases; the information is silently lost.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
735 */
2595
ae5285944c74 [xemacs-hg @ 2005-02-18 21:56:10 by james]
james
parents: 2551
diff changeset
736 (number, type, USED_IF_BIGFLOAT (precision)))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
737 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
738 CHECK_SYMBOL (type);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
739 if (EQ (type, Qfixnum))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
740 return internal_coerce_number (number, FIXNUM_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
741 else if (EQ (type, Qinteger))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
742 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
743 /* 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
744 downgrade to a fixnum if possible. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
745 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
746 return Fcanonicalize_number
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
747 (internal_coerce_number (number, BIGNUM_T, 0UL));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
748 #else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
749 return internal_coerce_number (number, FIXNUM_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
750 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
751 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
752 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
753 else if (EQ (type, Qratio))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
754 return internal_coerce_number (number, RATIO_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
755 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
756 else if (EQ (type, Qfloat))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
757 return internal_coerce_number (number, FLOAT_T, 0UL);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
758 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
759 else if (EQ (type, Qbigfloat))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
760 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
761 unsigned long prec;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
762
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
763 if (NILP (precision))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
764 prec = bigfloat_get_default_prec ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
765 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
766 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
767 CHECK_INTEGER (precision);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
768 #ifdef HAVE_BIGNUM
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
769 if (FIXNUMP (precision))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
770 #endif /* HAVE_BIGNUM */
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
771 prec = (unsigned long) XREALFIXNUM (precision);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
772 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
773 else
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
774 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
775 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision)))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
776 args_out_of_range (precision, Vbigfloat_max_prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
777 prec = bignum_to_ulong (XBIGNUM_DATA (precision));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
778 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
779 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
780 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
781 return internal_coerce_number (number, BIGFLOAT_T, prec);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
782 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
783 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
784
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
785 Fsignal (Qunsupported_type, type);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
786 /* NOTREACHED */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
787 return Qnil;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
788 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
789
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 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
792 syms_of_number (void)
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 #ifdef HAVE_BIGNUM
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
795 INIT_LISP_OBJECT (bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
796 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
797 #ifdef HAVE_RATIO
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
798 INIT_LISP_OBJECT (ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
799 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
800 #ifdef HAVE_BIGFLOAT
5117
3742ea8250b5 Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents: 3025
diff changeset
801 INIT_LISP_OBJECT (bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
802 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
803
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
804 /* Type predicates */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
805 DEFSYMBOL (Qrationalp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
806 DEFSYMBOL (Qfloatingp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
807 DEFSYMBOL (Qrealp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
808 DEFSYMBOL (Qbignump);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
809 DEFSYMBOL (Qratiop);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
810 DEFSYMBOL (Qbigfloatp);
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 /* Functions */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
813 DEFSUBR (Fbignump);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
814 DEFSUBR (Fratiop);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
815 DEFSUBR (Frationalp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
816 DEFSUBR (Fnumerator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
817 DEFSUBR (Fdenominator);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
818 DEFSUBR (Fbigfloatp);
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
819 DEFSUBR (Fbigfloat_get_precision);
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
820 DEFSUBR (Fbigfloat_set_precision);
2001
cc5b615380f8 [xemacs-hg @ 2004-04-08 15:23:07 by james]
james
parents: 1996
diff changeset
821 DEFSUBR (Ffloatingp);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
822 DEFSUBR (Frealp);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
823 DEFSUBR (Fcanonicalize_number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
824 DEFSUBR (Fcoerce_number);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
825 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
826
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
827 void
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
828 vars_of_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
829 {
2051
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
830 /* 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
831 we can put bignums in them. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
832 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /*
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
833 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
834 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
835 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
836 indicated precision.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
837 */ default_float_precision_changed);
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
838 Vdefault_float_precision = make_fixnum (0);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
839
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2061
diff changeset
840 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
841 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
842 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
843 */);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
844
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
845 #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
846 /* 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
847 See reinit_vars_of_number(). */
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
848 Vbigfloat_max_prec = make_fixnum (MOST_POSITIVE_FIXNUM);
2061
b75af0ab66f3 [xemacs-hg @ 2004-05-05 22:09:14 by james]
james
parents: 2057
diff changeset
849 #else
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5405
diff changeset
850 Vbigfloat_max_prec = make_fixnum (0);
2051
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
851 #endif /* HAVE_BIGFLOAT */
a7dd0aed0fe6 [xemacs-hg @ 2004-04-30 18:59:11 by james]
james
parents: 2019
diff changeset
852
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
853 Fprovide (intern ("number-types"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
854 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
855 Fprovide (intern ("bignum"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
856 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
857 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
858 Fprovide (intern ("ratio"));
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 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
861 Fprovide (intern ("bigfloat"));
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
862 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
863 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
864
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
865 void
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
866 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
867 {
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
868 #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
869 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
870 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
871 #endif
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
872 }
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
873
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
874 void
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
875 init_number (void)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
876 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
877 if (!number_initialized)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
878 {
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
879 number_initialized = 1;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
880
5739
a2912073be85 Support bignums with MPIR. Add documentation on the bignum, ratio,
Jerry James <james@xemacs.org>
parents: 5602
diff changeset
881 #if defined(WITH_GMP) || defined(WITH_MPIR)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
882 init_number_gmp ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
883 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
884 #ifdef WITH_MP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
885 init_number_mp ();
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
886 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
887
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
888 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
889 bignum_init (scratch_bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
890 bignum_init (scratch_bignum2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
891 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
892
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
893 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
894 ratio_init (scratch_ratio);
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
895 ratio_init (scratch_ratio2);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
896 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
897
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
898 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
899 bigfloat_init (scratch_bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
900 bigfloat_init (scratch_bigfloat2);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
901 #endif
4802
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
902
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
903 #ifndef PDUMP
2fc0e2f18322 Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents: 4678
diff changeset
904 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
905 #endif
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
906 }
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
907 }