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

TABLING: answers for completed calls can now be obtained by loading (new option) or executing (default) them from the trie data structure. 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1342 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
ricroc 2005-07-06 19:34:12 +00:00
parent 6d34ce46f3
commit 3a93e0e079
23 changed files with 1129 additions and 667 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

53
C/absmi.c
View File

@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2005-07-06 15:10:01 $,$Author: vsc $ *
* Last rev: $Date: 2005-07-06 19:33:51 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.169 2005/07/06 15:10:01 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.168 2005/06/04 07:27:33 ricroc
* long int support for tabling
*
@ -1405,31 +1408,23 @@ Yap_absmi(int inp)
go_on = FALSE;
switch (opnum) {
#ifdef TABLING
case _table_answer_resolution:
{
PredEntry *pe = ENV_ToP(B->cp_cp);
op_numbers caller_op = Yap_op_from_opcode(ENV_ToOp(B->cp_cp));
/* first condition checks if this was a meta-call */
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
low_level_trace(retry_table_consumer, NULL, NULL);
} else {
low_level_trace(retry_table_consumer, pe, NULL);
}
}
case _table_completion:
{
PredEntry *pe = ENV_ToP(B->cp_cp);
op_numbers caller_op = Yap_op_from_opcode(ENV_ToOp(B->cp_cp));
/* first condition checks if this was a meta-call */
if ((caller_op != _call && caller_op != _fcall) || pe == NULL) {
low_level_trace(retry_table_producer, NULL, NULL);
} else {
low_level_trace(retry_table_producer, pe, (CELL *)(GEN_CP(B)+1));
}
}
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
low_level_trace(retry_table_generator, TabEnt_pe(GEN_CP(B)->cp_tab_ent), (CELL *)(GEN_CP(B)+ 1));
break;
case _trie_retry_nothing:
case _trie_trust_nothing:
case _table_completion:
low_level_trace(retry_table_generator, TabEnt_pe(GEN_CP(B)->cp_tab_ent), (CELL *)(GEN_CP(B)+1));
break;
case _table_answer_resolution:
low_level_trace(retry_table_consumer, TabEnt_pe(CONS_CP(B)->cp_tab_ent), NULL);
break;
case _table_load_answer:
low_level_trace(retry_table_loader, TabEnt_pe(LOAD_CP(B)->cp_tab_ent), NULL);
break;
case _trie_retry_null:
case _trie_trust_null:
case _trie_retry_var:
case _trie_trust_var:
case _trie_retry_val:
@ -1440,15 +1435,13 @@ Yap_absmi(int inp)
case _trie_trust_list:
case _trie_retry_struct:
case _trie_trust_struct:
case _trie_retry_extension:
case _trie_trust_extension:
case _trie_retry_float:
case _trie_trust_float:
case _trie_retry_long:
case _trie_trust_long:
low_level_trace(retry_table_consumer, NULL, NULL);
break;
case _table_retry_me:
case _table_trust_me:
low_level_trace(retry_pred, ipc->u.lds.p, (CELL *)(GEN_CP(B)+ 1));
low_level_trace(retry_table_loader, UndefCode, NULL);
break;
#endif /* TABLING */
case _or_else:

