cgit.sxemacs.org Git - sxemacs/blob - src/ent/ent-pseumpc.c

   1 /*
   2   ent-pseumpc.c -- Numeric types for SXEmacs
   3   Copyright (C) 2005, 2006 Sebastian Freundt
   4
   5   Author:  Sebastian Freundt
   6
   7 This file is part of SXEmacs
   8
   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.
  13
  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.
  18
  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/>. */
  21
  22
  23 #include <config.h>
  24 #include <limits.h>
  25 #include <math.h>
  26 #include "lisp.h"
  27 #include "sysproc.h"    /* For qxe_getpid */
  28
  29 #include "ent-pseumpc.h"
  30
  31 bigc ent_scratch_bigc;
  32 static ase_nullary_operation_f Qent_mpc_zero, Qent_mpc_one;
  33
  34 \f
  35 static void
  36 bigc_print(Lisp_Object obj, Lisp_Object printcharfun, int SXE_UNUSED(escapeflag))
  37 {
  38         Bufbyte *fstr = bigc_to_string(XBIGC_DATA(obj), 10);
  39         write_c_string((char*)fstr, printcharfun);
  40         xfree(fstr);
  41         fstr = (Bufbyte *)NULL;
  42         return;
  43 }
  44
  45 static int
  46 bigc_equal (Lisp_Object obj1, Lisp_Object obj2, int SXE_UNUSED(depth))
  47 {
  48         return bigc_eq(XBIGC_DATA(obj1), XBIGC_DATA(obj2));
  49 }
  50
  51 static unsigned long
  52 bigc_hash (Lisp_Object obj, int SXE_UNUSED(depth))
  53 {
  54         return bigc_hashcode(XBIGC_DATA(obj));
  55 }
  56
  57 static Lisp_Object
  58 bigc_mark (Lisp_Object SXE_UNUSED(obj))
  59 {
  60         return Qnil;
  61 }
  62
  63 static void
  64 bigc_finalise (void *SXE_UNUSED(header), int for_disksave)
  65 {
  66         if (for_disksave)
  67                 signal_simple_error
  68                         ("Can't dump an emacs containing MPC objects",Qt);
  69         return;
  70 }
  71
  72 static const struct lrecord_description bigc_description[] = {
  73         { XD_OPAQUE_DATA_PTR, offsetof(Lisp_Bigc, data) },
  74         { XD_END }
  75 };
  76
  77 DEFINE_BASIC_LRECORD_IMPLEMENTATION("bigc", bigc,
  78                                     bigc_mark, bigc_print, bigc_finalise,
  79                                     bigc_equal, bigc_hash,
  80                                     bigc_description, Lisp_Bigc);
  81
  82
  83
  84 DEFUN ("bigc-get-precision", Fbigc_get_precision, 1, 1, 0, /*
  85 Return the precision of bigc C as an integer.
  86 */
  87        (c))
  88 {
  89         CHECK_BIGC(c);
  90         return make_integer((signed long)XBIGC_GET_PREC(c));
  91 }
  92
  93 DEFUN ("bigc-set-precision", Fbigc_set_precision, 2, 2, 0, /*
  94 Set the precision of C, a bigc, to PRECISION, a nonnegative integer.
  95 The new precision of C is returned.  Note that the return value may differ
  96 from PRECISION if the underlying library is unable to support exactly
  97 PRECISION bits of precision.
  98 */
  99        (c, precision))
 100 {
 101         unsigned long prec;
 102
 103         CHECK_BIGC(c);
 104         if (INTP(precision)) {
 105                 prec = (XINT(precision) <= 0)
 106                         ? MPFR_PREC_MIN : (unsigned long)XINT(precision);
 107         }
 108 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
 109         else if (BIGZP(precision)) {
 110                 prec = bigz_fits_ulong_p(XBIGZ_DATA(precision))
 111                         ? bigz_to_ulong(XBIGZ_DATA(precision))
 112                         : UINT_MAX;
 113         }
 114 #endif  /* HAVE_MPZ */
 115         else {
 116                 dead_wrong_type_argument(Qintegerp, c);
 117                 return Qnil;
 118         }
 119
 120         XBIGC_SET_PREC(c, prec);
 121         return Fbigc_get_precision(c);
 122 }
 123
 124 DEFUN ("make-bigc", Fmake_bigc, 2, 2, 0, /*
 125 Return the bigc number whose real component is REAL-PART and
 126 whose imaginary component is IMAGINARY-PART.
 127 */
 128        (real_part, imaginary_part))
 129 {
 130         Lisp_Object result;
 131
 132         CHECK_COMPARABLE(real_part);
 133         CHECK_COMPARABLE(imaginary_part);
 134
 135         real_part = Fcoerce_number(
 136                 real_part, Qbigfr, Qnil);
 137         imaginary_part = Fcoerce_number(
 138                 imaginary_part, Qbigfr, Qnil);
 139
 140         /* check if one of the components is not-a-number
 141          * set both components NaN in that case
 142          */
 143         if (bigfr_nan_p(XBIGFR_DATA(real_part)) ||
 144             bigfr_nan_p(XBIGFR_DATA(imaginary_part))) {
 145                 bigfr_set_nan(XBIGFR_DATA(real_part));
 146                 bigfr_set_nan(XBIGFR_DATA(imaginary_part));
 147         } else if (bigfr_inf_p(XBIGFR_DATA(real_part)) ||
 148                    bigfr_inf_p(XBIGFR_DATA(imaginary_part))) {
 149                 bigfr_set_pinf(XBIGFR_DATA(real_part));
 150                 bigfr_set_pinf(XBIGFR_DATA(imaginary_part));
 151         }
 152
 153         result =  make_bigc_bfr(XBIGFR_DATA(real_part),
 154                                 XBIGFR_DATA(imaginary_part),
 155                                 internal_get_precision(Qnil));
 156
 157         return result;
 158 }
 159
 160 \f
 161 /* basic functions */
 162 void bigc_init(bigc c)
 163 {
 164         bigfr_init(bigc_re(c));
 165         bigfr_init(bigc_im(c));
 166 }
 167
 168 void bigc_init_prec(bigc c, unsigned long prec)
 169 {
 170         bigfr_init_prec(bigc_re(c), prec);
 171         bigfr_init_prec(bigc_im(c), prec);
 172 }
 173
 174 void bigc_init_2prec(bigc c, unsigned long prec1, unsigned long prec2)
 175 {
 176         bigfr_init_prec(bigc_re(c), prec1);
 177         bigfr_init_prec(bigc_im(c), prec2);
 178 }
 179
 180 void bigc_fini(bigc c)
 181 {
 182         bigfr_fini(bigc_re(c));
 183         bigfr_fini(bigc_im(c));
 184 }
 185
 186 #if 0
 187 unsigned long bigc_hashcode(bigc c)
 188 {
 189         return (bigfr_hashcode(bigc_re(c)) ^
 190                 bigfr_hashcode(bigc_im(c)));
 191 }
 192 #endif  /* already have a macro */
 193
 194
 195 void bigc_set_prec(bigc c, unsigned long prec)
 196 {
 197         bigfr_set_prec(bigc_re(c), prec);
 198         bigfr_set_prec(bigc_im(c), prec);
 199 }
 200
 201
 202 \f
 203 int bigc_nan_p(bigc c)
 204 {
 205         return (bigfr_nan_p(bigc_re(c)) ||
 206                 bigfr_nan_p(bigc_im(c)));
 207 }
 208
 209 int bigc_inf_p(bigc c)
 210 {
 211         return (bigfr_inf_p(bigc_re(c)) ||
 212                 bigfr_inf_p(bigc_im(c)));
 213 }
 214
 215 \f
 216 Bufbyte *bigc_to_string(bigc c, int base)
 217 {
 218         Bufbyte *re_str;
 219         Bufbyte *im_str;
 220         int re_len, im_len;
 221
 222         /* if one of the components is infinity or not a number,
 223          * just print the respective component
 224          * +infinity+2i does not really make sense, that's why!
 225          */
 226         if (bigc_nan_p(c)) {
 227                 re_str = indef_to_string((indef)NOT_A_NUMBER);
 228                 return re_str;
 229         } else if (bigc_inf_p(c)) {
 230                 re_str = indef_to_string((indef)COMPLEX_INFINITY);
 231                 return re_str;
 232         } else {
 233                 /* fetch the components' strings */
 234                 re_str = bigfr_to_string(bigc_re(c), base);
 235                 im_str = bigfr_to_string(bigc_im(c), base);
 236
 237                 re_len = strlen((char*)re_str);
 238                 im_len = strlen((char*)im_str);
 239
 240                 const int sign = bigfr_sign(bigc_im(c));
 241                 const int neg = (sign >= 0) ? 1 : 0;
 242
 243                 /* now append the imaginary string */
 244                 XREALLOC_ARRAY(re_str, Bufbyte, re_len + neg + im_len + 2);
 245                 if (neg)
 246                         re_str[re_len] = '+';
 247                 memmove(&re_str[re_len + neg],
 248                         &im_str[0],
 249                         im_len);
 250                 re_str[re_len+neg+im_len] = 'i';
 251                 re_str[re_len+neg+im_len+1] = '\0';
 252                 free(im_str);
 253
 254                 return re_str;
 255         }
 256 }
 257
 258 /***** Bigg: converting assignments *****/
 259 void bigc_set(bigc c1,bigc c2)
 260 {
 261         bigfr_set(bigc_re(c1), bigc_re(c2));
 262         bigfr_set(bigc_im(c1), bigc_im(c2));
 263 }
 264
 265 void bigc_set_long(bigc c, long l)
 266 {
 267         bigfr_set_long(bigc_re(c), l);
 268         bigfr_set_long(bigc_im(c), 0L);
 269 }
 270
 271 void bigc_set_long_long(bigc c, long l1, long l2)
 272 {
 273         bigfr_set_long(bigc_re(c), l1);
 274         bigfr_set_long(bigc_im(c), l2);
 275 }
 276
 277 void bigc_set_ulong(bigc c, unsigned long ul)
 278 {
 279         bigfr_set_ulong(bigc_re(c), ul);
 280         bigfr_set_ulong(bigc_im(c), 0UL);
 281 }
 282
 283 void bigc_set_ulong_ulong(bigc c, unsigned long ul1, unsigned long ul2)
 284 {
 285         bigfr_set_ulong(bigc_re(c), ul1);
 286         bigfr_set_ulong(bigc_im(c), ul2);
 287 }
 288
 289 void bigc_set_fpfloat(bigc c, fpfloat f)
 290 {
 291         bigfr_set_fpfloat(bigc_re(c), f);
 292         bigfr_set_long(bigc_im(c), 0L);
 293 }
 294
 295 void bigc_set_fpfloat_fpfloat(bigc c, fpfloat f1, fpfloat f2)
 296 {
 297         bigfr_set_fpfloat(bigc_re(c), f1);
 298         bigfr_set_fpfloat(bigc_im(c), f2);
 299 }
 300
 301 void bigc_set_bigfr(bigc c, bigfr f)
 302 {
 303         bigfr_set(bigc_re(c), f);
 304         bigfr_set_long(bigc_im(c), 0L);
 305 }
 306
 307 void bigc_set_bigfr_bigfr(bigc c, bigfr f1, bigfr f2)
 308 {
 309         bigfr_set(bigc_re(c), f1);
 310         bigfr_set(bigc_im(c), f2);
 311 }
 312
 313 /* void bigc_set_bigc(bigc c, bigc c)
 314  * {
 315  *      bigc_set_bigfr_bigfr(bigc_re(c), z1);
 316  * }
 317  */
 318
 319 /***** Bigc: comparisons *****/
 320 int bigc_eq(bigc c1, bigc c2)
 321 {
 322         return ((bigfr_eq(bigc_re(c1), bigc_re(c2))) &&
 323                 (bigfr_eq(bigc_im(c1), bigc_im(c2))));
 324 }
 325
 326 /***** Bigc: arithmetic *****/
 327 void bigc_abs(bigfr res, bigc c)
 328 {
 329         /* the absolute archimedean valuation of a+bi is defined as:
 330          * (a^2 + b^2)^(1/2)
 331          */
 332         bigfr accu1, accu2, bf;
 333         bigfr_init(accu1);
 334         bigfr_init(accu2);
 335         bigfr_init(bf);
 336
 337         bigfr_mul(accu1, bigc_re(c), bigc_re(c));
 338         bigfr_mul(accu2, bigc_im(c), bigc_im(c));
 339         bigfr_add(bf, accu1, accu2);
 340
 341         bigfr_sqrt(res, bf);
 342
 343         bigfr_fini(accu1);
 344         bigfr_fini(accu2);
 345         bigfr_fini(bf);
 346 }
 347
 348 void bigc_norm(bigfr res, bigc c)
 349 {
 350         /* norm is the square of the absolute archimedean valuation */
 351         bigfr accu1, accu2;
 352         bigfr_init(accu1);
 353         bigfr_init(accu2);
 354
 355         bigfr_mul(accu1, bigc_re(c), bigc_re(c));
 356         bigfr_mul(accu2, bigc_im(c), bigc_im(c));
 357         bigfr_add(res, accu1, accu2);
 358
 359         bigfr_fini(accu1);
 360         bigfr_fini(accu2);
 361 }
 362
 363 void bigc_neg(bigc res, bigc c)
 364 {
 365         /* negation is defined point-wise */
 366         bigfr_neg(bigc_re(res), bigc_re(c));
 367         bigfr_neg(bigc_im(res), bigc_im(c));
 368 }
 369
 370 void bigc_conj(bigc res, bigc c)
 371 {
 372         bigc_set(res, c);
 373         bigfr_neg(bigc_im(res), bigc_im(res));
 374 }
 375
 376 void bigc_add(bigc res, bigc g1, bigc g2)
 377 {
 378         /* addition is defined point-wise */
 379         bigfr accu1, accu2;
 380         bigfr_init(accu1);
 381         bigfr_init(accu2);
 382
 383         bigfr_add(accu1, bigc_re(g1), bigc_re(g2));
 384         bigfr_add(accu2, bigc_im(g1), bigc_im(g2));
 385         bigc_set_bigfr_bigfr(res, accu1, accu2);
 386
 387         bigfr_fini(accu1);
 388         bigfr_fini(accu2);
 389 }
 390
 391 void bigc_sub(bigc res, bigc g1, bigc g2)
 392 {
 393         /* subtraction is defined point-wise */
 394         bigfr_sub(bigc_re(res), bigc_re(g1), bigc_re(g2));
 395         bigfr_sub(bigc_im(res), bigc_im(g1), bigc_im(g2));
 396 }
 397
 398 void bigc_mul(bigc res, bigc g1, bigc g2)
 399 {
 400         /* multiplication is defined as:
 401          * (a + bi)*(c + di) = (ac - bd) + (ad + bc)i
 402          */
 403         bigfr accu1, accu2, accu3, accu4;
 404         bigfr_init(accu1);
 405         bigfr_init(accu2);
 406         bigfr_init(accu3);
 407         bigfr_init(accu4);
 408
 409         bigfr_mul(accu1, bigc_re(g1), bigc_re(g2));
 410         bigfr_mul(accu2, bigc_im(g1), bigc_im(g2));
 411         bigfr_mul(accu3, bigc_re(g1), bigc_im(g2));
 412         bigfr_mul(accu4, bigc_im(g1), bigc_re(g2));
 413
 414         bigfr_sub(bigc_re(res), accu1, accu2);
 415         bigfr_add(bigc_im(res), accu3, accu4);
 416
 417         bigfr_fini(accu1);
 418         bigfr_fini(accu2);
 419         bigfr_fini(accu3);
 420         bigfr_fini(accu4);
 421 }
 422
 423 void bigc_div(bigc res, bigc g1, bigc g2)
 424 {
 425         /* division is defined as:
 426          * (a + bi) div (c + di) = ((a+bi)*(c-di)) div (c*c+d*d)
 427          */
 428         bigfr accu1, accu2;
 429         bigc accug;
 430         bigfr_init(accu1);
 431         bigfr_init(accu2);
 432         bigc_init(accug);
 433
 434         /* compute: c^2 + d^2 */
 435         bigfr_mul(accu1, bigc_re(g2), bigc_re(g2));
 436         bigfr_mul(accu2, bigc_im(g2), bigc_im(g2));
 437         bigfr_add(accu1, accu1, accu2);
 438
 439         /* do normal multiplication with conjugate of g2 */
 440         bigc_conj(accug, g2);
 441         bigc_mul(accug, g1, accug);
 442
 443         bigc_set(res, accug);
 444
 445         /* now divide (g1*conj(g2)) by c^2+d^2 (point-wise) */
 446         bigfr_div(bigc_re(res), bigc_re(accug), accu1);
 447         bigfr_div(bigc_im(res), bigc_im(accug), accu1);
 448
 449         bigc_fini(accug);
 450         bigfr_fini(accu2);
 451         bigfr_fini(accu1);
 452 }
 453
 454 void bigc_mod(bigc res, bigc g1, bigc g2)
 455 {
 456         /* the modulo relation is defined as:
 457          * (a + bi) mod (c + di) ~
 458          * (a+bi) - ((a+bi) div (c-di)) * (c+di)
 459          */
 460         bigc accug;
 461         bigc_init(accug);
 462
 463         /* do normal division */
 464         bigc_div(accug, g1, g2);
 465
 466         /* now re-multiply g2 */
 467         bigc_mul(accug, accug, g2);
 468
 469         /* and find the difference */
 470         bigc_sub(res, g1, accug);
 471
 472         bigc_fini(accug);
 473 }
 474
 475 void bigc_pow(bigc res, bigc g1, unsigned long g2)
 476 {
 477 #if defined(HAVE_MPZ) && defined(WITH_GMP)
 478         unsigned long i;
 479         bigfr resintg, resimag, tmpbz1, tmpbz2, tmpbz3, intg, imag;
 480
 481         bigfr_init(resintg);
 482         bigfr_init(resimag);
 483         bigfr_init(intg);
 484         bigfr_init(imag);
 485         bigfr_init(tmpbz1);
 486         bigfr_init(tmpbz2);
 487         bigfr_init(tmpbz3);
 488
 489         bigfr_set_long(resintg, 0L);
 490         bigfr_set_long(resimag, 0L);
 491
 492         bigfr_set(intg, bigc_re(g1));
 493         bigfr_set(imag, bigc_im(g1));
 494
 495         /* we compute using the binomial coefficients */
 496         for (i=0; i<=g2; i++) {
 497                 mpz_bin_uiui(ent_scratch_bigz, g2, i);
 498                 bigfr_set_bigz(ent_scratch_bigfr, ent_scratch_bigz);
 499                 if ((i & 1) == 0) {
 500                         /* real part changes */
 501                         bigfr_pow(tmpbz1, intg, g2-i);
 502                         bigfr_pow(tmpbz2, imag, i);
 503                         bigfr_mul(tmpbz3, tmpbz1, tmpbz2);
 504                         bigfr_mul(ent_scratch_bigfr, ent_scratch_bigfr, tmpbz3);
 505                         if (i % 4 == 0) {
 506                                 bigfr_add(resintg, resintg, ent_scratch_bigfr);
 507                         } else if (i % 4 == 2) {
 508                                 bigfr_sub(resintg, resintg, ent_scratch_bigfr);
 509                         }
 510                 } else {
 511                         /* imag part changes */
 512                         bigfr_pow(tmpbz1, intg, g2-i);
 513                         bigfr_pow(tmpbz2, imag, i);
 514                         bigfr_mul(tmpbz3, tmpbz1, tmpbz2);
 515                         bigfr_mul(ent_scratch_bigfr, ent_scratch_bigfr, tmpbz3);
 516                         if (i % 4 == 1) {
 517                                 bigfr_add(resimag, resimag, ent_scratch_bigfr);
 518                         } else if (i % 4 == 3) {
 519                                 bigfr_sub(resimag, resimag, ent_scratch_bigfr);
 520                         }
 521                 }
 522         }
 523
 524         bigc_set_bigfr_bigfr(res, resintg, resimag);
 525
 526         bigfr_fini(intg);
 527         bigfr_fini(imag);
 528         bigfr_init(resintg);
 529         bigfr_init(resimag);
 530         bigfr_fini(tmpbz1);
 531         bigfr_fini(tmpbz2);
 532         bigfr_fini(tmpbz3);
 533 #else  /* !WITH_MPZ */
 534         bigc_set_long_long(res, 0L, 0L);
 535 #endif  /* WITH_MPZ */
 536 }
 537
 538 void bigc_sqrt(bigc res, bigc c)
 539 {
 540         bigfr tmpnorm, tmphalf;
 541
 542         bigfr_init(tmpnorm);
 543         bigfr_init(tmphalf);
 544
 545         /* \sqrt{x+iy} =
 546          * \sqrt{\frac{\left|x+iy\right| + x}{2}} \pm
 547          * i \sqrt{\frac{\left|x+iy\right| - x}{2}}
 548          */
 549         /* compute norm and add/sub real-part */
 550         bigc_abs(tmpnorm, c);
 551         bigfr_add(bigc_re(res), tmpnorm, bigc_re(c));
 552         bigfr_sub(bigc_im(res), tmpnorm, bigc_re(c));
 553
 554         /* compute 1/2 and divide the above by it */
 555         bigfr_set_long(tmphalf, 2);
 556         bigfr_div(bigc_re(res), bigc_re(res), tmphalf);
 557         bigfr_div(bigc_im(res), bigc_im(res), tmphalf);
 558
 559         /* compute square root */
 560         bigfr_sqrt(bigc_re(res), bigc_re(res));
 561         bigfr_sqrt(bigc_im(res), bigc_im(res));
 562
 563         bigfr_fini(tmphalf);
 564         bigfr_init(tmpnorm);
 565 }
 566
 567 /* bigc ops */
 568 static inline int
 569 ent_mpc_zerop(Lisp_Object l)
 570 {
 571         return (bigfr_sign(bigc_re(XBIGC_DATA(l))) == 0 &&
 572                 bigfr_sign(bigc_im(XBIGC_DATA(l))) == 0);
 573 }
 574
 575 static inline int
 576 ent_mpc_onep(Lisp_Object l)
 577 {
 578         return (bigfr_to_fpfloat(bigc_re(XBIGC_DATA(l))) == 1.0f &&
 579                 bigfr_sign(bigc_im(XBIGC_DATA(l))) == 0);
 580 }
 581
 582 static inline int
 583 ent_mpc_unitp(Lisp_Object unused)
 584 {
 585         return 1;
 586 }
 587
 588 static inline Lisp_Object
 589 ent_sum_BIGC_T(Lisp_Object l, Lisp_Object r)
 590 {
 591         bigc_set_prec(ent_scratch_bigc,
 592                        max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
 593         bigc_add(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
 594         return make_bigc_bc(ent_scratch_bigc);
 595 }
 596 static inline Lisp_Object
 597 ent_sum_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 598 {
 599         struct ent_lift_args_s la;
 600
 601         CHECK_COMPARABLE(r);
 602
 603         la.precision = XBIGC_GET_PREC(l);
 604         r = ent_lift(r, BIGFR_T, &la);
 605
 606         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
 607         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
 608         bigc_add(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
 609         return make_bigc_bc(ent_scratch_bigc);
 610 }
 611 static inline Lisp_Object
 612 ent_sum_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
 613 {
 614         return ent_sum_BIGC_T_COMPARABLE(r, l);
 615 }
 616 static inline Lisp_Object
 617 ent_sum_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
 618 {
 619         struct ent_lift_args_s la;
 620
 621         CHECK_COMPLEX(r);
 622
 623         la.precision = XBIGC_GET_PREC(l);
 624         r = ent_lift(r, BIGC_T, &la);
 625
 626         return ent_sum_BIGC_T(l, r);
 627 }
 628 static inline Lisp_Object
 629 ent_sum_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
 630 {
 631         return ent_sum_BIGC_T_COMPLEX(r, l);
 632 }
 633
 634 static inline Lisp_Object
 635 ent_diff_BIGC_T(Lisp_Object l, Lisp_Object r)
 636 {
 637         bigc_set_prec(ent_scratch_bigc,
 638                        max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
 639         bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
 640         return make_bigc_bc(ent_scratch_bigc);
 641 }
 642 static inline Lisp_Object
 643 ent_diff_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 644 {
 645         struct ent_lift_args_s la;
 646
 647         CHECK_COMPARABLE(r);
 648
 649         la.precision = XBIGC_GET_PREC(l);
 650         r = ent_lift(r, BIGFR_T, &la);
 651
 652         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
 653         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
 654         bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
 655         return make_bigc_bc(ent_scratch_bigc);
 656 }
 657 static inline Lisp_Object
 658 ent_diff_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
 659 {
 660         struct ent_lift_args_s la;
 661
 662         CHECK_COMPARABLE(l);
 663
 664         la.precision = XBIGC_GET_PREC(r);
 665         l = ent_lift(l, BIGFR_T, &la);
 666
 667         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
 668         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(l));
 669         bigc_sub(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
 670         return make_bigc_bc(ent_scratch_bigc);
 671 }
 672 static inline Lisp_Object
 673 ent_diff_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
 674 {
 675         struct ent_lift_args_s la;
 676
 677         CHECK_COMPLEX(r);
 678
 679         la.precision = XBIGC_GET_PREC(l);
 680         r = ent_lift(r, BIGC_T, &la);
 681
 682         return ent_diff_BIGC_T(l, r);
 683 }
 684 static inline Lisp_Object
 685 ent_diff_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
 686 {
 687         struct ent_lift_args_s la;
 688
 689         CHECK_COMPLEX(l);
 690
 691         la.precision = XBIGC_GET_PREC(r);
 692         l = ent_lift(l, BIGC_T, &la);
 693
 694         return ent_diff_BIGC_T(l, r);
 695 }
 696
 697 static inline Lisp_Object
 698 ent_neg_BIGC_T(Lisp_Object l)
 699 {
 700         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
 701         bigc_neg(ent_scratch_bigc, XBIGC_DATA(l));
 702         return make_bigc_bc(ent_scratch_bigc);
 703 }
 704
 705 static inline Lisp_Object
 706 ent_prod_BIGC_T(Lisp_Object l, Lisp_Object r)
 707 {
 708         bigc_set_prec(ent_scratch_bigc,
 709                        max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
 710         bigc_mul(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
 711         return make_bigc_bc(ent_scratch_bigc);
 712 }
 713 static inline Lisp_Object
 714 ent_prod_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 715 {
 716         struct ent_lift_args_s la;
 717
 718         CHECK_COMPARABLE(r);
 719
 720         la.precision = XBIGC_GET_PREC(l);
 721         r = ent_lift(r, BIGFR_T, &la);
 722
 723         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
 724         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
 725         bigc_mul(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
 726         return make_bigc_bc(ent_scratch_bigc);
 727 }
 728 static inline Lisp_Object
 729 ent_prod_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
 730 {
 731         return ent_prod_BIGC_T_COMPARABLE(r, l);
 732 }
 733 static inline Lisp_Object
 734 ent_prod_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
 735 {
 736         struct ent_lift_args_s la;
 737
 738         CHECK_COMPLEX(r);
 739
 740         la.precision = XBIGC_GET_PREC(l);
 741         r = ent_lift(r, BIGC_T, &la);
 742
 743         return ent_prod_BIGC_T(l, r);
 744 }
 745 static inline Lisp_Object
 746 ent_prod_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
 747 {
 748         return ent_prod_BIGC_T_COMPLEX(r, l);
 749 }
 750
 751 static inline Lisp_Object
 752 ent_div_BIGC_T(Lisp_Object l, Lisp_Object r)
 753 {
 754         if (ent_mpc_zerop(r)) {
 755                 if (!ent_mpc_zerop(l)) {
 756                         return make_indef(COMPLEX_INFINITY);
 757                 } else {
 758                         return make_indef(NOT_A_NUMBER);
 759                 }
 760         }
 761         bigc_set_prec(ent_scratch_bigc,
 762                       max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
 763         bigc_div(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
 764         return make_bigc_bc(ent_scratch_bigc);
 765 }
 766 static inline Lisp_Object
 767 ent_div_BIGC_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 768 {
 769         struct ent_lift_args_s la;
 770
 771         CHECK_COMPARABLE(r);
 772
 773         if (ent_unrel(ASE_UNARY_REL_ZEROP, r)) {
 774                 if (!ent_mpc_zerop(l)) {
 775                         return make_indef(COMPLEX_INFINITY);
 776                 } else {
 777                         return make_indef(NOT_A_NUMBER);
 778                 }
 779         }
 780
 781         la.precision = XBIGC_GET_PREC(l);
 782         r = ent_lift(r, BIGFR_T, &la);
 783
 784         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(l));
 785         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(r));
 786         bigc_div(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
 787         return make_bigc_bc(ent_scratch_bigc);
 788 }
 789 static inline Lisp_Object
 790 ent_div_COMPARABLE_BIGC_T(Lisp_Object l, Lisp_Object r)
 791 {
 792         struct ent_lift_args_s la;
 793
 794         CHECK_COMPARABLE(l);
 795
 796         if (ent_mpc_zerop(r)) {
 797                 if (!ent_unrel(ASE_UNARY_REL_ZEROP, l)) {
 798                         return make_indef(COMPLEX_INFINITY);
 799                 } else {
 800                         return make_indef(NOT_A_NUMBER);
 801                 }
 802         }
 803
 804         la.precision = XBIGC_GET_PREC(r);
 805         l = ent_lift(l, BIGFR_T, &la);
 806
 807         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
 808         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(l));
 809         bigc_div(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
 810         return make_bigc_bc(ent_scratch_bigc);
 811 }
 812 static inline Lisp_Object
 813 ent_div_BIGC_T_COMPLEX(Lisp_Object l, Lisp_Object r)
 814 {
 815         struct ent_lift_args_s la;
 816
 817         CHECK_COMPLEX(r);
 818
 819         if (ent_unrel(ASE_UNARY_REL_ZEROP, r)) {
 820                 if (!ent_mpc_zerop(l)) {
 821                         return make_indef(COMPLEX_INFINITY);
 822                 } else {
 823                         return make_indef(NOT_A_NUMBER);
 824                 }
 825         }
 826
 827         la.precision = XBIGC_GET_PREC(l);
 828         r = ent_lift(r, BIGC_T, &la);
 829
 830         return ent_div_BIGC_T(l, r);
 831 }
 832 static inline Lisp_Object
 833 ent_div_COMPLEX_BIGC_T(Lisp_Object l, Lisp_Object r)
 834 {
 835         struct ent_lift_args_s la;
 836
 837         CHECK_COMPLEX(l);
 838
 839         if (ent_mpc_zerop(r)) {
 840                 if (!ent_unrel(ASE_UNARY_REL_ZEROP, l)) {
 841                         return make_indef(COMPLEX_INFINITY);
 842                 } else {
 843                         return make_indef(NOT_A_NUMBER);
 844                 }
 845         }
 846
 847         la.precision = XBIGC_GET_PREC(r);
 848         l = ent_lift(l, BIGC_T, &la);
 849
 850         return ent_div_BIGC_T(l, r);
 851 }
 852
 853 static inline Lisp_Object
 854 ent_inv_BIGC_T(Lisp_Object r)
 855 {
 856         if (ent_mpc_zerop(r)) {
 857                 return make_indef(COMPLEX_INFINITY);
 858         }
 859         bigc_set_long(ent_scratch_bigc, 1L);
 860         bigc_set_prec(ent_scratch_bigc, XBIGC_GET_PREC(r));
 861         bigc_div(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
 862         return make_bigc_bc(ent_scratch_bigc);
 863 }
 864
 865 static inline Lisp_Object
 866 ent_rem_BIGC_T(Lisp_Object unused, Lisp_Object r)
 867 {
 868         return Qent_mpc_zero;
 869 }
 870
 871 static inline Lisp_Object
 872 ent_mod_BIGC_T(Lisp_Object l, Lisp_Object r)
 873 {
 874         if (ent_mpc_zerop(r)) {
 875                 return Qent_mpc_zero;
 876         }
 877         bigc_set_prec(ent_scratch_bigc,
 878                       max(XBIGC_GET_PREC(l), XBIGC_GET_PREC(r)));
 879         bigc_div(ent_scratch_bigc, XBIGC_DATA(l), XBIGC_DATA(r));
 880         bigfr_trunc(bigc_re(ent_scratch_bigc), bigc_re(ent_scratch_bigc));
 881         bigfr_trunc(bigc_im(ent_scratch_bigc), bigc_im(ent_scratch_bigc));
 882         bigc_mul(ent_scratch_bigc, ent_scratch_bigc, XBIGC_DATA(r));
 883         bigc_sub(ent_scratch_bigc, XBIGC_DATA(l), ent_scratch_bigc);
 884         return make_bigc_bc(ent_scratch_bigc);
 885 }
 886
 887 /* relations */
 888 static inline int
 889 ent_eq_BIGC_T(Lisp_Object l, Lisp_Object r)
 890 {
 891         return (bigfr_eq(bigc_re(XBIGC_DATA(l)), bigc_re(XBIGC_DATA(r))) &&
 892                 bigfr_eq(bigc_im(XBIGC_DATA(l)), bigc_im(XBIGC_DATA(r))));
 893 }
 894
 895 static inline int
 896 ent_ne_BIGC_T(Lisp_Object l, Lisp_Object r)
 897 {
 898         return (bigfr_eq(bigc_re(XBIGC_DATA(l)), bigc_re(XBIGC_DATA(r))) &&
 899                 bigfr_eq(bigc_im(XBIGC_DATA(l)), bigc_im(XBIGC_DATA(r))));
 900 }
 901
 902 #if 0
 903 static Lisp_Object ent_vallt_BIGC_T(Lisp_Object l, Lisp_Object r)
 904 {
 905         bigfr b2;
 906         int result;
 907
 908         bigfr_init(b2);
 909         bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
 910         bigfr_set_prec(b2, internal_get_precision(Qnil));
 911         bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
 912         bigc_norm(b2, XBIGC_DATA(r));
 913         result = bigfr_lt(ent_scratch_bigfr, b2);
 914
 915         bigfr_fini(b2);
 916         return (result) ? Qt : Qnil;
 917 }
 918 static Lisp_Object ent_valgt_BIGC_T(Lisp_Object l, Lisp_Object r)
 919 {
 920         bigfr b2;
 921         int result;
 922
 923         bigfr_init(b2);
 924         bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
 925         bigfr_set_prec(b2, internal_get_precision(Qnil));
 926         bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
 927         bigc_norm(b2, XBIGC_DATA(r));
 928         result = bigfr_gt(ent_scratch_bigfr, b2);
 929
 930         bigfr_fini(b2);
 931         return (result) ? Qt : Qnil;
 932 }
 933 static Lisp_Object ent_valeq_BIGC_T(Lisp_Object l, Lisp_Object r)
 934 {
 935         bigfr b2;
 936         int result;
 937
 938         bigfr_init(b2);
 939         bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
 940         bigfr_set_prec(b2, internal_get_precision(Qnil));
 941         bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
 942         bigc_norm(b2, XBIGC_DATA(r));
 943         result = bigfr_eq(ent_scratch_bigfr, b2);
 944
 945         bigfr_fini(b2);
 946         return (result) ? Qt : Qnil;
 947 }
 948 static Lisp_Object ent_valne_BIGC_T(Lisp_Object l, Lisp_Object r)
 949 {
 950         bigfr b2;
 951         int result;
 952
 953         bigfr_init(b2);
 954         bigfr_set_prec(ent_scratch_bigfr, internal_get_precision(Qnil));
 955         bigfr_set_prec(b2, internal_get_precision(Qnil));
 956         bigc_norm(ent_scratch_bigfr, XBIGC_DATA(l));
 957         bigc_norm(b2, XBIGC_DATA(r));
 958         result = bigfr_eq(ent_scratch_bigfr, b2);
 959
 960         bigfr_fini(b2);
 961         return (result) ? Qnil : Qt;
 962 }
 963 #endif
 964
 965 \f
 966 static inline Lisp_Object
 967 ent_lift_INT_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
 968 {
 969         unsigned long precision = la->precision;
 970
 971         bigc_set_prec(ent_scratch_bigc, precision);
 972         bigc_set_long(ent_scratch_bigc, ent_int(number));
 973         return make_bigc_bc(ent_scratch_bigc);
 974 }
 975
 976 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
 977 static inline Lisp_Object
 978 ent_lift_BIGZ_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
 979 {
 980         unsigned long precision = la->precision;
 981
 982         bigfr_set_prec(ent_scratch_bigfr, precision);
 983         bigfr_set_bigz(ent_scratch_bigfr, XBIGZ_DATA(number));
 984         bigc_set_prec(ent_scratch_bigc, precision);
 985         bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
 986         return make_bigc_bc(ent_scratch_bigc);
 987 }
 988 #endif  /* HAVE_MPZ */
 989
 990 #if defined HAVE_MPQ && defined WITH_GMP
 991 static inline Lisp_Object
 992 ent_lift_BIGQ_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
 993 {
 994         unsigned long precision = la->precision;
 995
 996         bigfr_set_prec(ent_scratch_bigfr, precision);
 997         bigfr_set_bigq(ent_scratch_bigfr, XBIGQ_DATA(number));
 998         bigc_set_prec(ent_scratch_bigc, precision);
 999         bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
1000         return make_bigc_bc(ent_scratch_bigc);
1001 }
1002 #endif  /* HAVE_MPQ */
1003
1004 #if defined HAVE_MPF && defined WITH_GMP
1005 static inline Lisp_Object
1006 ent_lift_BIGF_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
1007 {
1008         unsigned long precision = la->precision;
1009
1010         bigfr_set_prec(ent_scratch_bigfr, precision);
1011         bigfr_set_bigf(ent_scratch_bigfr, XBIGF_DATA(number));
1012         bigc_set_prec(ent_scratch_bigc, precision);
1013         bigc_set_bigfr(ent_scratch_bigc, ent_scratch_bigfr);
1014         return make_bigc_bc(ent_scratch_bigc);
1015 }
1016 #endif  /* HAVE_MPF */
1017
1018 #if defined HAVE_MPFR && defined WITH_MPFR
1019 static inline Lisp_Object
1020 ent_lift_BIGFR_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
1021 {
1022         unsigned long precision = la->precision;
1023
1024         /* warn about coercions of indefinite symbols */
1025         if (bigfr_inf_p(XBIGFR_DATA(number)))
1026                 return make_indef(COMPLEX_INFINITY);
1027         if (bigfr_nan_p(XBIGFR_DATA(number)))
1028                 return make_indef(NOT_A_NUMBER);
1029
1030         bigc_set_prec(ent_scratch_bigc, precision);
1031         bigc_set_bigfr(ent_scratch_bigc, XBIGFR_DATA(number));
1032         return make_bigc_bc(ent_scratch_bigc);
1033 }
1034 #endif  /* HAVE_MPF */
1035
1036 #ifdef HAVE_FPFLOAT
1037 static inline Lisp_Object
1038 ent_lift_FLOAT_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
1039 {
1040         unsigned long precision = la->precision;
1041
1042         bigc_set_prec(ent_scratch_bigc, precision);
1043         bigc_set_fpfloat(ent_scratch_bigc, XFLOAT_DATA(number));
1044         return make_bigc_bc(ent_scratch_bigc);
1045 }
1046 #endif
1047
1048 #if defined HAVE_PSEUG && defined WITH_PSEUG
1049 static inline Lisp_Object
1050 ent_lift_BIGG_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
1051 {
1052         unsigned long precision = la->precision;
1053         bigfr bfr_im, bfr_re;
1054         Lisp_Object result, re, im;
1055
1056         re = Freal_part(number);
1057         re = ent_lift(re, BIGFR_T, la);
1058         im = Fimaginary_part(number);
1059         im = ent_lift(im, BIGFR_T, la);
1060
1061         bigfr_init(bfr_re);
1062         bigfr_init(bfr_im);
1063
1064         bigfr_set(bfr_re, XBIGFR_DATA(re));
1065         bigfr_set(bfr_im, XBIGFR_DATA(im));
1066         result = make_bigc_bfr(bfr_re, bfr_im, precision);
1067
1068         bigfr_fini(bfr_re);
1069         bigfr_fini(bfr_im);
1070
1071         return result;
1072 }
1073 #endif
1074
1075 static inline Lisp_Object
1076 ent_lift_BIGC_T_BIGC_T(Lisp_Object number, ent_lift_args_t la)
1077 {
1078         unsigned long precision = la->precision;
1079
1080         bigc_set_prec(ent_scratch_bigc, precision);
1081         bigc_set(ent_scratch_bigc, XBIGC_DATA(number));
1082         return make_bigc_bc(ent_scratch_bigc);
1083 }
1084
1085 \f
1086 static inline void
1087 ent_mpc_nullary_optable_init(void)
1088 {
1089         Qent_mpc_zero = make_bigc(0.0f, 0.0f, internal_get_precision(Qnil));
1090         Qent_mpc_one = make_bigc(1.0f, 0.0f, internal_get_precision(Qnil));
1091         staticpro(&Qent_mpc_zero);
1092         staticpro(&Qent_mpc_one);
1093
1094         ent_nullop_register(ASE_NULLARY_OP_ZERO, BIGC_T, Qent_mpc_zero);
1095         ent_nullop_register(ASE_NULLARY_OP_ONE, BIGC_T, Qent_mpc_one);
1096 }
1097
1098 static inline void
1099 ent_mpc_unary_optable_init(void)
1100 {
1101         ent_unop_register(ASE_UNARY_OP_NEG, BIGC_T, ent_neg_BIGC_T);
1102         ent_unop_register(ASE_UNARY_OP_INV, BIGC_T, ent_inv_BIGC_T);
1103 }
1104
1105 static inline void
1106 ent_mpc_binary_optable_init(void)
1107 {
1108         /* sums */
1109         ent_binop_register(ASE_BINARY_OP_SUM,
1110                            BIGC_T, BIGC_T, ent_sum_BIGC_T);
1111         ent_binop_register(ASE_BINARY_OP_SUM,
1112                            BIGC_T, INT_T, ent_sum_BIGC_T_COMPARABLE);
1113         ent_binop_register(ASE_BINARY_OP_SUM,
1114                            INT_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
1115 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1116         ent_binop_register(ASE_BINARY_OP_SUM,
1117                            BIGC_T, BIGZ_T, ent_sum_BIGC_T_COMPARABLE);
1118         ent_binop_register(ASE_BINARY_OP_SUM,
1119                            BIGZ_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
1120 #endif
1121 #if defined HAVE_MPQ && defined WITH_GMP
1122         ent_binop_register(ASE_BINARY_OP_SUM,
1123                            BIGC_T, BIGQ_T, ent_sum_BIGC_T_COMPARABLE);
1124         ent_binop_register(ASE_BINARY_OP_SUM,
1125                            BIGQ_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
1126 #endif
1127 #if defined HAVE_MPF && defined WITH_GMP
1128         ent_binop_register(ASE_BINARY_OP_SUM,
1129                            BIGC_T, BIGF_T, ent_sum_BIGC_T_COMPARABLE);
1130         ent_binop_register(ASE_BINARY_OP_SUM,
1131                            BIGF_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
1132 #endif
1133 #if defined HAVE_MPFR && defined WITH_MPFR
1134         ent_binop_register(ASE_BINARY_OP_SUM,
1135                            BIGC_T, BIGFR_T, ent_sum_BIGC_T_COMPARABLE);
1136         ent_binop_register(ASE_BINARY_OP_SUM,
1137                            BIGFR_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
1138 #endif
1139 #ifdef HAVE_FPFLOAT
1140         ent_binop_register(ASE_BINARY_OP_SUM,
1141                            BIGC_T, FLOAT_T, ent_sum_BIGC_T_COMPARABLE);
1142         ent_binop_register(ASE_BINARY_OP_SUM,
1143                            FLOAT_T, BIGC_T, ent_sum_COMPARABLE_BIGC_T);
1144 #endif
1145 #if defined HAVE_PSEUG && defined WITH_PSEUG
1146         ent_binop_register(ASE_BINARY_OP_SUM,
1147                            BIGC_T, BIGG_T, ent_sum_BIGC_T_COMPLEX);
1148         ent_binop_register(ASE_BINARY_OP_SUM,
1149                            BIGG_T, BIGC_T, ent_sum_COMPLEX_BIGC_T);
1150 #endif
1151         /* diffs */
1152         ent_binop_register(ASE_BINARY_OP_DIFF,
1153                            BIGC_T, BIGC_T, ent_diff_BIGC_T);
1154         ent_binop_register(ASE_BINARY_OP_DIFF,
1155                            BIGC_T, INT_T, ent_diff_BIGC_T_COMPARABLE);
1156         ent_binop_register(ASE_BINARY_OP_DIFF,
1157                            INT_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
1158 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1159         ent_binop_register(ASE_BINARY_OP_DIFF,
1160                            BIGC_T, BIGZ_T, ent_diff_BIGC_T_COMPARABLE);
1161         ent_binop_register(ASE_BINARY_OP_DIFF,
1162                            BIGZ_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
1163 #endif
1164 #if defined HAVE_MPQ && defined WITH_GMP
1165         ent_binop_register(ASE_BINARY_OP_DIFF,
1166                            BIGC_T, BIGQ_T, ent_diff_BIGC_T_COMPARABLE);
1167         ent_binop_register(ASE_BINARY_OP_DIFF,
1168                            BIGQ_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
1169 #endif
1170 #if defined HAVE_MPF && defined WITH_GMP
1171         ent_binop_register(ASE_BINARY_OP_DIFF,
1172                            BIGC_T, BIGF_T, ent_diff_BIGC_T_COMPARABLE);
1173         ent_binop_register(ASE_BINARY_OP_DIFF,
1174                            BIGF_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
1175 #endif
1176 #if defined HAVE_MPFR && defined WITH_MPFR
1177         ent_binop_register(ASE_BINARY_OP_DIFF,
1178                            BIGC_T, BIGFR_T, ent_diff_BIGC_T_COMPARABLE);
1179         ent_binop_register(ASE_BINARY_OP_DIFF,
1180                            BIGFR_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
1181 #endif
1182 #ifdef HAVE_FPFLOAT
1183         ent_binop_register(ASE_BINARY_OP_DIFF,
1184                            BIGC_T, FLOAT_T, ent_diff_BIGC_T_COMPARABLE);
1185         ent_binop_register(ASE_BINARY_OP_DIFF,
1186                            FLOAT_T, BIGC_T, ent_diff_COMPARABLE_BIGC_T);
1187 #endif
1188 #if defined HAVE_PSEUG && defined WITH_PSEUG
1189         ent_binop_register(ASE_BINARY_OP_DIFF,
1190                            BIGC_T, BIGG_T, ent_diff_BIGC_T_COMPLEX);
1191         ent_binop_register(ASE_BINARY_OP_DIFF,
1192                            BIGG_T, BIGC_T, ent_diff_COMPLEX_BIGC_T);
1193 #endif
1194         /* prods */
1195         ent_binop_register(ASE_BINARY_OP_PROD,
1196                            BIGC_T, BIGC_T, ent_prod_BIGC_T);
1197         ent_binop_register(ASE_BINARY_OP_PROD,
1198                            BIGC_T, INT_T, ent_prod_BIGC_T_COMPARABLE);
1199         ent_binop_register(ASE_BINARY_OP_PROD,
1200                            INT_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
1201 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1202         ent_binop_register(ASE_BINARY_OP_PROD,
1203                            BIGC_T, BIGZ_T, ent_prod_BIGC_T_COMPARABLE);
1204         ent_binop_register(ASE_BINARY_OP_PROD,
1205                            BIGZ_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
1206 #endif
1207 #if defined HAVE_MPQ && defined WITH_GMP
1208         ent_binop_register(ASE_BINARY_OP_PROD,
1209                            BIGC_T, BIGQ_T, ent_prod_BIGC_T_COMPARABLE);
1210         ent_binop_register(ASE_BINARY_OP_PROD,
1211                            BIGQ_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
1212 #endif
1213 #if defined HAVE_MPF && defined WITH_GMP
1214         ent_binop_register(ASE_BINARY_OP_PROD,
1215                            BIGC_T, BIGF_T, ent_prod_BIGC_T_COMPARABLE);
1216         ent_binop_register(ASE_BINARY_OP_PROD,
1217                            BIGF_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
1218 #endif
1219 #if defined HAVE_MPFR && defined WITH_MPFR
1220         ent_binop_register(ASE_BINARY_OP_PROD,
1221                            BIGC_T, BIGFR_T, ent_prod_BIGC_T_COMPARABLE);
1222         ent_binop_register(ASE_BINARY_OP_PROD,
1223                            BIGFR_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
1224 #endif
1225 #ifdef HAVE_FPFLOAT
1226         ent_binop_register(ASE_BINARY_OP_PROD,
1227                            BIGC_T, FLOAT_T, ent_prod_BIGC_T_COMPARABLE);
1228         ent_binop_register(ASE_BINARY_OP_PROD,
1229                            FLOAT_T, BIGC_T, ent_prod_COMPARABLE_BIGC_T);
1230 #endif
1231 #if defined HAVE_PSEUG && defined WITH_PSEUG
1232         ent_binop_register(ASE_BINARY_OP_PROD,
1233                            BIGC_T, BIGG_T, ent_prod_BIGC_T_COMPLEX);
1234         ent_binop_register(ASE_BINARY_OP_PROD,
1235                            BIGG_T, BIGC_T, ent_prod_COMPLEX_BIGC_T);
1236 #endif
1237
1238         /* divisions and quotients */
1239         ent_binop_register(ASE_BINARY_OP_DIV,
1240                            BIGC_T, BIGC_T, ent_div_BIGC_T);
1241         ent_binop_register(ASE_BINARY_OP_DIV,
1242                            BIGC_T, INT_T, ent_div_BIGC_T_COMPARABLE);
1243         ent_binop_register(ASE_BINARY_OP_DIV,
1244                            INT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1245 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1246         ent_binop_register(ASE_BINARY_OP_DIV,
1247                            BIGC_T, BIGZ_T, ent_div_BIGC_T_COMPARABLE);
1248         ent_binop_register(ASE_BINARY_OP_DIV,
1249                            BIGZ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1250 #endif
1251 #if defined HAVE_MPQ && defined WITH_GMP
1252         ent_binop_register(ASE_BINARY_OP_DIV,
1253                            BIGC_T, BIGQ_T, ent_div_BIGC_T_COMPARABLE);
1254         ent_binop_register(ASE_BINARY_OP_DIV,
1255                            BIGQ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1256 #endif
1257 #if defined HAVE_MPF && defined WITH_GMP
1258         ent_binop_register(ASE_BINARY_OP_DIV,
1259                            BIGC_T, BIGF_T, ent_div_BIGC_T_COMPARABLE);
1260         ent_binop_register(ASE_BINARY_OP_DIV,
1261                            BIGF_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1262 #endif
1263 #if defined HAVE_MPFR && defined WITH_MPFR
1264         ent_binop_register(ASE_BINARY_OP_DIV,
1265                            BIGC_T, BIGFR_T, ent_div_BIGC_T_COMPARABLE);
1266         ent_binop_register(ASE_BINARY_OP_DIV,
1267                            BIGFR_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1268 #endif
1269 #ifdef HAVE_FPFLOAT
1270         ent_binop_register(ASE_BINARY_OP_DIV,
1271                            BIGC_T, FLOAT_T, ent_div_BIGC_T_COMPARABLE);
1272         ent_binop_register(ASE_BINARY_OP_DIV,
1273                            FLOAT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1274 #endif
1275 #if defined HAVE_PSEUG && defined WITH_PSEUG
1276         ent_binop_register(ASE_BINARY_OP_DIV,
1277                            BIGC_T, BIGG_T, ent_div_BIGC_T_COMPLEX);
1278         ent_binop_register(ASE_BINARY_OP_DIV,
1279                            BIGG_T, BIGC_T, ent_div_COMPLEX_BIGC_T);
1280 #endif
1281         ent_binop_register(ASE_BINARY_OP_QUO,
1282                            BIGC_T, BIGC_T, ent_div_BIGC_T);
1283 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1284         ent_binop_register(ASE_BINARY_OP_QUO,
1285                            BIGC_T, BIGZ_T, ent_div_BIGC_T_COMPARABLE);
1286         ent_binop_register(ASE_BINARY_OP_QUO,
1287                            BIGZ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1288 #endif
1289 #if defined HAVE_MPQ && defined WITH_GMP
1290         ent_binop_register(ASE_BINARY_OP_QUO,
1291                            BIGC_T, BIGQ_T, ent_div_BIGC_T_COMPARABLE);
1292         ent_binop_register(ASE_BINARY_OP_QUO,
1293                            BIGQ_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1294 #endif
1295 #if defined HAVE_MPF && defined WITH_GMP
1296         ent_binop_register(ASE_BINARY_OP_QUO,
1297                            BIGC_T, BIGF_T, ent_div_BIGC_T_COMPARABLE);
1298         ent_binop_register(ASE_BINARY_OP_QUO,
1299                            BIGF_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1300 #endif
1301 #if defined HAVE_MPFR && defined WITH_MPFR
1302         ent_binop_register(ASE_BINARY_OP_QUO,
1303                            BIGC_T, BIGFR_T, ent_div_BIGC_T_COMPARABLE);
1304         ent_binop_register(ASE_BINARY_OP_QUO,
1305                            BIGFR_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1306 #endif
1307 #ifdef HAVE_FPFLOAT
1308         ent_binop_register(ASE_BINARY_OP_QUO,
1309                            BIGC_T, FLOAT_T, ent_div_BIGC_T_COMPARABLE);
1310         ent_binop_register(ASE_BINARY_OP_QUO,
1311                            FLOAT_T, BIGC_T, ent_div_COMPARABLE_BIGC_T);
1312 #endif
1313 #if defined HAVE_PSEUG && defined WITH_PSEUG
1314         ent_binop_register(ASE_BINARY_OP_QUO,
1315                            BIGC_T, BIGG_T, ent_div_BIGC_T_COMPLEX);
1316         ent_binop_register(ASE_BINARY_OP_QUO,
1317                            BIGG_T, BIGC_T, ent_div_COMPLEX_BIGC_T);
1318 #endif
1319         ent_binop_register(ASE_BINARY_OP_REM,
1320                            BIGC_T, BIGC_T, ent_rem_BIGC_T);
1321         ent_binop_register(ASE_BINARY_OP_MOD,
1322                            BIGC_T, BIGC_T, ent_mod_BIGC_T);
1323 }
1324
1325 static inline void
1326 ent_mpc_unary_reltable_init(void)
1327 {
1328         ent_unrel_register(ASE_UNARY_REL_ZEROP, BIGC_T, ent_mpc_zerop);
1329         ent_unrel_register(ASE_UNARY_REL_ONEP, BIGC_T, ent_mpc_onep);
1330         ent_unrel_register(ASE_UNARY_REL_UNITP, BIGC_T, ent_mpc_unitp);
1331 }
1332
1333 static inline void
1334 ent_mpc_binary_reltable_init(void)
1335 {
1336         ent_binrel_register(ASE_BINARY_REL_EQUALP,
1337                             BIGC_T, BIGC_T, ent_eq_BIGC_T);
1338         ent_binrel_register(ASE_BINARY_REL_NEQP,
1339                             BIGC_T, BIGC_T, ent_ne_BIGC_T);
1340 }
1341
1342 static inline void
1343 ent_mpc_lifttable_init(void)
1344 {
1345         ent_lift_register(INT_T, BIGC_T, ent_lift_INT_T_BIGC_T);
1346 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
1347         ent_lift_register(BIGZ_T, BIGC_T, ent_lift_BIGZ_T_BIGC_T);
1348 #endif
1349 #if defined HAVE_MPQ && defined WITH_GMP
1350         ent_lift_register(BIGQ_T, BIGC_T, ent_lift_BIGQ_T_BIGC_T);
1351 #endif
1352 #if defined HAVE_MPF && defined WITH_GMP
1353         ent_lift_register(BIGF_T, BIGC_T, ent_lift_BIGF_T_BIGC_T);
1354 #endif
1355 #if defined HAVE_MPFR && defined WITH_MPFR
1356         ent_lift_register(BIGFR_T, BIGC_T, ent_lift_BIGFR_T_BIGC_T);
1357 #endif
1358 #ifdef HAVE_FPFLOAT
1359         ent_lift_register(FLOAT_T, BIGC_T, ent_lift_FLOAT_T_BIGC_T);
1360 #endif
1361 #if defined HAVE_PSEUG && defined WITH_PSEUG
1362         ent_lift_register(BIGG_T, BIGC_T, ent_lift_BIGG_T_BIGC_T);
1363 #endif
1364         ent_lift_register(BIGC_T, BIGC_T, ent_lift_BIGC_T_BIGC_T);
1365 }
1366
1367 void init_optables_BIGC_T(void)
1368 {
1369         ent_mpc_nullary_optable_init();
1370         ent_mpc_unary_optable_init();
1371         ent_mpc_binary_optable_init();
1372         ent_mpc_unary_reltable_init();
1373         ent_mpc_binary_reltable_init();
1374         ent_mpc_lifttable_init();
1375 }
1376
1377 void init_ent_mpc(void)
1378 {
1379         bigc_init(ent_scratch_bigc);
1380 }
1381
1382 void syms_of_ent_mpc(void)
1383 {
1384         INIT_LRECORD_IMPLEMENTATION(bigc);
1385
1386         DEFSUBR(Fbigc_get_precision);
1387         DEFSUBR(Fbigc_set_precision);
1388         DEFSUBR(Fmake_bigc);
1389 }
1390
1391 void vars_of_ent_mpc(void)
1392 {
1393         Fprovide(intern("bigc"));
1394 }