yap-6.3/H/arith2.h

/*************************************************************************
*									 *
*	 YAP Prolog 							 *
*									 *
*	Yap Prolog was developed at NCCUP - Universidade do Porto	 *
*									 *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997	 *
*									 *
**************************************************************************
*									 *
* File:		arithi2.c						 *
* Last rev:								 *
* mods:									 *
* comments:	arithmetical expression evaluation			 *
*									 *
*************************************************************************/

/* This file implements fast binary math operations for YAP
 *
 */

inline static E_FUNC
add_int(Int i, Int j E_ARGS)
{
  Int x = i+j;
  /* Integer overflow, we need to use big integers */
#if USE_GMP
  if (((i^j) >= 0 && (i^x) < 0 ) ||
      j == Int_MIN) {
    MP_INT *new = TMP_BIG();

    mpz_init_set_si(new,i);
    if (j > 0) {
      mpz_add_ui(new, new, j);
      RBIG(new);
    } else {
      unsigned long u = -(j+1);
      u++;
      mpz_sub_ui(new, new, u);
      RBIG(new);
    }
  }
#endif
#ifdef BEAM
  RINT(x);
  return( MkIntegerTerm (x));
#else
  RINT(x);
#endif
}

/* Extended version with two possibilities:
   - both terms do not need evaluation;
   - a term needs evaluation;
*/
static E_FUNC
p_plus(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2) USE_E_ARGS);
    case double_e:
      {
	/* integer, double */
	Float fl1 = (Float)IntegerOfTerm(t1);
	Float fl2 = FloatOfTerm(t2);
	RFLOAT(fl1+fl2);
      }
#ifdef USE_GMP
    case big_int_e:
      {
	Int i1 = IntegerOfTerm(t1);
	MP_INT *l2 = Yap_BigIntOfTerm(t2);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, l2);
	if (i1 > 0) {
	  mpz_add_ui(new, new, i1);
	} else if (i1 < 0) {
	  unsigned long u1 = -(i1+1);
	  u1++;
	  mpz_sub_ui(new, new, u1);
	}
	RBIG(new);
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    f2 = AritFunctorOfTerm(t2);

    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* float * integer */
      RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
    case double_e:
      RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
#ifdef USE_GMP
    case big_int_e:
      RFLOAT(FloatOfTerm(t1)+mpz_get_d(Yap_BigIntOfTerm(t2)));
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.dbl = FloatOfTerm(t1);
      bt1 = double_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      {
	Int i2 = IntegerOfTerm(t2);
	MP_INT *l1 = Yap_BigIntOfTerm(t1);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new,l1);
	if (i2 > 0) {
	  mpz_add_ui(new, new, i2);
	} else if (i2 < 0) {
	  unsigned long u2 = -(i2+1);
	  u2++;
	  mpz_sub_ui(new, l1, u2);
	}
	RBIG(new);
      }
    case big_int_e:
      /* two bignums */
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, Yap_BigIntOfTerm(t1));
	mpz_add(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
    case double_e:
      RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))+FloatOfTerm(t2));
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big, Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      /* two integers */
      return add_int(v1.Int,v2.Int USE_E_ARGS);
    case double_e:
      /* integer, double */
      RFLOAT(v1.Int+v2.dbl);
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v2.big);
	if (v1.Int > 0) {
	  mpz_add_ui(new, new, v1.Int);
	} else if (v1.Int < 0) {
	  unsigned long u1 = -(v1.Int+1);
	  u1++;
	  mpz_sub_ui(new, new, u1);
	}
	RBIG(new);
      }
