Annotation of OpenXM_contrib/gmp/demos/perl/GMP.xs, Revision 1.1
1.1 ! ohara 1: /* GMP module external subroutines.
! 2:
! 3: Copyright 2001 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 2.1 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; see the file COPYING.LIB. If not, write to
! 19: the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
! 20: MA 02111-1307, USA. */
! 21:
! 22:
! 23: /* Notes:
! 24:
! 25: Routines are grouped with the alias feature and a table of function
! 26: pointers where possible, since each xsub routine ends up with quite a bit
! 27: of overhead. Different combinations of arguments and return values have
! 28: to be separate though.
! 29:
! 30: The "INTERFACE:" feature isn't available in perl 5.005 and so isn't used.
! 31: "ALIAS:" requires a table lookup with CvXSUBANY(cv).any_i32 (which is
! 32: "ix") whereas "INTERFACE:" would have CvXSUBANY(cv).any_dptr as the
! 33: function pointer immediately.
! 34:
! 35: Mixed-type swapped-order assignments like "$a = 123; $a += mpz(456);"
! 36: invoke the plain overloaded "+", not "+=", which makes life easier.
! 37:
! 38: The various mpz_assume types are used with the overloaded operators since
! 39: we know they always pass a class object as the first argument and we can
! 40: save an sv_derived_from() lookup. There's assert()s in MPX_ASSUME() to
! 41: check though.
! 42:
! 43: The overload_constant routines reached via overload::constant get 4
! 44: arguments in perl 5.6, not the 3 as documented. This is apparently a
! 45: bug, using "..." lets us ignore the extra one.
! 46:
! 47: There's only a few "si" functions in gmp, so generally SvIV values get
! 48: handled with an mpz_set_si into a temporary and then a full precision mpz
! 49: routine. This is reasonably efficient.
! 50:
! 51: Strings are identified with "SvPOK(sv)||SvPOKp(sv)" so that magic
! 52: SVt_PVLV returns from substr() will work. SvPV() always gives a plain
! 53: actual string.
! 54:
! 55: Bugs:
! 56:
! 57: Should IV's and/or NV's be identified with the same dual test as for
! 58: strings?
! 59:
! 60: The memory leak detection attempted in GMP::END() doesn't work when mpz's
! 61: are created as constants because END() is called before they're
! 62: destroyed. What's the right place to hook such a check? */
! 63:
! 64:
! 65: /* Comment this out to get assertion checking. */
! 66: #define NDEBUG
! 67:
! 68: /* Change this to "#define TRACE(x) x" for some diagnostics. */
! 69: #define TRACE(x)
! 70:
! 71:
! 72: #include <assert.h>
! 73: #include <float.h>
! 74:
! 75: #include "EXTERN.h"
! 76: #include "perl.h"
! 77: #include "XSUB.h"
! 78: #include "patchlevel.h"
! 79:
! 80: #include "gmp.h"
! 81:
! 82:
! 83: /* Code which doesn't check anything itself, but exists to support other
! 84: assert()s. */
! 85: #ifdef NDEBUG
! 86: #define assert_support(x)
! 87: #else
! 88: #define assert_support(x) x
! 89: #endif
! 90:
! 91: /* sv_derived_from etc in 5.005 took "char *" rather than "const char *".
! 92: Avoid some compiler warnings by using const only where it works. */
! 93: #if PERL_REVISION > 5 || (PERL_REVISION == 5 && PERL_VERSION >= 6)
! 94: #define classconst const
! 95: #else
! 96: #define classconst
! 97: #endif
! 98:
! 99: #define GMP_MALLOC_ID 42
! 100:
! 101: static classconst char mpz_class[] = "GMP::Mpz";
! 102: static classconst char mpq_class[] = "GMP::Mpq";
! 103: static classconst char mpf_class[] = "GMP::Mpf";
! 104: static classconst char rand_class[] = "GMP::Rand";
! 105:
! 106:
! 107: assert_support (static long mpz_count = 0;)
! 108: assert_support (static long mpq_count = 0;)
! 109: assert_support (static long mpf_count = 0;)
! 110: assert_support (static long rand_count = 0;)
! 111:
! 112: #define TRACE_ACTIVE() \
! 113: assert_support \
! 114: (TRACE (printf (" active %ld mpz, %ld mpq, %ld mpf, %ld randstate\n", \
! 115: mpz_count, mpq_count, mpf_count, rand_count)))
! 116:
! 117:
! 118: /* Each "struct mpz_elem" etc is an mpz_t with a link field tacked on the
! 119: end so they can be held on a linked list. */
! 120:
! 121: #define CREATE_MPX(type) \
! 122: \
! 123: /* must have mpz_t etc first, for sprintf below */ \
! 124: struct type##_elem { \
! 125: type##_t m; \
! 126: struct type##_elem *next; \
! 127: }; \
! 128: typedef struct type##_elem *type; \
! 129: typedef struct type##_elem *type##_assume; \
! 130: typedef type##_ptr type##_coerce; \
! 131: typedef type##_ptr type##_mutate; \
! 132: \
! 133: static type type##_freelist = NULL; \
! 134: \
! 135: static type \
! 136: new_##type (void) \
! 137: { \
! 138: type p; \
! 139: TRACE (printf ("new %s\n", type##_class)); \
! 140: if (type##_freelist != NULL) \
! 141: { \
! 142: p = type##_freelist; \
! 143: type##_freelist = type##_freelist->next; \
! 144: } \
! 145: else \
! 146: { \
! 147: New (GMP_MALLOC_ID, p, 1, struct type##_elem); \
! 148: type##_init (p->m); \
! 149: } \
! 150: TRACE (printf (" p=%p\n", p)); \
! 151: assert_support (type##_count++); \
! 152: TRACE_ACTIVE (); \
! 153: return p; \
! 154: } \
! 155:
! 156: CREATE_MPX (mpz)
! 157: CREATE_MPX (mpq)
! 158:
! 159: typedef mpf_ptr mpf;
! 160: typedef mpf_ptr mpf_assume;
! 161: typedef mpf_ptr mpf_coerce_st0;
! 162: typedef mpf_ptr mpf_coerce_def;
! 163:
! 164:
! 165: static mpf
! 166: new_mpf (unsigned long prec)
! 167: {
! 168: mpf p;
! 169: New (GMP_MALLOC_ID, p, 1, __mpf_struct);
! 170: mpf_init2 (p, prec);
! 171: TRACE (printf (" mpf p=%p\n", p));
! 172: assert_support (mpf_count++);
! 173: TRACE_ACTIVE ();
! 174: return p;
! 175: }
! 176:
! 177:
! 178: /* tmp_mpf_t records an allocated precision with an mpf_t so changes of
! 179: precision can be done with just an mpf_set_prec_raw. */
! 180:
! 181: struct tmp_mpf_struct {
! 182: mpf_t m;
! 183: unsigned long allocated_prec;
! 184: };
! 185: typedef const struct tmp_mpf_struct *tmp_mpf_srcptr;
! 186: typedef struct tmp_mpf_struct *tmp_mpf_ptr;
! 187: typedef struct tmp_mpf_struct tmp_mpf_t[1];
! 188:
! 189: #define tmp_mpf_init(f) \
! 190: do { \
! 191: mpf_init (f->m); \
! 192: f->allocated_prec = mpf_get_prec (f->m); \
! 193: } while (0)
! 194:
! 195: static void
! 196: tmp_mpf_grow (tmp_mpf_ptr f, unsigned long prec)
! 197: {
! 198: mpf_set_prec_raw (f->m, f->allocated_prec);
! 199: mpf_set_prec (f->m, prec);
! 200: f->allocated_prec = mpf_get_prec (f->m);
! 201: }
! 202:
! 203: #define tmp_mpf_shrink(f) tmp_mpf_grow (f, 1L)
! 204:
! 205: #define tmp_mpf_set_prec(f,prec) \
! 206: do { \
! 207: if (prec > f->allocated_prec) \
! 208: tmp_mpf_grow (f, prec); \
! 209: else \
! 210: mpf_set_prec_raw (f->m, prec); \
! 211: } while (0)
! 212:
! 213:
! 214: static mpz_t tmp_mpz_0, tmp_mpz_1, tmp_mpz_2;
! 215: static mpq_t tmp_mpq_0, tmp_mpq_1;
! 216: static tmp_mpf_t tmp_mpf_0, tmp_mpf_1;
! 217:
! 218:
! 219: #define FREE_MPX_FREELIST(p,type) \
! 220: do { \
! 221: TRACE (printf ("free %s\n", type##_class)); \
! 222: p->next = type##_freelist; \
! 223: type##_freelist = p; \
! 224: assert_support (type##_count--); \
! 225: TRACE_ACTIVE (); \
! 226: assert (type##_count >= 0); \
! 227: } while (0)
! 228:
! 229: /* this version for comparison, if desired */
! 230: #define FREE_MPX_NOFREELIST(p,type) \
! 231: do { \
! 232: TRACE (printf ("free %s\n", type##_class)); \
! 233: type##_clear (p->m); \
! 234: Safefree (p); \
! 235: assert_support (type##_count--); \
! 236: TRACE_ACTIVE (); \
! 237: assert (type##_count >= 0); \
! 238: } while (0)
! 239:
! 240: #define free_mpz(z) FREE_MPX_FREELIST (z, mpz)
! 241: #define free_mpq(q) FREE_MPX_FREELIST (q, mpq)
! 242:
! 243:
! 244: /* Aliases for use in typemaps */
! 245: typedef char *malloced_string;
! 246: typedef const char *const_string;
! 247: typedef const char *const_string_assume;
! 248: typedef char *string;
! 249: typedef SV *order_noswap;
! 250: typedef SV *dummy;
! 251: typedef SV *SV_copy_0;
! 252: typedef unsigned long ulong_coerce;
! 253: typedef __gmp_randstate_struct *randstate;
! 254:
! 255: #define SvMPX(s,type) ((type) SvIV((SV*) SvRV(s)))
! 256: #define SvMPZ(s) SvMPX(s,mpz)
! 257: #define SvMPQ(s) SvMPX(s,mpq)
! 258: #define SvMPF(s) SvMPX(s,mpf)
! 259: #define SvRANDSTATE(s) SvMPX(s,randstate)
! 260:
! 261: #define MPX_ASSUME(x,sv,type) \
! 262: do { \
! 263: assert (sv_derived_from (sv, type##_class)); \
! 264: x = SvMPX(sv,type); \
! 265: } while (0)
! 266:
! 267: #define MPZ_ASSUME(z,sv) MPX_ASSUME(z,sv,mpz)
! 268: #define MPQ_ASSUME(q,sv) MPX_ASSUME(q,sv,mpq)
! 269: #define MPF_ASSUME(f,sv) MPX_ASSUME(f,sv,mpf)
! 270:
! 271: #define numberof(x) (sizeof (x) / sizeof ((x)[0]))
! 272: #define SGN(x) ((x)<0 ? -1 : (x) != 0)
! 273: #define ABS(x) ((x)>=0 ? (x) : -(x))
! 274: #define double_integer_p(d) (floor (d) == (d))
! 275:
! 276: #define x_mpq_integer_p(q) \
! 277: (mpz_cmp_ui (mpq_denref(q), 1L) == 0)
! 278: #define x_mpq_equal_si(q,n,d) \
! 279: (mpz_cmp_si (mpq_numref(q), n) == 0 && mpz_cmp_ui (mpq_denref(q), d) == 0)
! 280: #define x_mpq_equal_z(q,z) \
! 281: (x_mpq_integer_p(q) && mpz_cmp (mpq_numref(q), z) == 0)
! 282:
! 283: #define assert_table(ix) assert (ix >= 0 && ix < numberof (table))
! 284:
! 285: #define SV_PTR_SWAP(x,y) \
! 286: do { SV *__tmp = (x); (x) = (y); (y) = __tmp; } while (0)
! 287: #define MPF_PTR_SWAP(x,y) \
! 288: do { mpf_ptr __tmp = (x); (x) = (y); (y) = __tmp; } while (0)
! 289:
! 290: #define SvPOKorp(sv) (SvPOK(sv) || SvPOKp(sv))
! 291:
! 292: static void
! 293: class_or_croak (SV *sv, classconst char *class)
! 294: {
! 295: if (! sv_derived_from (sv, class))
! 296: croak("not type %s", class);
! 297: }
! 298:
! 299:
! 300: /* These are macros, wrap them in functions. */
! 301: static int
! 302: x_mpz_odd_p (mpz_srcptr z)
! 303: {
! 304: return mpz_odd_p (z);
! 305: }
! 306: static int
! 307: x_mpz_even_p (mpz_srcptr z)
! 308: {
! 309: return mpz_even_p (z);
! 310: }
! 311:
! 312: static void
! 313: x_mpq_pow_ui (mpq_ptr r, mpq_srcptr b, unsigned long e)
! 314: {
! 315: mpz_pow_ui (mpq_numref(r), mpq_numref(b), e);
! 316: mpz_pow_ui (mpq_denref(r), mpq_denref(b), e);
! 317: }
! 318:
! 319:
! 320: static void *
! 321: my_gmp_alloc (size_t n)
! 322: {
! 323: void *p;
! 324: TRACE (printf ("my_gmp_alloc %u\n", n));
! 325: New (GMP_MALLOC_ID, p, n, char);
! 326: TRACE (printf (" p=%p\n", p));
! 327: return p;
! 328: }
! 329:
! 330: static void *
! 331: my_gmp_realloc (void *p, size_t oldsize, size_t newsize)
! 332: {
! 333: TRACE (printf ("my_gmp_realloc %p, %u to %u\n", p, oldsize, newsize));
! 334: Renew (p, newsize, char);
! 335: TRACE (printf (" p=%p\n", p));
! 336: return p;
! 337: }
! 338:
! 339: static void
! 340: my_gmp_free (void *p, size_t n)
! 341: {
! 342: TRACE (printf ("my_gmp_free %p %u\n", p, n));
! 343: Safefree (p);
! 344: }
! 345:
! 346:
! 347: #define my_mpx_set_svstr(type) \
! 348: static void \
! 349: my_##type##_set_svstr (type##_ptr x, SV *sv) \
! 350: { \
! 351: const char *str; \
! 352: STRLEN len; \
! 353: TRACE (printf (" my_" #type "_set_svstr\n")); \
! 354: assert (SvPOKorp (sv)); \
! 355: str = SvPV (sv, len); \
! 356: TRACE (printf (" str \"%s\"\n", str)); \
! 357: if (type##_set_str (x, str, 0) != 0) \
! 358: croak ("%s: invalid string: %s", type##_class, str); \
! 359: }
! 360:
! 361: my_mpx_set_svstr(mpz)
! 362: my_mpx_set_svstr(mpq)
! 363: my_mpx_set_svstr(mpf)
! 364:
! 365:
! 366: /* very slack */
! 367: static int
! 368: x_mpq_cmp_si (mpq_srcptr x, long yn, unsigned long yd)
! 369: {
! 370: mpq y;
! 371: int ret;
! 372: y = new_mpq ();
! 373: mpq_set_si (y->m, yn, yd);
! 374: ret = mpq_cmp (x, y->m);
! 375: free_mpq (y);
! 376: return ret;
! 377: }
! 378:
! 379: static int
! 380: x_mpq_fits_slong_p (mpq_srcptr q)
! 381: {
! 382: return x_mpq_cmp_si (q, LONG_MIN, 1L) >= 0
! 383: && mpq_cmp_ui (q, LONG_MAX, 1L) <= 0;
! 384: }
! 385:
! 386: static int
! 387: x_mpz_cmp_q (mpz_ptr x, mpq_srcptr y)
! 388: {
! 389: int ret;
! 390: mpz_set_ui (mpq_denref(tmp_mpq_0), 1L);
! 391: mpz_swap (mpq_numref(tmp_mpq_0), x);
! 392: ret = mpq_cmp (tmp_mpq_0, y);
! 393: mpz_swap (mpq_numref(tmp_mpq_0), x);
! 394: return ret;
! 395: }
! 396:
! 397: static int
! 398: x_mpz_cmp_f (mpz_srcptr x, mpf_srcptr y)
! 399: {
! 400: tmp_mpf_set_prec (tmp_mpf_0, mpz_sizeinbase (x, 2));
! 401: mpf_set_z (tmp_mpf_0->m, x);
! 402: return mpf_cmp (tmp_mpf_0->m, y);
! 403: }
! 404:
! 405:
! 406: /* Coerce sv to an mpz. Use tmp to hold the converted value if sv isn't
! 407: already an mpz (or an mpq of which the numerator can be used). Return
! 408: the chosen mpz (tmp or the contents of sv). */
! 409: static mpz_ptr
! 410: coerce_mpz (mpz_ptr tmp, SV *sv)
! 411: {
! 412: if (SvIOK(sv))
! 413: {
! 414: mpz_set_si (tmp, SvIVX(sv));
! 415: return tmp;
! 416: }
! 417: if (SvPOKorp(sv))
! 418: {
! 419: my_mpz_set_svstr (tmp, sv);
! 420: return tmp;
! 421: }
! 422: if (SvNOK(sv))
! 423: {
! 424: double d = SvNVX(sv);
! 425: if (! double_integer_p (d))
! 426: croak ("cannot coerce non-integer double to mpz");
! 427: mpz_set_d (tmp, d);
! 428: return tmp;
! 429: }
! 430: if (SvROK(sv))
! 431: {
! 432: if (sv_derived_from (sv, mpz_class))
! 433: {
! 434: return SvMPZ(sv)->m;
! 435: }
! 436: if (sv_derived_from (sv, mpq_class))
! 437: {
! 438: mpq q = SvMPQ(sv);
! 439: if (! x_mpq_integer_p (q->m))
! 440: croak ("cannot coerce non-integer mpq to mpz");
! 441: return mpq_numref(q->m);
! 442: }
! 443: if (sv_derived_from (sv, mpf_class))
! 444: {
! 445: mpf f = SvMPF(sv);
! 446: if (! mpf_integer_p (f))
! 447: croak ("cannot coerce non-integer mpf to mpz");
! 448: mpz_set_f (tmp, f);
! 449: return tmp;
! 450: }
! 451: }
! 452: croak ("cannot coerce to mpz");
! 453: }
! 454:
! 455:
! 456: /* Coerce sv to an mpq. If sv is an mpq then just return that, otherwise
! 457: use tmp to hold the converted value and return that. */
! 458: static mpq_ptr
! 459: coerce_mpq (mpq_ptr tmp, SV *sv)
! 460: {
! 461: if (SvIOK(sv))
! 462: {
! 463: mpq_set_si (tmp, SvIVX(sv), 1L);
! 464: return tmp;
! 465: }
! 466: if (SvNOK(sv))
! 467: {
! 468: mpq_set_d (tmp, SvNVX(sv));
! 469: return tmp;
! 470: }
! 471: if (SvPOKorp(sv))
! 472: {
! 473: my_mpq_set_svstr (tmp, sv);
! 474: return tmp;
! 475: }
! 476: if (SvROK(sv))
! 477: {
! 478: if (sv_derived_from (sv, mpz_class))
! 479: {
! 480: mpq_set_z (tmp, SvMPZ(sv)->m);
! 481: return tmp;
! 482: }
! 483: if (sv_derived_from (sv, mpq_class))
! 484: {
! 485: return SvMPQ(sv)->m;
! 486: }
! 487: if (sv_derived_from (sv, mpf_class))
! 488: {
! 489: mpq_set_f (tmp, SvMPF(sv));
! 490: return tmp;
! 491: }
! 492: }
! 493: croak ("cannot coerce to mpq");
! 494: }
! 495:
! 496:
! 497: static void
! 498: my_mpf_set_sv (mpf_ptr f, SV *sv)
! 499: {
! 500: if (SvIOK(sv))
! 501: mpf_set_si (f, SvIVX(sv));
! 502: else if (SvPOKorp(sv))
! 503: my_mpf_set_svstr (f, sv);
! 504: else if (SvNOK(sv))
! 505: mpf_set_d (f, SvNVX(sv));
! 506: else if (SvROK(sv))
! 507: {
! 508: if (sv_derived_from (sv, mpz_class))
! 509: mpf_set_z (f, SvMPZ(sv)->m);
! 510: else if (sv_derived_from (sv, mpq_class))
! 511: mpf_set_q (f, SvMPQ(sv)->m);
! 512: else if (sv_derived_from (sv, mpf_class))
! 513: mpf_set (f, SvMPF(sv));
! 514: else
! 515: goto invalid;
! 516: }
! 517: else
! 518: {
! 519: invalid:
! 520: croak ("cannot coerce to mpf");
! 521: }
! 522: }
! 523:
! 524: /* Coerce sv to an mpf. If sv is an mpf then just return that, otherwise
! 525: use tmp to hold the converted value (with prec precision). */
! 526: static mpf_ptr
! 527: coerce_mpf (tmp_mpf_ptr tmp, SV *sv, unsigned long prec)
! 528: {
! 529: if (SvROK(sv) && sv_derived_from (sv, mpf_class))
! 530: return SvMPF(sv);
! 531:
! 532: tmp_mpf_set_prec (tmp, prec);
! 533: my_mpf_set_sv (tmp->m, sv);
! 534: return tmp->m;
! 535: }
! 536:
! 537:
! 538: /* Coerce xv to an mpf and store the pointer in x, ditto for yv to x. If
! 539: one of xv or yv is an mpf then use it for the precision, otherwise use
! 540: the default precision. */
! 541: #define COERCE_MPF_PAIR(prec, x,xv, y,yv) \
! 542: do { \
! 543: if (SvROK(xv) && sv_derived_from (xv, mpf_class)) \
! 544: { \
! 545: x = SvMPF(xv); \
! 546: prec = mpf_get_prec (x); \
! 547: y = coerce_mpf (tmp_mpf_0, yv, prec); \
! 548: } \
! 549: else \
! 550: { \
! 551: y = coerce_mpf (tmp_mpf_0, yv, mpf_get_default_prec()); \
! 552: prec = mpf_get_prec (y); \
! 553: x = coerce_mpf (tmp_mpf_1, xv, prec); \
! 554: } \
! 555: } while (0)
! 556:
! 557:
! 558: static unsigned long
! 559: coerce_ulong (SV *sv)
! 560: {
! 561: long n;
! 562: if (SvIOK(sv))
! 563: {
! 564: n = SvIVX(sv);
! 565: negative_check:
! 566: if (n < 0)
! 567: {
! 568: range_error:
! 569: croak ("out of range for ulong");
! 570: }
! 571: return n;
! 572: }
! 573: if (SvNOK(sv))
! 574: {
! 575: double d = SvNVX(sv);
! 576: if (! double_integer_p (d))
! 577: {
! 578: integer_error:
! 579: croak ("not an integer");
! 580: }
! 581: n = SvIV(sv);
! 582: goto negative_check;
! 583: }
! 584: if (SvPOKorp(sv))
! 585: {
! 586: n = SvIV(sv);
! 587: goto negative_check;
! 588: }
! 589: if (SvROK(sv))
! 590: {
! 591: if (sv_derived_from (sv, mpz_class))
! 592: {
! 593: mpz z = SvMPZ(sv);
! 594: if (! mpz_fits_ulong_p (z->m))
! 595: goto range_error;
! 596: return mpz_get_ui (z->m);
! 597: }
! 598: if (sv_derived_from (sv, mpq_class))
! 599: {
! 600: mpq q = SvMPQ(sv);
! 601: if (! x_mpq_integer_p (q->m))
! 602: goto integer_error;
! 603: if (! mpz_fits_ulong_p (mpq_numref (q->m)))
! 604: goto range_error;
! 605: return mpz_get_ui (mpq_numref (q->m));
! 606: }
! 607: if (sv_derived_from (sv, mpf_class))
! 608: {
! 609: mpf f = SvMPF(sv);
! 610: if (! mpf_integer_p (f))
! 611: goto integer_error;
! 612: if (! mpf_fits_ulong_p (f))
! 613: goto range_error;
! 614: return mpf_get_ui (f);
! 615: }
! 616: }
! 617: croak ("cannot coerce to ulong");
! 618: }
! 619:
! 620:
! 621: static long
! 622: coerce_long (SV *sv)
! 623: {
! 624: if (SvIOK(sv))
! 625: return SvIVX(sv);
! 626:
! 627: if (SvNOK(sv))
! 628: {
! 629: double d = SvNVX(sv);
! 630: if (! double_integer_p (d))
! 631: {
! 632: integer_error:
! 633: croak ("not an integer");
! 634: }
! 635: return SvIV(sv);
! 636: }
! 637:
! 638: if (SvPOKorp(sv))
! 639: return SvIV(sv);
! 640:
! 641: if (SvROK(sv))
! 642: {
! 643: if (sv_derived_from (sv, mpz_class))
! 644: {
! 645: mpz z = SvMPZ(sv);
! 646: if (! mpz_fits_slong_p (z->m))
! 647: {
! 648: range_error:
! 649: croak ("out of range for ulong");
! 650: }
! 651: return mpz_get_si (z->m);
! 652: }
! 653: if (sv_derived_from (sv, mpq_class))
! 654: {
! 655: mpq q = SvMPQ(sv);
! 656: if (! x_mpq_integer_p (q->m))
! 657: goto integer_error;
! 658: if (! mpz_fits_slong_p (mpq_numref (q->m)))
! 659: goto range_error;
! 660: return mpz_get_si (mpq_numref (q->m));
! 661: }
! 662: if (sv_derived_from (sv, mpf_class))
! 663: {
! 664: mpf f = SvMPF(sv);
! 665: if (! mpf_integer_p (f))
! 666: goto integer_error;
! 667: if (! mpf_fits_slong_p (f))
! 668: goto range_error;
! 669: return mpf_get_si (f);
! 670: }
! 671: }
! 672: croak ("cannot coerce to long");
! 673: }
! 674:
! 675:
! 676: #define mpx_set_maybe(dst,src,type) \
! 677: do { if ((dst) != (src)) type##_set (dst, src); } while (0)
! 678:
! 679: #define coerce_mpx_into(p,sv,type) \
! 680: do { \
! 681: type##_ptr __new_p = coerce_##type (p, sv); \
! 682: mpx_set_maybe (p, __new_p, type); \
! 683: } while (0)
! 684:
! 685: /* Like plain coerce_mpz or coerce_mpq, but force the result into p by
! 686: copying if necessary. */
! 687: #define coerce_mpz_into(z,sv) coerce_mpx_into(z,sv,mpz)
! 688: #define coerce_mpq_into(q,sv) coerce_mpx_into(q,sv,mpq)
! 689:
! 690:
! 691: /* Prepare sv to be a changable mpz. If it's not an mpz then turn it into
! 692: one. If it is an mpz then ensure the reference count is 1. */
! 693: static mpz_ptr
! 694: mutate_mpz (SV *sv)
! 695: {
! 696: mpz old_z, new_z;
! 697:
! 698: TRACE (printf ("mutate_mpz %p\n", sv));
! 699: TRACE (printf (" type %d\n", SvTYPE(sv)));
! 700:
! 701: if (SvROK (sv) && sv_derived_from (sv, mpz_class))
! 702: {
! 703: old_z = SvMPZ(sv);
! 704: if (SvREFCNT(SvRV(sv)) == 1)
! 705: return SvMPZ(sv)->m;
! 706:
! 707: TRACE (printf ("mutate_mpz(): forking new mpz\n"));
! 708: new_z = new_mpz ();
! 709: mpz_set (new_z->m, old_z->m);
! 710: }
! 711: else
! 712: {
! 713: TRACE (printf ("mutate_mpz(): coercing new mpz\n"));
! 714: new_z = new_mpz ();
! 715: coerce_mpz_into (new_z->m, sv);
! 716: }
! 717: sv_setref_pv (sv, mpz_class, new_z);
! 718: return new_z->m;
! 719: }
! 720:
! 721:
! 722: /* ------------------------------------------------------------------------- */
! 723:
! 724: MODULE = GMP PACKAGE = GMP
! 725:
! 726: BOOT:
! 727: TRACE (printf ("GMP boot\n"));
! 728: mp_set_memory_functions (my_gmp_alloc, my_gmp_realloc, my_gmp_free);
! 729: mpz_init (tmp_mpz_0);
! 730: mpz_init (tmp_mpz_1);
! 731: mpz_init (tmp_mpz_2);
! 732: mpq_init (tmp_mpq_0);
! 733: mpq_init (tmp_mpq_1);
! 734: tmp_mpf_init (tmp_mpf_0);
! 735: tmp_mpf_init (tmp_mpf_1);
! 736:
! 737:
! 738: void
! 739: END()
! 740: CODE:
! 741: TRACE (printf ("GMP end\n"));
! 742: TRACE_ACTIVE ();
! 743: /* These are not always true, see Bugs at the top of the file. */
! 744: /* assert (mpz_count == 0); */
! 745: /* assert (mpq_count == 0); */
! 746: /* assert (mpf_count == 0); */
! 747: /* assert (rand_count == 0); */
! 748:
! 749:
! 750: const_string
! 751: version()
! 752: CODE:
! 753: RETVAL = gmp_version;
! 754: OUTPUT:
! 755: RETVAL
! 756:
! 757:
! 758: bool
! 759: fits_slong_p (sv)
! 760: SV *sv
! 761: PREINIT:
! 762: mpq_srcptr q;
! 763: CODE:
! 764: if (SvIOK(sv))
! 765: RETVAL = 1;
! 766: else if (SvNOK(sv))
! 767: {
! 768: double d = SvNVX(sv);
! 769: RETVAL = (d >= LONG_MIN && d <= LONG_MAX);
! 770: }
! 771: else if (SvPOKorp(sv))
! 772: {
! 773: STRLEN len;
! 774: const char *str = SvPV (sv, len);
! 775: if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
! 776: RETVAL = x_mpq_fits_slong_p (tmp_mpq_0);
! 777: else
! 778: {
! 779: /* enough precision for a long */
! 780: tmp_mpf_set_prec (tmp_mpf_0, 2*mp_bits_per_limb);
! 781: if (mpf_set_str (tmp_mpf_0->m, str, 10) != 0)
! 782: croak ("GMP::fits_slong_p invalid string format");
! 783: RETVAL = mpf_fits_slong_p (tmp_mpf_0->m);
! 784: }
! 785: }
! 786: else if (SvROK(sv))
! 787: {
! 788: if (sv_derived_from (sv, mpz_class))
! 789: RETVAL = mpz_fits_slong_p (SvMPZ(sv)->m);
! 790: else if (sv_derived_from (sv, mpq_class))
! 791: RETVAL = x_mpq_fits_slong_p (SvMPQ(sv)->m);
! 792: else if (sv_derived_from (sv, mpf_class))
! 793: RETVAL = mpf_fits_slong_p (SvMPF(sv));
! 794: else
! 795: goto invalid;
! 796: }
! 797: else
! 798: {
! 799: invalid:
! 800: croak ("GMP::fits_slong_p invalid argument");
! 801: }
! 802: OUTPUT:
! 803: RETVAL
! 804:
! 805:
! 806: double
! 807: get_d (sv)
! 808: SV *sv
! 809: CODE:
! 810: if (SvIOK(sv))
! 811: RETVAL = (double) SvIVX(sv);
! 812: else if (SvNOK(sv))
! 813: RETVAL = SvNVX(sv);
! 814: else if (SvPOKorp(sv))
! 815: {
! 816: STRLEN len;
! 817: RETVAL = atof(SvPV(sv, len));
! 818: }
! 819: else if (SvROK(sv))
! 820: {
! 821: if (sv_derived_from (sv, mpz_class))
! 822: RETVAL = mpz_get_d (SvMPZ(sv)->m);
! 823: else if (sv_derived_from (sv, mpq_class))
! 824: RETVAL = mpq_get_d (SvMPQ(sv)->m);
! 825: else if (sv_derived_from (sv, mpf_class))
! 826: RETVAL = mpf_get_d (SvMPF(sv));
! 827: else
! 828: goto invalid;
! 829: }
! 830: else
! 831: {
! 832: invalid:
! 833: croak ("GMP::get_d invalid argument");
! 834: }
! 835: OUTPUT:
! 836: RETVAL
! 837:
! 838:
! 839: long
! 840: get_si (sv)
! 841: SV *sv
! 842: CODE:
! 843: if (SvIOK(sv))
! 844: RETVAL = SvIVX(sv);
! 845: else if (SvNOK(sv))
! 846: RETVAL = (long) SvNVX(sv);
! 847: else if (SvPOKorp(sv))
! 848: RETVAL = SvIV(sv);
! 849: else if (SvROK(sv))
! 850: {
! 851: if (sv_derived_from (sv, mpz_class))
! 852: RETVAL = mpz_get_si (SvMPZ(sv)->m);
! 853: else if (sv_derived_from (sv, mpq_class))
! 854: {
! 855: mpz_set_q (tmp_mpz_0, SvMPQ(sv)->m);
! 856: RETVAL = mpz_get_si (tmp_mpz_0);
! 857: }
! 858: else if (sv_derived_from (sv, mpf_class))
! 859: RETVAL = mpf_get_si (SvMPF(sv));
! 860: else
! 861: goto invalid;
! 862: }
! 863: else
! 864: {
! 865: invalid:
! 866: croak ("GMP::get_si invalid argument");
! 867: }
! 868: OUTPUT:
! 869: RETVAL
! 870:
! 871:
! 872: void
! 873: get_str (sv, ...)
! 874: SV *sv
! 875: PREINIT:
! 876: char *str;
! 877: mp_exp_t exp;
! 878: mpz_ptr z;
! 879: mpq_ptr q;
! 880: mpf f;
! 881: int base;
! 882: int ndigits;
! 883: PPCODE:
! 884: TRACE (printf ("GMP::get_str\n"));
! 885:
! 886: if (items >= 2)
! 887: base = coerce_long (ST(1));
! 888: else
! 889: base = 10;
! 890: TRACE (printf (" base=%d\n", base));
! 891:
! 892: if (items >= 3)
! 893: ndigits = coerce_long (ST(2));
! 894: else
! 895: ndigits = 10;
! 896: TRACE (printf (" ndigits=%d\n", ndigits));
! 897:
! 898: EXTEND (SP, 2);
! 899:
! 900: if (SvIOK(sv))
! 901: {
! 902: mpz_set_si (tmp_mpz_0, SvIVX(sv));
! 903: z = tmp_mpz_0;
! 904: goto get_mpz;
! 905: }
! 906: else if (SvNOK(sv))
! 907: {
! 908: /* only digits in the original double, not in the coerced form */
! 909: if (ndigits == 0)
! 910: ndigits = DBL_DIG;
! 911: mpf_set_d (tmp_mpf_0->m, SvNVX(sv));
! 912: f = tmp_mpf_0->m;
! 913: goto get_mpf;
! 914: }
! 915: else if (SvPOKorp(sv))
! 916: {
! 917: /* get_str on a string is not much more than a base conversion */
! 918: STRLEN len;
! 919: str = SvPV (sv, len);
! 920: if (mpz_set_str (tmp_mpz_0, str, 0) == 0)
! 921: {
! 922: z = tmp_mpz_0;
! 923: goto get_mpz;
! 924: }
! 925: else if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
! 926: {
! 927: q = tmp_mpq_0;
! 928: goto get_mpq;
! 929: }
! 930: else
! 931: {
! 932: /* FIXME: Would like perhaps a precision equivalent to the
! 933: number of significant digits of the string, in its given
! 934: base. */
! 935: tmp_mpf_set_prec (tmp_mpf_0, strlen(str));
! 936: if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
! 937: {
! 938: f = tmp_mpf_0->m;
! 939: goto get_mpf;
! 940: }
! 941: else
! 942: croak ("GMP::get_str invalid string format");
! 943: }
! 944: }
! 945: else if (SvROK(sv))
! 946: {
! 947: if (sv_derived_from (sv, mpz_class))
! 948: {
! 949: z = SvMPZ(sv)->m;
! 950: get_mpz:
! 951: str = mpz_get_str (NULL, base, z);
! 952: push_str:
! 953: PUSHs (sv_2mortal (newSVpv (str, 0)));
! 954: }
! 955: else if (sv_derived_from (sv, mpq_class))
! 956: {
! 957: q = SvMPQ(sv)->m;
! 958: get_mpq:
! 959: str = mpq_get_str (NULL, base, q);
! 960: goto push_str;
! 961: }
! 962: else if (sv_derived_from (sv, mpf_class))
! 963: {
! 964: f = SvMPF(sv);
! 965: get_mpf:
! 966: str = mpf_get_str (NULL, &exp, base, 0, f);
! 967: PUSHs (sv_2mortal (newSVpv (str, 0)));
! 968: PUSHs (sv_2mortal (newSViv (exp)));
! 969: }
! 970: else
! 971: goto invalid;
! 972: }
! 973: else
! 974: {
! 975: invalid:
! 976: croak ("GMP::get_str invalid argument");
! 977: }
! 978:
! 979:
! 980: bool
! 981: integer_p (sv)
! 982: SV *sv
! 983: CODE:
! 984: if (SvIOK(sv))
! 985: RETVAL = 1;
! 986: else if (SvNOK(sv))
! 987: RETVAL = double_integer_p (SvNVX(sv));
! 988: else if (SvPOKorp(sv))
! 989: {
! 990: /* FIXME: Maybe this should be done by parsing the string, not by an
! 991: actual conversion. */
! 992: STRLEN len;
! 993: const char *str = SvPV (sv, len);
! 994: if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
! 995: RETVAL = x_mpq_integer_p (tmp_mpq_0);
! 996: else
! 997: {
! 998: /* enough for all digits of the string */
! 999: tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
! 1000: if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
! 1001: RETVAL = mpf_integer_p (tmp_mpf_0->m);
! 1002: else
! 1003: croak ("GMP::integer_p invalid string format");
! 1004: }
! 1005: }
! 1006: else if (SvROK(sv))
! 1007: {
! 1008: if (sv_derived_from (sv, mpz_class))
! 1009: RETVAL = 1;
! 1010: else if (sv_derived_from (sv, mpq_class))
! 1011: RETVAL = x_mpq_integer_p (SvMPQ(sv)->m);
! 1012: else if (sv_derived_from (sv, mpf_class))
! 1013: RETVAL = mpf_integer_p (SvMPF(sv));
! 1014: else
! 1015: goto invalid;
! 1016: }
! 1017: else
! 1018: {
! 1019: invalid:
! 1020: croak ("GMP::integer_p invalid argument");
! 1021: }
! 1022: OUTPUT:
! 1023: RETVAL
! 1024:
! 1025:
! 1026: int
! 1027: sgn (sv)
! 1028: SV *sv
! 1029: CODE:
! 1030: if (SvIOK(sv))
! 1031: RETVAL = SGN (SvIVX(sv));
! 1032: else if (SvNOK(sv))
! 1033: RETVAL = SGN (SvNVX(sv));
! 1034: else if (SvPOKorp(sv))
! 1035: {
! 1036: /* FIXME: Maybe this should be done by parsing the string, not by an
! 1037: actual conversion. */
! 1038: STRLEN len;
! 1039: const char *str = SvPV (sv, len);
! 1040: if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
! 1041: RETVAL = mpq_sgn (tmp_mpq_0);
! 1042: else
! 1043: {
! 1044: /* enough for all digits of the string */
! 1045: tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
! 1046: if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
! 1047: RETVAL = mpf_sgn (tmp_mpf_0->m);
! 1048: else
! 1049: croak ("GMP::sgn invalid string format");
! 1050: }
! 1051: }
! 1052: else if (SvROK(sv))
! 1053: {
! 1054: if (sv_derived_from (sv, mpz_class))
! 1055: RETVAL = mpz_sgn (SvMPZ(sv)->m);
! 1056: else if (sv_derived_from (sv, mpq_class))
! 1057: RETVAL = mpq_sgn (SvMPQ(sv)->m);
! 1058: else if (sv_derived_from (sv, mpf_class))
! 1059: RETVAL = mpf_sgn (SvMPF(sv));
! 1060: else
! 1061: goto invalid;
! 1062: }
! 1063: else
! 1064: {
! 1065: invalid:
! 1066: croak ("GMP::sgn invalid argument");
! 1067: }
! 1068: OUTPUT:
! 1069: RETVAL
! 1070:
! 1071:
! 1072: # currently undocumented
! 1073: void
! 1074: shrink ()
! 1075: CODE:
! 1076: #define x_mpz_shrink(z) \
! 1077: mpz_set_ui (z, 0L); _mpz_realloc (z, 1)
! 1078: #define x_mpq_shrink(q) \
! 1079: x_mpz_shrink (mpq_numref(q)); x_mpz_shrink (mpq_denref(q))
! 1080:
! 1081: x_mpz_shrink (tmp_mpz_0);
! 1082: x_mpz_shrink (tmp_mpz_1);
! 1083: x_mpz_shrink (tmp_mpz_2);
! 1084: x_mpq_shrink (tmp_mpq_0);
! 1085: x_mpq_shrink (tmp_mpq_1);
! 1086: tmp_mpf_shrink (tmp_mpf_0);
! 1087: tmp_mpf_shrink (tmp_mpf_1);
! 1088:
! 1089:
! 1090:
! 1091: malloced_string
! 1092: sprintf_internal (fmt, sv)
! 1093: const_string fmt
! 1094: SV *sv
! 1095: CODE:
! 1096: assert (strlen (fmt) >= 3);
! 1097: assert (SvROK(sv));
! 1098: assert ((sv_derived_from (sv, mpz_class) && fmt[strlen(fmt)-2] == 'Z')
! 1099: || (sv_derived_from (sv, mpq_class) && fmt[strlen(fmt)-2] == 'Q')
! 1100: || (sv_derived_from (sv, mpf_class) && fmt[strlen(fmt)-2] == 'F'));
! 1101: TRACE (printf ("GMP::sprintf_internal\n");
! 1102: printf (" fmt |%s|\n", fmt);
! 1103: printf (" sv |%p|\n", SvMPZ(sv)));
! 1104:
! 1105: /* cheat a bit here, SvMPZ works for mpq and mpf too */
! 1106: gmp_asprintf (&RETVAL, fmt, SvMPZ(sv));
! 1107:
! 1108: TRACE (printf (" result |%s|\n", RETVAL));
! 1109: OUTPUT:
! 1110: RETVAL
! 1111:
! 1112:
! 1113:
! 1114: #------------------------------------------------------------------------------
! 1115:
! 1116: MODULE = GMP PACKAGE = GMP::Mpz
! 1117:
! 1118: mpz
! 1119: mpz (...)
! 1120: ALIAS:
! 1121: GMP::Mpz::new = 1
! 1122: PREINIT:
! 1123: SV *sv;
! 1124: CODE:
! 1125: TRACE (printf ("%s new, ix=%ld, items=%d\n", mpz_class, ix, items));
! 1126: RETVAL = new_mpz();
! 1127:
! 1128: switch (items) {
! 1129: case 0:
! 1130: mpz_set_ui (RETVAL->m, 0L);
! 1131: break;
! 1132: case 1:
! 1133: sv = ST(0);
! 1134: if (SvIOK(sv)) mpz_set_si (RETVAL->m, SvIVX(sv));
! 1135: else if (SvNOK(sv)) mpz_set_d (RETVAL->m, SvNVX(sv));
! 1136: else if (SvPOKorp(sv)) my_mpz_set_svstr (RETVAL->m, sv);
! 1137: else if (SvROK(sv))
! 1138: {
! 1139: if (sv_derived_from (sv, mpz_class))
! 1140: mpz_set (RETVAL->m, SvMPZ(sv)->m);
! 1141: else if (sv_derived_from (sv, mpq_class))
! 1142: mpz_set_q (RETVAL->m, SvMPQ(sv)->m);
! 1143: else if (sv_derived_from (sv, mpf_class))
! 1144: mpz_set_f (RETVAL->m, SvMPF(sv));
! 1145: else
! 1146: goto invalid;
! 1147: }
! 1148: else
! 1149: goto invalid;
! 1150: break;
! 1151: default:
! 1152: invalid:
! 1153: croak ("%s new: invalid arguments", mpz_class);
! 1154: }
! 1155: OUTPUT:
! 1156: RETVAL
! 1157:
! 1158:
! 1159: void
! 1160: overload_constant (str, pv, d1, ...)
! 1161: const_string_assume str
! 1162: SV *pv
! 1163: dummy d1
! 1164: PREINIT:
! 1165: mpz z;
! 1166: PPCODE:
! 1167: TRACE (printf ("%s constant: %s\n", mpz_class, str));
! 1168: z = new_mpz();
! 1169: if (mpz_set_str (z->m, str, 0) == 0)
! 1170: {
! 1171: SV *sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, z); PUSHs(sv);
! 1172: }
! 1173: else
! 1174: {
! 1175: free_mpz (z);
! 1176: PUSHs(pv);
! 1177: }
! 1178:
! 1179:
! 1180: mpz
! 1181: overload_copy (z, d1, d2)
! 1182: mpz_assume z
! 1183: dummy d1
! 1184: dummy d2
! 1185: CODE:
! 1186: RETVAL = new_mpz();
! 1187: mpz_set (RETVAL->m, z->m);
! 1188: OUTPUT:
! 1189: RETVAL
! 1190:
! 1191:
! 1192: void
! 1193: DESTROY (z)
! 1194: mpz_assume z
! 1195: CODE:
! 1196: TRACE (printf ("%s DESTROY %p\n", mpz_class, z));
! 1197: free_mpz (z);
! 1198:
! 1199:
! 1200: malloced_string
! 1201: overload_string (z, d1, d2)
! 1202: mpz_assume z
! 1203: dummy d1
! 1204: dummy d2
! 1205: CODE:
! 1206: TRACE (printf ("%s overload_string %p\n", mpz_class, z));
! 1207: RETVAL = mpz_get_str (NULL, 10, z->m);
! 1208: OUTPUT:
! 1209: RETVAL
! 1210:
! 1211:
! 1212: mpz
! 1213: overload_add (xv, yv, order)
! 1214: SV *xv
! 1215: SV *yv
! 1216: SV *order
! 1217: ALIAS:
! 1218: GMP::Mpz::overload_sub = 1
! 1219: GMP::Mpz::overload_mul = 2
! 1220: GMP::Mpz::overload_div = 3
! 1221: GMP::Mpz::overload_rem = 4
! 1222: GMP::Mpz::overload_and = 5
! 1223: GMP::Mpz::overload_ior = 6
! 1224: GMP::Mpz::overload_xor = 7
! 1225: PREINIT:
! 1226: static const struct {
! 1227: void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
! 1228: } table[] = {
! 1229: { mpz_add }, /* 0 */
! 1230: { mpz_sub }, /* 1 */
! 1231: { mpz_mul }, /* 2 */
! 1232: { mpz_tdiv_q }, /* 3 */
! 1233: { mpz_tdiv_r }, /* 4 */
! 1234: { mpz_and }, /* 5 */
! 1235: { mpz_ior }, /* 6 */
! 1236: { mpz_xor }, /* 7 */
! 1237: };
! 1238: CODE:
! 1239: assert_table (ix);
! 1240: if (order == &PL_sv_yes)
! 1241: SV_PTR_SWAP (xv, yv);
! 1242: RETVAL = new_mpz();
! 1243: (*table[ix].op) (RETVAL->m,
! 1244: coerce_mpz (tmp_mpz_0, xv),
! 1245: coerce_mpz (tmp_mpz_1, yv));
! 1246: OUTPUT:
! 1247: RETVAL
! 1248:
! 1249:
! 1250: void
! 1251: overload_addeq (x, y, o)
! 1252: mpz_assume x
! 1253: mpz_coerce y
! 1254: order_noswap o
! 1255: ALIAS:
! 1256: GMP::Mpz::overload_subeq = 1
! 1257: GMP::Mpz::overload_muleq = 2
! 1258: GMP::Mpz::overload_diveq = 3
! 1259: GMP::Mpz::overload_remeq = 4
! 1260: GMP::Mpz::overload_andeq = 5
! 1261: GMP::Mpz::overload_ioreq = 6
! 1262: GMP::Mpz::overload_xoreq = 7
! 1263: PREINIT:
! 1264: static const struct {
! 1265: void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
! 1266: } table[] = {
! 1267: { mpz_add }, /* 0 */
! 1268: { mpz_sub }, /* 1 */
! 1269: { mpz_mul }, /* 2 */
! 1270: { mpz_tdiv_q }, /* 3 */
! 1271: { mpz_tdiv_r }, /* 4 */
! 1272: { mpz_and }, /* 5 */
! 1273: { mpz_ior }, /* 6 */
! 1274: { mpz_xor }, /* 7 */
! 1275: };
! 1276: PPCODE:
! 1277: assert_table (ix);
! 1278: (*table[ix].op) (x->m, x->m, y);
! 1279: XPUSHs (ST(0));
! 1280:
! 1281:
! 1282: mpz
! 1283: overload_lshift (zv, nv, order)
! 1284: SV *zv
! 1285: SV *nv
! 1286: SV *order
! 1287: ALIAS:
! 1288: GMP::Mpz::overload_rshift = 1
! 1289: GMP::Mpz::overload_pow = 2
! 1290: PREINIT:
! 1291: static const struct {
! 1292: void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
! 1293: } table[] = {
! 1294: { mpz_mul_2exp }, /* 0 */
! 1295: { mpz_div_2exp }, /* 1 */
! 1296: { mpz_pow_ui }, /* 2 */
! 1297: };
! 1298: CODE:
! 1299: assert_table (ix);
! 1300: if (order == &PL_sv_yes)
! 1301: SV_PTR_SWAP (zv, nv);
! 1302: RETVAL = new_mpz();
! 1303: (*table[ix].op) (RETVAL->m, coerce_mpz (RETVAL->m, zv), coerce_ulong (nv));
! 1304: OUTPUT:
! 1305: RETVAL
! 1306:
! 1307:
! 1308: void
! 1309: overload_lshifteq (z, n, o)
! 1310: mpz_assume z
! 1311: ulong_coerce n
! 1312: order_noswap o
! 1313: ALIAS:
! 1314: GMP::Mpz::overload_rshifteq = 1
! 1315: GMP::Mpz::overload_poweq = 2
! 1316: PREINIT:
! 1317: static const struct {
! 1318: void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
! 1319: } table[] = {
! 1320: { mpz_mul_2exp }, /* 0 */
! 1321: { mpz_div_2exp }, /* 1 */
! 1322: { mpz_pow_ui }, /* 2 */
! 1323: };
! 1324: PPCODE:
! 1325: assert_table (ix);
! 1326: (*table[ix].op) (z->m, z->m, n);
! 1327: XPUSHs(ST(0));
! 1328:
! 1329:
! 1330: mpz
! 1331: overload_abs (z, d1, d2)
! 1332: mpz_assume z
! 1333: dummy d1
! 1334: dummy d2
! 1335: ALIAS:
! 1336: GMP::Mpz::overload_neg = 1
! 1337: GMP::Mpz::overload_com = 2
! 1338: GMP::Mpz::overload_sqrt = 3
! 1339: PREINIT:
! 1340: static const struct {
! 1341: void (*op) (mpz_ptr w, mpz_srcptr x);
! 1342: } table[] = {
! 1343: { mpz_abs }, /* 0 */
! 1344: { mpz_neg }, /* 1 */
! 1345: { mpz_com }, /* 2 */
! 1346: { mpz_sqrt }, /* 3 */
! 1347: };
! 1348: CODE:
! 1349: assert_table (ix);
! 1350: RETVAL = new_mpz();
! 1351: (*table[ix].op) (RETVAL->m, z->m);
! 1352: OUTPUT:
! 1353: RETVAL
! 1354:
! 1355:
! 1356: void
! 1357: overload_inc (z, d1, d2)
! 1358: mpz_assume z
! 1359: dummy d1
! 1360: dummy d2
! 1361: ALIAS:
! 1362: GMP::Mpz::overload_dec = 1
! 1363: PREINIT:
! 1364: static const struct {
! 1365: void (*op) (mpz_ptr w, mpz_srcptr x, unsigned long y);
! 1366: } table[] = {
! 1367: { mpz_add_ui }, /* 0 */
! 1368: { mpz_sub_ui }, /* 1 */
! 1369: };
! 1370: CODE:
! 1371: assert_table (ix);
! 1372: (*table[ix].op) (z->m, z->m, 1L);
! 1373:
! 1374:
! 1375: int
! 1376: overload_spaceship (xv, yv, order)
! 1377: SV *xv
! 1378: SV *yv
! 1379: SV *order
! 1380: PREINIT:
! 1381: mpz x;
! 1382: CODE:
! 1383: TRACE (printf ("%s overload_spaceship\n", mpz_class));
! 1384: MPZ_ASSUME (x, xv);
! 1385: if (SvIOK(yv))
! 1386: RETVAL = mpz_cmp_si (x->m, SvIVX(yv));
! 1387: else if (SvPOKorp(yv))
! 1388: RETVAL = mpz_cmp (x->m, coerce_mpz (tmp_mpz_0, yv));
! 1389: else if (SvNOK(yv))
! 1390: RETVAL = mpz_cmp_d (x->m, SvNVX(yv));
! 1391: else if (SvROK(yv))
! 1392: {
! 1393: if (sv_derived_from (yv, mpz_class))
! 1394: RETVAL = mpz_cmp (x->m, SvMPZ(yv)->m);
! 1395: else if (sv_derived_from (yv, mpq_class))
! 1396: RETVAL = x_mpz_cmp_q (x->m, SvMPQ(yv)->m);
! 1397: else if (sv_derived_from (yv, mpf_class))
! 1398: RETVAL = x_mpz_cmp_f (x->m, SvMPF(yv));
! 1399: else
! 1400: goto invalid;
! 1401: }
! 1402: else
! 1403: {
! 1404: invalid:
! 1405: croak ("%s <=>: invalid operand", mpz_class);
! 1406: }
! 1407: RETVAL = SGN (RETVAL);
! 1408: if (order == &PL_sv_yes)
! 1409: RETVAL = -RETVAL;
! 1410: OUTPUT:
! 1411: RETVAL
! 1412:
! 1413:
! 1414: bool
! 1415: overload_bool (z, d1, d2)
! 1416: mpz_assume z
! 1417: dummy d1
! 1418: dummy d2
! 1419: ALIAS:
! 1420: GMP::Mpz::overload_not = 1
! 1421: CODE:
! 1422: RETVAL = (mpz_sgn (z->m) != 0) ^ ix;
! 1423: OUTPUT:
! 1424: RETVAL
! 1425:
! 1426:
! 1427: mpz
! 1428: bin (n, k)
! 1429: mpz_coerce n
! 1430: ulong_coerce k
! 1431: ALIAS:
! 1432: GMP::Mpz::root = 1
! 1433: PREINIT:
! 1434: /* mpz_root returns an int, hence the cast */
! 1435: static const struct {
! 1436: void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
! 1437: } table[] = {
! 1438: { mpz_bin_ui }, /* 0 */
! 1439: { (void (*)(mpz_ptr, mpz_srcptr, unsigned long)) mpz_root }, /* 1 */
! 1440: };
! 1441: CODE:
! 1442: assert_table (ix);
! 1443: RETVAL = new_mpz();
! 1444: (*table[ix].op) (RETVAL->m, n, k);
! 1445: OUTPUT:
! 1446: RETVAL
! 1447:
! 1448:
! 1449: void
! 1450: cdiv (a, d)
! 1451: mpz_coerce a
! 1452: mpz_coerce d
! 1453: ALIAS:
! 1454: GMP::Mpz::fdiv = 1
! 1455: GMP::Mpz::tdiv = 2
! 1456: PREINIT:
! 1457: static const struct {
! 1458: void (*op) (mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr);
! 1459: } table[] = {
! 1460: { mpz_cdiv_qr }, /* 0 */
! 1461: { mpz_fdiv_qr }, /* 1 */
! 1462: { mpz_tdiv_qr }, /* 2 */
! 1463: };
! 1464: mpz q, r;
! 1465: SV *sv;
! 1466: PPCODE:
! 1467: assert_table (ix);
! 1468: q = new_mpz();
! 1469: r = new_mpz();
! 1470: (*table[ix].op) (q->m, r->m, a, d);
! 1471: EXTEND (SP, 2);
! 1472: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, q); PUSHs(sv);
! 1473: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, r); PUSHs(sv);
! 1474:
! 1475:
! 1476: void
! 1477: cdiv_2exp (a, d)
! 1478: mpz_coerce a
! 1479: ulong_coerce d
! 1480: ALIAS:
! 1481: GMP::Mpz::fdiv_2exp = 1
! 1482: GMP::Mpz::tdiv_2exp = 2
! 1483: PREINIT:
! 1484: static const struct {
! 1485: void (*q) (mpz_ptr, mpz_srcptr, unsigned long);
! 1486: void (*r) (mpz_ptr, mpz_srcptr, unsigned long);
! 1487: } table[] = {
! 1488: { mpz_cdiv_q_2exp, mpz_cdiv_r_2exp }, /* 0 */
! 1489: { mpz_fdiv_q_2exp, mpz_fdiv_r_2exp }, /* 1 */
! 1490: { mpz_tdiv_q_2exp, mpz_tdiv_r_2exp }, /* 2 */
! 1491: };
! 1492: mpz q, r;
! 1493: SV *sv;
! 1494: PPCODE:
! 1495: assert_table (ix);
! 1496: q = new_mpz();
! 1497: r = new_mpz();
! 1498: (*table[ix].q) (q->m, a, d);
! 1499: (*table[ix].r) (r->m, a, d);
! 1500: EXTEND (SP, 2);
! 1501: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, q); PUSHs(sv);
! 1502: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, r); PUSHs(sv);
! 1503:
! 1504:
! 1505: bool
! 1506: congruent_p (a, c, d)
! 1507: mpz_coerce a
! 1508: mpz_coerce c
! 1509: mpz_coerce d
! 1510: PREINIT:
! 1511: CODE:
! 1512: RETVAL = mpz_congruent_p (a, c, d);
! 1513: OUTPUT:
! 1514: RETVAL
! 1515:
! 1516:
! 1517: bool
! 1518: congruent_2exp_p (a, c, d)
! 1519: mpz_coerce a
! 1520: mpz_coerce c
! 1521: ulong_coerce d
! 1522: PREINIT:
! 1523: CODE:
! 1524: RETVAL = mpz_congruent_2exp_p (a, c, d);
! 1525: OUTPUT:
! 1526: RETVAL
! 1527:
! 1528:
! 1529: mpz
! 1530: divexact (a, d)
! 1531: mpz_coerce a
! 1532: mpz_coerce d
! 1533: ALIAS:
! 1534: GMP::Mpz::mod = 1
! 1535: PREINIT:
! 1536: static const struct {
! 1537: void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
! 1538: } table[] = {
! 1539: { mpz_divexact }, /* 0 */
! 1540: { mpz_mod }, /* 1 */
! 1541: };
! 1542: CODE:
! 1543: assert_table (ix);
! 1544: RETVAL = new_mpz();
! 1545: (*table[ix].op) (RETVAL->m, a, d);
! 1546: OUTPUT:
! 1547: RETVAL
! 1548:
! 1549:
! 1550: bool
! 1551: divisible_p (a, d)
! 1552: mpz_coerce a
! 1553: mpz_coerce d
! 1554: CODE:
! 1555: RETVAL = mpz_divisible_p (a, d);
! 1556: OUTPUT:
! 1557: RETVAL
! 1558:
! 1559:
! 1560: bool
! 1561: divisible_2exp_p (a, d)
! 1562: mpz_coerce a
! 1563: ulong_coerce d
! 1564: CODE:
! 1565: RETVAL = mpz_divisible_2exp_p (a, d);
! 1566: OUTPUT:
! 1567: RETVAL
! 1568:
! 1569:
! 1570: bool
! 1571: even_p (z)
! 1572: mpz_coerce z
! 1573: ALIAS:
! 1574: GMP::Mpz::odd_p = 1
! 1575: GMP::Mpz::perfect_square_p = 2
! 1576: GMP::Mpz::perfect_power_p = 3
! 1577: PREINIT:
! 1578: static const struct {
! 1579: int (*op) (mpz_srcptr z);
! 1580: } table[] = {
! 1581: { x_mpz_even_p }, /* 0 */
! 1582: { x_mpz_odd_p }, /* 1 */
! 1583: { mpz_perfect_square_p }, /* 2 */
! 1584: { mpz_perfect_power_p }, /* 3 */
! 1585: };
! 1586: CODE:
! 1587: assert_table (ix);
! 1588: RETVAL = (*table[ix].op) (z);
! 1589: OUTPUT:
! 1590: RETVAL
! 1591:
! 1592:
! 1593: mpz
! 1594: fac (n)
! 1595: ulong_coerce n
! 1596: ALIAS:
! 1597: GMP::Mpz::fib = 1
! 1598: GMP::Mpz::lucnum = 2
! 1599: PREINIT:
! 1600: static const struct {
! 1601: void (*op) (mpz_ptr r, unsigned long n);
! 1602: } table[] = {
! 1603: { mpz_fac_ui }, /* 0 */
! 1604: { mpz_fib_ui }, /* 1 */
! 1605: { mpz_lucnum_ui }, /* 2 */
! 1606: };
! 1607: CODE:
! 1608: assert_table (ix);
! 1609: RETVAL = new_mpz();
! 1610: (*table[ix].op) (RETVAL->m, n);
! 1611: OUTPUT:
! 1612: RETVAL
! 1613:
! 1614:
! 1615: void
! 1616: fib2 (n)
! 1617: ulong_coerce n
! 1618: ALIAS:
! 1619: GMP::Mpz::lucnum2 = 1
! 1620: PREINIT:
! 1621: static const struct {
! 1622: void (*op) (mpz_ptr r, mpz_ptr r2, unsigned long n);
! 1623: } table[] = {
! 1624: { mpz_fib2_ui }, /* 0 */
! 1625: { mpz_lucnum2_ui }, /* 1 */
! 1626: };
! 1627: mpz r, r2;
! 1628: SV *sv;
! 1629: PPCODE:
! 1630: assert_table (ix);
! 1631: r = new_mpz();
! 1632: r2 = new_mpz();
! 1633: (*table[ix].op) (r->m, r2->m, n);
! 1634: EXTEND (SP, 2);
! 1635: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, r); PUSHs(sv);
! 1636: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, r2); PUSHs(sv);
! 1637:
! 1638:
! 1639: mpz
! 1640: gcd (x, ...)
! 1641: mpz_coerce x
! 1642: ALIAS:
! 1643: GMP::Mpz::lcm = 1
! 1644: PREINIT:
! 1645: static const struct {
! 1646: void (*op) (mpz_ptr w, mpz_srcptr x, mpz_srcptr y);
! 1647: void (*op_ui) (mpz_ptr w, mpz_srcptr x, unsigned long y);
! 1648: } table[] = {
! 1649: /* cast to ignore ulong return from mpz_gcd_ui */
! 1650: { mpz_gcd,
! 1651: (void (*) (mpz_ptr, mpz_srcptr, unsigned long)) mpz_gcd_ui }, /* 0 */
! 1652: { mpz_lcm, mpz_lcm_ui }, /* 1 */
! 1653: };
! 1654: int i;
! 1655: SV *yv;
! 1656: CODE:
! 1657: assert_table (ix);
! 1658: RETVAL = new_mpz();
! 1659: if (items == 1)
! 1660: mpz_set (RETVAL->m, x);
! 1661: else
! 1662: {
! 1663: for (i = 1; i < items; i++)
! 1664: {
! 1665: yv = ST(i);
! 1666: if (SvIOK(yv))
! 1667: (*table[ix].op_ui) (RETVAL->m, x, ABS(SvIVX(yv)));
! 1668: else
! 1669: (*table[ix].op) (RETVAL->m, x, coerce_mpz (tmp_mpz_1, yv));
! 1670: x = RETVAL->m;
! 1671: }
! 1672: }
! 1673: OUTPUT:
! 1674: RETVAL
! 1675:
! 1676:
! 1677: void
! 1678: gcdext (a, b)
! 1679: mpz_coerce a
! 1680: mpz_coerce b
! 1681: PREINIT:
! 1682: mpz g, x, y;
! 1683: SV *sv;
! 1684: PPCODE:
! 1685: g = new_mpz();
! 1686: x = new_mpz();
! 1687: y = new_mpz();
! 1688: mpz_gcdext (g->m, x->m, y->m, a, b);
! 1689: EXTEND (SP, 3);
! 1690: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, g); PUSHs(sv);
! 1691: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, x); PUSHs(sv);
! 1692: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, y); PUSHs(sv);
! 1693:
! 1694:
! 1695: unsigned long
! 1696: hamdist (x, y)
! 1697: mpz_coerce x
! 1698: mpz_coerce y
! 1699: CODE:
! 1700: RETVAL = mpz_hamdist (x, y);
! 1701: OUTPUT:
! 1702: RETVAL
! 1703:
! 1704:
! 1705: mpz
! 1706: invert (a, m)
! 1707: mpz_coerce a
! 1708: mpz_coerce m
! 1709: CODE:
! 1710: RETVAL = new_mpz();
! 1711: if (! mpz_invert (RETVAL->m, a, m))
! 1712: {
! 1713: free_mpz (RETVAL);
! 1714: XSRETURN_UNDEF;
! 1715: }
! 1716: OUTPUT:
! 1717: RETVAL
! 1718:
! 1719:
! 1720: int
! 1721: jacobi (a, b)
! 1722: mpz_coerce a
! 1723: mpz_coerce b
! 1724: CODE:
! 1725: RETVAL = mpz_jacobi (a, b);
! 1726: OUTPUT:
! 1727: RETVAL
! 1728:
! 1729:
! 1730: int
! 1731: kronecker (a, b)
! 1732: SV *a
! 1733: SV *b
! 1734: CODE:
! 1735: if (SvIOK(b))
! 1736: RETVAL = mpz_kronecker_si (coerce_mpz(tmp_mpz_0,a), SvIVX(b));
! 1737: else if (SvIOK(a))
! 1738: RETVAL = mpz_si_kronecker (SvIVX(a), coerce_mpz(tmp_mpz_0,b));
! 1739: else
! 1740: RETVAL = mpz_kronecker (coerce_mpz(tmp_mpz_0,a),
! 1741: coerce_mpz(tmp_mpz_1,b));
! 1742: OUTPUT:
! 1743: RETVAL
! 1744:
! 1745:
! 1746: mpz
! 1747: nextprime (z)
! 1748: mpz_coerce z
! 1749: CODE:
! 1750: RETVAL = new_mpz();
! 1751: mpz_nextprime (RETVAL->m, z);
! 1752: OUTPUT:
! 1753: RETVAL
! 1754:
! 1755:
! 1756: unsigned long
! 1757: popcount (x)
! 1758: mpz_coerce x
! 1759: CODE:
! 1760: RETVAL = mpz_popcount (x);
! 1761: OUTPUT:
! 1762: RETVAL
! 1763:
! 1764:
! 1765: mpz
! 1766: powm (b, e, m)
! 1767: mpz_coerce b
! 1768: mpz_coerce e
! 1769: mpz_coerce m
! 1770: CODE:
! 1771: RETVAL = new_mpz();
! 1772: mpz_powm (RETVAL->m, b, e, m);
! 1773: OUTPUT:
! 1774: RETVAL
! 1775:
! 1776:
! 1777: bool
! 1778: probab_prime_p (z, n)
! 1779: mpz_coerce z
! 1780: ulong_coerce n
! 1781: CODE:
! 1782: RETVAL = mpz_probab_prime_p (z, n);
! 1783: OUTPUT:
! 1784: RETVAL
! 1785:
! 1786:
! 1787: # No attempt to coerce here, only an mpz makes sense.
! 1788: void
! 1789: realloc (z, limbs)
! 1790: mpz z
! 1791: int limbs
! 1792: CODE:
! 1793: _mpz_realloc (z->m, limbs);
! 1794:
! 1795:
! 1796: void
! 1797: remove (z, f)
! 1798: mpz_coerce z
! 1799: mpz_coerce f
! 1800: PREINIT:
! 1801: SV *sv;
! 1802: mpz rem;
! 1803: unsigned long mult;
! 1804: dTARG;
! 1805: PPCODE:
! 1806: rem = new_mpz();
! 1807: mult = mpz_remove (rem->m, z, f);
! 1808: EXTEND (SP, 2);
! 1809: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, rem); PUSHs(sv);
! 1810: PUSHs (sv_2mortal (newSViv (mult)));
! 1811:
! 1812:
! 1813: void
! 1814: roote (z, n)
! 1815: mpz_coerce z
! 1816: ulong_coerce n
! 1817: PREINIT:
! 1818: SV *sv;
! 1819: mpz root;
! 1820: int exact;
! 1821: PPCODE:
! 1822: root = new_mpz();
! 1823: exact = mpz_root (root->m, z, n);
! 1824: EXTEND (SP, 2);
! 1825: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, root); PUSHs(sv);
! 1826: sv = (exact ? &PL_sv_yes : &PL_sv_no); sv_2mortal(sv); PUSHs(sv);
! 1827:
! 1828:
! 1829: unsigned long
! 1830: scan0 (z, start)
! 1831: mpz_coerce z
! 1832: ulong_coerce start
! 1833: ALIAS:
! 1834: GMP::Mpz::scan1 = 1
! 1835: PREINIT:
! 1836: static const struct {
! 1837: unsigned long (*op) (mpz_srcptr, unsigned long);
! 1838: } table[] = {
! 1839: { mpz_scan0 }, /* 0 */
! 1840: { mpz_scan1 }, /* 1 */
! 1841: };
! 1842: CODE:
! 1843: assert_table (ix);
! 1844: RETVAL = (*table[ix].op) (z, start);
! 1845: OUTPUT:
! 1846: RETVAL
! 1847:
! 1848:
! 1849: void
! 1850: setbit (z, bit)
! 1851: mpz_mutate z
! 1852: ulong_coerce bit
! 1853: ALIAS:
! 1854: GMP::Mpz::clrbit = 1
! 1855: PREINIT:
! 1856: static const struct {
! 1857: void (*op) (mpz_ptr, unsigned long);
! 1858: } table[] = {
! 1859: { mpz_setbit }, /* 0 */
! 1860: { mpz_clrbit }, /* 1 */
! 1861: };
! 1862: CODE:
! 1863: TRACE (printf ("%s %s\n", mpz_class, (ix==0 ? "setbit" : "clrbit")));
! 1864: assert (SvROK(ST(0)) && SvREFCNT(SvRV(ST(0))) == 1);
! 1865: assert_table (ix);
! 1866: (*table[ix].op) (z, bit);
! 1867:
! 1868:
! 1869: void
! 1870: sqrtrem (z)
! 1871: mpz_coerce z
! 1872: PREINIT:
! 1873: SV *sv;
! 1874: mpz root;
! 1875: mpz rem;
! 1876: PPCODE:
! 1877: root = new_mpz();
! 1878: rem = new_mpz();
! 1879: mpz_sqrtrem (root->m, rem->m, z);
! 1880: EXTEND (SP, 2);
! 1881: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, root); PUSHs(sv);
! 1882: sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, rem); PUSHs(sv);
! 1883:
! 1884:
! 1885: size_t
! 1886: sizeinbase (z, base)
! 1887: mpz_coerce z
! 1888: int base
! 1889: CODE:
! 1890: RETVAL = mpz_sizeinbase (z, base);
! 1891: OUTPUT:
! 1892: RETVAL
! 1893:
! 1894:
! 1895: int
! 1896: tstbit (z, bit)
! 1897: mpz_coerce z
! 1898: ulong_coerce bit
! 1899: CODE:
! 1900: RETVAL = mpz_tstbit (z, bit);
! 1901: OUTPUT:
! 1902: RETVAL
! 1903:
! 1904:
! 1905:
! 1906: #------------------------------------------------------------------------------
! 1907:
! 1908: MODULE = GMP PACKAGE = GMP::Mpq
! 1909:
! 1910:
! 1911: mpq
! 1912: mpq (...)
! 1913: ALIAS:
! 1914: GMP::Mpq::new = 1
! 1915: PREINIT:
! 1916: CODE:
! 1917: TRACE (printf ("%s new\n", mpq_class));
! 1918: RETVAL = new_mpq();
! 1919:
! 1920: switch (items) {
! 1921: case 0:
! 1922: mpq_set_ui (RETVAL->m, 0L, 1L);
! 1923: break;
! 1924: case 1:
! 1925: coerce_mpq_into (RETVAL->m, ST(0));
! 1926: break;
! 1927: case 2:
! 1928: coerce_mpz_into (mpq_numref(RETVAL->m), ST(0));
! 1929: coerce_mpz_into (mpq_denref(RETVAL->m), ST(1));
! 1930: break;
! 1931: default:
! 1932: croak ("%s new: invalid arguments", mpq_class);
! 1933: }
! 1934: OUTPUT:
! 1935: RETVAL
! 1936:
! 1937:
! 1938: void
! 1939: overload_constant (str, pv, d1, ...)
! 1940: const_string_assume str
! 1941: SV *pv
! 1942: dummy d1
! 1943: PREINIT:
! 1944: SV *sv;
! 1945: mpq q;
! 1946: PPCODE:
! 1947: TRACE (printf ("%s constant: %s\n", mpq_class, str));
! 1948: q = new_mpq();
! 1949: if (mpq_set_str (q->m, str, 0) == 0)
! 1950: { sv = sv_newmortal(); sv_setref_pv (sv, mpq_class, q); }
! 1951: else
! 1952: { free_mpq (q); sv = pv; }
! 1953: XPUSHs(sv);
! 1954:
! 1955:
! 1956: mpq
! 1957: overload_copy (q, d1, d2)
! 1958: mpq_assume q
! 1959: dummy d1
! 1960: dummy d2
! 1961: CODE:
! 1962: RETVAL = new_mpq();
! 1963: mpq_set (RETVAL->m, q->m);
! 1964: OUTPUT:
! 1965: RETVAL
! 1966:
! 1967:
! 1968: void
! 1969: DESTROY (q)
! 1970: mpq_assume q
! 1971: CODE:
! 1972: TRACE (printf ("%s DESTROY %p\n", mpq_class, q));
! 1973: free_mpq (q);
! 1974:
! 1975:
! 1976: malloced_string
! 1977: overload_string (q, d1, d2)
! 1978: mpq_assume q
! 1979: dummy d1
! 1980: dummy d2
! 1981: CODE:
! 1982: TRACE (printf ("%s overload_string %p\n", mpq_class, q));
! 1983: RETVAL = mpq_get_str (NULL, 10, q->m);
! 1984: OUTPUT:
! 1985: RETVAL
! 1986:
! 1987:
! 1988: mpq
! 1989: overload_add (xv, yv, order)
! 1990: SV *xv
! 1991: SV *yv
! 1992: SV *order
! 1993: ALIAS:
! 1994: GMP::Mpq::overload_sub = 1
! 1995: GMP::Mpq::overload_mul = 2
! 1996: GMP::Mpq::overload_div = 3
! 1997: PREINIT:
! 1998: static const struct {
! 1999: void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
! 2000: } table[] = {
! 2001: { mpq_add }, /* 0 */
! 2002: { mpq_sub }, /* 1 */
! 2003: { mpq_mul }, /* 2 */
! 2004: { mpq_div }, /* 3 */
! 2005: };
! 2006: CODE:
! 2007: TRACE (printf ("%s binary\n", mpf_class));
! 2008: assert_table (ix);
! 2009: if (order == &PL_sv_yes)
! 2010: SV_PTR_SWAP (xv, yv);
! 2011: RETVAL = new_mpq();
! 2012: (*table[ix].op) (RETVAL->m,
! 2013: coerce_mpq (tmp_mpq_0, xv),
! 2014: coerce_mpq (tmp_mpq_1, yv));
! 2015: OUTPUT:
! 2016: RETVAL
! 2017:
! 2018:
! 2019: void
! 2020: overload_addeq (x, y, o)
! 2021: mpq_assume x
! 2022: mpq_coerce y
! 2023: order_noswap o
! 2024: ALIAS:
! 2025: GMP::Mpq::overload_subeq = 1
! 2026: GMP::Mpq::overload_muleq = 2
! 2027: GMP::Mpq::overload_diveq = 3
! 2028: PREINIT:
! 2029: static const struct {
! 2030: void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
! 2031: } table[] = {
! 2032: { mpq_add }, /* 0 */
! 2033: { mpq_sub }, /* 1 */
! 2034: { mpq_mul }, /* 2 */
! 2035: { mpq_div }, /* 3 */
! 2036: };
! 2037: PPCODE:
! 2038: assert_table (ix);
! 2039: (*table[ix].op) (x->m, x->m, y);
! 2040: XPUSHs(ST(0));
! 2041:
! 2042:
! 2043: mpq
! 2044: overload_lshift (qv, nv, order)
! 2045: SV *qv
! 2046: SV *nv
! 2047: SV *order
! 2048: ALIAS:
! 2049: GMP::Mpq::overload_rshift = 1
! 2050: GMP::Mpq::overload_pow = 2
! 2051: PREINIT:
! 2052: static const struct {
! 2053: void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
! 2054: } table[] = {
! 2055: { mpq_mul_2exp }, /* 0 */
! 2056: { mpq_div_2exp }, /* 1 */
! 2057: { x_mpq_pow_ui }, /* 2 */
! 2058: };
! 2059: CODE:
! 2060: assert_table (ix);
! 2061: if (order == &PL_sv_yes)
! 2062: SV_PTR_SWAP (qv, nv);
! 2063: RETVAL = new_mpq();
! 2064: (*table[ix].op) (RETVAL->m, coerce_mpq (RETVAL->m, qv), coerce_ulong (nv));
! 2065: OUTPUT:
! 2066: RETVAL
! 2067:
! 2068:
! 2069: void
! 2070: overload_lshifteq (q, n, o)
! 2071: mpq_assume q
! 2072: ulong_coerce n
! 2073: order_noswap o
! 2074: ALIAS:
! 2075: GMP::Mpq::overload_rshifteq = 1
! 2076: GMP::Mpq::overload_poweq = 2
! 2077: PREINIT:
! 2078: static const struct {
! 2079: void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
! 2080: } table[] = {
! 2081: { mpq_mul_2exp }, /* 0 */
! 2082: { mpq_div_2exp }, /* 1 */
! 2083: { x_mpq_pow_ui }, /* 2 */
! 2084: };
! 2085: PPCODE:
! 2086: assert_table (ix);
! 2087: (*table[ix].op) (q->m, q->m, n);
! 2088: XPUSHs(ST(0));
! 2089:
! 2090:
! 2091: void
! 2092: overload_inc (q, d1, d2)
! 2093: mpq_assume q
! 2094: dummy d1
! 2095: dummy d2
! 2096: ALIAS:
! 2097: GMP::Mpq::overload_dec = 1
! 2098: PREINIT:
! 2099: static const struct {
! 2100: void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
! 2101: } table[] = {
! 2102: { mpz_add }, /* 0 */
! 2103: { mpz_sub }, /* 1 */
! 2104: };
! 2105: CODE:
! 2106: assert_table (ix);
! 2107: (*table[ix].op) (mpq_numref(q->m), mpq_numref(q->m), mpq_denref(q->m));
! 2108:
! 2109:
! 2110: mpq
! 2111: overload_abs (q, d1, d2)
! 2112: mpq_assume q
! 2113: dummy d1
! 2114: dummy d2
! 2115: ALIAS:
! 2116: GMP::Mpq::overload_neg = 1
! 2117: PREINIT:
! 2118: static const struct {
! 2119: void (*op) (mpq_ptr w, mpq_srcptr x);
! 2120: } table[] = {
! 2121: { mpq_abs }, /* 0 */
! 2122: { mpq_neg }, /* 1 */
! 2123: };
! 2124: CODE:
! 2125: assert_table (ix);
! 2126: RETVAL = new_mpq();
! 2127: (*table[ix].op) (RETVAL->m, q->m);
! 2128: OUTPUT:
! 2129: RETVAL
! 2130:
! 2131:
! 2132: int
! 2133: overload_spaceship (x, y, order)
! 2134: mpq_assume x
! 2135: mpq_coerce y
! 2136: SV *order
! 2137: CODE:
! 2138: RETVAL = mpq_cmp (x->m, y);
! 2139: RETVAL = SGN (RETVAL);
! 2140: if (order == &PL_sv_yes)
! 2141: RETVAL = -RETVAL;
! 2142: OUTPUT:
! 2143: RETVAL
! 2144:
! 2145:
! 2146: bool
! 2147: overload_bool (q, d1, d2)
! 2148: mpq_assume q
! 2149: dummy d1
! 2150: dummy d2
! 2151: ALIAS:
! 2152: GMP::Mpq::overload_not = 1
! 2153: CODE:
! 2154: RETVAL = (mpq_sgn (q->m) != 0) ^ ix;
! 2155: OUTPUT:
! 2156: RETVAL
! 2157:
! 2158:
! 2159: bool
! 2160: overload_eq (x, yv, d)
! 2161: mpq_assume x
! 2162: SV *yv
! 2163: dummy d
! 2164: ALIAS:
! 2165: GMP::Mpq::overload_ne = 1
! 2166: CODE:
! 2167: if (SvIOK(yv))
! 2168: RETVAL = x_mpq_equal_si (x->m, SvIVX(yv), 1L);
! 2169: else if (SvROK(yv))
! 2170: {
! 2171: if (sv_derived_from (yv, mpz_class))
! 2172: RETVAL = x_mpq_equal_z (x->m, SvMPZ(yv)->m);
! 2173: else if (sv_derived_from (yv, mpq_class))
! 2174: RETVAL = mpq_equal (x->m, SvMPQ(yv)->m);
! 2175: else
! 2176: goto coerce;
! 2177: }
! 2178: else
! 2179: {
! 2180: coerce:
! 2181: RETVAL = mpq_equal (x->m, coerce_mpq (tmp_mpq_0, yv));
! 2182: }
! 2183: RETVAL ^= ix;
! 2184: OUTPUT:
! 2185: RETVAL
! 2186:
! 2187:
! 2188: void
! 2189: canonicalize (q)
! 2190: mpq q
! 2191: CODE:
! 2192: mpq_canonicalize (q->m);
! 2193:
! 2194:
! 2195: mpq
! 2196: inv (q)
! 2197: mpq_coerce q
! 2198: CODE:
! 2199: RETVAL = new_mpq();
! 2200: mpq_inv (RETVAL->m, q);
! 2201: OUTPUT:
! 2202: RETVAL
! 2203:
! 2204:
! 2205: mpz
! 2206: num (q)
! 2207: mpq q
! 2208: ALIAS:
! 2209: GMP::Mpq::den = 1
! 2210: CODE:
! 2211: RETVAL = new_mpz();
! 2212: mpz_set (RETVAL->m, (ix == 0 ? mpq_numref(q->m) : mpq_denref(q->m)));
! 2213: OUTPUT:
! 2214: RETVAL
! 2215:
! 2216:
! 2217:
! 2218: #------------------------------------------------------------------------------
! 2219:
! 2220: MODULE = GMP PACKAGE = GMP::Mpf
! 2221:
! 2222:
! 2223: mpf
! 2224: mpf (...)
! 2225: ALIAS:
! 2226: GMP::Mpf::new = 1
! 2227: PREINIT:
! 2228: unsigned long prec;
! 2229: CODE:
! 2230: TRACE (printf ("%s new\n", mpf_class));
! 2231: if (items > 2)
! 2232: croak ("%s new: invalid arguments", mpf_class);
! 2233: prec = (items == 2 ? coerce_ulong (ST(1)) : mpf_get_default_prec());
! 2234: RETVAL = new_mpf (prec);
! 2235: if (items >= 1)
! 2236: my_mpf_set_sv (RETVAL, ST(0));
! 2237: OUTPUT:
! 2238: RETVAL
! 2239:
! 2240:
! 2241: mpf
! 2242: overload_constant (sv, d1, d2, ...)
! 2243: SV *sv
! 2244: dummy d1
! 2245: dummy d2
! 2246: PREINIT:
! 2247: mpf f;
! 2248: CODE:
! 2249: assert (SvPOK (sv));
! 2250: TRACE (printf ("%s constant: %s\n", mpq_class, SvPVX(sv)));
! 2251: RETVAL = new_mpf (mpf_get_default_prec());
! 2252: my_mpf_set_svstr (RETVAL, sv);
! 2253: OUTPUT:
! 2254: RETVAL
! 2255:
! 2256:
! 2257: mpf
! 2258: overload_copy (f, d1, d2)
! 2259: mpf_assume f
! 2260: dummy d1
! 2261: dummy d2
! 2262: CODE:
! 2263: TRACE (printf ("%s copy\n", mpf_class));
! 2264: RETVAL = new_mpf (mpf_get_prec (f));
! 2265: mpf_set (RETVAL, f);
! 2266: OUTPUT:
! 2267: RETVAL
! 2268:
! 2269:
! 2270: void
! 2271: DESTROY (f)
! 2272: mpf_assume f
! 2273: CODE:
! 2274: TRACE (printf ("%s DESTROY %p\n", mpf_class, f));
! 2275: mpf_clear (f);
! 2276: Safefree (f);
! 2277: assert_support (mpf_count--);
! 2278: TRACE_ACTIVE ();
! 2279:
! 2280:
! 2281: mpf
! 2282: overload_add (x, y, order)
! 2283: mpf_assume x
! 2284: mpf_coerce_st0 y
! 2285: SV *order
! 2286: ALIAS:
! 2287: GMP::Mpf::overload_sub = 1
! 2288: GMP::Mpf::overload_mul = 2
! 2289: GMP::Mpf::overload_div = 3
! 2290: PREINIT:
! 2291: static const struct {
! 2292: void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
! 2293: } table[] = {
! 2294: { mpf_add }, /* 0 */
! 2295: { mpf_sub }, /* 1 */
! 2296: { mpf_mul }, /* 2 */
! 2297: { mpf_div }, /* 3 */
! 2298: };
! 2299: unsigned long prec;
! 2300: CODE:
! 2301: assert_table (ix);
! 2302: RETVAL = new_mpf (mpf_get_prec (x));
! 2303: if (order == &PL_sv_yes)
! 2304: MPF_PTR_SWAP (x, y);
! 2305: (*table[ix].op) (RETVAL, x, y);
! 2306: OUTPUT:
! 2307: RETVAL
! 2308:
! 2309:
! 2310: void
! 2311: overload_addeq (x, y, o)
! 2312: mpf_assume x
! 2313: mpf_coerce_st0 y
! 2314: order_noswap o
! 2315: ALIAS:
! 2316: GMP::Mpf::overload_subeq = 1
! 2317: GMP::Mpf::overload_muleq = 2
! 2318: GMP::Mpf::overload_diveq = 3
! 2319: PREINIT:
! 2320: static const struct {
! 2321: void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
! 2322: } table[] = {
! 2323: { mpf_add }, /* 0 */
! 2324: { mpf_sub }, /* 1 */
! 2325: { mpf_mul }, /* 2 */
! 2326: { mpf_div }, /* 3 */
! 2327: };
! 2328: PPCODE:
! 2329: assert_table (ix);
! 2330: (*table[ix].op) (x, x, y);
! 2331: XPUSHs(ST(0));
! 2332:
! 2333:
! 2334: mpf
! 2335: overload_lshift (fv, nv, order)
! 2336: SV *fv
! 2337: SV *nv
! 2338: SV *order
! 2339: ALIAS:
! 2340: GMP::Mpf::overload_rshift = 1
! 2341: GMP::Mpf::overload_pow = 2
! 2342: PREINIT:
! 2343: static const struct {
! 2344: void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
! 2345: } table[] = {
! 2346: { mpf_mul_2exp }, /* 0 */
! 2347: { mpf_div_2exp }, /* 1 */
! 2348: { mpf_pow_ui }, /* 2 */
! 2349: };
! 2350: mpf f;
! 2351: unsigned long prec;
! 2352: CODE:
! 2353: assert_table (ix);
! 2354: MPF_ASSUME (f, fv);
! 2355: prec = mpf_get_prec (f);
! 2356: if (order == &PL_sv_yes)
! 2357: SV_PTR_SWAP (fv, nv);
! 2358: f = coerce_mpf (tmp_mpf_0, fv, prec);
! 2359: RETVAL = new_mpf (prec);
! 2360: (*table[ix].op) (RETVAL, f, coerce_ulong (nv));
! 2361: OUTPUT:
! 2362: RETVAL
! 2363:
! 2364:
! 2365: void
! 2366: overload_lshifteq (f, n, o)
! 2367: mpf_assume f
! 2368: ulong_coerce n
! 2369: order_noswap o
! 2370: ALIAS:
! 2371: GMP::Mpf::overload_rshifteq = 1
! 2372: GMP::Mpf::overload_poweq = 2
! 2373: PREINIT:
! 2374: static const struct {
! 2375: void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
! 2376: } table[] = {
! 2377: { mpf_mul_2exp }, /* 0 */
! 2378: { mpf_div_2exp }, /* 1 */
! 2379: { mpf_pow_ui }, /* 2 */
! 2380: };
! 2381: PPCODE:
! 2382: assert_table (ix);
! 2383: (*table[ix].op) (f, f, n);
! 2384: XPUSHs(ST(0));
! 2385:
! 2386:
! 2387: mpf
! 2388: overload_abs (f, d1, d2)
! 2389: mpf_assume f
! 2390: dummy d1
! 2391: dummy d2
! 2392: ALIAS:
! 2393: GMP::Mpf::overload_neg = 1
! 2394: GMP::Mpf::overload_sqrt = 2
! 2395: PREINIT:
! 2396: static const struct {
! 2397: void (*op) (mpf_ptr w, mpf_srcptr x);
! 2398: } table[] = {
! 2399: { mpf_abs }, /* 0 */
! 2400: { mpf_neg }, /* 1 */
! 2401: { mpf_sqrt }, /* 2 */
! 2402: };
! 2403: CODE:
! 2404: assert_table (ix);
! 2405: RETVAL = new_mpf (mpf_get_prec (f));
! 2406: (*table[ix].op) (RETVAL, f);
! 2407: OUTPUT:
! 2408: RETVAL
! 2409:
! 2410:
! 2411: void
! 2412: overload_inc (f, d1, d2)
! 2413: mpf_assume f
! 2414: dummy d1
! 2415: dummy d2
! 2416: ALIAS:
! 2417: GMP::Mpf::overload_dec = 1
! 2418: PREINIT:
! 2419: static const struct {
! 2420: void (*op) (mpf_ptr w, mpf_srcptr x, unsigned long y);
! 2421: } table[] = {
! 2422: { mpf_add_ui }, /* 0 */
! 2423: { mpf_sub_ui }, /* 1 */
! 2424: };
! 2425: CODE:
! 2426: assert_table (ix);
! 2427: (*table[ix].op) (f, f, 1L);
! 2428:
! 2429:
! 2430: int
! 2431: overload_spaceship (xv, yv, order)
! 2432: SV *xv
! 2433: SV *yv
! 2434: SV *order
! 2435: PREINIT:
! 2436: mpf x;
! 2437: CODE:
! 2438: MPF_ASSUME (x, xv);
! 2439: if (SvIOK(yv))
! 2440: RETVAL = mpf_cmp_si (x, SvIVX(yv));
! 2441: else if (SvNOK(yv))
! 2442: RETVAL = mpf_cmp_d (x, SvNVX(yv));
! 2443: else if (SvPOKorp(yv))
! 2444: {
! 2445: STRLEN len;
! 2446: const char *str = SvPV (yv, len);
! 2447: /* enough for all digits of the string */
! 2448: tmp_mpf_set_prec (tmp_mpf_0, strlen(str)+64);
! 2449: if (mpf_set_str (tmp_mpf_0->m, str, 10) != 0)
! 2450: croak ("%s <=>: invalid string format", mpf_class);
! 2451: RETVAL = mpf_cmp (x, tmp_mpf_0->m);
! 2452: }
! 2453: else if (SvROK(yv))
! 2454: {
! 2455: if (sv_derived_from (yv, mpz_class))
! 2456: RETVAL = - x_mpz_cmp_f (SvMPZ(yv)->m, x);
! 2457: else if (sv_derived_from (yv, mpf_class))
! 2458: RETVAL = mpf_cmp (x, SvMPF(yv));
! 2459: else
! 2460: goto use_mpq;
! 2461: }
! 2462: else
! 2463: {
! 2464: use_mpq:
! 2465: RETVAL = mpq_cmp (coerce_mpq (tmp_mpq_0, xv),
! 2466: coerce_mpq (tmp_mpq_1, yv));
! 2467: }
! 2468: RETVAL = SGN (RETVAL);
! 2469: if (order == &PL_sv_yes)
! 2470: RETVAL = -RETVAL;
! 2471: OUTPUT:
! 2472: RETVAL
! 2473:
! 2474:
! 2475: bool
! 2476: overload_bool (f, d1, d2)
! 2477: mpf_assume f
! 2478: dummy d1
! 2479: dummy d2
! 2480: ALIAS:
! 2481: GMP::Mpf::overload_not = 1
! 2482: CODE:
! 2483: RETVAL = (mpf_sgn (f) != 0) ^ ix;
! 2484: OUTPUT:
! 2485: RETVAL
! 2486:
! 2487:
! 2488: mpf
! 2489: ceil (f)
! 2490: mpf_coerce_def f
! 2491: ALIAS:
! 2492: GMP::Mpf::floor = 1
! 2493: GMP::Mpf::trunc = 2
! 2494: PREINIT:
! 2495: static const struct {
! 2496: void (*op) (mpf_ptr w, mpf_srcptr x);
! 2497: } table[] = {
! 2498: { mpf_ceil }, /* 0 */
! 2499: { mpf_floor }, /* 1 */
! 2500: { mpf_trunc }, /* 2 */
! 2501: };
! 2502: CODE:
! 2503: assert_table (ix);
! 2504: RETVAL = new_mpf (mpf_get_prec (f));
! 2505: (*table[ix].op) (RETVAL, f);
! 2506: OUTPUT:
! 2507: RETVAL
! 2508:
! 2509:
! 2510: unsigned long
! 2511: get_default_prec ()
! 2512: CODE:
! 2513: RETVAL = mpf_get_default_prec();
! 2514: OUTPUT:
! 2515: RETVAL
! 2516:
! 2517:
! 2518: unsigned long
! 2519: get_prec (f)
! 2520: mpf_coerce_def f
! 2521: CODE:
! 2522: RETVAL = mpf_get_prec (f);
! 2523: OUTPUT:
! 2524: RETVAL
! 2525:
! 2526:
! 2527: bool
! 2528: mpf_eq (xv, yv, bits)
! 2529: SV *xv
! 2530: SV *yv
! 2531: ulong_coerce bits
! 2532: PREINIT:
! 2533: mpf x, y;
! 2534: unsigned long prec;
! 2535: CODE:
! 2536: TRACE (printf ("%s eq\n", mpf_class));
! 2537: COERCE_MPF_PAIR (prec, x,xv, y,yv);
! 2538: RETVAL = mpf_eq (x, y, bits);
! 2539: OUTPUT:
! 2540: RETVAL
! 2541:
! 2542:
! 2543: mpf
! 2544: reldiff (xv, yv)
! 2545: SV *xv
! 2546: SV *yv
! 2547: PREINIT:
! 2548: mpf x, y;
! 2549: unsigned long prec;
! 2550: CODE:
! 2551: TRACE (printf ("%s reldiff\n", mpf_class));
! 2552: COERCE_MPF_PAIR (prec, x,xv, y,yv);
! 2553: RETVAL = new_mpf (prec);
! 2554: mpf_reldiff (RETVAL, x, y);
! 2555: OUTPUT:
! 2556: RETVAL
! 2557:
! 2558:
! 2559: void
! 2560: set_default_prec (prec)
! 2561: ulong_coerce prec
! 2562: CODE:
! 2563: TRACE (printf ("%s set_default_prec %lu\n", mpf_class, prec));
! 2564: mpf_set_default_prec (prec);
! 2565:
! 2566:
! 2567: void
! 2568: set_prec (sv, prec)
! 2569: SV *sv
! 2570: ulong_coerce prec
! 2571: PREINIT:
! 2572: mpf_ptr old_f, new_f;
! 2573: CODE:
! 2574: TRACE (printf ("%s set_prec to %lu\n", mpf_class, prec));
! 2575: if (SvROK (sv) && sv_derived_from (sv, mpf_class))
! 2576: {
! 2577: old_f = SvMPF(sv);
! 2578: if (SvREFCNT(SvRV(sv)) == 1)
! 2579: mpf_set_prec (old_f, prec);
! 2580: else
! 2581: {
! 2582: TRACE (printf (" fork new mpf\n"));
! 2583: new_f = new_mpf (prec);
! 2584: mpf_set (new_f, old_f);
! 2585: goto setref;
! 2586: }
! 2587: }
! 2588: else
! 2589: {
! 2590: TRACE (printf (" coerce to mpf\n"));
! 2591: new_f = new_mpf (prec);
! 2592: my_mpf_set_sv (new_f, sv);
! 2593: setref:
! 2594: sv_setref_pv (sv, mpf_class, new_f);
! 2595: }
! 2596:
! 2597:
! 2598:
! 2599: #------------------------------------------------------------------------------
! 2600:
! 2601: MODULE = GMP PACKAGE = GMP::Rand
! 2602:
! 2603: randstate
! 2604: new (...)
! 2605: ALIAS:
! 2606: GMP::Rand::randstate = 1
! 2607: CODE:
! 2608: TRACE (printf ("%s new\n", rand_class));
! 2609: New (GMP_MALLOC_ID, RETVAL, 1, __gmp_randstate_struct);
! 2610: TRACE (printf (" RETVAL %p\n", RETVAL));
! 2611: assert_support (rand_count++);
! 2612: TRACE_ACTIVE ();
! 2613:
! 2614: if (items == 0)
! 2615: {
! 2616: gmp_randinit_default (RETVAL);
! 2617: }
! 2618: else
! 2619: {
! 2620: STRLEN len;
! 2621: const char *method = SvPV (ST(0), len);
! 2622: assert (len == strlen (method));
! 2623: if (strcmp (method, "lc_2exp") == 0)
! 2624: {
! 2625: if (items != 4)
! 2626: goto invalid;
! 2627: gmp_randinit_lc_2exp (RETVAL,
! 2628: coerce_mpz (tmp_mpz_0, ST(1)),
! 2629: coerce_ulong (ST(2)),
! 2630: coerce_ulong (ST(3)));
! 2631: }
! 2632: else if (strcmp (method, "lc_2exp_size") == 0)
! 2633: {
! 2634: if (items != 2)
! 2635: goto invalid;
! 2636: if (! gmp_randinit_lc_2exp_size (RETVAL, coerce_ulong (ST(1))))
! 2637: {
! 2638: Safefree (RETVAL);
! 2639: XSRETURN_UNDEF;
! 2640: }
! 2641: }
! 2642: else
! 2643: {
! 2644: invalid:
! 2645: croak ("%s new: invalid arguments", rand_class);
! 2646: }
! 2647: }
! 2648: OUTPUT:
! 2649: RETVAL
! 2650:
! 2651:
! 2652: void
! 2653: DESTROY (r)
! 2654: randstate r
! 2655: CODE:
! 2656: TRACE (printf ("%s DESTROY\n", rand_class));
! 2657: gmp_randclear (r);
! 2658: Safefree (r);
! 2659: assert_support (rand_count--);
! 2660: TRACE_ACTIVE ();
! 2661:
! 2662:
! 2663: void
! 2664: seed (r, z)
! 2665: randstate r
! 2666: mpz_coerce z
! 2667: CODE:
! 2668: gmp_randseed (r, z);
! 2669:
! 2670:
! 2671: mpz
! 2672: mpz_urandomb (r, bits)
! 2673: randstate r
! 2674: ulong_coerce bits
! 2675: ALIAS:
! 2676: GMP::Rand::mpz_rrandomb = 1
! 2677: PREINIT:
! 2678: static const struct {
! 2679: void (*fun) (mpz_ptr, gmp_randstate_t r, unsigned long bits);
! 2680: } table[] = {
! 2681: { mpz_urandomb }, /* 0 */
! 2682: { mpz_rrandomb }, /* 1 */
! 2683: };
! 2684: CODE:
! 2685: assert_table (ix);
! 2686: RETVAL = new_mpz();
! 2687: (*table[ix].fun) (RETVAL->m, r, bits);
! 2688: OUTPUT:
! 2689: RETVAL
! 2690:
! 2691:
! 2692: mpz
! 2693: mpz_urandomm (r, m)
! 2694: randstate r
! 2695: mpz_coerce m
! 2696: CODE:
! 2697: RETVAL = new_mpz();
! 2698: mpz_urandomm (RETVAL->m, r, m);
! 2699: OUTPUT:
! 2700: RETVAL
! 2701:
! 2702:
! 2703: mpf
! 2704: mpf_urandomb (r, bits)
! 2705: randstate r
! 2706: ulong_coerce bits
! 2707: CODE:
! 2708: RETVAL = new_mpf (bits);
! 2709: mpf_urandomb (RETVAL, r, bits);
! 2710: OUTPUT:
! 2711: RETVAL
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to GMP.xs CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / gmp / demos / perl