diff --git a/C/agc.c b/C/agc.c index 992e6a09a..3557fe2e5 100644 --- a/C/agc.c +++ b/C/agc.c @@ -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 */ diff --git a/C/amasm.c b/C/amasm.c index 22e272e1a..fb88eac53 100644 --- a/C/amasm.c +++ b/C/amasm.c @@ -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 { diff --git a/C/index.c b/C/index.c index 84e25be29..025824d74 100644 --- a/C/index.c +++ b/C/index.c @@ -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; } } diff --git a/H/Yatom.h b/H/Yatom.h index 9dba39d18..6b34ed741 100644 --- a/H/Yatom.h +++ b/H/Yatom.h @@ -1,10 +1,3 @@ - - - - - - - /************************************************************************* * * * YAP Prolog %W% %G% diff --git a/OPTYap/tab.insts.i b/OPTYap/tab.insts.i index 82a757607..e88d67b2f 100644 --- a/OPTYap/tab.insts.i +++ b/OPTYap/tab.insts.i @@ -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();