- Lots of indenting changes - VC++ is strict with variadic macros - VC++ does not accept unistd.h - new interface for walltime - VC++ does not seem to have support for integer overflow. - VC++ defines YENV_REG? - no access flags, x permissions ignored. - new FindGMP supporting MPIR - make horus optional (c++ is hard).
		
			
				
	
	
		
			1899 lines
		
	
	
		
			70 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
			
		
		
	
	
			1899 lines
		
	
	
		
			70 KiB
		
	
	
	
		
			C
		
	
	
	
	
	
| /************************************************************************
 | |
| **                                                                     **
 | |
| **                   The YapTab/YapOr/OPTYap systems                   **
 | |
| **                                                                     **
 | |
| ** YapTab extends the Yap Prolog engine to support sequential tabling  **
 | |
| ** YapOr extends the Yap Prolog engine to support or-parallelism       **
 | |
| ** OPTYap extends the Yap Prolog engine to support or-parallel tabling **
 | |
| **                                                                     **
 | |
| **                                                                     **
 | |
| **      Yap Prolog was developed at University of Porto, Portugal      **
 | |
| **                                                                     **
 | |
| ************************************************************************/
 | |
| 
 | |
| /************************************
 | |
| **      Includes & Prototypes      **
 | |
| ************************************/
 | |
| 
 | |
| #include "Yap.h"
 | |
| #ifdef TABLING
 | |
| #include "Yatom.h"
 | |
| #include "YapHeap.h"
 | |
| #include "eval.h"
 | |
| #include "tab.macros.h"
 | |
| 
 | |
| static inline sg_node_ptr
 | |
| subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
 | |
| static inline sg_node_ptr
 | |
| subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
 | |
| static inline ans_node_ptr
 | |
| answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
 | |
| static inline ans_node_ptr
 | |
| answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
 | |
| static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr,
 | |
|                                                          Term USES_REGS);
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
| static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr,
 | |
|                                                             Term USES_REGS);
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
| static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term,
 | |
|                                               int *, CELL **USES_REGS);
 | |
| static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr,
 | |
|                                                     Term, int *,
 | |
|                                                     CELL **USES_REGS);
 | |
| static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term,
 | |
|                                               int *USES_REGS);
 | |
| static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr,
 | |
|                                                     Term, int *USES_REGS);
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
| static inline gt_node_ptr
 | |
| subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL *USES_REGS);
 | |
| static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *,
 | |
|                                                                CELL *USES_REGS);
 | |
| #else
 | |
| static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *,
 | |
|                                                           CELL **USES_REGS);
 | |
| static inline gt_node_ptr answer_search_global_trie_loop(Term, int *USES_REGS);
 | |
| #endif /* GLOBAL_TRIE_MODE */
 | |
| static inline CELL *load_answer_loop(ans_node_ptr USES_REGS);
 | |
| static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL *USES_REGS);
 | |
| static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **,
 | |
|                                            CELL *USES_REGS);
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
| static inline ans_node_ptr answer_search_min_max(sg_fr_ptr, ans_node_ptr, Term,
 | |
|                                                  int USES_REGS);
 | |
| static inline ans_node_ptr answer_search_sum(sg_fr_ptr, ans_node_ptr,
 | |
|                                              Term USES_REGS);
 | |
| static void invalidate_answer_trie(ans_node_ptr, sg_fr_ptr, int USES_REGS);
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
| 
 | |
| #ifdef YAPOR
 | |
| #ifdef TABLING_INNER_CUTS
 | |
| static int update_answer_trie_branch(ans_node_ptr, ans_node_ptr);
 | |
| #else /* YAPOR && ! TABLING_INNER_CUTS */
 | |
| static int update_answer_trie_branch(ans_node_ptr);
 | |
| #endif
 | |
| #else /* ! YAPOR */
 | |
| static void update_answer_trie_branch(ans_node_ptr, int);
 | |
| #endif
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
| static void free_global_trie_branch(gt_node_ptr, int USES_REGS);
 | |
| #else
 | |
| static void free_global_trie_branch(gt_node_ptr USES_REGS);
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
| static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int,
 | |
|                                   int USES_REGS);
 | |
| static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int,
 | |
|                                  int USES_REGS);
 | |
| static void traverse_global_trie(gt_node_ptr, char *, int, int *, int,
 | |
|                                  int USES_REGS);
 | |
| static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *,
 | |
|                                           int *, int USES_REGS);
 | |
| static inline void traverse_trie_node(Term, char *, int *, int *, int *,
 | |
|                                       int USES_REGS);
 | |
| static inline void traverse_update_arity(char *, int *, int *);
 | |
| 
 | |
| /*******************************
 | |
| **      Structs & Macros      **
 | |
| *******************************/
 | |
| 
 | |
| static struct trie_statistics {
 | |
|   FILE *out;
 | |
|   int show;
 | |
|   long subgoals;
 | |
|   long subgoals_incomplete;
 | |
|   long subgoal_trie_nodes;
 | |
|   long answers;
 | |
| #ifdef TABLING_INNER_CUTS
 | |
|   long answers_pruned;
 | |
| #endif /* TABLING_INNER_CUTS */
 | |
|   long answers_true;
 | |
|   long answers_no;
 | |
|   long answer_trie_nodes;
 | |
|   long global_trie_terms;
 | |
|   long global_trie_nodes;
 | |
|   long global_trie_references;
 | |
| }
 | |
| #ifdef THREADS
 | |
| trie_stats[MAX_THREADS];
 | |
| 
 | |
| #define TrStat_out trie_stats[worker_id].out
 | |
| #define TrStat_show trie_stats[worker_id].show
 | |
| #define TrStat_subgoals trie_stats[worker_id].subgoals
 | |
| #define TrStat_sg_incomplete trie_stats[worker_id].subgoals_incomplete
 | |
| #define TrStat_sg_nodes trie_stats[worker_id].subgoal_trie_nodes
 | |
| #define TrStat_answers trie_stats[worker_id].answers
 | |
| #define TrStat_answers_true trie_stats[worker_id].answers_true
 | |
| #define TrStat_answers_no trie_stats[worker_id].answers_no
 | |
| #define TrStat_answers_pruned trie_stats[worker_id].answers_pruned
 | |
| #define TrStat_ans_nodes trie_stats[worker_id].answer_trie_nodes
 | |
| #define TrStat_gt_terms trie_stats[worker_id].global_trie_terms
 | |
| #define TrStat_gt_nodes trie_stats[worker_id].global_trie_nodes
 | |
| #define TrStat_gt_refs trie_stats[worker_id].global_trie_references
 | |
| #else /*!THREADS */
 | |
| trie_stats;
 | |
| 
 | |
| #define TrStat_out trie_stats.out
 | |
| #define TrStat_show trie_stats.show
 | |
| #define TrStat_subgoals trie_stats.subgoals
 | |
| #define TrStat_sg_incomplete trie_stats.subgoals_incomplete
 | |
| #define TrStat_sg_nodes trie_stats.subgoal_trie_nodes
 | |
| #define TrStat_answers trie_stats.answers
 | |
| #define TrStat_answers_true trie_stats.answers_true
 | |
| #define TrStat_answers_no trie_stats.answers_no
 | |
| #define TrStat_answers_pruned trie_stats.answers_pruned
 | |
| #define TrStat_ans_nodes trie_stats.answer_trie_nodes
 | |
| #define TrStat_gt_terms trie_stats.global_trie_terms
 | |
| #define TrStat_gt_nodes trie_stats.global_trie_nodes
 | |
| #define TrStat_gt_refs trie_stats.global_trie_references
 | |
| #endif /*THREADS */
 | |
| 
 | |
| #if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) ||       \
 | |
|     defined(THREADS_CONSUMER_SHARING)
 | |
| #define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES                         \
 | |
|   if (GLOBAL_NOfThreads == 1)
 | |
| #else
 | |
| #define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES
 | |
| #endif /* THREADS_SUBGOAL_SHARING || THREADS_FULL_SHARING ||                   \
 | |
|           THREADS_CONSUMER_SHARING */
 | |
| 
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
| #define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES                          \
 | |
|   if (GLOBAL_NOfThreads == 1)
 | |
| #else
 | |
| #define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
| 
 | |
| #define SHOW_TABLE_STR_ARRAY_SIZE 100000
 | |
| #define SHOW_TABLE_ARITY_ARRAY_SIZE 10000
 | |
| #define SHOW_TABLE_STRUCTURE( ...)                                    \
 | |
|   if (TrStat_show == SHOW_MODE_STRUCTURE)                                      \
 | |
|   fprintf(TrStat_out, __VA_ARGS__ )
 | |
| 
 | |
| #define CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE)                       \
 | |
|   if (MODE == TRAVERSE_MODE_NORMAL && IsVarTerm(REF) &&                        \
 | |
|       REF > VarIndexOfTableTerm(MAX_TABLE_VARS)) {                             \
 | |
|     register gt_node_ptr gt_node = (gt_node_ptr)(REF);                         \
 | |
|     TrNode_child(gt_node) =                                                    \
 | |
|         (gt_node_ptr)((uintptr_t)TrNode_child(gt_node) - 1);                   \
 | |
|     if (TrNode_child(gt_node) == 0)                                            \
 | |
|       FREE_GLOBAL_TRIE_BRANCH(gt_node, TRAVERSE_MODE_NORMAL);                  \
 | |
|   }
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
| #define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF, MODE)          \
 | |
|   CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF, MODE)
 | |
| #define FREE_GLOBAL_TRIE_BRANCH(NODE, MODE)                                    \
 | |
|   free_global_trie_branch(NODE, MODE PASS_REGS)
 | |
| #else
 | |
| #define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF, MODE)
 | |
| #define FREE_GLOBAL_TRIE_BRANCH(NODE, MODE)                                    \
 | |
|   free_global_trie_branch(NODE PASS_REGS)
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
| 
 | |
| /******************************
 | |
| ** Rational Terms Support    **
 | |
| ******************************/
 | |
| #ifdef TRIE_RATIONAL_TERMS
 | |
| #include "tab.rational.h"
 | |
| #endif /* RATIONAL TERM SUPPORT FOR TRIES */
 | |
| 
 | |
| /******************************
 | |
| **      Local functions      **
 | |
| ******************************/
 | |
| 
 | |
| #define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_entry   \
 | |
|                                              */
 | |
| #define INCLUDE_ANSWER_TRIE_CHECK_INSERT  /* answer_trie_check_insert_entry */
 | |
| #define INCLUDE_GLOBAL_TRIE_CHECK_INSERT  /* global_trie_check_insert_entry */
 | |
| #include "tab.tries.h"
 | |
| #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
 | |
| #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT
 | |
| #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
 | |
| 
 | |
| #define MODE_GLOBAL_TRIE_ENTRY
 | |
| #define INCLUDE_SUBGOAL_TRIE_CHECK_INSERT /* subgoal_trie_check_insert_gt_entry \
 | |
|                                              */
 | |
| #define INCLUDE_ANSWER_TRIE_CHECK_INSERT  /* answer_trie_check_insert_gt_entry \
 | |
|                                              */
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
| #define INCLUDE_GLOBAL_TRIE_CHECK_INSERT /* global_trie_check_insert_gt_entry  \
 | |
|                                             */
 | |
| #endif                                   /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
| #include "tab.tries.h"
 | |
| #undef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
 | |
| #undef INCLUDE_ANSWER_TRIE_CHECK_INSERT
 | |
| #undef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
 | |
| #undef MODE_GLOBAL_TRIE_ENTRY
 | |
