e576bb2002-10-11Martin Nilsson /* || This file is part of Pike. For copyright information see COPYRIGHT. || Pike is distributed under GPL, LGPL and MPL. See the file COPYING || for more information. */
aedfb12002-10-09Martin Nilsson 
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #include "global.h" #include "gmp_machine.h"
e9ceac2008-06-29Henrik Grubbström (Grubba) #include "pike_float.h"
51ef5c2002-10-21Marcus Comstedt #include "module.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
91d0102014-10-14Martin Nilsson #if !defined(HAVE_GMP_H)
e7dab22014-04-23Henrik Grubbström (Grubba) #error "Gmp is required to build Pike!"
91d0102014-10-14Martin Nilsson #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
2b1c922013-12-24Henrik Grubbström (Grubba) #include "my_gmp.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #include "interpret.h" #include "svalue.h" #include "stralloc.h" #include "array.h"
bb55f81997-03-16Fredrik Hübinette (Hubbe) #include "pike_macros.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #include "program.h" #include "stralloc.h" #include "object.h" #include "pike_types.h"
b2d3e42000-12-01Fredrik Hübinette (Hubbe) #include "pike_error.h"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "builtin_functions.h"
7da3191997-04-25Niels Möller #include "module_support.h"
fda0de1999-10-08Fredrik Noring #include "bignum.h"
10f5031999-10-21Fredrik Noring #include "operators.h"
ad8d052008-05-02Martin Stjernholm #include "gc.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
7da3191997-04-25Niels Möller #include <limits.h>
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
c4f94b2014-10-31Martin Nilsson #if GMP_NUMB_BITS != SIZEOF_MP_LIMB_T * CHAR_BIT #error Cannot cope with GMP using nail bits. #endif
531c172002-05-11Martin Nilsson #define sp Pike_sp #define fp Pike_fp
4690901998-04-23Fredrik Hübinette (Hubbe) #undef THIS
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #define THIS ((MP_INT *)(fp->current_storage))
fa93a52008-02-28Henrik Grubbström (Grubba) #define THIS_PROGRAM (fp->context->prog)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
a35b262004-03-21Henrik Grubbström (Grubba) struct program *mpzmod_program = NULL;
07bb4a2014-10-29Martin Nilsson PMOD_EXPORT struct program *bignum_program = NULL;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
982a0c2003-03-28Martin Stjernholm static mpz_t mpz_int_type_min;
2355e32014-10-29Martin Nilsson PMOD_EXPORT int mpz_from_svalue(MP_INT *dest, struct svalue *s)
2b1c922013-12-24Henrik Grubbström (Grubba) {
43a3892013-12-26Henrik Grubbström (Grubba)  if (!s) return 0; if (TYPEOF(*s) == T_INT) { #if SIZEOF_LONG >= SIZEOF_INT64
8a11eb2014-10-31Martin Nilsson  mpz_set_si(dest, s->u.integer);
43a3892013-12-26Henrik Grubbström (Grubba) #else INT_TYPE i = s->u.integer; int neg = i < 0; unsigned INT64 bits = (unsigned INT64) (neg ? -i : i); mpz_import(dest, 1, 1, SIZEOF_INT64, 0, 0, &bits); if (neg) mpz_neg(dest, dest); #endif /* SIZEOF_LONG < SIZEOF_INT64 */ return 1; } if ((TYPEOF(*s) != T_OBJECT) || !IS_MPZ_OBJ(s->u.object)) return 0; mpz_set(dest, OBTOMPZ(s->u.object)); return 1;
2b1c922013-12-24Henrik Grubbström (Grubba) }
2355e32014-10-29Martin Nilsson PMOD_EXPORT void push_bignum(MP_INT *mpz)
2b1c922013-12-24Henrik Grubbström (Grubba) { push_object(fast_clone_object(bignum_program)); mpz_set(OBTOMPZ(Pike_sp[-1].u.object), mpz); }
d4bf622001-08-13Fredrik Hübinette (Hubbe) void mpzmod_reduce(struct object *o)
110b3f1999-10-29Fredrik Hübinette (Hubbe) {
982a0c2003-03-28Martin Stjernholm  MP_INT *mpz = OBTOMPZ (o); int neg = mpz_sgn (mpz) < 0; INT_TYPE res = 0;
2355e32014-10-29Martin Nilsson  /* Note: Similar code in int64_from_bignum. */
4a0a9c2003-05-19Martin Stjernholm 
49cb142003-05-19Henrik Grubbström (Grubba)  /* Get the index of the highest limb that has bits within the range
a36bd12003-03-28Martin Stjernholm  * of the INT_TYPE. */
982a0c2003-03-28Martin Stjernholm  size_t pos = (INT_TYPE_BITS + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS - 1;
4f561d2003-05-19Martin Stjernholm  if (mpz_size (mpz) <= pos + 1) {
04d4952003-05-17Henrik Grubbström (Grubba)  /* NOTE: INT_TYPE is signed, while GMP_NUMB is unsigned.
49cb142003-05-19Henrik Grubbström (Grubba)  * Thus INT_TYPE_BITS is usually 31 and GMP_NUMB_BITS 32.
04d4952003-05-17Henrik Grubbström (Grubba)  */
49cb142003-05-19Henrik Grubbström (Grubba) #if INT_TYPE_BITS == GMP_NUMB_BITS /* NOTE: Overflow is not possible. */
b6ff9d2014-10-31Martin Nilsson  res = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
49cb142003-05-19Henrik Grubbström (Grubba) #elif INT_TYPE_BITS < GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  mp_limb_t val = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
4f561d2003-05-19Martin Stjernholm  if (val >= (mp_limb_t) 1 << INT_TYPE_BITS) goto overflow; res = val;
982a0c2003-03-28Martin Stjernholm #else for (;; pos--) {
b6ff9d2014-10-31Martin Nilsson  res |= mpz_getlimbn (mpz, pos) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm  if (pos == 0) break;
49cb142003-05-19Henrik Grubbström (Grubba)  if (res >= (INT_TYPE) 1 << (INT_TYPE_BITS - GMP_NUMB_BITS)) goto overflow;
982a0c2003-03-28Martin Stjernholm  res <<= GMP_NUMB_BITS; } #endif
18099a2001-03-04Mirar (Pontus Hagland) 
4f561d2003-05-19Martin Stjernholm  if (neg) res = -res;
982a0c2003-03-28Martin Stjernholm  free_object (o); push_int (res); return;
18099a2001-03-04Mirar (Pontus Hagland)  }
982a0c2003-03-28Martin Stjernholm  overflow: if (neg && !mpz_cmp (mpz, mpz_int_type_min)) { /* No overflow afterall; it's MIN_INT_TYPE, the only valid integer * whose absolute value is INT_TYPE_BITS long. */ free_object (o); push_int (MIN_INT_TYPE);
110b3f1999-10-29Fredrik Hübinette (Hubbe)  }
982a0c2003-03-28Martin Stjernholm  else push_object (o);
110b3f1999-10-29Fredrik Hübinette (Hubbe) }
00cf022003-11-15Martin Stjernholm 
110b3f1999-10-29Fredrik Hübinette (Hubbe) #define PUSH_REDUCED(o) do { struct object *reducetmp__=(o); \ if(THIS_PROGRAM == bignum_program) \
d4bf622001-08-13Fredrik Hübinette (Hubbe)  mpzmod_reduce(reducetmp__); \
110b3f1999-10-29Fredrik Hübinette (Hubbe)  else \ push_object(reducetmp__); \ }while(0)
982a0c2003-03-28Martin Stjernholm #ifdef INT64
2355e32014-10-29Martin Nilsson PMOD_EXPORT void reduce_stack_top_bignum (void)
00cf022003-11-15Martin Stjernholm { struct object *o; #ifdef PIKE_DEBUG
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_OBJECT || sp[-1].u.object->prog != bignum_program)
00cf022003-11-15Martin Stjernholm  Pike_fatal ("Not a Gmp.bignum.\n"); #endif o = (--sp)->u.object; debug_malloc_touch (o); mpzmod_reduce (o); }
2355e32014-10-29Martin Nilsson PMOD_EXPORT void push_int64 (INT64 i)
982a0c2003-03-28Martin Stjernholm { if(i == DO_NOT_WARN((INT_TYPE)i)) { push_int(DO_NOT_WARN((INT_TYPE)i)); } else { MP_INT *mpz; push_object (fast_clone_object (bignum_program)); mpz = OBTOMPZ (sp[-1].u.object);
fd45d52003-04-02Martin Stjernholm #if SIZEOF_LONG >= SIZEOF_INT64
8a11eb2014-10-31Martin Nilsson  mpz_set_si (mpz, i);
982a0c2003-03-28Martin Stjernholm #else {
fd45d52003-04-02Martin Stjernholm  int neg = i < 0;
548d6e2003-06-12Martin Stjernholm  unsigned INT64 bits = (unsigned INT64) (neg ? -i : i);
fd45d52003-04-02Martin Stjernholm 
04d4952003-05-17Henrik Grubbström (Grubba)  mpz_import (mpz, 1, 1, SIZEOF_INT64, 0, 0, &bits);
fd45d52003-04-02Martin Stjernholm  if (neg) mpz_neg (mpz, mpz); }
2f8d142003-04-03Martin Stjernholm #endif /* SIZEOF_LONG < SIZEOF_INT64 */
982a0c2003-03-28Martin Stjernholm  } } static mpz_t mpz_int64_min;
2355e32014-10-29Martin Nilsson PMOD_EXPORT int int64_from_bignum (INT64 *i, struct object *bignum)
982a0c2003-03-28Martin Stjernholm { MP_INT *mpz = OBTOMPZ (bignum); int neg = mpz_sgn (mpz) < 0;
dccaa22008-05-01Martin Stjernholm  /* Note: Similar code in mpzmod_reduce and gmp_ulongest_from_bignum. */
4a0a9c2003-05-19Martin Stjernholm 
982a0c2003-03-28Martin Stjernholm  /* Get the index of the highest limb that have bits within the range * of the INT64. */ size_t pos = (INT64_BITS + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS - 1; #ifdef PIKE_DEBUG
1d81992007-12-27Henrik Grubbström (Grubba)  if ((bignum->prog != bignum_program) && (bignum->prog != mpzmod_program)) { Pike_fatal("cast_to_int(): Not a Gmp.bignum or Gmp.mpz.\n"); }
982a0c2003-03-28Martin Stjernholm #endif if (mpz_size (mpz) <= pos + 1) {
576cff2008-05-01Martin Stjernholm  INT64 res;
982a0c2003-03-28Martin Stjernholm #if INT64_BITS == GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  res = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm #elif INT64_BITS < GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  mp_limb_t val = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm  if (val >= (mp_limb_t) 1 << INT64_BITS) goto overflow;
576cff2008-05-01Martin Stjernholm  res = DO_NOT_WARN ((INT64) val);
982a0c2003-03-28Martin Stjernholm #else
576cff2008-05-01Martin Stjernholm  res = 0;
982a0c2003-03-28Martin Stjernholm  for (;; pos--) {
b6ff9d2014-10-31Martin Nilsson  res |= mpz_getlimbn (mpz, pos) & GMP_NUMB_MASK;
982a0c2003-03-28Martin Stjernholm  if (pos == 0) break; if (res >= (INT64) 1 << (INT64_BITS - GMP_NUMB_BITS)) goto overflow; res <<= GMP_NUMB_BITS; } #endif if (neg) res = -res; *i = res; return 1; } overflow: if (neg && !mpz_cmp (mpz, mpz_int64_min)) { /* No overflow afterall; it's MIN_INT64, the only valid integer * whose absolute value is INT64_BITS long. */ *i = MIN_INT64; return 1; } *i = neg ? MIN_INT64 : MAX_INT64; return 0; }
dccaa22008-05-01Martin Stjernholm #endif /* INT64 */
2355e32014-10-29Martin Nilsson PMOD_EXPORT void push_ulongest (unsigned LONGEST i)
dccaa22008-05-01Martin Stjernholm { if (i <= MAX_INT_TYPE) { push_int(DO_NOT_WARN((INT_TYPE)i)); } else { MP_INT *mpz; push_object (fast_clone_object (bignum_program)); mpz = OBTOMPZ (sp[-1].u.object); #if SIZEOF_LONG >= SIZEOF_LONGEST mpz_set_ui (mpz, i); #else
e5cbd92014-10-31Martin Nilsson  mpz_import (mpz, 1, 1, SIZEOF_LONGEST, 0, 0, &i);
ccceef2008-05-02Martin Stjernholm #endif /* SIZEOF_LONG < SIZEOF_LONGEST */
dccaa22008-05-01Martin Stjernholm  } }
2355e32014-10-29Martin Nilsson PMOD_EXPORT int ulongest_from_bignum (unsigned LONGEST *i, struct object *bignum)
576cff2008-05-01Martin Stjernholm { MP_INT *mpz = OBTOMPZ (bignum);
2355e32014-10-29Martin Nilsson  /* Note: Similar code in int64_from_bignum. */
576cff2008-05-01Martin Stjernholm  /* Get the index of the highest limb that have bits within the range
dccaa22008-05-01Martin Stjernholm  * of LONGEST. */ size_t pos = (ULONGEST_BITS + GMP_NUMB_BITS - 1) / GMP_NUMB_BITS - 1;
576cff2008-05-01Martin Stjernholm  #ifdef PIKE_DEBUG if ((bignum->prog != bignum_program) && (bignum->prog != mpzmod_program)) { Pike_fatal("cast_to_int(): Not a Gmp.bignum or Gmp.mpz.\n"); } #endif if (mpz_sgn (mpz) < 0) return 0; if (mpz_size (mpz) <= pos + 1) {
dccaa22008-05-01Martin Stjernholm  unsigned LONGEST res; #if ULONGEST_BITS == GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  res = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
dccaa22008-05-01Martin Stjernholm #elif ULONGEST_BITS < GMP_NUMB_BITS
b6ff9d2014-10-31Martin Nilsson  mp_limb_t val = mpz_getlimbn (mpz, 0) & GMP_NUMB_MASK;
dccaa22008-05-01Martin Stjernholm  res = DO_NOT_WARN ((unsigned LONGEST) val); if (val != res) return 0;
576cff2008-05-01Martin Stjernholm #else res = 0; for (;; pos--) {
b6ff9d2014-10-31Martin Nilsson  res |= mpz_getlimbn (mpz, pos) & GMP_NUMB_MASK;
576cff2008-05-01Martin Stjernholm  if (pos == 0) break;
dccaa22008-05-01Martin Stjernholm  if (res >= (unsigned LONGEST) 1 << (ULONGEST_BITS - GMP_NUMB_BITS)) return 0;
576cff2008-05-01Martin Stjernholm  res <<= GMP_NUMB_BITS; } #endif *i = res; return 1; } return 0; }
a3edd72002-03-08Martin Nilsson /*! @module Gmp
25616a2004-03-23Martin Nilsson  *! GMP is a free library for arbitrary precision arithmetic, *! operating on signed integers, rational numbers, and floating point *! numbers. There is no practical limit to the precision except the *! ones implied by the available memory in the machine GMP runs on. *! @url{http://www.swox.com/gmp/@}
a3edd72002-03-08Martin Nilsson  */
d1648c2004-01-12Martin Nilsson /*! @class bignum *! This program is used by the internal auto-bignum conversion. It
25616a2004-03-23Martin Nilsson  *! can be used to explicitly type integers that are too big to be
d1648c2004-01-12Martin Nilsson  *! INT_TYPE. Best is however to not use this program unless you *! really know what you are doing.
cd8be42004-09-15Martin Stjernholm  *! *! Due to the auto-bignum conversion, all integers can be treated as *! @[Gmp.mpz] objects insofar as that they can be indexed with the *! functions in the @[Gmp.mpz] class. For instance, to calculate the *! greatest common divisor between @expr{51@} and @expr{85@}, you can *! do @expr{51->gcd(85)@}. In other words, all the functions in *! @[Gmp.mpz] are also available here.
c8153e2004-01-14Martin Nilsson  *! @endclass
d1648c2004-01-12Martin Nilsson  */
a3edd72002-03-08Martin Nilsson /*! @class mpz
815ad12003-04-07Martin Nilsson  *! Gmp.mpz implements very large integers. In fact,
37de6f2003-04-03Martin Nilsson  *! the only limitation on these integers is the available memory. *! The mpz object implements all the normal integer operations.
cd8be42004-09-15Martin Stjernholm  *! *! Note that the auto-bignum feature also makes these operations *! available "in" normal integers. For instance, to calculate the *! greatest common divisor between @expr{51@} and @expr{85@}, you can *! do @expr{51->gcd(85)@}.
a3edd72002-03-08Martin Nilsson  */
110b3f1999-10-29Fredrik Hübinette (Hubbe) 
d4bf622001-08-13Fredrik Hübinette (Hubbe) void get_mpz_from_digits(MP_INT *tmp, struct pike_string *digits, int base)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
ace2d32012-07-24Martin Nilsson  if (digits->size_shift) Pike_error("Invalid digits, cannot convert to Gmp.mpz.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(!base || ((base >= 2) && (base <= 36))) {
5656451999-10-26Fredrik Noring  int offset = 0;
b333ef2000-06-09Fredrik Noring  int neg = 0; if(digits->len > 1)
5656451999-10-26Fredrik Noring  {
ace2d32012-07-24Martin Nilsson  if(STR0(digits)[0] == '+')
b333ef2000-06-09Fredrik Noring  offset += 1;
ace2d32012-07-24Martin Nilsson  else if(STR0(digits)[0] == '-')
b333ef2000-06-09Fredrik Noring  {
5656451999-10-26Fredrik Noring  offset += 1;
b333ef2000-06-09Fredrik Noring  neg = 1; } /* We need to fix the case with binary
04d4952003-05-17Henrik Grubbström (Grubba)  * 0b101... and -0b101... numbers. *
4f561d2003-05-19Martin Stjernholm  * What about hexadecimal and octal?
04d4952003-05-17Henrik Grubbström (Grubba)  * /grubba 2003-05-16
4f561d2003-05-19Martin Stjernholm  * * No sweat - they are handled by mpz_set_str. /mast
04d4952003-05-17Henrik Grubbström (Grubba)  */
b333ef2000-06-09Fredrik Noring  if(!base && digits->len > 2)
5656451999-10-26Fredrik Noring  {
ace2d32012-07-24Martin Nilsson  if((STR0(digits)[offset] == '0') && ((STR0(digits)[offset+1] == 'b') || (STR0(digits)[offset+1] == 'B')))
b333ef2000-06-09Fredrik Noring  { offset += 2; base = 2; }
5656451999-10-26Fredrik Noring  } } if (mpz_set_str(tmp, digits->str + offset, base))
c7549a2003-01-26Martin Nilsson  Pike_error("Invalid digits, cannot convert to Gmp.mpz.\n");
5656451999-10-26Fredrik Noring 
b333ef2000-06-09Fredrik Noring  if(neg)
5656451999-10-26Fredrik Noring  mpz_neg(tmp, tmp);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else if(base == 256) {
982a0c2003-03-28Martin Stjernholm  mpz_import (tmp, digits->len, 1, 1, 0, 0, digits->str);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else {
c7549a2003-01-26Martin Nilsson  Pike_error("Invalid base.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } }
afcf782003-03-28Martin Stjernholm int get_new_mpz(MP_INT *tmp, struct svalue *s, int throw_error, const char *arg_func, int arg, int args)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*s))
0226201997-03-10Niels Möller  { case T_INT:
9c96882003-03-29Martin Stjernholm #ifndef BIG_PIKE_INT
8a11eb2014-10-31Martin Nilsson  mpz_set_si(tmp, (signed long int) s->u.integer);
982a0c2003-03-28Martin Stjernholm #else {
f72f712003-03-29Martin Stjernholm  INT_TYPE i = s->u.integer; int neg = i < 0;
e5cbd92014-10-31Martin Nilsson  if (neg) i = -i;
f72f712003-03-29Martin Stjernholm  mpz_import (tmp, 1, 1, SIZEOF_INT_TYPE, 0, 0, &i); if (neg) mpz_neg (tmp, tmp);
982a0c2003-03-28Martin Stjernholm  }
b875ff2001-03-04Mirar (Pontus Hagland) #endif
0226201997-03-10Niels Möller  break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  case T_FLOAT:
e9ceac2008-06-29Henrik Grubbström (Grubba)  { double val = (double)s->u.float_number; if (PIKE_ISNAN(val) || PIKE_ISINF(val)) return 0; mpz_set_d(tmp, val); }
0226201997-03-10Niels Möller  break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  case T_OBJECT:
afcf782003-03-28Martin Stjernholm  if(IS_MPZ_OBJ (s->u.object)) { mpz_set(tmp, OBTOMPZ(s->u.object)); break; }
df867c2001-09-04Fredrik Hübinette (Hubbe)  if(s->u.object->prog == mpf_program) { mpz_set_f(tmp, OBTOMPF(s->u.object)); break; } if(s->u.object->prog == mpq_program) { mpz_set_q(tmp, OBTOMPQ(s->u.object)); break; }
afcf782003-03-28Martin Stjernholm  if (s->u.object->prog) { if (throw_error) SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpz|Gmp.mpf|Gmp.mpq"); else return 0;
f8afca2001-02-02Henrik Grubbström (Grubba)  } else {
afcf782003-03-28Martin Stjernholm  /* Destructed object. Use as zero. */ mpz_set_si(tmp, 0);
f8afca2001-02-02Henrik Grubbström (Grubba)  }
0226201997-03-10Niels Möller  break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #if 0
0226201997-03-10Niels Möller  case T_STRING: mpz_set_str(tmp, s->u.string->str, 0); break; case T_ARRAY: /* Experimental */ if ( (s->u.array->size != 2)
017b572011-10-28Henrik Grubbström (Grubba)  || (TYPEOF(ITEM(s->u.array)[0]) != T_STRING) || (TYPEOF(ITEM(s->u.array)[1]) != T_INT))
c7549a2003-01-26Martin Nilsson  Pike_error("Cannot convert array to Gmp.mpz.\n");
0226201997-03-10Niels Möller  get_mpz_from_digits(tmp, ITEM(s->u.array)[0].u.string, ITEM(s->u.array)[1]); break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  default:
afcf782003-03-28Martin Stjernholm  if (throw_error) SIMPLE_ARG_TYPE_ERROR (arg_func, arg, "int|float|Gmp.mpz|Gmp.mpf|Gmp.mpq"); else return 0; } return 1; } /* Converts an svalue, located on the stack, to an mpz object */ MP_INT *debug_get_mpz(struct svalue *s, int throw_error, const char *arg_func, int arg, int args) { struct object *o = fast_clone_object (mpzmod_program); ONERROR uwp; SET_ONERROR (uwp, do_free_object, o); if (get_new_mpz (OBTOMPZ (o), s, throw_error, arg_func, arg, args)) { UNSET_ONERROR (uwp); free_svalue(s);
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(*s, T_OBJECT, 0, object, o);
afcf782003-03-28Martin Stjernholm  return OBTOMPZ (o); } else { UNSET_ONERROR (uwp);
aaaab72003-03-29Martin Stjernholm  free_object (o);
afcf782003-03-28Martin Stjernholm  return NULL;
0226201997-03-10Niels Möller  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
33bd9a2002-02-06Henrik Grubbström (Grubba) /*! @decl void create() *! @decl void create(string|int|float|object value) *! @decl void create(string value, int(2..36)|int(256..256) base) *! *! Create and initialize a @[Gmp.mpz] object. *! *! @param value *! Initial value. If no value is specified, the object will be initialized *! to zero. *! *! @param base *! Base the value is specified in. The default base is base 10. *! The base can be either a value in the range @tt{[2..36]@} (inclusive), *! in which case the numbers are taken from the ASCII range *! @tt{0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ@} (case-insensitive), *! or the value 256, in which case @[value] is taken to be the binary *! representation in network byte order. *!
ace2d32012-07-24Martin Nilsson  *! Values in base @tt{[2..36]@} can be prefixed with @expr{"+"@} or *! @expr{"-"@}. Values prefixed with @expr{"0b"@} or @expr{"0B"@} *! will be interpreted as binary. Values prefixed with @expr{"0x"@} *! or @expr{"0X"@} will be interpreted as hexadecimal. Values *! prefixed with @expr{"0"@} will be interpreted as octal. *!
33bd9a2002-02-06Henrik Grubbström (Grubba)  *! @note
ace2d32012-07-24Martin Nilsson  *! Leading zeroes in @[value] are not significant when a base is *! explicitly given. In particular leading NUL characters are not *! preserved in base 256 mode.
33bd9a2002-02-06Henrik Grubbström (Grubba)  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_create(INT32 args) { switch(args) { case 1:
4c73712014-07-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) == T_STRING) { if (sp[-args].u.string->flags & STRING_CLEAR_ON_EXIT) { Pike_fp->current_object->flags |= OBJECT_CLEAR_ON_EXIT; }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  get_mpz_from_digits(THIS, sp[-args].u.string, 0);
4c73712014-07-28Henrik Grubbström (Grubba)  } else { if ((TYPEOF(sp[-args]) == T_OBJECT) && (sp[-args].u.object->flags & OBJECT_CLEAR_ON_EXIT)) { Pike_fp->current_object->flags |= OBJECT_CLEAR_ON_EXIT; }
afcf782003-03-28Martin Stjernholm  get_new_mpz(THIS, sp-args, 1, "Gmp.mpz", 1, args);
4c73712014-07-28Henrik Grubbström (Grubba)  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  break; case 2: /* Args are string of digits and integer base */
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) != T_STRING)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("create", 1, "string");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[1-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("create", 2, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
4c73712014-07-28Henrik Grubbström (Grubba)  if (sp[-args].u.string->flags & STRING_CLEAR_ON_EXIT) { Pike_fp->current_object->flags |= OBJECT_CLEAR_ON_EXIT; }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  get_mpz_from_digits(THIS, sp[-args].u.string, sp[1-args].u.integer); break; case 0: break; /* Needed by AIX cc */ } pop_n_elems(args); }
815ad12003-04-07Martin Nilsson /*! @decl int cast_to_int() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_get_int(INT32 args) { pop_n_elems(args);
110b3f1999-10-29Fredrik Hübinette (Hubbe)  add_ref(fp->current_object);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  mpzmod_reduce(fp->current_object);
017b572011-10-28Henrik Grubbström (Grubba)  if( TYPEOF(Pike_sp[-1]) == T_OBJECT &&
5b2e4b2006-10-20Martin Nilsson  Pike_sp[-1].u.object->prog != bignum_program ) {
07bb4a2014-10-29Martin Nilsson  push_object(clone_object(bignum_program, 1));
5b2e4b2006-10-20Martin Nilsson  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
88f57f2009-10-28Henrik Grubbström (Grubba) static INT32 crc_table[256]; static void init_crc_table(void) {
5bd3482014-01-11Tobias S. Josefowitz  unsigned INT32 i;
88f57f2009-10-28Henrik Grubbström (Grubba)  for (i = 0; i < 256; i++) { int j; INT32 crc = i << 24; for (j = 0; j < 8; j++) { if (crc < 0) {
5bd3482014-01-11Tobias S. Josefowitz  crc = (((unsigned INT32)crc) << 1)^0x04c11db7L;
88f57f2009-10-28Henrik Grubbström (Grubba)  } else {
5bd3482014-01-11Tobias S. Josefowitz  crc = ((unsigned INT32)crc) << 1;
88f57f2009-10-28Henrik Grubbström (Grubba)  } } crc_table[i] = crc; } }
815ad12003-04-07Martin Nilsson /*! @decl int __hash()
88f57f2009-10-28Henrik Grubbström (Grubba)  *! *! Calculate a hash of the value. *! *! @note *! Prior to Pike 7.8.359 this function returned the low *! 32-bits as an unsigned integer. This could in some *! common cases lead to very unbalanced mappings. *! *! @seealso *! @[hash_value()]
815ad12003-04-07Martin Nilsson  */
04edf32000-01-09Fredrik Hübinette (Hubbe) static void mpzmod___hash(INT32 args) {
88f57f2009-10-28Henrik Grubbström (Grubba)  MP_INT *mpz = THIS; /* Calculate the CRC32 of the limbs. * NOTE: LSB first! */ INT32 crc = 0; size_t pos; for (pos = 0; pos < mpz_size(mpz); pos++) {
b6ff9d2014-10-31Martin Nilsson  mp_limb_t x = mpz_getlimbn (mpz, pos);
88f57f2009-10-28Henrik Grubbström (Grubba)  size_t i; for (i=0; i<sizeof(mp_limb_t); i++) { crc = (crc >> 8) ^ crc_table[((crc >> 24) ^ x) & 0xff]; x >>= 8; } }
04edf32000-01-09Fredrik Hübinette (Hubbe)  pop_n_elems(args);
88f57f2009-10-28Henrik Grubbström (Grubba)  if (mpz_sgn(mpz) < 0) push_int(-crc); else push_int(crc);
04edf32000-01-09Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl float cast_to_float() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_get_float(INT32 args) { pop_n_elems(args);
6172662000-08-08Henrik Grubbström (Grubba)  push_float((FLOAT_TYPE)mpz_get_d(THIS));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
d4bf622001-08-13Fredrik Hübinette (Hubbe) struct pike_string *low_get_mpz_digits(MP_INT *mpz, int base)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
3ef2481999-10-22Fredrik Noring  struct pike_string *s = 0; /* Make gcc happy. */
6172662000-08-08Henrik Grubbström (Grubba)  ptrdiff_t len;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if ( (base >= 2) && (base <= 36)) { len = mpz_sizeinbase(mpz, base) + 2; s = begin_shared_string(len); mpz_get_str(s->str, base, mpz); /* Find NULL character */ len-=4; if (len < 0) len = 0; while(s->str[len]) len++;
84c7de2001-01-30Fredrik Hübinette (Hubbe)  s=end_and_resize_shared_string(s, len);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else if (base == 256) {
6172662000-08-08Henrik Grubbström (Grubba)  size_t i;
3445e71998-01-30Mirar (Pontus Hagland) 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (mpz_sgn(mpz) < 0)
c7549a2003-01-26Martin Nilsson  Pike_error("Only non-negative numbers can be converted to base 256.\n");
3445e71998-01-30Mirar (Pontus Hagland) 
2618ee1998-02-11Niels Möller  len = (mpz_sizeinbase(mpz, 2) + 7) / 8;
3445e71998-01-30Mirar (Pontus Hagland)  s = begin_shared_string(len);
982a0c2003-03-28Martin Stjernholm  if (!mpz_size (mpz))
3445e71998-01-30Mirar (Pontus Hagland)  {
1323f01998-02-11Niels Möller  /* Zero is a special case. There are no limbs at all, but * the size is still 1 bit, and one digit should be produced. */
06b9af2014-10-31Martin Nilsson #ifdef PIKE_DEBUG
1323f01998-02-11Niels Möller  if (len != 1)
5aad932002-08-15Marcus Comstedt  Pike_fatal("mpz->low_get_mpz_digits: strange mpz state!\n");
06b9af2014-10-31Martin Nilsson #endif
1323f01998-02-11Niels Möller  s->str[0] = 0; } else {
06b9af2014-10-31Martin Nilsson  mpz_export(s->str, NULL, 1, 1, 1, 0, mpz);
3445e71998-01-30Mirar (Pontus Hagland)  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  s = end_shared_string(s); } else {
c7549a2003-01-26Martin Nilsson  Pike_error("Invalid base.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return 0; /* Make GCC happy */ } return s; }
815ad12003-04-07Martin Nilsson /*! @decl string cast_to_string() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_get_string(INT32 args) {
9e74322010-05-29Martin Stjernholm  /* Also called as json_encode (with some arguments). */
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  push_string(low_get_mpz_digits(THIS, 10));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
37de6f2003-04-03Martin Nilsson /*! @decl string digits(void|int(2..36)|int(256..256) base)
cd8be42004-09-15Martin Stjernholm  *! *! Convert this mpz object to a string. If a @[base] is given the
37de6f2003-04-03Martin Nilsson  *! number will be represented in that base. Valid bases are 2-36 and *! 256. The default base is 10.
cd8be42004-09-15Martin Stjernholm  *!
37de6f2003-04-03Martin Nilsson  *! @seealso *! @[cast_to_string] */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_digits(INT32 args) { INT32 base;
2ac3721997-09-07Niels Möller  struct pike_string *s;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!args) { base = 10; } else {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("digits", 1, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  base = sp[-args].u.integer; }
2ac3721997-09-07Niels Möller 
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(THIS, base);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
2ac3721997-09-07Niels Möller  push_string(s);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl string _sprintf(int ind, mapping opt) */
10f5031999-10-21Fredrik Noring static void mpzmod__sprintf(INT32 args) {
eccd0a1999-10-29Fredrik Noring  INT_TYPE precision, width, width_undecided, base = 0, mask_shift = 0;
10f5031999-10-21Fredrik Noring  struct pike_string *s = 0;
e9be8e2002-03-08Henrik Grubbström (Grubba)  INT_TYPE flag_left, method;
1864682001-09-20Fredrik Hübinette (Hubbe)  debug_malloc_touch(Pike_fp->current_object);
10f5031999-10-21Fredrik Noring 
c7549a2003-01-26Martin Nilsson  if(args < 2)
de22f72014-08-25Martin Nilsson  SIMPLE_TOO_FEW_ARGS_ERROR("_sprintf", 2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("_sprintf", 1, "int");
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[1-args]) != T_MAPPING)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("_sprintf", 2, "mapping");
4f8deb1999-10-26Fredrik Noring  push_svalue(&sp[1-args]);
7cf0162014-05-22Per Hedbor  push_text("precision");
4f8deb1999-10-26Fredrik Noring  f_index(2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("_sprintf", 2,
afcf782003-03-28Martin Stjernholm  "The field \"precision\" doesn't hold an integer.");
4f8deb1999-10-26Fredrik Noring  precision = (--sp)->u.integer;
eccd0a1999-10-29Fredrik Noring  push_svalue(&sp[1-args]);
7cf0162014-05-22Per Hedbor  push_text("width");
eccd0a1999-10-29Fredrik Noring  f_index(2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("_sprintf", 2,
afcf782003-03-28Martin Stjernholm  "The field \"width\" doesn't hold an integer.");
017b572011-10-28Henrik Grubbström (Grubba)  width_undecided = (SUBTYPEOF(sp[-1]) != NUMBER_NUMBER);
eccd0a1999-10-29Fredrik Noring  width = (--sp)->u.integer;
310f601999-11-01Mirar (Pontus Hagland)  push_svalue(&sp[1-args]);
7cf0162014-05-22Per Hedbor  push_text("flag_left");
310f601999-11-01Mirar (Pontus Hagland)  f_index(2);
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("_sprintf", 2,
afcf782003-03-28Martin Stjernholm  "The field \"flag_left\" doesn't hold an integer.");
310f601999-11-01Mirar (Pontus Hagland)  flag_left=sp[-1].u.integer; pop_stack();
1864682001-09-20Fredrik Hübinette (Hubbe)  debug_malloc_touch(Pike_fp->current_object);
e9be8e2002-03-08Henrik Grubbström (Grubba)  switch(method = sp[-args].u.integer)
10f5031999-10-21Fredrik Noring  {
3905cf1999-11-11Fredrik Hübinette (Hubbe)  case 't': pop_n_elems(args); if(THIS_PROGRAM == bignum_program)
7cf0162014-05-22Per Hedbor  push_text("int");
3905cf1999-11-11Fredrik Hübinette (Hubbe)  else
7cf0162014-05-22Per Hedbor  push_text("object");
3905cf1999-11-11Fredrik Hübinette (Hubbe)  return;
fef5d02003-03-29Martin Stjernholm 
4f8deb1999-10-26Fredrik Noring  case 'O':
fef5d02003-03-29Martin Stjernholm  if (THIS_PROGRAM == mpzmod_program) {
7cf0162014-05-22Per Hedbor  push_text ("Gmp.mpz(");
fef5d02003-03-29Martin Stjernholm  push_string (low_get_mpz_digits (THIS, 10));
7cf0162014-05-22Per Hedbor  push_text (")");
fef5d02003-03-29Martin Stjernholm  f_add (3); s = (--sp)->u.string; break; } /* Fall through */
4f8deb1999-10-26Fredrik Noring  case 'u': /* Note: 'u' is not really supported. */ case 'd':
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(THIS, 10);
4f8deb1999-10-26Fredrik Noring  break; case 'x': case 'X': base += 8; mask_shift += 1; /* Fall-through. */ case 'o':
5656451999-10-26Fredrik Noring  base += 6; mask_shift += 2; /* Fall-through. */ case 'b': base += 2; mask_shift += 1;
4f8deb1999-10-26Fredrik Noring  if(precision > 0) { mpz_t mask; mpz_init_set_ui(mask, 1); mpz_mul_2exp(mask, mask, precision * mask_shift); mpz_sub_ui(mask, mask, 1); mpz_and(mask, mask, THIS);
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(mask, base);
4f8deb1999-10-26Fredrik Noring  mpz_clear(mask); } else
d4bf622001-08-13Fredrik Hübinette (Hubbe)  s = low_get_mpz_digits(THIS, base);
4f8deb1999-10-26Fredrik Noring  break;
eccd0a1999-10-29Fredrik Noring  case 'c': {
dd9add2003-03-28Martin Stjernholm  INT_TYPE neg = mpz_sgn (THIS) < 0;
eccd0a1999-10-29Fredrik Noring  unsigned char *dst;
dd9add2003-03-28Martin Stjernholm  size_t pos, length = mpz_size (THIS);
eccd0a1999-10-29Fredrik Noring  mpz_t tmp; MP_INT *n; INT_TYPE i; if(width_undecided) { p_wchar2 ch = mpz_get_ui(THIS);
dd9add2003-03-28Martin Stjernholm  if(neg)
eccd0a1999-10-29Fredrik Noring  ch = (~ch)+1; s = make_shared_binary_string2(&ch, 1); break; }
dd9add2003-03-28Martin Stjernholm  if (neg)
eccd0a1999-10-29Fredrik Noring  { mpz_init_set(tmp, THIS); mpz_add_ui(tmp, tmp, 1);
dd9add2003-03-28Martin Stjernholm  length = mpz_size (tmp);
eccd0a1999-10-29Fredrik Noring  n = tmp; } else n = THIS; if(width < 1) width = 1; s = begin_shared_string(width);
310f601999-11-01Mirar (Pontus Hagland)  if (!flag_left) dst = (unsigned char *)STR0(s) + width; else dst = (unsigned char *)STR0(s);
eccd0a1999-10-29Fredrik Noring 
982a0c2003-03-28Martin Stjernholm  pos = 0;
eccd0a1999-10-29Fredrik Noring  while(width > 0) {
b6ff9d2014-10-31Martin Nilsson  mp_limb_t x = (length-->0? mpz_getlimbn(n, pos++) : 0);
310f601999-11-01Mirar (Pontus Hagland)  if (!flag_left) for(i = 0; i < (INT_TYPE)sizeof(mp_limb_t); i++) {
340c562001-06-13Henrik Grubbström (Grubba)  *(--dst) = DO_NOT_WARN((unsigned char)((neg ? ~x : x) & 0xff));
310f601999-11-01Mirar (Pontus Hagland)  x >>= 8; if(!--width) break; } else for(i = 0; i < (INT_TYPE)sizeof(mp_limb_t); i++) {
340c562001-06-13Henrik Grubbström (Grubba)  *(dst++) = DO_NOT_WARN((unsigned char)((neg ? ~x : x) & 0xff));
310f601999-11-01Mirar (Pontus Hagland)  x >>= 8; if(!--width) break; }
eccd0a1999-10-29Fredrik Noring  } if(neg) { mpz_clear(tmp); } s = end_shared_string(s); } break;
10f5031999-10-21Fredrik Noring  }
1864682001-09-20Fredrik Hübinette (Hubbe)  debug_malloc_touch(Pike_fp->current_object);
10f5031999-10-21Fredrik Noring  pop_n_elems(args);
e9be8e2002-03-08Henrik Grubbström (Grubba)  if(s) {
10f5031999-10-21Fredrik Noring  push_string(s);
e9be8e2002-03-08Henrik Grubbström (Grubba)  if (method == 'X') { f_upper_case(1); } } else {
017b572011-10-28Henrik Grubbström (Grubba)  push_undefined();
eccd0a1999-10-29Fredrik Noring  }
10f5031999-10-21Fredrik Noring }
772d1a2014-05-22Per Hedbor /* protected int(0..1) _is_type(string type)
815ad12003-04-07Martin Nilsson  */
b359622014-07-28Per Hedbor static void mpzmod__is_type(INT32 UNUSED(args))
10f5031999-10-21Fredrik Noring {
772d1a2014-05-22Per Hedbor  int is_int;
6a932b2014-08-18Martin Nilsson  is_int = Pike_sp[-1].u.string == literal_int_string ? 1 : 0;
772d1a2014-05-22Per Hedbor  pop_stack(); push_int( is_int );
10f5031999-10-21Fredrik Noring }
9eeb732014-04-12Henrik Grubbström (Grubba) /*! @decl int(0..) size(void|int base)
cd8be42004-09-15Martin Stjernholm  *! *! Return how long this mpz would be represented in the specified *! @[base]. The default base is 2.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_size(INT32 args) { int base; if (!args) { /* Default is number of bits */ base = 2; } else {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("size", 1, "int");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  base = sp[-args].u.integer; if ((base != 256) && ((base < 2) || (base > 36)))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("size", 1, "Invalid base.");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } pop_n_elems(args); if (base == 256)
340c562001-06-13Henrik Grubbström (Grubba)  push_int(DO_NOT_WARN((INT32)((mpz_sizeinbase(THIS, 2) + 7) / 8)));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  else
340c562001-06-13Henrik Grubbström (Grubba)  push_int(DO_NOT_WARN((INT32)(mpz_sizeinbase(THIS, base))));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
7a74cc2014-08-26Per Hedbor /*! @decl string|int|float cast(string type)
cd8be42004-09-15Martin Stjernholm  *! *! Cast this mpz object to another type. Allowed types are string, *! int and float. *!
37de6f2003-04-03Martin Nilsson  *! @seealso *! @[cast_to_int], @[cast_to_float], @[cast_to_string] */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_cast(INT32 args) {
68ec3f2014-08-18Martin Nilsson  struct pike_string *s = sp[-args].u.string;
7f3b992014-10-28Per Hedbor  if( args ) pop_stack(); /* s have at least one more reference. */
68ec3f2014-08-18Martin Nilsson  if( s == literal_int_string ) mpzmod_get_int(0); else if( s == literal_string_string ) mpzmod_get_string(0); else if( s == literal_float_string ) mpzmod_get_float(0); else push_undefined();
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
0226201997-03-10Niels Möller /* Non-reentrant */ #if 0
a80a9c1997-02-11Fredrik Hübinette (Hubbe) /* These two functions are here so we can allocate temporary * objects without having to worry about them leaking in * case of errors.. */ static struct object *temporary;
be478c1997-08-30Henrik Grubbström (Grubba) MP_INT *get_tmp(void)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) { if(!temporary)
e709751997-03-12Fredrik Hübinette (Hubbe)  temporary=clone_object(mpzmod_program,0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return (MP_INT *)temporary->storage; } static void return_temporary(INT32 args) { pop_n_elems(args); push_object(temporary); temporary=0; }
0226201997-03-10Niels Möller #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
4d21fc1999-12-15Fredrik Hübinette (Hubbe) double double_from_sval(struct svalue *s) {
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(*s))
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  { case T_INT: return (double)s->u.integer; case T_FLOAT: return (double)s->u.float_number; case T_OBJECT:
afcf782003-03-28Martin Stjernholm  if(IS_MPZ_OBJ (s->u.object))
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  return mpz_get_d(OBTOMPZ(s->u.object)); default:
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Bad argument, expected a number of some sort.\n");
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  }
9509c52000-03-27Henrik Grubbström (Grubba)  /* NOT_REACHED */ return (double)0.0; /* Keep the compiler happy. */
4d21fc1999-12-15Fredrik Hübinette (Hubbe) }
fda0de1999-10-08Fredrik Noring 
b5e4fe2005-09-15Henrik Grubbström (Grubba) #define BINFUN2(name, errmsg_op, fun, OP, f_op, LFUN) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) static void name(INT32 args) \ { \ INT32 e; \ struct object *res; \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e-args])) \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  { \
b5e4fe2005-09-15Henrik Grubbström (Grubba)  case T_OBJECT: \ { \ struct object *o = sp[e-args].u.object; \ struct program *p = NULL; \ int fun = -1; \ if (o->prog && \
017b572011-10-28Henrik Grubbström (Grubba)  ((p = o->prog->inherits[SUBTYPEOF(sp[e-args])].prog) != \
b5e4fe2005-09-15Henrik Grubbström (Grubba)  bignum_program) && \ ((fun = FIND_LFUN(p, PIKE_CONCAT(LFUN_R, LFUN))) != \ -1)) { \ /* Found non-bignum program with double back operator. */ \ memmove(Pike_sp+1-args, Pike_sp-args, \ args * sizeof(struct svalue)); \ Pike_sp++; \ args++; \ e++; \
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL(Pike_sp[-args], T_OBJECT, 0 /* FIXME? */, object, \ Pike_fp->current_object); \ add_ref(Pike_fp->current_object); \
b5e4fe2005-09-15Henrik Grubbström (Grubba)  args = low_rop(o, fun, e, args); \ if (args > 1) { \ f_op(args); \ } \ return; \ } \ } \ break; \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  case T_FLOAT: \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  ret=mpz_get_d(THIS); \ for(e=0; e<args; e++) \
6f18502000-04-25Marcus Comstedt  ret = ret OP double_from_sval(sp-args); \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  \ pop_n_elems(args); \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  push_float( (FLOAT_TYPE)ret ); \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  return; \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  STRINGCONV( \ case T_STRING: \
68c0a82014-09-03Martin Nilsson  memmove(sp-args+1, sp-args, sizeof(struct svalue)*args); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  sp++; args++; \
017b572011-10-28Henrik Grubbström (Grubba)  SET_SVAL_TYPE(sp[-args], PIKE_T_FREE); \ SET_SVAL(sp[-args], T_STRING, 0, string, \ low_get_mpz_digits(THIS, 10)); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  f_add(args); \ return; ) \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  } \ } \
0311712013-06-17Martin Nilsson  } \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  for(e=0; e<args; e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "`" errmsg_op, e + 1, args); \
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  fun(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); \ else \ PIKE_CONCAT(fun,_ui)(OBTOMPZ(res), OBTOMPZ(res), \
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  sp[e-args].u.integer); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  \
18099a2001-03-04Mirar (Pontus Hagland)  pop_n_elems(args); \ PUSH_REDUCED(res); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) } \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  \ STRINGCONV( \ static void PIKE_CONCAT(name,_rhs)(INT32 args) \ { \ INT32 e; \ struct object *res; \ if(THIS_PROGRAM == bignum_program) \ { \ double ret; \ for(e=0; e<args; e++) \ { \
017b572011-10-28Henrik Grubbström (Grubba)  switch(TYPEOF(sp[e-args])) \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  { \ case T_FLOAT: \ ret=mpz_get_d(THIS); \ for(e=0; e<args; e++) \
6f18502000-04-25Marcus Comstedt  ret = ret OP double_from_sval(sp-args); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  \ pop_n_elems(args); \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  push_float( (FLOAT_TYPE)ret ); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  return; \ case T_STRING: \
d4bf622001-08-13Fredrik Hübinette (Hubbe)  push_string(low_get_mpz_digits(THIS, 10)); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  f_add(args+1); \ return; \ } \ } \
0311712013-06-17Martin Nilsson  } \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  for(e=0; e<args; e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || !FITS_ULONG (sp[e-args].u.integer)) \
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "``" errmsg_op, e + 1, args); \
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM); \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT) \
6547ef2000-03-01Fredrik Hübinette (Hubbe)  fun(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); \ else \ PIKE_CONCAT(fun,_ui)(OBTOMPZ(res), OBTOMPZ(res), \ sp[e-args].u.integer); \ \ pop_n_elems(args); \ PUSH_REDUCED(res); \ } \
7ce9dd2014-08-13Per Hedbor )
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
6547ef2000-03-01Fredrik Hübinette (Hubbe) #define STRINGCONV(X) X
815ad12003-04-07Martin Nilsson 
7ce9dd2014-08-13Per Hedbor static void mpzmod_add_eq(INT32 args) { INT32 e; if(THIS_PROGRAM == bignum_program) { double ret; for(e=0; e<args; e++) { switch(TYPEOF(sp[e-args])) { case T_FLOAT: ret=mpz_get_d(THIS); for(e=0; e<args; e++) ret = ret + double_from_sval(sp-args); pop_n_elems(args); push_float( (FLOAT_TYPE)ret ); return; case T_STRING:
68c0a82014-09-03Martin Nilsson  memmove(sp-args+1, sp-args, sizeof(struct svalue)*args);
7ce9dd2014-08-13Per Hedbor  sp++; args++; SET_SVAL_TYPE(sp[-args], PIKE_T_FREE); SET_SVAL(sp[-args], T_STRING, 0, string, low_get_mpz_digits(THIS, 10)); f_add(args); return; } } } for(e=0; e<args; e++) if(TYPEOF(sp[e-args]) != T_INT || !FITS_ULONG (sp[e-args].u.integer))
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "`+", e + 1, args);
7ce9dd2014-08-13Per Hedbor  for(e=0;e<args;e++) if(TYPEOF(sp[e-args]) != T_INT) mpz_add(THIS, THIS, OBTOMPZ(sp[e-args].u.object)); else mpz_add_ui(THIS,THIS, sp[e-args].u.integer); add_ref(fp->current_object); PUSH_REDUCED(fp->current_object); }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `+(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``+(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
b5e4fe2005-09-15Henrik Grubbström (Grubba) BINFUN2(mpzmod_add, "+", mpz_add, +, f_add, ADD)
6547ef2000-03-01Fredrik Hübinette (Hubbe)  #undef STRINGCONV #define STRINGCONV(X)
815ad12003-04-07Martin Nilsson 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `*(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``*(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
b5e4fe2005-09-15Henrik Grubbström (Grubba) BINFUN2(mpzmod_mul, "*", mpz_mul, *, f_multiply, MULTIPLY)
ee37801999-02-09Fredrik Hübinette (Hubbe) 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz gcd(object|int|float|string ... args)
7ce9dd2014-08-13Per Hedbor  *!
cd8be42004-09-15Martin Stjernholm  *! Return the greatest common divisor between this mpz object and *! all the arguments.
37de6f2003-04-03Martin Nilsson  */
4d21fc1999-12-15Fredrik Hübinette (Hubbe) static void mpzmod_gcd(INT32 args) { INT32 e; struct object *res; for(e=0; e<args; e++)
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || sp[e-args].u.integer<=0)
de22f72014-08-25Martin Nilsson  get_mpz(sp+e-args, 1, "gcd", e + 1, args);
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); for(e=0;e<args;e++)
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT) mpz_gcd(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object));
4d21fc1999-12-15Fredrik Hübinette (Hubbe)  else mpz_gcd_ui(OBTOMPZ(res), OBTOMPZ(res),sp[e-args].u.integer); pop_n_elems(args); PUSH_REDUCED(res); }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `-(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sub(INT32 args) { INT32 e;
79042c1997-03-11Niels Möller  struct object *res;
751aee1999-10-15Fredrik Noring 
79042c1997-03-11Niels Möller  if (args) for (e = 0; e<args; e++)
de22f72014-08-25Martin Nilsson  get_mpz(sp + e - args, 1, "`-", e + 1, args);
79042c1997-03-11Niels Möller 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  mpz_set(OBTOMPZ(res), THIS);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(args) { for(e=0;e<args;e++)
79042c1997-03-11Niels Möller  mpz_sub(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  }else{
0226201997-03-10Niels Möller  mpz_neg(OBTOMPZ(res), OBTOMPZ(res));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  }
0226201997-03-10Niels Möller  pop_n_elems(args);
bb4a9c1999-10-21Fredrik Hübinette (Hubbe)  debug_malloc_touch(res);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``-(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rsub(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  MP_INT *a; if(args!=1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``-", 1);
afcf782003-03-28Martin Stjernholm 
de22f72014-08-25Martin Nilsson  a=get_mpz(sp-1, 1, "``-", 1, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_sub(OBTOMPZ(res), a, THIS); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `/(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_div(INT32 args) { INT32 e;
79042c1997-03-11Niels Möller  struct object *res;
0226201997-03-10Niels Möller 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) != T_INT || sp[e-args].u.integer<=0)
de22f72014-08-25Martin Nilsson  if (!mpz_sgn(get_mpz(sp+e-args, 1, "`/", e + 1, args))) SIMPLE_DIVISION_BY_ZERO_ERROR ("`/");
80a0e41999-03-02Fredrik Hübinette (Hubbe)  }
79042c1997-03-11Niels Möller 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
79042c1997-03-11Niels Möller  mpz_set(OBTOMPZ(res), THIS); for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  {
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[e-args]) == T_INT)
a58a972004-02-17Mirar (Pontus Hagland) #ifdef BIG_PIKE_INT { INT_TYPE i=sp[e-args].u.integer; if ( (unsigned long int)i == i) { mpz_fdiv_q_ui(OBTOMPZ(res), OBTOMPZ(res), i); } else {
de22f72014-08-25Martin Nilsson  MP_INT *tmp=get_mpz(sp+e-args,1,"`/",e,e);
a58a972004-02-17Mirar (Pontus Hagland)  mpz_fdiv_q(OBTOMPZ(res), OBTOMPZ(res), tmp); /* will this leak? there is no simple way of poking at the references to tmp */ } } #else
80a0e41999-03-02Fredrik Hübinette (Hubbe)  mpz_fdiv_q_ui(OBTOMPZ(res), OBTOMPZ(res), sp[e-args].u.integer);
a58a972004-02-17Mirar (Pontus Hagland) #endif
80a0e41999-03-02Fredrik Hübinette (Hubbe)  else mpz_fdiv_q(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object)); }
79042c1997-03-11Niels Möller 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``/(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rdiv(INT32 args) { MP_INT *a;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``/", 1);
afcf782003-03-28Martin Stjernholm  if(!mpz_sgn(THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("``/");
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
de22f72014-08-25Martin Nilsson  a=get_mpz(sp-1, 1, "``/", 1, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  res=fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_fdiv_q(OBTOMPZ(res), a, THIS); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `%(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_mod(INT32 args) { INT32 e;
79042c1997-03-11Niels Möller  struct object *res; for(e=0;e<args;e++)
de22f72014-08-25Martin Nilsson  if (!mpz_sgn(get_mpz(sp+e-args, 1, "`%", e + 1, args))) SIMPLE_DIVISION_BY_ZERO_ERROR ("`%");
afcf782003-03-28Martin Stjernholm 
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  mpz_set(OBTOMPZ(res), THIS);
79042c1997-03-11Niels Möller  for(e=0;e<args;e++)
806a2c1997-04-28Fredrik Hübinette (Hubbe)  mpz_fdiv_r(OBTOMPZ(res), OBTOMPZ(res), OBTOMPZ(sp[e-args].u.object));
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz ``%(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rmod(INT32 args) { MP_INT *a;
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if(args!=1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``%", 1);
afcf782003-03-28Martin Stjernholm  if(!mpz_sgn(THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("``%");
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
de22f72014-08-25Martin Nilsson  a=get_mpz(sp-1, 1, "``%", 1, 1);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  res=fast_clone_object(THIS_PROGRAM);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_fdiv_r(OBTOMPZ(res), a, THIS); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl array(Gmp.mpz) gcdext(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Compute the greatest common divisor between this mpz object and *! @[x]. An array @expr{({g,s,t})@} is returned where @expr{g@} is *! the greatest common divisor, and @expr{s@} and @expr{t@} are the *! coefficients that satisfies *! *! @code *! this * s + @[x] * t = g *! @endcode *! *! @seealso *! @[gcdext2], @[gcd]
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_gcdext(INT32 args) { struct object *g, *s, *t; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("gcdext", 1);
0226201997-03-10Niels Möller 
de22f72014-08-25Martin Nilsson  a = get_mpz(sp-1, 1, "gcdext", 1, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  g = fast_clone_object(THIS_PROGRAM); s = fast_clone_object(THIS_PROGRAM); t = fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_gcdext(OBTOMPZ(g), OBTOMPZ(s), OBTOMPZ(t), THIS, a); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(g); PUSH_REDUCED(s); PUSH_REDUCED(t);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  f_aggregate(3); }
815ad12003-04-07Martin Nilsson /*! @decl array(Gmp.mpz) gcdext2(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Compute the greatest common divisor between this mpz object and *! @[x]. An array @expr{({g,s})@} is returned where @expr{g@} is the *! greatest common divisor, and @expr{s@} is a coefficient that *! satisfies *! *! @code *! this * s + @[x] * t = g *! @endcode *! *! where @expr{t@} is some integer value. *! *! @seealso *! @[gcdext], @[gcd]
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_gcdext2(INT32 args) { struct object *g, *s; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("gcdext2", 1);
0226201997-03-10Niels Möller 
de22f72014-08-25Martin Nilsson  a = get_mpz(sp-args, 1, "gcdext2", 1, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  g = fast_clone_object(THIS_PROGRAM); s = fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_gcdext(OBTOMPZ(g), OBTOMPZ(s), NULL, THIS, a); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(g); PUSH_REDUCED(s);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  f_aggregate(2); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz invert(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Return the inverse of this mpz value modulo @[x]. The returned *! value satisfies @expr{0 <= result < x@}. *! *! @throws *! An error is thrown if no inverse exists.
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_invert(INT32 args) { MP_INT *modulo;
0226201997-03-10Niels Möller  struct object *res;
79042c1997-03-11Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("invert", 1); modulo = get_mpz(sp-1, 1, "invert", 1, 1);
afcf782003-03-28Martin Stjernholm 
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!mpz_sgn(modulo))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("invert");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
0226201997-03-10Niels Möller  if (mpz_invert(OBTOMPZ(res), THIS, modulo) == 0) {
0620631997-10-29Fredrik Hübinette (Hubbe)  free_object(res);
afcf782003-03-28Martin Stjernholm  Pike_error("Not invertible.\n");
0226201997-03-10Niels Möller  } pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
cd8be42004-09-15Martin Stjernholm /*! @decl Gmp.mpz fac() *! *! Return the factorial of this mpz object. *! *! @throws *! Since factorials grow very quickly, only small integers are *! supported. An error is thrown if the value in this mpz object is *! too large. */ static void mpzmod_fac(INT32 args) { struct object *res; if (mpz_sgn (THIS) < 0) Pike_error ("Cannot calculate factorial for negative integer.\n"); if (!mpz_fits_ulong_p (THIS)) Pike_error ("Integer too large for factorial calculation.\n"); res = fast_clone_object (THIS_PROGRAM); mpz_fac_ui (OBTOMPZ(res), mpz_get_ui (THIS)); pop_n_elems (args); PUSH_REDUCED (res); } /*! @decl Gmp.mpz bin(int k)
7ce9dd2014-08-13Per Hedbor  *!
cd8be42004-09-15Martin Stjernholm  *! Return the binomial coefficient @expr{n@} over @[k], where *! @expr{n@} is the value of this mpz object. Negative values of *! @expr{n@} are supported using the identity *! *! @code *! (-n)->bin(k) == (-1)->pow(k) * (n+k-1)->bin(k) *! @endcode *! *! (See Knuth volume 1, section 1.2.6 part G.) *! *! @throws *! The @[k] value can't be arbitrarily large. An error is thrown if *! it's too large.
1975dd2009-06-28Henrik Grubbström (Grubba)  *! *! @note *! This function is currently (Pike 7.8) not available with old *! releases of the gmp libraries.
cd8be42004-09-15Martin Stjernholm  */ static void mpzmod_bin(INT32 args) { MP_INT *k; struct object *res; if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("bin", 1); k = get_mpz (sp-1, 1, "bin", 1, 1);
cd8be42004-09-15Martin Stjernholm  if (mpz_sgn (k) < 0) Pike_error ("Cannot calculate binomial with negative k value.\n"); if (!mpz_fits_ulong_p (k))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("bin", 1, "Argument too large.\n");
cd8be42004-09-15Martin Stjernholm  res = fast_clone_object(THIS_PROGRAM); mpz_bin_ui (OBTOMPZ (res), THIS, mpz_get_ui (k)); pop_n_elems(args); PUSH_REDUCED(res); }
afcf782003-03-28Martin Stjernholm #define BINFUN(name, errmsg_name, fun) \
aeb59e1999-10-30Fredrik Hübinette (Hubbe) static void name(INT32 args) \ { \ INT32 e; \ struct object *res; \ for(e=0; e<args; e++) \
afcf782003-03-28Martin Stjernholm  get_mpz(sp+e-args, 1, errmsg_name, e + 1, args); \
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \ fun(OBTOMPZ(res), OBTOMPZ(res), \ OBTOMPZ(sp[e-args].u.object)); \ pop_n_elems(args); \ PUSH_REDUCED(res); \ }
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `&(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
de22f72014-08-25Martin Nilsson BINFUN(mpzmod_and, "`&", mpz_and)
815ad12003-04-07Martin Nilsson 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `|(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
de22f72014-08-25Martin Nilsson BINFUN(mpzmod_or, "`|", mpz_ior)
815ad12003-04-07Martin Nilsson 
9866292014-08-25Per Hedbor /*! @decl Gmp.mpz `^(int|float|Gmp.mpz x)
815ad12003-04-07Martin Nilsson  */
de22f72014-08-25Martin Nilsson BINFUN(mpzmod_xor, "`^", mpz_xor)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `~() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_compl(INT32 args) { struct object *o; pop_n_elems(args);
195b1c2003-02-15Henrik Grubbström (Grubba)  o=fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_com(OBTOMPZ(o), THIS);
9b55461999-10-16Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
afcf782003-03-28Martin Stjernholm #define CMPEQU(name,errmsg_name,cmp,default) \
c089471997-04-09Niels Möller static void name(INT32 args) \ { \ INT32 i; \ MP_INT *arg; \
afcf782003-03-28Martin Stjernholm  if(!args) SIMPLE_TOO_FEW_ARGS_ERROR (errmsg_name, 1); \
e9ceac2008-06-29Henrik Grubbström (Grubba)  if (!(arg = get_mpz(sp-args, 0, NULL, 0, 0))) \
195b1c2003-02-15Henrik Grubbström (Grubba)  default; \
c089471997-04-09Niels Möller  else \ i=mpz_cmp(THIS, arg) cmp 0; \
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); \ push_int(i); \ }
d4bf622001-08-13Fredrik Hübinette (Hubbe) #define RET_UNDEFINED do{pop_n_elems(args);push_undefined();return;}while(0)
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) `>(mixed with) */
de22f72014-08-25Martin Nilsson CMPEQU(mpzmod_gt, "`>", >, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `<(mixed with) */
de22f72014-08-25Martin Nilsson CMPEQU(mpzmod_lt, "`<", <, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson  /*! @decl int(0..1) `==(mixed with) */
de22f72014-08-25Martin Nilsson CMPEQU(mpzmod_eq, "`==", ==, RET_UNDEFINED)
815ad12003-04-07Martin Nilsson 
47456b2014-09-01Martin Nilsson /*! @decl int(0..1) probably_prime_p(int count)
cd8be42004-09-15Martin Stjernholm  *! *! Return 1 if this mpz object is a prime, and 0 most of the time if *! it is not.
47456b2014-09-01Martin Nilsson  *! *! @param count *! The prime number testing is using Donald Knuth's probabilistic *! primality test. The chance for a false positive is *! pow(0.25,count). The higher value, the more probable it is that *! the number is a prime. Default value is 25.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_probably_prime_p(INT32 args) {
65a5492000-08-10Per Hedbor  INT_TYPE count;
7da3191997-04-25Niels Möller  if (args) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("probably_prime_p", 1, "int(1..)");
afcf782003-03-28Martin Stjernholm  count = sp[-args].u.integer;
7da3191997-04-25Niels Möller  if (count <= 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("probably_prime_p", 1, "int(1..)");
7da3191997-04-25Niels Möller  } else count = 25;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args);
7da3191997-04-25Niels Möller  push_int(mpz_probab_prime_p(THIS, count)); }
45f4322014-10-14Martin Nilsson /* Define NUMBER_OF_PRIMES and primes[] */ #include "prime_table.out" /* Returns a small factor of n, or 0 if none is found.*/ static unsigned long mpz_small_factor(mpz_t n, int limit) { int i; unsigned long stop; if (limit > NUMBER_OF_PRIMES) limit = NUMBER_OF_PRIMES; stop = mpz_get_ui(n); if (mpz_cmp_ui(n, stop) != 0) stop = ULONG_MAX; stop = (long)sqrt(stop)+1; for (i = 0; (i < limit) && primes[i] < stop; i++) if (mpz_fdiv_ui(n, primes[i]) == 0) return primes[i]; return 0; }
815ad12003-04-07Martin Nilsson /*! @decl int small_factor(void|int(1..) limit) */
7da3191997-04-25Niels Möller static void mpzmod_small_factor(INT32 args) {
65a5492000-08-10Per Hedbor  INT_TYPE limit;
7da3191997-04-25Niels Möller  if (args) {
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-args]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("small_factor", 1, "int(1..)");
afcf782003-03-28Martin Stjernholm  limit = sp[-args].u.integer;
bd44cf1997-04-26Niels Möller  if (limit < 1)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("small_factor", 1, "int(1..)");
7da3191997-04-25Niels Möller  } else limit = INT_MAX; pop_n_elems(args); push_int(mpz_small_factor(THIS, limit)); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz next_prime(void|int count, void|int limit) */
7da3191997-04-25Niels Möller static void mpzmod_next_prime(INT32 args) { struct object *o; pop_n_elems(args);
195b1c2003-02-15Henrik Grubbström (Grubba)  o = fast_clone_object(THIS_PROGRAM);
18a04e2014-05-05Martin Nilsson  mpz_nextprime(OBTOMPZ(o), THIS);
1598411999-10-20Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl int sgn()
d493622013-08-05Martin Nilsson  *! *! Return the sign of the integer, i.e. @expr{1@} for positive *! numbers and @expr{-1@} for negative numbers.
815ad12003-04-07Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sgn(INT32 args) { pop_n_elems(args); push_int(mpz_sgn(THIS)); }
37de6f2003-04-03Martin Nilsson /*! @decl Gmp.mpz sqrt()
cd8be42004-09-15Martin Stjernholm  *! *! Return the the truncated integer part of the square root of this *! mpz object.
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sqrt(INT32 args) {
9a44a41999-10-30Fredrik Noring  struct object *o = 0; /* Make gcc happy. */
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); if(mpz_sgn(THIS)<0)
c7549a2003-01-26Martin Nilsson  Pike_error("Gmp.mpz->sqrt() on negative number.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  o=fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_sqrt(OBTOMPZ(o), THIS);
751aee1999-10-15Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl array(Gmp.mpz) sqrtrem() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_sqrtrem(INT32 args) {
9a44a41999-10-30Fredrik Noring  struct object *root = 0, *rem = 0; /* Make gcc happy. */
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); if(mpz_sgn(THIS)<0)
c7549a2003-01-26Martin Nilsson  Pike_error("Gmp.mpz->sqrtrem() on negative number.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
195b1c2003-02-15Henrik Grubbström (Grubba)  root = fast_clone_object(THIS_PROGRAM); rem = fast_clone_object(THIS_PROGRAM);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_sqrtrem(OBTOMPZ(root), OBTOMPZ(rem), THIS);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(root); PUSH_REDUCED(rem);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  f_aggregate(2); }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `<<(int|float|Gmp.mpz x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_lsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
d96bb82003-02-07Mirar (Pontus Hagland)  MP_INT *mi;
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("`<<", 1);
afcf782003-03-28Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_INT) {
126bf22002-10-15Marcus Comstedt  if(sp[-1].u.integer < 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 1, "Got negative shift count.");
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT if (!FITS_ULONG (sp[-1].u.integer) && mpz_sgn (THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 1, "Shift count too large.");
3275be2003-01-27Mirar (Pontus Hagland) #endif
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_mul_2exp(OBTOMPZ(res), THIS, sp[-1].u.integer); } else {
de22f72014-08-25Martin Nilsson  mi = get_mpz(sp-1, 1, "`<<", 1, 1);
8632802003-10-11Henrik Grubbström (Grubba)  if(mpz_sgn(mi)<0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 1, "Got negative shift count.");
8632802003-10-11Henrik Grubbström (Grubba)  /* Cut off at 1MB ie 0x800000 bits. */ if(!mpz_fits_ulong_p(mi) || (mpz_get_ui(THIS) > 0x800000))
99c6912003-01-27Mirar (Pontus Hagland)  { if(mpz_sgn(THIS))
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`<<", 1, "Shift count too large.");
99c6912003-01-27Mirar (Pontus Hagland)  else { /* Special case: shifting 0 left any number of bits still yields 0 */
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
99c6912003-01-27Mirar (Pontus Hagland)  mpz_set_si(OBTOMPZ(res), 0); }
126bf22002-10-15Marcus Comstedt  } else {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
afcf782003-03-28Martin Stjernholm  mpz_mul_2exp(OBTOMPZ(res), THIS, mpz_get_ui (mi));
126bf22002-10-15Marcus Comstedt  } }
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz `>>(int|float|Gmp.mpz x) */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_rsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("`>>", 1);
afcf782003-03-28Martin Stjernholm 
017b572011-10-28Henrik Grubbström (Grubba)  if(TYPEOF(sp[-1]) == T_INT)
3275be2003-01-27Mirar (Pontus Hagland)  { if (sp[-1].u.integer < 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`>>", 1, "Got negative shift count.");
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT if (!FITS_ULONG (sp[-1].u.integer))
3275be2003-01-27Mirar (Pontus Hagland)  {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
3275be2003-01-27Mirar (Pontus Hagland)  mpz_set_si(OBTOMPZ(res), mpz_sgn(THIS)<0? -1:0); } else #endif {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
3275be2003-01-27Mirar (Pontus Hagland)  mpz_fdiv_q_2exp(OBTOMPZ(res), THIS, sp[-1].u.integer); } }
9c96882003-03-29Martin Stjernholm  else
3275be2003-01-27Mirar (Pontus Hagland)  {
de22f72014-08-25Martin Nilsson  MP_INT *mi = get_mpz(sp-1, 1, "`>>", 1, 1);
afcf782003-03-28Martin Stjernholm  if(!mpz_fits_ulong_p (mi)) { if(mpz_sgn(mi)<0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("`>>", 1, "Got negative shift count.");
afcf782003-03-28Martin Stjernholm  res = fast_clone_object(THIS_PROGRAM); mpz_set_si(OBTOMPZ(res), mpz_sgn(THIS)<0? -1:0); } else { res = fast_clone_object(THIS_PROGRAM); mpz_fdiv_q_2exp(OBTOMPZ(res), THIS, mpz_get_ui (mi)); }
126bf22002-10-15Marcus Comstedt  }
afcf782003-03-28Martin Stjernholm 
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``<<(int|float|Gmp.mpz x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rlsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *mi;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``<<", 1);
8632802003-10-11Henrik Grubbström (Grubba)  if(mpz_sgn(THIS) < 0) Pike_error ("Gmp.mpz->``<<(): Got negative shift count.\n");
de22f72014-08-25Martin Nilsson  mi = get_mpz(sp-1, 1, "``<<", 1, 1);
afcf782003-03-28Martin Stjernholm 
8632802003-10-11Henrik Grubbström (Grubba)  /* Cut off at 1MB ie 0x800000 bits. */ if(!mpz_fits_ulong_p(THIS) || (mpz_get_ui(THIS) > 0x800000)) {
afcf782003-03-28Martin Stjernholm  if(mpz_sgn(mi)) Pike_error ("Gmp.mpz->``<<(): Shift count too large.\n");
126bf22002-10-15Marcus Comstedt  else { /* Special case: shifting 0 left any number of bits still yields 0 */
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_set_si(OBTOMPZ(res), 0); } } else {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
afcf782003-03-28Martin Stjernholm  mpz_mul_2exp(OBTOMPZ(res), mi, mpz_get_ui (THIS));
126bf22002-10-15Marcus Comstedt  }
afcf782003-03-28Martin Stjernholm 
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz ``>>(int|float|Gmp.mpz x) */
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rrsh(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *mi;
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("``>>", 1); mi = get_mpz(sp-1, 1, "``>>", 1, 1);
afcf782003-03-28Martin Stjernholm  if (!mpz_fits_ulong_p (THIS)) { if(mpz_sgn(THIS) < 0) Pike_error ("Gmp.mpz->``>>(): Got negative shift count.\n"); res = fast_clone_object(THIS_PROGRAM); mpz_set_si(OBTOMPZ(res), mpz_sgn(mi)<0? -1:0); } else { res = fast_clone_object(THIS_PROGRAM); mpz_fdiv_q_2exp(OBTOMPZ(res), mi, mpz_get_ui (THIS)); }
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
cd8be42004-09-15Martin Stjernholm /*! @decl Gmp.mpz powm(int|string|float|Gmp.mpz exp,@ *! int|string|float|Gmp.mpz mod) *! *! Return @expr{( this->pow(@[exp]) ) % @[mod]@}. *! *! @seealso *! @[pow]
37de6f2003-04-03Martin Nilsson  */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_powm(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
afcf782003-03-28Martin Stjernholm  MP_INT *n, *e;
0226201997-03-10Niels Möller  if(args != 2)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("powm", 2);
afcf782003-03-28Martin Stjernholm 
de22f72014-08-25Martin Nilsson  e = get_mpz(sp - 2, 1, "powm", 1, 2); n = get_mpz(sp - 1, 1, "powm", 2, 2);
0226201997-03-10Niels Möller  if (!mpz_sgn(n))
de22f72014-08-25Martin Nilsson  SIMPLE_DIVISION_BY_ZERO_ERROR ("powm");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
afcf782003-03-28Martin Stjernholm  mpz_powm(OBTOMPZ(res), THIS, e, n);
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz pow(int|float|Gmp.mpz x)
cd8be42004-09-15Martin Stjernholm  *! *! Return this mpz object raised to @[x]. The case when zero is *! raised to zero yields one. *! *! @seealso *! @[powm]
815ad12003-04-07Martin Nilsson  */
79042c1997-03-11Niels Möller static void mpzmod_pow(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
37c0662013-06-19Arne Goedeke  INT_TYPE i;
d96bb82003-02-07Mirar (Pontus Hagland)  MP_INT *mi;
37c0662013-06-19Arne Goedeke  INT_TYPE size = (INT_TYPE)mpz_size(THIS);
79042c1997-03-11Niels Möller  if (args != 1)
de22f72014-08-25Martin Nilsson  SIMPLE_WRONG_NUM_ARGS_ERROR ("pow", 1);
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) == T_INT) {
37c0662013-06-19Arne Goedeke  INT_TYPE e = sp[-1].u.integer; if (e < 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("pow", 1, "Negative exponent.");
390ccc2003-10-12Henrik Grubbström (Grubba)  /* Cut off at 1 MB. */
aad71c2013-11-03Arne Goedeke  if (INT_TYPE_MUL_OVERFLOW(e, size) || size * e > (INT_TYPE)(0x100000/sizeof(mp_limb_t))) {
ccbc102003-01-26Mirar (Pontus Hagland)  if(mpz_cmp_si(THIS, -1)<0 || mpz_cmp_si(THIS, 1)>0)
99c6912003-01-27Mirar (Pontus Hagland)  goto too_large;
37c0662013-06-19Arne Goedeke  }
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_pow_ui(OBTOMPZ(res), THIS, sp[-1].u.integer); } else {
d96bb82003-02-07Mirar (Pontus Hagland) too_large:
de22f72014-08-25Martin Nilsson  mi = get_mpz(sp-1, 1, "pow", 1, 1);
126bf22002-10-15Marcus Comstedt  if(mpz_sgn(mi)<0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("pow", 1, "Negative exponent.");
126bf22002-10-15Marcus Comstedt  i=mpz_get_si(mi);
390ccc2003-10-12Henrik Grubbström (Grubba)  /* Cut off at 1 MB. */
aad71c2013-11-03Arne Goedeke  if(mpz_cmp_si(mi, i) || INT_TYPE_MUL_OVERFLOW(size, i) || (size*i>(INT_TYPE)(0x100000/sizeof(mp_limb_t))))
99c6912003-01-27Mirar (Pontus Hagland)  { if(mpz_cmp_si(THIS, -1)<0 || mpz_cmp_si(THIS, 1)>0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("pow", 1, "Exponent too large.");
99c6912003-01-27Mirar (Pontus Hagland)  else { /* Special case: these three integers can be raised to any power without overflowing. */
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
99c6912003-01-27Mirar (Pontus Hagland)  switch(mpz_get_si(THIS)) { case 0: mpz_set_si(OBTOMPZ(res), 0); break; case 1: mpz_set_si(OBTOMPZ(res), 1); break; case -1: mpz_set_si(OBTOMPZ(res), mpz_odd_p(mi)? -1:1); break; } } }
126bf22002-10-15Marcus Comstedt  else {
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(THIS_PROGRAM);
126bf22002-10-15Marcus Comstedt  mpz_pow_ui(OBTOMPZ(res), THIS, i); } }
79042c1997-03-11Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
79042c1997-03-11Niels Möller }
815ad12003-04-07Martin Nilsson /*! @decl int(0..1) `!() */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_not(INT32 args) { pop_n_elems(args); push_int(!mpz_sgn(THIS)); }
815ad12003-04-07Martin Nilsson /*! @decl int popcount()
0620ff2003-08-07Johan Sundström  *! For values >= 0, returns the population count (the number of set bits). *! For negative values (who have an infinite number of leading ones in a *! binary representation), -1 is returned.
815ad12003-04-07Martin Nilsson  */
78130c1998-07-19Niels Möller static void mpzmod_popcount(INT32 args) { pop_n_elems(args);
91d0102014-10-14Martin Nilsson  push_int(mpz_popcount(THIS));
9c96882003-03-29Martin Stjernholm #ifdef BIG_PIKE_INT
2dd8c12003-01-27Mirar (Pontus Hagland) /* need conversion from MAXUINT32 to -1 (otherwise it's done already) */ if (Pike_sp[-1].u.integer==0xffffffffLL) Pike_sp[-1].u.integer=-1; #endif
78130c1998-07-19Niels Möller }
815ad12003-04-07Martin Nilsson /*! @decl Gmp.mpz _random() */ static void mpzmod_random(INT32 args) { struct object *res = 0; /* Make gcc happy. */ pop_n_elems(args);
03cc312003-06-10Henrik Grubbström (Grubba)  args = 0;
815ad12003-04-07Martin Nilsson  if(mpz_sgn(THIS) <= 0) Pike_error("Random on negative number.\n");
03cc312003-06-10Henrik Grubbström (Grubba)  push_object(res=fast_clone_object(THIS_PROGRAM)); /* We add four to assure reasonably uniform randomness */ push_int(mpz_size(THIS)*sizeof(mp_limb_t) + 4); f_random_string(1);
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_STRING) {
e494ac2004-11-14Martin Nilsson  Pike_error("random_string(%ld) returned non string.\n",
03cc312003-06-10Henrik Grubbström (Grubba)  mpz_size(THIS)*sizeof(mp_limb_t) + 4); } get_mpz_from_digits(OBTOMPZ(res), sp[-1].u.string, 256); pop_stack();
815ad12003-04-07Martin Nilsson  mpz_fdiv_r(OBTOMPZ(res), OBTOMPZ(res), THIS); /* modulo */
03cc312003-06-10Henrik Grubbström (Grubba)  Pike_sp--; dmalloc_touch_svalue(Pike_sp);
815ad12003-04-07Martin Nilsson  PUSH_REDUCED(res); }
176e052009-11-17Henrik Grubbström (Grubba)  /*! @decl string(0..255) _encode() */ static void mpzmod__encode(INT32 args) { pop_n_elems(args); /* 256 would be better, but then negative numbers * won't work... /Hubbe */ push_int(36); mpzmod_digits(1); } /*! @decl void _decode(string(0..255)) */ static void mpzmod__decode(INT32 args) { /* 256 would be better, but then negative numbers * won't work... /Hubbe */ push_int(36); mpzmod_create(args+1); }
815ad12003-04-07Martin Nilsson /*! @endclass */ /*! @decl Gmp.mpz fac(int x)
0620ff2003-08-07Johan Sundström  *! Returns the factorial of @[x] (@[x]!).
815ad12003-04-07Martin Nilsson  */
79042c1997-03-11Niels Möller static void gmp_fac(INT32 args) {
cb787a2000-08-24Henrik Grubbström (Grubba)  struct object *res = NULL;
79042c1997-03-11Niels Möller  if (args != 1)
b2d3e42000-12-01Fredrik Hübinette (Hubbe)  Pike_error("Gmp.fac: Wrong number of arguments.\n");
017b572011-10-28Henrik Grubbström (Grubba)  if (TYPEOF(sp[-1]) != T_INT)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_TYPE_ERROR ("fac", 1, "int");
79042c1997-03-11Niels Möller  if (sp[-1].u.integer < 0)
de22f72014-08-25Martin Nilsson  SIMPLE_ARG_ERROR ("fac", 1, "Got negative exponent.");
195b1c2003-02-15Henrik Grubbström (Grubba)  res = fast_clone_object(mpzmod_program);
79042c1997-03-11Niels Möller  mpz_fac_ui(OBTOMPZ(res), sp[-1].u.integer); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
79042c1997-03-11Niels Möller }
42918d1999-10-25Fredrik Hübinette (Hubbe) 
b359622014-07-28Per Hedbor #define LIMBS(X) THIS->_mp_alloc static void mpzmod__size_object(INT32 UNUSED(args)) { push_int(LIMBS(THIS)*sizeof(mp_limb_t)+sizeof(mpz_t)); }
74dfe82012-12-30Jonas Walldén static void init_mpz_glue(struct object * UNUSED(o))
a80a9c1997-02-11Fredrik Hübinette (Hubbe) { mpz_init(THIS); }
74dfe82012-12-30Jonas Walldén static void exit_mpz_glue(struct object *UNUSED(o))
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
b359622014-07-28Per Hedbor  if( Pike_fp->current_object->flags & OBJECT_CLEAR_ON_EXIT ) memset( THIS->_mp_d, 0,LIMBS(THIS) * sizeof(mp_limb_t));
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_clear(THIS); }
ad8d052008-05-02Martin Stjernholm  static void gc_recurse_mpz (struct object *o) {
b3f6732008-05-11Martin Stjernholm  if (mc_count_bytes (o))
b359622014-07-28Per Hedbor  mc_counted_bytes += LIMBS(THIS)*sizeof (mp_limb_t) + sizeof (mpz_t);
ad8d052008-05-02Martin Stjernholm }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
51ef5c2002-10-21Marcus Comstedt PIKE_MODULE_EXIT
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
df867c2001-09-04Fredrik Hübinette (Hubbe)  pike_exit_mpf_module();
d4bf622001-08-13Fredrik Hübinette (Hubbe)  pike_exit_mpq_module();
04e1c31999-11-23Fredrik Hübinette (Hubbe)  if(mpzmod_program) { free_program(mpzmod_program); mpzmod_program=0; }
0311712013-06-17Martin Nilsson  if(bignum_program)
04e1c31999-11-23Fredrik Hübinette (Hubbe)  {
0311712013-06-17Martin Nilsson  free_program(bignum_program); bignum_program=0; } mpz_clear (mpz_int_type_min);
982a0c2003-03-28Martin Stjernholm #ifdef INT64
0311712013-06-17Martin Nilsson  mpz_clear (mpz_int64_min);
982a0c2003-03-28Martin Stjernholm #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
64474b2008-03-28Martin Stjernholm static void *pike_mp_alloc (size_t alloc_size) { void *ret = malloc (alloc_size); if (!ret) /* According to gmp docs, we're neither allowed to return zero nor * longjmp here. */ Pike_fatal ("Failed to allocate %"PRINTSIZET"db in gmp library.\n", alloc_size); return ret; } static void *pike_mp_realloc (void *ptr, size_t old_size, size_t new_size) { void *ret = realloc (ptr, new_size); if (!ret) /* According to gmp docs, we're neither allowed to return zero nor * longjmp here. */ Pike_fatal ("Failed to reallocate %"PRINTSIZET"db block " "to %"PRINTSIZET"db in gmp library.\n", old_size, new_size); return ret; }
74dfe82012-12-30Jonas Walldén static void pike_mp_free (void *ptr, size_t UNUSED(size))
64474b2008-03-28Martin Stjernholm { free (ptr); }
d412602008-03-28Martin Stjernholm  #define tMpz_arg tOr3(tInt,tFloat,tObj) #define tMpz_ret tObjIs_GMP_MPZ #define tMpz_shift_type tFunc(tMpz_arg,tMpz_ret) #define tMpz_binop_type tFuncV(tNone, tMpz_arg, tMpz_ret) #define tMpz_cmpop_type tFunc(tMixed, tInt01)
0957531999-10-25Fredrik Hübinette (Hubbe) #define MPZ_DEFS() \ ADD_STORAGE(MP_INT); \ \
9e3e5a2001-09-24Henrik Grubbström (Grubba)  /* function(void|string|int|float|object:void)" */ \ /* "|function(string,int:void) */ \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("create", mpzmod_create, \ tOr(tFunc(tOr5(tVoid,tStr,tInt,tFlt, \ tObj),tVoid), \
ecc9382008-06-29Martin Nilsson  tFunc(tStr tInt,tVoid)), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`+",mpzmod_add,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`+=",mpzmod_add_eq,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``+",mpzmod_add_rhs,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`-",mpzmod_sub,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``-",mpzmod_rsub,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`*",mpzmod_mul,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``*",mpzmod_mul,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`/",mpzmod_div,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``/",mpzmod_rdiv,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`%",mpzmod_mod,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``%",mpzmod_rmod,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`&",mpzmod_and,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``&",mpzmod_and,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`|",mpzmod_or,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``|",mpzmod_or,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`^",mpzmod_xor,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("``^",mpzmod_xor,tMpz_binop_type, ID_PROTECTED); \ ADD_FUNCTION("`~",mpzmod_compl,tFunc(tNone,tObj), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`<<",mpzmod_lsh,tMpz_shift_type, ID_PROTECTED); \ ADD_FUNCTION("`>>",mpzmod_rsh,tMpz_shift_type, ID_PROTECTED); \ ADD_FUNCTION("``<<",mpzmod_rlsh,tMpz_shift_type, ID_PROTECTED); \ ADD_FUNCTION("``>>",mpzmod_rrsh,tMpz_shift_type, ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`>", mpzmod_gt,tMpz_cmpop_type, ID_PROTECTED); \ ADD_FUNCTION("`<", mpzmod_lt,tMpz_cmpop_type, ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`==",mpzmod_eq,tMpz_cmpop_type, ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("`!",mpzmod_not,tFunc(tNone,tInt01), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
ecc9382008-06-29Martin Nilsson  ADD_FUNCTION("__hash",mpzmod___hash,tFunc(tNone,tInt), ID_PROTECTED); \
696ae12014-10-28Per Hedbor  ADD_FUNCTION("cast",mpzmod_cast,tFunc(tStr,tMix), ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
815ad12003-04-07Martin Nilsson  ADD_FUNCTION("_is_type", mpzmod__is_type, tFunc(tStr,tInt01), \
ecc9382008-06-29Martin Nilsson  ID_PROTECTED); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
19426a2013-05-19Martin Nilsson  ADD_FUNCTION("digits", mpzmod_digits,tFunc(tOr(tVoid,tInt),tStr8), 0);\
9e74322010-05-29Martin Stjernholm  ADD_FUNCTION("encode_json", mpzmod_get_string, \
19426a2013-05-19Martin Nilsson  tFunc(tOr(tVoid,tInt) tOr(tVoid,tInt),tStr7), 0); \
815ad12003-04-07Martin Nilsson  ADD_FUNCTION("_sprintf", mpzmod__sprintf, tFunc(tInt tMapping,tStr), \
ecc9382008-06-29Martin Nilsson  ID_PROTECTED); \
b359622014-07-28Per Hedbor  ADD_FUNCTION("_size_object",mpzmod__size_object, tFunc(tVoid,tInt),0);\
9eeb732014-04-12Henrik Grubbström (Grubba)  ADD_FUNCTION("size", mpzmod_size,tFunc(tOr(tVoid,tInt),tIntPos), 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
0ba4eb2014-08-18Martin Nilsson  ADD_FUNCTION("cast_to_int",mpzmod_get_int,tDeprecated(tFunc(tNone,tInt)),0); \ ADD_FUNCTION("cast_to_string",mpzmod_get_string,tDeprecated(tFunc(tNone,tStr7)),0); \ ADD_FUNCTION("cast_to_float",mpzmod_get_float,tDeprecated(tFunc(tNone,tFlt)),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ ADD_FUNCTION("probably_prime_p",mpzmod_probably_prime_p, \
47456b2014-09-01Martin Nilsson  tFunc(tOr(tVoid,tIntPos),tInt01),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("small_factor", mpzmod_small_factor, \ tFunc(tOr(tInt,tVoid),tInt), 0); \ ADD_FUNCTION("next_prime", mpzmod_next_prime, \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  tFunc(tOr(tInt,tVoid) tOr(tInt,tVoid),tMpz_ret), 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("gcd",mpzmod_gcd, tMpz_binop_type, 0); \ ADD_FUNCTION("gcdext",mpzmod_gcdext,tFunc(tMpz_arg,tArr(tMpz_ret)),0);\ ADD_FUNCTION("gcdext2",mpzmod_gcdext2,tFunc(tMpz_arg,tArr(tMpz_ret)),0);\ ADD_FUNCTION("invert", mpzmod_invert,tFunc(tMpz_arg,tMpz_ret),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
cd8be42004-09-15Martin Stjernholm  ADD_FUNCTION("fac", mpzmod_fac, tFunc(tNone,tMpz_ret), 0); \
91d0102014-10-14Martin Nilsson  ADD_FUNCTION("bin", mpzmod_bin, tFunc(tMpz_arg,tMpz_ret), 0); \
195b1c2003-02-15Henrik Grubbström (Grubba)  ADD_FUNCTION("sgn", mpzmod_sgn, tFunc(tNone,tInt), 0); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("sqrt", mpzmod_sqrt,tFunc(tNone,tMpz_ret),0); \
9a44a41999-10-30Fredrik Noring  ADD_FUNCTION("_sqrt", mpzmod_sqrt,tFunc(tNone,tMpz_ret),0); \
91d0102014-10-14Martin Nilsson  ADD_FUNCTION("sqrtrem",mpzmod_sqrtrem,tFunc(tNone,tArr(tMpz_ret)),0); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("powm",mpzmod_powm,tFunc(tMpz_arg tMpz_arg,tMpz_ret),0); \
126bf22002-10-15Marcus Comstedt  ADD_FUNCTION("pow", mpzmod_pow,tMpz_shift_type, 0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \ ADD_FUNCTION("popcount", mpzmod_popcount,tFunc(tVoid,tInt), 0); \ \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("_random",mpzmod_random,tFunc(tNone,tMpz_ret),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  \
176e052009-11-17Henrik Grubbström (Grubba)  ADD_FUNCTION("_encode",mpzmod__encode,tFunc(tNone,tStr8),0); \ \ ADD_FUNCTION("_decode",mpzmod__decode,tFunc(tStr8,tVoid),0); \ \
0957531999-10-25Fredrik Hübinette (Hubbe)  set_init_callback(init_mpz_glue); \
ad8d052008-05-02Martin Stjernholm  set_exit_callback(exit_mpz_glue); \ set_gc_recurse_callback (gc_recurse_mpz);
45ee5d1999-02-10Fredrik Hübinette (Hubbe) 
51ef5c2002-10-21Marcus Comstedt PIKE_MODULE_INIT
0957531999-10-25Fredrik Hübinette (Hubbe) {
88f57f2009-10-28Henrik Grubbström (Grubba)  init_crc_table();
64474b2008-03-28Martin Stjernholm  /* Make sure that gmp uses the same malloc functions as we do since * we got code that frees blocks allocated inside gmp (e.g. * mpf.get_string). This also ensures that gmp uses dlmalloc if we * do on Windows. In case gmp already uses the same malloc, this is * essentially just a NOP. */ mp_set_memory_functions (pike_mp_alloc, pike_mp_realloc, pike_mp_free);
0957531999-10-25Fredrik Hübinette (Hubbe)  start_new_program();
78130c1998-07-19Niels Möller 
0957531999-10-25Fredrik Hübinette (Hubbe)  MPZ_DEFS();
42918d1999-10-25Fredrik Hübinette (Hubbe) 
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #if 0 /* These are not implemented yet */
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(:int) */
e64f5a1999-06-19Fredrik Hübinette (Hubbe)  ADD_FUNCTION("squarep", mpzmod_squarep,tFunc(tNone,tInt), 0);
9ee2e52002-10-15Marcus Comstedt  ADD_FUNCTION("divmod", mpzmod_divmod, tFunc(tMpz_arg,tArr(tMpz_ret)), 0); ADD_FUNCTION("divm", mpzmod_divm, tFunc(tMpz_arg tMpz_arg,tMpz_ret), 0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
42918d1999-10-25Fredrik Hübinette (Hubbe) 
e9ce612001-03-29Per Hedbor  mpzmod_program=end_program(); mpzmod_program->id = PROG_GMP_MPZ_ID; add_program_constant("mpz", mpzmod_program, 0);
0226201997-03-10Niels Möller 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(int:object) */ ADD_FUNCTION("fac", gmp_fac,tFunc(tInt,tObj), 0);
79042c1997-03-11Niels Möller 
0311712013-06-17Martin Nilsson  /* This program autoconverts to integers, Gmp.mpz does not!! * magic? no, just an if statement :) /Hubbe */ start_new_program();
0957531999-10-25Fredrik Hübinette (Hubbe) 
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #undef tMpz_ret #define tMpz_ret tInt
0311712013-06-17Martin Nilsson  /* I first tried to just do an inherit here, but it becomes too hard * to tell the programs apart when I do that.. /Hubbe */ MPZ_DEFS();
0957531999-10-25Fredrik Hübinette (Hubbe) 
dffabf2014-02-24Per Hedbor  add_program_constant("bignum", bignum_program=end_program(), 0);
2b1c922013-12-24Henrik Grubbström (Grubba)  bignum_program->id = PROG_GMP_BIGNUM_ID;
0311712013-06-17Martin Nilsson  bignum_program->flags |= PROGRAM_NO_WEAK_FREE | PROGRAM_NO_EXPLICIT_DESTRUCT | PROGRAM_CONSTANT ;
982a0c2003-03-28Martin Stjernholm 
0311712013-06-17Martin Nilsson  mpz_init (mpz_int_type_min); mpz_setbit (mpz_int_type_min, INT_TYPE_BITS); mpz_neg (mpz_int_type_min, mpz_int_type_min);
dffabf2014-02-24Per Hedbor 
982a0c2003-03-28Martin Stjernholm #ifdef INT64
0311712013-06-17Martin Nilsson  mpz_init (mpz_int64_min); mpz_setbit (mpz_int64_min, INT64_BITS); mpz_neg (mpz_int64_min, mpz_int64_min);
982a0c2003-03-28Martin Stjernholm #endif
d4bf622001-08-13Fredrik Hübinette (Hubbe)  pike_init_mpq_module();
df867c2001-09-04Fredrik Hübinette (Hubbe)  pike_init_mpf_module();
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
a3edd72002-03-08Martin Nilsson /*! @endmodule */