/*
   This file is part of Numerix.  Numerix is free software; you can
   redistribute it and/or modify it under the terms of the GNU General
   Public License as published by the Free Software Foundation; either
   version 2 of the License, or (at your option) any later version.

   This program is distributed in the hope that it will be useful, but
   WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
   General Public License for more details.

   You should have received a copy of the GNU General Public License
   along with this program; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
   USA 
*/

/* +------------------------------------------------------------------------+
   |                                                                        |
   |                        Interface entre gmp et Ocaml                    |
   |                                                                        |
   +------------------------------------------------------------------------+ */

/* M. Quercia, 24/08/2001 */

#include <stdlib.h>
#include <stdio.h>
#include <gmp.h>

#ifdef use_camllight

/* Camllight */
#include <mlvalues.h>
#include <alloc.h>
#include <memory.h>
#define add_fail

#else

/* Ocaml toutes versions */
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/memory.h>

#if OCAML_VERSION >= 202
#include <caml/fail.h>
#else
#define add_fail
#endif

#endif /* #ifdef use_camllight */

#ifdef add_fail
#ifdef __GNUC__
/* Works only in GCC 2.5 and later */
#define Noreturn __attribute ((noreturn))
#else
#define Noreturn
#endif

void failwith (char *) Noreturn;
#endif /* #ifdef add_fail */


/* Un entier est vu depuis Ocaml comme une donnée abstraite avec customisation */
typedef struct {
  void *custom_ops;
  mpz_t val;
} entier;

/* Libération */
void mlg_finalize(value a){
  mpz_clear(((entier *)a)->val);
}

/* conversion entier * -> value */
#define Val(a) *(value *)&a

#ifndef use_camllight
#if OCAML_VERSION < 202
#define use_camllight
#endif
#endif

#ifndef use_camllight

                    /* +----------------------+
                       |  Pour Ocaml >= 1.07  |
                       +----------------------+ */


/* Allocation */
#define SE (sizeof(entier)+sizeof(long)-1)/sizeof(long)

#if OCAML_VERSION < 300
#define Alloc(a)                                     \
  a = (entier *) alloc_final(SE,mlg_finalize,1,1000); \
  mpz_init((a)->val)
#else

#include <caml/custom.h>

int mlg_compare(value a, value b) {return(mpz_cmp(((entier *)a)->val,((entier *)b)->val));}

/* hashage inspiré de ocaml/byterun/hash.c */
long mlg_hash(value a) {
  __mpz_struct *aa  = ((entier *)a)->val;
  unsigned long accu = aa->_mp_size;
  long l = abs(aa->_mp_size), i;
  for (i=0; i<l; accu = accu*65599 + aa->_mp_d[i++]);
  return(accu);
}

/* sérialisation/désérialisation par conversion en chaine hexadécimale */

extern void serialize_int_2(int i);
extern void serialize_block_1(void * data, long len);

void mlg_serialize(value x, unsigned long *w32, unsigned long *w64) {
  char *s = mpz_get_str(NULL, 16, ((entier *)x)->val);
  unsigned long l = strlen(s);
#ifdef bits_64
  if (l >= 0x10000000) failwith("number too big for serialization");
#endif
  serialize_int_2(l);
  serialize_block_1(s,l+1);
  free(s);
  *w32 = *w64 = l+3;
}

extern int  deserialize_uint_2(void);
extern void deserialize_block_1(void * data, long len);

unsigned long mlg_deserialize(void *x) {
  mpz_t *a = (mpz_t *)x;
  unsigned long l = deserialize_uint_2();
  char *s = malloc(l+1);
  if (s == NULL) failwith("out of memory during deserialization");
  deserialize_block_1(s,l+1);
  mpz_init_set_str(*a,s,16);
  free(s);
  return(l+3);
}

/* Enregistrement des méthodes */
struct custom_operations mlg_ops = {
  "Numerix GMP Integer 0.19",  /* identifier  */
  mlg_finalize,                /* finalize    */
  mlg_compare,                 /* compare     */
  mlg_hash,                    /* hash        */
  mlg_serialize,               /* serialise   */
  mlg_deserialize              /* deserialise */
};

void mlg_register() {
  static int unregistered = 1;
  if (unregistered) {
    register_custom_operations(&mlg_ops);
    unregistered = 0;
  }
}

#define Alloc(a)                                              \
  a = (entier *) alloc_custom(&mlg_ops,SE*sizeof(value),1,1000); \
  mpz_init((a)->val)
