annotate src/number.h @ 5864:750fab17b299

Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits. src/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * lread.c (read_atom): Use the new calling convention for parse_integer(). * lisp.h: Change the declaration of parse_integer (). * number.h (bignum_set_emacs_int, make_bignum_emacs_uint): New #defines, used in data.c. * lread.c (read_integer): Ditto. * lread.c (read1): Ditto. * data.c (find_highest_value): New. * data.c (fill_ichar_array): New. * data.c (build_fixnum_to_char_map): New. * data.c (Fset_digit_fixnum_map): New. * data.c (Fdigit_char_p): Moved from cl-extra.el. * data.c (Fdigit_char): Moved from cl-extra.el. * data.c (parse_integer): Moved from lread.c. * data.c (Fparse_integer): Made available to Lisp. * data.c (syms_of_data): Make the new subrs available. * data.c (vars_of_data): Make the new vars available. Expose parse_integer to Lisp, make it follow the Common Lisp API (with some extensions, to allow us to support non ASCII digit characters). lisp/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (digit-char-p): Moved to data.c. * cl-extra.el (digit-char): Moved to data.c. tests/ChangeLog addition: 2015-02-25 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el: parse_integer(), used in #'read, now signals invalid-argument rather than invalid-read-syntax, check for that. * automated/lisp-tests.el: Check #'parse-integer now it's available to Lisp, check #'digit-char, #'digit-char-p and the congruence in behaviour, check the XEmacs-specific RADIX-TABLE argument behaviour.
author Aidan Kehoe <kehoea@parhasard.net>
date Wed, 25 Feb 2015 11:47:12 +0000
parents 4d7032d36975
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
1 /* Definitions of numeric types for XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
2 Copyright (C) 2004 Jerry James.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
3
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
4 This file is part of XEmacs.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
5
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5234
diff changeset
6 XEmacs is free software: you can redistribute it and/or modify it
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
7 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: 5234
diff changeset
8 Free Software Foundation, either version 3 of the License, or (at your
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5234
diff changeset
9 option) any later version.
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
10
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
14 for more details.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
15
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
16 You should have received a copy of the GNU General Public License
5405
2aa9cd456ae7 Move src/ to GPLv3.
Mike Sperber <sperber@deinprogramm.de>
parents: 5234
diff changeset
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
18
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
19 /* Synched up with: Not in FSF. */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
20
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
21 #ifndef INCLUDED_number_h_
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
22 #define INCLUDED_number_h_
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
23
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
24 /* The following types are always defined in the same manner:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
25 fixnum = whatever fits in the Lisp_Object type
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
26 integer = union (fixnum, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
27 rational = union (integer, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
28 float = C double
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
29 floating = union(float, bigfloat) Anybody got a better name?
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
30 real = union (rational, floating)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
31 number = real (should be union(real, complex) but no complex yet)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
32
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
33 It is up to the library-specific code to define the remaining types,
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
34 namely: bignum, ratio, and bigfloat. Not all of these types may be
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
35 available. The top-level configure script should define the symbols
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
36 HAVE_BIGNUM, HAVE_RATIO, and HAVE_BIGFLOAT to indicate which it provides.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
37 If some type is not defined by the library, this is what happens:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
38
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
39 - bignum: bignump(x) is false for all x; any attempt to create a bignum
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
40 causes an error to be raised.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
41
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
42 - ratio: we define our own structure consisting of two Lisp_Objects, which
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
43 are presumed to be integers (i.e., either fixnums or bignums). We do our
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
44 own GCD calculation, which is bound to be slow, to keep the ratios
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
45 reduced to canonical form. (FIXME: Not yet implemented.)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
46
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
47 - bigfloat: bigfloat(x) is false for all x; any attempt to create a
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
48 bigfloat causes an error to be raised.
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
49
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
50 We (provide) the following symbols, so that Lisp code has some hope of
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
51 using this correctly:
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
52
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
53 - (provide 'bignum) if HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
54 - (provde 'ratio) if HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
55 - (provide 'bigfloat) if HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
56 */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
57
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
58 /* Load the library definitions */
5739
a2912073be85 Support bignums with MPIR. Add documentation on the bignum, ratio,
Jerry James <james@xemacs.org>
parents: 5736
diff changeset
59 #if defined(WITH_GMP) || defined(WITH_MPIR)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
60 #include "number-gmp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
61 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
62 #ifdef WITH_MP
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
63 #include "number-mp.h"
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
64 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
65
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
66
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
67 /********************************* Bignums **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
68 #ifdef HAVE_BIGNUM
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
69
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
70 struct Lisp_Bignum
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
71 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
72 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
73 bignum data;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
74 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
75 typedef struct Lisp_Bignum Lisp_Bignum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
76
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
77 DECLARE_LISP_OBJECT (bignum, Lisp_Bignum);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
78 #define XBIGNUM(x) XRECORD (x, bignum, Lisp_Bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
79 #define wrap_bignum(p) wrap_record (p, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
80 #define BIGNUMP(x) RECORDP (x, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
81 #define CHECK_BIGNUM(x) CHECK_RECORD (x, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
82 #define CONCHECK_BIGNUM(x) CONCHECK_RECORD (x, bignum)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
83
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
84 #define bignum_data(b) (b)->data
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
85 #define XBIGNUM_DATA(x) bignum_data (XBIGNUM (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
86
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
87 #define BIGNUM_ARITH_RETURN(b,op) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
88 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
89 Lisp_Object retval = make_bignum (0); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
90 bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
91 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
92 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
93
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
94 #define BIGNUM_ARITH_RETURN1(b,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
95 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
96 Lisp_Object retval = make_bignum(0); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
97 bignum_##op (XBIGNUM_DATA (retval), XBIGNUM_DATA (b), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
98 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
99 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
100
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
101 #if SIZEOF_EMACS_INT == SIZEOF_LONG
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
102 # define bignum_fits_emacs_int_p(b) bignum_fits_long_p(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
103 # define bignum_to_emacs_int(b) bignum_to_long(b)
5864
750fab17b299 Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5827
diff changeset
104 # define bignum_set_emacs_int bignum_set_long
750fab17b299 Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5827
diff changeset
105 # define make_bignum_emacs_uint(b) make_bignum_un(b)
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
106 #elif SIZEOF_EMACS_INT == SIZEOF_INT
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
107 # define bignum_fits_emacs_int_p(b) bignum_fits_int_p(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
108 # define bignum_to_emacs_int(b) bignum_to_int(b)
5864
750fab17b299 Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5827
diff changeset
109 # define bignum_set_emacs_int bignum_set_long
750fab17b299 Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5827
diff changeset
110 # define make_bignum_emacs_uint(b) make_bignum_un(b)
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
111 #else
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
112 # define bignum_fits_emacs_int_p(b) bignum_fits_llong_p(b)
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
113 # define bignum_to_emacs_int(b) bignum_to_llong(b)
5864
750fab17b299 Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5827
diff changeset
114 # define bignum_set_emacs_int bignum_set_llong
750fab17b299 Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5827
diff changeset
115 # define make_bignum_emacs_uint(b) make_bignum_ull(b)
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
116 #endif
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
117
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
118 extern Lisp_Object make_bignum (long);
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
119 extern Lisp_Object make_bignum_un (unsigned long);
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
120 extern Lisp_Object make_bignum_ll (long long);
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
121 extern Lisp_Object make_bignum_ull (unsigned long long);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
122 extern Lisp_Object make_bignum_bg (bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
123 extern bignum scratch_bignum, scratch_bignum2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
124
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
125 #else /* !HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
126
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
127 #define BIGNUMP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
128 #define CHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
129 #define CONCHECK_BIGNUM(x) dead_wrong_type_argument (Qbignump, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
130 typedef void bignum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
131 #define make_bignum(l) This XEmacs does not support bignums
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
132 #define make_bignum_ll(l) This XEmacs does not support bignums
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
133 #define make_bignum_bg(b) This XEmacs does not support bignums
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
134
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
135 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
136
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
137 extern Lisp_Object Qbignump;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
138 EXFUN (Fbignump, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
139
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
140
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
141 /********************************* Integers *********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
142 /* Qintegerp in lisp.h */
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
143 #define INTEGERP(x) (FIXNUMP(x) || BIGNUMP(x))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
144 #define CHECK_INTEGER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
145 if (!INTEGERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
146 dead_wrong_type_argument (Qintegerp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
147 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
148 #define CONCHECK_INTEGER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
149 if (!INTEGERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
150 x = wrong_type_argument (Qintegerp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
151 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
152
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
153 #ifdef HAVE_BIGNUM
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
154 #define make_integer(x) \
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
155 (NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) \
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
156 : (sizeof (x) > SIZEOF_LONG ? make_bignum_ll (x) : make_bignum (x)))
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
157 #define make_unsigned_integer(x) \
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
158 (UNSIGNED_NUMBER_FITS_IN_A_FIXNUM (x) ? make_fixnum (x) \
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
159 : (sizeof (x) > SIZEOF_LONG ? make_bignum_ull (x) : make_bignum_un (x)))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
160 #else
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
161 #define make_integer(x) make_fixnum (x)
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
162 #define make_unsigned_integer(x) make_fixnum ((EMACS_INT) x)
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
163 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
164
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
165 extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
166 EXFUN (Fintegerp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
167 EXFUN (Fevenp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
168 EXFUN (Foddp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
169
5307
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
170 /* There are varying mathematical definitions of what a natural number is,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
171 differing about whether 0 is inside or outside the set. The Oxford
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
172 English Dictionary, second edition, does say that they are whole numbers,
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
173 not fractional, but it doesn't give a bound, and gives a quotation
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
174 talking about the natural numbers from 1 to 100. Since 100 is certainly
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
175 *not* the upper bound on natural numbers, we can't take 1 as the lower
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
176 bound from that example. The Real Academia Española's dictionary, not of
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
177 English but certainly sharing the western academic tradition, says of
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
178 "número natural":
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
179
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
180 1. m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3...
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
181
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
182 that is, "each of the elements of the succession 0, 1, 2, 3 ...". The
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
183 various Wikipedia articles in languages I can read agree. It's
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
184 reasonable to call this macro and the associated Lisp function
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
185 NATNUMP. */
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
186
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
187 #ifdef HAVE_BIGNUM
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
188 #define NATNUMP(x) ((FIXNUMP (x) && XFIXNUM (x) >= 0) || \
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
189 (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
5307
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
190 #else
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
191 #define NATNUMP(x) (FIXNUMP (x) && XFIXNUM (x) >= 0)
5307
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
192 #endif
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
193
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
194 #define CHECK_NATNUM(x) do { \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
195 if (!NATNUMP (x)) \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
196 dead_wrong_type_argument (Qnatnump, x); \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
197 } while (0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
198
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
199 #define CONCHECK_NATNUM(x) do { \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
200 if (!NATNUMP (x)) \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
201 x = wrong_type_argument (Qnatnump, x); \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
202 } while (0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
203
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
204
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
205 /********************************** Ratios **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
206 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
207
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
208 struct Lisp_Ratio
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
209 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
210 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
211 ratio data;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
212 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
213 typedef struct Lisp_Ratio Lisp_Ratio;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
214
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
215 DECLARE_LISP_OBJECT (ratio, Lisp_Ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
216 #define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
217 #define wrap_ratio(p) wrap_record (p, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
218 #define RATIOP(x) RECORDP (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
219 #define CHECK_RATIO(x) CHECK_RECORD (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
220 #define CONCHECK_RATIO(x) CONCHECK_RECORD (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
221
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
222 #define ratio_data(r) (r)->data
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
223
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
224 #define XRATIO_DATA(r) ratio_data (XRATIO (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
225 #define XRATIO_NUMERATOR(r) ratio_numerator (XRATIO_DATA (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
226 #define XRATIO_DENOMINATOR(r) ratio_denominator (XRATIO_DATA (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
227
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
228 #define RATIO_ARITH_RETURN(r,op) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
229 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
230 Lisp_Object retval = make_ratio (0L, 1UL); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
231 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
232 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
233 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
234
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
235 #define RATIO_ARITH_RETURN1(r,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
236 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
237 Lisp_Object retval = make_ratio (0L, 1UL); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
238 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
239 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
240 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
241
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
242 extern Lisp_Object make_ratio (long, unsigned long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
243 extern Lisp_Object make_ratio_bg (bignum, bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
244 extern Lisp_Object make_ratio_rt (ratio);
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
245 extern ratio scratch_ratio, scratch_ratio2;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
246
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
247 #else /* !HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
248
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
249 #define RATIOP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
250 #define CHECK_RATIO(x) dead_wrong_type_argument (Qratiop, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
251 #define CONCHECK_RATIO(x) dead_wrong_type_argument (Qratiop, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
252 typedef void ratio;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
253 #define make_ratio(n,d) This XEmacs does not support ratios
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
254 #define make_ratio_bg(n,d) This XEmacs does not support ratios
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
255
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
256 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
257
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
258 extern Lisp_Object Qratiop;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
259 EXFUN (Fratiop, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
260
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
261
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
262 /******************************** Rationals *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
263 extern Lisp_Object Qrationalp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
264
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
265 #define RATIONALP(x) (INTEGERP(x) || RATIOP(x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
266 #define CHECK_RATIONAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
267 if (!RATIONALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
268 dead_wrong_type_argument (Qrationalp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
269 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
270 #define CONCHECK_RATIONAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
271 if (!RATIONALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
272 x = wrong_type_argument (Qrationalp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
273 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
274
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
275 EXFUN (Frationalp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
276 EXFUN (Fnumerator, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
277 EXFUN (Fdenominator, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
278
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
279
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
280 /******************************** Bigfloats *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
281 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
282 struct Lisp_Bigfloat
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
283 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
284 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
285 bigfloat bf;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
286 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
287 typedef struct Lisp_Bigfloat Lisp_Bigfloat;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
288
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
289 DECLARE_LISP_OBJECT (bigfloat, Lisp_Bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
290 #define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
291 #define wrap_bigfloat(p) wrap_record (p, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
292 #define BIGFLOATP(x) RECORDP (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
293 #define CHECK_BIGFLOAT(x) CHECK_RECORD (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
294 #define CONCHECK_BIGFLOAT(x) CONCHECK_RECORD (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
295
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
296 #define bigfloat_data(f) ((f)->bf)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
297 #define XBIGFLOAT_DATA(x) bigfloat_data (XBIGFLOAT (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
298 #define XBIGFLOAT_GET_PREC(x) bigfloat_get_prec (XBIGFLOAT_DATA (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
299 #define XBIGFLOAT_SET_PREC(x,p) bigfloat_set_prec (XBIGFLOAT_DATA (x), p)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
300
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
301 #define BIGFLOAT_ARITH_RETURN(f,op) do \
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
302 { \
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
303 Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
304 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
305 return retval; \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
306 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
307
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
308 #define BIGFLOAT_ARITH_RETURN1(f,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
309 { \
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
310 Lisp_Object retval = make_bigfloat (0.0, bigfloat_get_default_prec()); \
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
311 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
312 return retval; \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
313 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
314
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
315 extern Lisp_Object make_bigfloat (double, unsigned long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
316 extern Lisp_Object make_bigfloat_bf (bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
317 extern Lisp_Object Vdefault_float_precision;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
318 extern bigfloat scratch_bigfloat, scratch_bigfloat2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
319
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
320 #else /* !HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
321
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
322 #define BIGFLOATP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
323 #define CHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
324 #define CONCHECK_BIGFLOAT(x) dead_wrong_type_argument (Qbigfloatp, x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
325 typedef void bigfloat;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
326 #define make_bigfloat(f) This XEmacs does not support bigfloats
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
327 #define make_bigfloat_bf(f) This XEmacs does not support bigfloast
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
328
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
329 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
330
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
331 extern Lisp_Object Qbigfloatp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
332 EXFUN (Fbigfloatp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
333
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
334 /********************************* Floating *********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
335 extern Lisp_Object Qfloatingp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
336 extern Lisp_Object Qread_default_float_format, Vread_default_float_format;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
337
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
338 #define FLOATINGP(x) (FLOATP (x) || BIGFLOATP (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
339 #define CHECK_FLOATING(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
340 if (!FLOATINGP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
341 dead_wrong_type_argument (Qfloatingp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
342 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
343 #define CONCHECK_FLOATING(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
344 if (!FLOATINGP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
345 x = wrong_type_argument (Qfloating, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
346 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
347
2057
471242c84954 [xemacs-hg @ 2004-05-03 15:19:10 by james]
james
parents: 1995
diff changeset
348 extern Lisp_Object make_floating (double);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
349 EXFUN (Ffloatp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
350
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
351
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
352 /********************************** Reals ***********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
353 extern Lisp_Object Qrealp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
354
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
355 #define REALP(x) (RATIONALP (x) || FLOATINGP (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
356 #define CHECK_REAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
357 if (!REALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
358 dead_wrong_type_argument (Qrealp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
359 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
360 #define CONCHECK_REAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
361 if (!REALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
362 x = wrong_type_argument (Qrealp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
363 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
364
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
365 EXFUN (Frealp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
366
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
367
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
368 /********************************* Numbers **********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
369 /* Qnumberp in lisp.h */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
370 #define NUMBERP(x) REALP (x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
371 #define CHECK_NUMBER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
372 if (!NUMBERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
373 dead_wrong_type_argument (Qnumberp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
374 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
375 #define CONCHECK_NUMBER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
376 if (!NUMBERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
377 x = wrong_type_argument (Qnumberp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
378 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
379
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
380 EXFUN (Fcanonicalize_number, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
381
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
382 #define NUMBER_TYPES(prefix) prefix##FIXNUM_T, prefix##BIGNUM_T, \
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
383 prefix##RATIO_T, prefix##FLOAT_T, prefix##BIGFLOAT_T
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
384
5827
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
385 #ifdef _MSC_VER
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
386 /* Disable warning 4003:
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
387 * warning C4003: not enough actual parameters for macro 'NUMBER_TYPES'
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
388 */
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
389 #pragma warning( push )
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
390 #pragma warning( disable : 4003)
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
391 #endif
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
392
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
393 enum number_type { NUMBER_TYPES() };
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
394 enum lazy_number_type { NUMBER_TYPES(LAZY_), LAZY_MARKER_T };
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
395
5827
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
396 #ifdef _MSC_VER
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
397 #pragma warning( pop )
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
398 #endif
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
399
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
400 #undef NUMBER_TYPES
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
401
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
402 extern enum number_type get_number_type (Lisp_Object);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
403 extern enum number_type promote_args (Lisp_Object *, Lisp_Object *);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
404
5771
72a9467f93fc Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5769
diff changeset
405 #ifdef WITH_NUMBER_TYPES
72a9467f93fc Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5769
diff changeset
406
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
407 /* promote_args() *always* converts a marker argument to a fixnum.
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
408
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
409 Unfortunately, for a marker with byte position N, getting the (character)
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
410 marker position is O(N). Getting the character position isn't necessary
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
411 for bytecode_arithcompare() if two markers being compared are in the same
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
412 buffer, comparing the byte position is enough.
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
413
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
414 Similarly, min and max don't necessarily need to have their arguments
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
415 converted from markers, though we have always promised up to this point
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
416 that the result is a fixnum rather than a marker, and that's what we're
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
417 continuing to do. */
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
418
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
419 DECLARE_INLINE_HEADER (
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
420 enum lazy_number_type
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
421 promote_args_lazy (Lisp_Object *obj1, Lisp_Object *obj2))
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
422 {
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
423 if (MARKERP (*obj1) && MARKERP (*obj2) &&
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
424 XMARKER (*obj1)->buffer == XMARKER (*obj2)->buffer)
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
425 {
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
426 return LAZY_MARKER_T;
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
427 }
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
428
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
429 return (enum lazy_number_type) promote_args (obj1, obj2);
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
430 }
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
431
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
432 DECLARE_INLINE_HEADER (
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
433 int
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
434 non_fixnum_number_p (Lisp_Object object))
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
435 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
436 if (LRECORDP (object))
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
437 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
438 switch (XRECORD_LHEADER (object)->type)
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
439 {
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
440 case lrecord_type_float:
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
441 #ifdef HAVE_BIGNUM
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
442 case lrecord_type_bignum:
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
443 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
444 #ifdef HAVE_RATIO
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
445 case lrecord_type_ratio:
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
446 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
447 #ifdef HAVE_BIGFLOAT
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
448 case lrecord_type_bigfloat:
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
449 #endif
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
450 return 1;
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
451 }
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
452 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
453 return 0;
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
454 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
455 #define NON_FIXNUM_NUMBER_P(X) non_fixnum_number_p (X)
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
456
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
457 #else
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
458 #define NON_FIXNUM_NUMBER_P FLOATP
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
459 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
460
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
461
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
462 #endif /* INCLUDED_number_h_ */