diff --git a/C/cdmgr.c b/C/cdmgr.c index 1fc0f0ada..f2d2c80d2 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -11,8 +11,12 @@ * File: cdmgr.c * * comments: Code manager * * * -* Last rev: $Date: 2004-04-14 19:10:23 $,$Author: vsc $ * +* Last rev: $Date: 2004-04-27 15:03:43 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.118 2004/04/14 19:10:23 vsc +* expand_clauses: keep a list of clauses to expand +* fix new trail scheme for multi-assignment variables +* * Revision 1.117 2004/04/07 22:04:03 vsc * fix memory leaks * @@ -278,9 +282,23 @@ decrease_ref_counter(yamop *ptr, yamop *b, yamop *e, yamop *sc) } } +static void +release_wcls(yamop *cop, OPCODE ecs) +{ + if (cop->opc == ecs) { + cop->u.sp.s3--; + if (!cop->u.sp.s3) { + Yap_FreeCodeSpace((char *)cop); + } + } +} + + static void cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code) { + OPCODE ecs = Yap_opcode(_expand_clauses); + while (ipc < end) { op_numbers op = Yap_op_from_opcode(ipc->opc); /* printf("op: %d %p->%p\n", op, ipc, end); */ @@ -339,23 +357,41 @@ cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code case _trust_logical_pred: case _jump: case _jump_if_var: + release_wcls(ipc->u.l.l, ecs); ipc = NEXTOP(ipc,l); break; /* instructions type xl */ case _jump_if_nonvar: + release_wcls(ipc->u.xl.l, ecs); ipc = NEXTOP(ipc,xl); break; /* instructions type e */ case _switch_on_type: ipc = NEXTOP(ipc,llll); + release_wcls(ipc->u.llll.l1, ecs); + release_wcls(ipc->u.llll.l2, ecs); + release_wcls(ipc->u.llll.l3, ecs); + release_wcls(ipc->u.llll.l4, ecs); break; case _switch_list_nl: + release_wcls(ipc->u.ollll.l1, ecs); + release_wcls(ipc->u.ollll.l2, ecs); + release_wcls(ipc->u.ollll.l3, ecs); + release_wcls(ipc->u.ollll.l4, ecs); ipc = NEXTOP(ipc,ollll); break; case _switch_on_arg_type: + release_wcls(ipc->u.xllll.l1, ecs); + release_wcls(ipc->u.xllll.l2, ecs); + release_wcls(ipc->u.xllll.l3, ecs); + release_wcls(ipc->u.xllll.l4, ecs); ipc = NEXTOP(ipc,xllll); break; case _switch_on_sub_arg_type: + release_wcls(ipc->u.sllll.l1, ecs); + release_wcls(ipc->u.sllll.l2, ecs); + release_wcls(ipc->u.sllll.l3, ecs); + release_wcls(ipc->u.sllll.l4, ecs); ipc = NEXTOP(ipc,sllll); break; case _if_not_then: @@ -399,12 +435,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code) yamop *cop; cop = (yamop *)beg[1]; beg += 2; - if (cop->opc == ecs) { - cop->u.sp.s3--; - if (!cop->u.sp.s3) { - Yap_FreeCodeSpace((char *)cop); - } - } + release_wcls(cop, ecs); } return; } diff --git a/C/index.c b/C/index.c index 6c5698f03..5f7af2d76 100644 --- a/C/index.c +++ b/C/index.c @@ -11,8 +11,12 @@ * File: index.c * * comments: Indexing a Prolog predicate * * * -* Last rev: $Date: 2004-04-22 03:24:17 $,$Author: vsc $ * +* Last rev: $Date: 2004-04-27 15:03:43 $,$Author: vsc $ * * $Log: not supported by cvs2svn $ +* Revision 1.88 2004/04/22 03:24:17 vsc +* trust_logical should protect the last clause, otherwise it cannot +* jump there. +* * Revision 1.87 2004/04/21 04:01:53 vsc * fix bad ordering when inserting second clause * @@ -2874,7 +2878,7 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi cint->expand_block->u.sp.s3++; return (UInt)(cint->expand_block); } - if (cls < tcls/8) { + if (cls < tcls/8 && FALSE) { yamop *ncode; yamop **st; UInt sz = (UInt)(NEXTOP((yamop *)NULL,sp)+cls*sizeof(yamop *)); @@ -3299,6 +3303,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno, } if (argno == ap->ArityOfPE) { do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0); + cint->expand_block = eblk; return lablx; } argno++; @@ -4391,7 +4396,7 @@ expand_index(struct intermediates *cint) { #endif if (cls+2*nclauses > (ClauseDef *)(ASP-4096)) { /* tell how much space we need (worst case) */ - Yap_Error_Size += NClauses*sizeof(ClauseDef); + Yap_Error_Size += 2*NClauses*sizeof(ClauseDef); /* grow stack */ recover_from_failed_susp_on_cls(cint, 0); longjmp(cint->CompilerBotch,3); @@ -4405,7 +4410,7 @@ expand_index(struct intermediates *cint) { cint->expand_block = NULL; if (cls+2*NClauses > (ClauseDef *)(ASP-4096)) { /* tell how much space we need (worst case) */ - Yap_Error_Size += NClauses*sizeof(ClauseDef); + Yap_Error_Size += 2*NClauses*sizeof(ClauseDef); /* grow stack */ recover_from_failed_susp_on_cls(cint, 0); longjmp(cint->CompilerBotch,3); @@ -5611,10 +5616,9 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn path_stack_entry *sp = *spp; yamop **clar = (yamop **)NEXTOP(ipc,sp); - while ((--sp)->flag != block_entry); if (first) { if (*clar == NULL) { - while (*clar++ == NULL); + while (*clar == NULL) clar++; if (clar[0] != cls->Code) { clar[-1] = cls->Code; ipc->u.sp.s2++; @@ -5623,21 +5627,21 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn } } else { clar += ipc->u.sp.s1; - while (*--clar == NULL); - if (clar[0] == NULL) { - if (clar[-1] != cls->Code) { - clar[0] = cls->Code; + if (clar[-1] == NULL) { + while (*--clar == NULL); + if (clar[0] != cls->Code) { + clar[1] = cls->Code; ipc->u.sp.s2++; } return pop_path(spp, cls, ap); } } + while ((--sp)->flag != block_entry); if (sp->u.cle.entry_code) { *sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode); } - *spp = sp; recover_ecls_block(ipc); - return (yamop *)&(ap->cs.p_code.ExpandCode); + return pop_path(spp, cls, ap); } /* this code should be called when we jumped to clauses */ diff --git a/pl/preds.yap b/pl/preds.yap index 4aee8ec6c..a95016bb0 100644 --- a/pl/preds.yap +++ b/pl/preds.yap @@ -306,12 +306,12 @@ clause(V,Q,R) :- M0 = M, instance(R,T), ( T = (H :- B) -> P = H, Q = B ; P=T, Q = true). -'$clause'(V,M,Q,_) :- var(V), !, - '$do_error'(instantiation_error,M:clause(V,Q)). -'$clause'(C,M,Q,_) :- number(C), !, - '$do_error'(type_error(callable,C),M:clause(C,Q)). -'$clause'(R,M,Q,_) :- db_reference(R), !, - '$do_error'(type_error(callable,R),M:clause(R,Q)). +'$clause'(V,M,Q,R) :- var(V), !, + '$do_error'(instantiation_error,clause(M:V,Q,R)). +'$clause'(C,M,Q,R) :- number(C), !, + '$do_error'(type_error(callable,C),clause(M:C,Q,R)). +'$clause'(R,M,Q,R) :- db_reference(R), !, + '$do_error'(type_error(callable,R),clause(M:R,Q,R)). '$clause'(M:P,_,Q,R) :- !, '$clause'(P,M,Q,R). '$clause'(P,M,Q,R) :- @@ -323,13 +323,13 @@ clause(V,Q,R) :- '$clause'(P,M,Q,R) :- '$some_recordedp'(M:P), !, '$recordedp'(M:P,(P:-Q),R). -'$clause'(P,M,Q,_) :- +'$clause'(P,M,Q,R) :- \+ '$undefined'(P,M), ( '$system_predicate'(P,M) -> true ; '$number_of_clauses'(P,M,N), N > 0 ), functor(P,Name,Arity), '$do_error'(permission_error(access,private_procedure,Name/Arity), - clause(M:P,Q)). + clause(M:P,Q,R)). % just create a choice-point '$do_log_upd_clause'(_,_,_,_,_).