| 
 | |
| #define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_loop */
 | |
| #define INCLUDE_ANSWER_SEARCH_LOOP  /* answer_search_loop */
 | |
| #define INCLUDE_LOAD_ANSWER_LOOP    /* load_answer_loop */
 | |
| #include "tab.tries.h"
 | |
| #undef INCLUDE_LOAD_ANSWER_LOOP
 | |
| #undef INCLUDE_ANSWER_SEARCH_LOOP
 | |
| #undef INCLUDE_SUBGOAL_SEARCH_LOOP
 | |
| 
 | |
| #define MODE_TERMS_LOOP
 | |
| #define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_terms_loop */
 | |
| #define INCLUDE_ANSWER_SEARCH_LOOP  /* answer_search_terms_loop */
 | |
| #ifdef TRIE_RATIONAL_TERMS
 | |
| #undef TRIE_RATIONAL_TERMS
 | |
| #include "tab.tries.h"
 | |
| #define TRIE_RATIONAL_TERMS
 | |
| #else
 | |
| #include "tab.tries.h"
 | |
| #endif
 | |
| #undef INCLUDE_ANSWER_SEARCH_LOOP
 | |
| #undef INCLUDE_SUBGOAL_SEARCH_LOOP
 | |
| #undef MODE_TERMS_LOOP
 | |
| 
 | |
| #define MODE_GLOBAL_TRIE_LOOP
 | |
| #define INCLUDE_SUBGOAL_SEARCH_LOOP /* subgoal_search_global_trie_(terms)_loop \
 | |
|                                        */
 | |
| #define INCLUDE_ANSWER_SEARCH_LOOP  /* answer_search_global_trie_(terms)_loop  \
 | |
|                                        */
 | |
| #define INCLUDE_LOAD_ANSWER_LOOP    /* load_substitution_loop */
 | |
| #ifdef TRIE_RATIONAL_TERMS
 | |
| #undef TRIE_RATIONAL_TERMS
 | |
| #include "tab.tries.h"
 | |
| #define TRIE_RATIONAL_TERMS
 | |
| #else
 | |
| #include "tab.tries.h"
 | |
| #endif
 | |
| #undef INCLUDE_LOAD_ANSWER_LOOP
 | |
| #undef INCLUDE_ANSWER_SEARCH_LOOP
 | |
| #undef INCLUDE_SUBGOAL_SEARCH_LOOP
 | |
| #undef MODE_GLOBAL_TRIE_LOOP
 | |
| 
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
| #define INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
 | |
| #include "tab.tries.h" /* answer_search_min_max + answer_search_sum + invalidate_answer_trie */
 | |
| #undef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
| 
 | |
| static inline CELL *exec_substitution_loop(gt_node_ptr current_node,
 | |
|                                            CELL **stack_vars_ptr,
 | |
|                                            CELL *stack_terms USES_REGS) {
 | |
|   /************************************************************************
 | |
|                        ===========
 | |
|                        |         |
 | |
|                        |   ...   |
 | |
|                        |         |
 | |
|                        -----------
 | |
|              YENV -->  |   N+1   |  <-- stack_vars
 | |
|                        -----------
 | |
|                        |  VAR_N  |
 | |
|                        -----------
 | |
|                        |   ...   |
 | |
|                        -----------
 | |
|                        |  VAR_0  |
 | |
|                        -----------
 | |
|                        |         |
 | |
|                        |   ...   |
 | |
|                        |         |
 | |
|                        ===========
 | |
|                        |         |
 | |
|                        |   ...   |
 | |
|                        |         |
 | |
|                        -----------
 | |
|                TR -->  |         |  <-- stack_terms_limit
 | |
|                        -----------
 | |
|                        |         |
 | |
|                        |   ...   |
 | |
|                        |         |
 | |
|                        ----------|
 | |
|                        |  TERM_N |  <-- stack_terms
 | |
|                        ----------|           *
 | |
|                        |   ...   |          /|\
 | |
|                        ----------|           |  stack_terms_pair_offset
 | |
|   (TRIE_COMPACT_PAIRS)
 | |
|                        |  TERM_1 |          \|/
 | |
|                        ===========           *
 | |
|    LOCAL_TrailTop -->  |         |  <-- stack_terms_base (TRIE_COMPACT_PAIRS)
 | |
|                        -----------
 | |
|   ************************************************************************/
 | |
|   CELL *stack_vars = *stack_vars_ptr;
 | |
|   CELL *stack_terms_limit = (CELL *)TR;
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
| #define stack_terms_base ((CELL *)LOCAL_TrailTop)
 | |
|   int stack_terms_pair_offset = 0;
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|   Term t = TrNode_entry(current_node);
 | |
|   current_node = TrNode_parent(current_node);
 | |
| 
 | |
|   do {
 | |
|     if (IsVarTerm(t)) {
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
|       if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
 | |
|         stack_terms = exec_substitution_loop((gt_node_ptr)t, &stack_vars,
 | |
|                                              stack_terms PASS_REGS);
 | |
|       } else
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
|       {
 | |
|         int var_index = VarIndexOfTableTerm(t);
 | |
|         int vars_arity = *stack_vars;
 | |
|         t = MkVarTerm();
 | |
|         if (var_index >= vars_arity) {
 | |
|           while (vars_arity < var_index) {
 | |
|             *stack_vars-- = 0;
 | |
|             vars_arity++;
 | |
|           }
 | |
|           *stack_vars-- = t;
 | |
|           vars_arity++;
 | |
|           *stack_vars = vars_arity;
 | |
|         } else {
 | |
|           /* do the same as in macro stack_trie_val_instr() */
 | |
|           CELL aux_sub, aux_var, *vars_ptr;
 | |
|           vars_ptr = stack_vars + vars_arity - var_index;
 | |
|           aux_sub = *((CELL *)t);
 | |
|           aux_var = *vars_ptr;
 | |
|           if (aux_var == 0) {
 | |
|             *vars_ptr = t;
 | |
|           } else {
 | |
|             if (aux_sub > aux_var) {
 | |
|               if ((CELL *)aux_sub <= HR) {
 | |
|                 Bind_Global((CELL *)aux_sub, aux_var);
 | |
|               } else if ((CELL *)aux_var <= HR) {
 | |
|                 Bind_Local((CELL *)aux_sub, aux_var);
 | |
|               } else {
 | |
|                 Bind_Local((CELL *)aux_var, aux_sub);
 | |
|                 *vars_ptr = aux_sub;
 | |
|               }
 | |
|             } else {
 | |
|               if ((CELL *)aux_var <= HR) {
 | |
|                 Bind_Global((CELL *)aux_var, aux_sub);
 | |
|                 *vars_ptr = aux_sub;
 | |
|               } else if ((CELL *)aux_sub <= HR) {
 | |
|                 Bind_Local((CELL *)aux_var, aux_sub);
 | |
|                 *vars_ptr = aux_sub;
 | |
|               } else {
 | |
|                 Bind_Local((CELL *)aux_sub, aux_var);
 | |
|               }
 | |
|             }
 | |
|           }
 | |
|         }
 | |
|         AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
 | |
|         STACK_PUSH_UP(t, stack_terms);
 | |
|       }
 | |
|     } else if (IsAtomOrIntTerm(t)) {
 | |
|       AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
 | |
|       STACK_PUSH_UP(t, stack_terms);
 | |
|     } else if (IsPairTerm(t)) {
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|       if (t == CompactPairInit) {
 | |
|         Term *stack_aux = stack_terms_base - stack_terms_pair_offset;
 | |
|         Term head, tail = STACK_POP_UP(stack_aux);
 | |
|         while (STACK_NOT_EMPTY(stack_aux, stack_terms)) {
 | |
|           head = STACK_POP_UP(stack_aux);
 | |
|           tail = MkPairTerm(head, tail);
 | |
|         }
 | |
|         stack_terms = stack_terms_base - stack_terms_pair_offset;
 | |
|         stack_terms_pair_offset = (int)STACK_POP_DOWN(stack_terms);
 | |
|         STACK_PUSH_UP(tail, stack_terms);
 | |
|       } else { /* CompactPairEndList / CompactPairEndTerm */
 | |
|         Term last;
 | |
|         AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit + 1);
 | |
|         last = STACK_POP_DOWN(stack_terms);
 | |
|         STACK_PUSH_UP(stack_terms_pair_offset, stack_terms);
 | |
|         stack_terms_pair_offset = (int)(stack_terms_base - stack_terms);
 | |
|         if (t == CompactPairEndList)
 | |
|           STACK_PUSH_UP(TermNil, stack_terms);
 | |
|         STACK_PUSH_UP(last, stack_terms);
 | |
|       }
 | |
| #else
 | |
|       Term head = STACK_POP_DOWN(stack_terms);
 | |
|       Term tail = STACK_POP_DOWN(stack_terms);
 | |
|       t = MkPairTerm(head, tail);
 | |
|       STACK_PUSH_UP(t, stack_terms);
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|     } else if (IsApplTerm(t)) {
 | |
|       Functor f = (Functor)RepAppl(t);
 | |
|       if (f == FunctorDouble) {
 | |
|         union {
 | |
|           Term t_dbl[sizeof(Float) / sizeof(Term)];
 | |
|           Float dbl;
 | |
|         } u;
 | |
|         t = TrNode_entry(current_node);
 | |
|         current_node = TrNode_parent(current_node);
 | |
|         u.t_dbl[0] = t;
 | |
| #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
 | |
|         t = TrNode_entry(current_node);
 | |
|         current_node = TrNode_parent(current_node);
 | |
|         u.t_dbl[1] = t;
 | |
| #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
 | |
|         current_node = TrNode_parent(current_node);
 | |
|         t = MkFloatTerm(u.dbl);
 | |
|       } else if (f == FunctorLongInt) {
 | |
|         Int li = TrNode_entry(current_node);
 | |
|         current_node = TrNode_parent(current_node);
 | |
|         current_node = TrNode_parent(current_node);
 | |
|         t = MkLongIntTerm(li);
 | |
|       } else {
 | |
|         int f_arity = ArityOfFunctor(f);
 | |
|         t = Yap_MkApplTerm(f, f_arity, stack_terms);
 | |
|         stack_terms += f_arity;
 | |
|       }
 | |
|       AUX_STACK_CHECK_EXPAND(stack_terms, stack_terms_limit);
 | |
|       STACK_PUSH_UP(t, stack_terms);
 | |
|     }
 | |
|     t = TrNode_entry(current_node);
 | |
|     current_node = TrNode_parent(current_node);
 | |
|   } while (current_node);
 | |
| 
 | |
|   *stack_vars_ptr = stack_vars;
 | |
|   return stack_terms;
 | |
| 
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
| #undef stack_terms_base
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
| }
 | |
| 
 | |
| #ifdef YAPOR
 | |
| #ifdef TABLING_INNER_CUTS
 | |
