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:
parent
6d34ce46f3
commit
3a93e0e079
53
C/absmi.c
53
C/absmi.c
@ -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
14
C/cdmgr.c
@ -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
457
C/heapgc.c
@ -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
33
C/index.c
@ -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
32
C/init.c
@ -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
87
C/stdpreds.c
@ -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
48
C/tracer.c
@ -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
26
H/Heap.h
@ -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
10
H/Yap.h
@ -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 */
|
||||
|
@ -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
18
H/rclause.h
@ -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
26
H/rheap.h
@ -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);
|
||||
|
@ -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 *));
|
||||
|
@ -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
|
||||
|
@ -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;
|
||||
|
@ -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])
|
||||
|
@ -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();
|
||||
|
@ -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) \
|
||||
|
@ -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 */
|
||||
};
|
||||
|
@ -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;
|
||||
|
@ -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();
|
||||
|
||||
|
||||
|
@ -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
141
pl/tabling.yap
@ -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)).
|
||||
|
Reference in New Issue
Block a user