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

Merge branch 'master' of ssh://yap.git.sourceforge.net/gitroot/yap/yap-6.3

Browse Source
This commit is contained in:
Tiago Gomes 2013-01-09 18:51:11 +00:00
commit 29b2d4f3df
67 changed files with 2893 additions and 1226 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitignore vendored
View File

@ -11,3 +11,8 @@
*.dylib
docs/yap.info*
.build
.cproject
.project
.settings
autom4te.cache

3
.gitmodules vendored
View File

@ -43,3 +43,6 @@
[submodule "packages/odbc"]
path = packages/odbc
url = git://yap.git.sourceforge.net/gitroot/yap/odbc
[submodule "packages/udi"]
path = packages/udi
url = https://github.com/davidvaz/yap-udi-indexers.git

222
C/absmi.c
View File

@ -960,6 +960,193 @@ Yap_absmi(int inp)
GONext();
ENDOp();
/*****************************************************************
* EXO try - retry instructions *
*****************************************************************/
/* try_exo Pred,Label */
BOp(enter_exo, e);
{
yamop *pt;
saveregs();
pt = Yap_ExoLookup(PredFromDefCode(PREG));
setregs();
#ifdef SHADOW_S
SREG = S;
#endif
PREG = pt;
}
JMPNext();
ENDBOp();
/* check if enough space between trail and codespace */
/* try_exo Pred,Label */
Op(try_exo, 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);
{
struct index_t *i = (struct index_t *)(PREG->u.lp.l);
S_YREG[-1] = (CELL)EXO_OFFSET_TO_ADDRESS(i,i->links[(CELL)(SREG-i->cls)/i->arity]);
}
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();
/* check if enough space between trail and codespace */
/* try_exo Pred,Label */
Op(try_all_exo, 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);
{
struct index_t *i = (struct index_t *)(PREG->u.lp.l);
SREG = i->cls;
S_YREG[-2] = (CELL)(SREG+i->arity);
S_YREG[-1] = (CELL)(SREG+i->arity*i->nels);
}
S_YREG-=2;
/* 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();
/* retry_exo Pred */
Op(retry_exo, lp);
BEGD(d0);
CACHE_Y(B);
saveregs();
d0 = Yap_NextExo(B_YREG, (struct index_t *)PREG->u.lp.l);
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_all_exo, lp);
BEGD(d0);
CACHE_Y(B);
{
UInt arity = ((struct index_t *)PREG->u.lp.l)->arity;
CELL *extras = (CELL *)(B+1);
SREG = (CELL *)extras[arity];
d0 = (SREG+arity != (CELL *)extras[arity+1]);
if (d0) {
extras[arity] = (CELL)(SREG+arity);
/* After retry, cut should be pointing at the parent
* choicepoint for the current B */
restore_yaam_regs(PREG);
restore_at_least_one_arg(arity);
#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(arity);
#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(arity);
/* 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();
/*****************************************************************
* Profiled try - retry - trust instructions *
*****************************************************************/
@ -3228,7 +3415,7 @@ Yap_absmi(int inp)
ENDOp();
Op(run_eam, os);
if (inp==-9000) { /* usar a indexação para saber quais as alternativas validas */
if (inp==-9000) { /* use indexing to find out valid alternatives */
extern CELL *beam_ALTERNATIVES;
*beam_ALTERNATIVES= (CELL *) PREG->u.os.opcw;
beam_ALTERNATIVES++;
@ -3277,6 +3464,8 @@ Yap_absmi(int inp)
#endif
/************************************************************************\
* Get Instructions *
\************************************************************************/
@ -3470,6 +3659,37 @@ Yap_absmi(int inp)
ENDD(d0);
ENDOp();
Op(get_atom_exo, x);
BEGD(d0);
BEGD(d1);
/* fetch arguments */
d0 = XREG(PREG->u.x.x);
d1 = *SREG;
SREG++;
BEGP(pt0);
deref_head(d0, gatom_exo_unk);
/* argument is nonvar */
gatom_exo_nonvar:
if (d0 == d1) {
PREG = NEXTOP(PREG, x);
GONext();
}
else {
FAIL();
}
deref_body(d0, pt0, gatom_exo_unk, gatom_exo_nonvar);
/* argument is a variable */
pt0 = (CELL *)d0;
PREG = NEXTOP(PREG, x);
Bind(pt0, d1);
GONext();
ENDP(pt0);
ENDD(d1);
ENDD(d0);
ENDOp();
Op(get_2atoms, cc);
BEGD(d0);
BEGD(d1);

24
C/adtdefs.c Normal file → Executable file
View File

@ -264,8 +264,8 @@ LookupWideAtom(wchar_t *atom)
wae->NextOfPE = NIL;
wae->KindOfPE = WideAtomProperty;
wae->SizeOfAtom = sz;
if (ae->StrOfAE != (char *)atom)
wcscpy((wchar_t *)(ae->StrOfAE), atom);
if (ae->WStrOfAE != atom)
wcscpy(ae->WStrOfAE, atom);
NOfAtoms++;
ae->NextOfAE = a;
WideHashChain[hash].Entry = na;
@ -771,7 +771,6 @@ ExpandPredHash(void)
Prop
Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
{
CACHE_REGS
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
if (p == NULL) {
@ -852,9 +851,12 @@ Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
}
p->FunctorOfPred = fe;
WRITE_UNLOCK(fe->FRWLock);
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_FUNC);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_FUNC);
{
CACHE_REGS
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_FUNC);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_FUNC);
}
}
return AbsPredProp(p);
}
@ -907,7 +909,6 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
Prop
Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
{
CACHE_REGS
Prop p0;
PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
@ -964,9 +965,12 @@ Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
p0 = AbsPredProp(p);
p->FunctorOfPred = (Functor)AbsAtom(ae);
WRITE_UNLOCK(ae->ARWLock);
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_ATOM);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_ATOM);
{
CACHE_REGS
Yap_inform_profiler_of_clause(&(p->OpcodeOfPred), &(p->OpcodeOfPred)+1, p, GPROF_NEW_PRED_ATOM);
if (!(p->PredFlags & (CPredFlag|AsmPredFlag))) {
Yap_inform_profiler_of_clause(&(p->cs.p_code.ExpandCode), &(p->cs.p_code.ExpandCode)+1, p, GPROF_NEW_PRED_ATOM);
}
}
return p0;
}

8
C/alloc.c
View File

@ -126,7 +126,7 @@ long long unsigned int tmalloc;
static inline char *
call_malloc(unsigned long int size)
call_malloc(size_t size)
{
CACHE_REGS
char *out;
@ -152,7 +152,7 @@ call_malloc(unsigned long int size)
}
char *
Yap_AllocCodeSpace(unsigned long int size)
Yap_AllocCodeSpace(size_t size)
{
size = AdjustSize(size);
return call_malloc(size);
@ -187,7 +187,7 @@ call_realloc(char *p, unsigned long int size)
}
char *
Yap_ReallocCodeSpace(char *p, unsigned long int size)
Yap_ReallocCodeSpace(char *p, size_t size)
{
size = AdjustSize(size);
return call_realloc(p, size);
@ -214,7 +214,7 @@ Yap_FreeCodeSpace(char *p)
}
char *
Yap_AllocAtomSpace(unsigned long int size)
Yap_AllocAtomSpace(size_t size)
{
size = AdjustSize(size);
return call_malloc(size);

6
C/amasm.c Normal file → Executable file
View File

@ -2050,14 +2050,16 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
yamop *newcp;
/* emit a special instruction and then a label for backpatching */
if (pass_no) {
CACHE_REGS
UInt size = (UInt)NEXTOP((yamop *)NULL,OtaLl);
if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
/* OOOPS, got in trouble, must do a longjmp and recover space */
save_machine_regs();
siglongjmp(cip->CompilerBotch,2);
}
Yap_inform_profiler_of_clause(newcp, (char *)(newcp)+size, ap, GPROF_INDEX);
{
CACHE_REGS
Yap_inform_profiler_of_clause(newcp, (char *)(newcp)+size, ap, GPROF_INDEX);
}
Yap_LUIndexSpace_CP += size;
#ifdef DEBUG
Yap_NewCps++;

4
C/c_interface.c
View File

@ -3190,7 +3190,7 @@ YAP_Init(YAP_init_args *yap_init)
/* first, initialise the saved state */
Term t_goal = MkAtomTerm(AtomInitProlog);
YAP_RunGoalOnce(t_goal);
Yap_InitYaamRegs( 0 );
// Yap_InitYaamRegs( 0 );
/* reset stacks */
return YAP_BOOT_FROM_SAVED_CODE;
} else {
@ -3314,7 +3314,7 @@ YAP_Reset(void)
}
}
/* reinitialise the engine */
Yap_InitYaamRegs( worker_id );
// Yap_InitYaamRegs( worker_id );
GLOBAL_Initialised = TRUE;
RECOVER_MACHINE_REGS();

14
C/cdmgr.c
View File

@ -809,7 +809,7 @@ Yap_BuildMegaClause(PredEntry *ap)
UInt sz;
MegaClause *mcl;
yamop *ptr;
UInt required;
size_t required;
UInt has_blobs = 0;
if (ap->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|MegaClausePredFlag
@ -839,6 +839,12 @@ Yap_BuildMegaClause(PredEntry *ap)
sz -= (UInt)NEXTOP((yamop *)NULL,p) + sizeof(StaticClause);
}
required = sz*ap->cs.p_code.NOfClauses+sizeof(MegaClause)+(UInt)NEXTOP((yamop *)NULL,l);
while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
if (!Yap_growheap(FALSE, required, NULL)) {
/* just fail, the system will keep on going */
return;
}
}
#ifdef DEBUG
total_megaclause += required;
cl =
@ -846,12 +852,6 @@ Yap_BuildMegaClause(PredEntry *ap)
total_released += ap->cs.p_code.NOfClauses*cl->ClSize;
nof_megaclauses++;
#endif
while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
if (!Yap_growheap(FALSE, required, NULL)) {
/* just fail, the system will keep on going */
return;
}
}
Yap_ClauseSpace += required;
/* cool, it's our turn to do the conversion */
mcl->ClFlags = MegaMask | has_blobs;

12
C/dbase.c Normal file → Executable file
View File

@ -1887,13 +1887,15 @@ Yap_new_ludbe(Term t, PredEntry *pe, UInt nargs)
static LogUpdClause *
record_lu(PredEntry *pe, Term t, int position)
{
CACHE_REGS
LogUpdClause *cl;
if ((cl = new_lu_db_entry(t, pe)) == NULL) {
return NULL;
}
Yap_inform_profiler_of_clause(cl, (char *)cl+cl->ClSize, pe, GPROF_NEW_LU_CLAUSE);
{
CACHE_REGS
Yap_inform_profiler_of_clause(cl, (char *)cl+cl->ClSize, pe, GPROF_NEW_LU_CLAUSE);
}
Yap_add_logupd_clause(pe, cl, (position == MkFirst ? 2 : 0));
return cl;
}
@ -4430,7 +4432,7 @@ p_increase_reference_counter( USES_REGS1 )
cl = (LogUpdClause *)DBRefOfTerm(t1);
PELOCK(67,cl->ClPred);
cl->ClRefCount++;
UNLOCK(cl->ClPred);
UNLOCK(cl->ClPred->PELock);
return TRUE;
}
@ -4453,10 +4455,10 @@ p_decrease_reference_counter( USES_REGS1 )
PELOCK(67,cl->ClPred);
if (cl->ClRefCount) {
cl->ClRefCount--;
UNLOCK(cl->ClPred);
UNLOCK(cl->ClPred->PELock);
return TRUE;
}
UNLOCK(cl->ClPred);
UNLOCK(cl->ClPred->PELock);
return FALSE;
}

5
C/exec.c
View File

@ -1736,7 +1736,7 @@ Yap_InitYaamRegs( int myworker_id )
Yap_ResetExceptionTerm ( myworker_id );
Yap_PutValue (AtomBreak, MkIntTerm (0));
TR = (tr_fr_ptr)REMOTE_TrailBase(myworker_id);
H = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id));
H = H0 = ((CELL *) REMOTE_GlobalBase(myworker_id))+1; // +1: hack to ensure the gc does not try to mark mistakenly
LCL0 = ASP = (CELL *) REMOTE_LocalBase(myworker_id);
CurrentTrailTop = (tr_fr_ptr)(REMOTE_TrailTop(myworker_id)-MinTrailGap);
/* notice that an initial choice-point and environment
@ -1767,8 +1767,9 @@ Yap_InitYaamRegs( int myworker_id )
Yap_StartSlots( PASS_REGS1 );
REMOTE_GlobalArena(myworker_id) = TermNil;
h0var = MkVarTerm();
#ifdef THREADS
#if defined(YAPOR) || defined(THREADS)
LOCAL = REMOTE(myworker_id);
worker_id = myworker_id;
#endif /* THREADS */
#if COROUTINING
REMOTE_WokenGoals(myworker_id) = Yap_NewTimedVar(TermNil);

495
C/exo.c Normal file
View File

@ -0,0 +1,495 @@
/*************************************************************************
* *
* 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"
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#ifdef TABLING
#include "tab.macros.h"
#endif /* TABLING */
#if HAVE_STRING_H
#include <string.h>
#endif
//static int exo_write=FALSE;
//void do_write(void) { exo_write=TRUE;}
#define NEXTOP(V,TYPE) ((yamop *)(&((V)->u.TYPE.next)))
#define MAX_ARITY 256
/* Simple hash function:
first component is the base key.
hash0 spreads extensions coming from different elements.
spread over j quadrants.
*/
static UInt
HASH(UInt hash0, UInt j, CELL *cl, struct index_t *it)
{
Term t = cl[j];
UInt sz = it->hsize;
if (IsIntTerm(t))
return (IntOfTerm(t) * 17* (hash0+1)*(j+1) ) % sz;
return (((UInt)AtomOfTerm(t) >> 5)* 17*(hash0+1)*(j+1) ) % sz;
}
/* search for matching elements */
static int
MATCH(CELL *clp, CELL *kvp, UInt j, struct index_t *it)
{
if ((kvp - it->cls)%it->arity != j)
return FALSE;
do {
if ( LOCAL_ibnds[j] && *clp != *kvp)
return FALSE;
clp--;
kvp--;
} while (j-- != 0);
return TRUE;
}
static UInt
NEXT(UInt hash, Term t, UInt j, struct index_t *it)
{
return (hash+(t>>4)+j+1) % (it->hsize);
}
static void
ADD_TO_TRY_CHAIN(CELL *kvp, CELL *cl, struct index_t *it)
{
UInt old = (kvp-it->cls)/it->arity;
UInt new = (cl-it->cls)/it->arity;
UInt *links = it->links;
UInt tmp = links[old]; /* points to the end of the chain */
if (!tmp) {
links[old] = links[new] = new;
} else {
links[new] = links[tmp];
links[tmp] = new;
links[old] = new;
}
}
/* This is the critical routine, it builds the hash table *
* each HT field stores a key pointer which is actually
* a pointer to the point in the clause where one can find the element.
*
* The cls table indexes all elements that can be reached using that key.
*
* Insert:
* j = first
* not match cij -> insert, open new chain
* match ci..j ck..j -> find j = minarg(cij \= c2j),
* else j = +inf -> c2+ci
* Lookup:
* j= first
* not match cij -> fail
* match ci..j ck..j -> find j = minarg(cij \= c2j)
* else
*/
static void
INSERT(CELL *cl, struct index_t *it, UInt arity, UInt base, UInt hash0)
{
UInt j = base;
CELL *kvp;
UInt hash;
/* skip over argument */
while (!LOCAL_ibnds[j]) {
j++;
}
/* j is the firs bound element */
/* check if we match */
hash = hash0 = HASH(hash0, j, cl, it);
//if (exo_write) printf("h=%ld j=%ld %lx\n", hash, j, cl[j]);
next:
/* loop to insert element */
kvp = it->key[hash];
if (kvp == NULL) {
/* simple case, new entry */
it->nentries++;
it->key[hash] = cl+j;
return;
} else if (MATCH(cl+j, kvp, j, it)) {
/* collision */
UInt k;
CELL *target;
for (k =j+1, target = kvp+1; k < arity; k++,target++ ) {
if (LOCAL_ibnds[k]) {
if (*target != cl[k]) {
/* found a new forking point */
INSERT(cl, it, arity, k, hash0);
return;
}
}
}
it->ntrys++;
ADD_TO_TRY_CHAIN(kvp, cl, it);
return;
} else {
it->ncollisions++;
hash = NEXT(hash, cl[j], j, it);
//if (exo_write) printf("N=%ld\n", hash);
goto next;
}
}
static yamop *
LOOKUP(struct index_t *it, UInt arity, UInt j)
{
CELL *kvp;
UInt hash, hash0 = 0;
/* j is the firs bound element */
/* check if we match */
hash:
hash = hash0 = HASH(hash0, j, XREGS+1, it);
next:
/* loop to insert element */
kvp = it->key[hash];
if (kvp == NULL) {
/* simple case, no element */
return FAILCODE;
} else if (MATCH(XREGS+(j+1), kvp, j, it)) {
/* found element */
UInt k;
CELL *target;
for (k =j+1, target = kvp+1; k < arity; k++ ) {
if (LOCAL_ibnds[k]) {
if (*target != XREGS[k+1]) {
j = k;
goto hash;
}
}
target++;
}
S = target-arity;
if (!it->is_key && it->links[(S-it->cls)/arity])
return it->code;
else
return NEXTOP(NEXTOP(it->code,lp),lp);
} else {
/* collision */
hash = NEXT(hash, XREGS[j+1], j, it);
goto next;
}
}
static void
fill_hash(UInt bmap, struct index_t *it)
{
UInt i;
UInt arity = it->arity;
CELL *cl = it->cls;
for (i=0; i < it->nels; i++) {
INSERT(cl, it, arity, 0, 0);
cl += arity;
}
for (i=0; i < it->hsize; i++) {
if (it->key[i]) {
UInt offset = (it->key[i]-it->cls)/arity;
UInt last = it->links[offset];
if (last) {
/* the chain used to point straight to the last, and the last back to the origibal first */
it->links[offset] = it->links[last];
it->links[last] = 0;
}
}
}
}
static struct index_t *
add_index(struct index_t **ip, UInt bmap, PredEntry *ap, UInt count)
{
UInt ncls = ap->cs.p_code.NOfClauses, j;
CELL *base = NULL;
struct index_t *i;
size_t sz;
yamop *ptr;
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))) {
CACHE_REGS
save_machine_regs();
LOCAL_Error_Size = 3*ncls*sizeof(CELL);
LOCAL_ErrorMessage = "not enough space to index";
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL;
}
i->next = *ip;
i->prev = NULL;
i->nels = ncls;
i->arity = ap->ArityOfPE;
i->ap = ap;
i->bmap = bmap;
i->is_key = FALSE;
i->hsize = 2*ncls;
if (count) {
if (!(base = (CELL *)Yap_AllocCodeSpace(sizeof(CELL)*(ncls+i->hsize)))) {
CACHE_REGS
save_machine_regs();
LOCAL_Error_Size = 3*ncls*sizeof(CELL);
LOCAL_ErrorMessage = "not enough space to generate indices";
Yap_FreeCodeSpace((void *)i);
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
return NULL;
}
bzero(base, 3*sizeof(CELL)*ncls);
}
i->key = (CELL **)base;
i->links = (CELL *)(base+2*ncls);
i->ncollisions = i->nentries = i->ntrys = 0;
i->cls = (CELL *)((ADDR)ap->cs.p_code.FirstClause+2*sizeof(struct index_t *));
*ip = i;
if (count) {
fill_hash(bmap, i);
printf("entries=%ld collisions=%ld trys=%ld\n", i->nentries, i->ncollisions, i->ntrys);
if (!i->ntrys) {
i->is_key = TRUE;
if (base != realloc(base, 2*sizeof(CELL)*ncls))
return FALSE;
}
}
ptr = (yamop *)(i+1);
i->code = ptr;
if (count)
ptr->opc = Yap_opcode(_try_exo);
else
ptr->opc = Yap_opcode(_try_all_exo);
ptr->u.lp.l = (yamop *)i;
ptr->u.lp.p = ap;
ptr = NEXTOP(ptr, lp);
if (count)
ptr->opc = Yap_opcode(_retry_exo);
else
ptr->opc = Yap_opcode(_retry_all_exo);
ptr->u.lp.p = ap;
ptr->u.lp.l = (yamop *)i;
ptr = NEXTOP(ptr, lp);
for (j = 0; j < i->arity; j++) {
ptr->opc = Yap_opcode(_get_atom_exo);
#if PRECOMPUTE_REGADDRESS
ptr->u.x.x = (CELL) (XREGS + (j+1));
#else
ptr->u.x.x = j+1;
#endif
ptr = NEXTOP(ptr, x);
}
ptr->opc = Yap_opcode(_procceed);
ptr->u.p.p = ap;
ptr = NEXTOP(ptr, p);
ptr->opc = Yap_opcode(_Ystop);
ptr->u.l.l = i->code;
return i;
}
yamop *
Yap_ExoLookup(PredEntry *ap)
{
UInt arity = ap->ArityOfPE;
UInt bmap = 0L, bit = 1, count = 0, j, j0 = 0;
struct index_t **ip = (struct index_t **)(ap->cs.p_code.FirstClause);
struct index_t *i = *ip;
for (j=0; j< arity; j++, bit<<=1) {
Term t = Deref(XREGS[j+1]);
if (!IsVarTerm(t)) {
bmap += bit;
LOCAL_ibnds[j] = TRUE;
if (!count) j0= j;
count++;
} else {
LOCAL_ibnds[j] = FALSE;
}
XREGS[j+1] = t;
}
while (i) {
if (i->is_key) {
if ((i->bmap & bmap) == i->bmap) {
break;
}
} else {
if (i->bmap == bmap) {
break;
}
}
ip = &i->next;
i = i->next;
}
if (!i) {
i = add_index(ip, bmap, ap, count);
}
if (count)
return LOOKUP(i, arity, j0);
else
return i->code;
}
CELL
Yap_NextExo(choiceptr cptr, struct index_t *it)
{
CELL offset = EXO_ADDRESS_TO_OFFSET(it,(CELL *)((CELL *)(B+1))[it->arity]);
CELL next = it->links[offset];
((CELL *)(B+1))[it->arity] = (CELL)EXO_OFFSET_TO_ADDRESS(it, next);
S = it->cls+it->arity*offset;
return next;
}
static Int
p_exodb_get_space( USES_REGS1 )
{ /* '$number_of_clauses'(Predicate,M,N) */
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
Term tn = Deref(ARG3);
UInt arity;
Prop pe;
PredEntry *ap;
MegaClause *mcl;
UInt ncls;
UInt required;
struct index_t **li;
if (IsVarTerm(mod) || !IsAtomTerm(mod)) {
return(FALSE);
}
if (IsAtomTerm(t)) {
Atom a = AtomOfTerm(t);
arity = 0;
pe = PredPropByAtom(a, mod);
} else if (IsApplTerm(t)) {
register Functor f = FunctorOfTerm(t);
arity = ArityOfFunctor(f);
pe = PredPropByFunc(f, mod);
} else {
return FALSE;
}
if (EndOfPAEntr(pe))
return FALSE;
ap = RepPredProp(pe);
if (ap->PredFlags & (DynamicPredFlag|LogUpdatePredFlag
#ifdef TABLING
|TabledPredFlag
#endif /* TABLING */
)) {
Yap_Error(PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,t,"dbload_get_space/4");
return FALSE;
}
if (IsVarTerm(tn) || !IsIntegerTerm(tn)) {
return FALSE;
}
ncls = IntegerOfTerm(tn);
if (ncls <= 1) {
return FALSE;
}
required = ncls*arity*sizeof(CELL)+sizeof(MegaClause)+2*sizeof(struct index_t *);
while (!(mcl = (MegaClause *)Yap_AllocCodeSpace(required))) {
if (!Yap_growheap(FALSE, required, NULL)) {
/* just fail, the system will keep on going */
return FALSE;
}
}
Yap_ClauseSpace += required;
/* cool, it's our turn to do the conversion */
mcl->ClFlags = MegaMask;
mcl->ClSize = required-sizeof(MegaClause);
mcl->ClPred = ap;
mcl->ClItemSize = arity*sizeof(CELL);
mcl->ClNext = NULL;
li = (struct index_t **)(mcl->ClCode);
li[0] = li[1] = NULL;
ap->cs.p_code.FirstClause =
ap->cs.p_code.LastClause =
mcl->ClCode;
ap->PredFlags |= MegaClausePredFlag;
ap->cs.p_code.NOfClauses = ncls;
if (ap->PredFlags & (SpiedPredFlag|CountPredFlag|ProfiledPredFlag)) {
ap->OpcodeOfPred = Yap_opcode(_spy_pred);
} else {
ap->OpcodeOfPred = Yap_opcode(_enter_exo);
}
ap->CodeOfPred = ap->cs.p_code.TrueCodeOfPred = (yamop *)(&(ap->OpcodeOfPred));
return Yap_unify(ARG4, MkIntegerTerm((Int)mcl));
}
#define DerefAndCheck(t, V) \
t = Deref(V); if(IsVarTerm(t) || !(IsAtomOrIntTerm(t))) Yap_Error(TYPE_ERROR_ATOM, t0, "load_db");
static int
store_exo(yamop *pc, UInt arity, Term t0)
{
Term t;
CELL *tp = RepAppl(t0)+1,
*cpc = (CELL *)pc;
UInt i;
for (i = 0; i< arity; i++) {
DerefAndCheck(t, tp[0]);
*cpc = t;
tp++;
cpc++;
}
return TRUE;
}
static Int
p_exoassert( USES_REGS1 )
{ /* '$number_of_clauses'(Predicate,M,N) */
Term thandle = Deref(ARG2);
Term tn = Deref(ARG3);
PredEntry *pe;
MegaClause *mcl;
Int n;
if (IsVarTerm(thandle) || !IsIntegerTerm(thandle)) {
return FALSE;
}
mcl = (MegaClause *)IntegerOfTerm(thandle);
if (IsVarTerm(tn) || !IsIntegerTerm(tn)) {
return FALSE;
}
n = IntegerOfTerm(tn);
pe = mcl->ClPred;
return store_exo((yamop *)((ADDR)mcl->ClCode+2*sizeof(struct index_t *)+n*(mcl->ClItemSize)),pe->ArityOfPE, Deref(ARG1));
}
void
Yap_InitExoPreds(void)
{
CACHE_REGS
Term cm = CurrentModule;
CurrentModule = DBLOAD_MODULE;
Yap_InitCPred("exo_db_get_space", 4, p_exodb_get_space, 0L);
Yap_InitCPred("exoassert", 3, p_exoassert, 0L);
CurrentModule = cm;
}