| static int update_answer_trie_branch(ans_node_ptr previous_node,
 | |
|                                      ans_node_ptr current_node) {
 | |
|   int ltt;
 | |
|   if (!IS_ANSWER_LEAF_NODE(current_node)) {
 | |
|     if (TrNode_child(current_node)) {
 | |
|       TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
 | |
|       update_answer_trie_branch(NULL, TrNode_child(current_node));
 | |
|       if (TrNode_child(current_node))
 | |
|         goto update_next_trie_branch;
 | |
|     }
 | |
|     /* node belonging to a pruned answer */
 | |
|     if (previous_node) {
 | |
|       TrNode_next(previous_node) = TrNode_next(current_node);
 | |
|       FREE_ANSWER_TRIE_NODE(current_node);
 | |
|       if (TrNode_next(previous_node)) {
 | |
|         return update_answer_trie_branch(previous_node,
 | |
|                                          TrNode_next(previous_node));
 | |
|       } else {
 | |
|         TrNode_instr(previous_node) -= 2; /* retry --> trust : try --> do */
 | |
|         return 0;
 | |
|       }
 | |
|     } else {
 | |
|       TrNode_child(TrNode_parent(current_node)) = TrNode_next(current_node);
 | |
|       if (TrNode_next(current_node)) {
 | |
|         TrNode_instr(TrNode_next(current_node)) -= 1; /* retry --> try */
 | |
|         update_answer_trie_branch(NULL, TrNode_next(current_node));
 | |
|       }
 | |
|       FREE_ANSWER_TRIE_NODE(current_node);
 | |
|       return 0;
 | |
|     }
 | |
|   }
 | |
| update_next_trie_branch:
 | |
|   if (TrNode_next(current_node)) {
 | |
|     ltt =
 | |
|         1 + update_answer_trie_branch(current_node, TrNode_next(current_node));
 | |
|   } else {
 | |
|     TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
 | |
|     ltt = 1;
 | |
|   }
 | |
| 
 | |
|   TrNode_or_arg(current_node) = ltt;
 | |
|   TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
 | |
|   return ltt;
 | |
| }
 | |
| #else /* YAPOR && ! TABLING_INNER_CUTS */
 | |
| static int update_answer_trie_branch(ans_node_ptr current_node) {
 | |
|   int ltt;
 | |
|   if (!IS_ANSWER_LEAF_NODE(current_node)) {
 | |
|     TrNode_instr(TrNode_child(current_node)) -= 1; /* retry --> try */
 | |
|     update_answer_trie_branch(TrNode_child(current_node));
 | |
|   }
 | |
|   if (TrNode_next(current_node)) {
 | |
|     ltt = 1 + update_answer_trie_branch(TrNode_next(current_node));
 | |
|   } else {
 | |
|     TrNode_instr(current_node) -= 2; /* retry --> trust : try --> do */
 | |
|     ltt = 1;
 | |
|   }
 | |
|   TrNode_or_arg(current_node) = ltt;
 | |
|   TrNode_instr(current_node) = Yap_opcode(TrNode_instr(current_node));
 | |
|   return ltt;
 | |
| }
 | |
| #endif
 | |
| #else /* ! YAPOR */
 | |
| static void update_answer_trie_branch(ans_node_ptr current_node, int position) {
 | |
|   if (!IS_ANSWER_LEAF_NODE(current_node))
 | |
|     update_answer_trie_branch(TrNode_child(current_node),
 | |
|                               TRAVERSE_POSITION_FIRST); /* retry --> try */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     ans_node_ptr next = TrNode_next(current_node);
 | |
|     if (next) {
 | |
|       while (TrNode_next(next)) {
 | |
|         update_answer_trie_branch(next,
 | |
|                                   TRAVERSE_POSITION_NEXT); /* retry --> retry */
 | |
|         next = TrNode_next(next);
 | |
|       }
 | |
|       update_answer_trie_branch(next,
 | |
|                                 TRAVERSE_POSITION_LAST); /* retry --> trust */
 | |
|     } else
 | |
|       position += TRAVERSE_POSITION_LAST; /* try --> do */
 | |
|   }
 | |
|   TrNode_instr(current_node) =
 | |
|       Yap_opcode(TrNode_instr(current_node) - position);
 | |
|   return;
 | |
| }
 | |
| 
 | |
| #endif /* YAPOR */
 | |
| 
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
| static void free_global_trie_branch(gt_node_ptr current_node,
 | |
|                                     int mode USES_REGS) {
 | |
|   Term t = TrNode_entry(current_node);
 | |
| #else
 | |
| static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) {
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
|   gt_node_ptr parent_node, child_node;
 | |
| 
 | |
|   parent_node = TrNode_parent(current_node);
 | |
|   child_node = TrNode_child(parent_node);
 | |
|   if (IS_GLOBAL_TRIE_HASH(child_node)) {
 | |
|     gt_hash_ptr hash = (gt_hash_ptr)child_node;
 | |
|     gt_node_ptr *bucket =
 | |
|         Hash_buckets(hash) +
 | |
|         HASH_ENTRY(TrNode_entry(current_node), Hash_num_buckets(hash));
 | |
|     int num_nodes = --Hash_num_nodes(hash);
 | |
|     child_node = *bucket;
 | |
|     if (child_node != current_node) {
 | |
|       while (TrNode_next(child_node) != current_node)
 | |
|         child_node = TrNode_next(child_node);
 | |
|       TrNode_next(child_node) = TrNode_next(current_node);
 | |
|       CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
 | |
|       FREE_GLOBAL_TRIE_NODE(current_node);
 | |
|     } else {
 | |
|       *bucket = TrNode_next(current_node);
 | |
|       CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
 | |
|       FREE_GLOBAL_TRIE_NODE(current_node);
 | |
|       if (num_nodes == 0) {
 | |
|         FREE_BUCKETS(Hash_buckets(hash));
 | |
|         FREE_GLOBAL_TRIE_HASH(hash);
 | |
|         if (parent_node != GLOBAL_root_gt) {
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
|           if (mode == TRAVERSE_MODE_NORMAL) {
 | |
|             if (IsApplTerm(t)) {
 | |
|               Functor f = (Functor)RepAppl(t);
 | |
|               if (f == FunctorDouble)
 | |
|                 mode = TRAVERSE_MODE_DOUBLE;
 | |
|               else if (f == FunctorLongInt)
 | |
|                 mode = TRAVERSE_MODE_LONGINT;
 | |
|               else if (f == FunctorBigInt || f == FunctorString)
 | |
|                 mode = TRAVERSE_MODE_BIGINT_OR_STRING;
 | |
|               else
 | |
|                 mode = TRAVERSE_MODE_NORMAL;
 | |
|             } else
 | |
|               mode = TRAVERSE_MODE_NORMAL;
 | |
|           } else if (mode == TRAVERSE_MODE_LONGINT)
 | |
|             mode = TRAVERSE_MODE_LONGINT_END;
 | |
|         } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING)
 | |
|           mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
 | |
|         else if (mode == TRAVERSE_MODE_DOUBLE)
 | |
| #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
 | |
|           mode = TRAVERSE_MODE_DOUBLE2;
 | |
|         else if (mode == TRAVERSE_MODE_DOUBLE2)
 | |
| #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
 | |
|           mode = TRAVERSE_MODE_DOUBLE_END;
 | |
|         else
 | |
|           mode = TRAVERSE_MODE_NORMAL;
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
|         FREE_GLOBAL_TRIE_BRANCH(parent_node, mode);
 | |
|       } else
 | |
|         TrNode_child(parent_node) = NULL;
 | |
|     }
 | |
|   }
 | |
| }
 | |
| else if (child_node != current_node) {
 | |
|   while (TrNode_next(child_node) != current_node)
 | |
|     child_node = TrNode_next(child_node);
 | |
|   TrNode_next(child_node) = TrNode_next(current_node);
 | |
|   CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
 | |
|   FREE_GLOBAL_TRIE_NODE(current_node);
 | |
| }
 | |
| else if (TrNode_next(current_node) == NULL) {
 | |
|   CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
 | |
|   FREE_GLOBAL_TRIE_NODE(current_node);
 | |
|   if (parent_node != GLOBAL_root_gt) {
 | |
| #ifdef GLOBAL_TRIE_FOR_SUBTERMS
 | |
|     if (mode == TRAVERSE_MODE_NORMAL) {
 | |
|       if (IsApplTerm(t)) {
 | |
|         Functor f = (Functor)RepAppl(t);
 | |
|         if (f == FunctorDouble)
 | |
|           mode = TRAVERSE_MODE_DOUBLE;
 | |
|         else if (f == FunctorLongInt)
 | |
|           mode = TRAVERSE_MODE_LONGINT;
 | |
|         else if (f == FunctorBigInt || f == FunctorString)
 | |
|           mode = TRAVERSE_MODE_BIGINT_OR_STRING;
 | |
|         else
 | |
|           mode = TRAVERSE_MODE_NORMAL;
 | |
|       } else
 | |
|         mode = TRAVERSE_MODE_NORMAL;
 | |
|     } else if (mode == TRAVERSE_MODE_LONGINT) {
 | |
|       mode = TRAVERSE_MODE_LONGINT_END;
 | |
|     } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
 | |
|       mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
 | |
|     } else if (mode == TRAVERSE_MODE_DOUBLE)
 | |
| #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
 | |
|       mode = TRAVERSE_MODE_DOUBLE2;
 | |
|     else if (mode == TRAVERSE_MODE_DOUBLE2)
 | |
| #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
 | |
|       mode = TRAVERSE_MODE_DOUBLE_END;
 | |
|     else
 | |
|       mode = TRAVERSE_MODE_NORMAL;
 | |
| #endif /* GLOBAL_TRIE_FOR_SUBTERMS */
 | |
|     FREE_GLOBAL_TRIE_BRANCH(parent_node, mode);
 | |
|   } else
 | |
|     TrNode_child(parent_node) = NULL;
 | |
| }
 | |
| else {
 | |
|   TrNode_child(parent_node) = TrNode_next(current_node);
 | |
|   CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(t, mode);
 | |
|   FREE_GLOBAL_TRIE_NODE(current_node);
 | |
| }
 | |
| return;
 | |
| }
 | |
| 
 | |
| static void traverse_subgoal_trie(sg_node_ptr current_node, char *str,
 | |
|                                   int str_index, int *arity, int mode,
 | |
|                                   int position USES_REGS) {
 | |
|   int *current_arity = NULL, current_str_index = 0, current_mode = 0;
 | |
| 
 | |
|   /* test if hashing */
 | |
|   if (IS_SUBGOAL_TRIE_HASH(current_node)) {
 | |
|     sg_node_ptr *bucket, *last_bucket;
 | |
|     sg_hash_ptr hash;
 | |
|     hash = (sg_hash_ptr)current_node;
 | |
|     bucket = Hash_buckets(hash);
 | |
|     last_bucket = bucket + Hash_num_buckets(hash);
 | |
|     current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
 | |
|     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
 | |
|     do {
 | |
|       if (*bucket) {
 | |
|         traverse_subgoal_trie(*bucket, str, str_index, arity, mode,
 | |
|                               TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|         memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|         if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
 | |
|           str[str_index - 1] = ',';
 | |
| #else
 | |
|         if (arity[arity[0]] == -1)
 | |
|           str[str_index - 1] = '|';
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       }
 | |
|     } while (++bucket != last_bucket);
 | |
|     free(current_arity);
 | |
|     return;
 | |
|   }
 | |
| 
 | |
|   /* save current state if first sibling node */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
 | |
|     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
 | |
|     current_str_index = str_index;
 | |
|     current_mode = mode;
 | |
|   }
 | |
| 
 | |
|   /* process current trie node */
 | |
|   TrStat_sg_nodes++;
 | |
|   traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode,
 | |
|                      TRAVERSE_TYPE_SUBGOAL PASS_REGS);
 | |
| 
 | |
|   /* show answers ... */
 | |
