diff --git a/OPTYap/opt.preds.c b/OPTYap/opt.preds.c index 0c8a8e2ac..3e6409476 100644 --- a/OPTYap/opt.preds.c +++ b/OPTYap/opt.preds.c @@ -71,6 +71,7 @@ static Int p_abolish_table(void); static Int p_abolish_all_tables(void); static Int p_show_tabled_predicates(void); static Int p_show_table(void); +static Int p_show_all_tables(void); static Int p_table_statistics(void); static Int p_tabling_statistics(void); #endif /* TABLING */ @@ -135,6 +136,7 @@ void Yap_init_optyap_preds(void) { Yap_InitCPred("abolish_all_tables", 0, p_abolish_all_tables, SafePredFlag|SyncPredFlag); Yap_InitCPred("show_tabled_predicates", 0, p_show_tabled_predicates, SafePredFlag|SyncPredFlag); Yap_InitCPred("$c_show_table", 2, p_show_table, SafePredFlag|SyncPredFlag|HiddenPredFlag); + Yap_InitCPred("show_all_tables", 0, p_show_all_tables, SafePredFlag|SyncPredFlag); Yap_InitCPred("$c_table_statistics", 2, p_table_statistics, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("tabling_statistics", 0, p_tabling_statistics, SafePredFlag|SyncPredFlag); #endif /* TABLING */ @@ -328,32 +330,32 @@ Int p_performance(void) { return(FALSE); if (GLOBAL_number_goals) { - fprintf(Yap_stderr, "[\n Best execution times:\n"); + fprintf(Yap_stdout, "[\n Best execution times:\n"); for (i = 1; i <= GLOBAL_number_goals; i++) { - fprintf(Yap_stderr, " %d. time: %f seconds", i, GLOBAL_best_times(i)); + fprintf(Yap_stdout, " %d. time: %f seconds", i, GLOBAL_best_times(i)); if (one_worker_execution_time != 0) - fprintf(Yap_stderr, " --> speedup %f (%6.2f %% )\n", + fprintf(Yap_stdout, " --> speedup %f (%6.2f %% )\n", one_worker_execution_time / GLOBAL_best_times(i), one_worker_execution_time / GLOBAL_best_times(i) / number_workers * 100 ); - else fprintf(Yap_stderr, "\n"); + else fprintf(Yap_stdout, "\n"); } - fprintf(Yap_stderr, " Average : %f seconds", + fprintf(Yap_stdout, " Average : %f seconds", GLOBAL_best_times(0) / GLOBAL_number_goals); if (one_worker_execution_time != 0) - fprintf(Yap_stderr, " --> speedup %f (%6.2f %% )", + fprintf(Yap_stdout, " --> speedup %f (%6.2f %% )", one_worker_execution_time * GLOBAL_number_goals / GLOBAL_best_times(0), one_worker_execution_time * GLOBAL_number_goals / GLOBAL_best_times(0) / number_workers * 100 ); if (GLOBAL_number_goals >= 3) { - fprintf(Yap_stderr, "\n Average (best three): %f seconds", + fprintf(Yap_stdout, "\n Average (best three): %f seconds", (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)) / 3); if (one_worker_execution_time != 0) - fprintf(Yap_stderr, " --> speedup %f (%6.2f %% ) ]\n\n", + fprintf(Yap_stdout, " --> speedup %f (%6.2f %% ) ]\n\n", one_worker_execution_time * 3 / (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)), one_worker_execution_time * 3 / (GLOBAL_best_times(1) + GLOBAL_best_times(2) + GLOBAL_best_times(3)) / number_workers * 100 ); - else fprintf(Yap_stderr, "\n]\n\n"); - } else fprintf(Yap_stderr, "\n]\n\n"); + else fprintf(Yap_stdout, "\n]\n\n"); + } else fprintf(Yap_stdout, "\n]\n\n"); return (TRUE); } return (FALSE); @@ -497,27 +499,27 @@ Int p_or_statistics(void) { #ifdef SHM_MEMORY_ALLOC_SCHEME long pages_in_use = 0, bytes_in_use = 0; - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n"); shm_or_frames(&pages_in_use, &bytes_in_use); shm_query_goal_solution_frames(&pages_in_use, &bytes_in_use); shm_query_goal_answer_frames(&pages_in_use, &bytes_in_use); shm_pages(pages_in_use, bytes_in_use); - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n"); #else long bytes_in_use = 0; - fprintf(Yap_stderr, "\n"); - fprintf(Yap_stderr, "%s or frames: %10ld structs in use\n", + fprintf(Yap_stdout, "\n"); + fprintf(Yap_stdout, "%s or frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_or_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_or_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_or_fr) * sizeof(struct or_frame); - fprintf(Yap_stderr, "%s query goal solution frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s query goal solution frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) * sizeof(struct query_goal_solution_frame); - fprintf(Yap_stderr, "%s query goal answer frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s query goal answer frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) * sizeof(struct query_goal_answer_frame); - fprintf(Yap_stderr, "\n total memory in use: %10ld bytes\n", bytes_in_use); - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n total memory in use: %10ld bytes\n", bytes_in_use); + fprintf(Yap_stdout, "\n"); #endif /* MEMORY_ALLOC_SCHEME */ return (TRUE); } @@ -554,20 +556,21 @@ static Int p_table(void) { Term mod, t; PredEntry *pe; + Atom at; + int arity; tab_ent_ptr tab_ent; sg_node_ptr sg_node; - UInt arity; mod = Deref(ARG1); t = Deref(ARG2); if (IsAtomTerm(t)) { - Atom at = AtomOfTerm(t); + at = AtomOfTerm(t); pe = RepPredProp(PredPropByAtom(at, mod)); arity = 0; } else if (IsApplTerm(t)) { - Functor func = FunctorOfTerm(t); - pe = RepPredProp(PredPropByFunc(func, mod)); - arity = ArityOfFunctor(func); + at = NameOfFunctor(FunctorOfTerm(t)); + pe = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod)); + arity = ArityOfFunctor(FunctorOfTerm(t)); } else return (FALSE); if (pe->PredFlags & TabledPredFlag) @@ -576,7 +579,7 @@ Int p_table(void) { return (FALSE); /* predicate already compiled */ pe->PredFlags |= TabledPredFlag; new_subgoal_trie_node(sg_node, 0, NULL, NULL, NULL); - new_table_entry(tab_ent, pe, arity, sg_node); + new_table_entry(tab_ent, pe, at, arity, sg_node); if (IsMode_Local(yap_flags[TABLING_MODE_FLAG])) SetMode_Local(TabEnt_mode(tab_ent)); if (IsMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG])) @@ -593,13 +596,11 @@ Int p_tabling_mode(void) { mod = Deref(ARG1); t = Deref(ARG2); - if (IsAtomTerm(t)) { - Atom at = AtomOfTerm(t); - tab_ent = RepPredProp(PredPropByAtom(at, mod))->TableOfPred; - } else if (IsApplTerm(t)) { - Functor ft = FunctorOfTerm(t); - tab_ent = RepPredProp(PredPropByFunc(ft, mod))->TableOfPred; - } else + if (IsAtomTerm(t)) + tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred; + else if (IsApplTerm(t)) + tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; + else return (FALSE); val = Deref(ARG3); if (IsVarTerm(val)) { @@ -714,27 +715,14 @@ Int p_abolish_all_tables(void) { static Int p_show_tabled_predicates(void) { tab_ent_ptr tab_ent; - PredEntry *pred; - char *name; - Int arity; - fprintf(Yap_stderr, "Tabled predicates\n"); tab_ent = GLOBAL_root_tab_ent; + fprintf(Yap_stdout, "Tabled predicates\n"); if (tab_ent == NULL) - fprintf(Yap_stderr, " none\n"); - else + fprintf(Yap_stdout, " none\n"); + else while(tab_ent) { - pred = TabEnt_pe(tab_ent); - arity = pred->ArityOfPE; - if (arity == 0) - name = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE; - else - name = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE; -#if SHORT_INTS - fprintf(Yap_stderr, " %s/%ld\n", name, arity); -#else - fprintf(Yap_stderr, " %s/%d\n", name, arity); -#endif /* SHORT_INTS */ + fprintf(Yap_stdout, " %s/%d\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); tab_ent = TabEnt_next(tab_ent); } return (TRUE); @@ -745,20 +733,31 @@ static Int p_show_table(void) { Term mod, t; tab_ent_ptr tab_ent; - Atom at; mod = Deref(ARG1); t = Deref(ARG2); - if (IsAtomTerm(t)) { - at = AtomOfTerm(t); - tab_ent = RepPredProp(PredPropByAtom(at, mod))->TableOfPred; - } else if (IsApplTerm(t)) { - at = NameOfFunctor(FunctorOfTerm(t)); + if (IsAtomTerm(t)) + tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred; + else if (IsApplTerm(t)) tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; - } else + else return (FALSE); - fprintf(Yap_stderr, "Table structure for predicate '%s/%d'\n", AtomName(at), TabEnt_arity(tab_ent)); - traverse_table(tab_ent, at, TRUE); + fprintf(Yap_stdout, "Table structure for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + traverse_table(tab_ent, TRUE); + return (TRUE); +} + + +static +Int p_show_all_tables(void) { + tab_ent_ptr tab_ent; + + tab_ent = GLOBAL_root_tab_ent; + while(tab_ent) { + fprintf(Yap_stdout, "Table structure for predicate '%s/%d'\n", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + traverse_table(tab_ent, TRUE); + tab_ent = TabEnt_next(tab_ent); + } return (TRUE); } @@ -767,21 +766,18 @@ static Int p_table_statistics(void) { Term mod, t; tab_ent_ptr tab_ent; - Atom at; mod = Deref(ARG1); t = Deref(ARG2); - if (IsAtomTerm(t)) { - at = AtomOfTerm(t); - tab_ent = RepPredProp(PredPropByAtom(at, mod))->TableOfPred; - } else if (IsApplTerm(t)) { - at = NameOfFunctor(FunctorOfTerm(t)); + if (IsAtomTerm(t)) + tab_ent = RepPredProp(PredPropByAtom(AtomOfTerm(t), mod))->TableOfPred; + else if (IsApplTerm(t)) tab_ent = RepPredProp(PredPropByFunc(FunctorOfTerm(t), mod))->TableOfPred; - } else + else return (FALSE); - fprintf(Yap_stderr, "Table statistics for predicate '%s/%d'", AtomName(at), TabEnt_arity(tab_ent)); - if (traverse_table(tab_ent, at, FALSE)) - table_stats(); + fprintf(Yap_stdout, "Table statistics for predicate '%s/%d'", AtomName(TabEnt_atom(tab_ent)), TabEnt_arity(tab_ent)); + traverse_table(tab_ent, FALSE); + table_stats(); return (TRUE); } @@ -791,7 +787,7 @@ Int p_tabling_statistics(void) { #ifdef SHM_MEMORY_ALLOC_SCHEME long pages_in_use = 0, bytes_in_use = 0; - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n"); shm_table_entries(&pages_in_use, &bytes_in_use); shm_subgoal_frames(&pages_in_use, &bytes_in_use); shm_subgoal_trie_nodes(&pages_in_use, &bytes_in_use); @@ -800,29 +796,29 @@ Int p_tabling_statistics(void) { shm_answer_hashes(&pages_in_use, &bytes_in_use); shm_dependency_frames(&pages_in_use, &bytes_in_use); shm_pages(pages_in_use, bytes_in_use); - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n"); #else long bytes_in_use = 0; - fprintf(Yap_stderr, "\n"); - fprintf(Yap_stderr, " table entries: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_tab_ent)); + fprintf(Yap_stdout, "\n"); + fprintf(Yap_stdout, " table entries: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_tab_ent)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_tab_ent) * sizeof(struct table_entry); - fprintf(Yap_stderr, " subgoal frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_fr)); + fprintf(Yap_stdout, " subgoal frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_fr) * sizeof(struct subgoal_frame); - fprintf(Yap_stderr, " subgoal trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_node)); + fprintf(Yap_stdout, " subgoal trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_node)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_node) * sizeof(struct subgoal_trie_node); - fprintf(Yap_stderr, " answer trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_node)); + fprintf(Yap_stdout, " answer trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_node)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_node) * sizeof(struct answer_trie_node); - fprintf(Yap_stderr, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash)); + fprintf(Yap_stdout, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_hash) * sizeof(struct subgoal_hash); - fprintf(Yap_stderr, "%s answer hashes: %10ld structs in use\n", + fprintf(Yap_stdout, "%s answer hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_hash) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_ans_hash)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash); - fprintf(Yap_stderr, "%s dependency frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s dependency frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_dep_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_dep_fr) * sizeof(struct dependency_frame); - fprintf(Yap_stderr, "\n total memory in use: %10ld bytes\n", bytes_in_use); - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n total memory in use: %10ld bytes\n", bytes_in_use); + fprintf(Yap_stdout, "\n"); #endif /* MEMORY_ALLOC_SCHEME */ return (TRUE); } @@ -835,7 +831,7 @@ int p_opt_statistics(void) { #ifdef SHM_MEMORY_ALLOC_SCHEME long pages_in_use = 0, bytes_in_use = 0; - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n"); shm_or_frames(&pages_in_use, &bytes_in_use); shm_query_goal_solution_frames(&pages_in_use, &bytes_in_use); shm_query_goal_answer_frames(&pages_in_use, &bytes_in_use); @@ -852,49 +848,49 @@ int p_opt_statistics(void) { shm_dependency_frames(&pages_in_use, &bytes_in_use); shm_show_suspension_frames(&pages_in_use, &bytes_in_use); shm_pages(pages_in_use, bytes_in_use); - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n"); #else long bytes_in_use = 0; - fprintf(Yap_stderr, "\n"); - fprintf(Yap_stderr, "%s or frames: %10ld structs in use\n", + fprintf(Yap_stdout, "\n"); + fprintf(Yap_stdout, "%s or frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_or_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_or_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_or_fr) * sizeof(struct or_frame); - fprintf(Yap_stderr, "%s query goal solution frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s query goal solution frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) * sizeof(struct query_goal_solution_frame); - fprintf(Yap_stderr, "%s query goal answer frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s query goal answer frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) * sizeof(struct query_goal_answer_frame); #ifdef TABLING_INNER_CUTS - fprintf(Yap_stderr, "%s table subgoal solution frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s table subgoal solution frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr) * sizeof(struct table_subgoal_solution_frame); - fprintf(Yap_stderr, "%s table subgoal answer frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s table subgoal answer frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr) * sizeof(struct table_subgoal_answer_frame); #endif /* TABLING_INNER_CUTS */ - fprintf(Yap_stderr, " table entries: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_tab_ent)); + fprintf(Yap_stdout, " table entries: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_tab_ent)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_tab_ent) * sizeof(struct table_entry); - fprintf(Yap_stderr, " subgoal frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_fr)); + fprintf(Yap_stdout, " subgoal frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_fr) * sizeof(struct subgoal_frame); - fprintf(Yap_stderr, " subgoal trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_node)); + fprintf(Yap_stdout, " subgoal trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_node)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_node) * sizeof(struct subgoal_trie_node); - fprintf(Yap_stderr, " answer trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_node)); + fprintf(Yap_stdout, " answer trie nodes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_node)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_node) * sizeof(struct answer_trie_node); - fprintf(Yap_stderr, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash)); + fprintf(Yap_stdout, " subgoal hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_sg_hash)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_sg_hash) * sizeof(struct subgoal_hash); - fprintf(Yap_stderr, "%s answer hashes: %10ld structs in use\n", + fprintf(Yap_stdout, "%s answer hashes: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_ans_hash) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_ans_hash)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_ans_hash) * sizeof(struct answer_hash); - fprintf(Yap_stderr, "%s dependency frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s dependency frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_dep_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_dep_fr) * sizeof(struct dependency_frame); - fprintf(Yap_stderr, "%s suspension frames: %10ld structs in use\n", + fprintf(Yap_stdout, "%s suspension frames: %10ld structs in use\n", Pg_str_in_use(GLOBAL_PAGES_susp_fr) == 0 ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_susp_fr)); bytes_in_use += Pg_str_in_use(GLOBAL_PAGES_susp_fr) * sizeof(struct suspension_frame); - fprintf(Yap_stderr, "\n total memory in use: %10ld bytes\n", bytes_in_use); - fprintf(Yap_stderr, "\n"); + fprintf(Yap_stdout, "\n total memory in use: %10ld bytes\n", bytes_in_use); + fprintf(Yap_stdout, "\n"); #endif /* MEMORY_ALLOC_SCHEME */ return (TRUE); } @@ -938,11 +934,11 @@ void shm_pages(long pages_in_use, long bytes_in_use) { cont++; pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "\n%s total memory in use: %8ld pages %10ld bytes\n", + fprintf(Yap_stdout, "\n%s total memory in use: %8ld pages %10ld bytes\n", Pg_str_in_use(GLOBAL_PAGES_void) == pages_in_use && Pg_pg_alloc(GLOBAL_PAGES_void) - pages_in_use == cont ? " ": "*", Pg_str_in_use(GLOBAL_PAGES_void), bytes_in_use); - fprintf(Yap_stderr, " total memory: %8ld pages %10ld bytes\n", + fprintf(Yap_stdout, " total memory: %8ld pages %10ld bytes\n", Pg_pg_alloc(GLOBAL_PAGES_void), Pg_pg_alloc(GLOBAL_PAGES_void) * Yap_page_size); return; } @@ -964,7 +960,7 @@ void shm_or_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s or frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s or frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_or_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_or_fr) == 1 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_or_fr), Pg_str_in_use(GLOBAL_PAGES_or_fr)); @@ -989,7 +985,7 @@ void shm_query_goal_solution_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s query goal solution frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s query goal solution frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_qg_sol_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr) == 0 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_qg_sol_fr), Pg_str_in_use(GLOBAL_PAGES_qg_sol_fr)); @@ -1014,7 +1010,7 @@ void shm_query_goal_answer_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s query goal answer frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s query goal answer frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_qg_ans_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr) == 0 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_qg_ans_fr), Pg_str_in_use(GLOBAL_PAGES_qg_ans_fr)); @@ -1041,7 +1037,7 @@ void shm_table_subgoal_solution_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s table subgoal solution frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s table subgoal solution frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_tg_sol_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr) == 0 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_tg_sol_fr), Pg_str_in_use(GLOBAL_PAGES_tg_sol_fr)); @@ -1066,7 +1062,7 @@ void shm_table_subgoal_answer_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s table subgoal answer frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s table subgoal answer frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_tg_ans_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr) == 0 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_tg_ans_fr), Pg_str_in_use(GLOBAL_PAGES_tg_ans_fr)); @@ -1098,7 +1094,7 @@ void shm_table_entries(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s table entries: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s table entries: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_tab_ent) + Pg_str_in_use(GLOBAL_PAGES_tab_ent) == cont ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_tab_ent), Pg_str_in_use(GLOBAL_PAGES_tab_ent)); *pages_in_use += Pg_pg_alloc(GLOBAL_PAGES_tab_ent); @@ -1129,7 +1125,7 @@ void shm_subgoal_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s subgoal frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s subgoal frames: %8ld pages %10ld structs in use\n", #ifdef LIMIT_TABLING Pg_str_in_use(GLOBAL_PAGES_sg_fr) + #endif /* LIMIT_TABLING */ @@ -1156,7 +1152,7 @@ void shm_subgoal_trie_nodes(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s subgoal trie nodes: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s subgoal trie nodes: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_sg_node) == cont ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_sg_node), Pg_str_in_use(GLOBAL_PAGES_sg_node)); *pages_in_use += Pg_pg_alloc(GLOBAL_PAGES_sg_node); @@ -1180,7 +1176,7 @@ void shm_answer_trie_nodes(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s answer trie nodes: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s answer trie nodes: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_ans_node) == cont ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_ans_node), Pg_str_in_use(GLOBAL_PAGES_ans_node)); *pages_in_use += Pg_pg_alloc(GLOBAL_PAGES_ans_node); @@ -1204,7 +1200,7 @@ void shm_subgoal_hashes(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s subgoal hashes: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s subgoal hashes: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_sg_hash) == cont ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_sg_hash), Pg_str_in_use(GLOBAL_PAGES_sg_hash)); *pages_in_use += Pg_pg_alloc(GLOBAL_PAGES_sg_hash); @@ -1228,7 +1224,7 @@ void shm_answer_hashes(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s answer hashes: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s answer hashes: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_ans_hash) == cont && Pg_str_in_use(GLOBAL_PAGES_ans_hash) == 0 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_ans_hash), Pg_str_in_use(GLOBAL_PAGES_ans_hash)); @@ -1253,7 +1249,7 @@ void shm_dependency_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s dependency frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s dependency frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_dep_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_dep_fr) == 1 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_dep_fr), Pg_str_in_use(GLOBAL_PAGES_dep_fr)); @@ -1280,7 +1276,7 @@ void shm_suspension_frames(long *pages_in_use, long *bytes_in_use) { } pg_hd = PgHd_next(pg_hd); } - fprintf(Yap_stderr, "%s suspension frames: %8ld pages %10ld structs in use\n", + fprintf(Yap_stdout, "%s suspension frames: %8ld pages %10ld structs in use\n", Pg_str_free(GLOBAL_PAGES_susp_fr) == cont && Pg_str_in_use(GLOBAL_PAGES_susp_fr) == 0 ? " ": "*", Pg_pg_alloc(GLOBAL_PAGES_susp_fr), Pg_str_in_use(GLOBAL_PAGES_susp_fr)); diff --git a/OPTYap/opt.proto.h b/OPTYap/opt.proto.h index be219a7dd..f3bd7ae12 100644 --- a/OPTYap/opt.proto.h +++ b/OPTYap/opt.proto.h @@ -70,7 +70,7 @@ void private_completion(sg_fr_ptr sg_fr); void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes); void free_answer_trie_branch(ans_node_ptr node); void update_answer_trie(sg_fr_ptr sg_fr); -int traverse_table(tab_ent_ptr tab_ent, Atom pred_atom, int show_table); +void traverse_table(tab_ent_ptr tab_ent, int show_table); void table_stats(void); #endif /* TABLING */ diff --git a/OPTYap/or.insts.i b/OPTYap/or.insts.i index 85693a158..2c5c40b6a 100644 --- a/OPTYap/or.insts.i +++ b/OPTYap/or.insts.i @@ -110,7 +110,7 @@ PBOp(sync,Otapl) CUT_wait_leftmost(); - PREG = NEXTOP(PREG, Otapl); + PREG = NEXTOP(PREG,Otapl); PREFETCH_OP(PREG); GONext(); ENDPBOp(); diff --git a/OPTYap/tab.macros.h b/OPTYap/tab.macros.h index 0effbdc83..0021fe140 100644 --- a/OPTYap/tab.macros.h +++ b/OPTYap/tab.macros.h @@ -30,6 +30,8 @@ STD_PROTO(static inline void restore_bindings, (tr_fr_ptr, tr_fr_ptr)); STD_PROTO(static inline void abolish_incomplete_subgoals, (choiceptr)); STD_PROTO(static inline void free_subgoal_hash_chain, (sg_hash_ptr)); STD_PROTO(static inline void free_answer_hash_chain, (ans_hash_ptr)); +STD_PROTO(static inline choiceptr freeze_current_cp, (void)); +STD_PROTO(static inline void resume_frozen_cp, (choiceptr)); #ifdef YAPOR STD_PROTO(static inline void pruning_over_tabling_data_structures, (void)); @@ -79,26 +81,31 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p if (STACK_LIMIT >= STACK) { \ Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)") #else -#define STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) \ - if (STACK_LIMIT >= STACK) { \ - void *old_top; \ - UInt diff; \ - CELL *NEW_STACK; \ - INFORMATION_MESSAGE("Expanding trail in 64 Kbytes"); \ - old_top = Yap_TrailTop; \ - if (!Yap_growtrail(64 * 1024L, TRUE)) {Yap_Error(OUT_OF_TRAIL_ERROR,TermNil,"trie loading"); P=FAILCODE; } else { \ - diff = (void *)Yap_TrailTop - old_top; \ - NEW_STACK = (CELL *)((void *)STACK + diff); \ - memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \ - STACK = NEW_STACK; \ - STACK_BASE = (CELL *)((void *)STACK_BASE + diff); \ - }\ +#define STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) \ + if (STACK_LIMIT >= STACK) { \ + void *old_top; \ + UInt diff; \ + CELL *NEW_STACK; \ + INFORMATION_MESSAGE("Expanding trail in 64 Kbytes"); \ + old_top = Yap_TrailTop; \ + if (!Yap_growtrail(64 * 1024L, TRUE)) { \ + Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)"); \ + P = FAILCODE; \ + } else { \ + diff = (void *)Yap_TrailTop - old_top; \ + NEW_STACK = (CELL *)((void *)STACK + diff); \ + memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \ + STACK = NEW_STACK; \ + STACK_BASE = (CELL *)((void *)STACK_BASE + diff); \ + } \ } #endif /* YAPOR */ -#define MakeTableVarTerm(INDEX) (INDEX << LowTagBits) -#define VarIndexOfTableTerm(TERM) (TERM >> LowTagBits) +/* LowTagBits is 3 for 32 bit-machines and 7 for 64 bit-machines */ +#define NumberOfLowTagBits (LowTagBits == 3 ? 2 : 3) +#define MakeTableVarTerm(INDEX) (INDEX << NumberOfLowTagBits) +#define VarIndexOfTableTerm(TERM) (TERM >> NumberOfLowTagBits) #define VarIndexOfTerm(TERM) \ ((((CELL) TERM) - GLOBAL_table_var_enumerator(0)) / sizeof(CELL)) #define IsTableVarTerm(TERM) \ @@ -261,15 +268,16 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p DepFr_next(DEP_FR) = NEXT -#define new_table_entry(TAB_ENT, PRED_ENTRY, ARITY, SUBGOAL_TRIE) \ - ALLOC_TABLE_ENTRY(TAB_ENT); \ - TabEnt_init_lock_field(TAB_ENT); \ - TabEnt_pe(TAB_ENT) = PRED_ENTRY; \ - TabEnt_arity(TAB_ENT) = ARITY; \ - TabEnt_mode(TAB_ENT) = 0; \ - TabEnt_subgoal_trie(TAB_ENT) = SUBGOAL_TRIE; \ - TabEnt_hash_chain(TAB_ENT) = NULL; \ - TabEnt_next(TAB_ENT) = GLOBAL_root_tab_ent; \ +#define new_table_entry(TAB_ENT, PRED_ENTRY, ATOM, ARITY, SUBGOAL_TRIE) \ + ALLOC_TABLE_ENTRY(TAB_ENT); \ + TabEnt_init_lock_field(TAB_ENT); \ + TabEnt_pe(TAB_ENT) = PRED_ENTRY; \ + TabEnt_atom(TAB_ENT) = ATOM; \ + TabEnt_arity(TAB_ENT) = ARITY; \ + TabEnt_mode(TAB_ENT) = 0; \ + TabEnt_subgoal_trie(TAB_ENT) = SUBGOAL_TRIE; \ + TabEnt_hash_chain(TAB_ENT) = NULL; \ + TabEnt_next(TAB_ENT) = GLOBAL_root_tab_ent; \ GLOBAL_root_tab_ent = TAB_ENT @@ -299,7 +307,7 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p #define ANSWER_HASH_MARK 0 #define IS_SUBGOAL_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_HASH_MARK) #define IS_ANSWER_HASH(NODE) (TrNode_instr(NODE) == ANSWER_HASH_MARK) -#define HASH_TERM(TERM, SEED) (((TERM) >> LowTagBits) & (SEED)) +#define HASH_TERM(TERM, SEED) (((TERM) >> NumberOfLowTagBits) & (SEED)) #define new_subgoal_hash(HASH, NUM_NODES, TAB_ENT) \ @@ -503,7 +511,6 @@ void restore_bindings(tr_fr_ptr unbind_tr, tr_fr_ptr rebind_tr) { } } } - /* rebind loop */ Yap_NEW_MAHASH((ma_h_inner_struct *)H); while (rebind_tr != end_tr) { @@ -658,7 +665,9 @@ void free_answer_hash_chain(ans_hash_ptr hash) { return; } + /* +static inline choiceptr create_cp_and_freeze(void) { choiceptr freeze_cp; @@ -684,8 +693,9 @@ choiceptr create_cp_and_freeze(void) { } */ -static inline choiceptr -freeze_current_cp(void) { + +static inline +choiceptr freeze_current_cp(void) { choiceptr freeze_cp = B; B_FZ = freeze_cp; @@ -697,8 +707,8 @@ freeze_current_cp(void) { } -static inline void -resume_frozen_cp(choiceptr frozen_cp) { +static inline +void resume_frozen_cp(choiceptr frozen_cp) { restore_bindings(TR, frozen_cp->cp_tr); B = frozen_cp; TR = TR_FZ; @@ -706,6 +716,7 @@ resume_frozen_cp(choiceptr frozen_cp) { return; } + #ifdef YAPOR static inline void pruning_over_tabling_data_structures(void) { diff --git a/OPTYap/tab.structs.h b/OPTYap/tab.structs.h index ab20bef62..3a7e06098 100644 --- a/OPTYap/tab.structs.h +++ b/OPTYap/tab.structs.h @@ -54,6 +54,7 @@ typedef struct table_entry { lockvar lock; #endif /* YAPOR */ struct pred_entry *pred_entry; + Atom pred_atom; int pred_arity; int mode_flags; struct subgoal_trie_node *subgoal_trie; @@ -63,6 +64,7 @@ typedef struct table_entry { #define TabEnt_lock(X) ((X)->lock) #define TabEnt_pe(X) ((X)->pred_entry) +#define TabEnt_atom(X) ((X)->pred_atom) #define TabEnt_arity(X) ((X)->pred_arity) #define TabEnt_mode(X) ((X)->mode_flags) #define TabEnt_subgoal_trie(X) ((X)->subgoal_trie) diff --git a/OPTYap/tab.tries.c b/OPTYap/tab.tries.c index 4b2c30b04..5a7148733 100644 --- a/OPTYap/tab.tries.c +++ b/OPTYap/tab.tries.c @@ -51,8 +51,8 @@ static int update_answer_trie_branch(ans_node_ptr node); #else static void update_answer_trie_branch(ans_node_ptr node); #endif /* YAPOR */ -static int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth, int mode); -static int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth, int mode); +static void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth, int mode); +static void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth, int mode); @@ -694,8 +694,8 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { LOCK(TabEnt_lock(tab_ent)); #endif /* TABLE_LOCK_LEVEL */ for (i = 1; i <= arity; i++) { - STACK_PUSH_UP(XREGS[i], stack_terms); STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base); + STACK_PUSH_UP(XREGS[i], stack_terms); do { Term t = Deref(STACK_POP_DOWN(stack_terms)); if (IsVarTerm(t)) { @@ -715,10 +715,9 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t); } else if (IsPairTerm(t)) { current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsPair(NULL)); + STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1, stack_terms_base); STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base); STACK_PUSH_UP(*(RepPair(t)), stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base); } else if (IsApplTerm(t)) { Functor f = FunctorOfTerm(t); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsAppl((Term *)f)); @@ -733,10 +732,9 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) { Int li = LongIntOfTerm(t); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, li); } else { - for (j = ArityOfFunctor(f); j >= 1; j--) { + STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + ArityOfFunctor(f) - 1, stack_terms_base); + for (j = ArityOfFunctor(f); j >= 1; j--) STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base); - } } } else { Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (subgoal_search)"); @@ -792,8 +790,8 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { current_ans_node = SgFr_answer_trie(sg_fr); for (i = subs_arity; i >= 1; i--) { - STACK_PUSH_UP(*(subs_ptr + i), stack_terms); STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); + STACK_PUSH_UP(*(subs_ptr + i), stack_terms); #ifdef TABLING_ERRORS if (IsNonVarTerm(*stack_terms)) TABLING_ERROR_MESSAGE("IsNonVarTem(*stack_terms) (answer_search)"); @@ -808,7 +806,6 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { if (count_vars == MAX_TABLE_VARS) Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search)"); STACK_PUSH_DOWN(t, stack_vars); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); *((CELL *)t) = GLOBAL_table_var_enumerator(count_vars); t = MakeTableVarTerm(count_vars); count_vars++; @@ -818,10 +815,9 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_atom); } else if (IsPairTerm(t)) { current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsPair(NULL), _trie_retry_list); + STACK_CHECK_EXPAND(stack_terms, stack_vars + 1, stack_terms_base); STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); STACK_PUSH_UP(*(RepPair(t)), stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); } else if (IsApplTerm(t)) { Functor f = FunctorOfTerm(t); if (f == FunctorDouble) { @@ -840,10 +836,9 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_long); } else { current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_struct); - for (j = ArityOfFunctor(f); j >= 1; j--) { + STACK_CHECK_EXPAND(stack_terms, stack_vars + ArityOfFunctor(f) - 1, stack_terms_base); + for (j = ArityOfFunctor(f); j >= 1; j--) STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); - } } } else { Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search)"); @@ -881,20 +876,19 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) { do { if (IsVarTerm(t)) { int var_index = VarIndexOfTableTerm(t); + STACK_CHECK_EXPAND(stack_terms, stack_vars_base + var_index + 1, stack_terms_base); if(var_index > n_vars) { for (i = var_index; i > n_vars; i--) stack_vars_base[i] = 0; n_vars = var_index; - stack_vars = stack_vars_base + (n_vars+1); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); + stack_vars = stack_vars_base + var_index; } if (stack_vars_base[var_index] == 0) stack_vars_base[var_index] = MkVarTerm(); STACK_PUSH_UP(stack_vars_base[var_index], stack_terms); - STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); } else if (IsAtomOrIntTerm(t)) { - STACK_PUSH_UP(t, stack_terms); STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); + STACK_PUSH_UP(t, stack_terms); } else if (IsPairTerm(t)) { Term head = STACK_POP_DOWN(stack_terms); Term tail = STACK_POP_DOWN(stack_terms); @@ -915,17 +909,20 @@ void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) { #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ ans_node = TrNode_parent(ans_node); t = MkFloatTerm(dbl); + STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); STACK_PUSH_UP(t, stack_terms); } else if (f == FunctorLongInt) { Int li = TrNode_entry(ans_node); ans_node = TrNode_parent(ans_node); ans_node = TrNode_parent(ans_node); t = MkLongIntTerm(li); + STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); STACK_PUSH_UP(t, stack_terms); } else { int f_arity = ArityOfFunctor(f); t = Yap_MkApplTerm(f, f_arity, stack_terms); stack_terms += f_arity; + STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base); STACK_PUSH_UP(t, stack_terms); } } else { @@ -1091,12 +1088,12 @@ static struct trie_statistics{ #define TrStat_ans_max_depth trie_stats.answer_trie_max_depth #define TrStat_ans_min_depth trie_stats.answer_trie_min_depth -#define STR_ARRAY_SIZE 1000 -#define ARITY_ARRAY_SIZE 100 -#define SHOW_TABLE(MESG, ARGS...) if (TrStat_show) fprintf(Yap_stderr, MESG, ##ARGS) +#define STR_ARRAY_SIZE 10000 +#define ARITY_ARRAY_SIZE 1000 +#define SHOW_TABLE(MESG, ARGS...) if (TrStat_show) fprintf(Yap_stdout, MESG, ##ARGS) -int traverse_table(tab_ent_ptr tab_ent, Atom pred_atom, int show_table) { +void traverse_table(tab_ent_ptr tab_ent, int show_table) { sg_node_ptr sg_node = TrNode_child(TabEnt_subgoal_trie(tab_ent)); TrStat_show = show_table; @@ -1116,17 +1113,19 @@ int traverse_table(tab_ent_ptr tab_ent, Atom pred_atom, int show_table) { TrStat_ans_min_depth = -1; if (sg_node) { if (TabEnt_arity(tab_ent)) { - char str[STR_ARRAY_SIZE]; - int str_index = sprintf(str, " ?- %s(", AtomName(pred_atom)); - int arity[ARITY_ARRAY_SIZE]; + char *str = (char *) malloc(sizeof(char) * STR_ARRAY_SIZE); + int str_index = sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent))); + int *arity = (int *) malloc(sizeof(int) * ARITY_ARRAY_SIZE); arity[0] = 1; arity[1] = TabEnt_arity(tab_ent); - return traverse_subgoal_trie(sg_node, str, str_index, arity, 1, TRAVERSE_NORMAL); + traverse_subgoal_trie(sg_node, str, str_index, arity, 1, TRAVERSE_NORMAL); + free(str); + free(arity); } else { sg_fr_ptr sg_fr = (sg_fr_ptr) sg_node; TrStat_subgoals++; TrStat_sg_linear_nodes = TrStat_sg_min_depth = TrStat_sg_max_depth = 0; - SHOW_TABLE(" ?- %s.\n", AtomName(pred_atom)); + SHOW_TABLE(" ?- %s.\n", AtomName(TabEnt_atom(tab_ent))); TrStat_ans_nodes++; TrStat_ans_max_depth = TrStat_ans_min_depth = 0; if (SgFr_first_answer(sg_fr) == NULL) { @@ -1137,45 +1136,44 @@ int traverse_table(tab_ent_ptr tab_ent, Atom pred_atom, int show_table) { TrStat_answers_no++; SHOW_TABLE(" NO\n"); } - } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) { + } else { /* SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr) */ TrStat_answers_yes++; TrStat_answers++; SHOW_TABLE(" TRUE\n"); } } - return TRUE; - } - SHOW_TABLE(" empty\n"); - return TRUE; + } else + SHOW_TABLE(" empty\n"); + return; } void table_stats(void) { - fprintf(Yap_stderr, "\n Subgoal trie structure"); - fprintf(Yap_stderr, "\n subgoals: %ld", TrStat_subgoals); - fprintf(Yap_stderr, "\n subgoals incomplete: %ld", TrStat_sg_incomplete); - fprintf(Yap_stderr, "\n nodes: %ld (%ld%c saving)", + fprintf(Yap_stdout, "\n Subgoal trie structure"); + fprintf(Yap_stdout, "\n subgoals: %ld", TrStat_subgoals); + fprintf(Yap_stdout, "\n subgoals incomplete: %ld", TrStat_sg_incomplete); + fprintf(Yap_stdout, "\n nodes: %ld (%ld%c saving)", TrStat_sg_nodes, TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes, '%'); - fprintf(Yap_stderr, "\n average depth: %.2f (%d min - %d max)", + fprintf(Yap_stdout, "\n average depth: %.2f (%d min - %d max)", TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals, TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth, TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth); - fprintf(Yap_stderr, "\n Answer trie structure"); - fprintf(Yap_stderr, "\n answers: %ld", TrStat_answers); - fprintf(Yap_stderr, "\n yes answers: %ld", TrStat_answers_yes); - fprintf(Yap_stderr, "\n no answers: %ld", TrStat_answers_no); - fprintf(Yap_stderr, "\n pruned answers: %ld", TrStat_ans_pruned); - fprintf(Yap_stderr, "\n nodes: %ld (%ld%c saving)", + fprintf(Yap_stdout, "\n Answer trie structure"); + fprintf(Yap_stdout, "\n answers: %ld", TrStat_answers); + fprintf(Yap_stdout, "\n yes answers: %ld", TrStat_answers_yes); + fprintf(Yap_stdout, "\n no answers: %ld", TrStat_answers_no); + fprintf(Yap_stdout, "\n pruned answers: %ld", TrStat_ans_pruned); + fprintf(Yap_stdout, "\n nodes: %ld (%ld%c saving)", TrStat_ans_nodes, TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes, '%'); - fprintf(Yap_stderr, "\n average depth: %.2f (%d min - %d max)", + fprintf(Yap_stdout, "\n average depth: %.2f (%d min - %d max)", TrStat_answers == 0 ? 0 : (float)TrStat_ans_linear_nodes / (float)TrStat_answers, TrStat_ans_min_depth < 0 ? 0 : TrStat_ans_min_depth, TrStat_ans_max_depth < 0 ? 0 : TrStat_ans_max_depth); - fprintf(Yap_stderr, "\n Total memory in use\n %ld bytes\n", + fprintf(Yap_stdout, "\n Total memory in use\n %ld bytes\n", sizeof(struct table_entry) + TrStat_sg_nodes * sizeof(struct subgoal_trie_node) + TrStat_ans_nodes * sizeof(struct answer_trie_node) + @@ -1271,35 +1269,42 @@ void update_answer_trie_branch(ans_node_ptr node) { static -int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth, int mode) { - int old_str_index, old_arity[ARITY_ARRAY_SIZE], old_mode; +void traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth, int mode) { Term t; - /* save the current state */ - old_mode = mode; - old_str_index = str_index; - memcpy(old_arity, arity, sizeof(int) * (arity[0] + 1)); - t = TrNode_entry(sg_node); - /* test if hashing */ if (IS_SUBGOAL_HASH(sg_node)) { sg_node_ptr *bucket, *last_bucket; sg_hash_ptr hash; + int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); hash = (sg_hash_ptr) sg_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); do { if (*bucket) { sg_node = *bucket; - if (! traverse_subgoal_trie(sg_node, str, str_index, arity, depth, mode)) - return FALSE; - memcpy(arity, old_arity, sizeof(int) * (old_arity[0] + 1)); + traverse_subgoal_trie(sg_node, str, str_index, arity, depth, mode); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); } } while (++bucket != last_bucket); - return TRUE; + free(current_arity); + return; + } + + /* test if sibling node */ + if (TrNode_next(sg_node)) { + int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); + traverse_subgoal_trie(TrNode_next(sg_node), str, str_index, arity, depth, mode); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); + free(current_arity); + if (arity[arity[0]] == -1) + str[str_index - 1] = '|'; } /* test the node type */ + t = TrNode_entry(sg_node); #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P if (mode == TRAVERSE_FLOAT) { arity[0]++; @@ -1331,12 +1336,12 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } mode = TRAVERSE_NORMAL; @@ -1360,12 +1365,12 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } mode = TRAVERSE_NORMAL; @@ -1415,26 +1420,20 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } } else if (IsAtomTerm(t)) { - if (arity[arity[0]] == -1) { - if (strcmp("[]", AtomName(AtomOfTerm(t)))) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; - } + if (arity[arity[0]] == -1 && !strcmp("[]", AtomName(AtomOfTerm(t)))) { str[str_index - 1] = ']'; arity[0]--; - } else { + } else str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); - } while (arity[0]) { if (arity[arity[0]] > 0) { arity[arity[0]]--; @@ -1448,12 +1447,12 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } } else if (IsPairTerm(t)) { @@ -1515,11 +1514,8 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar TrStat_answers++; SHOW_TABLE(" TRUE\n"); } else { - char answer_str[STR_ARRAY_SIZE]; - int answer_arity[ARITY_ARRAY_SIZE]; - answer_arity[0] = 0; - if (! traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), answer_str, 0, answer_arity, 0, 1, TRAVERSE_NORMAL)) - return FALSE; + arity[0] = 0; + traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, 1, TRAVERSE_NORMAL); if (SgFr_state(sg_fr) < complete) { TrStat_sg_incomplete++; SHOW_TABLE(" ---> INCOMPLETE\n"); @@ -1528,46 +1524,46 @@ int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *ar } /* ... or continue with child node */ - else if (! traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, depth + 1, mode)) - return FALSE; + else + traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, depth + 1, mode); - /* continue with sibling node */ - if (TrNode_next(sg_node)) - if (! traverse_subgoal_trie(TrNode_next(sg_node), str, old_str_index, old_arity, depth, old_mode)) - return FALSE; - - return TRUE; + return; } static -int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth, int mode) { - int old_str_index, old_arity[ARITY_ARRAY_SIZE], old_var_index, old_mode; +void traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth, int mode) { Term t; - /* save the current state */ - old_mode = mode; - old_var_index = var_index; - old_str_index = str_index; - memcpy(old_arity, arity, sizeof(int) * (arity[0] + 1)); - t = TrNode_entry(ans_node); - /* test if hashing */ if (IS_ANSWER_HASH(ans_node)) { ans_node_ptr *bucket, *last_bucket; ans_hash_ptr hash; + int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); hash = (ans_hash_ptr) ans_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); do { if (*bucket) { ans_node = *bucket; - if (! traverse_answer_trie(ans_node, str, str_index, arity, var_index, depth, mode)) - return FALSE; - memcpy(arity, old_arity, sizeof(int) * (old_arity[0] + 1)); + traverse_answer_trie(ans_node, str, str_index, arity, var_index, depth, mode); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); } } while (++bucket != last_bucket); - return TRUE; + free(current_arity); + return; + } + + /* test if sibling node */ + if (TrNode_next(ans_node)) { + int *current_arity = (int *) malloc(sizeof(int) * (arity[0] + 1)); + memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1)); + traverse_answer_trie(TrNode_next(ans_node), str, str_index, arity, var_index, depth, mode); + memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1)); + free(current_arity); + if (arity[arity[0]] == -1) + str[str_index - 1] = '|'; } /* print VAR when starting a term */ @@ -1577,6 +1573,7 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } /* test the node type */ + t = TrNode_entry(ans_node); if (mode == TRAVERSE_FLOAT) { #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P arity[0]++; @@ -1607,12 +1604,12 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } mode = TRAVERSE_FLOAT_END; @@ -1638,12 +1635,12 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } mode = TRAVERSE_LONG_END; @@ -1695,26 +1692,20 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } } else if (IsAtomTerm(t)) { - if (arity[arity[0]] == -1) { - if (strcmp("[]", AtomName(AtomOfTerm(t)))) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; - } + if (arity[arity[0]] == -1 && !strcmp("[]", AtomName(AtomOfTerm(t)))) { str[str_index - 1] = ']'; arity[0]--; - } else { + } else str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); - } while (arity[0]) { if (arity[arity[0]] > 0) { arity[arity[0]]--; @@ -1728,12 +1719,12 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a } else { arity[arity[0]]++; if (arity[arity[0]] == 0) { - str[str_index] = 0; - fprintf(Yap_stderr, "%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); - return FALSE; + str_index += sprintf(& str[str_index], "]"); + arity[0]--; + } else { + str_index += sprintf(& str[str_index], "|"); + break; } - str_index += sprintf(& str[str_index], "|"); - break; } } } else if (IsPairTerm(t)) { @@ -1782,14 +1773,9 @@ int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *a #endif /* TABLING_INNER_CUTS */ /* ... or continue with child node */ - else if (! traverse_answer_trie(TrNode_child(ans_node), str, str_index, arity, var_index, depth + 1, mode)) - return FALSE; + else + traverse_answer_trie(TrNode_child(ans_node), str, str_index, arity, var_index, depth + 1, mode); - /* continue with sibling node */ - if (TrNode_next(ans_node)) - if (! traverse_answer_trie(TrNode_next(ans_node), str, old_str_index, old_arity, old_var_index, depth, old_mode)) - return FALSE; - - return TRUE; + return; } #endif /* TABLING */ diff --git a/OPTYap/tab.tries.insts.i b/OPTYap/tab.tries.insts.i index 0f318fe9b..8c47f6666 100644 --- a/OPTYap/tab.tries.insts.i +++ b/OPTYap/tab.tries.insts.i @@ -45,20 +45,27 @@ ** Trie instructions: auxiliary macros ** ** --------------------------------------------- */ -#define next_trie_instruction(NODE) \ - PREG = (yamop *) TrNode_child(NODE); \ - PREFETCH_OP(PREG); \ +#define copy_arity_stack() \ + { int size = heap_arity + subs_arity + vars_arity + 3; \ + YENV -= size; \ + memcpy(YENV, aux_ptr, size * sizeof(CELL *)); \ + aux_ptr = YENV; \ + } + +#define next_trie_instruction(NODE) \ + PREG = (yamop *) TrNode_child(NODE); \ + PREFETCH_OP(PREG); \ GONext() -#define next_instruction(CONDITION, NODE) \ - if (CONDITION) { \ - PREG = (yamop *) TrNode_child(NODE); \ - } else { \ - /* procceed */ \ - PREG = (yamop *) CPREG; \ - YENV = ENV; \ - } \ - PREFETCH_OP(PREG); \ +#define next_instruction(CONDITION, NODE) \ + if (CONDITION) { \ + PREG = (yamop *) TrNode_child(NODE); \ + } else { \ + /* procceed */ \ + PREG = (yamop *) CPREG; \ + YENV = ENV; \ + } \ + PREFETCH_OP(PREG); \ GONext() @@ -84,7 +91,8 @@ YAPOR_SET_LOAD(B); \ SET_BB(B); \ TABLING_ERRORS_check_stack; \ - } + } \ + copy_arity_stack() #define restore_trie_node(AP) \ H = HBREG = PROTECT_FROZEN_H(B); \ @@ -94,18 +102,22 @@ YAPOR_update_alternative(PREG, (yamop *) AP) \ B->cp_ap = (yamop *) AP; \ YENV = (CELL *) PROTECT_FROZEN_B(B); \ - SET_BB(NORM_CP(YENV)) + SET_BB(NORM_CP(YENV)); \ + copy_arity_stack() #define pop_trie_node() \ - YENV = (CELL *) PROTECT_FROZEN_B((B+1)); \ + YENV = (CELL *) PROTECT_FROZEN_B((B + 1)); \ H = PROTECT_FROZEN_H(B); \ pop_yaam_reg_cpdepth(B); \ CPREG = B->cp_cp; \ - TABLING_close_alt(B); \ + TABLING_close_alt(B); \ ENV = B->cp_env; \ - B = B->cp_b; \ + B = B->cp_b; \ HBREG = PROTECT_FROZEN_H(B); \ - SET_BB(PROTECT_FROZEN_B(B)) + SET_BB(PROTECT_FROZEN_B(B)); \ + if ((choiceptr) YENV == B_FZ) { \ + copy_arity_stack(); \ + } @@ -113,12 +125,12 @@ ** trie_null ** ** ------------------- */ -#define no_cp_trie_null_instr() \ +#define stack_trie_null_instr() \ *aux_ptr = 0; \ *--aux_ptr = heap_arity + 1; \ YENV = aux_ptr; \ next_trie_instruction(node) - +/* #define cp_trie_null_instr() \ aux_ptr += heap_arity + subs_arity + vars_arity + 2; \ for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \ @@ -126,6 +138,7 @@ *--YENV = 0; \ *--YENV = heap_arity + 1; \ next_trie_instruction(node) +*/ @@ -133,7 +146,7 @@ ** trie_var ** ** ------------------ */ -#define no_cp_trie_var_instr() \ +#define stack_trie_var_instr() \ if (heap_arity) { \ *aux_ptr = heap_arity - 1; \ var_ptr = *++aux_ptr; \ @@ -155,7 +168,7 @@ *++aux_ptr = subs_arity - 1; \ next_instruction(subs_arity - 1, node); \ } - +/* #define cp_trie_var_instr() \ if (heap_arity) { \ var_ptr = *++aux_ptr; \ @@ -182,6 +195,7 @@ *--YENV = 0; \ next_instruction(subs_arity - 1, node); \ } +*/ @@ -189,7 +203,7 @@ ** trie_val ** ** ------------------ */ -#define no_cp_trie_val_instr() \ +#define stack_trie_val_instr() \ if (heap_arity) { \ YENV = ++aux_ptr; \ subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \ @@ -197,7 +211,6 @@ subs = *subs_ptr; \ if (aux > subs) { \ Bind_Global((CELL *) aux, subs); \ - /* *((CELL *) aux) = subs; --> avoids trail test (always fails?) */ \ } else { \ RESET_VARIABLE(aux); \ Bind_Local((CELL *) subs, aux); \ @@ -238,7 +251,7 @@ } \ next_instruction(subs_arity - 1, node); \ } - +/* #define cp_trie_val_instr() \ if (heap_arity) { \ aux_ptr++; \ @@ -247,7 +260,6 @@ subs = *subs_ptr; \ if (aux > subs) { \ Bind_Global((CELL *) aux, subs); \ - /* *((CELL *) aux) = subs; --> avoids trail test (always fails?) */ \ } else { \ RESET_VARIABLE(aux); \ Bind_Local((CELL *) subs, aux); \ @@ -293,6 +305,7 @@ *--YENV = 0; \ next_instruction(subs_arity - 1, node); \ } +*/ @@ -300,7 +313,7 @@ ** trie_atom ** ** ------------------- */ -#define no_cp_trie_atom_instr() \ +#define stack_trie_atom_instr() \ if (heap_arity) { \ YENV = ++aux_ptr; \ Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \ @@ -317,7 +330,7 @@ } \ next_instruction(subs_arity - 1, node); \ } - +/* #define cp_trie_atom_instr() \ if (heap_arity) { \ aux_ptr++; \ @@ -340,6 +353,7 @@ *--YENV = 0; \ next_instruction(subs_arity - 1, node); \ } +*/ @@ -347,7 +361,7 @@ ** trie_list ** ** ------------------- */ -#define no_cp_trie_list_instr() \ +#define stack_trie_list_instr() \ if (heap_arity) { \ aux_ptr++; \ Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \ @@ -372,7 +386,7 @@ } \ } \ next_trie_instruction(node) - +/* #define cp_trie_list_instr() \ if (heap_arity) { \ aux_ptr++; \ @@ -400,6 +414,7 @@ *--YENV = 2; \ } \ next_trie_instruction(node) +*/ @@ -407,7 +422,7 @@ ** trie_struct ** ** --------------------- */ -#define no_cp_trie_struct_instr() \ +#define stack_trie_struct_instr() \ if (heap_arity) { \ aux_ptr++; \ Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \ @@ -434,7 +449,7 @@ } \ } \ next_trie_instruction(node) - +/* #define cp_trie_struct_instr() \ if (heap_arity) { \ aux_ptr++; \ @@ -464,6 +479,7 @@ *--YENV = func_arity; \ } \ next_trie_instruction(node) +*/ @@ -471,12 +487,12 @@ ** trie_extension ** ** ------------------------ */ -#define no_cp_trie_extension_instr() \ +#define stack_trie_extension_instr() \ *aux_ptr = TrNode_entry(node); \ *--aux_ptr = heap_arity + 1; \ YENV = aux_ptr; \ next_trie_instruction(node) - +/* #define cp_trie_extension_instr() \ aux_ptr += heap_arity + subs_arity + vars_arity + 2; \ for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \ @@ -484,6 +500,7 @@ *--YENV = TrNode_entry(node); \ *--YENV = heap_arity + 1; \ next_trie_instruction(node) +*/ @@ -491,7 +508,7 @@ ** trie_float_longint ** ** ---------------------------- */ -#define no_cp_trie_float_longint_instr() \ +#define stack_trie_float_longint_instr() \ if (heap_arity) { \ aux_ptr++; \ YENV = ++aux_ptr; \ @@ -523,32 +540,26 @@ register CELL *aux_ptr = YENV; int heap_arity = *aux_ptr; - no_cp_trie_null_instr(); + stack_trie_null_instr(); ENDPBOp(); PBOp(trie_trust_null, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); - int i; #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_null_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_null_instr(); - } else { - no_cp_trie_null_instr(); - } } + stack_trie_null_instr(); ENDPBOp(); @@ -558,23 +569,21 @@ int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); - int i; store_trie_node(TrNode_next(node)); - cp_trie_null_instr(); + stack_trie_null_instr(); ENDPBOp(); PBOp(trie_retry_null, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); - int i; restore_trie_node(TrNode_next(node)); - cp_trie_null_instr(); + stack_trie_null_instr(); ENDPBOp(); @@ -587,13 +596,13 @@ int subs_arity = *(aux_ptr + heap_arity + 2); int i; - no_cp_trie_var_instr(); + stack_trie_var_instr(); ENDPBOp(); PBOp(trie_trust_var, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); register CELL var_ptr; int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); @@ -603,17 +612,12 @@ #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_var_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_var_instr(); - } else { - no_cp_trie_var_instr(); - } } + stack_trie_var_instr(); ENDPBOp(); @@ -627,13 +631,13 @@ int i; store_trie_node(TrNode_next(node)); - cp_trie_var_instr(); + stack_trie_var_instr(); ENDPBOp(); PBOp(trie_retry_var, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); register CELL var_ptr; int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); @@ -641,7 +645,7 @@ int i; restore_trie_node(TrNode_next(node)); - cp_trie_var_instr(); + stack_trie_var_instr(); ENDPBOp(); @@ -655,13 +659,13 @@ int var_index = VarIndexOfTableTerm(TrNode_entry(node)); int i; - no_cp_trie_val_instr(); + stack_trie_val_instr(); ENDPBOp(); PBOp(trie_trust_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1), *subs_ptr; + register CELL *aux_ptr = (CELL *) (B + 1), *subs_ptr; register CELL aux, subs; int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); @@ -672,24 +676,18 @@ #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_val_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_val_instr(); - } else { - no_cp_trie_val_instr(); - } } + stack_trie_val_instr(); ENDPBOp(); PBOp(trie_try_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = YENV; - register CELL *subs_ptr; + register CELL *aux_ptr = YENV, *subs_ptr; register CELL aux, subs; int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); @@ -698,13 +696,13 @@ int i; store_trie_node(TrNode_next(node)); - cp_trie_val_instr(); + stack_trie_val_instr(); ENDPBOp(); PBOp(trie_retry_val, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1), *subs_ptr; + register CELL *aux_ptr = (CELL *) (B + 1), *subs_ptr; register CELL aux, subs; int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); @@ -713,7 +711,7 @@ int i; restore_trie_node(TrNode_next(node)); - cp_trie_val_instr(); + stack_trie_val_instr(); ENDPBOp(); @@ -725,13 +723,13 @@ int subs_arity = *(aux_ptr + heap_arity + 2); int i; - no_cp_trie_atom_instr(); + stack_trie_atom_instr(); ENDPBOp(); PBOp(trie_trust_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); @@ -740,17 +738,12 @@ #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_atom_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_atom_instr(); - } else { - no_cp_trie_atom_instr(); - } } + stack_trie_atom_instr(); ENDPBOp(); @@ -763,20 +756,20 @@ int i; store_trie_node(TrNode_next(node)); - cp_trie_atom_instr(); + stack_trie_atom_instr(); ENDPBOp(); PBOp(trie_retry_atom, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); int i; restore_trie_node(TrNode_next(node)); - cp_trie_atom_instr(); + stack_trie_atom_instr(); ENDPBOp(); @@ -788,13 +781,13 @@ int subs_arity = *(aux_ptr + heap_arity + 2); int i; - no_cp_trie_list_instr(); + stack_trie_list_instr(); ENDPBOp(); PBOp(trie_trust_list, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); @@ -803,17 +796,12 @@ #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_list_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_list_instr(); - } else { - no_cp_trie_list_instr(); - } } + stack_trie_list_instr(); ENDPBOp(); @@ -826,20 +814,20 @@ int i; store_trie_node(TrNode_next(node)); - cp_trie_list_instr(); + stack_trie_list_instr(); ENDPBOp(); PBOp(trie_retry_list, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); int i; restore_trie_node(TrNode_next(node)); - cp_trie_list_instr(); + stack_trie_list_instr(); ENDPBOp(); @@ -853,13 +841,13 @@ int func_arity = ArityOfFunctor(func); int i; - no_cp_trie_struct_instr(); + stack_trie_struct_instr(); ENDPBOp(); PBOp(trie_trust_struct, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); @@ -870,17 +858,12 @@ #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_struct_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_struct_instr(); - } else { - no_cp_trie_struct_instr(); - } } + stack_trie_struct_instr(); ENDPBOp(); @@ -895,13 +878,13 @@ int i; store_trie_node(TrNode_next(node)); - cp_trie_struct_instr(); + stack_trie_struct_instr(); ENDPBOp(); PBOp(trie_retry_struct, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); @@ -910,7 +893,7 @@ int i; restore_trie_node(TrNode_next(node)); - cp_trie_struct_instr(); + stack_trie_struct_instr(); ENDPBOp(); @@ -919,32 +902,26 @@ register CELL *aux_ptr = YENV; int heap_arity = *aux_ptr; - no_cp_trie_extension_instr(); + stack_trie_extension_instr(); ENDPBOp(); PBOp(trie_trust_extension, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); - int i; #ifdef YAPOR if (SCH_top_shared_cp(B)) { restore_trie_node(NULL); - cp_trie_extension_instr(); } else #endif /* YAPOR */ { pop_trie_node(); - if ((choiceptr) YENV == B_FZ) { - cp_trie_extension_instr(); - } else { - no_cp_trie_extension_instr(); - } } + stack_trie_extension_instr(); ENDPBOp(); @@ -954,23 +931,21 @@ int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); - int i; store_trie_node(TrNode_next(node)); - cp_trie_extension_instr(); + stack_trie_extension_instr(); ENDPBOp(); PBOp(trie_retry_extension, e) register ans_node_ptr node = (ans_node_ptr) PREG; - register CELL *aux_ptr = (CELL *)(B+1); + register CELL *aux_ptr = (CELL *) (B + 1); int heap_arity = *aux_ptr; int vars_arity = *(aux_ptr + heap_arity + 1); int subs_arity = *(aux_ptr + heap_arity + 2); - int i; restore_trie_node(TrNode_next(node)); - cp_trie_extension_instr(); + stack_trie_extension_instr(); ENDPBOp(); @@ -984,6 +959,7 @@ Term t; volatile Float dbl; volatile Term *t_dbl = (Term *)((void *) &dbl); + #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P *t_dbl = *++aux_ptr; *(t_dbl + 1) = *++aux_ptr; @@ -993,7 +969,7 @@ heap_arity -= 2; #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */ t = MkFloatTerm(dbl); - no_cp_trie_float_longint_instr(); + stack_trie_float_longint_instr(); ENDPBOp(); @@ -1003,7 +979,7 @@ BOp(trie_try_float, e) - Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_float)"); + Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_float)"); ENDBOp(); @@ -1020,14 +996,17 @@ int subs_arity = *(aux_ptr + heap_arity + 2); int i; Term t = MkLongIntTerm(*++aux_ptr); + heap_arity -= 2; - no_cp_trie_float_longint_instr(); + stack_trie_float_longint_instr(); ENDPBOp(); + BOp(trie_trust_long, e) Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_long)"); ENDBOp(); + BOp(trie_try_long, e) Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_long)"); ENDBOp(); @@ -1036,5 +1015,3 @@ BOp(trie_retry_long, e) Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_long)"); ENDBOp(); - -