#endif

#define Alloc_1_1(a,b) {                 \
  Begin_roots1(Val(b));                  \
  Alloc(a);                              \
  End_roots();                           \
}				         

#define Alloc_1_2(a,b,c) {               \
  Begin_roots2(Val(b),Val(c));           \
  Alloc(a);                              \
  End_roots();                           \
}				         

#define Alloc_1_3(a,b,c,d) {             \
  Begin_roots3(Val(b),Val(c),Val(d));    \
  Alloc(a);                              \
  End_roots();                           \
}				         

#define Alloc_2_1(a,b,c) {               \
  a = (entier *)Val_unit;		 \
  b = (entier *)Val_unit;		 \
  Begin_roots3(Val(a),Val(b),Val(c));    \
  Alloc(a);				 \
  Alloc(b);				 \
  End_roots();			         \
}

#define AllocN_1_1(v,n,a,b) {            \
  a = (entier *)Val_unit;		 \
  Begin_roots2(Val(a),Val(b));		 \
  Alloc(a);				 \
  v = alloc_tuple(n);			 \
  End_roots();			         \
}

#define AllocN_2_1(v,n,a,b,c) {          \
  a = (entier *)Val_unit;		 \
  b = (entier *)Val_unit;		 \
  Begin_roots3(Val(a),Val(b),Val(c));    \
  Alloc(a);				 \
  Alloc(b);				 \
  v = alloc_tuple(n);			 \
  End_roots();			         \
}

#define AllocN_2_2(v,n,a,b,c,d) {        \
  a = (entier *)Val_unit;		 \
  b = (entier *)Val_unit;		 \
  Begin_roots4(Val(a),Val(b),Val(c),Val(d)); \
  Alloc(a);				 \
  Alloc(b);				 \
  v = alloc_tuple(n);			 \
  End_roots();			         \
}

#define AllocN_3_2(v,n,a,b,c,d,e) {      \
  a = (entier *)Val_unit;		 \
  b = (entier *)Val_unit;		 \
  c = (entier *)Val_unit;		 \
  Begin_roots5(Val(a),Val(b),Val(c),Val(d),Val(e)); \
  Alloc(a);				 \
  Alloc(b);				 \
  Alloc(c);				 \
  v = alloc_tuple(n);			 \
  End_roots();		                 \
}

#define AllocN_5_2(v,n,a,b,c,d,e,f,g) {  \
  a = (entier *)Val_unit;		 \
  b = (entier *)Val_unit;		 \
  c = (entier *)Val_unit;		 \
  d = (entier *)Val_unit;		 \
  e = (entier *)Val_unit;		 \
  Begin_roots5(Val(a),Val(b),Val(c),Val(d),Val(e)); \
  Begin_roots2(Val(f),Val(g));           \
  Alloc(a);				 \
  Alloc(b);				 \
  Alloc(c);				 \
  Alloc(d);				 \
  Alloc(e);				 \
  v = alloc_tuple(n);			 \
  End_roots();			         \
  End_roots();		                 \
}

#else /* #ifndef use_camllight */

                 /* +-----------------------------+
                    |  Camllight et Ocaml < 1.07  |
                    +-----------------------------+ */


/* Allocation */
#define SE (sizeof(entier)+sizeof(long)-1)/sizeof(long)
#define Alloc(a)                                     \
  a = (entier *) alloc_final(SE,mlg_finalize,1,1000); \
  mpz_init((a)->val)

#define Alloc_1_1(a,b) {                 \
  Push_roots(__v,1);                     \
  __v[0] = (value)b;                     \
  Alloc(a);                              \
  (value)b = __v[0];                     \
  Pop_roots();                           \
}				         

#define Alloc_1_2(a,b,c) {               \
  Push_roots(__v,2);                     \
  __v[0] = (value)b;                     \
  __v[1] = (value)c;                     \
  Alloc(a);                              \
  (value)b = __v[0];                     \
  (value)c = __v[1];                     \
  Pop_roots();                           \
}				         

#define Alloc_1_3(a,b,c,d) {             \
  Push_roots(__v,3);                     \
  __v[0] = (value)b;                     \
  __v[1] = (value)c;                     \
  __v[2] = (value)d;                     \
  Alloc(a);                              \
  (value)b = __v[0];                     \
  (value)c = __v[1];                     \
  (value)d = __v[2];                     \
  Pop_roots();                           \
}				         

