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

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

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

53
C/absmi.c
View File

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

14
C/cdmgr.c
View File

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

457
C/heapgc.c
View File

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

33
C/index.c
View File

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

32
C/init.c
View File

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

87
C/stdpreds.c
View File

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

48
C/tracer.c
View File

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