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

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

Browse Source
This commit is contained in:
Denys Duchier 2012-06-28 14:05:38 +02:00
commit 3d28c7939e
278 changed files with 30810 additions and 14207 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

105
C/absmi.c Normal file → Executable file
View File

@ -2582,8 +2582,11 @@ Yap_absmi(int inp)
CHECK_ALARM(JMPNext());
PP = PREG->u.Osbpp.p0;
/* on X86 machines S will not actually be holding the pointer to pred */
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -2621,8 +2624,11 @@ Yap_absmi(int inp)
{
CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -2677,8 +2683,11 @@ Yap_absmi(int inp)
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_cut;
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
FAIL();
@ -2698,8 +2707,11 @@ Yap_absmi(int inp)
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_cut_t;
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
FAIL();
@ -2718,8 +2730,11 @@ Yap_absmi(int inp)
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_cut_e;
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
FAIL();
@ -2741,8 +2756,11 @@ Yap_absmi(int inp)
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_y;
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
FAIL();
@ -2764,8 +2782,11 @@ Yap_absmi(int inp)
if (!LOCAL_ActiveSignals || LOCAL_ActiveSignals & YAP_CDOVF_SIGNAL) {
goto do_commit_b_x;
}
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
FAIL();
@ -2797,8 +2818,11 @@ Yap_absmi(int inp)
/* Problem: have I got an environment or not? */
NoStackFail:
CHECK_ALARM(goto fail);
if (LOCAL_ActiveSignals && LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
/* we're happy */
@ -2821,8 +2845,11 @@ Yap_absmi(int inp)
/* don't forget I cannot creep at ; */
NoStackEither:
CHECK_ALARM(goto either_notest);
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -2904,8 +2931,11 @@ Yap_absmi(int inp)
NoStackDExecute:
CHECK_ALARM(JMPNext());
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -2983,8 +3013,11 @@ Yap_absmi(int inp)
CHECK_ALARM(JMPNext());
/* try performing garbage collection */
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -3032,8 +3065,11 @@ Yap_absmi(int inp)
/* and now CREEP */
creep:
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -13039,8 +13075,11 @@ Yap_absmi(int inp)
ENDD(d0);
NoStackPExecute2:
CHECK_ALARM(goto execute2_end);
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -13245,8 +13284,11 @@ Yap_absmi(int inp)
ENDD(d0);
NoStackPExecute:
CHECK_ALARM(goto execute_end);
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;
@ -13478,8 +13520,11 @@ Yap_absmi(int inp)
ENDP(pt0);
NoStackPTExecute:
CHECK_ALARM(goto execute_after_comma);
if (LOCAL_ActiveSignals & YAP_FAIL_SIGNAL) {
LOCAL_ActiveSignals &= ~YAP_FAIL_SIGNAL;
if (LOCAL_ActiveSignals & (YAP_FAIL_SIGNAL|YAP_INT_SIGNAL)) {
if (LOCAL_ActiveSignals & YAP_INT_SIGNAL) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
LOCAL_ActiveSignals &= ~(YAP_FAIL_SIGNAL|YAP_INT_SIGNAL);
if (!LOCAL_ActiveSignals)
CreepFlag = CalculateStackGap();
goto fail;

2
C/agc.c
View File

@ -148,7 +148,7 @@ AtomAdjust(Atom a)
#define DelayAddrAdjust(P) (P)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)
#define DBRefAdjust(P) (P)
#define DBRefAdjust(P,REF) (P)
#define DBRefPAdjust(P) (P)
#define DBTermAdjust(P) (P)
#define LUIndexAdjust(P) (P)

7
C/alloc.c
View File

@ -1121,6 +1121,13 @@ mmap_extension(Int s, MALLOC_T base, int fixed_allocation)
#endif /* !YAPOR */
/*
s= how much memory we need;
fixed_alloc = do we need to contiguously extend stack
returns TRUE or FALSE
updates WorkSpaceTop
*/
static int
ExtendWorkSpace(Int s, int fixed_allocation)
{

4
C/c_interface.c
View File

@ -3762,9 +3762,9 @@ YAP_AttsOfVar(Term t)
t = Deref(t);
if (!IsVarTerm(t))
return TermNil;
if (IsAttVar(VarOfTerm(t)))
if(!IsAttVar(VarOfTerm(t)))
return TermNil;
attv = (attvar_record *)VarOfTerm(t);
attv = RepAttVar(VarOfTerm(t));
return attv->Atts;
}

14
C/cdmgr.c
View File

@ -2633,6 +2633,9 @@ p_endconsult( USES_REGS1 )
static void
purge_clauses(PredEntry *pred)
{
if (pred->PredFlags & UDIPredFlag) {
Yap_udi_abolish(pred);
}
if (pred->cs.p_code.NOfClauses) {
if (pred->PredFlags & IndexedPredFlag)
RemoveIndexation(pred);
@ -2654,6 +2657,7 @@ p_purge_clauses( USES_REGS1 )
PredEntry *pred;
Term t = Deref(ARG1);
Term mod = Deref(ARG2);
MegaClause *before = DeadMegaClauses;
Yap_PutValue(AtomAbol, MkAtomTerm(AtomNil));
if (IsVarTerm(t))
@ -2677,7 +2681,15 @@ p_purge_clauses( USES_REGS1 )
}
purge_clauses(pred);
UNLOCKPE(34,pred);
return (TRUE);
/* try to use the garbage collector to recover the mega clause,
in case the objs pointing to it are dead themselves */
if (DeadMegaClauses != before) {
if (!Yap_gc(2, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, LOCAL_ErrorMessage);
return FALSE;
}
}
return TRUE;
}
/******************************************************************

7
C/errors.c
View File

@ -1431,9 +1431,11 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
case SYNTAX_ERROR:
{
int i;
Term ti[1];
i = strlen(tmpbuf);
nt[0] = where;
ti[0] = MkAtomTerm(AtomSyntaxError);
nt[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, ti);
psize -= i;
fun = FunctorError;
serious = TRUE;
@ -1807,6 +1809,9 @@ E);
LOCAL_Error_Size = 0L;
}
nt[1] = MkPairTerm(MkAtomTerm(Yap_LookupAtom(tmpbuf)), stack_dump);
if (type == SYNTAX_ERROR) {
nt[1] = MkPairTerm(where, nt[1]);
}
}
}
if (serious) {

5
C/exec.c
View File

@ -1676,6 +1676,11 @@ Yap_InitYaamRegs(void)
#if defined MYDDAS_MYSQL || defined MYDDAS_ODBC
Yap_REGS.MYDDAS_GLOBAL_POINTER = NULL;
#endif
#ifdef TABLING
/* ensure that LOCAL_top_dep_fr is always valid */
if (LOCAL_top_dep_fr)
DepFr_cons_cp(LOCAL_top_dep_fr) = NORM_CP(B);
#endif
}
static Int

20
C/globals.c
View File

@ -879,7 +879,7 @@ static Int
p_nb_setarg( USES_REGS1 )
{
Term wheret = Deref(ARG1);
Term dest = Deref(ARG2);
Term dest;
Term to;
UInt arity, pos;
CELL *destp;
@ -893,32 +893,30 @@ p_nb_setarg( USES_REGS1 )
return FALSE;
}
pos = IntegerOfTerm(wheret);
dest = Deref(ARG2);
if (IsVarTerm(dest)) {
Yap_Error(INSTANTIATION_ERROR,dest,"nb_setarg");
return FALSE;
} else if (IsPrimitiveTerm(dest)) {
arity = 0;
destp = NULL;
} else if (IsPairTerm(dest)) {
arity = 2;
destp = RepPair(dest)-1;
} else {
arity = ArityOfFunctor(FunctorOfTerm(dest));
destp = RepAppl(dest);
}
if (pos < 1 || pos > arity)
return FALSE;
to = Deref(ARG3);
to = CopyTermToArena(ARG3, LOCAL_GlobalArena, FALSE, TRUE, 2, &LOCAL_GlobalArena, garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
to = CopyTermToArena(ARG3, LOCAL_GlobalArena, FALSE, TRUE, 3, &LOCAL_GlobalArena, garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
if (to == 0L)
return FALSE;
dest = Deref(ARG2);
if (IsPairTerm(dest)) {
arity = 2;
destp = RepPair(dest)-1;
} else {
arity = ArityOfFunctor(FunctorOfTerm(dest));
destp = RepAppl(dest);
}
destp[pos] = to;
return TRUE;
@ -947,19 +945,21 @@ p_nb_set_shared_arg( USES_REGS1 )
return FALSE;
} else if (IsPrimitiveTerm(dest)) {
arity = 0;
destp = NULL;
} else if (IsPairTerm(dest)) {
arity = 2;
destp = RepPair(dest)-1;
} else {
arity = ArityOfFunctor(FunctorOfTerm(dest));
destp = RepAppl(dest);
}
if (pos < 1 || pos > arity)
return FALSE;
to = CopyTermToArena(ARG3, LOCAL_GlobalArena, TRUE, TRUE, 3, &LOCAL_GlobalArena, garena_overflow_size(ArenaPt(LOCAL_GlobalArena) PASS_REGS) PASS_REGS);
if (to == 0L)
return FALSE;
if (IsPairTerm(dest)) {
destp = RepPair(dest)-1;
} else {
destp = RepAppl(dest);
}
destp[pos] = to;
return TRUE;
}

4
C/heapgc.c
View File

@ -3943,7 +3943,7 @@ do_gc(Int predarity, CELL *current_env, yamop *nextop USES_REGS)
LOCAL_discard_trail_entries = 0;
alloc_sz = (CELL *)LOCAL_TrailTop-(CELL*)LOCAL_GlobalBase;
LOCAL_bp = Yap_PreAllocCodeSpace();
while (LOCAL_bp+alloc_sz > (char *)AuxSp) {
while (IN_BETWEEN(LOCAL_bp, AuxSp, LOCAL_bp+alloc_sz)) {
/* not enough space */
*--ASP = (CELL)current_env;
LOCAL_bp = (char *)Yap_ExpandPreAllocCodeSpace(alloc_sz, NULL, TRUE);
@ -4130,9 +4130,11 @@ call_gc(UInt gc_lim, Int predarity, CELL *current_env, yamop *nextop USES_REGS)
if (ASP - H < gc_margin/sizeof(CELL) ||
effectiveness < 20) {
LeaveGCMode( PASS_REGS1 );
#ifndef YAPOR
if (gc_margin < 2*CalculateStackGap())
gc_margin = 2*CalculateStackGap();
return Yap_growstack(gc_margin);
#endif
}
/*
* debug for(save_total=1; save_total<=N; ++save_total)

71
C/index.c
View File

@ -2529,6 +2529,20 @@ copy_clauses(ClauseDef *max0, ClauseDef *min0, CELL *top, struct intermediates *
}
/* make sure that it is worth it to generate indexing code at that point */
static int
several_tags(ClauseDef *min, ClauseDef *max)
{
CELL tag = min->Tag;
while (min < max) {
min++;
if (!IsAtomOrIntTerm(min->Tag) || min->Tag != tag)
return TRUE;
}
return FALSE;
}
/* execute an index inside a structure */
static UInt
do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermediates *cint, UInt i, UInt arity, UInt argno, UInt fail_l, int first, int last_arg, int clleft, CELL *top, int done_work)
@ -2538,20 +2552,29 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermedi
ClauseDef *min, *max;
PredEntry *ap = cint->CurrentPred;
int found_index = FALSE, lu_pred = ap->PredFlags & LogUpdatePredFlag;
UInt old_last_depth, old_last_depth_size;
newlabp = & ret_lab;
if (min0 == max0) {
/* base case, just commit to the current code */
return emit_single_switch_case(min0, cint, first, clleft, fail_l);
}
if (yap_flags[INDEXING_MODE_FLAG] == INDEX_MODE_SINGLE && ap->PredFlags & LogUpdatePredFlag) {
if ((yap_flags[INDEXING_MODE_FLAG] == INDEX_MODE_SINGLE && ap->PredFlags & LogUpdatePredFlag) ||
(yap_flags[INDEXING_TERM_DEPTH_FLAG] && cint->term_depth - cint->last_index_new_depth > yap_flags[INDEXING_TERM_DEPTH_FLAG])) {
*newlabp =
do_var_clauses(min0, max0, FALSE, cint, first, clleft, fail_l, ap->ArityOfPE+1);
return ret_lab;
return ret_lab;
}
if (sreg == NULL) {
return suspend_indexing(min0, max0, ap, cint);
}
cint->term_depth++;
old_last_depth = cint->last_index_new_depth;
old_last_depth_size = cint->last_depth_size;
if (cint->last_depth_size != max0-min0) {
cint->last_index_new_depth = cint->term_depth;
cint->last_depth_size = max0-min0;
}
while (i < arity && !found_index) {
ClauseDef *cl;
GroupDef *group;
@ -2569,7 +2592,7 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermedi
}
group = (GroupDef *)top;
ngroups = groups_in(min, max, group, cint);
if (ngroups == 1 && group->VarClauses == 0) {
if (ngroups == 1 && group->VarClauses == 0 && (i < 8 || several_tags(min,max))) {
/* ok, we are doing a sub-argument */
/* process group */
@ -2590,6 +2613,9 @@ do_compound_index(ClauseDef *min0, ClauseDef* max0, Term* sreg, struct intermedi
else
*newlabp = suspend_indexing(min0, max0, ap, cint);
}
cint->last_index_new_depth = old_last_depth;
cint->last_depth_size = old_last_depth_size;
cint->term_depth--;
return ret_lab;
}
@ -2815,6 +2841,7 @@ Yap_PredIsIndexable(PredEntry *ap, UInt NSlots, yamop *next_pc)
cint.expand_block = NULL;
cint.label_offset = NULL;
LOCAL_ErrorMessage = NULL;
cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
if (compile_index(&cint) == (UInt)FAILCODE) {
Yap_ReleaseCMem(&cint);
CleanCls(&cint);
@ -3285,6 +3312,29 @@ code_to_indexcl(yamop *ipc, int is_lu)
return ret;
}
/* CALLED by expand when entering sub_arg */
static void
increase_expand_depth(yamop *ipc, struct intermediates *cint)
{
yamop *ncode;
cint->term_depth++;
if (ipc->opc == Yap_opcode(_switch_on_sub_arg_type) &&
(ncode = ipc->u.sllll.l4)->opc == Yap_opcode(_expand_clauses)) {
if (ncode->u.sssllp.s2 != cint->last_depth_size) {
cint->last_index_new_depth = cint->term_depth;
cint->last_depth_size = ncode->u.sssllp.s2;
}
}
}
static void
zero_expand_depth(PredEntry *ap, struct intermediates *cint)
{
cint->term_depth = cint->last_index_new_depth;
cint->last_depth_size = ap->cs.p_code.NOfClauses;
}
static yamop **
expand_index(struct intermediates *cint) {
CACHE_REGS
@ -3317,6 +3367,7 @@ expand_index(struct intermediates *cint) {
cint->i_labelno = 1;
stack[0].pos = 0;
/* try to refine the interval using the indexing code */
cint->term_depth = cint->last_index_new_depth = cint->last_depth_size = 0L;
parentcl = code_to_indexcl(ipc,is_lu);
while (ipc != NULL) {
@ -3486,6 +3537,7 @@ expand_index(struct intermediates *cint) {
break;
/* instructions type e */
case _switch_on_type:
zero_expand_depth(ap, cint);
t = Deref(ARG1);
argno = 1;
i = 0;
@ -3497,9 +3549,11 @@ expand_index(struct intermediates *cint) {
s_reg = RepPair(t);
labp = &(ipc->u.llll.l1);
ipc = ipc->u.llll.l1;
increase_expand_depth(ipc, cint);
} else if (IsApplTerm(t)) {
sp = push_stack(sp, 1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint);
ipc = ipc->u.llll.l3;
increase_expand_depth(ipc, cint);
} else {
sp = push_stack(sp, argno, t, TermNil, cint);
ipc = ipc->u.llll.l2;
@ -3507,6 +3561,7 @@ expand_index(struct intermediates *cint) {
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
break;
case _switch_list_nl:
zero_expand_depth(ap, cint);
t = Deref(ARG1);
argno = 1;
i = 0;
@ -3518,9 +3573,11 @@ expand_index(struct intermediates *cint) {
labp = &(ipc->u.ollll.l1);
sp = push_stack(sp, 1, AbsPair(NULL), TermNil, cint);
ipc = ipc->u.ollll.l1;
increase_expand_depth(ipc, cint);
} else if (t == TermNil) {
sp = push_stack(sp, 1, t, TermNil, cint);
ipc = ipc->u.ollll.l2;
increase_expand_depth(ipc, cint);
} else {
Term tn;
@ -3535,6 +3592,7 @@ expand_index(struct intermediates *cint) {
parentcl = index_jmp(parentcl, parentcl, ipc, is_lu, e_code);
break;
case _switch_on_arg_type:
zero_expand_depth(ap, cint);
argno = arg_from_x(ipc->u.xllll.x);
i = 0;
t = Deref(XREGS[argno]);
@ -3546,9 +3604,11 @@ expand_index(struct intermediates *cint) {
sp = push_stack(sp, argno, AbsPair(NULL), TermNil, cint);
labp = &(ipc->u.xllll.l1);
ipc = ipc->u.xllll.l1;
increase_expand_depth(ipc, cint);
} else if (IsApplTerm(t)) {
sp = push_stack(sp, argno, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint);
ipc = ipc->u.xllll.l3;
increase_expand_depth(ipc, cint);
} else {
sp = push_stack(sp, argno, t, TermNil, cint);
ipc = ipc->u.xllll.l2;
@ -3570,10 +3630,12 @@ expand_index(struct intermediates *cint) {
labp = &(ipc->u.sllll.l1);
ipc = ipc->u.sllll.l1;
i = 0;
increase_expand_depth(ipc, cint);
} else if (IsApplTerm(t)) {
sp = push_stack(sp, -i-1, AbsAppl((CELL *)FunctorOfTerm(t)), TermNil, cint);
ipc = ipc->u.sllll.l3;
i = 0;
increase_expand_depth(ipc, cint);
} else {
/* We don't push stack here, instead we go over to next argument
sp = push_stack(sp, -i-1, t, cint);
@ -5381,6 +5443,7 @@ Yap_AddClauseToIndex(PredEntry *ap, yamop *beg, int first) {
cint.CurrentPred = ap;
cint.expand_block = NULL;
cint.CodeStart = cint.BlobsStart = cint.cpc = cint.icpc = NIL;
cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
if ((cb = sigsetjmp(cint.CompilerBotch, 0)) == 3) {
restore_machine_regs();
Yap_gcl(LOCAL_Error_Size, ap->ArityOfPE, ENV, CP);
@ -5866,6 +5929,7 @@ Yap_RemoveClauseFromIndex(PredEntry *ap, yamop *beg) {
}
LOCAL_Error_Size = 0;
LOCAL_ErrorMessage = NULL;
cint.term_depth = cint.last_index_new_depth = cint.last_depth_size = 0L;
if (cb) {
/* cannot rely on the code */
if (ap->PredFlags & LogUpdatePredFlag) {
@ -6394,6 +6458,7 @@ Yap_FollowIndexingCode(PredEntry *ap, yamop *ipc, Term Terms[3], yamop *ap_pc, y
unbounded = FALSE;
SET_JLBL(sllll.l1);
S = s_reg = RepPair(t);
ipc = ipc->u.sllll.l1;
} else if (IsAtomOrIntTerm(t)) {
SET_JLBL(sllll.l2);
ipc = ipc->u.sllll.l2;

6
C/init.c
View File

@ -654,7 +654,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
p_code->opc = Yap_opcode(_allocate);
p_code = NEXTOP(p_code,e);
}
p_code->opc = pe->OpcodeOfPred = Yap_opcode(_call_cpred);
p_code->opc = Yap_opcode(_call_cpred);
p_code->u.Osbpp.bmap = NULL;
p_code->u.Osbpp.s = -Signed(RealEnvSize);
p_code->u.Osbpp.p = p_code->u.Osbpp.p0 = pe;
@ -669,6 +669,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
p_code = NEXTOP(p_code,p);
p_code->opc = Yap_opcode(_Ystop);
p_code->u.l.l = cl->ClCode;
pe->OpcodeOfPred = pe->CodeOfPred->opc;
} else {
pe->OpcodeOfPred = Yap_opcode(_undef_p);
pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
@ -914,6 +915,7 @@ InitFlags(void)
yap_flags[INDEXING_MODE_FLAG] = INDEX_MODE_MULTI;
yap_flags[TABLING_MODE_FLAG] = 0;
yap_flags[QUIET_MODE_FLAG] = FALSE;
yap_flags[INDEXING_TERM_DEPTH_FLAG] = 0L;
}
static void
@ -1315,7 +1317,7 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
Yap_InitTime();
/* InitAbsmi must be done before InitCodes */
/* This must be done before initialising predicates */
for (i = 0; i <= LAST_FLAG; i++) {
for (i = 0; i <= NUMBER_OF_YAP_FLAGS; i++) {
yap_flags[i] = 0;
}
#ifdef MPW

5
C/iopreds.c
View File

@ -383,8 +383,9 @@ GenerateSyntaxError(Term *tp, TokEntry *tokstart, IOSTREAM *sno USES_REGS)
if (tp) {
Term et[2];
Term t = MkVarTerm();
et[0] = syntax_error(tokstart, sno, &t);
et[1] = MkAtomTerm(Yap_LookupAtom("Syntax error"));
et[1] = MkPairTerm(syntax_error(tokstart, sno, &t), TermNil);
t = MkAtomTerm(AtomSyntaxError);
et[0] = Yap_MkApplTerm(FunctorShortSyntaxError,1,&t);
*tp = Yap_MkApplTerm(FunctorError, 2, et);
}
}

7
C/load_dl.c Normal file → Executable file
View File

@ -34,14 +34,17 @@ Yap_CallFunctionByName(const char *thing_string);
int
Yap_CallFunctionByName(const char *thing_string)
{
void * handle = dlopen(NULL, RTLD_LAZY | RTLD_NOLOAD);
void * handle = dlopen(NULL, RTLD_LAZY
#ifndef __CYGWIN__
| RTLD_NOLOAD
#endif
);
// you could do RTLD_NOW as well. shouldn't matter
if (!handle) {
CACHE_REGS
Yap_Error(SYSTEM_ERROR, ARG1, "Dynamic linking on main module : %s\n", dlerror());
}
prismf * addr = (prismf *)dlsym(handle, thing_string);
fprintf(stderr, "%s is at %p\n", thing_string, addr);
if (addr)
(*addr)();
return TRUE;

4
C/load_foreign.c
View File

@ -90,7 +90,7 @@ p_load_foreign( USES_REGS1 )
ForeignObj *f_code = (ForeignObj *)Yap_AllocCodeSpace(sizeof(ForeignObj));
f_code->objs = ofiles;
f_code->libs = libs;
f_code->f = InitProcName;
f_code->f = AtomOfTerm(t1);
f_code->next = ForeignCodeLoaded;
f_code->module = CurrentModule;
ForeignCodeLoaded = f_code;
@ -248,7 +248,7 @@ Yap_ReOpenLoadForeign(void)
YapInitProc InitProc = NULL;
CurrentModule = f_code->module;
if(Yap_ReLoadForeign(f_code->objs,f_code->libs,f_code->f,&InitProc)==LOAD_SUCCEEDED) {
if(Yap_ReLoadForeign(f_code->objs,f_code->libs,RepAtom(f_code->f)->StrOfAE,&InitProc)==LOAD_SUCCEEDED) {
if (InitProc)
(*InitProc)();
}

19
C/pl-yap.c Normal file → Executable file
View File

@ -549,8 +549,11 @@ X_API int PL_handle_signals(void)
GET_LD
if ( !LD || LD->critical || !LD->signal.pending )
return 0;
fprintf(stderr,"PL_handle_signals not implemented\n");
return 0;
if (LD->signal.pending == 2) {
Yap_Error(PURE_ABORT, TermNil, "abort from console");
}
// fprintf(stderr,"PL_handle_signals not implemented\n");
return 1;
}
void
@ -572,12 +575,10 @@ int
currentOperator(Module m, atom_t name, int kind, int *type, int *priority)
{
YAP_Term mod = (YAP_Term)m;
YAP_Atom at;
int opkind, yap_type;
if (!m)
mod = YAP_CurrentModule();
at = YAP_AtomFromSWIAtom(name);
switch (kind) {
case OP_PREFIX:
opkind = 2;
@ -887,7 +888,7 @@ warning(const char *fm, ...)
return TRUE;
}
#if defined(HAVE_SELECT) && !defined(__WINDOWS__)
#if defined(HAVE_SELECT) && !defined(__WINDOWS__) && !defined(__CYGWIN__)
#ifdef __WINDOWS__
#include <winsock2.h>
@ -1046,12 +1047,14 @@ PL_w32thread_raise(DWORD id, int sig)
X_API int
PL_raise(int sig)
{
if (sig == SIG_PLABORT) {
if (sig < SIG_PROLOG_OFFSET) {
Yap_signal(YAP_INT_SIGNAL);
return 1;
} else if (sig == SIG_PLABORT) {
YAP_signal(0x40); /* YAP_INT_SIGNAL */
return 1;
} else {
return 0;
}
return 0;
}
extern size_t PL_utf8_strlen(const char *s, size_t len);

12
C/qlyr.c
View File

@ -253,7 +253,7 @@ InsertOPCODE(OPCODE op0, int i, OPCODE op)
}
static DBRef
LookupDBRef(DBRef dbr)
LookupDBRef(DBRef dbr, int inc_ref)
{
CACHE_REGS
CELL hash = (CELL)(dbr) % LOCAL_ImportDBRefHashTableSize;
@ -262,7 +262,9 @@ LookupDBRef(DBRef dbr)
p = LOCAL_ImportDBRefHashChain[hash];
while (p) {
if (p->oval == dbr) {
p->count++;
if (inc_ref) {
p->count++;
}
return p->val;
}
p = p->next;
@ -528,11 +530,11 @@ CellPtoHeapAdjust__ (CELL * dbtp USES_REGS)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)
#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS)
#define DBRefAdjust(P, Ref) DBRefAdjust__(P, Ref PASS_REGS)
static inline DBRef
DBRefAdjust__ (DBRef dbtp USES_REGS)
DBRefAdjust__ (DBRef dbtp, int do_reference USES_REGS)
{
return LookupDBRef(dbtp);
return LookupDBRef(dbtp, do_reference);
}
#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)

5
C/qlyw.c
View File

@ -300,7 +300,7 @@ PtoPredAdjust(PredEntry *pe)
#define DelayAdjust(P) (P)
#define GlobalAdjust(P) (P)
#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS)
#define DBRefAdjust(P,DoRef) DBRefAdjust__(P PASS_REGS)
static inline DBRef
DBRefAdjust__ (DBRef dbt USES_REGS)
{
@ -742,6 +742,9 @@ p_save_program( USES_REGS1 )
if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
return FALSE;
}
if (!(stream = Yap_GetOutputStream(AtomOfTerm(t1))) ) {
return FALSE;
}
return save_program(stream) != 0;
}

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

@ -1447,9 +1447,6 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
save_buffer[0] = '\0';
// LOCAL_ErrorMessage = NULL;
if (inpf == NULL) {
#if _MSC_VER || defined(__MINGW32__)
if (!(inpf = Yap_RegistryGetString("startup")))
#endif
inpf = StartUpFile;
}
/* careful it starts from the root */
@ -1510,6 +1507,13 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
}
}
#if _MSC_VER || defined(__MINGW32__)
if ((inpf = Yap_RegistryGetString("startup"))) {
if ((splfild = open_file(inpf, O_RDONLY)) > 0) {
if ((mode = try_open(inpf,Astate,ATrail,AStack,AHeap,save_buffer,streamp)) != FAIL_RESTORE) {
return mode;
}
}
}
{
DWORD fatts;
int buflen;
@ -1525,7 +1529,7 @@ OpenRestore(char *inpf, char *YapLibDir, CELL *Astate, CELL *ATrail, CELL *AStac
goto end;
}
buflen = strlen(LOCAL_FileNameBuf);
pt = LOCAL_FileNameBuf+strlen(LOCAL_FileNameBuf);
pt = LOCAL_FileNameBuf+buflen;
while (*--pt != '\\') {
/* skip executable */
if (pt == LOCAL_FileNameBuf) {

77
C/stdpreds.c
View File

@ -1530,7 +1530,6 @@ p_atom_concat( USES_REGS1 )
{
Term t1;
int wide_mode = FALSE;
UInt sz;
restart:
t1 = Deref(ARG1);
@ -1543,8 +1542,9 @@ p_atom_concat( USES_REGS1 )
if (wide_mode) {
wchar_t *cptr = (wchar_t *)(((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE), *cpt0;
wchar_t *top = (wchar_t *)AuxSp;
char *atom_str;
unsigned char *atom_str;
Atom ahead;
UInt sz;
cpt0 = cptr;
while (IsPairTerm(t1)) {
@ -1560,26 +1560,29 @@ p_atom_concat( USES_REGS1 )
return(FALSE);
}
ahead = AtomOfTerm(thead);
atom_str = RepAtom(ahead)->StrOfAE;
if (IsWideAtom(ahead)) {
/* check for overflows */
sz = wcslen((wchar_t *)atom_str);
sz = wcslen(RepAtom(ahead)->WStrOfAE);
} else {
sz = strlen(atom_str);
atom_str = (unsigned char *)RepAtom(ahead)->StrOfAE;
sz = strlen((char *)atom_str);
}
if (cptr+sz >= top-1024) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
if (cptr+sz > top+1024) {
cptr = (wchar_t *)Yap_ExpandPreAllocCodeSpace(sz+1024,NULL, TRUE);
if (cptr+sz > (wchar_t *)AuxSp+1024) {
/* crash in flames */
Yap_Error(OUT_OF_AUXSPACE_ERROR, ARG1, "allocating temp space in atom_concat/2");
return FALSE;
}
top = (wchar_t *)AuxSp;
goto restart;
}
if (IsWideAtom(ahead)) {
memcpy((void *)cptr, (void *)atom_str, sz*sizeof(wchar_t));
memcpy((void *)cptr, RepAtom(ahead)->WStrOfAE, sz*sizeof(wchar_t));
cptr += sz;
} else {
int i;
UInt i;
for (i=0; i < sz; i++) {
*cptr++ = *atom_str++;
}
@ -1607,7 +1610,8 @@ p_atom_concat( USES_REGS1 )
} else {
char *cptr = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE, *cpt0;
char *top = (char *)AuxSp;
char *atom_str;
unsigned char *atom_str;
UInt sz;
cpt0 = cptr;
while (IsPairTerm(t1)) {
@ -1627,9 +1631,9 @@ p_atom_concat( USES_REGS1 )
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
goto restart;
}
atom_str = RepAtom(AtomOfTerm(thead))->StrOfAE;
atom_str = (unsigned char *)RepAtom(AtomOfTerm(thead))->StrOfAE;
/* check for overflows */
sz = strlen(atom_str);
sz = strlen((char *)atom_str);
if (cptr+sz >= top-1024) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
@ -1725,9 +1729,9 @@ p_atomic_concat( USES_REGS1 )
memcpy((void *)wcptr, (void *)watom_str, sz*sizeof(wchar_t));
wcptr += sz;
} else {
char *atom_str = RepAtom(AtomOfTerm(thead))->StrOfAE;
unsigned char *atom_str = (unsigned char *)RepAtom(AtomOfTerm(thead))->StrOfAE;
/* check for overflows */
UInt sz = strlen(atom_str);
UInt sz = strlen((char *)atom_str);
if (wcptr+sz >= wtop-1024) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
@ -1823,7 +1827,7 @@ p_atomic_concat( USES_REGS1 )
return(FALSE);
}
if (IsAtomTerm(thead)) {
char *atom_str;
unsigned char *atom_str;
UInt sz;
if (IsWideAtom(AtomOfTerm(thead))) {
@ -1831,9 +1835,9 @@ p_atomic_concat( USES_REGS1 )
wide_mode = TRUE;
goto restart;
}
atom_str = RepAtom(AtomOfTerm(thead))->StrOfAE;
atom_str = (unsigned char *)RepAtom(AtomOfTerm(thead))->StrOfAE;
/* check for overflows */
sz = strlen(atom_str);
sz = strlen((char *)atom_str);
if (cptr+sz >= top-1024) {
Yap_ReleasePreAllocCodeSpace((ADDR)cpt0);
if (!Yap_growheap(FALSE, sz+1024, NULL)) {
@ -3222,26 +3226,51 @@ cont_current_predicate_for_atom( USES_REGS1 )
while (pf != NIL) {
FunctorEntry *pp = RepFunctorProp(pf);
if (IsFunctorProperty(pp->KindOfPE)) {
Prop p0 = pp->PropsOfFE;
while (p0) {
Prop p0;
READ_LOCK(pp->FRWLock);
p0 = pp->PropsOfFE;
if (p0) {
PredEntry *p = RepPredProp(p0);
if (p->ModuleOfPred == mod ||
p->ModuleOfPred == 0) {
UInt ar = p->ArityOfPE;
/* we found the predicate */
EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)(pp->NextOfPE));
READ_UNLOCK(pp->FRWLock);
return
Yap_unify(ARG3,Yap_MkNewApplTerm(p->FunctorOfPred,p->ArityOfPE));
Yap_unify(ARG3,MkIntegerTerm(ar));
} else if (p->NextOfPE) {
UInt hash = PRED_HASH(pp,mod,PredHashTableSize);
READ_LOCK(PredHashRWLock);
PredEntry *p = PredHash[hash];
while (p) {
if (p->FunctorOfPred == pp &&
p->ModuleOfPred == mod)
{
READ_UNLOCK(PredHashRWLock);
READ_UNLOCK(pp->FRWLock);
/* we found the predicate */
EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)(p->NextOfPE));
return Yap_unify(ARG3,MkIntegerTerm(p->ArityOfPE));
}
p = RepPredProp(p->NextOfPE);
}
READ_UNLOCK(PredHashRWLock);
}
p0 = p->NextOfPE;
}
READ_UNLOCK(pp->FRWLock);
} else if (pp->KindOfPE == PEProp) {
PredEntry *pe = RepPredProp(pf);
READ_LOCK(pp->FRWLock);
if (pe->ModuleOfPred == mod ||
pe->ModuleOfPred == 0) {
/* we found the predicate */
EXTRA_CBACK_ARG(3,1) = MkIntegerTerm((Int)(pp->NextOfPE));
return Yap_unify(ARG3,MkAtomTerm((Atom)(pe->FunctorOfPred)));
READ_UNLOCK(pp->FRWLock);
return Yap_unify(ARG3,MkIntTerm(0));
}
READ_UNLOCK(pp->FRWLock);
}
pf = pp->NextOfPE;
}

11
C/sysbits.c Normal file → Executable file
View File

@ -81,7 +81,8 @@ static char SccsId[] = "%W% %G%";
#include <sys/param.h>
#endif
#endif
#if HAVE_FENV_H
/* CYGWIN seems to include this automatically */
#if HAVE_FENV_H && !defined(__CYGWIN__)
#include <fenv.h>
#endif
#if HAVE_READLINE_READLINE_H
@ -216,7 +217,7 @@ Yap_InitSysPath(void) {
return;
}
buflen = strlen(LOCAL_FileNameBuf);
pt = LOCAL_FileNameBuf+strlen(LOCAL_FileNameBuf);
pt = LOCAL_FileNameBuf+buflen;
while (*--pt != '\\') {
/* skip executable */
if (pt == LOCAL_FileNameBuf) {
@ -3184,9 +3185,15 @@ Yap_RegistryGetString(char *name)
char *ptr;
int i;
#if SIZEOF_INT_P == 8
if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog64", FALSE)) ) {
return NULL;
}
#else
if ( !(key=reg_open_key(L"HKEY_LOCAL_MACHINE/SOFTWARE/YAP/Prolog", FALSE)) ) {
return NULL;
}
#endif
if ( RegQueryValueEx(key, name, NULL, &type, data, &len) == ERROR_SUCCESS ) {
RegCloseKey(key);
switch(type) {

23
C/threads.c
View File

@ -187,10 +187,30 @@ thread_die(int wid, int always_die)
tab_ent = TabEnt_next(tab_ent);
}
FREE_DEPENDENCY_FRAME(LOCAL_top_dep_fr);
#endif /* TABLING */
LOCAL_top_dep_fr = NULL;
#ifdef USE_PAGES_MALLOC
DETACH_PAGES(_pages_void);
#endif /* USE_PAGES_MALLOC */
DETACH_PAGES(_pages_tab_ent);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
DETACH_PAGES(_pages_sg_ent);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
DETACH_PAGES(_pages_sg_fr);
DETACH_PAGES(_pages_dep_fr);
DETACH_PAGES(_pages_sg_node);
DETACH_PAGES(_pages_sg_hash);
DETACH_PAGES(_pages_ans_node);
DETACH_PAGES(_pages_ans_hash);
#if defined(THREADS_FULL_SHARING)
DETACH_PAGES(_pages_ans_ref_node);
#endif /* THREADS_FULL_SHARING */
DETACH_PAGES(_pages_gt_node);
DETACH_PAGES(_pages_gt_hash);
#ifdef OUTPUT_THREADS_TABLING
fclose(LOCAL_thread_output);
#endif /* OUTPUT_THREADS_TABLING */
#endif /* TABLING */
GLOBAL_NOfThreads--;
if (!always_die) {
/* called by thread itself */
GLOBAL_ThreadsTotalTime += Yap_cputime();
@ -222,6 +242,7 @@ setup_engine(int myworker_id, int init_thread)
Yap_ReleasePreAllocCodeSpace(Yap_PreAllocCodeSpace());
/* I exist */
GLOBAL_NOfThreadsCreated++;
GLOBAL_NOfThreads++;
DEBUG_TLOCK_ACCESS(2, myworker_id);
pthread_mutex_unlock(&(REMOTE_ThreadHandle(myworker_id).tlock));
#ifdef TABLING

1
C/tracer.c
View File

@ -32,6 +32,7 @@ static void
send_tracer_message(char *start, char *name, Int arity, char *mname, CELL *args)
{
CACHE_REGS
fprintf(GLOBAL_stderr, "(%p) ", B);
if (name == NULL) {
#ifdef YAPOR
fprintf(GLOBAL_stderr, "(%d)%s", worker_id, start);

7
C/udi.c
View File

@ -148,6 +148,13 @@ Yap_udi_search(PredEntry *p)
return info->functions->search(info->cb);
}
/* index, called from absmi.c */
void
Yap_udi_abolish(PredEntry *p)
{
/* tell the predicate destroy */
}
void
Yap_udi_init(void)
{

333
C/utilpreds.c
View File

@ -18,11 +18,9 @@
static char SccsId[] = "@(#)utilpreds.c 1.3";
#endif
#include "Yap.h"
#include "clause.h"
#include "absmi.h"
#include "YapHeap.h"
#include "yapio.h"
#include "eval.h"
#include "attvar.h"
#ifdef HAVE_STRING_H
#include "string.h"
@ -1168,8 +1166,16 @@ CELL *CellDifH(CELL *hptr, CELL *hlow)
return (CELL *)((char *)hptr-(char *)hlow);
}
#define AdjustSizeAtom(X) ((char *)(((CELL)(X)+(8-1)) & ~(8-1)))
#define AdjustSizeAtom(X) (((CELL)(X)+(8-1)) & ~(8-1))
static inline
CELL *AdjustSize(CELL *x, char *buf)
{
UInt offset = (char *)x-buf;
return (CELL*)(buf+AdjustSizeAtom(offset));
}
/* export an atom from the symbol table to a buffer */
static inline
Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
{
@ -1177,7 +1183,7 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
size_t sz;
ptr = *hpp;
ptr = AdjustSizeAtom(ptr);
ptr = (char *)AdjustSize((CELL*)ptr, buf);
p0 = ptr;
if (IsWideAtom(at)) {
@ -1191,7 +1197,7 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
} else {
*ptr++ = 0;
sz = strlen(RepAtom(at)->StrOfAE);
if (sz +1 >= len)
if (sz + 1 + sizeof(wchar_t) >= len)
return (Atom)NULL;
strcpy(ptr, RepAtom(at)->StrOfAE);
*hpp = ptr+(sz+1);
@ -1200,10 +1206,11 @@ Atom export_atom(Atom at, char **hpp, char *buf, size_t len)
return (Atom)(p0-buf);
}
/* place a buffer: first arity then the atom */
static inline
Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
{
CELL *hptr = (UInt *)AdjustSizeAtom(*hpp);
CELL *hptr = AdjustSize((CELL *)*hpp, buf);
UInt arity = ArityOfFunctor(f);
if (2*sizeof(CELL) >= len)
return NULL;
@ -1211,7 +1218,9 @@ Functor export_functor(Functor f, char **hpp, char *buf, size_t len)
*hpp = (char *)(hptr+1);
if (!export_atom(NameOfFunctor(f), hpp, buf, len))
return NULL;
/* increment so that it cannot be mistaken with a standard functor */
/* increment so that it cannot be mistaken with a functor on the stack,
(increment is used as a tag ........01
*/
return (Functor)(((char *)hptr-buf)+1);
}
@ -1230,9 +1239,10 @@ export_term_to_buffer(Term inpt, char *buf, char *bptr, CELL *t0 , CELL *tf, siz
{
char *td = bptr;
CELL *bf = (CELL *)buf;
if (buf + len < (char *)((CELL *)td + (tf-t0)))
if (buf + len < (char *)((CELL *)td + (tf-t0))) {
return FALSE;
memcpy((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
}
memcpy((void *)td, (void *)t0, (tf-t0)* sizeof(CELL));
bf[0] = (td-buf);
bf[1] = (tf-t0);
bf[2] = inpt;
@ -1543,6 +1553,7 @@ static Atom
AddAtom(Atom t, char *buf)
{
char *s = buf+(UInt)t;
if (!*s) {
return Yap_LookupAtom(s+1);
} else {
@ -1559,7 +1570,7 @@ FetchFunctor(CELL *pt, char *buf)
UInt arity = *ptr++;
Atom name, at;
// and then an atom
ptr = (CELL *)AdjustSizeAtom((char*)ptr);
ptr = AdjustSize(ptr, buf);
name = (Atom)((char *)ptr-buf);
at = AddAtom(name, buf);
*pt = (CELL)Yap_MkFunctor(at, arity);
@ -1629,7 +1640,7 @@ Yap_ImportTerm(char * buf) {
return MkVarTerm();
if (IsAtomOrIntTerm(tinp)) {
if (IsAtomTerm(tinp)) {
char *pt = AdjustSizeAtom((char *)(bc+3));
char *pt = (char *)AdjustSize(bc+3, buf);
return MkAtomTerm(Yap_LookupAtom(pt));
} else
return tinp;
@ -4191,6 +4202,298 @@ p_subsumes( USES_REGS1 ) /* subsumes terms t1 and t2 */
}
}
static int term_subsumer_complex(register CELL *pt0, register CELL *pt0_end, register
CELL *pt1, CELL *npt USES_REGS)
{
register CELL **to_visit = (CELL **)ASP;
tr_fr_ptr OLDTR = TR;
int out;
CELL *bindings = NULL, *tbindings = NULL;
HB = H;
loop:
while (pt0 < pt0_end) {
register CELL d0, d1;
++ pt0;
++ pt1;
d0 = Derefa(pt0);
d1 = Derefa(pt1);
if (d0 == d1) {
*npt++ = d0;
continue;
} else if (IsVarTerm(d0)) {
CELL *match, *omatch = NULL;
match = VarOfTerm(d0);
if (match >= HB) {
while (match >= HB) {
/* chained to a sequence */
if (Yap_eq(d1, match[1]) ) {
*npt++ = match[2];
break;
}
omatch = match;
match = (CELL *)match[3];
}
/* found a match */
if (match >= HB)
continue;
/* could not find a match, add to end of chain */
RESET_VARIABLE(H); /* key */
H[1] = d1; /* comparison value */
H[2] = (CELL)npt; /* new value */
H[3] = (CELL)match; /* end of chain points back to first cell */
omatch[3] = (CELL)H;
H+=4;
RESET_VARIABLE(npt);
npt++;
continue;
}
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
goto trail_overflow;
}
RESET_VARIABLE(H);
H[1] = d1;
H[2] = (CELL)npt;
H[3] = d0;
Bind(VarOfTerm(d0), (CELL)H);
H+=4;
RESET_VARIABLE(npt);
npt++;
continue;
} else if (IsPairTerm(d0) && IsPairTerm(d1)) {
CELL *match = bindings;
while (match) {
if (match[0] == d0 && match[1] == d1) {
*npt++ = match[2];
break;
}
match = (CELL *)match[3];
}
if (match) {
continue;
}
if (bindings) {
*tbindings = (CELL)H;
} else {
bindings = H;
}
H[0] = d0;
H[1] = d1;
H[2] = AbsPair(H+4);
H[3] = (CELL)NULL;
tbindings = H+3;
H+=4;
*npt++ = AbsPair(H);
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 5;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = tbindings;
to_visit[4] = npt;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit -= 4;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = npt;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
npt = H;
H += 2;
if (H > (CELL *)to_visit -1024)
goto stack_overflow;
continue;
} else if (IsApplTerm(d0) && IsApplTerm(d1)) {
CELL *ap2 = RepAppl(d0);
CELL *ap3 = RepAppl(d1);
Functor f = (Functor)(*ap2);
Functor f2 = (Functor)(*ap3);
if (f == f2) {
CELL *match = bindings;
if (IsExtensionFunctor(f)) {
if (unify_extension(f, d0, ap2, d1)) {
*npt++ = d0;
continue;
}
}
while (match) {
if (match[0] == d0 && match[1] == d1) {
*npt++ = match[2];
break;
}
match = (CELL *)match[3];
}
if (match) {
continue;
}
if (bindings) {
*tbindings = (CELL)H;
} else {
bindings = H;
}
H[0] = d0;
H[1] = d1;
H[2] = AbsAppl(H+4);
H[3] = (CELL)NULL;
tbindings = H+3;
H+=4;
*npt++ = AbsAppl(H);
#ifdef RATIONAL_TREES
/* now link the two structures so that no one else will */
/* come here */
to_visit -= 5;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = tbindings;
to_visit[4] = npt;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit -= 4;
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = npt;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
npt = H;
*npt++ = (CELL)f;
H += d0;
if (H > (CELL *)to_visit -1024)
goto stack_overflow;
continue;
}
}
RESET_VARIABLE(npt);
npt++;
}
/* Do we still have compound terms to visit */
if (to_visit < (CELL **)ASP) {
#ifdef RATIONAL_TREES
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
tbindings = to_visit[3];
npt = to_visit[ 4];
if (!tbindings) {
bindings = NULL;
}
to_visit += 5;
#else
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
npt = to_visit[3];
to_visit += 4;
#endif
goto loop;
}
out = 1;
complete:
/* get rid of intermediate variables */
while (TR != OLDTR) {
CELL *pt1 = (CELL *) TrailTerm(--TR);
RESET_VARIABLE(pt1);
}
HBREG = B->cp_h;
return out;
stack_overflow:
out = -1;
goto complete;
trail_overflow:
out = -2;
goto complete;
}
static Int
p_term_subsumer( USES_REGS1 ) /* term_subsumer terms t1 and t2 */
{
int out = 0;
while (out != 1) {
Term t1 = Deref(ARG1);
Term t2 = Deref(ARG2);
CELL *oldH = H;
if (t1 == t2)
return Yap_unify(ARG3,t1);
if (IsPairTerm(t1) && IsPairTerm(t2)) {
Term tf = AbsAppl(H);
H += 2;
HB = H;
if ((out = term_subsumer_complex(RepPair(t1)-1,
RepPair(t1)+1,
RepPair(t2)-1, H-2 PASS_REGS)) > 0) {
HB = B->cp_h;
return Yap_unify(ARG3,tf);
}
} else if (IsApplTerm(t1) && IsApplTerm(t2)) {
Functor f1;
if ((f1 = FunctorOfTerm(t1)) == FunctorOfTerm(t2)) {
if (IsExtensionFunctor(f1)) {
if (unify_extension(f1, t1, RepAppl(t1), t2)) {
return Yap_unify(ARG3,t1);
}
} else {
Term tf = AbsAppl(H);
UInt ar = ArityOfFunctor(f1);
H[0] = (CELL)f1;
H += 1+ar;
HB = H;
if ((out = term_subsumer_complex(RepAppl(t1),
RepAppl(t1)+ArityOfFunctor(f1),
RepAppl(t2), H-ar PASS_REGS)) > 0) {
HB = B->cp_h;
return Yap_unify(ARG3,tf);
}
}
}
}
HB = B->cp_h;
if (out == 0) {
return Yap_unify(ARG3, MkVarTerm());
} else {
H = oldH;
if (out == -1) {
if (!Yap_gcl((ASP-H)*sizeof(CELL), 0, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, "in term_subsumer");
return FALSE;
}
} else {
/* Trail overflow */
if (!Yap_growtrail(0, FALSE)) {
Yap_Error(OUT_OF_TRAIL_ERROR, TermNil, "in term_subsumer");
return FALSE;
}
}
}
}
return FALSE;
}
#ifdef DEBUG
static Int
p_force_trail_expansion( USES_REGS1 )
@ -4370,6 +4673,10 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
goto trail_overflow;
}
}
#if defined(TABLING) || defined(YAPOR_SBA)
TrailVal(TR) = (CELL)ptd0;
#endif
TrailTerm(TR++) = (CELL)ptd0;
}
/* Do we still have compound terms to visit */
@ -4387,6 +4694,7 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
goto loop;
}
prune(B);
Yap_ReleasePreAllocCodeSpace((ADDR)to_visit0);
return numbv;
@ -4872,6 +5180,7 @@ void Yap_InitUtilCPreds(void)
Yap_InitCPred("instantiated_term_hash", 4, p_instantiated_term_hash, 0);
Yap_InitCPred("variant", 2, p_variant, 0);
Yap_InitCPred("subsumes", 2, p_subsumes, 0);
Yap_InitCPred("term_subsumer", 3, p_term_subsumer, 0);
Yap_InitCPred("variables_within_term", 3, p_variables_within_term, 0);
Yap_InitCPred("new_variables_in_term", 3, p_new_variables_in_term, 0);
Yap_InitCPred("export_term", 3, p_export_term, 0);

2
C/write.c
View File

@ -713,7 +713,7 @@ write_var(CELL *t, struct write_globs *wglb, struct rewind_term *rwt)
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
l = restore_from_write(&nrwt, wglb);
wrputc(',', wglb->stream);
l += 2;
l ++;
writeTerm(from_pointer(l, &nrwt, wglb), 999, 1, FALSE, wglb, &nrwt);
restore_from_write(&nrwt, wglb);
wrclose_bracket(wglb, TRUE);

552
C/yap-args.c Executable file
View File

@ -0,0 +1,552 @@
/*************************************************************************
* *
* Yap Prolog *
* *
* Yap Prolog Was Developed At Nccup - Universidade Do Porto *
* *
* Copyright L.Damas, V.S.Costa And Universidade Do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: Yap.C *
* Last Rev: *
* Mods: *
* Comments: Yap's Main File: parse arguments *
* *
*************************************************************************/
/* static char SccsId[] = "X 4.3.3"; */
#include "config.h"
#include "YapInterface.h"
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
#endif
#endif
#include <stdlib.h>
#include <stdio.h>
#if HAVE_STRING_H
#include <string.h>
#endif
#if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace
#define DefTrailSpace MinTrailSpace
#endif
#if (DefStackSpace < MinStackSpace)
#undef DefStackSpace
#define DefStackSpace MinStackSpace
#endif
#if (DefHeapSpace < MinHeapSpace)
#undef DefHeapSpace
#define DefHeapSpace MinHeapSpace
#endif
#define DEFAULT_NUMBERWORKERS 1
#define DEFAULT_SCHEDULERLOOP 10
#define DEFAULT_DELAYEDRELEASELOAD 3
static void
print_usage(void)
{
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr," -? Shows this screen\n");
fprintf(stderr," -b Boot file \n");
fprintf(stderr," -dump-runtime-variables\n");
fprintf(stderr," -f initialization file or \"none\"\n");
fprintf(stderr," -g Run Goal Before Top-Level \n");
fprintf(stderr," -z Run Goal Before Top-Level \n");
fprintf(stderr," -q start with informational messages off\n");
fprintf(stderr," -l load Prolog file\n");
fprintf(stderr," -L run Prolog file and exit\n");
fprintf(stderr," -p extra path for file-search-path\n");
fprintf(stderr," -hSize Heap area in Kbytes (default: %d, minimum: %d)\n",
DefHeapSpace, MinHeapSpace);
fprintf(stderr," -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
DefStackSpace, MinStackSpace);
fprintf(stderr," -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
DefTrailSpace, MinTrailSpace);
fprintf(stderr," -GSize Max Area for Global Stack\n");
fprintf(stderr," -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr," -TSize Max Area for Trail (number must follow L)\n");
fprintf(stderr,"\n[Execution Modes]\n");
fprintf(stderr," -J0 Interpreted mode (default)\n");
fprintf(stderr," -J1 Mixed mode only for user predicates\n");
fprintf(stderr," -J2 Mixed mode for all predicates\n");
fprintf(stderr," -J3 Compile all user predicates\n");
fprintf(stderr," -J4 Compile all predicates\n");
#ifdef TABLING
fprintf(stderr," -ts Maximum table space area in Mbytes (default: unlimited)\n");
#endif /* TABLING */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
fprintf(stderr," -w Number of workers (default: %d)\n",
DEFAULT_NUMBERWORKERS);
fprintf(stderr," -sl Loop scheduler executions before look for hiden shared work (default: %d)\n",
DEFAULT_SCHEDULERLOOP);
fprintf(stderr," -d Value of delayed release of load (default: %d)\n",
DEFAULT_DELAYEDRELEASELOAD);
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
/* nf: Preprocessor */
/* fprintf(stderr," -DVar=Name Persistent definition\n"); */
fprintf(stderr,"\n");
}
static int
myisblank(int c)
{
switch (c) {
case ' ':
case '\t':
case '\n':
case '\r':
return TRUE;
default:
return FALSE;
}
}
static char *
add_end_dot(char arg[])
{
int sz = strlen(arg), i;
i = sz;
while (i && myisblank(arg[--i]));
if (i && arg[i] != ',') {
char *p = (char *)malloc(sz+2);
if (!p)
return NULL;
strncpy(p,arg,sz);
p[sz] = '.';
p[sz+1] = '\0';
return p;
}
return arg;
}
static int
dump_runtime_variables(void)
{
fprintf(stdout,"CC=\"%s\"\n",YAP_CC);
fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR);
fprintf(stdout,"YAP_LIBS=\"%s\"\n",YAP_LIBS);
fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",YAP_SHLIB_SUFFIX);
fprintf(stdout,"YAP_VERSION=%d\n",YAP_VERSION);
exit(0);
return 1;
}
/*
* proccess command line arguments: valid switches are: -b boot -s
* stack area size (K) -h heap area size -a aux stack size -e
* emacs_mode -m -DVar=Value reserved memory for alloc IF DEBUG -p if you
* want to check out startup IF MAC -mpw if we are using the mpw
* shell
*/
X_API int
YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{
char *p;
#ifdef USE_SYSTEM_MALLOC
int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
#else
int BootMode = YAP_BOOT_FROM_SAVED_CODE;
#endif
#ifdef MYDDAS_MYSQL
char *myddas_temp;
#endif
unsigned long int *ssize;
iap->SavedState = NULL;
iap->HeapSize = 0;
iap->StackSize = 0;
iap->TrailSize = 0;
iap->AttsSize = 0;
iap->MaxAttsSize = 0;
iap->MaxHeapSize = 0;
iap->MaxStackSize = 0;
iap->MaxGlobalSize = 0;
iap->MaxTrailSize = 0;
iap->YapLibDir = NULL;
iap->YapPrologBootFile = NULL;
iap->YapPrologInitFile = NULL;
iap->YapPrologRCFile = NULL;
iap->YapPrologGoal = NULL;
iap->YapPrologTopLevelGoal = NULL;
iap->YapPrologAddPath = NULL;
iap->HaltAfterConsult = FALSE;
iap->FastBoot = FALSE;
iap->MaxTableSpaceSize = 0;
iap->NumberWorkers = DEFAULT_NUMBERWORKERS;
iap->SchedulerLoop = DEFAULT_SCHEDULERLOOP;
iap->DelayedReleaseLoad = DEFAULT_DELAYEDRELEASELOAD;
iap->PrologShouldHandleInterrupts = TRUE;
iap->ExecutionMode = YAPC_INTERPRETED;
iap->Argc = argc;
iap->Argv = argv;
iap->def_c = 0;
#ifdef MYDDAS_MYSQL
iap->myddas = 0;
iap->myddas_user = NULL;
iap->myddas_pass = NULL;
iap->myddas_db = NULL;
iap->myddas_host = NULL;
#endif
iap->ErrorNo = 0;
iap->ErrorCause = NULL;
iap->QuietMode = FALSE;
while (--argc > 0)
{
p = *++argv;
if (*p == '-')
switch (*++p)
{
case 'b':
BootMode = YAP_BOOT_FROM_PROLOG;
iap->YapPrologBootFile = *++argv;
argc--;
break;
case '?':
print_usage();
exit(EXIT_SUCCESS);
case 'q':
iap->QuietMode = TRUE;
break;
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
case 'w':
ssize = &(iap->NumberWorkers);
goto GetSize;
case 'd':
if (!strcmp("dump-runtime-variables",p))
return dump_runtime_variables();
ssize = &(iap->DelayedReleaseLoad);
goto GetSize;
#else
case 'd':
if (!strcmp("dump-runtime-variables",p))
return dump_runtime_variables();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
case 'F':
/* just ignore for now */
argc--;
argv++;
break;
case 'f':
if (argc > 1 && argv[1][0] != '-') {
argc--;
argv++;
if (!strcmp(*argv,"none")) {
iap->FastBoot = TRUE;
} else {
iap->YapPrologRCFile = *argv;
}
break;
}
iap->FastBoot = TRUE;
break;
#ifdef MYDDAS_MYSQL
case 'm':
if (strncmp(p,"myddas_",7) == 0)
{
iap->myddas = 1;
if ((*argv)[0] == '\0')
myddas_temp = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n");
exit(EXIT_FAILURE);
}
argv++;
myddas_temp = *argv;
}
if (strstr(p,"user") != NULL)
iap->myddas_user = myddas_temp;
else if (strstr(p,"pass") != NULL)
iap->myddas_pass = myddas_temp;
else if (strstr(p,"db") != NULL)
iap->myddas_db = myddas_temp;
else if (strstr(p,"host") != NULL)
iap->myddas_host = myddas_temp;
else
goto myddas_error_print;
break;
}
#endif
// execution mode
case 'J':
switch (p[1]) {
case '0':
iap->ExecutionMode = YAPC_INTERPRETED;
break;
case '1':
iap->ExecutionMode = YAPC_MIXED_MODE_USER;
break;
case '2':
iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
break;
case '3':
iap->ExecutionMode = YAPC_COMPILE_USER;
break;
case '4':
iap->ExecutionMode = YAPC_COMPILE_ALL;
break;
default:
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c%c ]\n", *p, p[1]);
exit(EXIT_FAILURE);
}
p++;
break;
case 'G':
ssize = &(iap->MaxGlobalSize);
goto GetSize;
break;
case 's':
case 'S':
ssize = &(iap->StackSize);
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
if (p[1] == 'l') {
p++;
ssize = &(iap->SchedulerLoop);
}
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
goto GetSize;
case 'a':
case 'A':
ssize = &(iap->AttsSize);
goto GetSize;
case 'T':
ssize = &(iap->MaxTrailSize);
goto get_trail_size;
case 't':
ssize = &(iap->TrailSize);
#ifdef TABLING
if (p[1] == 's') {
p++;
ssize = &(iap->MaxTableSpaceSize);
}
#endif /* TABLING */
get_trail_size:
if (*++p == '\0')
{
if (argc > 1)
--argc, p = *++argv;
else
{
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch(ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
i *= 1024*1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch) {
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
} else {
*ssize = i;
}
}
break;
case 'h':
case 'H':
ssize = &(iap->HeapSize);
GetSize:
if (*++p == '\0')
{
if (argc > 1)
--argc, p = *++argv;
else
{
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch(ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
case 'G':
i *= 1024*1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch)
{
fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]);
YAP_Exit(1);
}
*ssize = i;
}
break;
#ifdef DEBUG
case 'P':
YAP_SetOutputMessage();
break;
#endif
case 'L':
if (p[1] && p[1] >= '0' && p[1] <= '9') /* hack to emulate SWI's L local option */
{
ssize = &(iap->MaxStackSize);
goto GetSize;
}
iap->QuietMode = TRUE;
iap->HaltAfterConsult = TRUE;
case 'l':
p++;
if (!*++argv) {
fprintf(stderr,"%% YAP unrecoverable error: missing load file name\n");
exit(1);
} else if (!strcmp("--",*argv)) {
/* shell script, the next entry should be the file itself */
iap->YapPrologRCFile = argv[1];
argc = 1;
break;
} else {
iap->YapPrologRCFile = *argv;
argc--;
}
if (*p) {
/* we have something, usually, of the form:
-L --
FileName
ExtraArgs
*/
/* being called from a script */
while (*p && (*p == ' ' || *p == '\t'))
p++;
if (p[0] == '-' && p[1] == '-') {
/* ignore what is next */
argc = 1;
}
}
break;
/* run goal before top-level */
case 'g':
if ((*argv)[0] == '\0')
iap->YapPrologGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing initialization goal for option 'g' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologGoal = *argv;
}
break;
/* run goal as top-level */
case 'z':
if ((*argv)[0] == '\0')
iap->YapPrologTopLevelGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing goal for option 'z' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
}
break;
case 'p':
if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing paths for option 'p' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologAddPath = *argv;
}
break;
/* nf: Begin preprocessor code */
case 'D':
{
char *var, *value;
++p;
var = p;
if (var == NULL || *var=='\0')
break;
while(*p!='=' && *p!='\0') ++p;
if ( *p=='\0' ) break;
*p='\0';
++p;
value=p;
if ( *value == '\0' ) break;
if (iap->def_c == YAP_MAX_YPP_DEFS)
break;
iap->def_var[iap->def_c]=var;
iap->def_value[iap->def_c]=value;
++(iap->def_c);
break;
}
/* End preprocessor code */
case '-':
/* skip remaining arguments */
argc = 1;
break;
default:
{
#ifdef MYDDAS_MYSQL
myddas_error_print :
#endif
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p);
#ifdef MYDDAS_MYSQL
myddas_error :
#endif
print_usage();
exit(EXIT_FAILURE);
}
}
else {
iap->SavedState = p;
}
}
#ifdef MYDDAS_MYSQL
/* Check MYDDAS Arguments */
if (iap->myddas_user != NULL || iap->myddas_pass != NULL
|| iap->myddas_db != NULL || iap->myddas_host != NULL)
if (iap->myddas_user == NULL || iap->myddas_db == NULL){
fprintf(stderr,"[ YAP unrecoverable error: Missing Mandatory Arguments for MYDDAS ]\n");
goto myddas_error;
}
#endif
return BootMode;
}

2
H/Foreign.h
View File

@ -92,7 +92,7 @@ typedef struct StringListItem {
typedef struct ForeignLoadItem {
StringList objs;
StringList libs;
char *f;
Atom f;
Term module;
struct ForeignLoadItem *next;
} ForeignObj;

30
H/TermExt.h Normal file → Executable file
View File

@ -103,7 +103,7 @@ inline EXTERN blob_type BlobOfFunctor (Functor f);
inline EXTERN blob_type
BlobOfFunctor (Functor f)
{
return (blob_type) (f);
return (blob_type) ((CELL)f);
}
typedef struct cp_frame {
@ -148,8 +148,8 @@ exts;
#endif
#ifdef YAP_H
#ifdef YAP_H
/* make sure that these data structures are the first thing to be allocated
in the heap when we start the system */
#ifdef THREADS
@ -175,7 +175,9 @@ typedef struct special_functors_struct
special_functors;
#endif
inline EXTERN Float STD_PROTO (CpFloatUnaligned, (CELL *));
#endif /* YAP_H */
inline extern Float CpFloatUnaligned(CELL *ptr);
#if SIZEOF_DOUBLE == SIZEOF_LONG_INT
@ -214,7 +216,7 @@ CpFloatUnaligned(CELL *ptr)
#if SIZEOF_DOUBLE == 2*SIZEOF_LONG_INT
inline EXTERN void STD_PROTO (AlignGlobalForDouble, ( USES_REGS1 ));
inline extern void AlignGlobalForDouble( USES_REGS1 );
#define DOUBLE_ALIGNED(ADDR) ((CELL)(ADDR) & 0x4)
@ -269,16 +271,22 @@ FloatOfTerm (Term t)
#else
/* OOPS, YAP only understands Floats that are as large as cells or that
take two cells!!! */
OOPS
#endif
#endif
Term STD_PROTO (Yap_MkBlobStringTerm, (const char *, size_t len));
Term STD_PROTO (Yap_MkBlobWideStringTerm, (const wchar_t *, size_t len));
char *STD_PROTO (Yap_BlobStringOfTerm, (Term));
wchar_t *STD_PROTO (Yap_BlobWideStringOfTerm, (Term));
char *STD_PROTO (Yap_BlobStringOfTermAndLength, (Term, size_t *));
#ifndef YAP_H
#include <stddef.h>
#endif
Term Yap_MkBlobStringTerm(const char *, size_t len);
Term Yap_MkBlobWideStringTerm(const wchar_t *, size_t len);
char *Yap_BlobStringOfTerm(Term);
wchar_t *Yap_BlobWideStringOfTerm(Term);
char *Yap_BlobStringOfTermAndLength(Term, size_t *);
#endif /* YAP_NOT_INSTALLED */
inline EXTERN int IsFloatTerm (Term);
@ -294,7 +302,6 @@ IsFloatTerm (Term t)
/* extern Functor FunctorLongInt; */
#ifdef YAP_H
inline EXTERN Term MkLongIntTerm (Int);
inline EXTERN Term
@ -308,7 +315,6 @@ MkLongIntTerm (Int i)
return AbsAppl(H - 3);
}
#endif
inline EXTERN Int LongIntOfTerm (Term t);

75
H/Yap.h Normal file → Executable file
View File

@ -453,8 +453,9 @@ typedef enum
TABLING_MODE_FLAG = 20,
VARS_CAN_HAVE_QUOTE_FLAG = 21,
QUIET_MODE_FLAG = 22,
INDEXING_TERM_DEPTH_FLAG = 23,
/* let this be the last one */
LAST_FLAG = 23
NUMBER_OF_YAP_FLAGS = 24
} yap_flags;
#define STRING_AS_CHARS 0
@ -501,8 +502,6 @@ typedef enum
YAP_FAIL_SIGNAL = 0x100000 /* P = FAILCODE */
} yap_signals;
#define NUMBER_OF_YAP_FLAGS LAST_FLAG
typedef enum
{
GPROF_NO_EVENT,
@ -810,6 +809,7 @@ extern struct worker_local Yap_local;
#define REMOTE(wid) (&Yap_local)
#endif
#include <stdio.h>
#define YP_FILE FILE
#include "hglobals.h"
#include "dglobals.h"
@ -817,6 +817,12 @@ extern struct worker_local Yap_local;
#include "dlocals.h"
/*************************************************************************************************
unification support
*************************************************************************************************/
#include "YapCompoundTerm.h"
/*************************************************************************************************
unification routines
*************************************************************************************************/
@ -830,69 +836,6 @@ extern struct worker_local Yap_local;
/*************************************************************************************************
High level macros to access arguments
*************************************************************************************************/
inline EXTERN Term ArgOfTerm (int i, Term t);
inline EXTERN Term
ArgOfTerm (int i, Term t)
{
return (Term) (Derefa (RepAppl (t) + (i)));
}
inline EXTERN Term HeadOfTerm (Term);
inline EXTERN Term
HeadOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t)));
}
inline EXTERN Term TailOfTerm (Term);
inline EXTERN Term
TailOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t) + 1));
}
inline EXTERN Term ArgOfTermCell (int i, Term t);
inline EXTERN Term
ArgOfTermCell (int i, Term t)
{
return (Term) ((CELL) (RepAppl (t) + (i)));
}
inline EXTERN Term HeadOfTermCell (Term);
inline EXTERN Term
HeadOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t)));
}
inline EXTERN Term TailOfTermCell (Term);
inline EXTERN Term
TailOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t) + 1));
}
/*************************************************************************************************
slots

115
H/YapCompoundTerm.h Normal file
View File

@ -0,0 +1,115 @@
/*************************************************************************
* *
* YAP Prolog %W% %G% *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-2012 *
* *
**************************************************************************
* *
* File: YapCompounTerm.h *
* mods: *
* comments: main header file for YAP *
* version: $Id: Yap.h,v 1.38 2008-06-18 10:02:27 vsc Exp $ *
*************************************************************************/
/*************************************************************************************************
High level macros to access arguments
*************************************************************************************************/
#ifndef YAPCOMPOUNDTERM_H
#define YAPCOMPOUNDTERM_H 1
EXTERN Int Yap_unify(Term a,Term b);
EXTERN inline Term Deref(Term a);
EXTERN inline Term Deref(Term a)
{
while(IsVarTerm(a)) {
Term *b = (Term *) a;
a = *b;
if(a==((Term) b)) return a;
}
return(a);
}
EXTERN inline Term Derefa(CELL *b);
EXTERN inline Term
Derefa(CELL *b)
{
Term a = *b;
restart:
if (!IsVarTerm(a)) {
return(a);
} else if (a == (CELL)b) {
return(a);
} else {
b = (CELL *)a;
a = *b;
goto restart;
}
}
inline EXTERN Term ArgOfTerm (int i, Term t);
inline EXTERN Term
ArgOfTerm (int i, Term t)
{
return (Term) (Derefa (RepAppl (t) + (i)));
}
inline EXTERN Term HeadOfTerm (Term);
inline EXTERN Term
HeadOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t)));
}
inline EXTERN Term TailOfTerm (Term);
inline EXTERN Term
TailOfTerm (Term t)
{
return (Term) (Derefa (RepPair (t) + 1));
}
inline EXTERN Term ArgOfTermCell (int i, Term t);
inline EXTERN Term
ArgOfTermCell (int i, Term t)
{
return (Term) ((CELL) (RepAppl (t) + (i)));
}
inline EXTERN Term HeadOfTermCell (Term);
inline EXTERN Term
HeadOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t)));
}
inline EXTERN Term TailOfTermCell (Term);
inline EXTERN Term
TailOfTermCell (Term t)
{
return (Term) ((CELL) (RepPair (t) + 1));
}
#endif /* YAPCOMPOUNDTERM_H */

10
H/YapTags.h
View File

@ -184,8 +184,6 @@ IsUnboundVar (Term * t)
#else
#ifdef YAP_H
inline EXTERN Term MkVarTerm__ ( USES_REGS1 );
inline EXTERN Term
@ -194,8 +192,6 @@ MkVarTerm__ ( USES_REGS1 )
return (Term) ((*H = (CELL) H, H++));
}
#endif
inline EXTERN int IsUnboundVar (Term *);
@ -316,8 +312,7 @@ IsIntTerm (Term t)
}
#ifdef YAP_H
EXTERN inline Term STD_PROTO (MkPairTerm__, (Term, Term CACHE_TYPE) );
EXTERN inline Term MkPairTerm__(Term head, Term tail USES_REGS );
EXTERN inline Term
MkPairTerm__ (Term head, Term tail USES_REGS)
@ -330,7 +325,6 @@ MkPairTerm__ (Term head, Term tail USES_REGS)
return (AbsPair (p));
}
#endif
/* Needed to handle numbers:
@ -395,4 +389,6 @@ IntegerOfTerm (Term t)
return (Int) (IsIntTerm (t) ? IntOfTerm (t) : LongIntOfTerm (t));
}
#ifndef YAP_H
#endif

2
H/YapTerm.h
View File

@ -18,6 +18,7 @@
typedef void *Functor;
typedef void *Atom;
#endif
#ifndef EXTERN
@ -134,3 +135,4 @@ typedef unsigned long int YAP_ULONG_LONG;
#define Unsigned(V) ((CELL) (V))
#define Signed(V) ((Int) (V))

1
H/Yapproto.h
View File

@ -377,6 +377,7 @@ void STD_PROTO(Yap_InitLowLevelTrace,(void));
/* udi.c */
void STD_PROTO(Yap_udi_init,(void));
void STD_PROTO(Yap_udi_abolish,(struct pred_entry *));
/* unify.c */
int STD_PROTO(Yap_rational_tree_loop, (CELL *, CELL *, CELL **, CELL **));

31
H/amiops.h
View File

@ -87,35 +87,6 @@ Dereferencing macros
#endif /* UNIQUE_TAG_FOR_PAIRS */
EXTERN Term STD_PROTO(Deref,(Term));
EXTERN Term STD_PROTO(Derefa,(CELL *));
EXTERN inline Term Deref(Term a)
{
while(IsVarTerm(a)) {
Term *b = (Term *) a;
a = *b;
if(a==((Term) b)) return a;
}
return(a);
}
EXTERN inline Term
Derefa(CELL *b)
{
Term a = *b;
restart:
if (!IsVarTerm(a)) {
return(a);
} else if (a == (CELL)b) {
return(a);
} else {
b = (CELL *)a;
a = *b;
goto restart;
}
}
/************************************************************
TRAIL VARIABLE
@ -309,8 +280,6 @@ Unification Routines
*************************************************************/
EXTERN Int STD_PROTO(Yap_unify,(Term,Term));
inline EXTERN void STD_PROTO(reset_trail,(tr_fr_ptr));
inline EXTERN void

3
H/arith2.h Normal file → Executable file
View File

@ -120,6 +120,7 @@ times_int(Int i1, Int i2) {
}
#ifdef USE_GMP
#ifndef __GNUC__X
static int
clrsb(Int i)
@ -147,7 +148,7 @@ clrsb(Int i)
return j;
}
#endif
#endif
inline static Term
do_sll(Int i, Int j) /* j > 0 */

2
H/compile.h
View File

@ -273,6 +273,8 @@ typedef struct intermediates {
yamop *try_instructions;
struct StructClauseDef *cls;
int clause_has_cut;
UInt term_depth, last_index_at_depth;
UInt last_index_new_depth, last_depth_size;
/* for expanding code */
union {
struct static_index *si;

2
H/dhstruct.h
View File

@ -56,6 +56,8 @@
#define HeapTopLock Yap_heap_regs->heap_top_lock
#define HeapTopOwner Yap_heap_regs->heap_top_owner
#endif
#define MaxStack Yap_heap_regs->MaxStack_
#define MaxTrail Yap_heap_regs->MaxTrail_
#if USE_THREADED_CODE

2
H/hstruct.h
View File

@ -56,6 +56,8 @@
lockvar heap_top_lock;
int heap_top_owner;
#endif
UInt MaxStack_;
UInt MaxTrail_;
#if USE_THREADED_CODE

2
H/ihstruct.h
View File

@ -56,6 +56,8 @@
INIT_LOCK(HeapTopLock);
HeapTopOwner = -1;
#endif
MaxStack = 0;
MaxTrail = 0;
#if USE_THREADED_CODE

3
H/pl-incl.h Normal file → Executable file
View File

@ -864,7 +864,7 @@ skip_list(Word l, Word *tailp ARG_LD) {
static inline word
valHandle__LD(term_t r ARG_LD)
{
return (word)YAP_GetFromSlot(r);
return (word)YAP_GetFromSlot((Int)r);
}
static inline void *allocHeap__LD(size_t n ARG_LD)
@ -886,4 +886,5 @@ extern const PL_extension PL_predicates_from_read[];
extern const PL_extension PL_predicates_from_tai[];
extern const PL_extension PL_predicates_from_write[];
extern const PL_extension PL_predicates_from_prologflag[];
extern const PL_extension PL_predicates_from_win[];

3
H/qly.h
View File

@ -101,7 +101,8 @@ typedef enum {
QLY_END_PREDICATES = 13,
QLY_ATOM_WIDE = 14,
QLY_FAILCODE = 15,
QLY_ATOM = 16
QLY_ATOM = 16,
QLY_ATOM_BLOB = 17
} qlf_tag_t;
#define STATIC_PRED_FLAGS (SourcePredFlag|DynamicPredFlag|LogUpdatePredFlag|CompiledPredFlag|MultiFileFlag|TabledPredFlag|MegaClausePredFlag|CountPredFlag|ProfiledPredFlag|ThreadLocalPredFlag|AtomDBPredFlag|ModuleTransparentPredFlag|NumberDBPredFlag|MetaPredFlag|SyncPredFlag|BackCPredFlag)

65
H/rheap.h
View File

@ -241,7 +241,7 @@ static char SccsId[] = "@(#)rheap.c 1.3 3/15/90";
#define ConstantTermAdjust(P) ConstantTermAdjust__(P PASS_REGS)
#define DBGroundTermAdjust(P) DBGroundTermAdjust__(P PASS_REGS)
#define AdjustDBTerm(P,A) AdjustDBTerm__(P,A PASS_REGS)
#define AdjustDBTerm(P,A,B,C) AdjustDBTerm__(P,A,B,C PASS_REGS)
#define AdjustSwitchTable(op, table, i) AdjustSwitchTable__(op, table, i PASS_REGS)
#define RestoreOtaplInst(start, opc, pe) RestoreOtaplInst__(start, opc, pe PASS_REGS)
#define RestoreDBErasedMarker() RestoreDBErasedMarker__( PASS_REGS1 )
@ -460,7 +460,7 @@ RestoreInvisibleAtoms__( USES_REGS1 )
/* adjusts terms stored in the data base, when they have no variables */
static Term
AdjustDBTerm__(Term trm, Term *p_base USES_REGS)
AdjustDBTerm__(Term trm, Term *p_base, Term *p_lim, Term *p_max USES_REGS)
{
if (IsVarTerm(trm))
return CodeVarAdjust(trm);
@ -473,8 +473,8 @@ AdjustDBTerm__(Term trm, Term *p_base USES_REGS)
p = PtoHeapCellAdjust(RepPair(trm));
out = AbsPair(p);
loop:
if (p >= p_base) {
p[0] = AdjustDBTerm(p[0], p);
if (p >= p_base || p < p_lim) {
p[0] = AdjustDBTerm(p[0], p, p_lim, p_max);
if (IsPairTerm(p[1])) {
/* avoid term recursion with very deep lists */
Term *newp = PtoHeapCellAdjust(RepPair(p[1]));
@ -483,7 +483,7 @@ AdjustDBTerm__(Term trm, Term *p_base USES_REGS)
p = newp;
goto loop;
} else {
p[1] = AdjustDBTerm(p[1], p);
p[1] = AdjustDBTerm(p[1], p, p_lim, p_max);
}
}
return out;
@ -494,7 +494,12 @@ AdjustDBTerm__(Term trm, Term *p_base USES_REGS)
Term *p0 = p = PtoHeapCellAdjust(RepAppl(trm));
/* if it is before the current position, then we are looking
at old code */
if (p >= p_base) {
if (p >= p_base || p < p_lim) {
if (p >= p_max || p < p_lim) {
if (DBRefOfTerm(trm)!=DBRefAdjust(DBRefOfTerm(trm),FALSE))
/* external term pointer, has to be a DBRef */
return MkDBRefTerm(DBRefAdjust(DBRefOfTerm(trm),FALSE));
}
f = (Functor)p[0];
if (!IsExtensionFunctor(f)) {
UInt Arity, i;
@ -503,9 +508,10 @@ AdjustDBTerm__(Term trm, Term *p_base USES_REGS)
*p++ = (Term)f;
Arity = ArityOfFunctor(f);
for (i = 0; i < Arity; ++i) {
*p = AdjustDBTerm(*p, p0);
*p = AdjustDBTerm(*p, p0, p_lim, p_max);
p++;
}
} else if (f == FunctorDBRef) {
}
}
return AbsAppl(p0);
@ -519,22 +525,23 @@ RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS)
if (attachments) {
#ifdef COROUTINING
if (dbr->ag.attachments)
dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents);
dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells);
#endif
} else {
if (dbr->ag.NextDBT)
dbr->ag.NextDBT = DBTermAdjust(dbr->ag.NextDBT);
}
if (dbr->DBRefs != NULL) {
if (dbr->DBRefs) {
DBRef *cp;
DBRef tm;
dbr->DBRefs = DBRefPAdjust(dbr->DBRefs);
cp = dbr->DBRefs;
while ((tm = *--cp) != 0)
*cp = DBRefAdjust(tm);
while ((tm = *--cp) != 0) {
*cp = DBRefAdjust(tm,TRUE);
}
}
dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents);
dbr->Entry = AdjustDBTerm(dbr->Entry, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells);
}
/* Restoring the heap */
@ -551,7 +558,7 @@ RestoreStaticClause(StaticClause *cl USES_REGS)
char *x = (char *)DBTermAdjust(cl->usc.ClSource);
char *base = (char *)cl;
if (x < base || x > base+cl->ClSize) {
if (x < base || x >= base+cl->ClSize) {
cl->usc.ClPred = PtoPredAdjust(cl->usc.ClPred);
} else {
cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource);
@ -572,17 +579,16 @@ RestoreMegaClause(MegaClause *cl USES_REGS)
* clause for this predicate or not
*/
{
UInt ncls, i;
yamop *ptr;
yamop *ptr, *max, *nextptr;
cl->ClPred = PtoPredAdjust(cl->ClPred);
if (cl->ClNext) {
cl->ClNext = (MegaClause *)AddrAdjust((ADDR)(cl->ClNext));
}
ncls = cl->ClPred->cs.p_code.NOfClauses;
max = (yamop *)((CODEADDR)cl+cl->ClSize);
for (i = 0, ptr = cl->ClCode; i < ncls; i++) {
yamop *nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
for (ptr = cl->ClCode; ptr < max; ) {
nextptr = (yamop *)((char *)ptr + cl->ClItemSize);
restore_opcodes(ptr, nextptr PASS_REGS);
ptr = nextptr;
}
@ -864,7 +870,7 @@ static void
RestoreDBErasedMarker__( USES_REGS1 )
{
Yap_heap_regs->db_erased_marker =
DBRefAdjust(Yap_heap_regs->db_erased_marker);
DBRefAdjust(Yap_heap_regs->db_erased_marker,TRUE);
Yap_heap_regs->db_erased_marker->id = FunctorDBRef;
Yap_heap_regs->db_erased_marker->Flags = ErasedMask;
Yap_heap_regs->db_erased_marker->Code = NULL;
@ -995,8 +1001,9 @@ RestoreForeignCode__( USES_REGS1 )
libs->name = AtomAdjust(libs->name);
libs = libs->next;
}
if (f_code->f != NULL)
f_code->f = (char *)AddrAdjust((ADDR)f_code->f);
if (f_code->f != NULL) {
f_code->f = AtomAdjust(f_code->f);
}
if (f_code->next != NULL)
f_code->next = (ForeignObj *)AddrAdjust((ADDR)f_code->next);
f_code = f_code->next;
@ -1069,9 +1076,9 @@ RestoreDBEntry(DBRef dbr USES_REGS)
if (dbr->Code != NULL)
dbr->Code = PtoOpAdjust(dbr->Code);
if (dbr->Prev != NULL)
dbr->Prev = DBRefAdjust(dbr->Prev);
dbr->Prev = DBRefAdjust(dbr->Prev,TRUE);
if (dbr->Next != NULL)
dbr->Next = DBRefAdjust(dbr->Next);
dbr->Next = DBRefAdjust(dbr->Next,TRUE);
#ifdef DEBUG_RESTORE2
fprintf(stderr, "Recomputing masks\n");
#endif
@ -1085,26 +1092,26 @@ RestoreDB(DBEntry *pp USES_REGS)
register DBRef dbr;
if (pp->First != NULL)
pp->First = DBRefAdjust(pp->First);
pp->First = DBRefAdjust(pp->First,TRUE);
if (pp->Last != NULL)
pp->Last = DBRefAdjust(pp->Last);
pp->Last = DBRefAdjust(pp->Last, TRUE);
if (pp->ArityOfDB)
pp->FunctorOfDB = FuncAdjust(pp->FunctorOfDB);
else
pp->FunctorOfDB = (Functor) AtomAdjust((Atom)(pp->FunctorOfDB));
if (pp->F0 != NULL)
pp->F0 = DBRefAdjust(pp->F0);
pp->F0 = DBRefAdjust(pp->F0, TRUE);
if (pp->L0 != NULL)
pp->L0 = DBRefAdjust(pp->L0);
pp->L0 = DBRefAdjust(pp->L0, TRUE);
/* immediate update semantics */
dbr = pp->F0;
/* While we have something in the data base, even if erased, restore it */
while (dbr) {
RestoreDBEntry(dbr PASS_REGS);
if (dbr->n != NULL)
dbr->n = DBRefAdjust(dbr->n);
dbr->n = DBRefAdjust(dbr->n, TRUE);
if (dbr->p != NULL)
dbr->p = DBRefAdjust(dbr->p);
dbr->p = DBRefAdjust(dbr->p, TRUE);
dbr = dbr->n;
}
}

2
H/rhstruct.h
View File

@ -58,6 +58,8 @@
#endif
#if USE_THREADED_CODE
OP_RTABLE = OpRTableAdjust(OP_RTABLE);
#endif

2
H/sshift.h
View File

@ -72,7 +72,7 @@
#define DelayAddrAdjust(P) DelayAddrAdjust__(P PASS_REGS)
#define DelayAdjust(P) DelayAdjust__(P PASS_REGS)
#define GlobalAdjust(P) GlobalAdjust__(P PASS_REGS)
#define DBRefAdjust(P) DBRefAdjust__(P PASS_REGS)
#define DBRefAdjust(P,C) DBRefAdjust__(P PASS_REGS)
#define DBRefPAdjust(P) DBRefPAdjust__(P PASS_REGS)
#define DBTermAdjust(P) DBTermAdjust__(P PASS_REGS)
#define LUIndexAdjust(P) LUIndexAdjust__(P PASS_REGS)

2
LGPL/Makefile.in Normal file → Executable file
View File

@ -30,6 +30,7 @@ PROGRAMS= $(srcdir)/base64.pl \
$(srcdir)/debug.pl \
$(srcdir)/main.pl \
$(srcdir)/maplist.pl \
$(srcdir)/menu.pl \
$(srcdir)/nb_set.pl \
$(srcdir)/operators.pl \
$(srcdir)/option.pl \
@ -48,6 +49,7 @@ PROGRAMS= $(srcdir)/base64.pl \
$(srcdir)/thread_pool.pl \
$(srcdir)/url.pl \
$(srcdir)/utf8.pl \
$(srcdir)/win_menu.pl \
$(srcdir)/www_browser.pl

76
LGPL/menu.pl Executable file
View File

@ -0,0 +1,76 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: J.Wielemaker@uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2009, University of Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module('$win_menu',
[ win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal
win_has_menu/0 % Test whether we have menus
]).
:- meta_predicate
win_insert_menu_item(+,+,+,:).
%:- multifile
% prolog:on_menu/1.
:- dynamic
menu_action/2.
:- volatile
menu_action/2.
prolog:on_menu(Label) :-
menu_action(Label, Action),
catch(Action, Error,
print_message(error, Error)).
% win_has_menu
%
% Test whether the system provides the menu interface
prolog:win_has_menu :-
current_predicate(_, system:'$win_insert_menu_item'(_, _, _)).
% win_insert_menu_item(+Popup, +Item, +Before, :Goal)
%
% Add a menu-item to the PLWIN.EXE menu. See the reference manual
% for details.
prolog:win_insert_menu_item(Popup, --, Before, _Goal) :- !,
call(system:'$win_insert_menu_item'(Popup, --, Before)). % fool check/0
prolog:win_insert_menu_item(Popup, Item, Before, Goal) :-
insert_menu_item(Popup, Item, Before, Goal).
insert_menu_item(Popup, Item, Before, Goal) :-
( menu_action(Item, OldGoal),
OldGoal \== Goal
-> throw(error(permission_error(redefine, Item),
win_insert_menu_item/4))
; true
),
call(system:'$win_insert_menu_item'(Popup, Item, Before)),
assert(menu_action(Item, Goal)).

252
LGPL/win_menu.pl Executable file
View File

@ -0,0 +1,252 @@
/* $Id$
Part of SWI-Prolog
Author: Jan Wielemaker
E-mail: jan@swi.psy.uva.nl
WWW: http://www.swi-prolog.org
Copyright (C): 1985-2002, University of Amsterdam
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
As a special exception, if you link this library with other files,
compiled with a Free Software compiler, to produce an executable, this
library does not by itself cause the resulting executable to be covered
by the GNU General Public License. This exception does not however
invalidate any other reasons why the executable file might be covered by
the GNU General Public License.
*/
:- module(win_menu,
[ init_win_menus/0
]).
:- use_module(library(lists)).
:- use_module(library(www_browser)).
:- set_prolog_flag(generate_debug_info, false).
:- op(200, fy, @).
:- op(990, xfx, :=).
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
This library sets up the menu of PLWIN.EXE. It is called from the system
initialisation file plwin.rc, predicate gui_setup_/0.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
menu('&File',
[ '&Consult ...' = win_menu:action(user:compile(+file(open,
'Load file into Prolog'))),
% '&Edit ...' = win_menu:action(user:edit(+file(open,
% 'Edit existing file'))),
% '&New ...' = win_menu:action(edit_new(+file(save,
% 'Create new Prolog source'))),
--,
'&Reload modified files' = user:make,
% --,
% '&Navigator ...' = prolog_ide(open_navigator),
--
],
[ before_item('&Exit')
]).
/*
menu('&Settings',
[ --,
'&User init file ...' = prolog_edit_preferences(prolog)
% '&GUI preferences ...' = prolog_edit_preferences(xpce)
],
[]).
menu('&Debug',
[ %'&Trace' = trace,
%'&Debug mode' = debug,
%'&No debug mode' = nodebug,
'&Edit spy points ...' = user:prolog_ide(open_debug_status),
'&Edit exceptions ...' = user:prolog_ide(open_exceptions(@on)),
'&Threads monitor ...' = user:prolog_ide(thread_monitor),
'Debug &messages ...' = user:prolog_ide(debug_monitor),
'Cross &referencer ...'= user:prolog_ide(xref),
--,
'&Graphical debugger' = user:guitracer
],
[ before_menu(-)
]).
*/
menu('&Help',
[ '&About ...' = about,
'&Help ...' = help,
'YAP &Manual (on www) ...' = win_menu:www_open(yap_man),
--,
'YAP &WWW home (on www) ...' = win_menu:www_open(yap),
'YAP &GIT (on www) ...' = win_menu:www_open(yap_git),
% 'YAP Mailing &List (on www) ...' = win_menu:www_open(swipl_mail),
'YAP &Download (on www) ...' = win_menu:www_open(yap_download),
--,
% '&XPCE (GUI) Manual ...' = manpce,
% --,
'Submit &Bug report (on www) ...' = win_menu:www_open(yap_bugs)
],
[ before_menu(-)
]).
init_win_menus :-
( menu(Menu, Items, Options),
( memberchk(before_item(Before), Options)
-> true
; Before = (-)
),
( memberchk(before_menu(BM), Options)
-> system:win_insert_menu(Menu, BM)
; true
),
( member(Item, Items),
( Item = (Label = Action)
-> true
; Item == --
-> Label = --
),
win_insert_menu_item(Menu, Label, Before, Action),
fail
; true
),
fail
; insert_associated_file
).
insert_associated_file :-
current_prolog_flag(associated_file, File),
file_base_name(File, Base),
atom_concat('Edit &', Base, Label),
win_insert_menu_item('&File', Label, '&New ...', edit(file(File))).
insert_associated_file.
:- initialization
( win_has_menu
-> init_win_menus
; true
).
/*******************************
* ACTIONS *
*******************************/
edit_new(File) :-
call(edit(file(File))). % avoid autoloading
www_open(Id) :-
Spec =.. [Id, '.'],
call(expand_url_path(Spec, URL)),
print_message(informational, opening_url(URL)),
call(www_open_url(URL)), % avoid autoloading
print_message(informational, opened_url(URL)).
html_open(Spec) :-
absolute_file_name(Spec, [access(read)], Path),
call(win_shell(open, Path)).
about :-
print_message(informational, about).
/*******************************
* HANDLE CALLBACK *
*******************************/
action(Action) :-
strip_module(Action, Module, Plain),
Plain =.. [Name|Args],
gather_args(Args, Values),
Goal =.. [Name|Values],
Module:Goal.
gather_args([], []).
gather_args([+H0|T0], [H|T]) :- !,
gather_arg(H0, H),
gather_args(T0, T).
gather_args([H|T0], [H|T]) :-
gather_args(T0, T).
gather_arg(file(Mode, Title), File) :-
findall(tuple('Prolog Source', Pattern),
prolog_file_pattern(Pattern),
Tuples),
append(Tuples, [tuple('All files', '*.*')], AllTuples),
Filter =.. [chain|AllTuples],
current_prolog_flag(hwnd, HWND),
working_directory(CWD, CWD),
% filter(AllTuples, Filter),
win_open_file_name(HWND, CWD, File).
%% call(get(@display, win_file_name, % avoid autoloading
%% Mode, Filter, Title,
%% directory := CWD,
%% owner := HWND,
%% File)).
prolog_file_pattern(Pattern) :-
user:prolog_file_type(Ext, prolog),
atom_concat('*.', Ext, Pattern).
/*******************************
* APPLICATION *
*******************************/
%% init_win_app
%
% If Prolog is started using --win_app, try to change directory
% to <My Documents>\Prolog.
init_win_app :-
current_prolog_flag(associated_file, _), !.
init_win_app :-
current_prolog_flag(argv, Argv),
append(Pre, ['--win_app'|_Post], Argv),
\+ member(--, Pre), !,
catch(my_prolog, E, print_message(warning, E)).
init_win_app.
my_prolog :-
win_folder(personal, MyDocs),
atom_concat(MyDocs, '/Prolog', PrologDir),
( ensure_dir(PrologDir)
-> working_directory(_, PrologDir)
; working_directory(_, MyDocs)
).
ensure_dir(Dir) :-
exists_directory(Dir), !.
ensure_dir(Dir) :-
catch(make_directory(Dir), E, (print_message(warning, E), fail)).
:- initialization
init_win_app.
/*******************************
* MESSAGES *
*******************************/
:- multifile
prolog:message/3.
prolog:message(opening_url(Url)) -->
[ 'Opening ~w ... '-[Url], flush ].
prolog:message(opened_url(_Url)) -->
[ at_same_line, 'ok' ].

9
LGPL/www_browser.pl Normal file → Executable file
View File

@ -194,6 +194,15 @@ user:url_path(swipl_download, swipl('Download.html')).
user:url_path(swipl_bugs, swipl('bugzilla')).
user:url_path(swipl_quick, swipl('man/quickstart.html')).
user:url_path(yap, 'http://www.dcc.fc.up.pt/~vsc/Yap').
user:url_path(yap_download, 'http://www.dcc.fc.up.pt/~vsc/Yap/downloads.html').
user:url_path(yap_man, yap('documentation.html')).
user:url_path(yap_bugs, 'http://sourceforge.net/tracker/?group_id=24437&atid=381483').
user:url_path(yap_git, 'http://yap.git.sourceforge.net/git/gitweb-index.cgi').
%% expand_url_path(+Spec, -URL)
%
% Expand URL specifications similar to absolute_file_name/3. The

37
Makefile.in Normal file → Executable file
View File

@ -122,8 +122,9 @@ INTERFACE_HEADERS = \
$(srcdir)/H/Tags_32LowTag.h \
$(srcdir)/H/Tags_64bits.h \
$(srcdir)/H/Tags_24bits.h \
$(srcdir)/H/YapTerm.h \
$(srcdir)/H/YapCompoundTerm.h \
$(srcdir)/include/YapRegs.h \
$(srcdir)/H/YapTerm.h \
$(srcdir)/library/dialect/bprolog/fli/bprolog.h \
$(srcdir)/os/SWI-Stream.h
@ -261,6 +262,7 @@ C_SOURCES= \
$(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 \
$(srcdir)/BEAM/eam_am.c $(srcdir)/BEAM/eam_showcode.c \
$(srcdir)/BEAM/eamindex.c $(srcdir)/BEAM/eamamasm.c \
@ -366,7 +368,7 @@ ENGINE_OBJECTS = \
sysbits.o threads.o tracer.o \
udi.o rtree.o rtree_udi.o\
unify.o userpreds.o utilpreds.o \
write.o \
yap-args.o write.o \
blobs.o swi.o ypstdio.o $(IOLIB_OBJECTS) @MPI_OBJS@
LIBTAI_OBJECTS = \
@ -405,11 +407,13 @@ PLCONS_OBJECTS = \
pl-ntconsole.o \
pl-ntmain.o
all: parms.h startup.yss @ENABLE_WINCONSOLE@ pl-yap@EXEC_SUFFIX@
all: parms.h startup.yss @ENABLE_WINCONSOLE@ yap-win@EXEC_SUFFIX@
Makefile: $(srcdir)/Makefile.in
$(srcdir)/H/Yap.h: config.h YapTermConfig.h $(srcdir)/H/YapTags.h
$(srcdir)/H/Yap.h: config.h YapTermConfig.h \
$(srcdir)/H/YapTags.h \
$(srcdir)/H/YapCompoundTerm.h
config.h: parms.h
@ -439,6 +443,9 @@ parms.h: Makefile
c_interface.o: $(srcdir)/C/c_interface.c $(srcdir)/include/c_interface.h config.h
$(CC) $(C_INTERF_FLAGS) -c $(srcdir)/C/c_interface.c -o c_interface.o
yap-argss.o: $(srcdir)/C/yap-args.c $(srcdir)/include/c_interface.h config.h
$(CC) $(C_INTERF_FLAGS) -c $(srcdir)/C/yap-args.c -o yap-args.o
clause_list.o: $(srcdir)/C/clause_list.c $(srcdir)/include/clause_list.h config.h
$(CC) $(C_INTERF_FLAGS) -c $(srcdir)/C/clause_list.c -o clause_list.o
@ -578,7 +585,7 @@ pl-nt.o: $(srcdir)/os/pl-nt.c config.h
$(CC) -c $(CFLAGS) -I$(srcdir)/include -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/os/pl-nt.c -o $@
pl-ntcon.o: $(srcdir)/console/LGPL/pl-ntcon.c config.h
$(CC) -municode -DUNICODE -D_UNICODE -c $(CFLAGS) -DPL_CONSOLE=1 -I$(srcdir)/include $(srcdir)/console/LGPL/pl-ntcon.c -o $@
$(CC) -c $(CFLAGS) -DPL_CONSOLE=1 -I$(srcdir)/include $(srcdir)/console/LGPL/pl-ntcon.c -o $@
pl-ntconsole.o: $(srcdir)/console/LGPL/pl-ntconsole.c config.h
$(CC) -municode -DUNICODE -D_UNICODE -c $(CFLAGS) -DPL_CONSOLE=1 -I$(srcdir) -I$(srcdir)/include -I$(srcdir)/os @EXTRA_INCLUDES_FOR_WIN32@ $(srcdir)/console/LGPL/pl-ntconsole.c -o $@
@ -703,7 +710,7 @@ all: startup.yss
@ENABLE_SEMWEB@ @INSTALL_DLLS@ (cd packages/semweb; $(MAKE))
@ENABLE_SGML@ @INSTALL_DLLS@ (cd packages/sgml; $(MAKE))
@ENABLE_REAL@ (cd packages/real; $(MAKE))
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/clpbn/bp ; $(MAKE))
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/horus; $(MAKE))
@ENABLE_MINISAT@ (cd packages/swi-minisat2/C; $(MAKE))
@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE))
@ENABLE_CPLINT@ (cd packages/cplint/approx/simplecuddLPADs; $(MAKE))
@ -722,13 +729,13 @@ startup.yss: yap@EXEC_SUFFIX@ $(PL_SOURCES)
yap@EXEC_SUFFIX@: $(HEADERS) yap.o @YAPLIB@
$(MPI_CC) $(EXECUTABLE_CFLAGS) $(LDFLAGS) -o yap yap.o @YAPLIB@ $(LIBS) @MPI_LIBS@
plyap: pl-yap@EXEC_SUFFIX@
yap-win: yap-win@EXEC_SUFFIX@
pl-yap: pl-yap@EXEC_SUFFIX@
yapwin: yap-win@EXEC_SUFFIX@
pl-yap@EXEC_SUFFIX@: $(PLCONS_OBJECTS) $(HEADERS) @YAPLIB@
yap-win@EXEC_SUFFIX@: $(PLCONS_OBJECTS) $(HEADERS) @YAPLIB@
(cd LGPL/swi_console; $(MAKE))
$(MPI_CC) -municode -DUNICODE -D_UNICODE $(EXECUTABLE_CFLAGS) $(LDFLAGS) -Wl,-subsystem,windows -o pl-yap $(PLCONS_OBJECTS) plterm.dll @YAPLIB@ $(LIBS) @MPI_LIBS@
$(MPI_CC) -municode -DUNICODE -D_UNICODE $(EXECUTABLE_CFLAGS) $(LDFLAGS) -Wl,-subsystem,windows -o yap-win $(PLCONS_OBJECTS) plterm.dll @YAPLIB@ $(LIBS) @MPI_LIBS@
libYap.a: $(LIB_OBJECTS)
-rm -f libYap.a
@ -772,7 +779,7 @@ install_unix: startup.yss libYap.a
@ENABLE_SEMWEB@ @INSTALL_DLLS@ (cd packages/semweb; $(MAKE) install)
@ENABLE_SGML@ @INSTALL_DLLS@ (cd packages/sgml; $(MAKE) install)
@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE) @ZLIB_INSTALL@)
@ENABLE_CLPBN_BP@ @INSTALL_DLLS@ (cd packages/CLPBN/clpbn/bp ; $(MAKE) install)
@ENABLE_CLPBN_BP@ @INSTALL_DLLS@ (cd packages/CLPBN/horus; $(MAKE) install)
@ENABLE_MINISAT@ (cd packages/swi-minisat2/C; $(MAKE) install)
@INSTALL_MATLAB@ (cd library/matlab; $(MAKE) install)
@ENABLE_REAL@ (cd packages/real; $(MAKE) install)
@ -794,14 +801,14 @@ install_unix: startup.yss libYap.a
@ENABLE_CUDD@ (cd packages/ProbLog/simplecudd_lfi; $(MAKE) install)
install_win32: startup.yss @ENABLE_WINCONSOLE@ pl-yap@EXEC_SUFFIX@
install_win32: startup.yss @ENABLE_WINCONSOLE@ yap-win@EXEC_SUFFIX@
mkdir -p $(DESTDIR)$(BINDIR)
mkdir -p $(DESTDIR)$(LIBDIR)
mkdir -p $(DESTDIR)$(YAPLIBDIR)
mkdir -p $(DESTDIR)$(INCLUDEDIR)
$(INSTALL_PROGRAM) -m 755 yap.exe $(DESTDIR)$(BINDIR)/yap.exe
$(INSTALL_PROGRAM) -m 755 yap.dll $(DESTDIR)$(BINDIR)/yap.dll
@ENABLE_WINCONSOLE@ $(INSTALL_PROGRAM) -m 755 pl-yap.exe $(DESTDIR)$(BINDIR)/pl-yap.exe
@ENABLE_WINCONSOLE@ $(INSTALL_PROGRAM) -m 755 yap-win.exe $(DESTDIR)$(BINDIR)/yap-win.exe
@ENABLE_WINCONSOLE@ $(INSTALL_PROGRAM) -m 755 plterm.dll $(DESTDIR)$(BINDIR)/plterm.dll
$(INSTALL_PROGRAM) -m 755 @YAPLIB@ $(DESTDIR)$(YAPLIBDIR)/@YAPLIB@
$(INSTALL_PROGRAM) -m 755 startup.yss $(DESTDIR)$(YAPLIBDIR)/startup.yss
@ -836,7 +843,7 @@ install_win32: startup.yss @ENABLE_WINCONSOLE@ pl-yap@EXEC_SUFFIX@
@ENABLE_SGML@ (cd packages/sgml; $(MAKE) install)
@ENABLE_ZLIB@ (cd packages/zlib; $(MAKE) @ZLIB_INSTALL@)
(cd packages/CLPBN ; $(MAKE) install)
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/clpbn/bp ; $(MAKE) install)
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/horus; $(MAKE) install)
@ENABLE_JPL@ (cd packages/jpl ; $(MAKE) install)
@ENABLE_MINISAT@ (cd packages/swi-minisat2/C; $(MAKE) install)
@ENABLE_CPLINT@ (cd packages/cplint; $(MAKE) install)
@ -901,7 +908,7 @@ clean: clean_docs
@ENABLE_SGML@ @INSTALL_DLLS@ (cd packages/sgml; $(MAKE) clean)
@ENABLE_REAL@ (cd packages/real; $(MAKE) clean)
@ENABLE_MINISAT@ (cd packages/swi-minisat2; $(MAKE) clean)
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/clpbn/bp; $(MAKE) clean)
@ENABLE_CLPBN_BP@ (cd packages/CLPBN/horus; $(MAKE) clean)
@ENABLE_ZLIB@ @INSTALL_DLLS@ (cd packages/zlib; $(MAKE) clean)
@ENABLE_PRISM@ (cd packages/prism/src/c; $(MAKE) clean)
@ENABLE_PRISM@ (cd packages/prism/src/prolog; $(MAKE) clean)

2
OPTYap/locks_pthread.h
View File

@ -19,7 +19,7 @@
#define INIT_LOCK(LOCK_VAR) pthread_mutex_init(&(LOCK_VAR), NULL)
#define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR))
#define TRY_LOCK(LOCK_PTR) pthread_mutex_trylock(&(LOCK_VAR))
#define TRY_LOCK(LOCK_VAR) pthread_mutex_trylock(&(LOCK_VAR))
#define LOCK(LOCK_VAR) pthread_mutex_lock(&(LOCK_VAR))
#define UNLOCK(LOCK_VAR) pthread_mutex_unlock(&(LOCK_VAR))
static inline int

10
OPTYap/opt.config.h
View File

@ -339,10 +339,16 @@
#error LIMIT_TABLING requires USE_PAGES_MALLOC
#endif
#if defined(YAPOR) || defined(THREADS)
#undef MODE_DIRECTED_TABLING
#if defined(YAPOR) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#undef TABLING_EARLY_COMPLETION
#endif
#if defined(YAPOR) || defined(THREADS)
#undef INCOMPLETE_TABLING
#undef LIMIT_TABLING
#undef DETERMINISTIC_TABLING
#endif
#if defined(YAPOR)
#undef MODE_DIRECTED_TABLING
#endif

115
OPTYap/opt.init.c
View File

@ -43,14 +43,22 @@
#ifdef USE_PAGES_MALLOC
#define STRUCTS_PER_PAGE(STR_TYPE) ((Yap_page_size - ADJUST_SIZE(sizeof(struct page_header))) / ADJUST_SIZE(sizeof(STR_TYPE)))
#define INIT_PAGES(PG, STR_TYPE) \
INIT_LOCK(Pg_lock(PG)); \
Pg_pg_alloc(PG) = 0; \
Pg_str_in_use(PG) = 0; \
Pg_str_per_pg(PG) = STRUCTS_PER_PAGE(STR_TYPE); \
Pg_free_pg(PG) = NULL
#define INIT_GLOBAL_PAGE_ENTRY(PG,STR_TYPE) \
INIT_LOCK(PgEnt_lock(PG)); \
PgEnt_pages_in_use(PG) = 0; \
PgEnt_strs_in_use(PG) = 0; \
PgEnt_strs_per_page(PG) = STRUCTS_PER_PAGE(STR_TYPE); \
PgEnt_first(PG) = NULL; \
PgEnt_last(PG) = NULL;
#define INIT_LOCAL_PAGE_ENTRY(PG,STR_TYPE) \
PgEnt_pages_in_use(PG) = 0; \
PgEnt_strs_in_use(PG) = 0; \
PgEnt_strs_per_page(PG) = STRUCTS_PER_PAGE(STR_TYPE); \
PgEnt_first(PG) = NULL; \
PgEnt_last(PG) = NULL;
#else
#define INIT_PAGES(PG, STR_TYPE) Pg_str_in_use(PG) = 0
#define INIT_GLOBAL_PAGE_ENTRY(PG,STR_TYPE) PgEnt_strs_in_use(PG) = 0
#define INIT_LOCAL_PAGE_ENTRY(PG,STR_TYPE) PgEnt_strs_in_use(PG) = 0
#endif /* USE_PAGES_MALLOC */
@ -63,39 +71,39 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop
int i;
/* global data related to memory management */
INIT_PAGES(GLOBAL_pages_void, void *);
#ifdef USE_PAGES_MALLOC
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_alloc, void *);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_void, void *);
#endif /* USE_PAGES_MALLOC */
#ifdef TABLING
INIT_PAGES(GLOBAL_pages_tab_ent, struct table_entry);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tab_ent, struct table_entry);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
INIT_PAGES(GLOBAL_pages_sg_ent, struct subgoal_entry);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_sg_ent, struct subgoal_entry);
#endif
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
INIT_PAGES(GLOBAL_pages_sg_fr, struct subgoal_frame);
INIT_PAGES(GLOBAL_pages_dep_fr, struct dependency_frame);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_sg_fr, struct subgoal_frame);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_dep_fr, struct dependency_frame);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_sg_node, struct subgoal_trie_node);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_sg_hash, struct subgoal_trie_hash);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_ans_node, struct answer_trie_node);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_ans_hash, struct answer_trie_hash);
#if defined(THREADS_FULL_SHARING)
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_ans_ref_node, struct answer_ref_node);
#endif
#if !defined(THREADS_NO_SHARING)
INIT_PAGES(GLOBAL_pages_sg_node, struct subgoal_trie_node);
INIT_PAGES(GLOBAL_pages_sg_hash, struct subgoal_trie_hash);
#endif
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
INIT_PAGES(GLOBAL_pages_ans_node, struct answer_trie_node);
INIT_PAGES(GLOBAL_pages_ans_hash, struct answer_trie_hash);
#endif
INIT_PAGES(GLOBAL_pages_gt_node, struct global_trie_node);
INIT_PAGES(GLOBAL_pages_gt_hash, struct global_trie_hash);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_gt_node, struct global_trie_node);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_gt_hash, struct global_trie_hash);
#endif /* TABLING */
#ifdef YAPOR
INIT_PAGES(GLOBAL_pages_or_fr, struct or_frame);
INIT_PAGES(GLOBAL_pages_qg_sol_fr, struct query_goal_solution_frame);
INIT_PAGES(GLOBAL_pages_qg_ans_fr, struct query_goal_answer_frame);
#endif /* YAPOR */
#if defined(YAPOR) && defined(TABLING)
INIT_PAGES(GLOBAL_pages_susp_fr, struct suspension_frame);
#endif /* YAPOR && TABLING */
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_or_fr, struct or_frame);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_qg_sol_fr, struct query_goal_solution_frame);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_qg_ans_fr, struct query_goal_answer_frame);
#ifdef TABLING
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_susp_fr, struct suspension_frame);
#endif
#ifdef TABLING_INNER_CUTS
INIT_PAGES(GLOBAL_pages_tg_sol_fr, struct table_subgoal_solution_frame);
INIT_PAGES(GLOBAL_pages_tg_ans_fr, struct table_subgoal_answer_frame);
#endif /* TABLING_INNER_CUTS */
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tg_sol_fr, struct table_subgoal_solution_frame);
INIT_GLOBAL_PAGE_ENTRY(GLOBAL_pages_tg_ans_fr, struct table_subgoal_answer_frame);
#endif
#endif /* YAPOR */
#ifdef YAPOR
/* global static data */
@ -136,7 +144,7 @@ void Yap_init_global_optyap_data(int max_table_size, int n_workers, int sch_loop
#ifdef TABLING
/* global data related to tabling */
new_global_trie_node(GLOBAL_root_gt, 0, NULL, NULL, NULL);
GLOBAL_root_gt = NULL;
GLOBAL_root_tab_ent = NULL;
#ifdef LIMIT_TABLING
if (max_table_size)
@ -171,30 +179,28 @@ void Yap_init_local_optyap_data(int wid) {
#if defined(TABLING) && (defined(YAPOR) || defined(THREADS))
/* local data related to memory management */
#if defined(YAPOR)
#ifdef YAPOR
REMOTE_next_free_ans_node(wid) = NULL;
#elif defined(THREADS)
INIT_PAGES(REMOTE_pages_void(wid), void *);
INIT_PAGES(REMOTE_pages_sg_fr(wid), struct subgoal_frame);
INIT_PAGES(REMOTE_pages_dep_fr(wid), struct dependency_frame);
#if defined(THREADS_NO_SHARING)
INIT_PAGES(REMOTE_pages_sg_node(wid), struct subgoal_trie_node);
INIT_PAGES(REMOTE_pages_sg_hash(wid), struct subgoal_trie_hash);
#elif defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
REMOTE_next_free_sg_node(wid) = NULL;
REMOTE_next_free_sg_hash(wid) = NULL;
#elif THREADS
#ifdef USE_PAGES_MALLOC
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_void(wid), void *);
#endif
#if defined(THREADS_NO_SHARING) || defined(THREADS_SUBGOAL_SHARING)
INIT_PAGES(REMOTE_pages_ans_node(wid), struct answer_trie_node);
INIT_PAGES(REMOTE_pages_ans_hash(wid), struct answer_trie_hash);
#elif defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
REMOTE_next_free_ans_node(wid) = NULL;
REMOTE_next_free_ans_hash(wid) = NULL;
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_tab_ent(wid), struct table_entry);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_sg_ent(wid), struct subgoal_entry);
#endif
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_sg_fr(wid), struct subgoal_frame);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_dep_fr(wid), struct dependency_frame);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_sg_node(wid), struct subgoal_trie_node);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_sg_hash(wid), struct subgoal_trie_hash);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_ans_node(wid), struct answer_trie_node);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_ans_hash(wid), struct answer_trie_hash);
#if defined(THREADS_FULL_SHARING)
INIT_PAGES(REMOTE_pages_ans_ref_node(wid), struct answer_ref_node);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_ans_ref_node(wid), struct answer_ref_node);
#endif
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_gt_node(wid), struct global_trie_node);
INIT_LOCAL_PAGE_ENTRY(REMOTE_pages_gt_hash(wid), struct global_trie_hash);
#endif
#endif /* YAPOR - THREADS */
#endif /* TABLING && (YAPOR || THREADS) */
#ifdef YAPOR
@ -214,6 +220,7 @@ void Yap_init_local_optyap_data(int wid) {
#ifdef TABLING
/* local data related to tabling */
REMOTE_top_sg_fr(wid) = NULL;
REMOTE_top_dep_fr(wid) = NULL;
#ifdef YAPOR
REMOTE_top_dep_fr(wid) = GLOBAL_root_dep_fr;
Set_REMOTE_top_cp_on_stack(wid, (choiceptr) LOCAL_LocalBase); /* ??? */
@ -258,6 +265,8 @@ void Yap_init_root_frames(void) {
#endif /* YAPOR */
#ifdef TABLING
/* root global trie node */
new_global_trie_node(GLOBAL_root_gt, 0, NULL, NULL, NULL);
/* root dependency frame */
#ifdef YAPOR
DepFr_cons_cp(GLOBAL_root_dep_fr) = B; /* with YAPOR, at that point, LOCAL_top_dep_fr shouldn't be the same as GLOBAL_root_dep_fr ? */

704
OPTYap/opt.macros.h
View File

@ -40,348 +40,452 @@ extern int Yap_page_size;
#define ADJUST_SIZE_TO_PAGE(SIZE) ((SIZE) - (SIZE) % Yap_page_size + Yap_page_size)
#define PAGE_HEADER(STR) (pg_hd_ptr)((unsigned long int)STR - (unsigned long int)STR % Yap_page_size)
#define STRUCT_NEXT(STR) ((STR)->next)
#define UPDATE_STATS(STAT, VALUE) STAT += VALUE
#ifdef YAPOR
#define LOCK_PAGE_ENTRY(PG_ENT) LOCK(PgEnt_lock(PG_ENT))
#define UNLOCK_PAGE_ENTRY(PG_ENT) UNLOCK(PgEnt_lock(PG_ENT))
#else
#define LOCK_PAGE_ENTRY(PG_ENT)
#define UNLOCK_PAGE_ENTRY(PG_ENT)
#endif
#ifdef USE_SYSTEM_MALLOC
/**************************************************************************************
** USE_SYSTEM_MALLOC **
**************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
if ((STR = (STR_TYPE *) malloc(SIZE)) == NULL) \
/*******************************************************************************************
** USE_SYSTEM_MALLOC **
*******************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
if ((STR = (STR_TYPE *) malloc(SIZE)) == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error")
#define FREE_BLOCK(STR) \
#define FREE_BLOCK(STR) \
free(STR)
#else
/**************************************************************************************
** ! USE_SYSTEM_MALLOC **
**************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
{ char *block_ptr; \
if ((block_ptr = Yap_AllocCodeSpace(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'y'; \
else if ((block_ptr = (char *) malloc(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'm'; \
else \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error"); \
block_ptr += sizeof(CELL); \
STR = (STR_TYPE *) block_ptr; \
/*******************************************************************************************
** ! USE_SYSTEM_MALLOC **
*******************************************************************************************/
#define ALLOC_BLOCK(STR, SIZE, STR_TYPE) \
{ char *block_ptr; \
if ((block_ptr = Yap_AllocCodeSpace(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'y'; \
else if ((block_ptr = (char *) malloc(SIZE + sizeof(CELL))) != NULL) \
*block_ptr = 'm'; \
else \
Yap_Error(FATAL_ERROR, TermNil, "ALLOC_BLOCK: malloc error"); \
block_ptr += sizeof(CELL); \
STR = (STR_TYPE *) block_ptr; \
}
#define FREE_BLOCK(STR) \
{ char *block_ptr = (char *)(STR) - sizeof(CELL); \
if (block_ptr[0] == 'y') \
Yap_FreeCodeSpace(block_ptr); \
else \
free(block_ptr); \
#define FREE_BLOCK(STR) \
{ char *block_ptr = (char *)(STR) - sizeof(CELL); \
if (block_ptr[0] == 'y') \
Yap_FreeCodeSpace(block_ptr); \
else \
free(block_ptr); \
}
#endif /******************************************************************************/
#define INIT_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **init_bucket_ptr; \
init_bucket_ptr = (void **) BUCKET_PTR; \
for (i = NUM_BUCKETS; i != 0; i--) \
*init_bucket_ptr++ = NULL; \
#endif /***********************************************************************************/
#define INIT_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ int i; void **init_bucket_ptr; \
init_bucket_ptr = (void **) BUCKET_PTR; \
for (i = NUM_BUCKETS; i != 0; i--) \
*init_bucket_ptr++ = NULL; \
}
#define ALLOC_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ void **alloc_bucket_ptr; \
ALLOC_BLOCK(alloc_bucket_ptr, NUM_BUCKETS * sizeof(void *), void *); \
INIT_BUCKETS(alloc_bucket_ptr, NUM_BUCKETS); \
BUCKET_PTR = (void *) alloc_bucket_ptr; \
#define ALLOC_BUCKETS(BUCKET_PTR, NUM_BUCKETS) \
{ void **alloc_bucket_ptr; \
ALLOC_BLOCK(alloc_bucket_ptr, NUM_BUCKETS * sizeof(void *), void *); \
INIT_BUCKETS(alloc_bucket_ptr, NUM_BUCKETS); \
BUCKET_PTR = (void *) alloc_bucket_ptr; \
}
#define FREE_BUCKETS(BUCKET_PTR) FREE_BLOCK(BUCKET_PTR)
#ifndef USE_PAGES_MALLOC
/**************************************************************************************
** ! USE_PAGES_MALLOC **
**************************************************************************************/
#define ALLOC_STRUCT(STR, STR_TYPE, STR_PAGES, VOID_PAGES) \
LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
UNLOCK(Pg_lock(STR_PAGES)); \
/*******************************************************************************************
** ! USE_PAGES_MALLOC **
*******************************************************************************************/
#define MOVE_PAGES(FROM_PG_ENT, TO_PG_ENT) \
UPDATE_STATS(PgEnt_strs_in_use(TO_PG_ENT), PgEnt_strs_in_use(FROM_PG_ENT)); \
PgEnt_strs_in_use(FROM_PG_ENT) = 0
#define DETACH_PAGES(_PG_ENT) \
LOCK(PgEnt_lock(GLOBAL##_PG_ENT)); \
MOVE_PAGES(LOCAL##_PG_ENT, GLOBAL##_PG_ENT); \
UNLOCK(PgEnt_lock(GLOBAL##_PG_ENT))
#define ATTACH_PAGES(_PG_ENT) \
MOVE_PAGES(GLOBAL##_PG_ENT, LOCAL##_PG_ENT)
#define GET_FREE_STRUCT(STR, STR_TYPE, PG_ENT, EXTRA_PG_ENT) \
LOCK_PAGE_ENTRY(PG_ENT); \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), 1); \
UNLOCK_PAGE_ENTRY(PG_ENT); \
ALLOC_BLOCK(STR, sizeof(STR_TYPE), STR_TYPE)
#define LOCAL_NEXT_ALLOC_STRUCT(STR, LOCAL_STR, STR_TYPE, STR_PAGES, VOID_PAGES) \
ALLOC_STRUCT(STR, STR_TYPE, STR_PAGES, VOID_PAGES)
#define FREE_STRUCT(STR, STR_TYPE, STR_PAGES, VOID_PAGES) \
LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
UNLOCK(Pg_lock(STR_PAGES)); \
#define GET_NEXT_FREE_STRUCT(LOCAL_STR, STR, STR_TYPE, PG_ENT) \
GET_FREE_STRUCT(STR, STR_TYPE, PG_ENT, ___NOT_USED___)
#define PUT_FREE_STRUCT(STR, STR_TYPE, PG_ENT) \
LOCK_PAGE_ENTRY(PG_ENT); \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), -1); \
UNLOCK_PAGE_ENTRY(PG_ENT); \
FREE_BLOCK(STR)
#else
/**************************************************************************************
** USE_PAGES_MALLOC && ! LIMIT_TABLING **
**************************************************************************************/
#ifndef LIMIT_TABLING
#define ALLOC_STRUCT_TEST_PAGE if
#define ALLOC_STRUCT_RECOVER_SPACE(PG_HD, STR_PAGES, VOID_PAGES)
/*******************************************************************************************
** USE_PAGES_MALLOC **
*******************************************************************************************/
#define MOVE_PAGES(FROM_PG_ENT, TO_PG_ENT) \
if (PgEnt_first(TO_PG_ENT)) { \
PgHd_next(PgEnt_last(TO_PG_ENT)) = PgEnt_first(FROM_PG_ENT); \
PgHd_previous(PgEnt_first(FROM_PG_ENT)) = PgEnt_last(TO_PG_ENT); \
} else \
PgEnt_first(TO_PG_ENT) = PgEnt_first(FROM_PG_ENT); \
PgEnt_last(TO_PG_ENT) = PgEnt_last(FROM_PG_ENT); \
UPDATE_STATS(PgEnt_pages_in_use(TO_PG_ENT), PgEnt_pages_in_use(FROM_PG_ENT)); \
UPDATE_STATS(PgEnt_strs_in_use(TO_PG_ENT), PgEnt_strs_in_use(FROM_PG_ENT)); \
PgEnt_first(FROM_PG_ENT) = PgEnt_last(FROM_PG_ENT) = NULL; \
PgEnt_pages_in_use(FROM_PG_ENT) = PgEnt_strs_in_use(FROM_PG_ENT) = 0
#define DETACH_PAGES(_PG_ENT) \
if (PgEnt_first(LOCAL##_PG_ENT)) { \
LOCK(PgEnt_lock(GLOBAL##_PG_ENT)); \
MOVE_PAGES(LOCAL##_PG_ENT, GLOBAL##_PG_ENT); \
UNLOCK(PgEnt_lock(GLOBAL##_PG_ENT)); \
}
#define ATTACH_PAGES(_PG_ENT) \
if (PgEnt_first(GLOBAL##_PG_ENT)) { \
MOVE_PAGES(GLOBAL##_PG_ENT, LOCAL##_PG_ENT); \
}
/*******************************************************************************************
#define GET_PAGE_FIRST_LEVEL(PG_HD) GET_VOID_PAGE(PG_HD)
#define GET_VOID_PAGE_NEXT_LEVEL(PG_HD) GET_ALLOC_PAGE(PG_HD)
#define GET_ALLOC_PAGE_NEXT_LEVEL(PG_HD)
*******************************************************************************************/
#define GET_PAGE_FIRST_LEVEL(PG_HD) GET_ALLOC_PAGE(PG_HD)
#define GET_ALLOC_PAGE_NEXT_LEVEL(PG_HD) GET_VOID_PAGE(PG_HD)
#define GET_VOID_PAGE_NEXT_LEVEL(PG_HD)
#define GET_ALLOC_PAGE(PG_HD) \
LOCK(PgEnt_lock(GLOBAL_pages_alloc)); \
if ((PG_HD = PgEnt_first(GLOBAL_pages_alloc)) == NULL) { \
UNLOCK(PgEnt_lock(GLOBAL_pages_alloc)); \
GET_ALLOC_PAGE_NEXT_LEVEL(PG_HD); \
} else { \
PgEnt_first(GLOBAL_pages_alloc) = (pg_hd_ptr)(((void *)PG_HD) + Yap_page_size); \
if (PgEnt_first(GLOBAL_pages_alloc) == PgEnt_last(GLOBAL_pages_alloc)) \
PgEnt_first(GLOBAL_pages_alloc) = NULL; \
UNLOCK(PgEnt_lock(GLOBAL_pages_alloc)); \
}
#define GET_VOID_PAGE(PG_HD) \
LOCK(PgEnt_lock(GLOBAL_pages_void)); \
if ((PG_HD = PgEnt_first(GLOBAL_pages_void)) == NULL) { \
UNLOCK(PgEnt_lock(GLOBAL_pages_void)); \
GET_VOID_PAGE_NEXT_LEVEL(PG_HD); \
} else { \
if ((PgEnt_first(GLOBAL_pages_void) = PgHd_next(PG_HD)) == NULL) \
PgEnt_last(GLOBAL_pages_void) = NULL; \
UNLOCK(PgEnt_lock(GLOBAL_pages_void)); \
}
#define PUT_PAGE(PG_HD, PG_ENT) \
if ((PgHd_next(PG_HD) = PgEnt_first(PG_ENT)) == NULL) \
PgEnt_last(PG_ENT) = PG_HD; \
else \
PgHd_previous(PgHd_next(PG_HD)) = PG_HD; \
PgEnt_first(PG_ENT) = PG_HD; \
UPDATE_STATS(PgEnt_pages_in_use(PG_ENT), 1)
#define PUT_VOID_PAGE(PG_HD, PG_ENT) \
if ((PgHd_next(PG_HD) = PgEnt_first(PG_ENT)) == NULL) \
PgEnt_last(PG_ENT) = PG_HD; \
PgEnt_first(PG_ENT) = PG_HD
#ifdef THREADS
#define GET_FREE_PAGE(PG_HD) \
if ((PG_HD = PgEnt_first(LOCAL_pages_void)) == NULL) { \
GET_PAGE_FIRST_LEVEL(PG_HD); \
} else { \
if ((PgEnt_first(LOCAL_pages_void) = PgHd_next(PG_HD)) == NULL) \
PgEnt_last(LOCAL_pages_void) = NULL; \
}
#define PUT_FREE_PAGE(PG_HD) \
PUT_VOID_PAGE(PG_HD, LOCAL_pages_void)
#else
/**************************************************************************************
** USE_PAGES_MALLOC && LIMIT_TABLING **
**************************************************************************************/
#define ALLOC_STRUCT_TEST_PAGE while
#define ALLOC_STRUCT_RECOVER_SPACE(PG_HD, STR_PAGES, VOID_PAGES) \
if (Pg_free_pg(VOID_PAGES) == NULL && \
GLOBAL_max_pages == Pg_pg_alloc(VOID_PAGES)) { \
sg_fr_ptr sg_fr = GLOBAL_check_sg_fr; \
UNLOCK(Pg_lock(VOID_PAGES)); \
do { \
if (sg_fr) \
sg_fr = SgFr_next(sg_fr); \
else \
sg_fr = GLOBAL_first_sg_fr; \
if (sg_fr == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "no space left (RECOVER_SPACE)"); \
/* see function 'InteractSIGINT' in file 'sysbits.c' */ \
/* Yap_Error(PURE_ABORT, TermNil, ""); */ \
/* restore_absmi_regs(&Yap_standard_regs); */ \
/* siglongjmp (LOCAL_RestartEnv, 1); */ \
if (SgFr_first_answer(sg_fr) && \
SgFr_first_answer(sg_fr) != SgFr_answer_trie(sg_fr)) { \
SgFr_state(sg_fr) = ready; \
free_answer_hash_chain(SgFr_hash_chain(sg_fr)); \
SgFr_hash_chain(sg_fr) = NULL; \
SgFr_first_answer(sg_fr) = NULL; \
SgFr_last_answer(sg_fr) = NULL; \
free_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), \
TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); \
TrNode_child(SgFr_answer_trie(sg_fr)) = NULL; \
} \
} while (Pg_free_pg(VOID_PAGES) == Pg_free_pg(STR_PAGES)); \
GLOBAL_check_sg_fr = sg_fr; \
LOCK(Pg_lock(STR_PAGES)); \
PG_HD = Pg_free_pg(STR_PAGES); \
} else
#define GET_FREE_PAGE(PG_HD) \
GET_PAGE_FIRST_LEVEL(PG_HD)
#define PUT_FREE_PAGE(PG_HD) \
PUT_VOID_PAGE(PG_HD, GLOBAL_pages_void)
#endif
/**************************************************************************************
** USE_PAGES_MALLOC **
**************************************************************************************/
#define ALLOC_VOID_PAGES(PG_HD, VOID_PAGES) \
{ int i, shmid; \
pg_hd_ptr aux_pg_hd; \
if ((shmid = shmget(IPC_PRIVATE, SHMMAX, SHM_R|SHM_W)) == -1) \
Yap_Error(FATAL_ERROR, TermNil, "shmget error (ALLOC_VOID_PAGES)"); \
if ((PG_HD = (pg_hd_ptr) shmat(shmid, NULL, 0)) == (void *) -1) \
Yap_Error(FATAL_ERROR, TermNil, "shmat error (ALLOC_VOID_PAGES)"); \
if (shmctl(shmid, IPC_RMID, 0) != 0) \
Yap_Error(FATAL_ERROR, TermNil, "shmctl error (ALLOC_VOID_PAGES)"); \
aux_pg_hd = (pg_hd_ptr)(((void *)PG_HD) + Yap_page_size); \
Pg_free_pg(VOID_PAGES) = aux_pg_hd; \
for (i = 2; i < SHMMAX / Yap_page_size; i++) { \
PgHd_next(aux_pg_hd) = (pg_hd_ptr)(((void *)aux_pg_hd) + Yap_page_size); \
aux_pg_hd = PgHd_next(aux_pg_hd); \
} \
PgHd_next(aux_pg_hd) = NULL; \
UPDATE_STATS(Pg_pg_alloc(VOID_PAGES), SHMMAX / Yap_page_size); \
UPDATE_STATS(Pg_str_in_use(VOID_PAGES), 1); \
#define INIT_PAGE(PG_HD, STR_TYPE, PG_ENT) \
PgHd_strs_in_use(PG_HD) = 0; \
PgHd_previous(PG_HD) = NULL; \
PgHd_next(PG_HD) = NULL; \
PgHd_first_str(PG_HD) = NULL; \
PgHd_alloc_area(PG_HD) = (void *) (PG_HD + 1); \
PgHd_alloc_area(PG_HD) += sizeof(STR_TYPE) * PgEnt_strs_per_page(PG_ENT)
/*******************************************************************************************
#define OLD_INIT_PAGE(PG_HD, STR_TYPE, PG_ENT) \
{ int i; \
STR_TYPE *aux_str; \
PgHd_strs_in_use(PG_HD) = 0; \
PgHd_previous(PG_HD) = NULL; \
PgHd_next(PG_HD) = NULL; \
PgHd_alloc_area(PG_HD) = NULL; \
PgHd_first_str(PG_HD) = (void *) (PG_HD + 1); \
aux_str = (STR_TYPE *) PgHd_first_str(PG_HD); \
for (i = 1; i < PgEnt_strs_per_page(PG_ENT); i++) { \
STRUCT_NEXT(aux_str) = aux_str + 1; \
aux_str++; \
} \
STRUCT_NEXT(aux_str) = NULL; \
}
*******************************************************************************************/
#define ALLOC_SPACE() \
LOCK(PgEnt_lock(GLOBAL_pages_alloc)); \
if (PgEnt_first(GLOBAL_pages_alloc) == NULL) { \
int shmid; \
void *mem_block; \
if ((shmid = shmget(IPC_PRIVATE, SHMMAX, SHM_R|SHM_W)) == -1) \
Yap_Error(FATAL_ERROR, TermNil, "shmget error (ALLOC_PAGE)"); \
if ((mem_block = shmat(shmid, NULL, 0)) == (void *) -1) \
Yap_Error(FATAL_ERROR, TermNil, "shmat error (ALLOC_PAGE)"); \
if (shmctl(shmid, IPC_RMID, 0) != 0) \
Yap_Error(FATAL_ERROR, TermNil, "shmctl error (ALLOC_PAGE)"); \
PgEnt_first(GLOBAL_pages_alloc) = (pg_hd_ptr)(mem_block + Yap_page_size); \
PgEnt_last(GLOBAL_pages_alloc) = (pg_hd_ptr)(mem_block + SHMMAX); \
UPDATE_STATS(PgEnt_pages_in_use(GLOBAL_pages_alloc), SHMMAX / Yap_page_size); \
} \
UNLOCK(PgEnt_lock(GLOBAL_pages_alloc))
#ifdef LIMIT_TABLING
#define RECOVER_ALLOC_SPACE(PG_ENT, EXTRA_PG_ENT) \
if (GLOBAL_max_pages == PgEnt_pages_in_use(GLOBAL_pages_alloc)) { \
sg_fr_ptr sg_fr = GLOBAL_check_sg_fr; \
do { \
if (sg_fr) \
sg_fr = SgFr_next(sg_fr); \
else \
sg_fr = GLOBAL_first_sg_fr; \
if (sg_fr == NULL) \
Yap_Error(FATAL_ERROR, TermNil, "no space left (RECOVER_SPACE)"); \
/* see function 'InteractSIGINT' in file 'sysbits.c' */ \
/* Yap_Error(PURE_ABORT, TermNil, ""); */ \
/* restore_absmi_regs(&Yap_standard_regs); */ \
/* siglongjmp (LOCAL_RestartEnv, 1); */ \
if (SgFr_first_answer(sg_fr) && \
SgFr_first_answer(sg_fr) != SgFr_answer_trie(sg_fr)) { \
SgFr_state(sg_fr) = ready; \
free_answer_hash_chain(SgFr_hash_chain(sg_fr)); \
SgFr_hash_chain(sg_fr) = NULL; \
SgFr_first_answer(sg_fr) = NULL; \
SgFr_last_answer(sg_fr) = NULL; \
free_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), \
TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST); \
TrNode_child(SgFr_answer_trie(sg_fr)) = NULL; \
} \
} while (PgEnt_first(GLOBAL_pages_void) == PgEnt_first(PG_ENT)); \
GLOBAL_check_sg_fr = sg_fr; \
} else { \
ALLOC_SPACE(); \
}
#elif THREADS
#define RECOVER_ALLOC_SPACE(PG_ENT, EXTRA_PG_ENT) \
LOCK(PgEnt_lock(EXTRA_PG_ENT)); \
if (PgEnt_first(EXTRA_PG_ENT)) { \
MOVE_PAGES(EXTRA_PG_ENT, PG_ENT); \
UNLOCK(PgEnt_lock(EXTRA_PG_ENT)); \
} else { \
UNLOCK(PgEnt_lock(EXTRA_PG_ENT)); \
ALLOC_SPACE(); \
}
#else
#define RECOVER_ALLOC_SPACE(PG_ENT, EXTRA_PG_ENT) \
ALLOC_SPACE()
#endif
#define TEST_GET_FREE_PAGE(PG_HD, STR_TYPE, PG_ENT, EXTRA_PG_ENT) \
while (PG_HD == NULL) { \
UNLOCK_PAGE_ENTRY(PG_ENT); \
GET_FREE_PAGE(PG_HD); \
if (PG_HD) { \
INIT_PAGE(PG_HD, STR_TYPE, PG_ENT); \
LOCK_PAGE_ENTRY(PG_ENT); \
PUT_PAGE(PG_HD, PG_ENT); \
} else { \
RECOVER_ALLOC_SPACE(PG_ENT, EXTRA_PG_ENT); \
LOCK_PAGE_ENTRY(PG_ENT); \
PG_HD = PgEnt_first(PG_ENT); \
} \
}
#define INIT_PAGE(PG_HD, STR_TYPE, STR_PAGES) \
{ int i; \
STR_TYPE *aux_str; \
PgHd_str_in_use(PG_HD) = 0; \
PgHd_previous(PG_HD) = NULL; \
PgHd_next(PG_HD) = NULL; \
PgHd_free_str(PG_HD) = (void *) (PG_HD + 1); \
aux_str = (STR_TYPE *) PgHd_free_str(PG_HD); \
for (i = 1; i < Pg_str_per_pg(STR_PAGES); i++) { \
STRUCT_NEXT(aux_str) = aux_str + 1; \
aux_str++; \
} \
STRUCT_NEXT(aux_str) = NULL; \
}
#define ALLOC_STRUCT_TEST_ALLOC_PAGE(PG_HD, STR_TYPE, STR_PAGES, VOID_PAGES) \
ALLOC_STRUCT_TEST_PAGE (PG_HD == NULL) { /* if / while */ \
UNLOCK(Pg_lock(STR_PAGES)); \
LOCK(Pg_lock(VOID_PAGES)); \
/* if (...) { ... */ \
ALLOC_STRUCT_RECOVER_SPACE(PG_HD, STR_PAGES, VOID_PAGES) \
/* } else */ \
{ \
PG_HD = Pg_free_pg(VOID_PAGES); \
if (PG_HD == NULL) { \
ALLOC_VOID_PAGES(PG_HD, VOID_PAGES); \
} else { \
Pg_free_pg(VOID_PAGES) = PgHd_next(PG_HD); \
UPDATE_STATS(Pg_str_in_use(VOID_PAGES), 1); \
} \
UNLOCK(Pg_lock(VOID_PAGES)); \
INIT_PAGE(PG_HD, STR_TYPE, STR_PAGES); \
LOCK(Pg_lock(STR_PAGES)); \
if ((PgHd_next(PG_HD) = Pg_free_pg(STR_PAGES)) != NULL) \
PgHd_previous(PgHd_next(PG_HD)) = PG_HD; \
Pg_free_pg(STR_PAGES) = PG_HD; \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), 1); \
} \
}
#define ALLOC_STRUCT(STR, STR_TYPE, STR_PAGES, VOID_PAGES) \
{ pg_hd_ptr pg_hd; \
LOCK(Pg_lock(STR_PAGES)); \
pg_hd = Pg_free_pg(STR_PAGES); \
ALLOC_STRUCT_TEST_ALLOC_PAGE(pg_hd, STR_TYPE, STR_PAGES, VOID_PAGES); \
STR = (STR_TYPE *) PgHd_free_str(pg_hd); \
if ((PgHd_free_str(pg_hd) = (void *) STRUCT_NEXT(STR)) == NULL) \
if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
UPDATE_STATS(PgHd_str_in_use(pg_hd), 1); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), 1); \
UNLOCK(Pg_lock(STR_PAGES)); \
#define GET_FREE_STRUCT(STR, STR_TYPE, PG_ENT, EXTRA_PG_ENT) \
{ pg_hd_ptr pg_hd; \
LOCK_PAGE_ENTRY(PG_ENT); \
pg_hd = PgEnt_first(PG_ENT); \
TEST_GET_FREE_PAGE(pg_hd, STR_TYPE, PG_ENT, EXTRA_PG_ENT); \
if (PgHd_alloc_area(pg_hd)) { \
STR = ((STR_TYPE *) PgHd_alloc_area(pg_hd)) - 1; \
if (STR == (STR_TYPE *) (pg_hd + 1)) \
PgHd_alloc_area(pg_hd) = NULL; \
else \
PgHd_alloc_area(pg_hd) = (void *) STR; \
} else { \
STR = (STR_TYPE *) PgHd_first_str(pg_hd); \
PgHd_first_str(pg_hd) = (void *) STRUCT_NEXT(STR); \
} \
if (PgHd_alloc_area(pg_hd) == NULL && PgHd_first_str(pg_hd) == NULL) { \
if ((PgEnt_first(PG_ENT) = PgHd_next(pg_hd)) == NULL) \
PgEnt_last(PG_ENT) = NULL; \
else \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
} \
UPDATE_STATS(PgHd_strs_in_use(pg_hd), 1); \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), 1); \
UNLOCK_PAGE_ENTRY(PG_ENT); \
}
#define LOCAL_NEXT_ALLOC_STRUCT(STR, LOCAL_STR, STR_TYPE, STR_PAGES, VOID_PAGES) \
STR = LOCAL_STR; \
if (STR == NULL) { \
pg_hd_ptr pg_hd; \
LOCK(Pg_lock(STR_PAGES)); \
pg_hd = Pg_free_pg(STR_PAGES); \
ALLOC_STRUCT_TEST_ALLOC_PAGE(pg_hd, STR_TYPE, STR_PAGES, VOID_PAGES); \
if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -PgHd_str_in_use(pg_hd)); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), Pg_str_per_pg(STR_PAGES)); \
UNLOCK(Pg_lock(STR_PAGES)); \
STR = (STR_TYPE *) PgHd_free_str(pg_hd); \
PgHd_free_str(pg_hd) = NULL; \
PgHd_str_in_use(pg_hd) = Pg_str_per_pg(STR_PAGES); \
} \
/*******************************************************************************************
#define OLD_GET_FREE_STRUCT(STR, STR_TYPE, PG_ENT, EXTRA_PG_ENT) \
{ pg_hd_ptr pg_hd; \
LOCK_PAGE_ENTRY(PG_ENT); \
pg_hd = PgEnt_first(PG_ENT); \
TEST_GET_FREE_PAGE(pg_hd, STR_TYPE, PG_ENT, EXTRA_PG_ENT); \
STR = (STR_TYPE *) PgHd_first_str(pg_hd); \
if ((PgHd_first_str(pg_hd) = (void *) STRUCT_NEXT(STR)) == NULL) { \
if ((PgEnt_first(PG_ENT) = PgHd_next(pg_hd)) == NULL) \
PgEnt_last(PG_ENT) = NULL; \
else \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
} \
UPDATE_STATS(PgHd_strs_in_use(pg_hd), 1); \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), 1); \
UNLOCK_PAGE_ENTRY(PG_ENT); \
}
*******************************************************************************************/
#define GET_NEXT_FREE_STRUCT(LOCAL_STR, STR, STR_TYPE, PG_ENT) \
STR = LOCAL_STR; \
if (STR == NULL) { \
pg_hd_ptr pg_hd; \
LOCK_PAGE_ENTRY(PG_ENT); \
pg_hd = PgEnt_first(PG_ENT); \
TEST_GET_FREE_PAGE(pg_hd, STR_TYPE, PG_ENT, ___NOT_USED___); \
STR = (STR_TYPE *) PgHd_first_str(pg_hd); \
PgHd_first_str(pg_hd) = NULL; \
PgHd_strs_in_use(pg_hd) = PgEnt_strs_per_page(PG_ENT); \
if ((PgEnt_first(PG_ENT) = PgHd_next(pg_hd)) == NULL) \
PgEnt_last(PG_ENT) = NULL; \
else \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), -PgHd_strs_in_use(pg_hd)); \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), PgEnt_strs_per_page(PG_ENT)); \
UNLOCK_PAGE_ENTRY(PG_ENT); \
} \
LOCAL_STR = STRUCT_NEXT(STR)
#define FREE_PAGE(PG_HD, VOID_PAGES) \
LOCK(Pg_lock(VOID_PAGES)); \
PgHd_next(PG_HD) = Pg_free_pg(VOID_PAGES); \
Pg_free_pg(VOID_PAGES) = PG_HD; \
UPDATE_STATS(Pg_str_in_use(VOID_PAGES), -1); \
UNLOCK(Pg_lock(VOID_PAGES))
#define FREE_STRUCT(STR, STR_TYPE, STR_PAGES, VOID_PAGES) \
{ pg_hd_ptr pg_hd; \
pg_hd = PAGE_HEADER(STR); \
LOCK(Pg_lock(STR_PAGES)); \
UPDATE_STATS(Pg_str_in_use(STR_PAGES), -1); \
if (--PgHd_str_in_use(pg_hd) == 0) { \
UPDATE_STATS(Pg_pg_alloc(STR_PAGES), -1); \
if (PgHd_previous(pg_hd)) { \
if ((PgHd_next(PgHd_previous(pg_hd)) = PgHd_next(pg_hd)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = PgHd_previous(pg_hd); \
} else { \
if ((Pg_free_pg(STR_PAGES) = PgHd_next(pg_hd)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
} \
UNLOCK(Pg_lock(STR_PAGES)); \
FREE_PAGE(pg_hd, VOID_PAGES); \
} else { \
if ((STRUCT_NEXT(STR) = (STR_TYPE *) PgHd_free_str(pg_hd)) == NULL) { \
PgHd_previous(pg_hd) = NULL; \
if ((PgHd_next(pg_hd) = Pg_free_pg(STR_PAGES)) != NULL) \
PgHd_previous(PgHd_next(pg_hd)) = pg_hd; \
Pg_free_pg(STR_PAGES) = pg_hd; \
} \
PgHd_free_str(pg_hd) = (void *) STR; \
UNLOCK(Pg_lock(STR_PAGES)); \
} \
#define PUT_FREE_STRUCT(STR, STR_TYPE, PG_ENT) \
{ pg_hd_ptr pg_hd; \
pg_hd = PAGE_HEADER(STR); \
LOCK_PAGE_ENTRY(PG_ENT); \
UPDATE_STATS(PgEnt_strs_in_use(PG_ENT), -1); \
if (--PgHd_strs_in_use(pg_hd) == 0) { \
UPDATE_STATS(PgEnt_pages_in_use(PG_ENT), -1); \
if (PgHd_previous(pg_hd)) { \
if ((PgHd_next(PgHd_previous(pg_hd)) = PgHd_next(pg_hd)) == NULL) \
PgEnt_last(PG_ENT) = PgHd_previous(pg_hd); \
else \
PgHd_previous(PgHd_next(pg_hd)) = PgHd_previous(pg_hd); \
} else { \
if ((PgEnt_first(PG_ENT) = PgHd_next(pg_hd)) == NULL) \
PgEnt_last(PG_ENT) = NULL; \
else \
PgHd_previous(PgHd_next(pg_hd)) = NULL; \
} \
UNLOCK_PAGE_ENTRY(PG_ENT); \
LOCK_PAGE_ENTRY(GLOBAL_pages_void); \
PUT_FREE_PAGE(pg_hd); \
UNLOCK_PAGE_ENTRY(GLOBAL_pages_void); \
} else { \
STRUCT_NEXT(STR) = (STR_TYPE *) PgHd_first_str(pg_hd); \
if (PgHd_alloc_area(pg_hd) == NULL && PgHd_first_str(pg_hd) == NULL) { \
PgHd_next(pg_hd) = NULL; \
if ((PgHd_previous(pg_hd) = PgEnt_last(PG_ENT)) != NULL) \
PgHd_next(PgHd_previous(pg_hd)) = pg_hd; \
PgEnt_last(PG_ENT) = pg_hd; \
} \
PgHd_first_str(pg_hd) = (void *) STR; \
UNLOCK_PAGE_ENTRY(PG_ENT); \
} \
}
#endif /******************************************************************************/
#endif /***********************************************************************************/
#define ALLOC_TABLE_ENTRY(STR) ALLOC_STRUCT(STR, struct table_entry, GLOBAL_pages_tab_ent, GLOBAL_pages_void)
#define FREE_TABLE_ENTRY(STR) FREE_STRUCT(STR, struct table_entry, GLOBAL_pages_tab_ent, GLOBAL_pages_void)
#define ALLOC_SUBGOAL_ENTRY(STR) ALLOC_STRUCT(STR, struct subgoal_entry, GLOBAL_pages_sg_ent, GLOBAL_pages_void)
#define FREE_SUBGOAL_ENTRY(STR) FREE_STRUCT(STR, struct subgoal_entry, GLOBAL_pages_sg_ent, GLOBAL_pages_void)
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, struct subgoal_frame, GLOBAL_pages_sg_fr, GLOBAL_pages_void)
#define FREE_SUBGOAL_FRAME(STR) FREE_STRUCT(STR, struct subgoal_frame, GLOBAL_pages_sg_fr, GLOBAL_pages_void)
#ifdef THREADS
#define ALLOC_STRUCT(STR, STR_TYPE, _PG_ENT) \
GET_FREE_STRUCT(STR, STR_TYPE, LOCAL##_PG_ENT, GLOBAL##_PG_ENT)
#define FREE_STRUCT(STR, STR_TYPE, _PG_ENT) \
PUT_FREE_STRUCT(STR, STR_TYPE, LOCAL##_PG_ENT)
#else
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, struct subgoal_frame, LOCAL_pages_sg_fr, LOCAL_pages_void)
#define FREE_SUBGOAL_FRAME(STR) FREE_STRUCT(STR, struct subgoal_frame, LOCAL_pages_sg_fr, LOCAL_pages_void)
#define ALLOC_STRUCT(STR, STR_TYPE, _PG_ENT) \
GET_FREE_STRUCT(STR, STR_TYPE, GLOBAL##_PG_ENT, ___NOT_USED___)
#define FREE_STRUCT(STR, STR_TYPE, _PG_ENT) \
PUT_FREE_STRUCT(STR, STR_TYPE, GLOBAL##_PG_ENT)
#endif
#define ALLOC_NEXT_STRUCT(LOCAL_STR, STR, STR_TYPE, _PG_ENT) \
GET_NEXT_FREE_STRUCT(LOCAL_STR, STR, STR_TYPE, GLOBAL##_PG_ENT)
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
#define ALLOC_DEPENDENCY_FRAME(STR) ALLOC_STRUCT(STR, struct dependency_frame, GLOBAL_pages_dep_fr, GLOBAL_pages_void)
#define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, struct dependency_frame, GLOBAL_pages_dep_fr, GLOBAL_pages_void)
#define ALLOC_TABLE_ENTRY(STR) ALLOC_STRUCT(STR, struct table_entry, _pages_tab_ent)
#define FREE_TABLE_ENTRY(STR) FREE_STRUCT(STR, struct table_entry, _pages_tab_ent)
#define ALLOC_SUBGOAL_ENTRY(STR) ALLOC_STRUCT(STR, struct subgoal_entry, _pages_sg_ent)
#define FREE_SUBGOAL_ENTRY(STR) FREE_STRUCT(STR, struct subgoal_entry, _pages_sg_ent)
#define ALLOC_SUBGOAL_FRAME(STR) ALLOC_STRUCT(STR, struct subgoal_frame, _pages_sg_fr)
#define FREE_SUBGOAL_FRAME(STR) FREE_STRUCT(STR, struct subgoal_frame, _pages_sg_fr)
#define ALLOC_DEPENDENCY_FRAME(STR) ALLOC_STRUCT(STR, struct dependency_frame, _pages_dep_fr)
#define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, struct dependency_frame, _pages_dep_fr)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct subgoal_trie_node, _pages_sg_node)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, struct subgoal_trie_node, _pages_sg_node)
#define ALLOC_SUBGOAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct subgoal_trie_hash, _pages_sg_hash)
#define FREE_SUBGOAL_TRIE_HASH(STR) FREE_STRUCT(STR, struct subgoal_trie_hash, _pages_sg_hash)
#ifdef YAPOR
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_NEXT_STRUCT(LOCAL_next_free_ans_node, STR, struct answer_trie_node, _pages_ans_node)
#else
#define ALLOC_DEPENDENCY_FRAME(STR) ALLOC_STRUCT(STR, struct dependency_frame, LOCAL_pages_dep_fr, LOCAL_pages_void)
#define FREE_DEPENDENCY_FRAME(STR) FREE_STRUCT(STR, struct dependency_frame, LOCAL_pages_dep_fr, LOCAL_pages_void)
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct answer_trie_node, _pages_ans_node)
#endif
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, struct answer_trie_node, _pages_ans_node)
#if !defined(THREADS_NO_SHARING)
#if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#define ALLOC_SUBGOAL_TRIE_NODE(STR) LOCAL_NEXT_ALLOC_STRUCT(STR, LOCAL_next_free_sg_node, struct subgoal_trie_node, GLOBAL_pages_sg_node, GLOBAL_pages_void)
#else
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct subgoal_trie_node, GLOBAL_pages_sg_node, GLOBAL_pages_void)
#endif
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, struct subgoal_trie_node, GLOBAL_pages_sg_node, GLOBAL_pages_void)
#else
#define ALLOC_SUBGOAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct subgoal_trie_node, LOCAL_pages_sg_node, LOCAL_pages_void)
#define FREE_SUBGOAL_TRIE_NODE(STR) FREE_STRUCT(STR, struct subgoal_trie_node, LOCAL_pages_sg_node, LOCAL_pages_void)
#endif
#define ALLOC_ANSWER_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct answer_trie_hash, _pages_ans_hash)
#define FREE_ANSWER_TRIE_HASH(STR) FREE_STRUCT(STR, struct answer_trie_hash, _pages_ans_hash)
#if !defined(THREADS_NO_SHARING)
#if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#define ALLOC_SUBGOAL_TRIE_HASH(STR) LOCAL_NEXT_ALLOC_STRUCT(STR, LOCAL_next_free_sg_hash, struct subgoal_trie_hash, GLOBAL_pages_sg_hash, GLOBAL_pages_void)
#else
#define ALLOC_SUBGOAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct subgoal_trie_hash, GLOBAL_pages_sg_hash, GLOBAL_pages_void)
#endif
#define FREE_SUBGOAL_TRIE_HASH(STR) FREE_STRUCT(STR, struct subgoal_trie_hash, GLOBAL_pages_sg_hash, GLOBAL_pages_void)
#else
#define ALLOC_SUBGOAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct subgoal_trie_hash, LOCAL_pages_sg_hash, LOCAL_pages_void)
#define FREE_SUBGOAL_TRIE_HASH(STR) FREE_STRUCT(STR, struct subgoal_trie_hash, LOCAL_pages_sg_hash, LOCAL_pages_void)
#endif
#define ALLOC_ANSWER_REF_NODE(STR) ALLOC_STRUCT(STR, struct answer_ref_node, _pages_ans_ref_node)
#define FREE_ANSWER_REF_NODE(STR) FREE_STRUCT(STR, struct answer_ref_node, _pages_ans_ref_node)
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
#if defined(YAPOR) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#define ALLOC_ANSWER_TRIE_NODE(STR) LOCAL_NEXT_ALLOC_STRUCT(STR, LOCAL_next_free_ans_node, struct answer_trie_node, GLOBAL_pages_ans_node, GLOBAL_pages_void)
#else
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct answer_trie_node, GLOBAL_pages_ans_node, GLOBAL_pages_void)
#endif
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, struct answer_trie_node, GLOBAL_pages_ans_node, GLOBAL_pages_void)
#else
#define ALLOC_ANSWER_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct answer_trie_node, LOCAL_pages_ans_node, LOCAL_pages_void)
#define FREE_ANSWER_TRIE_NODE(STR) FREE_STRUCT(STR, struct answer_trie_node, LOCAL_pages_ans_node, LOCAL_pages_void)
#endif
#define ALLOC_GLOBAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct global_trie_node, _pages_gt_node)
#define FREE_GLOBAL_TRIE_NODE(STR) FREE_STRUCT(STR, struct global_trie_node, _pages_gt_node)
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#define ALLOC_ANSWER_TRIE_HASH(STR) LOCAL_NEXT_ALLOC_STRUCT(STR, LOCAL_next_free_ans_hash, struct answer_trie_hash, GLOBAL_pages_ans_hash, GLOBAL_pages_void)
#else
#define ALLOC_ANSWER_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct answer_trie_hash, GLOBAL_pages_ans_hash, GLOBAL_pages_void)
#endif
#define FREE_ANSWER_TRIE_HASH(STR) FREE_STRUCT(STR, struct answer_trie_hash, GLOBAL_pages_ans_hash, GLOBAL_pages_void)
#else
#define ALLOC_ANSWER_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct answer_trie_hash, LOCAL_pages_ans_hash, LOCAL_pages_void)
#define FREE_ANSWER_TRIE_HASH(STR) FREE_STRUCT(STR, struct answer_trie_hash, LOCAL_pages_ans_hash, LOCAL_pages_void)
#endif
#define ALLOC_GLOBAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct global_trie_hash, _pages_gt_hash)
#define FREE_GLOBAL_TRIE_HASH(STR) FREE_STRUCT(STR, struct global_trie_hash, _pages_gt_hash)
#define ALLOC_ANSWER_REF_NODE(STR) ALLOC_STRUCT(STR, struct answer_ref_node, LOCAL_pages_ans_ref_node, LOCAL_pages_void)
#define FREE_ANSWER_REF_NODE(STR) FREE_STRUCT(STR, struct answer_ref_node, LOCAL_pages_ans_ref_node, LOCAL_pages_void)
#define ALLOC_OR_FRAME(STR) ALLOC_STRUCT(STR, struct or_frame, _pages_or_fr)
#define FREE_OR_FRAME(STR) FREE_STRUCT(STR, struct or_frame, _pages_or_fr)
#define ALLOC_GLOBAL_TRIE_NODE(STR) ALLOC_STRUCT(STR, struct global_trie_node, GLOBAL_pages_gt_node, GLOBAL_pages_void)
#define FREE_GLOBAL_TRIE_NODE(STR) FREE_STRUCT(STR, struct global_trie_node, GLOBAL_pages_gt_node, GLOBAL_pages_void)
#define ALLOC_QG_SOLUTION_FRAME(STR) ALLOC_STRUCT(STR, struct query_goal_solution_frame, _pages_qg_sol_fr)
#define FREE_QG_SOLUTION_FRAME(STR) FREE_STRUCT(STR, struct query_goal_solution_frame, _pages_qg_sol_fr)
#define ALLOC_GLOBAL_TRIE_HASH(STR) ALLOC_STRUCT(STR, struct global_trie_hash, GLOBAL_pages_gt_hash, GLOBAL_pages_void)
#define FREE_GLOBAL_TRIE_HASH(STR) FREE_STRUCT(STR, struct global_trie_hash, GLOBAL_pages_gt_hash, GLOBAL_pages_void)
#define ALLOC_QG_ANSWER_FRAME(STR) ALLOC_STRUCT(STR, struct query_goal_answer_frame, _pages_qg_ans_fr)
#define FREE_QG_ANSWER_FRAME(STR) FREE_STRUCT(STR, struct query_goal_answer_frame, _pages_qg_ans_fr)
#define ALLOC_OR_FRAME(STR) ALLOC_STRUCT(STR, struct or_frame, GLOBAL_pages_or_fr, GLOBAL_pages_void)
#define FREE_OR_FRAME(STR) FREE_STRUCT(STR, struct or_frame, GLOBAL_pages_or_fr, GLOBAL_pages_void)
#define ALLOC_SUSPENSION_FRAME(STR) ALLOC_STRUCT(STR, struct suspension_frame, _pages_susp_fr)
#define FREE_SUSPENSION_FRAME(STR) FREE_BLOCK(SuspFr_global_start(STR)); \
FREE_STRUCT(STR, struct suspension_frame, _pages_susp_fr)
#define ALLOC_QG_SOLUTION_FRAME(STR) ALLOC_STRUCT(STR, struct query_goal_solution_frame, GLOBAL_pages_qg_sol_fr, GLOBAL_pages_void)
#define FREE_QG_SOLUTION_FRAME(STR) FREE_STRUCT(STR, struct query_goal_solution_frame, GLOBAL_pages_qg_sol_fr, GLOBAL_pages_void)
#define ALLOC_TG_SOLUTION_FRAME(STR) ALLOC_STRUCT(STR, struct table_subgoal_solution_frame, _pages_tg_sol_fr)
#define FREE_TG_SOLUTION_FRAME(STR) FREE_STRUCT(STR, struct table_subgoal_solution_frame, _pages_tg_sol_fr)
#define ALLOC_QG_ANSWER_FRAME(STR) ALLOC_STRUCT(STR, struct query_goal_answer_frame, GLOBAL_pages_qg_ans_fr, GLOBAL_pages_void)
#define FREE_QG_ANSWER_FRAME(STR) FREE_STRUCT(STR, struct query_goal_answer_frame, GLOBAL_pages_qg_ans_fr, GLOBAL_pages_void)
#define ALLOC_SUSPENSION_FRAME(STR) ALLOC_STRUCT(STR, struct suspension_frame, GLOBAL_pages_susp_fr, GLOBAL_pages_void)
#define FREE_SUSPENSION_FRAME(STR) FREE_BLOCK(SuspFr_global_start(STR)); \
FREE_STRUCT(STR, struct suspension_frame, GLOBAL_pages_susp_fr, GLOBAL_pages_void)
#define ALLOC_TG_SOLUTION_FRAME(STR) ALLOC_STRUCT(STR, struct table_subgoal_solution_frame, GLOBAL_pages_tg_sol_fr, GLOBAL_pages_void)
#define FREE_TG_SOLUTION_FRAME(STR) FREE_STRUCT(STR, struct table_subgoal_solution_frame, GLOBAL_pages_tg_sol_fr, GLOBAL_pages_void)
#define ALLOC_TG_ANSWER_FRAME(STR) ALLOC_STRUCT(STR, struct table_subgoal_answer_frame, GLOBAL_pages_tg_ans_fr, GLOBAL_pages_void)
#define FREE_TG_ANSWER_FRAME(STR) FREE_STRUCT(STR, struct table_subgoal_answer_frame, GLOBAL_pages_tg_ans_fr, GLOBAL_pages_void)
#define ALLOC_TG_ANSWER_FRAME(STR) ALLOC_STRUCT(STR, struct table_subgoal_answer_frame, _pages_tg_ans_fr)
#define FREE_TG_ANSWER_FRAME(STR) FREE_STRUCT(STR, struct table_subgoal_answer_frame, _pages_tg_ans_fr)

381
OPTYap/opt.preds.c
View File

@ -107,87 +107,87 @@ static inline struct page_statistics show_statistics_table_subgoal_answer_frames
struct page_statistics {
#ifdef USE_PAGES_MALLOC
long pages_allocated; /* same as struct pages (opt.structs.h) */
long pages_in_use; /* same as struct pages (opt.structs.h) */
#endif /* USE_PAGES_MALLOC */
long structs_in_use; /* same as struct pages (opt.structs.h) */
long structs_in_use; /* same as struct pages (opt.structs.h) */
long bytes_in_use;
};
#define Pg_bytes_in_use(STATS) STATS.bytes_in_use
#define PgEnt_bytes_in_use(STATS) STATS.bytes_in_use
#ifdef USE_PAGES_MALLOC
#ifdef DEBUG_TABLING
#define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE) \
{ pg_hd_ptr pg_hd; \
STR_TYPE *aux_ptr; \
long cont = 0; \
pg_hd = Pg_free_pg(PAGE); \
while (pg_hd) { \
aux_ptr = PgHd_free_str(pg_hd); \
while (aux_ptr) { \
cont++; \
aux_ptr = aux_ptr->next; \
} \
pg_hd = PgHd_next(pg_hd); \
} \
TABLING_ERROR_CHECKING(CHECK_PAGE_FREE_STRUCTS, Pg_str_free(PAGE) != cont); \
#define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE) \
{ pg_hd_ptr pg_hd; \
STR_TYPE *aux_ptr; \
long cont = 0; \
pg_hd = PgEnt_first(PAGE); \
while (pg_hd) { \
aux_ptr = PgHd_first_str(pg_hd); \
while (aux_ptr) { \
cont++; \
aux_ptr = aux_ptr->next; \
} \
pg_hd = PgHd_next(pg_hd); \
} \
TABLING_ERROR_CHECKING(CHECK_PAGE_FREE_STRUCTS, PgEnt_strs_free(PAGE) != cont); \
}
#else
#define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE)
#endif /* DEBUG_TABLING */
#define INIT_PAGE_STATS(STATS) \
Pg_pg_alloc(STATS) = 0; \
Pg_str_in_use(STATS) = 0
#define INCREMENT_PAGE_STATS(STATS, PAGE) \
Pg_pg_alloc(STATS) += Pg_pg_alloc(PAGE); \
Pg_str_in_use(STATS) += Pg_str_in_use(PAGE)
#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \
BYTES += Pg_bytes_in_use(STATS); \
PAGES += Pg_pg_alloc(STATS)
#define SHOW_PAGE_STATS_MSG(STR_NAME) " " STR_NAME " %10ld bytes (%ld pages and %ld structs in use)\n"
#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) Pg_str_in_use(STATS) * sizeof(STR_TYPE), Pg_pg_alloc(STATS), Pg_str_in_use(STATS)
#define INIT_PAGE_STATS(STATS) \
PgEnt_pages_in_use(STATS) = 0; \
PgEnt_strs_in_use(STATS) = 0
#define INCREMENT_PAGE_STATS(STATS, PAGE) \
PgEnt_pages_in_use(STATS) += PgEnt_pages_in_use(PAGE); \
PgEnt_strs_in_use(STATS) += PgEnt_strs_in_use(PAGE)
#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \
BYTES += PgEnt_bytes_in_use(STATS); \
PAGES += PgEnt_pages_in_use(STATS)
#define SHOW_PAGE_STATS_MSG(STR_NAME) " " STR_NAME " %10ld bytes (%ld pages and %ld structs in use)\n"
#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE), PgEnt_pages_in_use(STATS), PgEnt_strs_in_use(STATS)
#else /* !USE_PAGES_MALLOC */
#define CHECK_PAGE_FREE_STRUCTS(STR_TYPE, PAGE)
#define INIT_PAGE_STATS(STATS) \
Pg_str_in_use(STATS) = 0
#define INCREMENT_PAGE_STATS(STATS, PAGE) \
Pg_str_in_use(STATS) += Pg_str_in_use(PAGE)
#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \
BYTES += Pg_bytes_in_use(STATS)
#define SHOW_PAGE_STATS_MSG(STR_NAME) " " STR_NAME " %10ld bytes (%ld structs in use)\n"
#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) Pg_str_in_use(STATS) * sizeof(STR_TYPE), Pg_str_in_use(STATS)
#define INIT_PAGE_STATS(STATS) \
PgEnt_strs_in_use(STATS) = 0
#define INCREMENT_PAGE_STATS(STATS, PAGE) \
PgEnt_strs_in_use(STATS) += PgEnt_strs_in_use(PAGE)
#define INCREMENT_AUX_STATS(STATS, BYTES, PAGES) \
BYTES += PgEnt_bytes_in_use(STATS)
#define SHOW_PAGE_STATS_MSG(STR_NAME) " " STR_NAME " %10ld bytes (%ld structs in use)\n"
#define SHOW_PAGE_STATS_ARGS(STATS, STR_TYPE) PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE), PgEnt_strs_in_use(STATS)
#endif /* USE_PAGES_MALLOC */
#define GET_GLOBAL_PAGE_STATS(STATS, STR_TYPE, STR_PAGES) \
INIT_PAGE_STATS(STATS); \
CHECK_PAGE_FREE_STRUCTS(STR_TYPE, STR_PAGES); \
INCREMENT_PAGE_STATS(STATS, STR_PAGES); \
Pg_bytes_in_use(STATS) = Pg_str_in_use(STATS) * sizeof(STR_TYPE)
#define GET_REMOTE_PAGE_STATS(STATS, STR_TYPE, STR_PAGES) \
INIT_PAGE_STATS(STATS); \
LOCK(GLOBAL_ThreadHandlesLock); \
{ int wid; \
for (wid = 0; wid < MAX_THREADS; wid++) { \
if (! Yap_local[wid]) \
break; \
if (REMOTE_ThreadHandle(wid).in_use) { \
CHECK_PAGE_FREE_STRUCTS(STR_TYPE, STR_PAGES(wid)); \
INCREMENT_PAGE_STATS(STATS, STR_PAGES(wid)); \
} \
} \
} \
UNLOCK(GLOBAL_ThreadHandlesLock); \
Pg_bytes_in_use(STATS) = Pg_str_in_use(STATS) * sizeof(STR_TYPE)
#define SHOW_GLOBAL_PAGE_STATS(OUT_STREAM, STR_TYPE, STR_PAGES, STR_NAME) \
#ifdef THREADS
#define GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES) \
LOCK(GLOBAL_ThreadHandlesLock); \
CHECK_PAGE_FREE_STRUCTS(STR_TYPE, GLOBAL##_PAGES); \
INCREMENT_PAGE_STATS(STATS, GLOBAL##_PAGES); \
{ int wid; \
for (wid = 0; wid < MAX_THREADS; wid++) { \
if (! Yap_local[wid]) \
break; \
if (REMOTE_ThreadHandle(wid).in_use) { \
CHECK_PAGE_FREE_STRUCTS(STR_TYPE, REMOTE##_PAGES(wid)); \
INCREMENT_PAGE_STATS(STATS, REMOTE##_PAGES(wid)); \
} \
} \
} \
UNLOCK(GLOBAL_ThreadHandlesLock)
#else
#define GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES) \
CHECK_PAGE_FREE_STRUCTS(STR_TYPE, GLOBAL##_PAGES); \
INCREMENT_PAGE_STATS(STATS, GLOBAL##_PAGES)
#endif
#define GET_PAGE_STATS(STATS, STR_TYPE, _PAGES) \
INIT_PAGE_STATS(STATS); \
GET_ALL_PAGE_STATS(STATS, STR_TYPE, _PAGES); \
PgEnt_bytes_in_use(STATS) = PgEnt_strs_in_use(STATS) * sizeof(STR_TYPE)
#define SHOW_PAGE_STATS(OUT_STREAM, STR_TYPE, _PAGES, STR_NAME) \
{ struct page_statistics stats; \
GET_GLOBAL_PAGE_STATS(stats, STR_TYPE, STR_PAGES); \
Sfprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \
return stats; \
}
#define SHOW_REMOTE_PAGE_STATS(OUT_STREAM, STR_TYPE, STR_PAGES, STR_NAME) \
{ struct page_statistics stats; \
GET_REMOTE_PAGE_STATS(stats, STR_TYPE, STR_PAGES); \
GET_PAGE_STATS(stats, STR_TYPE, _PAGES); \
Sfprintf(OUT_STREAM, SHOW_PAGE_STATS_MSG(STR_NAME), SHOW_PAGE_STATS_ARGS(stats, STR_TYPE)); \
return stats; \
}
@ -307,48 +307,60 @@ static Int p_table( USES_REGS1 ) {
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (mode directed tabling not enabled)", AtomName(at), arity);
return(FALSE);
#else
/*************************************************************************************
The mode operator declaration is reordered as follows:
1. arguments with mode 'index' (any number)
2. arguments with mode 'min' and 'max' (any number, following the original order)
3. arguments with mode 'all' (any number)
4. arguments with mode 'sum' or 'last' (only one of the two is allowed)
5. arguments with mode 'first' (any number)
*************************************************************************************/
int pos_index = 0;
int pos_agreg = 0; /* min/max */
int pos_first = 0;
int pos_min_max = 0;
int pos_all = 0;
int pos_last = 0;
int pos_sum_last = 0;
int pos_first = 0;
int i;
int *aux_mode_directed;
aux_mode_directed = malloc(arity * sizeof(int));
ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
for (i = 0; i < arity; i++) {
int mode = IntOfTerm(HeadOfTerm(list));
if (mode == MODE_DIRECTED_INDEX)
pos_index++;
else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
pos_min_max++;
else if (mode == MODE_DIRECTED_ALL)
pos_all++;
else if (mode == MODE_DIRECTED_LAST)
pos_last++;
else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX)
pos_agreg++;
else if (mode == MODE_DIRECTED_SUM || mode == MODE_DIRECTED_LAST) {
if (pos_sum_last) {
free(aux_mode_directed);
Yap_Error(INTERNAL_COMPILER_ERROR, TermNil, "invalid tabling declaration for %s/%d (more than one argument with modes 'sum' and/or 'last')", AtomName(at), arity);
return(FALSE);
} else
pos_sum_last = 1;
}
aux_mode_directed[i] = mode;
list = TailOfTerm(list);
}
pos_first = pos_index + pos_agreg + pos_all + pos_last;
pos_last = pos_index + pos_agreg + pos_all;
pos_all = pos_index + pos_agreg;
pos_agreg = pos_index;
}
pos_first = pos_index + pos_min_max + pos_all + pos_sum_last;
pos_sum_last = pos_index + pos_min_max + pos_all;
pos_all = pos_index + pos_min_max;
pos_min_max = pos_index;
pos_index = 0;
ALLOC_BLOCK(mode_directed, arity * sizeof(int), int);
for (i = 0; i < arity; i++) {
int aux_pos = 0;
if (aux_mode_directed[i] == MODE_DIRECTED_MAX)
aux_pos = pos_agreg++;
else if (aux_mode_directed[i] == MODE_DIRECTED_MIN)
aux_pos = pos_agreg++;
else if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
if (aux_mode_directed[i] == MODE_DIRECTED_INDEX)
aux_pos = pos_index++;
else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
aux_pos = pos_first++;
else if (aux_mode_directed[i] == MODE_DIRECTED_MIN || aux_mode_directed[i] == MODE_DIRECTED_MAX)
aux_pos = pos_min_max++;
else if (aux_mode_directed[i] == MODE_DIRECTED_ALL)
aux_pos = pos_all++;
else if (aux_mode_directed[i] == MODE_DIRECTED_LAST)
aux_pos = pos_last++;
else if (aux_mode_directed[i] == MODE_DIRECTED_SUM || aux_mode_directed[i] == MODE_DIRECTED_LAST)
aux_pos = pos_sum_last++;
else if(aux_mode_directed[i] == MODE_DIRECTED_FIRST)
aux_pos = pos_first++;
mode_directed[aux_pos] = MODE_DIRECTED_SET(i, aux_mode_directed[i]);
}
free(aux_mode_directed);
@ -643,7 +655,7 @@ static Int p_show_statistics_tabling( USES_REGS1 ) {
Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes (%ld pages in use)\n",
total_bytes, total_pages);
Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size, Pg_pg_alloc(GLOBAL_pages_void));
PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc));
#else
Sfprintf(out, "Total memory in use (I+II+III): %10ld bytes\n", total_bytes);
#endif /* USE_PAGES_MALLOC */
@ -810,7 +822,7 @@ static Int p_show_statistics_or( USES_REGS1 ) {
Sfprintf(out, "Total memory in use (I+II): %10ld bytes (%ld pages in use)\n",
total_bytes, total_pages);
Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size, Pg_pg_alloc(GLOBAL_pages_void));
PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc));
#else
Sfprintf(out, "Total memory in use (I+II): %10ld bytes\n", total_bytes);
#endif /* USE_PAGES_MALLOC */
@ -832,6 +844,7 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
#ifdef USE_PAGES_MALLOC
long total_pages = 0;
#endif /* USE_PAGES_MALLOC */
IOSTREAM *out;
Term t = Deref(ARG1);
if (IsVarTerm(t) || !IsAtomTerm(t))
@ -898,7 +911,7 @@ static Int p_show_statistics_opt( USES_REGS1 ) {
Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes (%ld pages in use)\n",
total_bytes, total_pages);
Sfprintf(out, "Total memory allocated: %10ld bytes (%ld pages in total)\n",
Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size, Pg_pg_alloc(GLOBAL_pages_void));
PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size, PgEnt_pages_in_use(GLOBAL_pages_alloc));
#else
Sfprintf(out, "Total memory in use (I+II+III+IV): %10ld bytes\n", total_bytes);
#endif /* USE_PAGES_MALLOC */
@ -916,129 +929,105 @@ static Int p_get_optyap_statistics( USES_REGS1 ) {
value = IntOfTerm(Deref(ARG1));
#ifdef TABLING
if (value == 0 || value == 1) { /* table_entries */
GET_GLOBAL_PAGE_STATS(stats, struct table_entry, GLOBAL_pages_tab_ent);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct table_entry, _pages_tab_ent);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
if (value == 0 || value == 16) { /* subgoal_entries */
GET_GLOBAL_PAGE_STATS(stats, struct subgoal_entry, GLOBAL_pages_sg_ent);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct subgoal_entry, _pages_sg_ent);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
if (value == 0 || value == 2) { /* subgoal_frames */
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
GET_GLOBAL_PAGE_STATS(stats, struct subgoal_frame, GLOBAL_pages_sg_fr);
#else
GET_REMOTE_PAGE_STATS(stats, struct subgoal_frame, REMOTE_pages_sg_fr);
#endif
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
if (value == 0 || value == 2) { /* subgoal_frames */
GET_PAGE_STATS(stats, struct subgoal_frame, _pages_sg_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 3) { /* dependency_frames */
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
GET_GLOBAL_PAGE_STATS(stats, struct dependency_frame, GLOBAL_pages_dep_fr);
#else
GET_REMOTE_PAGE_STATS(stats, struct dependency_frame, REMOTE_pages_dep_fr);
#endif
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct dependency_frame, _pages_dep_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 6) { /* subgoal_trie_nodes */
#if !defined(THREADS_NO_SHARING)
GET_GLOBAL_PAGE_STATS(stats, struct subgoal_trie_node, GLOBAL_pages_sg_node);
#else
GET_REMOTE_PAGE_STATS(stats, struct subgoal_trie_node, REMOTE_pages_sg_node);
#endif
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct subgoal_trie_node, _pages_sg_node);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 8) { /* subgoal_trie_hashes */
#if !defined(THREADS_NO_SHARING)
GET_GLOBAL_PAGE_STATS(stats, struct subgoal_trie_hash, GLOBAL_pages_sg_hash);
#else
GET_REMOTE_PAGE_STATS(stats, struct subgoal_trie_hash, REMOTE_pages_sg_hash);
#endif
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct subgoal_trie_hash, _pages_sg_hash);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 7) { /* answer_trie_nodes */
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
GET_GLOBAL_PAGE_STATS(stats, struct answer_trie_node, GLOBAL_pages_ans_node);
#else
GET_REMOTE_PAGE_STATS(stats, struct answer_trie_node, REMOTE_pages_ans_node);
#endif
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct answer_trie_node, _pages_ans_node);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 9) { /* answer_trie_hashes */
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
GET_GLOBAL_PAGE_STATS(stats, struct answer_trie_hash, GLOBAL_pages_ans_hash);
#else
GET_REMOTE_PAGE_STATS(stats, struct answer_trie_hash, REMOTE_pages_ans_hash);
#endif
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct answer_trie_hash, _pages_ans_hash);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#if defined(THREADS_FULL_SHARING)
if (value == 0 || value == 17) { /* answer_ref_nodes */
GET_REMOTE_PAGE_STATS(stats, struct answer_ref_node, REMOTE_pages_ans_ref_node);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct answer_ref_node, _pages_ans_ref_node);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#endif /* THREADS_FULL_SHARING */
#endif
if (value == 0 || value == 10) { /* global_trie_nodes */
GET_GLOBAL_PAGE_STATS(stats, struct global_trie_node, GLOBAL_pages_gt_node);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct global_trie_node, _pages_gt_node);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 11) { /* global_trie_hashes */
GET_GLOBAL_PAGE_STATS(stats, struct global_trie_hash, GLOBAL_pages_gt_hash);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct global_trie_hash, _pages_gt_hash);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#endif /* TABLING */
#ifdef YAPOR
if (value == 0 || value == 4) { /* or_frames */
GET_GLOBAL_PAGE_STATS(stats, struct or_frame, GLOBAL_pages_or_fr);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct or_frame, _pages_or_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 12) { /* query_goal_solution_frames */
GET_GLOBAL_PAGE_STATS(stats, struct query_goal_solution_frame, GLOBAL_pages_qg_sol_fr);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct query_goal_solution_frame, _pages_qg_sol_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 13) { /* query_goal_answer_frames */
GET_GLOBAL_PAGE_STATS(stats, struct query_goal_answer_frame, GLOBAL_pages_qg_ans_fr);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct query_goal_answer_frame, _pages_qg_ans_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#endif /* YAPOR */
#if defined(YAPOR) && defined(TABLING)
if (value == 0 || value == 5) { /* suspension_frames */
GET_GLOBAL_PAGE_STATS(stats, struct suspension_frame, GLOBAL_pages_susp_fr);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct suspension_frame, _pages_susp_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#ifdef TABLING_INNER_CUTS
if (value == 0 || value == 14) { /* table_subgoal_solution_frames */
GET_GLOBAL_PAGE_STATS(stats, struct table_subgoal_solution_frame, GLOBAL_pages_tg_sol_fr);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct table_subgoal_solution_frame, _pages_tg_sol_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
if (value == 0 || value == 15) { /* table_subgoal_answer_frames */
GET_GLOBAL_PAGE_STATS(stats, struct table_subgoal_answer_frame, GLOBAL_pages_tg_ans_fr);
bytes += Pg_bytes_in_use(stats);
if (value != 0) structs = Pg_str_in_use(stats);
GET_PAGE_STATS(stats, struct table_subgoal_answer_frame, _pages_tg_ans_fr);
bytes += PgEnt_bytes_in_use(stats);
if (value != 0) structs = PgEnt_strs_in_use(stats);
}
#endif /* TABLING_INNER_CUTS */
#endif /* YAPOR && TABLING */
if (value == 0) { /* total_memory */
#ifdef USE_PAGES_MALLOC
structs = Pg_pg_alloc(GLOBAL_pages_void) * Yap_page_size;
structs = PgEnt_pages_in_use(GLOBAL_pages_alloc) * Yap_page_size;
#else
structs = bytes;
#endif /* USE_PAGES_MALLOC */
@ -1082,120 +1071,96 @@ static inline realtime current_time(void) {
#ifdef TABLING
static inline struct page_statistics show_statistics_table_entries(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct table_entry, GLOBAL_pages_tab_ent, "Table entries: ");
SHOW_PAGE_STATS(out, struct table_entry, _pages_tab_ent, "Table entries: ");
}
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
static inline struct page_statistics show_statistics_subgoal_entries(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct subgoal_entry, GLOBAL_pages_sg_ent, "Subgoal entries: ");
SHOW_PAGE_STATS(out, struct subgoal_entry, _pages_sg_ent, "Subgoal entries: ");
}
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
static inline struct page_statistics show_statistics_subgoal_frames(IOSTREAM *out) {
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
SHOW_GLOBAL_PAGE_STATS(out, struct subgoal_frame, GLOBAL_pages_sg_fr, "Subgoal frames: ");
#else
SHOW_REMOTE_PAGE_STATS(out, struct subgoal_frame, REMOTE_pages_sg_fr, "Subgoal frames: ");
#endif
SHOW_PAGE_STATS(out, struct subgoal_frame, _pages_sg_fr, "Subgoal frames: ");
}
static inline struct page_statistics show_statistics_dependency_frames(IOSTREAM *out) {
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
SHOW_GLOBAL_PAGE_STATS(out, struct dependency_frame, GLOBAL_pages_dep_fr, "Dependency frames: ");
#else
SHOW_REMOTE_PAGE_STATS(out, struct dependency_frame, REMOTE_pages_dep_fr, "Dependency frames: ");
#endif
SHOW_PAGE_STATS(out, struct dependency_frame, _pages_dep_fr, "Dependency frames: ");
}
static inline struct page_statistics show_statistics_subgoal_trie_nodes(IOSTREAM *out) {
#if !defined(THREADS_NO_SHARING)
SHOW_GLOBAL_PAGE_STATS(out, struct subgoal_trie_node, GLOBAL_pages_sg_node, "Subgoal trie nodes: ");
#else
SHOW_REMOTE_PAGE_STATS(out, struct subgoal_trie_node, REMOTE_pages_sg_node, "Subgoal trie nodes: ");
#endif
SHOW_PAGE_STATS(out, struct subgoal_trie_node, _pages_sg_node, "Subgoal trie nodes: ");
}
static inline struct page_statistics show_statistics_subgoal_trie_hashes(IOSTREAM *out) {
#if !defined(THREADS_NO_SHARING)
SHOW_GLOBAL_PAGE_STATS(out, struct subgoal_trie_hash, GLOBAL_pages_sg_hash, "Subgoal trie hashes: ");
#else
SHOW_REMOTE_PAGE_STATS(out, struct subgoal_trie_hash, REMOTE_pages_sg_hash, "Subgoal trie hashes: ");
#endif
SHOW_PAGE_STATS(out, struct subgoal_trie_hash, _pages_sg_hash, "Subgoal trie hashes: ");
}
static inline struct page_statistics show_statistics_answer_trie_nodes(IOSTREAM *out) {
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
SHOW_GLOBAL_PAGE_STATS(out, struct answer_trie_node, GLOBAL_pages_ans_node, "Answer trie nodes: ");
#else
SHOW_REMOTE_PAGE_STATS(out, struct answer_trie_node, REMOTE_pages_ans_node, "Answer trie nodes: ");
#endif
SHOW_PAGE_STATS(out, struct answer_trie_node, _pages_ans_node, "Answer trie nodes: ");
}
static inline struct page_statistics show_statistics_answer_trie_hashes(IOSTREAM *out) {
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
SHOW_GLOBAL_PAGE_STATS(out, struct answer_trie_hash, GLOBAL_pages_ans_hash, "Answer trie hashes: ");
#else
SHOW_REMOTE_PAGE_STATS(out, struct answer_trie_hash, REMOTE_pages_ans_hash, "Answer trie hashes: ");
#endif
SHOW_PAGE_STATS(out, struct answer_trie_hash, _pages_ans_hash, "Answer trie hashes: ");
}
#if defined(THREADS_FULL_SHARING)
static inline struct page_statistics show_statistics_answer_ref_nodes(IOSTREAM *out) {
SHOW_REMOTE_PAGE_STATS(out, struct answer_ref_node, REMOTE_pages_ans_ref_node, "Answer ref nodes: ");
SHOW_PAGE_STATS(out, struct answer_ref_node, _pages_ans_ref_node, "Answer ref nodes: ");
}
#endif /* THREADS_FULL_SHARING */
static inline struct page_statistics show_statistics_global_trie_nodes(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct global_trie_node, GLOBAL_pages_gt_node, "Global trie nodes: ");
SHOW_PAGE_STATS(out, struct global_trie_node, _pages_gt_node, "Global trie nodes: ");
}
static inline struct page_statistics show_statistics_global_trie_hashes(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct global_trie_hash, GLOBAL_pages_gt_hash, "Global trie hashes: ");
SHOW_PAGE_STATS(out, struct global_trie_hash, _pages_gt_hash, "Global trie hashes: ");
}
#endif /* TABLING */
#ifdef YAPOR
static inline struct page_statistics show_statistics_or_frames(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct or_frame, GLOBAL_pages_or_fr, "Or-frames: ");
SHOW_PAGE_STATS(out, struct or_frame, _pages_or_fr, "Or-frames: ");
}
static inline struct page_statistics show_statistics_query_goal_solution_frames(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct query_goal_solution_frame, GLOBAL_pages_qg_sol_fr, "Query goal solution frames: ");
SHOW_PAGE_STATS(out, struct query_goal_solution_frame, _pages_qg_sol_fr, "Query goal solution frames: ");
}
static inline struct page_statistics show_statistics_query_goal_answer_frames(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct query_goal_answer_frame, GLOBAL_pages_qg_ans_fr, "Query goal answer frames: ");
SHOW_PAGE_STATS(out, struct query_goal_answer_frame, _pages_qg_ans_fr, "Query goal answer frames: ");
}
#endif /* YAPOR */
#if defined(YAPOR) && defined(TABLING)
static inline struct page_statistics show_statistics_suspension_frames(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct suspension_frame, GLOBAL_pages_susp_fr, "Suspension frames: ");
SHOW_PAGE_STATS(out, struct suspension_frame, _pages_susp_fr, "Suspension frames: ");
}
#ifdef TABLING_INNER_CUTS
static inline struct page_statistics show_statistics_table_subgoal_solution_frames(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct table_subgoal_solution_frame, GLOBAL_pages_tg_sol_fr, "Table subgoal solution frames:");
SHOW_PAGE_STATS(out, struct table_subgoal_solution_frame, _pages_tg_sol_fr, "Table subgoal solution frames:");
}
static inline struct page_statistics show_statistics_table_subgoal_answer_frames(IOSTREAM *out) {
SHOW_GLOBAL_PAGE_STATS(out, struct table_subgoal_answer_frame, GLOBAL_pages_tg_ans_fr, "Table subgoal answer frames: ");
SHOW_PAGE_STATS(out, struct table_subgoal_answer_frame, _pages_tg_ans_fr, "Table subgoal answer frames: ");
}
#endif /* TABLING_INNER_CUTS */
#endif /* YAPOR && TABLING */

114
OPTYap/opt.structs.h
View File

@ -20,31 +20,23 @@ typedef unsigned long bitmap;
#ifdef YAPOR_THREADS
/* Threads may not assume addresses are the same at different workers */
static inline choiceptr
offset_to_cptr(Int node)
{
static inline choiceptr offset_to_cptr(Int node) {
CACHE_REGS
return (choiceptr)(LCL0+node);
}
static inline Int
cptr_to_offset(choiceptr node)
{
static inline Int cptr_to_offset(choiceptr node) {
CACHE_REGS
return (Int)((CELL *)node-LCL0);
}
static inline choiceptr
offset_to_cptr_with_null(Int node)
{
static inline choiceptr offset_to_cptr_with_null(Int node) {
CACHE_REGS
if (node == 0L) return NULL;
return (choiceptr)(LCL0+node);
}
static inline Int
cptr_to_offset_with_null(choiceptr node)
{
static inline Int cptr_to_offset_with_null(choiceptr node) {
CACHE_REGS
if (node == NULL) return 0L;
return (Int)((CELL *)node-LCL0);
@ -104,16 +96,18 @@ struct threads_dependency_frame {
#ifdef USE_PAGES_MALLOC
typedef struct page_header {
volatile int structs_in_use;
void *allocated_area;
void *first_free_struct;
struct page_header *previous;
struct page_header *next;
} *pg_hd_ptr;
#endif /* USE_PAGES_MALLOC */
#define PgHd_str_in_use(X) ((X)->structs_in_use)
#define PgHd_free_str(X) ((X)->first_free_struct)
#define PgHd_previous(X) ((X)->previous)
#define PgHd_next(X) ((X)->next)
#define PgHd_strs_in_use(X) ((X)->structs_in_use)
#define PgHd_alloc_area(X) ((X)->allocated_area)
#define PgHd_first_str(X) ((X)->first_free_struct)
#define PgHd_previous(X) ((X)->previous)
#define PgHd_next(X) ((X)->next)
@ -126,31 +120,31 @@ struct global_page_entry {
lockvar lock;
#endif /* YAPOR || THREADS */
#ifdef USE_PAGES_MALLOC
struct page_header *first_free_page;
struct page_header *first_page;
struct page_header *last_page;
int structs_per_page;
volatile long pages_allocated;
volatile long pages_in_use;
#endif /* USE_PAGES_MALLOC */
volatile long structs_in_use;
};
struct local_page_entry {
#if defined(YAPOR) || defined(THREADS)
lockvar lock;
#endif /* YAPOR || THREADS */
#ifdef USE_PAGES_MALLOC
struct page_header *first_free_page;
struct page_header *first_page;
struct page_header *last_page;
int structs_per_page;
volatile long pages_allocated;
long pages_in_use;
#endif /* USE_PAGES_MALLOC */
volatile long structs_in_use;
long structs_in_use;
};
#define Pg_lock(X) ((X).lock)
#define Pg_free_pg(X) ((X).first_free_page)
#define Pg_str_per_pg(X) ((X).structs_per_page)
#define Pg_pg_alloc(X) ((X).pages_allocated)
#define Pg_str_in_use(X) ((X).structs_in_use)
#define Pg_str_free(X) (Pg_pg_alloc(X) * Pg_str_per_pg(X) - Pg_str_in_use(X))
#define PgEnt_lock(X) ((X).lock)
#define PgEnt_first(X) ((X).first_page)
#define PgEnt_last(X) ((X).last_page)
#define PgEnt_strs_per_page(X) ((X).structs_per_page)
#define PgEnt_pages_in_use(X) ((X).pages_in_use)
#define PgEnt_strs_in_use(X) ((X).structs_in_use)
#define PgEnt_strs_free(X) (PgEnt_pg_in_use(X) * PgEnt_str_per_pg(X) - PgEnt_str_in_use(X))
@ -159,39 +153,41 @@ struct local_page_entry {
***************************/
struct global_pages {
#ifdef USE_PAGES_MALLOC
struct global_page_entry alloc_pages;
struct global_page_entry void_pages;
#endif /* USE_PAGES_MALLOC */
#ifdef TABLING
struct global_page_entry table_entry_pages;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
struct global_page_entry subgoal_entry_pages;
#endif
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
struct global_page_entry subgoal_frame_pages;
struct global_page_entry dependency_frame_pages;
#endif
#if !defined(THREADS_NO_SHARING)
struct global_page_entry subgoal_trie_node_pages;
struct global_page_entry subgoal_trie_hash_pages;
#endif
#if !defined(THREADS_NO_SHARING) && !defined(THREADS_SUBGOAL_SHARING)
struct global_page_entry answer_trie_node_pages;
struct global_page_entry answer_trie_hash_pages;
#if defined(THREADS_FULL_SHARING)
struct global_page_entry answer_ref_node_pages;
#endif
struct global_page_entry global_trie_node_pages;
struct global_page_entry global_trie_hash_pages;
#endif /* TABLING */
#ifdef YAPOR
struct global_page_entry or_frame_pages;
struct global_page_entry query_goal_solution_frame_pages;
struct global_page_entry query_goal_answer_frame_pages;
#endif /* YAPOR */
#if defined(YAPOR) && defined(TABLING)
#ifdef TABLING
struct global_page_entry suspension_frame_pages;
#endif /* YAPOR && TABLING */
#endif
#ifdef TABLING_INNER_CUTS
struct global_page_entry table_subgoal_solution_frame_pages;
struct global_page_entry table_subgoal_answer_frame_pages;
#endif /* TABLING_INNER_CUTS */
#endif
#endif /* YAPOR */
};
@ -202,30 +198,28 @@ struct global_pages {
#if defined(TABLING) && (defined(YAPOR) || defined(THREADS))
struct local_pages {
#if defined(YAPOR)
#ifdef YAPOR
struct answer_trie_node *next_free_answer_trie_node;
#elif defined(THREADS)
#elif THREADS
#ifdef USE_PAGES_MALLOC
struct local_page_entry void_pages;
#endif
struct local_page_entry table_entry_pages;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
struct local_page_entry subgoal_entry_pages;
#endif
struct local_page_entry subgoal_frame_pages;
struct local_page_entry dependency_frame_pages;
#if defined(THREADS_NO_SHARING)
struct local_page_entry subgoal_trie_node_pages;
struct local_page_entry subgoal_trie_hash_pages;
#elif defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
struct subgoal_trie_node *next_free_subgoal_trie_node;
struct subgoal_trie_hash *next_free_subgoal_trie_hash;
#endif
#if defined(THREADS_NO_SHARING) || defined(THREADS_SUBGOAL_SHARING)
struct local_page_entry answer_trie_node_pages;
struct local_page_entry answer_trie_hash_pages;
#elif defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
struct answer_trie_node *next_free_answer_trie_node;
struct answer_trie_hash *next_free_answer_trie_hash;
#endif
#if defined(THREADS_FULL_SHARING)
struct local_page_entry answer_ref_node_pages;
#endif
#endif /* YAPOR - THREADS */
struct local_page_entry global_trie_node_pages;
struct local_page_entry global_trie_hash_pages;
#endif
};
#endif /* TABLING && (YAPOR || THREADS) */
@ -351,6 +345,7 @@ struct global_optyap_data {
#endif /* TABLING */
};
#define GLOBAL_pages_alloc (GLOBAL_optyap_data.pages.alloc_pages)
#define GLOBAL_pages_void (GLOBAL_optyap_data.pages.void_pages)
#define GLOBAL_pages_tab_ent (GLOBAL_optyap_data.pages.table_entry_pages)
#define GLOBAL_pages_sg_ent (GLOBAL_optyap_data.pages.subgoal_entry_pages)
@ -360,6 +355,7 @@ struct global_optyap_data {
#define GLOBAL_pages_sg_hash (GLOBAL_optyap_data.pages.subgoal_trie_hash_pages)
#define GLOBAL_pages_ans_node (GLOBAL_optyap_data.pages.answer_trie_node_pages)
#define GLOBAL_pages_ans_hash (GLOBAL_optyap_data.pages.answer_trie_hash_pages)
#define GLOBAL_pages_ans_ref_node (GLOBAL_optyap_data.pages.answer_ref_node_pages)
#define GLOBAL_pages_gt_node (GLOBAL_optyap_data.pages.global_trie_node_pages)
#define GLOBAL_pages_gt_hash (GLOBAL_optyap_data.pages.global_trie_hash_pages)
#define GLOBAL_pages_or_fr (GLOBAL_optyap_data.pages.or_frame_pages)
@ -479,6 +475,8 @@ struct local_optyap_data {
};
#define LOCAL_pages_void (LOCAL_optyap_data.pages.void_pages)
#define LOCAL_pages_tab_ent (LOCAL_optyap_data.pages.table_entry_pages)
#define LOCAL_pages_sg_ent (LOCAL_optyap_data.pages.subgoal_entry_pages)
#define LOCAL_pages_sg_fr (LOCAL_optyap_data.pages.subgoal_frame_pages)
#define LOCAL_pages_dep_fr (LOCAL_optyap_data.pages.dependency_frame_pages)
#define LOCAL_pages_sg_node (LOCAL_optyap_data.pages.subgoal_trie_node_pages)
@ -486,10 +484,9 @@ struct local_optyap_data {
#define LOCAL_pages_ans_node (LOCAL_optyap_data.pages.answer_trie_node_pages)
#define LOCAL_pages_ans_hash (LOCAL_optyap_data.pages.answer_trie_hash_pages)
#define LOCAL_pages_ans_ref_node (LOCAL_optyap_data.pages.answer_ref_node_pages)
#define LOCAL_next_free_sg_node (LOCAL_optyap_data.pages.next_free_subgoal_trie_node)
#define LOCAL_next_free_sg_hash (LOCAL_optyap_data.pages.next_free_subgoal_trie_hash)
#define LOCAL_pages_gt_node (LOCAL_optyap_data.pages.global_trie_node_pages)
#define LOCAL_pages_gt_hash (LOCAL_optyap_data.pages.global_trie_hash_pages)
#define LOCAL_next_free_ans_node (LOCAL_optyap_data.pages.next_free_answer_trie_node)
#define LOCAL_next_free_ans_hash (LOCAL_optyap_data.pages.next_free_answer_trie_hash)
#define LOCAL_lock (LOCAL_optyap_data.lock)
#define LOCAL_load (LOCAL_optyap_data.load)
#ifdef YAPOR_THREADS
@ -538,6 +535,8 @@ struct local_optyap_data {
#define LOCAL_ma_hash_table (LOCAL_optyap_data.ma_hash_table)
#define REMOTE_pages_void(wid) (REMOTE(wid)->optyap_data_.pages.void_pages)
#define REMOTE_pages_tab_ent(wid) (REMOTE(wid)->optyap_data_.pages.table_entry_pages)
#define REMOTE_pages_sg_ent(wid) (REMOTE(wid)->optyap_data_.pages.subgoal_entry_pages)
#define REMOTE_pages_sg_fr(wid) (REMOTE(wid)->optyap_data_.pages.subgoal_frame_pages)
#define REMOTE_pages_dep_fr(wid) (REMOTE(wid)->optyap_data_.pages.dependency_frame_pages)
#define REMOTE_pages_sg_node(wid) (REMOTE(wid)->optyap_data_.pages.subgoal_trie_node_pages)
@ -545,10 +544,9 @@ struct local_optyap_data {
#define REMOTE_pages_ans_node(wid) (REMOTE(wid)->optyap_data_.pages.answer_trie_node_pages)
#define REMOTE_pages_ans_hash(wid) (REMOTE(wid)->optyap_data_.pages.answer_trie_hash_pages)
#define REMOTE_pages_ans_ref_node(wid) (REMOTE(wid)->optyap_data_.pages.answer_ref_node_pages)
#define REMOTE_next_free_sg_node(wid) (REMOTE(wid)->optyap_data_.pages.next_free_subgoal_trie_node)
#define REMOTE_next_free_sg_hash(wid) (REMOTE(wid)->optyap_data_.pages.next_free_subgoal_trie_hash)
#define REMOTE_pages_gt_node(wid) (REMOTE(wid)->optyap_data_.pages.global_trie_node_pages)
#define REMOTE_pages_gt_hash(wid) (REMOTE(wid)->optyap_data_.pages.global_trie_hash_pages)
#define REMOTE_next_free_ans_node(wid) (REMOTE(wid)->optyap_data_.pages.next_free_answer_trie_node)
#define REMOTE_next_free_ans_hash(wid) (REMOTE(wid)->optyap_data_.pages.next_free_answer_trie_hash)
#define REMOTE_lock(wid) (REMOTE(wid)->optyap_data_.lock)
#define REMOTE_load(wid) (REMOTE(wid)->optyap_data_.load)
#ifdef YAPOR_THREADS

90
OPTYap/tab.macros.h
View File

@ -131,11 +131,12 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
#define MODE_DIRECTED_TAGBITS 0xF
#define MODE_DIRECTED_NUMBER_TAGBITS 4
#define MODE_DIRECTED_INDEX 1
#define MODE_DIRECTED_FIRST 2
#define MODE_DIRECTED_ALL 3
#define MODE_DIRECTED_MAX 4
#define MODE_DIRECTED_MIN 5
#define MODE_DIRECTED_MIN 2
#define MODE_DIRECTED_MAX 3
#define MODE_DIRECTED_ALL 4
#define MODE_DIRECTED_SUM 5
#define MODE_DIRECTED_LAST 6
#define MODE_DIRECTED_FIRST 7
#define MODE_DIRECTED_SET(ARG,MODE) (((ARG) << MODE_DIRECTED_NUMBER_TAGBITS) + MODE)
#define MODE_DIRECTED_GET_ARG(X) ((X) >> MODE_DIRECTED_NUMBER_TAGBITS)
#define MODE_DIRECTED_GET_MODE(X) ((X) & MODE_DIRECTED_TAGBITS)
@ -193,27 +194,27 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
#endif /* DETERMINISTIC_TABLING */
/* tagging nodes */
#define TAG_AS_SUBGOAL_LEAF_NODE(NODE) TrNode_child(NODE) = (sg_node_ptr)((unsigned long int) TrNode_child(NODE) | 0x1)
#define IS_SUBGOAL_LEAF_NODE(NODE) ((unsigned long int) TrNode_child(NODE) & 0x1)
#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned long int) TrNode_parent(NODE) | 0x1)
#define IS_ANSWER_LEAF_NODE(NODE) ((unsigned long int) TrNode_parent(NODE) & 0x1)
#define TAG_AS_ANSWER_INVALID_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((unsigned long int) TrNode_parent(NODE) | 0x2)
#define IS_ANSWER_INVALID_NODE(NODE) ((unsigned long int) TrNode_parent(NODE) & 0x2)
#define UNTAG_SUBGOAL_NODE(NODE) ((unsigned long int) (NODE) & ~(0x1))
#define UNTAG_ANSWER_NODE(NODE) ((unsigned long int) (NODE) & ~(0x3))
#define TAG_AS_SUBGOAL_LEAF_NODE(NODE) TrNode_child(NODE) = (sg_node_ptr)((CELL) TrNode_child(NODE) | 0x1)
#define IS_SUBGOAL_LEAF_NODE(NODE) ((CELL) TrNode_child(NODE) & 0x1)
#define TAG_AS_ANSWER_LEAF_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((CELL) TrNode_parent(NODE) | 0x1)
#define IS_ANSWER_LEAF_NODE(NODE) ((CELL) TrNode_parent(NODE) & 0x1)
#define TAG_AS_ANSWER_INVALID_NODE(NODE) TrNode_parent(NODE) = (ans_node_ptr)((CELL) TrNode_parent(NODE) | 0x2)
#define IS_ANSWER_INVALID_NODE(NODE) ((CELL) TrNode_parent(NODE) & 0x2)
#define UNTAG_SUBGOAL_NODE(NODE) ((CELL) (NODE) & ~(0x1))
#define UNTAG_ANSWER_NODE(NODE) ((CELL) (NODE) & ~(0x3))
/* trie hashes */
#define MAX_NODES_PER_TRIE_LEVEL 8
#define MAX_NODES_PER_BUCKET (MAX_NODES_PER_TRIE_LEVEL / 2)
#define BASE_HASH_BUCKETS 64
#define HASH_ENTRY(ENTRY, NUM_BUCKETS) ((((unsigned long int) ENTRY) >> NumberOfLowTagBits) & (NUM_BUCKETS - 1))
#define HASH_ENTRY(ENTRY, NUM_BUCKETS) ((((CELL) ENTRY) >> NumberOfLowTagBits) & (NUM_BUCKETS - 1))
#define SUBGOAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define IS_SUBGOAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == SUBGOAL_TRIE_HASH_MARK)
#define ANSWER_TRIE_HASH_MARK 0
#define IS_ANSWER_TRIE_HASH(NODE) (TrNode_instr(NODE) == ANSWER_TRIE_HASH_MARK)
#define GLOBAL_TRIE_HASH_MARK ((Term) MakeTableVarTerm(MAX_TABLE_VARS))
#define IS_GLOBAL_TRIE_HASH(NODE) (TrNode_entry(NODE) == GLOBAL_TRIE_HASH_MARK)
#define HASH_TRIE_LOCK(NODE) GLOBAL_trie_locks((((unsigned long int) (NODE)) >> 5) & (TRIE_LOCK_BUCKETS - 1))
#define HASH_TRIE_LOCK(NODE) GLOBAL_trie_locks((((CELL) (NODE)) >> 5) & (TRIE_LOCK_BUCKETS - 1))
/* auxiliary stack */
#define STACK_PUSH_UP(ITEM, STACK) *--(STACK) = (CELL)(ITEM)
@ -449,9 +450,9 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
/* ... pointing to SgEnt_first_answer(SgFr_sg_ent(SG_FR)) */ \
if (SG_FR) \
DepFr_last_answer(DEP_FR) = (ans_node_ptr) ( \
(unsigned long int) (SgFr_sg_ent((sg_fr_ptr)SG_FR)) + \
(unsigned long int) (&SgEnt_first_answer((sg_ent_ptr)DEP_FR)) - \
(unsigned long int) (&TrNode_child((ans_node_ptr)DEP_FR))); \
(CELL) (SgFr_sg_ent((sg_fr_ptr)SG_FR)) + \
(CELL) (&SgEnt_first_answer((sg_ent_ptr)DEP_FR)) - \
(CELL) (&TrNode_child((ans_node_ptr)DEP_FR))); \
else \
DepFr_last_answer(DEP_FR) = NULL
#else
@ -460,9 +461,9 @@ static inline tg_sol_fr_ptr CUT_prune_tg_solution_frames(tg_sol_fr_ptr, int);
/* ... pointing to SgFr_first_answer(SG_FR) */ \
if (SG_FR) \
DepFr_last_answer(DEP_FR) = (ans_node_ptr) ( \
(unsigned long int) (SG_FR) + \
(unsigned long int) (&SgFr_first_answer((sg_fr_ptr)DEP_FR)) - \
(unsigned long int) (&TrNode_child((ans_node_ptr)DEP_FR))); \
(CELL) (SG_FR) + \
(CELL) (&SgFr_first_answer((sg_fr_ptr)DEP_FR)) - \
(CELL) (&TrNode_child((ans_node_ptr)DEP_FR))); \
else \
DepFr_last_answer(DEP_FR) = NULL
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
@ -744,7 +745,7 @@ static inline sg_node_ptr get_subgoal_trie_for_abolish(tab_ent_ptr tab_ent USES_
sg_node_ptr *sg_node_addr = (sg_node_ptr *) get_thread_bucket((void **) &TabEnt_subgoal_trie(tab_ent));
sg_node_ptr sg_node = *sg_node_addr;
*sg_node_addr = NULL;
if (worker_id == 0)
if (GLOBAL_NOfThreads == 1)
abolish_thread_buckets((void **) &TabEnt_subgoal_trie(tab_ent));
return sg_node;
#else
@ -804,7 +805,7 @@ static inline sg_fr_ptr get_subgoal_frame_for_abolish(sg_node_ptr sg_node USES_R
#if defined(THREADS_SUBGOAL_SHARING)
sg_fr_ptr *sg_fr_addr = (sg_fr_ptr *) get_thread_bucket((void **) UNTAG_SUBGOAL_NODE(TrNode_sg_fr(sg_node)));
sg_fr_ptr sg_fr = *sg_fr_addr;
if (worker_id == 0)
if (GLOBAL_NOfThreads == 1)
abolish_thread_buckets((void **) UNTAG_SUBGOAL_NODE(TrNode_sg_fr(sg_node)));
else
*sg_fr_addr = NULL;
@ -812,7 +813,7 @@ static inline sg_fr_ptr get_subgoal_frame_for_abolish(sg_node_ptr sg_node USES_R
#elif defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
sg_fr_ptr *sg_fr_addr = (sg_fr_ptr *) get_thread_bucket((void **) &SgEnt_sg_fr((sg_ent_ptr) UNTAG_SUBGOAL_NODE(TrNode_sg_fr(sg_node))));
sg_fr_ptr sg_fr = *sg_fr_addr;
if (worker_id == 0)
if (GLOBAL_NOfThreads == 1)
abolish_thread_buckets((void **) &SgEnt_sg_fr((sg_ent_ptr) UNTAG_SUBGOAL_NODE(TrNode_sg_fr(sg_node))));
else
*sg_fr_addr = NULL;
@ -1032,9 +1033,9 @@ static inline void adjust_freeze_registers(void) {
static inline void mark_as_completed(sg_fr_ptr sg_fr) {
#ifdef OUTPUT_THREADS_TABLING
#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
CACHE_REGS
#endif /* OUTPUT_THREADS_TABLING */
#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
LOCK_SG_FR(sg_fr);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
@ -1063,7 +1064,7 @@ static inline void mark_as_completed(sg_fr_ptr sg_fr) {
next_node = TrNode_child(next_node);
}
SgFr_last_answer(sg_fr) = current_node;
#ifndef YAPOR
#if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
/* free invalid answer nodes */
current_node = SgFr_invalid_chain(sg_fr);
SgFr_invalid_chain(sg_fr) = NULL;
@ -1072,7 +1073,7 @@ static inline void mark_as_completed(sg_fr_ptr sg_fr) {
FREE_ANSWER_TRIE_NODE(current_node);
current_node = next_node;
}
#endif /* ! YAPOR */
#endif /* !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
}
#endif /* MODE_DIRECTED_TABLING */
return;
@ -1298,24 +1299,33 @@ static inline void abolish_incomplete_subgoals(choiceptr prune_cp) {
next_node = TrNode_child(next_node);
}
SgFr_last_answer(sg_fr) = current_node;
#ifndef YAPOR
#if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
/* free invalid answer nodes */
current_node = SgFr_invalid_chain(sg_fr);
SgFr_invalid_chain(sg_fr) = NULL;
while (current_node) {
next_node = TrNode_next(invalid_node);
next_node = TrNode_next(current_node);
FREE_ANSWER_TRIE_NODE(current_node);
current_node = node_node;
current_node = next_node;
}
#endif /* ! YAPOR */
#endif /* !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
}
#endif /* MODE_DIRECTED_TABLING */
#else
ans_node_ptr node;
#ifdef MODE_DIRECTED_TABLING
ans_node_ptr invalid_node = SgFr_invalid_chain(sg_fr);
SgFr_invalid_chain(sg_fr) = NULL;
#endif /* MODE_DIRECTED_TABLING */
#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
if (SgFr_invalid_chain(sg_fr)) {
ans_node_ptr current_node, next_node;
/* free invalid answer nodes */
current_node = SgFr_invalid_chain(sg_fr);
SgFr_invalid_chain(sg_fr) = NULL;
while (current_node) {
next_node = TrNode_next(current_node);
FREE_ANSWER_TRIE_NODE(current_node);
current_node = next_node;
}
}
#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
SgFr_state(sg_fr) = ready;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
if (SgFr_active_workers(sg_fr) == 0) {
@ -1339,7 +1349,7 @@ static inline void abolish_incomplete_subgoals(choiceptr prune_cp) {
local_uncons_ans = SgFr_batched_cached_answers(sg_fr);
}
}
} else{ /* SgFr_active_workers(sg_fr) != 0 */
} else { /* SgFr_active_workers(sg_fr) != 0 */
if (IsMode_Batched(TabEnt_mode(SgFr_tab_ent(sg_fr)))){
SgFr_batched_last_answer(sg_fr) = NULL;
if ( worker_id >= ANSWER_LEAF_NODE_MAX_THREADS ) {
@ -1361,14 +1371,6 @@ static inline void abolish_incomplete_subgoals(choiceptr prune_cp) {
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
}
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
#if defined(MODE_DIRECTED_TABLING) && ! defined(YAPOR)
/* free invalid answer nodes */
while (invalid_node) {
node = TrNode_next(invalid_node);
FREE_ANSWER_TRIE_NODE(invalid_node);
invalid_node = node;
}
#endif /* MODE_DIRECTED_TABLING && ! YAPOR */
#endif /* INCOMPLETE_TABLING */
}
#ifdef LIMIT_TABLING

261
OPTYap/tab.tries.c
View File

@ -21,28 +21,33 @@
#include "YapHeap.h"
#include "tab.macros.h"
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term);
static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term);
static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int);
static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int);
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr, Term);
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr, sg_node_ptr, Term USES_REGS);
static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr, Term USES_REGS);
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr, Term);
static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr, Term USES_REGS);
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL **);
static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL **);
static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term, int *);
static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr, Term, int *);
static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL ** USES_REGS);
static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr, sg_node_ptr, Term, int *, CELL ** USES_REGS);
static inline ans_node_ptr answer_search_loop(sg_fr_ptr, ans_node_ptr, Term, int * USES_REGS);
static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr, ans_node_ptr, Term, int * USES_REGS);
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
static inline gt_node_ptr subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL *);
static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *, CELL *);
static inline gt_node_ptr subgoal_search_global_trie_terms_loop(Term, int *, CELL **, CELL * USES_REGS);
static inline gt_node_ptr answer_search_global_trie_terms_loop(Term, int *, CELL * USES_REGS);
#else
static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *, CELL **);
static inline gt_node_ptr answer_search_global_trie_loop(Term, int *);
static inline gt_node_ptr subgoal_search_global_trie_loop(Term, int *, CELL ** USES_REGS);
static inline gt_node_ptr answer_search_global_trie_loop(Term, int * USES_REGS);
#endif /* GLOBAL_TRIE_MODE */
static inline CELL *load_answer_loop(ans_node_ptr);
static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL *);
static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **, CELL *);
static inline CELL *load_answer_loop(ans_node_ptr USES_REGS);
static inline CELL *load_substitution_loop(gt_node_ptr, int *, CELL * USES_REGS);
static inline CELL *exec_substitution_loop(gt_node_ptr, CELL **, CELL * USES_REGS);
#ifdef MODE_DIRECTED_TABLING
static inline ans_node_ptr answer_search_min_max(sg_fr_ptr, ans_node_ptr, Term, int USES_REGS);
static inline ans_node_ptr answer_search_sum(sg_fr_ptr, ans_node_ptr, Term USES_REGS);
static void invalidate_answer_trie(ans_node_ptr, sg_fr_ptr, int USES_REGS);
#endif /* MODE_DIRECTED_TABLING */
#ifdef YAPOR
#ifdef TABLING_INNER_CUTS
@ -54,15 +59,15 @@ static int update_answer_trie_branch(ans_node_ptr);
static void update_answer_trie_branch(ans_node_ptr, int);
#endif
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
static void free_global_trie_branch(gt_node_ptr, int);
static void free_global_trie_branch(gt_node_ptr, int USES_REGS);
#else
static void free_global_trie_branch(gt_node_ptr);
static void free_global_trie_branch(gt_node_ptr USES_REGS);
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, int);
static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int, int);
static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, int);
static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *, int *, int);
static inline void traverse_trie_node(Term, char *, int *, int *, int *, int);
static void traverse_subgoal_trie(sg_node_ptr, char *, int, int *, int, int USES_REGS);
static void traverse_answer_trie(ans_node_ptr, char *, int, int *, int, int, int USES_REGS);
static void traverse_global_trie(gt_node_ptr, char *, int, int *, int, int USES_REGS);
static void traverse_global_trie_for_term(gt_node_ptr, char *, int *, int *, int *, int USES_REGS);
static inline void traverse_trie_node(Term, char *, int *, int *, int *, int USES_REGS);
static inline void traverse_update_arity(char *, int *, int *);
@ -123,13 +128,13 @@ static struct trie_statistics{
#endif /*THREADS */
#if defined(THREADS_SUBGOAL_SHARING) || defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES if (worker_id == 0)
#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES if (GLOBAL_NOfThreads == 1)
#else
#define IF_ABOLISH_SUBGOAL_TRIE_SHARED_DATA_STRUCTURES
#endif /* THREADS_SUBGOAL_SHARING || THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES if (worker_id == 0)
#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES if (GLOBAL_NOfThreads == 1)
#else
#define IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
@ -151,11 +156,11 @@ static struct trie_statistics{
#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF,MODE) \
CHECK_DECREMENT_GLOBAL_TRIE_REFERENCE(REF,MODE)
#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \
free_global_trie_branch(NODE,MODE)
free_global_trie_branch(NODE,MODE PASS_REGS)
#else
#define CHECK_DECREMENT_GLOBAL_TRIE_FOR_SUBTERMS_REFERENCE(REF,MODE)
#define FREE_GLOBAL_TRIE_BRANCH(NODE,MODE) \
free_global_trie_branch(NODE)
free_global_trie_branch(NODE PASS_REGS)
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
@ -212,13 +217,13 @@ static struct trie_statistics{
#ifdef MODE_DIRECTED_TABLING
#define INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
#include "tab.tries.i" /* answer_search_min_max + invalidate_answer_trie */
#include "tab.tries.i" /* answer_search_min_max + answer_search_sum + invalidate_answer_trie */
#undef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
#endif /* MODE_DIRECTED_TABLING */
static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms) {
static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stack_vars_ptr, CELL *stack_terms USES_REGS) {
/************************************************************************
===========
| |
@ -256,7 +261,6 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac
LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS)
-----------
************************************************************************/
CACHE_REGS
CELL *stack_vars = *stack_vars_ptr;
CELL *stack_terms_limit = (CELL *) TR;
#ifdef TRIE_COMPACT_PAIRS
@ -270,7 +274,7 @@ static inline CELL *exec_substitution_loop(gt_node_ptr current_node, CELL **stac
if (IsVarTerm(t)) {
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
stack_terms = exec_substitution_loop((gt_node_ptr) t, &stack_vars, stack_terms);
stack_terms = exec_substitution_loop((gt_node_ptr) t, &stack_vars, stack_terms PASS_REGS);
} else
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
{
@ -477,10 +481,10 @@ static void update_answer_trie_branch(ans_node_ptr current_node, int position) {
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
static void free_global_trie_branch(gt_node_ptr current_node, int mode) {
static void free_global_trie_branch(gt_node_ptr current_node, int mode USES_REGS) {
Term t = TrNode_entry(current_node);
#else
static void free_global_trie_branch(gt_node_ptr current_node) {
static void free_global_trie_branch(gt_node_ptr current_node USES_REGS) {
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
gt_node_ptr parent_node, child_node;
@ -578,8 +582,7 @@ static void free_global_trie_branch(gt_node_ptr current_node) {
}
static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
CACHE_REGS
static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position USES_REGS) {
int *current_arity = NULL, current_str_index = 0, current_mode = 0;
/* test if hashing */
@ -593,7 +596,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_subgoal_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
traverse_subgoal_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
@ -618,7 +621,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i
/* process current trie node */
TrStat_sg_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL);
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_SUBGOAL PASS_REGS);
/* show answers ... */
if (IS_SUBGOAL_LEAF_NODE(current_node)) {
@ -641,7 +644,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i
SHOW_TABLE_STRUCTURE(" TRUE\n");
} else {
arity[0] = 0;
traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
traverse_answer_trie(TrNode_child(SgFr_answer_trie(sg_fr)), &str[str_index], 0, arity, 0, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST PASS_REGS);
if (SgFr_state(sg_fr) < complete) {
TrStat_sg_incomplete++;
SHOW_TABLE_STRUCTURE(" ---> INCOMPLETE\n");
@ -650,7 +653,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i
}
} else
/* ... or continue with child node */
traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
traverse_subgoal_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
str_index = current_str_index;
@ -665,7 +668,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_subgoal_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
traverse_subgoal_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT PASS_REGS);
current_node = TrNode_next(current_node);
}
free(current_arity);
@ -674,8 +677,7 @@ static void traverse_subgoal_trie(sg_node_ptr current_node, char *str, int str_i
}
static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position) {
CACHE_REGS
static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_index, int *arity, int var_index, int mode, int position USES_REGS) {
int *current_arity = NULL, current_str_index = 0, current_var_index = 0, current_mode = 0;
/* test if hashing */
@ -689,7 +691,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
traverse_answer_trie(*bucket, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
@ -721,7 +723,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i
/* process current trie node */
TrStat_ans_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER);
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_ANSWER PASS_REGS);
/* show answer .... */
if (IS_ANSWER_LEAF_NODE(current_node)) {
@ -738,7 +740,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i
#endif /* TABLING_INNER_CUTS */
/* ... or continue with child node */
else
traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST);
traverse_answer_trie(TrNode_child(current_node), str, str_index, arity, var_index, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
/* restore the initial state and continue with sibling nodes */
if (position == TRAVERSE_POSITION_FIRST) {
@ -755,7 +757,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_NEXT);
traverse_answer_trie(current_node, str, str_index, arity, var_index, mode, TRAVERSE_POSITION_NEXT PASS_REGS);
current_node = TrNode_next(current_node);
}
free(current_arity);
@ -765,8 +767,7 @@ static void traverse_answer_trie(ans_node_ptr current_node, char *str, int str_i
}
static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position) {
CACHE_REGS
static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_index, int *arity, int mode, int position USES_REGS) {
int *current_arity = NULL, current_str_index = 0, current_mode = 0;
/* test if hashing */
@ -780,7 +781,7 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in
memcpy(current_arity, arity, sizeof(int) * (arity[0] + 1));
do {
if (*bucket) {
traverse_global_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
traverse_global_trie(*bucket, str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
memcpy(arity, current_arity, sizeof(int) * (current_arity[0] + 1));
#ifdef TRIE_COMPACT_PAIRS
if (arity[arity[0]] == -2 && str[str_index - 1] != '[')
@ -805,11 +806,11 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in
/* process current trie node */
TrStat_gt_nodes++;
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_GT_SUBGOAL);
traverse_trie_node(TrNode_entry(current_node), str, &str_index, arity, &mode, TRAVERSE_TYPE_GT_SUBGOAL PASS_REGS);
/* continue with child node ... */
if (arity[0] != 0 || mode != TRAVERSE_MODE_NORMAL)
traverse_global_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST);
traverse_global_trie(TrNode_child(current_node), str, str_index, arity, mode, TRAVERSE_POSITION_FIRST PASS_REGS);
/* ... or show term */
else {
TrStat_gt_terms++;
@ -831,7 +832,7 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in
if (arity[arity[0]] == -1)
str[str_index - 1] = '|';
#endif /* TRIE_COMPACT_PAIRS */
traverse_global_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT);
traverse_global_trie(current_node, str, str_index, arity, mode, TRAVERSE_POSITION_NEXT PASS_REGS);
current_node = TrNode_next(current_node);
}
free(current_arity);
@ -841,16 +842,15 @@ static void traverse_global_trie(gt_node_ptr current_node, char *str, int str_in
}
static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type) {
static void traverse_global_trie_for_term(gt_node_ptr current_node, char *str, int *str_index, int *arity, int *mode, int type USES_REGS) {
if (TrNode_parent(current_node) != GLOBAL_root_gt)
traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type);
traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type);
traverse_global_trie_for_term(TrNode_parent(current_node), str, str_index, arity, mode, type PASS_REGS);
traverse_trie_node(TrNode_entry(current_node), str, str_index, arity, mode, type PASS_REGS);
return;
}
static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type) {
CACHE_REGS
static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int *arity, int *mode_ptr, int type USES_REGS) {
int mode = *mode_ptr;
int str_index = *str_index_ptr;
@ -903,7 +903,7 @@ static inline void traverse_trie_node(Term t, char *str, int *str_index_ptr, int
TrStat_gt_refs++;
/* (type % 2 + 2): TRAVERSE_TYPE_ANSWER --> TRAVERSE_TYPE_GT_ANSWER */
/* (type % 2 + 2): TRAVERSE_TYPE_SUBGOAL --> TRAVERSE_TYPE_GT_SUBGOAL */
traverse_global_trie_for_term((gt_node_ptr) t, str, &str_index, arity, &mode, type % 2 + 2);
traverse_global_trie_for_term((gt_node_ptr) t, str, &str_index, arity, &mode, type % 2 + 2 PASS_REGS);
} else {
if (type == TRAVERSE_TYPE_SUBGOAL || type == TRAVERSE_TYPE_GT_SUBGOAL)
str_index += sprintf(& str[str_index], "VAR%d", VarIndexOfTableTerm(t));
@ -1037,7 +1037,7 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
int old_subs_arity = subs_arity;
for (i = 1; i <= pred_arity; i++) {
int j = MODE_DIRECTED_GET_ARG(mode_directed[i-1]) + 1;
current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[j]), &subs_arity, &stack_vars);
current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[j]), &subs_arity, &stack_vars PASS_REGS);
if (subs_arity != old_subs_arity) {
if (subs_pos && MODE_DIRECTED_GET_MODE(aux_mode_directed[subs_pos-1]) == MODE_DIRECTED_GET_MODE(mode_directed[i-1])) {
/* same mode as before -> use the current entry in the aux_mode_directed[] array */
@ -1054,10 +1054,10 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
#endif /* MODE_DIRECTED_TABLING */
if (IsMode_GlobalTrie(TabEnt_mode(tab_ent))) {
for (i = 1; i <= pred_arity; i++)
current_sg_node = subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars);
current_sg_node = subgoal_search_terms_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars PASS_REGS);
} else {
for (i = 1; i <= pred_arity; i++)
current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars);
current_sg_node = subgoal_search_loop(tab_ent, current_sg_node, Deref(XREGS[i]), &subs_arity, &stack_vars PASS_REGS);
}
STACK_PUSH_UP(subs_arity, stack_vars);
@ -1068,7 +1068,7 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
RESET_VARIABLE(t);
}
volatile sg_fr_ptr *sg_fr_end = get_insert_subgoal_frame_addr(current_sg_node PASS_REGS);
sg_fr_ptr *sg_fr_end = get_insert_subgoal_frame_addr(current_sg_node PASS_REGS);
#ifndef THREADS
LOCK_SUBGOAL_NODE(current_sg_node);
#endif /* !THREADS */
@ -1084,6 +1084,7 @@ sg_fr_ptr subgoal_search(yamop *preg, CELL **Yaddr) {
#if !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
new_subgoal_frame(sg_fr, preg, mode_directed);
*sg_fr_end = sg_fr;
__sync_synchronize();
TAG_AS_SUBGOAL_LEAF_NODE(current_sg_node);
UNLOCK_SUBGOAL_NODE(current_sg_node);
#else /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
@ -1139,12 +1140,12 @@ ans_node_ptr answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
if (IsMode_GlobalTrie(TabEnt_mode(SgFr_tab_ent(sg_fr)))) {
for (i = subs_arity; i >= 1; i--) {
TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
current_ans_node = answer_search_terms_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
current_ans_node = answer_search_terms_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
}
} else {
for (i = subs_arity; i >= 1; i--) {
TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
}
}
@ -1181,45 +1182,51 @@ ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
do {
TABLING_ERROR_CHECKING(answer_search, IsNonVarTerm(subs_ptr[i]));
if (mode == MODE_DIRECTED_INDEX || mode == MODE_DIRECTED_ALL) {
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
} else {
LOCK_ANSWER_NODE(current_ans_node);
if (TrNode_child(current_ans_node) == NULL) {
#ifdef YAPOR
struct answer_trie_node virtual_ans_node;
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
struct answer_trie_node virtual_ans_node; /* necessary because the answer_search_loop() procedure also locks the parent node */
ans_node_ptr parent_ans_node = current_ans_node;
TrNode_init_lock_field(&virtual_ans_node);
AnsNode_init_lock_field(&virtual_ans_node);
TrNode_parent(&virtual_ans_node) = NULL;
TrNode_child(&virtual_ans_node) = NULL;
current_ans_node = answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), &vars_arity);
current_ans_node = answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node);
TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node;
#else
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
#endif /* YAPOR */
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
} else if (mode == MODE_DIRECTED_MIN || mode == MODE_DIRECTED_MAX) {
ans_node_ptr parent_ans_node = current_ans_node;
invalid_ans_node = TrNode_child(parent_ans_node); /* by default, assume a better answer */
current_ans_node = answer_search_min_max(sg_fr, current_ans_node, Deref(subs_ptr[i]), mode);
current_ans_node = answer_search_min_max(sg_fr, current_ans_node, Deref(subs_ptr[i]), mode PASS_REGS);
if (invalid_ans_node == TrNode_child(parent_ans_node)) /* worse or equal answer */
invalid_ans_node = NULL;
} else if (mode == MODE_DIRECTED_FIRST)
current_ans_node = NULL;
else { /* mode == MODE_DIRECTED_LAST */
#ifdef YAPOR
struct answer_trie_node virtual_ans_node;
} else if (mode == MODE_DIRECTED_SUM) {
invalid_ans_node = TrNode_child(current_ans_node);
current_ans_node = answer_search_sum(sg_fr, current_ans_node, Deref(subs_ptr[i]) PASS_REGS);
} else if (mode == MODE_DIRECTED_LAST) {
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
struct answer_trie_node virtual_ans_node; /* necessary because the answer_search_loop() procedure also locks the parent node */
ans_node_ptr parent_ans_node = current_ans_node;
invalid_ans_node = TrNode_child(parent_ans_node);
TrNode_init_lock_field(&virtual_ans_node);
AnsNode_init_lock_field(&virtual_ans_node);
TrNode_parent(&virtual_ans_node) = NULL;
TrNode_child(&virtual_ans_node) = NULL;
current_ans_node = answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), &vars_arity);
current_ans_node = answer_search_loop(sg_fr, &virtual_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
TrNode_child(parent_ans_node) = TrNode_child(&virtual_ans_node);
TrNode_parent(TrNode_child(&virtual_ans_node)) = parent_ans_node;
#else
invalid_ans_node = TrNode_child(current_ans_node);
TrNode_child(current_ans_node) = NULL;
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity);
#endif /* YAPOR */
}
current_ans_node = answer_search_loop(sg_fr, current_ans_node, Deref(subs_ptr[i]), &vars_arity PASS_REGS);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
} else if (mode == MODE_DIRECTED_FIRST) {
current_ans_node = NULL;
} else
Yap_Error(INTERNAL_ERROR, TermNil, "mode_directed_answer_search: unknown mode");
UNLOCK_ANSWER_NODE(current_ans_node);
}
n_subs--;
@ -1230,7 +1237,7 @@ ans_node_ptr mode_directed_answer_search(sg_fr_ptr sg_fr, CELL *subs_ptr) {
j++;
}
if (invalid_ans_node)
invalidate_answer_trie(invalid_ans_node, sg_fr, TRAVERSE_POSITION_FIRST);
invalidate_answer_trie(invalid_ans_node, sg_fr, TRAVERSE_POSITION_FIRST PASS_REGS);
/* reset variables */
stack_vars = (CELL *) TR;
@ -1255,7 +1262,7 @@ void load_answer(ans_node_ptr current_ans_node, CELL *subs_ptr) {
if (subs_arity == 0)
return;
stack_terms = load_answer_loop(current_ans_node);
stack_terms = load_answer_loop(current_ans_node PASS_REGS);
for (i = subs_arity; i >= 1; i--) {
Term t = STACK_POP_DOWN(stack_terms);
@ -1275,7 +1282,7 @@ CELL *exec_substitution(gt_node_ptr current_node, CELL *aux_stack) {
Term t;
++aux_stack; /* skip the heap_arity entry */
stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) LOCAL_TrailTop);
stack_terms = exec_substitution_loop(current_node, &aux_stack, (CELL *) LOCAL_TrailTop PASS_REGS);
*--aux_stack = 0; /* restore the heap_arity entry */
subs_ptr = aux_stack + aux_stack[1] + 2;
@ -1388,24 +1395,31 @@ void free_subgoal_trie(sg_node_ptr current_node, int mode, int position) {
IF_ABOLISH_ANSWER_TRIE_SHARED_DATA_STRUCTURES {
FREE_ANSWER_TRIE_NODE(ans_node);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
#ifdef MODE_DIRECTED_TABLING
if (SgEnt_mode_directed(SgFr_sg_ent(sg_fr)))
FREE_BLOCK(SgEnt_mode_directed(SgFr_sg_ent(sg_fr)));
if (SgFr_invalid_chain(sg_fr)) {
ans_node_ptr current_node, next_node;
/* free invalid answer nodes */
current_node = SgFr_invalid_chain(sg_fr);
SgFr_invalid_chain(sg_fr) = NULL;
while (current_node) {
next_node = TrNode_next(current_node);
FREE_ANSWER_TRIE_NODE(current_node);
current_node = next_node;
}
}
#endif /* MODE_DIRECTED_TABLING */
FREE_SUBGOAL_ENTRY(SgFr_sg_ent(sg_fr));
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
}
#if defined(MODE_DIRECTED_TABLING) && defined(YAPOR)
if (SgFr_invalid_chain(sg_fr)) {
ans_node_ptr next_node, invalid_node = SgFr_invalid_chain(sg_fr);
SgFr_invalid_chain(sg_fr) = NULL;
/* free invalid answer nodes */
while (invalid_node) {
next_node = TrNode_next(invalid_node);
FREE_ANSWER_TRIE_NODE(invalid_node);
invalid_node = next_node;
}
}
#endif /* MODE_DIRECTED_TABLING && YAPOR */
#ifdef LIMIT_TABLING
remove_from_global_sg_fr_list(sg_fr);
#endif /* LIMIT_TABLING */
#if defined(MODE_DIRECTED_TABLING) && !defined(THREADS_FULL_SHARING) && !defined(THREADS_CONSUMER_SHARING)
if (SgFr_mode_directed(sg_fr))
FREE_BLOCK(SgFr_mode_directed(sg_fr));
#endif /* MODE_DIRECTED_TABLING && !THREADS_FULL_SHARING && !THREADS_CONSUMER_SHARING */
FREE_SUBGOAL_FRAME(sg_fr);
}
}
@ -1516,16 +1530,33 @@ void free_answer_hash_chain(ans_hash_ptr hash) {
}
/***********************************************************************************************************************
** - main thread (worker_id 0) abolishes its local and all shared data structures. **
** - all other threads only abolish their local data structures. **
** - for the main thread, we assume that all other threads have the table clean (i.e., without local data structures) **
** and that they will be not using the table during the abolish operation. **
***********************************************************************************************************************/
/*****************************************************************************************
** all threads abolish their local data structures, and the main thread also abolishes **
** all shared data structures, if no other thread is running (GLOBAL_NOfThreads == 1). **
*****************************************************************************************/
void abolish_table(tab_ent_ptr tab_ent) {
CACHE_REGS
sg_node_ptr sg_node;
#ifdef THREADS
if (GLOBAL_NOfThreads == 1) {
ATTACH_PAGES(_pages_tab_ent);
#if defined(THREADS_FULL_SHARING) || defined(THREADS_CONSUMER_SHARING)
ATTACH_PAGES(_pages_sg_ent);
#endif /* THREADS_FULL_SHARING || THREADS_CONSUMER_SHARING */
ATTACH_PAGES(_pages_sg_fr);
ATTACH_PAGES(_pages_dep_fr);
ATTACH_PAGES(_pages_sg_node);
ATTACH_PAGES(_pages_sg_hash);
ATTACH_PAGES(_pages_ans_node);
ATTACH_PAGES(_pages_ans_hash);
#if defined(THREADS_FULL_SHARING)
ATTACH_PAGES(_pages_ans_ref_node);
#endif /* THREADS_FULL_SHARING */
ATTACH_PAGES(_pages_gt_node);
ATTACH_PAGES(_pages_gt_hash);
}
#endif /* THREADS */
sg_node = get_subgoal_trie_for_abolish(tab_ent PASS_REGS);
if (sg_node) {
if (TrNode_child(sg_node)) {
@ -1586,16 +1617,20 @@ void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) {
int mode = MODE_DIRECTED_GET_MODE(mode_directed[i]);
if (mode == MODE_DIRECTED_INDEX) {
Sfprintf(TrStat_out, "index");
} else if (mode == MODE_DIRECTED_FIRST) {
Sfprintf(TrStat_out, "first");
} else if (mode == MODE_DIRECTED_ALL) {
Sfprintf(TrStat_out, "all");
} else if (mode == MODE_DIRECTED_MAX) {
Sfprintf(TrStat_out, "max");
} else if (mode == MODE_DIRECTED_MIN) {
Sfprintf(TrStat_out, "min");
} else /* MODE_DIRECTED_LAST */
} else if (mode == MODE_DIRECTED_MAX) {
Sfprintf(TrStat_out, "max");
} else if (mode == MODE_DIRECTED_ALL) {
Sfprintf(TrStat_out, "all");
} else if (mode == MODE_DIRECTED_SUM) {
Sfprintf(TrStat_out, "sum");
} else if (mode == MODE_DIRECTED_LAST) {
Sfprintf(TrStat_out, "last");
} else if (mode == MODE_DIRECTED_FIRST) {
Sfprintf(TrStat_out, "first");
} else
Yap_Error(INTERNAL_ERROR, TermNil, "show_table: unknown mode");
if (i != MODE_DIRECTED_GET_ARG(mode_directed[i]))
Sfprintf(TrStat_out, "(ARG%d)", MODE_DIRECTED_GET_ARG(mode_directed[i]) + 1);
if (i + 1 != TabEnt_arity(tab_ent))
@ -1614,7 +1649,7 @@ void show_table(tab_ent_ptr tab_ent, int show_mode, IOSTREAM *out) {
arity[0] = 1;
arity[1] = TabEnt_arity(tab_ent);
int str_index = sprintf(str, " ?- %s(", AtomName(TabEnt_atom(tab_ent)));
traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
traverse_subgoal_trie(TrNode_child(sg_node), str, str_index, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST PASS_REGS);
free(str);
free(arity);
} else {
@ -1676,7 +1711,7 @@ void show_global_trie(int show_mode, IOSTREAM *out) {
char *str = (char *) malloc(sizeof(char) * SHOW_TABLE_STR_ARRAY_SIZE);
int *arity = (int *) malloc(sizeof(int) * SHOW_TABLE_ARITY_ARRAY_SIZE);
arity[0] = 0;
traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST);
traverse_global_trie(TrNode_child(GLOBAL_root_gt), str, 0, arity, TRAVERSE_MODE_NORMAL, TRAVERSE_POSITION_FIRST PASS_REGS);
free(str);
free(arity);
} else

245
OPTYap/tab.tries.i
View File

@ -40,18 +40,40 @@
#ifdef MODE_GLOBAL_TRIE_LOOP
#define SUBGOAL_CHECK_INSERT_ENTRY(TAB_ENT, NODE, ENTRY) \
NODE = global_trie_check_insert_entry(NODE, ENTRY)
#define ANSWER_CHECK_INSERT_ENTRY(SG_FR, NODE, ENTRY, INSTR) \
NODE = global_trie_check_insert_entry(NODE, ENTRY)
#define SUBGOAL_CHECK_INSERT_ENTRY(TAB_ENT, NODE, ENTRY) \
NODE = global_trie_check_insert_entry(NODE, ENTRY PASS_REGS)
#define ANSWER_CHECK_INSERT_ENTRY(SG_FR, NODE, ENTRY, INSTR) \
NODE = global_trie_check_insert_entry(NODE, ENTRY PASS_REGS)
#else
#define SUBGOAL_CHECK_INSERT_ENTRY(TAB_ENT, NODE, ENTRY) \
NODE = subgoal_trie_check_insert_entry(TAB_ENT, NODE, ENTRY)
#define ANSWER_CHECK_INSERT_ENTRY(SG_FR, NODE, ENTRY, INSTR) \
NODE = answer_trie_check_insert_entry(SG_FR, NODE, ENTRY, INSTR)
#define SUBGOAL_CHECK_INSERT_ENTRY(TAB_ENT, NODE, ENTRY) \
NODE = subgoal_trie_check_insert_entry(TAB_ENT, NODE, ENTRY PASS_REGS)
#define ANSWER_CHECK_INSERT_ENTRY(SG_FR, NODE, ENTRY, INSTR) \
NODE = answer_trie_check_insert_entry(SG_FR, NODE, ENTRY, INSTR PASS_REGS)
#endif /* MODE_GLOBAL_TRIE_LOOP */
#ifdef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
#define ANSWER_SAFE_INSERT_ENTRY(NODE, ENTRY, INSTR) \
{ ans_node_ptr new_node; \
NEW_ANSWER_TRIE_NODE(new_node, INSTR, ENTRY, NULL, NODE, NULL); \
TrNode_child(NODE) = new_node; \
NODE = new_node; \
}
#ifdef THREADS
#define INVALIDATE_ANSWER_TRIE_NODE(NODE, SG_FR) \
TrNode_next(NODE) = SgFr_invalid_chain(SG_FR); \
SgFr_invalid_chain(SG_FR) = NODE
#else
#define INVALIDATE_ANSWER_TRIE_NODE(NODE, SG_FR) \
FREE_ANSWER_TRIE_NODE(NODE)
#endif /* THREADS */
#define INVALIDATE_ANSWER_TRIE_LEAF_NODE(NODE, SG_FR) \
TAG_AS_ANSWER_INVALID_NODE(NODE); \
TrNode_next(NODE) = SgFr_invalid_chain(SG_FR); \
SgFr_invalid_chain(SG_FR) = NODE
#endif /* INCLUDE_ANSWER_SEARCH_MODE_DIRECTED */
/************************************************************************
** subgoal_trie_check_insert_(gt)_entry **
@ -60,13 +82,10 @@
#ifdef INCLUDE_SUBGOAL_TRIE_CHECK_INSERT
#ifndef SUBGOAL_TRIE_LOCK_AT_WRITE_LEVEL /* SUBGOAL_TRIE_LOCK_AT_ENTRY_LEVEL || SUBGOAL_TRIE_LOCK_AT_NODE_LEVEL || ! YAPOR */
#ifdef MODE_GLOBAL_TRIE_ENTRY
static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) {
static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t USES_REGS) {
#else
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) {
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
#ifdef THREADS_NO_SHARING
CACHE_REGS
#endif /* THREADS_NO_SHARING */
sg_node_ptr child_node;
LOCK_SUBGOAL_NODE(parent_node);
@ -160,13 +179,10 @@ static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, s
}
#else /* SUBGOAL_TRIE_LOCK_AT_WRITE_LEVEL */
#ifdef MODE_GLOBAL_TRIE_ENTRY
static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) {
static inline sg_node_ptr subgoal_trie_check_insert_gt_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t USES_REGS) {
#else
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t) {
static inline sg_node_ptr subgoal_trie_check_insert_entry(tab_ent_ptr tab_ent, sg_node_ptr parent_node, Term t USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
#ifdef THREADS_NO_SHARING
CACHE_REGS
#endif /* THREADS_NO_SHARING */
sg_node_ptr child_node;
sg_hash_ptr hash;
@ -365,13 +381,10 @@ subgoal_trie_hash:
#ifdef INCLUDE_ANSWER_TRIE_CHECK_INSERT
#ifndef ANSWER_TRIE_LOCK_AT_WRITE_LEVEL /* ANSWER_TRIE_LOCK_AT_ENTRY_LEVEL || ANSWER_TRIE_LOCK_AT_NODE_LEVEL || ! YAPOR */
#ifdef MODE_GLOBAL_TRIE_ENTRY
static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) {
static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr USES_REGS) {
#else
static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) {
static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
#if defined(THREADS_NO_SHARING) || defined(THREADS_SUBGOAL_SHARING)
CACHE_REGS
#endif /* THREADS_NO_SHARING || THREADS_SUBGOAL_SHARING */
ans_node_ptr child_node;
TABLING_ERROR_CHECKING(answer_trie_check_insert_(gt)_entry, IS_ANSWER_LEAF_NODE(parent_node));
@ -466,11 +479,10 @@ static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_n
}
#else /* ANSWER_TRIE_LOCK_AT_WRITE_LEVEL */
#ifdef MODE_GLOBAL_TRIE_ENTRY
static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) {
static inline ans_node_ptr answer_trie_check_insert_gt_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr USES_REGS) {
#else
static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr) {
static inline ans_node_ptr answer_trie_check_insert_entry(sg_fr_ptr sg_fr, ans_node_ptr parent_node, Term t, int instr USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
CACHE_REGS
ans_node_ptr child_node;
ans_hash_ptr hash;
@ -670,9 +682,9 @@ answer_trie_hash:
#ifdef INCLUDE_GLOBAL_TRIE_CHECK_INSERT
#ifndef GLOBAL_TRIE_LOCK_AT_WRITE_LEVEL /* GLOBAL_TRIE_LOCK_AT_NODE_LEVEL || ! YAPOR */
#ifdef MODE_GLOBAL_TRIE_ENTRY
static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr parent_node, Term t) {
static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr parent_node, Term t USES_REGS) {
#else
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node, Term t) {
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node, Term t USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
gt_node_ptr child_node;
@ -767,11 +779,10 @@ static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node
}
#else /* GLOBAL_TRIE_LOCK_AT_WRITE_LEVEL */
#ifdef MODE_GLOBAL_TRIE_ENTRY
static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr parent_node, Term t) {
static inline gt_node_ptr global_trie_check_insert_gt_entry(gt_node_ptr parent_node, Term t USES_REGS) {
#else
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node, Term t) {
static inline gt_node_ptr global_trie_check_insert_entry(gt_node_ptr parent_node, Term t USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_ENTRY */
CACHE_REGS
gt_node_ptr child_node;
gt_hash_ptr hash;
@ -970,15 +981,15 @@ global_trie_hash:
#ifdef INCLUDE_SUBGOAL_SEARCH_LOOP
#ifdef MODE_GLOBAL_TRIE_LOOP
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
static inline gt_node_ptr subgoal_search_global_trie_terms_loop(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr, CELL *stack_terms) {
static inline gt_node_ptr subgoal_search_global_trie_terms_loop(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr, CELL *stack_terms USES_REGS) {
#else
static inline gt_node_ptr subgoal_search_global_trie_loop(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) {
static inline gt_node_ptr subgoal_search_global_trie_loop(Term t, int *subs_arity_ptr, CELL **stack_vars_ptr USES_REGS) {
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
#else
#ifdef MODE_TERMS_LOOP
static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) {
static inline sg_node_ptr subgoal_search_terms_loop(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr USES_REGS) {
#else
static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr) {
static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr current_node, Term t, int *subs_arity_ptr, CELL **stack_vars_ptr USES_REGS) {
#endif /* MODE_TERMS_LOOP */
#endif /* MODE_GLOBAL_TRIE_LOOP */
/************************************************************************
@ -1020,7 +1031,6 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c
LOCAL_TrailTop --> | |
-----------
************************************************************************/
CACHE_REGS
#ifdef MODE_GLOBAL_TRIE_LOOP
gt_node_ptr current_node = GLOBAL_root_gt;
#endif /* MODE_GLOBAL_TRIE_LOOP */
@ -1058,11 +1068,11 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c
} else {
gt_node_ptr entry_node;
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms);
entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms PASS_REGS);
#else
entry_node = subgoal_search_global_trie_loop(t, &subs_arity, &stack_vars);
entry_node = subgoal_search_global_trie_loop(t, &subs_arity, &stack_vars PASS_REGS);
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
current_node = subgoal_trie_check_insert_gt_entry(tab_ent, current_node, (Term) entry_node);
current_node = subgoal_trie_check_insert_gt_entry(tab_ent, current_node, (Term) entry_node PASS_REGS);
#else /* ! MODE_TERMS_LOOP */
} else
#if defined(MODE_GLOBAL_TRIE_LOOP)
@ -1093,8 +1103,8 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c
}
#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS)
} else if (current_node != GLOBAL_root_gt) {
gt_node_ptr entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node);
gt_node_ptr entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms PASS_REGS);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node PASS_REGS);
#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */
} else {
SUBGOAL_CHECK_INSERT_ENTRY(tab_ent, current_node, CompactPairInit);
@ -1110,14 +1120,14 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c
}
#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS)
} else if (current_node != GLOBAL_root_gt) {
gt_node_ptr entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node);
gt_node_ptr entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms PASS_REGS);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node PASS_REGS);
#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */
#else /* ! TRIE_COMPACT_PAIRS */
#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS)
if (current_node != GLOBAL_root_gt) {
gt_node_ptr entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node);
gt_node_ptr entry_node = subgoal_search_global_trie_terms_loop(t, &subs_arity, &stack_vars, stack_terms PASS_REGS);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node PASS_REGS);
} else
#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */
if (IsPairTerm(t)) {
@ -1184,15 +1194,15 @@ static inline sg_node_ptr subgoal_search_loop(tab_ent_ptr tab_ent, sg_node_ptr c
#ifdef INCLUDE_ANSWER_SEARCH_LOOP
#ifdef MODE_GLOBAL_TRIE_LOOP
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
static inline gt_node_ptr answer_search_global_trie_terms_loop(Term t, int *vars_arity_ptr, CELL *stack_terms) {
static inline gt_node_ptr answer_search_global_trie_terms_loop(Term t, int *vars_arity_ptr, CELL *stack_terms USES_REGS) {
#else
static inline gt_node_ptr answer_search_global_trie_loop(Term t, int *vars_arity_ptr) {
static inline gt_node_ptr answer_search_global_trie_loop(Term t, int *vars_arity_ptr USES_REGS) {
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
#else
#ifdef MODE_TERMS_LOOP
static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr) {
static inline ans_node_ptr answer_search_terms_loop(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr USES_REGS) {
#else
static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr) {
static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int *vars_arity_ptr USES_REGS) {
#endif /* MODE_TERMS_LOOP */
#endif /* MODE_GLOBAL_TRIE_LOOP */
/************************************************************************
@ -1224,7 +1234,6 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
LOCAL_TrailTop --> | |
-----------
************************************************************************/
CACHE_REGS
#ifdef MODE_GLOBAL_TRIE_LOOP
gt_node_ptr current_node = GLOBAL_root_gt;
#endif /* MODE_GLOBAL_TRIE_LOOP */
@ -1274,11 +1283,11 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
} else {
gt_node_ptr entry_node;
#ifdef GLOBAL_TRIE_FOR_SUBTERMS
entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms);
entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms PASS_REGS);
#else
entry_node = answer_search_global_trie_loop(t, &vars_arity);
entry_node = answer_search_global_trie_loop(t, &vars_arity PASS_REGS);
#endif /* GLOBAL_TRIE_FOR_SUBTERMS */
current_node = answer_trie_check_insert_gt_entry(sg_fr, current_node, (Term) entry_node, _trie_retry_gterm + in_pair);
current_node = answer_trie_check_insert_gt_entry(sg_fr, current_node, (Term) entry_node, _trie_retry_gterm + in_pair PASS_REGS);
#else /* ! MODE_TERMS_LOOP */
} else
#if defined(MODE_GLOBAL_TRIE_LOOP)
@ -1310,8 +1319,8 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
}
#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS)
} else if (current_node != GLOBAL_root_gt) {
gt_node_ptr entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node);
gt_node_ptr entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms PASS_REGS);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node PASS_REGS);
#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */
} else {
ANSWER_CHECK_INSERT_ENTRY(sg_fr, current_node, CompactPairInit, _trie_retry_null + in_pair);
@ -1329,14 +1338,14 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
}
#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS)
} else if (current_node != GLOBAL_root_gt) {
gt_node_ptr entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node);
gt_node_ptr entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms PASS_REGS);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node PASS_REGS);
#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */
#else /* ! TRIE_COMPACT_PAIRS */
#if defined(MODE_GLOBAL_TRIE_LOOP) && defined(GLOBAL_TRIE_FOR_SUBTERMS)
if (current_node != GLOBAL_root_gt) {
gt_node_ptr entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node);
gt_node_ptr entry_node = answer_search_global_trie_terms_loop(t, &vars_arity, stack_terms PASS_REGS);
current_node = global_trie_check_insert_gt_entry(current_node, (Term) entry_node PASS_REGS);
} else
#endif /* MODE_GLOBAL_TRIE_LOOP && GLOBAL_TRIE_FOR_SUBTERMS */
if (IsPairTerm(t)) {
@ -1404,18 +1413,10 @@ static inline ans_node_ptr answer_search_loop(sg_fr_ptr sg_fr, ans_node_ptr curr
**************************************************************/
#ifdef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
#define ANSWER_SAFE_INSERT_ENTRY(NODE, ENTRY, INSTR) \
{ ans_node_ptr new_node; \
NEW_ANSWER_TRIE_NODE(new_node, INSTR, ENTRY, NULL, NODE, NULL); \
TrNode_child(NODE) = new_node; \
NODE = new_node; \
}
static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int mode) {
CACHE_REGS
static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t, int mode USES_REGS) {
ans_node_ptr child_node;
Term child_term;
Float trie_value, term_value;
Float trie_value = 0, term_value = 0;
/* start by computing the current value on the trie (trie_value) */
child_node = TrNode_child(current_node);
@ -1492,27 +1493,84 @@ static inline ans_node_ptr answer_search_min_max(sg_fr_ptr sg_fr, ans_node_ptr c
/**********************************************************
** answer_search_sum **
**********************************************************/
#ifdef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
static inline ans_node_ptr answer_search_sum(sg_fr_ptr sg_fr, ans_node_ptr current_node, Term t USES_REGS) {
ans_node_ptr child_node;
Term child_term;
Float trie_value = 0, term_value = 0, sum_value = 0;
int sum_value_as_int;
/* start by computing the current value on the trie (trie_value) */
child_node = TrNode_child(current_node);
child_term = TrNode_entry(child_node);
if (IsIntTerm(child_term)) {
trie_value = (Float) IntOfTerm(child_term);
} else if (IsApplTerm(child_term)) {
Functor f = (Functor) RepAppl(child_term);
child_node = TrNode_child(child_node);
if (f == FunctorLongInt) {
trie_value = (Float) TrNode_entry(child_node);
} else if (f == FunctorDouble) {
union {
Term t_dbl[sizeof(Float)/sizeof(Term)];
Float dbl;
} u;
u.t_dbl[0] = TrNode_entry(child_node);
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
child_node = TrNode_child(child_node);
u.t_dbl[1] = TrNode_entry(child_node);
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
trie_value = u.dbl;
} else
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_sum: invalid arithmetic value");
child_node = TrNode_child(child_node);
}
/* then compute the value for the new term (term_value) */
if (IsAtomOrIntTerm(t))
term_value = (Float) IntOfTerm(t);
else if (IsApplTerm(t)) {
Functor f = FunctorOfTerm(t);
if (f == FunctorLongInt)
term_value = (Float) LongIntOfTerm(t);
else if (f == FunctorDouble)
term_value = FloatOfTerm(t);
else
Yap_Error(INTERNAL_ERROR, TermNil, "answer_search_sum: invalid arithmetic value");
}
sum_value = trie_value + term_value;
sum_value_as_int = (int) sum_value;
if (sum_value == (float) sum_value_as_int && IntInBnd(sum_value_as_int)) {
ANSWER_SAFE_INSERT_ENTRY(current_node, MkIntegerTerm(sum_value_as_int), _trie_retry_atom);
} else {
union {
Term t_dbl[sizeof(Float)/sizeof(Term)];
Float dbl;
} u;
u.dbl = sum_value;
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)FunctorDouble), _trie_retry_null);
#if SIZEOF_DOUBLE == 2 * SIZEOF_INT_P
ANSWER_SAFE_INSERT_ENTRY(current_node, u.t_dbl[1], _trie_retry_extension);
#endif /* SIZEOF_DOUBLE x SIZEOF_INT_P */
ANSWER_SAFE_INSERT_ENTRY(current_node, u.t_dbl[0], _trie_retry_extension);
ANSWER_SAFE_INSERT_ENTRY(current_node, AbsAppl((Term *)FunctorDouble), _trie_retry_double);
}
return current_node;
}
#endif /* INCLUDE_ANSWER_SEARCH_MODE_DIRECTED */
/***************************************************************
** invalidate_answer_trie **
***************************************************************/
#ifdef INCLUDE_ANSWER_SEARCH_MODE_DIRECTED
#ifdef YAPOR
#define INVALIDATE_ANSWER_TRIE_NODE(NODE, SG_FR) \
TrNode_next(NODE) = SgFr_invalid_chain(SG_FR); \
SgFr_invalid_chain(SG_FR) = NODE
#else
#define INVALIDATE_ANSWER_TRIE_NODE(NODE, SG_FR) \
FREE_ANSWER_TRIE_NODE(NODE)
#endif /* YAPOR */
#define INVALIDATE_ANSWER_TRIE_LEAF_NODE(NODE, SG_FR) \
TAG_AS_ANSWER_INVALID_NODE(NODE); \
TrNode_next(NODE) = SgFr_invalid_chain(SG_FR); \
SgFr_invalid_chain(SG_FR) = NODE
static void invalidate_answer_trie(ans_node_ptr current_node, sg_fr_ptr sg_fr, int position) {
CACHE_REGS
static void invalidate_answer_trie(ans_node_ptr current_node, sg_fr_ptr sg_fr, int position USES_REGS) {
if (IS_ANSWER_TRIE_HASH(current_node)) {
ans_hash_ptr hash;
ans_node_ptr *bucket, *last_bucket;
@ -1526,13 +1584,13 @@ static void invalidate_answer_trie(ans_node_ptr current_node, sg_fr_ptr sg_fr, i
if (IS_ANSWER_LEAF_NODE(current_node)) {
INVALIDATE_ANSWER_TRIE_LEAF_NODE(current_node, sg_fr);
} else {
invalidate_answer_trie(TrNode_child(current_node), sg_fr, TRAVERSE_POSITION_FIRST);
invalidate_answer_trie(TrNode_child(current_node), sg_fr, TRAVERSE_POSITION_FIRST PASS_REGS);
INVALIDATE_ANSWER_TRIE_NODE(current_node, sg_fr);
}
while (next_node) {
current_node = next_node;
next_node = TrNode_next(current_node);
invalidate_answer_trie(current_node, sg_fr, TRAVERSE_POSITION_NEXT);
invalidate_answer_trie(current_node, sg_fr, TRAVERSE_POSITION_NEXT PASS_REGS);
}
}
} while (++bucket != last_bucket);
@ -1550,19 +1608,19 @@ static void invalidate_answer_trie(ans_node_ptr current_node, sg_fr_ptr sg_fr, i
if (IS_ANSWER_LEAF_NODE(current_node)) {
INVALIDATE_ANSWER_TRIE_LEAF_NODE(current_node, sg_fr);
} else {
invalidate_answer_trie(TrNode_child(current_node), sg_fr, TRAVERSE_POSITION_FIRST);
invalidate_answer_trie(TrNode_child(current_node), sg_fr, TRAVERSE_POSITION_FIRST PASS_REGS);
INVALIDATE_ANSWER_TRIE_NODE(current_node, sg_fr);
}
while (next_node) {
current_node = next_node;
next_node = TrNode_next(current_node);
invalidate_answer_trie(current_node, sg_fr, TRAVERSE_POSITION_NEXT);
invalidate_answer_trie(current_node, sg_fr, TRAVERSE_POSITION_NEXT PASS_REGS);
}
} else {
if (IS_ANSWER_LEAF_NODE(current_node)) {
INVALIDATE_ANSWER_TRIE_LEAF_NODE(current_node, sg_fr);
} else {
invalidate_answer_trie(TrNode_child(current_node), sg_fr, TRAVERSE_POSITION_FIRST);
invalidate_answer_trie(TrNode_child(current_node), sg_fr, TRAVERSE_POSITION_FIRST PASS_REGS);
INVALIDATE_ANSWER_TRIE_NODE(current_node, sg_fr);
}
}
@ -1579,9 +1637,9 @@ static void invalidate_answer_trie(ans_node_ptr current_node, sg_fr_ptr sg_fr, i
#ifdef INCLUDE_LOAD_ANSWER_LOOP
#ifdef MODE_GLOBAL_TRIE_LOOP
static inline CELL *load_substitution_loop(gt_node_ptr current_node, int *vars_arity_ptr, CELL *stack_terms) {
static inline CELL *load_substitution_loop(gt_node_ptr current_node, int *vars_arity_ptr, CELL *stack_terms USES_REGS) {
#else
static inline CELL *load_answer_loop(ans_node_ptr current_node) {
static inline CELL *load_answer_loop(ans_node_ptr current_node USES_REGS) {
#endif /* MODE_GLOBAL_TRIE_LOOP */
/************************************************************************
===========
@ -1610,7 +1668,6 @@ static inline CELL *load_answer_loop(ans_node_ptr current_node) {
LOCAL_TrailTop --> | | <-- stack_terms_base (TRIE_COMPACT_PAIRS)
-----------
************************************************************************/
CACHE_REGS
#ifdef MODE_GLOBAL_TRIE_LOOP
int vars_arity = *vars_arity_ptr;
#else
@ -1634,7 +1691,7 @@ static inline CELL *load_answer_loop(ans_node_ptr current_node) {
if (IsVarTerm(t)) {
#if ! defined(MODE_GLOBAL_TRIE_LOOP) || defined(GLOBAL_TRIE_FOR_SUBTERMS)
if (t > VarIndexOfTableTerm(MAX_TABLE_VARS)) {
stack_terms = load_substitution_loop((gt_node_ptr) t, &vars_arity, stack_terms);
stack_terms = load_substitution_loop((gt_node_ptr) t, &vars_arity, stack_terms PASS_REGS);
} else
#endif /* ! MODE_GLOBAL_TRIE_LOOP || GLOBAL_TRIE_FOR_SUBTERMS */
{ int var_index = VarIndexOfTableTerm(t);

7
config.h.in
View File

@ -1,4 +1,8 @@
#ifndef YAP_CONFIG_H
#define YAP_CONFIG_H
#include "parms.h"
/* are dynamic arrays supported? */
@ -347,5 +351,4 @@
#undef MAX_THREADS
#endif /* YAP_CONFIG_H */

18727
configure vendored
View File

File diff suppressed because it is too large Load Diff

35
configure.in
View File

@ -501,6 +501,18 @@ else
INSTALL_MATLAB=""
fi
AC_LANG_PUSH([C++])
my_save_cxxflags="$CXXFLAGS"
CXXFLAGS=-std=c++0x
AC_MSG_CHECKING([whether CXX supports -std-c++0x])
AC_COMPILE_IFELSE([AC_LANG_PROGRAM([])],
[AC_MSG_RESULT([yes])]
[yap_cv_clpbn_bp=yes],
[AC_MSG_RESULT([no])]
)
CXXFLAGS="$my_save_cxxflags"
AC_LANG_POP()
if test "$yap_cv_clpbn_bp" = no
then
ENABLE_CLPBN_BP="@# "
@ -662,6 +674,7 @@ then
target_cpu=x86_64
YAP_TARGET=amd64
AC_CHECK_LIB(ws2_32,main)
AC_CHECK_LIB(comdlg32,main)
EXTRA_LIBS_FOR_DLLS="-lws2_32"
elif test "$target_os" = "cygwin"
then
@ -670,6 +683,7 @@ then
AC_CHECK_LIB(wsock32,main)
else
AC_CHECK_LIB(wsock32,main)
AC_CHECK_LIB(comdlg32,main)
fi
EXTRA_LIBS_FOR_DLLS="\$(abs_top_builddir)/yap.dll $EXTRA_LIBS_FOR_DLLS"
AC_CHECK_LIB(psapi,main)
@ -712,15 +726,18 @@ fi
if test "$yap_cv_readline" != "no"
then
AC_CHECK_LIB([ncurses], [main],[
LIBS="$LIBS -lncurses"
])
AC_CHECK_LIB([readline], [main],[
AC_DEFINE([HAVE_LIBREADLINE], [1],[Define if you have libreadline])
LIBS="$LIBS -lreadline -lncurses"
LIBS="$LIBS -lreadline"
],
[if test "x$with_readline" != xcheck; then
AC_MSG_FAILURE(
[--with-readline was given, but test for readline failed])
fi
], -lncurses)
])
fi
if test "$yap_cv_gmp" != "no"
then
@ -833,16 +850,16 @@ fi
if test "$yap_cv_cudd" != no; then
oldlibs="$LIBS"
if test "$withval" != "yes"; then
if test "$yap_cv_cudd" != "NONE"; then
if test -d "$yap_cv_cudd"/include/cudd; then
CUDD_CPPFLAGS="-I $yap_cv_cudd/include/cudd"
else
CUDD_CPPFLAGS="-I $yap_cv_cudd/include"
fi
fi
cudd_dir="$yap_cv_cudd"
elif test -e /usr/include/cudd; then
CUDD_CPPFLAGS="-I /usr/include/cudd"
cudd_dir="$withval"
cudd_dir="$yap_cv_cudd"
elif test "$prefix" != "NONE"; then
if test -d "$prefix"/include/cudd; then
CUDD_CPPFLAGS="-I $prefix/include/cudd"
@ -2288,8 +2305,7 @@ mkdir -p packages/clib/maildrop/rfc822
mkdir -p packages/clib/maildrop/rfc2045
mkdir -p packages/CLPBN
mkdir -p packages/CLPBN/clpbn
mkdir -p packages/CLPBN/clpbn/bp
mkdir -p packages/CLPBN/clpbn/bp/xmlParser
mkdir -p packages/CLPBN/horus
mkdir -p packages/clpqr
mkdir -p packages/cplint
mkdir -p packages/cplint/approx
@ -2401,7 +2417,8 @@ fi
if test "$ENABLE_ZLIB" = ""; then
AC_CONFIG_FILES([packages/zlib/Makefile])
fi
fi
if test "$ENABLE_CUDD" = ""; then
AC_CONFIG_FILES([packages/bdd/Makefile])
@ -2419,7 +2436,7 @@ AC_CONFIG_FILES([packages/real/Makefile])
fi
if test "$ENABLE_CLPBN_BP" = ""; then
AC_CONFIG_FILES([packages/CLPBN/clpbn/bp/Makefile])
AC_CONFIG_FILES([packages/CLPBN/horus/Makefile])
fi
if test "$ENABLE_GECODE" = ""; then

0
console/LGPL/pl-ntcon.c Normal file → Executable file
View File

41
console/LGPL/pl-ntmain.c Normal file → Executable file
View File

@ -654,8 +654,8 @@ pl_window_pos(term_t options)
static void
call_menu(const TCHAR *name)
{ fid_t fid = PL_open_foreign_frame();
predicate_t pred = PL_predicate("on_menu", 1, "prolog");
module_t m = PL_new_module(PL_new_atom("prolog"));
predicate_t pred = PL_predicate("on_menu", 1, "system");
module_t m = PL_new_module(PL_new_atom("system"));
term_t a0 = PL_new_term_ref();
size_t len = _tcslen(name);
@ -667,7 +667,7 @@ call_menu(const TCHAR *name)
foreign_t
pl_win_insert_menu_item(foreign_t menu, foreign_t label, foreign_t before)
pl_win_insert_menu_item(term_t menu, term_t label, term_t before)
{ TCHAR *m, *l, *b;
if ( !PL_get_wchars(menu, NULL, &m, CVT_ATOM) ||
@ -685,7 +685,7 @@ pl_win_insert_menu_item(foreign_t menu, foreign_t label, foreign_t before)
foreign_t
pl_win_insert_menu(foreign_t label, foreign_t before)
pl_win_insert_menu(term_t label, term_t before)
{ TCHAR *l, *b;
if ( !PL_get_wchars(label, NULL, &l, CVT_ATOM) ||
@ -1005,8 +1005,25 @@ win32main(rlc_console c, int argc, TCHAR **argv)
set_window_title(c);
rlc_bind_terminal(c);
/* YAP has to initialize before doing anything else */
#ifdef _YAP_NOT_INSTALLED_
if ( argc > MAX_ARGC )
argc = MAX_ARGC;
for(i=0; i<argc; i++)
{ char *s;
TCHAR *q;
av[i] = alloca(utf8_required_len(argv[i])+1);
for(s=av[i], q=argv[i]; *q; q++)
{ s = utf8_put_char(s, *q);
}
*s = '\0';
}
av[i] = NULL;
if ( !PL_initialise(argc, av) )
PL_halt(1);
#endif
PL_register_extensions_in_module("system", extensions);
install_readline(c);
@ -1026,23 +1043,9 @@ win32main(rlc_console c, int argc, TCHAR **argv)
#if !defined(O_DEBUG) && !defined(_DEBUG)
initSignals();
#endif
PL_register_foreign_in_module("system", "win_open_console", 5,
PL_register_foreign_in_module("prolog", "win_open_console", 5,
pl_win_open_console, 0);
if ( argc > MAX_ARGC )
argc = MAX_ARGC;
for(i=0; i<argc; i++)
{ char *s;
TCHAR *q;
av[i] = alloca(utf8_required_len(argv[i])+1);
for(s=av[i], q=argv[i]; *q; q++)
{ s = utf8_put_char(s, *q);
}
*s = '\0';
}
av[i] = NULL;
rlc_bind_terminal(c);
PL_halt(PL_toplevel() ? 0 : 1);

547
console/yap.c Normal file → Executable file
View File

@ -23,26 +23,6 @@
#include "cut_c.h"
#endif
#if (DefTrailSpace < MinTrailSpace)
#undef DefTrailSpace
#define DefTrailSpace MinTrailSpace
#endif
#if (DefStackSpace < MinStackSpace)
#undef DefStackSpace
#define DefStackSpace MinStackSpace
#endif
#if (DefHeapSpace < MinHeapSpace)
#undef DefHeapSpace
#define DefHeapSpace MinHeapSpace
#endif
#define DEFAULT_NUMBERWORKERS 1
#define DEFAULT_SCHEDULERLOOP 10
#define DEFAULT_DELAYEDRELEASELOAD 3
#ifdef _MSC_VER /* Microsoft's Visual C++ Compiler */
#ifdef HAVE_UNISTD_H
#undef HAVE_UNISTD_H
@ -79,12 +59,8 @@
#include <ieeefp.h>
#endif
static void PROTO(do_top_goal,(YAP_Term));
static void PROTO(exec_top_level,(int, YAP_init_args *));
#ifdef DEBUG
static int output_msg;
#endif
static void do_top_goal(YAP_Term Goal);
static void exec_top_level(int BootMode, YAP_init_args *iap);
#ifdef lint
/* VARARGS1 */
@ -94,13 +70,6 @@ static int output_msg;
long _stksize = 32000;
#endif
/* nf: Begin preprocessor code */
#define MAXDEFS 100
static char *def_var[MAXDEFS];
static char *def_value[MAXDEFS];
static int def_c=0;
/* End preprocessor code */
#ifdef USE_MYPUTC
static void
myputc (int ch)
@ -112,519 +81,15 @@ myputc (int ch)
static void
do_top_goal (YAP_Term Goal)
{
#ifdef DEBUG
if (output_msg)
fprintf(stderr,"Entering absmi\n");
#endif
YAP_RunGoalOnce(Goal);
}
static void
print_usage(void)
{
fprintf(stderr,"\n[ Valid switches for command line arguments: ]\n");
fprintf(stderr," -? Shows this screen\n");
fprintf(stderr," -b Boot file \n");
fprintf(stderr," -dump-runtime-variables\n");
fprintf(stderr," -f initialization file or \"none\"\n");
fprintf(stderr," -g Run Goal Before Top-Level \n");
fprintf(stderr," -z Run Goal Before Top-Level \n");
fprintf(stderr," -q start with informational messages off\n");
fprintf(stderr," -l load Prolog file\n");
fprintf(stderr," -L run Prolog file and exit\n");
fprintf(stderr," -p extra path for file-search-path\n");
fprintf(stderr," -hSize Heap area in Kbytes (default: %d, minimum: %d)\n",
DefHeapSpace, MinHeapSpace);
fprintf(stderr," -sSize Stack area in Kbytes (default: %d, minimum: %d)\n",
DefStackSpace, MinStackSpace);
fprintf(stderr," -tSize Trail area in Kbytes (default: %d, minimum: %d)\n",
DefTrailSpace, MinTrailSpace);
fprintf(stderr," -GSize Max Area for Global Stack\n");
fprintf(stderr," -LSize Max Area for Local Stack (number must follow L)\n");
fprintf(stderr," -TSize Max Area for Trail (number must follow L)\n");
fprintf(stderr,"\n[Execution Modes]\n");
fprintf(stderr," -J0 Interpreted mode (default)\n");
fprintf(stderr," -J1 Mixed mode only for user predicates\n");
fprintf(stderr," -J2 Mixed mode for all predicates\n");
fprintf(stderr," -J3 Compile all user predicates\n");
fprintf(stderr," -J4 Compile all predicates\n");
#ifdef TABLING
fprintf(stderr," -ts Maximum table space area in Mbytes (default: unlimited)\n");
#endif /* TABLING */
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
fprintf(stderr," -w Number of workers (default: %d)\n",
DEFAULT_NUMBERWORKERS);
fprintf(stderr," -sl Loop scheduler executions before look for hiden shared work (default: %d)\n",
DEFAULT_SCHEDULERLOOP);
fprintf(stderr," -d Value of delayed release of load (default: %d)\n",
DEFAULT_DELAYEDRELEASELOAD);
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
/* nf: Preprocessor */
/* fprintf(stderr," -DVar=Name Persistent definition\n"); */
fprintf(stderr,"\n");
}
static int
myisblank(int c)
{
switch (c) {
case ' ':
case '\t':
case '\n':
case '\r':
return TRUE;
default:
return FALSE;
}
}
static char *
add_end_dot(char arg[])
{
int sz = strlen(arg), i;
i = sz;
while (i && myisblank(arg[--i]));
if (i && arg[i] != ',') {
char *p = (char *)malloc(sz+2);
if (!p)
return NULL;
strncpy(p,arg,sz);
p[sz] = '.';
p[sz+1] = '\0';
return p;
}
return arg;
}
static int
dump_runtime_variables(void)
{
fprintf(stdout,"CC=\"%s\"\n",YAP_CC);
fprintf(stdout,"YAP_ROOTDIR=\"%s\"\n",YAP_ROOTDIR);
fprintf(stdout,"YAP_LIBS=\"%s\"\n",YAP_LIBS);
fprintf(stdout,"YAP_SHLIB_SUFFIX=\"%s\"\n",YAP_SHLIB_SUFFIX);
fprintf(stdout,"YAP_VERSION=%d\n",YAP_VERSION);
exit(0);
return 1;
}
/*
* proccess command line arguments: valid switches are: -b boot -s
* stack area size (K) -h heap area size -a aux stack size -e
* emacs_mode -m -DVar=Value reserved memory for alloc IF DEBUG -p if you
* want to check out startup IF MAC -mpw if we are using the mpw
* shell
*/
static int
parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap)
{
char *p;
#ifdef USE_SYSTEM_MALLOC
int BootMode = YAP_FULL_BOOT_FROM_PROLOG;
#else
int BootMode = YAP_BOOT_FROM_SAVED_CODE;
#endif
#ifdef MYDDAS_MYSQL
char *myddas_temp;
#endif
unsigned long int *ssize;
while (--argc > 0)
{
p = *++argv;
if (*p == '-')
switch (*++p)
{
case 'b':
BootMode = YAP_BOOT_FROM_PROLOG;
iap->YapPrologBootFile = *++argv;
argc--;
break;
case '?':
print_usage();
exit(EXIT_SUCCESS);
case 'q':
iap->QuietMode = TRUE;
break;
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
case 'w':
ssize = &(iap->NumberWorkers);
goto GetSize;
case 'd':
if (!strcmp("dump-runtime-variables",p))
return dump_runtime_variables();
ssize = &(iap->DelayedReleaseLoad);
goto GetSize;
#else
case 'd':
if (!strcmp("dump-runtime-variables",p))
return dump_runtime_variables();
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
case 'F':
/* just ignore for now */
argc--;
argv++;
break;
case 'f':
if (argc > 1 && argv[1][0] != '-') {
argc--;
argv++;
if (!strcmp(*argv,"none")) {
iap->FastBoot = TRUE;
} else {
iap->YapPrologRCFile = *argv;
}
break;
}
iap->FastBoot = TRUE;
break;
#ifdef MYDDAS_MYSQL
case 'm':
if (strncmp(p,"myddas_",7) == 0)
{
iap->myddas = 1;
if ((*argv)[0] == '\0')
myddas_temp = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing file name with option 'l' ]\n");
exit(EXIT_FAILURE);
}
argv++;
myddas_temp = *argv;
}
if (strstr(p,"user") != NULL)
iap->myddas_user = myddas_temp;
else if (strstr(p,"pass") != NULL)
iap->myddas_pass = myddas_temp;
else if (strstr(p,"db") != NULL)
iap->myddas_db = myddas_temp;
else if (strstr(p,"host") != NULL)
iap->myddas_host = myddas_temp;
else
goto myddas_error_print;
break;
}
#endif
// execution mode
case 'J':
switch (p[1]) {
case '0':
iap->ExecutionMode = YAPC_INTERPRETED;
break;
case '1':
iap->ExecutionMode = YAPC_MIXED_MODE_USER;
break;
case '2':
iap->ExecutionMode = YAPC_MIXED_MODE_ALL;
break;
case '3':
iap->ExecutionMode = YAPC_COMPILE_USER;
break;
case '4':
iap->ExecutionMode = YAPC_COMPILE_ALL;
break;
default:
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c%c ]\n", *p, p[1]);
exit(EXIT_FAILURE);
}
p++;
break;
case 'G':
ssize = &(iap->MaxGlobalSize);
goto GetSize;
break;
case 's':
case 'S':
ssize = &(iap->StackSize);
#if defined(YAPOR_COPY) || defined(YAPOR_COW) || defined(YAPOR_SBA) || defined(YAPOR_THREADS)
if (p[1] == 'l') {
p++;
ssize = &(iap->SchedulerLoop);
}
#endif /* YAPOR_COPY || YAPOR_COW || YAPOR_SBA || YAPOR_THREADS */
goto GetSize;
case 'a':
case 'A':
ssize = &(iap->AttsSize);
goto GetSize;
case 'T':
ssize = &(iap->MaxTrailSize);
goto get_trail_size;
case 't':
ssize = &(iap->TrailSize);
#ifdef TABLING
if (p[1] == 's') {
p++;
ssize = &(iap->MaxTableSpaceSize);
}
#endif /* TABLING */
get_trail_size:
if (*++p == '\0')
{
if (argc > 1)
--argc, p = *++argv;
else
{
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch(ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
i *= 1024*1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch) {
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
} else {
*ssize = i;
}
}
break;
case 'h':
case 'H':
ssize = &(iap->HeapSize);
GetSize:
if (*++p == '\0')
{
if (argc > 1)
--argc, p = *++argv;
else
{
fprintf(stderr,"[ YAP unrecoverable error: missing size in flag %s ]", argv[0]);
print_usage();
exit(EXIT_FAILURE);
}
}
{
unsigned long int i = 0, ch;
while ((ch = *p++) >= '0' && ch <= '9')
i = i * 10 + ch - '0';
switch(ch) {
case 'M':
case 'm':
i *= 1024;
ch = *p++;
break;
case 'g':
case 'G':
i *= 1024*1024;
ch = *p++;
break;
case 'k':
case 'K':
ch = *p++;
break;
}
if (ch)
{
fprintf(stderr,"[ YAP unrecoverable error: illegal size specification %s ]", argv[-1]);
YAP_Exit(1);
}
*ssize = i;
}
break;
#ifdef DEBUG
case 'P':
YAP_SetOutputMessage();
output_msg = TRUE;
break;
#endif
case 'L':
if (p[1] && p[1] >= '0' && p[1] <= '9') /* hack to emulate SWI's L local option */
{
ssize = &(iap->MaxStackSize);
goto GetSize;
}
iap->QuietMode = TRUE;
iap->HaltAfterConsult = TRUE;
case 'l':
p++;
if (!*++argv) {
fprintf(stderr,"%% YAP unrecoverable error: missing load file name\n");
exit(1);
} else if (!strcmp("--",*argv)) {
/* shell script, the next entry should be the file itself */
iap->YapPrologRCFile = argv[1];
argc = 1;
break;
} else {
iap->YapPrologRCFile = *argv;
argc--;
}
if (*p) {
/* we have something, usually, of the form:
-L --
FileName
ExtraArgs
*/
/* being called from a script */
while (*p && (*p == ' ' || *p == '\t'))
p++;
if (p[0] == '-' && p[1] == '-') {
/* ignore what is next */
argc = 1;
}
}
break;
/* run goal before top-level */
case 'g':
if ((*argv)[0] == '\0')
iap->YapPrologGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing initialization goal for option 'g' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologGoal = *argv;
}
break;
/* run goal as top-level */
case 'z':
if ((*argv)[0] == '\0')
iap->YapPrologTopLevelGoal = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing goal for option 'z' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologTopLevelGoal = add_end_dot(*argv);
}
break;
case 'p':
if ((*argv)[0] == '\0')
iap->YapPrologAddPath = *argv;
else {
argc--;
if (argc == 0) {
fprintf(stderr," [ YAP unrecoverable error: missing paths for option 'p' ]\n");
exit(EXIT_FAILURE);
}
argv++;
iap->YapPrologAddPath = *argv;
}
break;
/* nf: Begin preprocessor code */
case 'D':
{
char *var, *value;
++p;
var = p;
if (var == NULL || *var=='\0')
break;
while(*p!='=' && *p!='\0') ++p;
if ( *p=='\0' ) break;
*p='\0';
++p;
value=p;
if ( *value == '\0' ) break;
++def_c;
def_var[def_c-1]=var;
def_value[def_c-1]=value;
break;
}
/* End preprocessor code */
case '-':
/* skip remaining arguments */
argc = 1;
break;
default:
{
#ifdef MYDDAS_MYSQL
myddas_error_print :
#endif
fprintf(stderr,"[ YAP unrecoverable error: unknown switch -%c ]\n", *p);
#ifdef MYDDAS_MYSQL
myddas_error :
#endif
print_usage();
exit(EXIT_FAILURE);
}
}
else {
iap->SavedState = p;
}
}
#ifdef MYDDAS_MYSQL
/* Check MYDDAS Arguments */
if (iap->myddas_user != NULL || iap->myddas_pass != NULL
|| iap->myddas_db != NULL || iap->myddas_host != NULL)
if (iap->myddas_user == NULL || iap->myddas_db == NULL){
fprintf(stderr,"[ YAP unrecoverable error: Missing Mandatory Arguments for MYDDAS ]\n");
goto myddas_error;
}
#endif
return BootMode;
}
static int
init_standard_system(int argc, char *argv[], YAP_init_args *iap)
{
int BootMode;
iap->SavedState = NULL;
iap->HeapSize = 0;
iap->StackSize = 0;
iap->TrailSize = 0;
iap->AttsSize = 0;
iap->MaxAttsSize = 0;
iap->MaxHeapSize = 0;
iap->MaxStackSize = 0;
iap->MaxGlobalSize = 0;
iap->MaxTrailSize = 0;
iap->YapLibDir = NULL;
iap->YapPrologBootFile = NULL;
iap->YapPrologInitFile = NULL;
iap->YapPrologRCFile = NULL;
iap->YapPrologGoal = NULL;
iap->YapPrologTopLevelGoal = NULL;
iap->YapPrologAddPath = NULL;
iap->HaltAfterConsult = FALSE;
iap->FastBoot = FALSE;
iap->MaxTableSpaceSize = 0;
iap->NumberWorkers = DEFAULT_NUMBERWORKERS;
iap->SchedulerLoop = DEFAULT_SCHEDULERLOOP;
iap->DelayedReleaseLoad = DEFAULT_DELAYEDRELEASELOAD;
iap->PrologShouldHandleInterrupts = TRUE;
iap->ExecutionMode = YAPC_INTERPRETED;
iap->Argc = argc;
iap->Argv = argv;
#ifdef MYDDAS_MYSQL
iap->myddas = 0;
iap->myddas_user = NULL;
iap->myddas_pass = NULL;
iap->myddas_db = NULL;
iap->myddas_host = NULL;
#endif
iap->ErrorNo = 0;
iap->ErrorCause = NULL;
iap->QuietMode = FALSE;
BootMode = parse_yap_arguments(argc,argv,iap);
BootMode = YAP_parse_yap_arguments(argc,argv,iap);
/* init memory */
if (BootMode == YAP_BOOT_FROM_PROLOG ||
@ -693,10 +158,10 @@ main (int argc, char **argv)
mod_arg[0] = YAP_MkAtomTerm(YAP_LookupAtom("ypp"));
YAP_RunGoalOnce(YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("use_module"),1), 1, mod_arg));
// process the definitions
for(i=0;i<def_c;++i) {
for(i=0;i<init_args.def_c;++i) {
YAP_Term t_args[2],t_goal;
t_args[0] = YAP_MkAtomTerm(YAP_LookupAtom(def_var[i]));
t_args[1] = YAP_MkAtomTerm(YAP_LookupAtom(def_value[i]));
t_args[0] = YAP_MkAtomTerm(YAP_LookupAtom(init_args.def_var[i]));
t_args[1] = YAP_MkAtomTerm(YAP_LookupAtom(init_args.def_value[i]));
t_goal = YAP_MkApplTerm(YAP_MkFunctor(YAP_LookupAtom("ypp_define"),2), 2, t_args);
YAP_RunGoalOnce(t_goal);
}

57
docs/yap.tex
View File

@ -824,7 +824,7 @@ $YAPSRC\VC\include, $YAPSRC\include
@example
['$YAPSRC\\pl\\init'].
save_program('startup.yss').
qsave_program('startup.yss').
^Z
@end example
@ -2154,6 +2154,45 @@ Saves an image of the current state of the YAP database in file
@var{F}, and guarantee that execution of the restored code will start by
trying goal @var{G}.
@item qsave_program(+@var{F}, +@var{ListOfOpts})
@findex qsave_program/2
@syindex qsave_program/2
@cnindex qsave_program/2
Saves the current state of the program to the file @var{File}. The
result is a resource archive containing a saved state that expresses
all Prolog data from the running program and all user-defined
resources. Depending on the stand_alone option, the resource is headed
by the emulator, a Unix shell script or nothing. Options is a list of
additional options:
@table @code
@item stack(+@var{KBytes})
Limit for the local and global stack.
@item trail(+@var{KBytes})
Limit for the trail stack.
@item goal(:@var{Callable})
Initialization goal for the new executable (see -g).
@c @item toplevel(:@var{Callable})
@c Top-level goal for the new executable (see -t).
@item init_file(+@var{Atom})
Default initialization file for the new executable. See -f.
@c class(+Class)
@c If runtime, only read resources from the state (default). If kernel, lock all predicates as system predicates. If development, save the predicates in their current state and keep reading resources from their source (if present). See also resource/3.
@c autoload(+Boolean)
@c If true (default), run autoload/0 first.
@c map(+File)
@c Dump a human-readable trace of what has been saved in File.
@c op(+Action)
@c One of save (default) to save the current operator table or standard to use the initial table of the emulator.
@c stand_alone(+Boolean)
@c If true, the emulator is the first part of the state. If the emulator is started it will test whether a boot-file (state) is attached to the emulator itself and load this state. Provided the application has all libraries loaded, the resulting executable is completely independent of the runtime environment or location where it was built. See also section 2.10.2.4.
@c emulator(+File)
@c File to use for the emulator. Default is the running Prolog image.
@c foreign(+Action)
@c If save, include shared objects (DLLs) into the saved state. See current_foreign_library/2. If the program strip is available, this is first used to reduce the size of the shared object. If a state is started, use_foreign_library/1 first tries to locate the foreign resource in the executable. When found it copies the content of the resource to a temporary file and loads it. If possible (Unix), the temporary object is deleted immediately after opening.106
@end table
@item restore(+@var{F})
@findex restore/1
@syindex restore/1
@ -3430,6 +3469,15 @@ Same as @code{variant/2}, succeeds if @var{Term1} and @var{Term2} are variant te
Succeed if @var{Submuser} subsumes @var{Subsuned} but does not bind any
variable in @var{Subsumer}.
@item term_subsumer(?@var{T1}, ?@var{T2}, ?@var{Subsumer})
@findex term_subsumer/2
@syindex term_subsumer/2
@cnindex term_subsumer/2
Succeed if @var{Subsumer} unifies with the least general
generalization over @var{T1} and
@var{T2}.
@item acyclic_term(?@var{Term})
@findex cyclic_term/1
@syindex cyclic_term/1
@ -8069,8 +8117,13 @@ for which YAP was compiled and Operating System information.
@item index
@findex index (yap_flag/2 option)
@* If @code{on} allow indexing (default), if @code{off} disable it, if
@code{single} allow on first argument only.
@item index_sub_term_search_depth
@findex index (yap_flag/2 option)
@*
If @code{on} allow indexing (default), if @code{off} disable it.
Maximum bound on searching sub-terms for indexing, if @code{0} (default) no bound.
@item informational_messages
@findex informational_messages (yap_flag/2 option)

3
include/YapInterface.h Normal file → Executable file
View File

@ -601,6 +601,9 @@ extern X_API YAP_Term PROTO(YAP_ImportTerm,(char *));
extern X_API int PROTO(YAP_RequiresExtraStack,(size_t));
extern X_API int
YAP_parse_yap_arguments(int argc, char *argv[], YAP_init_args *iap);
#define YAP_InitCPred(N,A,F) YAP_UserCPredicate(N,F,A)
__END_DECLS

8
include/yap_structs.h Normal file → Executable file
View File

@ -186,6 +186,14 @@ typedef struct {
char **Argv;
/* QuietMode */
int QuietMode;
/* nf: Begin ypp preprocessor code */
#define YAP_MAX_YPP_DEFS 100
char *def_var[YAP_MAX_YPP_DEFS];
char *def_value[YAP_MAX_YPP_DEFS];
int def_c;
/* End preprocessor code */
#ifdef MYDDAS_MYSQL
/* If any myddas option was given */
short myddas;

84
library/dialect/swi/fli/swi.c Normal file → Executable file
View File

@ -53,6 +53,25 @@ extern X_API Atom YAP_AtomFromSWIAtom(atom_t at);
extern X_API atom_t YAP_SWIAtomFromAtom(Atom at);
extern int PL_error(const char *pred, int arity, const char *msg, int id, ...);
static int
do_gc(UInt sz)
{
/* always called from user_call_cpred */
CACHE_REGS
UInt arity;
yamop *nextpc;
if (P && PREVOP(P,Osbpp)->opc == Yap_opcode(_call_usercpred)) {
arity = PREVOP(P,Osbpp)->u.Osbpp.p->ArityOfPE;
nextpc = P;
} else {
arity = 0;
nextpc = CP;
}
return Yap_gcl(sz, arity, ENV, nextpc);
}
X_API extern Atom
YAP_AtomFromSWIAtom(atom_t at)
{
@ -768,8 +787,8 @@ X_API int PL_cons_functor(term_t d, functor_t f,...)
return TRUE;
}
arity = ArityOfFunctor(ff);
while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (Unsigned(H)+arity > Unsigned(ASP)-CreepFlag) {
if (!do_gc(arity*sizeof(CELL))) {
return FALSE;
}
}
@ -801,8 +820,8 @@ X_API int PL_cons_functor_v(term_t d, functor_t f, term_t a0)
return TRUE;
}
arity = ArityOfFunctor(ff);
while (Unsigned(H+arity) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -839,7 +858,7 @@ X_API int PL_put_atom_chars(term_t t, const char *s)
{
CACHE_REGS
Atom at;
while (!(at = Yap_LookupAtom((char *)s))) {
if (!(at = Yap_LookupAtom((char *)s))) {
if (!Yap_growheap(FALSE, 0L, NULL)) {
CACHE_REGS
Yap_Error(OUT_OF_HEAP_ERROR, TermNil, LOCAL_ErrorMessage);
@ -897,15 +916,15 @@ X_API int PL_put_functor(term_t t, functor_t f)
Yap_PutInSlot(t,(Term)ff PASS_REGS);
} else {
arity = ArityOfFunctor(ff);
if (Unsigned(H)+arity > Unsigned(ASP)-CreepFlag) {
if (!do_gc(arity*sizeof(CELL))) {
return FALSE;
}
}
if (arity == 2 && ff == FunctorDot)
Yap_PutInSlot(t,YAP_MkNewPairTerm() PASS_REGS);
else
Yap_PutInSlot(t,YAP_MkNewApplTerm((YAP_Functor)ff,arity) PASS_REGS);
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
return FALSE;
}
}
}
return TRUE;
}
@ -947,7 +966,7 @@ X_API int PL_put_list(term_t t)
CACHE_REGS
Yap_PutInSlot(t,YAP_MkNewPairTerm() PASS_REGS);
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -959,7 +978,7 @@ X_API int PL_put_list_chars(term_t t, const char *s)
CACHE_REGS
Yap_PutInSlot(t,YAP_BufferToString((char *)s) PASS_REGS);
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1132,8 +1151,8 @@ X_API int PL_unify_functor(term_t t, functor_t f)
Term tt = Yap_GetFromSlot(t PASS_REGS);
Functor ff = SWIFunctorToFunctor(f);
if (IsVarTerm(tt)) {
while (Unsigned(H)+ArityOfFunctor(ff) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(ArityOfFunctor(ff)*sizeof(CELL), ENV, CP)) {
if (Unsigned(H)+ArityOfFunctor(ff) > Unsigned(ASP)-CreepFlag) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1185,7 +1204,7 @@ X_API int PL_unify_list(term_t tt, term_t h, term_t tail)
CACHE_REGS
Term t;
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1238,7 +1257,7 @@ X_API int PL_unify_list_chars(term_t t, const char *chars)
CACHE_REGS
YAP_Term chterm;
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1253,7 +1272,7 @@ X_API int PL_unify_list_ncodes(term_t t, size_t len, const char *chars)
CACHE_REGS
Term chterm;
if (Unsigned(H) > Unsigned(ASP+len*2)-CreepFlag) {
if (!Yap_gc(len*2*sizeof(CELL), ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1292,7 +1311,7 @@ X_API int PL_unify_string_chars(term_t t, const char *chars)
CACHE_REGS
YAP_Term chterm;
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1304,8 +1323,9 @@ X_API int PL_unify_string_nchars(term_t t, size_t len, const char *chars)
{
CACHE_REGS
YAP_Term chterm;
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
return FALSE;
}
}
@ -1324,9 +1344,7 @@ X_API int PL_unify_wchars(term_t t, int type, size_t len, const pl_wchar_t *char
len = wcslen(chars);
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
return FALSE;
}
if (!do_gc(0)) return FALSE;
}
switch (type) {
case PL_ATOM:
@ -1455,7 +1473,7 @@ X_API int PL_unify_term(term_t l,...)
BACKUP_MACHINE_REGS();
if (Unsigned(H) > Unsigned(ASP)-CreepFlag) {
if (!Yap_gc(0, ENV, CP)) {
if (!do_gc(0)) {
RECOVER_MACHINE_REGS();
return FALSE;
}
@ -2019,6 +2037,8 @@ PL_initialise(int myargc, char **myargv)
init_args.SchedulerLoop = 10;
init_args.DelayedReleaseLoad = 3;
YAP_parse_yap_arguments(myargc,myargv,&init_args);
GLOBAL_PL_Argc = myargc;
GLOBAL_PL_Argv = myargv;
GLOBAL_InitialisedFromPL = TRUE;
@ -2336,7 +2356,11 @@ X_API int PL_call_predicate(module_t ctx, int flags, predicate_t p, term_t t0)
X_API int PL_toplevel(void)
{
return YAP_RunGoal(MkAtomTerm(Yap_FullLookupAtom("$live")));
while (TRUE) {
if (YAP_RunGoal(MkAtomTerm(Yap_FullLookupAtom("$live")))) {
return TRUE;
}
}
}
X_API int PL_call(term_t tp, module_t m)
@ -2815,9 +2839,14 @@ Yap_read_term(term_t t, IOSTREAM *st, term_t *excep, term_t vs)
{
CACHE_REGS
Term varnames, out, tpos;
Term error;
Term error, *vp;
if (!Yap_readTerm(st, &out, &varnames, &error, &tpos)) {
if (vs) {
vp = & varnames;
} else {
vp = NULL;
}
if (!Yap_readTerm(st, &out, vp, &error, &tpos)) {
if (excep) {
*excep = Yap_InitSlot(error PASS_REGS);
}
@ -2832,7 +2861,8 @@ Yap_read_term(term_t t, IOSTREAM *st, term_t *excep, term_t vs)
if (!Yap_unify(out, Yap_GetFromSlot(t PASS_REGS))) {
return FALSE;
}
if (!Yap_unify(varnames, Yap_GetFromSlot(vs PASS_REGS))) {
if (vp &&
!Yap_unify(varnames, Yap_GetFromSlot(vs PASS_REGS))) {
return FALSE;
}
return TRUE;

12
library/matrix/matrix.c
View File

@ -387,6 +387,11 @@ static YAP_Term
float_matrix_to_list(int *mat) {
double *data = matrix_double_data(mat, mat[MAT_NDIMS]);
/* prepare for worst case with double taking two cells */
if (YAP_RequiresExtraStack(6*mat[MAT_SIZE])) {
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
data = matrix_double_data(mat, mat[MAT_NDIMS]);
}
return YAP_FloatsToList(data, mat[MAT_SIZE]);
}
@ -429,6 +434,11 @@ static YAP_Term
long_matrix_to_list(int *mat) {
long int *data = matrix_long_data(mat, mat[MAT_NDIMS]);
/* prepare for worst case with longs evrywhere (3cells + 1) */
if (YAP_RequiresExtraStack(5*mat[MAT_SIZE])) {
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
data = matrix_long_data(mat, mat[MAT_NDIMS]);
}
return mk_long_list(mat[MAT_SIZE], data);
}
@ -1269,6 +1279,7 @@ matrix_agg_lines(void)
tf = new_int_matrix(dims-1,mat+(MAT_DIMS+1),NULL);
if (tf == YAP_TermNil())
return FALSE;
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_long_data(mat, dims);
ndata = matrix_long_data(nmat, dims-1);
@ -1351,6 +1362,7 @@ matrix_agg_cols(void)
tf = new_int_matrix(1,mat+MAT_DIMS,NULL);
if (tf == YAP_TermNil())
return FALSE;
mat = (int *)YAP_BlobOfTerm(YAP_ARG1);
nmat = (int *)YAP_BlobOfTerm(tf);
data = matrix_long_data(mat, dims);
ndata = matrix_long_data(nmat, 1);

1
library/terms.yap
View File

@ -18,6 +18,7 @@
:- module(terms, [
term_hash/2,
term_hash/4,
term_subsumer/3,
instantiated_term_hash/4,
variant/2,
unifiable/3,

3
misc/HEAPFIELDS
View File

@ -53,7 +53,8 @@ lockvar heap_used_lock HeapUsedLock MkLock
lockvar heap_top_lock HeapTopLock MkLock
int heap_top_owner HeapTopOwner =-1 void
#endif
UInt MaxStack_ MaxStack =0 void
UInt MaxTrail_ MaxTrail =0 void
/* execution info */
/* OPCODE TABLE, needed to recover op tables */

13
misc/yap.nsi Normal file → Executable file
View File

@ -50,7 +50,7 @@ Section "Base system (required)"
SetOutPath $INSTDIR\bin
File c:\Yap\bin\yap.exe
File c:\Yap\bin\yap.dll
File c:\Yap\bin\pl-yap.exe
File c:\Yap\bin\yap-win.exe
File c:\Yap\bin\plterm.dll
SetOutPath $INSTDIR\bin
@ -89,15 +89,10 @@ Section "Start Menu shortcuts"
SectionIn 1 2 3
SetOutPath ${CWD}
CreateDirectory "$SMPROGRAMS\${GRP}"
CreateShortCut "$SMPROGRAMS\${GRP}\Prolog.lnk" \
"$INSTDIR\bin\yap.exe" \
CreateShortCut "$SMPROGRAMS\${GRP}\YAP-WIN.lnk" \
"$INSTDIR\bin\yap-win.exe" \
"" \
"$INSTDIR\bin\yap.exe" \
0
CreateShortCut "$SMPROGRAMS\${GRP}\PLYap.lnk" \
"$INSTDIR\bin\pl-yap.exe" \
"" \
"$INSTDIR\bin\pl-yap.exe" \
"$INSTDIR\bin\yap-win.exe" \
0
SetOutPath $INSTDIR
CreateShortCut "$SMPROGRAMS\${GRP}\Readme.lnk" \

13
misc/yap64.nsi
View File

@ -47,7 +47,7 @@ Section "Base system (required)"
SetOutPath $INSTDIR\bin
File c:\Yap64\bin\yap.exe
File c:\Yap64\bin\yap.dll
File c:\Yap64\bin\pl-yap.exe
File c:\Yap64\bin\yap-win.exe
File c:\Yap64\bin\plterm.dll
SetOutPath $INSTDIR\bin
@ -86,15 +86,10 @@ Section "Start Menu shortcuts"
SectionIn 1 2 3
SetOutPath ${CWD}
CreateDirectory "$SMPROGRAMS\${GRP}"
CreateShortCut "$SMPROGRAMS\${GRP}\Prolog.lnk" \
"$INSTDIR\bin\yap.exe" \
CreateShortCut "$SMPROGRAMS\${GRP}\YAP-WIN.lnk" \
"$INSTDIR\bin\yap-win.exe" \
"" \
"$INSTDIR\bin\yap.exe" \
0
CreateShortCut "$SMPROGRAMS\${GRP}\PLYap.lnk" \
"$INSTDIR\bin\pl-yap.exe" \
"" \
"$INSTDIR\bin\pl-yap.exe" \
"$INSTDIR\bin\yap-win.exe" \
0
SetOutPath $INSTDIR
CreateShortCut "$SMPROGRAMS\${GRP}\Readme.lnk" \

34
os/pl-error.c
View File

@ -273,8 +273,10 @@ notImplemented(char *name, int arity)
X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
{
GET_LD
char msgbuf[50];
term_t formal, swi, predterm, msgterm, except;
va_list args;
int rc = TRUE;
formal = PL_new_term_ref();
swi = PL_new_term_ref();
@ -295,6 +297,21 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
err_instantiation:
PL_unify_atom(formal, ATOM_instantiation_error);
break;
case ERR_UNINSTANTIATION:
{ int argn = va_arg(args, int);
term_t bound = va_arg(args, term_t);
if ( !msg && argn > 0 )
{ Ssprintf(msgbuf, "%d-%s argument",
argn, argn == 1 ? "st" : argn == 2 ? "nd" : "th");
msg = msgbuf;
}
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_uninstantiation_error1,
PL_TERM, bound);
break;
}
case ERR_TYPE: /* ERR_INSTANTIATION if var(actual) */
{ atom_t expected = va_arg(args, atom_t);
term_t actual = va_arg(args, term_t);
@ -448,7 +465,6 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
case ERR_STREAM_OP:
{ atom_t action = va_arg(args, atom_t);
term_t stream = va_arg(args, term_t);
int rc;
rc = PL_unify_term(formal,
PL_FUNCTOR, FUNCTOR_io_error2,
@ -458,7 +474,6 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
}
case ERR_FORMAT:
{ const char *s = va_arg(args, const char*);
int rc;
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "format", 1,
@ -468,7 +483,6 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
case ERR_FORMAT_ARG:
{ const char *s = va_arg(args, const char*);
term_t arg = va_arg(args, term_t);
int rc;
rc = PL_unify_term(formal,
PL_FUNCTOR_CHARS, "format_argument_type", 2,
@ -491,19 +505,23 @@ X_API int PL_error(const char *pred, int arity, const char *msg, int id, ...)
PL_FUNCTOR, FUNCTOR_divide2,
PL_CHARS, pred,
PL_INT, arity);
}
}
if (!rc) {
fatalError("Cannot report error: no memory");
}
if ( msg )
{
PL_put_atom_chars(msgterm, msg);
rc = PL_put_atom_chars(msgterm, msg);
}
PL_unify_term(swi,
rc = PL_unify_term(swi,
PL_FUNCTOR, FUNCTOR_context2,
PL_TERM, predterm,
PL_TERM, msgterm);
PL_unify_term(except,
rc = PL_unify_term(except,
PL_FUNCTOR, FUNCTOR_error2,
PL_TERM, formal,
PL_TERM, swi);
return PL_raise_exception(except);
rc = PL_raise_exception(except);
return rc;
}

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

@ -4820,6 +4820,9 @@ init_yap(void)
PL_register_extensions(PL_predicates_from_read);
PL_register_extensions(PL_predicates_from_tai);
PL_register_extensions(PL_predicates_from_prologflag);
#ifdef __WINDOWS__
PL_register_extensions(PL_predicates_from_win);
#endif
PL_register_extensions(foreigns);
fileerrors = TRUE;
SinitStreams();

39
os/pl-nt.c Normal file → Executable file
View File

@ -942,6 +942,44 @@ getDefaultsFromRegistry()
}
}
static
PRED_IMPL("win_open_file_name", 3, win_open_file_name, 0)
{ GET_LD
OPENFILENAMEW ofn;
wchar_t szFileName[MAX_PATH];
void *x;
HWND hwnd;
wchar_t *yap_cwd;
if(!PL_get_pointer(A1, &x))
return FALSE;
if(!PL_get_wchars(A2, NULL, &yap_cwd, CVT_ATOM|CVT_EXCEPTION))
return FALSE;
hwnd = (HWND)x;
ZeroMemory(&ofn, sizeof(ofn));
ofn.lStructSize = sizeof(ofn); // SEE NOTE BELOW
ofn.hwndOwner = hwnd;
ofn.lpstrFilter = L"Prolog Files (*.pl;*.yap)\0*.pl;*.yap\0All Files (*.*)\0*.*\0";
ofn.lpstrFile = szFileName;
ofn.lpstrInitialDir = yap_cwd;
ofn.nMaxFile = MAX_PATH;
ofn.Flags = OFN_EXPLORER | OFN_FILEMUSTEXIST
//| OFN_HIDEREADONLY
//|OFN_ALLOWMULTISELECT
;
ofn.lpstrDefExt = "pl";
if(GetOpenFileNameW(&ofn))
{
// Do something usefull with the filename stored in szFileName
return PL_unify_wchars(A3, PL_ATOM,
MAX_PATH-1, szFileName);
}
return TRUE;
}
/*******************************
* PUBLISH PREDICATES *
*******************************/
@ -949,6 +987,7 @@ getDefaultsFromRegistry()
BeginPredDefs(win)
PRED_DEF("win_shell", 2, win_shell2, 0)
PRED_DEF("win_shell", 3, win_shell3, 0)
PRED_DEF("win_open_file_name", 3, win_open_file_name, 0)
PRED_DEF("win_registry_get_value", 3, win_registry_get_value, 0)
PRED_DEF("win_folder", 2, win_folder, PL_FA_NONDETERMINISTIC)
EndPredDefs

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

@ -50,6 +50,11 @@ SWI-Prolog.h and SWI-Stream.h
#include <config.h>
#endif
#if defined(__CYGWIN__) && defined(__YAP_PROLOG__)
#include <sys/time.h>
#endif
/* Disabled if dmalloc() is used because the readline library is full of
leaks and freeing the line returned by readline is considered an
error by the dmalloc library

22
packages/CLPBN/Makefile.in
View File

@ -42,19 +42,19 @@ CLPBN_PROGRAMS= \
$(CLPBN_SRCDIR)/aggregates.yap \
$(CLPBN_SRCDIR)/bdd.yap \
$(CLPBN_SRCDIR)/bnt.yap \
$(CLPBN_SRCDIR)/bp.yap \
$(CLPBN_SRCDIR)/connected.yap \
$(CLPBN_SRCDIR)/discrete_utils.yap \
$(CLPBN_SRCDIR)/display.yap \
$(CLPBN_SRCDIR)/dists.yap \
$(CLPBN_SRCDIR)/evidence.yap \
$(CLPBN_SRCDIR)/fove.yap \
$(CLPBN_SRCDIR)/gibbs.yap \
$(CLPBN_SRCDIR)/graphs.yap \
$(CLPBN_SRCDIR)/graphviz.yap \
$(CLPBN_SRCDIR)/ground_factors.yap \
$(CLPBN_SRCDIR)/hmm.yap \
$(CLPBN_SRCDIR)/horus.yap \
$(CLPBN_SRCDIR)/horus_ground.yap \
$(CLPBN_SRCDIR)/horus_lifted.yap \
$(CLPBN_SRCDIR)/jt.yap \
$(CLPBN_SRCDIR)/matrix_cpt_utils.yap \
$(CLPBN_SRCDIR)/pgrammar.yap \
@ -93,9 +93,23 @@ CLPBN_HMMER_EXAMPLES= \
$(CLPBN_EXDIR)/HMMer/scan.yap \
$(CLPBN_EXDIR)/HMMer/score.yap
CLPBN_LEARNING_EXAMPLES= \
$(CLPBN_EXDIR)/learning/school_params.yap \
$(CLPBN_EXDIR)/learning/sprinkler_params.yap \
$(CLPBN_EXDIR)/learning/train.yap
CLPBN_EXAMPLES= \
$(CLPBN_EXDIR)/burglary-alarm.fg \
$(CLPBN_EXDIR)/burglary-alarm.yap \
$(CLPBN_EXDIR)/burglary-alarm.uai \
$(CLPBN_EXDIR)/cg.yap \
$(CLPBN_EXDIR)/sprinkler.yap
$(CLPBN_EXDIR)/city.yap \
$(CLPBN_EXDIR)/comp_workshops.yap \
$(CLPBN_EXDIR)/social_domain1.yap \
$(CLPBN_EXDIR)/social_domain2.yap \
$(CLPBN_EXDIR)/sprinkler.pfl \
$(CLPBN_EXDIR)/sprinkler.yap \
$(CLPBN_EXDIR)/workshop_attrs.yap
install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS)
@ -104,10 +118,12 @@ install: $(CLBN_TOP) $(CLBN_PROGRAMS) $(CLPBN_PROGRAMS)
mkdir -p $(DESTDIR)$(EXDIR)
mkdir -p $(DESTDIR)$(EXDIR)/School
mkdir -p $(DESTDIR)$(EXDIR)/HMMer
mkdir -p $(DESTDIR)$(EXDIR)/learning
for h in $(CLPBN_TOP); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR); done
for h in $(CLPBN_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn; done
for h in $(CLPBN_LEARNING_PROGRAMS); do $(INSTALL_DATA) $$h $(DESTDIR)$(SHAREDIR)/clpbn/learning; done
for h in $(CLPBN_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR); done
for h in $(CLPBN_SCHOOL_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/School; done
for h in $(CLPBN_HMMER_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/HMMer; done
for h in $(CLPBN_LEARNING_EXAMPLES); do $(INSTALL_DATA) $$h $(DESTDIR)$(EXDIR)/learning; done

110
packages/CLPBN/README.txt Normal file
View File

@ -0,0 +1,110 @@
Prolog Factor Language (PFL)
Prolog Factor Language (PFL) is a extension of the Prolog language that
allows a natural representation of this first-order probabilistic models
(either directed or undirected). PFL is also capable of solving probabilistic
queries on this models through the implementation of several inference
techniques: variable elimination, belief propagation, lifted variable
elimination and lifted belief propagation.
Language
-------------------------------------------------------------------------------
A graphical model in PFL is represented using parfactors. A PFL parfactor
has the following four components:
Type ; Formulas ; Phi ; Constraint .
- Type refers the type of the network over which the parfactor is defined.
It can be bayes for directed networks, or markov for undirected ones.
- Formulas is a sequence of Prolog terms that define sets of random variables
under the constraint.
- Phi is either a list of parameters or a call to a Prolog goal that will
unify its last argument with a list of parameters.
- Constraint is a list (possible empty) of Prolog goals that will impose
bindings on the logical variables that appear in the formulas.
The "examples" directory contains some popular graphical models described
using PFL.
Querying
-------------------------------------------------------------------------------
Now we show how to use PFL to solve probabilistic queries. We will
use the burlgary alarm network as an example. First, we load the model:
$ yap -l examples/burglary-alarm.yap
Now let's suppose that we want to estimate the probability of a earthquake
ocurred given that mary called. We can do it with the following query:
?- earthquake(X), mary_calls(t).
Suppose now that we want the joint distribution for john_calls and
mary_calls. We can obtain this with the following query:
?- john_calls(X), mary_calls(Y).
Inference Options
-------------------------------------------------------------------------------
PFL supports both ground and lifted inference. The inference algorithm
can be chosen using the set_solver/1 predicate. The following algorithms
are supported:
- fove: lifted variable elimination with arbitrary constraints (GC-FOVE)
- hve: (ground) variable elimination
- lbp: lifted first-order belief propagation
- cbp: counting belief propagation
- bp: (ground) belief propagation
For example, if we want to use ground variable elimination to solve some
query, we need to call first the following goal:
?- set_solver(hve).
It is possible to tweak several parameters of PFL through the
set_horus_flag/2 predicate. The first argument is a key that
identifies the parameter that we desire to tweak, while the second
is some possible value for this key.
The verbosity key controls the level of log information that will be
printed by the corresponding solver. Its possible values are positive
integers. The bigger the number, more log information will be printed.
For example, to view some basic log information we need to call the
following goal:
?- set_horus_flag(verbosity, 1).
The use_logarithms key controls whether the calculations performed
during inference should be done in the log domain or not. Its values
can be true or false. By default is false.
There are also keys specific to the inference algorithm. For example,
elim_heuristic key controls the elimination heuristic that will be
used by ground variable elimination. The following heuristics are
supported:
- sequential
- min_neighbors
- min_weight
- min_fill
- weighted_min_fill
An explanation of this heuristics can be found in Probabilistic Graphical
Models by Daphne Koller.
The schedule, accuracy and max_iter keys are specific for inference
algorithms based on message passing, namely lbp, cbp and bp.
The key schedule can be used to specify the order in which the messages
are sent in belief propagation. The possible values are:
- seq_fixed: at each iteration, all messages are sent in the same order
- seq_random: at each iteration, the messages are sent with a random order
- parallel: at each iteration, the messages are all calculated using the
values of the previous iteration.
- max_residual: the next message to be sent is the one with maximum residual,
(Residual Belief Propagation:Informed Scheduling for Asynchronous Message
Passing)
The max_iter key sets the maximum number of iterations. One iteration
consists in sending all possible messages. The accuracy key indicate
when we should stop sending messages. If the largest difference between
a message sent in the current iteration and one message sent in the previous
iteration is less that accuracy value given, we terminate belief propagation.

80
packages/CLPBN/benchmarks/benchs.sh Executable file
View File

@ -0,0 +1,80 @@
function prepare_new_run
{
YAP=~/bin/$SHORTNAME-$SOLVER
LOG_FILE=$SOLVER.log
#LOG_FILE=results`date "+ %H:%M:%S %d-%m-%Y"`.
rm -f $LOG_FILE
rm -f ignore.$LOG_FILE
cp ~/bin/yap $YAP
}
function run_solver
{
constraint=$1
solver_flag=true
if [ -n "$2" ]; then
if [ $SOLVER = hve ]; then
solver_flag=clpbn_horus:set_horus_flag\(elim_heuristic,$2\)
elif [ $SOLVER = bp ]; then
solver_flag=clpbn_horus:set_horus_flag\(schedule,$2\)
elif [ $SOLVER = cbp ]; then
solver_flag=clpbn_horus:set_horus_flag\(schedule,$2\)
elif [ $SOLVER = lbp ]; then
solver_flag=clpbn_horus:set_horus_flag\(schedule,$2\)
else
echo "unknow flag $2"
fi
fi
/usr/bin/time -o $LOG_FILE -a -f "%U\t%S\t%e\t%M" \
$YAP << EOF >> $LOG_FILE &>> ignore.$LOG_FILE
nogc.
[$NETWORK].
[$constraint].
clpbn_horus:set_solver($SOLVER).
clpbn_horus:set_horus_flag(use_logarithms, true).
clpbn_horus:set_horus_flag(verbosity, 1).
$solver_flag.
$QUERY.
open("$LOG_FILE", 'append', S), format(S, '$constraint ~15+ ', []), close(S).
EOF
}
function clear_log_files
{
rm -f *~
rm -f ../*~
rm -f school/*.log school/*~
rm -f ../school/*.log ../school/*~
rm -f city/*.log city/*~
rm -f ../city/*.log ../city/*~
rm -f workshop_attrs/*.log workshop_attrs/*~
rm -f ../workshop_attrs/*.log ../workshop_attrs/*~
echo all done!
}
function write_header
{
echo -n "****************************************" >> $LOG_FILE
echo "****************************************" >> $LOG_FILE
echo "results for solver $1 user(s) sys(s) real(s), mem(kB)" >> $LOG_FILE
echo -n "****************************************" >> $LOG_FILE
echo "****************************************" >> $LOG_FILE
}
if [ $1 ] && [ $1 == "clean" ]; then
clear_log_files
fi

37
packages/CLPBN/benchmarks/city/bp_tests.sh Executable file
View File

@ -0,0 +1,37 @@
#!/bin/bash
source city.sh
source ../benchs.sh
SOLVER="bp"
function run_all_graphs
{
write_header $1
run_solver city1000 $2
run_solver city5000 $2
run_solver city10000 $2
run_solver city15000 $2
run_solver city20000 $2
run_solver city25000 $2
run_solver city30000 $2
run_solver city35000 $2
run_solver city40000 $2
run_solver city45000 $2
run_solver city50000 $2
run_solver city55000 $2
run_solver city60000 $2
run_solver city65000 $2
return
run_solver city70000 $2
run_solver city75000 $2
run_solver city80000 $2
run_solver city85000 $2
run_solver city90000 $2
run_solver city95000 $2
run_solver city100000 $2
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed

36
packages/CLPBN/benchmarks/city/cbp_tests.sh Executable file
View File

@ -0,0 +1,36 @@
#!/bin/bash
source city.sh
source ../benchs.sh
SOLVER="cbp"
function run_all_graphs
{
write_header $1
run_solver city1000 $2
run_solver city5000 $2
run_solver city10000 $2
run_solver city15000 $2
run_solver city20000 $2
run_solver city25000 $2
run_solver city30000 $2
run_solver city35000 $2
run_solver city40000 $2
run_solver city45000 $2
run_solver city50000 $2
run_solver city55000 $2
run_solver city60000 $2
run_solver city65000 $2
run_solver city70000 $2
run_solver city75000 $2
run_solver city80000 $2
run_solver city85000 $2
run_solver city90000 $2
run_solver city95000 $2
run_solver city100000 $2
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed

6
packages/CLPBN/benchmarks/city/city.sh Executable file
View File

@ -0,0 +1,6 @@
#!/bin/bash
NETWORK="'../../examples/city'"
SHORTNAME="city"
QUERY="is_joe_guilty(X)"

36
packages/CLPBN/benchmarks/city/fove_tests.sh Executable file
View File

@ -0,0 +1,36 @@
#!/bin/bash
source city.sh
source ../benchs.sh
SOLVER="fove"
function run_all_graphs
{
write_header $1
run_solver city1000 $2
run_solver city5000 $2
run_solver city10000 $2
run_solver city15000 $2
run_solver city20000 $2
run_solver city25000 $2
run_solver city30000 $2
run_solver city35000 $2
run_solver city40000 $2
run_solver city45000 $2
run_solver city50000 $2
run_solver city55000 $2
run_solver city60000 $2
run_solver city65000 $2
run_solver city70000 $2
run_solver city75000 $2
run_solver city80000 $2
run_solver city85000 $2
run_solver city90000 $2
run_solver city95000 $2
run_solver city100000 $2
}
prepare_new_run
run_all_graphs "fove "

20
packages/CLPBN/clpbn/bp/benchmarks/city/city_generator.sh → packages/CLPBN/benchmarks/city/gen_city.sh
View File

@ -1,21 +1,17 @@
#!/home/tiago/bin/yap -L --
#! /home/tgomes/bin/yap -L --
:- initialization(main).
main :-
unix(argv([H])),
generate_town(H).
generate_town(N) :-
atomic_concat(['city_', N, '.yap'], FileName),
unix(argv([N])),
atomic_concat(['city', N, '.yap'], FileName),
open(FileName, 'write', S),
atom_number(N, N2),
generate_people(S, N2, 4),
generate_people(S, N2, 1),
write(S, '\n'),
generate_query(S, N2, 4),
generate_evidence(S, N2, 1),
write(S, '\n'),
close(S).
@ -28,10 +24,10 @@ generate_people(S, N, Counting) :-
generate_people(S, N, Counting1).
generate_query(S, N, Counting) :-
generate_evidence(S, N, Counting) :-
Counting > N, !.
generate_query(S, N, Counting) :- !,
generate_evidence(S, N, Counting) :- !,
format(S, 'ev(descn(p~w, t)).~n', [Counting]),
Counting1 is Counting + 1,
generate_query(S, N, Counting1).
generate_evidence(S, N, Counting1).

37
packages/CLPBN/benchmarks/city/hve_tests.sh Executable file
View File

@ -0,0 +1,37 @@
#!/bin/bash
source city.sh
source ../benchs.sh
SOLVER="hve"
function run_all_graphs
{
write_header $1
run_solver city1000 $2
run_solver city5000 $2
run_solver city10000 $2
run_solver city15000 $2
run_solver city20000 $2
run_solver city25000 $2
run_solver city30000 $2
run_solver city35000 $2
run_solver city40000 $2
run_solver city45000 $2
run_solver city50000 $2
run_solver city55000 $2
run_solver city60000 $2
run_solver city65000 $2
run_solver city70000 $2
return
run_solver city75000 $2
run_solver city80000 $2
run_solver city85000 $2
run_solver city90000 $2
run_solver city95000 $2
run_solver city100000 $2
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors

36
packages/CLPBN/benchmarks/city/lbp_tests.sh Executable file
View File

@ -0,0 +1,36 @@
#!/bin/bash
source city.sh
source ../benchs.sh
SOLVER="lbp"
function run_all_graphs
{
write_header $1
run_solver city1000 $2
run_solver city5000 $2
run_solver city10000 $2
run_solver city15000 $2
run_solver city20000 $2
run_solver city25000 $2
run_solver city30000 $2
run_solver city35000 $2
run_solver city40000 $2
run_solver city45000 $2
run_solver city50000 $2
run_solver city55000 $2
run_solver city60000 $2
run_solver city65000 $2
run_solver city70000 $2
run_solver city75000 $2
run_solver city80000 $2
run_solver city85000 $2
run_solver city90000 $2
run_solver city95000 $2
run_solver city100000 $2
}
prepare_new_run
run_all_graphs "lbp(shedule=seq_fixed) " seq_fixed

31
packages/CLPBN/benchmarks/comp_workshops/bp_tests.sh Executable file
View File

@ -0,0 +1,31 @@
#!/bin/bash
source cw.sh
source ../benchs.sh
SOLVER="bp"
function run_all_graphs
{
write_header $1
run_solver p1000w$N_WORKSHOPS $2
run_solver p5000w$N_WORKSHOPS $2
run_solver p10000w$N_WORKSHOPS $2
run_solver p15000w$N_WORKSHOPS $2
run_solver p20000w$N_WORKSHOPS $2
run_solver p25000w$N_WORKSHOPS $2
return
run_solver p30000w$N_WORKSHOPS $2
run_solver p35000w$N_WORKSHOPS $2
run_solver p40000w$N_WORKSHOPS $2
run_solver p45000w$N_WORKSHOPS $2
run_solver p50000w$N_WORKSHOPS $2
run_solver p55000w$N_WORKSHOPS $2
run_solver p60000w$N_WORKSHOPS $2
run_solver p65000w$N_WORKSHOPS $2
run_solver p70000w$N_WORKSHOPS $2
}
prepare_new_run
run_all_graphs "bp(shedule=seq_fixed) " seq_fixed

30
packages/CLPBN/benchmarks/comp_workshops/cbp_tests.sh Executable file
View File

@ -0,0 +1,30 @@
#!/bin/bash
source cw.sh
source ../benchs.sh
SOLVER="cbp"
function run_all_graphs
{
write_header $1
run_solver p1000w$N_WORKSHOPS $2
run_solver p5000w$N_WORKSHOPS $2
run_solver p10000w$N_WORKSHOPS $2
run_solver p15000w$N_WORKSHOPS $2
run_solver p20000w$N_WORKSHOPS $2
run_solver p25000w$N_WORKSHOPS $2
run_solver p30000w$N_WORKSHOPS $2
run_solver p35000w$N_WORKSHOPS $2
run_solver p40000w$N_WORKSHOPS $2
run_solver p45000w$N_WORKSHOPS $2
run_solver p50000w$N_WORKSHOPS $2
run_solver p55000w$N_WORKSHOPS $2
run_solver p60000w$N_WORKSHOPS $2
run_solver p65000w$N_WORKSHOPS $2
run_solver p70000w$N_WORKSHOPS $2
}
prepare_new_run
run_all_graphs "cbp(shedule=seq_fixed) " seq_fixed

8
packages/CLPBN/benchmarks/comp_workshops/cw.sh Executable file
View File

@ -0,0 +1,8 @@
#!/bin/bash
NETWORK="'../../examples/comp_workshops'"
SHORTNAME="cw"
QUERY="series(X)"
N_WORKSHOPS=10

31
packages/CLPBN/benchmarks/comp_workshops/fove_tests.sh Executable file
View File

@ -0,0 +1,31 @@
#!/bin/bash
source cw.sh
source ../benchs.sh
SOLVER="fove"
function run_all_graphs
{
write_header $1
run_solver p1000w$N_WORKSHOPS $2
run_solver p5000w$N_WORKSHOPS $2
run_solver p10000w$N_WORKSHOPS $2
run_solver p15000w$N_WORKSHOPS $2
run_solver p20000w$N_WORKSHOPS $2
run_solver p25000w$N_WORKSHOPS $2
run_solver p30000w$N_WORKSHOPS $2
run_solver p35000w$N_WORKSHOPS $2
run_solver p40000w$N_WORKSHOPS $2
run_solver p45000w$N_WORKSHOPS $2
run_solver p50000w$N_WORKSHOPS $2
run_solver p55000w$N_WORKSHOPS $2
run_solver p60000w$N_WORKSHOPS $2
run_solver p65000w$N_WORKSHOPS $2
run_solver p70000w$N_WORKSHOPS $2
}
prepare_new_run
run_all_graphs "fove "

35
packages/CLPBN/benchmarks/comp_workshops/gen_workshops.sh Executable file
View File

@ -0,0 +1,35 @@
#!/home/tgomes/bin/yap -L --
:- use_module(library(lists)).
:- initialization(main).
main :-
unix(argv(Args)),
nth(1, Args, NP), % number of invitees
nth(2, Args, NW), % number of workshops
atomic_concat(['p', NP , 'w', NW, '.yap'], FileName),
open(FileName, 'write', S),
atom_number(NP, NP2),
atom_number(NW, NW2),
gen(S, NP2, NW2, 1),
write(S, '\n'),
close(S).
gen(_, NP, _, Count) :-
Count > NP, !.
gen(S, NP, NW, Count) :-
gen_workshops(S, Count, NW, 1),
Count1 is Count + 1,
gen(S, NP, NW, Count1).
gen_workshops(_, _, NW, Count) :-
Count > NW, !.
gen_workshops(S, P, NW, Count) :-
format(S, 'c(p~w,w~w).~n', [P,Count]),
Count1 is Count + 1,
gen_workshops(S, P, NW, Count1).

30
packages/CLPBN/benchmarks/comp_workshops/hve_tests.sh Executable file
View File

@ -0,0 +1,30 @@
#!/bin/bash
source cw.sh
source ../benchs.sh
SOLVER="hve"
function run_all_graphs
{
write_header $1
run_solver p1000w$N_WORKSHOPS $2
run_solver p5000w$N_WORKSHOPS $2
run_solver p10000w$N_WORKSHOPS $2
run_solver p15000w$N_WORKSHOPS $2
run_solver p20000w$N_WORKSHOPS $2
run_solver p25000w$N_WORKSHOPS $2
run_solver p30000w$N_WORKSHOPS $2
run_solver p35000w$N_WORKSHOPS $2
run_solver p40000w$N_WORKSHOPS $2
run_solver p45000w$N_WORKSHOPS $2
run_solver p50000w$N_WORKSHOPS $2
run_solver p55000w$N_WORKSHOPS $2
run_solver p60000w$N_WORKSHOPS $2
run_solver p65000w$N_WORKSHOPS $2
run_solver p70000w$N_WORKSHOPS $2
}
prepare_new_run
run_all_graphs "hve(elim_heuristic=min_neighbors) " min_neighbors

30
packages/CLPBN/benchmarks/comp_workshops/lbp_tests.sh Executable file
View File

@ -0,0 +1,30 @@
#!/bin/bash
source cw.sh
source ../benchs.sh
SOLVER="lbp"
function run_all_graphs
{
write_header $1
run_solver p1000w$N_WORKSHOPS $2
run_solver p5000w$N_WORKSHOPS $2
run_solver p10000w$N_WORKSHOPS $2
run_solver p15000w$N_WORKSHOPS $2
run_solver p20000w$N_WORKSHOPS $2
run_solver p25000w$N_WORKSHOPS $2
run_solver p30000w$N_WORKSHOPS $2
run_solver p35000w$N_WORKSHOPS $2
run_solver p40000w$N_WORKSHOPS $2
run_solver p45000w$N_WORKSHOPS $2
run_solver p50000w$N_WORKSHOPS $2
run_solver p55000w$N_WORKSHOPS $2
run_solver p60000w$N_WORKSHOPS $2
run_solver p65000w$N_WORKSHOPS $2
run_solver p70000w$N_WORKSHOPS $2
}
prepare_new_run
run_all_graphs "lbp(shedule=seq_fixed) " seq_fixed

35
packages/CLPBN/benchmarks/run_all.sh Executable file
View File

@ -0,0 +1,35 @@
#!/bin/bash
cd workshop_attrs
source hve_tests.sh
source bp_tests.sh
source fove_tests.sh
source lbp_tests.sh
source cbp_tests.sh
cd ..
cd comp_workshops
source hve_tests.sh
source bp_tests.sh
source fove_tests.sh
source lbp_tests.sh
source cbp_tests.sh
cd ..
cd city
source hve_tests.sh
source bp_tests.sh
source fove_tests.sh
source lbp_tests.sh
source cbp_tests.sh
cd ..
cd smokers
source hve_tests.sh
source bp_tests.sh
source fove_tests.sh
source lbp_tests.sh
source cbp_tests.sh
cd ..

0
packages/CLPBN/clpbn/bp/benchmarks/school/missing10.yap → packages/CLPBN/benchmarks/school/missing10.yap
View File

0
packages/CLPBN/clpbn/bp/benchmarks/school/missing20.yap → packages/CLPBN/benchmarks/school/missing20.yap
View File

0
packages/CLPBN/clpbn/bp/benchmarks/school/missing30.yap → packages/CLPBN/benchmarks/school/missing30.yap
View File

0
packages/CLPBN/clpbn/bp/benchmarks/school/missing40.yap → packages/CLPBN/benchmarks/school/missing40.yap
View File

0
packages/CLPBN/clpbn/bp/benchmarks/school/missing5.yap → packages/CLPBN/benchmarks/school/missing5.yap
View File

Some files were not shown because too many files have changed in this diff Show More