/************************************************************************* * * * 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) { CACHE_REGS 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 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); */ return IntOfTerm(i)-j; } static void RangeUDIRefitIndex(struct index_t **ip, UInt b[] USES_REGS) { 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 USES_REGS) { 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 USES_REGS) { 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 USES_REGS) { 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 PASS_REGS) <= 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 USES_REGS) { 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 PASS_REGS) >= 0) return FAILCODE; while ( pt < end && compare(pt, x PASS_REGS) < 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 USES_REGS) { 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 = 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 PASS_REGS)) == 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 USES_REGS) { 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 USES_REGS) { 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 PASS_REGS); } else if (at == AtomMin) { return Min(it, off PASS_REGS); } else if (at == AtomGT) { Term arg = ArgOfTerm(1, a1); if (IsVarTerm(arg)) 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 PASS_REGS); } else if (at == AtomLT) { Term arg = ArgOfTerm(1, a1); if (IsVarTerm(arg)) 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 PASS_REGS); } else if (at == AtomEQ) { Term arg = ArgOfTerm(1, a1); if (IsVarTerm(arg)) 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 PASS_REGS); } return FAILCODE; } static int RangeRetryUDIIndex(struct index_t *it USES_REGS) { 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; } exo_udi_encaps_t; 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) { CACHE_REGS struct index_t **ip = (struct index_t **)term; (ExoCB.refit)(ip, LOCAL_ibnds PASS_REGS); (*ip)->udi_first = (void *)RangeEnterUDIIndex; (*ip)->udi_next = (void *)RangeRetryUDIIndex; return control; } 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=NULL; cb->destroy=RangeUdiDestroy; Yap_UdiRegister(cb); }