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