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

expand_clauses: keep a list of clauses to expand

Browse Source 
fix new trail scheme for multi-assignment variables


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1035 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
2004-04-14 19:10:40 +00:00
parent dc245aed32
commit 5b6e8182d1
6 changed files with 108 additions and 52 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
C/absmi.c
View File

@@ -10,8 +10,11 @@
* *
* File: absmi.c *
* comments: Portable abstract machine interpreter *
* Last rev: $Date: 2004-03-31 01:03:09 $,$Author: vsc $ *
* Last rev: $Date: 2004-04-14 19:10:22 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.127 2004/03/31 01:03:09 vsc
* support expand group of clauses
*
* Revision 1.126 2004/03/19 11:35:42 vsc
* trim_trail for default machine
* be more aggressive about try-retry-trust chains.
@@ -1788,9 +1791,9 @@ Yap_absmi(int inp)
/* multi-assignment variable */
/* so the next cell is the old value */
#if FROZEN_STACKS
pt[0] = TrailVal(pt0);
pt[0] = TrailVal(pt0-1);
#else
pt[0] = TrailTerm(pt0);
pt[0] = TrailTerm(pt0-1);
#endif /* FROZEN_STACKS */
pt0 -= 2;
goto failloop;
@@ -1838,8 +1841,8 @@ Yap_absmi(int inp)
}
pt1++;
} else if (IsApplTerm(d1)) {
TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
TrailTerm(pt0+1) = TrailTerm(pt1+1);
TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
pt0 += 3;
pt1 += 3;
} else if (IsPairTerm(d1)) {
@@ -1872,7 +1875,7 @@ Yap_absmi(int inp)
pt1++;
}
ENDD(d1);
}
}
TR = pt0;
}
}
@@ -9741,6 +9744,7 @@ Yap_absmi(int inp)
pt[0] = TrailVal(--TR);
#else
pt[0] = TrailTerm(--TR);
TR--;
#endif
#endif
}

16
C/cdmgr.c
View File

