static void
cp_unmark(Word p, int flags ARG_LD)
{ term_agenda agenda;
initTermAgenda(&agenda, 1, p);
while((p=nextTermAgenda(&agenda)))
{ again:
switch(tag(*p))
{ case TAG_ATTVAR:
{ if ( flags & COPY_ATTRS )
{ p = valPAttVar(*p);
goto again;
}
}
case TAG_VAR:
{ *p &= ~BOTH_MASK;
continue;
}
case TAG_COMPOUND:
{ Functor f = valueTerm(*p);
if ( visited(f->definition) )
{ f->definition &= ~BOTH_MASK;
pushWorkAgenda(&agenda, arityFunctor(f->definition), f->arguments);
continue;
}
}
}
}
clearTermAgenda(&agenda);
}
static inline void
exitCyclicCopy(int flags ARG_LD)
{ Word p;
while(popSegStack(&LD->cycle.lstack, &p, Word))
{ if ( isRef(*p) )
{ Word p2 = unRef(*p);
if ( *p2 == VAR_MARK ) /* sharing variables */
{ setVar(*p2);
setVar(*p);
} else
{ *p = *p2 | MARK_MASK; /* cyclic terms */
}
} else
{ Word old;
popSegStack(&LD->cycle.lstack, &old, Word);
if ( !(flags©_ATTRS) )
{ Word p2 = valPAttVar(*p & ~BOTH_MASK);
assert(*p2 == VAR_MARK);
setVar(*p2);
}
*p = consPtr(old, STG_GLOBAL|TAG_ATTVAR);
}
}
}
void
assignAttVar(Word av, Word value ARG_LD)
{ Word a;
assert(isAttVar(*av));
assert(!isRef(*value));
assert(gTop+7 <= gMax && tTop+6 <= tMax);
DEBUG(1, Sdprintf("assignAttVar(%s)\n", vName(av)));
if ( isAttVar(*value) )
{ if ( value > av )
{ Word tmp = av;
av = value;
value = tmp;
} else if ( av == value )
return;
}
a = valPAttVar(*av);
registerWakeup(a, value PASS_LD);
TrailAssignment(av);
if ( isAttVar(*value) )
{ DEBUG(1, Sdprintf("Unifying two attvars\n"));
*av = makeRef(value);
} else
*av = *value;
return;
}
int
PL_get_attr__LD(term_t t, term_t a ARG_LD)
{ Word p = valTermRef(t);
deRef(p);
if ( isAttVar(*p) )
{ Word ap = valPAttVar(*p);
*valTermRef(a) = makeRef(ap); /* reference, so we can assign */
succeed;
}
fail;
}
static int
mark_for_duplicate(Word p, int flags ARG_LD)
{ term_agenda agenda;
initTermAgenda(&agenda, 1, p);
while((p=nextTermAgenda(&agenda)))
{
again:
switch(tag(*p))
{ case TAG_ATTVAR:
{ if ( flags & COPY_ATTRS )
{ p = valPAttVar(*p);
goto again;
}
/*FALLTHROUGH*/
}
case TAG_VAR:
{ if ( virgin(*p) )
set_visited(*p);
else if ( visited_once(*p) )
set_shared(*p);
break;
}
case TAG_COMPOUND:
{ Functor t = valueTerm(*p);
int arity = arityFunctor(t->definition);
if ( virgin(t->definition) )
{ set_visited(t->definition);
} else
{ if ( visited_once(t->definition) )
set_shared(t->definition);
break;
}
if ( !pushWorkAgenda(&agenda, arity, t->arguments) )
return MEMORY_OVERFLOW;
continue;
}
}
}
clearTermAgenda(&agenda);
return TRUE;
}
void
assignAttVar(Word av, Word value, int flags ARG_LD)
{ Word a;
mark m;
assert(isAttVar(*av));
assert(!isRef(*value));
assert(gTop+8 <= gMax && tTop+6 <= tMax);
DEBUG(CHK_SECURE, assert(on_attvar_chain(av)));
DEBUG(1, Sdprintf("assignAttVar(%s)\n", vName(av)));
if ( isAttVar(*value) )
{ if ( value > av )
{ Word tmp = av;
av = value;
value = tmp;
} else if ( av == value )
return;
}
if( !(flags & ATT_ASSIGNONLY) )
{ a = valPAttVar(*av);
registerWakeup(av, a, value PASS_LD);
}
if ( (flags&ATT_WAKEBINDS) )
return;
Mark(m); /* must be trailed, even if above last choice */
LD->mark_bar = NO_MARK_BAR;
TrailAssignment(av);
DiscardMark(m);
if ( isAttVar(*value) )
{ DEBUG(1, Sdprintf("Unifying two attvars\n"));
*av = makeRef(value);
} else if ( isVar(*value) )
{ DEBUG(1, Sdprintf("Assigning attvar with plain var\n"));
*av = makeRef(value); /* JW: Does this happen? */
} else
*av = *value;
return;
}
static int
copy_term(Word from, Word to, int flags ARG_LD)
{ term_agendaLR agenda;
int rc = TRUE;
initTermAgendaLR(&agenda, 1, from, to);
while( nextTermAgendaLR(&agenda, &from, &to) )
{
again:
switch(tag(*from))
{ case TAG_REFERENCE:
{ Word p2 = unRef(*from);
if ( *p2 == VAR_MARK ) /* reference to a copied variable */
{ *to = makeRef(p2);
} else
{ from = p2; /* normal reference */
goto again;
}
continue;
}
case TAG_VAR:
{ if ( shared(*from) )
{ *to = VAR_MARK;
*from = makeRef(to);
TrailCyclic(from PASS_LD);
} else
{ setVar(*to);
}
continue;
}
case TAG_ATTVAR:
if ( flags©_ATTRS )
{ Word p = valPAttVar(*from);
if ( isAttVar(*p) ) /* already copied */
{ *to = makeRefG(p);
} else
{ Word attr;
if ( !(attr = alloc_attvar(PASS_LD1)) )
{ rc = GLOBAL_OVERFLOW;
goto out;
}
TrailCyclic(p PASS_LD);
TrailCyclic(from PASS_LD);
*from = consPtr(attr, STG_GLOBAL|TAG_ATTVAR);
*to = makeRefG(attr);
from = p;
to = &attr[1];
goto again;
}
} else
{ if ( shared(*from) )
{ Word p = valPAttVar(*from & ~BOTH_MASK);
if ( *p == VAR_MARK )
{ *to = makeRef(p);
} else
{ *to = VAR_MARK;
*from = consPtr(to, STG_GLOBAL|TAG_ATTVAR)|BOTH_MASK;
TrailCyclic(p PASS_LD);
TrailCyclic(from PASS_LD);
}
} else
{ setVar(*to);
}
}
continue;
case TAG_COMPOUND:
{ Functor ff = valueTerm(*from);
if ( isRef(ff->definition) )
{ *to = consPtr(unRef(ff->definition), TAG_COMPOUND|STG_GLOBAL);
continue;
}
if ( ground(ff->definition) )
{ *to = *from;
continue;
}
if ( shared(ff->definition) )
{ int arity = arityFunctor(ff->definition);
Functor ft;
if ( !(ft = (Functor)allocGlobalNoShift(arity+1)) )
{ rc = GLOBAL_OVERFLOW;
goto out;
}
ft->definition = ff->definition & ~BOTH_MASK;
ff->definition = makeRefG((Word)ft);
TrailCyclic(&ff->definition PASS_LD);
*to = consPtr(ft, TAG_COMPOUND|STG_GLOBAL);
if ( pushWorkAgendaLR(&agenda, arity, ff->arguments, ft->arguments) )
continue;
rc = MEMORY_OVERFLOW;
goto out;
} else /* unshared term */
{ int arity = arityFunctor(ff->definition);
Functor ft;
if ( !(ft = (Functor)allocGlobalNoShift(arity+1)) )
{ rc = GLOBAL_OVERFLOW;
goto out;
}
ft->definition = ff->definition & ~BOTH_MASK;
*to = consPtr(ft, TAG_COMPOUND|STG_GLOBAL);
if ( pushWorkAgendaLR(&agenda, arity, ff->arguments, ft->arguments) )
continue;
rc = MEMORY_OVERFLOW;
goto out;
}
}
default:
*to = *from;
continue;
}
}
out:
clearTermAgendaLR(&agenda);
return rc;
}
static int
mark_for_copy(Word p, int flags ARG_LD)
{ Word start = p;
int walk_ref = FALSE;
Word buf[1024];
segstack stack;
initSegStack(&stack, sizeof(Word), sizeof(buf), buf);
for(;;)
{ switch(tag(*p))
{ case TAG_ATTVAR:
{ if ( flags & COPY_ATTRS )
{ if ( !pushForMark(&stack, p, walk_ref) )
{ clearSegStack(&stack);
return MEMORY_OVERFLOW;
}
walk_ref = TRUE;
p = valPAttVar(*p);
continue;
}
/*FALLTHROUGH*/
}
case TAG_VAR:
{ if ( virgin(*p) )
set_visited(*p);
else if ( visited_once(*p) )
set_shared(*p);
break;
}
case TAG_REFERENCE:
{ if ( !pushForMark(&stack, p, walk_ref) )
{ clearSegStack(&stack);
return MEMORY_OVERFLOW;
}
walk_ref = TRUE;
deRef(p);
continue;
}
case TAG_COMPOUND:
{ Functor t = valueTerm(*p);
int arity = arityFunctor(t->definition);
if ( virgin(t->definition) )
{ set_visited(t->definition);
} else
{ if ( visited_once(t->definition) )
set_shared(t->definition);
break;
}
if ( arity >= 1 )
{ if ( !pushForMark(&stack, p, walk_ref) )
{ clearSegStack(&stack);
return MEMORY_OVERFLOW;
}
walk_ref = FALSE;
p = &t->arguments[arity-1]; /* last argument */
continue;
}
}
}
if ( p == start )
{ clearSegStack(&stack);
return TRUE;
}
while ( walk_ref )
{ popForMark(&stack, &p, &walk_ref);
if ( isAttVar(*p) )
{ Word ap = valPAttVar(*p);
unshare_attvar(ap PASS_LD);
}
if ( p == start )
{ clearSegStack(&stack);
return TRUE;
}
}
p--;
if ( tagex(*p) == (TAG_ATOM|STG_GLOBAL) )
{ popForMark(&stack, &p, &walk_ref);
update_ground(p PASS_LD);
}
}
}
Find the location of the value for the attribute named `name'. Return
TRUE if found or FALSE if not found, leaving vp pointing at the ATOM_nil
of the end of the list. Returns FALSE with *vp == NULL if the attribute
list is invalid.
Caller must ensure 4 cells space on global stack.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
static int
find_attr(Word av, atom_t name, Word *vp ARG_LD)
{ Word l;
deRef(av);
assert(isAttVar(*av));
l = valPAttVar(*av);
for(;;)
{ deRef(l);
if ( isNil(*l) )
{ *vp = l;
fail;
} else if ( isTerm(*l) )
{ Functor f = valueTerm(*l);
if ( f->definition == FUNCTOR_att3 )
{ Word n;
deRef2(&f->arguments[0], n);
if ( *n == name )