more fixes for expand_clauses

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1050 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2004-04-27 15:03:43 +00:00
parent cfcbc82aa4
commit e6cab52dc2
3 changed files with 62 additions and 27 deletions

View File

@ -11,8 +11,12 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * 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 $ * $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 * Revision 1.117 2004/04/07 22:04:03 vsc
* fix memory leaks * 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 static void
cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code) cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code)
{ {
OPCODE ecs = Yap_opcode(_expand_clauses);
while (ipc < end) { while (ipc < end) {
op_numbers op = Yap_op_from_opcode(ipc->opc); op_numbers op = Yap_op_from_opcode(ipc->opc);
/* printf("op: %d %p->%p\n", op, ipc, end); */ /* 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 _trust_logical_pred:
case _jump: case _jump:
case _jump_if_var: case _jump_if_var:
release_wcls(ipc->u.l.l, ecs);
ipc = NEXTOP(ipc,l); ipc = NEXTOP(ipc,l);
break; break;
/* instructions type xl */ /* instructions type xl */
case _jump_if_nonvar: case _jump_if_nonvar:
release_wcls(ipc->u.xl.l, ecs);
ipc = NEXTOP(ipc,xl); ipc = NEXTOP(ipc,xl);
break; break;
/* instructions type e */ /* instructions type e */
case _switch_on_type: case _switch_on_type:
ipc = NEXTOP(ipc,llll); 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; break;
case _switch_list_nl: 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); ipc = NEXTOP(ipc,ollll);
break; break;
case _switch_on_arg_type: 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); ipc = NEXTOP(ipc,xllll);
break; break;
case _switch_on_sub_arg_type: 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); ipc = NEXTOP(ipc,sllll);
break; break;
case _if_not_then: case _if_not_then:
@ -399,12 +435,7 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
yamop *cop; yamop *cop;
cop = (yamop *)beg[1]; cop = (yamop *)beg[1];
beg += 2; beg += 2;
if (cop->opc == ecs) { release_wcls(cop, ecs);
cop->u.sp.s3--;
if (!cop->u.sp.s3) {
Yap_FreeCodeSpace((char *)cop);
}
}
} }
return; return;
} }

View File

@ -11,8 +11,12 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * 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 $ * $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 * Revision 1.87 2004/04/21 04:01:53 vsc
* fix bad ordering when inserting second clause * 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++; cint->expand_block->u.sp.s3++;
return (UInt)(cint->expand_block); return (UInt)(cint->expand_block);
} }
if (cls < tcls/8) { if (cls < tcls/8 && FALSE) {
yamop *ncode; yamop *ncode;
yamop **st; yamop **st;
UInt sz = (UInt)(NEXTOP((yamop *)NULL,sp)+cls*sizeof(yamop *)); 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) { if (argno == ap->ArityOfPE) {
do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0); do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0);
cint->expand_block = eblk;
return lablx; return lablx;
} }
argno++; argno++;
@ -4391,7 +4396,7 @@ expand_index(struct intermediates *cint) {
#endif #endif
if (cls+2*nclauses > (ClauseDef *)(ASP-4096)) { if (cls+2*nclauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */ /* tell how much space we need (worst case) */
Yap_Error_Size += NClauses*sizeof(ClauseDef); Yap_Error_Size += 2*NClauses*sizeof(ClauseDef);
/* grow stack */ /* grow stack */
recover_from_failed_susp_on_cls(cint, 0); recover_from_failed_susp_on_cls(cint, 0);
longjmp(cint->CompilerBotch,3); longjmp(cint->CompilerBotch,3);
@ -4405,7 +4410,7 @@ expand_index(struct intermediates *cint) {
cint->expand_block = NULL; cint->expand_block = NULL;
if (cls+2*NClauses > (ClauseDef *)(ASP-4096)) { if (cls+2*NClauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */ /* tell how much space we need (worst case) */
Yap_Error_Size += NClauses*sizeof(ClauseDef); Yap_Error_Size += 2*NClauses*sizeof(ClauseDef);
/* grow stack */ /* grow stack */
recover_from_failed_susp_on_cls(cint, 0); recover_from_failed_susp_on_cls(cint, 0);
longjmp(cint->CompilerBotch,3); 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; path_stack_entry *sp = *spp;
yamop **clar = (yamop **)NEXTOP(ipc,sp); yamop **clar = (yamop **)NEXTOP(ipc,sp);
while ((--sp)->flag != block_entry);
if (first) { if (first) {
if (*clar == NULL) { if (*clar == NULL) {
while (*clar++ == NULL); while (*clar == NULL) clar++;
if (clar[0] != cls->Code) { if (clar[0] != cls->Code) {
clar[-1] = cls->Code; clar[-1] = cls->Code;
ipc->u.sp.s2++; ipc->u.sp.s2++;
@ -5623,21 +5627,21 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
} }
} else { } else {
clar += ipc->u.sp.s1; clar += ipc->u.sp.s1;
while (*--clar == NULL); if (clar[-1] == NULL) {
if (clar[0] == NULL) { while (*--clar == NULL);
if (clar[-1] != cls->Code) { if (clar[0] != cls->Code) {
clar[0] = cls->Code; clar[1] = cls->Code;
ipc->u.sp.s2++; ipc->u.sp.s2++;
} }
return pop_path(spp, cls, ap); return pop_path(spp, cls, ap);
} }
} }
while ((--sp)->flag != block_entry);
if (sp->u.cle.entry_code) { if (sp->u.cle.entry_code) {
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode); *sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
} }
*spp = sp;
recover_ecls_block(ipc); 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 */ /* this code should be called when we jumped to clauses */

View File

@ -306,12 +306,12 @@ clause(V,Q,R) :-
M0 = M, M0 = M,
instance(R,T), instance(R,T),
( T = (H :- B) -> P = H, Q = B ; P=T, Q = true). ( T = (H :- B) -> P = H, Q = B ; P=T, Q = true).
'$clause'(V,M,Q,_) :- var(V), !, '$clause'(V,M,Q,R) :- var(V), !,
'$do_error'(instantiation_error,M:clause(V,Q)). '$do_error'(instantiation_error,clause(M:V,Q,R)).
'$clause'(C,M,Q,_) :- number(C), !, '$clause'(C,M,Q,R) :- number(C), !,
'$do_error'(type_error(callable,C),M:clause(C,Q)). '$do_error'(type_error(callable,C),clause(M:C,Q,R)).
'$clause'(R,M,Q,_) :- db_reference(R), !, '$clause'(R,M,Q,R) :- db_reference(R), !,
'$do_error'(type_error(callable,R),M:clause(R,Q)). '$do_error'(type_error(callable,R),clause(M:R,Q,R)).
'$clause'(M:P,_,Q,R) :- !, '$clause'(M:P,_,Q,R) :- !,
'$clause'(P,M,Q,R). '$clause'(P,M,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) :- '$clause'(P,M,Q,R) :-
'$some_recordedp'(M:P), !, '$some_recordedp'(M:P), !,
'$recordedp'(M:P,(P:-Q),R). '$recordedp'(M:P,(P:-Q),R).
'$clause'(P,M,Q,_) :- '$clause'(P,M,Q,R) :-
\+ '$undefined'(P,M), \+ '$undefined'(P,M),
( '$system_predicate'(P,M) -> true ; ( '$system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ), '$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity), functor(P,Name,Arity),
'$do_error'(permission_error(access,private_procedure,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 % just create a choice-point
'$do_log_upd_clause'(_,_,_,_,_). '$do_log_upd_clause'(_,_,_,_,_).