#define Alloc_2_1(a,b,c) {               \
  Push_roots(__v,2);                     \
  __v[0] = (value)c;                     \
  Alloc((entier *)__v[1]);               \
  Alloc(b);                              \
  (value)a = __v[1];                     \
  (value)c = __v[0];                     \
  Pop_roots();                           \
}				         

#define AllocN_1_1(v,n,a,b) {            \
  Push_roots(__v,2);                     \
  __v[0] = (value)b;                     \
  Alloc((entier *)__v[1]);               \
  v = alloc_tuple(n);			 \
  (value)a = __v[1];                     \
  (value)b = __v[0];                     \
  Pop_roots();                           \
}				         

#define AllocN_2_1(v,n,a,b,c) {          \
  Push_roots(__v,3);                     \
  __v[0] = (value)c;                     \
  Alloc((entier *)__v[1]);               \
  Alloc((entier *)__v[2]);               \
  v = alloc_tuple(n);			 \
  (value)a = __v[1];                     \
  (value)b = __v[2];                     \
  (value)c = __v[0];                     \
  Pop_roots();                           \
}				         

#define AllocN_2_2(v,n,a,b,c,d) {        \
  Push_roots(__v,4);                     \
  __v[0] = (value)c;                     \
  __v[1] = (value)d;                     \
  Alloc((entier *)__v[2]);               \
  Alloc((entier *)__v[3]);               \
  v = alloc_tuple(n);			 \
  (value)a = __v[2];                     \
  (value)b = __v[3];                     \
  (value)c = __v[0];                     \
  (value)d = __v[1];                     \
  Pop_roots();                           \
}				         

#define AllocN_3_2(v,n,a,b,c,d,e) {      \
  Push_roots(__v,5);                     \
  __v[0] = (value)d;                     \
  __v[1] = (value)e;                     \
  Alloc((entier *)__v[2]);               \
  Alloc((entier *)__v[3]);               \
  Alloc((entier *)__v[4]);               \
  v = alloc_tuple(n);			 \
  (value)a = __v[2];                     \
  (value)b = __v[3];                     \
  (value)c = __v[4];                     \
  (value)d = __v[0];                     \
  (value)e = __v[1];                     \
  Pop_roots();                           \
}				         

#define AllocN_5_2(v,n,a,b,c,d,e,f,g) {  \
  Push_roots(__v,7);                     \
  __v[0] = (value)f;                     \
  __v[1] = (value)g;                     \
  Alloc((entier *)__v[2]);               \
  Alloc((entier *)__v[3]);               \
  Alloc((entier *)__v[4]);               \
  Alloc((entier *)__v[5]);               \
  Alloc((entier *)__v[6]);               \
  v = alloc_tuple(n);			 \
  (value)a = __v[2];                     \
  (value)b = __v[3];                     \
  (value)c = __v[4];                     \
  (value)d = __v[5];                     \
  (value)e = __v[6];                     \
  (value)f = __v[0];                     \
  (value)g = __v[1];                     \
  Pop_roots();                           \
}				         

#endif /* #ifndef use_camllight */


                        /* +-------------------------+
                           |  Opérations hors place  |
                           +-------------------------+ */

#define MLG_un(f)                      \
value mlg_##f(entier *a) {             \
  entier *c;			       \
  Alloc_1_1(c,Val(a));		       \
  mpz_##f(c->val,a->val);              \
  return((value) c);                   \
}

#define MLG_bin(f)                     \
value mlg_##f(entier *a, entier *b) {  \
  entier *c;			       \
  Alloc_1_2(c,Val(a),Val(b));	       \
  mpz_##f(c->val,a->val,b->val);       \
  return((value) c);                   \
}

#define MLG_bin_ui(f)                  \
value mlg_##f(entier *a, value b) {    \
  long bb = Long_val(b);               \
  entier *c;			       \
  Alloc_1_1(c,Val(a));		       \
  mpz_##f(c->val,a->val,bb);	       \
  return((value) c);                   \
}

MLG_un(abs)
MLG_un(neg)
MLG_un(sqrt)
MLG_un(set)
MLG_bin(add)
MLG_bin(sub)
MLG_bin(mul)
MLG_bin(fdiv_q)
MLG_bin(fdiv_r)
MLG_bin_ui(mul_2exp)
MLG_bin_ui(tdiv_q_2exp)
MLG_bin_ui(pow_ui)