@@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2004-04-07 22:04:03 $,$Author: vsc $ *
* Last rev: $Date: 2004-04-14 19:10:23 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.117 2004/04/07 22:04:03 vsc
* fix memory leaks
*
* Revision 1.116 2004/03/31 01:03:09 vsc
* support expand group of clauses
*
@@ -275,12 +278,9 @@ decrease_ref_counter(yamop *ptr, yamop *b, yamop *e, yamop *sc)
}
}
static vsc_countis;
static void
cleanup_dangling_indices(yamop *ipc, yamop *beg, yamop *end, yamop *suspend_code)
{
vsc_countis++;
while (ipc < end) {
op_numbers op = Yap_op_from_opcode(ipc->opc);
/* printf("op: %d %p->%p\n", op, ipc, end); */
@@ -400,7 +400,10 @@ decrease_log_indices(LogUpdIndex *c, yamop *suspend_code)
cop = (yamop *)beg[1];
beg += 2;
if (cop->opc == ecs) {
Yap_FreeCodeSpace((char *)cop);
cop->u.sp.s3--;
if (!cop->u.sp.s3) {
Yap_FreeCodeSpace((char *)cop);
}
}
}
return;
@@ -429,12 +432,9 @@ kill_static_child_indxs(StaticIndex *indx)
Yap_FreeCodeSpace((CODEADDR)indx);
}
int kills;
static void
kill_off_lu_block(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
{
kills++;
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
if (parent != NULL) {
/* sat bye bye */

119
C/index.c
View File

@@ -11,8 +11,11 @@
* File: index.c *
* comments: Indexing a Prolog predicate *
* *
* Last rev: $Date: 2004-04-07 22:04:04 $,$Author: vsc $ *
* Last rev: $Date: 2004-04-14 19:10:38 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.83 2004/04/07 22:04:04 vsc
* fix memory leaks
*
* Revision 1.82 2004/03/31 01:02:18 vsc
* if number of left-over < 1/5 keep list of clauses to expand around
* fix call to stack expander
@@ -110,7 +113,7 @@ insort(ClauseDef base[], CELL *p, CELL *q, int my_p)
if (my_p) {
p[1] = p[0];
for (j = p+2; j < q; j += 2) {
for (j = p; j < q; j += 2) {
Term key;
Int off = *j;
CELL *i;
@@ -2739,18 +2742,17 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i
}
static UInt
suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap)
{
return (UInt)&(ap->cs.p_code.ExpandCode);
}
static UInt
suspend_indexing_in_switch(ClauseDef *min, ClauseDef *max, PredEntry *ap)
suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermediates *cint)
{
UInt tcls = ap->cs.p_code.NOfClauses;
UInt cls = (max-min)+1;
yamop *ncode;
if (cint->expand_block &&
cint->expand_block->u.sp.s2 < 2*(max-min)) {
cint->expand_block->u.sp.s3++;
return (UInt)(cint->expand_block);
}
if (cls < tcls/8 &&
(ncode = (yamop *)Yap_AllocCodeSpace((UInt)(NEXTOP((yamop *)NULL,sp)+cls*sizeof(yamop *))))) {
/* create an expand_block */
@@ -2759,6 +2761,7 @@ suspend_indexing_in_switch(ClauseDef *min, ClauseDef *max, PredEntry *ap)
ncode->opc = Yap_opcode(_expand_clauses);
ncode->u.sp.p = ap;
ncode->u.sp.s1 = ncode->u.sp.s2 = cls;
ncode->u.sp.s3 = 1;
st = (yamop **)NEXTOP(ncode,sp);
while (min <= max) {
*st++ = min->Code;
@@ -2769,13 +2772,21 @@ suspend_indexing_in_switch(ClauseDef *min, ClauseDef *max, PredEntry *ap)
return (UInt)&(ap->cs.p_code.ExpandCode);
}
static void
recover_ecls_block(yamop *ipc)
{
ipc->u.sp.s3--;
if (!ipc->u.sp.s3) {
Yap_FreeCodeSpace((char *)ipc);
}
}
static UInt
do_var_entries(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int first, int clleft, UInt nxtlbl){
PredEntry *ap = cint->CurrentPred;
if (!IsVarTerm(t) || t != 0L) {
return suspend_indexing(grp->FirstClause, grp->LastClause, ap);
return suspend_indexing(grp->FirstClause, grp->LastClause, ap, cint);
}
return do_var_group(grp, cint, FALSE, first, clleft, nxtlbl, ap->ArityOfPE+1);
}
@@ -2810,11 +2821,11 @@ do_consts(GroupDef *grp, Term t, struct intermediates *cint, int compound_term,
if (min != max) {
if (sreg != NULL) {
if (ap->PredFlags & LogUpdatePredFlag && max > min)
ics->Label = suspend_indexing_in_switch(min, max, ap);
ics->Label = suspend_indexing(min, max, ap, cint);
else
ics->Label = do_compound_index(min, max, sreg, cint, compound_term, arity, argno+1, nxtlbl, first, last_arg, clleft, top, TRUE);
} else if (ap->PredFlags & LogUpdatePredFlag) {
ics->Label = suspend_indexing_in_switch(min, max, cint->CurrentPred);
ics->Label = suspend_indexing(min, max, cint->CurrentPred, cint);
} else {
ics->Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top);
}
@@ -2848,7 +2859,7 @@ do_blobs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
max != grp->LastClause) max++;
if (min != max &&
(ap->PredFlags & LogUpdatePredFlag)) {
ics->Label = suspend_indexing_in_switch(min, max, ap);
ics->Label = suspend_indexing(min, max, ap, cint);
} else {
ics->Label = do_index(min, max, cint, argno+1, nxtlbl, first, clleft, top);
}
@@ -2883,10 +2894,10 @@ do_funcs(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int firs
while ((max+1)->Tag == min->Tag &&
max != grp->LastClause) max++;
/* delay non-trivial indexing
if (min != max &&
!IsExtensionFunctor(f)) {
ifs->Label = suspend_indexing(min, max, ap);
} else
if (min != max &&
!IsExtensionFunctor(f)) {
ifs->Label = suspend_indexing(min, max, ap, cint);
} else
*/
if (IsExtensionFunctor(f)) {
if (f == FunctorDBRef)
@@ -2928,7 +2939,7 @@ do_pair(GroupDef *grp, Term t, struct intermediates *cint, UInt argno, int first
return (UInt)(min->CurrentCode);
}
if (min != max && !IsPairTerm(t)) {
return suspend_indexing(min, max, cint->CurrentPred);
return suspend_indexing(min, max, cint->CurrentPred, cint);
}
return do_compound_index(min, max, (IsPairTerm(t) ? RepPair(t) : NULL), cint, 0, 2, argno+1, nxtlbl, first, last_arg, clleft, top, TRUE);
}
@@ -3130,6 +3141,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
/* remember how we entered here */
UInt argno0 = argno;
PredEntry *ap = cint->CurrentPred;
UInt susp_lab = 0L;
if (min == max) {
/* base case, just commit to the current code */
@@ -3150,8 +3162,13 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
lablx = new_label();
Yap_emit(label_op, lablx, Zero, cint);
while (IsVarTerm(t)) {
if (ngroups > 1 || !group->VarClauses)
Yap_emit(jump_nv_op, (CELL)(&(ap->cs.p_code.ExpandCode)), argno, cint);
if (ngroups > 1 || !group->VarClauses) {
susp_lab = suspend_indexing(min, max, ap, cint);
if (!cint->expand_block && FALSE) {
cint->expand_block = (yamop *)susp_lab;
}
Yap_emit(jump_nv_op, susp_lab, argno, cint);
}
if (argno == ap->ArityOfPE) {
do_var_clauses(min, max, FALSE, cint, first, clleft, fail_l, argno0);
return lablx;
@@ -3169,6 +3186,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
} else {
lablx = labl0 = labl = new_label();
}
cint->expand_block = NULL;
top = (CELL *)(group+ngroups);
if (argno > 1) {
/* don't try being smart for other arguments than the first */
@@ -3212,7 +3230,7 @@ do_index(ClauseDef *min, ClauseDef* max, struct intermediates *cint, UInt argno,
} else if (found_pvar) {
Yap_emit(label_op, labl0, Zero, cint);
labl = new_label();
Yap_emit(jump_v_op, suspend_indexing(min, max, ap), Zero, cint);
Yap_emit(jump_v_op, suspend_indexing(min, max, ap, cint), Zero, cint);
}
}
for (i=0; i < ngroups; i++) {
@@ -3286,7 +3304,7 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermedi
return ret_lab;
}
if (sreg == NULL) {
return suspend_indexing(min0, max0, ap);
return suspend_indexing(min0, max0, ap, cint);
}
while (i < arity && !found_index) {
ClauseDef *cl;
@@ -3329,7 +3347,7 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermedi
if (!lu_pred || !done_work)
*newlabp = do_index(min0, max0, cint, argno+1, fail_l, first, clleft, top);
else
*newlabp = suspend_indexing_in_switch(min0, max0, ap);
*newlabp = suspend_indexing(min0, max0, ap, cint);
}
return ret_lab;
}
@@ -3487,6 +3505,7 @@ Yap_PredIsIndexable(PredEntry *ap)
}
restart_index:
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NIL;
cint.expand_block = NULL;
Yap_ErrorMessage = NULL;
if (compile_index(&cint) == (UInt)FAILCODE) {
return FAILCODE;
@@ -4204,6 +4223,13 @@ expand_index(struct intermediates *cint) {
COUNT nclauses = ipc->u.sp.s2;
yamop **clp = (yamop **)NEXTOP(ipc,sp);
cint->expand_block = ipc;
/* if (ap->PredFlags & LogUpdatePredFlag) {
fprintf(stderr,"vsc +");
} else {
fprintf(stderr,"vsc ");
}
fprintf(stderr,"*: expanding %d out of %d\n", nclauses,NClauses);*/
if (cls+2*nclauses > (ClauseDef *)(ASP-4096)) {
/* tell how much space we need (worst case) */
Yap_Error_Size += NClauses*sizeof(ClauseDef);
@@ -4216,6 +4242,7 @@ expand_index(struct intermediates *cint) {
max = install_clauseseq(cls, ap, stack, clp, clp+nclauses);
}
} else {
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);
@@ -4227,6 +4254,12 @@ expand_index(struct intermediates *cint) {
} else {
max = install_clauses(cls, ap, stack, first, last);
}
/* if (ap->PredFlags & LogUpdatePredFlag) {
fprintf(stderr,"vsc +");
} else {
fprintf(stderr,"vsc ");
}
fprintf(stderr," : expanding %d out of %d\n", (max-cls)+1,NClauses);*/
}
/* don't count last clause if you don't have to */
if (alt && max->Code == last) max--;
@@ -4288,6 +4321,9 @@ expand_index(struct intermediates *cint) {
lab = do_index(cls, max, cint, argno+1, fail_l, isfirstcl, clleft, top);
}
}
if (cint->expand_block) {
recover_ecls_block(cint->expand_block);
}
if (labp && !(lab & 1))
*labp = (yamop *)lab; /* in case we have a single clause */
return labp;
@@ -5003,7 +5039,7 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
}
sz = sizeof(LogUpdIndex)+
xcls*((UInt)NEXTOP((yamop *)NULL,ld))+
jnvs*((UInt)NEXTOP((yamop *)NULL,l))+
jnvs*((UInt)NEXTOP((yamop *)NULL,xl))+
(UInt)NEXTOP((yamop *)NULL,Ill)+
(UInt)NEXTOP((yamop *)NULL,p);
if (count_reds) sz += xcls*((UInt)NEXTOP((yamop *)NULL,p));
@@ -5026,6 +5062,7 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
LogUpdIndex *idx = ncl->ChildIndex = blk->ChildIndex;
while (idx) {
blk->ClRefCount--;
ncl->ClRefCount++;
idx = idx->SiblingIndex;
}
}
@@ -5037,6 +5074,8 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
begin = blk->ClCode;
while (jnvs--) {
nbegin->opc = begin->opc;
nbegin->u.xl.x = begin->u.xl.x;
nbegin->u.xl.l = begin->u.xl.l;
begin = NEXTOP(begin, xl);
nbegin = NEXTOP(nbegin, xl);
}
@@ -5085,7 +5124,7 @@ replace_lu_block(LogUpdIndex *blk, int flag, PredEntry *ap, yamop *code, int has
Yap_kill_iblock((ClauseUnion *)blk, (ClauseUnion *)pcl, ap);
}
}
return start;
return ncl->ClCode;
}
static yamop *
@@ -5192,7 +5231,7 @@ insertz_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
begin->u.Ill.l2 = NEXTOP(where,ld);
begin->u.Ill.s++;
tgl->ClRefCount++;
return begin;
return blk->ClCode;
} else {
return replace_lu_block(blk, RECORDZ, ap, code, has_cut(code));
}
@@ -5265,7 +5304,7 @@ inserta_in_lu_block(LogUpdIndex *blk, PredEntry *ap, yamop *code)
here->opc = Yap_opcode(_retry_profiled);
here->u.p.p = ap;
}
return begin;
return blk->ClCode;
} else {
return replace_lu_block(blk, RECORDA, ap, code, has_cut(code));
}
@@ -5361,6 +5400,7 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
if (Yap_op_from_opcode(ipc->opc) == op) {
/* the new block was the current clause */
ClauseDef cld[2];
struct intermediates intrs;
if (remove) {
*sp->u.cle.entry_code = FAILCODE;
@@ -5385,7 +5425,8 @@ kill_unsafe_block(path_stack_entry *sp, op_numbers op, PredEntry *ap, int first,
cld[1].Code = lc->ClCode;
}
}
*sp->u.cle.entry_code = (yamop *)suspend_indexing_in_switch(cld, cld+1, ap);
intrs.expand_block = NULL;
*sp->u.cle.entry_code = (yamop *)suspend_indexing(cld, cld+1, ap, &intrs);
return sp;
}
/* we didn't have protection, should kill now */
@@ -5403,16 +5444,20 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
if (first) {
if (*clar == NULL) {
while (*clar++ == NULL);
clar[-1] = cls->Code;
ipc->u.sp.s2++;
if (clar[0] != cls->Code) {
clar[-1] = cls->Code;
ipc->u.sp.s2++;
}
return pop_path(spp, cls, ap);
}
} else {
clar += ipc->u.sp.s1;
while (*--clar == NULL);
if (clar[0] == NULL) {
clar[0] = cls->Code;
ipc->u.sp.s2++;
if (clar[-1] != cls->Code) {
clar[0] = cls->Code;
ipc->u.sp.s2++;
}
return pop_path(spp, cls, ap);
}
}
@@ -5420,7 +5465,7 @@ add_to_expand_clauses(path_stack_entry **spp, yamop *ipc, ClauseDef *cls, PredEn
*sp->u.cle.entry_code = (yamop *)&(ap->cs.p_code.ExpandCode);
}
*spp = sp;
Yap_FreeCodeSpace((char *)ipc);
recover_ecls_block(ipc);
return (yamop *)&(ap->cs.p_code.ExpandCode);
}
@@ -5443,10 +5488,11 @@ nullify_expand_clause(yamop *ipc, path_stack_entry *sp, ClauseDef *cls)
if (sp->u.cle.entry_code) {
*sp->u.cle.entry_code = cl;
}
Yap_FreeCodeSpace((char *)ipc);
recover_ecls_block(ipc);
} else {
yamop **max = st+ipc->u.sp.s1;
ipc->u.sp.s2--;
while (TRUE) {
while (st < max) {
if (*st && *st == cls->Code) {
*st = NULL;
return;
@@ -5901,6 +5947,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
return;
}
cint.CurrentPred = ap;
cint.expand_block = NULL;
if ((cb = setjmp(cint.CompilerBotch)) == 3) {
restore_machine_regs();
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);
@@ -6410,7 +6457,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
yamop *last;
struct intermediates cint;
cint.expand_block = NULL;
if ((cb = setjmp(cint.CompilerBotch)) == 3) {
restore_machine_regs();
Yap_gcl(Yap_Error_Size, ap->ArityOfPE, ENV, CP);

6
H/amidefs.h
View File

@@ -11,8 +11,11 @@
* File: amidefs.h *
* comments: Abstract machine peculiarities *
* *
* Last rev: $Date: 2004-03-31 01:03:10 $ *
* Last rev: $Date: 2004-04-14 19:10:40 $ *
* $Log: not supported by cvs2svn $
* Revision 1.23 2004/03/31 01:03:10 vsc
* support expand group of clauses
*
* Revision 1.22 2004/03/10 14:59:55 vsc
* optimise -> for type tests
* *
@@ -362,6 +365,7 @@ typedef struct yami {
struct {
COUNT s1;
COUNT s2;
COUNT s3;
struct pred_entry *p;
CELL next;
} sp;

2
H/amiops.h
View File

@@ -295,7 +295,7 @@ Binding Macros for Multiple Assignment Variables.
#define DO_MATRAIL(VP, OLDV, D) \
{ TrailTerm(TR+1) = OLDV; \
TrailTerm(TR) = TrailTerm(TR+2) = AbsAppl(VP); \
TR += 2; \
TR += 3; \
}
#define MATRAIL(VP,OLDV,D) if (OUTSIDE(HBREG,VP,B)) \

3
H/compile.h
View File

@@ -216,7 +216,8 @@ typedef struct intermediates {
Term *contents;
struct pred_entry *CurrentPred;
jmp_buf CompilerBotch;
yamop *code_addr;
yamop *code_addr;
yamop *expand_block;
} CIntermediates;
#define SafeVar 0x01