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

   1 /*
   2   ent-gaussian.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-gaussian.h"
  30 #ifdef HAVE_MPC
  31 #include "ent-mpc.h"
  32 #endif
  33
  34 bigg ent_scratch_bigg;
  35 static ase_nullary_operation_f Qent_gaussian_zero, Qent_gaussian_one;
  36
  37 \f
  38 static void
  39 bigg_print(Lisp_Object obj, Lisp_Object printcharfun, int SXE_UNUSED(escapeflag))
  40 {
  41         Bufbyte *fstr = bigg_to_string(XBIGG_DATA(obj), 10);
  42         write_c_string((char*)fstr, printcharfun);
  43         xfree(fstr);
  44         fstr = (Bufbyte *)NULL;
  45         return;
  46 }
  47
  48 static int
  49 bigg_equal(Lisp_Object obj1, Lisp_Object obj2, int depth)
  50 {
  51         return bigg_eql(XBIGG_DATA(obj1), XBIGG_DATA(obj2));
  52
  53         /* less warnings */
  54         if (depth);
  55 }
  56
  57 static unsigned long
  58 bigg_hash(Lisp_Object obj, int depth)
  59 {
  60         return bigg_hashcode(XBIGG_DATA(obj));
  61
  62         /* less warnings */
  63         if (depth);
  64 }
  65
  66 static Lisp_Object
  67 bigg_mark(Lisp_Object obj)
  68 {
  69         return Qnil;
  70
  71         /* less warnings */
  72         if (obj == Qnil);
  73 }
  74
  75 static void
  76 bigg_finalise(void *header, int for_disksave)
  77 {
  78         if (for_disksave)
  79                 signal_simple_error
  80                         ("Can't dump an emacs containing "
  81                          "pseudo-gaussian objects",Qt);
  82
  83         /* less warnings */
  84         if (header);
  85 }
  86
  87 static const struct lrecord_description bigg_description[] = {
  88         { XD_OPAQUE_DATA_PTR, offsetof(Lisp_Bigg, data) },
  89         { XD_END }
  90 };
  91
  92 DEFINE_BASIC_LRECORD_IMPLEMENTATION("bigg", bigg,
  93                                     bigg_mark, bigg_print, bigg_finalise,
  94                                     bigg_equal, bigg_hash,
  95                                     bigg_description, Lisp_Bigg);
  96
  97 DEFUN("make-bigg", Fmake_bigg, 2, 2, 0, /*
  98 Return the Gaussian number whose rational component is REAL-PART
  99 and whose imaginary component is IMAGINARY-PART.
 100 */
 101        (real_part, imaginary_part))
 102 {
 103         CHECK_COMPARABLE(real_part);
 104         CHECK_COMPARABLE(imaginary_part);
 105
 106         {
 107                 Lisp_Object tmp_r = Fcoerce_number(real_part, Qbigz, Qnil);
 108                 Lisp_Object tmp_i = Fcoerce_number(imaginary_part, Qbigz, Qnil);
 109                 return make_bigg_bz(XBIGZ_DATA(tmp_r), XBIGZ_DATA(tmp_i));
 110         }
 111 }
 112
 113 \f
 114 /* basic functions */
 115 void bigg_init(bigg g)
 116 {
 117         bigz_init(bigg_re(g));
 118         bigz_init(bigg_im(g));
 119 }
 120
 121 void bigg_fini(bigg g)
 122 {
 123         bigz_fini(bigg_re(g));
 124         bigz_fini(bigg_im(g));
 125 }
 126
 127 unsigned long bigg_hashcode(bigg g)
 128 {
 129         return (bigz_hashcode(bigg_re(g)) ^
 130                 bigz_hashcode(bigg_im(g)));
 131 }
 132
 133 Bufbyte *bigg_to_string(bigg g, int base)
 134 {
 135         Bufbyte *intg_str;
 136         Bufbyte *imag_str;
 137         int intg_len, imag_len;
 138         int sign, neg;
 139
 140         intg_str = (Bufbyte*)bigz_to_string(bigg_re(g), base);
 141         imag_str = (Bufbyte*)bigz_to_string(bigg_im(g), base);
 142
 143         intg_len = strlen((char*)intg_str);
 144         imag_len = strlen((char*)imag_str);
 145
 146         sign = bigz_sign(bigg_im(g));
 147         neg = (sign >= 0) ? 1 : 0;
 148
 149         /* now append the imaginary string */
 150         XREALLOC_ARRAY(intg_str, Bufbyte, intg_len + neg + imag_len + 2);
 151         if (neg)
 152                 intg_str[intg_len] = '+';
 153         memmove(&intg_str[intg_len + neg],
 154                 &imag_str[0],
 155                 imag_len);
 156         intg_str[intg_len+neg+imag_len] = 'i';
 157         intg_str[intg_len+neg+imag_len+1] = '\0';
 158         xfree(imag_str);
 159
 160         return intg_str;
 161 }
 162
 163 /***** Bigg: converting assignments *****/
 164 void bigg_set(bigg g1,bigg g2)
 165 {
 166         bigz_set(bigg_re(g1), bigg_re(g2));
 167         bigz_set(bigg_im(g1), bigg_im(g2));
 168 }
 169
 170 void bigg_set_long(bigg g, long l)
 171 {
 172         bigz_set_long(bigg_re(g), l);
 173         bigz_set_long(bigg_im(g), 0L);
 174 }
 175
 176 void bigg_set_long_long(bigg g, long l1, long l2)
 177 {
 178         bigz_set_long(bigg_re(g), l1);
 179         bigz_set_long(bigg_im(g), l2);
 180 }
 181
 182 void bigg_set_ulong(bigg g, unsigned long ul)
 183 {
 184         bigz_set_ulong(bigg_re(g), ul);
 185         bigz_set_ulong(bigg_im(g), 0UL);
 186 }
 187
 188 void bigg_set_ulong_ulong(bigg g, unsigned long ul1, unsigned long ul2)
 189 {
 190         bigz_set_ulong(bigg_re(g), ul1);
 191         bigz_set_ulong(bigg_im(g), ul2);
 192 }
 193
 194 void bigg_set_bigz(bigg g, bigz z)
 195 {
 196         bigz_set(bigg_re(g), z);
 197         bigz_set_long(bigg_im(g), 0L);
 198 }
 199
 200 void bigg_set_bigz_bigz(bigg g, bigz z1, bigz z2)
 201 {
 202         bigz_set(bigg_re(g), z1);
 203         bigz_set(bigg_im(g), z2);
 204 }
 205
 206 /* void bigc_set_bigg(bigc c, bigg g)
 207  * {
 208  *      bigc_set_bigfr_bigfr(bigg_re(g), z1);
 209  * }
 210  */
 211
 212 /***** Bigg: comparisons *****/
 213 int bigg_eql(bigg g1, bigg g2)
 214 {
 215         return ((bigz_eql(bigg_re(g1), bigg_re(g2))) &&
 216                 (bigz_eql(bigg_im(g1), bigg_im(g2))));
 217 }
 218
 219 /***** Bigg: arithmetic *****/
 220 #if defined HAVE_MPFR && defined WITH_MPFR
 221 void bigg_abs(bigfr res, bigg g)
 222 {
 223         /* the absolute archimedean valuation of a+bi is defined as:
 224          * (a^2 + b^2)^(1/2)
 225          */
 226         bigz accu1, accu2, bz;
 227         bigz_init(accu1);
 228         bigz_init(accu2);
 229         bigz_init(bz);
 230
 231         bigz_mul(accu1, bigg_re(g), bigg_re(g));
 232         bigz_mul(accu2, bigg_im(g), bigg_im(g));
 233         bigz_add(bz, accu1, accu2);
 234
 235         bigfr_set_bigz(res, bz);
 236         bigfr_sqrt(res, res);
 237
 238         bigz_fini(accu1);
 239         bigz_fini(accu2);
 240         bigz_fini(bz);
 241 }
 242 #endif
 243
 244 void bigg_norm(bigz res, bigg g)
 245 {
 246         /* norm is the square of the absolute archimedean valuation */
 247         bigz accu1, accu2;
 248         bigz_init(accu1);
 249         bigz_init(accu2);
 250
 251         bigz_mul(accu1, bigg_re(g), bigg_re(g));
 252         bigz_mul(accu2, bigg_im(g), bigg_im(g));
 253         bigz_add(res, accu1, accu2);
 254
 255         bigz_fini(accu1);
 256         bigz_fini(accu2);
 257 }
 258
 259 void bigg_neg(bigg res, bigg g)
 260 {
 261         /* negation is defined point-wise */
 262         bigz_neg(bigg_re(res), bigg_re(g));
 263         bigz_neg(bigg_im(res), bigg_im(g));
 264 }
 265
 266 void bigg_conj(bigg res, bigg g)
 267 {
 268         bigg_set(res, g);
 269         bigz_neg(bigg_im(res), bigg_im(res));
 270 }
 271
 272 void bigg_add(bigg res, bigg g1, bigg g2)
 273 {
 274         /* addition is defined point-wise */
 275         bigz accu1, accu2;
 276         bigz_init(accu1);
 277         bigz_init(accu2);
 278
 279         bigz_add(accu1, bigg_re(g1), bigg_re(g2));
 280         bigz_add(accu2, bigg_im(g1), bigg_im(g2));
 281         bigg_set_bigz_bigz(res, accu1, accu2);
 282
 283         bigz_fini(accu1);
 284         bigz_fini(accu2);
 285 }
 286
 287 void bigg_sub(bigg res, bigg g1, bigg g2)
 288 {
 289         /* subtraction is defined point-wise */
 290         bigz_sub(bigg_re(res), bigg_re(g1), bigg_re(g2));
 291         bigz_sub(bigg_im(res), bigg_im(g1), bigg_im(g2));
 292 }
 293
 294 void bigg_mul(bigg res, bigg g1, bigg g2)
 295 {
 296         /* multiplication is defined as:
 297          * (a + bi)*(c + di) = (ac - bd) + (ad + bc)i
 298          */
 299         bigz accu1, accu2, accu3, accu4;
 300         bigz_init(accu1);
 301         bigz_init(accu2);
 302         bigz_init(accu3);
 303         bigz_init(accu4);
 304
 305         bigz_mul(accu1, bigg_re(g1), bigg_re(g2));
 306         bigz_mul(accu2, bigg_im(g1), bigg_im(g2));
 307         bigz_mul(accu3, bigg_re(g1), bigg_im(g2));
 308         bigz_mul(accu4, bigg_im(g1), bigg_re(g2));
 309
 310         bigz_sub(bigg_re(res), accu1, accu2);
 311         bigz_add(bigg_im(res), accu3, accu4);
 312
 313         bigz_fini(accu1);
 314         bigz_fini(accu2);
 315         bigz_fini(accu3);
 316         bigz_fini(accu4);
 317 }
 318
 319 void bigg_div(bigg res, bigg g1, bigg g2)
 320 {
 321         /* division is defined as:
 322          * (a + bi) div (c + di) = ((a+bi)*(c-di)) div (c*c+d*d)
 323          */
 324         bigz accu1, accu2;
 325         bigg accug;
 326         bigz_init(accu1);
 327         bigz_init(accu2);
 328         bigg_init(accug);
 329
 330         /* compute: c^2 + d^2 */
 331         bigz_mul(accu1, bigg_re(g2), bigg_re(g2));
 332         bigz_mul(accu2, bigg_im(g2), bigg_im(g2));
 333         bigz_add(accu1, accu1, accu2);
 334
 335         /* do normal multiplication with conjugate of g2 */
 336         bigg_conj(accug, g2);
 337         bigg_mul(accug, g1, accug);
 338
 339         bigg_set(res, accug);
 340
 341         /* now divide (g1*conj(g2)) by c^2+d^2 (point-wise) */
 342         bigz_div(bigg_re(res), bigg_re(accug), accu1);
 343         bigz_div(bigg_im(res), bigg_im(accug), accu1);
 344
 345         bigg_fini(accug);
 346         bigz_fini(accu2);
 347         bigz_fini(accu1);
 348 }
 349
 350 void bigg_mod(bigg res, bigg g1, bigg g2)
 351 {
 352         /* the modulo relation is defined as:
 353          * (a + bi) mod (c + di) ~
 354          * (a+bi) - ((a+bi) div (c-di)) * (c+di)
 355          */
 356         bigg accug;
 357         bigg_init(accug);
 358
 359         /* do normal division */
 360         bigg_div(accug, g1, g2);
 361
 362         /* now re-multiply g2 */
 363         bigg_mul(accug, accug, g2);
 364
 365         /* and find the difference */
 366         bigg_sub(res, g1, accug);
 367
 368         bigg_fini(accug);
 369 }
 370
 371 void bigg_pow(bigg res, bigg g1, unsigned long g2)
 372 {
 373 #if defined(HAVE_MPZ) && defined(WITH_GMP)
 374         unsigned long i;
 375         bigz bin, resintg, resimag, tmpbz1, tmpbz2, tmpbz3, intg, imag;
 376
 377         bigz_init(bin);
 378         bigz_init(resintg);
 379         bigz_init(resimag);
 380         bigz_init(intg);
 381         bigz_init(imag);
 382         bigz_init(tmpbz1);
 383         bigz_init(tmpbz2);
 384         bigz_init(tmpbz3);
 385
 386         bigz_set_long(resintg, 0L);
 387         bigz_set_long(resimag, 0L);
 388
 389         bigz_set(intg, bigg_re(g1));
 390         bigz_set(imag, bigg_im(g1));
 391
 392         /* we compute using the binomial coefficients */
 393         for (i=0; i<=g2; i++) {
 394                 mpz_bin_uiui(bin, g2, i);
 395                 if (i % 2 == 0) {
 396                         /* real part changes */
 397                         bigz_pow(tmpbz1, intg, g2-i);
 398                         bigz_pow(tmpbz2, imag, i);
 399                         bigz_mul(tmpbz3, tmpbz1, tmpbz2);
 400                         bigz_mul(bin, bin, tmpbz3);
 401                         if (i % 4 == 0) {
 402                                 bigz_add(resintg, resintg, bin);
 403                         } else if (i % 4 == 2) {
 404                                 bigz_sub(resintg, resintg, bin);
 405                         }
 406                 } else {
 407                         /* imag part changes */
 408                         bigz_pow(tmpbz1, intg, g2-i);
 409                         bigz_pow(tmpbz2, imag, i);
 410                         bigz_mul(tmpbz3, tmpbz1, tmpbz2);
 411                         bigz_mul(bin, bin, tmpbz3);
 412                         if (i % 4 == 1) {
 413                                 bigz_add(resimag, resimag, bin);
 414                         } else if (i % 4 == 3) {
 415                                 bigz_sub(resimag, resimag, bin);
 416                         }
 417                 }
 418         }
 419
 420         bigg_set_bigz_bigz(res, resintg, resimag);
 421
 422         bigz_fini(bin);
 423         bigz_fini(intg);
 424         bigz_fini(imag);
 425         bigz_init(resintg);
 426         bigz_init(resimag);
 427         bigz_fini(tmpbz1);
 428         bigz_fini(tmpbz2);
 429         bigz_fini(tmpbz3);
 430 #else
 431         bigg_set_long_long(res, 0L, 0L);
 432 #endif
 433 }
 434
 435 Lisp_Object read_bigg_string(char *cp)
 436 {
 437         bigz bz_re, bz_im;
 438         int sign;
 439         Lisp_Object result;
 440         Bufbyte *end;
 441         Bufbyte tmp;
 442
 443         bigz_init(bz_re);
 444         bigz_init(bz_im);
 445
 446         /* MPZ bigz_set_string has no effect
 447          * with initial + sign */
 448         if (*cp == '+')
 449                 cp++;
 450
 451         end = (Bufbyte *)cp;
 452
 453         if (*cp == '-') {
 454                 /* jump over a leading minus */
 455                 cp++;
 456         }
 457
 458         while ((*cp >= '0' && *cp <= '9'))
 459                 cp++;
 460
 461         /* MPZ cannot read numbers with characters after them.
 462          * See limitations below in convert GMP-MPZ strings
 463          */
 464         tmp = (Bufbyte)*cp;
 465         *cp = '\0';
 466         bigz_set_string(bz_re, (char *)end, 0);
 467         *cp = tmp;
 468
 469         /* read the imaginary part */
 470         sign = 0;
 471         if (*cp == '+') {
 472                 cp++;
 473                 sign = 1;
 474         }
 475         if (*cp == '-') {
 476                 cp++;
 477                 sign = -1;
 478         }
 479         if ((*cp == 'i' || *cp == 'I') && (sign == 1)) {
 480                 /* expand +i to +1i and -i to -1i */
 481                 bigz_set_long(bz_im, 1L);
 482         } else if ((*cp == 'i' || *cp == 'I') && (sign == -1)) {
 483                 /* expand +i to +1i and -i to -1i */
 484                 bigz_set_long(bz_im, -1L);
 485         } else if (sign == 0) {
 486                 /* obviously we did not have a+bi,
 487                  * but merely bi
 488                  */
 489                 bigz_set(bz_im, bz_re);
 490                 bigz_set_long(bz_re, 0L);
 491         } else {
 492                 end = (Bufbyte*)cp;
 493                 if (sign == -1)
 494                         end--;
 495                 while ((*cp >= '0' && *cp <= '9'))
 496                         cp++;
 497                 tmp = (Bufbyte)*cp;
 498                 *cp = '\0';
 499                 bigz_set_string(bz_im, (char *)end, 0);
 500                 *cp = tmp;
 501         }
 502
 503         result = make_bigg_bz(bz_re, bz_im);
 504
 505         bigz_fini(bz_re);
 506         bigz_fini(bz_im);
 507         return result;
 508 }
 509
 510 /* bigg ops */
 511 static inline int
 512 ent_gaussian_zerop(Lisp_Object o)
 513 {
 514         return (bigz_sign(bigg_re(XBIGG_DATA(o))) == 0 &&
 515                 bigz_sign(bigg_im(XBIGG_DATA(o))) == 0);
 516 }
 517
 518 static inline int
 519 ent_gaussian_onep(Lisp_Object o)
 520 {
 521         return ((bigz_fits_long_p(bigg_re(XBIGG_DATA(o))) &&
 522                  bigz_to_long(bigg_re(XBIGG_DATA(o))) == 1L) &&
 523                 bigz_sign(bigg_im(XBIGG_DATA(o))) == 0);
 524 }
 525
 526 static inline int
 527 ent_gaussian_unitp(Lisp_Object o)
 528 {
 529         return (!ent_gaussian_zerop(o) &&
 530                 (bigz_fits_long_p(bigg_re(XBIGG_DATA(o))) &&
 531                  (bigz_to_long(bigg_re(XBIGG_DATA(o))) == 0L ||
 532                   bigz_to_long(bigg_re(XBIGG_DATA(o))) == 1L ||
 533                   bigz_to_long(bigg_re(XBIGG_DATA(o))) == -1L)) &&
 534                 (bigz_fits_long_p(bigg_im(XBIGG_DATA(o))) &&
 535                  (bigz_to_long(bigg_im(XBIGG_DATA(o))) == 0L ||
 536                   bigz_to_long(bigg_im(XBIGG_DATA(o))) == 1L ||
 537                   bigz_to_long(bigg_im(XBIGG_DATA(o))) == -1L)));
 538 }
 539
 540 static inline Lisp_Object
 541 ent_sum_BIGG_T(Lisp_Object l, Lisp_Object r)
 542 {
 543         bigg_add(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
 544         return make_bigg_bg(ent_scratch_bigg);
 545 }
 546 static inline Lisp_Object
 547 ent_sum_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 548 {
 549         CHECK_COMPARABLE(r);
 550
 551         r = ent_lift(r, BIGZ_T, NULL);
 552
 553         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
 554         bigg_add(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
 555         return make_bigg_bg(ent_scratch_bigg);
 556 }
 557 static inline Lisp_Object
 558 ent_sum_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
 559 {
 560         CHECK_COMPARABLE(l);
 561
 562         l = ent_lift(l, BIGZ_T, NULL);
 563
 564         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
 565         bigg_add(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
 566         return make_bigg_bg(ent_scratch_bigg);
 567 }
 568
 569 static inline Lisp_Object
 570 ent_diff_BIGG_T(Lisp_Object l, Lisp_Object r)
 571 {
 572         bigg_sub(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
 573         return make_bigg_bg(ent_scratch_bigg);
 574 }
 575 static inline Lisp_Object
 576 ent_diff_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 577 {
 578         CHECK_COMPARABLE(r);
 579
 580         r = ent_lift(r, BIGZ_T, NULL);
 581
 582         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
 583         bigg_sub(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
 584         return make_bigg_bg(ent_scratch_bigg);
 585 }
 586 static inline Lisp_Object
 587 ent_diff_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
 588 {
 589         CHECK_COMPARABLE(l);
 590
 591         l = ent_lift(l, BIGZ_T, NULL);
 592
 593         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
 594         bigg_sub(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
 595         return make_bigg_bg(ent_scratch_bigg);
 596 }
 597
 598 static inline Lisp_Object
 599 ent_neg_BIGG_T(Lisp_Object l)
 600 {
 601         bigg_neg(ent_scratch_bigg, XBIGG_DATA(l));
 602         return make_bigg_bg(ent_scratch_bigg);
 603 }
 604
 605 static inline Lisp_Object
 606 ent_prod_BIGG_T(Lisp_Object l, Lisp_Object r)
 607 {
 608         bigg_mul(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
 609         return make_bigg_bg(ent_scratch_bigg);
 610 }
 611 static inline Lisp_Object
 612 ent_prod_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 613 {
 614         CHECK_COMPARABLE(r);
 615
 616         r = ent_lift(r, BIGZ_T, NULL);
 617
 618         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
 619         bigg_mul(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
 620         return make_bigg_bg(ent_scratch_bigg);
 621 }
 622 static inline Lisp_Object
 623 ent_prod_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
 624 {
 625         CHECK_COMPARABLE(l);
 626
 627         l = ent_lift(l, BIGZ_T, NULL);
 628
 629         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
 630         bigg_mul(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
 631         return make_bigg_bg(ent_scratch_bigg);
 632 }
 633
 634 static inline Lisp_Object
 635 ent_div_BIGG_T(Lisp_Object l, Lisp_Object r)
 636 {
 637         if (ent_gaussian_zerop(r)) {
 638                 if (!ent_gaussian_zerop(l)) {
 639                         return make_indef(COMPLEX_INFINITY);
 640                 } else {
 641                         return make_indef(NOT_A_NUMBER);
 642                 }
 643         }
 644         bigg_div(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
 645         return make_bigg_bg(ent_scratch_bigg);
 646 }
 647 static inline Lisp_Object
 648 ent_div_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 649 {
 650         CHECK_COMPARABLE(r);
 651
 652         if (ent_unrel_zerop(l)) {
 653                 if (!ent_gaussian_zerop(l)) {
 654                         return make_indef(COMPLEX_INFINITY);
 655                 } else {
 656                         return make_indef(NOT_A_NUMBER);
 657                 }
 658         }
 659
 660         r = ent_lift(r, BIGZ_T, NULL);
 661
 662         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(r));
 663         bigg_div(ent_scratch_bigg, XBIGG_DATA(l), ent_scratch_bigg);
 664         return make_bigg_bg(ent_scratch_bigg);
 665 }
 666 static inline Lisp_Object
 667 ent_div_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
 668 {
 669         CHECK_COMPARABLE(l);
 670
 671         if (ent_gaussian_zerop(r)) {
 672                 if (!ent_unrel_zerop(l)) {
 673                         return make_indef(COMPLEX_INFINITY);
 674                 } else {
 675                         return make_indef(NOT_A_NUMBER);
 676                 }
 677         }
 678
 679         l = ent_lift(l, BIGZ_T, NULL);
 680
 681         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(l));
 682         bigg_div(ent_scratch_bigg, ent_scratch_bigg, XBIGG_DATA(r));
 683         return make_bigg_bg(ent_scratch_bigg);
 684 }
 685
 686 #if defined HAVE_MPC && defined WITH_MPC ||     \
 687         defined HAVE_PSEUC && defined WITH_PSEUC
 688 static inline Lisp_Object
 689 ent_quo_BIGG_T(Lisp_Object l, Lisp_Object r)
 690 {
 691         Lisp_Object tmp_l, tmp_r;
 692
 693         if (ent_gaussian_zerop(r)) {
 694                 if (!ent_gaussian_zerop(l)) {
 695                         return make_indef(COMPLEX_INFINITY);
 696                 } else {
 697                         return make_indef(NOT_A_NUMBER);
 698                 }
 699         }
 700
 701         bigc_set_prec(ent_scratch_bigc, internal_get_precision(Qnil));
 702         tmp_l = Fcoerce_number(l, Qbigc, Qnil);
 703         tmp_r = Fcoerce_number(r, Qbigc, Qnil);
 704         bigc_div(ent_scratch_bigc, XBIGC_DATA(tmp_l), XBIGC_DATA(tmp_r));
 705         return make_bigc_bc(ent_scratch_bigc);
 706 }
 707 static inline Lisp_Object
 708 ent_quo_BIGG_T_COMPARABLE(Lisp_Object l, Lisp_Object r)
 709 {
 710         CHECK_COMPARABLE(r);
 711
 712         if (ent_unrel_zerop(r)) {
 713                 if (!ent_gaussian_zerop(l)) {
 714                         return make_indef(COMPLEX_INFINITY);
 715                 } else {
 716                         return make_indef(NOT_A_NUMBER);
 717                 }
 718         }
 719
 720         l = ent_lift(l, BIGC_T, NULL);
 721         return ent_binop(ASE_BINARY_OP_QUO, l, r);
 722 }
 723 static inline Lisp_Object
 724 ent_quo_COMPARABLE_BIGG_T(Lisp_Object l, Lisp_Object r)
 725 {
 726         CHECK_COMPARABLE(l);
 727
 728         if (ent_gaussian_zerop(r)) {
 729                 if (!ent_unrel_zerop(l)) {
 730                         return make_indef(COMPLEX_INFINITY);
 731                 } else {
 732                         return make_indef(NOT_A_NUMBER);
 733                 }
 734         }
 735
 736         r = ent_lift(r, BIGC_T, NULL);
 737         return ent_binop(ASE_BINARY_OP_QUO, l, r);
 738 }
 739 #endif
 740
 741 static inline Lisp_Object
 742 ent_inv_BIGG_T(Lisp_Object r)
 743 {
 744         if (ent_gaussian_zerop(r)) {
 745                 return make_indef(COMPLEX_INFINITY);
 746         }
 747         bigg_div(ent_scratch_bigg,
 748                  XBIGG_DATA(Qent_gaussian_one), XBIGG_DATA(r));
 749         return make_bigg_bg(ent_scratch_bigg);
 750 }
 751 static inline Lisp_Object
 752 ent_rem_BIGG_T(Lisp_Object l, Lisp_Object r)
 753 {
 754         if (ent_gaussian_zerop(r)) {
 755                 return make_bigg(0, 0);
 756         }
 757         bigg_mod(ent_scratch_bigg, XBIGG_DATA(l), XBIGG_DATA(r));
 758         return make_bigg_bg(ent_scratch_bigg);
 759 }
 760 static inline Lisp_Object
 761 ent_pow_BIGG_T_integer(Lisp_Object l, Lisp_Object r)
 762 {
 763         long unsigned int expo = 0UL;
 764
 765         if (INTP(r)) {
 766                 expo = ent_int(r);
 767         } else if (BIGZP(r)) {
 768                 if (bigz_fits_ulong_p(XBIGZ_DATA(r)))
 769                         expo = bigz_to_ulong(XBIGZ_DATA(r));
 770                 else
 771                         Fsignal(Qarith_error, r);
 772         } else {
 773                 Fsignal(Qdomain_error, r);
 774         }
 775         bigg_pow(ent_scratch_bigg, XBIGG_DATA(l), expo);
 776         return make_bigg_bg(ent_scratch_bigg);
 777 }
 778
 779 /* relations */
 780 static inline int
 781 ent_eq_bigg(Lisp_Object l, Lisp_Object r)
 782 {
 783         return (bigz_eql(bigg_re(XBIGG_DATA(l)), bigg_re(XBIGG_DATA(r))) &&
 784                 bigz_eql(bigg_im(XBIGG_DATA(l)), bigg_im(XBIGG_DATA(r))));
 785 }
 786
 787 static inline int
 788 ent_ne_bigg(Lisp_Object l, Lisp_Object r)
 789 {
 790         return !(bigz_eql(bigg_re(XBIGG_DATA(l)), bigg_re(XBIGG_DATA(r))) &&
 791                  bigz_eql(bigg_im(XBIGG_DATA(l)), bigg_im(XBIGG_DATA(r))));
 792 }
 793
 794 #if 0
 795 static inline Lisp_Object
 796 ent_vallt_BIGG_T(Lisp_Object l, Lisp_Object r)
 797 {
 798         bigz b2;
 799         int result;
 800
 801         bigz_init(b2);
 802         bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
 803         bigg_norm(b2, XBIGG_DATA(r));
 804         result = bigz_lt(ent_scratch_bigz, b2);
 805
 806         bigz_fini(b2);
 807         return (result) ? Qt : Qnil;
 808 }
 809 static inline Lisp_Object
 810 ent_valgt_BIGG_T(Lisp_Object l, Lisp_Object r)
 811 {
 812         bigz b2;
 813         int result;
 814
 815         bigz_init(b2);
 816         bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
 817         bigg_norm(b2, XBIGG_DATA(r));
 818         result = bigz_gt(ent_scratch_bigz, b2);
 819
 820         bigz_fini(b2);
 821         return (result) ? Qt : Qnil;
 822 }
 823 static inline Lisp_Object
 824 ent_valeq_BIGG_T(Lisp_Object l, Lisp_Object r)
 825 {
 826         bigz b2;
 827         int result;
 828
 829         bigz_init(b2);
 830         bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
 831         bigg_norm(b2, XBIGG_DATA(r));
 832         result = bigz_eql(ent_scratch_bigz, b2);
 833
 834         bigz_fini(b2);
 835         return (result) ? Qt : Qnil;
 836 }
 837 static inline Lisp_Object
 838 ent_valne_BIGG_T(Lisp_Object l, Lisp_Object r)
 839 {
 840         bigz b2;
 841         int result;
 842
 843         bigz_init(b2);
 844         bigg_norm(ent_scratch_bigz, XBIGG_DATA(l));
 845         bigg_norm(b2, XBIGG_DATA(r));
 846         result = bigz_eql(ent_scratch_bigz, b2);
 847
 848         bigz_fini(b2);
 849         return (result) ? Qnil : Qt;
 850 }
 851 #endif
 852
 853 \f
 854 static Lisp_Object
 855 ent_lift_all_BIGG_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
 856 {
 857         number = ent_lift(number, BIGZ_T, NULL);
 858         bigg_set_bigz(ent_scratch_bigg, XBIGZ_DATA(number));
 859         return make_bigg_bg(ent_scratch_bigg);
 860 }
 861
 862 #if defined HAVE_MPC && defined WITH_MPC ||     \
 863         defined HAVE_PSEUC && defined WITH_PSEUC
 864 static Lisp_Object
 865 ent_lift_BIGC_T_BIGG_T(Lisp_Object number, ent_lift_args_t SXE_UNUSED(la))
 866 {
 867         Lisp_Object re, im;
 868
 869         re = Freal_part(number);
 870         re = ent_lift(re, BIGZ_T, NULL);
 871         im = Fimaginary_part(number);
 872         im = ent_lift(im, BIGZ_T, NULL);
 873
 874         return make_bigg_bz(XBIGZ_DATA(re), XBIGZ_DATA(im));
 875 }
 876 #endif
 877
 878 \f
 879 static inline void
 880 ent_gaussian_nullary_optable_init(void)
 881 {
 882         Qent_gaussian_zero = make_bigg(0L, 0L);
 883         Qent_gaussian_one = make_bigg(1L, 0L);
 884         staticpro(&Qent_gaussian_zero);
 885         staticpro(&Qent_gaussian_one);
 886
 887         ent_nullop_register(ASE_NULLARY_OP_ZERO, BIGG_T, Qent_gaussian_zero);
 888         ent_nullop_register(ASE_NULLARY_OP_ONE, BIGG_T, Qent_gaussian_one);
 889 }
 890
 891 static inline void
 892 ent_gaussian_unary_optable_init(void)
 893 {
 894         ent_unop_register(ASE_UNARY_OP_NEG, BIGG_T, ent_neg_BIGG_T);
 895         ent_unop_register(ASE_UNARY_OP_INV, BIGG_T, ent_inv_BIGG_T);
 896 }
 897
 898 static inline void
 899 ent_gaussian_binary_optable_init(void)
 900 {
 901         /* sums */
 902         ent_binop_register(ASE_BINARY_OP_SUM,
 903                            BIGG_T, BIGG_T, ent_sum_BIGG_T);
 904         ent_binop_register(ASE_BINARY_OP_SUM,
 905                            BIGG_T, INT_T, ent_sum_BIGG_T_COMPARABLE);
 906         ent_binop_register(ASE_BINARY_OP_SUM,
 907                            INT_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
 908 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_MP)
 909         ent_binop_register(ASE_BINARY_OP_SUM,
 910                            BIGG_T, BIGZ_T, ent_sum_BIGG_T_COMPARABLE);
 911         ent_binop_register(ASE_BINARY_OP_SUM,
 912                            BIGZ_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
 913 #endif
 914 #if defined HAVE_MPQ && defined WITH_GMP
 915         ent_binop_register(ASE_BINARY_OP_SUM,
 916                            BIGG_T, BIGQ_T, ent_sum_BIGG_T_COMPARABLE);
 917         ent_binop_register(ASE_BINARY_OP_SUM,
 918                            BIGQ_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
 919 #endif
 920 #if defined HAVE_MPF && defined WITH_GMP
 921         ent_binop_register(ASE_BINARY_OP_SUM,
 922                            BIGG_T, BIGF_T, ent_sum_BIGG_T_COMPARABLE);
 923         ent_binop_register(ASE_BINARY_OP_SUM,
 924                            BIGF_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
 925 #endif
 926 #if defined HAVE_MPFR && defined WITH_MPFR
 927         ent_binop_register(ASE_BINARY_OP_SUM,
 928                            BIGG_T, BIGFR_T, ent_sum_BIGG_T_COMPARABLE);
 929         ent_binop_register(ASE_BINARY_OP_SUM,
 930                            BIGFR_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
 931 #endif
 932 #ifdef HAVE_FPFLOAT
 933         ent_binop_register(ASE_BINARY_OP_SUM,
 934                            BIGG_T, FLOAT_T, ent_sum_BIGG_T_COMPARABLE);
 935         ent_binop_register(ASE_BINARY_OP_SUM,
 936                            FLOAT_T, BIGG_T, ent_sum_COMPARABLE_BIGG_T);
 937 #endif
 938         /* diffs */
 939         ent_binop_register(ASE_BINARY_OP_DIFF,
 940                            BIGG_T, BIGG_T, ent_diff_BIGG_T);
 941         ent_binop_register(ASE_BINARY_OP_DIFF,
 942                            BIGG_T, INT_T, ent_diff_BIGG_T_COMPARABLE);
 943         ent_binop_register(ASE_BINARY_OP_DIFF,
 944                            INT_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
 945         ent_binop_register(ASE_BINARY_OP_DIFF,
 946                            BIGG_T, BIGZ_T, ent_diff_BIGG_T_COMPARABLE);
 947         ent_binop_register(ASE_BINARY_OP_DIFF,
 948                            BIGZ_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
 949 #if defined HAVE_MPQ && defined WITH_GMP
 950         ent_binop_register(ASE_BINARY_OP_DIFF,
 951                            BIGG_T, BIGQ_T, ent_diff_BIGG_T_COMPARABLE);
 952         ent_binop_register(ASE_BINARY_OP_DIFF,
 953                            BIGQ_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
 954 #endif
 955 #if defined HAVE_MPF && defined WITH_GMP
 956         ent_binop_register(ASE_BINARY_OP_DIFF,
 957                            BIGG_T, BIGF_T, ent_diff_BIGG_T_COMPARABLE);
 958         ent_binop_register(ASE_BINARY_OP_DIFF,
 959                            BIGF_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
 960 #endif
 961 #if defined HAVE_MPFR && defined WITH_MPFR
 962         ent_binop_register(ASE_BINARY_OP_DIFF,
 963                            BIGG_T, BIGFR_T, ent_diff_BIGG_T_COMPARABLE);
 964         ent_binop_register(ASE_BINARY_OP_DIFF,
 965                            BIGFR_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
 966 #endif
 967 #ifdef HAVE_FPFLOAT
 968         ent_binop_register(ASE_BINARY_OP_DIFF,
 969                            BIGG_T, FLOAT_T, ent_diff_BIGG_T_COMPARABLE);
 970         ent_binop_register(ASE_BINARY_OP_DIFF,
 971                            FLOAT_T, BIGG_T, ent_diff_COMPARABLE_BIGG_T);
 972 #endif
 973         /* prods */
 974         ent_binop_register(ASE_BINARY_OP_PROD,
 975                            BIGG_T, BIGG_T, ent_prod_BIGG_T);
 976         ent_binop_register(ASE_BINARY_OP_PROD,
 977                            BIGG_T, INT_T, ent_prod_BIGG_T_COMPARABLE);
 978         ent_binop_register(ASE_BINARY_OP_PROD,
 979                            INT_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
 980         ent_binop_register(ASE_BINARY_OP_PROD,
 981                            BIGG_T, BIGZ_T, ent_prod_BIGG_T_COMPARABLE);
 982         ent_binop_register(ASE_BINARY_OP_PROD,
 983                            BIGZ_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
 984 #if defined HAVE_MPQ && defined WITH_GMP
 985         ent_binop_register(ASE_BINARY_OP_PROD,
 986                            BIGG_T, BIGQ_T, ent_prod_BIGG_T_COMPARABLE);
 987         ent_binop_register(ASE_BINARY_OP_PROD,
 988                            BIGQ_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
 989 #endif
 990 #if defined HAVE_MPF && defined WITH_GMP
 991         ent_binop_register(ASE_BINARY_OP_PROD,
 992                            BIGG_T, BIGF_T, ent_prod_BIGG_T_COMPARABLE);
 993         ent_binop_register(ASE_BINARY_OP_PROD,
 994                            BIGF_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
 995 #endif
 996 #if defined HAVE_MPFR && defined WITH_MPFR
 997         ent_binop_register(ASE_BINARY_OP_PROD,
 998                            BIGG_T, BIGFR_T, ent_prod_BIGG_T_COMPARABLE);
 999         ent_binop_register(ASE_BINARY_OP_PROD,
1000                            BIGFR_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
1001 #endif
1002 #ifdef HAVE_FPFLOAT
1003         ent_binop_register(ASE_BINARY_OP_PROD,
1004                            BIGG_T, FLOAT_T, ent_prod_BIGG_T_COMPARABLE);
1005         ent_binop_register(ASE_BINARY_OP_PROD,
1006                            FLOAT_T, BIGG_T, ent_prod_COMPARABLE_BIGG_T);
1007 #endif
1008
1009         /* divisions and quotients */
1010         ent_binop_register(ASE_BINARY_OP_DIV,
1011                            BIGG_T, BIGG_T, ent_div_BIGG_T);
1012         ent_binop_register(ASE_BINARY_OP_DIV,
1013                            BIGG_T, INT_T, ent_div_BIGG_T_COMPARABLE);
1014         ent_binop_register(ASE_BINARY_OP_DIV,
1015                            INT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1016         ent_binop_register(ASE_BINARY_OP_DIV,
1017                            BIGG_T, BIGZ_T, ent_div_BIGG_T_COMPARABLE);
1018         ent_binop_register(ASE_BINARY_OP_DIV,
1019                            BIGZ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1020 #if defined HAVE_MPQ && defined WITH_GMP
1021         ent_binop_register(ASE_BINARY_OP_DIV,
1022                            BIGG_T, BIGQ_T, ent_div_BIGG_T_COMPARABLE);
1023         ent_binop_register(ASE_BINARY_OP_DIV,
1024                            BIGQ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1025 #endif
1026 #if defined HAVE_MPF && defined WITH_GMP
1027         ent_binop_register(ASE_BINARY_OP_DIV,
1028                            BIGG_T, BIGF_T, ent_div_BIGG_T_COMPARABLE);
1029         ent_binop_register(ASE_BINARY_OP_DIV,
1030                            BIGF_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1031 #endif
1032 #if defined HAVE_MPFR && defined WITH_MPFR
1033         ent_binop_register(ASE_BINARY_OP_DIV,
1034                            BIGG_T, BIGFR_T, ent_div_BIGG_T_COMPARABLE);
1035         ent_binop_register(ASE_BINARY_OP_DIV,
1036                            BIGFR_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1037 #endif
1038 #ifdef HAVE_FPFLOAT
1039         ent_binop_register(ASE_BINARY_OP_DIV,
1040                            BIGG_T, FLOAT_T, ent_div_BIGG_T_COMPARABLE);
1041         ent_binop_register(ASE_BINARY_OP_DIV,
1042                            FLOAT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1043 #endif
1044
1045 #if defined HAVE_MPC && defined WITH_MPC ||     \
1046         defined HAVE_PSEUC && defined WITH_PSEUC
1047         ent_binop_register(ASE_BINARY_OP_QUO,
1048                            BIGG_T, BIGG_T, ent_quo_BIGG_T);
1049         ent_binop_register(ASE_BINARY_OP_QUO,
1050                            BIGG_T, BIGZ_T, ent_quo_BIGG_T_COMPARABLE);
1051         ent_binop_register(ASE_BINARY_OP_QUO,
1052                            BIGZ_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1053 #if defined HAVE_MPQ && defined WITH_GMP
1054         ent_binop_register(ASE_BINARY_OP_QUO,
1055                            BIGG_T, BIGQ_T, ent_quo_BIGG_T_COMPARABLE);
1056         ent_binop_register(ASE_BINARY_OP_QUO,
1057                            BIGQ_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1058 #endif
1059 #if defined HAVE_MPF && defined WITH_GMP
1060         ent_binop_register(ASE_BINARY_OP_QUO,
1061                            BIGG_T, BIGF_T, ent_quo_BIGG_T_COMPARABLE);
1062         ent_binop_register(ASE_BINARY_OP_QUO,
1063                            BIGF_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1064 #endif
1065 #if defined HAVE_MPFR && defined WITH_MPFR
1066         ent_binop_register(ASE_BINARY_OP_QUO,
1067                            BIGG_T, BIGFR_T, ent_quo_BIGG_T_COMPARABLE);
1068         ent_binop_register(ASE_BINARY_OP_QUO,
1069                            BIGFR_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1070 #endif
1071 #ifdef HAVE_FPFLOAT
1072         ent_binop_register(ASE_BINARY_OP_QUO,
1073                            BIGG_T, FLOAT_T, ent_quo_BIGG_T_COMPARABLE);
1074         ent_binop_register(ASE_BINARY_OP_QUO,
1075                            FLOAT_T, BIGG_T, ent_quo_COMPARABLE_BIGG_T);
1076 #endif
1077 #else  /* !HAVE_MPC */
1078         ent_binop_register(ASE_BINARY_OP_QUO,
1079                            BIGG_T, BIGG_T, ent_div_BIGG_T);
1080         ent_binop_register(ASE_BINARY_OP_QUO,
1081                            BIGG_T, BIGZ_T, ent_div_BIGG_T_COMPARABLE);
1082         ent_binop_register(ASE_BINARY_OP_QUO,
1083                            BIGZ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1084 #if defined HAVE_MPQ && defined WITH_GMP
1085         ent_binop_register(ASE_BINARY_OP_QUO,
1086                            BIGG_T, BIGQ_T, ent_div_BIGG_T_COMPARABLE);
1087         ent_binop_register(ASE_BINARY_OP_QUO,
1088                            BIGQ_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1089 #endif
1090 #if defined HAVE_MPF && defined WITH_GMP
1091         ent_binop_register(ASE_BINARY_OP_QUO,
1092                            BIGG_T, BIGF_T, ent_div_BIGG_T_COMPARABLE);
1093         ent_binop_register(ASE_BINARY_OP_QUO,
1094                            BIGF_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1095 #endif
1096 #if defined HAVE_MPFR && defined WITH_MPFR
1097         ent_binop_register(ASE_BINARY_OP_QUO,
1098                            BIGG_T, BIGFR_T, ent_div_BIGG_T_COMPARABLE);
1099         ent_binop_register(ASE_BINARY_OP_QUO,
1100                            BIGFR_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1101 #endif
1102 #ifdef HAVE_FPFLOAT
1103         ent_binop_register(ASE_BINARY_OP_QUO,
1104                            BIGG_T, FLOAT_T, ent_div_BIGG_T_COMPARABLE);
1105         ent_binop_register(ASE_BINARY_OP_QUO,
1106                            FLOAT_T, BIGG_T, ent_div_COMPARABLE_BIGG_T);
1107 #endif
1108 #endif
1109         ent_binop_register(ASE_BINARY_OP_REM,
1110                            BIGG_T, BIGG_T, ent_rem_BIGG_T);
1111         ent_binop_register(ASE_BINARY_OP_MOD,
1112                            BIGG_T, BIGG_T, ent_rem_BIGG_T);
1113         ent_binop_register(ASE_BINARY_OP_POW,
1114                            BIGG_T, INT_T, ent_pow_BIGG_T_integer);
1115         ent_binop_register(ASE_BINARY_OP_POW,
1116                            BIGG_T, BIGZ_T, ent_pow_BIGG_T_integer);
1117 }
1118
1119 static inline void
1120 ent_gaussian_unary_reltable_init(void)
1121 {
1122         ent_unrel_register(ASE_UNARY_REL_ZEROP, BIGG_T, ent_gaussian_zerop);
1123         ent_unrel_register(ASE_UNARY_REL_ONEP, BIGG_T, ent_gaussian_onep);
1124         ent_unrel_register(ASE_UNARY_REL_UNITP, BIGG_T, ent_gaussian_unitp);
1125 }
1126
1127 static inline void
1128 ent_gaussian_binary_reltable_init(void)
1129 {
1130         ent_binrel_register(ASE_BINARY_REL_EQUALP,
1131                             BIGG_T, BIGG_T, ent_eq_bigg);
1132         ent_binrel_register(ASE_BINARY_REL_NEQP,
1133                             BIGG_T, BIGG_T, ent_ne_bigg);
1134 }
1135
1136 static inline void
1137 ent_gaussian_lifttable_init(void)
1138 {
1139         ent_lift_register(INT_T, BIGG_T, ent_lift_all_BIGG_T);
1140         ent_lift_register(BIGZ_T, BIGC_T, ent_lift_all_BIGG_T);
1141 #if defined HAVE_MPQ && defined WITH_GMP
1142         ent_lift_register(BIGQ_T, BIGG_T, ent_lift_all_BIGG_T);
1143 #endif
1144 #if defined HAVE_MPF && defined WITH_GMP
1145         ent_lift_register(BIGF_T, BIGG_T, ent_lift_all_BIGG_T);
1146 #endif
1147 #if defined HAVE_MPFR && defined WITH_MPFR
1148         ent_lift_register(BIGFR_T, BIGG_T, ent_lift_all_BIGG_T);
1149 #endif
1150 #ifdef HAVE_FPFLOAT
1151         ent_lift_register(FLOAT_T, BIGG_T, ent_lift_all_BIGG_T);
1152 #endif
1153 #if defined HAVE_MPC && defined WITH_MPC ||     \
1154         defined HAVE_PSEUC && defined WITH_PSEUC
1155         ent_lift_register(BIGC_T, BIGG_T, ent_lift_BIGC_T_BIGG_T);
1156 #endif
1157 }
1158
1159 void init_optables_BIGG_T(void)
1160 {
1161         ent_gaussian_nullary_optable_init();
1162         ent_gaussian_unary_optable_init();
1163         ent_gaussian_binary_optable_init();
1164         ent_gaussian_unary_reltable_init();
1165         ent_gaussian_binary_reltable_init();
1166         ent_gaussian_lifttable_init();
1167 }
1168
1169 void init_ent_gaussian(void)
1170 {
1171         bigg_init(ent_scratch_bigg);
1172 }
1173
1174 void syms_of_ent_gaussian(void)
1175 {
1176         INIT_LRECORD_IMPLEMENTATION(bigg);
1177
1178         DEFSUBR(Fmake_bigg);
1179 }
1180
1181 void vars_of_ent_gaussian(void)
1182 {
1183         Fprovide(intern("bigg"));
1184         Fprovide(intern("gaussian"));
1185 }