#endif
    default:
      /* Error */
      RERROR();
    }
  case double_e:
    switch (bt2) {
    case long_int_e:
      /* float * integer */
      RFLOAT(v1.dbl+v2.Int);
    case double_e:
      /* float * float */
      RFLOAT(v1.dbl+v2.dbl);
#ifdef USE_GMP
    case big_int_e:
      /* float * float */
      RFLOAT(v1.dbl+mpz_get_d(v2.big));
      mpz_clear(v2.big);
#endif
    default:
      /* error */
      RERROR();
    }
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	/* big * integer */
	if (v2.Int > 0) {
	  mpz_add_ui(new, new, v2.Int);
	} else if (v2.Int < 0) {
	  unsigned long u2 = -(v2.Int+1);
	  u2++;
	  mpz_sub_ui(new, new, u2);
	}
	RBIG(new);
      }
    case double_e:
      /* big * float */
      {
	Float dbl = mpz_get_d(v1.big)+v2.dbl;
	mpz_clear(v1.big);
	RFLOAT(dbl);
      }
    case big_int_e:
      /* big * big */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_add(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

/* Extended version with two possibilities:
   - both terms do not need evaluation;
   - a term needs evaluation;
*/
static E_FUNC
p_minus(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      {
	Term sub = IntegerOfTerm(t2);
#ifdef USE_GMP
	if (sub == Int_MIN) {
	  Int i1 = IntegerOfTerm(t1);
	  MP_INT *new = TMP_BIG();

	  mpz_init_set_si(new, sub);
	  if (i1 > 0) {
	    mpz_neg(new, new);
	    mpz_add_ui(new, new, i1);
	  } else {
	    unsigned long u1 = -(i1+1);
	    u1++;
	    mpz_add_ui(new, new, u1);
	    mpz_neg(new, new);
	  }
	  RBIG(new);
	} else
#endif
	  return add_int(IntegerOfTerm(t1), -sub USE_E_ARGS);
      }
    case double_e:
      {
	/* integer, double */
	Float fl1 = (Float)IntegerOfTerm(t1);
	Float fl2 = FloatOfTerm(t2);
	RFLOAT(fl1-fl2);
      }
#ifdef USE_GMP
    case big_int_e:
      {
	Int i1 = IntegerOfTerm(t1);
	MP_INT *l2 = Yap_BigIntOfTerm(t2);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, l2);
	if (i1 > 0) {
	  mpz_ui_sub(new, i1, new);
	} else if (i1 == 0) {
	  mpz_neg(new, new);	  
	} else {
	  unsigned long u1 = -(i1+1);
	  u1++;
	  mpz_add_ui(new, new, u1);
	  mpz_neg(new, new);	  
	}
	RBIG(new);
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    f2 = AritFunctorOfTerm(t2);

    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* float * integer */
      RFLOAT(FloatOfTerm(t1)-IntegerOfTerm(t2));
    case double_e:
      {
	RFLOAT(FloatOfTerm(t1)-FloatOfTerm(t2));
      }
#ifdef USE_GMP
    case big_int_e:
      {
	RFLOAT(FloatOfTerm(t1)-mpz_get_d(Yap_BigIntOfTerm(t2)));
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.dbl = FloatOfTerm(t1);
      bt1 = double_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      {
	Int i2 = IntegerOfTerm(t2);
	MP_INT *l1 = Yap_BigIntOfTerm(t1);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, l1);
	if (i2 > 0) {
	  mpz_sub_ui(new, new, i2);
	} else if (i2 < 0) {
	  unsigned long u2 = -(i2+1);
	  u2++;
	  mpz_add_ui(new, new, u2);
	}
	RBIG(new);
      }
    case big_int_e:
      /* two bignums */
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, Yap_BigIntOfTerm(t1));
	mpz_sub(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
    case double_e:
      {
	RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))-FloatOfTerm(t2));
      }
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big,Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      /* two integers */
#ifdef USE_GMP
      if (v2.Int == Int_MIN) {
	MP_INT *new = TMP_BIG();
	mpz_init_set_si(new, v2.Int);
	if (v1.Int > 0) {
	  mpz_neg(new, new);
	  mpz_add_ui(new, new, v1.Int);
	} else {
	  if (v1.Int == Int_MIN)
	    mpz_set_ui(new, 0);
	  else if (v1.Int < 0)
	    mpz_add_ui(new, new, -v1.Int);
	  mpz_neg(new, new);
	}
	RBIG(new);
      } else
#endif
	return(add_int(v1.Int, -v2.Int USE_E_ARGS));
    case double_e:
      {
	/* integer, double */
	RFLOAT(v1.Int-v2.dbl);
      }
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v2.big);
	if (v1.Int > 0) {
	  mpz_ui_sub(new, v1.Int, v2.big);
	} else if (v1.Int == 0) {
	  mpz_neg(new, new);
	} else {
	  unsigned long int u1;

	  u1 = -(v1.Int+1);
	  u1++;
	  mpz_add_ui(new, new, u1);
	  mpz_neg(new, new);
	}
	RBIG(new);
      }
