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