/*-------------------------------------------------------------------------*
* PL_GROUP_SOLUTIONS_ALT_0 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Group_Solutions_Alt_0(void)
{
WamWord all_sol_word, gl_key_word, sol_word;
WamWord word;
WamWord key_word;
Pl_Update_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0),
0);
all_sol_word = AB(B, 0);
gl_key_word = AB(B, 1);
sol_word = AB(B, 2);
word = Group(all_sol_word, gl_key_word, &key_word);
if (word == NOT_A_WAM_WORD)
Delete_Last_Choice_Point();
else /* non deterministic case */
{
AB(B, 0) = word;
#if 0 /* the following data is unchanged */
AB(B, 1) = gl_key_word;
AB(B, 2) = sol_word;
#endif
}
Pl_Unify(key_word, gl_key_word);
return Pl_Unify(sol_word, all_sol_word);
}
/*-------------------------------------------------------------------------*
* PL_FD_MATH_UNIFY_X_Y *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Fd_Math_Unify_X_Y(WamWord x, WamWord y)
{
WamWord x_word, x_tag;
WamWord y_word, y_tag;
DEREF(x, x_word, x_tag);
DEREF(y, y_word, y_tag);
if (x_tag == TAG_FDV_MASK && y_tag == TAG_FDV_MASK)
{
MATH_CSTR_2(pl_x_eq_y, x, y);
return TRUE;
}
#ifdef DEBUG
DBGPRINTF("Prolog Unif: ");
Pl_Write_1(x_word);
DBGPRINTF(" = ");
Pl_Write_1(y_word);
DBGPRINTF("\n");
#endif
return Pl_Unify(x_word, y_word);
}
/*-------------------------------------------------------------------------*
* PL_TERM_VARIABLES_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Term_Variables_3(WamWord start_word, WamWord list_word, WamWord tail_word)
{
PlLong *p;
/* only check if no Tail since if there is no vars in Term
* then List = Tail and Tail can be any term */
if (tail_word == NOT_A_WAM_WORD)
Pl_Check_For_Un_List(list_word);
var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores variables */
Pl_Treat_Vars_Of_Term(start_word, TRUE, Collect_Variable);
for(p = pl_glob_dico_var; p < var_ptr; p++)
{
if (!Pl_Get_List(list_word) || !Pl_Unify_Value(*p))
return FALSE;
list_word = Pl_Unify_Variable();
}
if (tail_word == NOT_A_WAM_WORD)
return Pl_Get_Nil(list_word);
return Pl_Unify(list_word, tail_word);
}
/*-------------------------------------------------------------------------*
* PL_RECOVER_SOLUTIONS_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Recover_Solutions_2(WamWord stop_word, WamWord handle_key_word,
WamWord list_word)
{
int stop;
int nb_sol;
WamWord *p, *q;
OneSol *s;
Bool handle_key;
stop = Pl_Rd_Integer(stop_word);
nb_sol = sol->sol_no - stop;
if (nb_sol == 0)
return Pl_Get_Nil(list_word);
handle_key = Pl_Rd_Integer(handle_key_word);
key_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: key vars */
H += 2 * nb_sol;
/* Since we start from the end to the beginning, if nb_sol is very big
* when the heap overflow triggers a SIGSEGV the handler will not detect
* that the heap is the culprit (and emits a simple Segmentation Violation
* message). To avoid this we remain just after the end of the stack.
*/
if (H > Global_Stack + Global_Size)
H = Global_Stack + Global_Size;
p = q = H;
while (nb_sol--)
{
p--;
*p = Tag_LST(p + 1);
*--p = Tag_REF(H);
Pl_Copy_Contiguous_Term(H, &sol->term_word);
if (handle_key)
Handle_Key_Variables(*H);
H += sol->term_size;
s = sol;
sol = sol->prev;
Free(s);
}
q[-1] = NIL_WORD;
return Pl_Unify(Tag_LST(p), list_word);
}
/*-------------------------------------------------------------------------*
* PL_GROUP_SOLUTIONS_3 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Group_Solutions_3(WamWord all_sol_word, WamWord gl_key_word,
WamWord sol_word)
{
WamWord word, tag_mask;
WamWord key_word;
DEREF(all_sol_word, word, tag_mask);
if (word == NIL_WORD)
return FALSE;
word = Group(all_sol_word, gl_key_word, &key_word);
if (word != NOT_A_WAM_WORD)
{
A(0) = word;
A(1) = gl_key_word;
A(2) = sol_word;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(GROUP_SOLUTIONS_ALT, 0), 3);
}
Pl_Unify(key_word, gl_key_word);
return Pl_Unify(sol_word, all_sol_word);
}
/*-------------------------------------------------------------------------*
* PL_FREE_VARIABLES_4 *
* *
* Fail if no free variables. *
*-------------------------------------------------------------------------*/
Bool
Pl_Free_Variables_4(WamWord templ_word, WamWord gen_word, WamWord gen1_word,
WamWord key_word)
{
WamWord gl_key_word;
WamWord *save_H, *arg;
int nb_free_var = 0;
bound_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: stores bound vars */
Pl_Treat_Vars_Of_Term(templ_word, TRUE, Bound_Var);
new_gen_word = Existential_Variables(gen_word);
save_H = H++; /* one more word for f/n is possible */
arg = free_var_base = H; /* array is in the heap */
Pl_Treat_Vars_Of_Term(new_gen_word, TRUE, Free_Var);
nb_free_var = H - arg;
if (nb_free_var == 0)
return FALSE;
if (nb_free_var <= MAX_ARITY)
{
*save_H = Functor_Arity(ATOM_CHAR('.'), nb_free_var);
gl_key_word = Tag_STC(save_H);
}
else
{
H = free_var_base;
gl_key_word = Pl_Mk_Proper_List(nb_free_var, arg);
}
Pl_Unify(new_gen_word, gen1_word);
return Pl_Unify(gl_key_word, key_word);
}
/*-------------------------------------------------------------------------*
* PL_BLT_ARG *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Arg(WamWord arg_no_word, WamWord term_word, WamWord sub_term_word)
{
WamWord *arg_adr;
int func, arity;
int arg_no;
Pl_Set_C_Bip_Name("arg", 3);
arg_no = Pl_Rd_Positive_Check(arg_no_word) - 1;
arg_adr = Pl_Rd_Compound_Check(term_word, &func, &arity);
Pl_Unset_C_Bip_Name();
return (unsigned) arg_no < (unsigned) arity &&
Pl_Unify(sub_term_word, arg_adr[arg_no]);
}
/*-------------------------------------------------------------------------*
* PL_COPY_TERM_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Copy_Term_2(WamWord u_word, WamWord v_word)
{
WamWord word;
int size;
/* fix_bug is because when gcc sees &xxx where xxx is a fct argument variable
* it allocates a frame even with -fomit-frame-pointer.
* This corrupts ebp on ix86 */
static WamWord fix_bug;
size = Pl_Term_Size(u_word);
fix_bug = u_word;
Pl_Copy_Term(H, &fix_bug);
word = *H;
H += size;
return Pl_Unify(word, v_word);
}
/*-------------------------------------------------------------------------*
* STRING_TO_NUMBER *
* *
*-------------------------------------------------------------------------*/
static Bool
String_To_Number(char *str, WamWord number_word)
{
WamWord word;
int stm;
StmInf *pstm;
Bool eof;
Pl_Check_For_Un_Number(number_word);
/* #if 0 since layout leading chars allowed in ISO cf. number_chars */
#if 0
if (!isdigit(*str) && *str != '-')
{
Pl_Set_Last_Syntax_Error("", 1, 1, "non numeric character");
goto err;
}
#endif
stm = Pl_Add_Str_Stream(str, TERM_STREAM_ATOM);
pstm = pl_stm_tbl[stm];
word = Pl_Read_Number(pstm);
eof = (Pl_Stream_Peekc(pstm) == EOF);
if (word != NOT_A_WAM_WORD && !eof)
Pl_Set_Last_Syntax_Error(pl_atom_tbl[pstm->atom_file_name].name,
pstm->line_count + 1, pstm->line_pos + 1,
"non numeric character");
Pl_Delete_Str_Stream(stm);
if (word == NOT_A_WAM_WORD || !eof)
{
#if 0
err:
#endif
Pl_Syntax_Error(Flag_Value(syntax_error));
return FALSE;
}
return Pl_Unify(word, number_word);
}
/*-------------------------------------------------------------------------*
* PL_RECOVER_SOLUTIONS_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Recover_Solutions_2(WamWord stop_word, WamWord handle_key_word,
WamWord list_word)
{
int stop;
int nb_sol;
WamWord *p, *q;
OneSol *s;
Bool handle_key;
stop = Pl_Rd_Integer(stop_word);
nb_sol = sol->sol_no - stop;
if (nb_sol == 0)
return Pl_Get_Nil(list_word);
handle_key = Pl_Rd_Integer(handle_key_word);
key_var_ptr = pl_glob_dico_var; /* pl_glob_dico_var: key vars */
H += 2 * nb_sol;
p = q = H;
while (nb_sol--)
{
p--;
*p = Tag_LST(p + 1);
*--p = Tag_REF(H);
Pl_Copy_Contiguous_Term(H, &sol->term_word);
if (handle_key)
Handle_Key_Variables(*H);
H += sol->term_size;
s = sol;
sol = sol->prev;
Free(s);
}
q[-1] = NIL_WORD;
return Pl_Unify(Tag_LST(p), list_word);
}
/*-------------------------------------------------------------------------*
* PL_TERM_REF_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Term_Ref_2(WamWord term_word, WamWord ref_word)
{
WamWord word, tag_mask;
WamWord word1, *adr;
int ref;
/* my own DEREF here to get the address */
adr = NULL; /* added this */
word = term_word;
do
{
word1 = word;
tag_mask = Tag_Mask_Of(word);
if (tag_mask != TAG_REF_MASK)
break;
adr = UnTag_REF(word); /* added this */
word = *adr;
}
while (word != word1);
if (tag_mask == TAG_REF_MASK)
{
ref = Pl_Rd_Positive_Check(ref_word);
adr = Global_Stack + ref;
return Pl_Unify(word, *adr);
}
if (adr < Global_Stack || adr > H)
{
adr = H;
Global_Push(word);
}
ref = Global_Offset(adr);
return Pl_Un_Positive_Check(ref, ref_word);
}
/*-------------------------------------------------------------------------*
* PL_ARITH_EVAL_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Arith_Eval_2(WamWord exp_word, WamWord x_word)
{
return Pl_Unify(Load_Math_Expression(exp_word), x_word);
}
/*-------------------------------------------------------------------------*
* PL_RECOVER_GENERATOR_1 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Recover_Generator_1(WamWord gen1_word)
{
Pl_Unify(new_gen_word, gen1_word);
}
/*-------------------------------------------------------------------------*
* PL_BLT_FUNCTOR *
* *
*-------------------------------------------------------------------------*/
Bool FC
Pl_Blt_Functor(WamWord term_word, WamWord functor_word, WamWord arity_word)
{
WamWord word, tag_mask;
WamWord *adr;
WamWord tag_functor;
int arity;
Bool res;
Pl_Set_C_Bip_Name("functor", 3);
DEREF(term_word, word, tag_mask);
if (tag_mask != TAG_REF_MASK)
{
if (tag_mask == TAG_LST_MASK)
res = Pl_Un_Atom_Check(ATOM_CHAR('.'), functor_word) &&
Pl_Un_Integer_Check(2, arity_word);
else if (tag_mask == TAG_STC_MASK)
{
adr = UnTag_STC(word);
res = Pl_Un_Atom_Check(Functor(adr), functor_word) &&
Pl_Un_Integer_Check(Arity(adr), arity_word);
}
else
res = Pl_Unify(word, functor_word) && Pl_Un_Integer_Check(0, arity_word);
goto finish;
}
/* tag_mask == TAG_REF_MASK */
DEREF(functor_word, word, tag_mask);
if (tag_mask == TAG_REF_MASK)
Pl_Err_Instantiation();
if (tag_mask != TAG_ATM_MASK && tag_mask != TAG_INT_MASK &&
tag_mask != TAG_FLT_MASK)
Pl_Err_Type(pl_type_atomic, functor_word);
tag_functor = tag_mask;
functor_word = word;
arity = Pl_Rd_Positive_Check(arity_word);
if (arity > MAX_ARITY)
Pl_Err_Representation(pl_representation_max_arity);
if (tag_functor == TAG_ATM_MASK && UnTag_ATM(functor_word) == ATOM_CHAR('.')
&& arity == 2)
{
res = (Pl_Get_List(term_word)) ? Pl_Unify_Void(2), TRUE : FALSE;
goto finish;
}
if (tag_functor == TAG_ATM_MASK && arity > 0)
{
res = (Pl_Get_Structure(UnTag_ATM(functor_word), arity, term_word)) ?
Pl_Unify_Void(arity), TRUE : FALSE;
goto finish;
}
if (arity != 0)
Pl_Err_Type(pl_type_atom, functor_word);
res = Pl_Unify(functor_word, term_word);
finish:
Pl_Unset_C_Bip_Name();
return res;
}
/*-------------------------------------------------------------------------*
* PL_UNIF *
* *
* do not use directly Pl_Unify because of FC (fast call) *
*-------------------------------------------------------------------------*/
PlBool
Pl_Unif(PlTerm term1, PlTerm term2)
{
return Pl_Unify(term1, term2);
}
