/* ------------------ ** ** Includes ** ** ------------------ */ #include "Yap.h" #ifdef TABLING #include #ifdef HAVE_STRING_H #include #endif #include "Yatom.h" #include "Heap.h" #include "tab.macros.h" /* ------------------------------------- ** ** Local functions declaration ** ** ------------------------------------- */ static void free_answer_trie_branch(ans_node_ptr node); #ifdef YAPOR #ifdef TABLING_INNER_CUTS static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr node); #else static int update_answer_trie_branch(ans_node_ptr node); #endif /* TABLING_INNER_CUTS */ #else static void update_answer_trie_branch(ans_node_ptr node); #endif /* YAPOR */ /* ----------------------- ** ** Local inlines ** ** ----------------------- */ STD_PROTO(static inline sg_node_ptr subgoal_trie_node_check_insert, (tab_ent_ptr, sg_node_ptr, Term)); STD_PROTO(static inline ans_node_ptr answer_trie_node_check_insert, (sg_fr_ptr, ans_node_ptr, Term, int)); #ifdef TABLE_LOCK_AT_WRITE_LEVEL static inline sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { sg_node_ptr chain_node, new_node; chain_node = TrNode_child(parent_node); if (chain_node == NULL) { #ifdef ALLOC_BEFORE_CHECK new_subgoal_trie_node(new_node, t, NULL, parent_node, NULL); #endif /* ALLOC_BEFORE_CHECK */ LOCK_TABLE(parent_node); if (TrNode_child(parent_node)) { chain_node = TrNode_child(parent_node); if (IS_SUBGOAL_HASH(chain_node)) { #ifdef ALLOC_BEFORE_CHECK FREE_SUBGOAL_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); goto subgoal_hash; } do { if (TrNode_entry(chain_node) == t) { #ifdef ALLOC_BEFORE_CHECK FREE_SUBGOAL_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); return chain_node; } chain_node = TrNode_next(chain_node); } while (chain_node); #ifdef ALLOC_BEFORE_CHECK TrNode_next(new_node) = TrNode_child(parent_node); #else new_subgoal_trie_node(new_node, t, NULL, parent_node, TrNode_child(parent_node)); } else { new_subgoal_trie_node(new_node, t, NULL, parent_node, NULL); #endif /* ALLOC_BEFORE_CHECK */ } TrNode_child(parent_node) = new_node; UNLOCK_TABLE(parent_node); return new_node; } if (! IS_SUBGOAL_HASH(chain_node)) { sg_node_ptr first_node; int count_nodes; first_node = chain_node; count_nodes = 0; do { if (TrNode_entry(chain_node) == t) { return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node); #ifdef ALLOC_BEFORE_CHECK new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ LOCK_TABLE(parent_node); if (first_node != TrNode_child(parent_node)) { chain_node = TrNode_child(parent_node); if (IS_SUBGOAL_HASH(chain_node)) { #ifdef ALLOC_BEFORE_CHECK FREE_SUBGOAL_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); goto subgoal_hash; } do { if (TrNode_entry(chain_node) == t) { #ifdef ALLOC_BEFORE_CHECK FREE_SUBGOAL_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node != first_node); #ifdef ALLOC_BEFORE_CHECK TrNode_next(new_node) = TrNode_child(parent_node); #else new_subgoal_trie_node(new_node, t, NULL, parent_node, TrNode_child(parent_node)); } else { new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ } if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { /* alloc a new hash */ sg_hash_ptr hash; sg_node_ptr next_node, *bucket; new_subgoal_hash(hash, count_nodes, tab_ent); chain_node = new_node; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); TrNode_child(parent_node) = (sg_node_ptr) hash; } else { TrNode_child(parent_node) = new_node; } UNLOCK_TABLE(parent_node); return new_node; } subgoal_hash: { /* trie nodes with hashing */ sg_hash_ptr hash; sg_node_ptr *bucket, first_node; int seed, count_nodes; hash = (sg_hash_ptr) chain_node; seed = Hash_seed(hash); bucket = Hash_bucket(hash, HASH_TERM(t, seed)); first_node = chain_node = *bucket; count_nodes = 0; while (chain_node) { if (TrNode_entry(chain_node) == t) { return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node); #ifdef ALLOC_BEFORE_CHECK new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ LOCK_TABLE(parent_node); if (seed != Hash_seed(hash)) { /* the hash has been expanded */ #ifdef ALLOC_BEFORE_CHECK FREE_SUBGOAL_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); goto subgoal_hash; } if (first_node != *bucket) { chain_node = *bucket; do { if (TrNode_entry(chain_node) == t) { #ifdef ALLOC_BEFORE_CHECK FREE_SUBGOAL_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node != first_node); #ifdef ALLOC_BEFORE_CHECK TrNode_next(new_node) = *bucket; #else new_subgoal_trie_node(new_node, t, NULL, parent_node, *bucket); } else { new_subgoal_trie_node(new_node, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ } *bucket = new_node; Hash_num_nodes(hash)++; if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { /* expand current hash */ sg_node_ptr next_node, *old_bucket, *last_old_bucket; old_bucket = Hash_buckets(hash); last_old_bucket = old_bucket + Hash_num_buckets(hash); Hash_num_buckets(hash) *= 2; ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); seed = Hash_num_buckets(hash) - 1; do { if (*old_bucket) { chain_node = *old_bucket; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); } } while (++old_bucket != last_old_bucket); FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2); } UNLOCK_TABLE(parent_node); return new_node; } } static inline ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { ans_node_ptr chain_node, new_node; #ifdef TABLING_ERRORS if (IS_ANSWER_LEAF_NODE(parent_node)) TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_node_check_insert)"); #endif /* TABLING_ERRORS */ chain_node = TrNode_child(parent_node); if (chain_node == NULL) { #ifdef ALLOC_BEFORE_CHECK new_answer_trie_node(new_node, instr, t, NULL, parent_node, NULL); #endif /* ALLOC_BEFORE_CHECK */ LOCK_TABLE(parent_node); if (TrNode_child(parent_node)) { chain_node = TrNode_child(parent_node); if (IS_ANSWER_HASH(chain_node)) { #ifdef ALLOC_BEFORE_CHECK FREE_ANSWER_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); goto answer_hash; } do { if (TrNode_entry(chain_node) == t) { #ifdef ALLOC_BEFORE_CHECK FREE_ANSWER_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); return chain_node; } chain_node = TrNode_next(chain_node); } while (chain_node); #ifdef ALLOC_BEFORE_CHECK TrNode_next(new_node) = TrNode_child(parent_node); #else new_answer_trie_node(new_node, instr, t, NULL, parent_node, TrNode_child(parent_node)); } else { new_answer_trie_node(new_node, instr, t, NULL, parent_node, NULL); #endif /* ALLOC_BEFORE_CHECK */ } TrNode_child(parent_node) = new_node; UNLOCK_TABLE(parent_node); return new_node; } if (! IS_ANSWER_HASH(chain_node)) { ans_node_ptr first_node; int count_nodes; first_node = chain_node; count_nodes = 0; do { if (TrNode_entry(chain_node) == t) { return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node); #ifdef ALLOC_BEFORE_CHECK new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ LOCK_TABLE(parent_node); if (first_node != TrNode_child(parent_node)) { chain_node = TrNode_child(parent_node); if (IS_ANSWER_HASH(chain_node)) { #ifdef ALLOC_BEFORE_CHECK FREE_ANSWER_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); goto answer_hash; } do { if (TrNode_entry(chain_node) == t) { #ifdef ALLOC_BEFORE_CHECK FREE_ANSWER_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node != first_node); #ifdef ALLOC_BEFORE_CHECK TrNode_next(new_node) = TrNode_child(parent_node); #else new_answer_trie_node(new_node, instr, t, NULL, parent_node, TrNode_child(parent_node)); } else { new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ } if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { /* alloc a new hash */ ans_hash_ptr hash; ans_node_ptr next_node, *bucket; new_answer_hash(hash, count_nodes, sg_fr); chain_node = new_node; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); TrNode_child(parent_node) = (ans_node_ptr) hash; } else { TrNode_child(parent_node) = new_node; } UNLOCK_TABLE(parent_node); return new_node; } answer_hash: { /* trie nodes with hashing */ ans_hash_ptr hash; ans_node_ptr *bucket, first_node; int seed, count_nodes; hash = (ans_hash_ptr) chain_node; seed = Hash_seed(hash); bucket = Hash_bucket(hash, HASH_TERM(t, seed)); first_node = chain_node = *bucket; count_nodes = 0; while (chain_node) { if (TrNode_entry(chain_node) == t) { return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node); #ifdef ALLOC_BEFORE_CHECK new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ LOCK_TABLE(parent_node); if (seed != Hash_seed(hash)) { /* the hash has been expanded */ #ifdef ALLOC_BEFORE_CHECK FREE_ANSWER_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); goto answer_hash; } if (first_node != *bucket) { chain_node = *bucket; do { if (TrNode_entry(chain_node) == t) { #ifdef ALLOC_BEFORE_CHECK FREE_ANSWER_TRIE_NODE(new_node); #endif /* ALLOC_BEFORE_CHECK */ UNLOCK_TABLE(parent_node); return chain_node; } count_nodes++; chain_node = TrNode_next(chain_node); } while (chain_node != first_node); #ifdef ALLOC_BEFORE_CHECK TrNode_next(new_node) = *bucket; #else new_answer_trie_node(new_node, instr, t, NULL, parent_node, *bucket); } else { new_answer_trie_node(new_node, instr, t, NULL, parent_node, first_node); #endif /* ALLOC_BEFORE_CHECK */ } *bucket = new_node; Hash_num_nodes(hash)++; if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { /* expand current hash */ ans_node_ptr next_node, *old_bucket, *last_old_bucket; old_bucket = Hash_buckets(hash); last_old_bucket = old_bucket + Hash_num_buckets(hash); Hash_num_buckets(hash) *= 2; ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); seed = Hash_num_buckets(hash) - 1; do { if (*old_bucket) { chain_node = *old_bucket; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); } } while (++old_bucket != last_old_bucket); FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2); } UNLOCK_TABLE(parent_node); return new_node; } } #else /* TABLE_LOCK_AT_ENTRY_LEVEL || TABLE_LOCK_AT_NODE_LEVEL || ! YAPOR */ #ifdef TABLE_LOCK_AT_NODE_LEVEL #define LOCK_NODE(NODE) LOCK(TrNode_lock(NODE)) #define UNLOCK_NODE(NODE) UNLOCK(TrNode_lock(NODE)) #else #define LOCK_NODE(NODE) #define UNLOCK_NODE(NODE) #endif /* TABLE_LOCK_AT_NODE_LEVEL */ static inline sg_node_ptr subgoal_trie_node_check_insert(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) { sg_node_ptr child_node; LOCK_NODE(parent_node); child_node = TrNode_child(parent_node); if (child_node == NULL) { new_subgoal_trie_node(child_node, t, NULL, parent_node, NULL); TrNode_child(parent_node) = child_node; UNLOCK_NODE(parent_node); return child_node; } if (! IS_SUBGOAL_HASH(child_node)) { int count_nodes; count_nodes = 0; do { if (TrNode_entry(child_node) == t) { UNLOCK_NODE(parent_node); return child_node; } count_nodes++; child_node = TrNode_next(child_node); } while (child_node); new_subgoal_trie_node(child_node, t, NULL, parent_node, TrNode_child(parent_node)); if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { /* alloc a new hash */ sg_hash_ptr hash; sg_node_ptr chain_node, next_node, *bucket; new_subgoal_hash(hash, count_nodes, tab_ent); chain_node = child_node; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); TrNode_child(parent_node) = (sg_node_ptr) hash; } else { TrNode_child(parent_node) = child_node; } UNLOCK_NODE(parent_node); return child_node; } { /* trie nodes with hashing */ sg_hash_ptr hash; sg_node_ptr *bucket; int count_nodes; hash = (sg_hash_ptr) child_node; bucket = Hash_bucket(hash, HASH_TERM(t, Hash_seed(hash))); child_node = *bucket; count_nodes = 0; while (child_node) { if (TrNode_entry(child_node) == t) { UNLOCK_NODE(parent_node); return child_node; } count_nodes++; child_node = TrNode_next(child_node); } while (child_node); Hash_num_nodes(hash)++; new_subgoal_trie_node(child_node, t, NULL, parent_node, *bucket); *bucket = child_node; if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { /* expand current hash */ sg_node_ptr chain_node, next_node, *old_bucket, *last_old_bucket; int seed; old_bucket = Hash_buckets(hash); last_old_bucket = old_bucket + Hash_num_buckets(hash); Hash_num_buckets(hash) *= 2; ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); seed = Hash_num_buckets(hash) - 1; do { if (*old_bucket) { chain_node = *old_bucket; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); } } while (++old_bucket != last_old_bucket); FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2); } UNLOCK_NODE(parent_node); return child_node; } } static inline ans_node_ptr answer_trie_node_check_insert(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) { ans_node_ptr child_node; #ifdef TABLING_ERRORS if (IS_ANSWER_LEAF_NODE(parent_node)) TABLING_ERROR_MESSAGE("IS_ANSWER_LEAF_NODE(parent_node) (answer_trie_node_check_insert)"); #endif /* TABLING_ERRORS */ LOCK_NODE(parent_node); child_node = TrNode_child(parent_node); if (child_node == NULL) { new_answer_trie_node(child_node, instr, t, NULL, parent_node, NULL); TrNode_child(parent_node) = child_node; UNLOCK_NODE(parent_node); return child_node; } if (! IS_ANSWER_HASH(child_node)) { int count_nodes; count_nodes = 0; do { if (TrNode_entry(child_node) == t) { UNLOCK_NODE(parent_node); return child_node; } count_nodes++; child_node = TrNode_next(child_node); } while (child_node); new_answer_trie_node(child_node, instr, t, NULL, parent_node, TrNode_child(parent_node)); if (count_nodes > MAX_NODES_PER_TRIE_LEVEL) { /* alloc a new hash */ ans_hash_ptr hash; ans_node_ptr chain_node, next_node, *bucket; new_answer_hash(hash, count_nodes, sg_fr); chain_node = child_node; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), BASE_HASH_BUCKETS - 1)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); TrNode_child(parent_node) = (ans_node_ptr) hash; } else { TrNode_child(parent_node) = child_node; } UNLOCK_NODE(parent_node); return child_node; } { /* trie nodes with hashing */ ans_hash_ptr hash; ans_node_ptr *bucket; int count_nodes; hash = (ans_hash_ptr) child_node; bucket = Hash_bucket(hash, HASH_TERM(t, Hash_seed(hash))); child_node = *bucket; count_nodes = 0; while (child_node) { if (TrNode_entry(child_node) == t) { UNLOCK_NODE(parent_node); return child_node; } count_nodes++; child_node = TrNode_next(child_node); } while (child_node); Hash_num_nodes(hash)++; new_answer_trie_node(child_node, instr, t, NULL, parent_node, *bucket); *bucket = child_node; if (count_nodes > MAX_NODES_PER_BUCKET && Hash_num_nodes(hash) > Hash_num_buckets(hash)) { /* expand current hash */ ans_node_ptr chain_node, next_node, *old_bucket, *last_old_bucket; int seed; old_bucket = Hash_buckets(hash); last_old_bucket = old_bucket + Hash_num_buckets(hash); Hash_num_buckets(hash) *= 2; ALLOC_HASH_BUCKETS(Hash_buckets(hash), Hash_num_buckets(hash)); seed = Hash_num_buckets(hash) - 1; do { if (*old_bucket) { chain_node = *old_bucket; do { bucket = Hash_bucket(hash, HASH_TERM(TrNode_entry(chain_node), seed)); next_node = TrNode_next(chain_node); TrNode_next(chain_node) = *bucket; *bucket = chain_node; chain_node = next_node; } while (chain_node); } } while (++old_bucket != last_old_bucket); FREE_HASH_BUCKETS(old_bucket - Hash_num_buckets(hash) / 2); } UNLOCK_NODE(parent_node); return child_node; } } #endif /* TABLE_LOCK_LEVEL */ /* -------------------------- ** ** Global functions ** ** -------------------------- */ sg_node_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) { int i, j, count_vars; CELL *stack_vars, *stack_terms_top, *stack_terms_base, *stack_terms; sg_node_ptr current_sg_node; count_vars = 0; stack_vars = *Yaddr; #ifdef YAPOR stack_terms_top = (CELL *)TrailTop; stack_terms_base = stack_terms = AuxSp; #else stack_terms_top = (CELL *)TR; stack_terms_base = stack_terms = (CELL *)TrailTop; #endif current_sg_node = TabEnt_subgoal_trie(tab_ent); for (i = 1; i <= arity; i++) { STACK_PUSH(XREGS[i], stack_terms, stack_terms_top, stack_terms_base); do { Term t = Deref(STACK_POP(stack_terms)); int tag = t & TabTagBits; switch (tag) { case TabVarTagBits: if (IsTableVarTerm(t)) { t = MakeTableVarTerm(VarIndexOfTerm(t)); current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t); } else { if (count_vars == MAX_TABLE_VARS) abort_optyap("MAX_TABLE_VARS exceeded in function subgoal_search"); FREE_STACK_PUSH(t, stack_vars); *((CELL *)t) = GLOBAL_table_var_enumerator(count_vars); t = MakeTableVarTerm(count_vars); count_vars++; current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t); } break; case TabAtomTagBits: case TabNumberTagBits: current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, t); break; case TabPairTagBits: current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, TabPairTagBits); STACK_PUSH(*(RepPair(t) + 1), stack_terms, stack_terms_top, stack_terms_base); STACK_PUSH(*(RepPair(t)), stack_terms, stack_terms_top, stack_terms_base); break; case TabApplTagBits: current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, TAGGEDA(TabApplTagBits, FunctorOfTerm(t))); for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--) STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base); break; default: abort_optyap("unknown type tag in function subgoal_search"); } } while (STACK_NOT_EMPTY(stack_terms, stack_terms_base)); } FREE_STACK_PUSH(count_vars, stack_vars); *Yaddr = stack_vars++; /* reset variables */ while (count_vars--) *((CELL *)*stack_vars) = STACK_POP(stack_vars); return current_sg_node; } ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) { int i, j, count_vars, subs_arity; CELL *stack_vars, *stack_terms_base, *stack_terms_top, *stack_terms; ans_node_ptr current_ans_node; count_vars = 0; subs_arity = *subs_ptr; stack_vars = AuxSp; #ifdef YAPOR stack_terms_top = (CELL *)TrailTop; stack_terms_base = stack_terms = stack_vars - MAX_TABLE_VARS; #else stack_terms_top = (CELL *)TR; stack_terms_base = stack_terms = (CELL *)TrailTop; #endif current_ans_node = SgFr_answer_trie(sg_fr); for (i = subs_arity; i >= 1; i--) { STACK_PUSH(*(subs_ptr + i), stack_terms, stack_terms_top, stack_terms_base); #ifdef TABLING_ERRORS if ((*stack_terms & TabTagBits) != TabVarTagBits) TABLING_ERROR_MESSAGE("*stack_terms & TabTagBits != TabVarTagBits (answer_search)"); #endif /* TABLING_ERRORS */ do { Term t = Deref(STACK_POP(stack_terms)); int tag = t & TabTagBits; switch (tag) { case TabVarTagBits: if (IsTableVarTerm(t)) { t = MakeTableVarTerm(VarIndexOfTerm(t)); current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_val); } else { if (count_vars == MAX_TABLE_VARS) abort_optyap("MAX_TABLE_VARS exceeded in function answer_search"); FREE_STACK_PUSH(t, stack_vars); *((CELL *)t) = GLOBAL_table_var_enumerator(count_vars); t = MakeTableVarTerm(count_vars); count_vars++; current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_var); } break; case TabAtomTagBits: case TabNumberTagBits: current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, t, _trie_retry_atom); break; case TabPairTagBits: current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, TabPairTagBits, _trie_retry_list); STACK_PUSH(*(RepPair(t) + 1), stack_terms, stack_terms_top, stack_terms_base); STACK_PUSH(*(RepPair(t)), stack_terms, stack_terms_top, stack_terms_base); break; case TabApplTagBits: current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, TAGGEDA(TabApplTagBits, FunctorOfTerm(t)), _trie_retry_struct); for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--) STACK_PUSH(*(RepAppl(t) + j), stack_terms, stack_terms_top, stack_terms_base); break; default: abort_optyap("unknown type tag in function answer_search"); } } while (STACK_NOT_EMPTY(stack_terms, stack_terms_base)); } /* reset variables */ while (count_vars--) *((CELL *)*stack_vars) = STACK_POP(stack_vars); return current_ans_node; } void load_answer_trie(ans_node_ptr ans_node, CELL *subs_ptr) { int subs_arity; subs_arity = *subs_ptr; if (subs_arity) { int i, n_vars = 0; CELL *stack_vars, *stack_terms, *stack_refs, *stack_refs_base, *stack_top; ans_node_ptr aux_parent_node; #ifdef YAPOR stack_top = (CELL *)TrailTop; stack_vars = stack_terms = AuxSp - MAX_TABLE_VARS; #else stack_top = (CELL *)TR; stack_vars = stack_terms = ((CELL *)TrailTop)-MAX_TABLE_VARS; #endif /* load the new answer from the answer trie to the stack_terms */ aux_parent_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(ans_node)); do { STACK_PUSH(TrNode_entry(ans_node), stack_terms, stack_top, stack_vars); ans_node = aux_parent_node; aux_parent_node = TrNode_parent(aux_parent_node); } while (aux_parent_node); stack_refs_base = stack_refs = stack_terms; #ifdef TABLING_ERRORS if (H < H_FZ) TABLING_ERROR_MESSAGE("H < H_FZ (load_answer_trie)"); #endif /* TABLING_ERRORS */ for (i = subs_arity; i >= 1; i--) { /* bind the substitution variables with the answer loaded in stack_terms */ CELL *subs_var = (CELL *) *(subs_ptr + i); Term t = STACK_POP(stack_terms); int tag = t & TabTagBits; #ifdef TABLING_ERRORS if ((CELL)subs_var != *subs_var) TABLING_ERROR_MESSAGE("subs_var != *subs_var (load_answer_trie)"); #endif /* TABLING_ERRORS */ switch (tag) { case TabVarTagBits: { int var_index = VarIndexOfTableTerm(t); if (var_index == n_vars) { stack_vars[n_vars++] = (CELL) subs_var; } else { Bind(subs_var, stack_vars[var_index]); } } break; case TabNumberTagBits: case TabAtomTagBits: Bind(subs_var, t); break; case TabPairTagBits: /* build a pair term as in function MkPairTerm */ Bind(subs_var, AbsPair(H)); #ifdef TABLING_ERRORS if ((*subs_var & TabTagBits) != TabPairTagBits) TABLING_ERROR_MESSAGE("*subs_var & TabTagBits != TabPairTagBits (load_answer_trie)"); #endif /* TABLING_ERRORS */ H += 2; STACK_PUSH(H - 1, stack_refs, stack_top, stack_refs_base); STACK_PUSH(H - 2, stack_refs, stack_top, stack_refs_base); break; case TabApplTagBits: { /* build a pair term as in function MkApplTerm */ Functor f = (Functor)NonTagPart(t); int j, f_arity = ArityOfFunctor(f); Bind(subs_var, AbsAppl(H)); #ifdef TABLING_ERRORS if ((*subs_var & TabTagBits) != TabApplTagBits) TABLING_ERROR_MESSAGE("*subs_var & TabTagBits != TabApplTagBits (load_answer_trie)"); #endif /* TABLING_ERRORS */ *H++ = (CELL) f; H += f_arity; for (j = 1; j <= f_arity; j++) STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base); } break; default: abort_optyap("unknown type tag in macro load_answer_trie"); } while (STACK_NOT_EMPTY(stack_refs, stack_refs_base)) { CELL *ref = (CELL *) STACK_POP(stack_refs); Term t = STACK_POP(stack_terms); int tag = t & TabTagBits; switch (tag) { case TabVarTagBits: { int var_index = VarIndexOfTableTerm(t); if (var_index == n_vars) { stack_vars[n_vars++] = (CELL) ref; } *ref = stack_vars[var_index]; } break; case TabNumberTagBits: case TabAtomTagBits: *ref = t; break; case TabPairTagBits: /* build a pair term as in function MkPairTerm */ *ref = AbsPair(H); #ifdef TABLING_ERRORS if ((*ref & TabTagBits) != TabPairTagBits) TABLING_ERROR_MESSAGE("*ref & TabTagBits != TabPairTagBits (load_answer_trie)"); #endif /* TABLING_ERRORS */ H += 2; STACK_PUSH(H - 1, stack_refs, stack_top, stack_refs_base); STACK_PUSH(H - 2, stack_refs, stack_top, stack_refs_base); break; case TabApplTagBits: { /* build a pair term as in function MkApplTerm */ Functor f = (Functor)NonTagPart(t); int j, f_arity = ArityOfFunctor(f); *ref = AbsAppl(H); #ifdef TABLING_ERRORS if ((*ref & TabTagBits) != TabApplTagBits) TABLING_ERROR_MESSAGE("*ref & TabTagBits != TabApplTagBits (load_answer_trie)"); #endif /* TABLING_ERRORS */ *H++ = (CELL) f; H += f_arity; for (j = 1; j <= f_arity; j++) STACK_PUSH(H - j, stack_refs, stack_top, stack_refs_base); } break; default: abort_optyap("unknown type tag in macro load_answer_trie"); } } } #ifdef TABLING_ERRORS if (stack_terms != AuxSp - MAX_TABLE_VARS) TABLING_ERROR_MESSAGE("stack_terms != AuxSp - MAX_TABLE_VARS (load_answer_trie)"); #endif /* TABLING_ERRORS */ } return; } void private_completion(sg_fr_ptr sg_fr) { /* complete subgoals */ mark_as_completed(LOCAL_top_sg_fr); while (LOCAL_top_sg_fr != sg_fr) { LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr); mark_as_completed(LOCAL_top_sg_fr); } LOCAL_top_sg_fr = SgFr_next(LOCAL_top_sg_fr); /* release dependency frames */ #ifdef TABLING_BATCHED_SCHEDULING while (YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) { #else /* TABLING_LOCAL_SCHEDULING */ while (EQUAL_OR_YOUNGER_CP(DepFr_cons_cp(LOCAL_top_dep_fr), B)) { #endif /* TABLING_SCHEDULING */ dep_fr_ptr dep_fr = DepFr_next(LOCAL_top_dep_fr); FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr); LOCAL_top_dep_fr = dep_fr; } /* adjust freeze registers */ adjust_freeze_registers(); return; } void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes) { int tag; Term t; if (TrNode_next(node)) free_subgoal_trie_branch(TrNode_next(node), missing_nodes); missing_nodes -= 1; t = TrNode_entry(node); tag = t & TabTagBits; switch (tag) { case TabVarTagBits: case TabNumberTagBits: case TabAtomTagBits: break; case TabPairTagBits: missing_nodes += 2; break; case TabApplTagBits: missing_nodes += ArityOfFunctor((Functor)NonTagPart(t)); break; default: abort_optyap("unknown type tag in function chain_subgoal_frames"); } if (missing_nodes) { free_subgoal_trie_branch(TrNode_child(node), missing_nodes); } else { sg_fr_ptr sg_fr; sg_fr = (sg_fr_ptr) TrNode_sg_fr(node); if (sg_fr) { free_answer_hash_chain(SgFr_hash_chain(sg_fr)); free_answer_trie(sg_fr); FREE_SUBGOAL_FRAME(sg_fr); } } FREE_SUBGOAL_TRIE_NODE(node); return; } void free_answer_trie(sg_fr_ptr sg_fr) { ans_node_ptr node; node = SgFr_answer_trie(sg_fr); if (TrNode_child(node)) free_answer_trie_branch(TrNode_child(node)); FREE_ANSWER_TRIE_NODE(node); return; } void update_answer_trie(sg_fr_ptr sg_fr) { ans_node_ptr node; node = TrNode_child(SgFr_answer_trie(sg_fr)); if (node) { TrNode_instr(node) -= 1; #ifdef TABLING_INNER_CUTS update_answer_trie_branch(NULL, node); #else update_answer_trie_branch(node); #endif /* TABLING_INNER_CUTS */ } SgFr_state(sg_fr) = executable; return; } #define SHOW_INFO(MESG, ARGS...) fprintf(stream, MESG, ##ARGS) /*#define SHOW_TRIE(MESG, ARGS...) fprintf(stream, MESG, ##ARGS)*/ #define SHOW_TRIE(MESG, ARGS...) int trie_subgoals; int trie_subgoals_abolished; int trie_answers; int trie_answers_pruned; void show_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom) { char str[1000]; int arity[100]; int str_index; trie_subgoals = 0; trie_subgoals_abolished = 0; trie_answers = 0; trie_answers_pruned = 0; str_index = sprintf(str, " ?- %s(", AtomName(pred_atom)); arity[0] = 1; arity[1] = pred_arity; SHOW_INFO("\n[ Trie structure for predicate '%s/%d' ]\n[\n", AtomName(pred_atom), pred_arity); if (show_subgoal_trie(stream, sg_node, str, str_index, arity)) { SHOW_INFO("\n Number of subgoals: %d", trie_subgoals); if (trie_subgoals_abolished) SHOW_INFO(" (%d abolished)", trie_subgoals_abolished); SHOW_INFO("\n Number of answers: %d", trie_answers); if (trie_answers_pruned) SHOW_INFO(" (+ %d pruned)", trie_answers_pruned); } SHOW_INFO("\n]\n\n"); return; } int show_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity) { int tag; Term t; int new_arity[100]; if (arity[0] == 0) { ans_node_ptr ans_node; str[str_index] = 0; trie_subgoals++; if (sg_node == NULL) { trie_subgoals_abolished++; SHOW_TRIE("%s.\n ABOLISHED\n", str); return TRUE; } if (! SgFr_state((sg_fr_ptr)sg_node)) { SHOW_INFO("%s. --> TRIE ERROR: subgoal not completed !!!\n", str); return FALSE; } SHOW_TRIE("%s.\n", str); ans_node = SgFr_answer_trie((sg_fr_ptr)sg_node); if (IS_ANSWER_LEAF_NODE(ans_node)) { SHOW_TRIE(" YES\n"); } else if (TrNode_child(ans_node) == NULL) { SHOW_TRIE(" NO\n"); } else { char answer_str[1000]; int answer_arity[1000]; answer_arity[0] = 0; if (! show_answer_trie(stream, TrNode_child(ans_node), answer_str, 0, answer_arity, 0)) return FALSE; } return TRUE; } if (sg_node == NULL) return TRUE; if (IS_SUBGOAL_HASH(sg_node)) { sg_node_ptr *bucket, *last_bucket; sg_hash_ptr hash; hash = (sg_hash_ptr) sg_node; bucket = Hash_buckets(hash); last_bucket = bucket + Hash_num_buckets(hash); do { if (*bucket) { sg_node = *bucket; memcpy(new_arity, arity, 100); if (! show_subgoal_trie(stream, sg_node, str, str_index, new_arity)) return FALSE; } } while (++bucket != last_bucket); return TRUE; } memcpy(new_arity, arity, 100); if (! show_subgoal_trie(stream, TrNode_next(sg_node), str, str_index, new_arity)) return FALSE; t = TrNode_entry(sg_node); tag = t & TabTagBits; switch (tag) { case TabVarTagBits: str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t)); 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 { arity[arity[0]]++; if (arity[arity[0]] == 0) { str_index += sprintf(& str[str_index], "]"); arity[0]--; } else { str_index += sprintf(& str[str_index], "|"); break; } } } break; case TabNumberTagBits: str_index += sprintf(& str[str_index], "%d", IntOfTerm(t)); 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 { arity[arity[0]]++; if (arity[arity[0]] == 0) { str[str_index] = 0; SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); return FALSE; } str_index += sprintf(& str[str_index], "|"); break; } } break; case TabAtomTagBits: if (arity[arity[0]] == -1) { if (strcmp("[]", AtomName(AtomOfTerm(t)))) { str[str_index] = 0; SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); return FALSE; } str[str_index - 1] = ']'; arity[0]--; } else { str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); } 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 { arity[arity[0]]++; if (arity[arity[0]] == 0) { str[str_index] = 0; SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); return FALSE; } str_index += sprintf(& str[str_index], "|"); break; } } break; case TabPairTagBits: if (arity[arity[0]] == -1) { str[str_index - 1] = ','; arity[arity[0]] = -2; } else { str_index += sprintf(& str[str_index], "["); arity[0]++; arity[arity[0]] = -2; } break; case TabApplTagBits: str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor((Functor)NonTagPart(t)))); arity[0]++; arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t)); break; default: abort_optyap("unknown type tag in function show_subgoal_trie"); } if (! show_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity)) return FALSE; return TRUE; } int show_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index) { int tag; Term t; int new_arity[100]; if (ans_node == NULL) return TRUE; memcpy(new_arity, arity, 100); if (! show_answer_trie(stream, TrNode_next(ans_node), str, str_index, new_arity, var_index)) return FALSE; if (arity[0] == 0) { str_index += sprintf(& str[str_index], " VAR%d: ", var_index); var_index++; } t = TrNode_entry(ans_node); tag = t & TabTagBits; switch (tag) { case TabVarTagBits: str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t)); 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 { arity[arity[0]]++; if (arity[arity[0]] == 0) { str_index += sprintf(& str[str_index], "]"); arity[0]--; } else { str_index += sprintf(& str[str_index], "|"); break; } } } break; case TabNumberTagBits: str_index += sprintf(& str[str_index], "%d", IntOfTerm(t)); 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 { arity[arity[0]]++; if (arity[arity[0]] == 0) { str[str_index] = 0; SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); return FALSE; } str_index += sprintf(& str[str_index], "|"); break; } } break; case TabAtomTagBits: if (arity[arity[0]] == -1) { if (strcmp("[]", AtomName(AtomOfTerm(t)))) { str[str_index] = 0; SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); return FALSE; } str[str_index - 1] = ']'; arity[0]--; } else { str_index += sprintf(& str[str_index], "%s", AtomName(AtomOfTerm(t))); } 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 { arity[arity[0]]++; if (arity[arity[0]] == 0) { str[str_index] = 0; SHOW_INFO("%s --> TRIE ERROR: pair without end atom '[]' !!!\n", str); return FALSE; } str_index += sprintf(& str[str_index], "|"); break; } } break; case TabPairTagBits: if (arity[arity[0]] == -1) { str[str_index - 1] = ','; arity[arity[0]] = -2; } else { str_index += sprintf(& str[str_index], "["); arity[0]++; arity[arity[0]] = -2; } break; case TabApplTagBits: str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor((Functor)NonTagPart(t)))); arity[0]++; arity[arity[0]] = ArityOfFunctor((Functor)NonTagPart(t)); break; default: abort_optyap("unknown type tag in function show_answer_trie"); } if (! IS_ANSWER_LEAF_NODE(ans_node)) { #ifdef TABLING_INNER_CUTS if (! TrNode_child(ans_node)) { trie_answers_pruned++; return TRUE; } #endif /* TABLING_INNER_CUTS */ if (! show_answer_trie(stream, TrNode_child(ans_node), str, str_index, arity, var_index)) return FALSE; } else { str[str_index] = 0; SHOW_TRIE("%s\n", str); trie_answers++; } return TRUE; } /* ------------------------- ** ** Local functions ** ** ------------------------- */ static void free_answer_trie_branch(ans_node_ptr node) { #ifdef TABLING_INNER_CUTS if (TrNode_child(node) && ! IS_ANSWER_LEAF_NODE(node)) #else if (! IS_ANSWER_LEAF_NODE(node)) #endif /* TABLING_INNER_CUTS */ free_answer_trie_branch(TrNode_child(node)); if (TrNode_next(node)) free_answer_trie_branch(TrNode_next(node)); FREE_ANSWER_TRIE_NODE(node); return; } #ifdef YAPOR #ifdef TABLING_INNER_CUTS static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr node) { int ltt; if (! IS_ANSWER_LEAF_NODE(node)) { if (TrNode_child(node)) { TrNode_instr(TrNode_child(node)) -= 1; /* retry --> try */ update_answer_trie_branch(NULL, TrNode_child(node)); if (TrNode_child(node)) goto update_next_trie_branch; } /* node belonging to a pruned answer */ if (previous_node) { TrNode_next(previous_node) = TrNode_next(node); FREE_ANSWER_TRIE_NODE(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(node)) = TrNode_next(node); if (TrNode_next(node)) { TrNode_instr(TrNode_next(node)) -= 1; /* retry --> try */ update_answer_trie_branch(NULL, TrNode_next(node)); } FREE_ANSWER_TRIE_NODE(node); return 0; } } update_next_trie_branch: if (TrNode_next(node)) { ltt = 1 + update_answer_trie_branch(node, TrNode_next(node)); } else { TrNode_instr(node) -= 2; /* retry --> trust : try --> do */ ltt = 1; } TrNode_or_arg(node) = ltt; TrNode_instr(node) = opcode(TrNode_instr(node)); return ltt; } #else static int update_answer_trie_branch(ans_node_ptr node) { int ltt; if (! IS_ANSWER_LEAF_NODE(node)) { TrNode_instr(TrNode_child(node)) -= 1; /* retry --> try */ update_answer_trie_branch(TrNode_child(node)); } if (TrNode_next(node)) { ltt = 1 + update_answer_trie_branch(TrNode_next(node)); } else { TrNode_instr(node) -= 2; /* retry --> trust : try --> do */ ltt = 1; } TrNode_or_arg(node) = ltt; TrNode_instr(node) = opcode(TrNode_instr(node)); return ltt; } #endif /* TABLING_INNER_CUTS */ #else /* TABLING */ static void update_answer_trie_branch(ans_node_ptr node) { if (! IS_ANSWER_LEAF_NODE(node)) { TrNode_instr(TrNode_child(node)) -= 1; /* retry --> try */ update_answer_trie_branch(TrNode_child(node)); } if (TrNode_next(node)) { update_answer_trie_branch(TrNode_next(node)); } else { TrNode_instr(node) -= 2; /* retry --> trust : try --> do */ } TrNode_instr(node) = opcode(TrNode_instr(node)); return; } #endif /* YAPOR */ #endif /* TABLING */