value mlg_add_1(entier *a, value b) {
  long bb = Long_val(b);
  entier *c;
  Alloc_1_1(c,Val(a));

  if (bb > 0) mpz_add_ui(c->val, a->val, bb);
  else        mpz_sub_ui(c->val, a->val, -bb);

  return((value) c);
}

value mlg_sub_1(entier *a, value b) {
  long bb = Long_val(b);
  entier *c;
  Alloc_1_1(c,Val(a));

  if (bb > 0) mpz_sub_ui(c->val, a->val, bb);
  else        mpz_add_ui(c->val, a->val, -bb);

  return((value) c);
}

value mlg_mul_1(entier *a, value b) {
  long bb = Long_val(b);
  entier *c;
  Alloc_1_1(c,Val(a));

  if (bb > 0) mpz_mul_ui(c->val, a->val, bb);
  else {mpz_mul_ui(c->val, a->val, -bb); mpz_neg(c->val,c->val);}

  return((value) c);
}

value mlg_fdiv_qr(entier *a, entier *b) {
  entier *c,*d;
  value r;
  c = (entier *)Val_unit;
  d = (entier *)Val_unit;

  AllocN_2_2(r,2,c,d,Val(a),Val(b));
  Field(r,0) = (value) c;
  Field(r,1) = (value) d;

  mpz_fdiv_qr(c->val,d->val,a->val,b->val);

  return(r);
}


value mlg_fdiv_qr_ui(entier *a, value b) {
  long bb = Long_val(b), d;
  entier *c;
  mpz_t x;
  value r;

  AllocN_1_1(r,2,c,Val(a));
  mpz_init(x);

  if (bb > 0) d = mpz_fdiv_qr_ui(c->val,x,a->val,bb);
  else {
    d = mpz_fdiv_qr_ui(c->val,x,a->val,-bb);
    mpz_neg(c->val,c->val);
    if (d) {d += bb; mpz_sub_ui(c->val,c->val,1);}
  }
  mpz_clear(x);

  Field(r,0) = (value) c;
  Field(r,1) = Val_long(d);

  return(r);
}


value mlg_fdiv_q_ui(entier *a, value b) {
  long bb = Long_val(b), d;
  entier *c;
  mpz_t x;

  Alloc_1_1(c,Val(a));
  mpz_init(x);
  if (bb > 0) d = mpz_fdiv_qr_ui(c->val,x,a->val,bb);
  else {
    d = mpz_fdiv_qr_ui(c->val,x,a->val,-bb);
    mpz_neg(c->val,c->val);
    if (d) {d += bb; mpz_sub_ui(c->val,c->val,1);}
  }
  mpz_clear(x);

  return((value) c);
}


value mlg_fdiv_r_ui(entier *a, value b) {
  long bb = Long_val(b), d;

  if (bb > 0) d = mpz_fdiv_ui(a->val,bb);
  else       {d = mpz_fdiv_ui(a->val,-bb); if (d) d += bb;}

  return(Val_long(d));
}



value mlg_tdiv_qr_2exp(entier *a, value b) {
  long bb = Long_val(b);
  entier *c,*d;
  value r;

  AllocN_2_1(r,2,c,d,Val(a));
  Field(r,0) = (value) c;
  Field(r,1) = (value) d;

  mpz_tdiv_q_2exp(c->val,a->val,bb);
  mpz_tdiv_r_2exp(d->val,a->val,bb);

  return(r);
}

value mlg_fac_ui(value a) {
  long aa = Long_val(a);
  entier *b;

  if (aa < 0) {
    fprintf(stderr,"\nfactorial of a negative number\n"); fflush(stderr);
    exit(1);
  }
  Alloc(b);
  mpz_fac_ui(b->val,aa);
  return((value) b);
}


MLG_bin(gcd)

value mlg_gcdext(entier *a, entier *b) {
  entier *u,*v,*d;
  value r;

  AllocN_3_2(r,3,u,v,d,Val(a),Val(b));
  Field(r,0) = (value) u;
  Field(r,1) = (value) v;
  Field(r,2) = (value) d;

  mpz_gcdext(d->val,u->val,v->val,a->val,b->val);
  mpz_neg(v->val,v->val);

  return(r);
}

value mlg_powm(entier *a, entier *b, entier *c) {
  entier *r;
  Alloc_1_3(r,Val(a),Val(b),Val(c));
  if ((c->val)->_mp_size < 0) { /* bug dans GMP si le module est négatif */
    mpz_t c1;
    mpz_init(c1);
    mpz_neg(c1,c->val);
    mpz_powm(r->val,a->val,b->val,c1);
    mpz_neg(c1,c1);
    mpz_fdiv_r(r->val,r->val,c1);
    mpz_clear(c1);
  }
  else mpz_powm(r->val,a->val,b->val,c->val);
  return((value) r);
}
 

                        /* +------------------------+
                           |  Opérations sur place  |
                           +------------------------+ */