#endif
    default:
      /* Error */
      RERROR();
    }
  case double_e:
    switch (bt2) {
    case long_int_e:
      /* float * integer */
      RFLOAT(v1.dbl-v2.Int);
    case double_e:
      /* float * float */
      RFLOAT(v1.dbl-v2.dbl);
#ifdef USE_GMP
    case big_int_e:
      /* float * float */
      {
	Float flt = v1.dbl-mpz_get_d(v2.big);

	mpz_clear(v2.big);
	RFLOAT(flt);
      }
#endif
    default:
      /* error */
      RERROR();
    }
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	/* big - integer */
	if (v2.Int > 0) {
	  mpz_sub_ui(new, new, v2.Int);
	} else if (v2.Int < 0) {
	  unsigned long int u2;

	  u2 = -(v2.Int+1);
	  u2++;
	  mpz_add_ui(new, new, u2);
	}
	RBIG(new);
      }
    case double_e:
      /* big * float */
      {
	Float flt = mpz_get_d(v1.big)-v2.dbl;
	
	mpz_clear(v1.big);
	RFLOAT(flt);
      }
    case big_int_e:
      /* big * big */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_sub(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

#ifdef __GNUC__
#ifdef __i386__
#define DO_MULTI() { Int tmp1; \
  __asm__ ("imull  %3\n\t movl   $0,%1\n\t jno    0f\n\t movl   $1,%1\n\t 0:"    \
	   : "=a" (z),	    \
	     "=d" (tmp1)    \
	   : "a" (i1),      \
             "rm" (i2)      \
           : "cc" );   \
           if (tmp1) goto overflow; \
          }
#define OPTIMIZE_MULTIPLI 1
#endif
#endif

#ifndef OPTIMIZE_MULTIPLI
#define DO_MULTI() z = i1*i2; \
                          if (i2 &&  z/i2 != i1) goto overflow
#endif

inline static E_FUNC
times_int(Int i1, Int i2 E_ARGS) {
#ifdef USE_GMP
  Int z;
  DO_MULTI();
  RINT(z);
 overflow:
  {
    MP_INT *new = TMP_BIG();
    mpz_init_set_si(new,i1);
    if (i2 > 0) {
      mpz_mul_ui(new, new, i2);
      RBIG(new);
    } else {
      unsigned long int u2 = -(i2-1);
      u2++;
      mpz_mul_ui(new, new, u2);
      mpz_neg(new, new);
      RBIG(new);
    }
  }
#else
  RINT(i1*i2);
#endif
}

/* Extended version with two possibilities:
   - both terms do not need evaluation;
   - a term needs evaluation;
*/
static E_FUNC
p_times(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2) USE_E_ARGS));
    case double_e:
      {
	/* integer, double */
	Float fl1 = (Float)IntegerOfTerm(t1);
	Float fl2 = FloatOfTerm(t2);
	RFLOAT(fl1*fl2);
      }
#ifdef USE_GMP
    case big_int_e:
      {
	Int i1 = IntegerOfTerm(t1);
	MP_INT *l2 = Yap_BigIntOfTerm(t2);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, l2);
	mpz_mul_si(new, new, i1);
	RBIG(new);
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    f2 = AritFunctorOfTerm(t2);

    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* float * integer */
      RFLOAT(FloatOfTerm(t1)*IntegerOfTerm(t2));
    case double_e:
      {
	RFLOAT(FloatOfTerm(t1)*FloatOfTerm(t2));
      }
#ifdef USE_GMP
    case big_int_e:
      {
	RFLOAT(FloatOfTerm(t1)*mpz_get_d(Yap_BigIntOfTerm(t2)));
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.dbl = FloatOfTerm(t1);
      bt1 = double_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      {
	Int i2 = IntegerOfTerm(t2);
	MP_INT *l1 = Yap_BigIntOfTerm(t1);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, l1);
	mpz_mul_si(new, new, i2);
	RBIG(new);
      }
    case big_int_e:
      /* two bignums */
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, Yap_BigIntOfTerm(t1));
	mpz_mul(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
    case double_e:
      {
	RFLOAT(mpz_get_d(Yap_BigIntOfTerm(t1))*FloatOfTerm(t2));
      }
    default:
      /* We've got a full term, need to evaluate it first */
      mpz_init_set(v1.big,Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      /* two integers */
      return(times_int(v1.Int,v2.Int USE_E_ARGS));
    case double_e:
      {
	/* integer, double */
	RFLOAT(v1.Int*v2.dbl);
      }
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v2.big);
	mpz_mul_si(new, new, v1.Int);
	RBIG(new);
      }
