From 23d2f7b8e57c1520cd74f603e89c8d7a45fc459e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Sun, 7 Apr 2013 10:40:42 -0500 Subject: [PATCH 1/7] more cleanups. --- packages/CLPBN/clpbn/gibbs.yap | 76 +++++++++++++--------------------- 1 file changed, 28 insertions(+), 48 deletions(-) diff --git a/packages/CLPBN/clpbn/gibbs.yap b/packages/CLPBN/clpbn/gibbs.yap index c3febf0cb..ac8a88285 100644 --- a/packages/CLPBN/clpbn/gibbs.yap +++ b/packages/CLPBN/clpbn/gibbs.yap @@ -191,7 +191,7 @@ compile_graph(Graph) :- compile_var(Graph, var(_,I,_,Vals,Sz,VarSlot,Parents,_,_)) :- foldl2( fetch_parent(Graph), VarSlot, [], Parents, [], Sizes), - foldl( mult_list, Sizes,1,TotSize), + foldl( mult, Sizes, 1, TotSize), compile_var(TotSize,I,Vals,Sz,VarSlot,Parents,Sizes,Graph). fetch_parent(Graph, tabular(_,_,Ps), Parents0, ParentsF, Sizes0, SizesF) :- @@ -210,8 +210,7 @@ add_parent([P|Parents0],I,[I,P|Parents0],Sizes0,Sz,[Sz|Sizes0]) :- add_parent([P|Parents0],I,[P|ParentsI],[S|Sizes0],Sz,[S|SizesI]) :- add_parent(Parents0,I,ParentsI,Sizes0,Sz,SizesI). - -mult_list(Sz,Mult0,Mult) :- +mult(Sz, Mult0, Mult) :- Mult is Sz*Mult0. % compile node as set of facts, faster execution @@ -247,29 +246,24 @@ fetch_val([_|Vals],I0,Pos) :- I is I0+1, fetch_val(Vals,I,Pos). -multiply_all([tabular(Table,_,Parents)|CPTs],Graph,Probs) :- +multiply_all([tabular(Table,_,Parents)|CPTs], Graph, LProbs) :- maplist( fetch_parent(Graph), Parents, Vals), - column_from_possibly_deterministic_CPT(Table,Vals,Probs0), - multiply_more(CPTs,Graph,Probs0,Probs). + column_from_possibly_deterministic_CPT(Table, Vals, Probs0), + foldl( multiply_more(Graph), CPTs, Probs0, Probs1), + normalise_possibly_deterministic_CPT(Probs1, Probs), + list_from_CPT(Probs, LProbs0), + foldl( accumulate_up, LProbs0, LProbs, 0.0, _). fetch_parent(Graph, P, Val) :- arg(P,Graph,var(_,_,Val,_,_,_,_,_,_)). -multiply_more([],_,Probs0,LProbs) :- - normalise_possibly_deterministic_CPT(Probs0, Probs), - list_from_CPT(Probs, LProbs0), - accumulate_up_list(LProbs0, 0.0, LProbs). -multiply_more([tabular(Table,_,Parents)|CPTs],Graph,Probs0,Probs) :- +multiply_more(Graph, tabular(Table,_,Parents), Probs0, Probs) :- maplist( fetch_parent(Graph), Parents, Vals), column_from_possibly_deterministic_CPT(Table, Vals, P0), - multiply_possibly_deterministic_factors(Probs0, P0, ProbsI), - multiply_more(CPTs,Graph,ProbsI,Probs). - -accumulate_up_list([], _, []). -accumulate_up_list([P|LProbs], P0, [P1|L]) :- - P1 is P0+P, - accumulate_up_list(LProbs, P1, L). + multiply_possibly_deterministic_factors(Probs0, P0, Probs). +accumulate_up(P, P1, P0, P1) :- + P1 is P0+P. store_mblanket(I,Values,Probs) :- recordz(mblanket,m(I,Values,Probs),_). @@ -348,33 +342,24 @@ gen_e0(Sz,[0|E0L]) :- process_chains(0,_,F,F,_,_,Est,Est) :- !. process_chains(ToDo,VarOrder,End,Start,Graph,Len,Est0,Estf) :- %format('ToDo = ~d~n',[ToDo]), - process_chains(Start,VarOrder,Int,Graph,Len,Est0,Esti), + maplist( process_chain(VarOrder, Graph, Len), Start, Int, Est0, Esti), % (ToDo mod 100 =:= 1 -> statistics,maplist(cvt2prob, Esti, Probs), Int =[S|_], format('did ~d: ~w~n ~w~n',[ToDo,Probs,S]) ; true), ToDo1 is ToDo-1, process_chains(ToDo1,VarOrder,End,Int,Graph,Len,Esti,Estf). -process_chains([], _, [], _, _,[],[]). -process_chains([Sample0|Samples0], VarOrder, [Sample|Samples], Graph, SampLen,[E0|E0s],[Ef|Efs]) :- +process_chain(VarOrder, Graph, SampLen, Sample0, Sample, E0, Ef) :- functor(Sample,sample,SampLen), - do_sample(VarOrder,Sample,Sample0,Graph), + maplist(do_var(Graph, Sample0, Sample), VarOrder), % format('Sample = ~w~n',[Sample]), - maplist(update_estimate(Sample), E0, Ef), - process_chains(Samples0, VarOrder, Samples, Graph, SampLen,E0s,Efs). + maplist(update_estimate(Sample), E0, Ef). -do_sample([],_,_,_). -do_sample([I|VarOrder],Sample,Sample0,Graph) :- - do_var(I,Sample,Sample0,Graph), - do_sample(VarOrder,Sample,Sample0,Graph). - -do_var(I,Sample,Sample0,Graph) :- +do_var(Graph, Sample0, Sample, I) :- + arg(I,Graph,var(_,_,_,_,_,CPTs,Parents,_,_)), + maplist( fetch_parent(Sample0, Sample), Parents, Bindings), ( explicit(I) -> - arg(I,Graph,var(_,_,_,_,_,_,Parents,_,_)), - fetch_parents(Parents,I,Sample,Sample0,Args), - recorded(mblanket,m(I,Args,Vals),_) + recorded(mblanket,m(I,Bindings,Vals),_) ; - arg(I,Graph,var(_,_,_,_,_,CPTs,Parents,_,_)), - fetch_parents(Parents,I,Sample,Sample0,Bindings), multiply_all_in_context(Parents,Bindings,CPTs,Graph,Vals) ), X is random, @@ -382,25 +367,20 @@ do_var(I,Sample,Sample0,Graph) :- arg(I,Sample,Val). multiply_all_in_context(Parents,Args,CPTs,Graph,Vals) :- - set_pos(Parents,Args,Graph), + maplist( set_pos(Graph), Parents, Args), multiply_all(CPTs,Graph,Vals), assert(mall(Vals)), fail. multiply_all_in_context(_,_,_,_,Vals) :- retract(mall(Vals)). -set_pos([],[],_). -set_pos([I|Is],[Pos|Args],Graph) :- - arg(I,Graph,var(_,I,Pos,_,_,_,_,_,_)), - set_pos(Is,Args,Graph). +set_pos(Graph, I, Pos) :- + arg(I,Graph,var(_,I,Pos,_,_,_,_,_,_)). -fetch_parents([],_,_,_,[]). -fetch_parents([P|Parents],I,Sample,Sample0,[VP|Args]) :- - arg(P,Sample,VP), - nonvar(VP), !, - fetch_parents(Parents,I,Sample,Sample0,Args). -fetch_parents([P|Parents],I,Sample,Sample0,[VP|Args]) :- - arg(P,Sample0,VP), - fetch_parents(Parents,I,Sample,Sample0,Args). +fetch_parent(_Sample0, Sample, P, VP) :- + arg(P, Sample,VP), + nonvar(VP), !. +fetch_parent(Sample0, _Sample, P, VP) :- + arg(P, Sample0, VP). pick_new_value([V|Vals],X,I0,Val) :- ( X < V -> From cf7e904e9e811145bd82c617c28a21a4ab6425b1 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 16 Apr 2013 09:44:29 -0500 Subject: [PATCH 2/7] version level patch --- packages/CLPBN/horus/LiftedWCNF.h | 8 +++++--- packages/CLPBN/horus/ParfactorList.cpp | 6 ++++-- 2 files changed, 9 insertions(+), 5 deletions(-) diff --git a/packages/CLPBN/horus/LiftedWCNF.h b/packages/CLPBN/horus/LiftedWCNF.h index e563dab7b..94d30334c 100644 --- a/packages/CLPBN/horus/LiftedWCNF.h +++ b/packages/CLPBN/horus/LiftedWCNF.h @@ -191,9 +191,11 @@ struct CmpLitLvTypes if (types1.lid() < types2.lid()) { return true; } - // vsc if (types1.lid() == types2.lid()){ - // return types1.logVarTypes() < types2.logVarTypes(); - //} + if (types1.lid() == types2.lid()){ +#if !defined(__GNUC__) || ( __GNUC__ == 4 && __GNUC_MINOR__ > 4) + return types1.logVarTypes() < types2.logVarTypes(); +#endif + } return false; } }; diff --git a/packages/CLPBN/horus/ParfactorList.cpp b/packages/CLPBN/horus/ParfactorList.cpp index 3bfbae727..acb503883 100644 --- a/packages/CLPBN/horus/ParfactorList.cpp +++ b/packages/CLPBN/horus/ParfactorList.cpp @@ -122,7 +122,7 @@ void ParfactorList::print() const { struct sortByParams { - bool operator() (const Parfactor* pf1, const Parfactor* pf2) + bool operator() (const Parfactor* pf1, const Parfactor* pf2) const { if (pf1->params().size() < pf2->params().size()) { return true; @@ -134,7 +134,9 @@ ParfactorList::print() const } }; Parfactors pfVec (pfList_.begin(), pfList_.end()); - // vsc std::sort (pfVec.begin(), pfVec.end(), sortByParams()); +#if !defined(__GNUC__) || ( __GNUC__ == 4 && __GNUC_MINOR__ > 4) + std::sort (pfVec.begin(), pfVec.end(), sortByParams()); +#endif for (size_t i = 0; i < pfVec.size(); i++) { pfVec[i]->print(); std::cout << std::endl; From 6d16dcf991750bf2892512e606e52156bd81180f Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 16 Apr 2013 14:38:01 -0500 Subject: [PATCH 3/7] fix message --- C/errors.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/C/errors.c b/C/errors.c index 1728ff82f..eedc98ded 100644 --- a/C/errors.c +++ b/C/errors.c @@ -444,7 +444,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...) tmpbuf[0] = '\0'; } va_end (ap); - fprintf(stderr,"%% ERROR WITHIN ERROR %d: %s\n", tmpbuf, LOCAL_CurrentError); + fprintf(stderr,"%% ERROR WITHIN ERROR %d: %s\n", LOCAL_CurrentError, tmpbuf); exit(1); } /* must do this here */ From 9e57b32431e013bee96925d1e22f2f43884fd226 Mon Sep 17 00:00:00 2001 From: Tiago Gomes Date: Tue, 16 Apr 2013 21:07:03 +0100 Subject: [PATCH 4/7] Fix compilation with older versions of GCC --- packages/CLPBN/horus/LiftedWCNF.h | 10 ++++++++++ packages/CLPBN/horus/ParfactorList.cpp | 27 ++++++++++++++------------ 2 files changed, 25 insertions(+), 12 deletions(-) diff --git a/packages/CLPBN/horus/LiftedWCNF.h b/packages/CLPBN/horus/LiftedWCNF.h index 67a6134ea..6fc800c4f 100644 --- a/packages/CLPBN/horus/LiftedWCNF.h +++ b/packages/CLPBN/horus/LiftedWCNF.h @@ -21,6 +21,16 @@ enum class LogVarType { negLvt }; + + +// Workaround GCC bug #38064 +inline bool operator< (LogVarType lvt1, LogVarType lvt2) +{ + return (int)lvt1 < (int)lvt2; +} + + + typedef long LiteralId; typedef std::vector LogVarTypes; diff --git a/packages/CLPBN/horus/ParfactorList.cpp b/packages/CLPBN/horus/ParfactorList.cpp index dc50858ad..b07c59ef4 100644 --- a/packages/CLPBN/horus/ParfactorList.cpp +++ b/packages/CLPBN/horus/ParfactorList.cpp @@ -118,21 +118,24 @@ ParfactorList::isAllShattered() const +struct sortByParams { + bool operator() (const Parfactor* pf1, const Parfactor* pf2) const + { + if (pf1->params().size() < pf2->params().size()) { + return true; + } else if (pf1->params().size() == pf2->params().size() && + pf1->params() < pf2->params()) { + return true; + } + return false; + } +}; + + + void ParfactorList::print() const { - struct sortByParams { - bool operator() (const Parfactor* pf1, const Parfactor* pf2) - { - if (pf1->params().size() < pf2->params().size()) { - return true; - } else if (pf1->params().size() == pf2->params().size() && - pf1->params() < pf2->params()) { - return true; - } - return false; - } - }; Parfactors pfVec (pfList_.begin(), pfList_.end()); std::sort (pfVec.begin(), pfVec.end(), sortByParams()); for (size_t i = 0; i < pfVec.size(); i++) { From cb08a542e2f7972c7da253838111255894c2132b Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 16 Apr 2013 21:14:05 +0100 Subject: [PATCH 5/7] get rid of comments --- packages/CLPBN/horus/LiftedWCNF.h | 6 +++--- packages/CLPBN/horus/ParfactorList.cpp | 2 +- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/packages/CLPBN/horus/LiftedWCNF.h b/packages/CLPBN/horus/LiftedWCNF.h index c381da125..a5f3082a7 100644 --- a/packages/CLPBN/horus/LiftedWCNF.h +++ b/packages/CLPBN/horus/LiftedWCNF.h @@ -201,9 +201,9 @@ struct CmpLitLvTypes if (types1.lid() < types2.lid()) { return true; } - // vsc if (types1.lid() == types2.lid()){ - // return types1.logVarTypes() < types2.logVarTypes(); - //} + if (types1.lid() == types2.lid()){ + return types1.logVarTypes() < types2.logVarTypes(); + } return false; } }; diff --git a/packages/CLPBN/horus/ParfactorList.cpp b/packages/CLPBN/horus/ParfactorList.cpp index d38d00c84..b07c59ef4 100644 --- a/packages/CLPBN/horus/ParfactorList.cpp +++ b/packages/CLPBN/horus/ParfactorList.cpp @@ -137,7 +137,7 @@ void ParfactorList::print() const { Parfactors pfVec (pfList_.begin(), pfList_.end()); - // vsc std::sort (pfVec.begin(), pfVec.end(), sortByParams()); + std::sort (pfVec.begin(), pfVec.end(), sortByParams()); for (size_t i = 0; i < pfVec.size(); i++) { pfVec[i]->print(); std::cout << std::endl; From 90abff4f2f8515000e389c905e28a277d680bc2e Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Tue, 16 Apr 2013 20:04:53 -0500 Subject: [PATCH 6/7] Exo compilation, the range example. --- C/absmi.c | 82 +++++++++++ C/attvar.c | 4 +- C/cdmgr.c | 1 + C/exo.c | 23 ++- C/exo_udi.c | 393 +++++++++++++++++++++++++++++++++++++++++++++++++ C/stdpreds.c | 1 + C/udi.c | 54 +++---- H/YapOpcodes.h | 2 + H/Yapproto.h | 1 + H/clause.h | 5 + H/dlocals.h | 6 + H/hlocals.h | 3 + H/iatoms.h | 2 + H/ilocals.h | 3 + H/ratoms.h | 2 + H/rclause.h | 2 + H/rlocals.h | 3 + H/saveclause.h | 2 + H/tatoms.h | 4 + H/walkclause.h | 2 + Makefile.in | 3 +- misc/ATOMS | 2 + misc/LOCALS | 6 +- 23 files changed, 569 insertions(+), 37 deletions(-) create mode 100644 C/exo_udi.c 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 From 210dacfe5a886e4a0b11501b040520300e733d96 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= Date: Tue, 16 Apr 2013 21:49:37 -0500 Subject: [PATCH 7/7] exo-compilation fixes for threads. --- C/absmi.c | 2 +- C/exo.c | 2 +- C/exo_udi.c | 64 +++++++++++++++++++++++++---------------------------- H/clause.h | 6 ++--- 4 files changed, 35 insertions(+), 39 deletions(-) diff --git a/C/absmi.c b/C/absmi.c index 297b85687..04caafa39 100755 --- a/C/absmi.c +++ b/C/absmi.c @@ -1143,7 +1143,7 @@ Yap_absmi(int inp) { struct index_t *it = (struct index_t *)(PREG->u.lp.l); saveregs(); - d0 = ((CRetryExoIndex)it->udi_next)(it); + d0 = ((CRetryExoIndex)it->udi_next)(it PASS_REGS); setregs(); #ifdef SHADOW_S SREG = S; diff --git a/C/exo.c b/C/exo.c index 9167bcec8..10424a3c0 100644 --- a/C/exo.c +++ b/C/exo.c @@ -382,7 +382,7 @@ Yap_ExoLookup(PredEntry *ap USES_REGS) if (count) { yamop *code = LOOKUP(i, arity, j0, LOCAL_ibnds); if (i->is_udi) - return ((CEnterExoIndex)i->udi_first)(i); + return ((CEnterExoIndex)i->udi_first)(i PASS_REGS); else return code; } else return i->code; diff --git a/C/exo_udi.c b/C/exo_udi.c index c0a9d01df..478119b98 100644 --- a/C/exo_udi.c +++ b/C/exo_udi.c @@ -41,6 +41,7 @@ static int compar(const void *ip0, const void *jp0) { + CACHE_REGS BITS32 *ip = (BITS32 *)ip0, *jp = (BITS32 *)jp0; BITS32 *bs = LOCAL_exo_base; Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg]; @@ -49,7 +50,7 @@ compar(const void *ip0, const void *jp0) { } static int -compare(const BITS32 *ip, Int j) { +compare(const BITS32 *ip, Int j USES_REGS) { BITS32 *bs = LOCAL_exo_base; Int i = bs[LOCAL_exo_arity*(*ip)+LOCAL_exo_arg]; /* fprintf(stderr, "%ld-%ld\n", IntOfTerm(i), j); */ @@ -58,7 +59,7 @@ compare(const BITS32 *ip, Int j) { static void -RangeUDIRefitIndex(struct index_t **ip, UInt b[]) +RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS) { size_t sz; struct index_t *it = *ip; @@ -112,7 +113,7 @@ RangeUDIRefitIndex(struct index_t **ip, UInt b[]) } static yamop * -Min(struct index_t *it, BITS32 off) +Min(struct index_t *it, BITS32 off USES_REGS) { if (it->links[off]) { BITS32 *c = (BITS32 *)it->udi_data; @@ -123,7 +124,7 @@ Min(struct index_t *it, BITS32 off) } static yamop * -Max(struct index_t *it, BITS32 off) +Max(struct index_t *it, BITS32 off USES_REGS) { if (it->links[off]) { BITS32 *c = (BITS32 *)it->udi_data; @@ -135,7 +136,7 @@ Max(struct index_t *it, BITS32 off) } static yamop * -Gt(struct index_t *it, Int x, BITS32 off) +Gt(struct index_t *it, Int x, BITS32 off USES_REGS) { if (it->links[off]) { BITS32 *c = (BITS32 *)it->udi_data; @@ -149,7 +150,7 @@ Gt(struct index_t *it, Int x, BITS32 off) if (n > 8 && FALSE) { // start = binary_search(start,end, x, it); } else { - while ( pt < end && compare(pt, x) <= 0 ) { + while ( pt < end && compare(pt, x PASS_REGS) <= 0 ) { pt++; } } @@ -168,7 +169,7 @@ Gt(struct index_t *it, Int x, BITS32 off) } static yamop * -Lt(struct index_t *it, Int x, BITS32 off) +Lt(struct index_t *it, Int x, BITS32 off USES_REGS) { if (it->links[off]) { BITS32 *c = (BITS32 *)it->udi_data; @@ -182,9 +183,9 @@ Lt(struct index_t *it, Int x, BITS32 off) if (n > 8 && FALSE) { // start = binary_search(start,end, x, it); } else { - if (compare(start, x) >= 0) + if (compare(start, x PASS_REGS) >= 0) return FAILCODE; - while ( pt < end && compare(pt, x) < 0 ) { + while ( pt < end && compare(pt, x PASS_REGS) < 0 ) { pt++; } } @@ -201,7 +202,7 @@ Lt(struct index_t *it, Int x, BITS32 off) } static yamop * -Eq(struct index_t *it, Int x, BITS32 off) +Eq(struct index_t *it, Int x, BITS32 off USES_REGS) { if (it->links[off]) { BITS32 *c = (BITS32 *)it->udi_data; @@ -215,15 +216,15 @@ Eq(struct index_t *it, Int x, BITS32 off) if (n > 8 && FALSE) { // start = binary_search(start,end, x, it); } else { - Int c; - while ( pt < end && (c = compare(pt, x)) < 0 ) { + Int c = 0; + while ( pt < end && (c = compare(pt, x PASS_REGS)) < 0 ) { pt++; } if (pt == end || c) return FAILCODE; start = pt; pt ++; - while ( pt < end && (c = compare(pt, x)) == 0 ) { + while ( pt < end && (c = compare(pt, x PASS_REGS)) == 0 ) { pt++; } } @@ -240,7 +241,7 @@ Eq(struct index_t *it, Int x, BITS32 off) } static yamop * -All(struct index_t *it, BITS32 off) +All(struct index_t *it, BITS32 off USES_REGS) { if (it->links[off]) { BITS32 *c = (BITS32 *)it->udi_data; @@ -263,7 +264,7 @@ All(struct index_t *it, BITS32 off) } static yamop * -RangeEnterUDIIndex(struct index_t *it) +RangeEnterUDIIndex(struct index_t *it USES_REGS) { Int i = arg_of_interest(); Term t = XREGS[i+1], a1; @@ -286,44 +287,44 @@ RangeEnterUDIIndex(struct index_t *it) at = NameOfFunctor(f); } if (at == AtomMax) { - return Max(it, off); + return Max(it, off PASS_REGS); } else if (at == AtomMin) { - return Min(it, off); + return Min(it, off PASS_REGS); } else if (at == AtomGT) { Term arg = ArgOfTerm(1, a1); if (IsVarTerm(arg)) - return All(it, off); + return All(it, off PASS_REGS); else if (!IsIntTerm(arg)) { Yap_Error(TYPE_ERROR_INTEGER, arg, "data-base constraint"); return FAILCODE; } - return Gt(it, IntOfTerm(arg), off); + return Gt(it, IntOfTerm(arg), off PASS_REGS); } else if (at == AtomLT) { Term arg = ArgOfTerm(1, a1); if (IsVarTerm(arg)) - return All(it, off); + return All(it, off PASS_REGS); else if (!IsIntTerm(arg)) { Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint"); return FAILCODE; } - return Lt(it, IntOfTerm(arg), off); + return Lt(it, IntOfTerm(arg), off PASS_REGS); } else if (at == AtomEQ) { Term arg = ArgOfTerm(1, a1); if (IsVarTerm(arg)) - return All(it, off); + return All(it, off PASS_REGS); else if (!IsIntTerm(arg)) { Yap_Error(TYPE_ERROR_INTEGER, t, "data-base constraint"); return FAILCODE; } - return Eq(it, IntOfTerm(arg), off); + return Eq(it, IntOfTerm(arg), off PASS_REGS); } return FAILCODE; } static int -RangeRetryUDIIndex(struct index_t *it) +RangeRetryUDIIndex(struct index_t *it USES_REGS) { CELL *w = (CELL*)(B+1); BITS32 *end = (BITS32 *) w[it->arity+2], @@ -341,7 +342,7 @@ static struct udi_control_block RangeCB; typedef struct exo_udi_access_t { CRefitExoIndex refit; -}; +} exo_udi_encaps_t; static struct exo_udi_access_t ExoCB; @@ -355,20 +356,15 @@ static void * RangeUdiInsert (void *control, Term term, int arg, void *data) { + CACHE_REGS + struct index_t **ip = (struct index_t **)term; - (ExoCB.refit)(ip, LOCAL_ibnds); + (ExoCB.refit)(ip, LOCAL_ibnds PASS_REGS); (*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; @@ -386,7 +382,7 @@ void Yap_udi_range_init(void) { cb->init= RangeUdiInit; cb->insert=RangeUdiInsert; - cb->search=RangeUdiSearch; + cb->search=NULL; cb->destroy=RangeUdiDestroy; Yap_UdiRegister(cb); diff --git a/H/clause.h b/H/clause.h index edfcbf4d4..0358bb822 100644 --- a/H/clause.h +++ b/H/clause.h @@ -213,9 +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 void (*CRefitExoIndex)(struct index_t **ip, UInt b[] USES_REGS); +typedef yamop * (*CEnterExoIndex)(struct index_t *it USES_REGS); +typedef int (*CRetryExoIndex)(struct index_t *it USES_REGS); typedef struct dbterm_list { /* a list of dbterms associated with a clause */