开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 数值算法/人工智能 > 数学计算 > 查看源码
GMP.xs
资源名称：gmp-5.0.1.tar.gz　[点击查看]
上传用户：qaz666999
上传日期：2022-08-06
资源大小：2570k
文件大小：71k
源码类别：

数学计算

开发平台：

Unix_Linux

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