#endif
    default:
      /* Error */
      RERROR();
    }
  case double_e:
    switch (bt2) {
    case long_int_e:
      /* float * integer */
      RFLOAT(v1.dbl*v2.Int);
    case double_e:
      /* float * float */
      RFLOAT(v1.dbl*v2.dbl);
#ifdef USE_GMP
    case big_int_e:
      /* float * float */
      {
	Float flt = v1.dbl*mpz_get_d(v2.big);

	mpz_clear(v2.big);
	RFLOAT(flt);
      }
#endif
    default:
      /* error */
      RERROR();
    }
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      /* big * integer */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_mul_si(new, new, v2.Int);
	RBIG(new);
      }
    case double_e:
      /* big * float */
      {
	Float dbl = mpz_get_d(v1.big)*v2.dbl;
	mpz_clear(v1.big);
	RFLOAT(dbl);
      }
    case big_int_e:
      /* big * big */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_mul(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

/*
  Integer division //
*/
static E_FUNC
p_div(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      {
	Int i2 = IntegerOfTerm(t2);
      
	if (i2 == 0) {
	  Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
	  /* make GCC happy */
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
	RINT(IntegerOfTerm(t1) / i2);
      }
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "// /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      /* Cool */
      RINT(0);
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t1, "// /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* dividing a bignum by an integer */
      {
	Int i2 = IntegerOfTerm(t2);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, Yap_BigIntOfTerm(t1));
	if (i2 > 0) {
	  mpz_tdiv_q_ui(new, new, i2);
	  RBIG(new);
	} else if (i2 == 0) {
	  Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
	  /* make GCC happy */
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  unsigned long int u2 = -(i2-1);
	  u2++;
	  mpz_tdiv_q_ui(new, new, u2);
	  mpz_neg(new, new);
	  RBIG(new);
	}
      }
    case big_int_e:
      /* two bignums */
      {
	MP_INT *new = TMP_BIG();

	mpz_init(new);
	mpz_tdiv_q(new, Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "// /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big, Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      /* two integers */
      if (v2.Int == 0) {
	Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
	/* make GCC happy */
	P = (yamop *)FAILCODE;
	RERROR();
      }
      RINT(v1.Int / v2.Int);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "// /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      /* Cool */
      RINT(0);
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "// /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      /* big // integer */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	if (v2.Int > 0) {
	  mpz_tdiv_q_ui(new, new, v2.Int);
	} else if (v2.Int == 0) {
	  mpz_clear(new);
	  Yap_Error(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
	  /* make GCC happy */
	  P = (yamop *)FAILCODE;
	  RERROR();
	} else {
	  mpz_tdiv_q_ui(new, new, -v2.Int);
	  mpz_neg(new, new);
	}
	RBIG(new);
      }
    case double_e:
      /* big // float */
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "// /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    case big_int_e:
      /* big * big */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_tdiv_q(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

/*
  and /\\
*/
static E_FUNC
p_and(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      RINT(IntegerOfTerm(t1) & IntegerOfTerm(t2));
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();
	mpz_init_set_si(new, IntegerOfTerm(t1));
	mpz_and(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t1, "/\\ /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* anding a bignum with an integer is easy */
      {
	MP_INT *new = TMP_BIG();
	mpz_init_set_si(new, IntegerOfTerm(t2));
	mpz_and(new, new, Yap_BigIntOfTerm(t1));
	RBIG(new);
      }
    case big_int_e:
      /* two bignums */
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, Yap_BigIntOfTerm(t1));
	mpz_and(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big,Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      RINT(v1.Int & v2.Int);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "/\\ /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();
	mpz_init_set_si(new, v1.Int);
	mpz_and(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  case double_e:
#ifdef USE_GMP
    if (bt2 == big_int_e) {
      mpz_clear(v2.big);
    }
#endif
    Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "/\\ /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      /* anding a bignum with an integer is easy */
      {
	MP_INT *new = TMP_BIG();
	mpz_init_set_si(new, v2.Int);
	mpz_and(new, new, v1.big);
	mpz_clear(v1.big);
	RBIG(new);
      }
    case double_e:
      /* big // float */
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "/\\ /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    case big_int_e:
      /* big * big */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_and(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

/*
  or \/
*/
static E_FUNC
p_or(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      RINT(IntegerOfTerm(t1) | IntegerOfTerm(t2));
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set_si(new, IntegerOfTerm(t1));
	mpz_ior(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t1, "\\/ /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set_si(new,IntegerOfTerm(t2));
	mpz_ior(new, Yap_BigIntOfTerm(t1), new);
	RBIG(new);
      }
    case big_int_e:
      /* two bignums */
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, Yap_BigIntOfTerm(t1));
	mpz_ior(new, new, Yap_BigIntOfTerm(t2));
	RBIG(new);
      }
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big,Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      RINT(v1.Int | v2.Int);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set_si(new,v1.Int);
	mpz_ior(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "\\/ /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      /* anding a bignum with an integer is easy */
      {
	MP_INT *new = TMP_BIG();

	mpz_init_set_si(new, v2.Int);
	mpz_ior(new, v1.big, new);
	mpz_clear(v1.big);
	RBIG(new);
      }
    case double_e:
      /* big // float */
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "\\/ /2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    case big_int_e:
      /* big * big */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	mpz_ior(new, new, v2.big);
	mpz_clear(v2.big);
	RBIG(new);
      }
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

#if USE_GMP
static inline Int
sll_ovflw(Int x,Int i)
{
  CELL t = (1<<x)-1;
  return (t & i) != i;
}
#endif

inline static E_FUNC
do_sll(Int i, Int j E_ARGS)
{
#if USE_GMP
  Int x = (8*sizeof(CELL)-2)-j;
  
  if (x < 0||
      sll_ovflw(x,i)) {
    MP_INT *new = TMP_BIG();

    mpz_init_set_si(new,i);
    mpz_mul_2exp(new, new, j);
    RBIG(new);
  }
#endif
  RINT(i << j);
}

/*
  sll <<

  First argument may be int or bignum;
  Second argument may only be an int.
*/
static E_FUNC
p_sll(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      if (IntegerOfTerm(t2) < 0) {
	Int i2 = IntegerOfTerm(t2);
	if (i2 == Int_MIN) {
	  Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
	RINT(IntegerOfTerm(t1) >> -i2);
      }
      return do_sll(IntegerOfTerm(t1),IntegerOfTerm(t2) USE_E_ARGS);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "<</2");
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
      P = (yamop *)FAILCODE;
      RERROR();
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t1, "<< /2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);

    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      {
	Int i2 = IntegerOfTerm(t2);
	MP_INT *l1 = Yap_BigIntOfTerm(t1);

	if (i2 > 0) {
	  MP_INT *new = TMP_BIG();

	  mpz_init_set(new, l1);
	  mpz_mul_2exp(new, new, i2);
	  RBIG(new);
	} else if (i2 == 0) {
	  MP_INT *new = TMP_BIG();

	  mpz_init_set(new, l1);
	  RBIG(new);
	} else {
	  MP_INT *new = TMP_BIG();

	  mpz_init_set(new, l1);
	  if (i2 == Int_MIN) {
	    Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
	    P = (yamop *)FAILCODE;
	    RERROR();
	  }
	  mpz_tdiv_q_2exp(new, new, -i2);
	  RBIG(new);
	}
      }
    case big_int_e:
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
      P = (yamop *)FAILCODE;
      RERROR();
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, "<</2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big,Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      if (v2.Int < 0) {
	if (v2.Int == Int_MIN) {
	  Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
	RINT(v1.Int >> -v2.Int);
      }
      return do_sll(v1.Int,v2.Int USE_E_ARGS);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<</2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      mpz_clear(v2.big);
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
      P = (yamop *)FAILCODE;
      RERROR();
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  case double_e:
#ifdef USE_GMP
    if (bt2 == big_int_e)
      mpz_clear(v2.big);
#endif
    Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), "<</2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      /* big << int */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	if (v2.Int > 0) {
	  mpz_mul_2exp(new, new, v2.Int);
	} else if (v2.Int < 0) {
	  if (v2.Int == Int_MIN) {
	    Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2");
	    P = (yamop *)FAILCODE;
	    RERROR();
	  }
	  mpz_tdiv_q_2exp(v1.big, v1.big, -v2.Int);
	}
	RBIG(new);
      }
    case double_e:
      /* big << float */
      mpz_clear(v1.big);
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), "<</2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    case big_int_e:
      /* big << big */
      mpz_clear(v1.big);
      mpz_clear(v2.big);
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* error */
      mpz_clear(v1.big);
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}

/*
  slr >>

  First argument may be int or bignum;
  Second argument may only be an int.
*/
static E_FUNC
p_slr(Term t1, Term t2 E_ARGS)
{
  Functor f1 = AritFunctorOfTerm(t1), f2;
  blob_type bt1, bt2;
  union arith_ret v1, v2;

  switch (BlobOfFunctor(f1)) {
  case long_int_e:
    f2 = AritFunctorOfTerm(t2);
    
    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      /* two integers */
      if (IntegerOfTerm(t2) < 0) {
	Int i2 = IntegerOfTerm(t2);
	if (i2 == Int_MIN) {
	  Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
	return do_sll(IntegerOfTerm(t1), -i2 USE_E_ARGS);
      }
      RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2));
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
      P = (yamop *)FAILCODE;
      RERROR();
#endif
    default:
      /* we've got a full term, need to evaluate it first */
      v1.Int = IntegerOfTerm(t1);
      bt1 = long_int_e;
      bt2 = ArithIEval(t2, &v2);
    }
    break;
  case double_e:
    Yap_Error(TYPE_ERROR_INTEGER, t1, ">>/2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    f2 = AritFunctorOfTerm(t2);

    switch (BlobOfFunctor(f2)) {
    case long_int_e:
      {
	Int i2 = IntegerOfTerm(t2);
	MP_INT *l1 = Yap_BigIntOfTerm(t1);
	MP_INT *new = TMP_BIG();

	mpz_init_set(new, l1);
	if (i2 > 0) {
	  mpz_tdiv_q_2exp(new, new, i2);
	} else if (i2 < 0) {
	  if (i2 == Int_MIN) {
	    Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
	    P = (yamop *)FAILCODE;
	    RERROR();
	  }
	  mpz_mul_2exp(new, new, -i2);
	}
	RBIG(new);
      }
    case big_int_e:
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
      P = (yamop *)FAILCODE;
      RERROR();
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* we've got a full term, need to evaluate it first */
      mpz_init_set(v1.big,Yap_BigIntOfTerm(t1));
      bt1 = big_int_e;
      bt2 = ArithIEval(t2, &v2);
      break;
    }
#endif
  default:
    /* we've got a full term, need to evaluate it first */
    bt1 = ArithIEval(t1, &v1);
    /* don't know anything about second */
    bt2 = ArithIEval(t2, &v2);
  }
  /* second case, no need no evaluation */
  switch (bt1) {
  case long_int_e:
    switch (bt2) {
    case long_int_e:
      if (v2.Int < 0) {
	if (v2.Int == Int_MIN) {
	  Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2");
	  P = (yamop *)FAILCODE;
	  RERROR();
	}
	return do_sll(v1.Int, -v2.Int USE_E_ARGS);
      }
      RINT(v1.Int >> v2.Int);
    case double_e:
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
#ifdef USE_GMP
    case big_int_e:
      mpz_clear(v2.big);
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
      RERROR();
#endif
    default:
      /* Yap_Error */
      RERROR();
    }
  case double_e:
#if USE_GMP
    if (bt2 == big_int_e)
      mpz_clear(v2.big);
#endif
    Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v1.dbl), ">>/2");
    P = (yamop *)FAILCODE;
    RERROR();
#ifdef USE_GMP
  case big_int_e:
    switch (bt2) {
    case long_int_e:
      /* big >> int */
      {
	MP_INT *new = TMP_BIG();

	MPZ_SET(new, v1.big);
	if (v2.Int > 0) {
	  mpz_tdiv_q_2exp(new, new, v2.Int);
	} else if (v2.Int < 0) {
	  if (v2.Int == Int_MIN) {
	    Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, MkIntegerTerm(v2.Int), ">>/2");
	    P = (yamop *)FAILCODE;
	    RERROR();
	  }
	  mpz_mul_2exp(new, v1.big, -v2.Int);
	}
	RBIG(new);
      }
    case double_e:
      /* big >> float */
      mpz_clear(v1.big);
      Yap_Error(TYPE_ERROR_INTEGER, MkFloatTerm(v2.dbl), ">>/2");
      /* make GCC happy */
      P = (yamop *)FAILCODE;
      RERROR();
    case big_int_e:
      /* big >> big */
      mpz_clear(v1.big);
      mpz_clear(v2.big);
      Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
      P = (yamop *)FAILCODE;
      RERROR();
    default:
      /* error */
      RERROR();
    }
#endif
    default:
      /* error  */
      RERROR();
    }
}