1
/* GMP module external subroutines.
3
Copyright 2001 Free Software Foundation, Inc.
5
This file is part of the GNU MP Library.
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.
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.
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. */
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.
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.
35
Mixed-type swapped-order assignments like "$a = 123; $a += mpz(456);"
36
invoke the plain overloaded "+", not "+=", which makes life easier.
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
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.
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.
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
57
Should IV's and/or NV's be identified with the same dual test as for
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? */
65
/* Comment this out to get assertion checking. */
68
/* Change this to "#define TRACE(x) x" for some diagnostics. */
78
#include "patchlevel.h"
83
/* Code which doesn't check anything itself, but exists to support other
86
#define assert_support(x)
88
#define assert_support(x) x
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
99
#define GMP_MALLOC_ID 42
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";
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;)
112
#define TRACE_ACTIVE() \
114
(TRACE (printf (" active %ld mpz, %ld mpq, %ld mpf, %ld randstate\n", \
115
mpz_count, mpq_count, mpf_count, rand_count)))
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. */
121
#define CREATE_MPX(type) \
123
/* must have mpz_t etc first, for sprintf below */ \
124
struct type##_elem { \
126
struct type##_elem *next; \
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; \
133
static type type##_freelist = NULL; \
139
TRACE (printf ("new %s\n", type##_class)); \
140
if (type##_freelist != NULL) \
142
p = type##_freelist; \
143
type##_freelist = type##_freelist->next; \
147
New (GMP_MALLOC_ID, p, 1, struct type##_elem); \
148
type##_init (p->m); \
150
TRACE (printf (" p=%p\n", p)); \
151
assert_support (type##_count++); \
160
typedef mpf_ptr mpf_assume;
161
typedef mpf_ptr mpf_coerce_st0;
162
typedef mpf_ptr mpf_coerce_def;
166
new_mpf (unsigned long prec)
169
New (GMP_MALLOC_ID, p, 1, __mpf_struct);
171
TRACE (printf (" mpf p=%p\n", p));
172
assert_support (mpf_count++);
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. */
181
struct tmp_mpf_struct {
183
unsigned long allocated_prec;
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];
189
#define tmp_mpf_init(f) \
192
f->allocated_prec = mpf_get_prec (f->m); \
196
tmp_mpf_grow (tmp_mpf_ptr f, unsigned long prec)
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);
203
#define tmp_mpf_shrink(f) tmp_mpf_grow (f, 1L)
205
#define tmp_mpf_set_prec(f,prec) \
207
if (prec > f->allocated_prec) \
208
tmp_mpf_grow (f, prec); \
210
mpf_set_prec_raw (f->m, prec); \
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;
219
#define FREE_MPX_FREELIST(p,type) \
221
TRACE (printf ("free %s\n", type##_class)); \
222
p->next = type##_freelist; \
223
type##_freelist = p; \
224
assert_support (type##_count--); \
226
assert (type##_count >= 0); \
229
/* this version for comparison, if desired */
230
#define FREE_MPX_NOFREELIST(p,type) \
232
TRACE (printf ("free %s\n", type##_class)); \
233
type##_clear (p->m); \
235
assert_support (type##_count--); \
237
assert (type##_count >= 0); \
240
#define free_mpz(z) FREE_MPX_FREELIST (z, mpz)
241
#define free_mpq(q) FREE_MPX_FREELIST (q, mpq)
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;
251
typedef SV *SV_copy_0;
252
typedef unsigned long ulong_coerce;
253
typedef __gmp_randstate_struct *randstate;
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)
261
#define MPX_ASSUME(x,sv,type) \
263
assert (sv_derived_from (sv, type##_class)); \
264
x = SvMPX(sv,type); \
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)
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))
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)
283
#define assert_table(ix) assert (ix >= 0 && ix < numberof (table))
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)
290
#define SvPOKorp(sv) (SvPOK(sv) || SvPOKp(sv))
293
class_or_croak (SV *sv, classconst char *class)
295
if (! sv_derived_from (sv, class))
296
croak("not type %s", class);
300
/* These are macros, wrap them in functions. */
302
x_mpz_odd_p (mpz_srcptr z)
304
return mpz_odd_p (z);
307
x_mpz_even_p (mpz_srcptr z)
309
return mpz_even_p (z);
313
x_mpq_pow_ui (mpq_ptr r, mpq_srcptr b, unsigned long e)
315
mpz_pow_ui (mpq_numref(r), mpq_numref(b), e);
316
mpz_pow_ui (mpq_denref(r), mpq_denref(b), e);
321
my_gmp_alloc (size_t n)
324
TRACE (printf ("my_gmp_alloc %u\n", n));
325
New (GMP_MALLOC_ID, p, n, char);
326
TRACE (printf (" p=%p\n", p));
331
my_gmp_realloc (void *p, size_t oldsize, size_t newsize)
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));
340
my_gmp_free (void *p, size_t n)
342
TRACE (printf ("my_gmp_free %p %u\n", p, n));
347
#define my_mpx_set_svstr(type) \
349
my_##type##_set_svstr (type##_ptr x, SV *sv) \
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); \
361
my_mpx_set_svstr(mpz)
362
my_mpx_set_svstr(mpq)
363
my_mpx_set_svstr(mpf)
368
x_mpq_cmp_si (mpq_srcptr x, long yn, unsigned long yd)
373
mpq_set_si (y->m, yn, yd);
374
ret = mpq_cmp (x, y->m);
380
x_mpq_fits_slong_p (mpq_srcptr q)
382
return x_mpq_cmp_si (q, LONG_MIN, 1L) >= 0
383
&& mpq_cmp_ui (q, LONG_MAX, 1L) <= 0;
387
x_mpz_cmp_q (mpz_ptr x, mpq_srcptr y)
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);
398
x_mpz_cmp_f (mpz_srcptr x, mpf_srcptr y)
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);
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). */
410
coerce_mpz (mpz_ptr tmp, SV *sv)
414
mpz_set_si (tmp, SvIVX(sv));
419
my_mpz_set_svstr (tmp, sv);
424
double d = SvNVX(sv);
425
if (! double_integer_p (d))
426
croak ("cannot coerce non-integer double to mpz");
432
if (sv_derived_from (sv, mpz_class))
436
if (sv_derived_from (sv, mpq_class))
439
if (! x_mpq_integer_p (q->m))
440
croak ("cannot coerce non-integer mpq to mpz");
441
return mpq_numref(q->m);
443
if (sv_derived_from (sv, mpf_class))
446
if (! mpf_integer_p (f))
447
croak ("cannot coerce non-integer mpf to mpz");
452
croak ("cannot coerce to mpz");
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. */
459
coerce_mpq (mpq_ptr tmp, SV *sv)
463
mpq_set_si (tmp, SvIVX(sv), 1L);
468
mpq_set_d (tmp, SvNVX(sv));
473
my_mpq_set_svstr (tmp, sv);
478
if (sv_derived_from (sv, mpz_class))
480
mpq_set_z (tmp, SvMPZ(sv)->m);
483
if (sv_derived_from (sv, mpq_class))
487
if (sv_derived_from (sv, mpf_class))
489
mpq_set_f (tmp, SvMPF(sv));
493
croak ("cannot coerce to mpq");
498
my_mpf_set_sv (mpf_ptr f, SV *sv)
501
mpf_set_si (f, SvIVX(sv));
502
else if (SvPOKorp(sv))
503
my_mpf_set_svstr (f, sv);
505
mpf_set_d (f, SvNVX(sv));
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));
520
croak ("cannot coerce to mpf");
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). */
527
coerce_mpf (tmp_mpf_ptr tmp, SV *sv, unsigned long prec)
529
if (SvROK(sv) && sv_derived_from (sv, mpf_class))
532
tmp_mpf_set_prec (tmp, prec);
533
my_mpf_set_sv (tmp->m, sv);
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) \
543
if (SvROK(xv) && sv_derived_from (xv, mpf_class)) \
546
prec = mpf_get_prec (x); \
547
y = coerce_mpf (tmp_mpf_0, yv, prec); \
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); \
559
coerce_ulong (SV *sv)
569
croak ("out of range for ulong");
575
double d = SvNVX(sv);
576
if (! double_integer_p (d))
579
croak ("not an integer");
591
if (sv_derived_from (sv, mpz_class))
594
if (! mpz_fits_ulong_p (z->m))
596
return mpz_get_ui (z->m);
598
if (sv_derived_from (sv, mpq_class))
601
if (! x_mpq_integer_p (q->m))
603
if (! mpz_fits_ulong_p (mpq_numref (q->m)))
605
return mpz_get_ui (mpq_numref (q->m));
607
if (sv_derived_from (sv, mpf_class))
610
if (! mpf_integer_p (f))
612
if (! mpf_fits_ulong_p (f))
614
return mpf_get_ui (f);
617
croak ("cannot coerce to ulong");
629
double d = SvNVX(sv);
630
if (! double_integer_p (d))
633
croak ("not an integer");
643
if (sv_derived_from (sv, mpz_class))
646
if (! mpz_fits_slong_p (z->m))
649
croak ("out of range for ulong");
651
return mpz_get_si (z->m);
653
if (sv_derived_from (sv, mpq_class))
656
if (! x_mpq_integer_p (q->m))
658
if (! mpz_fits_slong_p (mpq_numref (q->m)))
660
return mpz_get_si (mpq_numref (q->m));
662
if (sv_derived_from (sv, mpf_class))
665
if (! mpf_integer_p (f))
667
if (! mpf_fits_slong_p (f))
669
return mpf_get_si (f);
672
croak ("cannot coerce to long");
676
#define mpx_set_maybe(dst,src,type) \
677
do { if ((dst) != (src)) type##_set (dst, src); } while (0)
679
#define coerce_mpx_into(p,sv,type) \
681
type##_ptr __new_p = coerce_##type (p, sv); \
682
mpx_set_maybe (p, __new_p, type); \
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)
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. */
698
TRACE (printf ("mutate_mpz %p\n", sv));
699
TRACE (printf (" type %d\n", SvTYPE(sv)));
701
if (SvROK (sv) && sv_derived_from (sv, mpz_class))
704
if (SvREFCNT(SvRV(sv)) == 1)
707
TRACE (printf ("mutate_mpz(): forking new mpz\n"));
709
mpz_set (new_z->m, old_z->m);
713
TRACE (printf ("mutate_mpz(): coercing new mpz\n"));
715
coerce_mpz_into (new_z->m, sv);
717
sv_setref_pv (sv, mpz_class, new_z);
722
/* ------------------------------------------------------------------------- */
724
MODULE = GMP PACKAGE = GMP
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);
741
TRACE (printf ("GMP end\n"));
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); */
753
RETVAL = gmp_version;
768
double d = SvNVX(sv);
769
RETVAL = (d >= LONG_MIN && d <= LONG_MAX);
771
else if (SvPOKorp(sv))
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);
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);
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));
800
croak ("GMP::fits_slong_p invalid argument");
811
RETVAL = (double) SvIVX(sv);
814
else if (SvPOKorp(sv))
817
RETVAL = atof(SvPV(sv, len));
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));
833
croak ("GMP::get_d invalid argument");
846
RETVAL = (long) SvNVX(sv);
847
else if (SvPOKorp(sv))
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))
855
mpz_set_q (tmp_mpz_0, SvMPQ(sv)->m);
856
RETVAL = mpz_get_si (tmp_mpz_0);
858
else if (sv_derived_from (sv, mpf_class))
859
RETVAL = mpf_get_si (SvMPF(sv));
866
croak ("GMP::get_si invalid argument");
884
TRACE (printf ("GMP::get_str\n"));
887
base = coerce_long (ST(1));
890
TRACE (printf (" base=%d\n", base));
893
ndigits = coerce_long (ST(2));
896
TRACE (printf (" ndigits=%d\n", ndigits));
902
mpz_set_si (tmp_mpz_0, SvIVX(sv));
908
/* only digits in the original double, not in the coerced form */
911
mpf_set_d (tmp_mpf_0->m, SvNVX(sv));
915
else if (SvPOKorp(sv))
917
/* get_str on a string is not much more than a base conversion */
919
str = SvPV (sv, len);
920
if (mpz_set_str (tmp_mpz_0, str, 0) == 0)
925
else if (mpq_set_str (tmp_mpq_0, str, 0) == 0)
932
/* FIXME: Would like perhaps a precision equivalent to the
933
number of significant digits of the string, in its given
935
tmp_mpf_set_prec (tmp_mpf_0, strlen(str));
936
if (mpf_set_str (tmp_mpf_0->m, str, 10) == 0)
942
croak ("GMP::get_str invalid string format");
947
if (sv_derived_from (sv, mpz_class))
951
str = mpz_get_str (NULL, base, z);
953
PUSHs (sv_2mortal (newSVpv (str, 0)));
955
else if (sv_derived_from (sv, mpq_class))
959
str = mpq_get_str (NULL, base, q);
962
else if (sv_derived_from (sv, mpf_class))
966
str = mpf_get_str (NULL, &exp, base, 0, f);
967
PUSHs (sv_2mortal (newSVpv (str, 0)));
968
PUSHs (sv_2mortal (newSViv (exp)));
976
croak ("GMP::get_str invalid argument");
987
RETVAL = double_integer_p (SvNVX(sv));
988
else if (SvPOKorp(sv))
990
/* FIXME: Maybe this should be done by parsing the string, not by an
991
actual conversion. */
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);
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);
1003
croak ("GMP::integer_p invalid string format");
1008
if (sv_derived_from (sv, mpz_class))
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));
1020
croak ("GMP::integer_p invalid argument");
1031
RETVAL = SGN (SvIVX(sv));
1033
RETVAL = SGN (SvNVX(sv));
1034
else if (SvPOKorp(sv))
1036
/* FIXME: Maybe this should be done by parsing the string, not by an
1037
actual conversion. */
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);
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);
1049
croak ("GMP::sgn invalid string format");
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));
1066
croak ("GMP::sgn invalid argument");
1072
# currently undocumented
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))
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);
1092
sprintf_internal (fmt, sv)
1096
assert (strlen (fmt) >= 3);
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)));
1105
/* cheat a bit here, SvMPZ works for mpq and mpf too */
1106
gmp_asprintf (&RETVAL, fmt, SvMPZ(sv));
1108
TRACE (printf (" result |%s|\n", RETVAL));
1114
#------------------------------------------------------------------------------
1116
MODULE = GMP PACKAGE = GMP::Mpz
1125
TRACE (printf ("%s new, ix=%ld, items=%d\n", mpz_class, ix, items));
1130
mpz_set_ui (RETVAL->m, 0L);
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);
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));
1153
croak ("%s new: invalid arguments", mpz_class);
1160
overload_constant (str, pv, d1, ...)
1161
const_string_assume str
1167
TRACE (printf ("%s constant: %s\n", mpz_class, str));
1169
if (mpz_set_str (z->m, str, 0) == 0)
1171
SV *sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, z); PUSHs(sv);
1181
overload_copy (z, d1, d2)
1187
mpz_set (RETVAL->m, z->m);
1196
TRACE (printf ("%s DESTROY %p\n", mpz_class, z));
1201
overload_string (z, d1, d2)
1206
TRACE (printf ("%s overload_string %p\n", mpz_class, z));
1207
RETVAL = mpz_get_str (NULL, 10, z->m);
1213
overload_add (xv, yv, order)
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
1226
static const struct {
1227
void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
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 */
1240
if (order == &PL_sv_yes)
1241
SV_PTR_SWAP (xv, yv);
1243
(*table[ix].op) (RETVAL->m,
1244
coerce_mpz (tmp_mpz_0, xv),
1245
coerce_mpz (tmp_mpz_1, yv));
1251
overload_addeq (x, y, o)
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
1264
static const struct {
1265
void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
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 */
1278
(*table[ix].op) (x->m, x->m, y);
1283
overload_lshift (zv, nv, order)
1288
GMP::Mpz::overload_rshift = 1
1289
GMP::Mpz::overload_pow = 2
1291
static const struct {
1292
void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
1294
{ mpz_mul_2exp }, /* 0 */
1295
{ mpz_div_2exp }, /* 1 */
1296
{ mpz_pow_ui }, /* 2 */
1300
if (order == &PL_sv_yes)
1301
SV_PTR_SWAP (zv, nv);
1303
(*table[ix].op) (RETVAL->m, coerce_mpz (RETVAL->m, zv), coerce_ulong (nv));
1309
overload_lshifteq (z, n, o)
1314
GMP::Mpz::overload_rshifteq = 1
1315
GMP::Mpz::overload_poweq = 2
1317
static const struct {
1318
void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
1320
{ mpz_mul_2exp }, /* 0 */
1321
{ mpz_div_2exp }, /* 1 */
1322
{ mpz_pow_ui }, /* 2 */
1326
(*table[ix].op) (z->m, z->m, n);
1331
overload_abs (z, d1, d2)
1336
GMP::Mpz::overload_neg = 1
1337
GMP::Mpz::overload_com = 2
1338
GMP::Mpz::overload_sqrt = 3
1340
static const struct {
1341
void (*op) (mpz_ptr w, mpz_srcptr x);
1343
{ mpz_abs }, /* 0 */
1344
{ mpz_neg }, /* 1 */
1345
{ mpz_com }, /* 2 */
1346
{ mpz_sqrt }, /* 3 */
1351
(*table[ix].op) (RETVAL->m, z->m);
1357
overload_inc (z, d1, d2)
1362
GMP::Mpz::overload_dec = 1
1364
static const struct {
1365
void (*op) (mpz_ptr w, mpz_srcptr x, unsigned long y);
1367
{ mpz_add_ui }, /* 0 */
1368
{ mpz_sub_ui }, /* 1 */
1372
(*table[ix].op) (z->m, z->m, 1L);
1376
overload_spaceship (xv, yv, order)
1383
TRACE (printf ("%s overload_spaceship\n", mpz_class));
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));
1390
RETVAL = mpz_cmp_d (x->m, SvNVX(yv));
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));
1405
croak ("%s <=>: invalid operand", mpz_class);
1407
RETVAL = SGN (RETVAL);
1408
if (order == &PL_sv_yes)
1415
overload_bool (z, d1, d2)
1420
GMP::Mpz::overload_not = 1
1422
RETVAL = (mpz_sgn (z->m) != 0) ^ ix;
1434
/* mpz_root returns an int, hence the cast */
1435
static const struct {
1436
void (*op) (mpz_ptr, mpz_srcptr, unsigned long);
1438
{ mpz_bin_ui }, /* 0 */
1439
{ (void (*)(mpz_ptr, mpz_srcptr, unsigned long)) mpz_root }, /* 1 */
1444
(*table[ix].op) (RETVAL->m, n, k);
1457
static const struct {
1458
void (*op) (mpz_ptr, mpz_ptr, mpz_srcptr, mpz_srcptr);
1460
{ mpz_cdiv_qr }, /* 0 */
1461
{ mpz_fdiv_qr }, /* 1 */
1462
{ mpz_tdiv_qr }, /* 2 */
1470
(*table[ix].op) (q->m, r->m, a, d);
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);
1481
GMP::Mpz::fdiv_2exp = 1
1482
GMP::Mpz::tdiv_2exp = 2
1484
static const struct {
1485
void (*q) (mpz_ptr, mpz_srcptr, unsigned long);
1486
void (*r) (mpz_ptr, mpz_srcptr, unsigned long);
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 */
1498
(*table[ix].q) (q->m, a, d);
1499
(*table[ix].r) (r->m, a, d);
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);
1506
congruent_p (a, c, d)
1512
RETVAL = mpz_congruent_p (a, c, d);
1518
congruent_2exp_p (a, c, d)
1524
RETVAL = mpz_congruent_2exp_p (a, c, d);
1536
static const struct {
1537
void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
1539
{ mpz_divexact }, /* 0 */
1540
{ mpz_mod }, /* 1 */
1545
(*table[ix].op) (RETVAL->m, a, d);
1555
RETVAL = mpz_divisible_p (a, d);
1561
divisible_2exp_p (a, d)
1565
RETVAL = mpz_divisible_2exp_p (a, d);
1575
GMP::Mpz::perfect_square_p = 2
1576
GMP::Mpz::perfect_power_p = 3
1578
static const struct {
1579
int (*op) (mpz_srcptr z);
1581
{ x_mpz_even_p }, /* 0 */
1582
{ x_mpz_odd_p }, /* 1 */
1583
{ mpz_perfect_square_p }, /* 2 */
1584
{ mpz_perfect_power_p }, /* 3 */
1588
RETVAL = (*table[ix].op) (z);
1598
GMP::Mpz::lucnum = 2
1600
static const struct {
1601
void (*op) (mpz_ptr r, unsigned long n);
1603
{ mpz_fac_ui }, /* 0 */
1604
{ mpz_fib_ui }, /* 1 */
1605
{ mpz_lucnum_ui }, /* 2 */
1610
(*table[ix].op) (RETVAL->m, n);
1619
GMP::Mpz::lucnum2 = 1
1621
static const struct {
1622
void (*op) (mpz_ptr r, mpz_ptr r2, unsigned long n);
1624
{ mpz_fib2_ui }, /* 0 */
1625
{ mpz_lucnum2_ui }, /* 1 */
1633
(*table[ix].op) (r->m, r2->m, n);
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);
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);
1649
/* cast to ignore ulong return from mpz_gcd_ui */
1651
(void (*) (mpz_ptr, mpz_srcptr, unsigned long)) mpz_gcd_ui }, /* 0 */
1652
{ mpz_lcm, mpz_lcm_ui }, /* 1 */
1660
mpz_set (RETVAL->m, x);
1663
for (i = 1; i < items; i++)
1667
(*table[ix].op_ui) (RETVAL->m, x, ABS(SvIVX(yv)));
1669
(*table[ix].op) (RETVAL->m, x, coerce_mpz (tmp_mpz_1, yv));
1688
mpz_gcdext (g->m, x->m, y->m, a, b);
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);
1700
RETVAL = mpz_hamdist (x, y);
1711
if (! mpz_invert (RETVAL->m, a, m))
1725
RETVAL = mpz_jacobi (a, b);
1736
RETVAL = mpz_kronecker_si (coerce_mpz(tmp_mpz_0,a), SvIVX(b));
1738
RETVAL = mpz_si_kronecker (SvIVX(a), coerce_mpz(tmp_mpz_0,b));
1740
RETVAL = mpz_kronecker (coerce_mpz(tmp_mpz_0,a),
1741
coerce_mpz(tmp_mpz_1,b));
1751
mpz_nextprime (RETVAL->m, z);
1760
RETVAL = mpz_popcount (x);
1772
mpz_powm (RETVAL->m, b, e, m);
1778
probab_prime_p (z, n)
1782
RETVAL = mpz_probab_prime_p (z, n);
1787
# No attempt to coerce here, only an mpz makes sense.
1793
_mpz_realloc (z->m, limbs);
1807
mult = mpz_remove (rem->m, z, f);
1809
sv = sv_newmortal(); sv_setref_pv (sv, mpz_class, rem); PUSHs(sv);
1810
PUSHs (sv_2mortal (newSViv (mult)));
1823
exact = mpz_root (root->m, z, n);
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);
1836
static const struct {
1837
unsigned long (*op) (mpz_srcptr, unsigned long);
1839
{ mpz_scan0 }, /* 0 */
1840
{ mpz_scan1 }, /* 1 */
1844
RETVAL = (*table[ix].op) (z, start);
1854
GMP::Mpz::clrbit = 1
1856
static const struct {
1857
void (*op) (mpz_ptr, unsigned long);
1859
{ mpz_setbit }, /* 0 */
1860
{ mpz_clrbit }, /* 1 */
1863
TRACE (printf ("%s %s\n", mpz_class, (ix==0 ? "setbit" : "clrbit")));
1864
assert (SvROK(ST(0)) && SvREFCNT(SvRV(ST(0))) == 1);
1866
(*table[ix].op) (z, bit);
1879
mpz_sqrtrem (root->m, rem->m, z);
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);
1886
sizeinbase (z, base)
1890
RETVAL = mpz_sizeinbase (z, base);
1900
RETVAL = mpz_tstbit (z, bit);
1906
#------------------------------------------------------------------------------
1908
MODULE = GMP PACKAGE = GMP::Mpq
1917
TRACE (printf ("%s new\n", mpq_class));
1922
mpq_set_ui (RETVAL->m, 0L, 1L);
1925
coerce_mpq_into (RETVAL->m, ST(0));
1928
coerce_mpz_into (mpq_numref(RETVAL->m), ST(0));
1929
coerce_mpz_into (mpq_denref(RETVAL->m), ST(1));
1932
croak ("%s new: invalid arguments", mpq_class);
1939
overload_constant (str, pv, d1, ...)
1940
const_string_assume str
1947
TRACE (printf ("%s constant: %s\n", mpq_class, str));
1949
if (mpq_set_str (q->m, str, 0) == 0)
1950
{ sv = sv_newmortal(); sv_setref_pv (sv, mpq_class, q); }
1952
{ free_mpq (q); sv = pv; }
1957
overload_copy (q, d1, d2)
1963
mpq_set (RETVAL->m, q->m);
1972
TRACE (printf ("%s DESTROY %p\n", mpq_class, q));
1977
overload_string (q, d1, d2)
1982
TRACE (printf ("%s overload_string %p\n", mpq_class, q));
1983
RETVAL = mpq_get_str (NULL, 10, q->m);
1989
overload_add (xv, yv, order)
1994
GMP::Mpq::overload_sub = 1
1995
GMP::Mpq::overload_mul = 2
1996
GMP::Mpq::overload_div = 3
1998
static const struct {
1999
void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
2001
{ mpq_add }, /* 0 */
2002
{ mpq_sub }, /* 1 */
2003
{ mpq_mul }, /* 2 */
2004
{ mpq_div }, /* 3 */
2007
TRACE (printf ("%s binary\n", mpf_class));
2009
if (order == &PL_sv_yes)
2010
SV_PTR_SWAP (xv, yv);
2012
(*table[ix].op) (RETVAL->m,
2013
coerce_mpq (tmp_mpq_0, xv),
2014
coerce_mpq (tmp_mpq_1, yv));
2020
overload_addeq (x, y, o)
2025
GMP::Mpq::overload_subeq = 1
2026
GMP::Mpq::overload_muleq = 2
2027
GMP::Mpq::overload_diveq = 3
2029
static const struct {
2030
void (*op) (mpq_ptr, mpq_srcptr, mpq_srcptr);
2032
{ mpq_add }, /* 0 */
2033
{ mpq_sub }, /* 1 */
2034
{ mpq_mul }, /* 2 */
2035
{ mpq_div }, /* 3 */
2039
(*table[ix].op) (x->m, x->m, y);
2044
overload_lshift (qv, nv, order)
2049
GMP::Mpq::overload_rshift = 1
2050
GMP::Mpq::overload_pow = 2
2052
static const struct {
2053
void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
2055
{ mpq_mul_2exp }, /* 0 */
2056
{ mpq_div_2exp }, /* 1 */
2057
{ x_mpq_pow_ui }, /* 2 */
2061
if (order == &PL_sv_yes)
2062
SV_PTR_SWAP (qv, nv);
2064
(*table[ix].op) (RETVAL->m, coerce_mpq (RETVAL->m, qv), coerce_ulong (nv));
2070
overload_lshifteq (q, n, o)
2075
GMP::Mpq::overload_rshifteq = 1
2076
GMP::Mpq::overload_poweq = 2
2078
static const struct {
2079
void (*op) (mpq_ptr, mpq_srcptr, unsigned long);
2081
{ mpq_mul_2exp }, /* 0 */
2082
{ mpq_div_2exp }, /* 1 */
2083
{ x_mpq_pow_ui }, /* 2 */
2087
(*table[ix].op) (q->m, q->m, n);
2092
overload_inc (q, d1, d2)
2097
GMP::Mpq::overload_dec = 1
2099
static const struct {
2100
void (*op) (mpz_ptr, mpz_srcptr, mpz_srcptr);
2102
{ mpz_add }, /* 0 */
2103
{ mpz_sub }, /* 1 */
2107
(*table[ix].op) (mpq_numref(q->m), mpq_numref(q->m), mpq_denref(q->m));
2111
overload_abs (q, d1, d2)
2116
GMP::Mpq::overload_neg = 1
2118
static const struct {
2119
void (*op) (mpq_ptr w, mpq_srcptr x);
2121
{ mpq_abs }, /* 0 */
2122
{ mpq_neg }, /* 1 */
2127
(*table[ix].op) (RETVAL->m, q->m);
2133
overload_spaceship (x, y, order)
2138
RETVAL = mpq_cmp (x->m, y);
2139
RETVAL = SGN (RETVAL);
2140
if (order == &PL_sv_yes)
2147
overload_bool (q, d1, d2)
2152
GMP::Mpq::overload_not = 1
2154
RETVAL = (mpq_sgn (q->m) != 0) ^ ix;
2160
overload_eq (x, yv, d)
2165
GMP::Mpq::overload_ne = 1
2168
RETVAL = x_mpq_equal_si (x->m, SvIVX(yv), 1L);
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);
2181
RETVAL = mpq_equal (x->m, coerce_mpq (tmp_mpq_0, yv));
2192
mpq_canonicalize (q->m);
2200
mpq_inv (RETVAL->m, q);
2212
mpz_set (RETVAL->m, (ix == 0 ? mpq_numref(q->m) : mpq_denref(q->m)));
2218
#------------------------------------------------------------------------------
2220
MODULE = GMP PACKAGE = GMP::Mpf
2230
TRACE (printf ("%s new\n", mpf_class));
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);
2236
my_mpf_set_sv (RETVAL, ST(0));
2242
overload_constant (sv, d1, d2, ...)
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);
2258
overload_copy (f, d1, d2)
2263
TRACE (printf ("%s copy\n", mpf_class));
2264
RETVAL = new_mpf (mpf_get_prec (f));
2265
mpf_set (RETVAL, f);
2274
TRACE (printf ("%s DESTROY %p\n", mpf_class, f));
2277
assert_support (mpf_count--);
2282
overload_add (x, y, order)
2287
GMP::Mpf::overload_sub = 1
2288
GMP::Mpf::overload_mul = 2
2289
GMP::Mpf::overload_div = 3
2291
static const struct {
2292
void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
2294
{ mpf_add }, /* 0 */
2295
{ mpf_sub }, /* 1 */
2296
{ mpf_mul }, /* 2 */
2297
{ mpf_div }, /* 3 */
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);
2311
overload_addeq (x, y, o)
2316
GMP::Mpf::overload_subeq = 1
2317
GMP::Mpf::overload_muleq = 2
2318
GMP::Mpf::overload_diveq = 3
2320
static const struct {
2321
void (*op) (mpf_ptr, mpf_srcptr, mpf_srcptr);
2323
{ mpf_add }, /* 0 */
2324
{ mpf_sub }, /* 1 */
2325
{ mpf_mul }, /* 2 */
2326
{ mpf_div }, /* 3 */
2330
(*table[ix].op) (x, x, y);
2335
overload_lshift (fv, nv, order)
2340
GMP::Mpf::overload_rshift = 1
2341
GMP::Mpf::overload_pow = 2
2343
static const struct {
2344
void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
2346
{ mpf_mul_2exp }, /* 0 */
2347
{ mpf_div_2exp }, /* 1 */
2348
{ mpf_pow_ui }, /* 2 */
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));
2366
overload_lshifteq (f, n, o)
2371
GMP::Mpf::overload_rshifteq = 1
2372
GMP::Mpf::overload_poweq = 2
2374
static const struct {
2375
void (*op) (mpf_ptr, mpf_srcptr, unsigned long);
2377
{ mpf_mul_2exp }, /* 0 */
2378
{ mpf_div_2exp }, /* 1 */
2379
{ mpf_pow_ui }, /* 2 */
2383
(*table[ix].op) (f, f, n);
2388
overload_abs (f, d1, d2)
2393
GMP::Mpf::overload_neg = 1
2394
GMP::Mpf::overload_sqrt = 2
2396
static const struct {
2397
void (*op) (mpf_ptr w, mpf_srcptr x);
2399
{ mpf_abs }, /* 0 */
2400
{ mpf_neg }, /* 1 */
2401
{ mpf_sqrt }, /* 2 */
2405
RETVAL = new_mpf (mpf_get_prec (f));
2406
(*table[ix].op) (RETVAL, f);
2412
overload_inc (f, d1, d2)
2417
GMP::Mpf::overload_dec = 1
2419
static const struct {
2420
void (*op) (mpf_ptr w, mpf_srcptr x, unsigned long y);
2422
{ mpf_add_ui }, /* 0 */
2423
{ mpf_sub_ui }, /* 1 */
2427
(*table[ix].op) (f, f, 1L);
2431
overload_spaceship (xv, yv, order)
2440
RETVAL = mpf_cmp_si (x, SvIVX(yv));
2442
RETVAL = mpf_cmp_d (x, SvNVX(yv));
2443
else if (SvPOKorp(yv))
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);
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));
2465
RETVAL = mpq_cmp (coerce_mpq (tmp_mpq_0, xv),
2466
coerce_mpq (tmp_mpq_1, yv));
2468
RETVAL = SGN (RETVAL);
2469
if (order == &PL_sv_yes)
2476
overload_bool (f, d1, d2)
2481
GMP::Mpf::overload_not = 1
2483
RETVAL = (mpf_sgn (f) != 0) ^ ix;
2495
static const struct {
2496
void (*op) (mpf_ptr w, mpf_srcptr x);
2498
{ mpf_ceil }, /* 0 */
2499
{ mpf_floor }, /* 1 */
2500
{ mpf_trunc }, /* 2 */
2504
RETVAL = new_mpf (mpf_get_prec (f));
2505
(*table[ix].op) (RETVAL, f);
2513
RETVAL = mpf_get_default_prec();
2522
RETVAL = mpf_get_prec (f);
2528
mpf_eq (xv, yv, bits)
2536
TRACE (printf ("%s eq\n", mpf_class));
2537
COERCE_MPF_PAIR (prec, x,xv, y,yv);
2538
RETVAL = mpf_eq (x, y, bits);
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);
2560
set_default_prec (prec)
2563
TRACE (printf ("%s set_default_prec %lu\n", mpf_class, prec));
2564
mpf_set_default_prec (prec);
2572
mpf_ptr old_f, new_f;
2574
TRACE (printf ("%s set_prec to %lu\n", mpf_class, prec));
2575
if (SvROK (sv) && sv_derived_from (sv, mpf_class))
2578
if (SvREFCNT(SvRV(sv)) == 1)
2579
mpf_set_prec (old_f, prec);
2582
TRACE (printf (" fork new mpf\n"));
2583
new_f = new_mpf (prec);
2584
mpf_set (new_f, old_f);
2590
TRACE (printf (" coerce to mpf\n"));
2591
new_f = new_mpf (prec);
2592
my_mpf_set_sv (new_f, sv);
2594
sv_setref_pv (sv, mpf_class, new_f);
2599
#------------------------------------------------------------------------------
2601
MODULE = GMP PACKAGE = GMP::Rand
2606
GMP::Rand::randstate = 1
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++);
2616
gmp_randinit_default (RETVAL);
2621
const char *method = SvPV (ST(0), len);
2622
assert (len == strlen (method));
2623
if (strcmp (method, "lc_2exp") == 0)
2627
gmp_randinit_lc_2exp (RETVAL,
2628
coerce_mpz (tmp_mpz_0, ST(1)),
2629
coerce_ulong (ST(2)),
2630
coerce_ulong (ST(3)));
2632
else if (strcmp (method, "lc_2exp_size") == 0)
2636
if (! gmp_randinit_lc_2exp_size (RETVAL, coerce_ulong (ST(1))))
2645
croak ("%s new: invalid arguments", rand_class);
2656
TRACE (printf ("%s DESTROY\n", rand_class));
2659
assert_support (rand_count--);
2668
gmp_randseed (r, z);
2672
mpz_urandomb (r, bits)
2676
GMP::Rand::mpz_rrandomb = 1
2678
static const struct {
2679
void (*fun) (mpz_ptr, gmp_randstate_t r, unsigned long bits);
2681
{ mpz_urandomb }, /* 0 */
2682
{ mpz_rrandomb }, /* 1 */
2687
(*table[ix].fun) (RETVAL->m, r, bits);
2698
mpz_urandomm (RETVAL->m, r, m);
2704
mpf_urandomb (r, bits)
2708
RETVAL = new_mpf (bits);
2709
mpf_urandomb (RETVAL, r, bits);
added
removed
gmp3/demos/perl/GMP.xs