|   if (IS_SUBGOAL_LEAF_NODE(current_node)) {
 | |
|     sg_fr_ptr sg_fr = get_subgoal_frame(current_node);
 | |
|     if (sg_fr) {
 | |
|       TrStat_subgoals++;
 | |
|       str[str_index] = 0;
 | |
|       SHOW_TABLE_STRUCTURE("%s.\n", str);
 | |
|       TrStat_ans_nodes++;
 | |
|       if (SgFr_first_answer(sg_fr) == NULL) {
 | |
|         if (SgFr_state(sg_fr) < complete) {
 | |
|           TrStat_sg_incomplete++;
 | |
|           SHOW_TABLE_STRUCTURE("    ---> INCOMPLETE\n");
 | |
|         } else {
 | |
|           TrStat_answers_no++;
 | |
|           SHOW_TABLE_STRUCTURE("    NO\n");
 | |
|         }
 | |
|       } else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
 | |
|         TrStat_answers_true++;
 | |
|         SHOW_TABLE_STRUCTURE("    TRUE\n");
 | |
|       } else {
 | |
|         arity[0] = 0;
 | |
|         traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)),
 | |
|                              &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL,
 | |
|                              TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|         if (SgFr_state(sg_fr) < complete) {
 | |
|           TrStat_sg_incomplete++;
 | |
|           SHOW_TABLE_STRUCTURE("    ---> INCOMPLETE\n");
 | |
|         }
 | |
|       }
 | |
|     }
 | |
|   } else
 | |
|     /* ... or continue with child node */
 | |
|     traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity,
 | |
|                           mode, TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|   /* restore the initial state and continue with sibling nodes */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     str_index = current_str_index;
 | |
|     mode = current_mode;
 | |
|     current_node = TrNode_next(current_node);
 | |
|     while (current_node) {
 | |
|       memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|       if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
 | |
|         str[str_index - 1] = ',';
 | |
| #else
 | |
|       if (arity[arity[0]] == -1)
 | |
|         str[str_index - 1] = '|';
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       traverse_subgoal_trie(current_node, str, str_index, arity, mode,
 | |
|                             TRAVERSE_POSITION_NEXT PASS_REGS);
 | |
|       current_node = TrNode_next(current_node);
 | |
|     }
 | |
|     free(current_arity);
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| static void traverse_answer_trie(ans_node_ptr current_node, char *str,
 | |
|                                  int str_index, int *arity, int var_index,
 | |
|                                  int mode, int position USES_REGS) {
 | |
|   int *current_arity = NULL, current_str_index = 0, current_var_index = 0,
 | |
|       current_mode = 0;
 | |
| 
 | |
|   /* test if hashing */
 | |
|   if (IS_ANSWER_TRIE_HASH(current_node)) {
 | |
|     ans_node_ptr *bucket, *last_bucket;
 | |
|     ans_hash_ptr hash;
 | |
|     hash = (ans_hash_ptr)current_node;
 | |
|     bucket = Hash_buckets(hash);
 | |
|     last_bucket = bucket + Hash_num_buckets(hash);
 | |
|     current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
 | |
|     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
 | |
|     do {
 | |
|       if (*bucket) {
 | |
|         traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode,
 | |
|                              TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|         memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|         if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
 | |
|           str[str_index - 1] = ',';
 | |
| #else
 | |
|         if (arity[arity[0]] == -1)
 | |
|           str[str_index - 1] = '|';
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       }
 | |
|     } while (++bucket != last_bucket);
 | |
|     free(current_arity);
 | |
|     return;
 | |
|   }
 | |
| 
 | |
|   /* save current state if first sibling node */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
 | |
|     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
 | |
|     current_str_index = str_index;
 | |
|     current_var_index = var_index;
 | |
|     current_mode = mode;
 | |
|   }
 | |
| 
 | |
|   /* print VAR if starting a term */
 | |
|   if (arity[0] == 0 && mode == TRAVERSE_MODE_NORMAL) {
 | |
|     str_index += sprintf(&str[str_index], "    VAR%d: ", var_index);
 | |
|     var_index++;
 | |
|   }
 | |
| 
 | |
|   /* process current trie node */
 | |
|   TrStat_ans_nodes++;
 | |
|   traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode,
 | |
|                      TRAVERSE_TYPE_ANSWER PASS_REGS);
 | |
| 
 | |
|   /* show answer .... */
 | |
|   if (IS_ANSWER_LEAF_NODE(current_node)) {
 | |
|     TrStat_answers++;
 | |
|     str[str_index] = 0;
 | |
|     SHOW_TABLE_STRUCTURE("%s\n", str);
 | |
|   }
 | |
| #ifdef TABLING_INNER_CUTS
 | |
|   /* ... or continue with pruned node */
 | |
|   else if (TrNode_child(current_node) == NULL) {
 | |
|     TrStat_answers++;
 | |
|     TrStat_answers_pruned++;
 | |
|   }
 | |
| #endif /* TABLING_INNER_CUTS */
 | |
|   /* ... or continue with child node */
 | |
|   else
 | |
|     traverse_answer_trie(TrNode_child(current_node), str, str_index, arity,
 | |
|                          var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
| 
 | |
|   /* restore the initial state and continue with sibling nodes */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     str_index = current_str_index;
 | |
|     var_index = current_var_index;
 | |
|     mode = current_mode;
 | |
|     current_node = TrNode_next(current_node);
 | |
|     while (current_node) {
 | |
|       memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|       if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
 | |
|         str[str_index - 1] = ',';
 | |
| #else
 | |
|       if (arity[arity[0]] == -1)
 | |
|         str[str_index - 1] = '|';
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       traverse_answer_trie(current_node, str, str_index, arity, var_index, mode,
 | |
|                            TRAVERSE_POSITION_NEXT PASS_REGS);
 | |
|       current_node = TrNode_next(current_node);
 | |
|     }
 | |
|     free(current_arity);
 | |
|   }
 | |
| 
 | |
|   return;
 | |
| }
 | |
| 
 | |
| static void traverse_global_trie(gt_node_ptr current_node, char *str,
 | |
|                                  int str_index, int *arity, int mode,
 | |
|                                  int position USES_REGS) {
 | |
|   int *current_arity = NULL, current_str_index = 0, current_mode = 0;
 | |
| 
 | |
|   /* test if hashing */
 | |
|   if (IS_GLOBAL_TRIE_HASH(current_node)) {
 | |
|     gt_node_ptr *bucket, *last_bucket;
 | |
|     gt_hash_ptr hash;
 | |
|     hash = (gt_hash_ptr)current_node;
 | |
|     bucket = Hash_buckets(hash);
 | |
|     last_bucket = bucket + Hash_num_buckets(hash);
 | |
|     current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
 | |
|     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
 | |
|     do {
 | |
|       if (*bucket) {
 | |
|         traverse_global_trie(*bucket, str, str_index, arity, mode,
 | |
|                              TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|         memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|         if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
 | |
|           str[str_index - 1] = ',';
 | |
| #else
 | |
|         if (arity[arity[0]] == -1)
 | |
|           str[str_index - 1] = '|';
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       }
 | |
|     } while (++bucket != last_bucket);
 | |
|     free(current_arity);
 | |
|     return;
 | |
|   }
 | |
| 
 | |
|   /* save current state if first sibling node */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     current_arity = (int *)malloc(sizeof(int) * (arity[0] + 1));
 | |
|     memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
 | |
|     current_str_index = str_index;
 | |
|     current_mode = mode;
 | |
|   }
 | |
| 
 | |
|   /* process current trie node */
 | |
|   TrStat_gt_nodes++;
 | |
|   traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode,
 | |
|                      TRAVERSE_TYPE_GT_SUBGOAL PASS_REGS);
 | |
| 
 | |
|   /* continue with child node ... */
 | |
|   if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
 | |
|     traverse_global_trie(TrNode_child(current_node), str, str_index, arity,
 | |
|                          mode, TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|   /* ... or show term */
 | |
|   else {
 | |
|     TrStat_gt_terms++;
 | |
|     str[str_index] = 0;
 | |
|     SHOW_TABLE_STRUCTURE("  TERMx" UInt_FORMAT ": %s\n",
 | |
|                          (CELL)TrNode_child(current_node), str);
 | |
|   }
 | |
| 
 | |
|   /* restore the initial state and continue with sibling nodes */
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     str_index = current_str_index;
 | |
|     mode = current_mode;
 | |
|     current_node = TrNode_next(current_node);
 | |
|     while (current_node) {
 | |
|       memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|       if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
 | |
|         str[str_index - 1] = ',';
 | |
| #else
 | |
|       if (arity[arity[0]] == -1)
 | |
|         str[str_index - 1] = '|';
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       traverse_global_trie(current_node, str, str_index, arity, mode,
 | |
|                            TRAVERSE_POSITION_NEXT PASS_REGS);
 | |
|       current_node = TrNode_next(current_node);
 | |
|     }
 | |
|     free(current_arity);
 | |
|   }
 | |
| 
 | |
|   return;
 | |
| }
 | |
| 
 | |
| static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str,
 | |
|                                           int *str_index, int *arity, int *mode,
 | |
|                                           int type USES_REGS) {
 | |
|   if (TrNode_parent(current_node) != GLOBAL_root_gt)
 | |
|     traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index,
 | |
|                                   arity, mode, type PASS_REGS);
 | |
|   traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode,
 | |
|                      type PASS_REGS);
 | |
|   return;
 | |
| }
 | |
| 
 | |
| static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr,
 | |
|                                       int *arity, int *mode_ptr,
 | |
