demos/perl/GMP.xs

   1 /* GMP module external subroutines.
   2
   3 Copyright 2001, 2002, 2003 Free Software Foundation, Inc.
   4
   5 This file is part of the GNU MP Library.
   6
   7 The GNU MP Library is free software; you can redistribute it and/or modify
   8 it under the terms of the GNU Lesser General Public License as published by
   9 the Free Software Foundation; either version 3 of the License, or (at your
  10 option) any later version.
  11
  12 The GNU MP Library is distributed in the hope that it will be useful, but
  13 WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  14 or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser General Public
  15 License for more details.
  16
  17 You should have received a copy of the GNU Lesser General Public License
  18 along with the GNU MP Library.  If not, see http://www.gnu.org/licenses/.
  19
  20
  21 /* Notes:
  22
  23    Routines are grouped with the alias feature and a table of function
  24    pointers where possible, since each xsub routine ends up with quite a bit
  25    of code size.  Different combinations of arguments and return values have
  26    to be separate though.
  27
  28    The "INTERFACE:" feature isn't available in perl 5.005 and so isn't used.
  29    "ALIAS:" requires a table lookup with CvXSUBANY(cv).any_i32 (which is
  30    "ix") whereas "INTERFACE:" would have CvXSUBANY(cv).any_dptr as the
  31    function pointer immediately.
  32
  33    Mixed-type swapped-order assignments like "$a = 123; $a += mpz(456);"
  34    invoke the plain overloaded "+", not "+=", which makes life easier.
  35
  36    mpz_assume etc types are used with the overloaded operators since such
  37    operators are always called with a class object as the first argument, we
  38    don't need an sv_derived_from() lookup to check.  There's assert()s in
  39    MPX_ASSUME() for this though.
  40
  41    The overload_constant routines reached via overload::constant get 4
  42    arguments in perl 5.6, not the 3 as documented.  This is apparently a
  43    bug, using "..." lets us ignore the extra one.
  44
  45    There's only a few "si" functions in gmp, so usually SvIV values get
  46    handled with an mpz_set_si into a temporary and then a full precision mpz
  47    routine.  This is reasonably efficient.
  48
  49    Argument types are checked, with a view to preserving all bits in the
  50    operand.  Perl is a bit looser in its arithmetic, allowing rounding or
  51    truncation to an intended operand type (IV, UV or NV).
  52
  53    Bugs:
  54
  55    The memory leak detection attempted in GMP::END() doesn't work when mpz's
  56    are created as constants because END() is called before they're
  57    destroyed.  What's the right place to hook such a check?
  58
  59    See the bugs section of GMP.pm too.  */
  60
  61
  62 /* Comment this out to get assertion checking. */
  63 #define NDEBUG
  64
  65 /* Change this to "#define TRACE(x) x" for some diagnostics. */
  66 #define TRACE(x)
  67
  68
  69 #include <assert.h>
  70 #include <float.h>
  71
  72 #include "EXTERN.h"
  73 #include "perl.h"
  74 #include "XSUB.h"
  75 #include "patchlevel.h"
  76
  77 #include "gmp.h"
  78
  79
  80 /* Perl 5.005 doesn't have SvIsUV, only 5.6 and up.
  81    Perl 5.8 has SvUOK, but not 5.6, so we don't use that.  */
  82 #ifndef SvIsUV
  83 #define SvIsUV(sv)  0
  84 #endif
  85 #ifndef SvUVX
  86 #define SvUVX(sv)  (croak("GMP: oops, shouldn't be using SvUVX"), 0)
  87 #endif
  88
  89
  90 /* Code which doesn't check anything itself, but exists to support other
  91    assert()s.  */
  92 #ifdef NDEBUG
  93 #define assert_support(x)
  94 #else
  95 #define assert_support(x) x
  96 #endif
  97
  98 /* LONG_MAX + 1 and ULONG_MAX + 1, as a doubles */
  99 #define LONG_MAX_P1_AS_DOUBLE   ((double) ((unsigned long) LONG_MAX + 1))
 100 #define ULONG_MAX_P1_AS_DOUBLE  (2.0 * (double) ((unsigned long) ULONG_MAX/2 + 1))
 101
 102 /* Check for perl version "major.minor".
 103    Perl 5.004 doesn't have PERL_REVISION and PERL_VERSION, but that's ok,
 104    we're only interested in tests above that.  */
 105 #if defined (PERL_REVISION) && defined (PERL_VERSION)
 106 #define PERL_GE(major,minor)                                    \
 107     (PERL_REVISION > (major)                                    \
 108      || ((major) == PERL_REVISION && PERL_VERSION >= (minor)))
 109 #else
 110 #define PERL_GE(major,minor)  (0)
 111 #endif
 112 #define PERL_LT(major,minor)  (! PERL_GE(major,minor))
 113
 114 /* sv_derived_from etc in 5.005 took "char *" rather than "const char *".
 115    Avoid some compiler warnings by using const only where it works.  */
 116 #if PERL_LT (5,6)
 117 #define classconst
 118 #else
 119 #define classconst const
 120 #endif
 121
 122 /* In a MINGW or Cygwin DLL build of gmp, the various gmp functions are
 123    given with dllimport directives, which prevents them being used as
 124    initializers for constant data.  We give function tables as
 125    "static_functable const ...", which is normally "static const", but for
 126    mingw expands to just "const" making the table an automatic with a
 127    run-time initializer.
 128
 129    In gcc 3.3.1, the function tables initialized like this end up getting
 130    all the __imp__foo values fetched, even though just one or two will be
 131    used.  This is wasteful, but probably not too bad.  */
 132
 133 #if defined (__MINGW32__) || defined (__CYGWIN__)
 134 #define static_functable
 135 #else
 136 #define static_functable  static
 137 #endif
 138
 139 #define GMP_MALLOC_ID  42
 140
 141 static classconst char mpz_class[]  = "GMP::Mpz";
 142 static classconst char mpq_class[]  = "GMP::Mpq";
 143 static classconst char mpf_class[]  = "GMP::Mpf";
 144 static classconst char rand_class[] = "GMP::Rand";
 145
 146 static HV *mpz_class_hv;
 147 static HV *mpq_class_hv;
 148 static HV *mpf_class_hv;
 149
 150 assert_support (static long mpz_count = 0;)
 151 assert_support (static long mpq_count = 0;)
 152 assert_support (static long mpf_count = 0;)
 153 assert_support (static long rand_count = 0;)
 154
 155 #define TRACE_ACTIVE()                                                   \
 156   assert_support                                                         \
 157   (TRACE (printf ("  active %ld mpz, %ld mpq, %ld mpf, %ld randstate\n", \
 158                   mpz_count, mpq_count, mpf_count, rand_count)))
 159
 160
 161 /* Each "struct mpz_elem" etc is an mpz_t with a link field tacked on the
 162    end so they can be held on a linked list.  */
 163
 164 #define CREATE_MPX(type)                                \
 165                                                         \
 166   /* must have mpz_t etc first, for sprintf below */    \
 167   struct type##_elem {                                  \
 168     type##_t            m;                              \
 169     struct type##_elem  *next;                          \
 170   };                                                    \
 171   typedef struct type##_elem  *type;                    \
 172   typedef struct type##_elem  *type##_assume;           \
 173   typedef type##_ptr          type##_coerce;            \
 174                                                         \
 175   static type type##_freelist = NULL;                   \
 176                                                         \
 177   static type                                           \
 178   new_##type (void)                                     \
 179   {                                                     \
 180     type p;                                             \
 181     TRACE (printf ("new %s\n", type##_class));          \
 182     if (type##_freelist != NULL)                        \
 183       {                                                 \
 184         p = type##_freelist;                            \
 185         type##_freelist = type##_freelist->next;        \
 186       }                                                 \
 187     else                                                \
 188       {                                                 \
 189         New (GMP_MALLOC_ID, p, 1, struct type##_elem);  \
 190         type##_init (p->m);                             \
 191       }                                                 \
 192     TRACE (printf ("  p=%p\n", p));                     \
 193     assert_support (type##_count++);                    \
 194     TRACE_ACTIVE ();                                    \
 195     return p;                                           \
 196   }                                                     \
 197
 198 CREATE_MPX (mpz)
 199 CREATE_MPX (mpq)
 200
 201 typedef mpf_ptr  mpf;
 202 typedef mpf_ptr  mpf_assume;
 203 typedef mpf_ptr  mpf_coerce_st0;
 204 typedef mpf_ptr  mpf_coerce_def;
 205
 206
 207 static mpf
 208 new_mpf (unsigned long prec)
 209 {
 210   mpf p;
 211   New (GMP_MALLOC_ID, p, 1, __mpf_struct);
 212   mpf_init2 (p, prec);
 213   TRACE (printf ("  mpf p=%p\n", p));
 214   assert_support (mpf_count++);
 215   TRACE_ACTIVE ();
 216   return p;
 217 }
 218
 219
 220 /* tmp_mpf_t records an allocated precision with an mpf_t so changes of
 221    precision can be done with just an mpf_set_prec_raw.  */
 222
 223 struct tmp_mpf_struct {
 224   mpf_t          m;
 225   unsigned long  allocated_prec;
 226 };
 227 typedef const struct tmp_mpf_struct  *tmp_mpf_srcptr;
 228 typedef struct tmp_mpf_struct        *tmp_mpf_ptr;
 229 typedef struct tmp_mpf_struct        tmp_mpf_t[1];
 230
 231 #define tmp_mpf_init(f)                         \
 232   do {                                          \
 233     mpf_init (f->m);                            \
 234     f->allocated_prec = mpf_get_prec (f->m);    \
 235   } while (0)
 236
 237 static void
 238 tmp_mpf_grow (tmp_mpf_ptr f, unsigned long prec)
 239 {
 240   mpf_set_prec_raw (f->m, f->allocated_prec);
 241   mpf_set_prec (f->m, prec);
 242   f->allocated_prec = mpf_get_prec (f->m);
 243 }
 244
 245 #define tmp_mpf_shrink(f)  tmp_mpf_grow (f, 1L)
 246
 247 #define tmp_mpf_set_prec(f,prec)        \
 248   do {                                  \
 249     if (prec > f->allocated_prec)       \
 250       tmp_mpf_grow (f, prec);           \
 251     else                                \
 252       mpf_set_prec_raw (f->m, prec);    \
 253   } while (0)
 254
 255
 256 static mpz_t  tmp_mpz_0, tmp_mpz_1, tmp_mpz_2;
 257 static mpq_t  tmp_mpq_0, tmp_mpq_1;
 258 static tmp_mpf_t tmp_mpf_0, tmp_mpf_1;
 259
 260 /* for GMP::Mpz::export */
 261 #define tmp_mpz_4  tmp_mpz_2
 262
 263
 264 #define FREE_MPX_FREELIST(p,type)               \
 265   do {                                          \
 266     TRACE (printf ("free %s\n", type##_class)); \
 267     p->next = type##_freelist;                  \
 268     type##_freelist = p;                        \
 269     assert_support (type##_count--);            \
 270     TRACE_ACTIVE ();                            \
 271     assert (type##_count >= 0);                 \
 272   } while (0)
 273
 274 /* this version for comparison, if desired */
 275 #define FREE_MPX_NOFREELIST(p,type)             \
 276   do {                                          \
 277     TRACE (printf ("free %s\n", type##_class)); \
 278     type##_clear (p->m);                        \
 279     Safefree (p);                               \
 280     assert_support (type##_count--);            \
 281     TRACE_ACTIVE ();                            \
 282     assert (type##_count >= 0);                 \
 283   } while (0)
 284
 285 #define free_mpz(z)    FREE_MPX_FREELIST (z, mpz)
 286 #define free_mpq(q)    FREE_MPX_FREELIST (q, mpq)
 287
 288
 289 /* Return a new mortal SV holding the given mpx_ptr pointer.
 290    class_hv should be one of mpz_class_hv etc.  */
 291 #define MPX_NEWMORTAL(mpx_ptr, class_hv)                                \
 292     sv_bless (sv_setref_pv (sv_newmortal(), NULL, mpx_ptr), class_hv)
 293
 294 /* Aliases for use in typemaps */
 295 typedef char           *malloced_string;
 296 typedef const char     *const_string;
 297 typedef const char     *const_string_assume;
 298 typedef char           *string;
 299 typedef SV             *order_noswap;
 300 typedef SV             *dummy;
 301 typedef SV             *SV_copy_0;
 302 typedef unsigned long  ulong_coerce;
 303 typedef __gmp_randstate_struct *randstate;
 304 typedef UV             gmp_UV;
 305
 306 #define SvMPX(s,type)  ((type) SvIV((SV*) SvRV(s)))
 307 #define SvMPZ(s)       SvMPX(s,mpz)
 308 #define SvMPQ(s)       SvMPX(s,mpq)
 309 #define SvMPF(s)       SvMPX(s,mpf)
 310 #define SvRANDSTATE(s) SvMPX(s,randstate)
 311
 312 #define MPX_ASSUME(x,sv,type)                           \
 313   do {                                                  \
 314     assert (sv_derived_from (sv, type##_class));        \
 315     x = SvMPX(sv,type);                                 \
 316   } while (0)
 317
 318 #define MPZ_ASSUME(z,sv)    MPX_ASSUME(z,sv,mpz)
 319 #define MPQ_ASSUME(q,sv)    MPX_ASSUME(q,sv,mpq)
 320 #define MPF_ASSUME(f,sv)    MPX_ASSUME(f,sv,mpf)
 321
 322 #define numberof(x)  (sizeof (x) / sizeof ((x)[0]))
 323 #define SGN(x)       ((x)<0 ? -1 : (x) != 0)
 324 #define ABS(x)       ((x)>=0 ? (x) : -(x))
 325 #define double_integer_p(d)  (floor (d) == (d))
 326
 327 #define x_mpq_integer_p(q) \
 328   (mpz_cmp_ui (mpq_denref(q), 1L) == 0)
 329
 330 #define assert_table(ix)  assert (ix >= 0 && ix < numberof (table))
 331
 332 #define SV_PTR_SWAP(x,y) \
 333   do { SV *__tmp = (x); (x) = (y); (y) = __tmp; } while (0)
 334 #define MPF_PTR_SWAP(x,y) \
 335   do { mpf_ptr __tmp = (x); (x) = (y); (y) = __tmp; } while (0)
 336
 337
 338 static void
 339 class_or_croak (SV *sv, classconst char *cl)
 340 {
 341   if (! sv_derived_from (sv, cl))
 342     croak("not type %s", cl);
 343 }
 344
 345
 346 /* These are macros, wrap them in functions. */
 347 static int
 348 x_mpz_odd_p (mpz_srcptr z)
 349 {
 350   return mpz_odd_p (z);
 351 }
 352 static int
 353 x_mpz_even_p (mpz_srcptr z)
 354 {
 355   return mpz_even_p (z);
 356 }
 357
 358 static void
 359 x_mpq_pow_ui (mpq_ptr r, mpq_srcptr b, unsigned long e)
 360 {
 361   mpz_pow_ui (mpq_numref(r), mpq_numref(b), e);
 362   mpz_pow_ui (mpq_denref(r), mpq_denref(b), e);
 363 }
 364
 365
 366 static void *
 367 my_gmp_alloc (size_t n)
 368 {
 369   void *p;
 370   TRACE (printf ("my_gmp_alloc %u\n", n));
 371   New (GMP_MALLOC_ID, p, n, char);
 372   TRACE (printf ("  p=%p\n", p));
 373   return p;
 374 }
 375
 376 static void *
 377 my_gmp_realloc (void *p, size_t oldsize, size_t newsize)
 378 {
 379   TRACE (printf ("my_gmp_realloc %p, %u to %u\n", p, oldsize, newsize));
 380   Renew (p, newsize, char);
 381   TRACE (printf ("  p=%p\n", p));
 382   return p;
 383 }
 384
 385 static void
 386 my_gmp_free (void *p, size_t n)
 387 {
 388   TRACE (printf ("my_gmp_free %p %u\n", p, n));
 389   Safefree (p);
 390 }
 391
 392
 393 #define my_mpx_set_svstr(type)                                  \
 394   static void                                                   \
 395   my_##type##_set_svstr (type##_ptr x, SV *sv)                  \
 396   {                                                             \
 397     const char  *str;                                           \
 398     STRLEN      len;                                            \
 399     TRACE (printf ("  my_" #type "_set_svstr\n"));              \
 400     assert (SvPOK(sv) || SvPOKp(sv));                           \
 401     str = SvPV (sv, len);                                       \
 402     TRACE (printf ("  str \"%s\"\n", str));                     \
 403     if (type##_set_str (x, str, 0) != 0)                        \
 404       croak ("%s: invalid string: %s", type##_class, str);      \
 405   }
 406
 407 my_mpx_set_svstr(mpz)
 408 my_mpx_set_svstr(mpq)
 409 my_mpx_set_svstr(mpf)
 410
 411
 412 /* very slack */
 413 static int
 414 x_mpq_cmp_si (mpq_srcptr x, long yn, unsigned long yd)
 415 {
 416   mpq  y;
 417   int  ret;
 418   y = new_mpq ();
 419   mpq_set_si (y->m, yn, yd);
 420   ret = mpq_cmp (x, y->m);
 421   free_mpq (y);
 422   return ret;
 423 }
 424
 425 static int
 426 x_mpq_fits_slong_p (mpq_srcptr q)
 427 {
 428   return x_mpq_cmp_si (q, LONG_MIN, 1L) >= 0
 429     && mpq_cmp_ui (q, LONG_MAX, 1L) <= 0;
 430 }
 431
 432 static int
 433 x_mpz_cmp_q (mpz_ptr x, mpq_srcptr y)
 434 {
 435   int  ret;
 436   mpz_set_ui (mpq_denref(tmp_mpq_0), 1L);
 437   mpz_swap (mpq_numref(tmp_mpq_0), x);
 438   ret = mpq_cmp (tmp_mpq_0, y);
 439   mpz_swap (mpq_numref(tmp_mpq_0), x);
 440   return ret;
 441 }
 442
 443 static int
 444 x_mpz_cmp_f (mpz_srcptr x, mpf_srcptr y)
 445 {
 446   tmp_mpf_set_prec (tmp_mpf_0, mpz_sizeinbase (x, 2));
 447   mpf_set_z (tmp_mpf_0->m, x);
 448   return mpf_cmp (tmp_mpf_0->m, y);
 449 }
 450
 451
 452 #define USE_UNKNOWN  0
 453 #define USE_IVX      1
 454 #define USE_UVX      2
 455 #define USE_NVX      3
 456 #define USE_PVX      4
 457 #define USE_MPZ      5
 458 #define USE_MPQ      6
 459 #define USE_MPF      7
 460
 461 /* mg_get is called every time we get a value, even if the private flags are
 462    still set from a previous such call.  This is the same as as SvIV and
 463    friends do.
 464
 465    When POK, we use the PV, even if there's an IV or NV available.  This is
 466    because it's hard to be sure there wasn't any rounding in establishing
 467    the IV and/or NV.  Cases of overflow, where the PV should definitely be
 468    used, are easy enough to spot, but rounding is hard.  So although IV or
 469    NV would be more efficient, we must use the PV to be sure of getting all
 470    the data.  Applications should convert once to mpz, mpq or mpf when using
 471    a value repeatedly.
 472
 473    Zany dual-type scalars like $! where the IV is an error code and the PV
 474    is an error description string won't work with this preference for PV,
 475    but that's too bad.  Such scalars should be rare, and unlikely to be used
 476    in bignum calculations.
 477
 478    When IOK and NOK are both set, we would prefer to use the IV since it can
 479    be converted more efficiently, and because on a 64-bit system the NV may
 480    have less bits than the IV.  The following rules are applied,
 481
 482    - If the NV is not an integer, then we must use that NV, since clearly
 483      the IV was merely established by rounding and is not the full value.
 484
 485    - In perl prior to 5.8, an NV too big for an IV leaves an overflow value
 486      0xFFFFFFFF.  If the NV is too big to fit an IV then clearly it's the NV
 487      which is the true value and must be used.
 488
 489    - In perl 5.8 and up, such an overflow doesn't set IOK, so that test is
 490      unnecessary.  However when coming from get-magic, IOKp _is_ set, and we
 491      must check for overflow the same as in older perl.
 492
 493    FIXME:
 494
 495    We'd like to call mg_get just once, but unfortunately sv_derived_from()
 496    will call it for each of our checks.  We could do a string compare like
 497    sv_isa ourselves, but that only tests the exact class, it doesn't
 498    recognise subclassing.  There doesn't seem to be a public interface to
 499    the subclassing tests (in the internal isa_lookup() function).  */
 500
 501 int
 502 use_sv (SV *sv)
 503 {
 504   double  d;
 505
 506   if (SvGMAGICAL(sv))
 507     {
 508       mg_get(sv);
 509
 510       if (SvPOKp(sv))
 511         return USE_PVX;
 512
 513       if (SvIOKp(sv))
 514         {
 515           if (SvIsUV(sv))
 516             {
 517               if (SvNOKp(sv))
 518                 goto u_or_n;
 519               return USE_UVX;
 520             }
 521           else
 522             {
 523               if (SvNOKp(sv))
 524                 goto i_or_n;
 525               return USE_IVX;
 526             }
 527         }
 528
 529       if (SvNOKp(sv))
 530         return USE_NVX;
 531
 532       goto rok_or_unknown;
 533     }
 534
 535   if (SvPOK(sv))
 536     return USE_PVX;
 537
 538   if (SvIOK(sv))
 539     {
 540       if (SvIsUV(sv))
 541         {
 542           if (SvNOK(sv))
 543             {
 544               if (PERL_LT (5, 8))
 545                 {
 546                 u_or_n:
 547                   d = SvNVX(sv);
 548                   if (d >= ULONG_MAX_P1_AS_DOUBLE || d < 0.0)
 549                     return USE_NVX;
 550                 }
 551               d = SvNVX(sv);
 552               if (d != floor (d))
 553                 return USE_NVX;
 554             }
 555           return USE_UVX;
 556         }
 557       else
 558         {
 559           if (SvNOK(sv))
 560             {
 561               if (PERL_LT (5, 8))
 562                 {
 563                 i_or_n:
 564                   d = SvNVX(sv);
 565                   if (d >= LONG_MAX_P1_AS_DOUBLE || d < (double) LONG_MIN)
 566                     return USE_NVX;
 567                 }
 568               d = SvNVX(sv);
 569               if (d != floor (d))
 570                 return USE_NVX;
 571             }
 572           return USE_IVX;
 573         }
 574     }
 575
 576   if (SvNOK(sv))
 577     return USE_NVX;
 578
 579  rok_or_unknown:
 580   if (SvROK(sv))
 581     {
 582       if (sv_derived_from (sv, mpz_class))
 583         return USE_MPZ;
 584       if (sv_derived_from (sv, mpq_class))
 585         return USE_MPQ;
 586       if (sv_derived_from (sv, mpf_class))
 587         return USE_MPF;
 588     }
 589
 590   return USE_UNKNOWN;
 591 }
 592
 593
 594 /* Coerce sv to an mpz.  Use tmp to hold the converted value if sv isn't
 595    already an mpz (or an mpq of which the numerator can be used).  Return
 596    the chosen mpz (tmp or the contents of sv).  */
 597
 598 static mpz_ptr
 599 coerce_mpz_using (mpz_ptr tmp, SV *sv, int use)
 600 {
 601   switch (use) {
 602   case USE_IVX:
 603     mpz_set_si (tmp, SvIVX(sv));
 604     return tmp;
 605
 606   case USE_UVX:
 607     mpz_set_ui (tmp, SvUVX(sv));
 608     return tmp;
 609
 610   case USE_NVX:
 611     {
 612       double d;
 613       d = SvNVX(sv);
 614       if (! double_integer_p (d))
 615         croak ("cannot coerce non-integer double to mpz");
 616       mpz_set_d (tmp, d);
 617       return tmp;
 618     }
 619
 620   case USE_PVX:
 621     my_mpz_set_svstr (tmp, sv);
 622     return tmp;
 623
 624   case USE_MPZ:
 625     return SvMPZ(sv)->m;
 626
 627   case USE_MPQ:
 628     {
 629       mpq q = SvMPQ(sv);
 630       if (! x_mpq_integer_p (q->m))
 631         croak ("cannot coerce non-integer mpq to mpz");
 632       return mpq_numref(q->m);
 633     }
 634
 635   case USE_MPF:
 636     {
 637       mpf f = SvMPF(sv);
 638       if (! mpf_integer_p (f))
 639         croak ("cannot coerce non-integer mpf to mpz");
 640       mpz_set_f (tmp, f);
 641       return tmp;
 642     }
 643
 644   default:
 645     croak ("cannot coerce to mpz");
 646   }
 647 }
 648 static mpz_ptr
 649 coerce_mpz (mpz_ptr tmp, SV *sv)
 650 {
 651   return coerce_mpz_using (tmp, sv, use_sv (sv));
 652 }
 653
 654
 655 /* Coerce sv to an mpq.  If sv is an mpq then just return that, otherwise
 656    use tmp to hold the converted value and return that.  */
 657
 658 static mpq_ptr
 659 coerce_mpq_using (mpq_ptr tmp, SV *sv, int use)
 660 {
 661   TRACE (printf ("coerce_mpq_using %p %d\n", tmp, use));
 662   switch (use) {
 663   case USE_IVX:
 664     mpq_set_si (tmp, SvIVX(sv), 1L);
 665     return tmp;
 666
 667   case USE_UVX:
 668     mpq_set_ui (tmp, SvUVX(sv), 1L);
 669     return tmp;
 670
 671   case USE_NVX:
 672     mpq_set_d (tmp, SvNVX(sv));
 673     return tmp;
 674
 675   case USE_PVX:
 676     my_mpq_set_svstr (tmp, sv);
 677     return tmp;
 678
 679   case USE_MPZ:
 680     mpq_set_z (tmp, SvMPZ(sv)->m);
 681     return tmp;
 682
 683   case USE_MPQ:
 684     return SvMPQ(sv)->m;
 685
 686   case USE_MPF:
 687     mpq_set_f (tmp, SvMPF(sv));
 688     return tmp;
 689
 690   default:
 691     croak ("cannot coerce to mpq");
 692   }
 693 }
 694 static mpq_ptr
 695 coerce_mpq (mpq_ptr tmp, SV *sv)
 696 {
 697   return coerce_mpq_using (tmp, sv, use_sv (sv));
 698 }
 699
 700
 701 static void
 702 my_mpf_set_sv_using (mpf_ptr f, SV *sv, int use)
 703 {
 704   switch (use) {
 705   case USE_IVX:
 706     mpf_set_si (f, SvIVX(sv));
 707     break;
 708
 709   case USE_UVX:
 710     mpf_set_ui (f, SvUVX(sv));
 711     break;
 712
 713   case USE_NVX:
 714     mpf_set_d (f, SvNVX(sv));
 715     break;
 716
 717   case USE_PVX:
 718     my_mpf_set_svstr (f, sv);
 719     break;
 720
 721   case USE_MPZ:
 722     mpf_set_z (f, SvMPZ(sv)->m);
 723     break;
 724
 725   case USE_MPQ:
 726     mpf_set_q (f, SvMPQ(sv)->m);
 727     break;
 728
 729   case USE_MPF:
 730     mpf_set (f, SvMPF(sv));
 731     break;
 732
 733   default:
 734     croak ("cannot coerce to mpf");
 735   }
 736 }
 737
 738 /* Coerce sv to an mpf.  If sv is an mpf then just return that, otherwise
 739    use tmp to hold the converted value (with prec precision).  */
 740 static mpf_ptr
 741 coerce_mpf_using (tmp_mpf_ptr tmp, SV *sv, unsigned long prec, int use)
 742 {
 743   if (use == USE_MPF)
 744     return SvMPF(sv);
 745
 746   tmp_mpf_set_prec (tmp, prec);
 747   my_mpf_set_sv_using (tmp->m, sv, use);
 748   return tmp->m;
 749 }
 750 static mpf_ptr
 751 coerce_mpf (tmp_mpf_ptr tmp, SV *sv, unsigned long prec)
 752 {
 753   return coerce_mpf_using (tmp, sv, prec, use_sv (sv));
 754 }
 755
 756
 757 /* Coerce xv to an mpf and store the pointer in x, ditto for yv to x.  If
 758    one of xv or yv is an mpf then use it for the precision, otherwise use
 759    the default precision.  */
 760 unsigned long
 761 coerce_mpf_pair (mpf *xp, SV *xv, mpf *yp, SV *yv)
 762 {
 763   int x_use = use_sv (xv);
 764   int y_use = use_sv (yv);
 765   unsigned long  prec;
 766   mpf  x, y;
 767
 768   if (x_use == USE_MPF)
 769     {
 770       x = SvMPF(xv);
 771       prec = mpf_get_prec (x);
 772       y = coerce_mpf_using (tmp_mpf_0, yv, prec, y_use);
 773     }
 774   else
 775     {
 776       y = coerce_mpf_using (tmp_mpf_0, yv, mpf_get_default_prec(), y_use);
 777       prec = mpf_get_prec (y);
 778       x = coerce_mpf_using (tmp_mpf_1, xv, prec, x_use);
 779     }
 780   *xp = x;
 781   *yp = y;
 782   return prec;
 783 }
 784
 785
 786 /* Note that SvUV is not used, since it merely treats the signed IV as if it
 787    was unsigned.  We get an IV and check its sign. */
 788 static unsigned long
 789 coerce_ulong (SV *sv)
 790 {
 791   long  n;
 792
 793   switch (use_sv (sv)) {
 794   case USE_IVX:
 795     n = SvIVX(sv);
 796   negative_check:
 797     if (n < 0)
 798       goto range_error;
 799     return n;
 800
 801   case USE_UVX:
 802     return SvUVX(sv);
 803
 804   case USE_NVX:
 805     {
 806       double d;
 807       d = SvNVX(sv);
 808       if (! double_integer_p (d))
 809         goto integer_error;
 810       n = SvIV(sv);
 811     }
 812     goto negative_check;
 813
 814   case USE_PVX:
 815     /* FIXME: Check the string is an integer. */
 816     n = SvIV(sv);
 817     goto negative_check;
 818
 819   case USE_MPZ:
 820     {
 821       mpz z = SvMPZ(sv);
 822       if (! mpz_fits_ulong_p (z->m))
 823         goto range_error;
 824       return mpz_get_ui (z->m);
 825     }
 826
 827   case USE_MPQ:
 828     {
 829       mpq q = SvMPQ(sv);
 830       if (! x_mpq_integer_p (q->m))
 831         goto integer_error;
 832       if (! mpz_fits_ulong_p (mpq_numref (q->m)))
 833         goto range_error;
 834       return mpz_get_ui (mpq_numref (q->m));
 835     }
 836
 837   case USE_MPF:
 838     {
 839       mpf f = SvMPF(sv);
 840       if (! mpf_integer_p (f))
 841         goto integer_error;
 842       if (! mpf_fits_ulong_p (f))
 843         goto range_error;
 844       return mpf_get_ui (f);
 845     }
 846
 847   default:
 848     croak ("cannot coerce to ulong");
 849   }
 850
 851  integer_error:
 852   croak ("not an integer");
 853
 854  range_error:
 855   croak ("out of range for ulong");
 856 }
 857
 858
 859 static long
 860 coerce_long (SV *sv)
 861 {
 862   switch (use_sv (sv)) {
 863   case USE_IVX:
 864     return SvIVX(sv);
 865
 866   case USE_UVX:
 867     {
 868       UV u = SvUVX(sv);
 869       if (u > (UV) LONG_MAX)
 870         goto range_error;
 871       return u;
 872     }
 873
 874   case USE_NVX:
 875     {
 876       double d = SvNVX(sv);
 877       if (! double_integer_p (d))
 878         goto integer_error;
 879       return SvIV(sv);
 880     }
 881
 882   case USE_PVX:
 883     /* FIXME: Check the string is an integer. */
 884     return SvIV(sv);
 885
 886   case USE_MPZ:
 887     {
 888       mpz z = SvMPZ(sv);
 889       if (! mpz_fits_slong_p (z->m))
 890         goto range_error;
 891       return mpz_get_si (z->m);
 892     }
 893
 894   case USE_MPQ:
 895     {
 896       mpq q = SvMPQ(sv);
 897       if (! x_mpq_integer_p (q->m))
 898         goto integer_error;
 899       if (! mpz_fits_slong_p (mpq_numref (q->m)))
 900         goto range_error;
 901       return mpz_get_si (mpq_numref (q->m));
 902     }
 903
 904   case USE_MPF:
 905     {
 906       mpf f = SvMPF(sv);
 907       if (! mpf_integer_p (f))
 908         goto integer_error;
 909       if (! mpf_fits_slong_p (f))
 910         goto range_error;
 911       return mpf_get_si (f);
 912     }
 913
 914   default:
 915     croak ("cannot coerce to long");
 916   }
 917
 918  integer_error:
 919   croak ("not an integer");
 920
 921  range_error:
 922   croak ("out of range for ulong");
 923 }
 924
 925
 926 /* ------------------------------------------------------------------------- */
 927
 928 MODULE = GMP         PACKAGE = GMP
 929
 930 BOOT:
 931     TRACE (printf ("GMP boot\n"));
 932     mp_set_memory_functions (my_gmp_alloc, my_gmp_realloc, my_gmp_free);
 933     mpz_init (tmp_mpz_0);
 934     mpz_init (tmp_mpz_1);
 935     mpz_init (tmp_mpz_2);
 936     mpq_init (tmp_mpq_0);
 937     mpq_init (tmp_mpq_1);
 938     tmp_mpf_init (tmp_mpf_0);
 939     tmp_mpf_init (tmp_mpf_1);
 940     mpz_class_hv = gv_stashpv (mpz_class, 1);
 941     mpq_class_hv = gv_stashpv (mpq_class, 1);
 942     mpf_class_hv = gv_stashpv (mpf_class, 1);
 943
 944
 945 void
 946 END()
 947 CODE:
 948     TRACE (printf ("GMP end\n"));
 949     TRACE_ACTIVE ();
 950     /* These are not always true, see Bugs at the top of the file. */
 951     /* assert (mpz_count == 0); */
 952     /* assert (mpq_count == 0); */
 953     /* assert (mpf_count == 0); */
 954     /* assert (rand_count == 0); */
 955
 956
 957 const_string
 958 version()
 959 CODE:
 960     RETVAL = gmp_version;
 961 OUTPUT:
 962     RETVAL
 963
 964
 965 bool
 966 fits_slong_p (sv)
 967     SV *sv
 968 CODE:
 969     switch (use_sv (sv)) {
 970     case USE_IVX:
 971       RETVAL = 1;
 972       break;
 973
 974     case USE_UVX:
 975       {
 976         UV u = SvUVX(sv);
 977         RETVAL = (u <= LONG_MAX);
 978       }
 979       break;
 980
 981     case USE_NVX:
 982       {
 983         double  d = SvNVX(sv);
 984         RETVAL = (d >= (double) LONG_MIN && d < LONG_MAX_P1_AS_DOUBLE);
 985       }
 986       break;
 987
 988     case USE_PVX:
 989       {
 990         STRLEN len;
 991         const char *str = SvPV (sv, len);
 992         if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
 993           RETVAL = x_mpq_fits_slong_p (tmp_mpq_0);
 994         else
 995           {
 996             /* enough precision for a long */
 997             tmp_mpf_set_prec (tmp_mpf_0, 2*mp_bits_per_limb);
 998             if (mpf_set_str (tmp_mpf_0->m, str, 10) != 0)
 999               croak ("GMP::fits_slong_p invalid string format");
1000             RETVAL = mpf_fits_slong_p (tmp_mpf_0->m);
1001           }
1002       }
1003       break;
1004
1005     case USE_MPZ:
1006       RETVAL = mpz_fits_slong_p (SvMPZ(sv)->m);
1007       break;
1008
1009     case USE_MPQ:
1010       RETVAL = x_mpq_fits_slong_p (SvMPQ(sv)->m);
1011       break;
1012
1013     case USE_MPF:
1014       RETVAL = mpf_fits_slong_p (SvMPF(sv));
1015       break;
1016
1017     default:
1018       croak ("GMP::fits_slong_p invalid argument");
1019     }
1020 OUTPUT:
1021     RETVAL
1022
1023
1024 double
1025 get_d (sv)
1026     SV *sv
1027 CODE:
1028     switch (use_sv (sv)) {
1029     case USE_IVX:
1030       RETVAL = (double) SvIVX(sv);
1031       break;
1032
1033     case USE_UVX:
1034       RETVAL = (double) SvUVX(sv);
1035       break;
1036
1037     case USE_NVX:
1038       RETVAL = SvNVX(sv);
1039       break;
1040
1041     case USE_PVX:
1042       {
1043         STRLEN len;
1044         RETVAL = atof(SvPV(sv, len));
1045       }
1046       break;
1047
1048     case USE_MPZ:
1049       RETVAL = mpz_get_d (SvMPZ(sv)->m);
1050       break;
1051
1052     case USE_MPQ:
1053       RETVAL = mpq_get_d (SvMPQ(sv)->m);
1054       break;
1055
1056     case USE_MPF:
1057       RETVAL = mpf_get_d (SvMPF(sv));
1058       break;
1059
1060     default:
1061       croak ("GMP::get_d invalid argument");
1062     }
1063 OUTPUT:
1064     RETVAL
1065
1066
1067 void
1068 get_d_2exp (sv)
1069     SV *sv
1070 PREINIT:
1071     double ret;
1072     long   exp;
1073 PPCODE:
1074     switch (use_sv (sv)) {
1075     case USE_IVX:
1076       ret = (double) SvIVX(sv);
1077       goto use_frexp;
1078
1079     case USE_UVX:
1080       ret = (double) SvUVX(sv);
1081       goto use_frexp;
1082
1083     case USE_NVX:
1084       {
1085         int i_exp;
1086         ret = SvNVX(sv);
1087       use_frexp:
1088         ret = frexp (ret, &i_exp);
1089         exp = i_exp;
1090       }
1091       break;
1092
1093     case USE_PVX:
1094       /* put strings through mpf to give full exp range */
1095       tmp_mpf_set_prec (tmp_mpf_0, DBL_MANT_DIG);
1096       my_mpf_set_svstr (tmp_mpf_0->m, sv);
1097       ret = mpf_get_d_2exp (&exp, tmp_mpf_0->m);
1098       break;
1099
1100     case USE_MPZ:
1101       ret = mpz_get_d_2exp (&exp, SvMPZ(sv)->m);
1102       break;
1103
1104     case USE_MPQ:
1105       tmp_mpf_set_prec (tmp_mpf_0, DBL_MANT_DIG);
1106       mpf_set_q (tmp_mpf_0->m, SvMPQ(sv)->m);
1107       ret = mpf_get_d_2exp (&exp, tmp_mpf_0->m);
1108       break;
1109
1110     case USE_MPF:
1111       ret = mpf_get_d_2exp (&exp, SvMPF(sv));
1112       break;
1113
1114     default:
1115       croak ("GMP::get_d_2exp invalid argument");
1116     }
1117     PUSHs (sv_2mortal (newSVnv (ret)));
1118     PUSHs (sv_2mortal (newSViv (exp)));
1119
1120
1121 long
1122 get_si (sv)
1123     SV *sv
1124 CODE:
1125     switch (use_sv (sv)) {
1126     case USE_IVX:
1127       RETVAL = SvIVX(sv);
1128       break;
1129
1130     case USE_UVX:
1131       RETVAL = SvUVX(sv);
1132       break;
1133
1134     case USE_NVX:
1135       RETVAL = (long) SvNVX(sv);
1136       break;
1137
1138     case USE_PVX:
1139       RETVAL = SvIV(sv);
1140       break;
1141
1142     case USE_MPZ:
1143       RETVAL = mpz_get_si (SvMPZ(sv)->m);
1144       break;
1145
1146     case USE_MPQ:
1147       mpz_set_q (tmp_mpz_0, SvMPQ(sv)->m);
1148       RETVAL = mpz_get_si (tmp_mpz_0);
1149       break;
1150
1151     case USE_MPF:
1152       RETVAL = mpf_get_si (SvMPF(sv));
1153       break;
1154
1155     default:
1156       croak ("GMP::get_si invalid argument");
1157     }
1158 OUTPUT:
1159     RETVAL
1160
1161
1162 void
1163 get_str (sv, ...)
1164     SV *sv
1165 PREINIT:
1166     char      *str;
1167     mp_exp_t  exp;
1168     mpz_ptr   z;
1169     mpq_ptr   q;
1170     mpf       f;
1171     int       base;
1172     int       ndigits;
1173 PPCODE:
1174     TRACE (printf ("GMP::get_str\n"));
1175
1176     if (items >= 2)
1177       base = coerce_long (ST(1));
1178     else
1179       base = 10;
1180     TRACE (printf (" base=%d\n", base));
1181
1182     if (items >= 3)
1183       ndigits = coerce_long (ST(2));
1184     else
1185       ndigits = 10;
1186     TRACE (printf (" ndigits=%d\n", ndigits));
1187
1188     EXTEND (SP, 2);
1189
1190     switch (use_sv (sv)) {
1191     case USE_IVX:
1192       mpz_set_si (tmp_mpz_0, SvIVX(sv));
1193     get_tmp_mpz_0:
1194       z = tmp_mpz_0;
1195       goto get_mpz;
1196
1197     case USE_UVX:
1198       mpz_set_ui (tmp_mpz_0, SvUVX(sv));
1199       goto get_tmp_mpz_0;
1200
1201     case USE_NVX:
1202       /* only digits in the original double, not in the coerced form */
1203       if (ndigits == 0)
1204         ndigits = DBL_DIG;
1205       mpf_set_d (tmp_mpf_0->m, SvNVX(sv));
1206       f = tmp_mpf_0->m;
1207       goto get_mpf;
1208
1209     case USE_PVX:
1210       {
1211         /* get_str on a string is not much more than a base conversion */
1212         STRLEN len;
1213         str = SvPV (sv, len);
1214         if (mpz_set_str (tmp_mpz_0, str, 0) == 0)
1215           {
1216             z = tmp_mpz_0;
1217             goto get_mpz;
1218           }
1219         else if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
1220           {
1221             q = tmp_mpq_0;
1222             goto get_mpq;
1223           }
1224         else
1225           {
1226             /* FIXME: Would like perhaps a precision equivalent to the
1227                number of significant digits of the string, in its given
1228                base.  */
1229             tmp_mpf_set_prec (tmp_mpf_0, strlen(str));
1230             if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
1231               {
1232                 f = tmp_mpf_0->m;
1233                 goto get_mpf;
1234               }
1235             else
1236               croak ("GMP::get_str invalid string format");
1237           }
1238       }
1239       break;
1240
1241     case USE_MPZ:
1242       z = SvMPZ(sv)->m;
1243     get_mpz:
1244       str = mpz_get_str (NULL, base, z);
1245     push_str:
1246       PUSHs (sv_2mortal (newSVpv (str, 0)));
1247       break;
1248
1249     case USE_MPQ:
1250       q = SvMPQ(sv)->m;
1251     get_mpq:
1252       str = mpq_get_str (NULL, base, q);
1253       goto push_str;
1254
1255     case USE_MPF:
1256       f = SvMPF(sv);
1257     get_mpf:
1258       str = mpf_get_str (NULL, &exp, base, 0, f);
1259       PUSHs (sv_2mortal (newSVpv (str, 0)));
1260       PUSHs (sv_2mortal (newSViv (exp)));
1261       break;
1262
1263     default:
1264       croak ("GMP::get_str invalid argument");
1265     }
1266
1267
1268 bool
1269 integer_p (sv)
1270     SV *sv
1271 CODE:
1272     switch (use_sv (sv)) {
1273     case USE_IVX:
1274     case USE_UVX:
1275       RETVAL = 1;
1276       break;
1277
1278     case USE_NVX:
1279       RETVAL = double_integer_p (SvNVX(sv));
1280       break;
1281
1282     case USE_PVX:
1283       {
1284         /* FIXME: Maybe this should be done by parsing the string, not by an
1285            actual conversion.  */
1286         STRLEN len;
1287         const char *str = SvPV (sv, len);
1288         if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
1289           RETVAL = x_mpq_integer_p (tmp_mpq_0);
1290         else
1291           {
1292             /* enough for all digits of the string */
1293             tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
1294             if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
1295               RETVAL = mpf_integer_p (tmp_mpf_0->m);
1296             else
1297               croak ("GMP::integer_p invalid string format");
1298           }
1299       }
1300       break;
1301
1302     case USE_MPZ:
1303       RETVAL = 1;
1304       break;
1305
1306     case USE_MPQ:
1307       RETVAL = x_mpq_integer_p (SvMPQ(sv)->m);
1308       break;
1309
1310     case USE_MPF:
1311       RETVAL = mpf_integer_p (SvMPF(sv));
1312       break;
1313
1314     default:
1315       croak ("GMP::integer_p invalid argument");
1316     }
1317 OUTPUT:
1318     RETVAL
1319
1320
1321 int
1322 sgn (sv)
1323     SV *sv
1324 CODE:
1325     switch (use_sv (sv)) {
1326     case USE_IVX:
1327       RETVAL = SGN (SvIVX(sv));
1328       break;
1329
1330     case USE_UVX:
1331       RETVAL = (SvUVX(sv) > 0);
1332       break;
1333
1334     case USE_NVX:
1335       RETVAL = SGN (SvNVX(sv));
1336       break;
1337
1338     case USE_PVX:
1339       {
1340         /* FIXME: Maybe this should be done by parsing the string, not by an
1341            actual conversion.  */
1342         STRLEN len;
1343         const char *str = SvPV (sv, len);
1344         if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
1345           RETVAL = mpq_sgn (tmp_mpq_0);
1346         else
1347           {
1348             /* enough for all digits of the string */
1349             tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
1350             if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
1351               RETVAL = mpf_sgn (tmp_mpf_0->m);
1352             else
1353               croak ("GMP::sgn invalid string format");
1354           }
1355       }
1356       break;
1357
1358     case USE_MPZ:
1359       RETVAL = mpz_sgn (SvMPZ(sv)->m);
1360       break;
1361
1362     case USE_MPQ:
1363       RETVAL = mpq_sgn (SvMPQ(sv)->m);
1364       break;
1365
1366     case USE_MPF:
1367       RETVAL = mpf_sgn (SvMPF(sv));
1368       break;
1369
1370     default:
1371       croak ("GMP::sgn invalid argument");
1372     }
1373 OUTPUT:
1374     RETVAL
1375
1376
1377 # currently undocumented
1378 void
1379 shrink ()
1380 CODE:
1381 #define x_mpz_shrink(z) \
1382     mpz_set_ui (z, 0L); _mpz_realloc (z, 1)
1383 #define x_mpq_shrink(q) \
1384     x_mpz_shrink (mpq_numref(q)); x_mpz_shrink (mpq_denref(q))
1385
1386     x_mpz_shrink (tmp_mpz_0);
1387     x_mpz_shrink (tmp_mpz_1);
1388     x_mpz_shrink (tmp_mpz_2);
1389     x_mpq_shrink (tmp_mpq_0);
1390     x_mpq_shrink (tmp_mpq_1);
1391     tmp_mpf_shrink (tmp_mpf_0);
1392     tmp_mpf_shrink (tmp_mpf_1);
1393
1394
1395
1396 malloced_string
1397 sprintf_internal (fmt, sv)
1398     const_string fmt
1399     SV           *sv
1400 CODE:
1401     assert (strlen (fmt) >= 3);
1402     assert (SvROK(sv));
1403     assert ((sv_derived_from (sv, mpz_class)    && fmt[strlen(fmt)-2] == 'Z')
1404             || (sv_derived_from (sv, mpq_class) && fmt[strlen(fmt)-2] == 'Q')
1405             || (sv_derived_from (sv, mpf_class) && fmt[strlen(fmt)-2] == 'F'));
1406     TRACE (printf ("GMP::sprintf_internal\n");
1407            printf ("  fmt  |%s|\n", fmt);
1408            printf ("  sv   |%p|\n", SvMPZ(sv)));
1409
1410     /* cheat a bit here, SvMPZ works for mpq and mpf too */
1411     gmp_asprintf (&RETVAL, fmt, SvMPZ(sv));
1412
1413     TRACE (printf ("  result |%s|\n", RETVAL));
1414 OUTPUT:
1415     RETVAL
1416
1417
1418
1419 #------------------------------------------------------------------------------
1420
1421 MODULE = GMP         PACKAGE = GMP::Mpz
1422
1423 mpz
1424 mpz (...)
1425 ALIAS:
1426     GMP::Mpz::new = 1
1427 PREINIT:
1428     SV *sv;
1429 CODE:
1430     TRACE (printf ("%s new, ix=%ld, items=%d\n", mpz_class, ix, (int) items));
1431     RETVAL = new_mpz();
1432
1433     switch (items) {
1434     case 0:
1435       mpz_set_ui (RETVAL->m, 0L);
1436       break;
1437
1438     case 1:
1439       sv = ST(0);
1440       TRACE (printf ("  use %d\n", use_sv (sv)));
1441       switch (use_sv (sv)) {
1442       case USE_IVX:
1443         mpz_set_si (RETVAL->m, SvIVX(sv));
1444         break;
1445
1446       case USE_UVX:
1447         mpz_set_ui (RETVAL->m, SvUVX(sv));
1448         break;
1449
1450       case USE_NVX:
1451         mpz_set_d (RETVAL->m, SvNVX(sv));
1452         break;
1453
1454       case USE_PVX:
1455         my_mpz_set_svstr (RETVAL->m, sv);
1456         break;
1457
1458       case USE_MPZ:
1459         mpz_set (RETVAL->m, SvMPZ(sv)->m);
1460         break;
1461
1462       case USE_MPQ:
1463         mpz_set_q (RETVAL->m, SvMPQ(sv)->m);
1464         break;
1465
1466       case USE_MPF:
1467         mpz_set_f (RETVAL->m, SvMPF(sv));
1468         break;
1469
1470       default:
1471         goto invalid;
1472       }
1473       break;
1474
1475     default:
1476     invalid:
1477       croak ("%s new: invalid arguments", mpz_class);
1478     }
1479 OUTPUT:
1480     RETVAL
1481
1482
1483 void
1484 overload_constant (str, pv, d1, ...)
1485     const_string_assume str
1486     SV                  *pv
1487     dummy               d1
1488 PREINIT:
1489     mpz z;
1490 PPCODE:
1491     TRACE (printf ("%s constant: %s\n", mpz_class, str));
1492     z = new_mpz();
1493     if (mpz_set_str (z->m, str, 0) == 0)
1494       {
1495         PUSHs (MPX_NEWMORTAL (z, mpz_class_hv));
1496       }
1497     else
1498       {
1499         free_mpz (z);
1500         PUSHs(pv);
1501       }
1502
1503
1504 mpz
1505 overload_copy (z, d1, d2)
1506     mpz_assume z
1507     dummy      d1
1508     dummy      d2
1509 CODE:
1510     RETVAL = new_mpz();
1511     mpz_set (RETVAL->m, z->m);
1512 OUTPUT:
1513     RETVAL
1514
1515
1516 void
1517 DESTROY (z)
1518     mpz_assume z
1519 CODE:
1520     TRACE (printf ("%s DESTROY %p\n", mpz_class, z));
1521     free_mpz (z);
1522
1523
1524 malloced_string
1525 overload_string (z, d1, d2)
1526     mpz_assume z
1527     dummy      d1
1528     dummy      d2
1529 CODE:
1530     TRACE (printf ("%s overload_string %p\n", mpz_class, z));
1531     RETVAL = mpz_get_str (NULL, 10, z->m);
1532 OUTPUT:
1533     RETVAL
1534
1535
1536 mpz
1537 overload_add (xv, yv, order)
1538     SV *xv
1539     SV *yv
1540     SV *order
1541 ALIAS:
1542     GMP::Mpz::overload_sub = 1
1543     GMP::Mpz::overload_mul = 2
1544     GMP::Mpz::overload_div = 3
1545     GMP::Mpz::overload_rem = 4
1546     GMP::Mpz::overload_and = 5
1547     GMP::Mpz::overload_ior = 6
1548     GMP::Mpz::overload_xor = 7
1549 PREINIT:
1550     static_functable const struct {
1551       void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
1552     } table[] = {
1553       { mpz_add    }, /* 0 */
1554       { mpz_sub    }, /* 1 */
1555       { mpz_mul    }, /* 2 */
1556       { mpz_tdiv_q }, /* 3 */
1557       { mpz_tdiv_r }, /* 4 */
1558       { mpz_and    }, /* 5 */
1559       { mpz_ior    }, /* 6 */
1560       { mpz_xor    }, /* 7 */
1561     };
1562 CODE:
1563     assert_table (ix);
1564     if (order == &PL_sv_yes)
1565       SV_PTR_SWAP (xv, yv);
1566     RETVAL = new_mpz();
1567     (*table[ix].op) (RETVAL->m,
1568                      coerce_mpz (tmp_mpz_0, xv),
1569                      coerce_mpz (tmp_mpz_1, yv));
1570 OUTPUT:
1571     RETVAL
1572
1573
1574 void
1575 overload_addeq (x, y, o)
1576     mpz_assume   x
1577     mpz_coerce   y
1578     order_noswap o
1579 ALIAS:
1580     GMP::Mpz::overload_subeq = 1
1581     GMP::Mpz::overload_muleq = 2
1582     GMP::Mpz::overload_diveq = 3
1583     GMP::Mpz::overload_remeq = 4
1584     GMP::Mpz::overload_andeq = 5
1585     GMP::Mpz::overload_ioreq = 6
1586     GMP::Mpz::overload_xoreq = 7
1587 PREINIT:
1588     static_functable const struct {
1589       void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
1590     } table[] = {
1591       { mpz_add    }, /* 0 */
1592       { mpz_sub    }, /* 1 */
1593       { mpz_mul    }, /* 2 */
1594       { mpz_tdiv_q }, /* 3 */
1595       { mpz_tdiv_r }, /* 4 */
1596       { mpz_and    }, /* 5 */
1597       { mpz_ior    }, /* 6 */
1598       { mpz_xor    }, /* 7 */
1599     };
1600 PPCODE:
1601     assert_table (ix);
1602     (*table[ix].op) (x->m, x->m, y);
1603     XPUSHs (ST(0));
1604
1605
1606 mpz
1607 overload_lshift (zv, nv, order)
1608     SV *zv
1609     SV *nv
1610     SV *order
1611 ALIAS:
1612     GMP::Mpz::overload_rshift   = 1
1613     GMP::Mpz::overload_pow      = 2
1614 PREINIT:
1615     static_functable const struct {
1616       void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
1617     } table[] = {
1618       { mpz_mul_2exp }, /* 0 */
1619       { mpz_div_2exp }, /* 1 */
1620       { mpz_pow_ui   }, /* 2 */
1621     };
1622 CODE:
1623     assert_table (ix);
1624     if (order == &PL_sv_yes)
1625       SV_PTR_SWAP (zv, nv);
1626     RETVAL = new_mpz();
1627     (*table[ix].op) (RETVAL->m, coerce_mpz (RETVAL->m, zv), coerce_ulong (nv));
1628 OUTPUT:
1629     RETVAL
1630
1631
1632 void
1633 overload_lshifteq (z, n, o)
1634     mpz_assume   z
1635     ulong_coerce n
1636     order_noswap o
1637 ALIAS:
1638     GMP::Mpz::overload_rshifteq   = 1
1639     GMP::Mpz::overload_poweq      = 2
1640 PREINIT:
1641     static_functable const struct {
1642       void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
1643     } table[] = {
1644       { mpz_mul_2exp }, /* 0 */
1645       { mpz_div_2exp }, /* 1 */
1646       { mpz_pow_ui   }, /* 2 */
1647     };
1648 PPCODE:
1649     assert_table (ix);
1650     (*table[ix].op) (z->m, z->m, n);
1651     XPUSHs(ST(0));
1652
1653
1654 mpz
1655 overload_abs (z, d1, d2)
1656     mpz_assume z
1657     dummy      d1
1658     dummy      d2
1659 ALIAS:
1660     GMP::Mpz::overload_neg  = 1
1661     GMP::Mpz::overload_com  = 2
1662     GMP::Mpz::overload_sqrt = 3
1663 PREINIT:
1664     static_functable const struct {
1665       void (*op) (mpz_ptr w, mpz_srcptr x);
1666     } table[] = {
1667       { mpz_abs  }, /* 0 */
1668       { mpz_neg  }, /* 1 */
1669       { mpz_com  }, /* 2 */
1670       { mpz_sqrt }, /* 3 */
1671     };
1672 CODE:
1673     assert_table (ix);
1674     RETVAL = new_mpz();
1675     (*table[ix].op) (RETVAL->m, z->m);
1676 OUTPUT:
1677     RETVAL
1678
1679
1680 void
1681 overload_inc (z, d1, d2)
1682     mpz_assume z
1683     dummy      d1
1684     dummy      d2
1685 ALIAS:
1686     GMP::Mpz::overload_dec = 1
1687 PREINIT:
1688     static_functable const struct {
1689       void (*op) (mpz_ptr w, mpz_srcptr x, unsigned long y);
1690     } table[] = {
1691       { mpz_add_ui }, /* 0 */
1692       { mpz_sub_ui }, /* 1 */
1693     };
1694 CODE:
1695     assert_table (ix);
1696     (*table[ix].op) (z->m, z->m, 1L);
1697
1698
1699 int
1700 overload_spaceship (xv, yv, order)
1701     SV *xv
1702     SV *yv
1703     SV *order
1704 PREINIT:
1705     mpz x;
1706 CODE:
1707     TRACE (printf ("%s overload_spaceship\n", mpz_class));
1708     MPZ_ASSUME (x, xv);
1709     switch (use_sv (yv)) {
1710     case USE_IVX:
1711       RETVAL = mpz_cmp_si (x->m, SvIVX(yv));
1712       break;
1713     case USE_UVX:
1714       RETVAL = mpz_cmp_ui (x->m, SvUVX(yv));
1715       break;
1716     case USE_PVX:
1717       RETVAL = mpz_cmp (x->m, coerce_mpz (tmp_mpz_0, yv));
1718       break;
1719     case USE_NVX:
1720       RETVAL = mpz_cmp_d (x->m, SvNVX(yv));
1721       break;
1722     case USE_MPZ:
1723       RETVAL = mpz_cmp (x->m, SvMPZ(yv)->m);
1724       break;
1725     case USE_MPQ:
1726       RETVAL = x_mpz_cmp_q (x->m, SvMPQ(yv)->m);
1727       break;
1728     case USE_MPF:
1729       RETVAL = x_mpz_cmp_f (x->m, SvMPF(yv));
1730       break;
1731     default:
1732       croak ("%s <=>: invalid operand", mpz_class);
1733     }
1734     RETVAL = SGN (RETVAL);
1735     if (order == &PL_sv_yes)
1736       RETVAL = -RETVAL;
1737 OUTPUT:
1738     RETVAL
1739
1740
1741 bool
1742 overload_bool (z, d1, d2)
1743     mpz_assume z
1744     dummy      d1
1745     dummy      d2
1746 ALIAS:
1747     GMP::Mpz::overload_not = 1
1748 CODE:
1749     RETVAL = (mpz_sgn (z->m) != 0) ^ ix;
1750 OUTPUT:
1751     RETVAL
1752
1753
1754 mpz
1755 bin (n, k)
1756     mpz_coerce   n
1757     ulong_coerce k
1758 ALIAS:
1759     GMP::Mpz::root = 1
1760 PREINIT:
1761     /* mpz_root returns an int, hence the cast */
1762     static_functable const struct {
1763       void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
1764     } table[] = {
1765       {                                                mpz_bin_ui }, /* 0 */
1766       { (void (*)(mpz_ptr, mpz_srcptr, unsigned long)) mpz_root   }, /* 1 */
1767     };
1768 CODE:
1769     assert_table (ix);
1770     RETVAL = new_mpz();
1771     (*table[ix].op) (RETVAL->m, n, k);
1772 OUTPUT:
1773     RETVAL
1774
1775
1776 void
1777 cdiv (a, d)
1778     mpz_coerce a
1779     mpz_coerce d
1780 ALIAS:
1781     GMP::Mpz::fdiv = 1
1782     GMP::Mpz::tdiv = 2
1783 PREINIT:
1784     static_functable const struct {
1785       void (*op) (mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr);
1786     } table[] = {
1787       { mpz_cdiv_qr }, /* 0 */
1788       { mpz_fdiv_qr }, /* 1 */
1789       { mpz_tdiv_qr }, /* 2 */
1790     };
1791     mpz q, r;
1792 PPCODE:
1793     assert_table (ix);
1794     q = new_mpz();
1795     r = new_mpz();
1796     (*table[ix].op) (q->m, r->m, a, d);
1797     EXTEND (SP, 2);
1798     PUSHs (MPX_NEWMORTAL (q, mpz_class_hv));
1799     PUSHs (MPX_NEWMORTAL (r, mpz_class_hv));
1800
1801
1802 void
1803 cdiv_2exp (a, d)
1804     mpz_coerce   a
1805     ulong_coerce d
1806 ALIAS:
1807     GMP::Mpz::fdiv_2exp = 1
1808     GMP::Mpz::tdiv_2exp = 2
1809 PREINIT:
1810     static_functable const struct {
1811       void (*q) (mpz_ptr, mpz_srcptr, unsigned long);
1812       void (*r) (mpz_ptr, mpz_srcptr, unsigned long);
1813     } table[] = {
1814       { mpz_cdiv_q_2exp, mpz_cdiv_r_2exp }, /* 0 */
1815       { mpz_fdiv_q_2exp, mpz_fdiv_r_2exp }, /* 1 */
1816       { mpz_tdiv_q_2exp, mpz_tdiv_r_2exp }, /* 2 */
1817     };
1818     mpz q, r;
1819 PPCODE:
1820     assert_table (ix);
1821     q = new_mpz();
1822     r = new_mpz();
1823     (*table[ix].q) (q->m, a, d);
1824     (*table[ix].r) (r->m, a, d);
1825     EXTEND (SP, 2);
1826     PUSHs (MPX_NEWMORTAL (q, mpz_class_hv));
1827     PUSHs (MPX_NEWMORTAL (r, mpz_class_hv));
1828
1829
1830 bool
1831 congruent_p (a, c, d)
1832     mpz_coerce a
1833     mpz_coerce c
1834     mpz_coerce d
1835 PREINIT:
1836 CODE:
1837     RETVAL = mpz_congruent_p (a, c, d);
1838 OUTPUT:
1839     RETVAL
1840
1841
1842 bool
1843 congruent_2exp_p (a, c, d)
1844     mpz_coerce   a
1845     mpz_coerce   c
1846     ulong_coerce d
1847 PREINIT:
1848 CODE:
1849     RETVAL = mpz_congruent_2exp_p (a, c, d);
1850 OUTPUT:
1851     RETVAL
1852
1853
1854 mpz
1855 divexact (a, d)
1856     mpz_coerce a
1857     mpz_coerce d
1858 ALIAS:
1859     GMP::Mpz::mod = 1
1860 PREINIT:
1861     static_functable const struct {
1862       void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
1863     } table[] = {
1864       { mpz_divexact }, /* 0 */
1865       { mpz_mod      }, /* 1 */
1866     };
1867 CODE:
1868     assert_table (ix);
1869     RETVAL = new_mpz();
1870     (*table[ix].op) (RETVAL->m, a, d);
1871 OUTPUT:
1872     RETVAL
1873
1874
1875 bool
1876 divisible_p (a, d)
1877     mpz_coerce a
1878     mpz_coerce d
1879 CODE:
1880     RETVAL = mpz_divisible_p (a, d);
1881 OUTPUT:
1882     RETVAL
1883
1884
1885 bool
1886 divisible_2exp_p (a, d)
1887     mpz_coerce   a
1888     ulong_coerce d
1889 CODE:
1890     RETVAL = mpz_divisible_2exp_p (a, d);
1891 OUTPUT:
1892     RETVAL
1893
1894
1895 bool
1896 even_p (z)
1897     mpz_coerce z
1898 ALIAS:
1899     GMP::Mpz::odd_p            = 1
1900     GMP::Mpz::perfect_square_p = 2
1901     GMP::Mpz::perfect_power_p  = 3
1902 PREINIT:
1903     static_functable const struct {
1904       int (*op) (mpz_srcptr z);
1905     } table[] = {
1906       { x_mpz_even_p         }, /* 0 */
1907       { x_mpz_odd_p          }, /* 1 */
1908       { mpz_perfect_square_p }, /* 2 */
1909       { mpz_perfect_power_p  }, /* 3 */
1910     };
1911 CODE:
1912     assert_table (ix);
1913     RETVAL = (*table[ix].op) (z);
1914 OUTPUT:
1915     RETVAL
1916
1917
1918 mpz
1919 fac (n)
1920     ulong_coerce n
1921 ALIAS:
1922     GMP::Mpz::fib    = 1
1923     GMP::Mpz::lucnum = 2
1924 PREINIT:
1925     static_functable const struct {
1926       void (*op) (mpz_ptr r, unsigned long n);
1927     } table[] = {
1928       { mpz_fac_ui },    /* 0 */
1929       { mpz_fib_ui },    /* 1 */
1930       { mpz_lucnum_ui }, /* 2 */
1931     };
1932 CODE:
1933     assert_table (ix);
1934     RETVAL = new_mpz();
1935     (*table[ix].op) (RETVAL->m, n);
1936 OUTPUT:
1937     RETVAL
1938
1939
1940 void
1941 fib2 (n)
1942     ulong_coerce n
1943 ALIAS:
1944     GMP::Mpz::lucnum2 = 1
1945 PREINIT:
1946     static_functable const struct {
1947       void (*op) (mpz_ptr r, mpz_ptr r2, unsigned long n);
1948     } table[] = {
1949       { mpz_fib2_ui },    /* 0 */
1950       { mpz_lucnum2_ui }, /* 1 */
1951     };
1952     mpz  r, r2;
1953 PPCODE:
1954     assert_table (ix);
1955     r = new_mpz();
1956     r2 = new_mpz();
1957     (*table[ix].op) (r->m, r2->m, n);
1958     EXTEND (SP, 2);
1959     PUSHs (MPX_NEWMORTAL (r,  mpz_class_hv));
1960     PUSHs (MPX_NEWMORTAL (r2, mpz_class_hv));
1961
1962
1963 mpz
1964 gcd (x, ...)
1965     mpz_coerce x
1966 ALIAS:
1967     GMP::Mpz::lcm = 1
1968 PREINIT:
1969     static_functable const struct {
1970       void (*op) (mpz_ptr w, mpz_srcptr x, mpz_srcptr y);
1971       void (*op_ui) (mpz_ptr w, mpz_srcptr x, unsigned long y);
1972     } table[] = {
1973       /* cast to ignore ulong return from mpz_gcd_ui */
1974       { mpz_gcd,
1975         (void (*) (mpz_ptr, mpz_srcptr, unsigned long)) mpz_gcd_ui }, /* 0 */
1976       { mpz_lcm, mpz_lcm_ui },                                        /* 1 */
1977     };
1978     int  i;
1979     SV   *yv;
1980 CODE:
1981     assert_table (ix);
1982     RETVAL = new_mpz();
1983     if (items == 1)
1984       mpz_set (RETVAL->m, x);
1985     else
1986       {
1987         for (i = 1; i < items; i++)
1988           {
1989             yv = ST(i);
1990             if (SvIOK(yv))
1991               (*table[ix].op_ui) (RETVAL->m, x, ABS(SvIVX(yv)));
1992             else
1993               (*table[ix].op) (RETVAL->m, x, coerce_mpz (tmp_mpz_1, yv));
1994             x = RETVAL->m;
1995           }
1996       }
1997 OUTPUT:
1998     RETVAL
1999
2000
2001 void
2002 gcdext (a, b)
2003     mpz_coerce a
2004     mpz_coerce b
2005 PREINIT:
2006     mpz g, x, y;
2007     SV  *sv;
2008 PPCODE:
2009     g = new_mpz();
2010     x = new_mpz();
2011     y = new_mpz();
2012     mpz_gcdext (g->m, x->m, y->m, a, b);
2013     EXTEND (SP, 3);
2014     PUSHs (MPX_NEWMORTAL (g, mpz_class_hv));
2015     PUSHs (MPX_NEWMORTAL (x, mpz_class_hv));
2016     PUSHs (MPX_NEWMORTAL (y, mpz_class_hv));
2017
2018
2019 unsigned long
2020 hamdist (x, y)
2021     mpz_coerce x
2022     mpz_coerce y
2023 CODE:
2024     RETVAL = mpz_hamdist (x, y);
2025 OUTPUT:
2026     RETVAL
2027
2028
2029 mpz
2030 invert (a, m)
2031     mpz_coerce a
2032     mpz_coerce m
2033 CODE:
2034     RETVAL = new_mpz();
2035     if (! mpz_invert (RETVAL->m, a, m))
2036       {
2037         free_mpz (RETVAL);
2038         XSRETURN_UNDEF;
2039       }
2040 OUTPUT:
2041     RETVAL
2042
2043
2044 int
2045 jacobi (a, b)
2046     mpz_coerce a
2047     mpz_coerce b
2048 CODE:
2049     RETVAL = mpz_jacobi (a, b);
2050 OUTPUT:
2051     RETVAL
2052
2053
2054 int
2055 kronecker (a, b)
2056     SV *a
2057     SV *b
2058 CODE:
2059     if (SvIOK(b))
2060       RETVAL = mpz_kronecker_si (coerce_mpz(tmp_mpz_0,a), SvIVX(b));
2061     else if (SvIOK(a))
2062       RETVAL = mpz_si_kronecker (SvIVX(a), coerce_mpz(tmp_mpz_0,b));
2063     else
2064       RETVAL = mpz_kronecker (coerce_mpz(tmp_mpz_0,a),
2065                               coerce_mpz(tmp_mpz_1,b));
2066 OUTPUT:
2067     RETVAL
2068
2069
2070 void
2071 mpz_export (order, size, endian, nails, z)
2072     int        order
2073     size_t     size
2074     int        endian
2075     size_t     nails
2076     mpz_coerce z
2077 PREINIT:
2078     size_t  numb, count, bytes, actual_count;
2079     char    *data;
2080     SV      *sv;
2081 PPCODE:
2082     numb = 8*size - nails;
2083     count = (mpz_sizeinbase (z, 2) + numb-1) / numb;
2084     bytes = count * size;
2085     New (GMP_MALLOC_ID, data, bytes+1, char);
2086     mpz_export (data, &actual_count, order, size, endian, nails, z);
2087     assert (count == actual_count);
2088     data[bytes] = '\0';
2089     sv = sv_newmortal(); sv_usepvn_mg (sv, data, bytes); PUSHs(sv);
2090
2091
2092 mpz
2093 mpz_import (order, size, endian, nails, sv)
2094     int     order
2095     size_t  size
2096     int     endian
2097     size_t  nails
2098     SV      *sv
2099 PREINIT:
2100     size_t      count;
2101     const char  *data;
2102     STRLEN      len;
2103 CODE:
2104     data = SvPV (sv, len);
2105     if ((len % size) != 0)
2106       croak ("%s mpz_import: string not a multiple of the given size",
2107              mpz_class);
2108     count = len / size;
2109     RETVAL = new_mpz();
2110     mpz_import (RETVAL->m, count, order, size, endian, nails, data);
2111 OUTPUT:
2112     RETVAL
2113
2114
2115 mpz
2116 nextprime (z)
2117     mpz_coerce z
2118 CODE:
2119     RETVAL = new_mpz();
2120     mpz_nextprime (RETVAL->m, z);
2121 OUTPUT:
2122     RETVAL
2123
2124
2125 unsigned long
2126 popcount (x)
2127     mpz_coerce x
2128 CODE:
2129     RETVAL = mpz_popcount (x);
2130 OUTPUT:
2131     RETVAL
2132
2133
2134 mpz
2135 powm (b, e, m)
2136     mpz_coerce b
2137     mpz_coerce e
2138     mpz_coerce m
2139 CODE:
2140     RETVAL = new_mpz();
2141     mpz_powm (RETVAL->m, b, e, m);
2142 OUTPUT:
2143     RETVAL
2144
2145
2146 bool
2147 probab_prime_p (z, n)
2148     mpz_coerce   z
2149     ulong_coerce n
2150 CODE:
2151     RETVAL = mpz_probab_prime_p (z, n);
2152 OUTPUT:
2153     RETVAL
2154
2155
2156 # No attempt to coerce here, only an mpz makes sense.
2157 void
2158 realloc (z, limbs)
2159     mpz z
2160     int limbs
2161 CODE:
2162     _mpz_realloc (z->m, limbs);
2163
2164
2165 void
2166 remove (z, f)
2167     mpz_coerce z
2168     mpz_coerce f
2169 PREINIT:
2170     SV             *sv;
2171     mpz            rem;
2172     unsigned long  mult;
2173 PPCODE:
2174     rem = new_mpz();
2175     mult = mpz_remove (rem->m, z, f);
2176     EXTEND (SP, 2);
2177     PUSHs (MPX_NEWMORTAL (rem, mpz_class_hv));
2178     PUSHs (sv_2mortal (newSViv (mult)));
2179
2180
2181 void
2182 roote (z, n)
2183     mpz_coerce   z
2184     ulong_coerce n
2185 PREINIT:
2186     SV  *sv;
2187     mpz root;
2188     int exact;
2189 PPCODE:
2190     root = new_mpz();
2191     exact = mpz_root (root->m, z, n);
2192     EXTEND (SP, 2);
2193     PUSHs (MPX_NEWMORTAL (root, mpz_class_hv));
2194     sv = (exact ? &PL_sv_yes : &PL_sv_no); sv_2mortal(sv); PUSHs(sv);
2195
2196
2197 void
2198 rootrem (z, n)
2199     mpz_coerce   z
2200     ulong_coerce n
2201 PREINIT:
2202     SV  *sv;
2203     mpz root;
2204     mpz rem;
2205 PPCODE:
2206     root = new_mpz();
2207     rem = new_mpz();
2208     mpz_rootrem (root->m, rem->m, z, n);
2209     EXTEND (SP, 2);
2210     PUSHs (MPX_NEWMORTAL (root, mpz_class_hv));
2211     PUSHs (MPX_NEWMORTAL (rem,  mpz_class_hv));
2212
2213
2214 # In the past scan0 and scan1 were described as returning ULONG_MAX which
2215 # could be obtained in perl with ~0.  That wasn't true on 64-bit systems
2216 # (eg. alpha) with perl 5.005, since in that version IV and UV were still
2217 # 32-bits.
2218 #
2219 # We changed in gmp 4.2 to just say ~0 for the not-found return.  It's
2220 # likely most people have used ~0 rather than POSIX::ULONG_MAX(), so this
2221 # change should match existing usage.  It only actually makes a difference
2222 # in old perl, since recent versions have gone to 64-bits for IV and UV, the
2223 # same as a ulong.
2224 #
2225 # In perl 5.005 we explicitly mask the mpz return down to 32-bits to get ~0.
2226 # UV_MAX is no good, it reflects the size of the UV type (64-bits), rather
2227 # than the size of the values one ought to be storing in an SV (32-bits).
2228
2229 gmp_UV
2230 scan0 (z, start)
2231     mpz_coerce   z
2232     ulong_coerce start
2233 ALIAS:
2234     GMP::Mpz::scan1 = 1
2235 PREINIT:
2236     static_functable const struct {
2237       unsigned long (*op) (mpz_srcptr, unsigned long);
2238     } table[] = {
2239       { mpz_scan0  }, /* 0 */
2240       { mpz_scan1  }, /* 1 */
2241     };
2242 CODE:
2243     assert_table (ix);
2244     RETVAL = (*table[ix].op) (z, start);
2245     if (PERL_LT (5,6))
2246       RETVAL &= 0xFFFFFFFF;
2247 OUTPUT:
2248     RETVAL
2249
2250
2251 void
2252 setbit (sv, bit)
2253     SV           *sv
2254     ulong_coerce bit
2255 ALIAS:
2256     GMP::Mpz::clrbit = 1
2257     GMP::Mpz::combit = 2
2258 PREINIT:
2259     static_functable const struct {
2260       void (*op) (mpz_ptr, unsigned long);
2261     } table[] = {
2262       { mpz_setbit }, /* 0 */
2263       { mpz_clrbit }, /* 1 */
2264       { mpz_combit }, /* 2 */
2265     };
2266     int  use;
2267     mpz  z;
2268 CODE:
2269     use = use_sv (sv);
2270     if (use == USE_MPZ && SvREFCNT(SvRV(sv)) == 1 && ! SvSMAGICAL(sv))
2271       {
2272         /* our operand is a non-magical mpz with a reference count of 1, so
2273            we can just modify it */
2274         (*table[ix].op) (SvMPZ(sv)->m, bit);
2275       }
2276     else
2277       {
2278         /* otherwise we need to make a new mpz, from whatever we have, and
2279            operate on that, possibly invoking magic when storing back */
2280         SV   *new_sv;
2281         mpz  z = new_mpz ();
2282         mpz_ptr  coerce_ptr = coerce_mpz_using (z->m, sv, use);
2283         if (coerce_ptr != z->m)
2284           mpz_set (z->m, coerce_ptr);
2285         (*table[ix].op) (z->m, bit);
2286         new_sv = sv_bless (sv_setref_pv (sv_newmortal(), NULL, z),
2287                            mpz_class_hv);
2288         SvSetMagicSV (sv, new_sv);
2289       }
2290
2291
2292 void
2293 sqrtrem (z)
2294     mpz_coerce z
2295 PREINIT:
2296     SV  *sv;
2297     mpz root;
2298     mpz rem;
2299 PPCODE:
2300     root = new_mpz();
2301     rem = new_mpz();
2302     mpz_sqrtrem (root->m, rem->m, z);
2303     EXTEND (SP, 2);
2304     PUSHs (MPX_NEWMORTAL (root, mpz_class_hv));
2305     PUSHs (MPX_NEWMORTAL (rem,  mpz_class_hv));
2306
2307
2308 size_t
2309 sizeinbase (z, base)
2310     mpz_coerce z
2311     int        base
2312 CODE:
2313     RETVAL = mpz_sizeinbase (z, base);
2314 OUTPUT:
2315     RETVAL
2316
2317
2318 int
2319 tstbit (z, bit)
2320     mpz_coerce   z
2321     ulong_coerce bit
2322 CODE:
2323     RETVAL = mpz_tstbit (z, bit);
2324 OUTPUT:
2325     RETVAL
2326
2327
2328
2329 #------------------------------------------------------------------------------
2330
2331 MODULE = GMP         PACKAGE = GMP::Mpq
2332
2333
2334 mpq
2335 mpq (...)
2336 ALIAS:
2337     GMP::Mpq::new = 1
2338 CODE:
2339     TRACE (printf ("%s new, ix=%ld, items=%d\n", mpq_class, ix, (int) items));
2340     RETVAL = new_mpq();
2341     switch (items) {
2342     case 0:
2343       mpq_set_ui (RETVAL->m, 0L, 1L);
2344       break;
2345     case 1:
2346       {
2347         mpq_ptr rp = RETVAL->m;
2348         mpq_ptr cp = coerce_mpq (rp, ST(0));
2349         if (cp != rp)
2350           mpq_set (rp, cp);
2351       }
2352       break;
2353     case 2:
2354       {
2355         mpz_ptr rp, cp;
2356         rp = mpq_numref (RETVAL->m);
2357         cp = coerce_mpz (rp, ST(0));
2358         if (cp != rp)
2359           mpz_set (rp, cp);
2360         rp = mpq_denref (RETVAL->m);
2361         cp = coerce_mpz (rp, ST(1));
2362         if (cp != rp)
2363           mpz_set (rp, cp);
2364       }
2365       break;
2366     default:
2367       croak ("%s new: invalid arguments", mpq_class);
2368     }
2369 OUTPUT:
2370     RETVAL
2371
2372
2373 void
2374 overload_constant (str, pv, d1, ...)
2375     const_string_assume str
2376     SV                  *pv
2377     dummy               d1
2378 PREINIT:
2379     SV  *sv;
2380     mpq q;
2381 PPCODE:
2382     TRACE (printf ("%s constant: %s\n", mpq_class, str));
2383     q = new_mpq();
2384     if (mpq_set_str (q->m, str, 0) == 0)
2385       { sv = sv_bless (sv_setref_pv (sv_newmortal(), NULL, q), mpq_class_hv); }
2386     else
2387       { free_mpq (q); sv = pv; }
2388     XPUSHs(sv);
2389
2390
2391 mpq
2392 overload_copy (q, d1, d2)
2393     mpq_assume q
2394     dummy      d1
2395     dummy      d2
2396 CODE:
2397     RETVAL = new_mpq();
2398     mpq_set (RETVAL->m, q->m);
2399 OUTPUT:
2400     RETVAL
2401
2402
2403 void
2404 DESTROY (q)
2405     mpq_assume q
2406 CODE:
2407     TRACE (printf ("%s DESTROY %p\n", mpq_class, q));
2408     free_mpq (q);
2409
2410
2411 malloced_string
2412 overload_string (q, d1, d2)
2413     mpq_assume q
2414     dummy      d1
2415     dummy      d2
2416 CODE:
2417     TRACE (printf ("%s overload_string %p\n", mpq_class, q));
2418     RETVAL = mpq_get_str (NULL, 10, q->m);
2419 OUTPUT:
2420     RETVAL
2421
2422
2423 mpq
2424 overload_add (xv, yv, order)
2425     SV *xv
2426     SV *yv
2427     SV *order
2428 ALIAS:
2429     GMP::Mpq::overload_sub   = 1
2430     GMP::Mpq::overload_mul   = 2
2431     GMP::Mpq::overload_div   = 3
2432 PREINIT:
2433     static_functable const struct {
2434       void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
2435     } table[] = {
2436       { mpq_add }, /* 0 */
2437       { mpq_sub }, /* 1 */
2438       { mpq_mul }, /* 2 */
2439       { mpq_div }, /* 3 */
2440     };
2441 CODE:
2442     TRACE (printf ("%s binary\n", mpf_class));
2443     assert_table (ix);
2444     if (order == &PL_sv_yes)
2445       SV_PTR_SWAP (xv, yv);
2446     RETVAL = new_mpq();
2447     (*table[ix].op) (RETVAL->m,
2448                      coerce_mpq (tmp_mpq_0, xv),
2449                      coerce_mpq (tmp_mpq_1, yv));
2450 OUTPUT:
2451     RETVAL
2452
2453
2454 void
2455 overload_addeq (x, y, o)
2456     mpq_assume   x
2457     mpq_coerce   y
2458     order_noswap o
2459 ALIAS:
2460     GMP::Mpq::overload_subeq = 1
2461     GMP::Mpq::overload_muleq = 2
2462     GMP::Mpq::overload_diveq = 3
2463 PREINIT:
2464     static_functable const struct {
2465       void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
2466     } table[] = {
2467       { mpq_add    }, /* 0 */
2468       { mpq_sub    }, /* 1 */
2469       { mpq_mul    }, /* 2 */
2470       { mpq_div    }, /* 3 */
2471     };
2472 PPCODE:
2473     assert_table (ix);
2474     (*table[ix].op) (x->m, x->m, y);
2475     XPUSHs(ST(0));
2476
2477
2478 mpq
2479 overload_lshift (qv, nv, order)
2480     SV *qv
2481     SV *nv
2482     SV *order
2483 ALIAS:
2484     GMP::Mpq::overload_rshift   = 1
2485     GMP::Mpq::overload_pow      = 2
2486 PREINIT:
2487     static_functable const struct {
2488       void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
2489     } table[] = {
2490       { mpq_mul_2exp }, /* 0 */
2491       { mpq_div_2exp }, /* 1 */
2492       { x_mpq_pow_ui }, /* 2 */
2493     };
2494 CODE:
2495     assert_table (ix);
2496     if (order == &PL_sv_yes)
2497       SV_PTR_SWAP (qv, nv);
2498     RETVAL = new_mpq();
2499     (*table[ix].op) (RETVAL->m, coerce_mpq (RETVAL->m, qv), coerce_ulong (nv));
2500 OUTPUT:
2501     RETVAL
2502
2503
2504 void
2505 overload_lshifteq (q, n, o)
2506     mpq_assume   q
2507     ulong_coerce n
2508     order_noswap o
2509 ALIAS:
2510     GMP::Mpq::overload_rshifteq   = 1
2511     GMP::Mpq::overload_poweq      = 2
2512 PREINIT:
2513     static_functable const struct {
2514       void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
2515     } table[] = {
2516       { mpq_mul_2exp }, /* 0 */
2517       { mpq_div_2exp }, /* 1 */
2518       { x_mpq_pow_ui }, /* 2 */
2519     };
2520 PPCODE:
2521     assert_table (ix);
2522     (*table[ix].op) (q->m, q->m, n);
2523     XPUSHs(ST(0));
2524
2525
2526 void
2527 overload_inc (q, d1, d2)
2528     mpq_assume q
2529     dummy      d1
2530     dummy      d2
2531 ALIAS:
2532     GMP::Mpq::overload_dec = 1
2533 PREINIT:
2534     static_functable const struct {
2535       void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
2536     } table[] = {
2537       { mpz_add }, /* 0 */
2538       { mpz_sub }, /* 1 */
2539     };
2540 CODE:
2541     assert_table (ix);
2542     (*table[ix].op) (mpq_numref(q->m), mpq_numref(q->m), mpq_denref(q->m));
2543
2544
2545 mpq
2546 overload_abs (q, d1, d2)
2547     mpq_assume q
2548     dummy      d1
2549     dummy      d2
2550 ALIAS:
2551     GMP::Mpq::overload_neg = 1
2552 PREINIT:
2553     static_functable const struct {
2554       void (*op) (mpq_ptr w, mpq_srcptr x);
2555     } table[] = {
2556       { mpq_abs }, /* 0 */
2557       { mpq_neg }, /* 1 */
2558     };
2559 CODE:
2560     assert_table (ix);
2561     RETVAL = new_mpq();
2562     (*table[ix].op) (RETVAL->m, q->m);
2563 OUTPUT:
2564     RETVAL
2565
2566
2567 int
2568 overload_spaceship (x, y, order)
2569     mpq_assume x
2570     mpq_coerce y
2571     SV         *order
2572 CODE:
2573     RETVAL = mpq_cmp (x->m, y);
2574     RETVAL = SGN (RETVAL);
2575     if (order == &PL_sv_yes)
2576       RETVAL = -RETVAL;
2577 OUTPUT:
2578     RETVAL
2579
2580
2581 bool
2582 overload_bool (q, d1, d2)
2583     mpq_assume q
2584     dummy      d1
2585     dummy      d2
2586 ALIAS:
2587     GMP::Mpq::overload_not = 1
2588 CODE:
2589     RETVAL = (mpq_sgn (q->m) != 0) ^ ix;
2590 OUTPUT:
2591     RETVAL
2592
2593
2594 bool
2595 overload_eq (x, yv, d)
2596     mpq_assume x
2597     SV         *yv
2598     dummy      d
2599 ALIAS:
2600     GMP::Mpq::overload_ne = 1
2601 PREINIT:
2602     int  use;
2603 CODE:
2604     use = use_sv (yv);
2605     switch (use) {
2606     case USE_IVX:
2607     case USE_UVX:
2608     case USE_MPZ:
2609       RETVAL = 0;
2610       if (x_mpq_integer_p (x->m))
2611         {
2612           switch (use) {
2613           case USE_IVX:
2614             RETVAL = (mpz_cmp_si (mpq_numref(x->m), SvIVX(yv)) == 0);
2615             break;
2616           case USE_UVX:
2617             RETVAL = (mpz_cmp_ui (mpq_numref(x->m), SvUVX(yv)) == 0);
2618             break;
2619           case USE_MPZ:
2620             RETVAL = (mpz_cmp (mpq_numref(x->m), SvMPZ(yv)->m) == 0);
2621             break;
2622           }
2623         }
2624       break;
2625
2626     case USE_MPQ:
2627       RETVAL = (mpq_equal (x->m, SvMPQ(yv)->m) != 0);
2628       break;
2629
2630     default:
2631       RETVAL = (mpq_equal (x->m, coerce_mpq_using (tmp_mpq_0, yv, use)) != 0);
2632       break;
2633     }
2634     RETVAL ^= ix;
2635 OUTPUT:
2636     RETVAL
2637
2638
2639 void
2640 canonicalize (q)
2641     mpq q
2642 CODE:
2643     mpq_canonicalize (q->m);
2644
2645
2646 mpq
2647 inv (q)
2648     mpq_coerce q
2649 CODE:
2650     RETVAL = new_mpq();
2651     mpq_inv (RETVAL->m, q);
2652 OUTPUT:
2653     RETVAL
2654
2655
2656 mpz
2657 num (q)
2658     mpq q
2659 ALIAS:
2660     GMP::Mpq::den = 1
2661 CODE:
2662     RETVAL = new_mpz();
2663     mpz_set (RETVAL->m, (ix == 0 ? mpq_numref(q->m) : mpq_denref(q->m)));
2664 OUTPUT:
2665     RETVAL
2666
2667
2668
2669 #------------------------------------------------------------------------------
2670
2671 MODULE = GMP         PACKAGE = GMP::Mpf
2672
2673
2674 mpf
2675 mpf (...)
2676 ALIAS:
2677     GMP::Mpf::new = 1
2678 PREINIT:
2679     unsigned long  prec;
2680 CODE:
2681     TRACE (printf ("%s new\n", mpf_class));
2682     if (items > 2)
2683       croak ("%s new: invalid arguments", mpf_class);
2684     prec = (items == 2 ? coerce_ulong (ST(1)) : mpf_get_default_prec());
2685     RETVAL = new_mpf (prec);
2686     if (items >= 1)
2687       {
2688         SV *sv = ST(0);
2689         my_mpf_set_sv_using (RETVAL, sv, use_sv(sv));
2690       }
2691 OUTPUT:
2692     RETVAL
2693
2694
2695 mpf
2696 overload_constant (sv, d1, d2, ...)
2697     SV     *sv
2698     dummy  d1
2699     dummy  d2
2700 CODE:
2701     assert (SvPOK (sv));
2702     TRACE (printf ("%s constant: %s\n", mpq_class, SvPVX(sv)));
2703     RETVAL = new_mpf (mpf_get_default_prec());
2704     my_mpf_set_svstr (RETVAL, sv);
2705 OUTPUT:
2706     RETVAL
2707
2708
2709 mpf
2710 overload_copy (f, d1, d2)
2711     mpf_assume f
2712     dummy      d1
2713     dummy      d2
2714 CODE:
2715     TRACE (printf ("%s copy\n", mpf_class));
2716     RETVAL = new_mpf (mpf_get_prec (f));
2717     mpf_set (RETVAL, f);
2718 OUTPUT:
2719     RETVAL
2720
2721
2722 void
2723 DESTROY (f)
2724     mpf_assume f
2725 CODE:
2726     TRACE (printf ("%s DESTROY %p\n", mpf_class, f));
2727     mpf_clear (f);
2728     Safefree (f);
2729     assert_support (mpf_count--);
2730     TRACE_ACTIVE ();
2731
2732
2733 mpf
2734 overload_add (x, y, order)
2735     mpf_assume     x
2736     mpf_coerce_st0 y
2737     SV             *order
2738 ALIAS:
2739     GMP::Mpf::overload_sub   = 1
2740     GMP::Mpf::overload_mul   = 2
2741     GMP::Mpf::overload_div   = 3
2742 PREINIT:
2743     static_functable const struct {
2744       void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
2745     } table[] = {
2746       { mpf_add }, /* 0 */
2747       { mpf_sub }, /* 1 */
2748       { mpf_mul }, /* 2 */
2749       { mpf_div }, /* 3 */
2750     };
2751 CODE:
2752     assert_table (ix);
2753     RETVAL = new_mpf (mpf_get_prec (x));
2754     if (order == &PL_sv_yes)
2755       MPF_PTR_SWAP (x, y);
2756     (*table[ix].op) (RETVAL, x, y);
2757 OUTPUT:
2758     RETVAL
2759
2760
2761 void
2762 overload_addeq (x, y, o)
2763     mpf_assume     x
2764     mpf_coerce_st0 y
2765     order_noswap   o
2766 ALIAS:
2767     GMP::Mpf::overload_subeq = 1
2768     GMP::Mpf::overload_muleq = 2
2769     GMP::Mpf::overload_diveq = 3
2770 PREINIT:
2771     static_functable const struct {
2772       void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
2773     } table[] = {
2774       { mpf_add }, /* 0 */
2775       { mpf_sub }, /* 1 */
2776       { mpf_mul }, /* 2 */
2777       { mpf_div }, /* 3 */
2778     };
2779 PPCODE:
2780     assert_table (ix);
2781     (*table[ix].op) (x, x, y);
2782     XPUSHs(ST(0));
2783
2784
2785 mpf
2786 overload_lshift (fv, nv, order)
2787     SV *fv
2788     SV *nv
2789     SV *order
2790 ALIAS:
2791     GMP::Mpf::overload_rshift = 1
2792     GMP::Mpf::overload_pow    = 2
2793 PREINIT:
2794     static_functable const struct {
2795       void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
2796     } table[] = {
2797       { mpf_mul_2exp }, /* 0 */
2798       { mpf_div_2exp }, /* 1 */
2799       { mpf_pow_ui   }, /* 2 */
2800     };
2801     mpf f;
2802     unsigned long prec;
2803 CODE:
2804     assert_table (ix);
2805     MPF_ASSUME (f, fv);
2806     prec = mpf_get_prec (f);
2807     if (order == &PL_sv_yes)
2808       SV_PTR_SWAP (fv, nv);
2809     f = coerce_mpf (tmp_mpf_0, fv, prec);
2810     RETVAL = new_mpf (prec);
2811     (*table[ix].op) (RETVAL, f, coerce_ulong (nv));
2812 OUTPUT:
2813     RETVAL
2814
2815
2816 void
2817 overload_lshifteq (f, n, o)
2818     mpf_assume   f
2819     ulong_coerce n
2820     order_noswap o
2821 ALIAS:
2822     GMP::Mpf::overload_rshifteq   = 1
2823     GMP::Mpf::overload_poweq      = 2
2824 PREINIT:
2825     static_functable const struct {
2826       void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
2827     } table[] = {
2828       { mpf_mul_2exp }, /* 0 */
2829       { mpf_div_2exp }, /* 1 */
2830       { mpf_pow_ui   }, /* 2 */
2831     };
2832 PPCODE:
2833     assert_table (ix);
2834     (*table[ix].op) (f, f, n);
2835     XPUSHs(ST(0));
2836
2837
2838 mpf
2839 overload_abs (f, d1, d2)
2840     mpf_assume f
2841     dummy      d1
2842     dummy      d2
2843 ALIAS:
2844     GMP::Mpf::overload_neg   = 1
2845     GMP::Mpf::overload_sqrt  = 2
2846 PREINIT:
2847     static_functable const struct {
2848       void (*op) (mpf_ptr w, mpf_srcptr x);
2849     } table[] = {
2850       { mpf_abs  }, /* 0 */
2851       { mpf_neg  }, /* 1 */
2852       { mpf_sqrt }, /* 2 */
2853     };
2854 CODE:
2855     assert_table (ix);
2856     RETVAL = new_mpf (mpf_get_prec (f));
2857     (*table[ix].op) (RETVAL, f);
2858 OUTPUT:
2859     RETVAL
2860
2861
2862 void
2863 overload_inc (f, d1, d2)
2864     mpf_assume f
2865     dummy      d1
2866     dummy      d2
2867 ALIAS:
2868     GMP::Mpf::overload_dec = 1
2869 PREINIT:
2870     static_functable const struct {
2871       void (*op) (mpf_ptr w, mpf_srcptr x, unsigned long y);
2872     } table[] = {
2873       { mpf_add_ui }, /* 0 */
2874       { mpf_sub_ui }, /* 1 */
2875     };
2876 CODE:
2877     assert_table (ix);
2878     (*table[ix].op) (f, f, 1L);
2879
2880
2881 int
2882 overload_spaceship (xv, yv, order)
2883     SV *xv
2884     SV *yv
2885     SV *order
2886 PREINIT:
2887     mpf x;
2888 CODE:
2889     MPF_ASSUME (x, xv);
2890     switch (use_sv (yv)) {
2891     case USE_IVX:
2892       RETVAL = mpf_cmp_si (x, SvIVX(yv));
2893       break;
2894     case USE_UVX:
2895       RETVAL = mpf_cmp_ui (x, SvUVX(yv));
2896       break;
2897     case USE_NVX:
2898       RETVAL = mpf_cmp_d (x, SvNVX(yv));
2899       break;
2900     case USE_PVX:
2901       {
2902         STRLEN len;
2903         const char *str = SvPV (yv, len);
2904         /* enough for all digits of the string */
2905         tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
2906         if (mpf_set_str (tmp_mpf_0->m, str, 10) != 0)
2907           croak ("%s <=>: invalid string format", mpf_class);
2908         RETVAL = mpf_cmp (x, tmp_mpf_0->m);
2909       }
2910       break;
2911     case USE_MPZ:
2912       RETVAL = - x_mpz_cmp_f (SvMPZ(yv)->m, x);
2913       break;
2914     case USE_MPF:
2915       RETVAL = mpf_cmp (x, SvMPF(yv));
2916       break;
2917     default:
2918       RETVAL = mpq_cmp (coerce_mpq (tmp_mpq_0, xv),
2919                         coerce_mpq (tmp_mpq_1, yv));
2920       break;
2921     }
2922     RETVAL = SGN (RETVAL);
2923     if (order == &PL_sv_yes)
2924       RETVAL = -RETVAL;
2925 OUTPUT:
2926     RETVAL
2927
2928
2929 bool
2930 overload_bool (f, d1, d2)
2931     mpf_assume f
2932     dummy      d1
2933     dummy      d2
2934 ALIAS:
2935     GMP::Mpf::overload_not = 1
2936 CODE:
2937     RETVAL = (mpf_sgn (f) != 0) ^ ix;
2938 OUTPUT:
2939     RETVAL
2940
2941
2942 mpf
2943 ceil (f)
2944     mpf_coerce_def f
2945 ALIAS:
2946     GMP::Mpf::floor = 1
2947     GMP::Mpf::trunc = 2
2948 PREINIT:
2949     static_functable const struct {
2950       void (*op) (mpf_ptr w, mpf_srcptr x);
2951     } table[] = {
2952       { mpf_ceil  }, /* 0 */
2953       { mpf_floor }, /* 1 */
2954       { mpf_trunc }, /* 2 */
2955     };
2956 CODE:
2957     assert_table (ix);
2958     RETVAL = new_mpf (mpf_get_prec (f));
2959     (*table[ix].op) (RETVAL, f);
2960 OUTPUT:
2961     RETVAL
2962
2963
2964 unsigned long
2965 get_default_prec ()
2966 CODE:
2967     RETVAL = mpf_get_default_prec();
2968 OUTPUT:
2969     RETVAL
2970
2971
2972 unsigned long
2973 get_prec (f)
2974     mpf_coerce_def f
2975 CODE:
2976     RETVAL = mpf_get_prec (f);
2977 OUTPUT:
2978     RETVAL
2979
2980
2981 bool
2982 mpf_eq (xv, yv, bits)
2983     SV           *xv
2984     SV           *yv
2985     ulong_coerce bits
2986 PREINIT:
2987     mpf  x, y;
2988 CODE:
2989     TRACE (printf ("%s eq\n", mpf_class));
2990     coerce_mpf_pair (&x,xv, &y,yv);
2991     RETVAL = mpf_eq (x, y, bits);
2992 OUTPUT:
2993     RETVAL
2994
2995
2996 mpf
2997 reldiff (xv, yv)
2998     SV *xv
2999     SV *yv
3000 PREINIT:
3001     mpf  x, y;
3002     unsigned long prec;
3003 CODE:
3004     TRACE (printf ("%s reldiff\n", mpf_class));
3005     prec = coerce_mpf_pair (&x,xv, &y,yv);
3006     RETVAL = new_mpf (prec);
3007     mpf_reldiff (RETVAL, x, y);
3008 OUTPUT:
3009     RETVAL
3010
3011
3012 void
3013 set_default_prec (prec)
3014     ulong_coerce prec
3015 CODE:
3016     TRACE (printf ("%s set_default_prec %lu\n", mpf_class, prec));
3017     mpf_set_default_prec (prec);
3018
3019
3020 void
3021 set_prec (sv, prec)
3022     SV           *sv
3023     ulong_coerce prec
3024 PREINIT:
3025     mpf_ptr  old_f, new_f;
3026     int      use;
3027 CODE:
3028     TRACE (printf ("%s set_prec to %lu\n", mpf_class, prec));
3029     use = use_sv (sv);
3030     if (use == USE_MPF)
3031       {
3032         old_f = SvMPF(sv);
3033         if (SvREFCNT(SvRV(sv)) == 1)
3034           mpf_set_prec (old_f, prec);
3035         else
3036           {
3037             TRACE (printf ("  fork new mpf\n"));
3038             new_f = new_mpf (prec);
3039             mpf_set (new_f, old_f);
3040             goto setref;
3041           }
3042       }
3043     else
3044       {
3045         TRACE (printf ("  coerce to mpf\n"));
3046         new_f = new_mpf (prec);
3047         my_mpf_set_sv_using (new_f, sv, use);
3048       setref:
3049         sv_bless (sv_setref_pv (sv, NULL, new_f), mpf_class_hv);
3050       }
3051
3052
3053
3054 #------------------------------------------------------------------------------
3055
3056 MODULE = GMP         PACKAGE = GMP::Rand
3057
3058 randstate
3059 new (...)
3060 ALIAS:
3061     GMP::Rand::randstate = 1
3062 CODE:
3063     TRACE (printf ("%s new\n", rand_class));
3064     New (GMP_MALLOC_ID, RETVAL, 1, __gmp_randstate_struct);
3065     TRACE (printf ("  RETVAL %p\n", RETVAL));
3066     assert_support (rand_count++);
3067     TRACE_ACTIVE ();
3068
3069     if (items == 0)
3070       {
3071         gmp_randinit_default (RETVAL);
3072       }
3073     else
3074       {
3075         if (SvROK (ST(0)) && sv_derived_from (ST(0), rand_class))
3076           {
3077             if (items != 1)
3078               goto invalid;
3079             gmp_randinit_set (RETVAL, SvRANDSTATE (ST(0)));
3080           }
3081         else
3082           {
3083             STRLEN      len;
3084             const char  *method = SvPV (ST(0), len);
3085             assert (len == strlen (method));
3086             if (strcmp (method, "lc_2exp") == 0)
3087               {
3088                 if (items != 4)
3089                   goto invalid;
3090                 gmp_randinit_lc_2exp (RETVAL,
3091                                       coerce_mpz (tmp_mpz_0, ST(1)),
3092                                       coerce_ulong (ST(2)),
3093                                       coerce_ulong (ST(3)));
3094               }
3095             else if (strcmp (method, "lc_2exp_size") == 0)
3096               {
3097                 if (items != 2)
3098                   goto invalid;
3099                 if (! gmp_randinit_lc_2exp_size (RETVAL, coerce_ulong (ST(1))))
3100                   {
3101                     Safefree (RETVAL);
3102                     XSRETURN_UNDEF;
3103                   }
3104               }
3105             else if (strcmp (method, "mt") == 0)
3106               {
3107                 if (items != 1)
3108                   goto invalid;
3109                 gmp_randinit_mt (RETVAL);
3110               }
3111             else
3112               {
3113               invalid:
3114                 croak ("%s new: invalid arguments", rand_class);
3115               }
3116           }
3117       }
3118 OUTPUT:
3119     RETVAL
3120
3121
3122 void
3123 DESTROY (r)
3124     randstate r
3125 CODE:
3126     TRACE (printf ("%s DESTROY\n", rand_class));
3127     gmp_randclear (r);
3128     Safefree (r);
3129     assert_support (rand_count--);
3130     TRACE_ACTIVE ();
3131
3132
3133 void
3134 seed (r, z)
3135     randstate  r
3136     mpz_coerce z
3137 CODE:
3138     gmp_randseed (r, z);
3139
3140
3141 mpz
3142 mpz_urandomb (r, bits)
3143     randstate    r
3144     ulong_coerce bits
3145 ALIAS:
3146     GMP::Rand::mpz_rrandomb = 1
3147 PREINIT:
3148     static_functable const struct {
3149       void (*fun) (mpz_ptr, gmp_randstate_t r, unsigned long bits);
3150     } table[] = {
3151       { mpz_urandomb }, /* 0 */
3152       { mpz_rrandomb }, /* 1 */
3153     };
3154 CODE:
3155     assert_table (ix);
3156     RETVAL = new_mpz();
3157     (*table[ix].fun) (RETVAL->m, r, bits);
3158 OUTPUT:
3159     RETVAL
3160
3161
3162 mpz
3163 mpz_urandomm (r, m)
3164     randstate  r
3165     mpz_coerce m
3166 CODE:
3167     RETVAL = new_mpz();
3168     mpz_urandomm (RETVAL->m, r, m);
3169 OUTPUT:
3170     RETVAL
3171
3172
3173 mpf
3174 mpf_urandomb (r, bits)
3175     randstate    r
3176     ulong_coerce bits
3177 CODE:
3178     RETVAL = new_mpf (bits);
3179     mpf_urandomb (RETVAL, r, bits);
3180 OUTPUT:
3181     RETVAL
3182
3183
3184 unsigned long
3185 gmp_urandomb_ui (r, bits)
3186     randstate    r
3187     ulong_coerce bits
3188 ALIAS:
3189     GMP::Rand::gmp_urandomm_ui = 1
3190 PREINIT:
3191     static_functable const struct {
3192       unsigned long (*fun) (gmp_randstate_t r, unsigned long bits);
3193     } table[] = {
3194       { gmp_urandomb_ui }, /* 0 */
3195       { gmp_urandomm_ui }, /* 1 */
3196     };
3197 CODE:
3198     assert_table (ix);
3199     RETVAL = (*table[ix].fun) (r, bits);
3200 OUTPUT:
3201     RETVAL