/*-------------------------------------------------------------------------* * 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); */ }