Exo compilation, the range example.
This commit is contained in:
parent
bd9e840e8b
commit
90abff4f2f
82
C/absmi.c
82
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);
|
||||
|
@ -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);
|
||||
|
@ -5436,6 +5436,7 @@ index_ssz(StaticIndex *x, PredEntry *pe)
|
||||
|
||||
while (i) {
|
||||
sz = i->size+sz;
|
||||
i = i->next;
|
||||
}
|
||||
return sz;
|
||||
}
|
||||
|
23
C/exo.c
23
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;
|
||||
}
|
||||
|
||||
|
393
C/exo_udi.c
Normal file
393
C/exo_udi.c
Normal file
@ -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 <string.h>
|
||||
#endif
|
||||
#define YAP_Term Term
|
||||
#define YAP_Atom Atom
|
||||
#include <udi.h>
|
||||
|
||||
#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);
|
||||
}
|
@ -4285,6 +4285,7 @@ Yap_InitCPreds(void)
|
||||
Yap_InitMYDDAS_TopLevelPreds();
|
||||
#endif
|
||||
Yap_udi_init();
|
||||
Yap_udi_range_init();
|
||||
|
||||
Yap_InitSignalCPreds();
|
||||
Yap_InitUserCPreds();
|
||||
|
54
C/udi.c
54
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 */
|
||||
|
||||
|
@ -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),
|
||||
|
@ -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));
|
||||
|
@ -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 */
|
||||
|
@ -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_
|
||||
|
@ -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;
|
||||
|
@ -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");
|
||||
|
@ -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;
|
||||
|
||||
|
||||
}
|
||||
|
@ -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);
|
||||
|
@ -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);
|
||||
|
@ -225,6 +225,9 @@ static void RestoreWorker(int wid USES_REGS) {
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
@ -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));
|
||||
|
@ -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_;
|
||||
|
@ -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;
|
||||
|
@ -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 \
|
||||
|
@ -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"
|
||||
|
@ -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
|
||||
|
Reference in New Issue
Block a user