This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/H/arith2.h

525 lines
11 KiB
C
Raw Normal View History

/*************************************************************************
* *
* 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 int
sub_overflow(Int x, Int i, Int j)
{
return ((i & ~j & ~x) | (~i & j & x)) < 0;
}
inline static Term
sub_int(Int i, Int j USES_REGS)
2008-11-28 15:54:08 +00:00
{
Int x = i-j;
#if USE_GMP
Int overflow = ((i & ~j & ~x) | (~i & j & x)) < 0;
2008-11-28 15:54:08 +00:00
/* 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
}
2011-11-16 07:36:34 +00:00
inline static Int
SLR(Int i, Int shift)
{
2011-11-16 14:55:13 +00:00
return (shift < sizeof(Int)*8-1 ? i >> shift : (i >= 0 ? 0 : -1));
2011-11-16 07:36:34 +00:00
}
#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
inline static int
mul_overflow(Int z, Int i1, Int i2)
{
if (i1 == Int_MIN && i2 == -1)
return TRUE;
return (i2 && z/i2 != i1);
}
#ifndef OPTIMIZE_MULTIPLI
#if __clang__ && FALSE /* not in OSX yet */
#define DO_MULTI() if (__builtin_smul_overflow( i1, i2, & z ) ) { goto overflow; }
2014-01-19 21:15:05 +00:00
#elif SIZEOF_DOUBLE == 2*SIZEOF_INT_P
#define DO_MULTI() {\
int64_t w = (int64_t)i1*i2; \
if (w >= 0) {\
if ((w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
} else {\
if ((-w | ((int64_t)(2^31)-1)) != ((int64_t)(2^31)-1)) goto overflow; \
}\
z = w;\
}
#else
#define DO_MULTI() {\
__int128_t w = (__int128_t)i1*i2; \
if (w >= 0) {\
if ((w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
} else {\
if ((-w | ((__int128_t)(2^63)-1)) != ((__int128_t)(2^63)-1)) goto overflow; \
}\
z = (Int)w; \
}
#endif
#endif
inline static Term
times_int(Int i1, Int i2 USES_REGS) {
#ifdef USE_GMP
Int z;
DO_MULTI();
RINT(z);
overflow:
{
return(Yap_gmp_mul_ints(i1, i2));
}
#else
RINT(i1*i2);
#endif
}
2012-04-18 20:14:56 +01:00
#ifdef USE_GMP
2011-11-16 07:36:34 +00:00
#ifndef __GNUC__X
static int
clrsb(Int i)
{
2011-11-16 07:36:34 +00:00
Int j=0;
2011-11-16 07:36:34 +00:00
if (i < 0) {
if (i == Int_MIN)
return 1;
i = -i;
}
#if SIZEOF_INT_P == 8
if (i < (Int)(0x100000000)) { j += 32;}
else i >>= 32;
#endif
if (i < (Int)(0x10000)) {j += 16;}
else i >>= 16;
if (i < (Int)(0x100)) {j += 8;}
else i >>= 8;
if (i < (Int)(0x10)) {j += 4;}
else i >>= 4;
if (i < (Int)(0x4)) {j += 2;}
else i >>= 2;
if (i < (Int)(0x2)) j++;
return j;
}
#endif
2012-04-18 20:14:56 +01:00
#endif
2011-11-16 07:36:34 +00:00
inline static Term
do_sll(Int i, Int j USES_REGS) /* j > 0 */
{
2009-04-27 01:24:21 +01:00
#ifdef USE_GMP
2011-11-16 07:36:34 +00:00
if (
#ifdef __GNUC__X
#if SIZEOF_LONG_INT < SIZEOF_INT_P
__builtin_clrsbll(i)
#else
__builtin_clrsbl(i)
#endif
#else
clrsb(i)
#endif
2011-11-16 07:36:34 +00:00
> j)
RINT(i << j);
return Yap_gmp_sll_ints(i, j);
#else
RINT(i << j);
2011-11-16 07:36:34 +00:00
#endif
}
static Term
p_minus(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return sub_int(IntegerOfTerm(t1), IntegerOfTerm(t2) PASS_REGS);
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1-fl2);
}
case big_int_e:
#ifdef USE_GMP
2010-05-27 12:24:15 +01:00
return Yap_gmp_sub_int_big(IntegerOfTerm(t1), t2);
#endif
2010-03-06 22:43:21 +00:00
default:
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
2010-05-27 12:24:15 +01:00
return Yap_gmp_sub_float_big(FloatOfTerm(t1),t2);
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_sub_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_sub_big_big(t1, t2);
case double_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_sub_big_float(t1,FloatOfTerm(t2));
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
RERROR();
}
static Term
p_times(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
return(times_int(IntegerOfTerm(t1),IntegerOfTerm(t2) PASS_REGS));
case double_e:
{
/* integer, double */
Float fl1 = (Float)IntegerOfTerm(t1);
Float fl2 = FloatOfTerm(t2);
RFLOAT(fl1*fl2);
}
case big_int_e:
#ifdef USE_GMP
2010-05-27 12:24:15 +01:00
return(Yap_gmp_mul_int_big(IntegerOfTerm(t1), t2));
#endif
2010-03-06 22:43:21 +00:00
default:
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
2010-05-27 12:24:15 +01:00
return Yap_gmp_mul_float_big(FloatOfTerm(t1),t2);
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_mul_int_big(IntegerOfTerm(t2), t1);
case big_int_e:
/* two bignums */
2010-05-27 12:24:15 +01:00
return Yap_gmp_mul_big_big(t1, t2);
case double_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_mul_float_big(FloatOfTerm(t2),t1);
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
RERROR();
}
static Term
p_div(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
{
Int i1 = IntegerOfTerm(t1), i2 = IntegerOfTerm(t2);
if (i2 == 0) {
return Yap_ArithError(EVALUATION_ERROR_ZERO_DIVISOR, t2, "// /2");
} else if (i1 == Int_MIN && i2 == -1) {
2009-04-27 01:24:21 +01:00
#ifdef USE_GMP
return Yap_gmp_add_ints(Int_MAX, 1);
2009-04-27 01:24:21 +01:00
#else
return Yap_ArithError(EVALUATION_ERROR_INT_OVERFLOW, t1,
2009-04-27 01:24:21 +01:00
"rem/2 with %d and %d", i1, i2);
#endif
} else {
RINT(IntegerOfTerm(t1) / i2);
}
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
case big_int_e:
#ifdef USE_GMP
2010-05-27 12:24:15 +01:00
/* dividing a bignum by an integer */
return Yap_gmp_div_int_big(IntegerOfTerm(t1), t2);
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "// /2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* dividing a bignum by an integer */
2010-05-27 12:24:15 +01:00
return Yap_gmp_div_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
/* two bignums */
2010-05-27 12:24:15 +01:00
return Yap_gmp_div_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "// /2");
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
2009-03-27 15:32:22 +00:00
RERROR();
}
RERROR();
}
static Term
p_and(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
RINT(IntegerOfTerm(t1) & IntegerOfTerm(t2));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
case big_int_e:
#ifdef USE_GMP
2010-05-27 12:24:15 +01:00
return Yap_gmp_and_int_big(IntegerOfTerm(t1),t2);
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "/\\ /2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* anding a bignum with an integer is easy */
2010-05-27 12:24:15 +01:00
return Yap_gmp_and_int_big(IntegerOfTerm(t2),t1);
case big_int_e:
/* two bignums */
2010-05-27 12:24:15 +01:00
return Yap_gmp_and_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "/\\ /2");
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
RERROR();
}
static Term
p_or(Term t1, Term t2 USES_REGS) {
switch(ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
RINT(IntegerOfTerm(t1) | IntegerOfTerm(t2));
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
case big_int_e:
#ifdef USE_GMP
2010-05-27 12:24:15 +01:00
return Yap_gmp_ior_int_big(IntegerOfTerm(t1),t2);
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "\\/ /2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* anding a bignum with an integer is easy */
2010-05-27 12:24:15 +01:00
return Yap_gmp_ior_int_big(IntegerOfTerm(t2),t1);
case big_int_e:
/* two bignums */
2010-05-27 12:24:15 +01:00
return Yap_gmp_ior_big_big(t1, t2);
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "\\/ /2");
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
RERROR();
}
static Term
p_sll(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
2011-11-16 07:36:34 +00:00
{ Int i2 = IntegerOfTerm(t2);
if (i2 <= 0) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
RINT(SLR(IntegerOfTerm(t1), -i2));
}
return do_sll(IntegerOfTerm(t1),i2 PASS_REGS);
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
case big_int_e:
#ifdef USE_GMP
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, "<</2");
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, "<< /2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_sll_big_int(t1, IntegerOfTerm(t2));
case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, "<</2");
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
RERROR();
}
static Term
p_slr(Term t1, Term t2 USES_REGS) {
switch (ETypeOfTerm(t1)) {
case long_int_e:
switch (ETypeOfTerm(t2)) {
case long_int_e:
/* two integers */
2011-11-16 07:36:34 +00:00
{ Int i2 = IntegerOfTerm(t2);
if (i2 < 0) {
if (i2 == Int_MIN) {
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
}
return do_sll(IntegerOfTerm(t1), -i2 PASS_REGS);
}
2011-11-16 07:36:34 +00:00
RINT(SLR(IntegerOfTerm(t1), i2));
}
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
case big_int_e:
#ifdef USE_GMP
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
break;
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t1, ">>/2");
case big_int_e:
#ifdef USE_GMP
switch (ETypeOfTerm(t2)) {
case long_int_e:
2010-05-27 12:24:15 +01:00
return Yap_gmp_sll_big_int(t1, -IntegerOfTerm(t2));
case big_int_e:
return Yap_ArithError(RESOURCE_ERROR_HUGE_INT, t2, ">>/2");
case double_e:
return Yap_ArithError(TYPE_ERROR_INTEGER, t2, ">>/2");
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
#endif
2010-03-06 22:43:21 +00:00
default:
RERROR();
}
RERROR();
}