diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

float support for tabling

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1323 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc 2005-06-03 08:19:18 +00:00
parent f79365e0f6
commit 08eaaa570d
8 changed files with 874 additions and 616 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2005-06-01 20:25:23 $ *
* Last rev: $Date: 2005-06-03 08:18:25 $ *
* $Log: not supported by cvs2svn $
* Revision 1.28 2005/06/01 20:25:23 vsc
* == and \= should not need a choice-point in ->
*
* Revision 1.27 2005/06/01 14:02:52 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
@ -60,18 +63,25 @@
OPCODE(getwork_seq ,ld),
OPCODE(sync ,ld),
#endif /* YAPOR */
#ifdef TABLING_INNER_CUTS
OPCODE(clause_with_cut ,e),
#endif /* TABLING_INNER_CUTS */
#ifdef TABLING
OPCODE(table_try_me ,ld),
OPCODE(table_retry_me ,ld),
OPCODE(table_trust_me ,ld),
OPCODE(table_try_single ,ld),
OPCODE(table_try_me ,ld),
OPCODE(table_try ,ld),
OPCODE(table_retry_me ,ld),
OPCODE(table_retry ,ld),
OPCODE(table_trust_me ,ld),
OPCODE(table_trust ,ld),
OPCODE(table_new_answer ,s),
OPCODE(table_answer_resolution ,ld),
OPCODE(table_completion ,ld),
OPCODE(trie_do_nothing ,e),
OPCODE(trie_trust_nothing ,e),
OPCODE(trie_try_nothing ,e),
OPCODE(trie_retry_nothing ,e),
OPCODE(trie_do_var ,e),
OPCODE(trie_trust_var ,e),
OPCODE(trie_try_var ,e),
@ -92,10 +102,11 @@
OPCODE(trie_trust_struct ,e),
OPCODE(trie_try_struct ,e),
OPCODE(trie_retry_struct ,e),
OPCODE(trie_do_float ,e),
OPCODE(trie_trust_float ,e),
OPCODE(trie_try_float ,e),
OPCODE(trie_retry_float ,e),
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
OPCODE(clause_with_cut ,e),
#endif /* TABLING_INNER_CUTS */
OPCODE(try_me ,ld),
OPCODE(retry_me ,ld),
OPCODE(trust_me ,ld),

13
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2005-06-01 20:25:23 $,$Author: vsc $ *
* Last rev: $Date: 2005-06-03 08:18:25 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.5 2005/06/01 20:25:23 vsc
* == and \= should not need a choice-point in ->
*
* Revision 1.4 2005/06/01 14:02:52 vsc
* get_rid of try_me?, retry_me? and trust_me? instructions: they are not
* significantly used nowadays.
@ -211,6 +214,10 @@ restore_opcodes(yamop *pc)
case _getwork_first_time:
#endif
#ifdef TABLING
case _trie_do_nothing:
case _trie_trust_nothing:
case _trie_try_nothing:
case _trie_retry_nothing:
case _trie_do_var:
case _trie_trust_var:
case _trie_try_var:
@ -231,6 +238,10 @@ restore_opcodes(yamop *pc)
case _trie_trust_struct:
case _trie_try_struct:
case _trie_retry_struct:
case _trie_do_float:
case _trie_trust_float:
case _trie_try_float:
case _trie_retry_float:
#endif /* TABLING */
#ifdef TABLING_INNER_CUTS
case _clause_with_cut:

6
OPTYap/opt.preds.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.preds.c
version: $Id: opt.preds.c,v 1.15 2005-05-31 08:24:24 ricroc Exp $
version: $Id: opt.preds.c,v 1.16 2005-06-03 08:19:17 ricroc Exp $
**********************************************************************/
@ -593,7 +593,7 @@ int p_do_show_trie(void) {
} else {
return (FALSE);
}
traverse_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
traverse_trie(TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, TRUE);
return (TRUE);
}
@ -622,7 +622,7 @@ int p_do_show_trie_stats(void) {
} else {
return(FALSE);
}
traverse_trie(stdout, TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, FALSE);
traverse_trie(TrNode_child(TabEnt_subgoal_trie(pe->TableOfPred)), arity, at, FALSE);
return (TRUE);
}
#endif /* TABLING */

4
OPTYap/opt.proto.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.proto.h
version: $Id: opt.proto.h,v 1.7 2005-05-31 08:24:24 ricroc Exp $
version: $Id: opt.proto.h,v 1.8 2005-06-03 08:19:17 ricroc Exp $
**********************************************************************/
@ -71,7 +71,7 @@ void private_completion(sg_fr_ptr sg_fr);
void free_subgoal_trie_branch(sg_node_ptr node, int missing_nodes);
void free_answer_trie_branch(ans_node_ptr node);
void update_answer_trie(sg_fr_ptr sg_fr);
void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show);
void traverse_trie(sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show);
#endif /* TABLING */