14
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2005-07-06 15:10:03 $,$Author: vsc $ *
* Last rev: $Date: 2005-07-06 19:33:52 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.164 2005/07/06 15:10:03 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.163 2005/06/08 00:35:27 vsc
* fix silly calls such as 0.15 ( bug reported by Jude Shavlik)
*
@ -289,8 +292,8 @@ PredForChoicePt(yamop *p_code) {
case _Nstop:
return NULL;
#ifdef TABLING
case _trie_retry_nothing:
case _trie_trust_nothing:
case _trie_retry_null:
case _trie_trust_null:
case _trie_retry_var:
case _trie_trust_var:
case _trie_retry_val:
@ -301,13 +304,16 @@ PredForChoicePt(yamop *p_code) {
case _trie_trust_list:
case _trie_retry_struct:
case _trie_trust_struct:
case _trie_retry_extension:
case _trie_trust_extension:
case _trie_retry_float:
case _trie_trust_float:
case _trie_retry_long:
case _trie_trust_long:
return NULL;
case _table_completion:
case _table_answer_resolution:
case _table_completion:
case _table_load_answer:
return NULL; /* ricroc: is this OK? */
/* compile error --> return ENV_ToP(gc_B->cp_cp); */
#endif

457
C/heapgc.c
View File

@ -27,7 +27,7 @@ static char SccsId[] = "%W% %G%";
#define EARLY_RESET 1
#if !defined(TABLING)
#define EASY_SHUNTING 1
#endif
#endif /* !TABLING */
#define HYBRID_SCHEME 1
@ -1684,7 +1684,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
*su_cl = NEXTOP(PredStaticClause->CodeOfPred,ld);
#ifdef TABLING
dep_fr_ptr depfr = LOCAL_top_dep_fr;
#endif
#endif /* TABLING */
#ifdef EASY_SHUNTING
HB = H;
#endif
@ -1714,7 +1714,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
if (rtp == NULL) {
opnum = _table_completion;
} else
#endif
#endif /* TABLING */
{
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
@ -1776,7 +1776,7 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
else
#ifdef TABLING
if (opnum != _table_completion)
#endif
#endif /* TABLING */
mark_environments((CELL_PTR) gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
@ -1828,57 +1828,69 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
nargs = 0;
break;
#ifdef TABLING
case _table_answer_resolution:
{
CELL *answ_fr;
CELL vars;
/* fetch the solution */
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->cp_dep_fr);
vars = *answ_fr++;
while (vars--) {
mark_external_reference(answ_fr);
answ_fr++;
}
nargs = 0;
}
break;
case _table_completion:
{
int nargs = SgFr_arity(GEN_CP(gc_B)->cp_sg_fr);
saved_reg = (CELL *)(GEN_CP(gc_B) + 1) + nargs;
nargs = *saved_reg++;
while (nargs--) {
mark_external_reference(saved_reg);
saved_reg++;
}
}
nargs = 0;
break;
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
{
int nargs = rtp->u.ld.s;
/* for each saved register */
for (saved_reg = (CELL *)(GEN_CP(gc_B) + 1);
/* assumes we can count registers in CP this
way */
saved_reg < (CELL *)(GEN_CP(gc_B) + 1) + nargs;
saved_reg++) {
mark_external_reference(saved_reg);
}
nargs = *saved_reg++;
CELL *vars_ptr, vars;
vars_ptr = (CELL *)(GEN_CP(gc_B) + 1);
nargs = rtp->u.ld.s;
while (nargs--) {
mark_external_reference(saved_reg);
saved_reg++;
mark_external_reference(vars_ptr);
vars_ptr++;
}
vars = *vars_ptr++;
while (vars--) {
mark_external_reference(vars_ptr);
vars_ptr++;
}
}
nargs = 0;
break;
case _trie_retry_nothing:
case _trie_trust_nothing:
case _table_completion:
{
CELL *vars_ptr, vars;
vars_ptr = (CELL *)(GEN_CP(gc_B) + 1);
nargs = SgFr_arity(GEN_CP(gc_B)->cp_sg_fr);
while (nargs--) {
mark_external_reference(vars_ptr);
vars_ptr++;
}
vars = *vars_ptr++;
while (vars--) {
mark_external_reference(vars_ptr);
vars_ptr++;
}
}
nargs = 0;
break;
case _table_answer_resolution:
{
CELL *vars_ptr, vars;
init_substitution_pointer(gc_B, vars_ptr, CONS_CP(gc_B)->cp_dep_fr);
vars = *vars_ptr++;
while (vars--) {
mark_external_reference(vars_ptr);
vars_ptr++;
}
}
nargs = 0;
break;
case _table_load_answer:
{
CELL *vars_ptr, vars;
vars_ptr = (CELL *) (LOAD_CP(gc_B) + 1);
vars = *vars_ptr++;
while (vars--) {
mark_external_reference(vars_ptr);
vars_ptr++;
}
}
nargs = 0;
break;
case _trie_retry_null:
case _trie_trust_null:
case _trie_retry_var:
case _trie_trust_var:
case _trie_retry_val:
@ -1889,44 +1901,45 @@ mark_choicepoints(register choiceptr gc_B, tr_fr_ptr saved_TR, int very_verbose)
case _trie_trust_list:
case _trie_retry_struct:
case _trie_trust_struct:
case _trie_retry_extension:
case _trie_trust_extension:
case _trie_retry_float:
case _trie_trust_float:
case _trie_retry_long:
case _trie_trust_long:
{
CELL *aux_ptr;
int heap_arity;
int vars_arity;
int subs_arity;
/* fetch the solution */
aux_ptr = (CELL *)(gc_B+1);
heap_arity = *aux_ptr;
vars_arity = *(aux_ptr + heap_arity + 1);
subs_arity = *(aux_ptr + heap_arity + 2);
CELL *vars_ptr;
int heap_arity, vars_arity, subs_arity;
vars_ptr = (CELL *)(gc_B + 1);
heap_arity = *vars_ptr;
vars_arity = *(vars_ptr + heap_arity + 1);
subs_arity = *(vars_ptr + heap_arity + 2);
vars_ptr += heap_arity + subs_arity + vars_arity + 2;
if (vars_arity) {
while (vars_arity--) {
mark_external_reference(vars_ptr);
vars_ptr--;
}
}
if (subs_arity) {
while (subs_arity--) {
mark_external_reference(vars_ptr);
vars_ptr--;
}
}
vars_ptr -= 2;
if (heap_arity) {
int i;
aux_ptr += heap_arity + subs_arity + vars_arity + 1;
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) {
mark_external_reference(aux_ptr);
aux_ptr--;
}
} else {
int i;
aux_ptr += 2 + subs_arity + vars_arity;
for (i = 0; i < vars_arity; i++) {
mark_external_reference(aux_ptr);
aux_ptr--;
}
for (i = 1; i < subs_arity; i++) {
aux_ptr--;
mark_external_reference(aux_ptr);
while (heap_arity--) {
if (*vars_ptr == 0)
break; /* term extension mark: float/longint */
mark_external_reference(vars_ptr);
vars_ptr--;
}
}
}
nargs = 0;
break;
#endif
#endif /* TABLING */
case _profiled_retry_and_mark:
case _count_retry_and_mark:
case _retry_and_mark:
@ -2464,7 +2477,7 @@ sweep_choicepoints(choiceptr gc_B)
{
#ifdef TABLING
dep_fr_ptr depfr = LOCAL_top_dep_fr;
#endif
#endif /* TABLING */
while(gc_B != NULL) {
yamop *rtp = gc_B->cp_ap;
@ -2481,7 +2494,7 @@ sweep_choicepoints(choiceptr gc_B)
if (rtp == NULL) {
opnum = _table_completion;
} else
#endif
#endif /* TABLING */
{
op = rtp->opc;
opnum = Yap_op_from_opcode(op);
@ -2535,160 +2548,174 @@ sweep_choicepoints(choiceptr gc_B)
opnum = Yap_op_from_opcode(op);
goto restart_cp;
#ifdef TABLING
case _table_answer_resolution:
{
CELL *answ_fr;
CELL vars;
sweep_environments(gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
/* fetch the solution */
init_substitution_pointer(gc_B, answ_fr, CONS_CP(gc_B)->cp_dep_fr);
vars = *answ_fr++;
while (vars--) {
CELL cp_cell = *answ_fr;
if (MARKED_PTR(answ_fr)) {
UNMARK(answ_fr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(answ_fr, GET_NEXT(cp_cell));
}
}
answ_fr++;
}
}
break;
case _table_completion:
{
int nargs = SgFr_arity(GEN_CP(gc_B)->cp_sg_fr);
CELL *saved_reg;
saved_reg = (CELL *)(GEN_CP(gc_B) + 1) + nargs;
nargs = *saved_reg++;
while (nargs--) {
CELL cp_cell = *saved_reg;
if (MARKED_PTR(saved_reg)) {
UNMARK(saved_reg);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
}
}
saved_reg++;
}
}
break;
case _table_retry_me:
case _table_trust_me:
case _table_retry:
case _table_trust:
{
int nargs;
CELL *saved_reg;
sweep_environments(gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
CELL *vars_ptr, vars;
sweep_environments(gc_B->cp_env, EnvSize((CELL_PTR) (gc_B->cp_cp)), EnvBMap((CELL_PTR) (gc_B->cp_cp)));
vars_ptr = (CELL *)(GEN_CP(gc_B) + 1);
nargs = rtp->u.ld.s;
/* for each saved register */
for (saved_reg = (CELL *)(GEN_CP(gc_B) + 1);
/* assumes we can count registers in CP this
way */
saved_reg < (CELL *)(GEN_CP(gc_B) + 1) + nargs;
saved_reg++) {
CELL cp_cell = *saved_reg;
if (MARKED_PTR(saved_reg)) {
UNMARK(saved_reg);
while(nargs--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr++;
}
saved_reg = (CELL *)(GEN_CP(gc_B) + 1) + nargs;
nargs = *saved_reg++;
while (nargs--) {
CELL cp_cell = *saved_reg;
if (MARKED_PTR(saved_reg)) {
UNMARK(saved_reg);
vars = *vars_ptr++;
while (vars--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(saved_reg, GET_NEXT(cp_cell));
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
saved_reg++;
vars_ptr++;
}
}
break;
case _trie_retry_nothing:
case _trie_trust_nothing:
case _trie_retry_var:
case _trie_trust_var:
case _trie_retry_val:
case _trie_trust_val:
case _trie_retry_atom:
case _trie_trust_atom:
case _trie_retry_list:
case _trie_trust_list:
case _trie_retry_struct:
case _trie_trust_struct:
case _trie_retry_float:
case _trie_trust_float:
case _trie_retry_long:
case _trie_trust_long:
{
CELL *aux_ptr;
int heap_arity;
int vars_arity;
int subs_arity;
sweep_environments(gc_B->cp_env,
EnvSize((CELL_PTR) (gc_B->cp_cp)),
EnvBMap((CELL_PTR) (gc_B->cp_cp)));
/* fetch the solution */
aux_ptr = (CELL *)(gc_B+1);
heap_arity = *aux_ptr;
vars_arity = *(aux_ptr + heap_arity + 1);
subs_arity = *(aux_ptr + heap_arity + 2);
if (heap_arity) {
int i;
aux_ptr += heap_arity + subs_arity + vars_arity + 1;
for (i = 0; i < heap_arity + subs_arity + vars_arity + 1; i++) {
CELL cp_cell = *aux_ptr;
if (MARKED_PTR(aux_ptr)) {
UNMARK(aux_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
}
}
aux_ptr--;
}
} else {
int i;
aux_ptr += 2 + subs_arity + vars_arity;
for (i = 0; i < vars_arity; i++) {
CELL cp_cell = *aux_ptr;
if (MARKED_PTR(aux_ptr)) {
UNMARK(aux_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
}
}
aux_ptr--;
}
for (i = 1; i < subs_arity; i++) {
CELL cp_cell = *--aux_ptr;
if (MARKED_PTR(aux_ptr)) {
UNMARK(aux_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(aux_ptr, GET_NEXT(cp_cell));
}
}
case _table_completion:
{
int nargs;
CELL *vars_ptr, vars;
sweep_environments(gc_B->cp_env, EnvSize((CELL_PTR) (gc_B->cp_cp)), EnvBMap((CELL_PTR) (gc_B->cp_cp)));
vars_ptr = (CELL *)(GEN_CP(gc_B) + 1);
nargs = SgFr_arity(GEN_CP(gc_B)->cp_sg_fr);
while(nargs--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr++;
}
break;
#endif
vars = *vars_ptr++;
while (vars--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr++;
}
}
break;
case _table_answer_resolution:
{
CELL *vars_ptr, vars;
sweep_environments(gc_B->cp_env, EnvSize((CELL_PTR) (gc_B->cp_cp)), EnvBMap((CELL_PTR) (gc_B->cp_cp)));
init_substitution_pointer(gc_B, vars_ptr, CONS_CP(gc_B)->cp_dep_fr);
vars = *vars_ptr++;
while (vars--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr++;
}
}
break;
case _table_load_answer:
{
CELL *vars_ptr, vars;
sweep_environments(gc_B->cp_env, EnvSize((CELL_PTR) (gc_B->cp_cp)), EnvBMap((CELL_PTR) (gc_B->cp_cp)));
vars_ptr = (CELL *) (LOAD_CP(gc_B) + 1);
vars = *vars_ptr++;
while (vars--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr++;
}
}
break;
case _trie_retry_null:
case _trie_trust_null:
case _trie_retry_var:
case _trie_trust_var:
case _trie_retry_val:
case _trie_trust_val:
case _trie_retry_atom:
case _trie_trust_atom:
case _trie_retry_list:
case _trie_trust_list:
case _trie_retry_struct:
case _trie_trust_struct:
case _trie_retry_extension:
case _trie_trust_extension:
case _trie_retry_float:
case _trie_trust_float:
case _trie_retry_long:
case _trie_trust_long:
{
CELL *vars_ptr;
int heap_arity, vars_arity, subs_arity;
sweep_environments(gc_B->cp_env, EnvSize((CELL_PTR) (gc_B->cp_cp)), EnvBMap((CELL_PTR) (gc_B->cp_cp)));
vars_ptr = (CELL *)(gc_B + 1);
heap_arity = *vars_ptr;
vars_arity = *(vars_ptr + heap_arity + 1);
subs_arity = *(vars_ptr + heap_arity + 2);
vars_ptr += heap_arity + subs_arity + vars_arity + 2;
if (vars_arity) {
while (vars_arity--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr--;
}
}
if (subs_arity) {
while (subs_arity--) {
CELL cp_cell = *vars_ptr;
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr--;
}
}
vars_ptr -= 2;
if (heap_arity) {
while (heap_arity--) {
CELL cp_cell = *vars_ptr;
if (*vars_ptr == 0)
break; /* term extension mark: float/longint */
if (MARKED_PTR(vars_ptr)) {
UNMARK(vars_ptr);
if (HEAP_PTR(cp_cell)) {
into_relocation_chain(vars_ptr, GET_NEXT(cp_cell));
}
}
vars_ptr--;
}
}
}
break;
#endif /* TABLING */
case _retry2:
sweep_b(gc_B, 2);
break;
@ -2796,7 +2823,7 @@ update_relocation_chain(CELL_PTR current, CELL_PTR dest)
#ifdef TABLING
static dep_fr_ptr gl_depfr;
#endif
#endif /* TABLING */
static inline choiceptr
update_B_H( choiceptr gc_B, CELL *current, CELL *dest, CELL *odest) {
@ -2815,7 +2842,7 @@ update_B_H( choiceptr gc_B, CELL *current, CELL *dest, CELL *odest) {
gc_B = DepFr_cons_cp(gl_depfr);
gl_depfr = DepFr_next(gl_depfr);
}
#endif
#endif /* TABLING */
}
return(gc_B);
}
@ -2844,7 +2871,7 @@ compact_heap(void)
#ifdef TABLING
gl_depfr = LOCAL_top_dep_fr;
#endif
#endif /* TABLING */
dest = (CELL_PTR) H0 + total_marked - 1;
for (current = H - 1; current >= H0; current--) {
if (MARKED_PTR(current)) {
@ -2994,7 +3021,7 @@ compact_heap(void)
H_FZ = H0;
else
H_FZ = B_FZ->cp_h;
#endif
#endif /* TABLING */
}
@ -3004,7 +3031,7 @@ adjust_cp_hbs(void)
{
#ifdef TABLING
dep_fr_ptr depfr = LOCAL_top_dep_fr;
#endif
#endif /* TABLING */
choiceptr gc_B = B;
CELL_PTR *top = iptop-1, *base = (CELL_PTR *)H;
@ -3048,7 +3075,7 @@ adjust_cp_hbs(void)
gc_B = DepFr_cons_cp(depfr);
depfr = DepFr_next(depfr);
} else
#endif
#endif /* TABLING */
gc_B = gc_B->cp_b;
}
}
@ -3192,7 +3219,7 @@ icompact_heap(void)
H_FZ = H0;
else
H_FZ = B_FZ->cp_h;
#endif
#endif /* TABLING */
}
#endif /* HYBRID_SCHEME */

33
C/index.c
View File

@ -11,8 +11,13 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-07-05 18:32:32 $,$Author: vsc $ *
* Last rev: $Date: 2005-07-06 19:33:53 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.138 2005/07/05 18:32:32 vsc
* ifix some wierd cases in indexing code:
* would not look at next argument
* problem with pvar as last clause (R Camacho).
*
* Revision 1.137 2005/06/04 07:27:34 ricroc
* long int support for tabling
*
@ -704,6 +709,7 @@ has_cut(yamop *pc)
case _table_trust_me:
case _table_answer_resolution:
case _table_completion:
case _table_load_answer:
#endif /* TABLING */
pc = NEXTOP(pc,ld);
break;
@ -773,10 +779,10 @@ has_cut(yamop *pc)
case _getwork_first_time:
#endif /* YAPOR */
#ifdef TABLING
case _trie_do_nothing:
case _trie_trust_nothing:
case _trie_try_nothing:
case _trie_retry_nothing:
case _trie_do_null:
case _trie_trust_null:
case _trie_try_null:
case _trie_retry_null:
case _trie_do_var:
case _trie_trust_var:
case _trie_try_var:
@ -797,6 +803,10 @@ has_cut(yamop *pc)
case _trie_trust_struct:
case _trie_try_struct:
case _trie_retry_struct:
case _trie_do_extension:
case _trie_trust_extension:
case _trie_try_extension:
case _trie_retry_extension:
case _trie_do_float:
case _trie_trust_float:
case _trie_try_float:
@ -2121,6 +2131,7 @@ add_info(ClauseDef *clause, UInt regno)
case _table_trust:
case _table_answer_resolution:
case _table_completion:
case _table_load_answer:
#endif /* TABLING */
case _enter_profiling:
case _count_call:
@ -2175,10 +2186,10 @@ add_info(ClauseDef *clause, UInt regno)
#endif /* YAPOR */
#ifdef TABLING
case _table_new_answer:
case _trie_do_nothing:
case _trie_trust_nothing:
case _trie_try_nothing:
case _trie_retry_nothing:
case _trie_do_null:
case _trie_trust_null:
case _trie_try_null:
case _trie_retry_null:
case _trie_do_var:
case _trie_trust_var:
case _trie_try_var:
@ -2199,6 +2210,10 @@ add_info(ClauseDef *clause, UInt regno)
case _trie_trust_struct:
case _trie_try_struct:
case _trie_retry_struct:
case _trie_do_extension:
case _trie_trust_extension:
case _trie_try_extension:
case _trie_retry_extension:
case _trie_do_float:
case _trie_trust_float:
case _trie_try_float:

32
C/init.c
View File

@ -742,11 +742,7 @@ InitFlags(void)
#endif
/* current default */
yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
#ifdef TABLING
yap_flags[TABLING_MODE_FLAG] = TABLING_MODE_DEFAULT;
#else
yap_flags[TABLING_MODE_FLAG] = TABLING_MODE_OFF;
#endif /* TABLING */
yap_flags[TABLING_MODE_FLAG] = 0;
}
static void
@ -780,18 +776,20 @@ InitCodes(void)
Yap_InitModules();
#ifdef YAPOR
Yap_heap_regs->seq_def = TRUE;
Yap_heap_regs->getworkfirsttimecode.opc = Yap_opcode(_getwork_first_time);
Yap_heap_regs->getworkcode.opc = Yap_opcode(_getwork);
INIT_YAMOP_LTT(&(Yap_heap_regs->getworkcode), 0);
Yap_heap_regs->getworkcode_seq.opc = Yap_opcode(_getwork_seq);
INIT_YAMOP_LTT(&(Yap_heap_regs->getworkcode_seq), 0);
Yap_heap_regs->getwork_code.opc = Yap_opcode(_getwork);
INIT_YAMOP_LTT(&(Yap_heap_regs->getwork_code), 0);
Yap_heap_regs->getwork_seq_code.opc = Yap_opcode(_getwork_seq);
INIT_YAMOP_LTT(&(Yap_heap_regs->getwork_seq_code), 0);
Yap_heap_regs->getwork_first_time_code.opc = Yap_opcode(_getwork_first_time);
#endif /* YAPOR */
#ifdef TABLING
Yap_heap_regs->tablecompletioncode.opc = Yap_opcode(_table_completion);
Yap_heap_regs->tableanswerresolutioncode.opc = Yap_opcode(_table_answer_resolution);
Yap_heap_regs->table_completion_code.opc = Yap_opcode(_table_completion);
Yap_heap_regs->table_answer_resolution_code.opc = Yap_opcode(_table_answer_resolution);
Yap_heap_regs->table_load_answer_code.opc = Yap_opcode(_table_load_answer);
#ifdef YAPOR
INIT_YAMOP_LTT(&(Yap_heap_regs->tablecompletioncode), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->tableanswerresolutioncode), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->table_completion_code), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->table_answer_resolution_code), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->table_load_answer_code), 0);
#endif /* YAPOR */
#endif /* TABLING */
Yap_heap_regs->expand_op_code = Yap_opcode(_expand_index);
@ -1098,9 +1096,9 @@ InitCodes(void)
modp->PredFlags |= MetaPredFlag;
}
#ifdef YAPOR
Yap_heap_regs->getworkcode.u.ld.p = RepPredProp(PredPropByAtom(Yap_FullLookupAtom("$getwork"), PROLOG_MODULE));
Yap_heap_regs->getworkcode_seq.u.ld.p = RepPredProp(PredPropByAtom(Yap_FullLookupAtom("$getwork_seq"), PROLOG_MODULE));
#endif
Yap_heap_regs->getwork_code.u.ld.p = RepPredProp(PredPropByAtom(Yap_FullLookupAtom("$getwork"), PROLOG_MODULE));
Yap_heap_regs->getwork_seq_code.u.ld.p = RepPredProp(PredPropByAtom(Yap_FullLookupAtom("$getwork_seq"), PROLOG_MODULE));
#endif /* YAPOR */
Yap_heap_regs->db_erased_marker =
(DBRef)Yap_AllocCodeSpace(sizeof(DBStruct));
Yap_heap_regs->db_erased_marker->id = FunctorDBRef;

87
C/stdpreds.c
View File

@ -11,8 +11,11 @@
* File: stdpreds.c *
* comments: General-purpose C implemented system predicates *
* *
* Last rev: $Date: 2005-07-06 15:10:14 $,$Author: vsc $ *
* Last rev: $Date: 2005-07-06 19:33:54 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.90 2005/07/06 15:10:14 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.89 2005/05/26 18:01:11 rslopes
* *** empty log message ***
*
@ -2822,6 +2825,32 @@ p_access_yap_flags(void)
if (flag < 0 || flag > NUMBER_OF_YAP_FLAGS) {
return(FALSE);
}
#ifdef TABLING
if (flag == TABLING_MODE_FLAG) {
int n = 0;
if (IsMode_CompletedOn(yap_flags[flag])) {
if (IsMode_LoadAnswers(yap_flags[flag]))
tout = MkAtomTerm(Yap_LookupAtom("load_answers"));
else
tout = MkAtomTerm(Yap_LookupAtom("exec_answers"));
n++;
}
if (IsMode_SchedulingOn(yap_flags[flag])) {
Term taux = tout;
if (IsMode_Local(yap_flags[flag]))
tout = MkAtomTerm(Yap_LookupAtom("local"));
else
tout = MkAtomTerm(Yap_LookupAtom("batched"));
if (n) {
taux = MkPairTerm(taux, MkAtomTerm(AtomNil));
tout = MkPairTerm(tout, taux);
}
n++;
}
if (n == 0)
tout = MkAtomTerm(Yap_LookupAtom("default"));
} else
#endif /* TABLING */
tout = MkIntegerTerm(yap_flags[flag]);
return(Yap_unify(ARG2, tout));
}
@ -2931,15 +2960,57 @@ p_set_yap_flags(void)
return(FALSE);
yap_flags[INDEXING_MODE_FLAG] = value;
break;
case TABLING_MODE_FLAG:
#ifdef TABLING
if (value != TABLING_MODE_DEFAULT && value != TABLING_MODE_BATCHED && value != TABLING_MODE_LOCAL)
return(FALSE);
yap_flags[TABLING_MODE_FLAG] = value;
#else
return(FALSE);
#endif /* TABLING */
case TABLING_MODE_FLAG:
if (value == 0) { /* default */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
if (IsDefaultMode_Local(TabEnt_mode(tab_ent)))
SetMode_Local(TabEnt_mode(tab_ent));
else
SetMode_Batched(TabEnt_mode(tab_ent));
if (IsDefaultMode_LoadAnswers(TabEnt_mode(tab_ent)))
SetMode_LoadAnswers(TabEnt_mode(tab_ent));
else
SetMode_ExecAnswers(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
yap_flags[TABLING_MODE_FLAG] = 0;
} else if (value == 1) { /* batched */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
SetMode_Batched(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_Batched(yap_flags[TABLING_MODE_FLAG]);
SetMode_SchedulingOn(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 2) { /* local */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
SetMode_Local(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_Local(yap_flags[TABLING_MODE_FLAG]);
SetMode_SchedulingOn(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 3) { /* exec_answers */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
SetMode_ExecAnswers(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_ExecAnswers(yap_flags[TABLING_MODE_FLAG]);
SetMode_CompletedOn(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 4) { /* load_answers */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while(tab_ent) {
SetMode_LoadAnswers(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG]);
SetMode_CompletedOn(yap_flags[TABLING_MODE_FLAG]);
}
break;
#endif /* TABLING */
default:
return(FALSE);
}

48
C/tracer.c
View File

@ -182,12 +182,10 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
fprintf(Yap_stderr,"(%d)", worker_id);
#endif
/* check_trail_consistency(); */
if (pred == NULL) {
if (pred == NULL)
return;
}
if (pred->ModuleOfPred == 0 && !do_trace_primitives) {
if (pred->ModuleOfPred == 0 && !do_trace_primitives)
return;
}
switch (port) {
case enter_pred:
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
@ -207,28 +205,30 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
send_tracer_message("FAIL ", NULL, 0, NULL, args);
send_tracer_message("RETRY_OR ", NULL, 0, NULL, args);
break;
case retry_table_producer:
case retry_table_generator:
send_tracer_message("FAIL ", NULL, 0, NULL, args);
/* HANDLE METACALLS */
if (pred == NULL) {
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
} else {
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
else
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
send_tracer_message("RETRY PRODUCER: ", s, 0, mname, NULL);
}
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
else
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
send_tracer_message("RETRY GENERATOR: ", s, arity, mname, args);
break;
case retry_table_consumer:
send_tracer_message("FAIL ", NULL, 0, NULL, args);
/* HANDLE METACALLS */
if (pred == NULL) {
send_tracer_message("RETRY TABLE: ", NULL, 0, NULL, args);
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE;
if (arity == 0)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
else
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
break;
case retry_table_loader:
send_tracer_message("FAIL ", NULL, 0, NULL, args);
if (pred == UndefCode) {
send_tracer_message("RETRY LOADER ", NULL, 0, NULL, NULL);
} else {
mname = RepAtom(AtomOfTerm(Yap_Module_Name(pred)))->StrOfAE;
arity = pred->ArityOfPE;
@ -236,9 +236,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
s = RepAtom((Atom)pred->FunctorOfPred)->StrOfAE;
else
s = RepAtom(NameOfFunctor((pred->FunctorOfPred)))->StrOfAE;
/* if ((pred->ModuleOfPred == 0) && (s[0] == '$'))
return; */
send_tracer_message("RETRY CONSUMER: ", s, 0, mname, NULL);
send_tracer_message("RETRY LOADER: ", s, 0, mname, NULL);
}
break;
case retry_pred:

26
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.80 2005-05-31 08:20:23 ricroc Exp $ *
* version: $Id: Heap.h,v 1.81 2005-07-06 19:34:11 ricroc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -135,14 +135,15 @@ typedef struct various_codes {
worker_local wl;
#endif
#ifdef YAPOR
int seq_def;
yamop getworkcode;
yamop getworkcode_seq;
yamop getworkfirsttimecode;
int seq_def;
yamop getwork_code;
yamop getwork_seq_code;
yamop getwork_first_time_code;
#endif /* YAPOR */
#ifdef TABLING
yamop tablecompletioncode;
yamop tableanswerresolutioncode;
yamop table_answer_resolution_code;
yamop table_completion_code;
yamop table_load_answer_code;
#endif /* TABLING */
OPCODE expand_op_code;
yamop *expand_clauses_first, *expand_clauses_last;
@ -463,13 +464,14 @@ struct various_codes *Yap_heap_regs;
#define HeapLim Yap_heap_regs->heap_lim
#ifdef YAPOR
#define SEQUENTIAL_IS_DEFAULT Yap_heap_regs->seq_def
#define GETWORK (&(Yap_heap_regs->getworkcode ))
#define GETWORK_SEQ (&(Yap_heap_regs->getworkcode_seq ))
#define GETWORK_FIRST_TIME (&(Yap_heap_regs->getworkfirsttimecode ))
#define GETWORK (&(Yap_heap_regs->getwork_code))
#define GETWORK_SEQ (&(Yap_heap_regs->getwork_seq_code))
#define GETWORK_FIRST_TIME (&(Yap_heap_regs->getwork_first_time_code))
#endif /* YAPOR */
#ifdef TABLING
#define COMPLETION ((yamop *)&(Yap_heap_regs->tablecompletioncode ))
#define ANSWER_RESOLUTION ((yamop *)&(Yap_heap_regs->tableanswerresolutioncode ))
#define ANSWER_RESOLUTION ((yamop *)&(Yap_heap_regs->table_answer_resolution_code))
#define COMPLETION ((yamop *)&(Yap_heap_regs->table_completion_code))
#define LOAD_ANSWER ((yamop *)&(Yap_heap_regs->table_load_answer_code))
#endif /* TABLING */
#define EXPAND_OP_CODE Yap_heap_regs->expand_op_code
#define ExpandClausesFirst Yap_heap_regs->expand_clauses_first

10
H/Yap.h
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.4 2005-07-06 15:10:14 vsc Exp $ *
* version: $Id: Yap.h,v 1.5 2005-07-06 19:34:11 ricroc Exp $ *
*************************************************************************/
#include "config.h"
@ -547,14 +547,6 @@ typedef enum
INDEX_MODE_MAX = 4
} index_mode_options;
typedef enum
{
TABLING_MODE_OFF = 0,
TABLING_MODE_BATCHED = 1,
TABLING_MODE_LOCAL = 2,
TABLING_MODE_DEFAULT = 3
} tabling_mode_options;
typedef enum
{
YAP_CREEP_SIGNAL = 0x1, /* received a creep */

18
H/YapOpcodes.h
View File

@ -11,8 +11,11 @@
* File: YapOpcodes.h *
* comments: Central Table with all YAP opcodes *
* *
* Last rev: $Date: 2005-07-06 15:10:15 $ *
* Last rev: $Date: 2005-07-06 19:34:11 $ *
* $Log: not supported by cvs2svn $
* Revision 1.31 2005/07/06 15:10:15 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.30 2005/06/04 07:26:43 ricroc
* long int support for tabling
*
@ -83,11 +86,12 @@
OPCODE(table_new_answer ,s),
OPCODE(table_answer_resolution ,ld),
OPCODE(table_completion ,ld),
OPCODE(table_load_answer ,ld),
OPCODE(trie_do_nothing ,e),
OPCODE(trie_trust_nothing ,e),
OPCODE(trie_try_nothing ,e),
OPCODE(trie_retry_nothing ,e),
OPCODE(trie_do_null ,e),
OPCODE(trie_trust_null ,e),
OPCODE(trie_try_null ,e),
OPCODE(trie_retry_null ,e),
OPCODE(trie_do_var ,e),
OPCODE(trie_trust_var ,e),
OPCODE(trie_try_var ,e),
@ -108,6 +112,10 @@
OPCODE(trie_trust_struct ,e),
OPCODE(trie_try_struct ,e),
OPCODE(trie_retry_struct ,e),
OPCODE(trie_do_extension ,e),
OPCODE(trie_trust_extension ,e),
OPCODE(trie_try_extension ,e),
OPCODE(trie_retry_extension ,e),
OPCODE(trie_do_float ,e),
OPCODE(trie_trust_float ,e),
OPCODE(trie_try_float ,e),

18
H/rclause.h
View File

@ -12,8 +12,11 @@
* File: rclause.h *
* comments: walk through a clause *
* *
* Last rev: $Date: 2005-07-06 15:10:15 $,$Author: vsc $ *
* Last rev: $Date: 2005-07-06 19:34:11 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.8 2005/07/06 15:10:15 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.7 2005/06/04 07:26:43 ricroc
* long int support for tabling
*
@ -130,6 +133,7 @@ restore_opcodes(yamop *pc)
case _table_trust:
case _table_answer_resolution:
case _table_completion:
case _table_load_answer:
#endif /* TABLING */
pc->u.ld.p = PtoPredAdjust(pc->u.ld.p);
pc->u.ld.d = PtoOpAdjust(pc->u.ld.d);
@ -220,10 +224,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_null:
case _trie_trust_null:
case _trie_try_null:
case _trie_retry_null:
case _trie_do_var:
case _trie_trust_var:
case _trie_try_var:
@ -244,6 +248,10 @@ restore_opcodes(yamop *pc)
case _trie_trust_struct:
case _trie_try_struct:
case _trie_retry_struct:
case _trie_do_extension:
case _trie_trust_extension:
case _trie_try_extension:
case _trie_retry_extension:
case _trie_do_float:
case _trie_trust_float:
case _trie_try_float:

26
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h *
* comments: walk through heap code *
* *
* Last rev: $Date: 2005-07-06 15:10:15 $,$Author: vsc $ *
* Last rev: $Date: 2005-07-06 19:34:11 $,$Author: ricroc $ *
* $Log: not supported by cvs2svn $
* Revision 1.51 2005/07/06 15:10:15 vsc
* improvements to compiler: merged instructions and fixes for ->
*
* Revision 1.50 2005/06/01 13:53:46 vsc
* improve bb routines to use the DB efficiently
* change interface between DB and BB.
@ -103,18 +106,21 @@ restore_codes(void)
{
Yap_heap_regs->heap_top = AddrAdjust(OldHeapTop);
#ifdef YAPOR
Yap_heap_regs->getworkfirsttimecode.opc = Yap_opcode(_getwork_first_time);
Yap_heap_regs->getworkcode.opc = Yap_opcode(_getwork);
INIT_YAMOP_LTT(&(Yap_heap_regs->getworkcode), 0);
Yap_heap_regs->getworkcode_seq.opc = Yap_opcode(_getwork_seq);
INIT_YAMOP_LTT(&(Yap_heap_regs->getworkcode_seq), 0);
Yap_heap_regs->seq_def = TRUE;
Yap_heap_regs->getwork_code.opc = Yap_opcode(_getwork);
INIT_YAMOP_LTT(&(Yap_heap_regs->getwork_code), 0);
Yap_heap_regs->getwork_seq_code.opc = Yap_opcode(_getwork_seq);
INIT_YAMOP_LTT(&(Yap_heap_regs->getwork_seq_code), 0);
Yap_heap_regs->getwork_first_time_code.opc = Yap_opcode(_getwork_first_time);
#endif /* YAPOR */
#ifdef TABLING
Yap_heap_regs->tablecompletioncode.opc = Yap_opcode(_table_completion);
Yap_heap_regs->tableanswerresolutioncode.opc = Yap_opcode(_table_answer_resolution);
Yap_heap_regs->table_answer_resolution_code.opc = Yap_opcode(_table_answer_resolution);
Yap_heap_regs->table_completion_code.opc = Yap_opcode(_table_completion);
Yap_heap_regs->table_load_answer_code.opc = Yap_opcode(_table_load_answer);
#ifdef YAPOR
INIT_YAMOP_LTT(&(Yap_heap_regs->tablecompletioncode), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->tableanswerresolutioncode), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->table_completion_code), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->table_answer_resolution_code), 0);
INIT_YAMOP_LTT(&(Yap_heap_regs->table_load_answer_code), 0);
#endif /* YAPOR */
#endif /* TABLING */
Yap_heap_regs->expand_op_code = Yap_opcode(_expand_index);

5
H/tracer.h
View File

@ -22,8 +22,9 @@ typedef enum {
try_or,
retry_or,
retry_pred,
retry_table_producer,
retry_table_consumer
retry_table_generator,
retry_table_consumer,
retry_table_loader
} yap_low_level_port;
void STD_PROTO(low_level_trace,(yap_low_level_port, PredEntry *, CELL *));

3
OPTYap/opt.init.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.init.c
version: $Id: opt.init.c,v 1.7 2005-06-03 18:28:11 ricroc Exp $
version: $Id: opt.init.c,v 1.8 2005-07-06 19:33:54 ricroc Exp $
**********************************************************************/
@ -143,6 +143,7 @@ void init_global(int n_workers, int sch_loop, int delay_load) {
#ifdef TABLING
/* global data related to tabling */
GLOBAL_root_tab_ent = NULL;
for (i = 0; i < MAX_TABLE_VARS; i++)
GLOBAL_table_var_enumerator(i) = (CELL) & GLOBAL_table_var_enumerator(i);
#ifdef TABLE_LOCK_AT_WRITE_LEVEL

98
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.18 2005-06-04 08:05:27 ricroc Exp $
version: $Id: opt.preds.c,v 1.19 2005-07-06 19:33:54 ricroc Exp $
**********************************************************************/
@ -63,9 +63,9 @@ static void answer_to_stdout(char *answer);
#ifdef TABLING
static int p_do_table(void);
static int p_do_tabling_mode(void);
static int p_do_abolish_trie(void);
static int p_do_show_trie(void);
static int p_do_show_trie_stats(void);
static int p_do_abolish_table(void);
static int p_do_show_table(void);
static int p_do_show_table_stats(void);
#endif /* TABLING */
#ifdef STATISTICS
static int p_show_frames_stats(void);
@ -94,9 +94,9 @@ void Yap_init_optyap_preds(void) {
#ifdef TABLING
Yap_InitCPred("$do_table", 2, p_do_table, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_tabling_mode", 3, p_do_tabling_mode, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_abolish_trie", 2, p_do_abolish_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_show_trie", 2, p_do_show_trie, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_show_trie_stats", 2, p_do_show_trie_stats, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_abolish_table", 2, p_do_abolish_table, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_show_table", 2, p_do_show_table, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$do_show_table_stats", 2, p_do_show_table_stats, SafePredFlag|SyncPredFlag|HiddenPredFlag);
#endif /* TABLING */
#ifdef STATISTICS
Yap_InitCPred("show_frames_stats", 0, p_show_frames_stats, SafePredFlag|SyncPredFlag);
@ -459,8 +459,9 @@ static
int p_do_table(void) {
Term t, mod;
PredEntry *pe;
tab_ent_ptr te;
tab_ent_ptr tab_ent;
sg_node_ptr sg_node;
UInt arity;
mod = Deref(ARG2);
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
@ -470,9 +471,11 @@ int p_do_table(void) {
if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
arity = 0;
} else if (IsApplTerm(t)) {
Functor func = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(func, mod));
arity = ArityOfFunctor(func);
} else {
return (FALSE);
}
@ -481,51 +484,68 @@ int p_do_table(void) {
}
pe->PredFlags |= TabledPredFlag;
new_subgoal_trie_node(sg_node, 0, NULL, NULL, NULL);
new_table_entry(te, sg_node);
pe->TableOfPred = te;
new_table_entry(tab_ent, pe, arity, sg_node);
pe->TableOfPred = tab_ent;
return (TRUE);
}
static
int p_do_tabling_mode(void) {
Term t, mod, s;
Term mod, t, val;
tab_ent_ptr tab_ent;
mod = Deref(ARG2);
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
return (FALSE);
}
t = Deref(ARG1);
mod = Deref(ARG1);
t = Deref(ARG2);
if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
tab_ent = RepPredProp(PredPropByAtom(at, mod))->TableOfPred;
} else if (IsApplTerm(t)) {
Functor func = FunctorOfTerm(t);
tab_ent = RepPredProp(PredPropByFunc(func, mod))->TableOfPred;
} else {
Functor ft = FunctorOfTerm(t);
tab_ent = RepPredProp(PredPropByFunc(ft, mod))->TableOfPred;
} else
return (FALSE);
}
s = Deref(ARG3);
if (IsVarTerm(s)) {
Term sa;
if (TabEnt_mode(tab_ent) == batched) {
sa = MkAtomTerm(Yap_LookupAtom("batched"));
} else {
sa = MkAtomTerm(Yap_LookupAtom("local"));
}
Bind((CELL *)s, sa);
val = Deref(ARG3);
if (IsVarTerm(val)) {
Term mode;
t = MkAtomTerm(AtomNil);
if (IsDefaultMode_LoadAnswers(TabEnt_mode(tab_ent)))
mode = MkAtomTerm(Yap_LookupAtom("load_answers"));
else
mode = MkAtomTerm(Yap_LookupAtom("exec_answers"));
t = MkPairTerm(mode, t);
if (IsDefaultMode_Local(TabEnt_mode(tab_ent)))
mode = MkAtomTerm(Yap_LookupAtom("local"));
else
mode = MkAtomTerm(Yap_LookupAtom("batched"));
t = MkPairTerm(mode, t);
Bind((CELL *)val, t);
return(TRUE);
}
if (IsAtomTerm(s)) {
char *sa;
sa = RepAtom(AtomOfTerm(s))->StrOfAE;
if (strcmp(sa,"batched") == 0) {
TabEnt_mode(tab_ent) = batched;
if (IsAtomTerm(val)) {
char *str_val = RepAtom(AtomOfTerm(val))->StrOfAE;
if (strcmp(str_val,"batched") == 0) {
SetDefaultMode_Batched(TabEnt_mode(tab_ent));
if (IsMode_SchedulingOff(yap_flags[TABLING_MODE_FLAG]))
SetMode_Batched(TabEnt_mode(tab_ent));
return(TRUE);
}
if (strcmp(sa, "local") == 0) {
TabEnt_mode(tab_ent) = local;
if (strcmp(str_val,"local") == 0) {
SetDefaultMode_Local(TabEnt_mode(tab_ent));
if (IsMode_SchedulingOff(yap_flags[TABLING_MODE_FLAG]))
SetMode_Local(TabEnt_mode(tab_ent));
return(TRUE);
}
if (strcmp(str_val,"exec_answers") == 0) {
SetDefaultMode_ExecAnswers(TabEnt_mode(tab_ent));
if (IsMode_CompletedOff(yap_flags[TABLING_MODE_FLAG]))
SetMode_ExecAnswers(TabEnt_mode(tab_ent));
return(TRUE);
}
if (strcmp(str_val,"load_answers") == 0) {
SetDefaultMode_LoadAnswers(TabEnt_mode(tab_ent));
if (IsMode_CompletedOff(yap_flags[TABLING_MODE_FLAG]))
SetMode_LoadAnswers(TabEnt_mode(tab_ent));
return(TRUE);
}
}
@ -534,7 +554,7 @@ int p_do_tabling_mode(void) {
static
int p_do_abolish_trie(void) {
int p_do_abolish_table(void) {
Term t, mod;
tab_ent_ptr tab_ent;
sg_hash_ptr hash;
@ -570,7 +590,7 @@ int p_do_abolish_trie(void) {
static
int p_do_show_trie(void) {
int p_do_show_table(void) {
Term t1, mod;
PredEntry *pe;
Atom at;
@ -599,7 +619,7 @@ int p_do_show_trie(void) {
static
int p_do_show_trie_stats(void) {
int p_do_show_table_stats(void) {
Term t, mod;
PredEntry *pe;
Atom at;

4
OPTYap/opt.structs.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.structs.h
version: $Id: opt.structs.h,v 1.6 2005-05-31 08:24:24 ricroc Exp $
version: $Id: opt.structs.h,v 1.7 2005-07-06 19:34:10 ricroc Exp $
**********************************************************************/
@ -167,6 +167,7 @@ struct global_data{
#ifdef TABLING
/* global data related to tabling */
struct table_entry *root_table_entry;
struct dependency_frame *root_dependency_frame;
CELL table_var_enumerator[MAX_TABLE_VARS];
#ifdef TABLE_LOCK_AT_WRITE_LEVEL
@ -225,6 +226,7 @@ struct global_data{
#define GLOBAL_branch(worker, depth) (GLOBAL.branch[worker][depth])
#define PARALLEL_EXECUTION_MODE (GLOBAL.parallel_execution_mode)
#define GLOBAL_answers (GLOBAL.answers)
#define GLOBAL_root_tab_ent (GLOBAL.root_table_entry)
#define GLOBAL_root_dep_fr (GLOBAL.root_dependency_frame)
#define GLOBAL_table_var_enumerator(index) (GLOBAL.table_var_enumerator[index])
#define GLOBAL_table_lock(index) (GLOBAL.table_lock[index])

363
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.15 2005-06-04 08:05:27 ricroc Exp $
version: $Id: tab.insts.i,v 1.16 2005-07-06 19:34:10 ricroc Exp $
**********************************************************************/
@ -13,70 +13,76 @@
** Tabling instructions: auxiliary macros **
** ------------------------------------------------ */
#ifdef LOW_LEVEL_TRACER
#define store_low_level_trace_info(CP, TAB_ENT) CP->cp_tab_ent = TAB_ENT
#else
#define store_low_level_trace_info(CP, TAB_ENT)
#endif /* LOW_LEVEL_TRACER */
#ifdef TABLING_ERRORS
#define TABLING_ERRORS_check_stack \
if (Unsigned(H) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H + 1024 > B (check_stack)"); \
if (Unsigned(H_FZ) + 1024 > Unsigned(B)) \
#define TABLING_ERRORS_check_stack \
if (Unsigned(H) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H + 1024 > B (check_stack)"); \
if (Unsigned(H_FZ) + 1024 > Unsigned(B)) \
TABLING_ERROR_MESSAGE("H_FZ + 1024 > B (check_stack)")
#define TABLING_ERRORS_consume_answer_and_procceed \
if (IS_BATCHED_GEN_CP(B)) \
TABLING_ERROR_MESSAGE("IS_BATCHED_GEN_CP(B) (consume_answer_and_procceed)")
#else
#define TABLING_ERRORS_check_stack
#define TABLING_ERRORS_consume_answer_and_procceed
#endif /* TABLING_ERRORS */
#define store_generator_node(TAB_ENT, SG_FR, ARITY, AP) \
{ register int subs_arity = *YENV; \
register CELL *pt_args; \
register choiceptr gcp; \
/* store args */ \
pt_args = XREGS + (ARITY); \
while (pt_args > XREGS) { \
register CELL aux_arg = pt_args[0]; \
--YENV; \
--pt_args; \
*YENV = aux_arg; \
} \
/* initialize gcp and adjust subgoal frame field */ \
YENV = (CELL *) (GEN_CP(YENV) - 1); \
gcp = NORM_CP(YENV); \
SgFr_gen_cp(SG_FR) = gcp; \
/* store generator choice point */ \
HBREG = H; \
store_yaam_reg_cpdepth(gcp); \
gcp->cp_tr = TR; \
gcp->cp_ap = (yamop *)(AP); \
gcp->cp_h = H; \
gcp->cp_b = B; \
gcp->cp_env = ENV; \
gcp->cp_cp = CPREG; \
\
\
/*if (SgFr_abolish(SG_FR) == 0) {*/ \
if (subs_arity == 0 || \
(yap_flags[TABLING_MODE_FLAG] != TABLING_MODE_LOCAL && \
(TabEnt_mode(TAB_ENT) == batched || \
yap_flags[TABLING_MODE_FLAG] == TABLING_MODE_BATCHED))) { \
\
\
/* go batched */ \
GEN_CP(gcp)->cp_dep_fr = NULL; \
} else { \
/* go local */ \
register dep_fr_ptr new_dep_fr; \
/* adjust freeze registers */ \
H_FZ = H; \
B_FZ = gcp; \
TR_FZ = TR; \
/* store dependency frame */ \
new_dependency_frame(new_dep_fr, TRUE, LOCAL_top_or_fr, \
gcp, gcp, SG_FR, LOCAL_top_dep_fr); \
LOCAL_top_dep_fr = new_dep_fr; \
GEN_CP(gcp)->cp_dep_fr = LOCAL_top_dep_fr; \
} \
GEN_CP(gcp)->cp_sg_fr = SG_FR; \
set_cut((CELL *)gcp, B); \
B = gcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
#define store_generator_node(TAB_ENT, SG_FR, ARITY, AP) \
{ register int subs_arity = *YENV; \
register CELL *pt_args; \
register choiceptr gcp; \
/* store args */ \
pt_args = XREGS + (ARITY); \
while (pt_args > XREGS) { \
register CELL aux_arg = pt_args[0]; \
--YENV; \
--pt_args; \
*YENV = aux_arg; \
} \
/* initialize gcp and adjust subgoal frame field */ \
YENV = (CELL *) (GEN_CP(YENV) - 1); \
gcp = NORM_CP(YENV); \
SgFr_gen_cp(SG_FR) = gcp; \
/* store generator choice point */ \
HBREG = H; \
store_yaam_reg_cpdepth(gcp); \
gcp->cp_tr = TR; \
gcp->cp_ap = (yamop *)(AP); \
gcp->cp_h = H; \
gcp->cp_b = B; \
gcp->cp_env = ENV; \
gcp->cp_cp = CPREG; \
if (subs_arity && IsMode_Local(TabEnt_mode(TAB_ENT))) { \
/* go local */ \
register dep_fr_ptr new_dep_fr; \
/* adjust freeze registers */ \
H_FZ = H; \
B_FZ = gcp; \
TR_FZ = TR; \
/* store dependency frame */ \
new_dependency_frame(new_dep_fr, TRUE, LOCAL_top_or_fr, \
gcp, gcp, SG_FR, LOCAL_top_dep_fr); \
LOCAL_top_dep_fr = new_dep_fr; \
GEN_CP(gcp)->cp_dep_fr = LOCAL_top_dep_fr; \
} else { \
/* go batched */ \
GEN_CP(gcp)->cp_dep_fr = NULL; \
} \
GEN_CP(gcp)->cp_sg_fr = SG_FR; \
store_low_level_trace_info(GEN_CP(gcp), TAB_ENT); \
set_cut((CELL *)gcp, B); \
B = gcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
}
@ -127,7 +133,7 @@
}
#define store_consumer_node(SG_FR, LEADER_CP, DEP_ON_STACK) \
#define store_consumer_node(TAB_ENT, SG_FR, LEADER_CP, DEP_ON_STACK) \
{ register choiceptr ccp; \
register dep_fr_ptr new_dep_fr; \
/* initialize ccp */ \
@ -151,20 +157,15 @@
ccp->cp_env= ENV; \
ccp->cp_cp = CPREG; \
CONS_CP(ccp)->cp_dep_fr = LOCAL_top_dep_fr; \
set_cut((CELL *)ccp, B); \
store_low_level_trace_info(CONS_CP(ccp), TAB_ENT); \
/* set_cut((CELL *)ccp, B); --> no effect */ \
B = ccp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
}
#ifdef TABLING_ERRORS
#define TABLING_ERRORS_consume_answer_and_procceed \
if (IS_BATCHED_GEN_CP(B)) \
TABLING_ERROR_MESSAGE("IS_BATCHED_GEN_CP(B) (consume_answer_and_procceed)")
#else
#define TABLING_ERRORS_consume_answer_and_procceed
#endif /* TABLING_ERRORS */
#define consume_answer_and_procceed(DEP_FR, ANSWER) \
{ CELL *subs_ptr; \
/* restore consumer choice point */ \
@ -191,6 +192,50 @@
GONext(); \
}
#define store_loader_node(TAB_ENT, ANSWER) \
{ register choiceptr lcp; \
/* initialize lcp */ \
lcp = NORM_CP(LOAD_CP(YENV) - 1); \
/* store loader choice point */ \
HBREG = H; \
store_yaam_reg_cpdepth(lcp); \
lcp->cp_tr = TR; \
lcp->cp_ap = LOAD_ANSWER; \
lcp->cp_h = H; \
lcp->cp_b = B; \
lcp->cp_env= ENV; \
lcp->cp_cp = CPREG; \
LOAD_CP(lcp)->cp_last_answer = ANSWER; \
store_low_level_trace_info(LOAD_CP(lcp), TAB_ENT); \
/* set_cut((CELL *)lcp, B); --> no effect */ \
B = lcp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
}
#define restore_loader_node(ANSWER) \
H = HBREG = PROTECT_FROZEN_H(B); \
restore_yaam_reg_cpdepth(B); \
CPREG = B->cp_cp; \
ENV = B->cp_env; \
LOAD_CP(B)->cp_last_answer = ANSWER; \
SET_BB(PROTECT_FROZEN_B(B))
#define pop_loader_node() \
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))
#ifdef DEPTH_LIMIT
#define allocate_environment() \
YENV[E_CP] = (CELL) CPREG; \
@ -252,7 +297,7 @@
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(sg_fr, leader_cp, leader_dep_on_stack);
store_consumer_node(tab_ent, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
@ -271,11 +316,12 @@
goto answer_resolution;
} else {
/* subgoal completed */
if (SgFr_first_answer(sg_fr) == NULL) {
ans_node_ptr ans_node = SgFr_first_answer(sg_fr);
if (ans_node == NULL) {
/* no answers --> fail */
UNLOCK(SgFr_lock(sg_fr));
goto fail;
} else if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
} else if (ans_node == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) CPREG;
@ -283,15 +329,29 @@
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
/* answers -> get first answer */
if (IsMode_LoadAnswers(TabEnt_mode(tab_ent))) {
/* load answers from the trie */
UNLOCK(SgFr_lock(sg_fr));
if(TrNode_child(ans_node) != NULL) {
store_loader_node(tab_ent, ans_node);
}
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
load_answer_trie(ans_node, YENV);
YENV = ENV;
GONext();
} else {
/* execute compiled code from the trie */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
}
}
}
ENDPBOp();
@ -322,7 +382,7 @@
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(sg_fr, leader_cp, leader_dep_on_stack);
store_consumer_node(tab_ent, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
@ -341,7 +401,8 @@
goto answer_resolution;
} else {
/* subgoal completed */
if (SgFr_first_answer(sg_fr) == NULL) {
ans_node_ptr ans_node = SgFr_first_answer(sg_fr);
if (ans_node == NULL) {
/* no answers --> fail */
UNLOCK(SgFr_lock(sg_fr));
goto fail;
@ -353,15 +414,29 @@
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
/* answers -> get first answer */
if (IsMode_LoadAnswers(TabEnt_mode(tab_ent))) {
/* load answers from the trie */
UNLOCK(SgFr_lock(sg_fr));
if(TrNode_child(ans_node) != NULL) {
store_loader_node(tab_ent, ans_node);
}
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
load_answer_trie(ans_node, YENV);
YENV = ENV;
GONext();
} else {
/* execute compiled code from the trie */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
}
}
}
ENDPBOp();
@ -392,7 +467,7 @@
find_dependency_node(sg_fr, leader_cp, leader_dep_on_stack);
UNLOCK(SgFr_lock(sg_fr));
find_leader_node(leader_cp, leader_dep_on_stack);
store_consumer_node(sg_fr, leader_cp, leader_dep_on_stack);
store_consumer_node(tab_ent, sg_fr, leader_cp, leader_dep_on_stack);
#ifdef OPTYAP_ERRORS
if (PARALLEL_EXECUTION_MODE) {
choiceptr aux_cp;
@ -411,7 +486,8 @@
goto answer_resolution;
} else {
/* subgoal completed */
if (SgFr_first_answer(sg_fr) == NULL) {
ans_node_ptr ans_node = SgFr_first_answer(sg_fr);
if (ans_node == NULL) {
/* no answers --> fail */
UNLOCK(SgFr_lock(sg_fr));
goto fail;
@ -423,15 +499,29 @@
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
/* answers -> get first answer */
if (IsMode_LoadAnswers(TabEnt_mode(tab_ent))) {
/* load answers from the trie */
UNLOCK(SgFr_lock(sg_fr));
if(TrNode_child(ans_node) != NULL) {
store_loader_node(tab_ent, ans_node);
}
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
load_answer_trie(ans_node, YENV);
YENV = ENV;
GONext();
} else {
/* execute compiled code from the trie */
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
}
}
}
ENDPBOp();
@ -1307,7 +1397,8 @@
goto fail;
} else {
/* subgoal completed */
if (SgFr_first_answer(sg_fr) == NULL) {
ans_node = SgFr_first_answer(sg_fr);
if (ans_node == NULL) {
/* no answers --> fail */
B = B->cp_b;
SET_BB(PROTECT_FROZEN_B(B));
@ -1322,25 +1413,65 @@
}
#endif /* TABLING_ERRORS */
pop_generator_node(SgFr_arity(sg_fr));
if (SgFr_first_answer(sg_fr) == SgFr_answer_trie(sg_fr)) {
if (ans_node == SgFr_answer_trie(sg_fr)) {
/* yes answer --> procceed */
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
YENV = ENV;
GONext();
} else {
/* answers -> load first answer */
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
}
/* answers -> get first answer */
tab_ent_ptr tab_ent = SgFr_tab_ent(sg_fr);
if (IsMode_LoadAnswers(TabEnt_mode(tab_ent))) {
/* load answers from the trie */
if(TrNode_child(ans_node) != NULL) {
store_loader_node(tab_ent, ans_node);
}
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
load_answer_trie(ans_node, YENV);
YENV = ENV;
GONext();
} else {
/* execute compiled code from the trie */
LOCK(SgFr_lock(sg_fr));
if (SgFr_state(sg_fr) == complete)
update_answer_trie(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
PREG = (yamop *) TrNode_child(SgFr_answer_trie(sg_fr));
PREFETCH_OP(PREG);
*--YENV = 0; /* vars_arity */
*--YENV = 0; /* heap_arity */
GONext();
}
}
}
}
END_PREFETCH()
ENDBOp();
BOp(table_load_answer, ld);
CELL *subs_ptr;
ans_node_ptr ans_node;
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
PROBLEM: cp_last_answer field is local to the cp!
-> we need a shared data structure to avoid redundant computations!
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
}
#endif /* YAPOR */
subs_ptr = (CELL *) (LOAD_CP(B) + 1);
ans_node = TrNode_child(LOAD_CP(B)->cp_last_answer);
if(TrNode_child(ans_node) != NULL) {
restore_loader_node(ans_node);
} else {
pop_loader_node();
}
PREG = (yamop *) CPREG;
PREFETCH_OP(PREG);
load_answer_trie(ans_node, subs_ptr);
YENV = ENV;
GONext();
ENDBOp();

25
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.13 2005-06-03 08:19:18 ricroc Exp $
version: $Id: tab.macros.h,v 1.14 2005-07-06 19:34:10 ricroc Exp $
**********************************************************************/
@ -62,6 +62,7 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
#define NORM_CP(CP) ((choiceptr)(CP))
#define CONS_CP(CP) ((struct consumer_choicept *)(CP))
#define GEN_CP(CP) ((struct generator_choicept *)(CP))
#define LOAD_CP(CP) ((struct loader_choicept *)(CP))
#define IS_BATCHED_GEN_CP(CP) (GEN_CP(CP)->cp_dep_fr == NULL)
@ -226,16 +227,17 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
memcpy(SuspFr_trail_start(SUSP_FR), SuspFr_trail_reg(SUSP_FR), TR_SIZE)
#define new_subgoal_frame(SG_FR, ARITY) \
#define new_subgoal_frame(SG_FR, TAB_ENT, ARITY) \
{ register ans_node_ptr ans_node; \
ALLOC_SUBGOAL_FRAME(SG_FR); \
INIT_LOCK(SgFr_lock(SG_FR)); \
SgFr_tab_ent(SG_FR) = TAB_ENT; \
SgFr_arity(SG_FR) = ARITY; \
SgFr_abolish(SG_FR) = 0; \
new_answer_trie_node(ans_node, 0, 0, NULL, NULL, NULL); \
SgFr_answer_trie(SG_FR) = ans_node; \
SgFr_hash_chain(SG_FR) = NULL; \
SgFr_state(SG_FR) = start; \
SgFr_abolish(SG_FR) = 0; \
SgFr_arity(SG_FR) = ARITY; \
}
@ -262,11 +264,16 @@ STD_PROTO(static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames, (tg_sol_fr_p
DepFr_next(DEP_FR) = NEXT
#define new_table_entry(TAB_ENT, SUBGOAL_TRIE) \
ALLOC_TABLE_ENTRY(TAB_ENT); \
TabEnt_init_lock_field(TAB_ENT); \
TabEnt_subgoal_trie(TAB_ENT) = SUBGOAL_TRIE; \
TabEnt_hash_chain(TAB_ENT) = NULL
#define new_table_entry(TAB_ENT, PRED_ENTRY, ARITY, SUBGOAL_TRIE) \
ALLOC_TABLE_ENTRY(TAB_ENT); \
TabEnt_init_lock_field(TAB_ENT); \
TabEnt_pe(TAB_ENT) = PRED_ENTRY; \
TabEnt_arity(TAB_ENT) = ARITY; \
TabEnt_mode(TAB_ENT) = 0; \
TabEnt_subgoal_trie(TAB_ENT) = SUBGOAL_TRIE; \
TabEnt_hash_chain(TAB_ENT) = NULL; \
TabEnt_next(TAB_ENT) = GLOBAL_root_tab_ent; \
GLOBAL_root_tab_ent = TAB_ENT
#define new_subgoal_trie_node(NODE, ENTRY, CHILD, PARENT, NEXT) \

86
OPTYap/tab.structs.h
View File

@ -5,10 +5,46 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal
File: tab.structs.h
version: $Id: tab.structs.h,v 1.6 2005-06-04 08:05:27 ricroc Exp $
version: $Id: tab.structs.h,v 1.7 2005-07-06 19:34:10 ricroc Exp $
**********************************************************************/
/* ---------------------------- **
** Tabling mode flags **
** ---------------------------- */
#define Mode_SchedulingOn 0x10000000L /* yap_flags[TABLING_MODE_FLAG] */
#define Mode_CompletedOn 0x20000000L /* yap_flags[TABLING_MODE_FLAG] */
#define Mode_Local 0x00000010L /* yap_flags[TABLING_MODE_FLAG] + table_entry */
#define Mode_LoadAnswers 0x00000020L /* yap_flags[TABLING_MODE_FLAG] + table_entry */
#define DefaultMode_Local 0x00000001L /* table_entry */
#define DefaultMode_LoadAnswers 0x00000002L /* table_entry */
#define SetMode_SchedulingOn(X) (X) |= Mode_SchedulingOn
#define SetMode_CompletedOn(X) (X) |= Mode_CompletedOn
#define IsMode_SchedulingOn(X) ((X) & Mode_SchedulingOn)
#define IsMode_SchedulingOff(X) !IsMode_SchedulingOn(X)
#define IsMode_CompletedOn(X) ((X) & Mode_CompletedOn)
#define IsMode_CompletedOff(X) !IsMode_CompletedOn(X)
#define SetMode_Local(X) (X) |= Mode_Local
#define SetMode_Batched(X) (X) &= ~Mode_Local
#define SetMode_LoadAnswers(X) (X) |= Mode_LoadAnswers
#define SetMode_ExecAnswers(X) (X) &= ~Mode_LoadAnswers
#define IsMode_Local(X) ((X) & Mode_Local)
#define IsMode_LoadAnswers(X) ((X) & Mode_LoadAnswers)
#define SetDefaultMode_Local(X) (X) |= DefaultMode_Local
#define SetDefaultMode_Batched(X) (X) &= ~DefaultMode_Local
#define SetDefaultMode_LoadAnswers(X) (X) |= DefaultMode_LoadAnswers
#define SetDefaultMode_ExecAnswers(X) (X) &= ~DefaultMode_LoadAnswers
#define IsDefaultMode_Local(X) ((X) & DefaultMode_Local)
#define IsDefaultMode_LoadAnswers(X) ((X) & DefaultMode_LoadAnswers)
/* ---------------------------- **
** Struct table_entry **
** ---------------------------- */
@ -17,17 +53,18 @@ typedef struct table_entry {
#ifdef YAPOR
lockvar lock;
#endif /* YAPOR */
enum {
batched = 0,
local = 1
} tabling_mode;
struct pred_entry *pred_entry;
int pred_arity;
int mode_flags;
struct subgoal_trie_node *subgoal_trie;
struct subgoal_hash *hash_chain;
struct table_entry *next;
} *tab_ent_ptr;
#define TabEnt_lock(X) ((X)->lock)
#define TabEnt_mode(X) ((X)->tabling_mode)
#define TabEnt_pe(X) ((X)->pred_entry)
#define TabEnt_arity(X) ((X)->pred_arity)
#define TabEnt_mode(X) ((X)->mode_flags)
#define TabEnt_subgoal_trie(X) ((X)->subgoal_trie)
#define TabEnt_hash_chain(X) ((X)->hash_chain)
#define TabEnt_next(X) ((X)->next)
@ -117,6 +154,9 @@ typedef struct subgoal_frame {
int generator_worker;
struct or_frame *top_or_frame_on_generator_branch;
#endif /* YAPOR */
struct table_entry *tab_ent;
int subgoal_arity;
int abolish_operations;
choiceptr generator_choice_point;
struct answer_trie_node *answer_trie;
struct answer_trie_node *first_answer;
@ -126,24 +166,23 @@ typedef struct subgoal_frame {
start = 0,
evaluating = 1,
complete = 2,
executable = 3
compiled = 3
} state_flag;
int abolish_operations;
int subgoal_arity;
struct subgoal_frame *next;
} *sg_fr_ptr;
#define SgFr_lock(X) ((X)->lock)
#define SgFr_gen_worker(X) ((X)->generator_worker)
#define SgFr_gen_top_or_fr(X) ((X)->top_or_frame_on_generator_branch)
#define SgFr_tab_ent(X) ((X)->tab_ent)
#define SgFr_arity(X) ((X)->subgoal_arity)
#define SgFr_abolish(X) ((X)->abolish_operations)
#define SgFr_gen_cp(X) ((X)->generator_choice_point)
#define SgFr_answer_trie(X) ((X)->answer_trie)
#define SgFr_first_answer(X) ((X)->first_answer)
#define SgFr_last_answer(X) ((X)->last_answer)
#define SgFr_hash_chain(X) ((X)->hash_chain)
#define SgFr_state(X) ((X)->state_flag)
#define SgFr_abolish(X) ((X)->abolish_operations)
#define SgFr_arity(X) ((X)->subgoal_arity)
#define SgFr_next(X) ((X)->next)
/* ------------------------------------------------------------------------------------------- **
@ -153,6 +192,9 @@ typedef struct subgoal_frame {
When the generator choice point is shared the pointer is updated
to its or-frame. It is used to find the direct dependency node for
consumer nodes in other workers branches.
SgFr_tab_ent a pointer to the correspondent table entry.
SgFr_arity the arity of the subgoal.
SgFr_abolish the number of times the subgoal was abolished.
SgFr_gen_cp: a pointer to the correspondent generator choice point.
SgFr_answer_trie: a pointer to the top answer trie node.
It is used to check for/insert new answers.
@ -160,8 +202,6 @@ typedef struct subgoal_frame {
SgFr_last_answer: a pointer to the bottom answer trie node of the last available answer.
SgFr_hash_chain: a pointer to the first answer_hash struct for the subgoal in hand.
SgFr_state: a flag that indicates the subgoal state.
SgFr_abolish the number of times the subgoal was abolished.
SgFr_arity the arity of the subgoal.
SgFr_next: a pointer to chain between subgoal frames.
** ------------------------------------------------------------------------------------------- */
@ -252,17 +292,31 @@ typedef struct suspension_frame {
/* ---------------------------------------------------------- **
** Structs generator_choicept and consumer_choicept **
** ---------------------------------------------------------- */
/* --------------------------------------------------------------------------- **
** Structs generator_choicept, consumer_choicept and loader_choicept **
** --------------------------------------------------------------------------- */
struct generator_choicept {
struct choicept cp;
struct dependency_frame *cp_dep_fr; /* NULL if batched scheduling */
struct subgoal_frame *cp_sg_fr;
#ifdef LOW_LEVEL_TRACER
struct table_entry* cp_tab_ent;
#endif /* LOW_LEVEL_TRACER */
};
struct consumer_choicept {
struct choicept cp;
struct dependency_frame *cp_dep_fr;
#ifdef LOW_LEVEL_TRACER
struct table_entry* cp_tab_ent;
#endif /* LOW_LEVEL_TRACER */
};
struct loader_choicept {
struct choicept cp;
struct answer_trie_node *cp_last_answer;
#ifdef LOW_LEVEL_TRACER
struct table_entry* cp_tab_ent;
#endif /* LOW_LEVEL_TRACER */
};

18
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.12 2005-06-04 07:28:23 ricroc Exp $
version: $Id: tab.tries.c,v 1.13 2005-07-06 19:34:10 ricroc Exp $
**********************************************************************/
@ -747,7 +747,7 @@ sg_fr_ptr subgoal_search(tab_ent_ptr tab_ent, OPREG arity, CELL **Yaddr) {
#endif /* TABLE_LOCK_LEVEL */
if (TrNode_sg_fr(current_sg_node) == NULL) {
/* new tabled subgoal */
new_subgoal_frame(sg_fr, arity);
new_subgoal_frame(sg_fr, tab_ent, arity);
TrNode_sg_fr(current_sg_node) = (sg_node_ptr) sg_fr;
} else {
sg_fr = (sg_fr_ptr) TrNode_sg_fr(current_sg_node);
@ -819,16 +819,16 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
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);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_null);
#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);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, *(t_dbl + 1), _trie_retry_extension);
#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, *t_dbl, _trie_retry_extension);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_float);
} else if (f == FunctorLongInt) {
Int li = LongIntOfTerm (t);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_nothing);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, li, _trie_retry_nothing);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_null);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, li, _trie_retry_extension);
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_long);
} else {
current_ans_node = answer_trie_node_check_insert(sg_fr, current_ans_node, AbsAppl((Term *)f), _trie_retry_struct);
@ -1027,7 +1027,7 @@ void update_answer_trie(sg_fr_ptr sg_fr) {
update_answer_trie_branch(node);
#endif /* TABLING_INNER_CUTS */
}
SgFr_state(sg_fr) = executable;
SgFr_state(sg_fr) = compiled;
return;
}
@ -1095,7 +1095,7 @@ void traverse_trie(sg_node_ptr sg_node, int pred_arity, Atom pred_atom, int show
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", AtomName(pred_atom), pred_arity);
SHOW_INFO("\n[ Table structure for predicate '%s/%d' ]\n", AtomName(pred_atom), pred_arity);
TrStat_sg_nodes++;
if (sg_node && ! traverse_subgoal_trie(sg_node, str, str_index, arity, 1, TRAVERSE_NORMAL))
return;

194
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.9 2005-06-04 07:28:24 ricroc Exp $
version: $Id: tab.tries.insts.i,v 1.10 2005-07-06 19:34:11 ricroc Exp $
**********************************************************************/
@ -28,7 +28,7 @@
| subs ptr sa | |
------------------- |
| ... | -- subs_arity
------------------- |
------------------- |
| subs ptr 1 | |
------------------- --
| var ptr va | |
@ -63,13 +63,12 @@
/* -------------------------------------------------------------- **
** the 'store_trie_choice_point', 'restore_trie_choice_point' and **
** 'pop_trie_choice_point' macros do not include the 'set_cut' **
** macro because there are no cuts in trie instructions. **
** -------------------------------------------------------------- */
/* ---------------------------------------------------------------------------- **
** the 'store_trie_node', 'restore_trie_node' and 'pop_trie_node' macros do not **
** include the 'set_cut' macro because there are no cuts in trie instructions. **
** ---------------------------------------------------------------------------- */
#define store_trie_choice_point(AP) \
#define store_trie_node(AP) \
{ register choiceptr cp; \
YENV = (CELL *) (NORM_CP(YENV) - 1); \
cp = NORM_CP(YENV); \
@ -84,9 +83,10 @@
B = cp; \
YAPOR_SET_LOAD(B); \
SET_BB(B); \
TABLING_ERRORS_check_stack; \
}
#define restore_trie_choice_point(AP) \
#define restore_trie_node(AP) \
H = HBREG = PROTECT_FROZEN_H(B); \
restore_yaam_reg_cpdepth(B); \
CPREG = B->cp_cp; \
@ -96,7 +96,7 @@
YENV = (CELL *) PROTECT_FROZEN_B(B); \
SET_BB(NORM_CP(YENV))
#define pop_trie_choice_point() \
#define pop_trie_node() \
YENV = (CELL *) PROTECT_FROZEN_B((B+1)); \
H = PROTECT_FROZEN_H(B); \
pop_yaam_reg_cpdepth(B); \
@ -109,21 +109,21 @@
/* ---------------------- **
** trie_nothing **
** ---------------------- */
/* ------------------- **
** trie_null **
** ------------------- */
#define no_cp_trie_nothing_instr() \
*aux_ptr = TrNode_entry(node); \
#define no_cp_trie_null_instr() \
*aux_ptr = 0; \
*--aux_ptr = heap_arity + 1; \
YENV = aux_ptr; \
next_trie_instruction(node)
#define cp_trie_nothing_instr() \
#define cp_trie_null_instr() \
aux_ptr += heap_arity + subs_arity + vars_arity + 2; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \
*--YENV = *aux_ptr--; \
*--YENV = TrNode_entry(node); \
*--YENV = 0; \
*--YENV = heap_arity + 1; \
next_trie_instruction(node)
@ -467,11 +467,31 @@
/* ---------------------------------------- **
** trie_extension (float/longint) **
** ---------------------------------------- */
/* ------------------------ **
** trie_extension **
** ------------------------ */
#define no_cp_trie_extension_instr() \
#define no_cp_trie_extension_instr() \
*aux_ptr = TrNode_entry(node); \
*--aux_ptr = heap_arity + 1; \
YENV = aux_ptr; \
next_trie_instruction(node)
#define cp_trie_extension_instr() \
aux_ptr += heap_arity + subs_arity + vars_arity + 2; \
for (i = 0; i < heap_arity + subs_arity + vars_arity + 2; i++) \
*--YENV = *aux_ptr--; \
*--YENV = TrNode_entry(node); \
*--YENV = heap_arity + 1; \
next_trie_instruction(node)
/* ---------------------------- **
** trie_float_longint **
** ---------------------------- */
#define no_cp_trie_float_longint_instr() \
if (heap_arity) { \
aux_ptr++; \
YENV = ++aux_ptr; \
@ -498,16 +518,16 @@
** Trie instructions **
** --------------------------- */
PBOp(trie_do_nothing, e)
PBOp(trie_do_null, 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();
no_cp_trie_null_instr();
ENDPBOp();
PBOp(trie_try_nothing, e)
PBOp(trie_try_null, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
@ -515,12 +535,12 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(TrNode_next(node));
cp_trie_nothing_instr();
store_trie_node(TrNode_next(node));
cp_trie_null_instr();
ENDPBOp();
PBOp(trie_retry_nothing, e)
PBOp(trie_retry_null, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
@ -528,12 +548,12 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
cp_trie_nothing_instr();
restore_trie_node(TrNode_next(node));
cp_trie_null_instr();
ENDPBOp();
PBOp(trie_trust_nothing, e)
PBOp(trie_trust_null, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
@ -543,16 +563,16 @@
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
cp_trie_nothing_instr();
restore_trie_node(NULL);
cp_trie_null_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_nothing_instr();
cp_trie_null_instr();
} else {
no_cp_trie_nothing_instr();
no_cp_trie_null_instr();
}
}
ENDPBOp();
@ -580,7 +600,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(TrNode_next(node));
store_trie_node(TrNode_next(node));
cp_trie_var_instr();
ENDPBOp();
@ -594,7 +614,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
restore_trie_node(TrNode_next(node));
cp_trie_var_instr();
ENDPBOp();
@ -610,12 +630,12 @@
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
restore_trie_node(NULL);
cp_trie_var_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_var_instr();
} else {
@ -649,7 +669,7 @@
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i;
store_trie_choice_point(TrNode_next(node));
store_trie_node(TrNode_next(node));
cp_trie_val_instr();
ENDPBOp();
@ -664,7 +684,7 @@
int var_index = VarIndexOfTableTerm(TrNode_entry(node));
int i;
restore_trie_choice_point(TrNode_next(node));
restore_trie_node(TrNode_next(node));
cp_trie_val_instr();
ENDPBOp();
@ -681,12 +701,12 @@
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
restore_trie_node(NULL);
cp_trie_val_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_val_instr();
} else {
@ -716,7 +736,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(TrNode_next(node));
store_trie_node(TrNode_next(node));
cp_trie_atom_instr();
ENDPBOp();
@ -729,7 +749,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
restore_trie_node(TrNode_next(node));
cp_trie_atom_instr();
ENDPBOp();
@ -744,12 +764,12 @@
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
restore_trie_node(NULL);
cp_trie_atom_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_atom_instr();
} else {
@ -779,7 +799,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
store_trie_choice_point(TrNode_next(node));
store_trie_node(TrNode_next(node));
cp_trie_list_instr();
ENDPBOp();
@ -792,7 +812,7 @@
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_choice_point(TrNode_next(node));
restore_trie_node(TrNode_next(node));
cp_trie_list_instr();
ENDPBOp();
@ -807,12 +827,12 @@
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
restore_trie_node(NULL);
cp_trie_list_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_list_instr();
} else {
@ -846,7 +866,7 @@
int func_arity = ArityOfFunctor(func);
int i;
store_trie_choice_point(TrNode_next(node));
store_trie_node(TrNode_next(node));
cp_trie_struct_instr();
ENDPBOp();
@ -861,7 +881,7 @@
int func_arity = ArityOfFunctor(func);
int i;
restore_trie_choice_point(TrNode_next(node));
restore_trie_node(TrNode_next(node));
cp_trie_struct_instr();
ENDPBOp();
@ -878,12 +898,12 @@
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
restore_trie_choice_point(NULL);
restore_trie_node(NULL);
cp_trie_struct_instr();
} else
#endif /* YAPOR */
{
pop_trie_choice_point();
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_struct_instr();
} else {
@ -893,6 +913,66 @@
ENDPBOp();
PBOp(trie_do_extension, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
int heap_arity = *aux_ptr;
no_cp_trie_extension_instr();
ENDPBOp();
PBOp(trie_try_extension, 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_node(TrNode_next(node));
cp_trie_extension_instr();
ENDPBOp();
PBOp(trie_retry_extension, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = (CELL *) (B + 1);
int heap_arity = *aux_ptr;
int vars_arity = *(aux_ptr + heap_arity + 1);
int subs_arity = *(aux_ptr + heap_arity + 2);
int i;
restore_trie_node(TrNode_next(node));
cp_trie_extension_instr();
ENDPBOp();
PBOp(trie_trust_extension, 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_node(NULL);
cp_trie_extension_instr();
} else
#endif /* YAPOR */
{
pop_trie_node();
if ((choiceptr) YENV == B_FZ) {
cp_trie_extension_instr();
} else {
no_cp_trie_extension_instr();
}
}
ENDPBOp();
PBOp(trie_do_float, e)
register ans_node_ptr node = (ans_node_ptr) PREG;
register CELL *aux_ptr = YENV;
@ -912,7 +992,7 @@
heap_arity -= 2;
#endif /* SIZEOF_DOUBLE x SIZEOF_LONG_INT */
t = MkFloatTerm(dbl);
no_cp_trie_extension_instr();
no_cp_trie_float_longint_instr();
ENDPBOp();
@ -940,7 +1020,7 @@
int i;
Term t = MkLongIntTerm(*++aux_ptr);
heap_arity -= 2;
no_cp_trie_extension_instr();
no_cp_trie_float_longint_instr();
ENDPBOp();

37
pl/directives.yap
View File

@ -220,7 +220,7 @@ yap_flag(index,X) :-
yap_flag(home,X) :-
'$yap_home'(X).
% should match definitions in Yap.h.m4
% should match definitions in Yap.h
'$transl_to_index_mode'(0, off).
'$transl_to_index_mode'(1, single).
'$transl_to_index_mode'(2, compact).
@ -228,25 +228,26 @@ yap_flag(home,X) :-
'$transl_to_index_mode'(3, on). % default is multi argument indexing
'$transl_to_index_mode'(4, max).
% tabling schedulinhg mode
yap_flag(tabling_mode,X) :- var(X),
'$access_yap_flags'(19, X1),
'$transl_to_tabling_mode'(X1,X), !.
yap_flag(tabling_mode,X) :-
'$access_yap_flags'(19, X1),
'$transl_to_tabling_mode'(X1,off), !,
'$do_error'(permission_error(modify,flag,tabling_mode),yap_flag(tabling_mode,X)).
yap_flag(tabling_mode,X) :- X \= off,
'$transl_to_tabling_mode'(X1,X), !,
'$set_yap_flags'(19,X1).
yap_flag(tabling_mode,X) :-
'$do_error'(domain_error(flag_value,tabling_mode+X),yap_flag(tabling_mode,X)).
% tabling mode
yap_flag(tabling_mode,Options) :-
var(Options), !,
'$access_yap_flags'(19,Options).
yap_flag(tabling_mode,[]) :- !.
yap_flag(tabling_mode,[HOption|TOption]) :- !,
yap_flag(tabling_mode,HOption),
yap_flag(tabling_mode,TOption).
yap_flag(tabling_mode,Option) :-
'$transl_to_tabling_mode'(Flag,Option),
'$set_yap_flags'(19,Flag).
yap_flag(tabling_mode,Options) :-
'$do_error'(domain_error(flag_value,tabling_mode+Options),yap_flag(tabling_mode,Options)).
% should match definitions in Yap.h.m4
'$transl_to_tabling_mode'(0,off).
% should match with code in stdpreds.c
'$transl_to_tabling_mode'(0,default).
'$transl_to_tabling_mode'(1,batched).
'$transl_to_tabling_mode'(2,local).
'$transl_to_tabling_mode'(3,default).
'$transl_to_tabling_mode'(3,exec_answers).
'$transl_to_tabling_mode'(4,load_answers).
yap_flag(informational_messages,X) :- var(X), !,
get_value('$verbose',X).
@ -610,7 +611,7 @@ yap_flag(host_type,X) :-
V = home ;
V = host_type ;
V = index ;
V = tabling ;
V = tabling_mode ;
V = informational_messages ;
V = integer_rounding_function ;
V = language ;

141
pl/tabling.yap
View File

@ -15,10 +15,14 @@
* *
*************************************************************************/
:- meta_predicate table(:), tabling_mode(:), abolish_trie(:), show_trie(:), show_trie_stats(:).
:- meta_predicate table(:), tabling_mode(:), abolish_table(:), show_table(:), show_table_stats(:).
/******************
* table/1 *
******************/
table(P) :- '$current_module'(M), '$table'(P,M).
'$table'(P,M) :- var(P), !, '$do_error'(instantiation_error,table(M:P)).
@ -35,64 +39,101 @@ table(P) :- '$current_module'(M), '$table'(P,M).
tabling_mode(P,S) :- '$current_module'(M), '$tabling_mode'(P,M,S).
/*************************
* tabling_mode/2 *
*************************/
'$tabling_mode'(P,M,S) :- var(P), !, '$do_error'(instantiation_error,tabling_mode(M:P,S)).
'$tabling_mode'(M:P,_,S) :- !, '$tabling_mode'(P,M,S).
'$tabling_mode'([],_,_) :- !.
'$tabling_mode'([H|T],M,S) :- !, '$tabling_mode'(H,M,S), '$tabling_mode'(T,M,S).
'$tabling_mode'((P1,P2),M,S) :- !, '$tabling_mode'(P1,M,S), '$tabling_mode'(P2,M,S).
'$tabling_mode'(A/N,M,S) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$set_tabling_mode'(T,M,S)
tabling_mode(Pred,Options) :-
'$current_module'(Mod),
'$tabling_mode'(Mod,Pred,Options).
'$tabling_mode'(Mod,Pred,Options) :-
var(Pred), !,
'$do_error'(instantiation_error,tabling_mode(Mod:Pred,Options)).
'$tabling_mode'(_,Mod:Pred,Options) :- !,
'$tabling_mode'(Mod,Pred,Options).
'$tabling_mode'(_,[],_) :- !.
'$tabling_mode'(Mod,[HPred|TPred],Options) :- !,
'$tabling_mode'(Mod,HPred,Options),
'$tabling_mode'(Mod,TPred,Options).
'$tabling_mode'(Mod,PredName/PredArity,Options) :-
atom(PredName),
integer(PredArity), !,
functor(PredFunctor,PredName,PredArity),
'$flags'(PredFunctor,Mod,Flags,Flags),
(Flags /\ 0x000040 =\= 0, !, '$set_tabling_mode'(Mod,PredFunctor,Options)
;
'$do_error'(domain_error(table,Mod:PredName/PredArity),tabling_mode(Mod:PredName/PredArity,Options))).
'$tabling_mode'(Mod,Pred,Options) :-
'$do_error'(type_error(callable,Pred),tabling_mode(Mod:Pred,Options)).
'$set_tabling_mode'(Mod,PredFunctor,Options) :-
var(Options), !,
'$do_tabling_mode'(Mod,PredFunctor,Options).
'$set_tabling_mode'(Mod,PredFunctor,[]) :- !.
'$set_tabling_mode'(Mod,PredFunctor,[HOption|TOption]) :- !,
'$set_tabling_mode'(Mod,PredFunctor,HOption),
'$set_tabling_mode'(Mod,PredFunctor,TOption).
'$set_tabling_mode'(Mod,PredFunctor,Option) :-
(Option = batched ; Option = local ; Option = exec_answers ; Option = load_answers), !,
'$do_tabling_mode'(Mod,PredFunctor,Option).
'$set_tabling_mode'(Mod,PredFunctor,Options) :-
functor(PredFunctor,PredName,PredArity),
'$do_error'(domain_error(flag_value,tabling_mode+Options),tabling_mode(Mod:PredName/PredArity,Options)).
/**************************
* abolish_table/1 *
**************************/
abolish_table(P) :- '$current_module'(M), '$abolish_table'(P,M).
'$abolish_table'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_table(M:P)).
'$abolish_table'(M:P,_) :- !, '$abolish_table'(P,M).
'$abolish_table'([],_) :- !.
'$abolish_table'([H|T],M) :- !, '$abolish_table'(H,M), '$abolish_table'(T,M).
'$abolish_table'((P1,P2),M) :- !, '$abolish_table'(P1,M), '$abolish_table'(P2,M).
'$abolish_table'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$do_abolish_table'(T,M)
;
'$do_error'(domain_error(table,M:A/N),tabling_mode(M:A/N,S))).
'$tabling_mode'(P,M,S) :- '$do_error'(type_error(callable,P),tabling_mode(M:P,S)).
'$set_tabling_mode'(T,M,S) :- var(S), !, '$do_tabling_mode'(T,M,S).
'$set_tabling_mode'(T,M,S) :- (S = local ; S = batched), !, '$do_tabling_mode'(T,M,S).
'$set_tabling_mode'(T,M,S) :- functor(T,A,N), '$do_error'(domain_error(flag_value,tabling_mode+S),tabling_mode(M:A/N,S)).
'$do_error'(domain_error(table,M:A/N),abolish_table(M:A/N))).
'$abolish_table'(P,M) :- '$do_error'(type_error(callable,P),abolish_table(M:P)).
abolish_trie(P) :- '$current_module'(M), '$abolish_trie'(P,M).
/***********************
* show_table/1 *
***********************/
'$abolish_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,abolish_trie(M:P)).
'$abolish_trie'(M:P,_) :- !, '$abolish_trie'(P,M).
'$abolish_trie'([],_) :- !.
'$abolish_trie'([H|T],M) :- !, '$abolish_trie'(H,M), '$abolish_trie'(T,M).
'$abolish_trie'((P1,P2),M) :- !, '$abolish_trie'(P1,M), '$abolish_trie'(P2,M).
'$abolish_trie'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$do_abolish_trie'(T,M)
show_table(P) :- '$current_module'(M), '$show_table'(P,M).
'$show_table'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_table(M:P)).
'$show_table'(M:P,_) :- !, '$show_table'(P,M).
'$show_table'([],_) :- !.
'$show_table'([H|T],M) :- !, '$show_table'(H,M), '$show_table'(T,M).
'$show_table'((P1,P2),M) :- !, '$show_table'(P1,M), '$show_table'(P2,M).
'$show_table'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$do_show_table'(T,M)
;
'$do_error'(domain_error(table,M:A/N),abolish_trie(M:A/N))).
'$abolish_trie'(P,M) :- '$do_error'(type_error(callable,P),abolish_trie(M:P)).
'$do_error'(domain_error(table,M:A/N),show_table(M:A/N))).
'$show_table'(P,M) :- '$do_error'(type_error(callable,P),show_table(M:P)).
show_trie(P) :- '$current_module'(M), '$show_trie'(P,M).
/*****************************
* show_table_stats/1 *
*****************************/
'$show_trie'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie(M:P)).
'$show_trie'(M:P,_) :- !, '$show_trie'(P,M).
'$show_trie'([],_) :- !.
'$show_trie'([H|T],M) :- !, '$show_trie'(H,M), '$show_trie'(T,M).
'$show_trie'((P1,P2),M) :- !, '$show_trie'(P1,M), '$show_trie'(P2,M).
'$show_trie'(A/N,M) :- integer(N), atom(A), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$do_show_trie'(T,M)
show_table_stats(P) :- '$current_module'(M), '$show_table_stats'(P,M).
'$show_table_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_table_stats(M:P)).
'$show_table_stats'(M:P,_) :- !, '$show_table_stats'(P,M).
'$show_table_stats'([],_) :- !.
'$show_table_stats'([H|T],M) :- !, '$show_table_stats'(H,M), '$show_table_stats'(T,M).
'$show_table_stats'((P1,P2),M) :- !, '$show_table_stats'(P1,M), '$show_table_stats'(P2,M).
'$show_table_stats'(A/N,M) :- atom(A), integer(N), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$do_show_table_stats'(T,M)
;
'$do_error'(domain_error(table,M:A/N),show_trie(M:A/N))).
'$show_trie'(P,M) :- '$do_error'(type_error(callable,P),show_trie(M:P)).
show_trie_stats(P) :- '$current_module'(M), '$show_trie_stats'(P,M).
'$show_trie_stats'(P,M) :- var(P), !, '$do_error'(instantiation_error,show_trie_stats(M:P)).
'$show_trie_stats'(M:P,_) :- !, '$show_trie_stats'(P,M).
'$show_trie_stats'([],_) :- !.
'$show_trie_stats'([H|T],M) :- !, '$show_trie_stats'(H,M), '$show_trie_stats'(T,M).
'$show_trie_stats'((P1,P2),M) :- !, '$show_trie_stats'(P1,M), '$show_trie_stats'(P2,M).
'$show_trie_stats'(A/N,M) :- atom(A), integer(N), !, functor(T,A,N), '$flags'(T,M,F,F),
(F /\ 0x000040 =\= 0, !, '$do_show_trie_stats'(T,M)
;
'$do_error'(domain_error(table,M:A/N),show_trie_stats(M:A/N))).
'$show_trie_stats'(P,M) :- '$do_error'(type_error(callable,P),show_trie_stats(M:P)).
'$do_error'(domain_error(table,M:A/N),show_table_stats(M:A/N))).
'$show_table_stats'(P,M) :- '$do_error'(type_error(callable,P),show_table_stats(M:P)).