2
C/gprof.c Normal file → Executable file
View File

@ -1177,8 +1177,8 @@ static Int profres0( USES_REGS1 ) {
void
Yap_InitLowProf(void)
{
CACHE_REGS
#if LOW_PROF
CACHE_REGS
LOCAL_ProfCalls = 0;
LOCAL_ProfilerOn = FALSE;

6
C/grow.c
View File

@ -1318,7 +1318,7 @@ init_new_table(AtomHashEntry *ntb, UInt nsize)
{
UInt i;
for (i = 0; i < nsize; ++i) {
for (i = 0; i < nsize; i++) {
INIT_RWLOCK(ntb[i].AERWLock);
ntb[i].Entry = NIL;
}
@ -1410,7 +1410,7 @@ growatomtable( USES_REGS1 )
int
Yap_growheap(int fix_code, UInt in_size, void *cip)
Yap_growheap(int fix_code, size_t in_size, void *cip)
{
CACHE_REGS
int res;
@ -1441,7 +1441,7 @@ Yap_growheap(int fix_code, UInt in_size, void *cip)
}
#if USE_SYSTEM_MALLOC
P = Yap_Error(OUT_OF_HEAP_ERROR,TermNil,"malloc failed");
res = -1;
res = FALSE;
#else
res=do_growheap(fix_code, in_size, (struct intermediates *)cip, NULL, NULL, NULL PASS_REGS);
#endif

33
C/heapgc.c
View File

@ -410,8 +410,15 @@ push_registers(Int num_regs, yamop *nextop USES_REGS)
al = al->NextAE;
}
while (gl) {
check_pr_trail(TR PASS_REGS);
TrailTerm(TR++) = gl->global;
Term t = gl->global;
if (!IsUnboundVar(&gl->global) &&
!IsAtomTerm(t) &&
!IsIntTerm(t)
) {
check_pr_trail(TR PASS_REGS);
//fprintf(stderr,"in=%s %p\n", gl->AtomOfGE->StrOfAE, gl->global);
TrailTerm(TR++) = t;
}
gl = gl->NextGE;
}
while (sal) {
@ -504,7 +511,14 @@ pop_registers(Int num_regs, yamop *nextop USES_REGS)
al = al->NextAE;
}
while (gl) {
gl->global = TrailTerm(ptr++);
Term t = gl->global;
if (!IsUnboundVar(&gl->global) &&
!IsAtomTerm(t) &&
!IsIntTerm(t)
) {
//fprintf(stderr,"out=%s %p\n", gl->AtomOfGE->StrOfAE, gl->global);
gl->global = TrailTerm(ptr++);
}
gl = gl->NextGE;
}
sal = LOCAL_StaticArrays;
@ -1150,6 +1164,7 @@ mark_variable(CELL_PTR current USES_REGS)
POP_CONTINUATION();
}
if (current >= H0 && current < H) {
//fprintf(stderr,"%p M\n", current);
LOCAL_total_marked++;
if (current < LOCAL_HGEN) {
LOCAL_total_oldies++;
@ -1165,6 +1180,7 @@ mark_variable(CELL_PTR current USES_REGS)
if (IN_BETWEEN(LOCAL_GlobalBase,current,H) && GlobalIsAttVar(current) && current==next) {
if (next < H0) POP_CONTINUATION();
if (!UNMARKED_MARK(next-1,local_bp)) {
//fprintf(stderr,"%p M\n", next-1);
LOCAL_total_marked++;
if (next-1 < LOCAL_HGEN) {
LOCAL_total_oldies++;
@ -1207,6 +1223,7 @@ mark_variable(CELL_PTR current USES_REGS)
UNMARK(current);
*current = cnext;
if (current >= H0 && current < H) {
//fprintf(stderr,"%p M\n", current-1);
LOCAL_total_marked--;
if (current < LOCAL_HGEN) {
LOCAL_total_oldies--;
@ -1231,6 +1248,7 @@ mark_variable(CELL_PTR current USES_REGS)
*current = UNMARK_CELL(cnext);
UNMARK(current);
if (current >= H0 && current < H ) {
//fprintf(stderr,"%p M\n", current);
LOCAL_total_marked--;
if (current < LOCAL_HGEN) {
LOCAL_total_oldies--;
@ -1278,6 +1296,7 @@ mark_variable(CELL_PTR current USES_REGS)
/* speedup for strings */
if (IsAtomOrIntTerm(*next)) {
if (!UNMARKED_MARK(next,local_bp)) {
//fprintf(stderr,"%p M\n", next);
LOCAL_total_marked++;
if (next < LOCAL_HGEN) {
LOCAL_total_oldies++;
@ -1337,6 +1356,7 @@ mark_variable(CELL_PTR current USES_REGS)
DEBUG_printf0("%p 1\n", next);
DEBUG_printf0("%p 3\n", next);
}
//fprintf(stderr,"%p M 3\n", next);
LOCAL_total_marked += 3;
PUSH_POINTER(next PASS_REGS);
PUSH_POINTER(next+2 PASS_REGS);
@ -1352,6 +1372,7 @@ mark_variable(CELL_PTR current USES_REGS)
DEBUG_printf0("%p 1\n", next);
DEBUG_printf1("%p %ld\n", next, (long int)(sz+1));
}
//fprintf(stderr,"%p M %d\n", next,1+sz);
LOCAL_total_marked += 1+sz;
PUSH_POINTER(next+sz PASS_REGS);
MARK(next+sz);
@ -1390,6 +1411,7 @@ mark_variable(CELL_PTR current USES_REGS)
DEBUG_printf0("%p 1\n", next);
DEBUG_printf1("%p %ld\n", next, (long int)(sz+2));
}
//fprintf(stderr,"%p M %d\n", next,2+sz);
LOCAL_total_marked += 2+sz;
PUSH_POINTER(next PASS_REGS);
sz++;
@ -1411,6 +1433,7 @@ mark_variable(CELL_PTR current USES_REGS)
#endif
arity = ArityOfFunctor((Functor)(cnext));
MARK(next);
//fprintf(stderr,"%p M\n", next);
++LOCAL_total_marked;
if (next < LOCAL_HGEN) {
++LOCAL_total_oldies;
@ -1422,6 +1445,7 @@ mark_variable(CELL_PTR current USES_REGS)
/* speedup for leaves */
while (arity && IsAtomOrIntTerm(*next)) {
if (!UNMARKED_MARK(next,local_bp)) {
//fprintf(stderr,"%p M\n", next);
LOCAL_total_marked++;
if (next < LOCAL_HGEN) {
LOCAL_total_oldies++;
@ -1695,6 +1719,7 @@ mark_trail(tr_fr_ptr trail_ptr, tr_fr_ptr trail_base, CELL *gc_H, choiceptr gc_B
The ideal solution would be to unbind all variables. The current solution is to
remark it as an attributed variable */
if (IN_BETWEEN(LOCAL_GlobalBase,hp,H) && GlobalIsAttVar(hp) && !UNMARKED_MARK(hp-1,LOCAL_bp)) {
//fprintf(stderr,"%p M\n", hp);
LOCAL_total_marked++;
PUSH_POINTER(hp-1 PASS_REGS);
if (hp-1 < LOCAL_HGEN) {
@ -3367,6 +3392,7 @@ compact_heap( USES_REGS1 )
ptr++;
MARK(ptr);
#ifdef DEBUG
//fprintf(stderr,"%p U %d\n", ptr, nofcells);
found_marked+=nofcells;
#endif
/* first swap the tag so that it will be seen by the next step */
@ -3381,6 +3407,7 @@ compact_heap( USES_REGS1 )
DEBUG_printf20("%p 1\n", current);
}
#ifdef DEBUG
// fprintf(stderr,"%p U\n", current);
found_marked++;
#endif /* DEBUG */
update_relocation_chain(current, dest PASS_REGS);

6
C/index.c Normal file → Executable file
View File

@ -1888,7 +1888,6 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i
static UInt
suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermediates *cint)
{
CACHE_REGS
UInt tcls = ap->cs.p_code.NOfClauses;
UInt cls = (max-min)+1;
@ -1924,7 +1923,10 @@ suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermedi
} else {
Yap_IndexSpace_EXT += sz;
}
Yap_inform_profiler_of_clause(ncode, (CODEADDR)ncode+sz, ap, GPROF_NEW_EXPAND_BLOCK);
{
CACHE_REGS
Yap_inform_profiler_of_clause(ncode, (CODEADDR)ncode+sz, ap, GPROF_NEW_EXPAND_BLOCK);
}
/* create an expand_block */
ncode->opc = Yap_opcode(_expand_clauses);
ncode->u.sssllp.p = ap;

2
C/init.c
View File

@ -1318,7 +1318,7 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
Yap_InitTime( 0 );
/* InitAbsmi must be done before InitCodes */
/* This must be done before initialising predicates */
for (i = 0; i <= NUMBER_OF_YAP_FLAGS; i++) {
for (i = 0; i < NUMBER_OF_YAP_FLAGS; i++) {
yap_flags[i] = 0;
}
#ifdef MPW

2
C/qlyr.c Normal file → Executable file
View File

@ -961,7 +961,6 @@ read_ops(IOSTREAM *stream) {
static void
read_module(IOSTREAM *stream) {
CACHE_REGS
qlf_tag_t x;
InitHash();
@ -1045,7 +1044,6 @@ p_read_program( USES_REGS1 )
int
Yap_Restore(char *s, char *lib_dir)
{
CACHE_REGS
IOSTREAM *stream = Yap_OpenRestore(s, lib_dir);
if (!stream)
return -1;

2
C/qlyw.c Normal file → Executable file
View File

@ -765,7 +765,6 @@ save_ops(IOSTREAM *stream, Term mod) {
static size_t
save_module(IOSTREAM *stream, Term mod) {
CACHE_REGS
PredEntry *ap = Yap_ModulePred(mod);
InitHash();
ModuleAdjust(mod);
@ -803,7 +802,6 @@ save_header(IOSTREAM *stream)
static size_t
save_program(IOSTREAM *stream) {
CACHE_REGS
ModEntry *me = CurrentModules;
InitHash();

3
C/stdpreds.c
View File

@ -4028,7 +4028,7 @@ p_access_yap_flags( USES_REGS1 )
return(FALSE);
}
flag = IntOfTerm(tflag);
if (flag < 0 || flag > NUMBER_OF_YAP_FLAGS) {
if (flag < 0 || flag >= NUMBER_OF_YAP_FLAGS) {
return(FALSE);
}
#ifdef TABLING
@ -4486,6 +4486,7 @@ Yap_InitCPreds(void)
Yap_InitGlobals();
Yap_InitInlines();
Yap_InitIOPreds();
Yap_InitExoPreds();
Yap_InitLoadForeign();
Yap_InitModulesC();
Yap_InitSavePreds();

29
C/sysbits.c
View File

@ -466,7 +466,7 @@ static clock_t TimesStartOfTimes, Times_last_time;
/* store user time in this variable */
static void
InitTime (int)
InitTime (int wid)
{
HANDLE hProcess = GetCurrentProcess();
FILETIME CreationTime, ExitTime, KernelTime, UserTime;
@ -476,6 +476,11 @@ InitTime (int)
t = clock ();
Times_last_time = TimesStartOfTimes = t;
} else {
#if THREADS
REMOTE_ThreadHandle(wid).start_of_timesp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_timep = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).start_of_times_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME));
REMOTE_ThreadHandle(wid).last_time_sysp = (struct _FILETIME *)malloc(sizeof(FILETIME));
(*REMOTE_ThreadHandle(wid).last_timep).dwLowDateTime =
UserTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_timep).dwHighDateTime =
@ -488,10 +493,28 @@ InitTime (int)
KernelTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).last_time_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwLowDateTime =
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwLowDateTime =
KernelTime.dwLowDateTime;
(*REMOTE_ThreadHandle(wid).start_of_times_sysp).dwHighDateTime =
KernelTime.dwHighDateTime;
#else
last_time.dwLowDateTime =
UserTime.dwLowDateTime;
last_time.dwHighDateTime =
UserTime.dwHighDateTime;
StartOfTimes.dwLowDateTime =
UserTime.dwLowDateTime;
StartOfTimes.dwHighDateTime =
UserTime.dwHighDateTime;
last_time_sys.dwLowDateTime =
KernelTime.dwLowDateTime;
last_time_sys.dwHighDateTime =
KernelTime.dwHighDateTime;
StartOfTimes_sys.dwLowDateTime =
KernelTime.dwLowDateTime;
StartOfTimes_sys.dwHighDateTime =
KernelTime.dwHighDateTime;
#endif
}
}
@ -1475,8 +1498,8 @@ STATIC_PROTO (void my_signal, (int, void (*)(int)));
static RETSIGTYPE
HandleMatherr(int sig)
{
#if HAVE_FETESTEXCEPT
CACHE_REGS
#if HAVE_FETESTEXCEPT
/* This should work in Linux, but it doesn't seem to. */
int raised = fetestexcept(FE_ALL_EXCEPT);

448
C/udi.c
View File

@ -1,169 +1,361 @@
#include <stdio.h>
#include <assert.h>
#include "Yap.h"
#include "YapInterface.h"
#include "clause.h"
#include "udi.h"
#include "udi_private.h"
/* to keep an array with the registered udi indexers */
UT_icd udicb_icd = {sizeof(UdiControlBlock), NULL, NULL, NULL};
UT_array *indexing_structures;
#include "rtree_udi.h"
/* we can have this stactic because it is written once */
static struct udi_control_block RtreeCmd;
/******
All the info we need to enter user indexed code:
predicate
the user control block
functions used, in case we have different schema (maybe should part of previous)
right now, this is just a linked list....
******/
typedef struct udi_info
{
PredEntry *p;
void *cb;
UdiControlBlock functions;
struct udi_info *next;
} *UdiInfo;
/******
we now have one extra user indexed predicate. We assume these
are few, so we can do with a linked list.
******/
static int
add_udi_block(void *info, PredEntry *p, UdiControlBlock cmd)
{
UdiInfo blk = (UdiInfo)Yap_AllocCodeSpace(sizeof(struct udi_info));
if (!blk)
return FALSE;
blk->next = UdiControlBlocks;
UdiControlBlocks = blk;
blk->p = p;
blk->functions = cmd;
blk->cb = info;
return TRUE;
/*
* Register a new user indexer
*/
void
Yap_UdiRegister(UdiControlBlock cb){
/*TODO: check structure integrity and duplicates */
utarray_push_back(indexing_structures, &cb);
}
/******
new user indexed predicate;
the type right now is just rtrees, but in the future we'll have more.
the second argument is the term.
******/
static Int
/*
* New user indexed predicate:
* the first argument is the term.
*/
static YAP_Int
p_new_udi( USES_REGS1 )
{
Term spec = Deref(ARG2), udi_type = Deref(ARG1);
PredEntry *p;
UdiControlBlock cmd;
Atom udi_t;
void *info;
Term spec = Deref(ARG1);
PredEntry *p;
UdiInfo blk;
int info;
/* fprintf(stderr,"new pred babe\n");*/
/* 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;
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;
}
if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag|TabledPredFlag)) {
Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2");
return FALSE;
}
/* just make sure we're looking at the right user type! */
if (IsVarTerm(udi_type)) {
Yap_Error(INSTANTIATION_ERROR,spec,"new user index/1");
return FALSE;
} else if (!IsAtomTerm(udi_type)) {
Yap_Error(TYPE_ERROR_ATOM,spec,"new user index/1");
return FALSE;
}
udi_t = AtomOfTerm(udi_type);
if (udi_t == AtomRTree) {
cmd = &RtreeCmd;
} else {
Yap_Error(TYPE_ERROR_ATOM,spec,"new user index/1");
return FALSE;
Yap_Error(PERMISSION_ERROR_ACCESS_PRIVATE_PROCEDURE, spec, "udi/2");
return FALSE;
}
/* TODO: remove AtomRTree from atom list */
/* this is the real work */
info = cmd->init(spec, (void *)p, p->ArityOfPE);
if (!info)
return FALSE;
/* add to table */
if (!add_udi_block(info, p, cmd)) {
Yap_Error(OUT_OF_HEAP_ERROR, spec, "new user index/1");
return FALSE;
blk = (UdiInfo) Yap_AllocCodeSpace(sizeof(struct udi_info));
memset((void *) blk,0, sizeof(struct udi_info));
if (!blk) {
Yap_Error(OUT_OF_HEAP_ERROR, spec, "new user index/1");
return FALSE;
}
/*Init UdiInfo */
utarray_new(blk->args, &arg_icd);
utarray_new(blk->clauselist, &cl_icd);
blk->p = p;
/*Now Init args list*/
info = p_udi_args_init(spec, p->ArityOfPE, blk);
if (!info)
{
utarray_free(blk->args);
utarray_free(blk->clauselist);
Yap_FreeCodeSpace((char *) blk);
return FALSE;
}
/*Push into the hash*/
HASH_ADD_UdiInfo(UdiControlBlocks, p, blk);
p->PredFlags |= UDIPredFlag;
return TRUE;
}
/* just pass info to user, called from cdmgr.c */
/*
* Here we initialize the arguments indexing
*/
YAP_Int
p_udi_args_init(Term spec, int arity, UdiInfo blk)
{
int i;
Term arg;
Atom idxtype;
UdiControlBlock *cb;
struct udi_p_args p_arg;
for (i = 1; i <= arity; i++) {
arg = ArgOfTerm(i,spec);
if (IsAtomTerm(arg)) {
idxtype = AtomOfTerm(arg);
if (idxtype == AtomMinus) //skip this argument
continue;
p_arg.control = NULL;
cb = NULL;
while ((cb = (UdiControlBlock *) utarray_next(indexing_structures, cb))) {
if (idxtype == (*cb)->decl){
p_arg.arg = i;
p_arg.control = *cb;
p_arg.idxstr = (*cb)->init(spec, i, arity);
utarray_push_back(blk->args, &p_arg);
}
}
if (p_arg.control == NULL){ /* not "-" and not found */
fprintf(stderr, "Invalid Spec (%s)\n", AtomName(idxtype));
return FALSE;
}
}
}
return TRUE;
}
/*
* From now on this is called in several places of yap
* when the predicate has the UDIPredFlag
* and is what actually triggers the insert/search/abolish of indexing structures
*/
/*
* Init Yap udi interface
*/
void
Yap_udi_init(void)
{
UdiControlBlocks = NULL;
/*init indexing structures array*/
utarray_new(indexing_structures, &udicb_icd);
Yap_InitCPred("$udi_init", 1, p_new_udi, 0);
/* TODO: decide if udi.yap should be loaded automaticaly in init.yap */
}
/* called from cdmgr.c
*
* for each assert of a udipredicate
* to pass info to user structure
*/
int
Yap_new_udi_clause(PredEntry *p, yamop *cl, Term t)
{
struct udi_info *info = UdiControlBlocks;
while (info->p != p && info)
info = info->next;
if (!info)
return FALSE;
info->cb = info->functions->insert(t, info->cb, (void *)cl);
return TRUE;
int i;
UdiPArg parg;
UdiInfo info;
YAP_Int index;
/* try to find our structure */
HASH_FIND_UdiInfo(UdiControlBlocks,p,info);
if (!info)
return FALSE;
/* insert into clauselist */
utarray_push_back(info->clauselist, &cl);
for (i = 0; i < utarray_len(info->args) ; i++) {
parg = (UdiPArg) utarray_eltptr(info->args,i);
index = (YAP_Int) utarray_len(info->clauselist);
parg->idxstr = parg->control->insert(parg->idxstr, t,
parg->arg,
(void *) index);
}
return TRUE;
}
/* index, called from absmi.c */
/* index, called from absmi.c
*
* Returns:
* NULL (yap fallback) No usable indexing available
*
* Yap_FAILCODE() (fail) No result found
* Yap_CauseListToClause(cl) 1 solution found
* Yap_ClauseListCode(cl) 2+ solutions found
*/
yamop *
Yap_udi_search(PredEntry *p)
{
struct udi_info *info = UdiControlBlocks;
while (info->p != p && info)
info = info->next;
if (!info)
return NULL;
return info->functions->search(info->cb);
int r;
struct ClauseList clauselist;
UdiPArg parg;
UdiInfo info;
/* find our structure*/
HASH_FIND_UdiInfo(UdiControlBlocks,p,info);
if (!info || utarray_len(info->args) == 0)
return NULL;
if (utarray_len(info->args) == 1){ //simple case no intersection needed
struct si_callback_h c;
c.cl = Yap_ClauseListInit(&clauselist);
c.clauselist = info->clauselist;
c.pred = info->p;
if (!c.cl)
return NULL;
parg = (UdiPArg) utarray_eltptr(info->args,0);
r = parg->control->search(parg->idxstr, parg->arg, si_callback, (void *) &c);
Yap_ClauseListClose(c.cl);
if (r == -1) {
Yap_ClauseListDestroy(c.cl);
return NULL;
}
if (Yap_ClauseListCount(c.cl) == 0) {
Yap_ClauseListDestroy(c.cl);
return Yap_FAILCODE();
}
} else {//intersection needed using Judy1
#ifdef USE_JUDY
/*TODO: do more tests to this algorithm*/
int i;
Pvoid_t tmp = (Pvoid_t) NULL;
Pvoid_t result = (Pvoid_t) NULL;
Word_t count = 0L;
Word_t idx_r = 0L;
Word_t idx_tmp = 0L;
int rc = 0;
yamop **x;
/*
* I will start with the simplest approach
* for each index create a set and intersect it with the
* next
*
* In the future it could pay to sort according to index type
* to improve intersection part
*/
for (i = 0; i < utarray_len(info->args) ; i++) {
parg = (UdiPArg) utarray_eltptr(info->args,i);
r = parg->control->search(parg->idxstr, parg->arg, j1_callback, &tmp);
if (r == -1) /*this arg does not prune search*/
continue;
rc ++;
J1C(count, result, 0, -1);
if (r == 0) /* this arg gave 0 results -> FAIL*/
{
if (count > 0) // clear previous result if they exists
J1FA(count, result);
return Yap_FAILCODE();
}
if (count == 0) // first result_set
{
result = tmp;
tmp = (Pvoid_t) NULL;
}
else /*intersection*/
{
idx_tmp = 0L;
idx_r = 0L;
J1F(count, result, idx_r); //succeeds one time at least
assert(count > 0);
J1F(count, tmp, idx_tmp); //succeeds one time at least
assert(count > 0);
while (count)
{
while (idx_r < idx_tmp)
{
J1U(count, result, idx_r); //does not belong
J1N(count, result, idx_r); //next
if (! count) break; //end result set
}
if(idx_r == idx_tmp)
{
J1N(count, result, idx_r); //next
if (! count) break; //end result set
J1N(count, tmp, idx_tmp); //next tmp
//if (! count) break; //end tmp set will break while
}
else // (idx_r > idx_tmp)
{
idx_tmp = idx_r; // fast forward
J1F(count, tmp, idx_tmp); // first starting in idx_r
//if (! count) break; //end tmp set will break while
}
}
J1F(count, result, idx_r); // first starting in idx_r
//clear up the rest
while (idx_r > idx_tmp && count) //result has more setted values
{
J1U(count, result, idx_r); //does not belong
J1N(count, result, idx_r); //next
}
J1FA(count, tmp); //free tmp
}
}
if (rc == 0) /*no search performed*/
return NULL;
J1C(count, result, 0, -1);
if (count == 0) { /*result set empty -> FAIL */
J1FA(count, result);
return Yap_FAILCODE();
}
/*convert Juddy1 to clauselist*/
Yap_ClauseListInit(&clauselist);
idx_r = 0L;
J1F(count, result, idx_r);
while (count)
{
x = (yamop **) utarray_eltptr(info->clauselist, idx_r - 1);
Yap_ClauseListExtend(
&clauselist,
*x,
info->p);
J1N(count, result, idx_r);
}
J1FA(count,result);
fprintf(stderr,"J1 used space %d bytes for %d clausules\n",
count, Yap_ClauseListCount(&clauselist));
Yap_ClauseListClose(&clauselist);
#else
fprintf(stderr,"Without libJudy only one argument indexed is allowed."
"Falling back to Yap Indexing\n");
return NULL; //NO Judy Available
#endif
}
if (Yap_ClauseListCount(&clauselist) == 1)
return Yap_ClauseListToClause(&clauselist);
return Yap_ClauseListCode(&clauselist);
}
/* index, called from absmi.c */
void
Yap_udi_abolish(PredEntry *p)
{
/* tell the predicate destroy */
/* tell the predicate destroy */
}
void
Yap_udi_init(void)
{
UdiControlBlocks = NULL;
/* to be filled in by David */
RtreeCmd.init = RtreeUdiInit;
RtreeCmd.insert = RtreeUdiInsert;
RtreeCmd.search = RtreeUdiSearch;
RtreeCmd.destroy = RtreeUdiDestroy;
Yap_InitCPred("$udi_init", 2, p_new_udi, 0);
}

2
H/Regs.h
View File

@ -111,7 +111,7 @@ typedef struct regstore_t
struct cut_c_str *CUT_C_TOP;
#endif
#if defined CUT_C && (defined MYDDAS_ODBC || defined MYDDAS_MYSQL)
MYDDAS_GLOBAL MYDDAS_GLOBAL_POINTER;
struct myddas_global *MYDDAS_GLOBAL_POINTER;
#endif
yamop *P_; /* 7 prolog machine program counter */
CELL *YENV_; /* 5 current environment (may differ from ENV)*/

7
H/Yap.h
View File

@ -746,11 +746,16 @@ typedef struct thandle {
#endif
pthread_mutex_t tlock;
pthread_mutex_t tlock_status;
#if HAVE_GETRUSAGE||defined(_WIN32)
#if HAVE_GETRUSAGE
struct timeval *start_of_timesp;
struct timeval *last_timep;
struct timeval *start_of_times_sysp;
struct timeval *last_time_sysp;
#elif _WIN32
struct _FILETIME *start_of_timesp;
struct _FILETIME *last_timep;
struct _FILETIME *start_of_times_sysp;
struct _FILETIME *last_time_sysp;
#endif
} yap_thandle;
#endif /* THREADS */

6
H/YapOpcodes.h
View File

@ -7,6 +7,11 @@
OPCODE(try_me ,Otapl),
OPCODE(retry_me ,Otapl),
OPCODE(trust_me ,Otapl),
OPCODE(enter_exo ,e),
OPCODE(try_exo ,lp),
OPCODE(try_all_exo ,lp),
OPCODE(retry_exo ,lp),
OPCODE(retry_all_exo ,lp),
OPCODE(enter_profiling ,p),
OPCODE(retry_profiled ,p),
OPCODE(profiled_retry_me ,Otapl),
@ -58,6 +63,7 @@
OPCODE(get_x_val ,xx),
OPCODE(get_y_val ,yx),
OPCODE(get_atom ,xc),
OPCODE(get_atom_exo ,x),
OPCODE(get_2atoms ,cc),
OPCODE(get_3atoms ,ccc),
OPCODE(get_4atoms ,cccc),

11
H/Yapproto.h
View File

@ -83,9 +83,9 @@ void STD_PROTO(Yap_init_agc, (void));
/* alloc.c */
void STD_PROTO(Yap_FreeCodeSpace,(char *));
char *STD_PROTO(Yap_AllocAtomSpace,(unsigned long int));
char *STD_PROTO(Yap_AllocCodeSpace,(unsigned long int));
char *STD_PROTO(Yap_ReallocCodeSpace,(char *,unsigned long int));
char *STD_PROTO(Yap_AllocAtomSpace,(size_t));
char *STD_PROTO(Yap_AllocCodeSpace,(size_t));
char *STD_PROTO(Yap_ReallocCodeSpace,(char *,size_t));
ADDR STD_PROTO(Yap_AllocFromForeignArea,(Int));
int STD_PROTO(Yap_ExtendWorkSpace,(Int));
void STD_PROTO(Yap_FreeAtomSpace,(char *));
@ -183,6 +183,9 @@ Int STD_PROTO(Yap_exec_absmi,(int));
void STD_PROTO(Yap_trust_last,(void));
Term STD_PROTO(Yap_GetException,(void));
/* exo.c */
void STD_PROTO(Yap_InitExoPreds,(void));
/* gprof.c */
void STD_PROTO(Yap_InitLowProf,(void));
#if LOW_PROF
@ -206,7 +209,7 @@ void STD_PROTO(Yap_AllocateDefaultArena, (Int, Int, int));
Int STD_PROTO(Yap_total_stack_shift_time,(void));
void STD_PROTO(Yap_InitGrowPreds, (void));
UInt STD_PROTO(Yap_InsertInGlobal, (CELL *, UInt));
int STD_PROTO(Yap_growheap, (int, UInt, void *));
int STD_PROTO(Yap_growheap, (int, size_t, void *));
int STD_PROTO(Yap_growstack, (long));
int STD_PROTO(Yap_growtrail, (long, int));
int STD_PROTO(Yap_growglobal, (CELL **));

1
H/Yatom.h
View File

@ -806,6 +806,7 @@ IsPredProperty (int flags)
/* There are several flags for code and data base entries */
typedef enum
{
ExoMask = 0x1000000, /* is exo code */
FuncSwitchMask = 0x800000, /* is a switch of functors */
HasDBTMask = 0x400000, /* includes a pointer to a DBTerm */
MegaMask = 0x200000, /* mega clause */

4
H/alloc.h
View File

@ -66,10 +66,10 @@ typedef struct FREEB {
#if SIZEOF_INT_P==4
#define YAP_ALIGN 3
#define YAP_ALIGNMASK 0xfffffffc
#define YAP_ALIGNMASK ((CELL)(-4))
#else
#define YAP_ALIGN 7
#define YAP_ALIGNMASK 0xfffffff8L
#define YAP_ALIGNMASK ((CELL)(-8))
#endif /* ALIGN_LONGS */
#define AdjustSize(X) ((X+YAP_ALIGN) & YAP_ALIGNMASK)

41
H/clause.h
View File

@ -159,6 +159,40 @@ typedef union clause_ptr {
struct static_index *si;
} ClausePointer;
typedef struct index_t {
struct index_t *next, *prev;
UInt nels;
UInt arity;
PredEntry *ap;
CELL bmap;
int is_key;
UInt ncollisions;
UInt ntrys;
UInt nentries;
UInt hsize;
CELL **key;
CELL *cls;
CELL *links;
yamop *code;
} Index_t;
INLINE_ONLY EXTERN inline UInt EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL *ptr);
INLINE_ONLY EXTERN inline UInt
EXO_ADDRESS_TO_OFFSET(struct index_t *it, CELL* ptr)
{
return ptr-it->links;
}
INLINE_ONLY EXTERN inline CELL *EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt off);
INLINE_ONLY EXTERN inline CELL *
EXO_OFFSET_TO_ADDRESS(struct index_t *it, UInt off)
{
return it->links+off;
}
typedef struct dbterm_list {
/* a list of dbterms associated with a clause */
DBTerm *dbterms;
@ -228,6 +262,10 @@ void STD_PROTO(Yap_RemoveClauseFromIndex,(PredEntry *,yamop *));
LogUpdClause *STD_PROTO(Yap_NthClause,(PredEntry *,Int));
LogUpdClause *STD_PROTO(Yap_FollowIndexingCode,(PredEntry *,yamop *, Term *, yamop *,yamop *));
/* exo.c */
yamop *Yap_ExoLookup(PredEntry *ap);
CELL Yap_NextExo(choiceptr cpt, struct index_t *it);
#if USE_THREADED_CODE
#define OP_HASH_SIZE 2048
@ -332,8 +370,9 @@ Term STD_PROTO(Yap_LUInstance,(LogUpdClause *, UInt));
/* udi.c */
void STD_PROTO(Yap_udi_init,(void));
yamop *STD_PROTO(Yap_udi_search,(PredEntry *));
int STD_PROTO(Yap_new_udi_clause,(PredEntry *, yamop *, Term));
yamop *STD_PROTO(Yap_udi_search,(PredEntry *));
void STD_PROTO(Yap_udi_abolish,(PredEntry *p));
#ifdef DEBUG
void STD_PROTO(Yap_bug_location,(yamop *));

3
H/dlocals.h
View File

@ -430,3 +430,6 @@
#define LOCAL_FunctorVar LOCAL->FunctorVar_
#define REMOTE_FunctorVar(wid) REMOTE(wid)->FunctorVar_
#define LOCAL_ibnds LOCAL->ibnds_
#define REMOTE_ibnds(wid) REMOTE(wid)->ibnds_

4
H/heapgc.h
View File

@ -111,7 +111,9 @@ UNMARKED_MARK__(CELL* ptr, char *bp USES_REGS)
static inline void
MARK__(CELL* ptr USES_REGS)
{
mcell(ptr) = mcell(ptr) | MARK_BIT;
Int pos = ptr - (CELL *)LOCAL_GlobalBase;
char t = LOCAL_bp[pos];
LOCAL_bp[pos] = t | MARK_BIT;
}
static inline void

2
H/hlocals.h
View File

@ -241,4 +241,6 @@ typedef struct worker_local {
FILE* FPreds_;
#endif /* LOW_PROF */
Functor FunctorVar_;
UInt ibnds_[256];
} w_local;

2
H/ilocals.h
View File

@ -241,4 +241,6 @@ static void InitWorker(int wid) {
REMOTE_FPreds(wid) = NULL;
#endif /* LOW_PROF */
REMOTE_FunctorVar(wid) = FunctorVar;
}

6
H/rclause.h
View File

@ -218,6 +218,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
case _Nstop:
case _allocate:
case _copy_idb_term:
case _enter_exo:
case _expand_index:
case _index_blob:
case _index_dbref:
@ -285,6 +286,10 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
pc = NEXTOP(pc,llll);
break;
/* instructions type lp */
case _retry_all_exo:
case _retry_exo:
case _try_all_exo:
case _try_exo:
case _user_switch:
pc->u.lp.l = PtoOpAdjust(pc->u.lp.l);
pc->u.lp.p = PtoPredAdjust(pc->u.lp.p);
@ -537,6 +542,7 @@ restore_opcodes(yamop *pc, yamop *max USES_REGS)
pc = NEXTOP(pc,sssllp);
break;
/* instructions type x */
case _get_atom_exo:
case _get_list:
case _put_list:
case _save_b_x:

2
H/rlocals.h
View File

@ -241,4 +241,6 @@ static void RestoreWorker(int wid USES_REGS) {
#endif /* LOW_PROF */
}

6
H/saveclause.h
View File

@ -236,6 +236,7 @@
case _Nstop:
case _allocate:
case _copy_idb_term:
case _enter_exo:
case _expand_index:
case _index_blob:
case _index_dbref:
@ -302,6 +303,10 @@
pc = NEXTOP(pc,llll);
break;
/* instructions type lp */
case _retry_all_exo:
case _retry_exo:
case _try_all_exo:
case _try_exo:
case _user_switch:
CHECK(save_PtoOp(stream, pc->u.lp.l));
CHECK(save_PtoPred(stream, pc->u.lp.p));
@ -553,6 +558,7 @@
pc = NEXTOP(pc,sssllp);
break;
/* instructions type x */
case _get_atom_exo:
case _get_list:
case _put_list:
case _save_b_x:

74
H/udi_private.h Normal file
View File

@ -0,0 +1,74 @@
#include "config.h"
#include "udi.h"
#include "utarray.h"
#include "uthash.h"
/* Argument Indexing */
struct udi_p_args {
int arg; //indexed arg
void *idxstr; //user indexing structure
UdiControlBlock control; //user indexing structure functions
};
typedef struct udi_p_args *UdiPArg;
UT_icd arg_icd = {sizeof(struct udi_p_args), NULL, NULL, NULL };
/* clauselist */
UT_icd cl_icd = {sizeof(yamop *), NULL, NULL, NULL };
/*
* All the info we need to enter user indexed code
* stored in a uthash
*/
struct udi_info
{
PredEntry *p; //predicate (need to identify asserts)
UT_array *clauselist; //clause list used on returns
UT_array *args; //indexed args
UT_hash_handle hh; //uthash handle
};
typedef struct udi_info *UdiInfo;
/* to ease code for a UdiInfo hash table*/
#define HASH_FIND_UdiInfo(head,find,out) \
HASH_FIND(hh,head,find,sizeof(PredEntry *),out)
#define HASH_ADD_UdiInfo(head,p,add) \
HASH_ADD_KEYPTR(hh,head,p,sizeof(PredEntry *),add)
/* used during init */
static YAP_Int p_new_udi( USES_REGS1 );
static YAP_Int p_udi_args_init(Term spec, int arity, UdiInfo blk);
/*
* Indexing Search and intersection Helpers
*/
/* single indexing helpers (no intersection needed just create clauselist) */
#include "clause_list.h"
struct si_callback_h
{
clause_list_t cl;
UT_array *clauselist;
void * pred;
};
typedef struct si_callback_h * si_callback_h_t;
static inline int si_callback(void *key, void *data, void *arg)
{
si_callback_h_t c = (si_callback_h_t) arg;
yamop **cl = (yamop **) utarray_eltptr(c->clauselist, ((YAP_Int) data) - 1);
return Yap_ClauseListExtend(c->cl, *cl, c->pred);
}
#ifdef USE_JUDY
#include <Judy.h>
/* Judy1 integer sparse set intersection */
static inline int j1_callback(void *key, void *data, void *arg)
{
int r;
Pvoid_t *array = (Pvoid_t *) arg;
J1S(r, *array, (int) data);
if (r == JERR)
return FALSE;
return TRUE;
}
#endif

233
H/utarray.h Normal file
View File

@ -0,0 +1,233 @@
/*
Copyright (c) 2008-2013, Troy D. Hanson http://uthash.sourceforge.net
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
/* a dynamic array implementation using macros
* see http://uthash.sourceforge.net/utarray
*/
#ifndef UTARRAY_H
#define UTARRAY_H
#define UTARRAY_VERSION 1.9.7
#ifdef __GNUC__
#define _UNUSED_ __attribute__ ((__unused__))
#else
#define _UNUSED_
#endif
#include <stddef.h> /* size_t */
#include <string.h> /* memset, etc */
#include <stdlib.h> /* exit */
#define oom() exit(-1)
typedef void (ctor_f)(void *dst, const void *src);
typedef void (dtor_f)(void *elt);
typedef void (init_f)(void *elt);
typedef struct {
size_t sz;
init_f *init;
ctor_f *copy;
dtor_f *dtor;
} UT_icd;
typedef struct {
unsigned i,n;/* i: index of next available slot, n: num slots */
UT_icd icd; /* initializer, copy and destructor functions */
char *d; /* n slots of size icd->sz*/
} UT_array;
#define utarray_init(a,_icd) do { \
memset(a,0,sizeof(UT_array)); \
(a)->icd=*_icd; \
} while(0)
#define utarray_done(a) do { \
if ((a)->n) { \
if ((a)->icd.dtor) { \
size_t _ut_i; \
for(_ut_i=0; _ut_i < (a)->i; _ut_i++) { \
(a)->icd.dtor(utarray_eltptr(a,_ut_i)); \
} \
} \
free((a)->d); \
} \
(a)->n=0; \
} while(0)
#define utarray_new(a,_icd) do { \
a=(UT_array*)malloc(sizeof(UT_array)); \
utarray_init(a,_icd); \
} while(0)
#define utarray_free(a) do { \
utarray_done(a); \
free(a); \
} while(0)
#define utarray_reserve(a,by) do { \
if (((a)->i+by) > ((a)->n)) { \
while(((a)->i+by) > ((a)->n)) { (a)->n = ((a)->n ? (2*(a)->n) : 8); } \
if ( ((a)->d=(char*)realloc((a)->d, (a)->n*(a)->icd.sz)) == NULL) oom(); \
} \
} while(0)
#define utarray_push_back(a,p) do { \
utarray_reserve(a,1); \
if ((a)->icd.copy) { (a)->icd.copy( _utarray_eltptr(a,(a)->i++), p); } \
else { memcpy(_utarray_eltptr(a,(a)->i++), p, (a)->icd.sz); }; \
} while(0)
#define utarray_pop_back(a) do { \
if ((a)->icd.dtor) { (a)->icd.dtor( _utarray_eltptr(a,--((a)->i))); } \
else { (a)->i--; } \
} while(0)
#define utarray_extend_back(a) do { \
utarray_reserve(a,1); \
if ((a)->icd.init) { (a)->icd.init(_utarray_eltptr(a,(a)->i)); } \
else { memset(_utarray_eltptr(a,(a)->i),0,(a)->icd.sz); } \
(a)->i++; \
} while(0)
#define utarray_len(a) ((a)->i)
#define utarray_eltptr(a,j) (((j) < (a)->i) ? _utarray_eltptr(a,j) : NULL)
#define _utarray_eltptr(a,j) ((char*)((a)->d + ((a)->icd.sz*(j) )))
#define utarray_insert(a,p,j) do { \
utarray_reserve(a,1); \
if (j > (a)->i) break; \
if ((j) < (a)->i) { \
memmove( _utarray_eltptr(a,(j)+1), _utarray_eltptr(a,j), \
((a)->i - (j))*((a)->icd.sz)); \
} \
if ((a)->icd.copy) { (a)->icd.copy( _utarray_eltptr(a,j), p); } \
else { memcpy(_utarray_eltptr(a,j), p, (a)->icd.sz); }; \
(a)->i++; \
} while(0)
#define utarray_inserta(a,w,j) do { \
if (utarray_len(w) == 0) break; \
if (j > (a)->i) break; \
utarray_reserve(a,utarray_len(w)); \
if ((j) < (a)->i) { \
memmove(_utarray_eltptr(a,(j)+utarray_len(w)), \
_utarray_eltptr(a,j), \
((a)->i - (j))*((a)->icd.sz)); \
} \
if ((a)->icd.copy) { \
size_t _ut_i; \
for(_ut_i=0;_ut_i<(w)->i;_ut_i++) { \
(a)->icd.copy(_utarray_eltptr(a,j+_ut_i), _utarray_eltptr(w,_ut_i)); \
} \
} else { \
memcpy(_utarray_eltptr(a,j), _utarray_eltptr(w,0), \
utarray_len(w)*((a)->icd.sz)); \
} \
(a)->i += utarray_len(w); \
} while(0)
#define utarray_resize(dst,num) do { \
size_t _ut_i; \
if (dst->i > (size_t)(num)) { \
if ((dst)->icd.dtor) { \
for(_ut_i=num; _ut_i < dst->i; _ut_i++) { \
(dst)->icd.dtor(utarray_eltptr(dst,_ut_i)); \
} \
} \
} else if (dst->i < (size_t)(num)) { \
utarray_reserve(dst,num-dst->i); \
if ((dst)->icd.init) { \
for(_ut_i=dst->i; _ut_i < num; _ut_i++) { \
(dst)->icd.init(utarray_eltptr(dst,_ut_i)); \
} \
} else { \
memset(_utarray_eltptr(dst,dst->i),0,(dst)->icd.sz*(num-dst->i)); \
} \
} \
dst->i = num; \
} while(0)
#define utarray_concat(dst,src) do { \
utarray_inserta((dst),(src),utarray_len(dst)); \
} while(0)
#define utarray_erase(a,pos,len) do { \
if ((a)->icd.dtor) { \
size_t _ut_i; \
for(_ut_i=0; _ut_i < len; _ut_i++) { \
(a)->icd.dtor(utarray_eltptr((a),pos+_ut_i)); \
} \
} \
if ((a)->i > (pos+len)) { \
memmove( _utarray_eltptr((a),pos), _utarray_eltptr((a),pos+len), \
(((a)->i)-(pos+len))*((a)->icd.sz)); \
} \
(a)->i -= (len); \
} while(0)
#define utarray_renew(a,u) do { \
if (a) utarray_clear(a); \
else utarray_new((a),(u)); \
} while(0)
#define utarray_clear(a) do { \
if ((a)->i > 0) { \
if ((a)->icd.dtor) { \
size_t _ut_i; \
for(_ut_i=0; _ut_i < (a)->i; _ut_i++) { \
(a)->icd.dtor(utarray_eltptr(a,_ut_i)); \
} \
} \
(a)->i = 0; \
} \
} while(0)
#define utarray_sort(a,cmp) do { \
qsort((a)->d, (a)->i, (a)->icd.sz, cmp); \
} while(0)
#define utarray_find(a,v,cmp) bsearch((v),(a)->d,(a)->i,(a)->icd.sz,cmp)
#define utarray_front(a) (((a)->i) ? (_utarray_eltptr(a,0)) : NULL)
#define utarray_next(a,e) (((e)==NULL) ? utarray_front(a) : ((((a)->i) > (utarray_eltidx(a,e)+1)) ? _utarray_eltptr(a,utarray_eltidx(a,e)+1) : NULL))
#define utarray_prev(a,e) (((e)==NULL) ? utarray_back(a) : ((utarray_eltidx(a,e) > 0) ? _utarray_eltptr(a,utarray_eltidx(a,e)-1) : NULL))
#define utarray_back(a) (((a)->i) ? (_utarray_eltptr(a,(a)->i-1)) : NULL)
#define utarray_eltidx(a,e) (((char*)(e) >= (char*)((a)->d)) ? (((char*)(e) - (char*)((a)->d))/(a)->icd.sz) : -1)
/* last we pre-define a few icd for common utarrays of ints and strings */
static void utarray_str_cpy(void *dst, const void *src) {
char **_src = (char**)src, **_dst = (char**)dst;
*_dst = (*_src == NULL) ? NULL : strdup(*_src);
}
static void utarray_str_dtor(void *elt) {
char **eltc = (char**)elt;
if (*eltc) free(*eltc);
}
static const UT_icd ut_str_icd _UNUSED_ = {sizeof(char*),NULL,utarray_str_cpy,utarray_str_dtor};
static const UT_icd ut_int_icd _UNUSED_ = {sizeof(int),NULL,NULL,NULL};
static const UT_icd ut_ptr_icd _UNUSED_ = {sizeof(void*),NULL,NULL,NULL};
#endif /* UTARRAY_H */

917
H/uthash.h Normal file
View File

@ -0,0 +1,917 @@
/*
Copyright (c) 2003-2013, Troy D. Hanson http://uthash.sourceforge.net
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
*/
#ifndef UTHASH_H
#define UTHASH_H
#include <string.h> /* memcmp,strlen */
#include <stddef.h> /* ptrdiff_t */
#include <stdlib.h> /* exit() */
/* These macros use decltype or the earlier __typeof GNU extension.
As decltype is only available in newer compilers (VS2010 or gcc 4.3+
when compiling c++ source) this code uses whatever method is needed
or, for VS2008 where neither is available, uses casting workarounds. */
#ifdef _MSC_VER /* MS compiler */
#if _MSC_VER >= 1600 && defined(__cplusplus) /* VS2010 or newer in C++ mode */
#define DECLTYPE(x) (decltype(x))
#else /* VS2008 or older (or VS2010 in C mode) */
#define NO_DECLTYPE
#define DECLTYPE(x)
#endif
#else /* GNU, Sun and other compilers */
#define DECLTYPE(x) (__typeof(x))
#endif
#ifdef NO_DECLTYPE
#define DECLTYPE_ASSIGN(dst,src) \
do { \
char **_da_dst = (char**)(&(dst)); \
*_da_dst = (char*)(src); \
} while(0)
#else
#define DECLTYPE_ASSIGN(dst,src) \
do { \
(dst) = DECLTYPE(dst)(src); \
} while(0)
#endif
/* a number of the hash function use uint32_t which isn't defined on win32 */
#ifdef _MSC_VER
typedef unsigned int uint32_t;
typedef unsigned char uint8_t;
#else
#include <inttypes.h> /* uint32_t */
#endif
#define UTHASH_VERSION 1.9.7
#ifndef uthash_fatal
#define uthash_fatal(msg) exit(-1) /* fatal error (out of memory,etc) */
#endif
#ifndef uthash_malloc
#define uthash_malloc(sz) malloc(sz) /* malloc fcn */
#endif
#ifndef uthash_free
#define uthash_free(ptr,sz) free(ptr) /* free fcn */
#endif
#ifndef uthash_noexpand_fyi
#define uthash_noexpand_fyi(tbl) /* can be defined to log noexpand */
#endif
#ifndef uthash_expand_fyi
#define uthash_expand_fyi(tbl) /* can be defined to log expands */
#endif
/* initial number of buckets */
#define HASH_INITIAL_NUM_BUCKETS 32 /* initial number of buckets */
#define HASH_INITIAL_NUM_BUCKETS_LOG2 5 /* lg2 of initial number of buckets */
#define HASH_BKT_CAPACITY_THRESH 10 /* expand when bucket count reaches */
/* calculate the element whose hash handle address is hhe */
#define ELMT_FROM_HH(tbl,hhp) ((void*)(((char*)(hhp)) - ((tbl)->hho)))
#define HASH_FIND(hh,head,keyptr,keylen,out) \
do { \
unsigned _hf_bkt,_hf_hashv; \
out=NULL; \
if (head) { \
HASH_FCN(keyptr,keylen, (head)->hh.tbl->num_buckets, _hf_hashv, _hf_bkt); \
if (HASH_BLOOM_TEST((head)->hh.tbl, _hf_hashv)) { \
HASH_FIND_IN_BKT((head)->hh.tbl, hh, (head)->hh.tbl->buckets[ _hf_bkt ], \
keyptr,keylen,out); \
} \
} \
} while (0)
#ifdef HASH_BLOOM
#define HASH_BLOOM_BITLEN (1ULL << HASH_BLOOM)
#define HASH_BLOOM_BYTELEN (HASH_BLOOM_BITLEN/8) + ((HASH_BLOOM_BITLEN%8) ? 1:0)
#define HASH_BLOOM_MAKE(tbl) \
do { \
(tbl)->bloom_nbits = HASH_BLOOM; \
(tbl)->bloom_bv = (uint8_t*)uthash_malloc(HASH_BLOOM_BYTELEN); \
if (!((tbl)->bloom_bv)) { uthash_fatal( "out of memory"); } \
memset((tbl)->bloom_bv, 0, HASH_BLOOM_BYTELEN); \
(tbl)->bloom_sig = HASH_BLOOM_SIGNATURE; \
} while (0)
#define HASH_BLOOM_FREE(tbl) \
do { \
uthash_free((tbl)->bloom_bv, HASH_BLOOM_BYTELEN); \
} while (0)
#define HASH_BLOOM_BITSET(bv,idx) (bv[(idx)/8] |= (1U << ((idx)%8)))
#define HASH_BLOOM_BITTEST(bv,idx) (bv[(idx)/8] & (1U << ((idx)%8)))
#define HASH_BLOOM_ADD(tbl,hashv) \
HASH_BLOOM_BITSET((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1)))
#define HASH_BLOOM_TEST(tbl,hashv) \
HASH_BLOOM_BITTEST((tbl)->bloom_bv, (hashv & (uint32_t)((1ULL << (tbl)->bloom_nbits) - 1)))
#else
#define HASH_BLOOM_MAKE(tbl)
#define HASH_BLOOM_FREE(tbl)
#define HASH_BLOOM_ADD(tbl,hashv)
#define HASH_BLOOM_TEST(tbl,hashv) (1)
#endif
#define HASH_MAKE_TABLE(hh,head) \
do { \
(head)->hh.tbl = (UT_hash_table*)uthash_malloc( \
sizeof(UT_hash_table)); \
if (!((head)->hh.tbl)) { uthash_fatal( "out of memory"); } \
memset((head)->hh.tbl, 0, sizeof(UT_hash_table)); \
(head)->hh.tbl->tail = &((head)->hh); \
(head)->hh.tbl->num_buckets = HASH_INITIAL_NUM_BUCKETS; \
(head)->hh.tbl->log2_num_buckets = HASH_INITIAL_NUM_BUCKETS_LOG2; \
(head)->hh.tbl->hho = (char*)(&(head)->hh) - (char*)(head); \
(head)->hh.tbl->buckets = (UT_hash_bucket*)uthash_malloc( \
HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket)); \
if (! (head)->hh.tbl->buckets) { uthash_fatal( "out of memory"); } \
memset((head)->hh.tbl->buckets, 0, \
HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket)); \
HASH_BLOOM_MAKE((head)->hh.tbl); \
(head)->hh.tbl->signature = HASH_SIGNATURE; \
} while(0)
#define HASH_ADD(hh,head,fieldname,keylen_in,add) \
HASH_ADD_KEYPTR(hh,head,&((add)->fieldname),keylen_in,add)
#define HASH_ADD_KEYPTR(hh,head,keyptr,keylen_in,add) \
do { \
unsigned _ha_bkt; \
(add)->hh.next = NULL; \
(add)->hh.key = (char*)keyptr; \
(add)->hh.keylen = (unsigned)keylen_in; \
if (!(head)) { \
head = (add); \
(head)->hh.prev = NULL; \
HASH_MAKE_TABLE(hh,head); \
} else { \
(head)->hh.tbl->tail->next = (add); \
(add)->hh.prev = ELMT_FROM_HH((head)->hh.tbl, (head)->hh.tbl->tail); \
(head)->hh.tbl->tail = &((add)->hh); \
} \
(head)->hh.tbl->num_items++; \
(add)->hh.tbl = (head)->hh.tbl; \
HASH_FCN(keyptr,keylen_in, (head)->hh.tbl->num_buckets, \
(add)->hh.hashv, _ha_bkt); \
HASH_ADD_TO_BKT((head)->hh.tbl->buckets[_ha_bkt],&(add)->hh); \
HASH_BLOOM_ADD((head)->hh.tbl,(add)->hh.hashv); \
HASH_EMIT_KEY(hh,head,keyptr,keylen_in); \
HASH_FSCK(hh,head); \
} while(0)
#define HASH_TO_BKT( hashv, num_bkts, bkt ) \
do { \
bkt = ((hashv) & ((num_bkts) - 1)); \
} while(0)
/* delete "delptr" from the hash table.
* "the usual" patch-up process for the app-order doubly-linked-list.
* The use of _hd_hh_del below deserves special explanation.
* These used to be expressed using (delptr) but that led to a bug
* if someone used the same symbol for the head and deletee, like
* HASH_DELETE(hh,users,users);
* We want that to work, but by changing the head (users) below
* we were forfeiting our ability to further refer to the deletee (users)
* in the patch-up process. Solution: use scratch space to
* copy the deletee pointer, then the latter references are via that
* scratch pointer rather than through the repointed (users) symbol.
*/
#define HASH_DELETE(hh,head,delptr) \
do { \
unsigned _hd_bkt; \
struct UT_hash_handle *_hd_hh_del; \
if ( ((delptr)->hh.prev == NULL) && ((delptr)->hh.next == NULL) ) { \
uthash_free((head)->hh.tbl->buckets, \
(head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \
HASH_BLOOM_FREE((head)->hh.tbl); \
uthash_free((head)->hh.tbl, sizeof(UT_hash_table)); \
head = NULL; \
} else { \
_hd_hh_del = &((delptr)->hh); \
if ((delptr) == ELMT_FROM_HH((head)->hh.tbl,(head)->hh.tbl->tail)) { \
(head)->hh.tbl->tail = \
(UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) + \
(head)->hh.tbl->hho); \
} \
if ((delptr)->hh.prev) { \
((UT_hash_handle*)((ptrdiff_t)((delptr)->hh.prev) + \
(head)->hh.tbl->hho))->next = (delptr)->hh.next; \
} else { \
DECLTYPE_ASSIGN(head,(delptr)->hh.next); \
} \
if (_hd_hh_del->next) { \
((UT_hash_handle*)((ptrdiff_t)_hd_hh_del->next + \
(head)->hh.tbl->hho))->prev = \
_hd_hh_del->prev; \
} \
HASH_TO_BKT( _hd_hh_del->hashv, (head)->hh.tbl->num_buckets, _hd_bkt); \
HASH_DEL_IN_BKT(hh,(head)->hh.tbl->buckets[_hd_bkt], _hd_hh_del); \
(head)->hh.tbl->num_items--; \
} \
HASH_FSCK(hh,head); \
} while (0)
/* convenience forms of HASH_FIND/HASH_ADD/HASH_DEL */
#define HASH_FIND_STR(head,findstr,out) \
HASH_FIND(hh,head,findstr,strlen(findstr),out)
#define HASH_ADD_STR(head,strfield,add) \
HASH_ADD(hh,head,strfield,strlen(add->strfield),add)
#define HASH_FIND_INT(head,findint,out) \
HASH_FIND(hh,head,findint,sizeof(int),out)
#define HASH_ADD_INT(head,intfield,add) \
HASH_ADD(hh,head,intfield,sizeof(int),add)
#define HASH_FIND_PTR(head,findptr,out) \
HASH_FIND(hh,head,findptr,sizeof(void *),out)
#define HASH_ADD_PTR(head,ptrfield,add) \
HASH_ADD(hh,head,ptrfield,sizeof(void *),add)
#define HASH_DEL(head,delptr) \
HASH_DELETE(hh,head,delptr)
/* HASH_FSCK checks hash integrity on every add/delete when HASH_DEBUG is defined.
* This is for uthash developer only; it compiles away if HASH_DEBUG isn't defined.
*/
#ifdef HASH_DEBUG
#define HASH_OOPS(...) do { fprintf(stderr,__VA_ARGS__); exit(-1); } while (0)
#define HASH_FSCK(hh,head) \
do { \
unsigned _bkt_i; \
unsigned _count, _bkt_count; \
char *_prev; \
struct UT_hash_handle *_thh; \
if (head) { \
_count = 0; \
for( _bkt_i = 0; _bkt_i < (head)->hh.tbl->num_buckets; _bkt_i++) { \
_bkt_count = 0; \
_thh = (head)->hh.tbl->buckets[_bkt_i].hh_head; \
_prev = NULL; \
while (_thh) { \
if (_prev != (char*)(_thh->hh_prev)) { \
HASH_OOPS("invalid hh_prev %p, actual %p\n", \
_thh->hh_prev, _prev ); \
} \
_bkt_count++; \
_prev = (char*)(_thh); \
_thh = _thh->hh_next; \
} \
_count += _bkt_count; \
if ((head)->hh.tbl->buckets[_bkt_i].count != _bkt_count) { \
HASH_OOPS("invalid bucket count %d, actual %d\n", \
(head)->hh.tbl->buckets[_bkt_i].count, _bkt_count); \
} \
} \
if (_count != (head)->hh.tbl->num_items) { \
HASH_OOPS("invalid hh item count %d, actual %d\n", \
(head)->hh.tbl->num_items, _count ); \
} \
/* traverse hh in app order; check next/prev integrity, count */ \
_count = 0; \
_prev = NULL; \
_thh = &(head)->hh; \
while (_thh) { \
_count++; \
if (_prev !=(char*)(_thh->prev)) { \
HASH_OOPS("invalid prev %p, actual %p\n", \
_thh->prev, _prev ); \
} \
_prev = (char*)ELMT_FROM_HH((head)->hh.tbl, _thh); \
_thh = ( _thh->next ? (UT_hash_handle*)((char*)(_thh->next) + \
(head)->hh.tbl->hho) : NULL ); \
} \
if (_count != (head)->hh.tbl->num_items) { \
HASH_OOPS("invalid app item count %d, actual %d\n", \
(head)->hh.tbl->num_items, _count ); \
} \
} \
} while (0)
#else
#define HASH_FSCK(hh,head)
#endif
/* When compiled with -DHASH_EMIT_KEYS, length-prefixed keys are emitted to
* the descriptor to which this macro is defined for tuning the hash function.
* The app can #include <unistd.h> to get the prototype for write(2). */
#ifdef HASH_EMIT_KEYS
#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen) \
do { \
unsigned _klen = fieldlen; \
write(HASH_EMIT_KEYS, &_klen, sizeof(_klen)); \
write(HASH_EMIT_KEYS, keyptr, fieldlen); \
} while (0)
#else
#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen)
#endif
/* default to Jenkin's hash unless overridden e.g. DHASH_FUNCTION=HASH_SAX */
#ifdef HASH_FUNCTION
#define HASH_FCN HASH_FUNCTION
#else
#define HASH_FCN HASH_JEN
#endif
/* The Bernstein hash function, used in Perl prior to v5.6 */
#define HASH_BER(key,keylen,num_bkts,hashv,bkt) \
do { \
unsigned _hb_keylen=keylen; \
char *_hb_key=(char*)(key); \
(hashv) = 0; \
while (_hb_keylen--) { (hashv) = ((hashv) * 33) + *_hb_key++; } \
bkt = (hashv) & (num_bkts-1); \
} while (0)
/* SAX/FNV/OAT/JEN hash functions are macro variants of those listed at
* http://eternallyconfuzzled.com/tuts/algorithms/jsw_tut_hashing.aspx */
#define HASH_SAX(key,keylen,num_bkts,hashv,bkt) \
do { \
unsigned _sx_i; \
char *_hs_key=(char*)(key); \
hashv = 0; \
for(_sx_i=0; _sx_i < keylen; _sx_i++) \
hashv ^= (hashv << 5) + (hashv >> 2) + _hs_key[_sx_i]; \
bkt = hashv & (num_bkts-1); \
} while (0)
#define HASH_FNV(key,keylen,num_bkts,hashv,bkt) \
do { \
unsigned _fn_i; \
char *_hf_key=(char*)(key); \
hashv = 2166136261UL; \
for(_fn_i=0; _fn_i < keylen; _fn_i++) \
hashv = (hashv * 16777619) ^ _hf_key[_fn_i]; \
bkt = hashv & (num_bkts-1); \
} while(0)
#define HASH_OAT(key,keylen,num_bkts,hashv,bkt) \
do { \
unsigned _ho_i; \
char *_ho_key=(char*)(key); \
hashv = 0; \
for(_ho_i=0; _ho_i < keylen; _ho_i++) { \
hashv += _ho_key[_ho_i]; \
hashv += (hashv << 10); \
hashv ^= (hashv >> 6); \
} \
hashv += (hashv << 3); \
hashv ^= (hashv >> 11); \
hashv += (hashv << 15); \
bkt = hashv & (num_bkts-1); \
} while(0)
#define HASH_JEN_MIX(a,b,c) \
do { \
a -= b; a -= c; a ^= ( c >> 13 ); \
b -= c; b -= a; b ^= ( a << 8 ); \
c -= a; c -= b; c ^= ( b >> 13 ); \
a -= b; a -= c; a ^= ( c >> 12 ); \
b -= c; b -= a; b ^= ( a << 16 ); \
c -= a; c -= b; c ^= ( b >> 5 ); \
a -= b; a -= c; a ^= ( c >> 3 ); \
b -= c; b -= a; b ^= ( a << 10 ); \
c -= a; c -= b; c ^= ( b >> 15 ); \
} while (0)
#define HASH_JEN(key,keylen,num_bkts,hashv,bkt) \
do { \
unsigned _hj_i,_hj_j,_hj_k; \
char *_hj_key=(char*)(key); \
hashv = 0xfeedbeef; \
_hj_i = _hj_j = 0x9e3779b9; \
_hj_k = (unsigned)keylen; \
while (_hj_k >= 12) { \
_hj_i += (_hj_key[0] + ( (unsigned)_hj_key[1] << 8 ) \
+ ( (unsigned)_hj_key[2] << 16 ) \
+ ( (unsigned)_hj_key[3] << 24 ) ); \
_hj_j += (_hj_key[4] + ( (unsigned)_hj_key[5] << 8 ) \
+ ( (unsigned)_hj_key[6] << 16 ) \
+ ( (unsigned)_hj_key[7] << 24 ) ); \
hashv += (_hj_key[8] + ( (unsigned)_hj_key[9] << 8 ) \
+ ( (unsigned)_hj_key[10] << 16 ) \
+ ( (unsigned)_hj_key[11] << 24 ) ); \
\
HASH_JEN_MIX(_hj_i, _hj_j, hashv); \
\
_hj_key += 12; \
_hj_k -= 12; \
} \
hashv += keylen; \
switch ( _hj_k ) { \
case 11: hashv += ( (unsigned)_hj_key[10] << 24 ); \
case 10: hashv += ( (unsigned)_hj_key[9] << 16 ); \
case 9: hashv += ( (unsigned)_hj_key[8] << 8 ); \
case 8: _hj_j += ( (unsigned)_hj_key[7] << 24 ); \
case 7: _hj_j += ( (unsigned)_hj_key[6] << 16 ); \
case 6: _hj_j += ( (unsigned)_hj_key[5] << 8 ); \
case 5: _hj_j += _hj_key[4]; \
case 4: _hj_i += ( (unsigned)_hj_key[3] << 24 ); \
case 3: _hj_i += ( (unsigned)_hj_key[2] << 16 ); \
case 2: _hj_i += ( (unsigned)_hj_key[1] << 8 ); \
case 1: _hj_i += _hj_key[0]; \
} \
HASH_JEN_MIX(_hj_i, _hj_j, hashv); \
bkt = hashv & (num_bkts-1); \
} while(0)
/* The Paul Hsieh hash function */
#undef get16bits
#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__) \
|| defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__)
#define get16bits(d) (*((const uint16_t *) (d)))
#endif
#if !defined (get16bits)
#define get16bits(d) ((((uint32_t)(((const uint8_t *)(d))[1])) << 8) \
+(uint32_t)(((const uint8_t *)(d))[0]) )
#endif
#define HASH_SFH(key,keylen,num_bkts,hashv,bkt) \
do { \
char *_sfh_key=(char*)(key); \
uint32_t _sfh_tmp, _sfh_len = keylen; \
\
int _sfh_rem = _sfh_len & 3; \
_sfh_len >>= 2; \
hashv = 0xcafebabe; \
\
/* Main loop */ \
for (;_sfh_len > 0; _sfh_len--) { \
hashv += get16bits (_sfh_key); \
_sfh_tmp = (get16bits (_sfh_key+2) << 11) ^ hashv; \
hashv = (hashv << 16) ^ _sfh_tmp; \
_sfh_key += 2*sizeof (uint16_t); \
hashv += hashv >> 11; \
} \
\
/* Handle end cases */ \
switch (_sfh_rem) { \
case 3: hashv += get16bits (_sfh_key); \
hashv ^= hashv << 16; \
hashv ^= _sfh_key[sizeof (uint16_t)] << 18; \
hashv += hashv >> 11; \
break; \
case 2: hashv += get16bits (_sfh_key); \
hashv ^= hashv << 11; \
hashv += hashv >> 17; \
break; \
case 1: hashv += *_sfh_key; \
hashv ^= hashv << 10; \
hashv += hashv >> 1; \
} \
\
/* Force "avalanching" of final 127 bits */ \
hashv ^= hashv << 3; \
hashv += hashv >> 5; \
hashv ^= hashv << 4; \
hashv += hashv >> 17; \
hashv ^= hashv << 25; \
hashv += hashv >> 6; \
bkt = hashv & (num_bkts-1); \
} while(0)
#ifdef HASH_USING_NO_STRICT_ALIASING
/* The MurmurHash exploits some CPU's (x86,x86_64) tolerance for unaligned reads.
* For other types of CPU's (e.g. Sparc) an unaligned read causes a bus error.
* MurmurHash uses the faster approach only on CPU's where we know it's safe.
*
* Note the preprocessor built-in defines can be emitted using:
*
* gcc -m64 -dM -E - < /dev/null (on gcc)
* cc -## a.c (where a.c is a simple test file) (Sun Studio)
*/
#if (defined(__i386__) || defined(__x86_64__) || defined(_M_IX86))
#define MUR_GETBLOCK(p,i) p[i]
#else /* non intel */
#define MUR_PLUS0_ALIGNED(p) (((unsigned long)p & 0x3) == 0)
#define MUR_PLUS1_ALIGNED(p) (((unsigned long)p & 0x3) == 1)
#define MUR_PLUS2_ALIGNED(p) (((unsigned long)p & 0x3) == 2)
#define MUR_PLUS3_ALIGNED(p) (((unsigned long)p & 0x3) == 3)
#define WP(p) ((uint32_t*)((unsigned long)(p) & ~3UL))
#if (defined(__BIG_ENDIAN__) || defined(SPARC) || defined(__ppc__) || defined(__ppc64__))
#define MUR_THREE_ONE(p) ((((*WP(p))&0x00ffffff) << 8) | (((*(WP(p)+1))&0xff000000) >> 24))
#define MUR_TWO_TWO(p) ((((*WP(p))&0x0000ffff) <<16) | (((*(WP(p)+1))&0xffff0000) >> 16))
#define MUR_ONE_THREE(p) ((((*WP(p))&0x000000ff) <<24) | (((*(WP(p)+1))&0xffffff00) >> 8))
#else /* assume little endian non-intel */
#define MUR_THREE_ONE(p) ((((*WP(p))&0xffffff00) >> 8) | (((*(WP(p)+1))&0x000000ff) << 24))
#define MUR_TWO_TWO(p) ((((*WP(p))&0xffff0000) >>16) | (((*(WP(p)+1))&0x0000ffff) << 16))
#define MUR_ONE_THREE(p) ((((*WP(p))&0xff000000) >>24) | (((*(WP(p)+1))&0x00ffffff) << 8))
#endif
#define MUR_GETBLOCK(p,i) (MUR_PLUS0_ALIGNED(p) ? ((p)[i]) : \
(MUR_PLUS1_ALIGNED(p) ? MUR_THREE_ONE(p) : \
(MUR_PLUS2_ALIGNED(p) ? MUR_TWO_TWO(p) : \
MUR_ONE_THREE(p))))
#endif
#define MUR_ROTL32(x,r) (((x) << (r)) | ((x) >> (32 - (r))))
#define MUR_FMIX(_h) \
do { \
_h ^= _h >> 16; \
_h *= 0x85ebca6b; \
_h ^= _h >> 13; \
_h *= 0xc2b2ae35l; \
_h ^= _h >> 16; \
} while(0)
#define HASH_MUR(key,keylen,num_bkts,hashv,bkt) \
do { \
const uint8_t *_mur_data = (const uint8_t*)(key); \
const int _mur_nblocks = (keylen) / 4; \
uint32_t _mur_h1 = 0xf88D5353; \
uint32_t _mur_c1 = 0xcc9e2d51; \
uint32_t _mur_c2 = 0x1b873593; \
uint32_t _mur_k1 = 0; \
const uint8_t *_mur_tail; \
const uint32_t *_mur_blocks = (const uint32_t*)(_mur_data+_mur_nblocks*4); \
int _mur_i; \
for(_mur_i = -_mur_nblocks; _mur_i; _mur_i++) { \
_mur_k1 = MUR_GETBLOCK(_mur_blocks,_mur_i); \
_mur_k1 *= _mur_c1; \
_mur_k1 = MUR_ROTL32(_mur_k1,15); \
_mur_k1 *= _mur_c2; \
\
_mur_h1 ^= _mur_k1; \
_mur_h1 = MUR_ROTL32(_mur_h1,13); \
_mur_h1 = _mur_h1*5+0xe6546b64; \
} \
_mur_tail = (const uint8_t*)(_mur_data + _mur_nblocks*4); \
_mur_k1=0; \
switch((keylen) & 3) { \
case 3: _mur_k1 ^= _mur_tail[2] << 16; \
case 2: _mur_k1 ^= _mur_tail[1] << 8; \
case 1: _mur_k1 ^= _mur_tail[0]; \
_mur_k1 *= _mur_c1; \
_mur_k1 = MUR_ROTL32(_mur_k1,15); \
_mur_k1 *= _mur_c2; \
_mur_h1 ^= _mur_k1; \
} \
_mur_h1 ^= (keylen); \
MUR_FMIX(_mur_h1); \
hashv = _mur_h1; \
bkt = hashv & (num_bkts-1); \
} while(0)
#endif /* HASH_USING_NO_STRICT_ALIASING */
/* key comparison function; return 0 if keys equal */
#define HASH_KEYCMP(a,b,len) memcmp(a,b,len)
/* iterate over items in a known bucket to find desired item */
#define HASH_FIND_IN_BKT(tbl,hh,head,keyptr,keylen_in,out) \
do { \
if (head.hh_head) DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,head.hh_head)); \
else out=NULL; \
while (out) { \
if ((out)->hh.keylen == keylen_in) { \
if ((HASH_KEYCMP((out)->hh.key,keyptr,keylen_in)) == 0) break; \
} \
if ((out)->hh.hh_next) DECLTYPE_ASSIGN(out,ELMT_FROM_HH(tbl,(out)->hh.hh_next)); \
else out = NULL; \
} \
} while(0)
/* add an item to a bucket */
#define HASH_ADD_TO_BKT(head,addhh) \
do { \
head.count++; \
(addhh)->hh_next = head.hh_head; \
(addhh)->hh_prev = NULL; \
if (head.hh_head) { (head).hh_head->hh_prev = (addhh); } \
(head).hh_head=addhh; \
if (head.count >= ((head.expand_mult+1) * HASH_BKT_CAPACITY_THRESH) \
&& (addhh)->tbl->noexpand != 1) { \
HASH_EXPAND_BUCKETS((addhh)->tbl); \
} \
} while(0)
/* remove an item from a given bucket */
#define HASH_DEL_IN_BKT(hh,head,hh_del) \
(head).count--; \
if ((head).hh_head == hh_del) { \
(head).hh_head = hh_del->hh_next; \
} \
if (hh_del->hh_prev) { \
hh_del->hh_prev->hh_next = hh_del->hh_next; \
} \
if (hh_del->hh_next) { \
hh_del->hh_next->hh_prev = hh_del->hh_prev; \
}
/* Bucket expansion has the effect of doubling the number of buckets
* and redistributing the items into the new buckets. Ideally the
* items will distribute more or less evenly into the new buckets
* (the extent to which this is true is a measure of the quality of
* the hash function as it applies to the key domain).
*
* With the items distributed into more buckets, the chain length
* (item count) in each bucket is reduced. Thus by expanding buckets
* the hash keeps a bound on the chain length. This bounded chain
* length is the essence of how a hash provides constant time lookup.
*
* The calculation of tbl->ideal_chain_maxlen below deserves some
* explanation. First, keep in mind that we're calculating the ideal
* maximum chain length based on the *new* (doubled) bucket count.
* In fractions this is just n/b (n=number of items,b=new num buckets).
* Since the ideal chain length is an integer, we want to calculate
* ceil(n/b). We don't depend on floating point arithmetic in this
* hash, so to calculate ceil(n/b) with integers we could write
*
* ceil(n/b) = (n/b) + ((n%b)?1:0)
*
* and in fact a previous version of this hash did just that.
* But now we have improved things a bit by recognizing that b is
* always a power of two. We keep its base 2 log handy (call it lb),
* so now we can write this with a bit shift and logical AND:
*
* ceil(n/b) = (n>>lb) + ( (n & (b-1)) ? 1:0)
*
*/
#define HASH_EXPAND_BUCKETS(tbl) \
do { \
unsigned _he_bkt; \
unsigned _he_bkt_i; \
struct UT_hash_handle *_he_thh, *_he_hh_nxt; \
UT_hash_bucket *_he_new_buckets, *_he_newbkt; \
_he_new_buckets = (UT_hash_bucket*)uthash_malloc( \
2 * tbl->num_buckets * sizeof(struct UT_hash_bucket)); \
if (!_he_new_buckets) { uthash_fatal( "out of memory"); } \
memset(_he_new_buckets, 0, \
2 * tbl->num_buckets * sizeof(struct UT_hash_bucket)); \
tbl->ideal_chain_maxlen = \
(tbl->num_items >> (tbl->log2_num_buckets+1)) + \
((tbl->num_items & ((tbl->num_buckets*2)-1)) ? 1 : 0); \
tbl->nonideal_items = 0; \
for(_he_bkt_i = 0; _he_bkt_i < tbl->num_buckets; _he_bkt_i++) \
{ \
_he_thh = tbl->buckets[ _he_bkt_i ].hh_head; \
while (_he_thh) { \
_he_hh_nxt = _he_thh->hh_next; \
HASH_TO_BKT( _he_thh->hashv, tbl->num_buckets*2, _he_bkt); \
_he_newbkt = &(_he_new_buckets[ _he_bkt ]); \
if (++(_he_newbkt->count) > tbl->ideal_chain_maxlen) { \
tbl->nonideal_items++; \
_he_newbkt->expand_mult = _he_newbkt->count / \
tbl->ideal_chain_maxlen; \
} \
_he_thh->hh_prev = NULL; \
_he_thh->hh_next = _he_newbkt->hh_head; \
if (_he_newbkt->hh_head) _he_newbkt->hh_head->hh_prev = \
_he_thh; \
_he_newbkt->hh_head = _he_thh; \
_he_thh = _he_hh_nxt; \
} \
} \
uthash_free( tbl->buckets, tbl->num_buckets*sizeof(struct UT_hash_bucket) ); \
tbl->num_buckets *= 2; \
tbl->log2_num_buckets++; \
tbl->buckets = _he_new_buckets; \
tbl->ineff_expands = (tbl->nonideal_items > (tbl->num_items >> 1)) ? \
(tbl->ineff_expands+1) : 0; \
if (tbl->ineff_expands > 1) { \
tbl->noexpand=1; \
uthash_noexpand_fyi(tbl); \
} \
uthash_expand_fyi(tbl); \
} while(0)
/* This is an adaptation of Simon Tatham's O(n log(n)) mergesort */
/* Note that HASH_SORT assumes the hash handle name to be hh.
* HASH_SRT was added to allow the hash handle name to be passed in. */
#define HASH_SORT(head,cmpfcn) HASH_SRT(hh,head,cmpfcn)
#define HASH_SRT(hh,head,cmpfcn) \
do { \
unsigned _hs_i; \
unsigned _hs_looping,_hs_nmerges,_hs_insize,_hs_psize,_hs_qsize; \
struct UT_hash_handle *_hs_p, *_hs_q, *_hs_e, *_hs_list, *_hs_tail; \
if (head) { \
_hs_insize = 1; \
_hs_looping = 1; \
_hs_list = &((head)->hh); \
while (_hs_looping) { \
_hs_p = _hs_list; \
_hs_list = NULL; \
_hs_tail = NULL; \
_hs_nmerges = 0; \
while (_hs_p) { \
_hs_nmerges++; \
_hs_q = _hs_p; \
_hs_psize = 0; \
for ( _hs_i = 0; _hs_i < _hs_insize; _hs_i++ ) { \
_hs_psize++; \
_hs_q = (UT_hash_handle*)((_hs_q->next) ? \
((void*)((char*)(_hs_q->next) + \
(head)->hh.tbl->hho)) : NULL); \
if (! (_hs_q) ) break; \
} \
_hs_qsize = _hs_insize; \
while ((_hs_psize > 0) || ((_hs_qsize > 0) && _hs_q )) { \
if (_hs_psize == 0) { \
_hs_e = _hs_q; \
_hs_q = (UT_hash_handle*)((_hs_q->next) ? \
((void*)((char*)(_hs_q->next) + \
(head)->hh.tbl->hho)) : NULL); \
_hs_qsize--; \
} else if ( (_hs_qsize == 0) || !(_hs_q) ) { \
_hs_e = _hs_p; \
_hs_p = (UT_hash_handle*)((_hs_p->next) ? \
((void*)((char*)(_hs_p->next) + \
(head)->hh.tbl->hho)) : NULL); \
_hs_psize--; \
} else if (( \
cmpfcn(DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_p)), \
DECLTYPE(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_q))) \
) <= 0) { \
_hs_e = _hs_p; \
_hs_p = (UT_hash_handle*)((_hs_p->next) ? \
((void*)((char*)(_hs_p->next) + \
(head)->hh.tbl->hho)) : NULL); \
_hs_psize--; \
} else { \
_hs_e = _hs_q; \
_hs_q = (UT_hash_handle*)((_hs_q->next) ? \
((void*)((char*)(_hs_q->next) + \
(head)->hh.tbl->hho)) : NULL); \
_hs_qsize--; \
} \
if ( _hs_tail ) { \
_hs_tail->next = ((_hs_e) ? \
ELMT_FROM_HH((head)->hh.tbl,_hs_e) : NULL); \
} else { \
_hs_list = _hs_e; \
} \
_hs_e->prev = ((_hs_tail) ? \
ELMT_FROM_HH((head)->hh.tbl,_hs_tail) : NULL); \
_hs_tail = _hs_e; \
} \
_hs_p = _hs_q; \
} \
_hs_tail->next = NULL; \
if ( _hs_nmerges <= 1 ) { \
_hs_looping=0; \
(head)->hh.tbl->tail = _hs_tail; \
DECLTYPE_ASSIGN(head,ELMT_FROM_HH((head)->hh.tbl, _hs_list)); \
} \
_hs_insize *= 2; \
} \
HASH_FSCK(hh,head); \
} \
} while (0)
/* This function selects items from one hash into another hash.
* The end result is that the selected items have dual presence
* in both hashes. There is no copy of the items made; rather
* they are added into the new hash through a secondary hash
* hash handle that must be present in the structure. */
#define HASH_SELECT(hh_dst, dst, hh_src, src, cond) \
do { \
unsigned _src_bkt, _dst_bkt; \
void *_last_elt=NULL, *_elt; \
UT_hash_handle *_src_hh, *_dst_hh, *_last_elt_hh=NULL; \
ptrdiff_t _dst_hho = ((char*)(&(dst)->hh_dst) - (char*)(dst)); \
if (src) { \
for(_src_bkt=0; _src_bkt < (src)->hh_src.tbl->num_buckets; _src_bkt++) { \
for(_src_hh = (src)->hh_src.tbl->buckets[_src_bkt].hh_head; \
_src_hh; \
_src_hh = _src_hh->hh_next) { \
_elt = ELMT_FROM_HH((src)->hh_src.tbl, _src_hh); \
if (cond(_elt)) { \
_dst_hh = (UT_hash_handle*)(((char*)_elt) + _dst_hho); \
_dst_hh->key = _src_hh->key; \
_dst_hh->keylen = _src_hh->keylen; \
_dst_hh->hashv = _src_hh->hashv; \
_dst_hh->prev = _last_elt; \
_dst_hh->next = NULL; \
if (_last_elt_hh) { _last_elt_hh->next = _elt; } \
if (!dst) { \
DECLTYPE_ASSIGN(dst,_elt); \
HASH_MAKE_TABLE(hh_dst,dst); \
} else { \
_dst_hh->tbl = (dst)->hh_dst.tbl; \
} \
HASH_TO_BKT(_dst_hh->hashv, _dst_hh->tbl->num_buckets, _dst_bkt); \
HASH_ADD_TO_BKT(_dst_hh->tbl->buckets[_dst_bkt],_dst_hh); \
(dst)->hh_dst.tbl->num_items++; \
_last_elt = _elt; \
_last_elt_hh = _dst_hh; \
} \
} \
} \
} \
HASH_FSCK(hh_dst,dst); \
} while (0)
#define HASH_CLEAR(hh,head) \
do { \
if (head) { \
uthash_free((head)->hh.tbl->buckets, \
(head)->hh.tbl->num_buckets*sizeof(struct UT_hash_bucket)); \
HASH_BLOOM_FREE((head)->hh.tbl); \
uthash_free((head)->hh.tbl, sizeof(UT_hash_table)); \
(head)=NULL; \
} \
} while(0)
#ifdef NO_DECLTYPE
#define HASH_ITER(hh,head,el,tmp) \
for((el)=(head), (*(char**)(&(tmp)))=(char*)((head)?(head)->hh.next:NULL); \
el; (el)=(tmp),(*(char**)(&(tmp)))=(char*)((tmp)?(tmp)->hh.next:NULL))
#else
#define HASH_ITER(hh,head,el,tmp) \
for((el)=(head),(tmp)=DECLTYPE(el)((head)?(head)->hh.next:NULL); \
el; (el)=(tmp),(tmp)=DECLTYPE(el)((tmp)?(tmp)->hh.next:NULL))
#endif
/* obtain a count of items in the hash */
#define HASH_COUNT(head) HASH_CNT(hh,head)
#define HASH_CNT(hh,head) ((head)?((head)->hh.tbl->num_items):0)
typedef struct UT_hash_bucket {
struct UT_hash_handle *hh_head;
unsigned count;
/* expand_mult is normally set to 0. In this situation, the max chain length
* threshold is enforced at its default value, HASH_BKT_CAPACITY_THRESH. (If
* the bucket's chain exceeds this length, bucket expansion is triggered).
* However, setting expand_mult to a non-zero value delays bucket expansion
* (that would be triggered by additions to this particular bucket)
* until its chain length reaches a *multiple* of HASH_BKT_CAPACITY_THRESH.
* (The multiplier is simply expand_mult+1). The whole idea of this
* multiplier is to reduce bucket expansions, since they are expensive, in
* situations where we know that a particular bucket tends to be overused.
* It is better to let its chain length grow to a longer yet-still-bounded
* value, than to do an O(n) bucket expansion too often.
*/
unsigned expand_mult;
} UT_hash_bucket;
/* random signature used only to find hash tables in external analysis */
#define HASH_SIGNATURE 0xa0111fe1
#define HASH_BLOOM_SIGNATURE 0xb12220f2
typedef struct UT_hash_table {
UT_hash_bucket *buckets;
unsigned num_buckets, log2_num_buckets;
unsigned num_items;
struct UT_hash_handle *tail; /* tail hh in app order, for fast append */
ptrdiff_t hho; /* hash handle offset (byte pos of hash handle in element */
/* in an ideal situation (all buckets used equally), no bucket would have
* more than ceil(#items/#buckets) items. that's the ideal chain length. */
unsigned ideal_chain_maxlen;
/* nonideal_items is the number of items in the hash whose chain position
* exceeds the ideal chain maxlen. these items pay the penalty for an uneven
* hash distribution; reaching them in a chain traversal takes >ideal steps */
unsigned nonideal_items;
/* ineffective expands occur when a bucket doubling was performed, but
* afterward, more than half the items in the hash had nonideal chain
* positions. If this happens on two consecutive expansions we inhibit any
* further expansion, as it's not helping; this happens when the hash
* function isn't a good fit for the key domain. When expansion is inhibited
* the hash will still work, albeit no longer in constant time. */
unsigned ineff_expands, noexpand;
uint32_t signature; /* used only to find hash tables in external analysis */
#ifdef HASH_BLOOM
uint32_t bloom_sig; /* used only to test bloom exists in external analysis */
uint8_t *bloom_bv;
char bloom_nbits;
#endif
} UT_hash_table;
typedef struct UT_hash_handle {
struct UT_hash_table *tbl;
void *prev; /* prev element in app order */
void *next; /* next element in app order */
struct UT_hash_handle *hh_prev; /* previous hh in bucket order */
struct UT_hash_handle *hh_next; /* next hh in bucket order */
void *key; /* ptr to enclosing struct's key */
unsigned keylen; /* enclosing struct's key len */
unsigned hashv; /* result of hash-fcn(key) */
} UT_hash_handle;
#endif /* UTHASH_H */

6
H/walkclause.h
View File

@ -165,6 +165,7 @@
case _unify_idb_term:
return found_idb_clause(pc, startp, endp);
case _allocate:
case _enter_exo:
case _index_blob:
case _index_dbref:
case _index_long:
@ -215,6 +216,10 @@
pc = NEXTOP(pc,llll);
break;
/* instructions type lp */
case _retry_all_exo:
case _retry_exo:
case _try_all_exo:
case _try_exo:
case _user_switch:
pc = NEXTOP(pc,lp);
break;
@ -405,6 +410,7 @@
pc = NEXTOP(pc,sssllp);
break;
/* instructions type x */
case _get_atom_exo:
case _get_list:
case _put_list:
case _save_b_x:

14
Makefile.in
View File

@ -111,7 +111,6 @@ INTERFACE_HEADERS = \
$(srcdir)/include/clause_list.h \
$(srcdir)/include/dswiatoms.h \
$(srcdir)/include/udi.h \
$(srcdir)/include/rtree_udi.h \
$(srcdir)/include/yap_structs.h \
$(srcdir)/include/YapInterface.h \
$(srcdir)/include/SWI-Prolog.h \
@ -243,6 +242,7 @@ C_SOURCES= \
$(srcdir)/C/corout.c $(srcdir)/C/dbase.c $(srcdir)/C/dlmalloc.c \
$(srcdir)/C/errors.c \
$(srcdir)/C/eval.c $(srcdir)/C/exec.c \
$(srcdir)/C/exo.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 \
@ -262,8 +262,6 @@ C_SOURCES= \
$(srcdir)/C/threads.c \
$(srcdir)/C/tracer.c $(srcdir)/C/unify.c $(srcdir)/C/userpreds.c \
$(srcdir)/C/udi.c \
$(srcdir)/packages/udi/rtree.c \
$(srcdir)/packages/udi/rtree_udi.c \
$(srcdir)/C/utilpreds.c $(srcdir)/C/write.c $(srcdir)/console/yap.c \
$(srcdir)/C/yap-args.c \
$(srcdir)/C/ypstdio.c \
@ -361,7 +359,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 globals.o gmp_support.o gprof.o grow.o \
exec.o exo.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 \
@ -370,7 +368,7 @@ ENGINE_OBJECTS = \
parser.o qlyr.o qlyw.o range.o \
save.o scanner.o sort.o stdpreds.o \
sysbits.o threads.o tracer.o \
udi.o rtree.o rtree_udi.o\
udi.o\
unify.o userpreds.o utilpreds.o \
yap-args.o write.o \
blobs.o swi.o ypstdio.o $(IOLIB_OBJECTS) @MPI_OBJS@
@ -474,12 +472,6 @@ sysbits.o: $(srcdir)/C/sysbits.c config.h
udi.o: $(srcdir)/C/udi.c config.h
$(CC) -c $(C_INTERF_FLAGS) $(srcdir)/C/udi.c -o $@
rtree.o: $(srcdir)/packages/udi/rtree.c config.h
$(CC) -c $(C_INTERF_FLAGS) $(srcdir)/packages/udi/rtree.c -o $@
rtree_udi.o: $(srcdir)/packages/udi/rtree_udi.c config.h
$(CC) -c $(C_INTERF_FLAGS) $(srcdir)/packages/udi/rtree_udi.c -o $@
yap.o: $(srcdir)/console/yap.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include $(srcdir)/console/yap.c -o $@

7
config.h.in
View File

@ -24,6 +24,8 @@
/* Should we use gmp ? */
#undef HAVE_LIBGMP
#undef HAVE_LIBJUDY
/* What MPI libraries are there? */
#define HAVE_LIBMPI 0
#define HAVE_LIBMPICH
@ -67,6 +69,7 @@
#undef HAVE_GMP_H
#undef HAVE_IEEEFP_H
#undef HAVE_IO_H
#undef HAVE_JUDY_H
#undef HAVE_LIMITS_H
#undef HAVE_LOCALE_H
#undef HAVE_MACH_O_DYLD_H
@ -326,6 +329,10 @@
#define USE_GMP 1
#endif
#if HAVE_JUDY_H && HAVE_LIBJUDY
#define USE_JUDY 1
#endif
/* Should we use MPI ? */
#if defined(HAVE_MPI_H) && (defined(HAVE_LIBMPI) || defined(HAVE_LIBMPICH))
#define HAVE_MPI 1

335
configure vendored
View File

@ -1,11 +1,9 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
# Generated by GNU Autoconf 2.68.
# Generated by GNU Autoconf 2.69.
#
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software
# Foundation, Inc.
# Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc.
#
#
# This configure script is free software; the Free Software Foundation
@ -134,6 +132,31 @@ export LANGUAGE
# CDPATH.
(unset CDPATH) >/dev/null 2>&1 && unset CDPATH
# Use a proper internal environment variable to ensure we don't fall
# into an infinite loop, continuously re-executing ourselves.
if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then
_as_can_reexec=no; export _as_can_reexec;
# We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
*v*x* | *x*v* ) as_opts=-vx ;;
*v* ) as_opts=-v ;;
*x* ) as_opts=-x ;;
* ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
as_fn_exit 255
fi
# We don't want this to propagate to other subprocesses.
{ _as_can_reexec=; unset _as_can_reexec;}
if test "x$CONFIG_SHELL" = x; then
as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then :
emulate sh
@ -167,7 +190,8 @@ if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then :
else
exitcode=1; echo positional parameters were not saved.
fi
test x\$exitcode = x0 || exit 1"
test x\$exitcode = x0 || exit 1
test -x / || exit 1"
as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO
as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO
eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" &&
@ -212,21 +236,25 @@ IFS=$as_save_IFS
if test "x$CONFIG_SHELL" != x; then :
# We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
export CONFIG_SHELL
case $- in # ((((
*v*x* | *x*v* ) as_opts=-vx ;;
*v* ) as_opts=-v ;;
*x* ) as_opts=-x ;;
* ) as_opts= ;;
esac
exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"}
export CONFIG_SHELL
# We cannot yet assume a decent shell, so we have to provide a
# neutralization value for shells without unset; and this also
# works around shells that cannot unset nonexistent variables.
# Preserve -v and -x to the replacement shell.
BASH_ENV=/dev/null
ENV=/dev/null
(unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV
case $- in # ((((
*v*x* | *x*v* ) as_opts=-vx ;;
*v* ) as_opts=-v ;;
*x* ) as_opts=-x ;;
* ) as_opts= ;;
esac
exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"}
# Admittedly, this is quite paranoid, since all the known shells bail
# out after a failed `exec'.
$as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2
exit 255
fi
if test x$as_have_required = xno; then :
@ -328,6 +356,14 @@ $as_echo X"$as_dir" |
} # as_fn_mkdir_p
# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
test -f "$1" && test -x "$1"
} # as_fn_executable_p
# as_fn_append VAR VALUE
# ----------------------
# Append the text in VALUE to the end of the definition contained in VAR. Take
@ -449,6 +485,10 @@ as_cr_alnum=$as_cr_Letters$as_cr_digits
chmod +x "$as_me.lineno" ||
{ $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; }
# If we had to re-execute with $CONFIG_SHELL, we're ensured to have
# already done that, so ensure we don't try to do so again and fall
# in an infinite loop. This has already happened in practice.
_as_can_reexec=no; export _as_can_reexec
# Don't try to exec as it changes $[0], causing all sort of problems
# (the dirname of $[0] is not the place where we might find the
# original and so on. Autoconf is especially sensitive to this).
@ -483,16 +523,16 @@ if (echo >conf$$.file) 2>/dev/null; then
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
# In both cases, we have to default to `cp -p'.
# In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
as_ln_s='cp -p'
as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
as_ln_s='cp -p'
as_ln_s='cp -pR'
fi
else
as_ln_s='cp -p'
as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@ -504,28 +544,8 @@ else
as_mkdir_p=false
fi
if test -x / >/dev/null 2>&1; then
as_test_x='test -x'
else
if ls -dL / >/dev/null 2>&1; then
as_ls_L_option=L
else
as_ls_L_option=
fi
as_test_x='
eval sh -c '\''
if test -d "$1"; then
test -d "$1/.";
else
case $1 in #(
-*)set "./$1";;
esac;
case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
???[sx]*):;;*)false;;esac;fi
'\'' sh
'
fi
as_executable_p=$as_test_x
as_test_x='test -x'
as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@ -617,6 +637,7 @@ ZLIB_TARGETS
ZLIBS
MAILDROP_CFLAGS
RFC2045CHARSET
EXTRA_LIBS_FOR_SWIDLLS
CLIB_CRYPTLIBS
CLIB_NETLIBS
CLIB_PLTARGETS
@ -686,7 +707,6 @@ YAP_EXTRAS
SONAMEFLAG
DYNYAPLIB
YAPLIB
EXTRA_LIBS_FOR_SWIDLLS
EXTRA_LIBS_FOR_DLLS
YAPLIB_CFLAGS
YAPLIB_LD
@ -829,6 +849,7 @@ enable_clpbn_bp
with_gmp
with_R
with_python
with_judy
with_minisat
with_cudd
enable_myddas
@ -1315,8 +1336,6 @@ target=$target_alias
if test "x$host_alias" != x; then
if test "x$build_alias" = x; then
cross_compiling=maybe
$as_echo "$as_me: WARNING: if you wanted to set the --build type, don't use --host.
If a cross compiler is detected then cross compile mode will be used" >&2
elif test "x$build_alias" != "x$host_alias"; then
cross_compiling=yes
fi
@ -1513,6 +1532,7 @@ Optional Packages:
--with-gmp=DIR use GNU Multiple Precision in DIR
--with-R=DIR interface to R language
--with-python=DIR interface to R language
--with-judy=DIR UDI needs judy library
--enable-minisat use minisat interface
--with-cudd=DIR use CUDD package in DIR
--with-java=JAVA_HOME use Java instalation in JAVA_HOME
@ -1607,9 +1627,9 @@ test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
configure
generated by GNU Autoconf 2.68
generated by GNU Autoconf 2.69
Copyright (C) 2010 Free Software Foundation, Inc.
Copyright (C) 2012 Free Software Foundation, Inc.
This configure script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it.
_ACEOF
@ -1920,7 +1940,7 @@ $as_echo "$ac_try_echo"; } >&5
test ! -s conftest.err
} && test -s conftest$ac_exeext && {
test "$cross_compiling" = yes ||
$as_test_x conftest$ac_exeext
test -x conftest$ac_exeext
}; then :
ac_retval=0
else
@ -2023,7 +2043,8 @@ int
main ()
{
static int test_array [1 - 2 * !(($2) >= 0)];
test_array [0] = 0
test_array [0] = 0;
return test_array [0];
;
return 0;
@ -2039,7 +2060,8 @@ int
main ()
{
static int test_array [1 - 2 * !(($2) <= $ac_mid)];
test_array [0] = 0
test_array [0] = 0;
return test_array [0];
;
return 0;
@ -2065,7 +2087,8 @@ int
main ()
{
static int test_array [1 - 2 * !(($2) < 0)];
test_array [0] = 0
test_array [0] = 0;
return test_array [0];
;
return 0;
@ -2081,7 +2104,8 @@ int
main ()
{
static int test_array [1 - 2 * !(($2) >= $ac_mid)];
test_array [0] = 0
test_array [0] = 0;
return test_array [0];
;
return 0;
@ -2115,7 +2139,8 @@ int
main ()
{
static int test_array [1 - 2 * !(($2) <= $ac_mid)];
test_array [0] = 0
test_array [0] = 0;
return test_array [0];
;
return 0;
@ -2299,7 +2324,7 @@ This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
It was created by $as_me, which was
generated by GNU Autoconf 2.68. Invocation command line was
generated by GNU Autoconf 2.69. Invocation command line was
$ $0 $@
@ -2675,7 +2700,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -2715,7 +2740,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="gcc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -2768,7 +2793,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="${ac_tool_prefix}cc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -2809,7 +2834,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then
ac_prog_rejected=yes
continue
@ -2867,7 +2892,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CC="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -2911,7 +2936,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CC="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -3357,8 +3382,7 @@ cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
#include <stdarg.h>
#include <stdio.h>
#include <sys/types.h>
#include <sys/stat.h>
struct stat;
/* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */
struct buf { int x; };
FILE * (*rcsopen) (struct buf *, struct stat *, int);
@ -3471,7 +3495,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_CXX="$ac_tool_prefix$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -3515,7 +3539,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_CXX="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -3718,7 +3742,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AWK="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -4068,7 +4092,7 @@ do
for ac_prog in grep ggrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_GREP="$as_dir/$ac_prog$ac_exec_ext"
{ test -f "$ac_path_GREP" && $as_test_x "$ac_path_GREP"; } || continue
as_fn_executable_p "$ac_path_GREP" || continue
# Check for GNU ac_path_GREP and select it if it is found.
# Check for GNU $ac_path_GREP
case `"$ac_path_GREP" --version 2>&1` in
@ -4134,7 +4158,7 @@ do
for ac_prog in egrep; do
for ac_exec_ext in '' $ac_executable_extensions; do
ac_path_EGREP="$as_dir/$ac_prog$ac_exec_ext"
{ test -f "$ac_path_EGREP" && $as_test_x "$ac_path_EGREP"; } || continue
as_fn_executable_p "$ac_path_EGREP" || continue
# Check for GNU ac_path_EGREP and select it if it is found.
# Check for GNU $ac_path_EGREP
case `"$ac_path_EGREP" --version 2>&1` in
@ -4695,6 +4719,21 @@ fi
# Check whether --with-judy was given.
if test "${with_judy+set}" = set; then :
withval=$with_judy; if test "$withval" = yes; then
yap_cv_judy=yes
elif test "$withval" = no; then
yap_cv_judy=no
else
yap_cv_judy=$withval
fi
else
yap_cv_judy=yes
fi
# Check whether --with-minisat was given.
if test "${with_minisat+set}" = set; then :
withval=$with_minisat; if test "$withval" = yes; then
@ -5256,7 +5295,7 @@ case $as_dir/ in #((
# by default.
for ac_prog in ginstall scoinst install; do
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_prog$ac_exec_ext" && $as_test_x "$as_dir/$ac_prog$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_prog$ac_exec_ext"; then
if test $ac_prog = install &&
grep dspmsg "$as_dir/$ac_prog$ac_exec_ext" >/dev/null 2>&1; then
# AIX install. It has an incompatible calling convention.
@ -5329,7 +5368,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5369,7 +5408,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_RANLIB="ranlib"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5421,7 +5460,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_INDENT="${ac_tool_prefix}indent"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5461,7 +5500,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_INDENT="indent"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5513,7 +5552,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_AR="${ac_tool_prefix}ar"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5553,7 +5592,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_AR="ar"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5605,7 +5644,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_MPI_CC="${ac_tool_prefix}mpicc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5645,7 +5684,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_ac_ct_MPI_CC="mpicc"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5699,7 +5738,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_INSTALL_INFO="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -5740,7 +5779,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_path_SHELL="$as_dir/$ac_word$ac_exec_ext"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -6730,7 +6769,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_REXE="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -6851,7 +6890,7 @@ do
IFS=$as_save_IFS
test -z "$as_dir" && as_dir=.
for ac_exec_ext in '' $ac_executable_extensions; do
if { test -f "$as_dir/$ac_word$ac_exec_ext" && $as_test_x "$as_dir/$ac_word$ac_exec_ext"; }; then
if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then
ac_cv_prog_PYTHON="$ac_prog"
$as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5
break 2
@ -6882,13 +6921,63 @@ test -n "$PYTHON" || PYTHON=""none""
PYTHONHOME=`$PYTHON -c'import sys; print sys.prefix'`
PYTHONVERSION=`"$PYTHON" -c "import sys; print sys.version[:3]"`
PYTHON_LIBS="-L $PYTHONHOME/lib -lpython$PYTHONVERSION"
LIBS="$LIBS $PYTHON_LIBS"
PYTHON_INCLUDES="-I $PYTHONHOME/include/python$PYTHONVERSION"
else
PYTHON_TARGET="dummy"
ENABLE_PYTHON="@# "
fi
if test "$yap_cv_judy" != "no"; then
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for Judy1Set in -lJudy" >&5
$as_echo_n "checking for Judy1Set in -lJudy... " >&6; }
if ${ac_cv_lib_Judy_Judy1Set+:} false; then :
$as_echo_n "(cached) " >&6
else
ac_check_lib_save_LIBS=$LIBS
LIBS="-lJudy $LIBS"
cat confdefs.h - <<_ACEOF >conftest.$ac_ext
/* end confdefs.h. */
/* Override any GCC internal prototype to avoid an error.
Use char because int might match the return type of a GCC
builtin and then its argument prototype would still apply. */
#ifdef __cplusplus
extern "C"
#endif
char Judy1Set ();
int
main ()
{
return Judy1Set ();
;
return 0;
}
_ACEOF
if ac_fn_c_try_link "$LINENO"; then :
ac_cv_lib_Judy_Judy1Set=yes
else
ac_cv_lib_Judy_Judy1Set=no
fi
rm -f core conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
LIBS=$ac_check_lib_save_LIBS
fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Judy_Judy1Set" >&5
$as_echo "$ac_cv_lib_Judy_Judy1Set" >&6; }
if test "x$ac_cv_lib_Judy_Judy1Set" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_LIBJUDY 1
_ACEOF
LIBS="-lJudy $LIBS"
else
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: libJudy not found, UDI will only work with one Index at a time" >&5
$as_echo "libJudy not found, UDI will only work with one Index at a time" >&6; }
fi
fi
if test "$yap_cv_myddas" != "no"
then
@ -7658,11 +7747,7 @@ elif test -e "$srcdir"/packages/jpl/Makefile.in; then
JAVA_HOME="$yap_cv_java"
case "$target_os" in
*cygwin*|*mingw*)
if test $threads = yes; then
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib -lpthread"
else
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib"
fi
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib"
JPLCFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/win32"
;;
*darwin*)
@ -8276,7 +8361,7 @@ fi
SHLIB_CXXFLAGS="-shared -fPIC $CXXFLAGS"
INSTALL_DLLS=""
fi
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall -Wstrict-aliasing=2"
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall"
DYNYAPLIB=libYap."$SO"
SONAMEFLAG=""
YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.$SO"
@ -8425,8 +8510,6 @@ fi
;;
esac
EXTRA_LIBS_FOR_SWIDLLS="$EXTRA_LIBS_FOR_DLLS"
if test "$dynamic_loading" = "yes"
then
YAPLIB_CFLAGS="$SHLIB_CFLAGS"
@ -9164,6 +9247,20 @@ fi
done
fi
if test "$yap_cv_judy" != "no"; then
for ac_header in Judy.h
do :
ac_fn_c_check_header_mongrel "$LINENO" "Judy.h" "ac_cv_header_Judy_h" "$ac_includes_default"
if test "x$ac_cv_header_Judy_h" = xyes; then :
cat >>confdefs.h <<_ACEOF
#define HAVE_JUDY_H 1
_ACEOF
fi
done
fi
if test "$yap_cv_myddas" != "no"
then
@ -9702,7 +9799,6 @@ CMDEXT=sh
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking for gcc threaded code" >&5
@ -10806,6 +10902,9 @@ _ACEOF
fi
EXTRA_LIBS_FOR_SWIDLLS="$EXTRA_LIBS_FOR_DLLS $CLIB_PTHREADS"
{ $as_echo "$as_me:${as_lineno-$LINENO}: checking \"variable timezone in tzset\"" >&5
$as_echo_n "checking \"variable timezone in tzset\"... " >&6; }
@ -11832,16 +11931,16 @@ if (echo >conf$$.file) 2>/dev/null; then
# ... but there are two gotchas:
# 1) On MSYS, both `ln -s file dir' and `ln file dir' fail.
# 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable.
# In both cases, we have to default to `cp -p'.
# In both cases, we have to default to `cp -pR'.
ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe ||
as_ln_s='cp -p'
as_ln_s='cp -pR'
elif ln conf$$.file conf$$ 2>/dev/null; then
as_ln_s=ln
else
as_ln_s='cp -p'
as_ln_s='cp -pR'
fi
else
as_ln_s='cp -p'
as_ln_s='cp -pR'
fi
rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file
rmdir conf$$.dir 2>/dev/null
@ -11901,28 +12000,16 @@ else
as_mkdir_p=false
fi
if test -x / >/dev/null 2>&1; then
as_test_x='test -x'
else
if ls -dL / >/dev/null 2>&1; then
as_ls_L_option=L
else
as_ls_L_option=
fi
as_test_x='
eval sh -c '\''
if test -d "$1"; then
test -d "$1/.";
else
case $1 in #(
-*)set "./$1";;
esac;
case `ls -ld'$as_ls_L_option' "$1" 2>/dev/null` in #((
???[sx]*):;;*)false;;esac;fi
'\'' sh
'
fi
as_executable_p=$as_test_x
# as_fn_executable_p FILE
# -----------------------
# Test if FILE is an executable regular file.
as_fn_executable_p ()
{
test -f "$1" && test -x "$1"
} # as_fn_executable_p
as_test_x='test -x'
as_executable_p=as_fn_executable_p
# Sed expression to map a string onto a valid CPP name.
as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'"
@ -11944,7 +12031,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
# values after options handling.
ac_log="
This file was extended by $as_me, which was
generated by GNU Autoconf 2.68. Invocation command line was
generated by GNU Autoconf 2.69. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
CONFIG_HEADERS = $CONFIG_HEADERS
@ -12006,10 +12093,10 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
ac_cs_version="\\
config.status
configured by $0, generated by GNU Autoconf 2.68,
configured by $0, generated by GNU Autoconf 2.69,
with options \\"\$ac_cs_config\\"
Copyright (C) 2010 Free Software Foundation, Inc.
Copyright (C) 2012 Free Software Foundation, Inc.
This config.status script is free software; the Free Software Foundation
gives unlimited permission to copy, distribute and modify it."
@ -12099,7 +12186,7 @@ fi
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
if \$ac_cs_recheck; then
set X '$SHELL' '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion
shift
\$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6
CONFIG_SHELL='$SHELL'

34
configure.in
View File

@ -254,8 +254,18 @@ AC_ARG_WITH(python,
yap_cv_python=$withval
fi,
[yap_cv_python=no])
AC_ARG_WITH(judy,
[ --with-judy[=DIR] UDI needs judy library],
if test "$withval" = yes; then
yap_cv_judy=yes
elif test "$withval" = no; then
yap_cv_judy=no
else
yap_cv_judy=$withval
fi,
[yap_cv_judy=yes])
dnl best test we could do.
AC_ARG_WITH(minisat,
[ --enable-minisat use minisat interface],
if test "$withval" = yes; then
@ -863,13 +873,16 @@ elif test -e "$srcdir"/packages/python/Makefile.in ; then
PYTHONHOME=`$PYTHON -c'import sys; print sys.prefix'`
PYTHONVERSION=`"$PYTHON" -c "import sys; print sys.version[[:3]]"`
PYTHON_LIBS="-L $PYTHONHOME/lib -lpython$PYTHONVERSION"
LIBS="$LIBS $PYTHON_LIBS"
PYTHON_INCLUDES="-I $PYTHONHOME/include/python$PYTHONVERSION"
else
PYTHON_TARGET="dummy"
ENABLE_PYTHON="@# "
fi
if test "$yap_cv_judy" != "no"; then
AC_CHECK_LIB(Judy, Judy1Set,,[AC_MSG_RESULT([libJudy not found, UDI will only work with one Index at a time])])
fi
dnl if test "$yap_cv_cudd" != "no"
dnl then
dnl AC_CHECK_LIB(cudd,Cudd_Init)
@ -1110,11 +1123,7 @@ elif test -e "$srcdir"/packages/jpl/Makefile.in; then
JAVA_HOME="$yap_cv_java"
case "$target_os" in
*cygwin*|*mingw*)
if test $threads = yes; then
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib -lpthread"
else
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib"
fi
JAVALIBS="\"$JAVA_HOME\"/lib/jvm.lib"
JPLCFLAGS="-I\"$JAVA_HOME\"/include -I\"$JAVA_HOME\"/include/win32"
;;
*darwin*)
@ -1365,7 +1374,7 @@ dnl Linux has both elf and a.out, in this case we found elf
SHLIB_CXXFLAGS="-shared -fPIC $CXXFLAGS"
INSTALL_DLLS=""
fi
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall -Wstrict-aliasing=2"
CC="$CC -fstrict-aliasing -freorder-blocks -fsched-interblock -Wall"
DYNYAPLIB=libYap."$SO"
SONAMEFLAG=""
YAPLIB_LD="$CC -dynamiclib -Wl,-install_name,$prefix/lib/libYap.$SO"
@ -1475,8 +1484,6 @@ dnl Linux has both elf and a.out, in this case we found elf
;;
esac
EXTRA_LIBS_FOR_SWIDLLS="$EXTRA_LIBS_FOR_DLLS"
if test "$dynamic_loading" = "yes"
then
YAPLIB_CFLAGS="$SHLIB_CFLAGS"
@ -1707,6 +1714,9 @@ if test "$yap_cv_gmp" != "no"
then
AC_CHECK_HEADERS(gmp.h)
fi
if test "$yap_cv_judy" != "no"; then
AC_CHECK_HEADERS(Judy.h)
fi
if test "$yap_cv_myddas" != "no"
then
AC_CHECK_HEADERS(mysql/mysql.h)
@ -1813,7 +1823,6 @@ AC_SUBST(SHLIB_CXX_LD)
AC_SUBST(YAPLIB_LD)
AC_SUBST(YAPLIB_CFLAGS)
AC_SUBST(EXTRA_LIBS_FOR_DLLS)
AC_SUBST(EXTRA_LIBS_FOR_SWIDLLS)
dnl objects in YAP library
AC_SUBST(YAPLIB)
AC_SUBST(DYNYAPLIB)
@ -2256,6 +2265,9 @@ AC_CHECK_TYPES(ssize_t, [], [],
#include <sys/socket.h>
])
EXTRA_LIBS_FOR_SWIDLLS="$EXTRA_LIBS_FOR_DLLS $CLIB_PTHREADS"
AC_SUBST(EXTRA_LIBS_FOR_SWIDLLS)
dnl tszet and timezone trouble
AC_MSG_CHECKING("variable timezone in tzset")

8
docs/yap.tex
View File

@ -1703,6 +1703,14 @@ if they have not been loaded before, does nothing otherwise.
@var{F} must be a list containing the names of the files to load.
@item load_db(@var{+Files})
@findex load_db/1
@syindex load_db/1
@cnindex load_db/1
@noindent
Load a database of facts with equal structure. Useful when wanting to
read in a very compact way database tables.
@item make
@findex make/0
@snindex make/0

1
include/SWI-Prolog.h
View File

@ -706,6 +706,7 @@ PL_EXPORT(int) PL_get_list_ex(term_t l, term_t h, term_t t);
PL_EXPORT(int) PL_get_nil_ex(term_t l);
PL_EXPORT(int) PL_instantiation_error(term_t culprit);
PL_EXPORT(int) PL_uninstantiation_error(term_t culprit);
PL_EXPORT(int) PL_representation_error(const char *resource);
PL_EXPORT(int) PL_type_error(const char *expected, term_t culprit);
PL_EXPORT(int) PL_domain_error(const char *expected, term_t culprit);

24
include/rtree_udi.h
View File

@ -1,24 +0,0 @@
#ifndef _RTREE_UDI_
#define _RTREE_UDI_
#ifndef _RTREE_
typedef void control_t;
#endif
/*Prolog term from :- udi(a(-,+,+)).
User defined index announce
*/
extern control_t *RtreeUdiInit (Term spec,
void *pred,
int arity);
/*this is called in each asserted term that was declared to udi_init*/
extern control_t *RtreeUdiInsert (Term term, /*asserted term*/
control_t *control,
void *clausule); /*to store in tree and return
in search*/
extern void *RtreeUdiSearch (control_t *control);
extern int RtreeUdiDestroy(control_t *control);
#endif /* _RTREE_UDI_ */

114
include/udi.h
View File

@ -1,45 +1,85 @@
/*
* This file is part of the YAP Prolog
*
* User Defined Indexing was developed by:
* David Vaz <davidvaz@dcc.fc.up.pt>
* Vitor Santos Costa <vsc@dcc.fc.up.pt>
*
* UDI Indexing Interface:
*
* Each new indexing mechanism should register it self by filling up a
* UdiControlBlock and calling Yap_UdiRegister(UdiControlBlock).
*
* UdiControlBlock has the main declaration that triggers the
* indexing structure as well as the pointers to the needed functions
* called at the appropriate times.
*
* For now each indexing structure only works with a single argument
* even when multiple arguments are indexed with the same struture.
*
* TODO: think of alternative ways of support both cases, e.g. a rtree
* does not benefit from multiple rtree indexing, but a hash table do
*/
/*chamada a cada index/2
controi estrutura de control, para definir a indexação, contem a
rtree p.e.
retorna a estrutura de control
*/
typedef void *
(* Yap_UdiInit)(
Term spec, /* mode spec */
void *pred, /* pass predicate information */
int arity);
/* This is called upon udi mode spec call, and the purpose is to allow
* the indexing struture to initialize itself.
* Should return the need opaque struture to be used in future calls
*
* arg is used to track the specific call, on multiple indexing with the
* same struture
*/
typedef void * (* Yap_UdiInit)
(YAP_Term spec,
int arg, /* argument regarding this call */
int arity);
/*chamada a cada assert*/
typedef void *
(* Yap_UdiInsert)(Term t, /* termo asserted */
void *control, /* estrutura de control*/
void *clausule); /* valor a guardar na arvore, para retornar na pesquisa */
/* Upon each assert the struture insert method is called to perform
* its work
*/
typedef void * (* Yap_UdiInsert)
(void *control, /* indexing structure opaque handle */
YAP_Term term, /* asserted argument */
int arg, /* argument regarding this call */
void *data); /* value to return on search */
/* chamada cada vez que um predicado indexado aparece no código
Returns:
NULL quando não há indexação usavel no predicado (fallback to
yap indexing)
FALSE
TRY_RETRY_TRUST quando há resultados positivos
*/
typedef void *
(* Yap_UdiSearch)(void * control);
/* Callback for each value found in a search
* if it returns FALSE the search should be immediately aborted
*/
typedef int (* Yap_UdiCallback)
(void *key, /* index key */
void *data, /* data */
void *arg); /* auxiliary data to callback */
/* chamada cada vez que um predicado indexado aparece no código
Returns:
NULL quando não há indexação usavel no predicado (fallback to
yap indexing)
FALSE
TRY_RETRY_TRUST quando há resultados positivos
*/
typedef int
(* Yap_UdiDestroy)(void * control);
/* Called upon search
*
* If there is any search to do with this structure should return >= 0
* corresponding to the values found
*
* returns -1 if there is nothing to search with this indexing structure
* e.g. a Variable as argument
*/
typedef int (* Yap_UdiSearch)
(void * control, /* indexing structure opaque handle */
int arg, /* argument regarding this call */
Yap_UdiCallback f, /* callback on each found value */
void *args); /* auxiliary data to callback */
/* Called upon abolish of the term
* to allow for a clean destroy of the indexing structures
*/
typedef int (* Yap_UdiDestroy)
(void * control);
/*
* Main structure used in UDI
*/
typedef struct udi_control_block {
Yap_UdiInit init;
Yap_UdiInsert insert;
Yap_UdiSearch search;
YAP_Atom decl; //atom that triggers this indexing structure
Yap_UdiInit init;
Yap_UdiInsert insert;
Yap_UdiSearch search;
Yap_UdiDestroy destroy;
} *UdiControlBlock;
} * UdiControlBlock;
/* Register a new indexing structure */
void Yap_UdiRegister(UdiControlBlock);

3
misc/LOCALS
View File

@ -271,4 +271,7 @@ FILE* FPreds =NULL
Functor FunctorVar =FunctorVar
// exo indexing
UInt ibnds[256] void
END_WORKER_LOCAL

1
misc/buildops
View File

@ -139,6 +139,7 @@ file(I,W,C,L,F,H, S) :-
output_save_clause(S).
grep_opcode(W, Line) :-
%format('~s~n', [Line]),
split(Line," ,();",[OP,Name,Type]),
Name \= "or_last",
check_op(OP),

5
os/pl-error.c Normal file → Executable file
View File

@ -204,6 +204,11 @@ PL_instantiation_error(term_t actual)
{ return PL_error(NULL, 0, NULL, ERR_INSTANTIATION);
}
int
PL_uninstantiation_error(term_t actual)
{ return PL_error(NULL, 0, NULL, ERR_UNINSTANTIATION, 0, actual);
}
int
PL_representation_error(const char *resource)
{ atom_t r = PL_new_atom(resource);

16
packages/CLPBN/clpbn.yap
View File

@ -390,6 +390,9 @@ call_ground_solver(Solver, GVars, _GoalKeys, Keys, Factors, Evidence) :-
% do nothing if we don't have query variables to compute.
write_out(_, GVars, AVars, _) :-
maplist(bound_varl(AVars), GVars), !.
write_out(_, [], _, _) :- !.
write_out(graphs, _, AVars, _) :- !,
@ -426,6 +429,19 @@ write_out(Solver, _, _, _) :-
format("Error: solver '~w' is unknown.", [Solver]),
fail.
bound_varl(AVars, L) :-
maplist(bound_var(AVars), L).
bound_var(_AVars,V) :-
var(V), !,
get_atts(V, [key(K)]),
( pfl:evidence(K, Ev) -> true ; get_atts(V, [key(K), evidence(Ev)]) ),
pfl:skolem(K,D),
once(nth0(Ev,D,V)).
bound_var(_AVars, _V).
%
% convert a PFL network (without constraints)
% into CLP(BN) for evaluation

7
packages/CLPBN/clpbn/horus_lifted.yap
View File

@ -44,7 +44,7 @@ call_horus_lifted_solver(QueryVars, AllVars, Output) :-
init_horus_lifted_solver(_, AllVars, _, state(Network, DistIds)) :-
get_parfactors(Parfactors),
get_observed_keys(AllVars, ObservedKeys),
%writeln(network:(parfactors=Parfactors, evidence=ObservedKeys)), nl,
% writeln(network:(parfactors=Parfactors, evidence=ObservedKeys)), nl,
cpp_create_lifted_network(Parfactors, ObservedKeys, Network),
maplist(get_dist_id, Parfactors, DistIds0),
sort(DistIds0, DistIds).
@ -74,7 +74,7 @@ is_factor(pf(Id, Ks, Rs, Phi, Tuples)) :-
maplist(get_range, Ks, Rs),
Table \= avg,
gen_table(Table, Phi),
all_tuples(Constraints, Vs, Tuples).
all_tuples(Constraints, Vs, Tuples).
get_range(K, Range) :-
@ -87,7 +87,8 @@ gen_table(Table, Phi) :-
all_tuples(Constraints, Tuple, Tuples) :-
setof(Tuple, Constraints^run(Constraints), Tuples).
findall(Tuple, run(Constraints), Tuples0),
sort(Tuples0, Tuples).
run([]).

11
packages/CLPBN/examples/learning/sprinkler_params.yap
View File

@ -36,14 +36,7 @@ main(Lik) :-
findall(X,scan_data(X),L),
em(L,0.01,10,_,Lik).
scan_data(I:[wet_grass(W),sprinkler(S),rain(R),cloudy(C)]) :-
data(W, S, R, C),
new_id(I).
scan_data([wet_grass(W),sprinkler(S),rain(R),cloudy(C)]) :-
data(W, S, R, C).
new_id(I) :-
retract(id(I)),
I1 is I+1,
assert(id(I1)).
id(0).

7
packages/CLPBN/learning/em.yap
View File

@ -134,11 +134,14 @@ setup_em_network(Items, state(AllDists, AllDistInstances, MargVars, SolverState)
clpbn_init_solver(MargVars, AllVars, _, SolverState).
run_examples(user:Exs, Keys, Factors, EList) :-
Exs = [_:_|_], !,
Exs = [[_]|_], !,
foldl(add_key, Exs, ,KExs, 1, _),
findall(ex(EKs, EFs, EEs), run_example(Exs, EKs, EFs, EEs), VExs),
foldl4(join_example, VExs, [], Keys, [], Factors, [], EList, 0, _).
run_examples(Items, Keys, Factors, EList) :-
run_ex(Items, Keys, Factors, EList).
add_key(Ex, I:Ex, I, I1) :- I1 is I+1.
join_example( ex(EKs, EFs, EEs), Keys0, Keys, Factors0, Factors, EList0, EList, I0, I) :-
I is I0+1,
@ -188,7 +191,7 @@ em_loop(Its, Likelihood0, State, MaxError, MaxIts, LikelihoodF, FTables) :-
;
Its1 is Its+1,
em_loop(Its1, Likelihood, State, MaxError, MaxIts, LikelihoodF, FTables)
).
).
ltables([], []).
ltables([Id-T|Tables], [Key-LTable|FTables]) :-

9
packages/CLPBN/pfl.yap
View File

@ -153,12 +153,15 @@ process_arg(Sk, Id, _I) -->
new_skolem(Sk,D) :-
copy_term(Sk, Sk1),
skolem(Sk1, D1),
Sk1 =@= Sk,
functor(Sk1,N,A),
functor(Sk ,N,A),
!,
( D1 = D -> true ; throw(pfl(permission_error(redefining_domain(Sk),D:D1)))).
new_skolem(Sk,D) :-
interface_predicate(Sk),
assert(skolem(Sk, D)).
functor(Sk ,N,A),
functor(NSk ,N,A),
interface_predicate(NSk),
assert(skolem(NSk, D)).
interface_predicate(Sk) :-
Sk =.. SKAs,

2
packages/prism/src/c/Makefile.in Normal file → Executable file
View File

@ -71,7 +71,7 @@ mp/%.o: $(srcdir)/mp/%.c
$(CC) -c $(CFLAGS) $< -o $@
@DO_SECOND_LD@prism.@SO@: $(OBJS)
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@
@DO_SECOND_LD@ @SHLIB_LD@ $(LDFLAGS) -o $@ $(OBJS) @EXTRA_LIBS_FOR_DLLS@ @CLIB_PTHREADS@
all: $(TARGETS)

2
packages/real

@ -1 +1 @@
Subproject commit 29a8436d86886cf932a790a013cfcf10240c68c8
Subproject commit 4452ed66c995b13258d74144d64a9d9425f22e77

1
packages/udi Submodule

@ -0,0 +1 @@
Subproject commit 13ae724d30e4c9dd56ddde63cba4a34f1844c099

7
packages/udi/README
View File

@ -1,7 +0,0 @@
This directory contains support for user defined indexers, currently:
- RTrees
For Examples and Tests proceed as follows:
git clone git://yap.dcc.fc.up.pt/udi-examples

524
packages/udi/rtree.c
View File

@ -1,524 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <float.h>
#include "rtree.h"
static node_t RTreeNewNode (void);
static void RTreeDestroyNode (node_t);
static void RTreeNodeInit (node_t);
static int RTreeSearchNode (node_t, rect_t, SearchHitCallback, void *);
static int RTreeInsertNode (node_t, int, rect_t,void *,node_t *);
static int RTreePickBranch (rect_t, node_t);
static int RTreeAddBranch(node_t, branch_t, node_t *);
static void RTreeSplitNode (node_t, branch_t, node_t *);
static void RTreePickSeeds(partition_t *, node_t, node_t);
static void RTreeNodeAddBranch(rect_t *, node_t, branch_t);
static void RTreePickNext(partition_t *, node_t, node_t);
static rect_t RTreeNodeCover(node_t);
static double RectArea (rect_t);
static rect_t RectCombine (rect_t, rect_t);
static int RectOverlap (rect_t, rect_t);
static void RectPrint (rect_t);
static partition_t PartitionNew (void);
static void PartitionPush (partition_t *, branch_t);
static branch_t PartitionPop (partition_t *);
static branch_t PartitionGet (partition_t *, int);
rtree_t RTreeNew (void)
{
rtree_t t;
t = RTreeNewNode();
t->level = 0; /*leaf*/
return t;
}
void RTreeDestroy (rtree_t t)
{
if (t)
RTreeDestroyNode (t);
}
static node_t RTreeNewNode (void)
{
node_t n;
n = (node_t) malloc (sizeof(*n));
assert(n);
RTreeNodeInit(n);
return n;
}
static void RTreeDestroyNode (node_t node)
{
int i;
if (node->level == 0) /* leaf level*/
{
for (i = 0; i < MAXCARD; i++)
if (node->branch[i].child)
;/* allow user free data*/
else
break;
}
else
{
for (i = 0; i < MAXCARD; i++)
if (node->branch[i].child)
RTreeDestroyNode (node->branch[i].child);
else
break;
}
free (node);
}
static void RTreeNodeInit (node_t n)
{
memset((void *) n,0, sizeof(*n));
n->level = -1;
}
int RTreeSearch (rtree_t t, rect_t s, SearchHitCallback f, void *arg)
{
assert(t);
return RTreeSearchNode(t,s,f,arg);
}
static int RTreeSearchNode (node_t n, rect_t s, SearchHitCallback f, void *arg)
{
int i;
int c = 0;
if (n->level > 0)
{
for (i = 0; i < MAXCARD; i++)
if (n->branch[i].child &&
RectOverlap (s,n->branch[i].mbr))
c += RTreeSearchNode ((node_t) n->branch[i].child, s, f, arg);
}
else
{
for (i = 0; i < MAXCARD; i++)
if (n->branch[i].child &&
RectOverlap (s,n->branch[i].mbr))
{
c ++;
if (f)
if ( !f(n->branch[i].mbr,n->branch[i].child,arg))
return c;
}
}
return c;
}
void RTreeInsert (rtree_t *t, rect_t r, void *data)
{
node_t n2;
node_t new_root;
branch_t b;
assert(t && *t);
if (RTreeInsertNode(*t, 0, r, data, &n2))
/* deal with root split */
{
new_root = RTreeNewNode();
new_root->level = (*t)->level + 1;
b.mbr = RTreeNodeCover(*t);
b.child = (void *) *t;
RTreeAddBranch(new_root, b, NULL);
b.mbr = RTreeNodeCover(n2);
b.child = (void *) n2;
RTreeAddBranch(new_root, b, NULL);
*t = new_root;
}
}
static int RTreeInsertNode (node_t n, int level,
rect_t r, void *data,
node_t *new_node)
{
int i;
node_t n2;
branch_t b;
assert(n && new_node);
assert(level >= 0 && level <= n->level);
if (n->level > level)
{
i = RTreePickBranch(r,n);
if (!RTreeInsertNode((node_t) n->branch[i].child, level,
r, data,&n2)) /* not split */
{
n->branch[i].mbr = RectCombine(r,n->branch[i].mbr);
return FALSE;
}
else /* node split */
{
n->branch[i].mbr = RTreeNodeCover(n->branch[i].child);
b.child = n2;
b.mbr = RTreeNodeCover(n2);
return RTreeAddBranch(n, b, new_node);
}
}
else /*insert level*/
{
b.mbr = r;
b.child = data;
return RTreeAddBranch(n, b, new_node);
}
}
static int RTreeAddBranch(node_t n, branch_t b, node_t *new_node)
{
int i;
assert(n);
if (n->count < MAXCARD) /*split not necessary*/
{
for (i = 0; i < MAXCARD; i++)
if (n->branch[i].child == NULL)
{
n->branch[i] = b;
n->count ++;
break;
}
return FALSE;
}
else /*needs to split*/
{
assert(new_node);
RTreeSplitNode (n, b, new_node);
return TRUE;
}
}
static int RTreePickBranch (rect_t r, node_t n)
{
int i;
double area;
double inc_area;
rect_t tmp;
int best_i;
double best_inc;
double best_i_area;
best_i = 0;
best_inc = DBL_MAX; /* double Max value */
best_i_area = DBL_MAX;
for (i = 0; i < MAXCARD; i++)
if (n->branch[i].child)
{
area = RectArea (n->branch[i].mbr);
tmp = RectCombine (r, n->branch[i].mbr);
inc_area = RectArea (tmp) - area;
if (inc_area < best_inc)
{
best_inc = inc_area;
best_i = i;
best_i_area = area;
}
else if (inc_area == best_inc && best_i_area > area)
{
best_inc = inc_area;
best_i = i;
best_i_area = area;
}
}
else
break;
return best_i;
}
static void RTreeSplitNode (node_t n, branch_t b, node_t *new_node)
{
partition_t p;
int level;
int i;
assert(n);
assert(new_node);
p = PartitionNew();
for (i = 0; i < MAXCARD; i ++)
PartitionPush(&p,n->branch[i]);
PartitionPush(&p,b);
level = n->level;
RTreeNodeInit(n);
n->level = level;
*new_node = RTreeNewNode();
(*new_node)->level = level;
RTreePickSeeds(&p, n, *new_node);
while (p.n)
if (n->count + p.n <= MINCARD)
/* first group (n) needs all entries */
RTreeNodeAddBranch(&(p.cover[0]), n, PartitionPop(&p));
else if ((*new_node)->count + p.n <= MINCARD)
/* second group (new_node) needs all entries */
RTreeNodeAddBranch(&(p.cover[1]), *new_node, PartitionPop(&p));
else
RTreePickNext(&p, n, *new_node);
}
static void RTreePickNext(partition_t *p, node_t n1, node_t n2)
/* linear version */
{
branch_t b;
double area[2], inc_area[2];
rect_t tmp;
b = PartitionPop(p);
area[0] = RectArea (p->cover[0]);
tmp = RectCombine (p->cover[0], b.mbr);
inc_area[0] = RectArea (tmp) - area[0];
area[1] = RectArea (p->cover[1]);
tmp = RectCombine (p->cover[1], b.mbr);
inc_area[1] = RectArea (tmp) - area[1];
if (inc_area[0] < inc_area[1] ||
(inc_area[0] == inc_area[1] && area[0] < area[1]))
RTreeNodeAddBranch(&(p->cover[0]),n1,b);
else
RTreeNodeAddBranch(&(p->cover[1]),n2,b);
}
static void RTreePickSeeds(partition_t *p, node_t n1, node_t n2)
/* puts in index 0 of each node the resulting entry, forming the two
groups
This is the linear version
*/
{
int dim,high, i;
int highestLow[NUMDIMS], lowestHigh[NUMDIMS];
double width[NUMDIMS];
int seed0, seed1;
double sep, best_sep;
assert(p->n == MAXCARD + 1);
for (dim = 0; dim < NUMDIMS; dim++)
{
high = dim + NUMDIMS;
highestLow[dim] = lowestHigh[dim] = 0;
for (i = 1; i < MAXCARD +1; i++)
{
if (p->buffer[i].mbr.coords[dim] >
p->buffer[highestLow[dim]].mbr.coords[dim])
highestLow[dim] = i;
if (p->buffer[i].mbr.coords[high] <
p->buffer[lowestHigh[dim]].mbr.coords[high])
lowestHigh[dim] = i;
}
width[dim] = p->cover_all.coords[high] - p->cover_all.coords[dim];
assert(width[dim] >= 0);
}
seed0 = lowestHigh[0];
seed1 = highestLow[0];
best_sep = 0;
for (dim = 0; dim < NUMDIMS; dim ++)
{
high = dim + NUMDIMS;
sep = (p->buffer[highestLow[dim]].mbr.coords[dim] -
p->buffer[lowestHigh[dim]].mbr.coords[high]) / width[dim];
if (sep > best_sep)
{
seed0 = lowestHigh[dim];
seed1 = highestLow[dim];
best_sep = sep;
}
}
/* assert (seed0 != seed1); */
if (seed0 > seed1)
{
RTreeNodeAddBranch(&(p->cover[0]),n1,PartitionGet(p,seed0));
RTreeNodeAddBranch(&(p->cover[1]),n2,PartitionGet(p,seed1));
}
else if (seed0 < seed1)
{
RTreeNodeAddBranch(&(p->cover[0]),n1,PartitionGet(p,seed1));
RTreeNodeAddBranch(&(p->cover[1]),n2,PartitionGet(p,seed0));
}
}
static void RTreeNodeAddBranch(rect_t *r, node_t n, branch_t b)
{
int i;
assert(n);
assert(n->count < MAXCARD);
for (i = 0; i < MAXCARD; i++)
if (n->branch[i].child == NULL)
{
n->branch[i] = b;
n->count ++;
break;
}
*r = RectCombine(*r,b.mbr);
}
void RTreePrint(node_t t)
{
int i;
/* printf("rtree([_,_,_,_,_]).\n"); */
printf("rtree(%p,%d,[",t,t->level);
for (i = 0; i < MAXCARD; i++)
{
if (t->branch[i].child != NULL)
{
printf("(%p,",t->branch[i].child);
RectPrint(t->branch[i].mbr);
printf(")");
}
else
{
printf("nil");
}
if (i < MAXCARD-1)
printf(",");
}
printf("]).\n");
if (t->level != 0)
for (i = 0; i < MAXCARD; i++)
if (t->branch[i].child != NULL)
RTreePrint((node_t) t->branch[i].child);
else
break;
}
/*
* Partition related
*/
static partition_t PartitionNew (void)
{
partition_t p;
memset((void *) &p,0, sizeof(p));
p.cover[0] = p.cover[1] = p.cover_all = RectInit();
return p;
}
static void PartitionPush (partition_t *p, branch_t b)
{
assert(p->n < MAXCARD + 1);
p->buffer[p->n] = b;
p->n ++;
p->cover_all = RectCombine(p->cover_all,b.mbr);
}
static branch_t PartitionPop (partition_t *p)
{
assert(p->n > 0);
p->n --;
return p->buffer[p->n];
}
static branch_t PartitionGet (partition_t *p, int n)
{
branch_t b;
assert (p->n > n);
b = p->buffer[n];
p->buffer[n] = PartitionPop(p);
return b;
}
/*
* Rect related
*/
rect_t RectInit (void)
{
rect_t r = {{DBL_MAX, DBL_MAX, DBL_MIN, DBL_MIN}};
return (r);
}
static double RectArea (rect_t r)
{
int i;
double area;
for (i = 0,area = 1; i < NUMDIMS; i++)
area *= r.coords[i+NUMDIMS] - r.coords[i];
/* area = (r.coords[1] - r.coords[0]) * */
/* (r.coords[3] - r.coords[2]); */
return area;
}
static rect_t RectCombine (rect_t r, rect_t s)
{
int i;
rect_t new_rect;
for (i = 0; i < NUMDIMS; i++)
{
new_rect.coords[i] = MIN(r.coords[i],s.coords[i]);
new_rect.coords[i+NUMDIMS] = MAX(r.coords[i+NUMDIMS],s.coords[i+NUMDIMS]);
}
return new_rect;
}
static int RectOverlap (rect_t r, rect_t s)
{
int i;
for (i = 0; i < NUMDIMS; i++)
if (r.coords[i] > s.coords[i + NUMDIMS] ||
s.coords[i] > r.coords[i + NUMDIMS])
return FALSE;
return TRUE;
}
static rect_t RTreeNodeCover(node_t n)
{
int i;
rect_t r = RectInit();
for (i = 0; i < MAXCARD; i++)
if (n->branch[i].child)
{
r = RectCombine (r, n->branch[i].mbr);
}
else
break;
return r;
}
static void RectPrint (rect_t r)
{
int i;
printf("[");
for (i = 0; i < 2*NUMDIMS; i++)
{
printf("%f",r.coords[i]);
if ( i < 2*NUMDIMS - 1)
printf(",");
}
printf("]");
}

63
packages/udi/rtree.h
View File

@ -1,63 +0,0 @@
#ifndef _RTREE_
#define _RTREE_
#ifndef FALSE
#define FALSE 0
#endif
#ifndef TRUE
#define TRUE !FALSE
#endif
#define NUMDIMS 2 /* 2d */
struct Rect
{
double coords[2*NUMDIMS]; /* x1min, y1min, ... , x1max, y1max, ...*/
};
typedef struct Rect rect_t;
struct Branch
{
rect_t mbr;
void * child; /*void * so user can store whatever he needs, in case
of non-leaf ndes it stores the child-pointer*/
};
typedef struct Branch branch_t;
#define PGSIZE 196
#define MAXCARD (int)((PGSIZE-(2*sizeof(int)))/ sizeof(struct Branch))
#define MINCARD (MAXCARD / 2)
struct Node
{
int count;
int level;
branch_t branch[MAXCARD];
};
typedef struct Node * node_t;
typedef node_t rtree_t;
#define MIN(a, b) ((a) < (b) ? (a) : (b))
#define MAX(a, b) ((a) > (b) ? (a) : (b))
/* CallBack to search function */
typedef int (*SearchHitCallback)(rect_t r, void *data, void *arg);
extern rtree_t RTreeNew (void);
extern void RTreeInsert (rtree_t *, rect_t, void *);
extern int RTreeSearch (rtree_t, rect_t, SearchHitCallback, void *);
extern void RTreeDestroy (rtree_t);
extern void RTreePrint(node_t);
extern rect_t RectInit (void);
struct Partition
{
branch_t buffer[MAXCARD+1];
int n;
rect_t cover_all;
rect_t cover[2];
};
typedef struct Partition partition_t;
#endif /* _RTREE_ */

179
packages/udi/rtree_udi.c
View File

@ -1,179 +0,0 @@
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <assert.h>
#include <YapInterface.h>
#include "Yap.h"
#include "rtree.h"
#include "clause_list.h"
#include "rtree_udi_i.h"
#include "rtree_udi.h"
static int YAP_IsNumberTermToFloat (Term term, YAP_Float *n)
{
if (YAP_IsIntTerm (term) != FALSE)
{
if (n != NULL)
*n = (YAP_Float) YAP_IntOfTerm (term);
return (TRUE);
}
if (YAP_IsFloatTerm (term) != FALSE)
{
if (n != NULL)
*n = YAP_FloatOfTerm (term);
return (TRUE);
}
return (FALSE);
}
static rect_t RectOfTerm (Term term)
{
YAP_Term tmp;
rect_t rect;
int i;
if (!YAP_IsPairTerm(term))
return (RectInit());
for (i = 0; YAP_IsPairTerm(term) && i < 4; i++)
{
tmp = YAP_HeadOfTerm (term);
if (!YAP_IsNumberTermToFloat(tmp,&(rect.coords[i])))
return (RectInit());
term = YAP_TailOfTerm (term);
}
return (rect);
}
control_t *RtreeUdiInit (Term spec,
void * pred,
int arity){
control_t *control;
YAP_Term arg;
int i, c;
/* YAP_Term mod; */
/* spec = Yap_StripModule(spec, &mod); */
if (! YAP_IsApplTerm(spec))
return (NULL);
control = (control_t *) malloc (sizeof(*control));
assert(control);
memset((void *) control,0, sizeof(*control));
c = 0;
for (i = 1; i <= arity; i ++)
{
arg = YAP_ArgOfTerm(i,spec);
if (YAP_IsAtomTerm(arg)
&& strcmp("+",YAP_AtomName(YAP_AtomOfTerm(arg))) == 0)
{
(*control)[c].pred = pred;
(*control)[c++].arg = i;
}
}
/* for (i = 0; i < NARGS; i++)
printf("%d,%p\t",(*control)[i].arg,(*control)[i].tree);
printf("\n"); */
return control;
}
control_t *RtreeUdiInsert (Term term,control_t *control,void *clausule)
{
int i;
rect_t r;
assert(control);
for (i = 0; i < NARGS && (*control)[i].arg != 0 ; i++)
{
r = RectOfTerm(YAP_ArgOfTerm((*control)[i].arg,term));
if (!(*control)[i].tree)
(*control)[i].tree = RTreeNew();
RTreeInsert(&(*control)[i].tree,r,clausule);
}
/* printf("insert %p\n", clausule); */
return (control);
}
static int callback(rect_t r, void *data, void *arg)
{
callback_m_t x;
x = (callback_m_t) arg;
return Yap_ClauseListExtend(x->cl,data,x->pred);
}
/*ARGS ARE AVAILABLE*/
void *RtreeUdiSearch (control_t *control)
{
rect_t r;
int i;
struct ClauseList clauselist;
struct CallbackM cm;
callback_m_t c;
YAP_Term Constraints;
/*RTreePrint ((*control)[0].tree);*/
for (i = 0; i < NARGS && (*control)[i].arg != 0 ; i++) {
YAP_Term t = YAP_A((*control)[i].arg);
if (YAP_IsAttVar(t))
{
fprintf(stderr,"i=%ld\n",i);
/*get the constraits rect*/
Constraints = YAP_AttsOfVar(t);
/* Yap_DebugPlWrite(Constraints); */
r = RectOfTerm(YAP_ArgOfTerm(2,Constraints));
c = &cm;
c->cl = Yap_ClauseListInit(&clauselist);
c->pred = (*control)[i].pred;
if (!c->cl)
return NULL; /*? or fail*/
RTreeSearch((*control)[i].tree, r, callback, c);
Yap_ClauseListClose(c->cl);
if (Yap_ClauseListCount(c->cl) == 0)
{
Yap_ClauseListDestroy(c->cl);
return Yap_FAILCODE();
}
if (Yap_ClauseListCount(c->cl) == 1)
{
return Yap_ClauseListToClause(c->cl);
}
return Yap_ClauseListCode(c->cl);
}
}
return NULL; /*YAP FALLBACK*/
}
int RtreeUdiDestroy(control_t *control)
{
int i;
assert(control);
for (i = 0; i < NARGS && (*control)[i].arg != 0; i++)
{
if ((*control)[i].tree)
RTreeDestroy((*control)[i].tree);
}
free(control);
control = NULL;
return TRUE;
}

20
packages/udi/rtree_udi_i.h
View File

@ -1,20 +0,0 @@
#ifndef _RTREE_UDI_I_
#define _RTREE_UDI_I_
#define NARGS 5
struct Control
{
int arg;
void *pred;
rtree_t tree;
};
typedef struct Control control_t[NARGS];
struct CallbackM
{
clause_list_t cl;
void * pred;
};
typedef struct CallbackM * callback_m_t;
#endif /* _RTREE_UDI_I_ */

5
pl/boot.yap
View File

@ -153,6 +153,7 @@ true :- true.
/* main execution loop */
'$read_toplevel'(Goal, Bindings) :-
'$pred_exists'(read_history(_,_,_,_,_,_), user),
'$swi_current_prolog_flag'(readline, true), !,
read_history(h, '!h',
[trace, end_of_file],
@ -217,7 +218,7 @@ true :- true.
get_value('$top_level_goal',GA), GA \= [], !,
set_value('$top_level_goal',[]),
'$run_atom_goal'(GA),
halt(0).
( '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ).
'$enter_top_level' :-
'$disable_docreep',
'$run_toplevel_hooks',
@ -228,7 +229,7 @@ true :- true.
nb_setval('$debug_run',off),
nb_setval('$debug_jump',off),
'$command'(Command,Varnames,_Pos,top),
halt(0).
( '$pred_exists'(halt(_), user) -> halt(0) ; '$halt'(0) ).
'$erase_sets' :-

50
pl/dbload.yap
View File

@ -31,11 +31,11 @@ prolog:load_db(Fs) :-
dbload(Fs, _, G) :-
var(Fs),
'$do_error'(instantiation_error,G).
dbload([], _, _).
dbload([F|Fs], M0, G) :-
dbload([], _, _) :- !.
dbload([F|Fs], M0, G) :- !,
dbload(F, M0, G),
dbload(Fs, M0, G).
dbload(M:F, _M0, G) :-
dbload(M:F, _M0, G) :- !,
dbload(F, M, G).
dbload(F, M0, G) :-
atom(F), !,
@ -52,7 +52,7 @@ do_dbload(F0, M0, G) :-
check_dbload_stream(R, M0) :-
repeat,
read(R,T),
catch(read(R,T), _, fail),
( T = end_of_file -> !;
dbload_count(T, M0),
fail
@ -76,8 +76,11 @@ dbload_count(T0, M0) :-
get_module(M1:T0,_,T,M) :- !,
get_module(T0, M1, T , M).
get_module(T,M,T,M).
load_facts :-
!, % yap_flag(exo_compilation, on), !.
load_exofacts.
load_facts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
@ -95,7 +98,7 @@ load_facts.
dbload_add_facts(R, M) :-
repeat,
read(R,T),
catch(read(R,T), _, fail),
( T = end_of_file -> !;
dbload_add_fact(T, M),
fail
@ -104,13 +107,44 @@ dbload_add_facts(R, M) :-
dbload_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
Na \= gene_product,
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
dbassert(T,Handle,I0).
load_exofacts :-
retract(dbloading(Na,Arity,M,T,NaAr,_)),
nb_getval(NaAr,Size),
exo_db_get_space(T, M, Size, Handle),
assertz(dbloading(Na,Arity,M,T,NaAr,Handle)),
nb_setval(NaAr,0),
fail.
load_exofacts :-
dbprocess(F, M),
open(F, read, R),
exodb_add_facts(R, M),
close(R),
fail.
load_exofacts.
exodb_add_facts(R, M) :-
repeat,
catch(read(R,T), _, fail),
( T = end_of_file -> !;
exodb_add_fact(T, M),
fail
).
exodb_add_fact(T0, M0) :-
get_module(T0,M0,T,M),
functor(T,Na,Arity),
dbloading(Na,Arity,M,_,NaAr,Handle),
nb_getval(NaAr,I0),
I is I0+1,
nb_setval(NaAr,I),
exoassert(T,Handle,I0).
clean_up :-
retractall(dbloading(_,_,_,_,_,_)),
retractall(dbprocess(_,_)),

7
pl/flags.yap
View File

@ -1020,15 +1020,12 @@ set_prolog_flag(F,V) :-
set_prolog_flag(F,V) :-
var(V), !,
'$do_error'(instantiation_error,set_prolog_flag(F,V)).
set_prolog_flag(F, Val) :-
prolog:'$user_defined_flag'(F,_,_,_), !,
yap_flag(F, Val).
set_prolog_flag(F,V) :-
\+ atom(F), !,
'$do_error'(type_error(atom,F),set_prolog_flag(F,V)).
set_prolog_flag(F, Val) :-
prolog:'$user_defined_flag'(F,_,_,_), !,
yap_flag(F, Val).
'$swi_current_prolog_flag'(F, _),
'$swi_set_prolog_flag'(F, Val).
set_prolog_flag(F,V) :-
'$yap_system_flag'(F), !,
yap_flag(F,V).

5
pl/udi.yap
View File

@ -9,7 +9,7 @@
**************************************************************************
* *
* File: udi.yap *
* Last rev: 8/2/88 *
* Last rev: 17/12/2012 *
* mods: *
* comments: support user defined indexing *
* *
@ -22,5 +22,4 @@
******************/
udi(Pred) :-
'$udi_init'(rtree, Pred).
'$udi_init'(Pred).