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
parent
cfcbc82aa4
commit
e6cab52dc2
45
C/cdmgr.c
45
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;
|
||||
}
|
||||
|
|
|
|||
28
C/index.c
28
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 */
|
||||
|
|
|
|||
16
pl/preds.yap
16
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'(_,_,_,_,_).
|
||||
|
|
|
|||
Reference in New Issue