|                                       int type USES_REGS) {
 | |
|   int mode = *mode_ptr;
 | |
|   int str_index = *str_index_ptr;
 | |
| 
 | |
|   /* test the node type */
 | |
|   if (mode == TRAVERSE_MODE_DOUBLE) {
 | |
| #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
 | |
|     arity[0]++;
 | |
|     arity[arity[0]] = (int)t;
 | |
|     mode = TRAVERSE_MODE_DOUBLE2;
 | |
|   } else if (mode == TRAVERSE_MODE_DOUBLE2) {
 | |
|     union {
 | |
|       Term t_dbl[sizeof(Float) / sizeof(Term)];
 | |
|       Float dbl;
 | |
|     } u;
 | |
|     u.dbl = 0.0;
 | |
|     u.t_dbl[0] = t;
 | |
|     u.t_dbl[1] = (Term)arity[arity[0]];
 | |
|     arity[0]--;
 | |
| #else  /* SIZEOF_DOUBLE == SIZEOF_INT_P */
 | |
|     union {
 | |
|       Term t_dbl[sizeof(Float) / sizeof(Term)];
 | |
|       Float dbl;
 | |
|     } u;
 | |
|     u.t_dbl[0] = t;
 | |
| #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
 | |
|     str_index += sprintf(&str[str_index], "%.15g", u.dbl);
 | |
|     traverse_update_arity(str, &str_index, arity);
 | |
|     if (type == TRAVERSE_TYPE_SUBGOAL)
 | |
|       mode = TRAVERSE_MODE_NORMAL;
 | |
|     else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL ||
 | |
|             TRAVERSE_TYPE_GT_ANSWER */
 | |
|       mode = TRAVERSE_MODE_DOUBLE_END;
 | |
|   } else if (mode == TRAVERSE_MODE_DOUBLE_END) {
 | |
|     mode = TRAVERSE_MODE_NORMAL;
 | |
|   } else if (mode == TRAVERSE_MODE_LONGINT) {
 | |
|     Int li = (Int)t;
 | |
|     str_index += sprintf(&str[str_index], Int_FORMAT, li);
 | |
|     traverse_update_arity(str, &str_index, arity);
 | |
|     if (type == TRAVERSE_TYPE_SUBGOAL)
 | |
|       mode = TRAVERSE_MODE_NORMAL;
 | |
|     else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL ||
 | |
|             TRAVERSE_TYPE_GT_ANSWER */
 | |
|       mode = TRAVERSE_MODE_LONGINT_END;
 | |
|   } else if (mode == TRAVERSE_MODE_LONGINT_END) {
 | |
|     mode = TRAVERSE_MODE_NORMAL;
 | |
|   } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
 | |
|     str_index += Yap_OpaqueTermToString(AbsAppl((CELL *)t), str + str_index, 0);
 | |
|     traverse_update_arity(str, &str_index, arity);
 | |
|     if (type == TRAVERSE_TYPE_SUBGOAL)
 | |
|       mode = TRAVERSE_MODE_NORMAL;
 | |
|     else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_SUBGOAL ||
 | |
|             TRAVERSE_TYPE_GT_ANSWER */
 | |
|       mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
 | |
|   } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING_END) {
 | |
|     mode = TRAVERSE_MODE_NORMAL;
 | |
|   } else if (IsVarTerm(t)) {
 | |
| #ifdef TRIE_RATIONAL_TERMS
 | |
|     if (t > VarIndexOfTableTerm(MAX_TABLE_VARS) &&
 | |
|         TrNode_child((gt_node_ptr)t) !=
 | |
|             (gt_node_ptr)1) { // TODO: substitute the != 1 test to something
 | |
|                               // more appropriate
 | |
|       /* Rational term */
 | |
|       str_index += sprintf(&str[str_index], "**");
 | |
|       traverse_update_arity(str, &str_index, arity);
 | |
|     } else
 | |
| #endif /* RATIONAL TERM SUPPORT FOR TRIES */
 | |
|         if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
 | |
|       TrStat_gt_refs++;
 | |
|       /* (type % 2 + 2): TRAVERSE_TYPE_ANSWER  --> TRAVERSE_TYPE_GT_ANSWER  */
 | |
|       /* (type % 2 + 2): TRAVERSE_TYPE_SUBGOAL --> TRAVERSE_TYPE_GT_SUBGOAL */
 | |
|       traverse_global_trie_for_term((gt_node_ptr)t, str, &str_index, arity,
 | |
|                                     &mode, type % 2 + 2 PASS_REGS);
 | |
|     } else {
 | |
|       if (type == TRAVERSE_TYPE_SUBGOAL || type == TRAVERSE_TYPE_GT_SUBGOAL)
 | |
|         str_index += sprintf(&str[str_index], "VAR%d", VarIndexOfTableTerm(t));
 | |
|       else /* TRAVERSE_TYPE_ANSWER || TRAVERSE_TYPE_GT_ANSWER */
 | |
|         str_index +=
 | |
|             sprintf(&str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t));
 | |
|       traverse_update_arity(str, &str_index, arity);
 | |
|     }
 | |
|   } else if (IsIntTerm(t)) {
 | |
|     str_index += sprintf(&str[str_index], Int_FORMAT, IntOfTerm(t));
 | |
|     traverse_update_arity(str, &str_index, arity);
 | |
|   } else if (IsAtomTerm(t)) {
 | |
| #ifndef TRIE_COMPACT_PAIRS
 | |
|     if (arity[arity[0]] == -1 && t == TermNil) {
 | |
|       str[str_index - 1] = ']';
 | |
|       arity[0]--;
 | |
|     } else
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|       str_index += sprintf(&str[str_index], "%s", AtomName(AtomOfTerm(t)));
 | |
|     traverse_update_arity(str, &str_index, arity);
 | |
|   } else if (IsPairTerm(t)) {
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|     if (t == CompactPairEndList)
 | |
|       arity[arity[0]] = -1;
 | |
|     else if (t == CompactPairEndTerm) {
 | |
|       str[str_index - 1] = '|';
 | |
|       arity[arity[0]] = -1;
 | |
| #else
 | |
|     if (arity[arity[0]] == -1) {
 | |
|       str[str_index - 1] = ',';
 | |
|       arity[arity[0]] = -2;
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|     } else {
 | |
|       str_index += sprintf(&str[str_index], "[");
 | |
|       arity[0]++;
 | |
|       arity[arity[0]] = -2;
 | |
|     }
 | |
|   } else if (IsApplTerm(t)) {
 | |
|     Functor f = (Functor)RepAppl(t);
 | |
|     if (f == FunctorDouble) {
 | |
|       mode = TRAVERSE_MODE_DOUBLE;
 | |
|     } else if (f == FunctorLongInt) {
 | |
|       mode = TRAVERSE_MODE_LONGINT;
 | |
|     } else if (f == FunctorBigInt || f == FunctorString) {
 | |
|       mode = TRAVERSE_MODE_BIGINT_OR_STRING;
 | |
|     } else if (f == FunctorComma) {
 | |
|       if (arity[arity[0]] != -3) {
 | |
|         str_index += sprintf(&str[str_index], "(");
 | |
|         arity[0]++;
 | |
|       }
 | |
|       arity[arity[0]] = -4;
 | |
|     } else {
 | |
|       str_index += sprintf(&str[str_index], "%s(", AtomName(NameOfFunctor(f)));
 | |
|       arity[0]++;
 | |
|       arity[arity[0]] = ArityOfFunctor(f);
 | |
|     }
 | |
|   }
 | |
| 
 | |
|   *mode_ptr = mode;
 | |
|   *str_index_ptr = str_index;
 | |
|   return;
 | |
| }
 | |
| 
 | |
| static inline void traverse_update_arity(char *str, int *str_index_ptr,
 | |
|                                          int *arity) {
 | |
|   int str_index = *str_index_ptr;
 | |
|   while (arity[0]) {
 | |
|     if (arity[arity[0]] > 0) {
 | |
|       arity[arity[0]]--;
 | |
|       if (arity[arity[0]] == 0) {
 | |
|         str_index += sprintf(&str[str_index], ")");
 | |
|         arity[0]--;
 | |
|       } else {
 | |
|         str_index += sprintf(&str[str_index], ",");
 | |
|         break;
 | |
|       }
 | |
|     } else {
 | |
|       if (arity[arity[0]] == -4) {
 | |
|         str_index += sprintf(&str[str_index], ",");
 | |
|         arity[arity[0]] = -3;
 | |
|         break;
 | |
|       } else if (arity[arity[0]] == -3) {
 | |
|         str_index += sprintf(&str[str_index], ")");
 | |
|         arity[0]--;
 | |
|       } else if (arity[arity[0]] == -2) {
 | |
| #ifdef TRIE_COMPACT_PAIRS
 | |
|         str_index += sprintf(&str[str_index], ",");
 | |
| #else
 | |
|         str_index += sprintf(&str[str_index], "|");
 | |
|         arity[arity[0]] = -1;
 | |
| #endif /* TRIE_COMPACT_PAIRS */
 | |
|         break;
 | |
|       } else if (arity[arity[0]] == -1) {
 | |
|         str_index += sprintf(&str[str_index], "]");
 | |
|         arity[0]--;
 | |
|       }
 | |
|     }
 | |
|   }
 | |
|   *str_index_ptr = str_index;
 | |
| }
 | |
| 
 | |
| /*******************************
 | |
| **      Global functions      **
 | |
| *******************************/
 | |
| 
 | |
| sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
 | |
|   CACHE_REGS
 | |
|   CELL *stack_vars;
 | |
|   int i, subs_arity, pred_arity;
 | |
|   tab_ent_ptr tab_ent;
 | |
|   sg_fr_ptr sg_fr;
 | |
|   sg_node_ptr current_sg_node;
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
|   int *mode_directed, aux_mode_directed[MAX_TABLE_VARS];
 | |
|   int subs_pos = 0;
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
| 
 | |
|   stack_vars = *Yaddr;
 | |
|   subs_arity = 0;
 | |
|   pred_arity = preg->y_u.Otapl.s;
 | |
|   tab_ent = preg->y_u.Otapl.te;
 | |
|   current_sg_node = get_insert_subgoal_trie(tab_ent PASS_REGS);
 | |
|   LOCK_SUBGOAL_TRIE(tab_ent);
 | |
| 
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
|   mode_directed = TabEnt_mode_directed(tab_ent);
 | |
|   if (mode_directed) {
 | |
|     int old_subs_arity = subs_arity;
 | |
|     for (i = 1; i <= pred_arity; i++) {
 | |
|       int j = MODE_DIRECTED_GET_ARG(mode_directed[i - 1]) + 1;
 | |
|       current_sg_node =
 | |
|           subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[j]),
 | |
|                               &subs_arity, &stack_vars PASS_REGS);
 | |
|       if (subs_arity != old_subs_arity) {
 | |
|         if (subs_pos &&
 | |
|             MODE_DIRECTED_GET_MODE(aux_mode_directed[subs_pos - 1]) ==
 | |
|                 MODE_DIRECTED_GET_MODE(mode_directed[i - 1])) {
 | |
|           /* same mode as before -> use the current entry in the
 | |
|            * aux_mode_directed[] array */
 | |
|           aux_mode_directed[subs_pos - 1] +=
 | |
|               MODE_DIRECTED_SET(subs_arity - old_subs_arity, 0);
 | |
|         } else {
 | |
|           /* new mode -> init a new entry in the aux_mode_directed[] array */
 | |
|           aux_mode_directed[subs_pos] =
 | |
|               MODE_DIRECTED_SET(subs_arity - old_subs_arity,
 | |
|                                 MODE_DIRECTED_GET_MODE(mode_directed[i - 1]));
 | |
|           subs_pos++;
 | |
|         }
 | |
|         old_subs_arity = subs_arity;
 | |
|       }
 | |
|     }
 | |
|   } else
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
|       if (IsMode_GlobalTrie(TabEnt_mode(tab_ent))) {
 | |
|     for (i = 1; i <= pred_arity; i++)
 | |
|       current_sg_node =
 | |
|           subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]),
 | |
|                                     &subs_arity, &stack_vars PASS_REGS);
 | |
|   } else {
 | |
|     for (i = 1; i <= pred_arity; i++)
 | |
|       current_sg_node =
 | |
|           subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]),
 | |
|                               &subs_arity, &stack_vars PASS_REGS);
 | |
|   }
 | |
| 
 | |
|   STACK_PUSH_UP(subs_arity, stack_vars);
 | |
|   *Yaddr = stack_vars++;
 | |
|   /* reset variables */
 | |
|   while (subs_arity--) {
 | |
|     Term t = STACK_POP_DOWN(stack_vars);
 | |
|     RESET_VARIABLE(t);
 | |
|   }
 | |
| 
 | |
|   sg_fr_ptr *sg_fr_end =
 | |
|       get_insert_subgoal_frame_addr(current_sg_node PASS_REGS);
 | |
| #ifndef THREADS
 | |
|   LOCK_SUBGOAL_NODE(current_sg_node);
 | |
| #endif /* !THREADS */
 | |
|   if (*sg_fr_end == NULL) {
 | |
| /* new tabled subgoal */
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
|     if (subs_pos) {
 | |
|       ALLOC_BLOCK(mode_directed, subs_pos * sizeof(int), int);
 | |
|       memcpy((void *)mode_directed, (void *)aux_mode_directed,
 | |
|              subs_pos * sizeof(int));
 | |
|     } else
 | |
|       mode_directed = NULL;
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
| #if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
 | |
|     new_subgoal_frame(sg_fr, preg, mode_directed);
 | |
|     *sg_fr_end = sg_fr;
 | |
| #ifndef _MSC_VER
 | |
|     __sync_synchronize();
 | |
| #endif
 | |
|     TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node);
 | |
