604 lines
13 KiB
C
604 lines
13 KiB
C
/*************************************************************************
|
|
* *
|
|
* 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 Term
|
|
add_int(Int i, Int j)
|
|
{
|
|
Int x = i+j;
|
|
#if USE_GMP
|
|
/* Integer overflow, we need to use big integers */
|
|
Int overflow = (i & j & ~x) | (~i & ~j & x);
|
|
if (overflow) {
|
|
return(Yap_gmp_add_ints(i, j));
|
|
}
|
|
#endif
|
|
#ifdef BEAM
|
|
RINT(x);
|
|
return( MkIntegerTerm (x));
|
|
#else
|
|
RINT(x);
|
|
#endif
|
|
}
|
|
|
|
inline static Term
|
|
sub_int(Int i, Int j)
|
|
{
|
|
Int x = i-j;
|
|
#if USE_GMP
|
|
Int overflow = (i & ~j & ~x) | (~i & j & x);
|
|
/* Integer overflow, we need to use big integers */
|
|
if (overflow) {
|
|
return(Yap_gmp_sub_ints(i, j));
|
|
}
|
|
#endif
|
|
#ifdef BEAM
|
|
RINT(x);
|
|
return( MkIntegerTerm (x));
|
|
#else
|
|
RINT(x);
|
|
#endif
|
|
}
|
|
|
|
#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 Term
|
|
times_int(Int i1, Int i2) {
|
|
#ifdef USE_GMP
|
|
Int z;
|
|
DO_MULTI();
|
|
RINT(z);
|
|
overflow:
|
|
{
|
|
return(Yap_gmp_mul_ints(i1, i2));
|
|
}
|
|
#else
|
|
RINT(i1*i2);
|
|
#endif
|
|
}
|
|
|
|
|
|
#if USE_GMP
|
|
static inline Int
|
|
sll_ovflw(Int x,Int i)
|
|
{
|
|
CELL t = (1<<x)-1;
|
|
return (t & i) != i;
|
|
}
|
|
#endif
|
|
|
|
inline static Term
|
|
do_sll(Int i, Int j)
|
|
{
|
|
#if USE_GMP
|
|
Int x = (8*sizeof(CELL)-2)-j;
|
|
|
|
if (x < 0||
|
|
sll_ovflw(x,i)) {
|
|
return(Yap_gmp_sll_ints(i, j));
|
|
}
|
|
#endif
|
|
RINT(i << j);
|
|
}
|
|
|
|
|
|
static inline Term
|
|
p_plus(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* two integers */
|
|
return add_int(IntegerOfTerm(t1),IntegerOfTerm(t2));
|
|
case double_e:
|
|
{
|
|
/* integer, double */
|
|
Float fl1 = (Float)IntegerOfTerm(t1);
|
|
Float fl2 = FloatOfTerm(t2);
|
|
RFLOAT(fl1+fl2);
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_add_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
case double_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* float * integer */
|
|
RFLOAT(FloatOfTerm(t1)+IntegerOfTerm(t2));
|
|
case double_e:
|
|
RFLOAT(FloatOfTerm(t1)+FloatOfTerm(t2));
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_add_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
return(Yap_gmp_add_int_big(IntegerOfTerm(t2), Yap_BigIntOfTerm(t1)));
|
|
case big_int_e:
|
|
/* two bignums */
|
|
return(Yap_gmp_add_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
|
|
case double_e:
|
|
return(Yap_gmp_add_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1)));
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
static Term
|
|
p_minus(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* two integers */
|
|
return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2));
|
|
case double_e:
|
|
{
|
|
/* integer, double */
|
|
Float fl1 = (Float)IntegerOfTerm(t1);
|
|
Float fl2 = FloatOfTerm(t2);
|
|
RFLOAT(fl1-fl2);
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_sub_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* float * integer */
|
|
RFLOAT(FloatOfTerm(t1)-IntegerOfTerm(t2));
|
|
case double_e:
|
|
{
|
|
RFLOAT(FloatOfTerm(t1)-FloatOfTerm(t2));
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_sub_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
return(Yap_gmp_sub_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2)));
|
|
case big_int_e:
|
|
return(Yap_gmp_sub_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
|
|
case double_e:
|
|
return(Yap_gmp_sub_big_float(Yap_BigIntOfTerm(t1),FloatOfTerm(t2)));
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
|
|
static Term
|
|
p_times(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* two integers */
|
|
return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2)));
|
|
case double_e:
|
|
{
|
|
/* integer, double */
|
|
Float fl1 = (Float)IntegerOfTerm(t1);
|
|
Float fl2 = FloatOfTerm(t2);
|
|
RFLOAT(fl1*fl2);
|
|
}
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* float * integer */
|
|
RFLOAT(FloatOfTerm(t1)*IntegerOfTerm(t2));
|
|
case double_e:
|
|
RFLOAT(FloatOfTerm(t1)*FloatOfTerm(t2));
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_mul_float_big(FloatOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
return(Yap_gmp_mul_int_big(IntegerOfTerm(t2), Yap_BigIntOfTerm(t1)));
|
|
case big_int_e:
|
|
/* two bignums */
|
|
return(Yap_gmp_mul_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2)));
|
|
case double_e:
|
|
return(Yap_gmp_mul_float_big(FloatOfTerm(t2),Yap_BigIntOfTerm(t1)));
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
static Term
|
|
p_div(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
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();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
/* Cool */
|
|
RINT(0);
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t1, "// /2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* dividing a bignum by an integer */
|
|
{
|
|
Term t= Yap_gmp_div_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
|
|
if (t==0L) {
|
|
/* make GCC happy */
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
}
|
|
return(t);
|
|
}
|
|
case big_int_e:
|
|
/* two bignums */
|
|
{
|
|
Term t;
|
|
|
|
t = Yap_gmp_div_big_big(Yap_BigIntOfTerm(t1), Yap_BigIntOfTerm(t2));
|
|
if (t==0L) {
|
|
/* make GCC happy */
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
}
|
|
return(t);
|
|
}
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t2, "// /2");
|
|
/* make GCC happy */
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
case db_ref_e:
|
|
RERROR();
|
|
#endif
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
static Term
|
|
p_and(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
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();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_and_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t1, "/\\ /2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* anding a bignum with an integer is easy */
|
|
return(Yap_gmp_and_int_big(IntegerOfTerm(t2),Yap_BigIntOfTerm(t1)));
|
|
case big_int_e:
|
|
/* two bignums */
|
|
return(Yap_gmp_and_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)));
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t2, "/\\ /2");
|
|
/* make GCC happy */
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
static Term
|
|
p_or(Term t1, Term t2) {
|
|
switch(ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
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();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
return(Yap_gmp_ior_int_big(IntegerOfTerm(t1),Yap_BigIntOfTerm(t2)));
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t1, "\\/ /2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
/* anding a bignum with an integer is easy */
|
|
return(Yap_gmp_ior_int_big(IntegerOfTerm(t2),Yap_BigIntOfTerm(t1)));
|
|
case big_int_e:
|
|
/* two bignums */
|
|
return(Yap_gmp_ior_big_big(Yap_BigIntOfTerm(t2), Yap_BigIntOfTerm(t1)));
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t2, "\\/ /2");
|
|
/* make GCC happy */
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
static Term
|
|
p_sll(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
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));
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t2, "<</2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, "<</2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t1, "<< /2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
{
|
|
Term t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), IntegerOfTerm(t2));
|
|
if (t == 0L) {
|
|
Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
}
|
|
return(t);
|
|
}
|
|
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();
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|
|
static Term
|
|
p_slr(Term t1, Term t2) {
|
|
switch (ETypeOfTerm(t1)) {
|
|
case long_int_e:
|
|
switch (ETypeOfTerm(t2)) {
|
|
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);
|
|
}
|
|
RINT(IntegerOfTerm(t1) >> IntegerOfTerm(t2));
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t2, ">>/2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
break;
|
|
case double_e:
|
|
Yap_Error(TYPE_ERROR_INTEGER, t1, ">>/2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
case big_int_e:
|
|
#ifdef USE_GMP
|
|
switch (ETypeOfTerm(t2)) {
|
|
case long_int_e:
|
|
{
|
|
Term t;
|
|
|
|
t = Yap_gmp_sll_big_int(Yap_BigIntOfTerm(t1), -IntegerOfTerm(t2));
|
|
if (t == 0L) {
|
|
Yap_Error(DOMAIN_ERROR_SHIFT_COUNT_OVERFLOW, t2, ">>/2");
|
|
P = (yamop *)FAILCODE;
|
|
RERROR();
|
|
}
|
|
return(t);
|
|
}
|
|
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();
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
#endif
|
|
case db_ref_e:
|
|
RERROR();
|
|
}
|
|
RERROR();
|
|
}
|
|
|