line numbers for clauses and clause properties

This commit is contained in:
Vítor Santos Costa 2013-11-05 17:59:19 +00:00
parent e06b160da2
commit 917d5ad75b
17 changed files with 374 additions and 192 deletions

View File

@ -1894,7 +1894,7 @@ Yap_absmi(int inp)
SET_ASP(YREG, E_CB*sizeof(CELL));
saveregs();
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
while ((t = Yap_FetchTermFromDB(cl->lusl.ClSource)) == 0L) {
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
@ -1967,7 +1967,7 @@ Yap_absmi(int inp)
LogUpdClause *cl = ClauseCodeToLogUpdClause(PREG);
saveregs();
if (!Yap_IUnify(ARG2, cl->ClSource->Entry)) {
if (!Yap_IUnify(ARG2, cl->lusl.ClSource->Entry)) {
setregs();
UNLOCKPE(8,PP);
#if defined(YAPOR) || defined(THREADS)

View File

@ -187,6 +187,7 @@ static char SccsId[] = "@(#)amasm.c 1.3 3/15/90";
#include "yapio.h"
#include "compile.h"
#include "clause.h"
#ifdef BEAM
#include"eam.h"
#endif
@ -3086,7 +3087,7 @@ do_pass(int pass_no, yamop **entry_codep, int assembling, int *clause_has_blobsp
cl_u->sc.ClFlags |= HasCutMask;
cl_u->sc.ClNext = NULL;
cl_u->sc.ClSize = size;
cl_u->sc.usc.ClPred = cip->CurrentPred;
cl_u->sc.usc.ClLine = Yap_source_line_no();
if (*clause_has_blobsp) {
cl_u->sc.ClFlags |= HasBlobsMask;
}
@ -3913,7 +3914,8 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
return NULL;
}
cl = (LogUpdClause *)((CODEADDR)x-(UInt)size);
cl->ClSource = x;
cl->lusl.ClSource = x;
x->ag.line_number = Yap_source_line_no();
cl->ClSize = osize;
cip->code_addr = (yamop *)cl;
} else if (mode == ASSEMBLING_CLAUSE &&
@ -3931,6 +3933,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
code_p = do_pass(1, &entry_code, mode, &clause_has_blobs, &clause_has_dbterm, cip, size PASS_REGS);
/* make sure we copy after second pass */
cl->usc.ClSource = x;
x->ag.line_number = Yap_source_line_no();
cl->ClSize = osize;
LOCAL_ProfEnd=code_p;
Yap_inform_profiler_of_clause(cl, LOCAL_ProfEnd, ap, GPROF_CLAUSE);
@ -3951,6 +3954,7 @@ Yap_assemble(int mode, Term t, PredEntry *ap, int is_fact, struct intermediates
Yap_LUClauseSpace += size;
} else {
((StaticClause *)(cip->code_addr))->ClSize = size;
((StaticClause *)(cip->code_addr))->ClFlags = 0;
Yap_ClauseSpace += size;
}
} else {

177
C/cdmgr.c
View File

@ -864,6 +864,7 @@ Yap_BuildMegaClause(PredEntry *ap)
mcl->ClNext = NULL;
cl =
ClauseCodeToStaticClause(ap->cs.p_code.FirstClause);
mcl->ClLine = cl->usc.ClLine;
ptr = mcl->ClCode;
while (TRUE) {
memcpy((void *)ptr, (void *)cl->ClCode, sz);
@ -937,7 +938,7 @@ split_megaclause(PredEntry *ap)
Yap_ClauseSpace += sizeof(StaticClause)+mcl->ClItemSize+(UInt)NEXTOP((yamop *)NULL,p);
new->ClFlags = StaticMask|FactMask;
new->ClSize = mcl->ClItemSize;
new->usc.ClPred = ap;
new->usc.ClLine = Yap_source_line_no();
new->ClNext = NULL;
memcpy((void *)new->ClCode, (void *)ptr, mcl->ClItemSize);
if (prev) {
@ -2280,14 +2281,14 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
clp->ClFlags |= LogUpdMask;
if (is_fact(t)) {
clp->ClFlags |= FactMask;
clp->ClSource = NULL;
clp->lusl.ClLine = Yap_source_line_no();
}
} else {
StaticClause *clp = ClauseCodeToStaticClause(cp);
clp->ClFlags |= StaticMask;
if (is_fact(t) && !(p->PredFlags & TabledPredFlag)) {
clp->ClFlags |= FactMask;
clp->usc.ClPred = p;
clp->usc.ClLine = Yap_source_line_no();
}
}
if (compile_mode)
@ -2352,7 +2353,7 @@ addclause(Term t, yamop *cp, int mode, Term mod, Term *t4ref)
}
#endif
} else {
tf = Yap_MkStaticRefTerm(ClauseCodeToStaticClause(cp));
tf = Yap_MkStaticRefTerm(ClauseCodeToStaticClause(cp), p);
}
if (*t4ref != TermNil) {
if (!Yap_unify(*t4ref,tf)) {
@ -2385,22 +2386,9 @@ Yap_EraseMegaClause(yamop *cl,PredEntry *ap) {
}
void
Yap_EraseStaticClause(StaticClause *cl, Term mod) {
PredEntry *ap;
Yap_EraseStaticClause(StaticClause *cl, PredEntry *ap, Term mod) {
/* ok, first I need to find out the parent predicate */
if (cl->ClFlags & FactMask) {
ap = cl->usc.ClPred;
} else {
Term t = ArgOfTerm(1,cl->usc.ClSource->Entry);
if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
ap = RepPredProp(Yap_GetPredPropByAtom(at, mod));
} else {
Functor fun = FunctorOfTerm(t);
ap = RepPredProp(Yap_GetPredPropByFunc(fun, mod));
}
}
if (ap->PredFlags & MegaClausePredFlag) {
split_megaclause(ap);
}
@ -4643,7 +4631,8 @@ fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr, ya
} else {
Term t;
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
while ((t = Yap_FetchClauseTermFromDB(cl->lusl.ClSource)) == 0L) {
if (first_time) {
ARG5 = th;
ARG6 = tb;
@ -4791,7 +4780,7 @@ fetch_next_lu_clause_erase(PredEntry *pe, yamop *i_code, Term th, Term tb, Term
Term t;
Int res;
while ((t = Yap_FetchTermFromDB(cl->ClSource)) == 0L) {
while ((t = Yap_FetchClauseTermFromDB(cl->lusl.ClSource)) == 0L) {
if (first_time) {
ARG5 = th;
ARG6 = tb;
@ -5091,7 +5080,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
UNLOCKPE(45,pe);
return TRUE;
}
rtn = Yap_MkStaticRefTerm(cl);
rtn = Yap_MkStaticRefTerm(cl, pe);
if (cl->ClFlags & FactMask) {
if (!Yap_unify(tb, MkAtomTerm(AtomTrue)) ||
!Yap_unify(tr, rtn)) {
@ -5124,17 +5113,17 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
if (!(pe->PredFlags & SourcePredFlag)) {
/* no source */
rtn = Yap_MkStaticRefTerm(cl);
rtn = Yap_MkStaticRefTerm(cl, pe);
UNLOCKPE(45,pe);
return Yap_unify(tr, rtn);
}
if (!(pe->PredFlags & SourcePredFlag)) {
rtn = Yap_MkStaticRefTerm(cl);
rtn = Yap_MkStaticRefTerm(cl, pe);
UNLOCKPE(45,pe);
return Yap_unify(tr, rtn);
}
while ((t = Yap_FetchTermFromDB(cl->usc.ClSource)) == 0L) {
while ((t = Yap_FetchClauseTermFromDB(cl->usc.ClSource)) == 0L) {
if (first_time) {
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -5172,7 +5161,7 @@ fetch_next_static_clause(PredEntry *pe, yamop *i_code, Term th, Term tb, Term tr
tr = ARG8;
}
}
rtn = Yap_MkStaticRefTerm(cl);
rtn = Yap_MkStaticRefTerm(cl, pe);
UNLOCKPE(45,pe);
if (!IsApplTerm(t) || FunctorOfTerm(t) != FunctorAssert) {
return(Yap_unify(th, t) &&
@ -5268,7 +5257,7 @@ p_nth_clause( USES_REGS1 )
return Yap_unify(Yap_MkMegaRefTerm(pe,(yamop *)cl), ARG4);
} else {
UNLOCK(pe->PELock);
return Yap_unify(Yap_MkStaticRefTerm((StaticClause *)cl), ARG4);
return Yap_unify(Yap_MkStaticRefTerm((StaticClause *)cl, pe), ARG4);
}
}
@ -6080,6 +6069,141 @@ p_dbassert( USES_REGS1 )
return store_dbcl_size((yamop *)((ADDR)mcl->ClCode+n*(mcl->ClItemSize)),pe->ArityOfPE,Deref(ARG1),pe);
}
#define CL_PROP_ERASED 0
#define CL_PROP_PRED 1
#define CL_PROP_FILE 2
#define CL_PROP_FACT 3
#define CL_PROP_LINE 4
#define CL_PROP_STREAM 5
/* instance(+Ref,?Term) */
static Int
p_instance_property( USES_REGS1 )
{
Term t1 = Deref(ARG1);
DBRef dbr;
Int op = IntOfTerm(Deref(ARG2));
if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
if (IsApplTerm(t1)) {
if (FunctorOfTerm(t1) == FunctorStaticClause) {
StaticClause *cl = Yap_ClauseFromTerm(t1);
if (op == CL_PROP_ERASED) {
if (cl->ClFlags & ErasedMask) {
if (!Yap_unify(ARG3, MkAtomTerm(AtomTrue)))
return FALSE;
} else {
if (!Yap_unify(ARG3, MkAtomTerm(AtomFalse)))
return FALSE;
}
}
if (op == CL_PROP_PRED || op == CL_PROP_FILE || op == CL_PROP_STREAM) {
PredEntry *ap = (PredEntry *)IntegerOfTerm(ArgOfTerm(2, t1));
if (!ap) {
return FALSE;
}
if (op == CL_PROP_FILE) {
if (ap->src.OwnerFile)
return Yap_unify(ARG3,MkAtomTerm(ap->src.OwnerFile));
else
return FALSE;
} else {
Term t[2];
if (ap->ArityOfPE == 0) {
t[1] = MkAtomTerm((Atom)ap->FunctorOfPred);
} else {
Functor nf = ap->FunctorOfPred;
UInt arity = ArityOfFunctor(nf);
Atom name = NameOfFunctor(nf);
t[0] = MkAtomTerm(name);
t[1] = MkIntegerTerm(arity);
t[1] = Yap_MkApplTerm(FunctorSlash, 2, t);
}
if (ap->ModuleOfPred == PROLOG_MODULE) {
t[0] = MkAtomTerm(AtomProlog);
} else {
t[0] = ap->ModuleOfPred;
}
return Yap_unify( ARG3, Yap_MkApplTerm(FunctorModule, 2, t) );
}
}
if (op == CL_PROP_FACT) {
if (cl->ClFlags & FactMask) {
return Yap_unify(ARG3, MkAtomTerm(AtomTrue));
} else {
return Yap_unify(ARG3, MkAtomTerm(AtomFalse));
}
}
if (op == CL_PROP_LINE) {
if (cl->ClFlags & FactMask) {
return Yap_unify(ARG3, MkIntTerm(cl->usc.ClLine));
} else {
return Yap_unify(ARG3, MkIntTerm(cl->usc.ClSource->ag.line_number));
}
}
}
}
} else if ((dbr = DBRefOfTerm(t1))->Flags & LogUpdMask) {
LogUpdClause *cl = (LogUpdClause *)dbr;
if (op == CL_PROP_ERASED) {
if (cl->ClFlags & ErasedMask) {
if (!Yap_unify(ARG3, MkAtomTerm(AtomTrue)))
return FALSE;
} else {
if (!Yap_unify(ARG3, MkAtomTerm(AtomFalse)))
return FALSE;
}
}
if (op == CL_PROP_PRED || op == CL_PROP_FILE) {
PredEntry *ap = cl->ClPred;
Term t[2];
if (op == CL_PROP_FILE) {
if (ap->src.OwnerFile)
return Yap_unify(ARG3,MkAtomTerm(ap->src.OwnerFile));
else
return FALSE;
}
if (ap->ArityOfPE == 0) {
t[1] = MkAtomTerm((Atom)ap->FunctorOfPred);
} else {
Functor nf = ap->FunctorOfPred;
UInt arity = ArityOfFunctor(nf);
Atom name = NameOfFunctor(nf);
t[0] = MkAtomTerm(name);
t[1] = MkIntegerTerm(arity);
t[1] = Yap_MkApplTerm(FunctorSlash, 2, t);
}
if (ap->ModuleOfPred == PROLOG_MODULE) {
t[0] = MkAtomTerm(AtomProlog);
} else {
t[0] = ap->ModuleOfPred;
}
return Yap_unify( ARG3, Yap_MkApplTerm(FunctorModule, 2, t) );
}
if (op == CL_PROP_FACT) {
if (cl->ClFlags & FactMask) {
return Yap_unify(ARG3, MkAtomTerm(AtomTrue));
} else {
return Yap_unify(ARG3, MkAtomTerm(AtomFalse));
}
}
if (op == CL_PROP_LINE) {
if (cl->ClFlags & FactMask) {
return Yap_unify(ARG3, MkIntTerm(cl->lusl.ClLine));
} else {
return Yap_unify(ARG3, MkIntTerm(cl->lusl.ClSource->ag.line_number));
}
}
}
return FALSE;
}
void
Yap_InitCdMgr(void)
@ -6142,6 +6266,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$static_pred_statistics", 5, p_static_pred_statistics, SyncPredFlag);
Yap_InitCPred("$p_nth_clause", 4, p_nth_clause, SyncPredFlag);
Yap_InitCPred("$program_continuation", 3, p_program_continuation, SafePredFlag|SyncPredFlag);
Yap_InitCPred("$instance_property", 3, p_instance_property, SafePredFlag|SyncPredFlag);
CurrentModule = HACKS_MODULE;
Yap_InitCPred("current_choicepoints", 1, p_all_choicepoints, 0);
Yap_InitCPred("current_continuations", 1, p_all_envs, 0);

View File

@ -197,7 +197,7 @@ static Int p_rcdz( USES_REGS1 );
static Int p_rcdzp( USES_REGS1 );
static Int p_drcdap( USES_REGS1 );
static Int p_drcdzp( USES_REGS1 );
static Term GetDBTerm(DBTerm * CACHE_TYPE);
static Term GetDBTerm(DBTerm *, int src CACHE_TYPE);
static DBProp FetchDBPropFromKey(Term, int, int, char *);
static Int i_recorded(DBProp,Term CACHE_TYPE);
static Int c_recorded(int CACHE_TYPE);
@ -1829,7 +1829,7 @@ new_lu_db_entry(Term t, PredEntry *pe)
ipc = cl->ClCode;
cl->Id = FunctorDBRef;
cl->ClFlags = LogUpdMask;
cl->ClSource = x;
cl->lusl.ClSource = x;
cl->ClRefCount = 0;
cl->ClPred = pe;
cl->ClExt = NULL;
@ -2314,7 +2314,7 @@ p_still_variant( USES_REGS1 )
if (Yap_op_from_opcode(cl->ClCode->opc) == _unify_idb_term) {
return TRUE;
} else {
dbt = cl->ClSource;
dbt = cl->lusl.ClSource;
}
} else {
if (old_tr == TR-1) {
@ -2451,7 +2451,7 @@ UnifyDBNumber(DBRef DBSP, Term t)
static Term
GetDBTerm(DBTerm *DBSP USES_REGS)
GetDBTerm(DBTerm *DBSP, int src USES_REGS)
{
Term t = DBSP->Entry;
@ -2492,7 +2492,7 @@ GetDBTerm(DBTerm *DBSP USES_REGS)
linkblk(lp, HOld-1, (CELL)HOld-(CELL)(DBSP->Contents));
}
#ifdef COROUTINING
if (DBSP->ag.attachments != 0L) {
if (DBSP->ag.attachments != 0L && !src) {
if (!copy_attachments((CELL *)AdjustIDBPtr(DBSP->ag.attachments,(CELL)HOld-(CELL)(DBSP->Contents)) PASS_REGS)) {
H = HOld;
LOCAL_Error_TYPE = OUT_OF_ATTVARS_ERROR;
@ -2510,7 +2510,7 @@ GetDBTermFromDBEntry(DBRef DBSP USES_REGS)
{
if (DBSP->Flags & (DBNoVars | DBAtomic))
return DBSP->DBT.Entry;
return GetDBTerm(&(DBSP->DBT) PASS_REGS);
return GetDBTerm(&(DBSP->DBT), FALSE PASS_REGS);
}
static void
@ -4049,10 +4049,10 @@ complete_lu_erase(LogUpdClause *clau)
{
DBRef *cp;
if (clau->ClSource)
cp = clau->ClSource->DBRefs;
else
if (clau->ClFlags & FactMask)
cp = NULL;
else
cp = clau->lusl.ClSource->DBRefs;
if (CL_IN_USE(clau)) {
return;
}
@ -4501,7 +4501,7 @@ p_erase_clause( USES_REGS1 )
if (!IsDBRefTerm(t1)) {
if (IsApplTerm(t1)) {
if (FunctorOfTerm(t1) == FunctorStaticClause) {
Yap_EraseStaticClause(Yap_ClauseFromTerm(t1), Deref(ARG2));
Yap_EraseStaticClause(Yap_ClauseFromTerm(t1), (PredEntry *)IntegerOfTerm(ArgOfTerm(2,t1)), Deref(ARG2));
return TRUE;
}
if (FunctorOfTerm(t1) == FunctorMegaClause) {
@ -4602,13 +4602,12 @@ p_erased( USES_REGS1 )
}
static Int
static_instance(StaticClause *cl USES_REGS)
static_instance(StaticClause *cl, PredEntry *ap USES_REGS)
{
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 {
@ -4635,7 +4634,7 @@ static_instance(StaticClause *cl USES_REGS)
} else {
Term TermDB;
while ((TermDB = GetDBTerm(cl->usc.ClSource PASS_REGS)) == 0L) {
while ((TermDB = GetDBTerm(cl->usc.ClSource, TRUE PASS_REGS)) == 0L) {
/* oops, we are in trouble, not enough stack space */
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -4694,7 +4693,7 @@ p_instance( USES_REGS1 )
if (IsVarTerm(t1) || !IsDBRefTerm(t1)) {
if (IsApplTerm(t1)) {
if (FunctorOfTerm(t1) == FunctorStaticClause) {
return static_instance(Yap_ClauseFromTerm(t1) PASS_REGS);
return static_instance(Yap_ClauseFromTerm(t1), (PredEntry *)IntegerOfTerm(ArgOfTerm(2,t1)) PASS_REGS);
}
if (FunctorOfTerm(t1) == FunctorMegaClause) {
return mega_instance(Yap_MegaClauseFromTerm(t1), Yap_MegaClausePredicateFromTerm(t1) PASS_REGS);
@ -4717,7 +4716,7 @@ p_instance( USES_REGS1 )
UNLOCK(ap->PELock);
return FALSE;
}
if (cl->ClSource == NULL) {
if (cl->ClFlags & FactMask) {
if (ap->ArityOfPE == 0) {
UNLOCK(ap->PELock);
return Yap_unify(ARG2,MkAtomTerm((Atom)ap->FunctorOfPred));
@ -4754,10 +4753,12 @@ p_instance( USES_REGS1 )
opc = Yap_op_from_opcode(cl->ClCode->opc);
if (opc == _unify_idb_term) {
UNLOCK(ap->PELock);
return Yap_unify(ARG2, cl->ClSource->Entry);
return Yap_unify(ARG2, cl->lusl.ClSource->Entry);
} else {
Term TermDB;
while ((TermDB = GetDBTerm(cl->ClSource PASS_REGS)) == 0L) {
int in_cl = (opc != _copy_idb_term);
while ((TermDB = GetDBTerm(cl->lusl.ClSource, in_cl PASS_REGS)) == 0L) {
/* oops, we are in trouble, not enough stack space */
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -4809,10 +4810,13 @@ Yap_LUInstance(LogUpdClause *cl, UInt arity)
op_numbers opc = Yap_op_from_opcode(cl->ClCode->opc);
if (opc == _unify_idb_term) {
TermDB = cl->ClSource->Entry;
TermDB = cl->lusl.ClSource->Entry;
} else {
CACHE_REGS
while ((TermDB = GetDBTerm(cl->ClSource PASS_REGS)) == 0L) {
int in_src;
in_src = (opc != _copy_idb_term);
while ((TermDB = GetDBTerm(cl->lusl.ClSource, in_src PASS_REGS)) == 0L) {
/* oops, we are in trouble, not enough stack space */
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
@ -5052,14 +5056,22 @@ Term
Yap_FetchTermFromDB(DBTerm *ref)
{
CACHE_REGS
return GetDBTerm(ref PASS_REGS);
return GetDBTerm(ref, FALSE PASS_REGS);
}
Term
Yap_FetchClauseTermFromDB(DBTerm *ref)
{
CACHE_REGS
return GetDBTerm(ref, TRUE PASS_REGS);
}
Term
Yap_PopTermFromDB(DBTerm *ref)
{
CACHE_REGS
Term t = GetDBTerm(ref PASS_REGS);
Term t = GetDBTerm(ref, FALSE PASS_REGS);
if (t != 0L)
ReleaseTermFromDB(ref PASS_REGS);
return t;
@ -5269,7 +5281,7 @@ p_dequeue( USES_REGS1 )
else
father_key->FirstInQueue = cur_instance->next;
WRITE_UNLOCK(father_key->QRWLock);
while ((TDB = GetDBTerm(cur_instance->DBT PASS_REGS)) == 0L) {
while ((TDB = GetDBTerm(cur_instance->DBT, FALSE PASS_REGS)) == 0L) {
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
@ -5313,7 +5325,7 @@ p_dequeue_unlocked( USES_REGS1 )
cur_instance = father_key->FirstInQueue;
while (cur_instance) {
Term TDB;
while ((TDB = GetDBTerm(cur_instance->DBT PASS_REGS)) == 0L) {
while ((TDB = GetDBTerm(cur_instance->DBT, FALSE PASS_REGS)) == 0L) {
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {
@ -5370,7 +5382,7 @@ p_peek_queue( USES_REGS1 )
cur_instance = father_key->FirstInQueue;
while (cur_instance) {
Term TDB;
while ((TDB = GetDBTerm(cur_instance->DBT PASS_REGS)) == 0L) {
while ((TDB = GetDBTerm(cur_instance->DBT, FALSE PASS_REGS)) == 0L) {
if (LOCAL_Error_TYPE == OUT_OF_ATTVARS_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (!Yap_growglobal(NULL)) {

View File

@ -2340,7 +2340,7 @@ cls_head_info(ClauseDef *min, ClauseDef *max, UInt argno, int in_idb)
} else {
while (cl <= max) {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl->CurrentCode);
Term t = lcl->ClSource->Entry;
Term t = lcl->lusl.ClSource->Entry;
if (IsVarTerm(t)) {
cl->Tag = (CELL)NULL;

View File

@ -468,7 +468,7 @@ Yap_InitCPred(char *Name, unsigned long int Arity, CPredicate code, UInt flags)
cl->ClFlags = StaticMask;
cl->ClNext = NULL;
cl->ClSize = sz;
cl->usc.ClPred = pe;
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
}
}
@ -556,7 +556,7 @@ Yap_InitCmpPred(char *Name, unsigned long int Arity, CmpPredicate cmp_code, UInt
cl->ClFlags = StaticMask;
cl->ClNext = NULL;
cl->ClSize = sz;
cl->usc.ClPred = pe;
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
break;
}
@ -647,7 +647,7 @@ Yap_InitAsmPred(char *Name, unsigned long int Arity, int code, CPredicate def,
} else {
cl->ClSize = (CELL)NEXTOP(NEXTOP(NEXTOP(NEXTOP(NEXTOP(((yamop *)p_code),e),Osbpp),p),e),e);
}
cl->usc.ClPred = pe;
cl->usc.ClLine = Yap_source_line_no();
p_code = cl->ClCode;
pe->CodeOfPred = p_code;
if (!(flags & SafePredFlag)) {
@ -831,7 +831,7 @@ Yap_InitCPredBack(char *Name, unsigned long int Arity,
cl->ClSize =
(CELL)NEXTOP(NEXTOP(NEXTOP(code,OtapFs),OtapFs),e);
#endif
cl->usc.ClPred = pe;
cl->usc.ClLine = Yap_source_line_no();
code = cl->ClCode;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred =
@ -997,9 +997,8 @@ InitLogDBErasedMarker(void)
Yap_LUClauseSpace += sizeof(LogUpdClause)+(UInt)NEXTOP((yamop*)NULL,e);
Yap_heap_regs->logdb_erased_marker->Id = FunctorDBRef;
Yap_heap_regs->logdb_erased_marker->ClFlags = ErasedMask|LogUpdMask;
Yap_heap_regs->logdb_erased_marker->ClSource = NULL;
Yap_heap_regs->logdb_erased_marker->lusl.ClSource = NULL;
Yap_heap_regs->logdb_erased_marker->ClRefCount = 0;
Yap_heap_regs->logdb_erased_marker->ClPred = PredLogUpdClause;
Yap_heap_regs->logdb_erased_marker->ClExt = NULL;
Yap_heap_regs->logdb_erased_marker->ClPrev = NULL;
Yap_heap_regs->logdb_erased_marker->ClNext = NULL;
@ -1377,7 +1376,8 @@ Yap_InitWorkspace(UInt Heap, UInt Stack, UInt Trail, UInt Atts, UInt max_table_s
#if THREADS
/* don't forget this is a thread */
LOCAL_ThreadHandle.stack_address = LOCAL_GlobalBase;
LOCAL_ThreadHandle.ssize = Trail+Stack;
LOCAL_ThreadHandle.tsize = Trail;
LOCAL_ThreadHandle.ssize = Stack;
#endif
#endif
GLOBAL_AllowGlobalExpansion = TRUE;

View File

@ -1248,8 +1248,7 @@ setAccessLevel(access_level_t accept)
static bool
vsysError(const char *fm, va_list args)
{ GET_LD
static int active = 0;
{ static int active = 0;
switch ( active++ )
{ case 1:
@ -1310,7 +1309,17 @@ raiseSignal(PL_local_data_t *ld, int sig)
return FALSE;
}
Int
Yap_source_line_no( void )
{ GET_LD
return source_line_no;
}
Atom
Yap_source_file_name( void )
{ GET_LD
return YAP_AtomFromSWIAtom(source_file_name);
}
#if THREADS

View File

@ -521,6 +521,10 @@ void Yap_init_optyap_preds(void);
struct PL_local_data *Yap_InitThreadIO(int wid);
void Yap_flush(void);
/* pl-yap.c */
Int Yap_source_line_no( void );
Atom Yap_source_file_name( void );
static inline
yamop *
gc_P(yamop *p, yamop *cp)

View File

@ -826,7 +826,8 @@ typedef enum
LogUpdMask = 0x0200, /* logic update index. */
StaticMask = 0x0100, /* static predicates */
DirtyMask = 0x0080, /* LUIndices */
HasCutMask = 0x0040 /* ! */
HasCutMask = 0x0040, /* ! */
SrcMask = 0x0020, /* has a source term, only for static references */
/* other flags belong to DB */
} dbentry_flags;
@ -837,6 +838,7 @@ typedef struct DB_TERM
#ifdef COROUTINING
union {
CELL attachments; /* attached terms */
Int line_number;
struct DB_TERM *NextDBT;
} ag;
#endif
@ -1524,6 +1526,7 @@ void Yap_ErDBE(DBRef);
DBTerm *Yap_StoreTermInDB(Term, int);
DBTerm *Yap_StoreTermInDBPlusExtraSpace(Term, UInt, UInt *);
Term Yap_FetchTermFromDB(DBTerm *);
Term Yap_FetchClauseTermFromDB(DBTerm *);
Term Yap_PopTermFromDB(DBTerm *);
void Yap_ReleaseTermFromDB(DBTerm *);

View File

@ -73,7 +73,10 @@ typedef struct logic_upd_clause {
UInt ClRefCount;
/* data for clauses with environments */
yamop *ClExt;
DBTerm *ClSource;
union {
DBTerm *ClSource;
Int ClLine;
} lusl;
/* doubly linked list of clauses */
struct logic_upd_clause *ClPrev, *ClNext;
/* parent pointer */
@ -100,6 +103,7 @@ typedef struct dynamic_clause {
lockvar ClLock;
#endif
UInt ClSize;
Int ClLine;
UInt ClRefCount;
yamop *ClPrevious; /* immediate update clause */
/* The instructions, at least one of the form sl */
@ -122,8 +126,8 @@ typedef struct static_clause {
CELL ClFlags;
UInt ClSize;
union {
DBTerm *ClSource;
PredEntry *ClPred;
DBTerm *ClSource;
Int ClLine;
} usc;
struct static_clause *ClNext;
/* The instructions, at least one of the form sl */
@ -136,6 +140,7 @@ typedef struct static_mega_clause {
UInt ClSize;
PredEntry *ClPred;
UInt ClItemSize;
Int ClLine;
struct static_mega_clause *ClNext;
/* The instructions, at least one of the form sl */
yamop ClCode[MIN_ARRAY];
@ -268,7 +273,7 @@ void Yap_IPred(PredEntry *, UInt, yamop *);
int Yap_addclause(Term,yamop *,int,Term,Term*);
void Yap_add_logupd_clause(PredEntry *,LogUpdClause *,int);
void Yap_kill_iblock(ClauseUnion *,ClauseUnion *,PredEntry *);
void Yap_EraseStaticClause(StaticClause *, Term);
void Yap_EraseStaticClause(StaticClause *, PredEntry *, Term);
ClauseUnion *Yap_find_owner_index(yamop *, PredEntry *);
/* dbase.c */
@ -350,14 +355,15 @@ same_lu_block(yamop **paddr, yamop *p)
}
#endif
#define Yap_MkStaticRefTerm(cp) __Yap_MkStaticRefTerm((cp) PASS_REGS)
#define Yap_MkStaticRefTerm(cp, ap) __Yap_MkStaticRefTerm((cp), (ap) PASS_REGS)
static inline Term
__Yap_MkStaticRefTerm(StaticClause *cp USES_REGS)
__Yap_MkStaticRefTerm(StaticClause *cp, PredEntry *ap USES_REGS)
{
Term t[1];
Term t[2];
t[0] = MkIntegerTerm((Int)cp);
return Yap_MkApplTerm(FunctorStaticClause,1,t);
t[1] = MkIntegerTerm((Int)ap);
return Yap_MkApplTerm(FunctorStaticClause,2,t);
}
static inline StaticClause *

View File

@ -228,22 +228,24 @@
case _copy_idb_term:
if (regno == 2) {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl);
Term t = lcl->ClSource->Entry;
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
Term t = lcl->lusl.ClSource->Entry;
if (!(lcl->ClFlags & FactMask)) {
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
}
} else {
clause->Tag = (CELL)NULL;
}
@ -261,22 +263,24 @@
case _unify_idb_term:
if (regno == 2) {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl);
Term t = lcl->ClSource->Entry;
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
Term t = lcl->lusl.ClSource->Entry;
if (!(lcl->ClFlags & FactMask)) {
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
}
} else {
clause->Tag = (CELL)NULL;
}

View File

@ -212,27 +212,29 @@
clause->Tag = (CELL)NULL;
} else {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl);
Term t = lcl->ClSource->Entry;
Term t = lcl->lusl.ClSource->Entry;
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
if (!(lcl->ClFlags & FactMask)) {
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
} else {
clause->u.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
} else {
clause->u.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
}
}
return;
cl = NEXTOP(cl,e);
@ -245,27 +247,29 @@
clause->Tag = (CELL)NULL;
} else {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl);
Term t = lcl->ClSource->Entry;
Term t = lcl->lusl.ClSource->Entry;
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
if (!(lcl->ClFlags & FactMask)) {
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
} else {
clause->u.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
} else {
clause->u.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
}
}
return;
cl = NEXTOP(cl,e);

View File

@ -34,7 +34,7 @@ extern int Yap_read_term(term_t t, IOSTREAM *st, term_t *exc, term_t vs);
extern term_t Yap_fetch_module_for_format(term_t args, YAP_Term *modp);
extern IOENC Yap_DefaultEncoding(void);
extern void Yap_SetDefaultEncoding(IOENC);
extern void Yap_setCurrentSourceLocation(IOSTREAM **s);
extern void *Yap_GetStreamHandle(Atom at);
extern atom_t codeToAtom(int chrcode);

View File

@ -526,7 +526,7 @@ RestoreDBTerm(DBTerm *dbr, int attachments USES_REGS)
{
if (attachments) {
#ifdef COROUTINING
if (dbr->ag.attachments)
if (attachments == 1 && dbr->ag.attachments )
dbr->ag.attachments = AdjustDBTerm(dbr->ag.attachments, dbr->Contents, dbr->Contents, dbr->Contents+dbr->NOfCells);
#endif
} else {
@ -565,16 +565,9 @@ RestoreStaticClause(StaticClause *cl USES_REGS)
* clause for this predicate or not
*/
{
if (cl->usc.ClSource) {
char *x = (char *)DBTermAdjust(cl->usc.ClSource);
char *base = (char *)cl;
if (x < base || x >= base+cl->ClSize) {
cl->usc.ClPred = PtoPredAdjust(cl->usc.ClPred);
} else {
cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource);
RestoreDBTerm(cl->usc.ClSource, TRUE PASS_REGS);
}
if (cl->ClFlags & SrcMask) {
cl->usc.ClSource = DBTermAdjust(cl->usc.ClSource);
RestoreDBTerm(cl->usc.ClSource, 2 PASS_REGS);
}
if (cl->ClNext) {
cl->ClNext = PtoStCAdjust(cl->ClNext);
@ -643,9 +636,9 @@ RestoreLUClause(LogUpdClause *cl, PredEntry *pp USES_REGS)
if (cl->ClFlags & LogUpdRuleMask) {
cl->ClExt = PtoOpAdjust(cl->ClExt);
}
if (cl->ClSource) {
cl->ClSource = DBTermAdjust(cl->ClSource);
RestoreDBTerm(cl->ClSource, TRUE PASS_REGS);
if (!(cl->ClFlags & FactMask)) {
cl->lusl.ClSource = DBTermAdjust(cl->lusl.ClSource);
RestoreDBTerm(cl->lusl.ClSource, 2 PASS_REGS);
}
if (cl->ClPrev) {
cl->ClPrev = PtoLUCAdjust(cl->ClPrev);
@ -670,7 +663,7 @@ RestoreDBTermEntry(struct dbterm_list *dbl USES_REGS) {
dbl->next_dbl = PtoDBTLAdjust(dbl->next_dbl);
dbl->p = PredEntryAdjust(dbl->p);
while (dbt) {
RestoreDBTerm(dbt, FALSE PASS_REGS);
RestoreDBTerm(dbt, 0 PASS_REGS);
dbt = dbt->ag.NextDBT;
}
}
@ -913,7 +906,7 @@ RestoreLogDBErasedMarker__( USES_REGS1 )
PtoLUCAdjust(Yap_heap_regs->logdb_erased_marker);
Yap_heap_regs->logdb_erased_marker->Id = FunctorDBRef;
Yap_heap_regs->logdb_erased_marker->ClFlags = ErasedMask|LogUpdMask;
Yap_heap_regs->logdb_erased_marker->ClSource = NULL;
Yap_heap_regs->logdb_erased_marker->lusl.ClSource = NULL;
Yap_heap_regs->logdb_erased_marker->ClRefCount = 0;
Yap_heap_regs->logdb_erased_marker->ClPred = PredLogUpdClause;
Yap_heap_regs->logdb_erased_marker->ClExt = NULL;
@ -1049,7 +1042,7 @@ RestoreYapRecords__( USES_REGS1 )
ptr->next_rec = DBRecordAdjust(ptr->next_rec);
ptr->prev_rec = DBRecordAdjust(ptr->prev_rec);
ptr->dbrecord = DBTermAdjust(ptr->dbrecord);
RestoreDBTerm(ptr->dbrecord, FALSE PASS_REGS);
RestoreDBTerm(ptr->dbrecord, 0 PASS_REGS);
ptr = ptr->next_rec;
}
}
@ -1060,7 +1053,7 @@ RestoreBallTerm(int wid)
CACHE_REGS
if (LOCAL_BallTerm) {
LOCAL_BallTerm = DBTermAdjust(LOCAL_BallTerm);
RestoreDBTerm(LOCAL_BallTerm, TRUE PASS_REGS);
RestoreDBTerm(LOCAL_BallTerm, 1 PASS_REGS);
}
}
@ -1098,7 +1091,7 @@ RestoreDBEntry(DBRef dbr USES_REGS)
else
fprintf(stderr, " a var\n");
#endif
RestoreDBTerm(&(dbr->DBT), TRUE PASS_REGS);
RestoreDBTerm(&(dbr->DBT), 1 PASS_REGS);
if (dbr->Parent) {
dbr->Parent = (DBProp)AddrAdjust((ADDR)(dbr->Parent));
}
@ -1317,7 +1310,7 @@ restore_static_array(StaticArrayEntry *ae USES_REGS)
} else {
DBTerm *db = (DBTerm *)RepAppl(reg);
db = DBTermAdjust(db);
RestoreDBTerm(db, TRUE PASS_REGS);
RestoreDBTerm(db, 1 PASS_REGS);
base->tstore = AbsAppl((CELL *)db);
}
}
@ -1336,7 +1329,7 @@ restore_static_array(StaticArrayEntry *ae USES_REGS)
base++;
} else {
*base++ = reg = DBTermAdjust(reg);
RestoreDBTerm(reg, TRUE PASS_REGS);
RestoreDBTerm(reg, 1 PASS_REGS);
}
}
}

View File

@ -443,7 +443,7 @@ F Safe Safe 1
F SafeCallCleanup SafeCallCleanup 4
F Same Same 2
F Slash Slash 2
F StaticClause StaticClause 1
F StaticClause StaticClause 2
F Stream Stream 1
F StreamEOS EndOfStream 1
F StreamPos StreamPos 4

View File

@ -538,22 +538,24 @@ dump_action(unify(Who1,Who2), _, T, L) :-
dump_action(logical, _, _, L) :-
format(L,' if (regno == 2) {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl);
Term t = lcl->ClSource->Entry;
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
Term t = lcl->lusl.ClSource->Entry;
if (!(lcl->ClFlags & FactMask)) {
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
clause->u.c_sreg = pt;
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
}
} else {
clause->Tag = (CELL)NULL;
}
@ -684,27 +686,29 @@ dump_head_action(logical, _, _, L) :-
clause->Tag = (CELL)NULL;
} else {
LogUpdClause *lcl = ClauseCodeToLogUpdClause(cl);
Term t = lcl->ClSource->Entry;
Term t = lcl->lusl.ClSource->Entry;
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
if (!(lcl->ClFlags & FactMask)) {
if (IsVarTerm(t)) {
clause->Tag = (CELL)NULL;
} else if (IsApplTerm(t)) {
CELL *pt = RepAppl(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
} else {
clause->u.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsAppl((CELL *)pt[0]);
if (IsExtensionFunctor(FunctorOfTerm(t))) {
clause->u.t_ptr = t;
} else {
clause->u.c_sreg = pt;
}
} else if (IsPairTerm(t)) {
CELL *pt = RepPair(t);
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
clause->Tag = AbsPair(NULL);
clause->u.c_sreg = pt-1;
} else {
clause->Tag = t;
}
}
}
return;~n', []).

View File

@ -1079,3 +1079,17 @@ compile_predicates(Ps) :-
assert_static(Mod:(G:-B)),
'$add_all'(Cls, Mod).
clause_property(ClauseRef, file(FileName)) :-
'$instance_property'(ClauseRef, 2, FileName).
clause_property(ClauseRef, source(FileName)) :-
'$instance_property'(ClauseRef, 2, FileName).
clause_property(ClauseRef, line_count(LineNumber)) :-
'$instance_property'(ClauseRef, 4, LineNumber),
LineNumber > 0.
clause_property(ClauseRef, fact) :-
'$instance_property'(ClauseRef, 3, true).
clause_property(ClauseRef, erased) :-
'$instance_property'(ClauseRef, 0, true).
clause_property(ClauseRef, predicate(PredicateIndicator)) :-
'$instance_property'(ClauseRef, 1, PredicateIndicator).