|     UNLOCK_SUBGOAL_NODE(current_sg_node);
 | |
| #else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|     sg_ent_ptr sg_ent =
 | |
|         (sg_ent_ptr)UNTAG_SUBGOAL_NODE(TrNode_sg_ent(current_sg_node));
 | |
|     new_subgoal_frame(sg_fr, sg_ent);
 | |
| #ifdef THREADS_CONSUMER_SHARING
 | |
|     SgFr_state(sg_fr) = ready_external;
 | |
| #else
 | |
|     SgFr_state(sg_fr) = ready;
 | |
| #endif /* THREADS_CONSUMER_SHARING */
 | |
|     if (SgEnt_sg_ent_state(sg_ent) == ready) {
 | |
|       LOCK(SgEnt_lock(sg_ent));
 | |
|       if (SgEnt_sg_ent_state(sg_ent) == ready) {
 | |
|         SgEnt_code(sg_ent) = preg;
 | |
|         SgEnt_init_mode_directed_fields(sg_ent, mode_directed);
 | |
|         SgEnt_sg_ent_state(sg_ent) = evaluating;
 | |
| #ifdef THREADS_CONSUMER_SHARING
 | |
|         SgEnt_gen_worker(sg_ent) = worker_id;
 | |
|         SgFr_state(sg_fr) = ready;
 | |
| #endif /* THREADS_CONSUMER_SHARING */
 | |
|       }
 | |
|       UNLOCK(SgEnt_lock(sg_ent));
 | |
|     }
 | |
|     *sg_fr_end = sg_fr;
 | |
| #endif /* !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
 | |
|   } else {
 | |
| /* repeated tabled subgoal */
 | |
| #ifndef THREADS
 | |
|     UNLOCK_SUBGOAL_NODE(current_sg_node);
 | |
| #endif /* !THREADS */
 | |
|     sg_fr = (sg_fr_ptr)UNTAG_SUBGOAL_NODE(*sg_fr_end);
 | |
| #ifdef LIMIT_TABLING
 | |
|     if (SgFr_state(sg_fr) <= ready) { /* incomplete or ready */
 | |
|       remove_from_global_sg_fr_list(sg_fr);
 | |
|     }
 | |
| #endif /* LIMIT_TABLING */
 | |
|   }
 | |
|   UNLOCK_SUBGOAL_TRIE(tab_ent);
 | |
|   return sg_fr;
 | |
| }
 | |
| 
 | |
| ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
 | |
| #define subs_arity *subs_ptr
 | |
|   CACHE_REGS
 | |
|   CELL *stack_vars;
 | |
|   int i, vars_arity;
 | |
|   ans_node_ptr current_ans_node;
 | |
| 
 | |
|   vars_arity = 0;
 | |
|   current_ans_node = SgFr_answer_trie(sg_fr);
 | |
| 
 | |
|   if (IsMode_GlobalTrie(TabEnt_mode(SgFr_tab_ent(sg_fr)))) {
 | |
|     for (i = subs_arity; i >= 1; i--) {
 | |
|       TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
 | |
|       current_ans_node = answer_search_terms_loop(
 | |
|           sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
 | |
|     }
 | |
|   } else {
 | |
|     for (i = subs_arity; i >= 1; i--) {
 | |
|       TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
 | |
|       current_ans_node = answer_search_loop(
 | |
|           sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
 | |
|     }
 | |
|   }
 | |
| 
 | |
|   /* reset variables */
 | |
|   stack_vars = (CELL *)TR;
 | |
|   while (vars_arity--) {
 | |
|     Term t = STACK_POP_DOWN(stack_vars);
 | |
|     RESET_VARIABLE(t);
 | |
|   }
 | |
| 
 | |
|   return current_ans_node;
 | |
| #undef subs_arity
 | |
| }
 | |
| 
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
| ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
 | |
| #define subs_arity *subs_ptr
 | |
|   CACHE_REGS
 | |
|   CELL *stack_vars;
 | |
|   int i, j, vars_arity;
 | |
|   ans_node_ptr current_ans_node, invalid_ans_node;
 | |
|   int *mode_directed;
 | |
| 
 | |
|   vars_arity = 0;
 | |
|   current_ans_node = SgFr_answer_trie(sg_fr);
 | |
|   invalid_ans_node = NULL;
 | |
|   mode_directed = SgFr_mode_directed(sg_fr);
 | |
|   j = 0;
 | |
|   i = subs_arity;
 | |
|   while (i) {
 | |
|     int mode = MODE_DIRECTED_GET_MODE(mode_directed[j]);
 | |
|     int n_subs = MODE_DIRECTED_GET_ARG(mode_directed[j]);
 | |
|     do {
 | |
|       TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
 | |
|       if (mode == MODE_DIRECTED_INDEX || mode == MODE_DIRECTED_ALL) {
 | |
|         current_ans_node = answer_search_loop(
 | |
|             sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
 | |
|       } else {
 | |
|         LOCK_ANSWER_NODE(current_ans_node);
 | |
|         if (TrNode_child(current_ans_node) == NULL) {
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
|           struct answer_trie_node
 | |
|               virtual_ans_node; /* necessary because the answer_search_loop()
 | |
|                                    procedure also locks the parent node */
 | |
|           ans_node_ptr parent_ans_node = current_ans_node;
 | |
|           AnsNode_init_lock_field(&virtual_ans_node);
 | |
|           TrNode_parent(&virtual_ans_node) = NULL;
 | |
|           TrNode_child(&virtual_ans_node) = NULL;
 | |
|           current_ans_node =
 | |
|               answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]),
 | |
|                                  &vars_arity PASS_REGS);
 | |
|           TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node);
 | |
|           TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node;
 | |
| #else
 | |
|           current_ans_node =
 | |
|               answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]),
 | |
|                                  &vars_arity PASS_REGS);
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|         } else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX) {
 | |
|           ans_node_ptr parent_ans_node = current_ans_node;
 | |
|           invalid_ans_node = TrNode_child(
 | |
|               parent_ans_node); /* by default, assume a better answer */
 | |
|           current_ans_node = answer_search_min_max(
 | |
|               sg_fr, current_ans_node, Deref(subs_ptr[i]), mode PASS_REGS);
 | |
|           if (invalid_ans_node ==
 | |
|               TrNode_child(parent_ans_node)) /* worse or equal answer */
 | |
|             invalid_ans_node = NULL;
 | |
|         } else if (mode == MODE_DIRECTED_SUM) {
 | |
|           invalid_ans_node = TrNode_child(current_ans_node);
 | |
|           current_ans_node = answer_search_sum(sg_fr, current_ans_node,
 | |
|                                                Deref(subs_ptr[i]) PASS_REGS);
 | |
|         } else if (mode == MODE_DIRECTED_LAST) {
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
|           struct answer_trie_node
 | |
|               virtual_ans_node; /* necessary because the answer_search_loop()
 | |
|                                    procedure also locks the parent node */
 | |
|           ans_node_ptr parent_ans_node = current_ans_node;
 | |
|           invalid_ans_node = TrNode_child(parent_ans_node);
 | |
|           AnsNode_init_lock_field(&virtual_ans_node);
 | |
|           TrNode_parent(&virtual_ans_node) = NULL;
 | |
|           TrNode_child(&virtual_ans_node) = NULL;
 | |
|           current_ans_node =
 | |
|               answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]),
 | |
|                                  &vars_arity PASS_REGS);
 | |
|           TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node);
 | |
|           TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node;
 | |
| #else
 | |
|           invalid_ans_node = TrNode_child(current_ans_node);
 | |
|           TrNode_child(current_ans_node) = NULL;
 | |
|           current_ans_node =
 | |
|               answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]),
 | |
|                                  &vars_arity PASS_REGS);
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|         } else if (mode == MODE_DIRECTED_FIRST) {
 | |
|           current_ans_node = NULL;
 | |
|         } else
 | |
|           Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil,
 | |
|                     "mode_directed_answer_search: unknown mode");
 | |
|         UNLOCK_ANSWER_NODE(current_ans_node);
 | |
|       }
 | |
|       n_subs--;
 | |
|       i--;
 | |
|     } while (n_subs && current_ans_node);
 | |
|     if (current_ans_node == NULL) /* no answer inserted */
 | |
|       break;
 | |
|     j++;
 | |
|   }
 | |
|   if (invalid_ans_node)
 | |
|     invalidate_answer_trie(invalid_ans_node, sg_fr,
 | |
|                            TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
| 
 | |
|   /* reset variables */
 | |
|   stack_vars = (CELL *)TR;
 | |
|   while (vars_arity--) {
 | |
|     Term t = STACK_POP_DOWN(stack_vars);
 | |
|     RESET_VARIABLE(t);
 | |
|   }
 | |
| 
 | |
|   return current_ans_node;
 | |
| #undef subs_arity
 | |
| }
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
| 
 | |
| void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) {
 | |
|   CACHE_REGS
 | |
| #define subs_arity *subs_ptr
 | |
|   CELL *stack_terms;
 | |
|   int i;
 | |
| 
 | |
|   TABLING_ERROR_CHECKING(load_answer, H < H_FZ);
 | |
|   if (subs_arity == 0)
 | |
|     return;
 | |
| 
 | |
|   stack_terms = load_answer_loop(current_ans_node PASS_REGS);
 | |
| 
 | |
|   for (i = subs_arity; i >= 1; i--) {
 | |
|     Term t = STACK_POP_DOWN(stack_terms);
 | |
|     YapBind((CELL *)subs_ptr[i], t);
 | |
|   }
 | |
|   TABLING_ERROR_CHECKING(load_answer, stack_terms != (CELL *)LOCAL_TrailTop);
 | |
| 
 | |
|   return;
 | |
| #undef subs_arity
 | |
| }
 | |
| 
 | |
| CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) {
 | |
|   CACHE_REGS
 | |
| #define subs_arity *subs_ptr
 | |
|   CELL *stack_terms, *subs_ptr;
 | |
|   Term t;
 | |
| 
 | |
|   ++aux_stack; /* skip the heap_arity entry */
 | |
|   stack_terms = exec_substitution_loop(current_node, &aux_stack,
 | |
|                                        (CELL *)LOCAL_TrailTop PASS_REGS);
 | |
|   *--aux_stack = 0; /* restore the heap_arity entry */
 | |
| 
 | |
|   subs_ptr = aux_stack + aux_stack[1] + 2;
 | |
|   t = STACK_POP_DOWN(stack_terms);
 | |
|   YapBind((CELL *)subs_ptr[subs_arity], t);
 | |
|   TABLING_ERROR_CHECKING(exec_substitution,
 | |
|                          stack_terms != (CELL *)LOCAL_TrailTop);
 | |
|   *subs_ptr = subs_arity - 1;
 | |
| 
 | |
|   return aux_stack;
 | |
| #undef subs_arity
 | |
| }
 | |
| 
 | |
