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

more fixes for expand_clauses

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
C/cdmgr.c
View File

@ -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;
}

28
C/index.c
View File

@ -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 */

16
pl/preds.yap
View File

@ -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'(_,_,_,_,_).