void mlg_put(entier *c,entier *a) {
  mpz_set(c->val,a->val);
}

#define MLG_un_in(f)                                \
void mlg_##f##_in(entier *c, entier *a) {           \
  mpz_##f(c->val,a->val);                           \
}

#define MLG_bin_in(f)                               \
void mlg_##f##_in(entier *c, entier *a, entier *b) {\
  mpz_##f(c->val,a->val,b->val);                    \
}

#define MLG_bin_ui_in(f)                            \
void mlg_##f##_in(entier *c, entier *a, value b) {  \
  mpz_##f(c->val,a->val,Long_val(b));               \
}

MLG_un_in(abs)
MLG_un_in(neg)
MLG_un_in(sqrt)
MLG_bin_in(add)
MLG_bin_in(sub)
MLG_bin_in(mul)
MLG_bin_in(fdiv_q)
MLG_bin_ui_in(pow_ui)
MLG_bin_ui_in(mul_2exp)
MLG_bin_ui_in(tdiv_q_2exp)

void mlg_add_1_in(entier *c, entier *a, value b) {
  long bb = Long_val(b);
  if (bb > 0) mpz_add_ui(c->val, a->val, bb);
  else        mpz_sub_ui(c->val, a->val, -bb);
}

void mlg_sub_1_in(entier *c, entier *a, value b) {
  long bb = Long_val(b);
  if (bb > 0) mpz_sub_ui(c->val, a->val, bb);
  else        mpz_add_ui(c->val, a->val, -bb);
}

void mlg_mul_1_in(entier *c, entier *a, value b) {
  long bb = Long_val(b);
  if (bb > 0) mpz_mul_ui(c->val, a->val, bb);
  else {mpz_mul_ui(c->val, a->val, -bb); mpz_neg(c->val,c->val);}
}


void mlg_fdiv_qr_in(entier *c, entier *d, entier *a, entier *b) {
  mpz_fdiv_qr(c->val,d->val,a->val,b->val);
}

value mlg_fdiv_qr_ui_in(entier *c, entier *a, value b) {
  long bb = Long_val(b), d;
  mpz_t x;

  mpz_init(x);
  if (bb > 0) d = mpz_fdiv_qr_ui(c->val,x,a->val,bb);
  else {
    d = mpz_fdiv_qr_ui(c->val,x,a->val,-bb);
    mpz_neg(c->val,c->val);
    if (d) {d += bb; mpz_sub_ui(c->val,c->val,1);}
  }
  mpz_clear(x);

  return(Val_long(d));
}


void mlg_tdiv_qr_2exp_in(entier *c, entier *d, entier *a, value b) {
  long bb = Long_val(b);

  if (c != a) {
    mpz_tdiv_q_2exp(c->val,a->val,bb);
    mpz_tdiv_r_2exp(d->val,a->val,bb);
  } else {
    mpz_tdiv_r_2exp(d->val,a->val,bb);
    mpz_tdiv_q_2exp(c->val,a->val,bb);
  }
}

void mlg_fac_ui_in(entier *b, value a) {
  long aa = Long_val(a);

  if (aa < 0) {
    fprintf(stderr,"\nfactorial of a negative number\n"); fflush(stderr);
    exit(1);
  }
  mpz_fac_ui(b->val,aa);
}

MLG_bin_in(gcd)

void mlg_gcdext_in(entier *u, entier *v, entier *d, entier *a, entier *b) {
  mpz_gcdext(d->val,u->val,v->val,a->val,b->val);
  mpz_neg(v->val,v->val);
}
 
void mlg_powm_in(entier *r, entier *a, entier *b, entier *c) {
  if ((c->val)->_mp_size < 0) { /* bug dans GMP si le module est négatif */
    mpz_t c1;
    mpz_init(c1);
    mpz_neg(c1,c->val);
    mpz_powm(r->val,a->val,b->val,c1);
    mpz_neg(c1,c1);
    mpz_fdiv_r(r->val,r->val,c1);
    mpz_clear(c1);
  }
  else mpz_powm(r->val,a->val,b->val,c->val);
}
 

                             /* +---------------+
                                |  Comparaison  |
                                +---------------+ */