33
OPTYap/tab.insts.i
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.insts.i
version: $Id: tab.insts.i,v 1.13 2005-05-31 08:24:24 ricroc Exp $
version: $Id: tab.insts.i,v 1.14 2005-06-03 08:19:18 ricroc Exp $
**********************************************************************/
@ -16,7 +16,9 @@
#ifdef TABLING_ERRORS
#define TABLING_ERRORS_check_stack \
if (Unsigned(H) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H + 1024 > B (check_stack)")
TABLING_ERROR_MESSAGE("H + 1024 > B (check_stack)"); \
if (Unsigned(H_FZ) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H_FZ + 1024 > B (check_stack)")
#else
#define TABLING_ERRORS_check_stack
#endif /* TABLING_ERRORS */
@ -365,6 +367,7 @@
ENDPBOp();
PBOp(table_try, ld)
tab_ent_ptr tab_ent;
sg_fr_ptr sg_fr;
@ -435,17 +438,6 @@
Op(table_retry, ld)
restore_generator_node(PREG->u.ld.s, NEXTOP(PREG,ld));
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment();
PREG = PREG->u.ld.d;
GONext();
ENDOp();
Op(table_retry_me, ld)
restore_generator_node(PREG->u.ld.s, PREG->u.ld.d);
YENV = (CELL *) PROTECT_FROZEN_B(B);
@ -458,6 +450,18 @@
Op(table_retry, ld)
restore_generator_node(PREG->u.ld.s, NEXTOP(PREG,ld));
YENV = (CELL *) PROTECT_FROZEN_B(B);
set_cut(YENV, B->cp_b);
SET_BB(NORM_CP(YENV));
allocate_environment();
PREG = PREG->u.ld.d;
GONext();
ENDOp();
Op(table_trust_me, ld)
restore_generator_node(PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B);
@ -468,6 +472,8 @@
GONext();
ENDOp();
Op(table_trust, ld)
restore_generator_node(PREG->u.ld.s, COMPLETION);
YENV = (CELL *) PROTECT_FROZEN_B(B);
@ -479,6 +485,7 @@
ENDOp();
PBOp(table_new_answer, s)
CELL *subs_ptr;
choiceptr gcp;

57
OPTYap/tab.macros.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.macros.h
version: $Id: tab.macros.h,v 1.12 2005-05-31 08:17:46 ricroc Exp $
version: $Id: tab.macros.h,v 1.13 2005-06-03 08:19:18 ricroc Exp $
**********************************************************************/
@ -76,46 +76,23 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define STACK_PUSH_DOWN(ITEM, STACK) *STACK++ = (CELL)(ITEM)
#define STACK_POP_UP(STACK) *--STACK
#ifdef YAPOR
#define STACK_CHECK_EXPAND1(STACK, STACK_LIMIT, STACK1) \
if (STACK_LIMIT >= STACK) { \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND1)")
#define STACK_CHECK_EXPAND3(STACK, STACK_LIMIT, STACK1, STACK2, STACK3) \
if (STACK_LIMIT >= STACK) { \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND3)")
#define STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) \
if (STACK_LIMIT >= STACK) { \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND)")
#else
#define STACK_CHECK_EXPAND1(STACK, STACK_LIMIT, STACK1) \
if (STACK_LIMIT >= STACK) { \
void *old_top; \
UInt diff; \
CELL *NEW_STACK; \
if (STACK_LIMIT > STACK) \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND1)"); \
INFORMATION_MESSAGE("Expanding trail in 64 Mbytes"); \
old_top = Yap_TrailTop; \
Yap_growtrail(64 * 1024L, TRUE); \
diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((void *)STACK + diff); \
memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \
STACK = NEW_STACK; \
STACK1 = (CELL *)((void *)STACK1 + diff); \
}
#define STACK_CHECK_EXPAND3(STACK, STACK_LIMIT, STACK1, STACK2, STACK3) \
if (STACK_LIMIT >= STACK) { \
void *old_top; \
UInt diff; \
CELL *NEW_STACK; \
if (STACK_LIMIT > STACK) \
Yap_Error(INTERNAL_ERROR, TermNil, "stack full (STACK_CHECK_EXPAND3)"); \
INFORMATION_MESSAGE("Expanding trail in 64 Mbytes"); \
old_top = Yap_TrailTop; \
Yap_growtrail(64 * 1024L, TRUE); \
diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((void *)STACK + diff); \
memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \
STACK = NEW_STACK; \
STACK1 = (CELL *)((void *)STACK1 + diff); \
STACK2 = (CELL *)((void *)STACK2 + diff); \
STACK3 = (CELL *)((void *)STACK3 + diff); \
#define STACK_CHECK_EXPAND(STACK, STACK_LIMIT, STACK_BASE) \
if (STACK_LIMIT >= STACK) { \
void *old_top; \
UInt diff; \
CELL *NEW_STACK; \
INFORMATION_MESSAGE("Expanding trail in 64 Mbytes"); \
old_top = Yap_TrailTop; \
Yap_growtrail(64 * 1024L, TRUE); \
diff = (void *)Yap_TrailTop - old_top; \
NEW_STACK = (CELL *)((void *)STACK + diff); \
memmove((void *)NEW_STACK, (void *)STACK, old_top - (void *)STACK); \
STACK = NEW_STACK; \
STACK_BASE = (CELL *)((void *)STACK_BASE + diff); \
}
#endif /* YAPOR */

783
OPTYap/tab.tries.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.tries.C
version: $Id: tab.tries.c,v 1.9 2005-05-31 08:17:46 ricroc Exp $
version: $Id: tab.tries.c,v 1.10 2005-06-03 08:19:18 ricroc Exp $
**********************************************************************/
@ -21,16 +21,25 @@
#endif
#include "Yatom.h"
#include "Heap.h"
#include "yapio.h"
#include "tab.macros.h"
/* ----------------- **
** Defines **
** ----------------- */
#define TRAVERSE_NORMAL 0
#define TRAVERSE_FLOAT_INIT 1
#define TRAVERSE_FLOAT 2
#define TRAVERSE_FLOAT_END 3
/* ------------------------------------- **
** Local functions declaration **
** ------------------------------------- */
static int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth);
static int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth);
#ifdef YAPOR
#ifdef TABLING_INNER_CUTS
static int update_answer_trie_branch(ans_node_ptr previous_node, ans_node_ptr node);
@ -40,6 +49,8 @@ static int update_answer_trie_branch(ans_node_ptr node);
#else
static void update_answer_trie_branch(ans_node_ptr node);
#endif /* YAPOR */
static int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth, int mode);
static int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth, int mode);
@ -667,7 +678,7 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
CELL *stack_vars, *stack_terms_limit, *stack_terms_base, *stack_terms;
sg_node_ptr current_sg_node;
sg_fr_ptr sg_fr;
count_vars = 0;
stack_vars = *Yaddr;
stack_terms_limit = (CELL *)TR;
@ -679,7 +690,7 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
#endif /* TABLE_LOCK_LEVEL */
for (i = 1; i <= arity; i++) {
STACK_PUSH_UP(XREGS[i], stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base);
do {
Term t = Deref(STACK_POP_DOWN(stack_terms));
if (IsVarTerm(t)) {
@ -700,14 +711,24 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
} else if (IsPairTerm(t)) {
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsPair(NULL));
STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t)), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base);
} else if (IsApplTerm(t)) {
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsAppl((Term *)FunctorOfTerm(t)));
for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--) {
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_terms_limit, stack_terms_base);
Functor f = FunctorOfTerm(t);
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, AbsAppl((Term *)f));
if (f == FunctorDouble) {
volatile Float dbl = FloatOfTerm(t);
volatile Term *t_dbl = (Term *)((void *) &dbl);
#if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, *(t_dbl + 1));
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
current_sg_node = subgoal_trie_node_check_insert(tab_ent, current_sg_node, *t_dbl);
} else {
for (j = ArityOfFunctor(f); j >= 1; j--) {
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
STACK_CHECK_EXPAND(stack_terms, stack_terms_limit, stack_terms_base);
}
}
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (subgoal_search)");
@ -759,7 +780,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
for (i = subs_arity; i >= 1; i--) {
STACK_PUSH_UP(*(subs_ptr + i), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
#ifdef TABLING_ERRORS
if (IsNonVarTerm(*stack_terms))
TABLING_ERROR_MESSAGE("IsNonVarTem(*stack_terms) (answer_search)");
@ -774,7 +795,7 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
if (count_vars == MAX_TABLE_VARS)
Yap_Error(INTERNAL_ERROR, TermNil, "MAX_TABLE_VARS exceeded (answer_search)");
STACK_PUSH_DOWN(t, stack_vars);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
*((CELL *)t) = GLOBAL_table_var_enumerator(count_vars);
t = MakeTableVarTerm(count_vars);
count_vars++;
@ -785,14 +806,26 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
} else if (IsPairTerm(t)) {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsPair(NULL), _trie_retry_list);
STACK_PUSH_UP(*(RepPair(t) + 1), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
STACK_PUSH_UP(*(RepPair(t)), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
} else if (IsApplTerm(t)) {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)FunctorOfTerm(t)), _trie_retry_struct);
for (j = ArityOfFunctor(FunctorOfTerm(t)); j >= 1; j--) {
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
Functor f = FunctorOfTerm(t);
if (f == FunctorDouble) {
volatile Float dbl = FloatOfTerm(t);
volatile Term *t_dbl = (Term *)((void *) &dbl);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_nothing);
#if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, *(t_dbl + 1), _trie_retry_nothing);
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, *t_dbl, _trie_retry_nothing);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_float);
} else {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_struct);
for (j = ArityOfFunctor(f); j >= 1; j--) {
STACK_PUSH_UP(*(RepAppl(t) + j), stack_terms);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
}
}
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (answer_search)");
@ -811,128 +844,83 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
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_base, *stack_vars, *stack_terms_base, *stack_terms, *stack_refs_base, *stack_refs;
ans_node_ptr aux_parent_node;
stack_vars_base = stack_vars = (CELL *)TR;
stack_terms_base = stack_terms = (CELL *)Yap_TrailTop;
CELL *stack_vars_base, *stack_vars, *stack_terms_base, *stack_terms;
int subs_arity, i, n_vars = MAX_TABLE_VARS;
Term t;
/* 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_UP(TrNode_entry(ans_node), stack_terms);
STACK_CHECK_EXPAND1(stack_terms, stack_vars, stack_terms_base);
ans_node = aux_parent_node;
aux_parent_node = TrNode_parent(aux_parent_node);
} while (aux_parent_node);
stack_refs_base = stack_refs = stack_terms;
if ((subs_arity = *subs_ptr) == 0)
return;
#ifdef TABLING_ERRORS
if (H < H_FZ)
TABLING_ERROR_MESSAGE("H < H_FZ (load_answer_trie)");
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_DOWN(stack_terms);
#ifdef TABLING_ERRORS
if ((CELL)subs_var != *subs_var)
TABLING_ERROR_MESSAGE("subs_var != *subs_var (load_answer_trie)");
#endif /* TABLING_ERRORS */
if (IsVarTerm(t)) {
int var_index = VarIndexOfTableTerm(t);
if (var_index == n_vars) {
n_vars++;
STACK_PUSH_DOWN(subs_var, stack_vars);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
} else {
Bind(subs_var, stack_vars_base[var_index]);
}
} else if (IsAtomOrIntTerm(t)) {
Bind(subs_var, t);
} else if (IsPairTerm(t)) {
/* build a pair term as in function MkPairTerm */
Bind(subs_var, AbsPair(H));
#ifdef TABLING_ERRORS
if (!IsPairTerm(*subs_var))
TABLING_ERROR_MESSAGE("IsNonPairTerm(*subs_var) (load_answer_trie)");
#endif /* TABLING_ERRORS */
H += 2;
STACK_PUSH_UP(H - 1, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
STACK_PUSH_UP(H - 2, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
} else if (IsApplTerm(t)) {
/* build a pair term as in function MkApplTerm */
Functor f = (Functor) RepAppl(t);
int j, f_arity = ArityOfFunctor(f);
Bind(subs_var, AbsAppl(H));
#ifdef TABLING_ERRORS
if (!IsApplTerm(*subs_var))
TABLING_ERROR_MESSAGE("IsNonApplTerm(*subs_var) (load_answer_trie)");
#endif /* TABLING_ERRORS */
*H++ = (CELL) f;
H += f_arity;
for (j = 1; j <= f_arity; j++) {
STACK_PUSH_UP(H - j, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
}
stack_vars_base = stack_vars = (CELL *)TR;
stack_terms_base = stack_terms = (CELL *)Yap_TrailTop;
t = TrNode_entry(ans_node);
ans_node = UNTAG_ANSWER_LEAF_NODE(TrNode_parent(ans_node));
do {
if (IsVarTerm(t)) {
int var_index = VarIndexOfTableTerm(t);
if (n_vars == MAX_TABLE_VARS) {
stack_vars += var_index;
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
}
if (var_index < n_vars) {
n_vars = var_index;
stack_vars_base[var_index] = MkVarTerm();
}
STACK_PUSH_UP(stack_vars_base[var_index], stack_terms);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
} else if (IsAtomOrIntTerm(t)) {
STACK_PUSH_UP(t, stack_terms);
STACK_CHECK_EXPAND(stack_terms, stack_vars, stack_terms_base);
} else if (IsPairTerm(t)) {
Term head = STACK_POP_DOWN(stack_terms);
Term tail = STACK_POP_DOWN(stack_terms);
t = MkPairTerm(head, tail);
STACK_PUSH_UP(t, stack_terms);
} else if (IsApplTerm(t)) {
Functor f = (Functor) RepAppl(t);
if (f == FunctorDouble) {
volatile Float dbl;
volatile Term *t_dbl = (Term *)((void *) &dbl);
t = TrNode_entry(ans_node);
ans_node = TrNode_parent(ans_node);
*t_dbl = t;
#if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT
t = TrNode_entry(ans_node);
ans_node = TrNode_parent(ans_node);
*(t_dbl + 1) = t;
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
ans_node = TrNode_parent(ans_node);
t = MkFloatTerm(dbl);
STACK_PUSH_UP(t, stack_terms);
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (load_answer_trie)");
}
while (STACK_NOT_EMPTY(stack_refs, stack_refs_base)) {
CELL *ref = (CELL *) STACK_POP_DOWN(stack_refs);
Term t = STACK_POP_DOWN(stack_terms);
if (IsVarTerm(t)) {
int var_index = VarIndexOfTableTerm(t);
if (var_index == n_vars) {
n_vars++;
STACK_PUSH_DOWN(ref, stack_vars);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
}
*ref = stack_vars_base[var_index];
} else if (IsAtomOrIntTerm(t)) {
*ref = t;
} else if (IsPairTerm(t)) {
/* build a pair term as in function MkPairTerm */
*ref = AbsPair(H);
#ifdef TABLING_ERRORS
if (!IsPairTerm(*ref))
TABLING_ERROR_MESSAGE("IsNonPairTerm(*ref) (load_answer_trie)");
#endif /* TABLING_ERRORS */
H += 2;
STACK_PUSH_UP(H - 1, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
STACK_PUSH_UP(H - 2, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
} else if (IsApplTerm(t)) {
/* build a pair term as in function MkApplTerm */
Functor f = (Functor) RepAppl(t);
int j, f_arity = ArityOfFunctor(f);
*ref = AbsAppl(H);
#ifdef TABLING_ERRORS
if (!IsApplTerm(*ref))
TABLING_ERROR_MESSAGE("IsNonApplTerm(*ref) (load_answer_trie)");
#endif /* TABLING_ERRORS */
*H++ = (CELL) f;
H += f_arity;
for (j = 1; j <= f_arity; j++) {
STACK_PUSH_UP(H - j, stack_refs);
STACK_CHECK_EXPAND3(stack_refs, stack_vars, stack_refs_base, stack_terms, stack_terms_base);
}
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (load_answer_trie)");
}
int f_arity = ArityOfFunctor(f);
t = Yap_MkApplTerm(f, f_arity, stack_terms);
stack_terms += f_arity;
STACK_PUSH_UP(t, stack_terms);
}
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (load_answer_trie)");
}
#ifdef TABLING_ERRORS
if (stack_terms != (CELL *)Yap_TrailTop)
TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_answer_trie)");
#endif /* TABLING_ERRORS */
t = TrNode_entry(ans_node);
ans_node = TrNode_parent(ans_node);
} while (ans_node);
for (i = subs_arity; i >= 1; i--) {
CELL *subs_var = (CELL *) *(subs_ptr + i);
t = STACK_POP_DOWN(stack_terms);
Bind(subs_var, t);
}
#ifdef TABLING_ERRORS
if (stack_terms != (CELL *)Yap_TrailTop)
TABLING_ERROR_MESSAGE("stack_terms != Yap_TrailTop (load_answer_trie)");
#endif /* TABLING_ERRORS */
return;
}
@ -1061,12 +1049,15 @@ static struct trie_statistics{
#define TrStat_ans_linear_nodes trie_stats.answer_linear_nodes
#define TrStat_ans_max_depth trie_stats.answer_trie_max_depth
#define TrStat_ans_min_depth trie_stats.answer_trie_min_depth
#define SHOW_INFO(MESG, ARGS...) fprintf(stream, MESG, ##ARGS)
#define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(stream, MESG, ##ARGS)
void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show) {
char str[1000];
int arity[100];
#define STR_ARRAY_SIZE 1000
#define ARITY_ARRAY_SIZE 100
#define SHOW_INFO(MESG, ARGS...) fprintf(Yap_stderr, MESG, ##ARGS)
#define SHOW_TRIE(MESG, ARGS...) if (TrStat_show) fprintf(Yap_stderr, MESG, ##ARGS)
void traverse_trie(sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show) {
char str[STR_ARRAY_SIZE];
int arity[ARITY_ARRAY_SIZE];
int str_index;
TrStat_show = show;
@ -1088,35 +1079,42 @@ void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_
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);
SHOW_INFO("\n[ Trie structure for predicate '%s/%d' ]\n", AtomName(pred_atom), pred_arity);
TrStat_sg_nodes++;
if (traverse_subgoal_trie(stream, sg_node, str, str_index, arity, 0)) {
SHOW_INFO("\n Subgoal Trie structure\n %ld subgoals", TrStat_subgoals);
if (TrStat_sg_abolished)
SHOW_INFO(" including %ld abolished", TrStat_sg_abolished);
if (TrStat_sg_abolish_operations)
SHOW_INFO(" (%ld abolish operations executed)", TrStat_sg_abolish_operations);
SHOW_INFO("\n %ld nodes (%ld%c reuse)\n %.2f average depth (%d min - %d max)",
TrStat_sg_nodes,
TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes,
'%',
TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals,
TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth,
TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth);
SHOW_INFO("\n Answer Trie Structure\n %ld/%ld answers", TrStat_answers_yes, TrStat_answers);
if (TrStat_ans_pruned)
SHOW_INFO(" including %ld pruned", TrStat_ans_pruned);
if (TrStat_answers_no)
SHOW_INFO(" (%ld no answers)", TrStat_answers_no);
SHOW_INFO("\n %ld nodes (%ld%c reuse)\n %.2f average depth (%d min - %d max)",
TrStat_ans_nodes,
TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes,
'%',
TrStat_answers == 0 ? 0 : (float)TrStat_ans_linear_nodes / (float)TrStat_answers,
TrStat_ans_min_depth < 0 ? 0 : TrStat_ans_min_depth,
TrStat_ans_max_depth < 0 ? 0 : TrStat_ans_max_depth);
}
SHOW_INFO("\n]\n\n");
if (sg_node && ! traverse_subgoal_trie(sg_node, str, str_index, arity, 1, TRAVERSE_NORMAL))
return;
SHOW_INFO("\n Subgoal Trie structure\n %ld subgoals", TrStat_subgoals);
if (TrStat_sg_abolished)
SHOW_INFO(" including %ld abolished", TrStat_sg_abolished);
if (TrStat_sg_abolish_operations)
SHOW_INFO(" (%ld abolish operations executed)", TrStat_sg_abolish_operations);
SHOW_INFO("\n %ld nodes (%ld%c saving)\n %.2f average depth (%d min - %d max)",
TrStat_sg_nodes,
TrStat_sg_linear_nodes == 0 ? 0 : (TrStat_sg_linear_nodes - TrStat_sg_nodes + 1) * 100 / TrStat_sg_linear_nodes,
'%',
TrStat_subgoals == 0 ? 0 : (float)TrStat_sg_linear_nodes / (float)TrStat_subgoals,
TrStat_sg_min_depth < 0 ? 0 : TrStat_sg_min_depth,
TrStat_sg_max_depth < 0 ? 0 : TrStat_sg_max_depth);
SHOW_INFO("\n Answer Trie Structure\n ");
if (TrStat_answers_yes)
SHOW_INFO("%ld yes answers/", TrStat_answers_yes);
SHOW_INFO("%ld answers", TrStat_answers);
if (TrStat_ans_pruned)
SHOW_INFO(" including %ld pruned", TrStat_ans_pruned);
if (TrStat_answers_no)
SHOW_INFO(" (%ld no answers)", TrStat_answers_no);
SHOW_INFO("\n %ld nodes (%ld%c saving)\n %.2f average depth (%d min - %d max)",
TrStat_ans_nodes,
TrStat_ans_linear_nodes == 0 ? 0 : (TrStat_ans_linear_nodes - TrStat_ans_nodes + TrStat_subgoals) * 100 / TrStat_ans_linear_nodes,
'%',
TrStat_answers == 0 ? 0 : (float)TrStat_ans_linear_nodes / (float)TrStat_answers,
TrStat_ans_min_depth < 0 ? 0 : TrStat_ans_min_depth,
TrStat_ans_max_depth < 0 ? 0 : TrStat_ans_max_depth);
SHOW_INFO("\n Total Memory Used\n %ld bytes",
TrStat_sg_nodes * sizeof(struct subgoal_trie_node) +
TrStat_ans_nodes * sizeof(struct answer_trie_node) +
TrStat_subgoals * sizeof(struct subgoal_frame));
SHOW_INFO("\n\n");
return;
}
@ -1126,88 +1124,157 @@ void traverse_trie(FILE *stream, sg_node_ptr sg_node, int pred_arity, Atom pred_
** Local functions **
** ------------------------- */
#ifdef YAPOR
#ifdef TABLING_INNER_CUTS
static
int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth) {
Term t;
int new_arity[100];
if (arity[0] == 0) {
sg_fr_ptr sg_fr = (sg_fr_ptr)sg_node;
str[str_index] = 0;
TrStat_subgoals++;
TrStat_sg_abolish_operations += SgFr_abolish(sg_fr);
TrStat_sg_linear_nodes+= depth;
if (TrStat_sg_max_depth < 0) {
TrStat_sg_min_depth = TrStat_sg_max_depth = depth;
} else if (depth < TrStat_sg_min_depth) {
TrStat_sg_min_depth = depth;
} else if (depth > TrStat_sg_max_depth) {
TrStat_sg_max_depth = depth;
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;
}
if (SgFr_state(sg_fr) == start) {
TrStat_sg_abolished++;
SHOW_TRIE("%s.\n ABOLISHED\n", str);
return TRUE;
}
if (SgFr_state(sg_fr) == evaluating) {
SHOW_INFO("%s. --> TRIE ERROR: subgoal not completed !!!\n", str);
return FALSE;
}
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
SHOW_TRIE("%s.\n", str);
TrStat_ans_nodes++;
if (SgFr_first_answer(sg_fr) == NULL) {
SHOW_TRIE(" NO\n");
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers_no++;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
SHOW_TRIE(" YES\n");
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers_yes++;
TrStat_answers++;
/* 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 {
char answer_str[1000];
int answer_arity[1000];
answer_arity[0] = 0;
if (! traverse_answer_trie(stream, TrNode_child(SgFr_answer_trie(sg_fr)), answer_str, 0, answer_arity, 0, 1))
return FALSE;
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;
}
return TRUE;
}
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;
}
if (sg_node == NULL)
return TRUE;
TrNode_or_arg(node) = ltt;
TrNode_instr(node) = Yap_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) = Yap_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) = Yap_opcode(TrNode_instr(node));
return;
}
#endif /* YAPOR */
#endif /* TABLING */
static
int traverse_subgoal_trie(sg_node_ptr sg_node, char *str, int str_index, int *arity, int depth, int mode) {
int old_str_index, old_arity[ARITY_ARRAY_SIZE], old_mode;
Term t;
/* save the current state */
old_mode = mode;
old_str_index = str_index;
memcpy(old_arity, arity, sizeof(int) * (arity[0] + 1));
t = TrNode_entry(sg_node);
/* test if hashing */
if (IS_SUBGOAL_HASH(sg_node)) {
sg_node_ptr *bucket, *last_bucket;
sg_hash_ptr hash;
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 (! traverse_subgoal_trie(stream, sg_node, str, str_index, new_arity, depth))
if (! traverse_subgoal_trie(sg_node, str, str_index, arity, depth, mode))
return FALSE;
memcpy(arity, old_arity, sizeof(int) * (old_arity[0] + 1));
}
} while (++bucket != last_bucket);
return TRUE;
}
TrStat_sg_nodes++;
memcpy(new_arity, arity, 100);
if (! traverse_subgoal_trie(stream, TrNode_next(sg_node), str, str_index, new_arity, depth))
return FALSE;
t = TrNode_entry(sg_node);
if (IsVarTerm(t)) {
/* test the node type */
#if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT
if (mode == TRAVERSE_FLOAT_INIT) {
arity[0]++;
arity[arity[0]] = (int) t;
mode = TRAVERSE_FLOAT;
} else if (mode == TRAVERSE_FLOAT) {
volatile Float dbl;
volatile Term *t_dbl = (Term *)((void *) &dbl);
*t_dbl = t;
*(t_dbl + 1) = (Term) arity[arity[0]];
arity[0]--;
#else /* SIZEOF_DOUBLE == SIZEOF_LONG_INT */
if (mode == TRAVERSE_FLOAT_INIT) {
Float dbl = (Float) t;
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
str_index += sprintf(& str[str_index], "%.15g", dbl);
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;
}
}
mode = TRAVERSE_NORMAL;
} else if (IsVarTerm(t)) {
str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t));
while (arity[0]) {
if (arity[arity[0]] > 0) {
@ -1297,39 +1364,141 @@ int traverse_subgoal_trie(FILE *stream, sg_node_ptr sg_node, char *str, int str_
}
} else if (IsApplTerm(t)) {
Functor f = (Functor) RepAppl(t);
str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f)));
arity[0]++;
arity[arity[0]] = ArityOfFunctor(f);
if (f == FunctorDouble) {
mode = TRAVERSE_FLOAT_INIT;
} else {
str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f)));
arity[0]++;
arity[arity[0]] = ArityOfFunctor(f);
}
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (traverse_subgoal_trie)");
}
if (! traverse_subgoal_trie(stream, TrNode_child(sg_node), str, str_index, arity, depth + 1))
TrStat_sg_nodes++;
/* show answers ... */
if (arity[0] == 0) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrNode_child(sg_node);
str[str_index] = 0;
TrStat_subgoals++;
TrStat_sg_abolish_operations += SgFr_abolish(sg_fr);
TrStat_sg_linear_nodes+= depth;
if (TrStat_sg_max_depth < 0) {
TrStat_sg_min_depth = TrStat_sg_max_depth = depth;
} else if (depth < TrStat_sg_min_depth) {
TrStat_sg_min_depth = depth;
} else if (depth > TrStat_sg_max_depth) {
TrStat_sg_max_depth = depth;
}
if (SgFr_state(sg_fr) == start) {
TrStat_sg_abolished++;
SHOW_TRIE("%s.\n ABOLISHED\n", str);
}
if (SgFr_state(sg_fr) == evaluating) {
SHOW_INFO("%s. --> TRIE ERROR: subgoal not completed !!!\n", str);
return FALSE;
}
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
SHOW_TRIE("%s.\n", str);
TrStat_ans_nodes++;
if (SgFr_first_answer(sg_fr) == NULL) {
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers_no++;
SHOW_TRIE(" NO\n");
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
if (TrStat_ans_max_depth < 0)
TrStat_ans_max_depth = 0;
TrStat_ans_min_depth = 0;
TrStat_answers_yes++;
TrStat_answers++;
SHOW_TRIE(" YES\n");
} else {
char answer_str[STR_ARRAY_SIZE];
int answer_arity[ARITY_ARRAY_SIZE];
answer_arity[0] = 0;
if (! traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), answer_str, 0, answer_arity, 0, 1, TRAVERSE_NORMAL))
return FALSE;
}
}
/* ... or continue with child node */
else if (! traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, depth + 1, mode))
return FALSE;
/* continue with sibling node */
if (TrNode_next(sg_node))
if (! traverse_subgoal_trie(TrNode_next(sg_node), str, old_str_index, old_arity, depth, old_mode))
return FALSE;
return TRUE;
}
static
int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth) {
int traverse_answer_trie(ans_node_ptr ans_node, char *str, int str_index, int *arity, int var_index, int depth, int mode) {
int old_str_index, old_arity[ARITY_ARRAY_SIZE], old_var_index, old_mode;
Term t;
int new_arity[100];
if (ans_node == NULL)
return TRUE;
TrStat_ans_nodes++;
memcpy(new_arity, arity, 100);
if (! traverse_answer_trie(stream, TrNode_next(ans_node), str, str_index, new_arity, var_index, depth))
return FALSE;
/* save the current state */
old_mode = mode;
old_var_index = var_index;
old_str_index = str_index;
memcpy(old_arity, arity, sizeof(int) * (arity[0] + 1));
t = TrNode_entry(ans_node);
if (arity[0] == 0) {
/* print VAR when starting a term */
if (arity[0] == 0 && mode == TRAVERSE_NORMAL) {
str_index += sprintf(& str[str_index], " VAR%d: ", var_index);
var_index++;
}
t = TrNode_entry(ans_node);
if (IsVarTerm(t)) {
/* test the node type */
if (mode == TRAVERSE_FLOAT_END) {
mode = TRAVERSE_NORMAL;
#if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT
} else if (mode == TRAVERSE_FLOAT_INIT) {
arity[0]++;
arity[arity[0]] = (int) t;
mode = TRAVERSE_FLOAT;
} else if (mode == TRAVERSE_FLOAT) {
volatile Float dbl;
volatile Term *t_dbl = (Term *)((void *) &dbl);
*t_dbl = t;
*(t_dbl + 1) = (Term) arity[arity[0]];
arity[0]--;
#else /* SIZEOF_DOUBLE == SIZEOF_LONG_INT */
} else if (mode == TRAVERSE_FLOAT_INIT) {
Float dbl = (Float) t;
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
str_index += sprintf(& str[str_index], "%.15g", dbl);
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;
}
}
mode = TRAVERSE_FLOAT_END;
} else if (IsVarTerm(t)) {
str_index += sprintf(& str[str_index], "ANSVAR%d", VarIndexOfTableTerm(t));
while (arity[0]) {
if (arity[arity[0]] > 0) {
@ -1419,116 +1588,46 @@ int traverse_answer_trie(FILE *stream, ans_node_ptr ans_node, char *str, int str
}
} else if (IsApplTerm(t)) {
Functor f = (Functor) RepAppl(t);
str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f)));
arity[0]++;
arity[arity[0]] = ArityOfFunctor(f);
if (f == FunctorDouble) {
mode = TRAVERSE_FLOAT_INIT;
} else {
str_index += sprintf(& str[str_index], "%s(", AtomName(NameOfFunctor(f)));
arity[0]++;
arity[arity[0]] = ArityOfFunctor(f);
}
} else {
Yap_Error(INTERNAL_ERROR, TermNil, "unknown type tag (traverse_answer_trie)");
}
if (! IS_ANSWER_LEAF_NODE(ans_node)) {
#ifdef TABLING_INNER_CUTS
if (! TrNode_child(ans_node)) {
TrStat_ans_pruned++;
return TRUE;
}
#endif /* TABLING_INNER_CUTS */
if (! traverse_answer_trie(stream, TrNode_child(ans_node), str, str_index, arity, var_index, depth + 1))
return FALSE;
} else {
TrStat_ans_nodes++;
/* show answer .... */
if (IS_ANSWER_LEAF_NODE(ans_node)) {
str[str_index] = 0;
SHOW_TRIE("%s\n", str);
TrStat_answers++;
TrStat_ans_linear_nodes+= depth;
if (TrStat_ans_max_depth < 0) {
if (TrStat_ans_max_depth < 0)
TrStat_ans_min_depth = TrStat_ans_max_depth = depth;
} else if (depth < TrStat_ans_min_depth) {
else if (depth < TrStat_ans_min_depth)
TrStat_ans_min_depth = depth;
} else if (depth > TrStat_ans_max_depth) {
else if (depth > TrStat_ans_max_depth)
TrStat_ans_max_depth = depth;
}
}
#ifdef TABLING_INNER_CUTS
/* ... or continue with pruned node */
else if (TrNode_child(ans_node) == NULL)
TrStat_ans_pruned++;
#endif /* TABLING_INNER_CUTS */
/* ... or continue with child node */
else if (! traverse_answer_trie(TrNode_child(ans_node), str, str_index, arity, var_index, depth + 1, mode))
return FALSE;
/* continue with sibling node */
if (TrNode_next(ans_node))
if (! traverse_answer_trie(TrNode_next(ans_node), str, old_str_index, old_arity, old_var_index, depth, old_mode))
return FALSE;
return TRUE;
}
#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) = Yap_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) = Yap_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) = Yap_opcode(TrNode_instr(node));
return;
}
#endif /* YAPOR */
#endif /* TABLING */

