1 #include <stdio.h> 2 #include <stdlib.h> 3 #include <gmp.h> 4 5 #if defined(USE_QUADMATH) 6 #include <quadmath.h> 7 #endif 8 9 #if !defined(__GNU_MP_VERSION) || __GNU_MP_VERSION < 5 10 #define mp_bitcnt_t unsigned long int 11 #endif 12 13 #ifdef _MSC_VER 14 #pragma warning(disable:4700 4715 4716) 15 #endif 16 17 #if defined MATH_GMPZ_NEED_LONG_LONG_INT 18 #ifndef _MSC_VER 19 #include <inttypes.h> 20 #endif 21 #endif 22 23 #ifdef OLDPERL 24 #define SvUOK SvIsUV 25 #endif 26 27 #ifndef Newx 28 # define Newx(v,n,t) New(0,v,n,t) 29 #endif 30 31 #ifndef Newxz 32 # define Newxz(v,n,t) Newz(0,v,n,t) 33 #endif 34 35 #define SV_IS_IOK(x) \ 36 SvIOK(x) 37 38 #define SV_IS_POK(x) \ 39 SvPOK(x) 40 41 #define SV_IS_NOK(x) \ 42 SvNOK(x) 43 44 /* for Math::BigInt overloading */ 45 #define MBI_DECLARATIONS \ 46 mpz_t * mpz = (mpz_t *)NULL; \ 47 const char * sign; \ 48 SV ** sign_key; 49 50 #define VALIDATE_MBI_OBJECT \ 51 sign_key = hv_fetch((HV*)SvRV(b), "sign", 4, 0); \ 52 sign = SvPV_nolen(*sign_key); \ 53 if(strNE("-", sign) && strNE("+", sign)) 54 55 #ifdef ENABLE_MATH_BIGINT_GMP_OVERLOAD /* start ENABLE_MATH_BIGINT_GMP_OVERLOAD */ 56 57 #ifndef PERL_MAGIC_ext 58 # define PERL_MAGIC_ext '~' 59 #endif 60 61 #ifdef sv_magicext 62 # define MATH_GMPz_HAS_MAGICEXT 1 63 #else 64 # define MATH_GMPz_HAS_MAGICEXT 0 65 #endif 66 67 #define MBI_GMP_DECLARATIONS \ 68 const char * h2; \ 69 MAGIC * mg; \ 70 SV ** value_key; 71 72 #if MATH_GMPz_HAS_MAGICEXT 73 74 #define VALUE_TO_MPZ \ 75 for(mg = SvMAGIC(SvRV(*value_key)); mg; mg = mg->mg_moremagic) { \ 76 if(mg->mg_type == PERL_MAGIC_ext) { \ 77 mpz = (mpz_t *)mg->mg_ptr; \ 78 break; \ 79 } \ 80 } 81 82 #else 83 84 #define VALUE_TO_MPZ \ 85 for(mg = SvMAGIC(SvRV(*value_key)); mg; mg = mg->mg_moremagic) { \ 86 if(mg->mg_type == PERL_MAGIC_ext) { \ 87 mpz = INT2PTR(mpz_t *, SvIV((SV *)mg->mg_ptr)); \ 88 break; \ 89 } \ 90 } 91 92 #endif 93 94 #define MBI_GMP_INSERT \ 95 value_key = hv_fetch((HV*)SvRV(b), "value", 5, 0); \ 96 if(sv_isobject(*value_key)) { \ 97 h2 = HvNAME(SvSTASH(SvRV(*value_key))); \ 98 if(strEQ(h2, "Math::BigInt::GMP")) { \ 99 VALUE_TO_MPZ \ 100 } \ 101 } 102 103 104 #else 105 106 #define MBI_GMP_DECLARATIONS 107 #define MBI_GMP_INSERT 108 109 #endif /* end ENABLE_MATH_BIGINT_GMP_OVERLOAD */ 110 111 #define _overload_callback(_1st_arg,_2nd_arg,_3rd_arg) \ 112 dSP; \ 113 SV * ret; \ 114 int count; \ 115 char buf[32]; \ 116 ENTER; \ 117 PUSHMARK(SP); \ 118 XPUSHs(b); \ 119 XPUSHs(a); \ 120 XPUSHs(sv_2mortal(_3rd_arg)); \ 121 PUTBACK; \ 122 sprintf(buf, "%s", _1st_arg); \ 123 count = call_pv(buf, G_SCALAR); \ 124 SPAGAIN; \ 125 if (count != 1) \ 126 croak("Error in %s callback to %s\n", _2nd_arg, _1st_arg); \ 127 ret = POPs; \ 128 SvREFCNT_inc(ret); \ 129 LEAVE; \ 130 return ret 131 132 133 #if defined(_GMP_INDEX_OVERFLOW) && __GNU_MP_VERSION < 7 134 #define CHECK_MP_BITCNT_T_OVERFLOW(x) \ 135 if((mp_bitcnt_t)SvUVX(x) < SvUVX(x)) \ 136 croak("Magnitude of UV argument overflows mp_bitcnt_t"); 137 #else 138 #define CHECK_MP_BITCNT_T_OVERFLOW(x) 139 #endif 140 141 #define RMPZ_IMPORT_UTF8_WARN \ 142 " UTF8 string encountered in Rmpz_import. It will be utf8-downgraded\n\ 143 before being passed to mpz_import, and then will be restored to\n\ 144 its original condition by a utf8::upgrade if:\n\ 145 1) the downgrade was successful\n\ 146 OR\n\ 147 2) $Math::GMPz::utf8_no_croak is set to a true integer value.\n\ 148 Otherwise, a downgrade failure will cause the program to croak\n\ 149 with an explanatory error message.\n\ 150 To disable the croak on downgrade failure set $Math::GMPz::utf8_no_croak to 1.\n\ 151 See the Rmpz_import documentation for a more detailed explanation.\n" 152 153 #define RMPZ_IMPORT_DOWNGRADE_WARN \ 154 " An attempted utf8 downgrade has failed, but you have opted to allow\n\ 155 the Rmpz_import() to continue. Should you decide that this is not the\n\ 156 behaviour that you want, then please reset $Math::GMPz::utf8_no_croak\n\ 157 to its original value of 0\n" 158 159