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

fix tabling

Browse Source 
allow atom gc again for now.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1300 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2005-05-30 05:26:50 +00:00
parent b45acf1195
commit bb9077d5cc
5 changed files with 49 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
C/agc.c
View File

@ -25,8 +25,9 @@ static char SccsId[] = "@(#)agc.c 1.3 3/15/90";
#include "attvar.h"
#ifdef DEBUG
#define DEBUG_RESTORE1 1
/* #define DEBUG_RESTORE1 1 */
/* #define DEBUG_RESTORE2 1 */
#define DEBUG_RESTORE3 1
#define errout Yap_stderr
#endif
@ -190,7 +191,7 @@ mark_atoms(void)
return;
}
do {
#ifdef DEBUG_RESTORE2 /* useful during debug */
#ifdef DEBUG_RESTORE1 /* useful during debug */
fprintf(errout, "Restoring %s\n", at->StrOfAE);
#endif
RestoreEntries(RepProp(at->PropsOfAE));
@ -323,7 +324,7 @@ clean_atoms(void)
atm = at->NextOfAE;
NOfAtoms--;
} else {
#ifdef DEBUG_RESTORE2
#ifdef DEBUG_RESTORE3
fprintf(stderr, "Purged %s\n", at->StrOfAE);
#endif
*patm = at->NextOfAE;
@ -343,7 +344,7 @@ clean_atoms(void)
NOfAtoms--;
atm = at->NextOfAE;
} else {
#ifdef DEBUG_RESTORE2
#ifdef DEBUG_RESTORE1
fprintf(stderr, "Purged %s\n", at->StrOfAE);
#endif
*patm = at->NextOfAE;
@ -396,7 +397,6 @@ Yap_atom_gc(void)
static Int
p_atom_gc(void)
{
return TRUE;
#ifndef FIXED_STACKS
atom_gc();
#endif /* FIXED_STACKS */

20
C/amasm.c
View File

@ -11,8 +11,12 @@
* File: amasm.c *
* comments: abstract machine assembler *
* *
* Last rev: $Date: 2005-05-25 21:43:32 $ *
* Last rev: $Date: 2005-05-30 05:26:49 $ *
* $Log: not supported by cvs2svn $
* Revision 1.74 2005/05/25 21:43:32 vsc
* fix compiler bug in 1 << X, found by Nuno Fonseca.
* compiler internal errors get their own message.
*
* Revision 1.73 2005/04/10 04:01:09 vsc
* bug fixes, I hope!
*
@ -2285,9 +2289,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
#endif /* YAPOR */
int log_update;
int dynamic;
#ifdef TABLING
int tabled;
#endif
int ystop_found = FALSE;
union clause_obj *cl_u;
yamop *code_p;
@ -2309,9 +2311,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
/* Space while for the clause flags */
log_update = cip->CurrentPred->PredFlags & LogUpdatePredFlag;
dynamic = cip->CurrentPred->PredFlags & DynamicPredFlag;
#ifdef TABLING
tabled = cip->CurrentPred->PredFlags & TabledPredFlag;
#endif
if (assembling == ASSEMBLING_CLAUSE) {
if (log_update) {
if (pass_no) {
@ -2359,11 +2359,17 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
}
IPredArity = cip->cpc->rnd2; /* number of args */
*entry_codep = code_p;
if (tabled) {
#if TABLING
printf("Here I go at %p\n", code_p);
code_p = a_try(_table_try_single, (CELL)NEXTOP(code_p,ld), IPredArity, &clinfo, code_p, pass_no);
#endif
}
if (dynamic) {
#ifdef YAPOR
a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, 1, 0, code_p, pass_no);
code_p = a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, 1, 0, code_p, pass_no);
#else
a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, code_p, pass_no);
code_p = a_try(TRYOP(_try_me, _try_me0), 0, IPredArity, &clinfo, code_p, pass_no);
#endif /* YAPOR */
}
} else {

44
C/index.c
View File

@ -11,8 +11,12 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2005-05-27 21:44:00 $,$Author: vsc $ *
* Last rev: $Date: 2005-05-30 05:26:49 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.127 2005/05/27 21:44:00 vsc
* Don't try to mess with sequences that don't end with a trust.
* A fix for the atom garbage collector actually ignore floats ;-).
*
* Revision 1.126 2005/05/25 18:58:37 vsc
* fix another bug in nth_instance, thanks to Pat Caldon
*
@ -2070,6 +2074,8 @@ add_info(ClauseDef *clause, UInt regno)
#endif /* YAPOR */
#ifdef TABLING
case _table_try_single:
cl = NEXTOP(cl,ld);
break;
case _table_try_me:
case _table_retry_me:
case _table_trust_me:
@ -3017,7 +3023,10 @@ static void
emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl, int clauses)
{
PredEntry *ap = cint->CurrentPred;
yamop *clcode = cl->Code;
if (ap->PredFlags & TabledPredFlag)
clcode = NEXTOP(clcode, ld);
if (ap->PredFlags & ProfiledPredFlag) {
Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
}
@ -3025,9 +3034,9 @@ emit_trust(ClauseDef *cl, struct intermediates *cint, UInt nxtlbl, int clauses)
Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
}
if (clauses == 0) {
Yap_emit(trust_op, (CELL)(cl->Code), has_cut(cl->CurrentCode) , cint);
Yap_emit(trust_op, (CELL)clcode, has_cut(cl->CurrentCode) , cint);
} else {
Yap_emit(retry_op, (CELL)(cl->Code), (clauses << 1) | has_cut(cl->CurrentCode) , cint);
Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->CurrentCode) , cint);
Yap_emit(jumpi_op, nxtlbl, Zero, cint);
}
}
@ -3036,14 +3045,17 @@ static void
emit_retry(ClauseDef *cl, struct intermediates *cint, int clauses)
{
PredEntry *ap = cint->CurrentPred;
yamop *clcode = cl->Code;
if (ap->PredFlags & TabledPredFlag)
clcode = NEXTOP(clcode, ld);
if (ap->PredFlags & ProfiledPredFlag) {
Yap_emit(retry_profiled_op, Unsigned(ap), Zero, cint);
}
if (ap->PredFlags & CountPredFlag) {
Yap_emit(count_retry_op, Unsigned(ap), Zero, cint);
}
Yap_emit(retry_op, (CELL)(cl->Code), (clauses << 1) | has_cut(cl->CurrentCode), cint);
Yap_emit(retry_op, (CELL)clcode, (clauses << 1) | has_cut(cl->CurrentCode), cint);
}
static compiler_vm_op
@ -3079,8 +3091,15 @@ emit_optry(int var_group, int first, int clauses, int clleft, PredEntry *ap)
static void
emit_try(ClauseDef *cl, struct intermediates *cint, int var_group, int first, int clauses, int clleft, UInt nxtlbl)
{
PredEntry *ap = cint->CurrentPred;
yamop *clcode = cl->CurrentCode;
if (ap->PredFlags & TabledPredFlag) {
clcode = NEXTOP(cl->Code, ld);
}
compiler_vm_op comp_op = emit_optry(var_group, first, clauses, clleft, cint->CurrentPred);
Yap_emit(comp_op, (CELL)(cl->CurrentCode), ((clauses+clleft) << 1) | has_cut(cl->CurrentCode), cint);
Yap_emit(comp_op, (CELL)clcode, ((clauses+clleft) << 1) | has_cut(cl->CurrentCode), cint);
}
static TypeSwitch *
@ -3377,19 +3396,14 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i
{
#ifdef TABLING
if (cint->CurrentPred->PredFlags & TabledPredFlag) {
/* we have two differences with tabling:
1. we cannot allow straight jumps to clauses, otherwise thetabled
would never get to be created.
2. we don't clean trust at the very end of computation.
/* with tabling we don't clean trust at the very end of computation.
*/
if (clleft == 0) {
if (clleft == 0 && !first) {
UInt lbl = new_label();
Yap_emit(label_op, lbl, Zero, cint);
if (first) {
Yap_emit(table_try_single_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode), cint);
} else {
Yap_emit(trust_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode), cint);
}
/* vsc: should check if this condition is sufficient */
Yap_emit(trust_op, (UInt)(min->CurrentCode), has_cut(cl->CurrentCode), cint);
return lbl;
}
}

7
H/Yatom.h
View File

@ -1,10 +1,3 @@
/*************************************************************************
* *
* YAP Prolog %W% %G%

3
OPTYap/tab.insts.i
View File

@ -214,7 +214,8 @@ if (IS_BATCHED_GEN_CP(B)) printf("***** Cannot be here - batched scheduling\n");
init_subgoal_frame(sg_fr);
UNLOCK(SgFr_lock(sg_fr));
store_generator_node(PREG->u.ld.s, COMPLETION, sg_fr);
PREG = PREG->u.ld.d;
/* PREG = PREG->u.ld.d; */
PREG = NEXTOP(PREG,ld);
PREFETCH_OP(PREG);
allocate_environment(YENV);
GONext();