569
OPTYap/tab.tries.insts.i
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.tries.insts.i
version: $Id: tab.tries.insts.i,v 1.6 2005-05-31 08:18:19 ricroc Exp $
version: $Id: tab.tries.insts.i,v 1.7 2005-06-03 08:19:18 ricroc Exp $
**********************************************************************/
@ -46,12 +46,11 @@
** Trie instructions: auxiliary macros **
** --------------------------------------------- */
#define next_trie_instruction(NODE) \
PREG = (yamop *) TrNode_child(NODE); \
PREFETCH_OP(PREG); \
#define next_trie_instruction(NODE) \
PREG = (yamop *) TrNode_child(NODE); \
PREFETCH_OP(PREG); \
GONext()
#define next_instruction(CONDITION, NODE) \
if (CONDITION) { \
PREG = (yamop *) TrNode_child(NODE); \
@ -71,24 +70,23 @@
** macro because there are no cuts in trie instructions. **
** -------------------------------------------------------------- */
#define store_trie_choice_point(AP) \
{ register choiceptr cp; \
YENV = (CELL *) (NORM_CP(YENV) - 1); \
cp = NORM_CP(YENV); \
HBREG = H; \
store_yaam_reg_cpdepth(cp); \
cp->cp_tr = TR; \
cp->cp_h = H; \
cp->cp_b = B; \
cp->cp_cp = CPREG; \
cp->cp_ap = (yamop *) AP; \
cp->cp_env= ENV; \
B = cp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
#define store_trie_choice_point(AP) \
{ register choiceptr cp; \
YENV = (CELL *) (NORM_CP(YENV) - 1); \
cp = NORM_CP(YENV); \
HBREG = H; \
store_yaam_reg_cpdepth(cp); \
cp->cp_tr = TR; \
cp->cp_h = H; \
cp->cp_b = B; \
cp->cp_cp = CPREG; \
cp->cp_ap = (yamop *) AP; \
cp->cp_env= ENV; \
B = cp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
}
#define restore_trie_choice_point(AP) \
H = HBREG = PROTECT_FROZEN_H(B); \
restore_yaam_reg_cpdepth(B); \
@ -99,91 +97,115 @@
YENV = (CELL *) PROTECT_FROZEN_B(B); \
SET_BB(NORM_CP(YENV))
#define pop_trie_choice_point() \
YENV = (CELL *) PROTECT_FROZEN_B((B+1)); \
H = PROTECT_FROZEN_H(B); \
pop_yaam_reg_cpdepth(B); \
CPREG = B->cp_cp; \
TABLING_close_alt(B); \
ENV = B->cp_env; \
B = B->cp_b; \
HBREG = PROTECT_FROZEN_H(B); \
#define pop_trie_choice_point() \
YENV = (CELL *) PROTECT_FROZEN_B((B+1)); \
H = PROTECT_FROZEN_H(B); \
pop_yaam_reg_cpdepth(B); \
CPREG = B->cp_cp; \
TABLING_close_alt(B); \
ENV = B->cp_env; \
B = B->cp_b; \
HBREG = PROTECT_FROZEN_H(B); \
SET_BB(PROTECT_FROZEN_B(B))
#define no_cp_trie_var_instr() \
if (heap_arity) { \
*aux_ptr = heap_arity - 1; \
var_ptr = *++aux_ptr; \
*((CELL *) var_ptr) = var_ptr; \
for (i = 0; i < heap_arity - 1; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
*aux_ptr++ = vars_arity + 1; \
*aux_ptr++ = subs_arity; \
for (i = 0; i < subs_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
*aux_ptr = var_ptr; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
*++aux_ptr = vars_arity + 1; \
*++aux_ptr = subs_arity - 1; \
/* var_ptr = *(aux_ptr + subs_arity); */ \
/* Bind((CELL *) var_ptr, var_ptr); */ \
next_instruction(--subs_arity, node); \
/* ---------------------- **
** trie_nothing **
** ---------------------- */
#define no_cp_trie_nothing_instr() \
*aux_ptr = TrNode_entry(node); \
*--aux_ptr = heap_arity + 1; \
YENV = aux_ptr; \
next_trie_instruction(node)
#define cp_trie_nothing_instr() \
aux_ptr += heap_arity + subs_arity + vars_arity + 2; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \
*--YENV = *aux_ptr--; \
*--YENV = TrNode_entry(node); \
*--YENV = heap_arity + 1; \
next_trie_instruction(node)
/* ------------------ **
** trie_var **
** ------------------ */
#define no_cp_trie_var_instr() \
if (heap_arity) { \
*aux_ptr = heap_arity - 1; \
var_ptr = *++aux_ptr; \
RESET_VARIABLE(var_ptr); \
for (i = 0; i < heap_arity - 1; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
*aux_ptr++ = vars_arity + 1; \
*aux_ptr++ = subs_arity; \
for (i = 0; i < subs_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
*aux_ptr = var_ptr; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
*++aux_ptr = vars_arity + 1; \
*++aux_ptr = subs_arity - 1; \
next_instruction(subs_arity - 1, node); \
}
#define cp_trie_var_instr() \
if (heap_arity) { \
var_ptr = *++aux_ptr; \
RESET_VARIABLE(var_ptr); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = var_ptr; \
for (i = 0; i < subs_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = subs_arity; \
*--YENV = vars_arity + 1; \
aux_ptr--; \
for (i = 1; i < heap_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity + vars_arity; \
for (i = 0; i < subs_arity + vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity + 1; \
*--YENV = 0; \
next_instruction(subs_arity - 1, node); \
}
#define cp_trie_var_instr() \
if (heap_arity) { \
var_ptr = *++aux_ptr; \
*((CELL *) var_ptr) = var_ptr; \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = var_ptr; \
for (i = 0; i < subs_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = subs_arity; \
*--YENV = vars_arity + 1; \
aux_ptr--; \
for (i = 1; i < heap_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
/* var_ptr = *aux_ptr; */ \
/* Bind((CELL *) var_ptr, var_ptr); */ \
aux_ptr += vars_arity; \
for (i = 0; i < subs_arity + vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity + 1; \
*--YENV = 0; \
next_instruction(--subs_arity, node); \
}
/* ------------------ **
** trie_val **
** ------------------ */
#define no_cp_trie_val_instr() \
if (heap_arity) { \
YENV = ++aux_ptr; \
YENV = ++aux_ptr; \
subs_ptr = aux_ptr + heap_arity + 1 + subs_arity + vars_arity - var_index; \
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
*((CELL *) aux) = subs; \
Bind_Global((CELL *) aux, subs); \
/* *((CELL *) aux) = subs; --> avoids trail test (always fails?) */ \
} else { \
*((CELL *) aux) = aux; \
RESET_VARIABLE(aux); \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
*aux_ptr = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \
@ -211,14 +233,13 @@
Bind_Local((CELL *) aux, subs); \
} \
} \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
next_instruction(--subs_arity, node); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
next_instruction(subs_arity - 1, node); \
}
#define cp_trie_val_instr() \
if (heap_arity) { \
aux_ptr++; \
@ -226,17 +247,18 @@
aux = *aux_ptr; \
subs = *subs_ptr; \
if (aux > subs) { \
*((CELL *) aux) = subs; \
Bind_Global((CELL *) aux, subs); \
/* *((CELL *) aux) = subs; --> avoids trail test (always fails?) */ \
} else { \
*((CELL *) aux) = aux; \
RESET_VARIABLE(aux); \
Bind_Local((CELL *) subs, aux); \
*subs_ptr = aux; \
} \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) \
*--YENV = *aux_ptr--; \
*--YENV = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
*--YENV = *aux_ptr--; \
*--YENV = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
subs_ptr = aux_ptr + vars_arity - var_index; \
@ -264,186 +286,279 @@
} \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = 0; \
next_instruction(--subs_arity, node); \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = 0; \
next_instruction(subs_arity - 1, node); \
}
#define no_cp_trie_atom_instr() \
if (heap_arity) { \
YENV = ++aux_ptr; \
/* *((CELL *) *aux_ptr) = TrNode_entry(node); */ \
Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \
*aux_ptr = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
} else { \
aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
next_instruction(--subs_arity, node); \
}
/* ------------------- **
** trie_atom **
** ------------------- */
#define no_cp_trie_atom_instr() \
if (heap_arity) { \
YENV = ++aux_ptr; \
Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \
*aux_ptr = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
next_instruction(subs_arity - 1, node); \
}
#define cp_trie_atom_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = TrNode_entry(node); */ \
Bind_Global((CELL *) *aux_ptr, TrNode_entry(node)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) \
*--YENV = *aux_ptr--; \
*--YENV = heap_arity - 1; \
next_instruction(--heap_arity || subs_arity, node); \
*--YENV = *aux_ptr--; \
*--YENV = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, TrNode_entry(node)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = 0; \
next_instruction(--subs_arity, node); \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = 0; \
next_instruction(subs_arity - 1, node); \
}
#define no_cp_trie_list_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsPair(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = heap_arity - 1 + 2; \
YENV = aux_ptr; \
} else { \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = 2; \
YENV = aux_ptr; \
aux_ptr += 2 + 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, AbsPair(H - 2)); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
} \
next_trie_instruction(node)
/* ------------------- **
** trie_list **
** ------------------- */
#define no_cp_trie_list_instr() \
if (heap_arity) { \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = heap_arity - 1 + 2; \
YENV = aux_ptr; \
} else { \
H += 2; \
*aux_ptr-- = (CELL) (H - 1); \
*aux_ptr-- = (CELL) (H - 2); \
*aux_ptr = 2; \
YENV = aux_ptr; \
aux_ptr += 2 + 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, AbsPair(H - 2)); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
} \
next_trie_instruction(node)
#define cp_trie_list_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsPair(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsPair(H)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity + subs_arity + heap_arity + 1; i++) \
*--YENV = *aux_ptr--; \
*--YENV = *aux_ptr--; \
H += 2; \
*--YENV = (CELL) (H - 1); \
*--YENV = (CELL) (H - 2); \
*--YENV = heap_arity + 1; \
*--YENV = (CELL) (H - 1); \
*--YENV = (CELL) (H - 2); \
*--YENV = heap_arity + 1; \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, AbsPair(H)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
H += 2; \
*--YENV = (CELL) (H - 1); \
*--YENV = (CELL) (H - 2); \
*--YENV = 2; \
*--YENV = (CELL) (H - 1); \
*--YENV = (CELL) (H - 2); \
*--YENV = 2; \
} \
next_trie_instruction(node)
#define no_cp_trie_struct_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsAppl(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = heap_arity - 1 + func_arity; \
YENV = aux_ptr; \
} else { \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = func_arity; \
YENV = aux_ptr; \
aux_ptr += func_arity + 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, AbsAppl(H - func_arity - 1)); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
} \
next_trie_instruction(node)
/* --------------------- **
** trie_struct **
** --------------------- */
#define no_cp_trie_struct_instr() \
if (heap_arity) { \
aux_ptr++; \
Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = heap_arity - 1 + func_arity; \
YENV = aux_ptr; \
} else { \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*aux_ptr-- = (CELL) (H - i); \
*aux_ptr = func_arity; \
YENV = aux_ptr; \
aux_ptr += func_arity + 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, AbsAppl(H - func_arity - 1)); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
} \
next_trie_instruction(node)
#define cp_trie_struct_instr() \
if (heap_arity) { \
aux_ptr++; \
/* *((CELL *) *aux_ptr) = AbsAppl(H); */ \
Bind_Global((CELL *) *aux_ptr, AbsAppl(H)); \
aux_ptr += heap_arity + subs_arity + vars_arity + 1; \
for (i = 0; i < vars_arity + subs_arity + heap_arity + 1; i++) \
*--YENV = *aux_ptr--; \
*--YENV = *aux_ptr--; \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*--YENV = (CELL) (H - i); \
*--YENV = heap_arity + func_arity - 1; \
*--YENV = (CELL) (H - i); \
*--YENV = heap_arity + func_arity - 1; \
} else { \
aux_ptr += 2 + subs_arity; \
Bind((CELL *) *aux_ptr, AbsAppl(H)); \
aux_ptr += vars_arity; \
for (i = 0; i < vars_arity; i++) \
*--YENV = *aux_ptr--; \
*--YENV = *aux_ptr--; \
for (i = 1; i < subs_arity; i++) \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*--YENV = *--aux_ptr; \
*--YENV = subs_arity - 1; \
*--YENV = vars_arity; \
*H++ = (CELL) func; \
H += func_arity; \
for (i = 1; i <= func_arity; i++) \
*--YENV = (CELL) (H - i); \
*--YENV = func_arity; \
*--YENV = (CELL) (H - i); \
*--YENV = func_arity; \
} \
next_trie_instruction(node)
/* -------------------- **
** trie_float **
** -------------------- */
#define no_cp_trie_float_instr() \
if (heap_arity) { \
aux_ptr++; \
YENV = ++aux_ptr; \
Bind_Global((CELL *) *aux_ptr, t); \
*aux_ptr = heap_arity - 1; \
next_instruction(heap_arity - 1 || subs_arity, node); \
} else { \
YENV = ++aux_ptr; \
*aux_ptr = 0; \
aux_ptr += 2; \
*aux_ptr = subs_arity - 1; \
aux_ptr += subs_arity; \
Bind((CELL *) *aux_ptr, t); \
for (i = 0; i < vars_arity; i++) { \
*aux_ptr = *(aux_ptr + 1); \
aux_ptr++; \
} \
next_instruction(subs_arity - 1, node); \
} \
/* --------------------------- **
** Trie instructions **
** --------------------------- */
PBOp(trie_do_nothing, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
no_cp_trie_nothing_instr();
ENDPBOp();
PBOp(trie_try_nothing, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(TrNode_next(node));
cp_trie_nothing_instr();
ENDPBOp();
PBOp(trie_retry_nothing, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_nothing_instr();
ENDPBOp();
PBOp(trie_trust_nothing, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_nothing_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
if ((choiceptr) YENV == B_FZ) {
cp_trie_nothing_instr();
} else {
no_cp_trie_nothing_instr();
}
}
ENDPBOp();
PBOp(trie_do_var, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
@ -777,3 +892,41 @@
}
}
ENDPBOp();
PBOp(trie_do_float, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
Term t;
volatile Float dbl;
#if SIZEOF_DOUBLE == 2 * SIZEOF_LONG_INT
volatile Term *t_dbl = (Term *)((void *) &dbl);
*t_dbl = *++aux_ptr;
*(t_dbl + 1) = *++aux_ptr;
heap_arity -= 3;
#else /* SIZEOF_DOUBLE == SIZEOF_LONG_INT */
dbl = (Float) *++aux_ptr;
heap_arity -= 2;
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
t = MkFloatTerm(dbl);
no_cp_trie_float_instr();
ENDPBOp();
PBOp(trie_try_float, e)
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_try_float)");
ENDPBOp();
PBOp(trie_retry_float, e)
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_retry_float)");
ENDPBOp();
PBOp(trie_trust_float, e)
Yap_Error(INTERNAL_ERROR, TermNil, "invalid instruction (trie_trust_float)");
ENDPBOp();