diff --git a/C/absmi.c b/C/absmi.c index cad3cd404..297b85687 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -990,6 +990,35 @@ Yap_absmi(int inp) GONext(); ENDOp(); + /* check if enough space between trail and codespace */ + /* try_exo Pred,Label */ + Op(try_exo_udi, lp); + /* check if enough space between trail and codespace */ + check_trail(TR); + /* I use YREG =to go through the choicepoint. Usually YREG =is in a + * register, but sometimes (X86) not. In this case, have a + * new register to point at YREG =*/ + CACHE_Y(YREG); + S_YREG--; + /* store arguments for procedure */ + store_at_least_one_arg(PREG->u.lp.p->ArityOfPE); + /* store abstract machine registers */ + store_yaam_regs(NEXTOP(PREG,lp), 0); + /* On a try_me, set cut to point at previous choicepoint, + * that is, to the B before the cut. + */ + set_cut(S_YREG, B); + /* now, install the new YREG =*/ + B = B_YREG; +#ifdef YAPOR + SCH_set_load(B_YREG); +#endif /* YAPOR */ + PREG = NEXTOP(NEXTOP(PREG, lp),lp); + SET_BB(B_YREG); + ENDCACHE_Y(); + GONext(); + ENDOp(); + /* try_udi Pred,Label */ Op(try_udi, p); /* check if enough space between trail and codespace */ @@ -1107,6 +1136,59 @@ Yap_absmi(int inp) GONext(); ENDOp(); + /* retry_exo_udi Pred */ + Op(retry_exo_udi, lp); + BEGD(d0); + CACHE_Y(B); + { + struct index_t *it = (struct index_t *)(PREG->u.lp.l); + saveregs(); + d0 = ((CRetryExoIndex)it->udi_next)(it); + setregs(); +#ifdef SHADOW_S + SREG = S; +#endif + } + if (d0) { + /* After retry, cut should be pointing at the parent + * choicepoint for the current B */ + restore_yaam_regs(PREG); + restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE); +#ifdef FROZEN_STACKS + S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); + set_cut(S_YREG, B->cp_b); +#else + set_cut(S_YREG, B_YREG->cp_b); +#endif /* FROZEN_STACKS */ + SET_BB(B_YREG); + } else { +#ifdef YAPOR + if (SCH_top_shared_cp(B)) { + SCH_last_alternative(PREG, B_YREG); + restore_at_least_one_arg(PREG->u.lp.p->ArityOfPE); +#ifdef FROZEN_STACKS + S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B->cp_b); + } else +#endif /* YAPOR */ + { + pop_yaam_regs(); + pop_at_least_one_arg(PREG->u.lp.p->ArityOfPE); + /* After trust, cut should be pointing at the new top + * choicepoint */ +#ifdef FROZEN_STACKS + S_YREG = (CELL *) PROTECT_FROZEN_B(B_YREG); +#endif /* FROZEN_STACKS */ + set_cut(S_YREG, B); + } + } + PREG = NEXTOP(PREG, lp); + ENDCACHE_Y(); + ENDD(D0); + GONext(); + ENDOp(); + /* retry_exo Pred */ Op(retry_udi, p); BEGD(d0); diff --git a/C/attvar.c b/C/attvar.c index 0c6fcf9ad..1173381e9 100644 --- a/C/attvar.c +++ b/C/attvar.c @@ -364,10 +364,10 @@ DelAtts(attvar_record *attv, Term oatt USES_REGS) static void PutAtt(Int pos, Term atts, Term att USES_REGS) { - if (IsVarTerm(att) && (CELL *)att > H && (CELL *)att < LCL0) { + if (IsVarTerm(att) && VarOfTerm(att) > H && VarOfTerm(att) < LCL0) { /* globalise locals */ Term tnew = MkVarTerm(); - Bind_NonAtt((CELL *)att, tnew); + Bind_NonAtt(VarOfTerm(att), tnew); att = tnew; } MaBind(RepAppl(atts)+pos, att); diff --git a/C/cdmgr.c b/C/cdmgr.c index 3ba4e15f6..cba627968 100644 --- a/C/cdmgr.c +++ b/C/cdmgr.c @@ -5436,6 +5436,7 @@ index_ssz(StaticIndex *x, PredEntry *pe) while (i) { sz = i->size+sz; + i = i->next; } return sz; } diff --git a/C/exo.c b/C/exo.c index 523fb9c71..9167bcec8 100644 --- a/C/exo.c +++ b/C/exo.c @@ -216,7 +216,7 @@ fill_hash(UInt bmap, struct index_t *it, UInt bnds[]) } static struct index_t * -add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[]) +add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count) { CACHE_REGS UInt ncls = ap->cs.p_code.NOfClauses, j; @@ -224,6 +224,7 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[] struct index_t *i; size_t sz; yamop *ptr; + UInt *bnds = LOCAL_ibnds; sz = (CELL)NEXTOP(NEXTOP((yamop*)NULL,lp),lp)+ap->ArityOfPE*(CELL)NEXTOP((yamop *)NULL,x) +(CELL)NEXTOP(NEXTOP((yamop *)NULL,p),l); if (!(i = (struct index_t *)Yap_AllocCodeSpace(sizeof(struct index_t)+sz))) { @@ -278,7 +279,9 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[] i->ncollisions = i->nentries = i->ntrys = 0; continue; } +#if DEBUG fprintf(stderr, "entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys); +#endif if (!i->ntrys && !i->is_key) { i->is_key = TRUE; if (base != realloc(base, i->hsize*sizeof(BITS32))) @@ -333,7 +336,12 @@ add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count, UInt bnds[] ptr = NEXTOP(ptr, p); ptr->opc = Yap_opcode(_Ystop); ptr->u.l.l = i->code; - Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX); + Yap_inform_profiler_of_clause((char *)(i->code), (char *)NEXTOP(ptr,l), ap, GPROF_INDEX); + if (ap->PredFlags & UDIPredFlag) { + Yap_new_udi_clause( ap, NULL, (Term)ip); + } else { + i->is_udi = FALSE; + } return i; } @@ -369,11 +377,14 @@ Yap_ExoLookup(PredEntry *ap USES_REGS) i = i->next; } if (!i) { - i = add_index(ip, bmap, ap, count, LOCAL_ibnds); + i = add_index(ip, bmap, ap, count); } - if (count) - return LOOKUP(i, arity, j0, LOCAL_ibnds); - else + if (count) { + yamop *code = LOOKUP(i, arity, j0, LOCAL_ibnds); + if (i->is_udi) + return ((CEnterExoIndex)i->udi_first)(i); + else return code; + } else return i->code; } diff --git a/C/exo_udi.c b/C/exo_udi.c new file mode 100644 index 000000000..c0a9d01df --- /dev/null +++ b/C/exo_udi.c @@ -0,0 +1,393 @@ +/************************************************************************* +* * +* YAP Prolog * +* * +* Yap Prolog was developed at NCCUP - Universidade do Porto * +* * +* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 * +* * +************************************************************************** +* * +* File: exo.c * +* comments: Exo compilation * +* * +* Last rev: $Date: 2008-07-22 23:34:44 $,$Author: vsc $ * * +* $Log: not supported by cvs2svn $ * +* * +* * +*************************************************************************/ + +#include "Yap.h" +#include "clause.h" +#include "yapio.h" +#include "eval.h" +#include "tracer.h" +#include "attvar.h" +#ifdef YAPOR +#include "or.macros.h" +#endif /* YAPOR */ +#ifdef TABLING +#include "tab.macros.h" +#endif /* TABLING */ +#if HAVE_STRING_H +#include +#endif +#define YAP_Term Term +#define YAP_Atom Atom +#include + +#define arg_of_interest() 0 + + +static int +compar(const void *ip0, const void *jp0) { + BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0; + BITS32 *bs = LOCAL_exo_base; + Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg]; + Int j = bs[LOCAL_exo_arity*(*jp)+LOCAL_exo_arg]; + return IntOfTerm(i)-IntOfTerm(j); +} + +static int +compare(const BITS32 *ip, Int j) { + BITS32 *bs = LOCAL_exo_base; + Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg]; + /* fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j); */ + return IntOfTerm(i)-j; +} + + +static void +RangeUDIRefitIndex(struct index_t **ip, UInt b[]) +{ + size_t sz; + struct index_t *it = *ip; + BITS32 *sorted0, *sorted; + UInt arity = it->arity; + yamop *code; + + /* hard-wired implementation for the range case */ + Int i = arg_of_interest(); + /* it is bound, use hash */ + if (it->bmap & b[i]) return; + /* no constraints, nothing to gain */ + if (!IsAttVar(VarOfTerm(XREGS[i+1]))) return; + /* be conservative */ + sz = sizeof(BITS32)*(it->ntrys+it->nentries*2); + /* allocate space */ + if (!(it->udi_data = malloc(sz))) + return; + sorted0 = sorted = (BITS32 *)it->udi_data; + LOCAL_exo_base = it->cls; + LOCAL_exo_arity = it->arity; + LOCAL_exo_arg = i; + for (i=0; i < it->hsize; i++) { + if (it->key[i]) { + BITS32 *s0 = sorted; + BITS32 offset = it->key[i]/arity, offset0 = offset; + + if (offset) { + *sorted++ = 0; + while (offset) { + *sorted++ = offset; + offset = it->links[offset]; + } + if (sorted-s0 == 2) { + it->links[offset0] = 0; + sorted = s0; + } else { + /* number of elements comes first */ + *s0 = sorted - (s0+1); + qsort(s0+1, (size_t)*s0, sizeof(BITS32), compar); + it->links[offset0] = s0-sorted0; + } + } + } + } + it->is_udi = i+1; + code = it->code; + code->opc = Yap_opcode(_try_exo_udi); + code = NEXTOP(code, lp); + code->opc = Yap_opcode(_retry_exo_udi); +} + +static yamop * +Min(struct index_t *it, BITS32 off) +{ + if (it->links[off]) { + BITS32 *c = (BITS32 *)it->udi_data; + BITS32 f = c[it->links[off]+1]; + S = it->cls+it->arity*f; + } + return NEXTOP(NEXTOP(it->code,lp),lp); +} + +static yamop * +Max(struct index_t *it, BITS32 off) +{ + if (it->links[off]) { + BITS32 *c = (BITS32 *)it->udi_data; + BITS32 n = c[it->links[off]]; + BITS32 f = c[it->links[off]+n]; + S = it->cls+it->arity*f; + } + return NEXTOP(NEXTOP(it->code,lp),lp); +} + +static yamop * +Gt(struct index_t *it, Int x, BITS32 off) +{ + if (it->links[off]) { + BITS32 *c = (BITS32 *)it->udi_data; + BITS32 n = c[it->links[off]]; + + LOCAL_exo_base = it->cls; + LOCAL_exo_arity = it->arity; + LOCAL_exo_arg = arg_of_interest(); + BITS32 *pt = c+(it->links[off]+1); + BITS32 *end = c+(it->links[off]+(n+2)); + if (n > 8 && FALSE) { + // start = binary_search(start,end, x, it); + } else { + while ( pt < end && compare(pt, x) <= 0 ) { + pt++; + } + } + if (pt == end) + return FAILCODE; + S = it->cls+it->arity*pt[0]; + end --; + if (pt < end ) { + YENV[-2] = (CELL)( pt+1 ); + YENV[-1] = (CELL)( end ); + YENV -= 2; + return it->code; + } + } + return NEXTOP(NEXTOP(it->code,lp),lp); +} + +static yamop * +Lt(struct index_t *it, Int x, BITS32 off) +{ + if (it->links[off]) { + BITS32 *c = (BITS32 *)it->udi_data; + BITS32 n = c[it->links[off]]; + + LOCAL_exo_base = it->cls; + LOCAL_exo_arity = it->arity; + LOCAL_exo_arg = arg_of_interest(); + BITS32 *start = c+(it->links[off]+1), *pt = start+1; + BITS32 *end = c+(it->links[off]+(n+2)); + if (n > 8 && FALSE) { + // start = binary_search(start,end, x, it); + } else { + if (compare(start, x) >= 0) + return FAILCODE; + while ( pt < end && compare(pt, x) < 0 ) { + pt++; + } + } + S = it->cls+it->arity*start[0]; + pt --; + if ( pt > start ) { + YENV[-2] = (CELL)( start+1 ); + YENV[-1] = (CELL)( pt ); + YENV -= 2; + return it->code; + } + } + return NEXTOP(NEXTOP(it->code,lp),lp); +} + +static yamop * +Eq(struct index_t *it, Int x, BITS32 off) +{ + if (it->links[off]) { + BITS32 *c = (BITS32 *)it->udi_data; + BITS32 n = c[it->links[off]]; + + LOCAL_exo_base = it->cls; + LOCAL_exo_arity = it->arity; + LOCAL_exo_arg = arg_of_interest(); + BITS32 *end = c+(it->links[off]+(n+2)); + BITS32 *start, *pt = c+(it->links[off]+1); + if (n > 8 && FALSE) { + // start = binary_search(start,end, x, it); + } else { + Int c; + while ( pt < end && (c = compare(pt, x)) < 0 ) { + pt++; + } + if (pt == end || c) + return FAILCODE; + start = pt; + pt ++; + while ( pt < end && (c = compare(pt, x)) == 0 ) { + pt++; + } + } + S = it->cls+it->arity*start[0]; + pt --; + if ( pt > start ) { + YENV[-2] = (CELL)( start+1 ); + YENV[-1] = (CELL)( pt ); + YENV -= 2; + return it->code; + } + } + return NEXTOP(NEXTOP(it->code,lp),lp); +} + +static yamop * +All(struct index_t *it, BITS32 off) +{ + if (it->links[off]) { + BITS32 *c = (BITS32 *)it->udi_data; + BITS32 n = c[it->links[off]]; + + LOCAL_exo_base = it->cls; + LOCAL_exo_arity = it->arity; + LOCAL_exo_arg = arg_of_interest(); + BITS32 *start = c+(it->links[off]+1); + BITS32 *end = c+(it->links[off]+(n+1)); + S = it->cls+it->arity*start[0]; + if ( end > start ) { + YENV[-2] = (CELL)( start+1 ); + YENV[-1] = (CELL)( end ); + YENV -= 2; + return it->code; + } + } + return NEXTOP(NEXTOP(it->code,lp),lp); +} + +static yamop * +RangeEnterUDIIndex(struct index_t *it) +{ + Int i = arg_of_interest(); + Term t = XREGS[i+1], a1; + BITS32 off = EXO_ADDRESS_TO_OFFSET(it, S)/it->arity; + attvar_record *attv; + Atom at; + + t = Deref(t); + if (!IsVarTerm(t)) + return FALSE; + if(!IsAttVar(VarOfTerm(t))) + return FALSE; + attv = RepAttVar(VarOfTerm(t)); + t = attv->Atts; + a1 = ArgOfTerm(2,t); + if (IsAtomTerm(a1)) { + at = AtomOfTerm(a1); + } else { + Functor f = FunctorOfTerm(a1); + at = NameOfFunctor(f); + } + if (at == AtomMax) { + return Max(it, off); + } else if (at == AtomMin) { + return Min(it, off); + } else if (at == AtomGT) { + Term arg = ArgOfTerm(1, a1); + if (IsVarTerm(arg)) + return All(it, off); + else if (!IsIntTerm(arg)) { + Yap_Error(TYPE_ERROR_INTEGER, arg, "data-base constraint"); + return FAILCODE; + } + return Gt(it, IntOfTerm(arg), off); + } else if (at == AtomLT) { + Term arg = ArgOfTerm(1, a1); + + if (IsVarTerm(arg)) + return All(it, off); + else if (!IsIntTerm(arg)) { + Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint"); + return FAILCODE; + } + return Lt(it, IntOfTerm(arg), off); + } else if (at == AtomEQ) { + Term arg = ArgOfTerm(1, a1); + + if (IsVarTerm(arg)) + return All(it, off); + else if (!IsIntTerm(arg)) { + Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint"); + return FAILCODE; + } + return Eq(it, IntOfTerm(arg), off); + } + return FAILCODE; +} + +static int +RangeRetryUDIIndex(struct index_t *it) +{ + CELL *w = (CELL*)(B+1); + BITS32 *end = (BITS32 *) w[it->arity+2], + *pt = (BITS32 *) w[it->arity+1]; + BITS32 f = *pt; + + S = it->cls+it->arity*f; + if (pt++ == end) return FALSE; + w[it->arity+1] = (CELL)pt; + return TRUE; +} + + +static struct udi_control_block RangeCB; + +typedef struct exo_udi_access_t { + CRefitExoIndex refit; +}; + +static struct exo_udi_access_t ExoCB; + +static void * +RangeUdiInit (Term spec, int arg, int arity) { + ExoCB.refit = RangeUDIRefitIndex; + return (void *)&ExoCB; +} + +static void * +RangeUdiInsert (void *control, + Term term, int arg, void *data) +{ + struct index_t **ip = (struct index_t **)term; + (ExoCB.refit)(ip, LOCAL_ibnds); + (*ip)->udi_first = (void *)RangeEnterUDIIndex; + (*ip)->udi_next = (void *)RangeRetryUDIIndex; + return control; +} + +static void * +RangeUdiSearch (void *control, + int arg, Yap_UdiCallback callback, void *args) +{ + return NULL; +} + +static int RangeUdiDestroy(void *control) +{ + return TRUE; +} + + + +void Yap_udi_range_init(void) { + UdiControlBlock cb = &RangeCB; + + memset((void *) cb,0, sizeof(*cb)); + + /*TODO: ask vitor why this gives a warning*/ + cb->decl=Yap_LookupAtom("range"); + + cb->init= RangeUdiInit; + cb->insert=RangeUdiInsert; + cb->search=RangeUdiSearch; + cb->destroy=RangeUdiDestroy; + + Yap_UdiRegister(cb); +} diff --git a/C/stdpreds.c b/C/stdpreds.c index 08f838f90..b45a8f893 100644 --- a/C/stdpreds.c +++ b/C/stdpreds.c @@ -4285,6 +4285,7 @@ Yap_InitCPreds(void) Yap_InitMYDDAS_TopLevelPreds(); #endif Yap_udi_init(); + Yap_udi_range_init(); Yap_InitSignalCPreds(); Yap_InitUserCPreds(); diff --git a/C/udi.c b/C/udi.c index 48fcec985..645e0f3b8 100644 --- a/C/udi.c +++ b/C/udi.c @@ -33,42 +33,42 @@ p_new_udi( USES_REGS1 ) /* get the predicate from the spec, copied from cdmgr.c */ if (IsVarTerm(spec)) { - Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1"); - return FALSE; + Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1"); + return FALSE; } else if (!IsApplTerm(spec)) { - Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1"); - return FALSE; + Yap_Error(TYPE_ERROR_COMPOUND,spec,"new user index/1"); + return FALSE; } else { - Functor fun = FunctorOfTerm(spec); - Term tmod = CurrentModule; + Functor fun = FunctorOfTerm(spec); + Term tmod = CurrentModule; - while (fun == FunctorModule) { - tmod = ArgOfTerm(1,spec); - if (IsVarTerm(tmod) ) { - Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1"); - return FALSE; - } - if (!IsAtomTerm(tmod) ) { - Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1"); - return FALSE; - } - spec = ArgOfTerm(2, spec); - fun = FunctorOfTerm(spec); - } - p = RepPredProp(PredPropByFunc(fun, tmod)); + while (fun == FunctorModule) { + tmod = ArgOfTerm(1,spec); + if (IsVarTerm(tmod) ) { + Yap_Error(INSTANTIATION_ERROR, spec, "new user index/1"); + return FALSE; + } + if (!IsAtomTerm(tmod) ) { + Yap_Error(TYPE_ERROR_ATOM, spec, "new user index/1"); + return FALSE; + } + spec = ArgOfTerm(2, spec); + fun = FunctorOfTerm(spec); + } + p = RepPredProp(PredPropByFunc(fun, tmod)); } if (!p) - return FALSE; + return FALSE; /* boring, boring, boring! */ if ((p->PredFlags - & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) - || (p->ModuleOfPred == PROLOG_MODULE)) { - Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2"); - return FALSE; + & (DynamicPredFlag|LogUpdatePredFlag|UserCPredFlag|CArgsPredFlag|NumberDBPredFlag|AtomDBPredFlag|TestPredFlag|AsmPredFlag|CPredFlag|BinaryPredFlag)) + || (p->ModuleOfPred == PROLOG_MODULE)) { + Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, spec, "udi/2"); + return FALSE; } if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|TabledPredFlag)) { - Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2"); - return FALSE; + Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2"); + return FALSE; } /* TODO: remove AtomRTree from atom list */ diff --git a/H/YapOpcodes.h b/H/YapOpcodes.h index d81d0573b..d27088bdd 100644 --- a/H/YapOpcodes.h +++ b/H/YapOpcodes.h @@ -9,9 +9,11 @@ OPCODE(trust_me ,Otapl), OPCODE(enter_exo ,e), OPCODE(try_exo ,lp), + OPCODE(try_exo_udi ,lp), OPCODE(try_udi ,p), OPCODE(try_all_exo ,lp), OPCODE(retry_exo ,lp), + OPCODE(retry_exo_udi ,lp), OPCODE(retry_udi ,p), OPCODE(retry_all_exo ,lp), OPCODE(enter_profiling ,p), diff --git a/H/Yapproto.h b/H/Yapproto.h index 2b8aa4b32..79e8ab4d4 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -186,6 +186,7 @@ void STD_PROTO(Yap_PrepGoal,(UInt, CELL *, choiceptr USES_REGS)); /* exo.c */ void STD_PROTO(Yap_InitExoPreds,(void)); +void Yap_udi_range_init(void); /* foreign.c */ char *STD_PROTO(Yap_FindExecutable,(void)); diff --git a/H/clause.h b/H/clause.h index 5f56e03d1..edfcbf4d4 100644 --- a/H/clause.h +++ b/H/clause.h @@ -166,6 +166,7 @@ typedef struct index_t { PredEntry *ap; CELL bmap; int is_key; + int is_udi; UInt ncollisions; UInt ntrys; UInt nentries; @@ -175,6 +176,7 @@ typedef struct index_t { BITS32 *links; size_t size; yamop *code; + void *udi_data, *udi_first, *udi_next; } Index_t; INLINE_ONLY EXTERN inline BITS32 EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr); @@ -211,6 +213,9 @@ LINK_TO_ADDRESS(struct index_t *it, BITS32 off) return it->links+off; } +typedef void (*CRefitExoIndex)(struct index_t **ip, UInt b[]); +typedef yamop * (*CEnterExoIndex)(struct index_t *it); +typedef int (*CRetryExoIndex)(struct index_t *it); typedef struct dbterm_list { /* a list of dbterms associated with a clause */ diff --git a/H/dlocals.h b/H/dlocals.h index 08f84899a..b1bea94f5 100644 --- a/H/dlocals.h +++ b/H/dlocals.h @@ -403,6 +403,12 @@ #define LOCAL_ibnds LOCAL->ibnds_ #define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_ +#define LOCAL_exo_base LOCAL->exo_base_ +#define REMOTE_exo_base(wid) REMOTE(wid)->exo_base_ +#define LOCAL_exo_arity LOCAL->exo_arity_ +#define REMOTE_exo_arity(wid) REMOTE(wid)->exo_arity_ +#define LOCAL_exo_arg LOCAL->exo_arg_ +#define REMOTE_exo_arg(wid) REMOTE(wid)->exo_arg_ #define LOCAL_search_atoms LOCAL->search_atoms_ #define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_ diff --git a/H/hlocals.h b/H/hlocals.h index cc8e68a17..561bc7253 100644 --- a/H/hlocals.h +++ b/H/hlocals.h @@ -227,6 +227,9 @@ typedef struct worker_local { Functor FunctorVar_; UInt ibnds_[256]; + void* exo_base_; + UInt exo_arity_; + UInt exo_arg_; struct scan_atoms* search_atoms_; } w_local; diff --git a/H/iatoms.h b/H/iatoms.h index 6e0bc29a1..a0f715e4e 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -161,11 +161,13 @@ AtomLocal = Yap_LookupAtom("local"); AtomLocalSp = Yap_LookupAtom("local_sp"); AtomLocalTrie = Yap_LookupAtom("local_trie"); + AtomMax = Yap_LookupAtom("max"); AtomMaxArity = Yap_LookupAtom("max_arity"); AtomMaxFiles = Yap_LookupAtom("max_files"); AtomMegaClause = Yap_FullLookupAtom("$mega_clause"); AtomMetaCall = Yap_FullLookupAtom("$call"); AtomMfClause = Yap_FullLookupAtom("$mf_clause"); + AtomMin = Yap_LookupAtom("min"); AtomMinus = Yap_LookupAtom("-"); AtomModify = Yap_LookupAtom("modify"); AtomMultiFile = Yap_FullLookupAtom("$mf"); diff --git a/H/ilocals.h b/H/ilocals.h index 49a2e2a0d..537d0464c 100644 --- a/H/ilocals.h +++ b/H/ilocals.h @@ -227,6 +227,9 @@ static void InitWorker(int wid) { REMOTE_FunctorVar(wid) = FunctorVar; + REMOTE_exo_base(wid) = NULL; + REMOTE_exo_arity(wid) = 0; + REMOTE_exo_arg(wid) = 0; } diff --git a/H/ratoms.h b/H/ratoms.h index 012907290..35709e00e 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -161,11 +161,13 @@ AtomLocal = AtomAdjust(AtomLocal); AtomLocalSp = AtomAdjust(AtomLocalSp); AtomLocalTrie = AtomAdjust(AtomLocalTrie); + AtomMax = AtomAdjust(AtomMax); AtomMaxArity = AtomAdjust(AtomMaxArity); AtomMaxFiles = AtomAdjust(AtomMaxFiles); AtomMegaClause = AtomAdjust(AtomMegaClause); AtomMetaCall = AtomAdjust(AtomMetaCall); AtomMfClause = AtomAdjust(AtomMfClause); + AtomMin = AtomAdjust(AtomMin); AtomMinus = AtomAdjust(AtomMinus); AtomModify = AtomAdjust(AtomModify); AtomMultiFile = AtomAdjust(AtomMultiFile); diff --git a/H/rclause.h b/H/rclause.h index c647637e0..12d088594 100644 --- a/H/rclause.h +++ b/H/rclause.h @@ -288,8 +288,10 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS) /* instructions type lp */ case _retry_all_exo: case _retry_exo: + case _retry_exo_udi: case _try_all_exo: case _try_exo: + case _try_exo_udi: case _user_switch: pc->u.lp.l = PtoOpAdjust(pc->u.lp.l); pc->u.lp.p = PtoPredAdjust(pc->u.lp.p); diff --git a/H/rlocals.h b/H/rlocals.h index 24811a5b9..b2ad1e01e 100644 --- a/H/rlocals.h +++ b/H/rlocals.h @@ -225,6 +225,9 @@ static void RestoreWorker(int wid USES_REGS) { + + + diff --git a/H/saveclause.h b/H/saveclause.h index e7d0a4a90..31a4c8df9 100644 --- a/H/saveclause.h +++ b/H/saveclause.h @@ -305,8 +305,10 @@ /* instructions type lp */ case _retry_all_exo: case _retry_exo: + case _retry_exo_udi: case _try_all_exo: case _try_exo: + case _try_exo_udi: case _user_switch: CHECK(save_PtoOp(stream, pc->u.lp.l)); CHECK(save_PtoPred(stream, pc->u.lp.p)); diff --git a/H/tatoms.h b/H/tatoms.h index 622db3179..6201d471a 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -320,6 +320,8 @@ #define AtomLocalSp Yap_heap_regs->AtomLocalSp_ Atom AtomLocalTrie_; #define AtomLocalTrie Yap_heap_regs->AtomLocalTrie_ + Atom AtomMax_; +#define AtomMax Yap_heap_regs->AtomMax_ Atom AtomMaxArity_; #define AtomMaxArity Yap_heap_regs->AtomMaxArity_ Atom AtomMaxFiles_; @@ -330,6 +332,8 @@ #define AtomMetaCall Yap_heap_regs->AtomMetaCall_ Atom AtomMfClause_; #define AtomMfClause Yap_heap_regs->AtomMfClause_ + Atom AtomMin_; +#define AtomMin Yap_heap_regs->AtomMin_ Atom AtomMinus_; #define AtomMinus Yap_heap_regs->AtomMinus_ Atom AtomModify_; diff --git a/H/walkclause.h b/H/walkclause.h index 479b728b3..ac69e0447 100644 --- a/H/walkclause.h +++ b/H/walkclause.h @@ -218,8 +218,10 @@ /* instructions type lp */ case _retry_all_exo: case _retry_exo: + case _retry_exo_udi: case _try_all_exo: case _try_exo: + case _try_exo_udi: case _user_switch: pc = NEXTOP(pc,lp); break; diff --git a/Makefile.in b/Makefile.in index fdc3feecc..fa228a10c 100755 --- a/Makefile.in +++ b/Makefile.in @@ -243,6 +243,7 @@ C_SOURCES= \ $(srcdir)/C/errors.c \ $(srcdir)/C/eval.c $(srcdir)/C/exec.c \ $(srcdir)/C/exo.c \ + $(srcdir)/C/exo_udi.c \ $(srcdir)/C/globals.c $(srcdir)/C/gmp_support.c \ $(srcdir)/C/gprof.c $(srcdir)/C/grow.c \ $(srcdir)/C/heapgc.c $(srcdir)/C/index.c \ @@ -359,7 +360,7 @@ ENGINE_OBJECTS = \ bignum.o bb.o \ cdmgr.o cmppreds.o compiler.o computils.o \ corout.o cut_c.o dbase.o dlmalloc.o errors.o eval.o \ - exec.o exo.o globals.o gmp_support.o gprof.o grow.o \ + exec.o exo.o exo_udi.o globals.o gmp_support.o gprof.o grow.o \ heapgc.o index.o init.o inlines.o \ iopreds.o depth_bound.o mavar.o \ myddas_mysql.o myddas_odbc.o myddas_shared.o myddas_initialization.o \ diff --git a/misc/ATOMS b/misc/ATOMS index 8629a3f32..71291072a 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -166,11 +166,13 @@ A LoadAnswers N "load_answers" A Local N "local" A LocalSp N "local_sp" A LocalTrie N "local_trie" +A Max N "max" A MaxArity N "max_arity" A MaxFiles N "max_files" A MegaClause F "$mega_clause" A MetaCall F "$call" A MfClause F "$mf_clause" +A Min N "min" A Minus N "-" A Modify N "modify" A MultiFile F "$mf" diff --git a/misc/LOCALS b/misc/LOCALS index e204662aa..7a1f259eb 100644 --- a/misc/LOCALS +++ b/misc/LOCALS @@ -255,8 +255,12 @@ yamop *ImportFAILCODE =NULL Functor FunctorVar =FunctorVar -// exo indexing +// exo indexingxb + UInt ibnds[256] void +BITS32* exo_base =NULL +UInt exo_arity =0 +UInt exo_arg =0 // atom completion struct scan_atoms* search_atoms void