value mlg_eq   (entier *a, entier *b) {return((mpz_cmp(a->val,b->val) == 0) ? Val_true : Val_false);}
value mlg_neq  (entier *a, entier *b) {return((mpz_cmp(a->val,b->val) != 0) ? Val_true : Val_false);}
value mlg_inf  (entier *a, entier *b) {return((mpz_cmp(a->val,b->val) <  0) ? Val_true : Val_false);}
value mlg_infeq(entier *a, entier *b) {return((mpz_cmp(a->val,b->val) <= 0) ? Val_true : Val_false);}
value mlg_sup  (entier *a, entier *b) {return((mpz_cmp(a->val,b->val) >  0) ? Val_true : Val_false);}
value mlg_supeq(entier *a, entier *b) {return((mpz_cmp(a->val,b->val) >= 0) ? Val_true : Val_false);}

value mlg_eq_si   (entier *a, value b) {return((mpz_cmp_si(a->val,Long_val(b)) == 0) ? Val_true : Val_false);}
value mlg_neq_si  (entier *a, value b) {return((mpz_cmp_si(a->val,Long_val(b)) != 0) ? Val_true : Val_false);}
value mlg_inf_si  (entier *a, value b) {return((mpz_cmp_si(a->val,Long_val(b)) <  0) ? Val_true : Val_false);}
value mlg_infeq_si(entier *a, value b) {return((mpz_cmp_si(a->val,Long_val(b)) <= 0) ? Val_true : Val_false);}
value mlg_sup_si  (entier *a, value b) {return((mpz_cmp_si(a->val,Long_val(b)) >  0) ? Val_true : Val_false);}
value mlg_supeq_si(entier *a, value b) {return((mpz_cmp_si(a->val,Long_val(b)) >= 0) ? Val_true : Val_false);}

value mlg_cmp  (entier *a, entier *b) {
  long r = mpz_cmp(a->val,b->val);
  return(Val_int((r == 0) ? 0 : (r > 0) ? 1 : -1));
}

value mlg_cmp_si  (entier *a, value b) {
  long r = mpz_cmp_si(a->val,Long_val(b));
  return(Val_int((r == 0) ? 0 : (r > 0) ? 1 : -1));
}

value mlg_sgn  (entier *a) {return(Val_int(mpz_sgn(a->val)));}
value mlg_nbits(entier *a) {
  if (mpz_sgn(a->val)) return(Val_long(mpz_sizeinbase(a->val,2)));
  else return(Val_long(0));
}


                             /* +--------------+
                                |  Conversion  |
                                +--------------+ */


value mlg_of_int(value a) {
  long aa = Long_val(a);
  entier *b;
  Alloc(b);
  mpz_set_si(b->val,aa);
  return((value) b);
}

value mlg_int_of(entier *a) {
  if (mpz_sizeinbase(a->val,2) > 30) failwith("mlg_int_of: number too big");
  return(Val_int(mpz_get_si(a->val)));
}

value mlg_lowbits(entier *a) {
  return(Val_int(mpz_get_ui(a->val) & 0x7fffffff));
}

value mlg_highbits(entier *a) {
  long l = mpz_sizeinbase(a->val,2), res;
  mpz_t x;
  mpz_init(x);

  if (l < 31) {
    mpz_mul_2exp(x,a->val,31-l);
    res = mpz_get_ui(x);
    mpz_clear(x);
  }
  else if (l > 31) {
    mpz_tdiv_q_2exp(x,a->val,l-31);
    res = mpz_get_ui(x);
    mpz_clear(x);
  }
  else res = mpz_get_ui(a->val);

  return(Val_long(res));
}

value mlg_nth_word(entier *a, value b) {
  long bb = Long_val(b), n1,n2;

  if (bb < 0) {failwith("mlg_nth_word: negative index");}
  n1 = bb/(sizeof(mp_limb_t)/2);
  n2 = 16*(bb%(sizeof(mp_limb_t)/2));
  return(Val_long((n1 < abs((a->val[0])._mp_size))
		  ? ((a->val[0])._mp_d[n1] >> n2) & 0xffff
		  : 0));
}
  
value mlg_of_string(char *s) {
  entier *a;
  Alloc_1_1(a,Val(s));
  mpz_set_str(a->val,s,10);
  return((value) a);
}

value mlg_string_of(entier *a) {
  char *s = mpz_get_str(NULL, 10,a->val);
  value res = copy_string(s);
  free(s);
  return(res);
}
