annotate src/number.h @ 5827:4d7032d36975

Allow building --without-tls on the Windows native platform
author Vin Shelton <acs@xemacs.org>
date Mon, 10 Nov 2014 13:43:46 -0500
parents 72a9467f93fc
children 750fab17b299 574f0cded429
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)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
104 #elif SIZEOF_EMACS_INT == SIZEOF_INT
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
105 # 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
106 # define bignum_to_emacs_int(b) bignum_to_int(b)
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
107 #else
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
108 # 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
109 # define bignum_to_emacs_int(b) bignum_to_llong(b)
3391
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
110 #endif
639cdee384e4 [xemacs-hg @ 2006-05-10 15:03:35 by james]
james
parents: 2092
diff changeset
111
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
112 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
113 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
114 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
115 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
116 extern Lisp_Object make_bignum_bg (bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
117 extern bignum scratch_bignum, scratch_bignum2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
118
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
119 #else /* !HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
120
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
121 #define BIGNUMP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
122 #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
123 #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
124 typedef void bignum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
125 #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
126 #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
127 #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
128
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
129 #endif /* HAVE_BIGNUM */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
130
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
131 extern Lisp_Object Qbignump;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
132 EXFUN (Fbignump, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
133
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
134
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
135 /********************************* Integers *********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
136 /* Qintegerp in lisp.h */
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
137 #define INTEGERP(x) (FIXNUMP(x) || BIGNUMP(x))
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
138 #define CHECK_INTEGER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
139 if (!INTEGERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
140 dead_wrong_type_argument (Qintegerp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
141 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
142 #define CONCHECK_INTEGER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
143 if (!INTEGERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
144 x = wrong_type_argument (Qintegerp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
145 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
146
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
147 #ifdef HAVE_BIGNUM
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
148 #define make_integer(x) \
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
149 (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
150 : (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
151 #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
152 (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
153 : (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
154 #else
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
155 #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
156 #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
157 #endif
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
158
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
159 extern Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
160 EXFUN (Fintegerp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
161 EXFUN (Fevenp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
162 EXFUN (Foddp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
163
5307
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
164 /* 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
165 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
166 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
167 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
168 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
169 *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
170 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
171 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
172 "número natural":
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
173
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
174 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
175
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
176 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
177 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
178 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
179 NATNUMP. */
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
180
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
181 #ifdef HAVE_BIGNUM
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
182 #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
183 (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
184 #else
5581
56144c8593a8 Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5438
diff changeset
185 #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
186 #endif
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
187
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
188 #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
189 if (!NATNUMP (x)) \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
190 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
191 } while (0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
192
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
193 #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
194 if (!NATNUMP (x)) \
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
195 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
196 } while (0)
c096d8051f89 Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5286
diff changeset
197
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
198
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
199 /********************************** Ratios **********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
200 #ifdef HAVE_RATIO
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
201
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
202 struct Lisp_Ratio
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
203 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
204 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
205 ratio data;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
206 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
207 typedef struct Lisp_Ratio Lisp_Ratio;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
208
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
209 DECLARE_LISP_OBJECT (ratio, Lisp_Ratio);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
210 #define XRATIO(x) XRECORD (x, ratio, Lisp_Ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
211 #define wrap_ratio(p) wrap_record (p, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
212 #define RATIOP(x) RECORDP (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
213 #define CHECK_RATIO(x) CHECK_RECORD (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
214 #define CONCHECK_RATIO(x) CONCHECK_RECORD (x, ratio)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
215
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
216 #define ratio_data(r) (r)->data
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
217
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
218 #define XRATIO_DATA(r) ratio_data (XRATIO (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
219 #define XRATIO_NUMERATOR(r) ratio_numerator (XRATIO_DATA (r))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
220 #define XRATIO_DENOMINATOR(r) ratio_denominator (XRATIO_DATA (r))
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_ARITH_RETURN(r,op) do \
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 Lisp_Object retval = make_ratio (0L, 1UL); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
225 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
226 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
227 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
228
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
229 #define RATIO_ARITH_RETURN1(r,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
230 { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
231 Lisp_Object retval = make_ratio (0L, 1UL); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
232 ratio_##op (XRATIO_DATA (retval), XRATIO_DATA (r), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
233 return Fcanonicalize_number (retval); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
234 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
235
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
236 extern Lisp_Object make_ratio (long, unsigned long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
237 extern Lisp_Object make_ratio_bg (bignum, bignum);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
238 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
239 extern ratio scratch_ratio, scratch_ratio2;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
240
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
241 #else /* !HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
242
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
243 #define RATIOP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
244 #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
245 #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
246 typedef void ratio;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
247 #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
248 #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
249
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
250 #endif /* HAVE_RATIO */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
251
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
252 extern Lisp_Object Qratiop;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
253 EXFUN (Fratiop, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
254
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
255
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
256 /******************************** Rationals *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
257 extern Lisp_Object Qrationalp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
258
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
259 #define RATIONALP(x) (INTEGERP(x) || RATIOP(x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
260 #define CHECK_RATIONAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
261 if (!RATIONALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
262 dead_wrong_type_argument (Qrationalp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
263 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
264 #define CONCHECK_RATIONAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
265 if (!RATIONALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
266 x = wrong_type_argument (Qrationalp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
267 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
268
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
269 EXFUN (Frationalp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
270 EXFUN (Fnumerator, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
271 EXFUN (Fdenominator, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
272
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
273
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
274 /******************************** Bigfloats *********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
275 #ifdef HAVE_BIGFLOAT
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
276 struct Lisp_Bigfloat
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
277 {
5120
d1247f3cc363 latest work on lisp-object workspace;
Ben Wing <ben@xemacs.org>
parents: 5118
diff changeset
278 FROB_BLOCK_LISP_OBJECT_HEADER lheader;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
279 bigfloat bf;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
280 };
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
281 typedef struct Lisp_Bigfloat Lisp_Bigfloat;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
282
5118
e0db3c197671 merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
parents: 4678
diff changeset
283 DECLARE_LISP_OBJECT (bigfloat, Lisp_Bigfloat);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
284 #define XBIGFLOAT(x) XRECORD (x, bigfloat, Lisp_Bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
285 #define wrap_bigfloat(p) wrap_record (p, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
286 #define BIGFLOATP(x) RECORDP (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
287 #define CHECK_BIGFLOAT(x) CHECK_RECORD (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
288 #define CONCHECK_BIGFLOAT(x) CONCHECK_RECORD (x, bigfloat)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
289
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
290 #define bigfloat_data(f) ((f)->bf)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
291 #define XBIGFLOAT_DATA(x) bigfloat_data (XBIGFLOAT (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
292 #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
293 #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
294
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
295 #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
296 { \
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
297 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
298 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f)); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
299 return retval; \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
300 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
301
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
302 #define BIGFLOAT_ARITH_RETURN1(f,op,arg) do \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
303 { \
4678
b5e1d4f6b66f Make #'floor, #'ceiling, #'round, #'truncate conform to Common Lisp.
Aidan Kehoe <kehoea@parhasard.net>
parents: 3391
diff changeset
304 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
305 bigfloat_##op (XBIGFLOAT_DATA (retval), XBIGFLOAT_DATA (f), arg); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
306 return retval; \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
307 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
308
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
309 extern Lisp_Object make_bigfloat (double, unsigned long);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
310 extern Lisp_Object make_bigfloat_bf (bigfloat);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
311 extern Lisp_Object Vdefault_float_precision;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
312 extern bigfloat scratch_bigfloat, scratch_bigfloat2;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
313
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
314 #else /* !HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
315
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
316 #define BIGFLOATP(x) 0
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
317 #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
318 #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
319 typedef void bigfloat;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
320 #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
321 #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
322
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
323 #endif /* HAVE_BIGFLOAT */
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
324
2092
f557693c61de [xemacs-hg @ 2004-05-21 20:56:26 by james]
james
parents: 2057
diff changeset
325 extern Lisp_Object Qbigfloatp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
326 EXFUN (Fbigfloatp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
327
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
328 /********************************* Floating *********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
329 extern Lisp_Object Qfloatingp;
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
330 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
331
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
332 #define FLOATINGP(x) (FLOATP (x) || BIGFLOATP (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
333 #define CHECK_FLOATING(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
334 if (!FLOATINGP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
335 dead_wrong_type_argument (Qfloatingp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
336 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
337 #define CONCHECK_FLOATING(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
338 if (!FLOATINGP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
339 x = wrong_type_argument (Qfloating, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
340 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
341
2057
471242c84954 [xemacs-hg @ 2004-05-03 15:19:10 by james]
james
parents: 1995
diff changeset
342 extern Lisp_Object make_floating (double);
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
343 EXFUN (Ffloatp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
344
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
345
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
346 /********************************** Reals ***********************************/
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
347 extern Lisp_Object Qrealp;
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
348
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
349 #define REALP(x) (RATIONALP (x) || FLOATINGP (x))
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
350 #define CHECK_REAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
351 if (!REALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
352 dead_wrong_type_argument (Qrealp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
353 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
354 #define CONCHECK_REAL(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
355 if (!REALP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
356 x = wrong_type_argument (Qrealp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
357 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
358
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
359 EXFUN (Frealp, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
360
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
361
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
362 /********************************* Numbers **********************************/
4932
8b63e21b0436 fix compile issues with gcc 4
Ben Wing <ben@xemacs.org>
parents: 4802
diff changeset
363 /* Qnumberp in lisp.h */
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
364 #define NUMBERP(x) REALP (x)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
365 #define CHECK_NUMBER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
366 if (!NUMBERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
367 dead_wrong_type_argument (Qnumberp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
368 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
369 #define CONCHECK_NUMBER(x) do { \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
370 if (!NUMBERP (x)) \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
371 x = wrong_type_argument (Qnumberp, x); \
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
372 } while (0)
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
373
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
374 EXFUN (Fcanonicalize_number, 1);
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
375
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
376 #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
377 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
378
5827
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
379 #ifdef _MSC_VER
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
380 /* Disable warning 4003:
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
381 * 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
382 */
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
383 #pragma warning( push )
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
384 #pragma warning( disable : 4003)
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
385 #endif
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
386
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
387 enum number_type { NUMBER_TYPES() };
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
388 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
389
5827
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
390 #ifdef _MSC_VER
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
391 #pragma warning( pop )
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
392 #endif
4d7032d36975 Allow building --without-tls on the Windows native platform
Vin Shelton <acs@xemacs.org>
parents: 5771
diff changeset
393
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
394 #undef NUMBER_TYPES
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
395
1995
4e6a63799f08 [xemacs-hg @ 2004-04-07 03:48:58 by james]
james
parents: 1983
diff changeset
396 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
397 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
398
5771
72a9467f93fc Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5769
diff changeset
399 #ifdef WITH_NUMBER_TYPES
72a9467f93fc Only make promote_args_lazy() available if WITH_NUMBER_TYPES.
Aidan Kehoe <kehoea@parhasard.net>
parents: 5769
diff changeset
400
5769
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
401 /* 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
402
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
403 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
404 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
405 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
406 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
407
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
408 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
409 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
410 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
411 continuing to do. */
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
412
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
413 DECLARE_INLINE_HEADER (
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
414 enum lazy_number_type
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
415 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
416 {
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
417 if (MARKERP (*obj1) && MARKERP (*obj2) &&
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
418 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
419 {
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
420 return LAZY_MARKER_T;
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
421 }
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 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
424 }
ffc0c5a66ab1 Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents: 5739
diff changeset
425
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
426 DECLARE_INLINE_HEADER (
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
427 int
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
428 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
429 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
430 if (LRECORDP (object))
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
431 {
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
432 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
433 {
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
434 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
435 #ifdef HAVE_BIGNUM
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
436 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
437 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
438 #ifdef HAVE_RATIO
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
439 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
440 #endif
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
441 #ifdef HAVE_BIGFLOAT
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_bigfloat:
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
443 #endif
5736
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
444 return 1;
3192994c49ca Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents: 5581
diff changeset
445 }
4885
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
446 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
447 return 0;
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
448 }
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
449 #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
450
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
451 #else
6772ce4d982b Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents: 4802
diff changeset
452 #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
453 #endif
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
1983
9c872f33ecbe [xemacs-hg @ 2004-04-05 22:49:31 by james]
james
parents:
diff changeset
456 #endif /* INCLUDED_number_h_ */