| void update_answer_trie(sg_fr_ptr sg_fr) {
 | |
|   ans_node_ptr current_node;
 | |
| 
 | |
|   free_answer_hash_chain(SgFr_hash_chain(sg_fr));
 | |
|   SgFr_hash_chain(sg_fr) = NULL;
 | |
|   SgFr_state(sg_fr) +=
 | |
|       2; /* complete --> compiled : complete_in_use --> compiled_in_use */
 | |
| 
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
|   SgFr_sg_ent_state(sg_fr) += 2; /* complete --> compiled */
 | |
| #ifdef THREADS_FULL_SHARING
 | |
|   if (IsMode_Batched(TabEnt_mode(SgFr_tab_ent(sg_fr)))) {
 | |
|     /* cleaning bits used by batched mode and shifting the instruction back to
 | |
|      * the original place */
 | |
|     ans_node_ptr leaf_ans_trie_node = SgFr_first_answer(sg_fr);
 | |
|     while (TrNode_child(leaf_ans_trie_node) != NULL) {
 | |
|       ANSWER_LEAF_NODE_INSTR_ABSOLUTE(leaf_ans_trie_node);
 | |
|       leaf_ans_trie_node = TrNode_child(leaf_ans_trie_node);
 | |
|     }
 | |
|     ANSWER_LEAF_NODE_INSTR_ABSOLUTE(leaf_ans_trie_node);
 | |
|   }
 | |
| #endif /* THREADS_FULL_SHARING */
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|   current_node = TrNode_child(SgFr_answer_trie(sg_fr));
 | |
|   if (current_node) {
 | |
| #ifdef YAPOR
 | |
|     TrNode_instr(current_node) -= 1;
 | |
| #ifdef TABLING_INNER_CUTS
 | |
|     update_answer_trie_branch(NULL, current_node);
 | |
| #else
 | |
|     update_answer_trie_branch(current_node);
 | |
| #endif /* TABLING_INNER_CUTS */
 | |
| #else  /* TABLING */
 | |
|     update_answer_trie_branch(current_node, TRAVERSE_POSITION_FIRST);
 | |
| #endif /* YAPOR */
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) {
 | |
|   CACHE_REGS
 | |
| 
 | |
|   if (IS_SUBGOAL_TRIE_HASH(current_node)) {
 | |
|     sg_node_ptr *bucket, *last_bucket;
 | |
|     sg_hash_ptr hash;
 | |
|     hash = (sg_hash_ptr)current_node;
 | |
|     bucket = Hash_buckets(hash);
 | |
|     last_bucket = bucket + Hash_num_buckets(hash);
 | |
|     do {
 | |
|       if (*bucket) {
 | |
|         sg_node_ptr next_node = *bucket;
 | |
|         do {
 | |
|           current_node = next_node;
 | |
|           next_node = TrNode_next(current_node);
 | |
|           free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
 | |
|         } while (next_node);
 | |
|       }
 | |
|     } while (++bucket != last_bucket);
 | |
|     IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES {
 | |
|       FREE_BUCKETS(Hash_buckets(hash));
 | |
|       FREE_SUBGOAL_TRIE_HASH(hash);
 | |
|     }
 | |
|     return;
 | |
|   }
 | |
|   if (!IS_SUBGOAL_LEAF_NODE(current_node)) {
 | |
|     int child_mode;
 | |
|     if (mode == TRAVERSE_MODE_NORMAL) {
 | |
|       Term t = TrNode_entry(current_node);
 | |
|       if (IsApplTerm(t)) {
 | |
|         Functor f = (Functor)RepAppl(t);
 | |
|         if (f == FunctorDouble)
 | |
|           child_mode = TRAVERSE_MODE_DOUBLE;
 | |
|         else if (f == FunctorLongInt)
 | |
|           child_mode = TRAVERSE_MODE_LONGINT;
 | |
|         else if (f == FunctorBigInt || f == FunctorString)
 | |
|           child_mode = TRAVERSE_MODE_BIGINT_OR_STRING;
 | |
|         else
 | |
|           child_mode = TRAVERSE_MODE_NORMAL;
 | |
|       } else
 | |
|         child_mode = TRAVERSE_MODE_NORMAL;
 | |
|     } else if (mode == TRAVERSE_MODE_LONGINT) {
 | |
|       child_mode = TRAVERSE_MODE_LONGINT_END;
 | |
|     } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
 | |
|       Yap_FreeCodeSpace((char *)TrNode_entry(current_node));
 | |
|       child_mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
 | |
|     } else if (mode == TRAVERSE_MODE_DOUBLE) {
 | |
| #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
 | |
|       child_mode = TRAVERSE_MODE_DOUBLE2;
 | |
|     } else if (mode == TRAVERSE_MODE_DOUBLE2) {
 | |
| #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
 | |
|       child_mode = TRAVERSE_MODE_DOUBLE_END;
 | |
|     } else {
 | |
|       child_mode = TRAVERSE_MODE_NORMAL;
 | |
|     }
 | |
|     free_subgoal_trie(TrNode_child(current_node), child_mode,
 | |
|                       TRAVERSE_POSITION_FIRST);
 | |
|   } else {
 | |
|     sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(current_node PASS_REGS);
 | |
|     if (sg_fr) {
 | |
|       ans_node_ptr ans_node;
 | |
|       free_answer_hash_chain(SgFr_hash_chain(sg_fr));
 | |
|       ans_node = SgFr_answer_trie(sg_fr);
 | |
|       if (TrNode_child(ans_node))
 | |
|         free_answer_trie(TrNode_child(ans_node), TRAVERSE_MODE_NORMAL,
 | |
|                          TRAVERSE_POSITION_FIRST);
 | |
|       IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
 | |
|         FREE_ANSWER_TRIE_NODE(ans_node);
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
|         if (SgEnt_mode_directed(SgFr_sg_ent(sg_fr)))
 | |
|           FREE_BLOCK(SgEnt_mode_directed(SgFr_sg_ent(sg_fr)));
 | |
|         if (SgFr_invalid_chain(sg_fr)) {
 | |
|           ans_node_ptr current_node, next_node;
 | |
|           /* free invalid answer nodes */
 | |
|           current_node = SgFr_invalid_chain(sg_fr);
 | |
|           SgFr_invalid_chain(sg_fr) = NULL;
 | |
|           while (current_node) {
 | |
|             next_node = TrNode_next(current_node);
 | |
|             FREE_ANSWER_TRIE_NODE(current_node);
 | |
|             current_node = next_node;
 | |
|           }
 | |
|         }
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
|         FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr));
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|       }
 | |
| #ifdef LIMIT_TABLING
 | |
|       remove_from_global_sg_fr_list(sg_fr);
 | |
| #endif /* LIMIT_TABLING */
 | |
| #if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) &&        \
 | |
|     !defined(THREADS_CONSUMER_SHARING)
 | |
|       if (SgFr_mode_directed(sg_fr))
 | |
|         FREE_BLOCK(SgFr_mode_directed(sg_fr));
 | |
| #endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING &&                    \
 | |
|           !THREADS_CONSUMER_SHARING */
 | |
|       FREE_SUBGOAL_FRAME(sg_fr);
 | |
|     }
 | |
|   }
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     sg_node_ptr next_node = TrNode_next(current_node);
 | |
|     IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES {
 | |
|       CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
 | |
|       FREE_SUBGOAL_TRIE_NODE(current_node);
 | |
|     }
 | |
|     while (next_node) {
 | |
|       current_node = next_node;
 | |
|       next_node = TrNode_next(current_node);
 | |
|       free_subgoal_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
 | |
|     }
 | |
