void YAPQuery::openQuery() {
CACHE_REGS
arity_t arity = ap->ArityOfPE;
if (arity) {
Term *ts;
Term t = goal;
if (IsPairTerm(t)) {
ts = RepPair(t);
} else {
ts = RepAppl(t) + 1;
}
for (arity_t i = 0; i < arity; i++) {
XREGS[i + 1] = ts[i];
}
}
// oq = LOCAL_execution;
// LOCAL_execution = this;
q_open = true;
q_state = 0;
q_flags = true; // PL_Q_PASS_EXCEPTION;
q_p = P;
q_cp = CP;
// make sure this is safe
q_handles = Yap_StartSlots();
}
Term &YAPTerm::operator[](arity_t i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
Term *tf = nullptr;
if (IsApplTerm(t0)) {
// Functor f = FunctorOfTerm(t0);
// if (IsExtensionFunctor(f))
// return 0;
tf = RepAppl(t0) + (i + 1);
} else if (IsPairTerm(t0)) {
if (i == 0)
tf = RepPair(t0);
else if (i == 1)
tf = RepPair(t0) + 1;
RECOVER_MACHINE_REGS();
} else {
throw YAPError(SOURCE(), TYPE_ERROR_COMPOUND, t0, "");
}
RECOVER_MACHINE_REGS();
return *tf;
}
static void
reset_trail(tr_fr_ptr tr_top, tr_fr_ptr trp)
{
register CELL aux_cell;
/* unbinding variables */
while (tr_top != trp) {
aux_cell = TrailTerm(--trp);
/* check for global or local variables */
if (IsVarTerm(aux_cell)) {
/* clean up the trail when we backtrack */
/* shouldn't this test always succeed? */
if (Unsigned((Int)(aux_cell)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
RESET_VARIABLE(STACK_TO_SBA(aux_cell));
} else {
RESET_VARIABLE(aux_cell);
}
}
else if (IsPairTerm(aux_cell)) {
/* avoid frozen segments */
if ((ADDR) RepPair(aux_cell) > HeapTop) {
trp = (tr_fr_ptr) RepPair(aux_cell);
}
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
CELL *aux_ptr = RepAppl(aux_cell);
trp--;
if (Unsigned((Int)(aux_ptr)-(Int)(H_FZ)) >
Unsigned((Int)(B_FZ)-(Int)(H_FZ))) {
*STACK_TO_SBA(aux_ptr) = TrailTerm(trp);
} else {
*aux_ptr = TrailTerm(trp);
}
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
}
}
Term &YAPListTerm::operator[](arity_t i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
Term tf = 0;
while (IsPairTerm(t0)) {
if (i == 0) {
tf = HeadOfTerm(t0);
break;
} else {
t0 = TailOfTerm(t0);
i--;
}
}
RECOVER_MACHINE_REGS();
return RepPair(tf)[i];
}
static inline int
rational_tree(Term d0) {
CACHE_REGS
CELL **to_visit_max = (CELL **)AuxBase, **to_visit = (CELL **)AuxSp;
if (IsPairTerm(d0)) {
CELL *pt0 = RepPair(d0);
return Yap_rational_tree_loop(pt0-1, pt0+1, to_visit, to_visit_max);
} else if (IsApplTerm(d0)) {
CELL *pt0 = RepAppl(d0);
Functor f = (Functor)(*pt0);
if (IsExtensionFunctor(f))
return FALSE;
return Yap_rational_tree_loop(pt0, pt0+ArityOfFunctor(f), to_visit, to_visit_max);
} else
return FALSE;
}
static Int
p_stream_to_codes(void)
{
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "read_line_to_codes/2");
CELL *HBASE = H;
CELL *h0 = &ARG4;
if (sno < 0)
return FALSE;
while (!(Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
Int ch = Stream[sno].stream_getc(sno);
Term t;
if (ch == EOFCHAR)
break;
t = MkIntegerTerm(ch);
h0[0] = AbsPair(H);
*H = t;
H+=2;
h0 = H-1;
if (H >= ASP-1024) {
RESET_VARIABLE(h0);
ARG4 = AbsPair(HBASE);
ARG5 = (CELL)h0;
if (!Yap_gcl((ASP-HBASE)*sizeof(CELL), 5, ENV, gc_P(P,CP))) {
Yap_Error(OUT_OF_STACK_ERROR, ARG1, "read_stream_to_codes/3");
return FALSE;
}
/* build a legal term again */
h0 = (CELL *)ARG5;
HBASE = RepPair(ARG4);
}
}
UNLOCK(Stream[sno].streamlock);
if (H == HBASE)
return Yap_unify(ARG2,ARG3);
RESET_VARIABLE(H-1);
Yap_unify(H[-1],ARG3);
return Yap_unify(AbsPair(HBASE),ARG2);
}
static Int read_stream_to_codes(USES_REGS1) {
int sno = Yap_CheckStream(ARG1, Input_Stream_f,
"reaMkAtomTerm (AtomEofd_line_to_codes/2");
CELL *HBASE = HR;
CELL *h0 = &ARG4;
if (sno < 0)
return FALSE;
while (!(GLOBAL_Stream[sno].status & Eof_Stream_f)) {
/* skip errors */
Int ch = GLOBAL_Stream[sno].stream_getc(sno);
Term t;
if (ch == EOFCHAR)
break;
t = MkIntegerTerm(ch);
h0[0] = AbsPair(HR);
*HR = t;
HR += 2;
h0 = HR - 1;
yhandle_t news, news1, st = Yap_StartSlots();
if (HR >= ASP - 1024) {
RESET_VARIABLE(h0);
news = Yap_InitSlot(AbsPair(HBASE));
news1 = Yap_InitSlot((CELL)(h0));
if (!Yap_gcl((ASP - HBASE) * sizeof(CELL), 3, ENV, Yap_gcP())) {
Yap_Error(RESOURCE_ERROR_STACK, ARG1, "read_stream_to_codes/3");
return false;
}
/* build a legal term again */
h0 = (CELL *)(Yap_GetFromSlot(news1));
HBASE = RepPair(Yap_GetFromSlot(news));
}
Yap_CloseSlots(st);
}
UNLOCK(GLOBAL_Stream[sno].streamlock);
if (HR == HBASE)
return Yap_unify(ARG2, ARG3);
RESET_VARIABLE(HR - 1);
Yap_unify(HR[-1], ARG3);
return Yap_unify(AbsPair(HBASE), ARG2);
}
Term &YAPTerm::operator[](arity_t i) {
BACKUP_MACHINE_REGS();
Term t0 = gt();
Term tf = 0;
if (IsApplTerm(t0)) {
// Functor f = FunctorOfTerm(t0);
// if (IsExtensionFunctor(f))
// return 0;
tf = RepAppl(t0)[(i + 1)];
} else if (IsPairTerm(t0)) {
if (i == 0)
tf = HeadOfTerm(t0);
else if (i == 1)
tf = TailOfTerm(t0);
RECOVER_MACHINE_REGS();
tf = RepPair(tf)[i];
}
RECOVER_MACHINE_REGS();
Yap_Error(TYPE_ERROR_COMPOUND, tf, "");
throw YAPError();
}
/**
* Syntax Error Handler
*
* @par tokptr: the sequence of tokens
* @par sno: the stream numbet
*
* Implicit arguments:
* +
*/
static Term syntax_error(TokEntry *errtok, int sno, Term cmod) {
CACHE_REGS
Term startline, errline, endline;
Term tf[3];
Term tm;
Term *tailp = tf + 2;
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokPos;
startline = MkIntegerTerm(cline);
endline = MkIntegerTerm(cline);
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos);
if (LOCAL_ErrorMessage)
tm = MkStringTerm(LOCAL_ErrorMessage);
else
tm = MkStringTerm("syntax error");
while (tok) {
if (HR > ASP - 1024) {
errline = MkIntegerTerm(0);
endline = MkIntegerTerm(0);
/* for some reason moving this earlier confuses gcc on solaris */
HR = Hi;
break;
}
if (tok->TokPos != cline) {
*tailp = MkPairTerm(TermNewLine, TermNil);
tailp = RepPair(*tailp) + 1;
cline = tok->TokPos;
}
if (tok == errtok && tok->Tok != Error_tok) {
*tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil);
tailp = RepPair(*tailp) + 1;
}
Term rep = Yap_tokRep(tok);
if (tok->TokNext) {
tok = tok->TokNext;
} else {
endline = MkIntegerTerm(tok->TokPos);
tok = NULL;
break;
}
*tailp = MkPairTerm(rep, TermNil);
tailp = RepPair(*tailp) + 1;
}
{
Term t[3];
t[0] = startline;
t[1] = errline;
t[2] = endline;
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t);
}
/* 0: strat, error, end line */
/*2 msg */
/* 1: file */
tf[1] = Yap_StreamUserName(sno);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
Term terr = Yap_MkApplTerm(FunctorInfo3, 3, tf);
Term tn[2];
tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &tm);
tn[1] = terr;
terr = Yap_MkApplTerm(FunctorError, 2, tn);
#if DEBUG
if (Yap_ExecutionMode == YAP_BOOT_MODE) {
fprintf(stderr, "SYNTAX ERROR while booting: ");
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
}
int
Yap_rational_tree_loop(CELL *pt0, CELL *pt0_end, CELL **to_visit, CELL **to_visit_max)
{
CELL ** base = to_visit;
rtree_loop:
while (pt0 < pt0_end) {
register CELL *ptd0;
register CELL d0;
ptd0 = ++pt0;
pt0 = ptd0;
d0 = *ptd0;
deref_head(d0, rtree_loop_unk);
rtree_loop_nvar:
{
if (d0 == TermFoundVar)
goto cufail;
if (IsPairTerm(d0)) {
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
*pt0 = TermFoundVar;
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
continue;
}
if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2;
/* store the terms to visit */
ap2 = RepAppl(d0);
f = (Functor) (*ap2);
/* compare functors */
if (IsExtensionFunctor(f)) {
continue;
}
to_visit -= 3;
if (to_visit < to_visit_max) {
to_visit = Yap_shift_visit(to_visit, &to_visit_max, &base);
}
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = (CELL *)*pt0;
*pt0 = TermFoundVar;
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
continue;
}
continue;
}
derefa_body(d0, ptd0, rtree_loop_unk, rtree_loop_nvar);
}
/* Do we still have compound terms to visit */
if (to_visit < base) {
pt0 = to_visit[0];
pt0_end = to_visit[1];
*pt0 = (CELL)to_visit[2];
to_visit += 3;
goto rtree_loop;
}
return FALSE;
cufail:
/* we found an infinite term */
while (to_visit < (CELL **)base) {
CELL *pt0;
pt0 = to_visit[0];
*pt0 = (CELL)to_visit[2];
to_visit += 3;
}
return TRUE;
}
static int
unifiable_complex(CELL *pt0, CELL *pt0_end, CELL *pt1)
{
CACHE_REGS
#ifdef THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) || defined(HB) */
#endif
#ifdef SHADOW_HB
register CELL *HBREG = HB;
#endif /* SHADOW_HB */
struct unif_record *unif = (struct unif_record *)AuxBase;
struct v_record *to_visit = (struct v_record *)AuxSp;
#define unif_base ((struct unif_record *)AuxBase)
#define to_visit_base ((struct v_record *)AuxSp)
loop:
while (pt0 < pt0_end) {
register CELL *ptd0 = pt0+1;
register CELL d0;
++pt1;
pt0 = ptd0;
d0 = *ptd0;
deref_head(d0, unifiable_comp_unk);
unifiable_comp_nvar:
{
register CELL *ptd1 = pt1;
register CELL d1 = *ptd1;
deref_head(d1, unifiable_comp_nvar_unk);
unifiable_comp_nvar_nvar:
if (d0 == d1)
continue;
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
goto cufail;
}
/* now link the two structures so that no one else will */
/* come here */
/* store the terms to visit */
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
CELL **urec = (CELL **)unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
unif = (struct unif_record *)urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
pt0_end = (pt0 = RepPair(d0) - 1) + 2;
pt1 = RepPair(d1) - 1;
continue;
}
if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
goto cufail;
}
/* store the terms to visit */
ap2 = RepAppl(d0);
ap3 = RepAppl(d1);
f = (Functor) (*ap2);
/* compare functors */
if (f != (Functor) *ap3)
goto cufail;
if (IsExtensionFunctor(f)) {
if (unify_extension(f, d0, ap2, d1))
continue;
goto cufail;
}
/* now link the two structures so that no one else will */
/* come here */
/* store the terms to visit */
if (RATIONAL_TREES || pt0 < pt0_end) {
to_visit --;
#ifdef RATIONAL_TREES
unif++;
#endif
if ((void *)to_visit < (void *)unif) {
CELL **urec = (CELL **)unif;
to_visit = (struct v_record *)Yap_shift_visit((CELL **)to_visit, &urec, NULL);
unif = (struct unif_record *)urec;
}
to_visit->start0 = pt0;
to_visit->end0 = pt0_end;
to_visit->start1 = pt1;
#ifdef RATIONAL_TREES
unif[-1].old = *pt0;
unif[-1].ptr = pt0;
*pt0 = d1;
#endif
}
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
}
goto cufail;
derefa_body(d1, ptd1, unifiable_comp_nvar_unk, unifiable_comp_nvar_nvar);
/* d1 and pt2 have the unbound value, whereas d0 is bound */
*(ptd1) = d0;
DO_TRAIL(ptd1, d0);
continue;
}
derefa_body(d0, ptd0, unifiable_comp_unk, unifiable_comp_nvar);
/* first arg var */
{
register CELL d1;
register CELL *ptd1;
ptd1 = pt1;
d1 = ptd1[0];
/* pt2 is unbound */
deref_head(d1, unifiable_comp_var_unk);
unifiable_comp_var_nvar:
/* pt2 is unbound and d1 is bound */
*ptd0 = d1;
DO_TRAIL(ptd0, d1);
continue;
derefa_body(d1, ptd1, unifiable_comp_var_unk, unifiable_comp_var_nvar);
/* ptd0 and ptd1 are unbound */
UnifyAndTrailGlobalCells(ptd0, ptd1);
}
}
/* Do we still have compound terms to visit */
if (to_visit < to_visit_base) {
pt0 = to_visit->start0;
pt0_end = to_visit->end0;
pt1 = to_visit->start1;
to_visit++;
goto loop;
}
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return TRUE;
cufail:
#ifdef RATIONAL_TREES
/* restore bindigs */
while (unif-- != unif_base) {
CELL *pt0;
pt0 = unif->ptr;
*pt0 = unif->old;
}
#endif
return FALSE;
#ifdef THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif defined(SHADOW_REGS)
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
static int
unifiable(CELL d0, CELL d1)
{
CACHE_REGS
#if THREADS
#undef Yap_REGS
register REGSTORE *regp = Yap_regp;
#define Yap_REGS (*regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
register REGSTORE *regp = &Yap_REGS;
#define Yap_REGS (*regp)
#endif /* defined(B) || defined(TR) */
#endif
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
register CELL *pt0, *pt1;
deref_head(d0, unifiable_unk);
unifiable_nvar:
/* d0 is bound */
deref_head(d1, unifiable_nvar_unk);
unifiable_nvar_nvar:
/* both arguments are bound */
if (d0 == d1)
return TRUE;
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
return (FALSE);
}
pt0 = RepPair(d0);
pt1 = RepPair(d1);
return (unifiable_complex(pt0 - 1, pt0 + 1, pt1 - 1));
}
else if (IsApplTerm(d0)) {
pt0 = RepAppl(d0);
d0 = *pt0;
if (!IsApplTerm(d1))
return (FALSE);
pt1 = RepAppl(d1);
d1 = *pt1;
if (d0 != d1) {
return (FALSE);
} else {
if (IsExtensionFunctor((Functor)d0)) {
switch(d0) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
}
}
return (unifiable_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
pt1));
}
} else {
return (FALSE);
}
deref_body(d1, pt1, unifiable_nvar_unk, unifiable_nvar_nvar);
/* d0 is bound and d1 is unbound */
*(pt1) = d0;
DO_TRAIL(pt1, d0);
return (TRUE);
deref_body(d0, pt0, unifiable_unk, unifiable_nvar);
/* pt0 is unbound */
deref_head(d1, unifiable_var_unk);
unifiable_var_nvar:
/* pt0 is unbound and d1 is bound */
*pt0 = d1;
DO_TRAIL(pt0, d1);
return TRUE;
deref_body(d1, pt1, unifiable_var_unk, unifiable_var_nvar);
/* d0 and pt1 are unbound */
UnifyAndTrailCells(pt0, pt1);
return (TRUE);
#if THREADS
#undef Yap_REGS
#define Yap_REGS (*Yap_regp)
#elif SHADOW_REGS
#if defined(B) || defined(TR)
#undef Yap_REGS
#endif /* defined(B) || defined(TR) */
#endif
}
static Term
syntax_error (TokEntry * tokptr, IOSTREAM *st, Term *outp)
{
CACHE_REGS
Term info;
int count = 0, out = 0;
Int start, err = 0, end;
Term tf[7];
Term *error = tf+3;
CELL *Hi = H;
/* make sure to globalise variable */
start = tokptr->TokPos;
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
while (1) {
Term ts[2];
if (H > ASP-1024) {
tf[3] = TermNil;
err = 0;
end = 0;
/* for some reason moving this earlier confuses gcc on solaris */
H = Hi;
break;
}
if (tokptr == LOCAL_toktide) {
err = tokptr->TokPos;
out = count;
}
info = tokptr->TokInfo;
switch (tokptr->Tok) {
case Name_tok:
{
Term t0[1];
t0[0] = MkAtomTerm((Atom)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom,1),1,t0);
}
break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo));
break;
case Var_tok:
{
Term t[3];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_StringToList(varinfo->VarRep);
if (varinfo->VarAdr == TermNil) {
t[2] = varinfo->VarAdr = MkVarTerm();
} else {
t[2] = varinfo->VarAdr;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar,3),3,t);
}
break;
case String_tok:
{
Term t0 = Yap_StringToList((char *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case WString_tok:
{
Term t0 = Yap_WideStringToList((wchar_t *)info);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString,1),1,&t0);
}
break;
case Error_tok:
case eot_tok:
break;
case Ponctuation_tok:
{
char s[2];
s[1] = '\0';
if (Ord (info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
if (tokptr->Tok == Ord (eot_tok)) {
*error = TermNil;
end = tokptr->TokPos;
break;
} else if (tokptr->Tok != Ord (Error_tok)) {
ts[1] = MkIntegerTerm(tokptr->TokPos);
*error =
MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil);
error = RepPair(*error)+1;
count++;
}
tokptr = tokptr->TokNext;
}
/* now we can throw away tokens, so we can unify and possibly overwrite TR */
Yap_unify(*outp, MkVarTerm());
if (IsVarTerm(*outp) && (VarOfTerm(*outp) > H || VarOfTerm(*outp) < H0)) {
tf[0] = Yap_MkNewApplTerm(Yap_MkFunctor(AtomRead,1),1);
} else {
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,outp);
}
{
Term t[3];
t[0] = MkIntegerTerm(start);
t[1] = MkIntegerTerm(err);
t[2] = MkIntegerTerm(end);
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t);
}
tf[2] = MkAtomTerm(AtomHERE);
tf[4] = MkIntegerTerm(out);
tf[5] = MkIntegerTerm(err);
tf[6] = StreamName(st);
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf));
}
inline static Int compare(Term t1, Term t2) /* compare terms t1 and t2 */
{
if (t1 == t2)
return 0;
if (IsVarTerm(t1)) {
if (IsVarTerm(t2))
return Signed(t1) - Signed(t2);
return -1;
} else if (IsVarTerm(t2)) {
/* get rid of variables */
return 1;
}
if (IsAtomOrIntTerm(t1)) {
if (IsAtomTerm(t1)) {
if (IsAtomTerm(t2))
return cmp_atoms(AtomOfTerm(t1), AtomOfTerm(t2));
if (IsPrimitiveTerm(t2))
return 1;
if (IsStringTerm(t2))
return 1;
return -1;
} else {
if (IsIntTerm(t2)) {
return IntOfTerm(t1) - IntOfTerm(t2);
}
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return IntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
case big_int_e:
return Yap_gmp_tcmp_int_big(IntOfTerm(t1), t2);
#endif
case db_ref_e:
return 1;
case string_e:
return -1;
}
}
return -1;
}
} else if (IsPairTerm(t1)) {
if (IsApplTerm(t2)) {
Functor f = FunctorOfTerm(t2);
if (IsExtensionFunctor(f))
return 1;
else {
if (f != FunctorDot)
return strcmp(".", RepAtom(NameOfFunctor(f))->StrOfAE);
else {
return compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepAppl(t2));
}
}
}
if (IsPairTerm(t2)) {
return (
compare_complex(RepPair(t1) - 1, RepPair(t1) + 1, RepPair(t2) - 1));
} else
return 1;
} else {
/* compound term */
Functor fun1 = FunctorOfTerm(t1);
if (IsExtensionFunctor(fun1)) {
/* float, long, big, dbref */
switch ((CELL)fun1) {
case double_e: {
if (IsFloatTerm(t2))
return (rfloat(FloatOfTerm(t1) - FloatOfTerm(t2)));
if (IsRefTerm(t2))
return 1;
return -1;
}
case long_int_e: {
if (IsIntTerm(t2))
return LongIntOfTerm(t1) - IntOfTerm(t2);
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2))
return LongIntOfTerm(t1) - LongIntOfTerm(t2);
#ifdef USE_GMP
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_int_big(LongIntOfTerm(t1), t2);
}
#endif
if (IsRefTerm(t2))
return 1;
return -1;
}
#ifdef USE_GMP
case big_int_e: {
if (IsIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, IntOfTerm(t2));
if (IsFloatTerm(t2)) {
return 1;
}
if (IsLongIntTerm(t2))
return Yap_gmp_tcmp_big_int(t1, LongIntOfTerm(t2));
if (IsBigIntTerm(t2)) {
return Yap_gmp_tcmp_big_big(t1, t2);
}
if (IsRefTerm(t2))
return 1;
return -1;
}
#endif
case string_e: {
if (IsApplTerm(t2)) {
Functor fun2 = FunctorOfTerm(t2);
switch ((CELL)fun2) {
case double_e:
return 1;
case long_int_e:
return 1;
#ifdef USE_GMP
case big_int_e:
return 1;
#endif
case db_ref_e:
return 1;
case string_e:
return strcmp((char *)StringOfTerm(t1), (char *)StringOfTerm(t2));
}
return -1;
}
return -1;
}
case db_ref_e:
if (IsRefTerm(t2))
return Unsigned(RefOfTerm(t2)) - Unsigned(RefOfTerm(t1));
return -1;
}
}
if (!IsApplTerm(t2)) {
if (IsPairTerm(t2)) {
Int out;
Functor f = FunctorOfTerm(t1);
if (!(out = ArityOfFunctor(f)) - 2)
out = strcmp((char *)RepAtom(NameOfFunctor(f))->StrOfAE, ".");
return out;
}
return 1;
} else {
Functor fun2 = FunctorOfTerm(t2);
Int r;
if (IsExtensionFunctor(fun2)) {
return 1;
}
r = ArityOfFunctor(fun1) - ArityOfFunctor(fun2);
if (r)
return r;
r = cmp_atoms(NameOfFunctor(fun1), NameOfFunctor(fun2));
if (r)
return r;
else
return (compare_complex(RepAppl(t1), RepAppl(t1) + ArityOfFunctor(fun1),
RepAppl(t2)));
}
}
}
static Int compare_complex(register CELL *pt0, register CELL *pt0_end,
register CELL *pt1) {
CACHE_REGS
register CELL **to_visit = (CELL **)HR;
register Int out = 0;
loop:
while (pt0 < pt0_end) {
register CELL d0, d1;
++pt0;
++pt1;
d0 = Derefa(pt0);
d1 = Derefa(pt1);
if (IsVarTerm(d0)) {
if (IsVarTerm(d1)) {
out = Signed(d0) - Signed(d1);
if (out)
goto done;
} else {
out = -1;
goto done;
}
} else if (IsVarTerm(d1)) {
out = 1;
goto done;
} else {
if (d0 == d1)
continue;
else if (IsAtomTerm(d0)) {
if (IsAtomTerm(d1))
out = cmp_atoms(AtomOfTerm(d0), AtomOfTerm(d1));
else if (IsPrimitiveTerm(d1))
out = 1;
else
out = -1;
/* I know out must be != 0 */
goto done;
} else if (IsIntTerm(d0)) {
if (IsIntTerm(d1))
out = IntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = IntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_int_big(IntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1))
out = 1;
else
out = -1;
if (out != 0)
goto done;
} else if (IsFloatTerm(d0)) {
if (IsFloatTerm(d1)) {
out = rfloat(FloatOfTerm(d0) - FloatOfTerm(d1));
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsStringTerm(d0)) {
if (IsStringTerm(d1)) {
out = strcmp((char *)StringOfTerm(d0), (char *)StringOfTerm(d1));
} else if (IsIntTerm(d1))
out = 1;
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = 1;
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = 1;
#endif
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
} else if (IsLongIntTerm(d0)) {
if (IsIntTerm(d1))
out = LongIntOfTerm(d0) - IntOfTerm(d1);
else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = LongIntOfTerm(d0) - LongIntOfTerm(d1);
#ifdef USE_GMP
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_int_big(LongIntOfTerm(d0), d1);
#endif
} else if (IsRefTerm(d1)) {
out = 1;
} else {
out = -1;
}
if (out != 0)
goto done;
}
#ifdef USE_GMP
else if (IsBigIntTerm(d0)) {
if (IsIntTerm(d1)) {
out = Yap_gmp_tcmp_big_int(d0, IntOfTerm(d1));
} else if (IsFloatTerm(d1)) {
out = 1;
} else if (IsLongIntTerm(d1)) {
out = Yap_gmp_tcmp_big_int(d0, LongIntOfTerm(d1));
} else if (IsBigIntTerm(d1)) {
out = Yap_gmp_tcmp_big_big(d0, d1);
} else if (IsRefTerm(d1))
out = 1;
else
out = -1;
if (out != 0)
goto done;
}
#endif
else if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
if (IsApplTerm(d1)) {
Functor f = FunctorOfTerm(d1);
if (IsExtensionFunctor(f))
out = 1;
else if (!(out = 2 - ArityOfFunctor(f)))
out = strcmp(".", (char *)RepAtom(NameOfFunctor(f))->StrOfAE);
} else
out = 1;
goto done;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit += 4;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
#endif
pt0 = RepPair(d0) - 1;
pt0_end = RepPair(d0) + 1;
pt1 = RepPair(d1) - 1;
continue;
} else if (IsRefTerm(d0)) {
if (IsRefTerm(d1))
out = Unsigned(RefOfTerm(d1)) - Unsigned(RefOfTerm(d0));
else
out = -1;
goto done;
} else if (IsApplTerm(d0)) {
register Functor f;
register CELL *ap2, *ap3;
if (!IsApplTerm(d1)) {
out = 1;
goto done;
} else {
/* store the terms to visit */
Functor f2;
ap2 = RepAppl(d0);
ap3 = RepAppl(d1);
f = (Functor)(*ap2);
if (IsExtensionFunctor(f)) {
out = 1;
goto done;
}
f2 = (Functor)(*ap3);
if (IsExtensionFunctor(f2)) {
out = -1;
goto done;
}
/* compare functors */
if (f != (Functor)*ap3) {
if (!(out = ArityOfFunctor(f) - ArityOfFunctor(f2)))
out = cmp_atoms(NameOfFunctor(f), NameOfFunctor(f2));
goto done;
}
#ifdef RATIONAL_TREES
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit[3] = (CELL *)*pt0;
to_visit += 4;
*pt0 = d1;
#else
/* store the terms to visit */
if (pt0 < pt0_end) {
to_visit[0] = pt0;
to_visit[1] = pt0_end;
to_visit[2] = pt1;
to_visit += 3;
}
#endif
d0 = ArityOfFunctor(f);
pt0 = ap2;
pt0_end = ap2 + d0;
pt1 = ap3;
continue;
}
}
}
}
/* Do we still have compound terms to visit */
if (to_visit > (CELL **)HR) {
#ifdef RATIONAL_TREES
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
#else
to_visit -= 3;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
#endif
goto loop;
}
done:
/* failure */
#ifdef RATIONAL_TREES
while (to_visit > (CELL **)HR) {
to_visit -= 4;
pt0 = to_visit[0];
pt0_end = to_visit[1];
pt1 = to_visit[2];
*pt0 = (CELL)to_visit[3];
}
#endif
return (out);
}
static int
OCUnify(register CELL d0, register CELL d1)
{
CACHE_REGS
register CELL *pt0, *pt1;
#if SHADOW_HB
register CELL *HBREG = HB;
#endif
deref_head(d0, oc_unify_unk);
oc_unify_nvar:
/* d0 is bound */
deref_head(d1, oc_unify_nvar_unk);
oc_unify_nvar_nvar:
if (d0 == d1) {
return (!rational_tree(d0));
}
/* both arguments are bound */
if (IsPairTerm(d0)) {
if (!IsPairTerm(d1)) {
return (FALSE);
}
pt0 = RepPair(d0);
pt1 = RepPair(d1);
return (OCUnify_complex(pt0 - 1, pt0 + 1, pt1 - 1));
}
else if (IsApplTerm(d0)) {
if (!IsApplTerm(d1))
return (FALSE);
pt0 = RepAppl(d0);
d0 = *pt0;
pt1 = RepAppl(d1);
d1 = *pt1;
if (d0 != d1) {
return (FALSE);
} else {
if (IsExtensionFunctor((Functor)d0)) {
switch(d0) {
case (CELL)FunctorDBRef:
return(pt0 == pt1);
case (CELL)FunctorLongInt:
return(pt0[1] == pt1[1]);
case (CELL)FunctorDouble:
return(FloatOfTerm(AbsAppl(pt0)) == FloatOfTerm(AbsAppl(pt1)));
case (CELL)FunctorString:
return(strcmp( (const char *)(pt0+2), (const char *)(pt1+2)) == 0);
#ifdef USE_GMP
case (CELL)FunctorBigInt:
return(Yap_gmp_tcmp_big_big(AbsAppl(pt0),AbsAppl(pt0)) == 0);
#endif /* USE_GMP */
default:
return(FALSE);
}
}
return (OCUnify_complex(pt0, pt0 + ArityOfFunctor((Functor) d0),
pt1));
}
} else {
return(FALSE);
}
deref_body(d1, pt1, oc_unify_nvar_unk, oc_unify_nvar_nvar);
/* d0 is bound and d1 is unbound */
YapBind(pt1, d0);
/* local variables cannot be in a term */
if (pt1 > HR && pt1 < LCL0)
return TRUE;
if (rational_tree(d0))
return(FALSE);
return (TRUE);
deref_body(d0, pt0, oc_unify_unk, oc_unify_nvar);
/* pt0 is unbound */
deref_head(d1, oc_unify_var_unk);
oc_unify_var_nvar:
/* pt0 is unbound and d1 is bound */
YapBind(pt0, d1);
/* local variables cannot be in a term */
if (pt0 > HR && pt0 < LCL0)
return TRUE;
if (rational_tree(d1))
return(FALSE);
return (TRUE);
deref_body(d1, pt1, oc_unify_var_unk, oc_unify_var_nvar);
/* d0 and pt1 are unbound */
UnifyCells(pt0, pt1);
return (TRUE);
return (TRUE);
}
/**
* Syntax Error Handler
*
* @par tokptr: the sequence of tokens
* @par sno: the stream numbet
*
* Implicit arguments:
* +
*/
Term Yap_syntax_error(TokEntry *errtok, int sno) {
CACHE_REGS
Term info;
Term startline, errline, endline;
Term tf[4];
Term *tailp = tf + 3;
CELL *Hi = HR;
TokEntry *tok = LOCAL_tokptr;
Int cline = tok->TokPos;
startline = MkIntegerTerm(cline);
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos);
if (LOCAL_ErrorMessage)
tf[0] = MkStringTerm(LOCAL_ErrorMessage);
else
tf[0] = MkStringTerm("");
while (tok) {
Term ts[2];
if (HR > ASP - 1024) {
errline = MkIntegerTerm(0);
endline = MkIntegerTerm(0);
/* for some reason moving this earlier confuses gcc on solaris */
HR = Hi;
break;
}
if (tok->TokPos != cline) {
*tailp = MkPairTerm(TermNewLine, TermNil);
tailp = RepPair(*tailp) + 1;
cline = tok->TokPos;
}
if (tok == errtok && tok->Tok != Error_tok) {
*tailp = MkPairTerm(MkAtomTerm(AtomError), TermNil);
tailp = RepPair(*tailp) + 1;
}
info = tok->TokInfo;
switch (tok->Tok) {
case Name_tok: {
Term t0[1];
if (info) {
t0[0] = MkAtomTerm((Atom)info);
} else {
t0[0] = TermNil;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case QuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<QQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case WQuasiQuotes_tok: {
Term t0[2];
t0[0] = MkAtomTerm(Yap_LookupAtom("<WideQQ>"));
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomAtom, 1), 1, t0);
} break;
case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber, 1), 1, &(tok->TokInfo));
break;
case Var_tok: {
Term t[2];
VarEntry *varinfo = (VarEntry *)info;
t[0] = MkIntTerm(0);
t[1] = Yap_CharsToString(varinfo->VarRep, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomGVar, 2), 2, t);
} break;
case String_tok: {
Term t0 =
Yap_CharsToTDQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
if (!t0) {
return 0;
}
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case BQString_tok: {
Term t0 =
Yap_CharsToTBQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case WBQString_tok: {
Term t0 = Yap_WCharsToTBQ((wchar_t *)info, CurrentModule PASS_REGS);
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case Error_tok: {
ts[0] = MkAtomTerm(AtomError);
} break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(Yap_LookupAtom("EOT"));
break;
case Ponctuation_tok: {
char s[2];
s[1] = '\0';
if ((info) == 'l') {
s[0] = '(';
} else {
s[0] = (char)info;
}
ts[0] = MkAtomTerm(Yap_LookupAtom(s));
}
}
tok = tok->TokNext;
if (!tok)
break;
*tailp = MkPairTerm(ts[0], TermNil);
tailp = RepPair(*tailp) + 1;
}
{
Term t[3];
t[0] = startline;
t[1] = errline;
t[2] = endline;
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween, 3), 3, t);
}
/* 0: id */
/* 1: strat, error, end line */
/*2 msg */
/* file */
tf[2] = Yap_StreamUserName(sno);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
Term terr = Yap_MkApplTerm(FunctorSyntaxError, 4, tf);
Term tn[2];
tn[0] = Yap_MkApplTerm(FunctorShortSyntaxError, 1, &terr);
tn[1] = TermNil;
terr = Yap_MkApplTerm(FunctorError, 2, tn);
#if DEBUG
if (Yap_ExecutionMode == YAP_BOOT_MODE) {
fprintf(stderr, "SYNTAX ERROR while booting: ");
Yap_DebugPlWriteln(terr);
}
#endif
return terr;
}
int q_share_work(int worker_p) {
register tr_fr_ptr aux_tr;
register CELL aux_cell;
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (Get_REMOTE_prune_request(worker_p)) {
/* worker p with prune request */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
YAPOR_ERROR_CHECKING(q_share_work, OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr));
/* there is no pending prune with worker p at right --> safe move to worker p branch */
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
LOCAL_prune_request = NULL;
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
reset_trail(LOCAL_top_cp->cp_tr, TR);
TR = LOCAL_top_cp->cp_tr;
/* make sharing request */
LOCK_WORKER(worker_p);
if (BITMAP_member(GLOBAL_bm_idle_workers, worker_p) ||
REMOTE_share_request(worker_p) != MAX_WORKERS) {
/* worker p is idle or has another request */
UNLOCK_WORKER(worker_p);
return FALSE;
}
REMOTE_share_request(worker_p) = worker_id;
UNLOCK_WORKER(worker_p);
/* wait for an answer */
while (LOCAL_reply_signal == worker_ready);
if (LOCAL_reply_signal == no_sharing) {
/* sharing request refused */
LOCAL_reply_signal = worker_ready;
return FALSE;
}
/* install fase --> TR and LOCAL_top_cp->cp_tr are equal */
TR = ((choiceptr)LOCAL_end_local_copy)->cp_tr;
aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr;
NEW_MAHASH((ma_h_inner_struct *)H);
while (TR != aux_tr) {
aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
CELL *ptr = STACK_TO_SBA(aux_cell);
*ptr = TrailVal(aux_tr);
} else if ((ADDR) RepPair(aux_cell) >= HeapTop) {
/* avoid frozen segments */
aux_tr = (tr_fr_ptr) RepPair(aux_cell);
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(aux_cell)) {
CELL *cell_ptr = RepAppl(aux_cell);
if (!lookup_ma_var(cell_ptr)) {
/* first time we found the variable, let's put the new value */
CELL *ptr = STACK_TO_SBA(cell_ptr);
*ptr = TrailVal(aux_tr);
}
/* skip the old value */
aux_tr--;
}
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
/* update registers and return */
/* REMOTE_reply_signal(worker_p) = worker_ready; */
LOCAL_reply_signal = worker_ready;
PUT_IN_REQUESTABLE(worker_id);
TR = LOCAL_top_cp->cp_tr;
return TRUE;
}
static
void share_private_nodes(int worker_q) {
int depth;
choiceptr AuxB;
or_fr_ptr or_frame, previous_or_frame;
/* initialize auxiliary variables */
AuxB = B;
previous_or_frame = NULL;
depth = OrFr_depth(LOCAL_top_or_fr);
/* sharing loop */
while (AuxB != LOCAL_top_cp) {
depth++;
ALLOC_OR_FRAME(or_frame);
INIT_LOCK(OrFr_lock(or_frame));
OrFr_node(or_frame) = AuxB;
OrFr_alternative(or_frame) = AuxB->cp_ap;
OrFr_pend_prune_cp(or_frame) = NULL;
OrFr_nearest_leftnode(or_frame) = LOCAL_top_or_fr;
OrFr_qg_solutions(or_frame) = NULL;
BITMAP_clear(OrFr_members(or_frame));
BITMAP_insert(OrFr_members(or_frame), worker_id);
BITMAP_insert(OrFr_members(or_frame), worker_q);
if (AuxB->cp_ap && YAMOP_SEQ(AuxB->cp_ap)) {
AuxB->cp_ap = GETWORK_SEQ;
} else {
AuxB->cp_ap = GETWORK;
}
AuxB->cp_or_fr = or_frame;
AuxB = AuxB->cp_b;
if (previous_or_frame) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
previous_or_frame = or_frame;
}
/* initialize last or-frame pointer */
or_frame = AuxB->cp_or_fr;
if (previous_or_frame) {
OrFr_nearest_livenode(previous_or_frame) = OrFr_next(previous_or_frame) = or_frame;
}
/* update depth */
if (depth >= MAX_BRANCH_DEPTH)
Yap_Error(INTERNAL_ERROR, TermNil, "maximum depth exceded (share_private_nodes)");
or_frame = B->cp_or_fr;
while (or_frame != LOCAL_top_or_fr) {
unsigned int branch;
if (OrFr_alternative(or_frame)) {
branch = YAMOP_OR_ARG(OrFr_alternative(or_frame)) + 1;
} else {
branch = 1;
}
branch |= YAMOP_CUT_FLAG; /* in doubt, assume cut */
BRANCH(worker_id, depth) = BRANCH(worker_q, depth) = branch;
OrFr_depth(or_frame) = depth--;
or_frame = OrFr_next_on_stack(or_frame);
}
/* update old shared nodes */
while (or_frame != REMOTE_top_or_fr(worker_q)) {
LOCK_OR_FRAME(or_frame);
BRANCH(worker_q, OrFr_depth(or_frame)) = BRANCH(worker_id, OrFr_depth(or_frame));
BITMAP_insert(OrFr_members(or_frame), worker_q);
UNLOCK_OR_FRAME(or_frame);
or_frame = OrFr_next_on_stack(or_frame);
}
/* move conditional bindings to BA */
{
tr_fr_ptr top, tr_ptr;
top = LOCAL_top_cp->cp_tr;
tr_ptr = TR;
while (tr_ptr != top) {
CELL aux_cell = TrailTerm(--tr_ptr);
if (IsVarTerm(aux_cell) &&
((CELL *)aux_cell < B->cp_h || (choiceptr)aux_cell > B) &&
!((CELL *)aux_cell < H_FZ || (choiceptr)aux_cell > B_FZ)) {
CELL *ptr = STACK_TO_SBA(aux_cell);
*ptr = TrailVal(tr_ptr);
*(CELL *)aux_cell = (CELL)ptr;
} else if (IsPairTerm(aux_cell) && (ADDR) RepPair(aux_cell) > HeapTop) {
/* avoid frozen segments */
aux_cell = (CELL) RepPair(aux_cell);
tr_ptr = (tr_fr_ptr) aux_cell;
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else {
CELL *cell_ptr = RepAppl(aux_cell);
/* first do as a for a standard cell */
if ((cell_ptr < B->cp_h || cell_ptr > (CELL *)B) && !(cell_ptr < H_FZ || (choiceptr)cell_ptr > B_FZ)) {
CELL *ptr = STACK_TO_SBA(cell_ptr);
/* we may have several bindings in the trail */
if ((CELL)ptr != *cell_ptr) {
*ptr = TrailVal(tr_ptr);
*cell_ptr = (CELL)ptr;
}
}
/* but we also need to skip the old value */
tr_ptr--;
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
}
}
/* update frozen registers */
B_FZ = B;
H_FZ = B->cp_h;
TR_FZ = B->cp_tr;
/* update top shared nodes */
REMOTE_top_cp(worker_q) = LOCAL_top_cp = B;
REMOTE_top_or_fr(worker_q) = LOCAL_top_or_fr = LOCAL_top_cp->cp_or_fr;
/* update prune request */
if (LOCAL_prune_request) {
CUT_send_prune_request(worker_q, LOCAL_prune_request);
}
/* update load and return */
REMOTE_load(worker_q) = LOCAL_load = 0;
}
int q_share_work(int worker_p) {
register tr_fr_ptr aux_tr;
register CELL aux_cell;
LOCK_OR_FRAME(LOCAL_top_or_fr);
if (REMOTE_prune_request(worker_p)) {
/* worker p with prune request */
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
YAPOR_ERROR_CHECKING(q_share_work, Get_OrFr_pend_prune_cp(LOCAL_top_or_fr) && BRANCH_LTT(worker_p, OrFr_depth(LOCAL_top_or_fr)) < OrFr_pend_prune_ltt(LOCAL_top_or_fr));
/* there is no pending prune with worker p at right --> safe move to worker p branch */
CUT_reset_prune_request();
if(Get_LOCAL_prune_request()){
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
return FALSE;
}
BRANCH(worker_id, OrFr_depth(LOCAL_top_or_fr)) = BRANCH(worker_p, OrFr_depth(LOCAL_top_or_fr));
UNLOCK_OR_FRAME(LOCAL_top_or_fr);
/* unbind variables */
aux_tr = LOCAL_top_cp->cp_tr;
TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr);
while (aux_tr != TR) {
aux_cell = TrailTerm(--TR);
/* check for global or local variables */
if (IsVarTerm(aux_cell)) {
RESET_VARIABLE(aux_cell);
#ifdef TABLING
} else if (IsPairTerm(aux_cell)) {
aux_cell = (CELL) RepPair(aux_cell);
if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) {
/* avoid frozen segments */
TR = (tr_fr_ptr) aux_cell;
TABLING_ERROR_CHECKING(q_share_work, TR > (tr_fr_ptr) LOCAL_TrailTop);
TABLING_ERROR_CHECKING(q_share_work, TR < aux_tr);
}
#endif /* TABLING */
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(aux_cell)) {
CELL *aux_ptr = RepAppl(aux_cell);
Term aux_val = TrailTerm(--aux_tr);
*aux_ptr = aux_val;
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
}
OPTYAP_ERROR_CHECKING(q_share_work, LOCAL_top_cp != LOCAL_top_cp_on_stack);
OPTYAP_ERROR_CHECKING(q_share_work, YOUNGER_CP(B_FZ, LOCAL_top_cp));
YAPOR_ERROR_CHECKING(q_share_work, LOCAL_reply_signal != worker_ready);
/* make sharing request */
LOCK_WORKER(worker_p);
if (BITMAP_member(GLOBAL_bm_idle_workers, worker_p) ||
REMOTE_share_request(worker_p) != MAX_WORKERS) {
/* worker p is idle or has another request */
UNLOCK_WORKER(worker_p);
return FALSE;
}
REMOTE_share_request(worker_p) = worker_id;
UNLOCK_WORKER(worker_p);
/* wait for an answer */
while (LOCAL_reply_signal == worker_ready);
if (LOCAL_reply_signal == no_sharing) {
/* sharing request refused */
LOCAL_reply_signal = worker_ready;
return FALSE;
}
/* copy trail stack ? */
LOCK(LOCAL_lock_signals);
if (LOCAL_p_fase_signal > trail) {
LOCAL_q_fase_signal = trail;
UNLOCK(LOCAL_lock_signals);
Q_COPY_TRAIL_FROM(worker_p);
} else {
UNLOCK(LOCAL_lock_signals);
goto sync_with_p;
}
/* copy global stack ? */
LOCK(LOCAL_lock_signals);
if (LOCAL_p_fase_signal > global) {
LOCAL_q_fase_signal = global;
UNLOCK(LOCAL_lock_signals);
Q_COPY_GLOBAL_FROM(worker_p);
} else {
UNLOCK(LOCAL_lock_signals);
goto sync_with_p;
}
/* copy local stack ? */
while (LOCAL_reply_signal < nodes_shared);
LOCK(LOCAL_lock_signals);
if (LOCAL_p_fase_signal > local) {
LOCAL_q_fase_signal = local;
UNLOCK(LOCAL_lock_signals);
Q_COPY_LOCAL_FROM(worker_p);
} else UNLOCK(LOCAL_lock_signals);
sync_with_p:
#ifdef TABLING
REMOTE_reply_signal(worker_p) = worker_ready;
#else
REMOTE_reply_signal(worker_p) = copy_done;
#endif /* TABLING */
while (LOCAL_reply_signal != copy_done);
#if INCREMENTAL_COPY
/* install fase --> TR and LOCAL_top_cp->cp_tr are equal */
aux_tr = ((choiceptr) LOCAL_start_local_copy)->cp_tr;
TR = ((choiceptr) LOCAL_end_local_copy)->cp_tr;
Yap_NEW_MAHASH((ma_h_inner_struct *)HR);
while (TR != aux_tr) {
aux_cell = TrailTerm(--aux_tr);
if (IsVarTerm(aux_cell)) {
if (aux_cell < LOCAL_start_global_copy || EQUAL_OR_YOUNGER_CP((choiceptr)LOCAL_end_local_copy, (choiceptr)aux_cell)) {
YAPOR_ERROR_CHECKING(q_share_work, (CELL *)aux_cell < H0);
YAPOR_ERROR_CHECKING(q_share_work, (ADDR)aux_cell > LOCAL_LocalBase);
#ifdef TABLING
*((CELL *) aux_cell) = TrailVal(aux_tr);
#else
*((CELL *) aux_cell) = *((CELL *) (worker_offset(worker_p) + aux_cell));
#endif /* TABLING */
}
#ifdef TABLING
} else if (IsPairTerm(aux_cell)) {
aux_cell = (CELL) RepPair(aux_cell);
if (IN_BETWEEN(LOCAL_TrailBase, aux_cell, LOCAL_TrailTop)) {
/* avoid frozen segments */
aux_tr = (tr_fr_ptr) aux_cell;
}
#endif /* TABLING */
#ifdef MULTI_ASSIGNMENT_VARIABLES
} else if (IsApplTerm(aux_cell)) {
CELL *cell_ptr = RepAppl(aux_cell);
if (((CELL *)aux_cell < LOCAL_top_cp->cp_h ||
EQUAL_OR_YOUNGER_CP(LOCAL_top_cp, (choiceptr)aux_cell)) &&
!Yap_lookup_ma_var(cell_ptr)) {
/* first time we found the variable, let's put the new value */
#ifdef TABLING
*cell_ptr = TrailVal(aux_tr);
#else
*cell_ptr = *((CELL *) (worker_offset(worker_p) + (CELL)cell_ptr));
#endif /* TABLING */
}
/* skip the old value */
aux_tr--;
#endif /* MULTI_ASSIGNMENT_VARIABLES */
}
}
#endif /* incremental */
/* update registers and return */
PUT_OUT_ROOT_NODE(worker_id);
#ifndef TABLING
REMOTE_reply_signal(worker_p) = worker_ready;
#endif /* TABLING */
TR = (tr_fr_ptr) LOCAL_end_trail_copy;
LOCAL_reply_signal = worker_ready;
PUT_IN_REQUESTABLE(worker_id);
#ifdef TABLING
adjust_freeze_registers();
#endif /* TABLING */
return TRUE;
}
static Int
p_setarg( USES_REGS1 )
{
CELL ti = Deref(ARG1), ts = Deref(ARG2), t3 = Deref(ARG3);
Int i;
if (IsVarTerm(t3) &&
VarOfTerm(t3) > H &&VarOfTerm(t3) < ASP) {
/* local variable */
Term tn = MkVarTerm();
Bind_Local(VarOfTerm(t3), tn);
t3 = tn;
}
if (IsVarTerm(ti)) {
Yap_Error(INSTANTIATION_ERROR,ti,"setarg/3");
return FALSE;
} else {
if (IsIntTerm(ti))
i = IntOfTerm(ti);
else {
Term te = Yap_Eval(ti);
if (IsIntegerTerm(te)) {
i = IntegerOfTerm(te);
} else {
Yap_Error(TYPE_ERROR_INTEGER,ti,"setarg/3");
return FALSE;
}
}
}
if (IsVarTerm(ts)) {
Yap_Error(INSTANTIATION_ERROR,ts,"setarg/3");
} else if(IsApplTerm(ts)) {
CELL *pt;
if (IsExtensionFunctor(FunctorOfTerm(ts))) {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
if (i < 1 || i > (Int)ArityOfFunctor(FunctorOfTerm(ts))) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
if (i==0)
Yap_Error(DOMAIN_ERROR_NOT_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepAppl(ts)+i;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else if(IsPairTerm(ts)) {
CELL *pt;
if (i < 1 || i > 2) {
if (i<0)
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO,ts,"setarg/3");
return FALSE;
}
pt = RepPair(ts)+i-1;
/* the evil deed is to be done now */
MaBind(pt, t3);
} else {
Yap_Error(TYPE_ERROR_COMPOUND,ts,"setarg/3");
return FALSE;
}
return TRUE;
}
