2 ent-mpc.c -- Numeric types for SXEmacs
3 Copyright (C) 2005, 2006 Sebastian Freundt
5 Author: Sebastian Freundt
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
27 #include "sysproc.h" /* For qxe_getpid */
31 bigc ent_scratch_bigc;
32 static ase_nullary_operation_f Qent_mpc_zero, Qent_mpc_one;
36 bigc_print (Lisp_Object obj, Lisp_Object printcharfun, int SXE_UNUSED(escapeflag))
38 Bufbyte *fstr = bigc_to_string(XBIGC_DATA(obj), 10);
39 write_c_string((char*)fstr, printcharfun);
41 fstr = (Bufbyte *)NULL;
46 bigc_equal (Lisp_Object obj1, Lisp_Object obj2, int SXE_UNUSED(depth))
48 return bigc_eq(XBIGC_DATA(obj1), XBIGC_DATA(obj2));
52 bigc_hash (Lisp_Object obj, int SXE_UNUSED(depth))
54 return bigc_hashcode(XBIGC_DATA(obj));
58 bigc_mark (Lisp_Object SXE_UNUSED(obj))
64 bigc_finalise (void *header, int for_disksave)
68 ("Can't dump an emacs containing MPC objects",Qt);
74 static const struct lrecord_description bigc_description[] = {
75 { XD_OPAQUE_DATA_PTR, offsetof(Lisp_Bigc, data) },
79 DEFINE_BASIC_LRECORD_IMPLEMENTATION("bigc", bigc,
80 bigc_mark, bigc_print, bigc_finalise,
81 bigc_equal, bigc_hash,
82 bigc_description, Lisp_Bigc);
86 DEFUN ("bigc-get-precision", Fbigc_get_precision, 1, 1, 0, /*
87 Return the precision of bigc C as an integer.
92 return make_integer((signed long)XBIGC_GET_PREC(c));
95 DEFUN ("bigc-set-precision", Fbigc_set_precision, 2, 2, 0, /*
96 Set the precision of C, a bigc, to PRECISION, a nonnegative integer.
97 The new precision of C is returned. Note that the return value may differ
98 from PRECISION if the underlying library is unable to support exactly
99 PRECISION bits of precision.
106 if (INTP(precision)) {
107 prec = (XINT(precision) <= 0)
108 ? MPFR_PREC_MIN : (unsigned long)XINT(precision);
110 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
111 else if (BIGZP(precision)) {
112 prec = bigz_fits_ulong_p(XBIGZ_DATA(precision))
113 ? bigz_to_ulong(XBIGZ_DATA(precision))
116 #endif /* HAVE_MPZ */
118 dead_wrong_type_argument(Qintegerp, c);
122 XBIGC_SET_PREC(c, prec);
123 return Fbigc_get_precision(c);
126 DEFUN ("make-bigc", Fmake_bigc, 2, 2, 0, /*
127 Return the bigc number whose real component is REAL-PART and
128 whose imaginary component is IMAGINARY-PART.
130 (real_part, imaginary_part))
134 CHECK_COMPARABLE(real_part);
135 CHECK_COMPARABLE(imaginary_part);
137 real_part = Fcoerce_number(
138 real_part, Qbigfr, Qnil);
139 imaginary_part = Fcoerce_number(
140 imaginary_part, Qbigfr, Qnil);
142 /* check if one of the components is not-a-number
143 * set both components NaN in that case
145 if (bigfr_nan_p(XBIGFR_DATA(real_part)) ||
146 bigfr_nan_p(XBIGFR_DATA(imaginary_part))) {
147 bigfr_set_nan(XBIGFR_DATA(real_part));
148 bigfr_set_nan(XBIGFR_DATA(imaginary_part));
149 } else if (bigfr_inf_p(XBIGFR_DATA(real_part)) ||
150 bigfr_inf_p(XBIGFR_DATA(imaginary_part))) {
151 bigfr_set_pinf(XBIGFR_DATA(real_part));
152 bigfr_set_pinf(XBIGFR_DATA(imaginary_part));
155 result = make_bigc_bfr(XBIGFR_DATA(real_part),
156 XBIGFR_DATA(imaginary_part),
157 internal_get_precision(Qnil));
163 int bigc_nan_p(bigc c)
165 return (bigfr_nan_p(bigc_re(c)) ||
166 bigfr_nan_p(bigc_im(c)));
169 int bigc_inf_p(bigc c)
171 return (bigfr_inf_p(bigc_re(c)) ||
172 bigfr_inf_p(bigc_im(c)));
176 Bufbyte *bigc_to_string(mpc_t c, int base)
182 /* if one of the components is infinity or not a number,
183 * just print the respective component
184 * +infinity+2i does not really make sense, that's why!
187 re_str = indef_to_string((indef)NOT_A_NUMBER);
189 } else if (bigc_inf_p(c)) {
190 re_str = indef_to_string((indef)COMPLEX_INFINITY);
193 /* fetch the components' strings */
194 re_str = bigfr_to_string(bigc_re(c), base);
195 im_str = bigfr_to_string(bigc_im(c), base);
197 re_len = strlen((char*)re_str);
198 im_len = strlen((char*)im_str);
200 const int sign = bigfr_sign(bigc_im(c));
201 const int neg = (sign >= 0) ? 1 : 0;
203 /* now append the imaginary string */
204 XREALLOC_ARRAY(re_str, Bufbyte, re_len + neg + im_len + 2);
206 re_str[re_len] = '+';
207 memmove(&re_str[re_len + neg],
210 re_str[re_len+neg+im_len] = 'i';
211 re_str[re_len+neg+im_len+1] = '\0';
219 void bigc_pow(bigc res, bigc g1, unsigned long g2)
221 #if defined(HAVE_MPZ) && defined(WITH_GMP)
224 bigfr binfr, resintg, resimag, tmpbz1, tmpbz2, tmpbz3, intg, imag;
236 bigfr_set_long(resintg, 0L);
237 bigfr_set_long(resimag, 0L);
239 bigfr_set(intg, bigc_re(g1));
240 bigfr_set(imag, bigc_im(g1));
242 /* we compute using the binomial coefficients */
243 for (i=0; i<=g2; i++) {
244 mpz_bin_uiui(bin, g2, i);
245 bigfr_set_bigz(binfr, bin);
247 /* real part changes */
248 bigfr_pow(tmpbz1, intg, g2-i);
249 bigfr_pow(tmpbz2, imag, i);
250 bigfr_mul(tmpbz3, tmpbz1, tmpbz2);
251 bigfr_mul(binfr, binfr, tmpbz3);
253 bigfr_add(resintg, resintg, binfr);
254 } else if (i % 4 == 2) {
255 bigfr_sub(resintg, resintg, binfr);
258 /* imag part changes */
259 bigfr_pow(tmpbz1, intg, g2-i);
260 bigfr_pow(tmpbz2, imag, i);
261 bigfr_mul(tmpbz3, tmpbz1, tmpbz2);
262 bigfr_mul(binfr, binfr, tmpbz3);
264 bigfr_add(resimag, resimag, binfr);
265 } else if (i % 4 == 3) {
266 bigfr_sub(resimag, resimag, binfr);
271 bigc_set_bigfr_bigfr(res, resintg, resimag);
282 #else /* !WITH_GMP */
283 bigc_set_long_long(res, 0L, 0L);
284 #endif /* WITH_GMP */
290 ent_mpc_zerop(Lisp_Object l)
292 return (bigfr_sign(bigc_re(XBIGC_DATA(l))) == 0 &&
293 bigfr_sign(bigc_im(XBIGC_DATA(l))) == 0);
297 ent_mpc_onep(Lisp_Object l)
299 return (bigfr_to_fpfloat(bigc_re(XBIGC_DATA(l))) == 1.0f &&
300 bigfr_sign(bigc_im(XBIGC_DATA(l))) == 0);
304 ent_mpc_unitp(Lisp_Object SXE_UNUSED(unused))
310 ent_sum_BIGC_T(Lisp_Object l, Lisp_Object r)
312 bigc_set_prec(ent_scratch_bigc,
313 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
314 bigc_add(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
315 return make_bigc_bc(ent_scratch_bigc);
319 ent_sum_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
321 struct ent_lift_args_s la;
325 la.precision = XBIGC_GET_PREC(l);
326 r = ent_lift(r, BIGFR_T, &la);
328 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
329 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
330 bigc_add(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
331 return make_bigc_bc(ent_scratch_bigc);
335 ent_sum_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
337 return ent_sum_BIGC_T_COMPARABLE(r, l);
341 ent_sum_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
343 struct ent_lift_args_s la;
347 la.precision = XBIGC_GET_PREC(l);
348 r = ent_lift(r, BIGC_T, &la);
350 return ent_sum_BIGC_T(l, r);
354 ent_sum_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
356 return ent_sum_BIGC_T_COMPLEX(r, l);
360 ent_diff_BIGC_T(Lisp_Object l, Lisp_Object r)
362 bigc_set_prec(ent_scratch_bigc,
363 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
364 bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
365 return make_bigc_bc(ent_scratch_bigc);
369 ent_diff_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
371 struct ent_lift_args_s la;
375 la.precision = XBIGC_GET_PREC(l);
376 r = ent_lift(r, BIGFR_T, &la);
378 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
379 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
380 bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
381 return make_bigc_bc(ent_scratch_bigc);
385 ent_diff_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
387 struct ent_lift_args_s la;
391 la.precision = XBIGC_GET_PREC(r);
392 l = ent_lift(l, BIGFR_T, &la);
394 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
395 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(l));
396 bigc_sub(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
397 return make_bigc_bc(ent_scratch_bigc);
401 ent_diff_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
403 struct ent_lift_args_s la;
407 la.precision = XBIGC_GET_PREC(l);
408 r = ent_lift(r, BIGC_T, &la);
410 return ent_diff_BIGC_T(l, r);
414 ent_diff_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
416 struct ent_lift_args_s la;
420 la.precision = XBIGC_GET_PREC(r);
421 l = ent_lift(l, BIGC_T, &la);
423 return ent_diff_BIGC_T(l, r);
427 ent_neg_BIGC_T(Lisp_Object l)
429 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
430 bigc_neg(ent_scratch_bigc, XBIGC_DATA(l));
431 return make_bigc_bc(ent_scratch_bigc);
435 ent_prod_BIGC_T(Lisp_Object l, Lisp_Object r)
437 bigc_set_prec(ent_scratch_bigc,
438 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
439 bigc_mul(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
440 return make_bigc_bc(ent_scratch_bigc);
444 ent_prod_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
446 struct ent_lift_args_s la;
450 la.precision = XBIGC_GET_PREC(l);
451 r = ent_lift(r, BIGFR_T, &la);
453 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
454 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
455 bigc_mul(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
456 return make_bigc_bc(ent_scratch_bigc);
460 ent_prod_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
462 return ent_prod_BIGC_T_COMPARABLE(r, l);
466 ent_prod_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
468 struct ent_lift_args_s la;
472 la.precision = XBIGC_GET_PREC(l);
473 r = ent_lift(r, BIGC_T, &la);
475 return ent_prod_BIGC_T(l, r);
479 ent_prod_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
481 return ent_prod_BIGC_T_COMPLEX(r, l);
485 ent_div_BIGC_T(Lisp_Object l, Lisp_Object r)
487 if (ent_mpc_zerop(r)) {
488 if (!ent_mpc_zerop(l)) {
489 return make_indef(COMPLEX_INFINITY);
491 return make_indef(NOT_A_NUMBER);
494 bigc_set_prec(ent_scratch_bigc,
495 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
496 bigc_div(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
497 return make_bigc_bc(ent_scratch_bigc);
501 ent_div_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
503 struct ent_lift_args_s la;
507 if (ent_unrel(ASE_UNARY_REL_ZEROP, r)) {
508 if (!ent_mpc_zerop(l)) {
509 return make_indef(COMPLEX_INFINITY);
511 return make_indef(NOT_A_NUMBER);
515 la.precision = XBIGC_GET_PREC(l);
516 r = ent_lift(r, BIGFR_T, &la);
518 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
519 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
520 bigc_div(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
521 return make_bigc_bc(ent_scratch_bigc);
525 ent_div_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
527 struct ent_lift_args_s la;
531 if (ent_mpc_zerop(r)) {
532 if (!ent_unrel(ASE_UNARY_REL_ZEROP, l)) {
533 return make_indef(COMPLEX_INFINITY);
535 return make_indef(NOT_A_NUMBER);
539 la.precision = XBIGC_GET_PREC(r);
540 l = ent_lift(l, BIGFR_T, &la);
542 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
543 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(l));
544 bigc_div(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
545 return make_bigc_bc(ent_scratch_bigc);
549 ent_div_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
551 struct ent_lift_args_s la;
555 if (ent_unrel(ASE_UNARY_REL_ZEROP, r)) {
556 if (!ent_mpc_zerop(l)) {
557 return make_indef(COMPLEX_INFINITY);
559 return make_indef(NOT_A_NUMBER);
563 la.precision = XBIGC_GET_PREC(l);
564 r = ent_lift(r, BIGC_T, &la);
566 return ent_div_BIGC_T(l, r);
570 ent_div_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
572 struct ent_lift_args_s la;
576 if (ent_mpc_zerop(r)) {
577 if (!ent_unrel(ASE_UNARY_REL_ZEROP, l)) {
578 return make_indef(COMPLEX_INFINITY);
580 return make_indef(NOT_A_NUMBER);
584 la.precision = XBIGC_GET_PREC(r);
585 l = ent_lift(l, BIGC_T, &la);
587 return ent_div_BIGC_T(l, r);
591 ent_inv_BIGC_T(Lisp_Object r)
593 if (ent_mpc_zerop(r)) {
594 return make_indef(COMPLEX_INFINITY);
596 bigc_set_long(ent_scratch_bigc, 1L);
597 bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
598 bigc_div(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
599 return make_bigc_bc(ent_scratch_bigc);
603 ent_rem_BIGC_T(Lisp_Object SXE_UNUSED(unused), Lisp_Object r)
605 return Qent_mpc_zero;
609 ent_mod_BIGC_T(Lisp_Object l, Lisp_Object r)
611 if (ent_mpc_zerop(r)) {
612 return Qent_mpc_zero;
614 bigc_set_prec(ent_scratch_bigc,
615 max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
616 bigc_div(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
617 bigfr_trunc(bigc_re(ent_scratch_bigc), bigc_re(ent_scratch_bigc));
618 bigfr_trunc(bigc_im(ent_scratch_bigc), bigc_im(ent_scratch_bigc));
619 bigc_mul(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
620 bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
621 return make_bigc_bc(ent_scratch_bigc);
626 ent_eq_BIGC_T(Lisp_Object l, Lisp_Object r)
628 return (bigfr_eq(bigc_re(XBIGC_DATA(l)), bigc_re(XBIGC_DATA(r))) &&
629 bigfr_eq(bigc_im(XBIGC_DATA(l)), bigc_im(XBIGC_DATA(r))));
633 ent_ne_BIGC_T(Lisp_Object l, Lisp_Object r)
635 return (bigfr_eq(bigc_re(XBIGC_DATA(l)), bigc_re(XBIGC_DATA(r))) &&
636 bigfr_eq(bigc_im(XBIGC_DATA(l)), bigc_im(XBIGC_DATA(r))));
640 static inline Lisp_Object
641 ent_vallt_BIGC_T(Lisp_Object l, Lisp_Object r)
647 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
648 bigfr_set_prec(b2, internal_get_precision(Qnil));
649 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
650 bigc_norm(b2, XBIGC_DATA(r));
651 result = bigfr_lt(ent_scratch_bigfr, b2);
654 return (result) ? Qt : Qnil;
656 static inline Lisp_Object
657 ent_valgt_BIGC_T(Lisp_Object l, Lisp_Object r)
663 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
664 bigfr_set_prec(b2, internal_get_precision(Qnil));
665 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
666 bigc_norm(b2, XBIGC_DATA(r));
667 result = bigfr_gt(ent_scratch_bigfr, b2);
670 return (result) ? Qt : Qnil;
672 static inline Lisp_Object
673 ent_valeq_BIGC_T(Lisp_Object l, Lisp_Object r)
679 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
680 bigfr_set_prec(b2, internal_get_precision(Qnil));
681 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
682 bigc_norm(b2, XBIGC_DATA(r));
683 result = bigfr_eq(ent_scratch_bigfr, b2);
686 return (result) ? Qt : Qnil;
688 static inline Lisp_Object
689 ent_valne_BIGC_T(Lisp_Object l, Lisp_Object r)
695 bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
696 bigfr_set_prec(b2, internal_get_precision(Qnil));
697 bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
698 bigc_norm(b2, XBIGC_DATA(r));
699 result = bigfr_eq(ent_scratch_bigfr, b2);
702 return (result) ? Qnil : Qt;
708 ent_lift_INT_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
710 unsigned long precision = la->precision;
712 bigc_set_prec(ent_scratch_bigc, precision);
713 bigc_set_long(ent_scratch_bigc, ent_int(number));
714 return make_bigc_bc(ent_scratch_bigc);
717 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
719 ent_lift_BIGZ_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
721 unsigned long precision = la->precision;
723 bigfr_set_prec(ent_scratch_bigfr, precision);
724 bigfr_set_bigz(ent_scratch_bigfr, XBIGZ_DATA(number));
725 bigc_set_prec(ent_scratch_bigc, precision);
726 bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
727 return make_bigc_bc(ent_scratch_bigc);
729 #endif /* HAVE_MPZ */
731 #if defined HAVE_MPQ && defined WITH_GMP
733 ent_lift_BIGQ_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
735 unsigned long precision = la->precision;
737 bigfr_set_prec(ent_scratch_bigfr, precision);
738 bigfr_set_bigq(ent_scratch_bigfr, XBIGQ_DATA(number));
739 bigc_set_prec(ent_scratch_bigc, precision);
740 bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
741 return make_bigc_bc(ent_scratch_bigc);
743 #endif /* HAVE_MPQ */
745 #if defined HAVE_MPF && defined WITH_GMP
747 ent_lift_BIGF_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
749 unsigned long precision = la->precision;
751 bigfr_set_prec(ent_scratch_bigfr, precision);
752 bigfr_set_bigf(ent_scratch_bigfr, XBIGF_DATA(number));
753 bigc_set_prec(ent_scratch_bigc, precision);
754 bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
755 return make_bigc_bc(ent_scratch_bigc);
757 #endif /* HAVE_MPF */
759 #if defined HAVE_MPFR && defined WITH_MPFR
761 ent_lift_BIGFR_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
763 unsigned long precision = la->precision;
765 /* warn about coercions of indefinite symbols */
766 if (bigfr_inf_p(XBIGFR_DATA(number)))
767 return make_indef(COMPLEX_INFINITY);
768 if (bigfr_nan_p(XBIGFR_DATA(number)))
769 return make_indef(NOT_A_NUMBER);
771 bigc_set_prec(ent_scratch_bigc, precision);
772 bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(number));
773 return make_bigc_bc(ent_scratch_bigc);
775 #endif /* HAVE_MPF */
779 ent_lift_FLOAT_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
781 unsigned long precision = la->precision;
783 bigc_set_prec(ent_scratch_bigc, precision);
784 bigc_set_fpfloat(ent_scratch_bigc, XFLOAT_DATA(number));
785 return make_bigc_bc(ent_scratch_bigc);
789 #if defined HAVE_PSEUG && defined WITH_PSEUG
791 ent_lift_BIGG_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
793 unsigned long precision = la->precision;
794 bigfr bfr_im, bfr_re;
795 Lisp_Object result, re, im;
797 re = Freal_part(number);
798 re = ent_lift(re, BIGFR_T, la);
799 im = Fimaginary_part(number);
800 im = ent_lift(im, BIGFR_T, la);
805 bigfr_set(bfr_re, XBIGFR_DATA(re));
806 bigfr_set(bfr_im, XBIGFR_DATA(im));
807 result = make_bigc_bfr(bfr_re, bfr_im, precision);
817 ent_lift_BIGC_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
819 unsigned long precision = la->precision;
821 bigc_set_prec(ent_scratch_bigc, precision);
822 bigc_set(ent_scratch_bigc, XBIGC_DATA(number));
823 return make_bigc_bc(ent_scratch_bigc);
828 ent_mpc_nullary_optable_init(void)
830 Qent_mpc_zero = make_bigc(0.0f, 0.0f, internal_get_precision(Qnil));
831 Qent_mpc_one = make_bigc(1.0f, 0.0f, internal_get_precision(Qnil));
832 staticpro(&Qent_mpc_zero);
833 staticpro(&Qent_mpc_one);
835 ent_nullop_register(ASE_NULLARY_OP_ZERO, BIGC_T, Qent_mpc_zero);
836 ent_nullop_register(ASE_NULLARY_OP_ONE, BIGC_T, Qent_mpc_one);
840 ent_mpc_unary_optable_init(void)
842 ent_unop_register(ASE_UNARY_OP_NEG, BIGC_T, ent_neg_BIGC_T);
843 ent_unop_register(ASE_UNARY_OP_INV, BIGC_T, ent_inv_BIGC_T);
847 ent_mpc_binary_optable_init(void)
850 ent_binop_register(ASE_BINARY_OP_SUM,
851 BIGC_T, BIGC_T, ent_sum_BIGC_T);
852 ent_binop_register(ASE_BINARY_OP_SUM,
853 BIGC_T, INT_T, ent_sum_BIGC_T_COMPARABLE);
854 ent_binop_register(ASE_BINARY_OP_SUM,
855 INT_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
856 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
857 ent_binop_register(ASE_BINARY_OP_SUM,
858 BIGC_T, BIGZ_T, ent_sum_BIGC_T_COMPARABLE);
859 ent_binop_register(ASE_BINARY_OP_SUM,
860 BIGZ_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
862 #if defined HAVE_MPQ && defined WITH_GMP
863 ent_binop_register(ASE_BINARY_OP_SUM,
864 BIGC_T, BIGQ_T, ent_sum_BIGC_T_COMPARABLE);
865 ent_binop_register(ASE_BINARY_OP_SUM,
866 BIGQ_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
868 #if defined HAVE_MPF && defined WITH_GMP
869 ent_binop_register(ASE_BINARY_OP_SUM,
870 BIGC_T, BIGF_T, ent_sum_BIGC_T_COMPARABLE);
871 ent_binop_register(ASE_BINARY_OP_SUM,
872 BIGF_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
874 #if defined HAVE_MPFR && defined WITH_MPFR
875 ent_binop_register(ASE_BINARY_OP_SUM,
876 BIGC_T, BIGFR_T, ent_sum_BIGC_T_COMPARABLE);
877 ent_binop_register(ASE_BINARY_OP_SUM,
878 BIGFR_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
881 ent_binop_register(ASE_BINARY_OP_SUM,
882 BIGC_T, FLOAT_T, ent_sum_BIGC_T_COMPARABLE);
883 ent_binop_register(ASE_BINARY_OP_SUM,
884 FLOAT_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
886 #if defined HAVE_PSEUG && defined WITH_PSEUG
887 ent_binop_register(ASE_BINARY_OP_SUM,
888 BIGC_T, BIGG_T, ent_sum_BIGC_T_COMPLEX);
889 ent_binop_register(ASE_BINARY_OP_SUM,
890 BIGG_T, BIGC_T, ent_sum_COMPLEX_BIGC_T);
893 ent_binop_register(ASE_BINARY_OP_DIFF,
894 BIGC_T, BIGC_T, ent_diff_BIGC_T);
895 ent_binop_register(ASE_BINARY_OP_DIFF,
896 BIGC_T, INT_T, ent_diff_BIGC_T_COMPARABLE);
897 ent_binop_register(ASE_BINARY_OP_DIFF,
898 INT_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
899 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
900 ent_binop_register(ASE_BINARY_OP_DIFF,
901 BIGC_T, BIGZ_T, ent_diff_BIGC_T_COMPARABLE);
902 ent_binop_register(ASE_BINARY_OP_DIFF,
903 BIGZ_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
905 #if defined HAVE_MPQ && defined WITH_GMP
906 ent_binop_register(ASE_BINARY_OP_DIFF,
907 BIGC_T, BIGQ_T, ent_diff_BIGC_T_COMPARABLE);
908 ent_binop_register(ASE_BINARY_OP_DIFF,
909 BIGQ_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
911 #if defined HAVE_MPF && defined WITH_GMP
912 ent_binop_register(ASE_BINARY_OP_DIFF,
913 BIGC_T, BIGF_T, ent_diff_BIGC_T_COMPARABLE);
914 ent_binop_register(ASE_BINARY_OP_DIFF,
915 BIGF_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
917 #if defined HAVE_MPFR && defined WITH_MPFR
918 ent_binop_register(ASE_BINARY_OP_DIFF,
919 BIGC_T, BIGFR_T, ent_diff_BIGC_T_COMPARABLE);
920 ent_binop_register(ASE_BINARY_OP_DIFF,
921 BIGFR_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
924 ent_binop_register(ASE_BINARY_OP_DIFF,
925 BIGC_T, FLOAT_T, ent_diff_BIGC_T_COMPARABLE);
926 ent_binop_register(ASE_BINARY_OP_DIFF,
927 FLOAT_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
929 #if defined HAVE_PSEUG && defined WITH_PSEUG
930 ent_binop_register(ASE_BINARY_OP_DIFF,
931 BIGC_T, BIGG_T, ent_diff_BIGC_T_COMPLEX);
932 ent_binop_register(ASE_BINARY_OP_DIFF,
933 BIGG_T, BIGC_T, ent_diff_COMPLEX_BIGC_T);
936 ent_binop_register(ASE_BINARY_OP_PROD,
937 BIGC_T, BIGC_T, ent_prod_BIGC_T);
938 ent_binop_register(ASE_BINARY_OP_PROD,
939 BIGC_T, INT_T, ent_prod_BIGC_T_COMPARABLE);
940 ent_binop_register(ASE_BINARY_OP_PROD,
941 INT_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
942 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
943 ent_binop_register(ASE_BINARY_OP_PROD,
944 BIGC_T, BIGZ_T, ent_prod_BIGC_T_COMPARABLE);
945 ent_binop_register(ASE_BINARY_OP_PROD,
946 BIGZ_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
948 #if defined HAVE_MPQ && defined WITH_GMP
949 ent_binop_register(ASE_BINARY_OP_PROD,
950 BIGC_T, BIGQ_T, ent_prod_BIGC_T_COMPARABLE);
951 ent_binop_register(ASE_BINARY_OP_PROD,
952 BIGQ_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
954 #if defined HAVE_MPF && defined WITH_GMP
955 ent_binop_register(ASE_BINARY_OP_PROD,
956 BIGC_T, BIGF_T, ent_prod_BIGC_T_COMPARABLE);
957 ent_binop_register(ASE_BINARY_OP_PROD,
958 BIGF_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
960 #if defined HAVE_MPFR && defined WITH_MPFR
961 ent_binop_register(ASE_BINARY_OP_PROD,
962 BIGC_T, BIGFR_T, ent_prod_BIGC_T_COMPARABLE);
963 ent_binop_register(ASE_BINARY_OP_PROD,
964 BIGFR_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
967 ent_binop_register(ASE_BINARY_OP_PROD,
968 BIGC_T, FLOAT_T, ent_prod_BIGC_T_COMPARABLE);
969 ent_binop_register(ASE_BINARY_OP_PROD,
970 FLOAT_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
972 #if defined HAVE_PSEUG && defined WITH_PSEUG
973 ent_binop_register(ASE_BINARY_OP_PROD,
974 BIGC_T, BIGG_T, ent_prod_BIGC_T_COMPLEX);
975 ent_binop_register(ASE_BINARY_OP_PROD,
976 BIGG_T, BIGC_T, ent_prod_COMPLEX_BIGC_T);
979 /* divisions and quotients */
980 ent_binop_register(ASE_BINARY_OP_DIV,
981 BIGC_T, BIGC_T, ent_div_BIGC_T);
982 ent_binop_register(ASE_BINARY_OP_DIV,
983 BIGC_T, INT_T, ent_div_BIGC_T_COMPARABLE);
984 ent_binop_register(ASE_BINARY_OP_DIV,
985 INT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
986 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
987 ent_binop_register(ASE_BINARY_OP_DIV,
988 BIGC_T, BIGZ_T, ent_div_BIGC_T_COMPARABLE);
989 ent_binop_register(ASE_BINARY_OP_DIV,
990 BIGZ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
992 #if defined HAVE_MPQ && defined WITH_GMP
993 ent_binop_register(ASE_BINARY_OP_DIV,
994 BIGC_T, BIGQ_T, ent_div_BIGC_T_COMPARABLE);
995 ent_binop_register(ASE_BINARY_OP_DIV,
996 BIGQ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
998 #if defined HAVE_MPF && defined WITH_GMP
999 ent_binop_register(ASE_BINARY_OP_DIV,
1000 BIGC_T, BIGF_T, ent_div_BIGC_T_COMPARABLE);
1001 ent_binop_register(ASE_BINARY_OP_DIV,
1002 BIGF_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1004 #if defined HAVE_MPFR && defined WITH_MPFR
1005 ent_binop_register(ASE_BINARY_OP_DIV,
1006 BIGC_T, BIGFR_T, ent_div_BIGC_T_COMPARABLE);
1007 ent_binop_register(ASE_BINARY_OP_DIV,
1008 BIGFR_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1011 ent_binop_register(ASE_BINARY_OP_DIV,
1012 BIGC_T, FLOAT_T, ent_div_BIGC_T_COMPARABLE);
1013 ent_binop_register(ASE_BINARY_OP_DIV,
1014 FLOAT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1016 #if defined HAVE_PSEUG && defined WITH_PSEUG
1017 ent_binop_register(ASE_BINARY_OP_DIV,
1018 BIGC_T, BIGG_T, ent_div_BIGC_T_COMPLEX);
1019 ent_binop_register(ASE_BINARY_OP_DIV,
1020 BIGG_T, BIGC_T, ent_div_COMPLEX_BIGC_T);
1022 ent_binop_register(ASE_BINARY_OP_QUO,
1023 BIGC_T, BIGC_T, ent_div_BIGC_T);
1024 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1025 ent_binop_register(ASE_BINARY_OP_QUO,
1026 BIGC_T, BIGZ_T, ent_div_BIGC_T_COMPARABLE);
1027 ent_binop_register(ASE_BINARY_OP_QUO,
1028 BIGZ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1030 #if defined HAVE_MPQ && defined WITH_GMP
1031 ent_binop_register(ASE_BINARY_OP_QUO,
1032 BIGC_T, BIGQ_T, ent_div_BIGC_T_COMPARABLE);
1033 ent_binop_register(ASE_BINARY_OP_QUO,
1034 BIGQ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1036 #if defined HAVE_MPF && defined WITH_GMP
1037 ent_binop_register(ASE_BINARY_OP_QUO,
1038 BIGC_T, BIGF_T, ent_div_BIGC_T_COMPARABLE);
1039 ent_binop_register(ASE_BINARY_OP_QUO,
1040 BIGF_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1042 #if defined HAVE_MPFR && defined WITH_MPFR
1043 ent_binop_register(ASE_BINARY_OP_QUO,
1044 BIGC_T, BIGFR_T, ent_div_BIGC_T_COMPARABLE);
1045 ent_binop_register(ASE_BINARY_OP_QUO,
1046 BIGFR_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1049 ent_binop_register(ASE_BINARY_OP_QUO,
1050 BIGC_T, FLOAT_T, ent_div_BIGC_T_COMPARABLE);
1051 ent_binop_register(ASE_BINARY_OP_QUO,
1052 FLOAT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1054 #if defined HAVE_PSEUG && defined WITH_PSEUG
1055 ent_binop_register(ASE_BINARY_OP_QUO,
1056 BIGC_T, BIGG_T, ent_div_BIGC_T_COMPLEX);
1057 ent_binop_register(ASE_BINARY_OP_QUO,
1058 BIGG_T, BIGC_T, ent_div_COMPLEX_BIGC_T);
1060 ent_binop_register(ASE_BINARY_OP_REM,
1061 BIGC_T, BIGC_T, ent_rem_BIGC_T);
1062 ent_binop_register(ASE_BINARY_OP_MOD,
1063 BIGC_T, BIGC_T, ent_mod_BIGC_T);
1067 ent_mpc_unary_reltable_init(void)
1069 ent_unrel_register(ASE_UNARY_REL_ZEROP, BIGC_T, ent_mpc_zerop);
1070 ent_unrel_register(ASE_UNARY_REL_ONEP, BIGC_T, ent_mpc_onep);
1071 ent_unrel_register(ASE_UNARY_REL_UNITP, BIGC_T, ent_mpc_unitp);
1075 ent_mpc_binary_reltable_init(void)
1077 ent_binrel_register(ASE_BINARY_REL_EQUALP,
1078 BIGC_T, BIGC_T, ent_eq_BIGC_T);
1079 ent_binrel_register(ASE_BINARY_REL_NEQP,
1080 BIGC_T, BIGC_T, ent_ne_BIGC_T);
1084 ent_mpc_lifttable_init(void)
1086 ent_lift_register(INT_T, BIGC_T, ent_lift_INT_T_BIGC_T);
1087 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1088 ent_lift_register(BIGZ_T, BIGC_T, ent_lift_BIGZ_T_BIGC_T);
1090 #if defined HAVE_MPQ && defined WITH_GMP
1091 ent_lift_register(BIGQ_T, BIGC_T, ent_lift_BIGQ_T_BIGC_T);
1093 #if defined HAVE_MPF && defined WITH_GMP
1094 ent_lift_register(BIGF_T, BIGC_T, ent_lift_BIGF_T_BIGC_T);
1096 #if defined HAVE_MPFR && defined WITH_MPFR
1097 ent_lift_register(BIGFR_T, BIGC_T, ent_lift_BIGFR_T_BIGC_T);
1100 ent_lift_register(FLOAT_T, BIGC_T, ent_lift_FLOAT_T_BIGC_T);
1102 ent_lift_register(BIGG_T, BIGC_T, ent_lift_BIGG_T_BIGC_T);
1103 ent_lift_register(BIGC_T, BIGC_T, ent_lift_BIGC_T_BIGC_T);
1106 void init_optables_BIGC_T(void)
1108 ent_mpc_nullary_optable_init();
1109 ent_mpc_unary_optable_init();
1110 ent_mpc_binary_optable_init();
1111 ent_mpc_unary_reltable_init();
1112 ent_mpc_binary_reltable_init();
1113 ent_mpc_lifttable_init();
1116 void init_ent_mpc(void)
1118 bigc_init(ent_scratch_bigc);
1121 void syms_of_ent_mpc(void)
1123 INIT_LRECORD_IMPLEMENTATION(bigc);
1125 DEFSUBR(Fbigc_get_precision);
1126 DEFSUBR(Fbigc_set_precision);
1127 DEFSUBR(Fmake_bigc);
1130 void vars_of_ent_mpc(void)
1132 Fprovide(intern("bigc"));