|   } else {
 | |
|     IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES {
 | |
|       CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
 | |
|       FREE_SUBGOAL_TRIE_NODE(current_node);
 | |
|     }
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| void free_answer_trie(ans_node_ptr current_node, int mode, int position) {
 | |
|   CACHE_REGS
 | |
| 
 | |
| #ifdef TABLING_INNER_CUTS
 | |
|   if (!IS_ANSWER_LEAF_NODE(current_node) && TrNode_child(current_node)) {
 | |
| #else
 | |
|   if (!IS_ANSWER_LEAF_NODE(current_node)) {
 | |
| #endif /* TABLING_INNER_CUTS */
 | |
|     int child_mode;
 | |
|     if (mode == TRAVERSE_MODE_NORMAL) {
 | |
|       Term t = TrNode_entry(current_node);
 | |
|       if (IsApplTerm(t)) {
 | |
|         Functor f = (Functor)RepAppl(t);
 | |
|         if (f == FunctorDouble)
 | |
|           child_mode = TRAVERSE_MODE_DOUBLE;
 | |
|         else if (f == FunctorLongInt)
 | |
|           child_mode = TRAVERSE_MODE_LONGINT;
 | |
|         else if (f == FunctorBigInt || f == FunctorString)
 | |
|           child_mode = TRAVERSE_MODE_BIGINT_OR_STRING;
 | |
|         else
 | |
|           child_mode = TRAVERSE_MODE_NORMAL;
 | |
|       } else
 | |
|         child_mode = TRAVERSE_MODE_NORMAL;
 | |
|     } else if (mode == TRAVERSE_MODE_LONGINT) {
 | |
|       child_mode = TRAVERSE_MODE_LONGINT_END;
 | |
|     } else if (mode == TRAVERSE_MODE_BIGINT_OR_STRING) {
 | |
|       Yap_FreeCodeSpace((char *)TrNode_entry(current_node));
 | |
|       child_mode = TRAVERSE_MODE_BIGINT_OR_STRING_END;
 | |
|     } else if (mode == TRAVERSE_MODE_DOUBLE) {
 | |
| #if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
 | |
|       child_mode = TRAVERSE_MODE_DOUBLE2;
 | |
|     } else if (mode == TRAVERSE_MODE_DOUBLE2) {
 | |
| #endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
 | |
|       child_mode = TRAVERSE_MODE_DOUBLE_END;
 | |
|     } else {
 | |
|       child_mode = TRAVERSE_MODE_NORMAL;
 | |
|     }
 | |
|     free_answer_trie(TrNode_child(current_node), child_mode,
 | |
|                      TRAVERSE_POSITION_FIRST);
 | |
|   }
 | |
|   if (position == TRAVERSE_POSITION_FIRST) {
 | |
|     ans_node_ptr next_node = TrNode_next(current_node);
 | |
|     IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
 | |
|       CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
 | |
|       FREE_ANSWER_TRIE_NODE(current_node);
 | |
|     }
 | |
|     while (next_node) {
 | |
|       current_node = next_node;
 | |
|       next_node = TrNode_next(current_node);
 | |
|       free_answer_trie(current_node, mode, TRAVERSE_POSITION_NEXT);
 | |
|     }
 | |
|   } else {
 | |
|     IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
 | |
|       CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(TrNode_entry(current_node), mode);
 | |
|       FREE_ANSWER_TRIE_NODE(current_node);
 | |
|     }
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| void free_answer_hash_chain(ans_hash_ptr hash) {
 | |
| #if defined(THREADS_NO_SHARING) || defined(THREADS_SUBGOAL_SHARING)
 | |
|   CACHE_REGS
 | |
| #endif /* THREADS_NO_SHARING || THREADS_SUBGOAL_SHARING */
 | |
| 
 | |
|   while (hash) {
 | |
|     ans_node_ptr chain_node, *bucket, *last_bucket;
 | |
|     ans_hash_ptr next_hash;
 | |
| 
 | |
|     bucket = Hash_buckets(hash);
 | |
|     last_bucket = bucket + Hash_num_buckets(hash);
 | |
|     while (!*bucket)
 | |
|       bucket++;
 | |
|     chain_node = *bucket;
 | |
|     TrNode_child((ans_node_ptr)UNTAG_ANSWER_NODE(TrNode_parent(chain_node))) =
 | |
|         chain_node;
 | |
|     while (++bucket != last_bucket) {
 | |
|       if (*bucket) {
 | |
|         while (TrNode_next(chain_node))
 | |
|           chain_node = TrNode_next(chain_node);
 | |
|         TrNode_next(chain_node) = *bucket;
 | |
|         chain_node = *bucket;
 | |
|       }
 | |
|     }
 | |
|     next_hash = Hash_next(hash);
 | |
|     FREE_BUCKETS(Hash_buckets(hash));
 | |
|     FREE_ANSWER_TRIE_HASH(hash);
 | |
|     hash = next_hash;
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| /*****************************************************************************************
 | |
| ** all threads abolish their local data structures, and the main thread also
 | |
| *abolishes  **
 | |
| ** all shared data structures, if no other thread is running (GLOBAL_NOfThreads
 | |
| *== 1).  **
 | |
| *****************************************************************************************/
 | |
| void abolish_table(tab_ent_ptr tab_ent) {
 | |
|   CACHE_REGS
 | |
|   sg_node_ptr sg_node;
 | |
| 
 | |
| #ifdef THREADS
 | |
|   if (GLOBAL_NOfThreads == 1) {
 | |
|     ATTACH_PAGES(_pages_tab_ent);
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
|     ATTACH_PAGES(_pages_sg_ent);
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|     ATTACH_PAGES(_pages_sg_fr);
 | |
|     ATTACH_PAGES(_pages_dep_fr);
 | |
|     ATTACH_PAGES(_pages_sg_node);
 | |
|     ATTACH_PAGES(_pages_sg_hash);
 | |
|     ATTACH_PAGES(_pages_ans_node);
 | |
|     ATTACH_PAGES(_pages_ans_hash);
 | |
| #if defined(THREADS_FULL_SHARING)
 | |
|     ATTACH_PAGES(_pages_ans_ref_node);
 | |
| #endif /* THREADS_FULL_SHARING */
 | |
|     ATTACH_PAGES(_pages_gt_node);
 | |
|     ATTACH_PAGES(_pages_gt_hash);
 | |
|   }
 | |
| #endif /* THREADS */
 | |
|   sg_node = get_subgoal_trie_for_abolish(tab_ent PASS_REGS);
 | |
|   if (sg_node) {
 | |
|     if (TrNode_child(sg_node)) {
 | |
|       if (TabEnt_arity(tab_ent)) {
 | |
|         free_subgoal_trie(TrNode_child(sg_node), TRAVERSE_MODE_NORMAL,
 | |
|                           TRAVERSE_POSITION_FIRST);
 | |
|       } else {
 | |
|         sg_fr_ptr sg_fr = get_subgoal_frame_for_abolish(sg_node PASS_REGS);
 | |
|         if (sg_fr) {
 | |
|           IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
 | |
|             FREE_ANSWER_TRIE_NODE(SgFr_answer_trie(sg_fr));
 | |
| #if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
 | |
|             FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr));
 | |
| #endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
 | |
|           }
 | |
| #ifdef LIMIT_TABLING
 | |
|           remove_from_global_sg_fr_list(sg_fr);
 | |
| #endif /* LIMIT_TABLING */
 | |
|           FREE_SUBGOAL_FRAME(sg_fr);
 | |
|         }
 | |
|       }
 | |
|       IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES
 | |
|       TrNode_child(sg_node) = NULL;
 | |
|     }
 | |
| #ifdef THREADS_NO_SHARING
 | |
|     FREE_SUBGOAL_TRIE_NODE(sg_node);
 | |
| #endif /* THREADS_NO_SHARING */
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| void showTable(tab_ent_ptr tab_ent, int show_mode, FILE *out) {
 | |
|   CACHE_REGS
 | |
|   sg_node_ptr sg_node;
 | |
| 
 | |
|   TrStat_out = out;
 | |
|   TrStat_show = show_mode;
 | |
|   TrStat_subgoals = 0;
 | |
|   TrStat_sg_incomplete = 0;
 | |
|   TrStat_sg_nodes = 1;
 | |
|   TrStat_answers = 0;
 | |
|   TrStat_answers_true = 0;
 | |
|   TrStat_answers_no = 0;
 | |
| #ifdef TABLING_INNER_CUTS
 | |
|   TrStat_answers_pruned = 0;
 | |
| #endif /* TABLING_INNER_CUTS */
 | |
|   TrStat_ans_nodes = 0;
 | |
|   TrStat_gt_refs = 0;
 | |
|   if (show_mode == SHOW_MODE_STATISTICS)
 | |
|     fprintf(TrStat_out, "Table statistics for predicate '%s",
 | |
|             AtomName(TabEnt_atom(tab_ent)));
 | |
|   else /* SHOW_MODE_STRUCTURE */
 | |
|     fprintf(TrStat_out, "Table structure for predicate '%s",
 | |
|             AtomName(TabEnt_atom(tab_ent)));
 | |
| #ifdef MODE_DIRECTED_TABLING
 | |
|   if (TabEnt_mode_directed(tab_ent)) {
 | |
|     int i, *mode_directed = TabEnt_mode_directed(tab_ent);
 | |
|     fprintf(TrStat_out, "(");
 | |
|     for (i = 0; i < TabEnt_arity(tab_ent); i++) {
 | |
|       int mode = MODE_DIRECTED_GET_MODE(mode_directed[i]);
 | |
|       if (mode == MODE_DIRECTED_INDEX) {
 | |
|         fprintf(TrStat_out, "index");
 | |
|       } else if (mode == MODE_DIRECTED_MIN) {
 | |
|         fprintf(TrStat_out, "min");
 | |
|       } else if (mode == MODE_DIRECTED_MAX) {
 | |
|         fprintf(TrStat_out, "max");
 | |
|       } else if (mode == MODE_DIRECTED_ALL) {
 | |
|         fprintf(TrStat_out, "all");
 | |
|       } else if (mode == MODE_DIRECTED_SUM) {
 | |
|         fprintf(TrStat_out, "sum");
 | |
|       } else if (mode == MODE_DIRECTED_LAST) {
 | |
|         fprintf(TrStat_out, "last");
 | |
|       } else if (mode == MODE_DIRECTED_FIRST) {
 | |
|         fprintf(TrStat_out, "first");
 | |
|       } else
 | |
|         Yap_Error(SYSTEM_ERROR_INTERNAL, TermNil, "show_table: unknown mode");
 | |
|       if (i != MODE_DIRECTED_GET_ARG(mode_directed[i]))
 | |
|         fprintf(TrStat_out, "(ARG%d)",
 | |
|                 MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1);
 | |
|       if (i + 1 != TabEnt_arity(tab_ent))
 | |
|         fprintf(TrStat_out, ",");
 | |
|     }
 | |
|     fprintf(TrStat_out, ")'\n");
 | |
|   } else
 | |
| #endif /* MODE_DIRECTED_TABLING */
 | |
|     fprintf(TrStat_out, "/%d'\n", TabEnt_arity(tab_ent));
 | |
|   sg_node = get_subgoal_trie(tab_ent);
 | |
|   if (sg_node) {
 | |
|     if (TrNode_child(sg_node)) {
 | |
|       if (TabEnt_arity(tab_ent)) {
 | |
|         char *str = (char *)malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
 | |
|         int *arity = (int *)malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
 | |
|         arity[0] = 1;
 | |
|         arity[1] = TabEnt_arity(tab_ent);
 | |
|         int str_index =
 | |
|             sprintf(str, "  ?- %s(", AtomName(TabEnt_atom(tab_ent)));
 | |
|         traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity,
 | |
|                               TRAVERSE_MODE_NORMAL,
 | |
|                               TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|         free(str);
 | |
|         free(arity);
 | |
|       } else {
 | |
|         sg_fr_ptr sg_fr = get_subgoal_frame(sg_node);
 | |
|         if (sg_fr) {
 | |
|           TrStat_subgoals++;
 | |
|           SHOW_TABLE_STRUCTURE("  ?- %s.\n", AtomName(TabEnt_atom(tab_ent)));
 | |
|           TrStat_ans_nodes++;
 | |
|           if (SgFr_first_answer(sg_fr) == NULL) {
 | |
|             if (SgFr_state(sg_fr) < complete) {
 | |
|               TrStat_sg_incomplete++;
 | |
|               SHOW_TABLE_STRUCTURE("    ---> INCOMPLETE\n");
 | |
|             } else {
 | |
|               TrStat_answers_no++;
 | |
|               SHOW_TABLE_STRUCTURE("    NO\n");
 | |
|             }
 | |
|           } else { /* SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr) */
 | |
|             TrStat_answers_true++;
 | |
|             SHOW_TABLE_STRUCTURE("    TRUE\n");
 | |
|           }
 | |
|         }
 | |
|       }
 | |
|     }
 | |
|   }
 | |
|   if (TrStat_subgoals == 0)
 | |
|     SHOW_TABLE_STRUCTURE("  EMPTY\n");
 | |
|   if (show_mode == SHOW_MODE_STATISTICS) {
 | |
|     fprintf(TrStat_out, "  Subgoal trie structure\n");
 | |
|     fprintf(TrStat_out, "    Subgoals: %ld (%ld incomplete)\n", TrStat_subgoals,
 | |
|             TrStat_sg_incomplete);
 | |
|     fprintf(TrStat_out, "    Subgoal trie nodes: %ld\n", TrStat_sg_nodes);
 | |
|     fprintf(TrStat_out, "  Answer trie structure(s)\n");
 | |
| #ifdef TABLING_INNER_CUTS
 | |
|     fprintf(TrStat_out, "    Answers: %ld (%ld pruned)\n", TrStat_answers,
 | |
|             TrStat_answers_pruned);
 | |
| #else
 | |
|     fprintf(TrStat_out, "    Answers: %ld\n", TrStat_answers);
 | |
| #endif /* TABLING_INNER_CUTS */
 | |
|     fprintf(TrStat_out, "    Answers 'TRUE': %ld\n", TrStat_answers_true);
 | |
|     fprintf(TrStat_out, "    Answers 'NO': %ld\n", TrStat_answers_no);
 | |
|     fprintf(TrStat_out, "    Answer trie nodes: %ld\n", TrStat_ans_nodes);
 | |
|     fprintf(TrStat_out, "  Global trie references: %ld\n", TrStat_gt_refs);
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| 
 | |
| void showGlobalTrie(int show_mode, FILE *out) {
 | |
|   CACHE_REGS
 | |
| 
 | |
|   TrStat_out = out;
 | |
|   TrStat_show = show_mode;
 | |
|   TrStat_gt_terms = 0;
 | |
|   TrStat_gt_nodes = 1;
 | |
|   TrStat_gt_refs = 0;
 | |
|   if (show_mode == SHOW_MODE_STATISTICS)
 | |
|     fprintf(TrStat_out, "Global trie statistics\n");
 | |
|   else /* SHOW_MODE_STRUCTURE */
 | |
|     fprintf(TrStat_out, "Global trie structure\n");
 | |
|   if (TrNode_child(GLOBAL_root_gt)) {
 | |
|     char *str = (char *)malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
 | |
|     int *arity = (int *)malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
 | |
|     arity[0] = 0;
 | |
|     traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity,
 | |
|                          TRAVERSE_MODE_NORMAL,
 | |
|                          TRAVERSE_POSITION_FIRST PASS_REGS);
 | |
|     free(str);
 | |
|     free(arity);
 | |
|   } else
 | |
|     SHOW_TABLE_STRUCTURE("  EMPTY\n");
 | |
|   if (show_mode == SHOW_MODE_STATISTICS) {
 | |
|     fprintf(TrStat_out, "  Terms: %ld\n", TrStat_gt_terms);
 | |
|     fprintf(TrStat_out, "  Global trie nodes: %ld\n", TrStat_gt_nodes);
 | |
|     fprintf(TrStat_out, "  Global trie auto references: %ld\n", TrStat_gt_refs);
 | |
|   }
 | |
|   return;
 | |
| }
 | |
| #endif /* TABLING */
 |