a80a9c1997-02-11Fredrik Hübinette (Hubbe) /*\ ||| This file a part of Pike, and is copyright by Fredrik Hubinette ||| Pike is distributed as GPL (General Public License) ||| See the files COPYING and DISCLAIMER for more information. \*/ #include "global.h"
310f601999-11-01Mirar (Pontus Hagland) RCSID("$Id: mpz_glue.c,v 1.64 1999/11/01 15:21:57 mirar Exp $");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #include "gmp_machine.h"
8e721c1998-07-11Henrik Grubbström (Grubba) #if defined(HAVE_GMP2_GMP_H) && defined(HAVE_LIBGMP2) #define USE_GMP2 #else /* !HAVE_GMP2_GMP_H || !HAVE_LIBGMP2 */ #if defined(HAVE_GMP_H) && defined(HAVE_LIBGMP) #define USE_GMP #endif /* HAVE_GMP_H && HAVE_LIBGMP */ #endif /* HAVE_GMP2_GMP_H && HAVE_LIBGMP2 */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
8e721c1998-07-11Henrik Grubbström (Grubba) #if defined(USE_GMP) || defined(USE_GMP2)
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"
9c6f7d1997-04-15Fredrik Hübinette (Hubbe) #include "error.h" #include "builtin_functions.h" #include "opcodes.h"
7da3191997-04-25Niels Möller #include "module_support.h"
fda0de1999-10-08Fredrik Noring #include "bignum.h"
10f5031999-10-21Fredrik Noring #include "operators.h"
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
7da3191997-04-25Niels Möller #include "my_gmp.h" #include <limits.h>
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
18e3291999-08-06Fredrik Hübinette (Hubbe) #ifdef _MSC_VER /* No random()... provide one for gmp * This should possibly be a configure test * /Hubbe */ long random(void) { return my_rand(); } #endif
4690901998-04-23Fredrik Hübinette (Hubbe) #undef THIS
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #define THIS ((MP_INT *)(fp->current_storage)) #define OBTOMPZ(o) ((MP_INT *)(o->storage))
0957531999-10-25Fredrik Hübinette (Hubbe) #define THIS_PROGRAM (fp->context.prog)
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  static struct program *mpzmod_program;
0957531999-10-25Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM static struct program *bignum_program; #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
110b3f1999-10-29Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM static void reduce(struct object *o) { INT_TYPE i; i = mpz_get_si(OBTOMPZ(o)); if(mpz_cmp_si(OBTOMPZ(o), i) == 0) { free_object(o); push_int(i); }else{ push_object(o); } } #define PUSH_REDUCED(o) do { struct object *reducetmp__=(o); \ if(THIS_PROGRAM == bignum_program) \ reduce(reducetmp__); \ else \ push_object(reducetmp__); \ }while(0) #else #define PUSH_REDUCED(o) push_object(o) #endif /* AUTO_BIGNUM */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void get_mpz_from_digits(MP_INT *tmp, struct pike_string *digits, int base) { if(!base || ((base >= 2) && (base <= 36))) {
5656451999-10-26Fredrik Noring  int offset = 0; /* We need to fix the case with binary 0b101... and -0b101... numbers. */ if(base == 0 && digits->len > 2) { if(INDEX_CHARP(digits->str, 0, digits->size_shift) == '-') offset += 1; if((INDEX_CHARP(digits->str, offset, digits->size_shift) == '0') && ((INDEX_CHARP(digits->str, offset+1, digits->size_shift) == 'b') || (INDEX_CHARP(digits->str, offset+1, digits->size_shift) == 'B'))) { offset += 2; base = 2; } else offset = 0; } if (mpz_set_str(tmp, digits->str + offset, base))
310f601999-11-01Mirar (Pontus Hagland)  error("invalid digits, cannot convert to mpz\n");
5656451999-10-26Fredrik Noring  if(offset == 3) { /* This means a negative binary number. */ mpz_neg(tmp, tmp); }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else if(base == 256) {
97b2481997-04-18Niels Möller  int i;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_t digit; mpz_init(digit); mpz_set_ui(tmp, 0); for (i = 0; i < digits->len; i++) { mpz_set_ui(digit, EXTRACT_UCHAR(digits->str + i)); mpz_mul_2exp(digit, digit, (digits->len - i - 1) * 8); mpz_ior(tmp, tmp, digit); }
d0fe741997-06-04Niels Möller  mpz_clear(digit);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } else { error("invalid base.\n"); } } static void get_new_mpz(MP_INT *tmp, struct svalue *s) { switch(s->type)
0226201997-03-10Niels Möller  { case T_INT: mpz_set_si(tmp, (signed long int) s->u.integer); break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  case T_FLOAT: mpz_set_d(tmp, (double) s->u.float_number); break;
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  case T_OBJECT:
0957531999-10-25Fredrik Hübinette (Hubbe)  if(s->u.object->prog != mpzmod_program #ifdef AUTO_BIGNUM && s->u.object->prog != bignum_program #endif )
0226201997-03-10Niels Möller  error("Wrong type of object, cannot convert to mpz.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0226201997-03-10Niels Möller  mpz_set(tmp, OBTOMPZ(s->u.object)); 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) || (ITEM(s->u.array)[0].type != T_STRING) || (ITEM(s->u.array)[1].type != T_INT)) error("cannot convert array to mpz.\n"); 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
0226201997-03-10Niels Möller  default: error("cannot convert argument to mpz.\n"); }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) } static void mpzmod_create(INT32 args) { switch(args) { case 1: if(sp[-args].type == T_STRING) get_mpz_from_digits(THIS, sp[-args].u.string, 0); else get_new_mpz(THIS, sp-args); break; case 2: /* Args are string of digits and integer base */ if(sp[-args].type != T_STRING)
310f601999-11-01Mirar (Pontus Hagland)  error("bad argument 1 for Mpz->create()\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (sp[1-args].type != T_INT)
310f601999-11-01Mirar (Pontus Hagland)  error("wrong type for base in Mpz->create()\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  get_mpz_from_digits(THIS, sp[-args].u.string, sp[1-args].u.integer); break; default: error("Too many arguments to Mpz->create()\n"); case 0: break; /* Needed by AIX cc */ } pop_n_elems(args); } static void mpzmod_get_int(INT32 args) { pop_n_elems(args);
110b3f1999-10-29Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM add_ref(fp->current_object); reduce(fp->current_object); #else
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  push_int(mpz_get_si(THIS));
110b3f1999-10-29Fredrik Hübinette (Hubbe) #endif /* AUTO_BIGNUM */
a80a9c1997-02-11Fredrik Hübinette (Hubbe) } static void mpzmod_get_float(INT32 args) { pop_n_elems(args); push_float((float)mpz_get_d(THIS)); } static struct pike_string *low_get_digits(MP_INT *mpz, int base) {
3ef2481999-10-22Fredrik Noring  struct pike_string *s = 0; /* Make gcc happy. */
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  INT32 len; 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++; s->len=len; s=end_shared_string(s); } else if (base == 256) {
9305551998-01-30Henrik Grubbström (Grubba)  unsigned INT32 i;
3445e71998-01-30Mirar (Pontus Hagland) #if 0
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_t tmp;
3445e71998-01-30Mirar (Pontus Hagland) #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (mpz_sgn(mpz) < 0) error("only non-negative numbers can be converted to base 256.\n");
3445e71998-01-30Mirar (Pontus Hagland) #if 0
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  len = (mpz_sizeinbase(mpz, 2) + 7) / 8; s = begin_shared_string(len); mpz_init_set(tmp, mpz); i = len; while(i--) { s->str[i] = mpz_get_ui(tmp) & 0xff;
806a2c1997-04-28Fredrik Hübinette (Hubbe)  mpz_fdiv_q_2exp(tmp, tmp, 8);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  } mpz_clear(tmp);
3445e71998-01-30Mirar (Pontus Hagland) #endif /* lets optimize this /Mirar & Per */
2618ee1998-02-11Niels Möller  /* len = mpz->_mp_size*sizeof(mp_limb_t); */ /* This function should not return any leading zeros. /Nisse */ len = (mpz_sizeinbase(mpz, 2) + 7) / 8;
3445e71998-01-30Mirar (Pontus Hagland)  s = begin_shared_string(len);
1323f01998-02-11Niels Möller  if (!mpz->_mp_size)
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. */ if (len != 1) fatal("mpz->low_get_digits: strange mpz state!\n"); s->str[0] = 0; } else { mp_limb_t *src = mpz->_mp_d;
c66a901998-04-30Henrik Grubbström (Grubba)  unsigned char *dst = (unsigned char *)s->str+s->len;
1323f01998-02-11Niels Möller  while (len > 0) { mp_limb_t x=*(src++); for (i=0; i<sizeof(mp_limb_t); i++)
78130c1998-07-19Niels Möller  {
3445e71998-01-30Mirar (Pontus Hagland)  *(--dst)=x&0xff,x>>=8;
78130c1998-07-19Niels Möller  if (!--len) break; }
1323f01998-02-11Niels Möller  }
3445e71998-01-30Mirar (Pontus Hagland)  }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  s = end_shared_string(s); } else { error("invalid base.\n"); return 0; /* Make GCC happy */ } return s; } static void mpzmod_get_string(INT32 args) { pop_n_elems(args); push_string(low_get_digits(THIS, 10)); } 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 { if (sp[-args].type != T_INT) error("Bad argument 1 for Mpz->digits().\n"); base = sp[-args].u.integer; }
2ac3721997-09-07Niels Möller  s = low_get_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) }
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;
310f601999-11-01Mirar (Pontus Hagland)  INT_TYPE flag_left;
10f5031999-10-21Fredrik Noring  if(args < 1 || sp[-args].type != T_INT) error("Bad argument 1 for Mpz->_sprintf().\n");
4f8deb1999-10-26Fredrik Noring  if(args < 2 || sp[1-args].type != T_MAPPING) error("Bad argument 2 for Mpz->_sprintf().\n"); push_svalue(&sp[1-args]); push_constant_text("precision"); f_index(2); if(sp[-1].type != T_INT)
310f601999-11-01Mirar (Pontus Hagland)  error("\"precision\" argument to Mpz->_sprintf() is not an integer.\n");
4f8deb1999-10-26Fredrik Noring  precision = (--sp)->u.integer;
eccd0a1999-10-29Fredrik Noring  push_svalue(&sp[1-args]); push_constant_text("width"); f_index(2); if(sp[-1].type != T_INT)
310f601999-11-01Mirar (Pontus Hagland)  error("\"width\" argument to Mpz->_sprintf() is not an integer.\n");
eccd0a1999-10-29Fredrik Noring  width_undecided = ((sp-1)->subtype != NUMBER_NUMBER); width = (--sp)->u.integer;
310f601999-11-01Mirar (Pontus Hagland)  push_svalue(&sp[1-args]); push_constant_text("flag_left"); f_index(2); if(sp[-1].type != T_INT) error("\"flag_left\" argument to Mpz->_sprintf() is not an integer.\n"); flag_left=sp[-1].u.integer; pop_stack();
10f5031999-10-21Fredrik Noring  switch(sp[-args].u.integer) {
4f8deb1999-10-26Fredrik Noring  case 'O': case 'u': /* Note: 'u' is not really supported. */ case 'd': s = low_get_digits(THIS, 10); 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); s = low_get_digits(mask, base); mpz_clear(mask); } else s = low_get_digits(THIS, base); break;
eccd0a1999-10-29Fredrik Noring  case 'c': { INT_TYPE length, neg = 0; unsigned char *dst; mp_limb_t *src; mpz_t tmp; MP_INT *n; INT_TYPE i; length = THIS->_mp_size; if(width_undecided) { p_wchar2 ch = mpz_get_ui(THIS); if(length<0) ch = (~ch)+1; s = make_shared_binary_string2(&ch, 1); break; } if(length < 0) { mpz_init_set(tmp, THIS); mpz_add_ui(tmp, tmp, 1); length = -tmp->_mp_size; n = tmp; neg = 1; } 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  src = n->_mp_d; while(width > 0) { mp_limb_t x = (length-->0? *(src++) : 0);
310f601999-11-01Mirar (Pontus Hagland)  if (!flag_left) for(i = 0; i < (INT_TYPE)sizeof(mp_limb_t); i++) { *(--dst) = (neg ? ~x : x) & 0xff; x >>= 8; if(!--width) break; } else for(i = 0; i < (INT_TYPE)sizeof(mp_limb_t); i++) { *(dst++) = (neg ? ~x : x) & 0xff; x >>= 8; if(!--width) break; }
eccd0a1999-10-29Fredrik Noring  } if(neg) { mpz_clear(tmp); } s = end_shared_string(s); } break;
10f5031999-10-21Fredrik Noring  } pop_n_elems(args); if(s) push_string(s);
eccd0a1999-10-29Fredrik Noring  else {
10f5031999-10-21Fredrik Noring  push_int(0); /* Push false? */
eccd0a1999-10-29Fredrik Noring  sp[-1].subtype = 1; }
10f5031999-10-21Fredrik Noring } static void mpzmod__is_type(INT32 args) { INT32 r = 0; if(args < 1 || sp[-args].type != T_STRING) error("Bad argument 1 for Mpz->_is_type().\n"); pop_n_elems(args-1); push_constant_text("int"); f_eq(2); }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_size(INT32 args) { int base; if (!args) { /* Default is number of bits */ base = 2; } else { if (sp[-args].type != T_INT) error("bad argument 1 for Mpz->size()\n"); base = sp[-args].u.integer; if ((base != 256) && ((base < 2) || (base > 36))) error("invalid base\n"); } pop_n_elems(args); if (base == 256) push_int((mpz_sizeinbase(THIS, 2) + 7) / 8); else push_int(mpz_sizeinbase(THIS, base)); } static void mpzmod_cast(INT32 args) {
9305551998-01-30Henrik Grubbström (Grubba)  struct pike_string *s;
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(args < 1) error("mpz->cast() called without arguments.\n"); if(sp[-args].type != T_STRING) error("Bad argument 1 to mpz->cast().\n");
9305551998-01-30Henrik Grubbström (Grubba)  s = sp[-args].u.string;
d6ac731998-04-20Henrik Grubbström (Grubba)  add_ref(s);
9305551998-01-30Henrik Grubbström (Grubba)  pop_n_elems(args); switch(s->str[0])
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { case 'i':
b660c81999-03-01Fredrik Hübinette (Hubbe)  if(!strncmp(s->str, "int", 3))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
eccd0a1999-10-29Fredrik Noring  free_string(s);
9305551998-01-30Henrik Grubbström (Grubba)  mpzmod_get_int(0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return; } break; case 's':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "string"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
9305551998-01-30Henrik Grubbström (Grubba)  free_string(s); mpzmod_get_string(0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return; } break; case 'f':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "float"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  {
9305551998-01-30Henrik Grubbström (Grubba)  free_string(s); mpzmod_get_float(0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return; } break; case 'o':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "object"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { push_object(this_object()); } break; case 'm':
9305551998-01-30Henrik Grubbström (Grubba)  if(!strcmp(s->str, "mixed"))
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  { push_object(this_object()); } break; }
9305551998-01-30Henrik Grubbström (Grubba)  push_string(s); /* To get it freed when error() pops the stack. */ error("mpz->cast() to \"%s\" is other type than string, int or float.\n", s->str);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
3c0c281998-01-26Fredrik Hübinette (Hubbe) #ifdef DEBUG_MALLOC #define get_mpz(X,Y) \ (debug_get_mpz((X),(Y)),( (X)->type==T_OBJECT? debug_malloc_touch((X)->u.object) :0 ),debug_get_mpz((X),(Y))) #else #define get_mpz debug_get_mpz #endif
0226201997-03-10Niels Möller /* Converts an svalue, located on the stack, to an mpz object */
3c0c281998-01-26Fredrik Hübinette (Hubbe) static MP_INT *debug_get_mpz(struct svalue *s, int throw_error)
a80a9c1997-02-11Fredrik Hübinette (Hubbe) {
05158a1998-04-10Fredrik Hübinette (Hubbe) #define MPZ_ERROR(x) if (throw_error) error(x)
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  struct object *o; switch(s->type) { default:
05158a1998-04-10Fredrik Hübinette (Hubbe)  MPZ_ERROR("Wrong type of object, cannot convert to mpz.\n");
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return 0; case T_INT: case T_FLOAT: #if 0 case T_STRING: case T_ARRAY: #endif
e709751997-03-12Fredrik Hübinette (Hubbe)  o=clone_object(mpzmod_program,0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  get_new_mpz(OBTOMPZ(o), s); free_svalue(s); s->u.object=o; s->type=T_OBJECT; return (MP_INT *)o->storage; case T_OBJECT:
0957531999-10-25Fredrik Hübinette (Hubbe)  if(s->u.object->prog != mpzmod_program #ifdef AUTO_BIGNUM && s->u.object->prog != bignum_program #endif )
c089471997-04-09Niels Möller  {
05158a1998-04-10Fredrik Hübinette (Hubbe)  MPZ_ERROR("Wrong type of object, cannot convert to mpz.\n");
c089471997-04-09Niels Möller  return 0; }
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  return (MP_INT *)s->u.object->storage; }
c089471997-04-09Niels Möller #undef ERROR
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) 
fda0de1999-10-08Fredrik Noring 
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #define BINFUN2(name, fun) \ static void name(INT32 args) \ { \ INT32 e; \ struct object *res; \ for(e=0; e<args; e++) \ if(sp[e-args].type != T_INT || sp[e-args].u.integer<=0) \ get_mpz(sp+e-args, 1); \ res = fast_clone_object(THIS_PROGRAM, 0); \ mpz_set(OBTOMPZ(res), THIS); \ for(e=0;e<args;e++) \ if(sp[e-args].type != T_INT) \ 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); \ } \ \ static void PIKE_CONCAT(name,_eq)(INT32 args) \ { \ INT32 e; \ for(e=0; e<args; e++) \ if(sp[e-args].type != T_INT || sp[e-args].u.integer<=0) \ get_mpz(sp+e-args, 1); \ for(e=0;e<args;e++) \ if(sp[e-args].type != T_INT) \ fun(THIS, THIS, OBTOMPZ(sp[e-args].u.object)); \ else \ PIKE_CONCAT(fun,_ui)(THIS,THIS, sp[e-args].u.integer); \ add_ref(fp->current_object); \ PUSH_REDUCED(fp->current_object); \
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
aeb59e1999-10-30Fredrik Hübinette (Hubbe) BINFUN2(mpzmod_add,mpz_add) BINFUN2(mpzmod_mul,mpz_mul) BINFUN2(mpzmod_gcd,mpz_gcd)
ee37801999-02-09Fredrik Hübinette (Hubbe) 
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++)
c089471997-04-09Niels Möller  get_mpz(sp + e - args, 1);
79042c1997-03-11Niels Möller 
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
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) }
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rsub(INT32 args) { INT32 e; struct object *res; MP_INT *a; if(args!=1) error("Gmp.mpz->``- called with more or less than one argument.\n"); a=get_mpz(sp-1,1);
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
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) }
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)  { if(sp[e-args].type != T_INT || sp[e-args].u.integer<=0) if (!mpz_sgn(get_mpz(sp+e-args, 1))) error("Division by zero.\n"); }
79042c1997-03-11Niels Möller 
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
79042c1997-03-11Niels Möller  mpz_set(OBTOMPZ(res), THIS); for(e=0;e<args;e++)
80a0e41999-03-02Fredrik Hübinette (Hubbe)  { if(sp[e-args].type == T_INT) mpz_fdiv_q_ui(OBTOMPZ(res), OBTOMPZ(res), sp[e-args].u.integer); 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) }
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rdiv(INT32 args) { MP_INT *a; struct object *res; if(!mpz_sgn(THIS)) error("Division by zero.\n"); if(args!=1) error("Gmp.mpz->``/() called with more than one argument.\n"); a=get_mpz(sp-1,1);
0957531999-10-25Fredrik Hübinette (Hubbe)  res=fast_clone_object(THIS_PROGRAM,0);
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) }
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++)
c089471997-04-09Niels Möller  if (!mpz_sgn(get_mpz(sp+e-args, 1)))
79042c1997-03-11Niels Möller  error("Division by zero.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
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) }
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rmod(INT32 args) { MP_INT *a; struct object *res; if(!mpz_sgn(THIS)) error("Modulo by zero.\n"); if(args!=1) error("Gmp.mpz->``%%() called with more than one argument.\n"); a=get_mpz(sp-1,1);
0957531999-10-25Fredrik Hübinette (Hubbe)  res=fast_clone_object(THIS_PROGRAM,0);
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) }
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) error("Gmp.mpz->gcdext: Wrong number of arguments.\n");
c089471997-04-09Niels Möller  a = get_mpz(sp-1, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0957531999-10-25Fredrik Hübinette (Hubbe)  g = fast_clone_object(THIS_PROGRAM, 0); s = fast_clone_object(THIS_PROGRAM, 0); t = fast_clone_object(THIS_PROGRAM, 0);
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); } static void mpzmod_gcdext2(INT32 args) { struct object *g, *s; MP_INT *a;
0226201997-03-10Niels Möller  if (args != 1) error("Gmp.mpz->gcdext: Wrong number of arguments.\n");
c089471997-04-09Niels Möller  a = get_mpz(sp-args, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) 
0957531999-10-25Fredrik Hübinette (Hubbe)  g = fast_clone_object(THIS_PROGRAM, 0); s = fast_clone_object(THIS_PROGRAM, 0);
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); } 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) error("Gmp.mpz->invert: wrong number of arguments.\n");
c089471997-04-09Niels Möller  modulo = get_mpz(sp-args, 1);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if (!mpz_sgn(modulo))
310f601999-11-01Mirar (Pontus Hagland)  error("divide by zero\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
0226201997-03-10Niels Möller  if (mpz_invert(OBTOMPZ(res), THIS, modulo) == 0) {
0620631997-10-29Fredrik Hübinette (Hubbe)  free_object(res);
310f601999-11-01Mirar (Pontus Hagland)  error("Gmp.mpz->invert: 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) }
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #define BINFUN(name, fun) \ static void name(INT32 args) \ { \ INT32 e; \ struct object *res; \ for(e=0; e<args; e++) \ get_mpz(sp+e-args, 1); \ res = fast_clone_object(THIS_PROGRAM, 0); \ 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); \ }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) BINFUN(mpzmod_and,mpz_and) BINFUN(mpzmod_or,mpz_ior) static void mpzmod_compl(INT32 args) { struct object *o; pop_n_elems(args);
0957531999-10-25Fredrik Hübinette (Hubbe)  o=fast_clone_object(THIS_PROGRAM,0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_com(OBTOMPZ(o), THIS);
9b55461999-10-16Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) } #define CMPFUN(name,cmp) \ static void name(INT32 args) \ { \ INT32 i; \ if(!args) error("Comparison with one argument?\n"); \
c089471997-04-09Niels Möller  i=mpz_cmp(THIS, get_mpz(sp-args, 1)) cmp 0; \ pop_n_elems(args); \ push_int(i); \ } #define CMPEQU(name,cmp,default) \ static void name(INT32 args) \ { \ INT32 i; \ MP_INT *arg; \ if(!args) error("Comparison with one argument?\n"); \ if (!(arg = get_mpz(sp-args, 0))) \ i = default; \ else \ i=mpz_cmp(THIS, arg) cmp 0; \
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  pop_n_elems(args); \ push_int(i); \ } CMPFUN(mpzmod_gt, >) CMPFUN(mpzmod_lt, <) CMPFUN(mpzmod_ge, >=) CMPFUN(mpzmod_le, <=)
c089471997-04-09Niels Möller CMPEQU(mpzmod_eq, ==, 0) CMPEQU(mpzmod_nq, !=, 1)
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  static void mpzmod_probably_prime_p(INT32 args) {
7da3191997-04-25Niels Möller  int count; if (args) { get_all_args("Gmp.mpz->probably_prime_p", args, "%i", &count); count = sp[-1].u.integer; if (count <= 0) error("Gmp.mpz->probably_prime_p: count argument must be positive.\n"); } 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)); } static void mpzmod_small_factor(INT32 args) { int limit; if (args) { get_all_args("Gmp.mpz->small_factor", args, "%i", &limit);
bd44cf1997-04-26Niels Möller  if (limit < 1) error("Gmp.mpz->small_factor: limit argument must be at least 1.\n");
7da3191997-04-25Niels Möller  } else limit = INT_MAX; pop_n_elems(args); push_int(mpz_small_factor(THIS, limit)); } static void mpzmod_next_prime(INT32 args) {
bd44cf1997-04-26Niels Möller  INT32 count = 25; INT32 limit = INT_MAX;
7da3191997-04-25Niels Möller  struct object *o; switch(args) { case 0: break; case 1: get_all_args("Gmp.mpz->next_prime", args, "%i", &count);
bd44cf1997-04-26Niels Möller  break;
7da3191997-04-25Niels Möller  default: get_all_args("Gmp.mpz->next_prime", args, "%i%i", &count, &limit);
bd44cf1997-04-26Niels Möller  break;
7da3191997-04-25Niels Möller  } pop_n_elems(args);
0957531999-10-25Fredrik Hübinette (Hubbe)  o = fast_clone_object(THIS_PROGRAM, 0);
7da3191997-04-25Niels Möller  mpz_next_prime(OBTOMPZ(o), THIS, count, limit);
1598411999-10-20Fredrik Noring  PUSH_REDUCED(o);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) } static void mpzmod_sgn(INT32 args) { pop_n_elems(args); push_int(mpz_sgn(THIS)); } 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) error("mpz->sqrt() on negative number.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  o=fast_clone_object(THIS_PROGRAM,0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  mpz_sqrt(OBTOMPZ(o), THIS);
751aee1999-10-15Fredrik Noring  PUSH_REDUCED(o);
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) error("mpz->sqrtrem() on negative number.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  root = fast_clone_object(THIS_PROGRAM,0); rem = fast_clone_object(THIS_PROGRAM,0);
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); } static void mpzmod_lsh(INT32 args) {
0226201997-03-10Niels Möller  struct object *res; if (args != 1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  error("Wrong number of arguments to Gmp.mpz->`<<.\n"); ref_push_string(int_type_string);
98f2b11998-02-19Fredrik Hübinette (Hubbe)  stack_swap();
1458b91997-08-31Henrik Grubbström (Grubba)  f_cast();
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  if(sp[-1].u.integer < 0) error("mpz->lsh on negative number.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
0226201997-03-10Niels Möller  mpz_mul_2exp(OBTOMPZ(res), THIS, sp[-1].u.integer); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) } static void mpzmod_rsh(INT32 args) {
0226201997-03-10Niels Möller  struct object *res; if (args != 1)
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  error("Wrong number of arguments to Gmp.mpz->`>>.\n"); ref_push_string(int_type_string);
98f2b11998-02-19Fredrik Hübinette (Hubbe)  stack_swap();
1458b91997-08-31Henrik Grubbström (Grubba)  f_cast();
0226201997-03-10Niels Möller  if (sp[-1].u.integer < 0) error("Gmp.mpz->rsh: Shift count must be positive.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
806a2c1997-04-28Fredrik Hübinette (Hubbe)  mpz_fdiv_q_2exp(OBTOMPZ(res), THIS, sp[-1].u.integer);
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
1b89ad1997-10-10Fredrik Hübinette (Hubbe) static void mpzmod_rlsh(INT32 args) { struct object *res; INT32 i; if (args != 1) error("Wrong number of arguments to Gmp.mpz->``<<.\n"); get_mpz(sp-1,1); i=mpz_get_si(THIS); if(i < 0) error("mpz->``<< on negative number.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_mul_2exp(OBTOMPZ(res), OBTOMPZ(sp[-1].u.object), i); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) } static void mpzmod_rrsh(INT32 args) { struct object *res; INT32 i; if (args != 1) error("Wrong number of arguments to Gmp.mpz->``>>.\n"); get_mpz(sp-1,1); i=mpz_get_si(THIS); if(i < 0) error("mpz->``>> on negative number.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
1b89ad1997-10-10Fredrik Hübinette (Hubbe)  mpz_fdiv_q_2exp(OBTOMPZ(res), OBTOMPZ(sp[-1].u.object), i); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
1b89ad1997-10-10Fredrik Hübinette (Hubbe) }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_powm(INT32 args) {
0226201997-03-10Niels Möller  struct object *res; MP_INT *n; if(args != 2) error("Wrong number of arguments to Gmp.mpz->powm()\n");
c089471997-04-09Niels Möller  n = get_mpz(sp - 1, 1);
0226201997-03-10Niels Möller  if (!mpz_sgn(n)) error("Gmp.mpz->powm: Divide by zero\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
c089471997-04-09Niels Möller  mpz_powm(OBTOMPZ(res), THIS, get_mpz(sp - 2, 1), n);
0226201997-03-10Niels Möller  pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) }
79042c1997-03-11Niels Möller static void mpzmod_pow(INT32 args) { struct object *res; if (args != 1) error("Gmp.mpz->pow: Wrong number of arguments.\n"); if (sp[-1].type != T_INT) error("Gmp.mpz->pow: Non int exponent.\n"); if (sp[-1].u.integer < 0) error("Gmp.mpz->pow: Negative exponent.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
79042c1997-03-11Niels Möller  mpz_pow_ui(OBTOMPZ(res), THIS, sp[-1].u.integer); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
79042c1997-03-11Niels Möller }
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void mpzmod_not(INT32 args) { pop_n_elems(args); push_int(!mpz_sgn(THIS)); }
78130c1998-07-19Niels Möller static void mpzmod_popcount(INT32 args) { pop_n_elems(args); switch (mpz_sgn(THIS)) { case 0: push_int(0); break; case -1: /* How would one define popcount for negative numbers? */ error("Gmp.mpz->popcount: Undefined for negative numbers.\n"); /* Not reached */ case 1: push_int(mpn_popcount(THIS->_mp_d, THIS->_mp_size)); break; default: fatal("Gmp.mpz->popcount: Unexpected sign!\n"); } }
79042c1997-03-11Niels Möller static void gmp_pow(INT32 args) { struct object *res; if (args != 2) error("Gmp.pow: Wrong number of arguments"); if ( (sp[-2].type != T_INT) || (sp[-2].u.integer < 0) || (sp[-1].type != T_INT) || (sp[-1].u.integer < 0)) error("Gmp.pow: Negative arguments");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
79042c1997-03-11Niels Möller  mpz_ui_pow_ui(OBTOMPZ(res), sp[-2].u.integer, sp[-1].u.integer); pop_n_elems(args);
fda0de1999-10-08Fredrik Noring  PUSH_REDUCED(res);
79042c1997-03-11Niels Möller } static void gmp_fac(INT32 args) { struct object *res; if (args != 1) error("Gmp.fac: Wrong number of arguments.\n"); if (sp[-1].type != T_INT) error("Gmp.fac: Non int argument.\n"); if (sp[-1].u.integer < 0) error("Gmp.mpz->pow: Negative exponent.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res = fast_clone_object(THIS_PROGRAM, 0);
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)  static void mpzmod_random(INT32 args) {
9a44a41999-10-30Fredrik Noring  struct object *res = 0; /* Make gcc happy. */
42918d1999-10-25Fredrik Hübinette (Hubbe)  pop_n_elems(args); if(mpz_sgn(THIS) <= 0) error("random on negative number.\n");
0957531999-10-25Fredrik Hübinette (Hubbe)  res=fast_clone_object(THIS_PROGRAM,0);
42918d1999-10-25Fredrik Hübinette (Hubbe)  /* We add two to assure reasonably uniform randomness */
3c002a1999-10-25Fredrik Hübinette (Hubbe)  mpz_random(OBTOMPZ(res), mpz_size(THIS) + 2);
42918d1999-10-25Fredrik Hübinette (Hubbe)  mpz_fdiv_r(OBTOMPZ(res), OBTOMPZ(res), THIS); /* modulo */ PUSH_REDUCED(res); }
79042c1997-03-11Niels Möller 
a80a9c1997-02-11Fredrik Hübinette (Hubbe) static void init_mpz_glue(struct object *o) { mpz_init(THIS); } static void exit_mpz_glue(struct object *o) { mpz_clear(THIS); } #endif void pike_module_exit(void) {
8e721c1998-07-11Henrik Grubbström (Grubba) #if defined(USE_GMP) || defined(USE_GMP2)
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  free_program(mpzmod_program);
0957531999-10-25Fredrik Hübinette (Hubbe)  mpzmod_program=0; #ifdef AUTO_BIGNUM free_program(bignum_program); bignum_program=0; #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif } #define MPZ_ARG_TYPE "int|float|object"
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #define MPZ_RET_TYPE "object" #define MPZ_SHIFT_TYPE "function(int|float|object:" MPZ_RET_TYPE")" #define MPZ_BINOP_TYPE ("function(" MPZ_ARG_TYPE "...:"MPZ_RET_TYPE")")
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #define MPZ_CMPOP_TYPE ("function(" MPZ_ARG_TYPE ":int)")
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #define tMpz_arg tOr3(tInt,tFloat,tObj) #define tMpz_ret tObj #define tMpz_int tInt #define tMpz_shift_type tFunc(tMpz_arg,tMpz_ret) #define tMpz_binop_type tFuncV(tNone, tMpz_arg, tMpz_ret) #define tMpz_cmpop_type tFunc(tMpz_arg, tMpz_ret)
0957531999-10-25Fredrik Hübinette (Hubbe) #define MPZ_DEFS() \ ADD_STORAGE(MP_INT); \ \ /* function(void|string|int|float|object:void)" \ "|function(string,int:void) */ \ ADD_FUNCTION("create", mpzmod_create, \ tOr(tFunc(tOr5(tVoid,tStr,tInt,tFlt, \ tObj),tVoid), \ tFunc(tStr tInt,tVoid)), 0); \ \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("`+",mpzmod_add,tMpz_binop_type,0); \ ADD_FUNCTION("`+=",mpzmod_add_eq,tMpz_binop_type,0); \ ADD_FUNCTION("``+",mpzmod_add,tMpz_binop_type,0); \ ADD_FUNCTION("`-",mpzmod_sub,tMpz_binop_type,0); \ ADD_FUNCTION("``-",mpzmod_rsub,tMpz_binop_type,0); \ ADD_FUNCTION("`*",mpzmod_mul,tMpz_binop_type,0); \ ADD_FUNCTION("``*",mpzmod_mul,tMpz_binop_type,0); \ ADD_FUNCTION("`*=",mpzmod_mul_eq,tMpz_binop_type,0); \ ADD_FUNCTION("`/",mpzmod_div,tMpz_binop_type,0); \ ADD_FUNCTION("``/",mpzmod_rdiv,tMpz_binop_type,0); \ ADD_FUNCTION("`%",mpzmod_mod,tMpz_binop_type,0); \ ADD_FUNCTION("``%",mpzmod_rmod,tMpz_binop_type,0); \ ADD_FUNCTION("`&",mpzmod_and,tMpz_binop_type,0); \ ADD_FUNCTION("``&",mpzmod_and,tMpz_binop_type,0); \ ADD_FUNCTION("`|",mpzmod_or,tMpz_binop_type,0); \ ADD_FUNCTION("``|",mpzmod_or,tMpz_binop_type,0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("`~",mpzmod_compl,tFunc(tNone,tObj),0); \ \ add_function("`<<",mpzmod_lsh,MPZ_SHIFT_TYPE,0); \ add_function("`>>",mpzmod_rsh,MPZ_SHIFT_TYPE,0); \ add_function("``<<",mpzmod_rlsh,MPZ_SHIFT_TYPE,0); \ add_function("``>>",mpzmod_rrsh,MPZ_SHIFT_TYPE,0); \ \ add_function("`>", mpzmod_gt,MPZ_CMPOP_TYPE,0); \ add_function("`<", mpzmod_lt,MPZ_CMPOP_TYPE,0); \ add_function("`>=",mpzmod_ge,MPZ_CMPOP_TYPE,0); \ add_function("`<=",mpzmod_le,MPZ_CMPOP_TYPE,0); \ \ add_function("`==",mpzmod_eq,MPZ_CMPOP_TYPE,0); \ add_function("`!=",mpzmod_nq,MPZ_CMPOP_TYPE,0); \ \ ADD_FUNCTION("`!",mpzmod_not,tFunc(tNone,tInt),0); \ \ ADD_FUNCTION("__hash",mpzmod_get_int,tFunc(tNone,tInt),0); \ ADD_FUNCTION("cast",mpzmod_cast,tFunc(tStr,tMix),0); \ \ ADD_FUNCTION("_is_type", mpzmod__is_type, tFunc(tStr,tInt), 0); \ \ ADD_FUNCTION("digits", mpzmod_digits,tFunc(tOr(tVoid,tInt),tStr), 0); \ ADD_FUNCTION("_sprintf", mpzmod__sprintf, tFunc(tInt,tStr), 0); \ ADD_FUNCTION("size", mpzmod_size,tFunc(tOr(tVoid,tInt),tInt), 0); \ \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("cast_to_int",mpzmod_get_int,tFunc(tNone,tMpz_int),0); \
0957531999-10-25Fredrik Hübinette (Hubbe)  ADD_FUNCTION("cast_to_string",mpzmod_get_string,tFunc(tNone,tStr),0); \ ADD_FUNCTION("cast_to_float",mpzmod_get_float,tFunc(tNone,tFlt),0); \ \ ADD_FUNCTION("probably_prime_p",mpzmod_probably_prime_p, \ tFunc(tNone,tInt),0); \ 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("gcd_eq",mpzmod_gcd_eq, 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)  \
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); \
aeb59e1999-10-30Fredrik Hübinette (Hubbe)  ADD_FUNCTION("sqrtrem",mpzmod_sqrtrem,tFunc(tNone,tArr(tMpz_ret)),0);\ ADD_FUNCTION("powm",mpzmod_powm,tFunc(tMpz_arg tMpz_arg,tMpz_ret),0); \ ADD_FUNCTION("pow", mpzmod_pow,tFunc(tInt,tMpz_ret), 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)  \ set_init_callback(init_mpz_glue); \ set_exit_callback(exit_mpz_glue);
45ee5d1999-02-10Fredrik Hübinette (Hubbe) 
0957531999-10-25Fredrik Hübinette (Hubbe) void pike_module_init(void) { #if defined(USE_GMP) || defined(USE_GMP2) 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);
a80a9c1997-02-11Fredrik Hübinette (Hubbe)  add_function("divmod", mpzmod_divmod, "function(" MPZ_ARG_TYPE ":array(object))", 0);
d5fdfa1997-04-15Niels Möller  add_function("divm", mpzmod_divm, "function(" MPZ_ARG_TYPE "," MPZ_ARG_TYPE ":object)", 0);
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif
42918d1999-10-25Fredrik Hübinette (Hubbe) 
0957531999-10-25Fredrik Hübinette (Hubbe)  add_program_constant("mpz", mpzmod_program=end_program(), 0);
0226201997-03-10Niels Möller 
45ee5d1999-02-10Fredrik Hübinette (Hubbe)  /* function(int, int:object) */ ADD_FUNCTION("pow", gmp_pow,tFunc(tInt tInt,tObj), 0); /* function(int:object) */ ADD_FUNCTION("fac", gmp_fac,tFunc(tInt,tObj), 0);
79042c1997-03-11Niels Möller 
e28b471999-10-25Fredrik Hübinette (Hubbe) #ifdef AUTO_BIGNUM {
0957531999-10-25Fredrik Hübinette (Hubbe)  int id;
9a44a41999-10-30Fredrik Noring  extern int gmp_library_loaded;
0957531999-10-25Fredrik Hübinette (Hubbe)  /* This program autoconverts to integers, Gmp.mpz does not!! * magic? no, just an if statement :) /Hubbe */ start_new_program();
aeb59e1999-10-30Fredrik Hübinette (Hubbe) #undef tMpz_ret #undef tMpz_int #define tMpz_ret tInt #define tMpz_int tInt
0957531999-10-25Fredrik Hübinette (Hubbe)  /* 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(); id=add_program_constant("bignum", bignum_program=end_program(), 0);
6af1ab1999-10-29Martin Stjernholm  bignum_program->flags |= PROGRAM_NO_WEAK_DESTRUCT|PROGRAM_NO_EXPLICIT_DESTRUCT;
0957531999-10-25Fredrik Hübinette (Hubbe)  /* Alert bignum.c that we have been loaded /Hubbe */
e28b471999-10-25Fredrik Hübinette (Hubbe)  gmp_library_loaded=1; #if 0 /* magic /Hubbe * This seems to break more than it fixes though... /Hubbe */ free_string(ID_FROM_INT(new_program, id)->type); ID_FROM_INT(new_program, id)->type=CONSTTYPE(tOr(tFunc(tOr5(tVoid,tStr,tInt,tFlt,tObj),tInt),tFunc(tStr tInt,tInt))); #endif } #endif
a80a9c1997-02-11Fredrik Hübinette (Hubbe) #endif }