/*-------------------------------------------------------------------------*
* PL_FD_NEQ_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Neq_2(WamWord le_word, WamWord re_word)
{
int mask;
WamWord l_word, r_word;
PlLong c;
#ifdef DEBUG
cur_op = (pl_full_ac) ? "#\\=#" : "#\\=";
#endif
if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word))
return FALSE;
switch (mask)
{
case MASK_EMPTY:
if (c == 0)
return FALSE;
goto term_load;
case MASK_LEFT:
if (c > 0)
{
Pl_Fd_Prolog_To_Fd_Var(l_word, TRUE);
goto term_load;
}
PRIM_CSTR_2(pl_x_neq_c, l_word, Tag_INT(-c));
goto term_load;
case MASK_RIGHT:
if (c < 0)
{
Pl_Fd_Prolog_To_Fd_Var(r_word, TRUE);
goto term_load;
}
PRIM_CSTR_2(pl_x_neq_c, r_word, Tag_INT(c));
goto term_load;
}
if (c > 0)
{
PRIM_CSTR_3(pl_x_plus_c_neq_y, l_word, Tag_INT(c), r_word);
goto term_load;
}
if (c < 0)
{
PRIM_CSTR_3(pl_x_plus_c_neq_y, r_word, Tag_INT(-c), l_word);
goto term_load;
}
PRIM_CSTR_2(pl_x_neq_y, l_word, r_word);
term_load:
return Pl_Term_Math_Loading(l_word, r_word);
}
/*-------------------------------------------------------------------------*
* LOAD_POLY_REC *
* *
* This function recursively loads a polynomial term into a word. *
* Input: *
* nb_monom : nb of monomial terms (nb_monom > 0) *
* m : array of monomial terms *
* load_word : the word where the term must be loaded *
* *
* At the entry, if nb_monom==1 then the coefficient of the monomial term *
* is > 1 (see call from Load_Poly() and recursive call). *
*-------------------------------------------------------------------------*/
static Bool
Load_Poly_Rec(int nb_monom, Monom *m, WamWord load_word)
{
WamWord load_word1;
if (nb_monom == 1)
{ /* here m[0].a != 1 */
MATH_CSTR_3(pl_ax_eq_y, Tag_INT(m[0].a), m[0].x_word, load_word);
return TRUE;
}
if (nb_monom == 2)
{
if (m[0].a == 1)
{
if (m[1].a == 1)
MATH_CSTR_3(pl_x_plus_y_eq_z, m[0].x_word, m[1].x_word, load_word);
else
MATH_CSTR_4(pl_ax_plus_y_eq_z, Tag_INT(m[1].a), m[1].x_word,
m[0].x_word, load_word);
}
else if (m[1].a == 1)
MATH_CSTR_4(pl_ax_plus_y_eq_z, Tag_INT(m[0].a), m[0].x_word, m[1].x_word,
load_word);
else
MATH_CSTR_5(pl_ax_plus_by_eq_z, Tag_INT(m[0].a), m[0].x_word,
Tag_INT(m[1].a), m[1].x_word, load_word);
return TRUE;
}
if (nb_monom == 3 && m[2].a == 1)
load_word1 = m[2].x_word;
else
load_word1 = New_Tagged_Fd_Variable;
if (m[0].a == 1)
{
if (m[1].a == 1)
MATH_CSTR_4(pl_x_plus_y_plus_z_eq_t, m[0].x_word, m[1].x_word,
load_word1, load_word);
else
MATH_CSTR_5(pl_ax_plus_y_plus_z_eq_t, Tag_INT(m[1].a), m[1].x_word,
m[0].x_word, load_word1, load_word);
}
else if (m[1].a == 1)
MATH_CSTR_5(pl_ax_plus_y_plus_z_eq_t, Tag_INT(m[0].a), m[0].x_word,
m[1].x_word, load_word1, load_word);
else
PRIM_CSTR_6(pl_ax_plus_by_plus_z_eq_t, Tag_INT(m[0].a), m[0].x_word,
Tag_INT(m[1].a), m[1].x_word, load_word1, load_word);
if (!(nb_monom == 3 && m[2].a == 1))
return Load_Poly_Rec(nb_monom - 2, m + 2, load_word1);
return TRUE;
}
/*-------------------------------------------------------------------------*
* PL_FD_EQ_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Eq_2(WamWord le_word, WamWord re_word)
{
int mask;
WamWord l_word, r_word;
PlLong c;
#ifdef DEBUG
cur_op = (pl_full_ac) ? "#=#" : "#=";
#endif
if (!Pl_Load_Left_Right(TRUE, le_word, re_word, &mask, &c, &l_word, &r_word))
return FALSE;
switch (mask)
{
case MASK_EMPTY:
if (c != 0)
return FALSE;
goto term_load;
case MASK_LEFT:
if (c > 0)
return FALSE;
PRIM_CSTR_2(pl_x_eq_c, l_word, Tag_INT(-c));
goto term_load;
case MASK_RIGHT:
if (c < 0)
return FALSE;
PRIM_CSTR_2(pl_x_eq_c, r_word, Tag_INT(c));
goto term_load;
}
if (c > 0)
{
MATH_CSTR_3(pl_x_plus_c_eq_y, l_word, Tag_INT(c), r_word);
goto term_load;
}
if (c < 0)
{
MATH_CSTR_3(pl_x_plus_c_eq_y, r_word, Tag_INT(-c), l_word);
goto term_load;
}
/* if c == 0 nothing to do since preference via pref_load_word */
term_load:
return Pl_Term_Math_Loading(l_word, r_word);
}
WamWord FC
Pl_Fct_Fast_Shl(WamWord x, WamWord y)
{
long vx = UnTag_INT(x);
long vy = UnTag_INT(y);
return Tag_INT(vx << vy);
}
WamWord FC
Pl_Fct_Fast_Add(WamWord x, WamWord y)
{
long vx = UnTag_INT(x);
long vy = UnTag_INT(y);
return Tag_INT(vx + vy);
}
/*-------------------------------------------------------------------------*
* PREPARE_CALL *
* *
*-------------------------------------------------------------------------*/
static CodePtr
Prepare_Call(int func, int arity, WamWord *arg_adr)
{
PredInf *pred;
WamWord *w;
int i;
int bip_func, bip_arity;
pred = Pl_Lookup_Pred(func, arity);
if (pred == NULL || !(pred->prop & MASK_PRED_NATIVE_CODE) ||
(pred->prop & MASK_PRED_CONTROL_CONSTRUCT))
{
if (arity == 0)
A(0) = Tag_ATM(func);
else
{
w = goal_H;
A(0) = Tag_STC(w);
*w++ = Functor_Arity(func, arity);
for (i = 0; i < arity; i++)
*w++ = *arg_adr++;
}
bip_func = Pl_Get_Current_Bip(&bip_arity);
A(1) = Tag_INT(Call_Info(bip_func, bip_arity, 0));
return (CodePtr) Prolog_Predicate(CALL_INTERNAL, 2);
}
for (i = 0; i < arity; i++)
A(i) = *arg_adr++;
return (CodePtr) (pred->codep);
}
WamWord FC
Pl_Fct_Fast_Rem(WamWord x, WamWord y)
{
long vx = UnTag_INT(x);
long vy = UnTag_INT(y);
if (vy == 0)
Pl_Err_Evaluation(pl_evluation_zero_divisor);
return Tag_INT(vx % vy);
}
WamWord FC
Pl_Fct_Fast_Mod(WamWord x, WamWord y)
{
long vx = UnTag_INT(x);
long vy = UnTag_INT(y);
long m;
if (vy == 0)
Pl_Err_Evaluation(pl_evluation_zero_divisor);
m = vx % vy;
if (m != 0 && (m ^ vy) < 0) /* have m and vy different signs ? */
m += vy;
return Tag_INT(m);
}
/*-------------------------------------------------------------------------*
* PL_FD_NEW_INT_VARIABLE *
* *
*-------------------------------------------------------------------------*/
WamWord *
Pl_Fd_New_Int_Variable(int n)
{
WamWord *fdv_adr = CS;
FD_Tag_Value(fdv_adr) = Tag_INT(n);
FD_INT_Date(fdv_adr) = DATE; /* put a great value to have an exact optim #2 */
Queue_Date_At_Push(fdv_adr) = 0;
Queue_Propag_Mask(fdv_adr) = 0;
Queue_Next_Fdv_Adr(fdv_adr) = (WamWord) NULL;
Range_Stamp(fdv_adr) = STAMP;
Nb_Elem(fdv_adr) = 1;
Range_Init_Interval(Range(fdv_adr), n, n);
CS += FD_INT_VARIABLE_FRAME_SIZE;
return fdv_adr;
}
WamWord FC
Pl_Fct_Fast_Not(WamWord x)
{
long vx = UnTag_INT(x);
return Tag_INT(~vx);
}
WamWord FC
Pl_Fct_Fast_Dec(WamWord x)
{
long vx = UnTag_INT(x);
return Tag_INT(vx - 1);
}
WamWord FC
Pl_Fct_Fast_Neg(WamWord x)
{
long vx = UnTag_INT(x);
return Tag_INT(-vx);
}
/*-------------------------------------------------------------------------*
* SET_LTE *
* *
*-------------------------------------------------------------------------*/
static Bool
Set_Lte(WamWord *exp, int result, WamWord *load_word)
{
WamWord le_word, re_word;
int mask;
WamWord l_word, r_word;
PlLong c;
le_word = exp[1];
re_word = exp[2];
if (result == 0) /* L <= R is false */
return Pl_Fd_Lt_2(re_word, le_word);
if (result == 1) /* L <= R is true */
return Pl_Fd_Lte_2(le_word, re_word);
*load_word = Tag_REF(Pl_Fd_New_Bool_Variable());
#ifdef DEBUG
cur_op = (pl_full_ac) ? "truth#=<#" : "truth#=<";
#endif
if (!Pl_Load_Left_Right(FALSE, le_word, re_word, &mask, &c, &l_word, &r_word)
|| !Pl_Term_Math_Loading(l_word, r_word))
return FALSE;
switch (mask)
{
case MASK_EMPTY:
return Pl_Get_Integer(c <= 0, *load_word);
case MASK_LEFT:
if (c > 0)
return Pl_Get_Integer(0, *load_word);
PRIM_CSTR_3(pl_truth_x_lte_c, l_word, Tag_INT(-c), *load_word);
return TRUE;
case MASK_RIGHT:
if (c <= 0)
return Pl_Get_Integer(1, *load_word);
PRIM_CSTR_3(pl_truth_x_gte_c, r_word, Tag_INT(c), *load_word);
return TRUE;
}
if (c > 0)
{
PRIM_CSTR_4(pl_truth_x_plus_c_lte_y, l_word, Tag_INT(c), r_word,
*load_word);
return TRUE;
}
if (c < 0)
{
PRIM_CSTR_4(pl_truth_x_plus_c_gte_y, r_word, Tag_INT(-c), l_word,
*load_word);
return TRUE;
}
PRIM_CSTR_3(pl_truth_x_lte_y, l_word, r_word, *load_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* LOAD_TERM_INTO_WORD *
* *
* This function loads a term into a (tagged) word. *
* Input: *
* e_word : term to load *
* *
* Output: *
* load_word: the tagged word containing the loading of the term: *
* can be a <INT,val> if there is no variable or a <REF,adr>) *
* *
* This functions acts like T #= NewVar. However, if T is just an integer *
* it avoids the creation of a useless FD NewVar. *
*-------------------------------------------------------------------------*/
static Bool
Load_Term_Into_Word(WamWord e_word, WamWord *load_word)
{
int mask;
WamWord l_word, r_word, word;
PlLong c;
if (!Load_Left_Right_Rec(FALSE, e_word, NOT_A_WAM_WORD, &mask, &c,
&l_word, &r_word))
return FALSE;
if (mask == MASK_EMPTY)
{
if (c < 0)
return FALSE;
*load_word = Tag_INT(c);
return TRUE;
}
if (mask == MASK_LEFT && c == 0)
{
*load_word = l_word;
return TRUE;
}
*load_word = New_Tagged_Fd_Variable;
switch (mask)
{
case MASK_LEFT: /* here c != 0 */
if (c > 0)
MATH_CSTR_3(pl_x_plus_c_eq_y, l_word, Tag_INT(c), *load_word);
else
MATH_CSTR_3(pl_x_plus_c_eq_y, *load_word, Tag_INT(-c), l_word);
return TRUE;
case MASK_RIGHT:
if (c < 0)
return FALSE;
word = New_Tagged_Fd_Variable;
MATH_CSTR_3(pl_x_plus_y_eq_z, r_word, *load_word, word);
PRIM_CSTR_2(pl_x_eq_c, word, Tag_INT(c));
return TRUE;
}
if (c == 0)
{
MATH_CSTR_3(pl_x_plus_y_eq_z, r_word, *load_word, l_word);
return TRUE;
}
word = New_Tagged_Fd_Variable;
MATH_CSTR_3(pl_x_plus_y_eq_z, r_word, *load_word, word);
if (c > 0)
MATH_CSTR_3(pl_x_plus_c_eq_y, l_word, Tag_INT(c), word);
else
MATH_CSTR_3(pl_x_plus_c_eq_y, word, Tag_INT(-c), l_word);
return TRUE;
}
/*-------------------------------------------------------------------------*
* LOAD_DELAY_CSTR_PART *
* *
*-------------------------------------------------------------------------*/
static Bool
Load_Delay_Cstr_Part(void)
{
NonLin *i;
for (i = delay_cstr_stack; i < delay_sp; i++)
{
switch (i->cstr)
{
case DC_X2_EQ_Y:
MATH_CSTR_2(pl_x2_eq_y, i->a1, i->res);
break;
case DC_XY_EQ_Z:
MATH_CSTR_3(pl_xy_eq_z, i->a1, i->a2, i->res);
break;
case DC_DIV_A_Y_EQ_Z:
PRIM_CSTR_2(pl_x_gte_c, i->a2, Tag_INT(1));
MATH_CSTR_3(pl_xy_eq_z, i->res, i->a2, i->a1);
break;
case DC_DIV_X_A_EQ_Z:
MATH_CSTR_3(pl_ax_eq_y, i->a2, i->res, i->a1);
break;
case DC_DIV_X_Y_EQ_Z:
PRIM_CSTR_2(pl_x_gte_c, i->a2, Tag_INT(1));
MATH_CSTR_3(pl_xy_eq_z, i->res, i->a2, i->a1);
break;
case DC_ZERO_POWER_N_EQ_Y:
PRIM_CSTR_2(pl_zero_power_n_eq_y, i->a1, i->res);
break;
case DC_A_POWER_N_EQ_Y:
MATH_CSTR_3(pl_a_power_n_eq_y, i->a1, i->a2, i->res);
break;
case DC_X_POWER_A_EQ_Y:
MATH_CSTR_3(pl_x_power_a_eq_y, i->a1, i->a2, i->res);
break;
case DC_MIN_X_A_EQ_Z:
MATH_CSTR_3(pl_min_x_a_eq_z, i->a1, i->a2, i->res);
break;
case DC_MIN_X_Y_EQ_Z:
MATH_CSTR_3(pl_min_x_y_eq_z, i->a1, i->a2, i->res);
break;
case DC_MAX_X_A_EQ_Z:
MATH_CSTR_3(pl_max_x_a_eq_z, i->a1, i->a2, i->res);
break;
case DC_MAX_X_Y_EQ_Z:
MATH_CSTR_3(pl_max_x_y_eq_z, i->a1, i->a2, i->res);
break;
case DC_ABS_X_MINUS_A_EQ_Z:
MATH_CSTR_3(pl_abs_x_minus_a_eq_z, i->a1, i->a2, i->res);
break;
case DC_ABS_X_MINUS_Y_EQ_Z:
MATH_CSTR_3(pl_abs_x_minus_y_eq_z, i->a1, i->a2, i->res);
break;
case DC_QUOT_REM_A_Y_R_EQ_Z:
MATH_CSTR_4(pl_quot_rem_a_y_r_eq_z, i->a1, i->a2, i->a3, i->res);
break;
case DC_QUOT_REM_X_A_R_EQ_Z:
MATH_CSTR_4(pl_quot_rem_x_a_r_eq_z, i->a1, i->a2, i->a3, i->res);
break;
case DC_QUOT_REM_X_Y_R_EQ_Z:
MATH_CSTR_4(pl_quot_rem_x_y_r_eq_z, i->a1, i->a2, i->a3, i->res);
break;
}
}
delay_sp = delay_cstr_stack;
return TRUE;
}
WamWord FC
Pl_Fct_Fast_Abs(WamWord x)
{
long vx = UnTag_INT(x);
return (vx < 0) ? Tag_INT(-vx) : x;
}
WamWord FC
Pl_Fct_Fast_Sign(WamWord x)
{
long vx = UnTag_INT(x);
return (vx < 0) ? Tag_INT(-1) : (vx == 0) ? Tag_INT(0) : Tag_INT(1);
}
WamWord FC
Pl_Fct_Fast_Inc(WamWord x)
{
long vx = UnTag_INT(x);
return Tag_INT(vx + 1);
}