Mercurial > hg > xemacs-beta
annotate src/number.c @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | 56144c8593a8 |
| children | a2912073be85 |
| rev | line source |
|---|---|
| 1983 | 1 /* Numeric types for XEmacs. |
| 2 Copyright (C) 2004 Jerry James. | |
| 5125 | 3 Copyright (C) 2010 Ben Wing. |
| 1983 | 4 |
| 5 This file is part of XEmacs. | |
| 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 | 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 | 11 |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 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 | 19 |
| 20 /* Synched up with: Not in FSF. */ | |
| 21 | |
| 22 #include <config.h> | |
| 23 #include <limits.h> | |
| 24 #include "lisp.h" | |
| 25 | |
| 2595 | 26 #ifdef HAVE_BIGFLOAT |
| 27 #define USED_IF_BIGFLOAT(decl) decl | |
| 28 #else | |
| 29 #define USED_IF_BIGFLOAT(decl) UNUSED (decl) | |
| 30 #endif | |
| 31 | |
| 2001 | 32 Lisp_Object Qrationalp, Qfloatingp, Qrealp; |
| 1983 | 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 | 35 static Lisp_Object Qunsupported_type; |
| 36 static Lisp_Object Vbigfloat_max_prec; | |
| 37 static int number_initialized; | |
| 38 | |
| 39 #ifdef HAVE_BIGNUM | |
| 40 bignum scratch_bignum, scratch_bignum2; | |
| 41 #endif | |
| 42 #ifdef HAVE_RATIO | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
43 ratio scratch_ratio, scratch_ratio2; |
| 1983 | 44 #endif |
| 45 #ifdef HAVE_BIGFLOAT | |
| 46 bigfloat scratch_bigfloat, scratch_bigfloat2; | |
| 47 #endif | |
| 48 | |
| 49 /********************************* Bignums **********************************/ | |
| 50 #ifdef HAVE_BIGNUM | |
| 51 static void | |
| 2286 | 52 bignum_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 53 int UNUSED (escapeflag)) | |
| 1983 | 54 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4883
diff
changeset
|
55 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
|
56 write_ascstring (printcharfun, bstr); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
57 xfree (bstr); |
| 1983 | 58 } |
| 59 | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
60 #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
|
61 static void |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
62 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
|
63 { |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
64 struct Lisp_Bignum *num = XBIGNUM (obj); |
| 5125 | 65 /* #### WARNING: It would be better to put some sort of check to make |
| 66 sure this doesn't happen more than once, just in case --- | |
| 67 e.g. checking if it's zero before finalizing and then setting it to | |
| 68 zero after finalizing. */ | |
| 69 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
|
70 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
71 #endif |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
72 |
| 1983 | 73 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
|
74 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
|
75 int UNUSED (foldcase)) |
| 1983 | 76 { |
| 77 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)); | |
| 78 } | |
| 79 | |
| 80 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
|
81 bignum_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) |
| 1983 | 82 { |
|
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
|
83 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
|
84 { |
|
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 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
|
86 } |
|
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 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
|
88 { |
|
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 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
|
90 } |
| 1983 | 91 } |
| 92 | |
| 2551 | 93 static void |
| 94 bignum_convert (const void *object, void **data, Bytecount *size) | |
| 95 { | |
| 96 CIbyte *bstr = bignum_to_string (*(bignum *)object, 10); | |
| 97 *data = bstr; | |
| 98 *size = strlen(bstr)+1; | |
| 99 } | |
| 100 | |
| 101 static void | |
| 102 bignum_convfree (const void * UNUSED (object), void *data, | |
| 103 Bytecount UNUSED (size)) | |
| 104 { | |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
105 xfree (data); |
| 2551 | 106 } |
| 107 | |
| 108 static void * | |
| 109 bignum_deconvert (void *object, void *data, Bytecount UNUSED (size)) | |
| 110 { | |
| 111 bignum *b = (bignum *) object; | |
| 112 bignum_init(*b); | |
| 113 bignum_set_string(*b, (const char *) data, 10); | |
| 114 return object; | |
| 115 } | |
| 116 | |
| 117 static const struct opaque_convert_functions bignum_opc = { | |
| 118 bignum_convert, | |
| 119 bignum_convfree, | |
| 120 bignum_deconvert | |
| 121 }; | |
| 122 | |
| 1983 | 123 static const struct memory_description bignum_description[] = { |
| 2551 | 124 { XD_OPAQUE_DATA_CONVERTIBLE, offsetof (Lisp_Bignum, data), |
| 125 0, { &bignum_opc }, XD_FLAG_NO_KKCC }, | |
| 1983 | 126 { XD_END } |
| 127 }; | |
| 128 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
129 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
|
130 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
|
131 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
|
132 bignum_description, Lisp_Bignum); |
| 2092 | 133 #endif /* HAVE_BIGNUM */ |
| 1983 | 134 |
| 135 Lisp_Object Qbignump; | |
| 136 | |
| 137 DEFUN ("bignump", Fbignump, 1, 1, 0, /* | |
| 138 Return t if OBJECT is a bignum, nil otherwise. | |
| 139 */ | |
| 140 (object)) | |
| 141 { | |
| 142 return BIGNUMP (object) ? Qt : Qnil; | |
| 143 } | |
| 144 | |
| 145 | |
| 146 /********************************** Ratios **********************************/ | |
| 147 #ifdef HAVE_RATIO | |
| 148 static void | |
| 2286 | 149 ratio_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 150 int UNUSED (escapeflag)) | |
| 1983 | 151 { |
| 152 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
|
153 write_ascstring (printcharfun, rstr); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
154 xfree (rstr); |
| 1983 | 155 } |
| 156 | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
157 #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
|
158 static void |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
159 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
|
160 { |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
161 struct Lisp_Ratio *num = XRATIO (obj); |
| 5125 | 162 /* #### WARNING: It would be better to put some sort of check to make |
| 163 sure this doesn't happen more than once, just in case --- | |
| 164 e.g. checking if it's zero before finalizing and then setting it to | |
| 165 zero after finalizing. */ | |
| 166 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
|
167 } |
|
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
|
168 #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
|
169 |
| 1983 | 170 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
|
171 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
|
172 int UNUSED (foldcase)) |
| 1983 | 173 { |
| 174 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2)); | |
| 175 } | |
| 176 | |
| 177 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
|
178 ratio_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) |
| 1983 | 179 { |
|
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
|
180 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
|
181 { |
|
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 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
|
183 } |
|
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 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
|
185 { |
|
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 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
|
187 } |
| 1983 | 188 } |
| 189 | |
| 190 static const struct memory_description ratio_description[] = { | |
| 191 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) }, | |
| 192 { XD_END } | |
| 193 }; | |
| 194 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
195 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
|
196 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
|
197 ratio_equal, ratio_hash, |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
198 ratio_description, Lisp_Ratio); |
| 1983 | 199 |
| 2092 | 200 #endif /* HAVE_RATIO */ |
| 1983 | 201 |
| 202 Lisp_Object Qratiop; | |
| 203 | |
| 204 DEFUN ("ratiop", Fratiop, 1, 1, 0, /* | |
| 205 Return t if OBJECT is a ratio, nil otherwise. | |
| 206 */ | |
| 207 (object)) | |
| 208 { | |
| 209 return RATIOP (object) ? Qt : Qnil; | |
| 210 } | |
| 211 | |
| 212 | |
| 213 /******************************** Rationals *********************************/ | |
| 214 DEFUN ("rationalp", Frationalp, 1, 1, 0, /* | |
| 215 Return t if OBJECT is a rational, nil otherwise. | |
| 216 */ | |
| 217 (object)) | |
| 218 { | |
| 219 return RATIONALP (object) ? Qt : Qnil; | |
| 220 } | |
| 221 | |
| 222 DEFUN ("numerator", Fnumerator, 1, 1, 0, /* | |
| 223 Return the numerator of the canonical form of RATIONAL. | |
| 224 If RATIONAL is an integer, RATIONAL is returned. | |
| 225 */ | |
| 226 (rational)) | |
| 227 { | |
| 228 CONCHECK_RATIONAL (rational); | |
| 229 #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
|
230 if (RATIOP (rational)) |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
231 { |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
232 return |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
233 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
|
234 } |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
235 #endif |
| 1983 | 236 return rational; |
| 237 } | |
| 238 | |
| 239 DEFUN ("denominator", Fdenominator, 1, 1, 0, /* | |
| 240 Return the denominator of the canonical form of RATIONAL. | |
| 241 If RATIONAL is an integer, 1 is returned. | |
| 242 */ | |
| 243 (rational)) | |
| 244 { | |
| 245 CONCHECK_RATIONAL (rational); | |
| 246 #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
|
247 if (RATIOP (rational)) |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
248 { |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
249 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
|
250 (XRATIO_DENOMINATOR (rational))); |
|
f730384b8ddf
Be more careful about canonical integer forms when dealing with ratios.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4802
diff
changeset
|
251 } |
|
4892
d1d4ce10c7b4
Fix the build problem in number.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
4886
diff
changeset
|
252 #endif |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
253 return make_fixnum (1); |
| 1983 | 254 } |
| 255 | |
| 256 | |
| 257 /******************************** Bigfloats *********************************/ | |
| 258 #ifdef HAVE_BIGFLOAT | |
| 259 static void | |
| 2286 | 260 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun, |
| 261 int UNUSED (escapeflag)) | |
| 1983 | 262 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4883
diff
changeset
|
263 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
|
264 write_ascstring (printcharfun, fstr); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
265 xfree (fstr); |
| 1983 | 266 } |
| 267 | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
268 #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
|
269 static void |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
270 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
|
271 { |
|
5141
0dcd22290039
fix issues with finalizers in number.c, postgresql, ldap
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
272 struct Lisp_Bigfloat *num = XBIGFLOAT (obj); |
| 5125 | 273 /* #### WARNING: It would be better to put some sort of check to make |
| 274 sure this doesn't happen more than once, just in case --- | |
| 275 e.g. checking if it's zero before finalizing and then setting it to | |
| 276 zero after finalizing. */ | |
| 277 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
|
278 } |
|
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
|
279 #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
|
280 |
| 1983 | 281 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
|
282 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
|
283 int UNUSED (foldcase)) |
| 1983 | 284 { |
| 285 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)); | |
| 286 } | |
| 287 | |
| 288 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
|
289 bigfloat_hash (Lisp_Object obj, int UNUSED (depth), Boolint equalp) |
| 1983 | 290 { |
|
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
|
291 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
|
292 { |
|
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 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
|
294 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
|
295 } |
|
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 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
|
297 { |
|
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 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
|
299 } |
| 1983 | 300 } |
| 301 | |
| 302 static const struct memory_description bigfloat_description[] = { | |
| 303 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) }, | |
| 304 { XD_END } | |
| 305 }; | |
| 306 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
307 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
|
308 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
|
309 IF_NEW_GC (bigfloat_finalize), |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
310 bigfloat_equal, bigfloat_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
311 bigfloat_description, Lisp_Bigfloat); |
| 1983 | 312 |
| 2092 | 313 #endif /* HAVE_BIGFLOAT */ |
| 1983 | 314 |
| 315 Lisp_Object Qbigfloatp; | |
| 316 | |
| 317 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /* | |
| 318 Return t if OBJECT is a bigfloat, nil otherwise. | |
| 319 */ | |
| 320 (object)) | |
| 321 { | |
| 322 return BIGFLOATP (object) ? Qt : Qnil; | |
| 323 } | |
| 324 | |
| 2092 | 325 DEFUN ("bigfloat-get-precision", Fbigfloat_get_precision, 1, 1, 0, /* |
| 326 Return the precision of bigfloat F as an integer. | |
| 327 */ | |
| 328 (f)) | |
| 329 { | |
| 330 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
|
331 #ifdef HAVE_BIGFLOAT |
| 2092 | 332 #ifdef HAVE_BIGNUM |
| 333 bignum_set_ulong (scratch_bignum, XBIGFLOAT_GET_PREC (f)); | |
| 334 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 335 #else | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
336 return make_fixnum ((int) XBIGFLOAT_GET_PREC (f)); |
| 2092 | 337 #endif |
|
5602
c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
338 #endif |
| 2092 | 339 } |
| 340 | |
| 341 DEFUN ("bigfloat-set-precision", Fbigfloat_set_precision, 2, 2, 0, /* | |
| 342 Set the precision of F, a bigfloat, to PRECISION, a nonnegative integer. | |
| 343 The new precision of F is returned. Note that the return value may differ | |
| 344 from PRECISION if the underlying library is unable to support exactly | |
| 345 PRECISION bits of precision. | |
| 346 */ | |
| 347 (f, precision)) | |
| 348 { | |
| 349 unsigned long prec; | |
| 350 | |
| 351 CHECK_BIGFLOAT (f); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
352 if (FIXNUMP (precision)) |
| 2092 | 353 { |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
354 prec = (XFIXNUM (precision) <= 0) ? 1UL : (unsigned long) XFIXNUM (precision); |
| 2092 | 355 } |
| 356 #ifdef HAVE_BIGNUM | |
| 357 else if (BIGNUMP (precision)) | |
| 358 { | |
| 359 prec = bignum_fits_ulong_p (XBIGNUM_DATA (precision)) | |
| 360 ? bignum_to_ulong (XBIGNUM_DATA (precision)) | |
| 361 : UINT_MAX; | |
| 362 } | |
| 363 #endif | |
| 364 else | |
| 365 { | |
| 366 dead_wrong_type_argument (Qintegerp, f); | |
| 367 return Qnil; | |
| 368 } | |
|
5602
c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
369 #ifdef HAVE_BIGFLOAT |
| 2092 | 370 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
|
371 #endif |
| 2092 | 372 return Fbigfloat_get_precision (f); |
| 373 } | |
| 374 | |
| 1983 | 375 static int |
| 2286 | 376 default_float_precision_changed (Lisp_Object UNUSED (sym), Lisp_Object *val, |
| 377 Lisp_Object UNUSED (in_object), | |
| 378 int UNUSED (flags)) | |
| 1983 | 379 { |
| 380 unsigned long prec; | |
| 381 | |
| 382 CONCHECK_INTEGER (*val); | |
| 383 #ifdef HAVE_BIGFLOAT | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
384 if (FIXNUMP (*val)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
385 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
|
386 else |
| 1983 | 387 { |
| 388 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val))) | |
| 389 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec); | |
| 390 prec = bignum_to_ulong (XBIGNUM_DATA (*val)); | |
| 391 } | |
| 392 if (prec != 0UL) | |
| 393 bigfloat_set_default_prec (prec); | |
| 394 #endif | |
| 395 return 0; | |
| 396 } | |
| 397 | |
| 398 | |
| 399 /********************************* Floating *********************************/ | |
| 400 Lisp_Object | |
| 401 make_floating (double d) | |
| 402 { | |
| 403 #ifdef HAVE_BIGFLOAT | |
| 404 if (ZEROP (Vdefault_float_precision)) | |
| 405 #endif | |
| 406 return make_float (d); | |
| 407 #ifdef HAVE_BIGFLOAT | |
| 408 else | |
| 409 return make_bigfloat (d, 0UL); | |
| 410 #endif | |
| 411 } | |
| 412 | |
| 413 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /* | |
| 414 Return t if OBJECT is a floating point number of any kind, nil otherwise. | |
| 415 */ | |
| 416 (object)) | |
| 417 { | |
| 418 return FLOATINGP (object) ? Qt : Qnil; | |
| 419 } | |
| 420 | |
| 421 | |
| 422 /********************************** Reals ***********************************/ | |
| 423 DEFUN ("realp", Frealp, 1, 1, 0, /* | |
| 424 Return t if OBJECT is a real, nil otherwise. | |
| 425 */ | |
| 426 (object)) | |
| 427 { | |
| 428 return REALP (object) ? Qt : Qnil; | |
| 429 } | |
| 430 | |
| 431 | |
| 432 /********************************* Numbers **********************************/ | |
| 433 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /* | |
| 434 Return the canonical form of NUMBER. | |
| 435 */ | |
| 436 (number)) | |
| 437 { | |
| 438 /* The tests should go in order from larger, more expressive, or more | |
| 439 complex types to smaller, less expressive, or simpler types so that a | |
| 440 number can cascade all the way down to the simplest type if | |
| 441 appropriate. */ | |
| 442 #ifdef HAVE_RATIO | |
| 443 if (RATIOP (number) && | |
| 444 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) && | |
| 445 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
|
446 number = Fcanonicalize_number (make_bignum_bg (XRATIO_NUMERATOR (number))); |
| 1983 | 447 #endif |
| 448 #ifdef HAVE_BIGNUM | |
| 3391 | 449 if (BIGNUMP (number) && bignum_fits_emacs_int_p (XBIGNUM_DATA (number))) |
| 1983 | 450 { |
| 3391 | 451 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
|
452 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
|
453 number = make_fixnum (n); |
| 1983 | 454 } |
| 455 #endif | |
| 456 return number; | |
| 457 } | |
| 458 | |
| 459 enum number_type | |
| 460 get_number_type (Lisp_Object arg) | |
| 461 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
462 if (FIXNUMP (arg)) |
| 1983 | 463 return FIXNUM_T; |
| 464 #ifdef HAVE_BIGNUM | |
| 465 if (BIGNUMP (arg)) | |
| 466 return BIGNUM_T; | |
| 467 #endif | |
| 468 #ifdef HAVE_RATIO | |
| 469 if (RATIOP (arg)) | |
| 470 return RATIO_T; | |
| 471 #endif | |
| 472 if (FLOATP (arg)) | |
| 473 return FLOAT_T; | |
| 474 #ifdef HAVE_BIGFLOAT | |
| 475 if (BIGFLOATP (arg)) | |
| 476 return BIGFLOAT_T; | |
| 477 #endif | |
| 478 /* Catch unintentional bad uses of this function */ | |
| 2500 | 479 ABORT (); |
| 1995 | 480 /* NOTREACHED */ |
| 481 return FIXNUM_T; | |
| 1983 | 482 } |
| 483 | |
| 484 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated | |
| 485 PRECISION; otherwise, PRECISION is ignored. */ | |
| 486 static Lisp_Object | |
| 487 internal_coerce_number (Lisp_Object number, enum number_type type, | |
| 2286 | 488 #ifdef HAVE_BIGFLOAT |
| 489 unsigned long precision | |
| 490 #else | |
| 491 unsigned long UNUSED (precision) | |
| 492 #endif | |
| 493 ) | |
| 1983 | 494 { |
| 495 enum number_type current_type; | |
| 496 | |
| 497 if (CHARP (number)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
498 number = make_fixnum (XCHAR (number)); |
| 1983 | 499 else if (MARKERP (number)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
500 number = make_fixnum (marker_position (number)); |
| 1983 | 501 |
| 502 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence, | |
| 2500 | 503 we ABORT() in the #else sections below, because it shouldn't be possible |
| 1983 | 504 to arrive there. */ |
| 505 CHECK_NUMBER (number); | |
| 506 current_type = get_number_type (number); | |
| 507 switch (current_type) | |
| 508 { | |
| 509 case FIXNUM_T: | |
| 510 switch (type) | |
| 511 { | |
| 512 case FIXNUM_T: | |
| 513 return number; | |
| 514 case BIGNUM_T: | |
| 515 #ifdef HAVE_BIGNUM | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
516 return make_bignum (XREALFIXNUM (number)); |
| 1983 | 517 #else |
| 2500 | 518 ABORT (); |
| 1983 | 519 #endif /* HAVE_BIGNUM */ |
| 520 case RATIO_T: | |
| 521 #ifdef HAVE_RATIO | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
522 return make_ratio (XREALFIXNUM (number), 1UL); |
| 1983 | 523 #else |
| 2500 | 524 ABORT (); |
| 1983 | 525 #endif /* HAVE_RATIO */ |
| 526 case FLOAT_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
527 return make_float (XREALFIXNUM (number)); |
| 1983 | 528 case BIGFLOAT_T: |
| 529 #ifdef HAVE_BIGFLOAT | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
530 return make_bigfloat (XREALFIXNUM (number), precision); |
| 1983 | 531 #else |
| 2500 | 532 ABORT (); |
| 1983 | 533 #endif /* HAVE_BIGFLOAT */ |
| 534 } | |
| 535 case BIGNUM_T: | |
| 536 #ifdef HAVE_BIGNUM | |
| 537 switch (type) | |
| 538 { | |
| 539 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
540 return make_fixnum (bignum_to_long (XBIGNUM_DATA (number))); |
| 1983 | 541 case BIGNUM_T: |
| 542 return number; | |
| 543 case RATIO_T: | |
| 544 #ifdef HAVE_RATIO | |
| 545 bignum_set_long (scratch_bignum, 1L); | |
| 546 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum); | |
| 547 #else | |
| 2500 | 548 ABORT (); |
| 1983 | 549 #endif /* HAVE_RATIO */ |
| 550 case FLOAT_T: | |
| 551 return make_float (bignum_to_double (XBIGNUM_DATA (number))); | |
| 552 case BIGFLOAT_T: | |
| 553 #ifdef HAVE_BIGFLOAT | |
| 554 { | |
| 555 Lisp_Object temp; | |
| 556 temp = make_bigfloat (0.0, precision); | |
| 557 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number)); | |
| 558 return temp; | |
| 559 } | |
| 560 #else | |
| 2500 | 561 ABORT (); |
| 1983 | 562 #endif /* HAVE_BIGFLOAT */ |
| 563 } | |
| 564 #else | |
| 2500 | 565 ABORT (); |
| 1983 | 566 #endif /* HAVE_BIGNUM */ |
| 567 case RATIO_T: | |
| 568 #ifdef HAVE_RATIO | |
| 569 switch (type) | |
| 570 { | |
| 571 case FIXNUM_T: | |
| 572 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
| 573 XRATIO_DENOMINATOR (number)); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
574 return make_fixnum (bignum_to_long (scratch_bignum)); |
| 1983 | 575 case BIGNUM_T: |
| 576 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number), | |
| 577 XRATIO_DENOMINATOR (number)); | |
| 578 return make_bignum_bg (scratch_bignum); | |
| 579 case RATIO_T: | |
| 580 return number; | |
| 581 case FLOAT_T: | |
| 582 return make_float (ratio_to_double (XRATIO_DATA (number))); | |
| 583 case BIGFLOAT_T: | |
| 584 #ifdef HAVE_BIGFLOAT | |
| 585 { | |
| 586 Lisp_Object temp; | |
| 587 temp = make_bigfloat (0.0, precision); | |
| 588 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number)); | |
| 589 return temp; | |
| 590 } | |
| 591 #else | |
| 2500 | 592 ABORT (); |
| 1983 | 593 #endif /* HAVE_BIGFLOAT */ |
| 594 } | |
| 595 #else | |
| 2500 | 596 ABORT (); |
| 1983 | 597 #endif /* HAVE_RATIO */ |
| 598 case FLOAT_T: | |
| 599 switch (type) | |
| 600 { | |
| 601 case FIXNUM_T: | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
602 return Ftruncate (number, Qnil); |
| 1983 | 603 case BIGNUM_T: |
| 604 #ifdef HAVE_BIGNUM | |
| 605 bignum_set_double (scratch_bignum, XFLOAT_DATA (number)); | |
| 606 return make_bignum_bg (scratch_bignum); | |
| 607 #else | |
| 2500 | 608 ABORT (); |
| 1983 | 609 #endif /* HAVE_BIGNUM */ |
| 610 case RATIO_T: | |
| 611 #ifdef HAVE_RATIO | |
| 612 ratio_set_double (scratch_ratio, XFLOAT_DATA (number)); | |
| 613 return make_ratio_rt (scratch_ratio); | |
| 614 #else | |
| 2500 | 615 ABORT (); |
| 1983 | 616 #endif /* HAVE_RATIO */ |
| 617 case FLOAT_T: | |
| 618 return number; | |
| 619 case BIGFLOAT_T: | |
| 620 #ifdef HAVE_BIGFLOAT | |
| 621 bigfloat_set_prec (scratch_bigfloat, precision); | |
| 622 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number)); | |
| 623 return make_bigfloat_bf (scratch_bigfloat); | |
| 624 #else | |
| 2500 | 625 ABORT (); |
| 1983 | 626 #endif /* HAVE_BIGFLOAT */ |
| 627 } | |
| 628 case BIGFLOAT_T: | |
| 629 #ifdef HAVE_BIGFLOAT | |
| 630 switch (type) | |
| 631 { | |
| 632 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
633 return make_fixnum (bigfloat_to_long (XBIGFLOAT_DATA (number))); |
| 1983 | 634 case BIGNUM_T: |
| 635 #ifdef HAVE_BIGNUM | |
| 636 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number)); | |
| 637 return make_bignum_bg (scratch_bignum); | |
| 638 #else | |
| 2500 | 639 ABORT (); |
| 1983 | 640 #endif /* HAVE_BIGNUM */ |
| 641 case RATIO_T: | |
| 642 #ifdef HAVE_RATIO | |
| 643 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number)); | |
| 644 return make_ratio_rt (scratch_ratio); | |
| 645 #else | |
| 2500 | 646 ABORT (); |
| 1983 | 647 #endif |
| 648 case FLOAT_T: | |
| 649 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number))); | |
| 650 case BIGFLOAT_T: | |
| 651 /* FIXME: Do we need to change the precision? */ | |
| 652 return number; | |
| 653 } | |
| 654 #else | |
| 2500 | 655 ABORT (); |
| 1983 | 656 #endif /* HAVE_BIGFLOAT */ |
| 657 } | |
| 2500 | 658 ABORT (); |
| 1995 | 659 /* NOTREACHED */ |
| 660 return Qzero; | |
| 1983 | 661 } |
| 662 | |
| 663 /* This function promotes its arguments as necessary to make them both the | |
| 664 same type. It destructively modifies its arguments to do so. Characters | |
| 665 and markers are ALWAYS converted to integers. */ | |
| 666 enum number_type | |
| 667 promote_args (Lisp_Object *arg1, Lisp_Object *arg2) | |
| 668 { | |
| 669 enum number_type type1, type2; | |
| 670 | |
| 671 if (CHARP (*arg1)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
672 *arg1 = make_fixnum (XCHAR (*arg1)); |
| 1983 | 673 else if (MARKERP (*arg1)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
674 *arg1 = make_fixnum (marker_position (*arg1)); |
| 1983 | 675 if (CHARP (*arg2)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
676 *arg2 = make_fixnum (XCHAR (*arg2)); |
| 1983 | 677 else if (MARKERP (*arg2)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
678 *arg2 = make_fixnum (marker_position (*arg2)); |
| 1983 | 679 |
| 680 CHECK_NUMBER (*arg1); | |
| 681 CHECK_NUMBER (*arg2); | |
| 682 | |
| 683 type1 = get_number_type (*arg1); | |
| 684 type2 = get_number_type (*arg2); | |
| 685 | |
| 686 if (type1 < type2) | |
| 687 { | |
| 688 *arg1 = internal_coerce_number (*arg1, type2, | |
| 689 #ifdef HAVE_BIGFLOAT | |
| 690 type2 == BIGFLOAT_T | |
| 691 ? XBIGFLOAT_GET_PREC (*arg2) : | |
| 692 #endif | |
| 693 0UL); | |
| 694 return type2; | |
| 695 } | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
696 |
| 1983 | 697 if (type2 < type1) |
| 698 { | |
| 699 *arg2 = internal_coerce_number (*arg2, type1, | |
| 700 #ifdef HAVE_BIGFLOAT | |
| 701 type1 == BIGFLOAT_T | |
| 702 ? XBIGFLOAT_GET_PREC (*arg1) : | |
| 703 #endif | |
| 704 0UL); | |
| 705 return type1; | |
| 706 } | |
| 707 | |
| 708 /* No conversion necessary */ | |
| 709 return type1; | |
| 710 } | |
| 711 | |
| 712 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /* | |
| 713 Convert NUMBER to the indicated type, possibly losing information. | |
| 714 Do not call this function. Use `coerce' instead. | |
| 715 | |
| 3025 | 716 TYPE is one of the symbols `fixnum', `integer', `ratio', `float', or |
| 717 `bigfloat'. Not all of these types may be supported. | |
| 1983 | 718 |
| 719 PRECISION is the number of bits of precision to use when converting to | |
| 720 bigfloat; it is ignored otherwise. If nil, the default precision is used. | |
| 721 | |
| 722 Note that some conversions lose information. No error is signaled in such | |
| 723 cases; the information is silently lost. | |
| 724 */ | |
| 2595 | 725 (number, type, USED_IF_BIGFLOAT (precision))) |
| 1983 | 726 { |
| 727 CHECK_SYMBOL (type); | |
| 728 if (EQ (type, Qfixnum)) | |
| 729 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
| 730 else if (EQ (type, Qinteger)) | |
| 731 { | |
| 732 /* If bignums are available, we always convert to one first, then | |
| 733 downgrade to a fixnum if possible. */ | |
| 734 #ifdef HAVE_BIGNUM | |
| 735 return Fcanonicalize_number | |
| 736 (internal_coerce_number (number, BIGNUM_T, 0UL)); | |
| 737 #else | |
| 738 return internal_coerce_number (number, FIXNUM_T, 0UL); | |
| 739 #endif | |
| 740 } | |
| 741 #ifdef HAVE_RATIO | |
| 742 else if (EQ (type, Qratio)) | |
| 743 return internal_coerce_number (number, RATIO_T, 0UL); | |
| 744 #endif | |
| 745 else if (EQ (type, Qfloat)) | |
| 746 return internal_coerce_number (number, FLOAT_T, 0UL); | |
| 747 #ifdef HAVE_BIGFLOAT | |
| 748 else if (EQ (type, Qbigfloat)) | |
| 749 { | |
| 750 unsigned long prec; | |
| 751 | |
| 752 if (NILP (precision)) | |
| 753 prec = bigfloat_get_default_prec (); | |
| 754 else | |
| 755 { | |
| 756 CHECK_INTEGER (precision); | |
| 757 #ifdef HAVE_BIGNUM | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
758 if (FIXNUMP (precision)) |
| 1983 | 759 #endif /* HAVE_BIGNUM */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
760 prec = (unsigned long) XREALFIXNUM (precision); |
| 1983 | 761 #ifdef HAVE_BIGNUM |
| 762 else | |
| 763 { | |
| 764 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision))) | |
| 765 args_out_of_range (precision, Vbigfloat_max_prec); | |
| 766 prec = bignum_to_ulong (XBIGNUM_DATA (precision)); | |
| 767 } | |
| 768 #endif /* HAVE_BIGNUM */ | |
| 769 } | |
| 770 return internal_coerce_number (number, BIGFLOAT_T, prec); | |
| 771 } | |
| 772 #endif /* HAVE_BIGFLOAT */ | |
| 773 | |
| 774 Fsignal (Qunsupported_type, type); | |
| 775 /* NOTREACHED */ | |
| 776 return Qnil; | |
| 777 } | |
| 778 | |
| 779 | |
| 780 void | |
| 781 syms_of_number (void) | |
| 782 { | |
| 783 #ifdef HAVE_BIGNUM | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
784 INIT_LISP_OBJECT (bignum); |
| 1983 | 785 #endif |
| 786 #ifdef HAVE_RATIO | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
787 INIT_LISP_OBJECT (ratio); |
| 1983 | 788 #endif |
| 789 #ifdef HAVE_BIGFLOAT | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3025
diff
changeset
|
790 INIT_LISP_OBJECT (bigfloat); |
| 1983 | 791 #endif |
| 792 | |
| 793 /* Type predicates */ | |
| 794 DEFSYMBOL (Qrationalp); | |
| 795 DEFSYMBOL (Qfloatingp); | |
| 796 DEFSYMBOL (Qrealp); | |
| 797 DEFSYMBOL (Qbignump); | |
| 798 DEFSYMBOL (Qratiop); | |
| 799 DEFSYMBOL (Qbigfloatp); | |
| 800 | |
| 801 /* Functions */ | |
| 802 DEFSUBR (Fbignump); | |
| 803 DEFSUBR (Fratiop); | |
| 804 DEFSUBR (Frationalp); | |
| 805 DEFSUBR (Fnumerator); | |
| 806 DEFSUBR (Fdenominator); | |
| 807 DEFSUBR (Fbigfloatp); | |
| 2092 | 808 DEFSUBR (Fbigfloat_get_precision); |
| 809 DEFSUBR (Fbigfloat_set_precision); | |
| 2001 | 810 DEFSUBR (Ffloatingp); |
| 1983 | 811 DEFSUBR (Frealp); |
| 812 DEFSUBR (Fcanonicalize_number); | |
| 813 DEFSUBR (Fcoerce_number); | |
| 814 | |
| 815 /* Errors */ | |
| 816 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument); | |
| 817 } | |
| 818 | |
| 819 void | |
| 820 vars_of_number (void) | |
| 821 { | |
| 2051 | 822 /* These variables are Lisp variables rather than number variables so that |
| 823 we can put bignums in them. */ | |
| 1983 | 824 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /* |
| 825 The default floating-point precision for newly created floating point values. | |
| 2092 | 826 This should be 0 to create Lisp float types, or an unsigned integer no greater |
| 827 than `bigfloat-maximum-precision' to create Lisp bigfloat types with the | |
| 828 indicated precision. | |
| 1983 | 829 */ default_float_precision_changed); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
830 Vdefault_float_precision = make_fixnum (0); |
| 1983 | 831 |
| 2092 | 832 DEFVAR_CONST_LISP ("bigfloat-maximum-precision", &Vbigfloat_max_prec /* |
| 1983 | 833 The maximum number of bits of precision a bigfloat can have. |
| 2092 | 834 This is determined by the underlying library used to implement bigfloats. |
| 1983 | 835 */); |
| 836 | |
| 2061 | 837 #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
|
838 /* 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
|
839 See reinit_vars_of_number(). */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
840 Vbigfloat_max_prec = make_fixnum (MOST_POSITIVE_FIXNUM); |
| 2061 | 841 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5405
diff
changeset
|
842 Vbigfloat_max_prec = make_fixnum (0); |
| 2051 | 843 #endif /* HAVE_BIGFLOAT */ |
| 844 | |
| 1983 | 845 Fprovide (intern ("number-types")); |
| 846 #ifdef HAVE_BIGNUM | |
| 847 Fprovide (intern ("bignum")); | |
| 848 #endif | |
| 849 #ifdef HAVE_RATIO | |
| 850 Fprovide (intern ("ratio")); | |
| 851 #endif | |
| 852 #ifdef HAVE_BIGFLOAT | |
| 853 Fprovide (intern ("bigfloat")); | |
| 854 #endif | |
| 855 } | |
| 856 | |
| 857 void | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
858 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
|
859 { |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
860 #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
|
861 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
|
862 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
|
863 #endif |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
864 } |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
865 |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
866 void |
| 1983 | 867 init_number (void) |
| 868 { | |
| 869 if (!number_initialized) | |
| 870 { | |
| 871 number_initialized = 1; | |
| 872 | |
| 873 #ifdef WITH_GMP | |
| 874 init_number_gmp (); | |
| 875 #endif | |
| 876 #ifdef WITH_MP | |
| 877 init_number_mp (); | |
| 878 #endif | |
| 879 | |
| 880 #ifdef HAVE_BIGNUM | |
| 881 bignum_init (scratch_bignum); | |
| 882 bignum_init (scratch_bignum2); | |
| 883 #endif | |
| 884 | |
| 885 #ifdef HAVE_RATIO | |
| 886 ratio_init (scratch_ratio); | |
|
4678
b5e1d4f6b66f
Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3391
diff
changeset
|
887 ratio_init (scratch_ratio2); |
| 1983 | 888 #endif |
| 889 | |
| 890 #ifdef HAVE_BIGFLOAT | |
| 891 bigfloat_init (scratch_bigfloat); | |
| 892 bigfloat_init (scratch_bigfloat2); | |
| 893 #endif | |
|
4802
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
894 |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
895 #ifndef PDUMP |
|
2fc0e2f18322
Don't create any bignums before pdumping. Add bignum, ratio, and bigfloat
Jerry James <james@xemacs.org>
parents:
4678
diff
changeset
|
896 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
|
897 #endif |
| 1983 | 898 } |
| 899 } |