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

a few more simple fixes 

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@935 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2003-11-24 00:00:43 +00:00
parent f5edbc8aa7
commit 2fc4750456
7 changed files with 127 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
C/absmi.c
View File

@ -1470,8 +1470,9 @@ Yap_absmi(int inp)
yamop *ipc = PREG;
while (go_on) {
go_on = FALSE;
op_numbers opnum = Yap_op_from_opcode(ipc->opc);
go_on = FALSE;
switch (opnum) {
#ifdef TABLING
case _table_answer_resolution:
@ -6569,11 +6570,8 @@ Yap_absmi(int inp)
JMPNext();
ENDBOp();
/* same as retry */
BOp(retry_killed, ld);
goto retry_label;
ENDBOp();
BOp(retry, ld);
retry_label:
CACHE_Y(B);
restore_yaam_regs(NEXTOP(PREG, ld));
@ -6590,12 +6588,51 @@ Yap_absmi(int inp)
JMPNext();
ENDBOp();
BOp(retry, ld);
CACHE_Y(B);
restore_yaam_regs(NEXTOP(PREG, ld));
restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG);
set_cut(S_YREG, B->cp_b);
#else
set_cut(S_YREG, B_YREG->cp_b);
#endif /* FROZEN_STACKS */
SET_BB(B_YREG);
ENDCACHE_Y();
PREG = PREG->u.ld.d;
JMPNext();
ENDBOp();
/* same as trust */
BOp(trust_killed, ld);
goto trust_label;
CACHE_Y(B);
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {
SCH_last_alternative(PREG, B_YREG);
restore_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B->cp_b);
}
else
#endif /* YAPOR */
{
pop_yaam_regs();
pop_at_least_one_arg(PREG->u.ld.s);
#ifdef FROZEN_STACKS
B_YREG = PROTECT_FROZEN_B(B_YREG);
#endif /* FROZEN_STACKS */
set_cut(S_YREG, B);
}
SET_BB(B_YREG);
ENDCACHE_Y();
PREG = PREG->u.ld.d;
JMPNext();
ENDBOp();
BOp(trust, ld);
trust_label:
CACHE_Y(B);
#ifdef YAPOR
if (SCH_top_shared_cp(B)) {

4
C/amasm.c
View File

@ -2080,7 +2080,7 @@ do_pass(void)
/* static clause */
if (pass_no) {
cl_u->sc.Id = FunctorDBRef;
cl_u->sc.ClFlags = 0;
cl_u->sc.ClFlags = StaticMask;
cl_u->sc.Owner = Yap_ConsultingFile();
if (clause_has_blobs) {
cl_u->sc.ClFlags |= HasBlobsMask;
@ -2687,7 +2687,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact)
}
H = h0;
cl = (StaticClause *)((CODEADDR)x-(UInt)size);
cl->ClSource = x;
cl->usc.ClSource = x;
code_addr = (yamop *)cl;
} else {
while ((code_addr = (yamop *) Yap_AllocCodeSpace(size)) == NULL) {

49
C/cdmgr.c
View File

@ -396,16 +396,16 @@ kill_static_child_indxs(StaticIndex *indx)
}
static void
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *parent, PredEntry *ap)
{
LogUpdIndex *ncl = c->ChildIndex;
if (cl != NULL &&
if (parent != NULL &&
!(c->ClFlags & ErasedMask)) {
if (c == cl->ChildIndex) {
cl->ChildIndex = c->SiblingIndex;
if (c == parent->ChildIndex) {
parent->ChildIndex = c->SiblingIndex;
} else {
LogUpdIndex *tcl = cl->ChildIndex;
LogUpdIndex *tcl = parent->ChildIndex;
while (tcl->SiblingIndex != c) {
tcl = tcl->SiblingIndex;
}
@ -421,32 +421,35 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
}
c->ClRefCount--;
/* check if we are still the main index */
if (cl == NULL &&
if (parent == NULL &&
ap->cs.p_code.TrueCodeOfPred == c->ClCode) {
RemoveMainIndex(ap);
}
if (!((c->ClFlags & InUseMask) || c->ClRefCount)) {
if (cl != NULL) {
cl->ClRefCount--;
if (cl->ClFlags & ErasedMask && cl->ClRefCount == 0) {
if (parent != NULL) {
parent->ClRefCount--;
if (parent->ClFlags & ErasedMask &&
!(parent->ClFlags & InUseMask) &&
parent->ClRefCount == 0) {
/* cool, I can erase the father too. */
if (cl->ClFlags & SwitchRootMask) {
kill_first_log_iblock(cl, NULL, ap);
if (parent->ClFlags & SwitchRootMask) {
kill_first_log_iblock(parent, NULL, ap);
} else {
kill_first_log_iblock(cl, cl->u.ParentIndex, ap);
kill_first_log_iblock(parent, parent->u.ParentIndex, ap);
}
}
}
decrease_log_indices(c, (yamop *)&(ap->cs.p_code.ExpandCode));
#ifdef DEBUG
{
LogUpdIndex *cl = DBErasedIList, *c0 = NULL;
while (cl != NULL) {
if (c == cl) {
LogUpdIndex *parent = DBErasedIList, *c0 = NULL;
while (parent != NULL) {
if (c == parent) {
if (c0) c0->SiblingIndex = c->SiblingIndex;
else DBErasedIList = c->SiblingIndex;
}
cl = cl->SiblingIndex;
c0 = parent;
parent = parent->SiblingIndex;
}
}
#endif
@ -458,11 +461,11 @@ kill_first_log_iblock(LogUpdIndex *c, LogUpdIndex *cl, PredEntry *ap)
#endif
c->ClFlags |= ErasedMask;
/* try to move up, so that we don't hold an index */
if (cl != NULL &&
cl->ClFlags & SwitchTableMask) {
c->u.ParentIndex = cl->u.ParentIndex;
cl->u.ParentIndex->ClRefCount++;
cl->ClRefCount--;
if (parent != NULL &&
parent->ClFlags & SwitchTableMask) {
c->u.ParentIndex = parent->u.ParentIndex;
parent->u.ParentIndex->ClRefCount++;
parent->ClRefCount--;
}
c->ChildIndex = NULL;
}
@ -1203,7 +1206,7 @@ addclause(Term t, yamop *cp, int mode, int mod)
if (IsAtomTerm(t) ||
FunctorOfTerm(t) != FunctorAssert) {
clp->ClFlags |= FactMask;
clp->ClSource = NULL;
clp->usc.ClPred = p;
}
}
if (compile_mode)
@ -3202,7 +3205,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
} else {
Term t;
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
while ((t = Yap_FetchTermFromDB(cl->usc.ClSource)) == 0L) {
if (first_time) {
if (!Yap_gc(4, YENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);

51
C/dbase.c
View File

@ -4201,12 +4201,55 @@ p_erased(void)
return (DBRefOfTerm(t)->Flags & ErasedMask);
}
static Int
static_instance(StaticClause *cl)
{
if (cl->ClFlags & ErasedMask) {
return FALSE;
}
if (cl->ClFlags & FactMask) {
PredEntry *ap = cl->usc.ClPred;
if (ap->ArityOfPE == 0) {
return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred));
} else {
Functor f = ap->FunctorOfPred;
UInt arity = ArityOfFunctor(ap->FunctorOfPred), i;
Term t2 = Deref(ARG2);
CELL *ptr;
if (IsVarTerm(t2)) {
Yap_unify(ARG2, (t2 = Yap_MkNewApplTerm(f,arity)));
} else if (!IsApplTerm(t2) || FunctorOfTerm(t2) != f) {
return FALSE;
}
ptr = RepAppl(t2)+1;
for (i=0; i<arity; i++) {
XREGS[i+1] = ptr[i];
}
CP = P;
YENV = ASP;
YENV[E_CB] = (CELL) B;
P = cl->ClCode;
return TRUE;
}
} else {
Term TermDB;
while ((TermDB = GetDBTerm(cl->usc.ClSource)) == 0L) {
/* oops, we are in trouble, not enough stack space */
if (!Yap_gc(2, ENV, P)) {
Yap_Error(OUT_OF_STACK_ERROR, TermNil, Yap_ErrorMessage);
return(FALSE);
}
}
return Yap_unify(ARG2, TermDB);
}
}
/* instance(+Ref,?Term) */
static Int
p_instance(void)
{
Term TermDB;
Term t1 = Deref(ARG1);
DBRef dbr;
@ -4222,7 +4265,9 @@ p_instance(void)
} else {
dbr = DBRefOfTerm(t1);
}
if (dbr->Flags & LogUpdMask) {
if (dbr->Flags & StaticMask) {
return static_instance((StaticClause *)dbr);
} else if (dbr->Flags & LogUpdMask) {
op_numbers opc;
LogUpdClause *cl = (LogUpdClause *)dbr;
@ -4259,6 +4304,7 @@ p_instance(void)
if (opc == _unify_idb_term) {
return Yap_unify(ARG2, cl->ClSource->Entry);
} else {
Term TermDB;
while ((TermDB = GetDBTerm(cl->ClSource)) == 0L) {
/* oops, we are in trouble, not enough stack space */
if (!Yap_gc(2, ENV, P)) {
@ -4269,6 +4315,7 @@ p_instance(void)
return Yap_unify(ARG2, TermDB);
}
} else {
Term TermDB;
while ((TermDB = GetDBTermFromDBEntry(dbr)) == 0L) {
/* oops, we are in trouble, not enough stack space */
if (!Yap_gc(2, ENV, P)) {

1
C/index.c
View File

@ -3962,6 +3962,7 @@ expand_index(PredEntry *ap) {
}
} else {
op_numbers op = Yap_op_from_opcode(alt->opc);
fprintf(stderr,"hello, %d\n", op);
if (op == _retry ||
op == _trust) {
last = PREVOP(alt->u.ld.d,ld);

5
C/tracer.c
View File

@ -115,10 +115,7 @@ low_level_trace(yap_low_level_port port, PredEntry *pred, CELL *args)
/* extern int gc_calls; */
vsc_count++;
if (vsc_count == 121085)
vsc_xstop = 1;
if (vsc_count < 121000LL)
return;
return;
#ifdef COMMENTED
if (port != enter_pred ||
!pred ||

5
H/clause.h
View File

@ -108,7 +108,10 @@ typedef struct static_clause {
/* A set of flags describing info on the clause */
Functor Id;
CELL ClFlags;
DBTerm *ClSource;
union {
DBTerm *ClSource;
PredEntry *ClPred;
} usc;
Atom Owner;
/* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY];