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

make or-parallelism compile again

Browse Source 
git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2164 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-03-25 16:45:53 +00:00
parent 84c15fda0b
commit b2274186bd
23 changed files with 2828 additions and 378 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

433
C/absmi.c
View File

@ -10,8 +10,11 @@
* * * *
* File: absmi.c * * File: absmi.c *
* comments: Portable abstract machine interpreter * * comments: Portable abstract machine interpreter *
* Last rev: $Date: 2008-02-12 17:03:50 $,$Author: vsc $ * * Last rev: $Date: 2008-03-25 16:45:52 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.235 2008/02/12 17:03:50 vsc
* SWI-portability changes
*
* Revision 1.234 2008/01/27 11:01:06 vsc * Revision 1.234 2008/01/27 11:01:06 vsc
* make thread code more stable * make thread code more stable
* *
@ -2147,211 +2150,212 @@ Yap_absmi(int inp)
/* cut */ /* cut */
Op(cut, e); Op(cut, e);
PREG = NEXTOP(PREG, e); PREG = NEXTOP(PREG, e);
BEGD(d0);
/* assume cut is always in stack */
d0 = YREG[E_CB];
#ifdef CUT_C
{ {
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) choiceptr d0;
/* assume cut is always in stack */
d0 = (choiceptr)YREG[E_CB];
#ifdef CUT_C
{
if (SHOULD_CUT_UP_TO(B,d0))
{ {
while (POP_CHOICE_POINT(d0)) while (POP_CHOICE_POINT(d0))
{ {
POP_EXECUTE(); POP_EXECUTE();
} }
} }
} }
#endif /* CUT_C */ #endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to((choiceptr) d0); CUT_prune_to(d0);
#endif /* YAPOR */ #endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) { if (SHOULD_CUT_UP_TO(B,d0)) {
/* cut ! */ /* cut ! */
while (B->cp_b < (choiceptr)d0) { while (B->cp_b < d0) {
B = B->cp_b; B = B->cp_b;
} }
#ifdef TABLING #ifdef TABLING
abolish_incomplete_subgoals(B); abolish_incomplete_subgoals(B);
#endif /* TABLING */ #endif /* TABLING */
trim_trail: trim_trail:
HBREG = PROTECT_FROZEN_H(B->cp_b); HBREG = PROTECT_FROZEN_H(B->cp_b);
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
tr_fr_ptr pt0, pt1, pbase; tr_fr_ptr pt0, pt1, pbase;
pbase = B->cp_tr; pbase = B->cp_tr;
pt0 = pt1 = TR - 1; pt0 = pt1 = TR - 1;
while (pt1 >= pbase) { while (pt1 >= pbase) {
BEGD(d1); BEGD(d1);
d1 = TrailTerm(pt1); d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) { if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) { if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
pt0--; pt0--;
}
pt1--;
} else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1);
#ifdef LIMIT_TABLING
if ((ADDR) pt == Yap_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt1);
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr);
} else
#endif /* LIMIT_TABLING */
if ((ADDR) pt >= Yap_TrailBase) {
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
} }
pt1--; pt1--;
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) { } else if (IsPairTerm(d1)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt); CELL *pt = RepPair(d1);
int erase; #ifdef LIMIT_TABLING
PredEntry *ap = cl->ClPred; if ((ADDR) pt == Yap_TrailBase) {
sg_fr_ptr sg_fr = (sg_fr_ptr) TrailVal(pt1);
SgFr_state(sg_fr)--; /* complete_in_use --> complete : compiled_in_use --> compiled */
insert_into_global_sg_fr_list(sg_fr);
} else
#endif /* LIMIT_TABLING */
if ((ADDR) pt >= Yap_TrailBase) {
/* skip, this is a problem because we lose information,
namely active references */
pt1 = (tr_fr_ptr)pt;
} else if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt);
if (IsVarTerm(val)) {
Bind(pt, MkAtomTerm(AtomCut));
Yap_WakeUp(pt);
}
pt1--;
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
int erase;
PredEntry *ap = cl->ClPred;
LOCK(ap->PELock); LOCK(ap->PELock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount); erase = (cl->ClFlags & (ErasedMask|DirtyMask)) && !(cl->ClRefCount);
if (erase) { if (erase) {
/* at this point, we are the only ones accessing the clause, /* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */ hence we don't need to have a lock it */
saveregs(); saveregs();
if (cl->ClFlags & ErasedMask) if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
else else
Yap_CleanUpIndex(cl); Yap_CleanUpIndex(cl);
setregs(); setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
}
pt1--;
} else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) {
/* deterministic binding to multi-assignment variable */
pt1 -= 2;
} else {
TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1;
TrailVal(pt0-1) = TrailVal(pt1-1);
TrailTerm(pt0-1) = TrailTerm(pt1-1);
pt0 -= 2;
pt1 -= 2;
} }
UNLOCK(ap->PELock);
} else { } else {
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
pt0--; pt0--;
pt1--;
} }
pt1--; ENDD(d1);
} else if (IsApplTerm(d1)) { }
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) { if (pt0 != pt1) {
/* deterministic binding to multi-assignment variable */ int size;
pt1 -= 2; pt0++;
} else { size = TR - pt0;
TrailVal(pt0) = TrailVal(pt1); memcpy(pbase, pt0, size * sizeof(struct trail_frame));
TrailTerm(pt0) = d1; TR = pbase + size;
TrailVal(pt0-1) = TrailVal(pt1-1);
TrailTerm(pt0-1) = TrailTerm(pt1-1);
pt0 -= 2;
pt1 -= 2;
}
} else {
TrailTerm(pt0) = d1;
TrailVal(pt0) = TrailVal(pt1);
pt0--;
pt1--;
} }
ENDD(d1);
} }
if (pt0 != pt1) {
int size;
pt0++;
size = TR - pt0;
memcpy(pbase, pt0, size * sizeof(struct trail_frame));
TR = pbase + size;
}
}
#else #else
{ {
tr_fr_ptr pt1, pt0; tr_fr_ptr pt1, pt0;
pt1 = pt0 = B->cp_tr; pt1 = pt0 = B->cp_tr;
while (pt1 != TR) { while (pt1 != TR) {
BEGD(d1); BEGD(d1);
d1 = TrailTerm(pt1); d1 = TrailTerm(pt1);
if (IsVarTerm(d1)) { if (IsVarTerm(d1)) {
if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) { if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
pt0++; pt0++;
} }
pt1++; pt1++;
} else if (IsApplTerm(d1)) { } else if (IsApplTerm(d1)) {
if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) { if (IN_BETWEEN(HBREG,RepAppl(d1),B->cp_b)) {
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
pt1 += 2; pt1 += 2;
#else #else
pt1 += 3; pt1 += 3;
#endif #endif
} else { } else {
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
TrailVal(pt0) = TrailVal(pt1); TrailVal(pt0) = TrailVal(pt1);
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
TrailVal(pt0+1) = TrailVal(pt1+1); TrailVal(pt0+1) = TrailVal(pt1+1);
TrailTerm(pt0+1) = TrailTerm(pt1+1); TrailTerm(pt0+1) = TrailTerm(pt1+1);
pt0 += 2; pt0 += 2;
pt1 += 2; pt1 += 2;
#else #else
TrailTerm(pt0+1) = TrailTerm(pt1+1); TrailTerm(pt0+1) = TrailTerm(pt1+1);
TrailTerm(pt0) = TrailTerm(pt0+2) = d1; TrailTerm(pt0) = TrailTerm(pt0+2) = d1;
pt0 += 3; pt0 += 3;
pt1 += 3; pt1 += 3;
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
} }
} else if (IsPairTerm(d1)) { } else if (IsPairTerm(d1)) {
CELL *pt = RepPair(d1); CELL *pt = RepPair(d1);
if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) { if (IN_BETWEEN(Yap_GlobalBase, pt, H0)) {
CELL val = Deref(*pt); CELL val = Deref(*pt);
if (IsVarTerm(val)) { if (IsVarTerm(val)) {
Bind(VarOfTerm(val), MkAtomTerm(AtomCut)); Bind(VarOfTerm(val), MkAtomTerm(AtomCut));
Yap_WakeUp(pt); Yap_WakeUp(pt);
} }
} else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) { } else if ((*pt & (LogUpdMask|IndexMask)) == (LogUpdMask|IndexMask)) {
LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt); LogUpdIndex *cl = ClauseFlagsToLogUpdIndex(pt);
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
PredEntry *ap = cl->ClPred; PredEntry *ap = cl->ClPred;
#endif #endif
int erase; int erase;
LOCK(ap->PELock); LOCK(ap->PELock);
DEC_CLREF_COUNT(cl); DEC_CLREF_COUNT(cl);
cl->ClFlags &= ~InUseMask; cl->ClFlags &= ~InUseMask;
erase = (cl->ClFlags & (DirtyMask|ErasedMask)) && !(cl->ClRefCount); erase = (cl->ClFlags & (DirtyMask|ErasedMask)) && !(cl->ClRefCount);
if (erase) { if (erase) {
/* at this point, we are the only ones accessing the clause, /* at this point, we are the only ones accessing the clause,
hence we don't need to have a lock it */ hence we don't need to have a lock it */
saveregs(); saveregs();
if (cl->ClFlags & ErasedMask) if (cl->ClFlags & ErasedMask)
Yap_ErLogUpdIndex(cl); Yap_ErLogUpdIndex(cl);
else else
Yap_CleanUpIndex(cl); Yap_CleanUpIndex(cl);
setregs(); setregs();
}
UNLOCK(ap->PELock);
} else {
TrailTerm(pt0) = d1;
pt0++;
} }
UNLOCK(ap->PELock); pt1++;
} else { } else {
TrailTerm(pt0) = d1; TrailTerm(pt0) = d1;
pt0++; pt0++;
pt1++;
} }
pt1++; ENDD(d1);
} else {
TrailTerm(pt0) = d1;
pt0++;
pt1++;
} }
ENDD(d1); TR = pt0;
} }
TR = pt0;
}
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
B = B->cp_b; B = B->cp_b;
SET_BB(PROTECT_FROZEN_B(B)); SET_BB(PROTECT_FROZEN_B(B));
}
} }
ENDD(d0);
GONext(); GONext();
ENDOp(); ENDOp();
@ -2359,87 +2363,90 @@ Yap_absmi(int inp)
/* cut_t does the same as cut */ /* cut_t does the same as cut */
Op(cut_t, e); Op(cut_t, e);
PREG = NEXTOP(PREG, e); PREG = NEXTOP(PREG, e);
BEGD(d0);
/* assume cut is always in stack */
d0 = YREG[E_CB];
#ifdef CUT_C
{ {
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) choiceptr d0;
{
while (POP_CHOICE_POINT(d0)) /* assume cut is always in stack */
{ d0 = (choiceptr)YREG[E_CB];
POP_EXECUTE(); #ifdef CUT_C
} {
} if (SHOULD_CUT_UP_TO(B,d0))
} {
while (POP_CHOICE_POINT(d0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */ #endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to((choiceptr) d0); CUT_prune_to(d0);
#endif /* YAPOR */ #endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) { if (SHOULD_CUT_UP_TO(B,d0)) {
/* cut ! */ /* cut ! */
while (B->cp_b < (choiceptr)d0) { while (B->cp_b < d0) {
B = B->cp_b; B = B->cp_b;
} }
#ifdef TABLING #ifdef TABLING
abolish_incomplete_subgoals(B); abolish_incomplete_subgoals(B);
#endif /* TABLING */ #endif /* TABLING */
#ifdef FROZEN_STACKS #ifdef FROZEN_STACKS
{ {
choiceptr top_b = PROTECT_FROZEN_B(B->cp_b); choiceptr top_b = PROTECT_FROZEN_B(B->cp_b);
#ifdef SBA #ifdef SBA
if (ENV > (CELL *) top_b || ENV < H) YREG = (CELL *) top_b; if (ENV > (CELL *) top_b || ENV < H) YREG = (CELL *) top_b;
#else #else
if (ENV > (CELL *) top_b) YREG = (CELL *) top_b; if (ENV > (CELL *) top_b) YREG = (CELL *) top_b;
#endif /* SBA */ #endif /* SBA */
else YREG = (CELL *)((CELL)ENV + ENV_Size(CPREG)); else YREG = (CELL *)((CELL)ENV + ENV_Size(CPREG));
} }
#else #else
if (ENV > (CELL *)B->cp_b) { if (ENV > (CELL *)B->cp_b) {
YREG = (CELL *)B->cp_b; YREG = (CELL *)B->cp_b;
} }
else { else {
YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG)); YREG = (CELL *) ((CELL) ENV + ENV_Size(CPREG));
} }
#endif /* FROZEN_STACKS */ #endif /* FROZEN_STACKS */
YREG[E_CB] = d0; YREG[E_CB] = (CELL)d0;
goto trim_trail; goto trim_trail;
}
} }
ENDD(d0);
GONext(); GONext();
ENDOp(); ENDOp();
/* cut_e */ /* cut_e */
Op(cut_e, e); Op(cut_e, e);
PREG = NEXTOP(PREG, e); PREG = NEXTOP(PREG, e);
BEGD(d0);
/* we assume dealloc leaves in S the previous env */
d0 = SREG[E_CB];
#ifdef CUT_C
{ {
if (SHOULD_CUT_UP_TO(B,(choiceptr) d0)) choiceptr d0;
{ /* we assume dealloc leaves in S the previous env */
while (POP_CHOICE_POINT(d0)) d0 = (choiceptr)SREG[E_CB];
{ #ifdef CUT_C
POP_EXECUTE(); {
} if (SHOULD_CUT_UP_TO(B,d0))
} {
} while (POP_CHOICE_POINT(d0))
{
POP_EXECUTE();
}
}
}
#endif /* CUT_C */ #endif /* CUT_C */
#ifdef YAPOR #ifdef YAPOR
CUT_prune_to((choiceptr) d0); CUT_prune_to(d0);
#endif /* YAPOR */ #endif /* YAPOR */
if (SHOULD_CUT_UP_TO(B,(choiceptr)d0)) { if (SHOULD_CUT_UP_TO(B,d0)) {
/* cut ! */ /* cut ! */
while (B->cp_b < (choiceptr)d0) { while (B->cp_b < d0) {
B = B->cp_b; B = B->cp_b;
} }
#ifdef TABLING #ifdef TABLING
abolish_incomplete_subgoals(B); abolish_incomplete_subgoals(B);
#endif /* TABLING */ #endif /* TABLING */
goto trim_trail; goto trim_trail;
}
} }
ENDD(d0);
GONext(); GONext();
ENDOp(); ENDOp();

15
C/alloc.c
View File

@ -12,7 +12,7 @@
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: allocating space * * comments: allocating space *
* version:$Id: alloc.c,v 1.89 2008-01-28 23:35:03 vsc Exp $ * * version:$Id: alloc.c,v 1.90 2008-03-25 16:45:52 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#ifdef SCCS #ifdef SCCS
static char SccsId[] = "%W% %G%"; static char SccsId[] = "%W% %G%";
@ -51,8 +51,6 @@ static char SccsId[] = "%W% %G%";
#endif #endif
#endif #endif
#define K ((Int) 1024)
/************************************************************************/ /************************************************************************/
/* Yap workspace management */ /* Yap workspace management */
@ -1364,17 +1362,6 @@ Yap_InitMemory(int Trail, int Heap, int Stack)
{ {
Int pm, sa, ta; Int pm, sa, ta;
if (Heap < MinHeapSpace)
Heap = MinHeapSpace;
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
Trail = AdjustPageSize(Trail * K);
if (Stack < MinStackSpace)
Stack = MinStackSpace;
Stack = AdjustPageSize(Stack * K);
Heap = AdjustPageSize(Heap * K);
pm = (Trail + Heap + Stack); /* memory to be pm = (Trail + Heap + Stack); /* memory to be
* requested */ * requested */
sa = Stack; /* stack area size */ sa = Stack; /* stack area size */

12
C/amasm.c
View File

@ -11,8 +11,12 @@
* File: amasm.c * * File: amasm.c *
* comments: abstract machine assembler * * comments: abstract machine assembler *
* * * *
* Last rev: $Date: 2008-01-23 17:57:44 $ * * Last rev: $Date: 2008-03-25 16:45:52 $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.99 2008/01/23 17:57:44 vsc
* valgrind it!
* enable atom garbage collection.
*
* Revision 1.98 2007/11/26 23:43:07 vsc * Revision 1.98 2007/11/26 23:43:07 vsc
* fixes to support threads and assert correctly, even if inefficiently. * fixes to support threads and assert correctly, even if inefficiently.
* *
@ -1911,7 +1915,7 @@ a_either(op_numbers opcode, CELL opr, CELL lab, yamop *code_p, int pass_no, stru
INIT_YAMOP_LTT(code_p, nofalts); INIT_YAMOP_LTT(code_p, nofalts);
if (hascut) if (hascut)
PUT_YAMOP_CUT(code_p); PUT_YAMOP_CUT(code_p);
if (clinfo->CurrentPred->PredFlags & SequentialPredFlag) if (cip->CurrentPred->PredFlags & SequentialPredFlag)
PUT_YAMOP_SEQ(code_p); PUT_YAMOP_SEQ(code_p);
if(opcode != _or_last) { if(opcode != _or_last) {
code_p->u.sla.bmap = emit_bmlabel(cip->cpc->arnds[1], cip); code_p->u.sla.bmap = emit_bmlabel(cip->cpc->arnds[1], cip);
@ -2848,7 +2852,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
switch ((int) cip->cpc->op) { switch ((int) cip->cpc->op) {
#ifdef YAPOR #ifdef YAPOR
case sync_op: case sync_op:
code_p = a_try(_sync, cip->cpc->rnd1, cip->cpc->rnd2, 1, Zero, cip); code_p = a_try(_sync, cip->cpc->rnd1, cip->cpc->rnd2, 1, Zero, code_p, pass_no, cip);
break; break;
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
@ -3296,7 +3300,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
#ifdef YAPOR #ifdef YAPOR
if (pass_no) if (pass_no)
either_inst[either_cont++] = code_p; either_inst[either_cont++] = code_p;
code_p = a_either(_or_last, 0, 0, 0, 0, code_p, pass_no, cpc); code_p = a_either(_or_last, 0, 0, 0, 0, code_p, pass_no, cip);
if (pass_no) { if (pass_no) {
int cont = 1; int cont = 1;
do { do {

15
C/cdmgr.c
View File

@ -11,8 +11,11 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * comments: Code manager *
* * * *
* Last rev: $Date: 2008-03-24 23:48:47 $,$Author: vsc $ * * Last rev: $Date: 2008-03-25 16:45:53 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.222 2008/03/24 23:48:47 vsc
* fix maximum number of threads open error
*
* Revision 1.221 2008/03/22 23:35:00 vsc * Revision 1.221 2008/03/22 23:35:00 vsc
* fix bug in all_calls * fix bug in all_calls
* *
@ -440,9 +443,6 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#ifdef TABLING #ifdef TABLING
#include "tab.macros.h" #include "tab.macros.h"
#endif /* TABLING */ #endif /* TABLING */
#ifdef YAPOR
#include "or.macros.h"
#endif /* YAPOR */
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
@ -1549,8 +1549,6 @@ add_first_static(PredEntry *p, yamop *cp, int spy_flag)
p->PredFlags |= SequentialPredFlag; p->PredFlags |= SequentialPredFlag;
PUT_YAMOP_SEQ(pt); PUT_YAMOP_SEQ(pt);
} }
if (YAMOP_LTT(pt) != 1)
Yap_Error(INTERNAL_ERROR, TermNil, "YAMOP_LTT error (add_first_static)");
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
if (is_tabled(p)) { if (is_tabled(p)) {
@ -1717,9 +1715,6 @@ asserta_stat_clause(PredEntry *p, yamop *q, int spy_flag)
return; return;
} }
cl->ClNext = ClauseCodeToStaticClause(p->cs.p_code.FirstClause); cl->ClNext = ClauseCodeToStaticClause(p->cs.p_code.FirstClause);
#ifdef YAPOR
PUT_YAMOP_LTT(q, YAMOP_LTT((yamop *)(p->cs.p_code.FirstClause)) + 1);
#endif /* YAPOR */
p->cs.p_code.FirstClause = q; p->cs.p_code.FirstClause = q;
p->cs.p_code.TrueCodeOfPred = q; p->cs.p_code.TrueCodeOfPred = q;
if (p->PredFlags & SpiedPredFlag) { if (p->PredFlags & SpiedPredFlag) {
@ -3697,7 +3692,7 @@ ClauseInfoForCode(yamop *codeptr, CODEADDR *startp, CODEADDR *endp) {
if (pc == YESCODE) { if (pc == YESCODE) {
pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,CurrentModule)); pp = RepPredProp(Yap_GetPredPropByAtom(AtomTrue,CurrentModule));
*startp = (CODEADDR)YESCODE; *startp = (CODEADDR)YESCODE;
*endp = (CODEADDR)YESCODE; /*+(CELL)(NEXTOP((yamop *)NULL,e));*/ *endp = (CODEADDR)YESCODE+(CELL)(NEXTOP((yamop *)NULL,e));
return pp; return pp;
} }
if (!pp) { if (!pp) {

5
C/grow.c
View File

@ -1005,6 +1005,9 @@ fix_compiler_instructions(PInstr *pcpc)
case table_new_answer_op: case table_new_answer_op:
case table_try_single_op: case table_try_single_op:
#endif /* TABLING */ #endif /* TABLING */
#ifdef YAPOR
case sync_op:
#endif
#ifdef BEAM #ifdef BEAM
case run_op: case run_op:
case body_op: case body_op:
@ -1261,7 +1264,7 @@ Yap_growglobal(CELL **ptr)
{ {
unsigned long sz = sizeof(CELL) * 16 * 1024L; unsigned long sz = sizeof(CELL) * 16 * 1024L;
#if YAPOR #if defined(YAPOR) || defined(THREADS)
if (NOfThreads != 1) { if (NOfThreads != 1) {
Yap_Error(OUT_OF_STACK_ERROR,TermNil,"cannot grow Global: more than a worker/thread running"); Yap_Error(OUT_OF_STACK_ERROR,TermNil,"cannot grow Global: more than a worker/thread running");
return(FALSE); return(FALSE);

16
C/index.c
View File

@ -11,8 +11,11 @@
* File: index.c * * File: index.c *
* comments: Indexing a Prolog predicate * * comments: Indexing a Prolog predicate *
* * * *
* Last rev: $Date: 2008-02-14 14:35:13 $,$Author: vsc $ * * Last rev: $Date: 2008-03-25 16:45:53 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.197 2008/02/14 14:35:13 vsc
* fixes for indexing code.
*
* Revision 1.196 2008/01/30 10:35:43 vsc * Revision 1.196 2008/01/30 10:35:43 vsc
* fix indexing in 64 bits (it would split ints from atoms :( ). * fix indexing in 64 bits (it would split ints from atoms :( ).
* *
@ -872,6 +875,8 @@ has_cut(yamop *pc)
do { do {
op_numbers op = Yap_op_from_opcode(pc->opc); op_numbers op = Yap_op_from_opcode(pc->opc);
switch (op) { switch (op) {
case _unify_idb_term:
case _copy_idb_term:
case _Ystop: case _Ystop:
case _Nstop: case _Nstop:
return FALSE; return FALSE;
@ -918,7 +923,6 @@ has_cut(yamop *pc)
break; break;
/* instructions type Ill */ /* instructions type Ill */
case _enter_lu_pred: case _enter_lu_pred:
case _stale_lu_index:
pc = pc->u.Ill.l1; pc = pc->u.Ill.l1;
break; break;
case _execute: case _execute:
@ -953,6 +957,8 @@ has_cut(yamop *pc)
pc = NEXTOP(pc,EC); pc = NEXTOP(pc,EC);
break; break;
/* instructions type e */ /* instructions type e */
case _lock_lu:
case _unlock_lu:
case _trust_fail: case _trust_fail:
case _op_fail: case _op_fail:
case _allocate: case _allocate:
@ -1045,7 +1051,6 @@ has_cut(yamop *pc)
case _p_primitive_x: case _p_primitive_x:
case _p_compound_x: case _p_compound_x:
case _p_float_x: case _p_float_x:
case _p_cut_by_x:
pc = NEXTOP(pc,xF); pc = NEXTOP(pc,xF);
break; break;
/* instructions type y */ /* instructions type y */
@ -1066,7 +1071,6 @@ has_cut(yamop *pc)
case _p_primitive_y: case _p_primitive_y:
case _p_compound_y: case _p_compound_y:
case _p_float_y: case _p_float_y:
case _p_cut_by_y:
pc = NEXTOP(pc,yF); pc = NEXTOP(pc,yF);
break; break;
/* instructions type sla */ /* instructions type sla */
@ -1278,6 +1282,10 @@ has_cut(yamop *pc)
case _write_atom: case _write_atom:
pc = NEXTOP(pc,c); pc = NEXTOP(pc,c);
break; break;
/* instructions type p */
case _procceed:
pc = NEXTOP(pc,p);
break;
/* instructions type sc */ /* instructions type sc */
case _write_n_atoms: case _write_n_atoms:
pc = NEXTOP(pc,sc); pc = NEXTOP(pc,sc);

29
C/init.c
View File

@ -81,7 +81,7 @@ STD_PROTO(void exit, (int));
ADDR Yap_HeapBase; ADDR Yap_HeapBase;
#ifdef THREADS #if defined(THREADS)
struct restore_info rinfo[MAX_WORKERS]; struct restore_info rinfo[MAX_WORKERS];
@ -944,17 +944,17 @@ InitCodes(void)
Yap_heap_regs->env_for_yes_code.op = Yap_opcode(_call); Yap_heap_regs->env_for_yes_code.op = Yap_opcode(_call);
Yap_heap_regs->env_for_yes_code.s = -Signed(RealEnvSize); Yap_heap_regs->env_for_yes_code.s = -Signed(RealEnvSize);
Yap_heap_regs->env_for_yes_code.l2 = NULL; Yap_heap_regs->env_for_yes_code.l2 = NULL;
Yap_heap_regs->yescode->opc = Yap_opcode(_Ystop); Yap_heap_regs->yescode.opc = Yap_opcode(_Ystop);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p); Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
Yap_heap_regs->index_op = Yap_opcode(_index_pred); Yap_heap_regs->index_op = Yap_opcode(_index_pred);
Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred); Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
Yap_heap_regs->fail_op = Yap_opcode(_op_fail); Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->nocode->opc = Yap_opcode(_Nstop); Yap_heap_regs->nocode.opc = Yap_opcode(_Nstop);
((yamop *)(&Yap_heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark); Yap_heap_regs->rtrycode.opc = Yap_opcode(_retry_and_mark);
((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.s = 0; Yap_heap_regs->rtrycode.u.ld.s = 0;
((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d = NIL; Yap_heap_regs->rtrycode.u.ld.d = NIL;
#ifdef YAPOR #ifdef YAPOR
INIT_YAMOP_LTT(&(Yap_heap_regs->rtrycode), 1); INIT_YAMOP_LTT(&(Yap_heap_regs->rtrycode), 1);
#endif /* YAPOR */ #endif /* YAPOR */
@ -981,6 +981,9 @@ InitCodes(void)
Yap_heap_regs->n_of_threads_created = 1; Yap_heap_regs->n_of_threads_created = 1;
Yap_heap_regs->threads_total_time = 0; Yap_heap_regs->threads_total_time = 0;
#endif #endif
#ifdef YAPOR
Yap_heap_regs->n_of_threads = 1;
#endif
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
INIT_LOCK(Yap_heap_regs->bgl); INIT_LOCK(Yap_heap_regs->bgl);
INIT_LOCK(Yap_heap_regs->free_blocks_lock); INIT_LOCK(Yap_heap_regs->free_blocks_lock);
@ -1343,6 +1346,9 @@ InitVersion(void)
} }
#define K ((Int) 1024)
void void
Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size, Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size,
int n_workers, int sch_loop, int delay_load) int n_workers, int sch_loop, int delay_load)
@ -1370,6 +1376,17 @@ Yap_InitWorkspace(int Heap, int Stack, int Trail, int max_table_size,
/* also init memory page size, required by later functions */ /* also init memory page size, required by later functions */
Yap_InitSysbits (); Yap_InitSysbits ();
if (Heap < MinHeapSpace)
Heap = MinHeapSpace;
Heap = AdjustPageSize(Heap * K);
/* sanity checking for data areas */
if (Trail < MinTrailSpace)
Trail = MinTrailSpace;
Trail = AdjustPageSize(Trail * K);
if (Stack < MinStackSpace)
Stack = MinStackSpace;
Stack = AdjustPageSize(Stack * K);
#ifdef YAPOR #ifdef YAPOR
worker_id = 0; worker_id = 0;
if (n_workers > MAX_WORKERS) if (n_workers > MAX_WORKERS)

2
C/tracer.c
View File

@ -164,8 +164,6 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
LOCK(Yap_heap_regs->low_level_trace_lock); LOCK(Yap_heap_regs->low_level_trace_lock);
sc = Yap_heap_regs; sc = Yap_heap_regs;
vsc_count++; vsc_count++;
if (vsc_count < 2064000LL)
return;
#ifdef COMMENTED #ifdef COMMENTED
//*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc || //*(H0+(0xb65f2850-0xb64b2008)/sizeof(CELL))==0xc ||
//0x4fd4d //0x4fd4d

59
C/utilpreds.c
View File

@ -2027,65 +2027,6 @@ camacho_dum(void)
#endif /* DEBUG */ #endif /* DEBUG */
static Int
cont_current_atom(void)
{
Atom catom;
Int i = IntOfTerm(EXTRA_CBACK_ARG(1,2));
AtomEntry *ap; /* nasty hack for gcc on hpux */
/* protect current hash table line */
if (IsAtomTerm(EXTRA_CBACK_ARG(1,1)))
catom = AtomOfTerm(EXTRA_CBACK_ARG(1,1));
else
catom = NIL;
if (catom == NIL){
i++;
/* move away from current hash table line */
while (i < AtomHashTableSize) {
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
if (catom != NIL) {
break;
}
i++;
}
if (i == AtomHashTableSize) {
cut_fail();
}
}
ap = RepAtom(catom);
if (Yap_unify_constant(ARG1, MkAtomTerm(catom))) {
READ_LOCK(ap->ARWLock);
if (ap->NextOfAE == NIL) {
READ_UNLOCK(ap->ARWLock);
i++;
while (i < AtomHashTableSize) {
READ_LOCK(HashChain[i].AERWLock);
catom = HashChain[i].Entry;
READ_UNLOCK(HashChain[i].AERWLock);
if (catom != NIL) {
break;
}
i++;
}
if (i == AtomHashTableSize) {
cut_fail();
} else {
EXTRA_CBACK_ARG(1,1) = MkAtomTerm(catom);
}
} else {
EXTRA_CBACK_ARG(1,1) = MkAtomTerm(ap->NextOfAE);
READ_UNLOCK(ap->ARWLock);
}
EXTRA_CBACK_ARG(1,2) = MkIntTerm(i);
return TRUE;
} else {
return FALSE;
}
}
static Int static Int
p_unifiable(void) p_unifiable(void)
{ {

12
CLPBN/clpbn/dists.yap
View File

@ -1,5 +1,5 @@
% %
% distribution % routines to manipulate distributions
% %
:- module(clpbn_dist, :- module(clpbn_dist,
@ -101,10 +101,10 @@ dist(p(Type, CPT), Id, FParents) :-
distribution(bool, trans(CPT), Id, Parents, FParents) :- distribution(bool, trans(CPT), Id, Parents, FParents) :-
is_list(CPT), !, is_list(CPT), !,
compress_hmm_table(CPT, Parents, Tab, FParents), compress_hmm_table(CPT, Parents, Tab, FParents),
add_dist([t,f], trans, Tab, ParentsId). add_dist([t,f], trans, Tab, Parents, Id).
distribution(bool, CPT, Id, Parents, Parents) :- distribution(bool, CPT, Id, Parents, Parents) :-
is_list(CPT), !, is_list(CPT), !,
add_dist([t,f], tab, CPT, Id). add_dist([t,f], tab, CPT, Parents, Id).
distribution(aminoacids, trans(CPT), Id, Parents, FParents) :- distribution(aminoacids, trans(CPT), Id, Parents, FParents) :-
is_list(CPT), !, is_list(CPT), !,
compress_hmm_table(CPT, Parents, Tab, FParents), compress_hmm_table(CPT, Parents, Tab, FParents),
@ -138,7 +138,7 @@ distribution(Domain, CPT, Id, Parents, Parents) :-
add_dist(Domain, Type, CPT, _, Id) :- add_dist(Domain, Type, CPT, _, Id) :-
recorded(clpbn_dist_db, db(Id, CPT, Type, Domain, _, _), _), !. recorded(clpbn_dist_db, db(Id, CPT, Type, Domain, _, _), _), !.
add_dist(Domain, Type, CPT, PSizes, Id) :- add_dist(Domain, Type, CPT, Parents, Id) :-
length(CPT, CPTSize), length(CPT, CPTSize),
length(Domain, DSize), length(Domain, DSize),
new_id(Id), new_id(Id),
@ -150,7 +150,7 @@ record_parent_sizes([], Id, [], DSizes) :-
recordz(clpbn_dist_psizes,db(Id, DSizes),_). recordz(clpbn_dist_psizes,db(Id, DSizes),_).
record_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :- record_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :-
clpbn:get_atts(P,dist(Dist,_)), clpbn:get_atts(P,dist(Dist,_)),
get_dist_domain_size(Dist, DSize), get_dist_domain_size(Dist, Size),
record_parent_sizes(Parents, Id, Sizes, DSizes). record_parent_sizes(Parents, Id, Sizes, DSizes).
% %
@ -217,7 +217,7 @@ empty_dist(Dist, TAB) :-
recorded(clpbn_dist_psizes,db(Dist, DSizes),_), recorded(clpbn_dist_psizes,db(Dist, DSizes),_),
matrix_new(floats, DSizes, TAB). matrix_new(floats, DSizes, TAB).
dist_new_table(Id, NewMAT) :- dist_new_table(Id, NewMat) :-
matrix_to_list(NewMat, List), matrix_to_list(NewMat, List),
recorded(clpbn_dist_db, db(Id, _, A, B, C, D), R), recorded(clpbn_dist_db, db(Id, _, A, B, C, D), R),
erase(R), erase(R),

44
CLPBN/clpbn/examples/School/parlearn.yap Normal file
View File

@ -0,0 +1,44 @@
:- [pos:sample32].
:- ['~/Yap/work/CLPBN/clpbn/examples/School/school_32'].
% These libraries provide same functionality.
:- [library('clpbn/learning/mle')].
%:- [library('clpbn/learning/bnt_parms')].
:- [library(matrix)].
main :-
findall(X,goal(X),L),
learn_parameters(L,CPTs),
write_cpts(CPTs).
goal(professor_ability(P,V)) :-
pos:professor_ability(P,V),
p(pa, M), random < M.
goal(professor_popularity(P,V)) :-
pos:professor_popularity(P,V),
p(pp, M), random < M.
goal(registration_grade(P,V)) :-
pos:registration_grade(P,V),
p(rg, M), random < M.
goal(student_intelligence(P,V)) :-
pos:student_intelligence(P,V),
p(si, M), random < M.
goal(course_difficulty(P,V)) :-
pos:course_difficulty(P,V),
p(cd, M), random < M.
goal(registration_satisfaction(P,V)) :-
pos:registration_satisfaction(P,V),
p(rs, M), random < M.
% sampling parameter
p(_, 1.0).
write_cpts([]).
write_cpts([CPT|CPTs]) :-
matrix_to_list(CPT,L),
format('CPT=~w~n',[L]),
write_cpts(CPTs).

2433
CLPBN/clpbn/examples/School/sample32.yap Normal file
View File

File diff suppressed because it is too large Load Diff

4
CLPBN/clpbn/matrix_cpt_utils.yap
View File

@ -149,8 +149,8 @@ expand_tabs([V1|Deps1], [S1|Sz1], [V2|Deps2], [S2|Sz2], Map1, Map2, NDeps) :-
normalise_CPT(MAT,NMAT) :- normalise_CPT(MAT,NMAT) :-
matrix_to_exps(MAT), matrix_to_exps(MAT),
matrix_sum(MAT, Sum), matrix_agg_lines(MAT, +, Sum),
matrix_op_to_all(MAT,/,Sum,NMAT). matrix_op_to_lines(MAT, Sum, /, NMAT).
list_from_CPT(MAT, List) :- list_from_CPT(MAT, List) :-
matrix_to_list(MAT, List). matrix_to_list(MAT, List).

27
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h * * File: Heap.h *
* mods: * * mods: *
* comments: Heap Init Structure * * comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.125 2008-02-12 17:03:52 vsc Exp $ * * version: $Id: Heap.h,v 1.126 2008-03-25 16:45:53 vsc Exp $ *
*************************************************************************/ *************************************************************************/
/* information that can be stored in Code Space */ /* information that can be stored in Code Space */
@ -21,9 +21,13 @@
#if defined(YAPOR) || defined(THREADS) #if defined(YAPOR) || defined(THREADS)
#define WL wl[worker_id] #define WL wl[worker_id]
#define RINFO rinfo[worker_id]
#else #else
#define WL wl #define WL wl
#endif
#if defined(THREADS)
#define RINFO rinfo[worker_id]
#else
#define RINFO rinfo #define RINFO rinfo
#endif #endif
@ -93,7 +97,7 @@ typedef struct restore_info {
ADDR old_HeapBase, old_HeapTop; ADDR old_HeapBase, old_HeapTop;
} restoreinfo; } restoreinfo;
#if THREADS #if defined(THREADS)
extern struct restore_info rinfo[MAX_WORKERS]; extern struct restore_info rinfo[MAX_WORKERS];
#else #else
extern struct restore_info rinfo; extern struct restore_info rinfo;
@ -279,9 +283,9 @@ typedef struct various_codes {
struct pred_entry *p; struct pred_entry *p;
struct pred_entry *p0; struct pred_entry *p0;
} env_for_yes_code; /* sla */ } env_for_yes_code; /* sla */
yamop yescode[1]; struct yami yescode;
yamop nocode[1]; struct yami nocode;
yamop rtrycode[1]; struct yami rtrycode;
struct { struct {
OPREG arity; OPREG arity;
struct yami *clause; struct yami *clause;
@ -332,7 +336,7 @@ typedef struct various_codes {
Int yap_flags_field[NUMBER_OF_YAP_FLAGS]; Int yap_flags_field[NUMBER_OF_YAP_FLAGS];
char *char_conversion_table; char *char_conversion_table;
char *char_conversion_table2; char *char_conversion_table2;
#if THREADS #if defined(THREADS) || defined(YAPOR)
unsigned int n_of_threads; /* number of threads and processes in system */ unsigned int n_of_threads; /* number of threads and processes in system */
unsigned int n_of_threads_created; /* number of threads created since start */ unsigned int n_of_threads_created; /* number of threads created since start */
UInt threads_total_time; /* total run time for dead threads */ UInt threads_total_time; /* total run time for dead threads */
@ -591,6 +595,9 @@ struct various_codes *Yap_heap_regs;
#define Yap_NOfMemoryHoles Yap_heap_regs->nof_memory_holes #define Yap_NOfMemoryHoles Yap_heap_regs->nof_memory_holes
#if USE_DL_MALLOC || (USE_SYSTEM_MALLOC && HAVE_MALLINFO) #if USE_DL_MALLOC || (USE_SYSTEM_MALLOC && HAVE_MALLINFO)
#define HeapUsed Yap_givemallinfo() #define HeapUsed Yap_givemallinfo()
#ifdef YAPOR
#define HeapUsedLock Yap_heap_regs->heap_used_lock
#endif
#else #else
#define HeapUsed Yap_heap_regs->heap_used #define HeapUsed Yap_heap_regs->heap_used
#define HeapUsedLock Yap_heap_regs->heap_used_lock #define HeapUsedLock Yap_heap_regs->heap_used_lock
@ -622,9 +629,9 @@ struct various_codes *Yap_heap_regs;
#define COMMA_CODE Yap_heap_regs->comma_code #define COMMA_CODE Yap_heap_regs->comma_code
#define FAILCODE Yap_heap_regs->failcode #define FAILCODE Yap_heap_regs->failcode
#define TRUSTFAILCODE Yap_heap_regs->trustfailcode #define TRUSTFAILCODE Yap_heap_regs->trustfailcode
#define YESCODE Yap_heap_regs->yescode #define YESCODE (&Yap_heap_regs->yescode)
#define NOCODE Yap_heap_regs->nocode #define NOCODE (&Yap_heap_regs->nocode)
#define RTRYCODE Yap_heap_regs->rtrycode #define RTRYCODE (&Yap_heap_regs->rtrycode)
#define DUMMYCODE Yap_heap_regs->dummycode #define DUMMYCODE Yap_heap_regs->dummycode
#define CLAUSECODE Yap_heap_regs->clausecode #define CLAUSECODE Yap_heap_regs->clausecode
#define INVISIBLECHAIN Yap_heap_regs->invisiblechain #define INVISIBLECHAIN Yap_heap_regs->invisiblechain

17
H/rheap.h
View File

@ -11,8 +11,11 @@
* File: rheap.h * * File: rheap.h *
* comments: walk through heap code * * comments: walk through heap code *
* * * *
* Last rev: $Date: 2008-02-12 17:03:52 $,$Author: vsc $ * * Last rev: $Date: 2008-03-25 16:45:53 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $ * $Log: not supported by cvs2svn $
* Revision 1.85 2008/02/12 17:03:52 vsc
* SWI-portability changes
*
* Revision 1.84 2008/02/07 21:39:51 vsc * Revision 1.84 2008/02/07 21:39:51 vsc
* fix case where predicate is for an integer (DBEntry). * fix case where predicate is for an integer (DBEntry).
* *
@ -497,17 +500,17 @@ restore_codes(void)
Yap_heap_regs->trustfailcode->opc = Yap_opcode(_trust_fail); Yap_heap_regs->trustfailcode->opc = Yap_opcode(_trust_fail);
Yap_heap_regs->env_for_yes_code.op = Yap_opcode(_call); Yap_heap_regs->env_for_yes_code.op = Yap_opcode(_call);
Yap_heap_regs->yescode->opc = Yap_opcode(_Ystop); Yap_heap_regs->yescode.opc = Yap_opcode(_Ystop);
Yap_heap_regs->undef_op = Yap_opcode(_undef_p); Yap_heap_regs->undef_op = Yap_opcode(_undef_p);
Yap_heap_regs->index_op = Yap_opcode(_index_pred); Yap_heap_regs->index_op = Yap_opcode(_index_pred);
Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred); Yap_heap_regs->lockpred_op = Yap_opcode(_lock_pred);
Yap_heap_regs->fail_op = Yap_opcode(_op_fail); Yap_heap_regs->fail_op = Yap_opcode(_op_fail);
Yap_heap_regs->nocode->opc = Yap_opcode(_Nstop); Yap_heap_regs->nocode.opc = Yap_opcode(_Nstop);
Yap_heap_regs->rtrycode.opc = Yap_opcode(_retry_and_mark);
#ifdef YAPOR #ifdef YAPOR
INIT_YAMOP_LTT(&(Yap_heap_regs->nocode), 1); INIT_YAMOP_LTT(&(Yap_heap_regs->nocode), 1);
INIT_YAMOP_LTT(&(Yap_heap_regs->rtrycode), 1); INIT_YAMOP_LTT(&(Yap_heap_regs->rtrycode), 1);
#endif /* YAPOR */ #endif /* YAPOR */
((yamop *)(&Yap_heap_regs->rtrycode))->opc = Yap_opcode(_retry_and_mark);
if (((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d != NIL) if (((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d != NIL)
((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d = ((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d =
PtoOpAdjust(((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d); PtoOpAdjust(((yamop *)(&Yap_heap_regs->rtrycode))->u.ld.d);
@ -526,7 +529,7 @@ restore_codes(void)
(Functor)AtomAdjust((Atom)(Yap_heap_regs->clausecode->func)); (Functor)AtomAdjust((Atom)(Yap_heap_regs->clausecode->func));
} }
} }
#if !defined(THREADS) #if !defined(THREADS) && !defined(YAPOR)
/* restore consult stack. It consists of heap pointers, so it /* restore consult stack. It consists of heap pointers, so it
is easy to fix. is easy to fix.
*/ */
@ -834,7 +837,7 @@ restore_codes(void)
Yap_heap_regs->creep_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->creep_code)); Yap_heap_regs->creep_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->creep_code));
if (Yap_heap_regs->spy_code != NULL) if (Yap_heap_regs->spy_code != NULL)
Yap_heap_regs->spy_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->spy_code)); Yap_heap_regs->spy_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->spy_code));
#if !defined(THREADS) #if !defined(THREADS) && !defined(YAPOR)
if (Yap_heap_regs->wl.scratchpad.ptr) { if (Yap_heap_regs->wl.scratchpad.ptr) {
Yap_heap_regs->wl.scratchpad.ptr = Yap_heap_regs->wl.scratchpad.ptr =
(char *)AddrAdjust((ADDR)Yap_heap_regs->wl.scratchpad.ptr); (char *)AddrAdjust((ADDR)Yap_heap_regs->wl.scratchpad.ptr);
@ -848,7 +851,7 @@ restore_codes(void)
#ifdef COROUTINING #ifdef COROUTINING
if (Yap_heap_regs->wake_up_code != NULL) if (Yap_heap_regs->wake_up_code != NULL)
Yap_heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->wake_up_code)); Yap_heap_regs->wake_up_code = (PredEntry *)PtoHeapCellAdjust((CELL *)(Yap_heap_regs->wake_up_code));
#if !defined(THREADS) #if !defined(THREADS) && !defined(YAPOR)
Yap_heap_regs->wl.atts_mutable_list = Yap_heap_regs->wl.atts_mutable_list =
AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.atts_mutable_list))); AbsAppl(PtoGloAdjust(RepAppl(Yap_heap_regs->wl.atts_mutable_list)));
if (Yap_heap_regs->wl.dynamic_arrays) { if (Yap_heap_regs->wl.dynamic_arrays) {

19
OPTYap/opt.memory.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.memory.c File: opt.memory.c
version: $Id: opt.memory.c,v 1.9 2005-06-03 18:28:11 ricroc Exp $ version: $Id: opt.memory.c,v 1.10 2008-03-25 16:45:53 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -55,6 +55,7 @@ void shm_map_memory(int id, int size, void *shmaddr) {
return; return;
} }
#else /* MMAP_MEMORY_MAPPING_SCHEME */ #else /* MMAP_MEMORY_MAPPING_SCHEME */
void
open_mapfile(long TotalArea) { open_mapfile(long TotalArea) {
char mapfile[20]; char mapfile[20];
strcpy(mapfile,"/tmp/mapfile"); strcpy(mapfile,"/tmp/mapfile");
@ -69,6 +70,7 @@ open_mapfile(long TotalArea) {
} }
void
close_mapfile(void) { close_mapfile(void) {
if (close(fd_mapfile) < 0) if (close(fd_mapfile) < 0)
Yap_Error(FATAL_ERROR, TermNil, "close error (close_mapfile)"); Yap_Error(FATAL_ERROR, TermNil, "close error (close_mapfile)");
@ -90,11 +92,12 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
#endif /* YAPOR_MODEL */ #endif /* YAPOR_MODEL */
/* initial allocation - model independent */ /* initial allocation - model independent */
HeapArea = ADJUST_SIZE_TO_PAGE(HeapArea * KBYTES); HeapArea = ADJUST_SIZE_TO_PAGE(HeapArea);
GlobalLocalArea = ADJUST_SIZE(GlobalLocalArea * KBYTES); GlobalLocalArea = ADJUST_SIZE(GlobalLocalArea);
TrailAuxArea = ADJUST_SIZE(TrailAuxArea * KBYTES); TrailAuxArea = ADJUST_SIZE(TrailAuxArea);
/* we'll need this later */ /* we'll need this later */
Yap_HeapBase = (ADDR)mmap_addr;
Yap_GlobalBase = mmap_addr + HeapArea; Yap_GlobalBase = mmap_addr + HeapArea;
/* shared memory allocation - model dependent */ /* shared memory allocation - model dependent */
@ -163,11 +166,11 @@ void map_memory(long HeapArea, long GlobalLocalArea, long TrailAuxArea, int n_wo
Yap_LocalBase = Yap_TrailBase - CellSize; Yap_LocalBase = Yap_TrailBase - CellSize;
if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */ if (TrailAuxArea > 262144) /* 262144 = 256 * 1024 */
Yap_TrailTop = Yap_TrailBase + TrailAuxArea - 131072; /* 131072 = 262144 / 2 */ Yap_TrailTop = Yap_TrailBase + (TrailAuxArea - 131072); /* 131072 = 262144 / 2 */
else else
Yap_TrailTop = Yap_TrailBase + TrailAuxArea / 2; Yap_TrailTop = Yap_TrailBase + (TrailAuxArea / 2);
HeapMax = Yap_TrailBase + TrailAuxArea - CellSize; HeapMax = (CELL)(Yap_TrailBase + (TrailAuxArea - CellSize));
Yap_InitHeap(mmap_addr); Yap_InitHeap(mmap_addr);
} }
@ -245,7 +248,7 @@ void remap_memory(void) {
int i; int i;
remap_addr = worker_area(0); remap_addr = worker_area(0);
remap_offset = remap_addr - Yap_HeapBase; remap_offset = (char *)remap_addr - (char *)Yap_HeapBase;
WorkerArea = worker_offset(1); WorkerArea = worker_offset(1);
#ifdef SHM_MEMORY_MAPPING_SCHEME #ifdef SHM_MEMORY_MAPPING_SCHEME
for (i = 0; i < number_workers; i++) { for (i = 0; i < number_workers; i++) {

38
OPTYap/opt.preds.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: opt.preds.c File: opt.preds.c
version: $Id: opt.preds.c,v 1.27 2007-04-26 14:11:08 ricroc Exp $ version: $Id: opt.preds.c,v 1.28 2008-03-25 16:45:53 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -48,18 +48,18 @@ static qg_ans_fr_ptr actual_answer;
#ifdef YAPOR #ifdef YAPOR
static realtime current_time(void); static realtime current_time(void);
static int p_yapor_on(void); static Int p_yapor_on(void);
static int p_start_yapor(void); static Int p_start_yapor(void);
static int p_sequential(void); static Int p_sequential(void);
static int p_default_sequential(void); static Int p_default_sequential(void);
static int p_execution_mode(void); static Int p_execution_mode(void);
static int p_performance(void); static Int p_performance(void);
static int p_parallel_new_answer(void); static Int p_parallel_new_answer(void);
static int p_parallel_yes_answer(void); static Int p_parallel_yes_answer(void);
static int parallel_new_answer_putchar(int sno, int ch); static int parallel_new_answer_putchar(int sno, int ch);
static void show_answers(void); static void show_answers(void);
static void answer_to_stdout(char *answer); static void answer_to_stdout(char *answer);
static int p_or_statistics(void); static Int p_or_statistics(void);
#endif /* YAPOR */ #endif /* YAPOR */
#ifdef TABLING #ifdef TABLING
@ -173,13 +173,13 @@ realtime current_time(void) {
static static
int p_yapor_on(void) { Int p_yapor_on(void) {
return (PARALLEL_EXECUTION_MODE); return (PARALLEL_EXECUTION_MODE);
} }
static static
int p_start_yapor(void) { Int p_start_yapor(void) {
#ifdef TIMESTAMP_CHECK #ifdef TIMESTAMP_CHECK
GLOBAL_timestamp = 0; GLOBAL_timestamp = 0;
#endif /* TIMESTAMP_CHECK */ #endif /* TIMESTAMP_CHECK */
@ -199,7 +199,7 @@ int p_start_yapor(void) {
static static
int p_sequential(void) { Int p_sequential(void) {
Term t, mod; Term t, mod;
PredEntry *pe; PredEntry *pe;
@ -223,7 +223,7 @@ int p_sequential(void) {
static static
int p_default_sequential(void) { Int p_default_sequential(void) {
Term t; Term t;
t = Deref(ARG1); t = Deref(ARG1);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
@ -252,7 +252,7 @@ int p_default_sequential(void) {
static static
int p_execution_mode(void) { Int p_execution_mode(void) {
Term t; Term t;
t = Deref(ARG1); t = Deref(ARG1);
if (IsVarTerm(t)) { if (IsVarTerm(t)) {
@ -281,7 +281,7 @@ int p_execution_mode(void) {
static static
int p_performance(void) { Int p_performance(void) {
Term t; Term t;
realtime one_worker_execution_time = 0; realtime one_worker_execution_time = 0;
int i; int i;
@ -356,7 +356,7 @@ int p_performance(void) {
static static
int p_parallel_new_answer(void) { Int p_parallel_new_answer(void) {
or_fr_ptr leftmost_or_fr; or_fr_ptr leftmost_or_fr;
length_answer = 0; length_answer = 0;
@ -378,7 +378,7 @@ int p_parallel_new_answer(void) {
static static
int p_parallel_yes_answer(void) { Int p_parallel_yes_answer(void) {
GLOBAL_answers = YES_ANSWER; GLOBAL_answers = YES_ANSWER;
return (TRUE); return (TRUE);
} }
@ -490,7 +490,7 @@ void answer_to_stdout(char *answer) {
static static
int p_or_statistics(void) { Int p_or_statistics(void) {
#ifdef SHM_MEMORY_ALLOC_SCHEME #ifdef SHM_MEMORY_ALLOC_SCHEME
long pages_in_use = 0, bytes_in_use = 0; long pages_in_use = 0, bytes_in_use = 0;

4
OPTYap/or.cut.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: or.cut.c File: or.cut.c
version: $Id: or.cut.c,v 1.2 2005-05-31 08:24:24 ricroc Exp $ version: $Id: or.cut.c,v 1.3 2008-03-25 16:45:53 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -249,11 +249,11 @@ void prune_shared_branch(choiceptr prune_cp) {
BITMAP_copy(members, OrFr_members(leftmost_or_fr)); BITMAP_copy(members, OrFr_members(leftmost_or_fr));
leftmost_cp = leftmost_cp->cp_b; leftmost_cp = leftmost_cp->cp_b;
} }
end_prune_more:
} }
} }
} }
end_prune_more:
CUT_reset_prune_request(); CUT_reset_prune_request();
#ifdef TABLING #ifdef TABLING
LOCAL_top_cp_on_stack = LOCAL_top_cp; LOCAL_top_cp_on_stack = LOCAL_top_cp;

6
OPTYap/or.engine.c
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: or.engine.c File: or.engine.c
version: $Id: or.engine.c,v 1.10 2005-06-03 18:28:11 ricroc Exp $ version: $Id: or.engine.c,v 1.11 2008-03-25 16:45:53 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -304,7 +304,7 @@ sync_with_p:
/* install fase --> TR and LOCAL_top_cp->cp_tr are equal */ /* install fase --> TR and LOCAL_top_cp->cp_tr are equal */
aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr; aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr;
NEW_MAHASH((ma_h_inner_struct *)H); Yap_NEW_MAHASH((ma_h_inner_struct *)H);
while (TR != aux_tr) { while (TR != aux_tr) {
aux_cell = TrailTerm(--aux_tr); aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) { if (IsVarTerm(aux_cell)) {
@ -334,7 +334,7 @@ sync_with_p:
CELL *cell_ptr = RepAppl(aux_cell); CELL *cell_ptr = RepAppl(aux_cell);
if (((CELL *)aux_cell < LOCAL_top_cp->cp_h || if (((CELL *)aux_cell < LOCAL_top_cp->cp_h ||
EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, (choiceptr)aux_cell)) && EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, (choiceptr)aux_cell)) &&
!lookup_ma_var(cell_ptr)) { !Yap_lookup_ma_var(cell_ptr)) {
/* first time we found the variable, let's put the new value */ /* first time we found the variable, let's put the new value */
#ifdef TABLING #ifdef TABLING
*cell_ptr = TrailVal(aux_tr); *cell_ptr = TrailVal(aux_tr);

6
OPTYap/or.macros.h
View File

@ -5,7 +5,7 @@
Copyright: R. Rocha and NCC - University of Porto, Portugal Copyright: R. Rocha and NCC - University of Porto, Portugal
File: or.macros.h File: or.macros.h
version: $Id: or.macros.h,v 1.4 2005-05-31 08:24:24 ricroc Exp $ version: $Id: or.macros.h,v 1.5 2008-03-25 16:45:53 vsc Exp $
**********************************************************************/ **********************************************************************/
@ -298,11 +298,11 @@ void SCH_refuse_share_request_if_any(void) {
static inline static inline
void SCH_set_load(choiceptr current_cp) { void SCH_set_load(choiceptr current_cp) {
int lub; /* local untried branches */ Int lub; /* local untried branches */
choiceptr previous_cp = current_cp->cp_b; choiceptr previous_cp = current_cp->cp_b;
#define INIT_CP_LUB(CP, LUB) CP->cp_or_fr = (struct or_frame *)(LUB) #define INIT_CP_LUB(CP, LUB) CP->cp_or_fr = (struct or_frame *)(LUB)
#define CP_LUB(CP) (int)(CP->cp_or_fr) #define CP_LUB(CP) (Int)(CP->cp_or_fr)
if (SCH_top_shared_cp(previous_cp)) if (SCH_top_shared_cp(previous_cp))
lub = 0; lub = 0;

3
library/dgraphs.yap
View File

@ -31,7 +31,8 @@
dgraph_max_path/5, dgraph_max_path/5,
dgraph_min_paths/3, dgraph_min_paths/3,
dgraph_isomorphic/4, dgraph_isomorphic/4,
dgraph_path/3]). dgraph_path/3,
dgraph_connected_components]).
:- reexport(library(rbtrees), :- reexport(library(rbtrees),
[rb_new/1 as dgraph_new]). [rb_new/1 as dgraph_new]).

3
library/matrix/matrix.c
View File

@ -1908,7 +1908,7 @@ matrix_op_to_all(void)
/* Error */ /* Error */
return FALSE; return FALSE;
} }
/* create a new array without first dimension */ /* create a new array with same dimensions */
if (mat[MAT_TYPE] == INT_MATRIX) { if (mat[MAT_TYPE] == INT_MATRIX) {
long int *data; long int *data;
int dims = mat[MAT_NDIMS]; int dims = mat[MAT_NDIMS];
@ -2804,7 +2804,6 @@ init_matrix(void)
YAP_UserCPredicate("matrix_shuffle", matrix_transpose, 3); YAP_UserCPredicate("matrix_shuffle", matrix_transpose, 3);
YAP_UserCPredicate("matrix_expand", matrix_expand, 3); YAP_UserCPredicate("matrix_expand", matrix_expand, 3);
YAP_UserCPredicate("matrix_select", matrix_select, 4); YAP_UserCPredicate("matrix_select", matrix_select, 4);
YAP_UserCPredicate("matrix_add_to_all", matrix_sum, 2);
YAP_UserCPredicate("matrix_to_logs", matrix_log_all,1); YAP_UserCPredicate("matrix_to_logs", matrix_log_all,1);
YAP_UserCPredicate("matrix_to_exps", matrix_exp_all, 1); YAP_UserCPredicate("matrix_to_exps", matrix_exp_all, 1);
YAP_UserCPredicate("matrix_sum_out", matrix_sum_out, 3); YAP_UserCPredicate("matrix_sum_out", matrix_sum_out, 3);

4
library/yap2swi/yap2swi.c
View File

@ -1478,13 +1478,13 @@ PL_destroy_engine(PL_engine_t e)
X_API int X_API int
PL_set_engine(PL_engine_t engine, PL_engine_t *old) PL_set_engine(PL_engine_t engine, PL_engine_t *old)
{ {
int cwid = YAP_ThreadSelf(); long int cwid = YAP_ThreadSelf();
if (*old) *old = (PL_engine_t)cwid; if (*old) *old = (PL_engine_t)cwid;
if (engine == PL_ENGINE_CURRENT) if (engine == PL_ENGINE_CURRENT)
return PL_ENGINE_SET; return PL_ENGINE_SET;
if (engine < 0) /* should really check if engine does not exist */ if (engine < 0) /* should really check if engine does not exist */
return PL_ENGINE_INVAL; return PL_ENGINE_INVAL;
if (!(YAP_ThreadAttachEngine((int)engine))) { if (!(YAP_ThreadAttachEngine((long int)engine))) {
return PL_ENGINE_INUSE; return PL_ENGINE_INUSE;
} }
return PL_ENGINE_SET; return PL_ENGINE_SET;