2 ent.h -- Numeric types for SXEmacs
3 Copyright (C) 2004 Jerry James
4 Copyright (C) 2004, 2005, 2006, 2007 Sebastian Freundt
6 XEmacs Author: Jerry James
7 Author: Sebastian Freundt
8 Backport: Sebastian Freundt
10 This file is part of SXEmacs
12 SXEmacs is free software: you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation, either version 3 of the License, or
15 (at your option) any later version.
17 SXEmacs is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
22 You should have received a copy of the GNU General Public License
23 along with this program. If not, see <http://www.gnu.org/licenses/>. */
26 #ifndef INCLUDED_ent_h_
27 #define INCLUDED_ent_h_
29 /* The following types are always defined in the same manner,
30 we have some inclusions of the categories (worlds) they live in.
31 These inclusions, unlike in XEmacs, are mathematically inspired,
36 int = whatever fits in the Lisp_Object type, ordinary C int
37 bigz = mpz rational integers
39 bigq = mpq rational numbers
41 ffelm = finite field element
45 float = ordinary C double or long double
46 bigf = mpf big floats (= gmp reals)
49 bigc = mpc complex number
50 pseudoc = mpfr + mpfr*i implementation of complex numbers
52 gaussian = gaussian number (mpz + mpz*i implementation)
54 quatern = quaternion number (which library does that?) - NOT YET
56 octon = octonion number (which library does that? lidia?) - NOT YET
60 rational = integer + bigq
61 real = float + bigf + bigr
62 (and everything else simulating real numbers)
63 comparable = rational + real
64 (and everything else that has a total order)
65 complex = bigc + gaussian
66 algebraic = rational + ffelm + padic + gaussian
67 archimedean = rational + real + complex
68 (and everything else with an archimedean valuation)
69 non-archimidean = padic + ffelm
71 number = archimedean + non-archimedean + quatern + octon
74 The top-level configure script should define the symbols
75 HAVE_MPZ, HAVE_MPQ, HAVE_MPF, HAVE_MPFR and HAVE_MPC to indicate which
77 If some type is not defined by the library, this is what happens:
79 - (provide 'bignum) and (provide 'bigz) if HAVE_MPZ
80 - (provide 'ratio) and (provide 'bigq) if HAVE_MPQ
81 - (provide 'bigfloat) and (provide 'bigf) if HAVE_MPF
82 - (provide 'bigfr) if HAVE_MPFR
83 - (provide 'bigc) if HAVE_MPC
84 - (provide 'ecm) if HAVE_ECM
88 /* definitely the wrong way to go */
89 #if defined(LINUX) && !(defined (__GLIBC__) && (__GLIBC__ >= 2))
90 /* These are redefined (correctly, but differently) in values.h. */
97 #if defined HAVE_MATH_H
99 #endif /* HAVE_MATH_H */
100 #if defined HAVE_LIMITS_H
102 #endif /* HAVE_LIMITS_H */
103 #if defined HAVE_VALUES_H
105 #endif /* HAVE_VALUES_H */
107 #include "ent/ent-optable.h"
108 #include "ent/ent-nullary-op.h"
109 #include "ent/ent-unary-op.h"
110 #include "ent/ent-binary-op.h"
111 #include "ent/ent-unary-rel.h"
112 #include "ent/ent-binary-rel.h"
113 #include "ent/ent-lift.h"
115 /* ordinary (small) integers */
116 #include "ent/ent-int.h"
117 /* ordinary floats */
119 # include "ent/ent-float.h"
120 #endif /* HAVE_FPFLOAT */
122 #include "ent/ent-indef.h"
124 /* Load the library definitions */
125 #if defined HAVE_GMP && defined WITH_GMP
126 # include "ent/ent-gmp.h"
127 #elif defined HAVE_BSDMP && defined WITH_MP
128 # include "ent/ent-mp.h"
130 #if defined HAVE_MPFR && defined WITH_MPFR
131 # include "ent/ent-mpfr.h"
133 #if defined HAVE_MPC && defined WITH_MPC
134 # include "ent/ent-mpc.h"
135 #elif defined HAVE_PSEUC && defined WITH_PSEUC
136 # include "ent/ent-pseumpc.h"
138 #if defined HAVE_ECM && defined WITH_ECM
139 # include "ent/ent-ecm.h"
142 /* now maybe include those pseudo implementations */
143 #if defined HAVE_PSEUG && defined WITH_PSEUG
144 # include "ent/ent-gaussian.h"
146 #if defined HAVE_QUATERN && defined WITH_QUATERN
147 # include "ent/ent-quatern.h"
151 /* debugging stuff */
152 #ifdef ALL_DEBUG_FLAGS
153 #undef ENT_DEBUG_FLAG
154 #define ENT_DEBUG_FLAG
157 #define __ENT_DEBUG__(args...) fprintf(stderr, "ENT " args)
158 #ifndef ENT_DEBUG_FLAG
159 #define ENT_DEBUG(args...)
161 #define ENT_DEBUG(args...) __ENT_DEBUG__(args)
163 #define ENT_DEBUG_OP(args...) ENT_DEBUG("[operation]: " args)
164 #define ENT_CRITICAL(args...) __ENT_DEBUG__("CRITICAL: " args)
167 /******************************** Errors ************************************/
168 extern Lisp_Object Qoperation_error, Qrelation_error, Qvaluation_error;
171 /************************* Big Rational Integers ****************************/
172 extern Lisp_Object Qbigzp;
175 #if !defined HAVE_MPZ || !(defined WITH_GMP || defined WITH_MP)
176 #define BIGZP(x) (0 && x)
177 #define CHECK_BIGZ(x) dead_wrong_type_argument(Qbigzp, x)
178 #define CONCHECK_BIGZ(x) dead_wrong_type_argument(Qbigzp, x)
180 #endif /* !HAVE_MPZ */
183 /********************************* Integers *********************************/
184 extern Lisp_Object Qintegerp;
190 #define INTEGERP(x) (INTP(x) || BIGZP(x))
191 #define CHECK_INTEGER(x) \
194 dead_wrong_type_argument(Qintegerp, x); \
196 #define CONCHECK_INTEGER(x) \
199 x = wrong_type_argument (Qintegerp, x); \
203 /************************** Rational Integer Fractions **********************/
204 extern Lisp_Object Qbigqp;
207 #if !defined HAVE_MPQ || !defined WITH_GMP
208 #define BIGQP(x) (0 && x)
209 #define CHECK_BIGQ(x) dead_wrong_type_argument(Qbigqp, x)
210 #define CONCHECK_BIGQ(x) dead_wrong_type_argument(Qbigqp, x)
212 #endif /* !HAVE_MPQ */
215 /********************************* Rationals ********************************/
216 extern Lisp_Object Qrationalp;
218 #define RATIONALP(x) (INTEGERP(x) || BIGQP(x))
219 #define CHECK_RATIONAL(x) do { \
220 if (!RATIONALP (x)) \
221 dead_wrong_type_argument (Qrationalp, x); \
223 #define CONCHECK_RATIONAL(x) do { \
224 if (!RATIONALP (x)) \
225 x = wrong_type_argument (Qrationalp, x); \
228 EXFUN(Frationalp, 1);
229 EXFUN(Fnumerator, 1);
230 EXFUN(Fdenominator, 1);
233 /******************************** Bigfs ************************************/
234 #if !defined HAVE_MPF || !defined WITH_GMP
235 #define BIGFP(x) (0 && x)
236 #define CHECK_BIGF(x) dead_wrong_type_argument(Qbigfp, x)
237 #define CONCHECK_BIGF(x) dead_wrong_type_argument(Qbigfp, x)
239 #endif /* !HAVE_MPF */
241 extern Lisp_Object Qbigfp;
245 /******************************** Bigfrs ***********************************/
246 extern Lisp_Object Qbigfrp;
249 #if !defined HAVE_MPFR || !defined WITH_MPFR
250 #define BIGFRP(x) (0 && x)
251 #define CHECK_BIGFR(x) dead_wrong_type_argument(Qbigfrp, x)
252 #define CONCHECK_BIGFR(x) dead_wrong_type_argument(Qbigfrp, x)
254 #endif /* !HAVE_MPFR */
257 /******************************* Floats *************************************/
258 extern Lisp_Object Qfloatp;
261 #if !defined(HAVE_FPFLOAT)
262 #define FLOATP(x) (0 && x)
263 #define CHECK_FLOAT(x) dead_wrong_type_argument(Qfloatp, x)
264 #define CONCHECK_FLOAT(x) dead_wrong_type_argument(Qfloatp, x)
265 typedef void fpfloat;
266 #endif /* !HAVE_FPFLOAT */
268 #define INT_OR_FLOATP(x) (INTP(x) || FLOATP(x))
269 #define CHECK_INT_OR_FLOAT(x) \
271 if (!INT_OR_FLOATP (x)) \
272 dead_wrong_type_argument(Qnumberp, x); \
275 #define CONCHECK_INT_OR_FLOAT(x) \
277 if (!INT_OR_FLOATP (x)) \
278 x = wrong_type_argument(Qnumberp, x); \
282 /*********************************** Reals **********************************/
283 extern Lisp_Object Qrealp;
286 #define REALP(x) (FLOATP(x) || BIGFP(x) || BIGFRP(x))
288 #define REALP(x) (BIGFP(x) || BIGFRP(x))
290 #define CHECK_REAL(x) \
293 dead_wrong_type_argument(Qrealp, x); \
295 #define CONCHECK_REAL(x) \
298 x = wrong_type_argument(Qrealp, x); \
301 extern Lisp_Object Vread_real_as;
302 extern Fixnum max_real_precision;
303 extern Fixnum default_real_precision;
306 /****************************** Comparables *********************************/
307 extern Lisp_Object Qcomparablep;
309 #define COMPARABLEP(x) (RATIONALP(x) || REALP(x) || COMPARABLE_INDEF_P(x))
310 #define CHECK_COMPARABLE(x) do { \
311 if (!COMPARABLEP(x)) \
312 dead_wrong_type_argument(Qcomparablep, x); \
314 #define CONCHECK_COMPARABLE(x) do { \
315 if (!COMPARABLEP(x)) \
316 x = wrong_type_argument(Qcomparablep, x); \
320 /********************************* Biggs ************************************/
321 extern Lisp_Object Qbiggp;
324 #if !defined HAVE_PSEUG || !defined WITH_PSEUG
325 #define BIGGP(x) (0 && x)
326 #define CHECK_BIGG(x) dead_wrong_type_argument(Qbiggp, x)
327 #define CONCHECK_BIGG(x) dead_wrong_type_argument(Qbiggp, x)
329 #endif /* HAVE_PSEUG */
332 /***************************** Bigcs ****************************************/
333 extern Lisp_Object Qbigcp;
336 #if !(defined HAVE_MPC && defined WITH_MPC || \
337 defined HAVE_PSEUC && defined WITH_PSEUC)
338 #define BIGCP(x) (0 && x)
339 #define CHECK_BIGC(x) dead_wrong_type_argument(Qbigcp, x)
340 #define CONCHECK_BIGC(x) dead_wrong_type_argument(Qbigcp, x)
345 /******************************* Complex Nums *******************************/
346 extern Lisp_Object Qcomplexp;
348 #define COMPLEXP(x) (BIGCP(x) || BIGGP(x) || INFINITE_POINT_P(x))
349 #define CHECK_COMPLEX(x) do { \
351 dead_wrong_type_argument(Qcomplexp, x); \
353 #define CONCHECK_COMPLEX(x) do { \
355 x = wrong_type_argument(Qcomplexp, x); \
358 EXFUN(Freal_part, 1);
359 EXFUN(Fimaginary_part, 1);
362 /********************************* Quaterns *********************************/
363 extern Lisp_Object Qquaternp;
366 #if !defined HAVE_QUATERN || !defined WITH_QUATERN
367 #define QUATERNP(x) (0 && x)
368 #define CHECK_QUATERN(x) dead_wrong_type_argument(Qquaternp, x)
369 #define CONCHECK_QUATERN(x) dead_wrong_type_argument(Qquaternp, x)
370 typedef void quatern;
371 #endif /* HAVE_QUATERN */
374 /******************************* Archimedeans *******************************/
375 extern Lisp_Object Qarchimedeanp;
377 #define ARCHIMEDEANP(x) \
378 (RATIONALP(x) || REALP(x) || COMPARABLE_INDEF_P(x) || \
379 COMPLEXP(x) || QUATERNP(x))
380 #define CHECK_ARCHIMEDEAN(x) do { \
381 if (!ARCHIMEDEANP (x)) \
382 dead_wrong_type_argument (Qarchimedeanp, x); \
384 #define CONCHECK_ARCHIMEDEAN(x) do { \
385 if (!ARCHIMEDEANP (x)) \
386 x = wrong_type_argument (Qarchimedeanp, x); \
390 /***************************** Non-Archimedeans ******************************/
391 extern Lisp_Object Qnonarchimedeanp;
393 #define NONARCHIMEDEANP(x) (x != x) /* RESC_ELMP(x) || PADICP(x) */
394 #define CHECK_NONARCHIMEDEAN(x) \
396 if (!NONARCHIMEDEANP (x)) \
397 dead_wrong_type_argument (Qnonarchimedeanp, x); \
399 #define CONCHECK_NONARCHIMEDEAN(x) \
401 if (!NONARCHIMEDEANP (x)) \
402 x = wrong_type_argument (Qnonarchimedeanp, x); \
406 /****************************** Indefinities ********************************/
407 extern Lisp_Object Qindefinitep;
408 extern Lisp_Object Qinfinityp;
409 EXFUN(Findefinitep, 1);
410 EXFUN(Finfinityp, 1);
413 /********************************* Numbers **********************************/
414 extern Lisp_Object Qnumberp;
416 #define NUMBERP(x) (ARCHIMEDEANP(x) || NONARCHIMEDEANP(x))
417 #define CHECK_NUMBER(x) do { \
419 dead_wrong_type_argument (Qnumberp, x); \
421 #define CONCHECK_NUMBER(x) do { \
423 x = wrong_type_argument (Qnumberp, x); \
426 EXFUN(Fcanonicalize_number, 1);
427 EXFUN(Fcoerce_number, 3);
429 extern unsigned long ent_normalise_precision(unsigned long);
430 extern unsigned long internal_get_precision(Lisp_Object);
432 /* parser hook for resclass objects */
433 extern int(*ase_resc_rng_pred_f)(const char *cp);
434 extern Lisp_Object(*ase_resc_rng_f)(char *cp);
435 extern int(*ase_resc_elm_pred_f)(const char *cp);
436 extern Lisp_Object(*ase_resc_elm_f)(char *cp);
437 /* parser hook for perms */
438 extern Lisp_Object(*ase_permutation_f)(Lisp_Object);
441 /**************************** Auxiliary Categories **************************/
448 /**************************** Categorical Function Table ********************/
450 /* tentative stuff */
451 extern dllist_t ase_empty_sets;
453 /* these tables hold functions according to their input signature and are
454 grouped by their operation
457 extern void syms_of_ent(void);
458 extern void vars_of_ent(void);
459 extern void init_ent(void);
462 /* asm helpers (taken from ASE, KANT, linux kernel and libc) */
463 /* the following is stolen from the linux kernel */
466 * \param x the word to search
468 * This is defined the same way as
469 * the libc and compiler builtin ffs routines, therefore
470 * differs in spirit from the above ffz() (man ffs).
472 * \example ffs(32) => 5
474 extern_inline long unsigned int
475 __ase_ffsl(long unsigned int x) __attribute__((always_inline));
476 extern_inline unsigned int
477 __ase_ffs(unsigned int x) __attribute__((always_inline));
481 * \param x the word to search
483 * This is defined the same way as ffs().
485 extern_inline long unsigned int
486 __ase_flsl(long unsigned int x) __attribute__((always_inline));
488 /* as long as it is undefined ... */
489 extern_inline unsigned int
490 __ase_fls(unsigned int x) __attribute__((always_inline));
493 #if defined __x86_64__
494 extern_inline long unsigned int
495 __ase_ffsl(long unsigned int x)
498 "bsfq %[in], %[out]\n\t"
499 : [out] "=r" (x) : [in] "rm" (x));
502 #elif defined __i386__
503 extern_inline long unsigned int
504 __ase_ffsl(long unsigned int x)
507 "bsfl %[in], %[out]\n\t"
508 : [out] "=r" (x) : [in] "rm" (x));
512 #elif defined __ppc__
514 extern_inline long unsigned int
515 __ase_ffsl(long unsigned int x)
517 long unsigned int cnt;
520 "cntlzw %[out], %[in]\n"
522 : [in] "r" (x & -x));
526 #elif defined HAVE_FFSL
527 extern_inline long unsigned int
528 __ase_ffsl(long unsigned int x)
533 #elif SIZEOF_LONG == 4 || SIZEOF_LONG == 8
534 /* that's glibc's idea of ffs */
535 extern_inline long unsigned int
536 __ase_ffs_(long unsigned int i)
538 const unsigned char table[] = {
539 0,1,2,2,3,3,3,3,4,4,4,4,4,4,4,4,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
540 6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
541 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
542 7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
543 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
544 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
545 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
546 8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8
549 long unsigned int x = i & -i;
551 a = x <= 0xffff ? (x <= 0xff ? 0 : 8) : (x <= 0xffffff ? 16 : 24);
553 return table[x >> a] + a;
556 # if SIZEOF_LONG == 4
557 # define __ase_ffsl __ase_ffs_
558 # else /* SIZEOF_LONG == 8 */
559 extern_inline long unsigned int
560 __ase_ffsl(long unsigned int i)
562 long unsigned int x = i & -i;
565 return __ase_ffs_(i);
567 return 32 + __ase_ffs_(i >> 32);
570 #else /* SIZEOF_LONG != 4,8 */
571 # error "Don't know how to compute the first bit set."
572 #endif /* __x86_64__ || __i386__ */
574 #if defined(__x86_64__) || defined(__i386__)
575 extern_inline unsigned int
576 __ase_ffs(unsigned int x)
579 "bsfl %[in], %[out]\n\t"
580 : [out] "=r" (x) : [in] "rm" (x));
584 extern_inline unsigned int
585 __ase_ffs(unsigned int x)
587 return __ase_ffsl(x);
591 #if defined __x86_64__
592 extern_inline long unsigned int
593 __ase_flsl(long unsigned int x)
596 "bsrq %[in], %[out]\n\t"
597 : [out] "=r" (x) : [in] "rm" (x));
600 #elif defined __i386__
601 extern_inline long unsigned int
602 __ase_flsl(long unsigned int x)
605 "bsrl %[in], %[out]\n\t"
606 : [out] "=r" (x) : [in] "rm" (x));
610 #elif defined HAVE_FLSL
611 extern_inline long unsigned int
612 __ase_flsl(long unsigned int x)
617 #elif SIZEOF_LONG == 8
619 /* stolen from glibc-2.7/sysdeps/posix/getaddrinfo.c
620 * what a nice file to put _THAT_ :O */
621 extern_inline long unsigned int
622 __ase_flsl(long unsigned int a)
624 long unsigned int n = 0;
625 for (long unsigned int mask = 1 << 63; n < 64; mask >>= 1, ++n) {
626 if ((a & mask) != 0) {
633 #elif SIZEOF_LONG == 4
635 /* stolen from glibc-2.7/sysdeps/posix/getaddrinfo.c
636 * what a nice file to put _THAT_ :O */
637 extern_inline long unsigned int
638 __ase_flsl(long unsigned int a)
640 long unsigned int n = 0;
641 for (long unsigned int mask = 1 << 31; n < 32; mask >>= 1, ++n) {
642 if ((a & mask) != 0) {
649 #else /* SIZEOF_LONG != 4,8 */
650 # error "Don't know how to compute the last bit set."
651 #endif /* __x86_64__ || __i386__ */
653 #endif /* INCLUDED_ent_h_ */