/*-------------------------------------------------------------------------*
* 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_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_FD_SET_FULL_AC_FLAG_1 *
* *
*-------------------------------------------------------------------------*/
void
Pl_Fd_Set_Full_Ac_Flag_1(WamWord full_ac_word)
{
pl_full_ac = Pl_Rd_Integer(full_ac_word);
}
/*-------------------------------------------------------------------------*
* PL_CURRENT_PREDICATE_2 *
* *
*-------------------------------------------------------------------------*/
Bool
Pl_Current_Predicate_2(WamWord pred_indic_word, WamWord which_preds_word)
{
WamWord name_word, arity_word;
HashScan scan;
PredInf *pred;
int func, arity;
int func1, arity1;
int which_preds; /* 0=user, 1=user+bips, 2=user+bips+system */
Bool all;
func = Pl_Get_Pred_Indicator(pred_indic_word, FALSE, &arity);
name_word = pl_pi_name_word;
arity_word = pl_pi_arity_word;
which_preds = Pl_Rd_Integer(which_preds_word);
if (which_preds == 0 && !Flag_Value(FLAG_STRICT_ISO))
which_preds = 1;
#define Pred_Is_Ok(pred, func, which_preds) \
(which_preds == 2 || (pl_atom_tbl[func].name[0] != '$' && \
(which_preds == 1 || !(pred->prop & MASK_PRED_ANY_BUILTIN))))
if (func >= 0 && arity >= 0)
{
pred = Pl_Lookup_Pred(func, arity);
return pred && Pred_Is_Ok(pred, func, which_preds);
}
/* here func or arity == -1 (or both) */
all = (func == -1 && arity == -1);
pred = (PredInf *) Pl_Hash_First(pl_pred_tbl, &scan);
for (;;)
{
if (pred == NULL)
return FALSE;
func1 = Functor_Of(pred->f_n);
arity1 = Arity_Of(pred->f_n);
if ((all || func == func1 || arity == arity1) &&
Pred_Is_Ok(pred, func1, which_preds))
break;
pred = (PredInf *) Pl_Hash_Next(&scan);
}
/* non deterministic case */
A(0) = name_word;
A(1) = arity_word;
A(2) = which_preds;
A(3) = (WamWord) scan.endt;
A(4) = (WamWord) scan.cur_t;
A(5) = (WamWord) scan.cur_p;
Pl_Create_Choice_Point((CodePtr) Prolog_Predicate(CURRENT_PREDICATE_ALT, 0),
6);
return Pl_Get_Atom(Functor_Of(pred->f_n), name_word) &&
Pl_Get_Integer(Arity_Of(pred->f_n), arity_word);
/*
return Pl_Un_Atom_Check(Functor_Of(pred->f_n), name_word) &&
Pl_Un_Integer_Check(Arity_Of(pred->f_n), arity_word);
*/
}