Mercurial > hg > xemacs-beta

comparison src/number.c @ 1983:9c872f33ecbe

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2004-04-05 22:49:31 by james] Add bignum, ratio, and bigfloat support.
author james
date Mon, 05 Apr 2004 22:50:11 +0000
parents
children 4e6a63799f08
comparison
equal deleted inserted replaced
1982:a748951fd4fb 1983:9c872f33ecbe
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
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 /* Synched up with: Not in FSF. */
22
23 #include <config.h>
24 #include <limits.h>
25 #include "lisp.h"
26
27 Lisp_Object Qintegerp, Qrationalp, Qfloatingp, Qrealp, Qnumberp;
28 Lisp_Object Vdefault_float_precision;
29 Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
30 static Lisp_Object Qunsupported_type;
31 static Lisp_Object Vbigfloat_max_prec;
32 static int number_initialized;
33
34 #ifdef HAVE_BIGNUM
35 bignum scratch_bignum, scratch_bignum2;
36 #endif
37 #ifdef HAVE_RATIO
38 ratio scratch_ratio;
39 #endif
40 #ifdef HAVE_BIGFLOAT
41 bigfloat scratch_bigfloat, scratch_bigfloat2;
42 #endif
43
44 /********************************* Bignums **********************************/
45 #ifdef HAVE_BIGNUM
46 static void
47 bignum_print (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
48 {
49 CIbyte *bstr = bignum_to_string (XBIGNUM_DATA (obj), 10);
50 write_c_string (printcharfun, bstr);
51 xfree (bstr, CIbyte *);
52 }
53
54 static void
55 bignum_finalize (void *header, int for_disksave)
56 {
57 if (for_disksave)
58 invalid_operation ("Can't dump an XEmacs containing bignum objects",
59 VOID_TO_LISP (header));
60 bignum_fini (((Lisp_Bignum *)header)->data);
61 }
62
63 static int
64 bignum_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
65 {
66 return bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2));
67 }
68
69 static Hashcode
70 bignum_hash (Lisp_Object obj, int depth)
71 {
72 return bignum_hashcode (XBIGNUM_DATA (obj));
73 }
74
75 static const struct memory_description bignum_description[] = {
76 { XD_OPAQUE_PTR, offsetof (Lisp_Bignum, data) },
77 { XD_END }
78 };
79
80 DEFINE_LRECORD_IMPLEMENTATION ("bignum", bignum, 0, 0,
81 bignum_print, bignum_finalize, bignum_equal,
82 bignum_hash, bignum_description, Lisp_Bignum);
83
84 Lisp_Object
85 string_to_bignum(const Ibyte *str, Bytecount len, int base)
86 {
87 Lisp_Object b = make_bignum (0L);
88 return (bignum_set_string (XBIGNUM_DATA (b), str, base) < 0)
89 ? Fsignal (Qinvalid_read_syntax,
90 list3 (build_msg_string
91 ("Invalid integer constant in reader"),
92 make_string (str, len),
93 make_int (10)))
94 : b;
95 }
96
97 #else /* !HAVE_BIGNUM */
98
99 Lisp_Object Qbignump;
100
101 #endif /* HAVE_BIGNUM */
102
103 DEFUN ("bignump", Fbignump, 1, 1, 0, /*
104 Return t if OBJECT is a bignum, nil otherwise.
105 */
106 (object))
107 {
108 return BIGNUMP (object) ? Qt : Qnil;
109 }
110
111
112 /********************************* Integers *********************************/
113 DEFUN ("integerp", Fintegerp, 1, 1, 0, /*
114 Return t if OBJECT is an integer, nil otherwise.
115 */
116 (object))
117 {
118 return INTEGERP (object) ? Qt : Qnil;
119 }
120
121 DEFUN ("evenp", Fevenp, 1, 1, 0, /*
122 Return t if INTEGER is even, nil otherwise.
123 */
124 (integer))
125 {
126 CONCHECK_INTEGER (integer);
127 return BIGNUMP (integer)
128 ? bignum_evenp (XBIGNUM_DATA (integer))
129 : XTYPE (integer) == Lisp_Type_Int_Even;
130 }
131
132 DEFUN ("odd", Foddp, 1, 1, 0, /*
133 Return t if INTEGER is odd, nil otherwise.
134 */
135 (integer))
136 {
137 CONCHECK_INTEGER (integer);
138 return BIGNUMP (integer)
139 ? bignum_oddp (XBIGNUM_DATA (integer))
140 : XTYPE (integer) == Lisp_Type_Int_Odd;
141 }
142
143
144 /********************************** Ratios **********************************/
145 #ifdef HAVE_RATIO
146 static void
147 ratio_print (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
148 {
149 CIbyte *rstr = ratio_to_string (XRATIO_DATA (obj), 10);
150 write_c_string (printcharfun, rstr);
151 xfree (rstr, CIbyte *);
152 }
153
154 static void
155 ratio_finalize (void *header, int for_disksave)
156 {
157 if (for_disksave)
158 invalid_operation ("Can't dump an XEmacs containing ratio objects",
159 VOID_TO_LISP (header));
160 ratio_fini (((Lisp_Ratio *)header)->data);
161 }
162 ;
163
164 static int
165 ratio_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
166 {
167 return ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2));
168 }
169
170 static Hashcode
171 ratio_hash (Lisp_Object obj, int depth)
172 {
173 return ratio_hashcode (XRATIO_DATA (obj));
174 }
175
176 static const struct memory_description ratio_description[] = {
177 { XD_OPAQUE_PTR, offsetof (Lisp_Ratio, data) },
178 { XD_END }
179 };
180
181 DEFINE_LRECORD_IMPLEMENTATION ("ratio", ratio, 0, 0,
182 ratio_print, ratio_finalize, ratio_equal,
183 ratio_hash, ratio_description, Lisp_Ratio);
184
185 #else /* !HAVE_RATIO */
186
187 Lisp_Object Qratiop;
188
189 #endif /* HAVE_RATIO */
190
191 DEFUN ("ratiop", Fratiop, 1, 1, 0, /*
192 Return t if OBJECT is a ratio, nil otherwise.
193 */
194 (object))
195 {
196 return RATIOP (object) ? Qt : Qnil;
197 }
198
199
200 /******************************** Rationals *********************************/
201 DEFUN ("rationalp", Frationalp, 1, 1, 0, /*
202 Return t if OBJECT is a rational, nil otherwise.
203 */
204 (object))
205 {
206 return RATIONALP (object) ? Qt : Qnil;
207 }
208
209 DEFUN ("numerator", Fnumerator, 1, 1, 0, /*
210 Return the numerator of the canonical form of RATIONAL.
211 If RATIONAL is an integer, RATIONAL is returned.
212 */
213 (rational))
214 {
215 CONCHECK_RATIONAL (rational);
216 #ifdef HAVE_RATIO
217 return RATIOP (rational)
218 ? make_bignum_bg (XRATIO_NUMERATOR (rational))
219 : rational;
220 #else
221 return rational;
222 #endif
223 }
224
225 DEFUN ("denominator", Fdenominator, 1, 1, 0, /*
226 Return the denominator of the canonical form of RATIONAL.
227 If RATIONAL is an integer, 1 is returned.
228 */
229 (rational))
230 {
231 CONCHECK_RATIONAL (rational);
232 #ifdef HAVE_RATIO
233 return RATIOP (rational)
234 ? make_bignum_bg (XRATIO_DENOMINATOR (rational))
235 : make_int (1);
236 #else
237 return rational;
238 #endif
239 }
240
241
242 /******************************** Bigfloats *********************************/
243 #ifdef HAVE_BIGFLOAT
244 static void
245 bigfloat_print (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
246 {
247 CIbyte *fstr = bigfloat_to_string (XBIGFLOAT_DATA (obj), 10);
248 write_c_string (printcharfun, fstr);
249 xfree (fstr, CIbyte *);
250 }
251
252 static void
253 bigfloat_finalize (void *header, int for_disksave)
254 {
255 if (for_disksave)
256 invalid_operation ("Can't dump an XEmacs containing bigfloat objects",
257 VOID_TO_LISP (header));
258 bigfloat_fini (((Lisp_Bigfloat *)header)->bf);
259 }
260
261 static int
262 bigfloat_equal (Lisp_Object obj1, Lisp_Object obj2, int depth)
263 {
264 return bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2));
265 }
266
267 static Hashcode
268 bigfloat_hash (Lisp_Object obj, int depth)
269 {
270 return bigfloat_hashcode (XBIGFLOAT_DATA (obj));
271 }
272
273 static const struct memory_description bigfloat_description[] = {
274 { XD_OPAQUE_PTR, offsetof (Lisp_Bigfloat, bf) },
275 { XD_END }
276 };
277
278 DEFINE_LRECORD_IMPLEMENTATION ("bigfloat", bigfloat, 1, 0,
279 bigfloat_print, bigfloat_finalize,
280 bigfloat_equal, bigfloat_hash,
281 bigfloat_description, Lisp_Bigfloat);
282
283 #else /* !HAVE_BIGFLOAT */
284
285 Lisp_Object Qbigfloatp;
286
287 #endif /* HAVE_BIGFLOAT */
288
289 DEFUN ("bigfloatp", Fbigfloatp, 1, 1, 0, /*
290 Return t if OBJECT is a bigfloat, nil otherwise.
291 */
292 (object))
293 {
294 return BIGFLOATP (object) ? Qt : Qnil;
295 }
296
297 static int
298 default_float_precision_changed (Lisp_Object sym, Lisp_Object *val,
299 Lisp_Object in_object, int flags)
300 {
301 unsigned long prec;
302
303 CONCHECK_INTEGER (*val);
304 #ifdef HAVE_BIGFLOAT
305 if (INTP (*val))
306 prec = XINT (*val);
307 else
308 {
309 if (!bignum_fits_ulong_p (XBIGNUM_DATA (*val)))
310 args_out_of_range_3 (*val, Qzero, Vbigfloat_max_prec);
311 prec = bignum_to_ulong (XBIGNUM_DATA (*val));
312 }
313 if (prec != 0UL)
314 bigfloat_set_default_prec (prec);
315 #endif
316 return 0;
317 }
318
319
320 /********************************* Floating *********************************/
321 Lisp_Object
322 make_floating (double d)
323 {
324 #ifdef HAVE_BIGFLOAT
325 if (ZEROP (Vdefault_float_precision))
326 #endif
327 return make_float (d);
328 #ifdef HAVE_BIGFLOAT
329 else
330 return make_bigfloat (d, 0UL);
331 #endif
332 }
333
334 DEFUN ("floatingp", Ffloatingp, 1, 1, 0, /*
335 Return t if OBJECT is a floating point number of any kind, nil otherwise.
336 */
337 (object))
338 {
339 return FLOATINGP (object) ? Qt : Qnil;
340 }
341
342
343 /********************************** Reals ***********************************/
344 DEFUN ("realp", Frealp, 1, 1, 0, /*
345 Return t if OBJECT is a real, nil otherwise.
346 */
347 (object))
348 {
349 return REALP (object) ? Qt : Qnil;
350 }
351
352
353 /********************************* Numbers **********************************/
354 DEFUN ("canonicalize-number", Fcanonicalize_number, 1, 1, 0, /*
355 Return the canonical form of NUMBER.
356 */
357 (number))
358 {
359 /* The tests should go in order from larger, more expressive, or more
360 complex types to smaller, less expressive, or simpler types so that a
361 number can cascade all the way down to the simplest type if
362 appropriate. */
363 #ifdef HAVE_RATIO
364 if (RATIOP (number) &&
365 bignum_fits_long_p (XRATIO_DENOMINATOR (number)) &&
366 bignum_to_long (XRATIO_DENOMINATOR (number)) == 1L)
367 number = make_bignum_bg (XRATIO_NUMERATOR (number));
368 #endif
369 #ifdef HAVE_BIGNUM
370 if (BIGNUMP (number) && bignum_fits_int_p (XBIGNUM_DATA (number)))
371 {
372 int n = bignum_to_int (XBIGNUM_DATA (number));
373 if (NUMBER_FITS_IN_AN_EMACS_INT (n))
374 number = make_int (n);
375 }
376 #endif
377 return number;
378 }
379
380 enum number_type
381 get_number_type (Lisp_Object arg)
382 {
383 if (INTP (arg))
384 return FIXNUM_T;
385 #ifdef HAVE_BIGNUM
386 if (BIGNUMP (arg))
387 return BIGNUM_T;
388 #endif
389 #ifdef HAVE_RATIO
390 if (RATIOP (arg))
391 return RATIO_T;
392 #endif
393 if (FLOATP (arg))
394 return FLOAT_T;
395 #ifdef HAVE_BIGFLOAT
396 if (BIGFLOATP (arg))
397 return BIGFLOAT_T;
398 #endif
399 /* Catch unintentional bad uses of this function */
400 abort ();
401 }
402
403 /* Convert NUMBER to type TYPE. If TYPE is BIGFLOAT_T then use the indicated
404 PRECISION; otherwise, PRECISION is ignored. */
405 static Lisp_Object
406 internal_coerce_number (Lisp_Object number, enum number_type type,
407 unsigned long precision)
408 {
409 enum number_type current_type;
410
411 if (CHARP (number))
412 number = make_int (XCHAR (number));
413 else if (MARKERP (number))
414 number = make_int (marker_position (number));
415
416 /* Note that CHECK_NUMBER ensures that NUMBER is a supported type. Hence,
417 we abort() in the #else sections below, because it shouldn't be possible
418 to arrive there. */
419 CHECK_NUMBER (number);
420 current_type = get_number_type (number);
421 switch (current_type)
422 {
423 case FIXNUM_T:
424 switch (type)
425 {
426 case FIXNUM_T:
427 return number;
428 case BIGNUM_T:
429 #ifdef HAVE_BIGNUM
430 return make_bignum (XREALINT (number));
431 #else
432 abort ();
433 #endif /* HAVE_BIGNUM */
434 case RATIO_T:
435 #ifdef HAVE_RATIO
436 return make_ratio (XREALINT (number), 1UL);
437 #else
438 abort ();
439 #endif /* HAVE_RATIO */
440 case FLOAT_T:
441 return make_float (XREALINT (number));
442 case BIGFLOAT_T:
443 #ifdef HAVE_BIGFLOAT
444 return make_bigfloat (XREALINT (number), precision);
445 #else
446 abort ();
447 #endif /* HAVE_BIGFLOAT */
448 }
449 case BIGNUM_T:
450 #ifdef HAVE_BIGNUM
451 switch (type)
452 {
453 case FIXNUM_T:
454 return make_int (bignum_to_long (XBIGNUM_DATA (number)));
455 case BIGNUM_T:
456 return number;
457 case RATIO_T:
458 #ifdef HAVE_RATIO
459 bignum_set_long (scratch_bignum, 1L);
460 return make_ratio_bg (XBIGNUM_DATA (number), scratch_bignum);
461 #else
462 abort ();
463 #endif /* HAVE_RATIO */
464 case FLOAT_T:
465 return make_float (bignum_to_double (XBIGNUM_DATA (number)));
466 case BIGFLOAT_T:
467 #ifdef HAVE_BIGFLOAT
468 {
469 Lisp_Object temp;
470 temp = make_bigfloat (0.0, precision);
471 bigfloat_set_bignum (XBIGFLOAT_DATA (temp), XBIGNUM_DATA (number));
472 return temp;
473 }
474 #else
475 abort ();
476 #endif /* HAVE_BIGFLOAT */
477 }
478 #else
479 abort ();
480 #endif /* HAVE_BIGNUM */
481 case RATIO_T:
482 #ifdef HAVE_RATIO
483 switch (type)
484 {
485 case FIXNUM_T:
486 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
487 XRATIO_DENOMINATOR (number));
488 return make_int (bignum_to_long (scratch_bignum));
489 case BIGNUM_T:
490 bignum_div (scratch_bignum, XRATIO_NUMERATOR (number),
491 XRATIO_DENOMINATOR (number));
492 return make_bignum_bg (scratch_bignum);
493 case RATIO_T:
494 return number;
495 case FLOAT_T:
496 return make_float (ratio_to_double (XRATIO_DATA (number)));
497 case BIGFLOAT_T:
498 #ifdef HAVE_BIGFLOAT
499 {
500 Lisp_Object temp;
501 temp = make_bigfloat (0.0, precision);
502 bigfloat_set_ratio (XBIGFLOAT_DATA (temp), XRATIO_DATA (number));
503 return temp;
504 }
505 #else
506 abort ();
507 #endif /* HAVE_BIGFLOAT */
508 }
509 #else
510 abort ();
511 #endif /* HAVE_RATIO */
512 case FLOAT_T:
513 switch (type)
514 {
515 case FIXNUM_T:
516 return Fround (number);
517 case BIGNUM_T:
518 #ifdef HAVE_BIGNUM
519 bignum_set_double (scratch_bignum, XFLOAT_DATA (number));
520 return make_bignum_bg (scratch_bignum);
521 #else
522 abort ();
523 #endif /* HAVE_BIGNUM */
524 case RATIO_T:
525 #ifdef HAVE_RATIO
526 ratio_set_double (scratch_ratio, XFLOAT_DATA (number));
527 return make_ratio_rt (scratch_ratio);
528 #else
529 abort ();
530 #endif /* HAVE_RATIO */
531 case FLOAT_T:
532 return number;
533 case BIGFLOAT_T:
534 #ifdef HAVE_BIGFLOAT
535 bigfloat_set_prec (scratch_bigfloat, precision);
536 bigfloat_set_double (scratch_bigfloat, XFLOAT_DATA (number));
537 return make_bigfloat_bf (scratch_bigfloat);
538 #else
539 abort ();
540 #endif /* HAVE_BIGFLOAT */
541 }
542 case BIGFLOAT_T:
543 #ifdef HAVE_BIGFLOAT
544 switch (type)
545 {
546 case FIXNUM_T:
547 return make_int (bigfloat_to_long (XBIGFLOAT_DATA (number)));
548 case BIGNUM_T:
549 #ifdef HAVE_BIGNUM
550 bignum_set_bigfloat (scratch_bignum, XBIGFLOAT_DATA (number));
551 return make_bignum_bg (scratch_bignum);
552 #else
553 abort ();
554 #endif /* HAVE_BIGNUM */
555 case RATIO_T:
556 #ifdef HAVE_RATIO
557 ratio_set_bigfloat (scratch_ratio, XBIGFLOAT_DATA (number));
558 return make_ratio_rt (scratch_ratio);
559 #else
560 abort ();
561 #endif
562 case FLOAT_T:
563 return make_float (bigfloat_to_double (XBIGFLOAT_DATA (number)));
564 case BIGFLOAT_T:
565 /* FIXME: Do we need to change the precision? */
566 return number;
567 }
568 #else
569 abort ();
570 #endif /* HAVE_BIGFLOAT */
571 }
572 abort ();
573 }
574
575 /* This function promotes its arguments as necessary to make them both the
576 same type. It destructively modifies its arguments to do so. Characters
577 and markers are ALWAYS converted to integers. */
578 enum number_type
579 promote_args (Lisp_Object *arg1, Lisp_Object *arg2)
580 {
581 enum number_type type1, type2;
582
583 if (CHARP (*arg1))
584 *arg1 = make_int (XCHAR (*arg1));
585 else if (MARKERP (*arg1))
586 *arg1 = make_int (marker_position (*arg1));
587 if (CHARP (*arg2))
588 *arg2 = make_int (XCHAR (*arg2));
589 else if (MARKERP (*arg2))
590 *arg2 = make_int (marker_position (*arg2));
591
592 CHECK_NUMBER (*arg1);
593 CHECK_NUMBER (*arg2);
594
595 type1 = get_number_type (*arg1);
596 type2 = get_number_type (*arg2);
597
598 if (type1 < type2)
599 {
600 *arg1 = internal_coerce_number (*arg1, type2,
601 #ifdef HAVE_BIGFLOAT
602 type2 == BIGFLOAT_T
603 ? XBIGFLOAT_GET_PREC (*arg2) :
604 #endif
605 0UL);
606 return type2;
607 }
608
609 if (type2 < type1)
610 {
611 *arg2 = internal_coerce_number (*arg2, type1,
612 #ifdef HAVE_BIGFLOAT
613 type1 == BIGFLOAT_T
614 ? XBIGFLOAT_GET_PREC (*arg1) :
615 #endif
616 0UL);
617 return type1;
618 }
619
620 /* No conversion necessary */
621 return type1;
622 }
623
624 DEFUN ("coerce-number", Fcoerce_number, 2, 3, 0, /*
625 Convert NUMBER to the indicated type, possibly losing information.
626 Do not call this function. Use `coerce' instead.
627
628 TYPE is one of the symbols 'fixnum, 'integer, 'ratio, 'float, or 'bigfloat.
629 Not all of these types may be supported.
630
631 PRECISION is the number of bits of precision to use when converting to
632 bigfloat; it is ignored otherwise. If nil, the default precision is used.
633
634 Note that some conversions lose information. No error is signaled in such
635 cases; the information is silently lost.
636 */
637 (number, type, precision))
638 {
639 CHECK_SYMBOL (type);
640 if (EQ (type, Qfixnum))
641 return internal_coerce_number (number, FIXNUM_T, 0UL);
642 else if (EQ (type, Qinteger))
643 {
644 /* If bignums are available, we always convert to one first, then
645 downgrade to a fixnum if possible. */
646 #ifdef HAVE_BIGNUM
647 return Fcanonicalize_number
648 (internal_coerce_number (number, BIGNUM_T, 0UL));
649 #else
650 return internal_coerce_number (number, FIXNUM_T, 0UL);
651 #endif
652 }
653 #ifdef HAVE_RATIO
654 else if (EQ (type, Qratio))
655 return internal_coerce_number (number, RATIO_T, 0UL);
656 #endif
657 else if (EQ (type, Qfloat))
658 return internal_coerce_number (number, FLOAT_T, 0UL);
659 #ifdef HAVE_BIGFLOAT
660 else if (EQ (type, Qbigfloat))
661 {
662 unsigned long prec;
663
664 if (NILP (precision))
665 prec = bigfloat_get_default_prec ();
666 else
667 {
668 CHECK_INTEGER (precision);
669 #ifdef HAVE_BIGNUM
670 if (INTP (precision))
671 #endif /* HAVE_BIGNUM */
672 prec = (unsigned long) XREALINT (precision);
673 #ifdef HAVE_BIGNUM
674 else
675 {
676 if (!bignum_fits_ulong_p (XBIGNUM_DATA (precision)))
677 args_out_of_range (precision, Vbigfloat_max_prec);
678 prec = bignum_to_ulong (XBIGNUM_DATA (precision));
679 }
680 #endif /* HAVE_BIGNUM */
681 }
682 return internal_coerce_number (number, BIGFLOAT_T, prec);
683 }
684 #endif /* HAVE_BIGFLOAT */
685
686 Fsignal (Qunsupported_type, type);
687 /* NOTREACHED */
688 return Qnil;
689 }
690
691
692 void
693 syms_of_number (void)
694 {
695 #ifdef HAVE_BIGNUM
696 INIT_LRECORD_IMPLEMENTATION (bignum);
697 #endif
698 #ifdef HAVE_RATIO
699 INIT_LRECORD_IMPLEMENTATION (ratio);
700 #endif
701 #ifdef HAVE_BIGFLOAT
702 INIT_LRECORD_IMPLEMENTATION (bigfloat);
703 #endif
704
705 /* Type predicates */
706 DEFSYMBOL (Qintegerp);
707 DEFSYMBOL (Qrationalp);
708 DEFSYMBOL (Qfloatingp);
709 DEFSYMBOL (Qrealp);
710 DEFSYMBOL (Qnumberp);
711 #ifndef HAVE_BIGNUM
712 DEFSYMBOL (Qbignump);
713 #endif
714 #ifndef HAVE_RATIO
715 DEFSYMBOL (Qratiop);
716 #endif
717 #ifndef HAVE_BIGFLOAT
718 DEFSYMBOL (Qbigfloatp);
719 #endif
720
721 /* Functions */
722 DEFSUBR (Fbignump);
723 DEFSUBR (Fintegerp);
724 DEFSUBR (Fevenp);
725 DEFSUBR (Foddp);
726 DEFSUBR (Fratiop);
727 DEFSUBR (Frationalp);
728 DEFSUBR (Fnumerator);
729 DEFSUBR (Fdenominator);
730 DEFSUBR (Fbigfloatp);
731 DEFSUBR (Frealp);
732 DEFSUBR (Fcanonicalize_number);
733 DEFSUBR (Fcoerce_number);
734
735 /* Errors */
736 DEFERROR_STANDARD (Qunsupported_type, Qwrong_type_argument);
737 }
738
739 void
740 vars_of_number (void)
741 {
742 /* This variable is a Lisp variable rather than a number variable so that we
743 can put bignums in it. */
744 DEFVAR_LISP_MAGIC ("default-float-precision", &Vdefault_float_precision, /*
745 The default floating-point precision for newly created floating point values.
746 This should be 0 for the precision of the machine-supported floating point
747 type (the C double type), or an unsigned integer no greater than
748 bigfloat-max-prec (currently the size of a C unsigned long).
749 */ default_float_precision_changed);
750 Vdefault_float_precision = make_int (0);
751
752 DEFVAR_CONST_LISP ("bigfloat-max-prec", &Vbigfloat_max_prec /*
753 The maximum number of bits of precision a bigfloat can have.
754 This is currently the value of ULONG_MAX on the target machine.
755 */);
756
757 DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /*
758 The fixnum closest in value to negative infinity.
759 */);
760 Vmost_negative_fixnum = EMACS_INT_MIN;
761
762 DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /*
763 The fixnum closest in value to positive infinity.
764 */);
765 Vmost_positive_fixnum = EMACS_INT_MAX;
766
767 Fprovide (intern ("number-types"));
768 #ifdef HAVE_BIGNUM
769 Fprovide (intern ("bignum"));
770 #endif
771 #ifdef HAVE_RATIO
772 Fprovide (intern ("ratio"));
773 #endif
774 #ifdef HAVE_BIGFLOAT
775 Fprovide (intern ("bigfloat"));
776 #endif
777 }
778
779 void
780 init_number (void)
781 {
782 if (!number_initialized)
783 {
784 number_initialized = 1;
785
786 #ifdef WITH_GMP
787 init_number_gmp ();
788 #endif
789 #ifdef WITH_MP
790 init_number_mp ();
791 #endif
792
793 #if defined(BIGNUM) && defined(BIGFLOAT)
794 Vbigfloat_max_prec = make_bignum (0L);
795 bignum_set_ulong (XBIGNUM_DATA (Vbigfloat_max_prec), ULONG_MAX);
796 #endif
797
798 #ifdef HAVE_BIGNUM
799 bignum_init (scratch_bignum);
800 bignum_init (scratch_bignum2);
801 #endif
802
803 #ifdef HAVE_RATIO
804 ratio_init (scratch_ratio);
805 #endif
806
807 #ifdef HAVE_BIGFLOAT
808 bigfloat_init (scratch_bigfloat);
809 bigfloat_init (scratch_bigfloat2);
810 #endif
811 }
812 }