![[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|
Return to GMP.xs CVS log | Up to [local] / OpenXM_contrib / gmp / demos / perl |
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