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

state

Browse Source
This commit is contained in:
Vitor Santos Costa
2018-06-14 11:27:43 +01:00
parent 59534a04f6
commit d2024c1aed
23 changed files with 1156 additions and 1125 deletions
Download Patch File Download Diff File Expand all files Collapse all files

442
C/stack.c
View File

@@ -67,13 +67,13 @@ static LogUpdIndex *find_owner_log_index(LogUpdIndex *, yamop *);
static StaticIndex *find_owner_static_index(StaticIndex *, yamop *);
#define IN_BLOCK(P, B, SZ) \
#define IN_BLOCK(P, B, SZ) \
((CODEADDR)(P) >= (CODEADDR)(B) && (CODEADDR)(P) < (CODEADDR)(B) + (SZ))
static PredEntry *get_pred(Term t, Term tmod, char *pname) {
Term t0 = t;
restart:
restart:
if (IsVarTerm(t)) {
Yap_Error(INSTANTIATION_ERROR, t0, pname);
return NULL;
@@ -268,8 +268,8 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
/* check first environments that are younger than our latest choicepoint */
if (check_everything && env_ptr) {
/*
I do not need to check environments for asserts,
only for retracts
I do not need to check environments for asserts,
only for retracts
*/
while (env_ptr && b_ptr > (choiceptr)env_ptr) {
yamop *cp = (yamop *)env_ptr[E_CP];
@@ -286,8 +286,7 @@ bool Yap_search_for_static_predicate_in_use(PredEntry *p,
if (b_ptr) {
pe = PredForChoicePt(b_ptr->cp_ap, NULL);
}
else
} else
return false;
if (pe == p) {
if (check_everything)
@@ -539,7 +538,8 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp,
}
/*
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry *pp) {
static bool put_clause_loc(yap_error_descriptor_t *t, void *clcode, PredEntry
*pp) {
CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) {
@@ -575,33 +575,33 @@ static Int find_code_in_clause(PredEntry *pp, yamop *codeptr, void **startp,
static Term clause_loc(void *clcode, PredEntry *pp) {
CACHE_REGS
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = clcode;
if (pp->PredFlags & LogUpdatePredFlag) {
LogUpdClause *cl = clcode;
if (cl->ClFlags & FactMask) {
return MkIntegerTerm(cl->lusl.ClLine);
} else {
return MkIntegerTerm(cl->lusl.ClSource->ag.line_number);
}
} else if (pp->PredFlags & DynamicPredFlag) {
// DynamicClause *cl;
// cl = ClauseCodeToDynamicClause(clcode);
return MkIntTerm(0);
} else if (pp->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
return MkIntTerm(mcl->ClLine);
if (cl->ClFlags & FactMask) {
return MkIntegerTerm(cl->lusl.ClLine);
} else {
StaticClause *cl;
cl = clcode;
if (cl->ClFlags & FactMask) {
return MkIntTerm(cl->usc.ClLine);
} else if (cl->ClFlags & SrcMask) {
return MkIntTerm(cl->usc.ClSource->ag.line_number);
} else
return MkIntTerm(0);
return MkIntegerTerm(cl->lusl.ClSource->ag.line_number);
}
} else if (pp->PredFlags & DynamicPredFlag) {
// DynamicClause *cl;
// cl = ClauseCodeToDynamicClause(clcode);
return MkIntTerm(0);
} else if (pp->PredFlags & MegaClausePredFlag) {
MegaClause *mcl = ClauseCodeToMegaClause(pp->cs.p_code.FirstClause);
return MkIntTerm(mcl->ClLine);
} else {
StaticClause *cl;
cl = clcode;
if (cl->ClFlags & FactMask) {
return MkIntTerm(cl->usc.ClLine);
} else if (cl->ClFlags & SrcMask) {
return MkIntTerm(cl->usc.ClSource->ag.line_number);
} else
return MkIntTerm(0);
}
return MkIntTerm(0);
}
@@ -614,15 +614,15 @@ static int cl_code_in_pred(PredEntry *pp, yamop *codeptr, void **startp,
if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
UNLOCK(pp->PELock);
return TRUE;
}
} else {
if (code_in_pred_s_index(
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
startp, endp)) {
UNLOCK(pp->PELock);
return TRUE;
}
@@ -659,16 +659,16 @@ static Int code_in_pred(PredEntry *pp, Atom *pat, UInt *parity,
if (pp->PredFlags & IndexedPredFlag) {
if (pp->PredFlags & LogUpdatePredFlag) {
if (code_in_pred_lu_index(
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
ClauseCodeToLogUpdIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
code_in_pred_info(pp, pat, parity);
UNLOCK(pp->PELock);
return -1;
}
} else {
if (code_in_pred_s_index(
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
ClauseCodeToStaticIndex(pp->cs.p_code.TrueCodeOfPred), codeptr,
NULL, NULL)) {
code_in_pred_info(pp, pat, parity);
UNLOCK(pp->PELock);
return -1;
@@ -821,8 +821,8 @@ static PredEntry *found_owner_op(yamop *pc, void **startp,
static PredEntry *found_expand(yamop *pc, void **startp,
void **endp USES_REGS) {
PredEntry *pp =
((PredEntry *)(Unsigned(pc) -
(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
((PredEntry *)(Unsigned(pc) -
(CELL)(&(((PredEntry *)NULL)->cs.p_code.ExpandCode))));
*startp = (CODEADDR) & (pp->cs.p_code.ExpandCode);
*endp = (CODEADDR)NEXTOP((yamop *)&(pp->cs.p_code.ExpandCode), e);
return pp;
@@ -898,19 +898,19 @@ static PredEntry *ClauseInfoForCode(yamop *codeptr, void **startp,
PredEntry *Yap_PredEntryForCode(yamop *codeptr, find_pred_type where_from,
void **startp, void **endp) {
CACHE_REGS
if (where_from == FIND_PRED_FROM_CP) {
PredEntry *pp = PredForChoicePt(codeptr, NULL);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else if (where_from == FIND_PRED_FROM_ENV) {
PredEntry *pp = EnvPreg(codeptr);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else {
return ClauseInfoForCode(codeptr, startp, endp PASS_REGS);
if (where_from == FIND_PRED_FROM_CP) {
PredEntry *pp = PredForChoicePt(codeptr, NULL);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else if (where_from == FIND_PRED_FROM_ENV) {
PredEntry *pp = EnvPreg(codeptr);
if (cl_code_in_pred(pp, codeptr, startp, endp)) {
return pp;
}
} else {
return ClauseInfoForCode(codeptr, startp, endp PASS_REGS);
}
return NULL;
}
@@ -1097,7 +1097,7 @@ static Int p_all_envs(USES_REGS1) {
static Term clause_info(yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
@@ -1121,22 +1121,21 @@ static Term clause_info(yamop *codeptr, PredEntry *pp) {
return Yap_MkApplTerm(FunctorModule, 2, ts);
}
yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *codeptr, PredEntry *pp) {
yap_error_descriptor_t *set_clause_info(yap_error_descriptor_t *t,
yamop *codeptr, PredEntry *pp) {
CACHE_REGS
Term ts[2];
Term ts[2];
void *begin;
if (pp->ArityOfPE == 0) {
t->prologPredName =
AtomName((Atom)pp->FunctorOfPred);
t->prologPredName = AtomName((Atom)pp->FunctorOfPred);
t->prologPredArity = 0;
} else {
t->prologPredName =
AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredName = AtomName(NameOfFunctor(pp->FunctorOfPred));
t->prologPredArity = pp->ArityOfPE;
}
t->prologPredModule =
(pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE
: "prolog");
(pp->ModuleOfPred ? RepAtom(AtomOfTerm(pp->ModuleOfPred))->StrOfAE
: "prolog");
t->prologPredFile = RepAtom(pp->src.OwnerFile)->StrOfAE;
if (codeptr->opc == UNDEF_OPCODE) {
t->prologPredFirstLine = 0;
@@ -1144,25 +1143,25 @@ yap_error_descriptor_t * set_clause_info(yap_error_descriptor_t *t, yamop *cod
t->prologPredLastLine = 0;
return t;
} else if (pp->cs.p_code.NOfClauses) {
if ((t->prologPredCl =
find_code_in_clause(pp, codeptr, &begin, NULL)) <= 0) {
if ((t->prologPredCl = find_code_in_clause(pp, codeptr, &begin, NULL)) <=
0) {
t->prologPredLine = 0;
} else {
t->prologPredLine = IntegerOfTerm(clause_loc(begin, pp));
}
if (pp->PredFlags & LogUpdatePredFlag) {
t->prologPredFirstLine = clause_loc(
ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine = clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause),
pp);
t->prologPredFirstLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.FirstClause), pp);
t->prologPredLastLine =
clause_loc(ClauseCodeToLogUpdClause(pp->cs.p_code.LastClause), pp);
} else {
t->prologPredFirstLine = IntegerOfTerm(
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
ts[0] = clause_loc(
ClauseCodeToStaticClause(pp->cs.p_code.FirstClause), pp));
t->prologPredLastLine = IntegerOfTerm(
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
ts[1] = clause_loc(ClauseCodeToStaticClause(pp->cs.p_code.LastClause),
pp));
}
return t;
} else {
@@ -1198,7 +1197,8 @@ static Term error_culprit(bool internal USES_REGS) {
return TermNil;
}
yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
yap_error_descriptor_t *
Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_REGS) {
PredEntry *pe;
void *startp, *endp;
// case number 1: Yap_Error called from built-in.
@@ -1212,32 +1212,32 @@ yap_error_descriptor_t * Yap_prolog_add_culprit(yap_error_descriptor_t *t PASS_R
PredEntry *pe = EnvPreg(curCP);
while (curCP != YESCODE) {
if (curENV ) {
pe = EnvPreg(curCP);
curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) {
break;
}
curCP = (yamop *)curENV[E_CP];
if (pe == NULL) {
pe = PredMetaCall;
}
if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))
return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
} else if (0) {
if ( curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE
&& curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe);
}
curB = curB->cp_b;
if (curENV) {
pe = EnvPreg(curCP);
curENV = (CELL *)(curENV[E_E]);
if (curENV < ASP || curENV >= LCL0) {
break;
}
curCP = (yamop *)curENV[E_CP];
if (pe == NULL) {
pe = PredMetaCall;
}
if (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag))
return set_clause_info(t, curCP, pe);
curCP = (yamop *)(curENV[E_CP]);
} else if (0) {
if (curB->cp_ap != NOCODE && curB->cp_ap != TRUSTFAILCODE &&
curB->cp_ap != FAILCODE) {
pe = curB->cp_ap->y_u.Otapl.p;
if (pe && (pe->ModuleOfPred || !(pe->PredFlags & HiddenPredFlag)))
return set_clause_info(t, curB->cp_ap, pe);
}
curB = curB->cp_b;
}
}
}
return NULL;
return NULL;
}
static Term all_calls(bool internal USES_REGS) {
@@ -1261,10 +1261,9 @@ static Term all_calls(bool internal USES_REGS) {
return Yap_MkApplTerm(f, 6, ts);
}
Term Yap_all_calls(void) {
CACHE_REGS
return all_calls(true PASS_REGS);
return all_calls(true PASS_REGS);
}
/**
@@ -1392,23 +1391,23 @@ void Yap_dump_code_area_for_profiler(void) {
while (pp != NULL) {
/* if (pp->ArityOfPE) {
fprintf(stderr,"%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
fprintf(stderr,"\%s/%d %p\n",
RepAtom(NameOfFunctor(pp->FunctorOfPred))->StrOfAE,
pp->ArityOfPE,
pp);
} else {
fprintf(stderr,"\%s %p\n",
RepAtom((Atom)(pp->FunctorOfPred))->StrOfAE,
pp);
}*/
add_code_in_pred(pp);
pp = pp->NextPredOfModule;
}
me = me->NextME;
}
Yap_inform_profiler_of_clause(
COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)),
GPROF_INIT_COMMA);
COMMA_CODE, FAILCODE, RepPredProp(Yap_GetPredPropByFunc(FunctorComma, 0)),
GPROF_INIT_COMMA);
Yap_inform_profiler_of_clause(FAILCODE, FAILCODE + 1,
RepPredProp(Yap_GetPredPropByAtom(AtomFail, 0)),
GPROF_INIT_FAIL);
@@ -1441,7 +1440,7 @@ static Int program_continuation(USES_REGS1) {
static Term BuildActivePred(PredEntry *ap, CELL *vect) {
CACHE_REGS
arity_t i;
arity_t i;
if (!ap->ArityOfPE) {
return MkAtomTerm((Atom)ap->FunctorOfPred);
@@ -1489,8 +1488,8 @@ static int UnifyPredInfo(PredEntry *pe, int start_arg USES_REGS) {
}
return Yap_unify(XREGS[start_arg], tmod) &&
Yap_unify(XREGS[start_arg + 1], tname) &&
Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity));
Yap_unify(XREGS[start_arg + 1], tname) &&
Yap_unify(XREGS[start_arg + 2], MkIntegerTerm(arity));
}
static Int ClauseId(yamop *ipc, PredEntry *pe) {
@@ -1512,7 +1511,7 @@ static Int env_info(USES_REGS1) {
/* pe = PREVOP(env_cp,Osbpp)->y_u.Osbpp.p0; */
taddr = MkIntegerTerm((Int)env);
return Yap_unify(ARG3, MkIntegerTerm((Int)env_cp)) &&
Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b);
Yap_unify(ARG2, taddr) && Yap_unify(ARG4, env_b);
}
static Int p_cpc_info(USES_REGS1) {
@@ -1521,7 +1520,7 @@ static Int p_cpc_info(USES_REGS1) {
pe = PREVOP(ipc, Osbpp)->y_u.Osbpp.p0;
return UnifyPredInfo(pe, 2 PASS_REGS) &&
Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe)));
Yap_unify(ARG5, MkIntegerTerm(ClauseId(ipc, pe)));
}
static Int p_choicepoint_info(USES_REGS1) {
@@ -1562,10 +1561,10 @@ static Int p_choicepoint_info(USES_REGS1) {
t = MkVarTerm();
} else
#endif /* DETERMINISTIC_TABLING */
{
pe = GEN_CP(cptr)->cp_pred_entry;
t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1));
}
{
pe = GEN_CP(cptr)->cp_pred_entry;
t = BuildActivePred(pe, (CELL *)(GEN_CP(B) + 1));
}
#else
pe = UndefCode;
t = MkVarTerm();
@@ -1701,8 +1700,8 @@ static Int p_choicepoint_info(USES_REGS1) {
}
}
return UnifyPredInfo(pe, 3 PASS_REGS) && Yap_unify(ARG2, taddr) &&
Yap_unify(ARG6, t) &&
Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe)));
Yap_unify(ARG6, t) &&
Yap_unify(ARG7, MkIntegerTerm(ClauseId(ncl, pe)));
}
static Int /* $parent_pred(Module, Name, Arity) */
@@ -1714,11 +1713,11 @@ parent_pred(USES_REGS1) {
Term module;
if (!PredForCode(P_before_spy, &at, &arity, &module, NULL)) {
return Yap_unify(ARG1, MkIntTerm(0)) &&
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0));
Yap_unify(ARG2, MkAtomTerm(AtomMetaCall)) &&
Yap_unify(ARG3, MkIntTerm(0));
}
return Yap_unify(ARG1, MkIntTerm(module)) &&
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
Yap_unify(ARG2, MkAtomTerm(at)) && Yap_unify(ARG3, MkIntTerm(arity));
}
void Yap_dump_stack(void);
@@ -1729,7 +1728,7 @@ static int hidden(Atom);
static int legal_env(CELL *CACHE_TYPE);
#define ONLOCAL(ptr) \
#define ONLOCAL(ptr) \
(CellPtr(ptr) > CellPtr(HR) && CellPtr(ptr) < CellPtr(LOCAL_LocalBase))
static int hidden(Atom at) {
@@ -1788,7 +1787,7 @@ static bool handled_exception(USES_REGS1) {
void Yap_dump_stack(void) {
CACHE_REGS
choiceptr b_ptr = B;
choiceptr b_ptr = B;
CELL *env_ptr = ENV;
char tp[256];
yamop *ipc = CP;
@@ -1797,23 +1796,83 @@ void Yap_dump_stack(void) {
/* check if handled */
if (handled_exception(PASS_REGS1))
return;
#if DEBUG
fprintf(stderr, "%% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
#if DEBU
fprintf(stderr, "\% YAP regs: P=%p, CP=%p, ASP=%p, H=%p, TR=%p, HeapTop=%p\n",
P, CP, ASP, HR, TR, HeapTop);
fprintf(stderr, "%% YAP mode: %ux\n", (unsigned int)LOCAL_PrologMode);
if (LOCAL_ErrorMessage)
fprintf(stderr, "%% LOCAL_ErrorMessage: %s\n", LOCAL_ErrorMessage);
#endif
fprintf(stderr, "\% \n% =====================================\n\%\n");
fprintf(stderr, "\% \n% YAP Status:\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
yap_error_descriptor_t errno = LOCAL_Error_TYPE;
yap_error_class_number classno = Yap_errorClass(errno);
fprintf(stderr, "\% Error STATUS: %s/%s\n\n", Yap_errorName(errno),
Yap_errorName(classno));
fprintf(stderr, "\% Execution mode\n");
if (LOCAL_PrologMode & BootMode)
fprintf(stderr, "\% Bootstrap\n");
if (LOCAL_PrologMode & UserMode)
fprintf(stderr, "\% User Prolo\n");
if (LOCAL_PrologMode & CritMode)
fprintf(stderr, "\% Exclusive Access Mode\n");
if (LOCAL_PrologMode & AbortMode)
fprintf(stderr, "\% Abort\n");
if (LOCAL_PrologMode & InterruptMode)
fprintf(stderr, "\% Interrupt\n");
if (LOCAL_PrologMode & InErrorMode)
fprintf(stderr, "\% Error\n");
if (LOCAL_PrologMode & ConsoleGetcMode)
fprintf(stderr, "\% Prompt Console\n");
if (LOCAL_PrologMode & ExtendStackMode)
fprintf(stderr, "\% Stack expansion \n");
if (LOCAL_PrologMode & GrowHeapMode)
fprintf(stderr, "\% Data Base Expansion\n");
if (LOCAL_PrologMode & GrowStackMode)
fprintf(stderr, "\% User Prolog\n");
if (LOCAL_PrologMode & GCMode)
fprintf(stderr, "\% Garbage Collection\n");
if (LOCAL_PrologMode & ErrorHandlingMode)
fprintf(stderr, "\% Error handler\n");
if (LOCAL_PrologMode & CCallMode)
fprintf(stderr, "\% System Foreign Code\n");
if (LOCAL_PrologMode & UnifyMode)
fprintf(stderr, "\% Off-line Foreign Code\n");
if (LOCAL_PrologMode & UserCCallMode)
fprintf(stderr, "\% User Foreig C\n");
if (LOCAL_PrologMode & MallocMode)
fprintf(stderr, "\% Heap Allocaror\n");
if (LOCAL_PrologMode & SystemMode)
fprintf(stderr, "\% Prolog Internals\n");
if (LOCAL_PrologMode & AsyncIntMode)
fprintf(stderr, "\% Async Interruot mode\n");
if (LOCAL_PrologMode & InReadlineMode)
fprintf(stderr, "\% Readline Console\n");
if (LOCAL_PrologMode & TopGoalMode)
fprintf(stderr, "\% Creating new query\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
fprintf(stderr, "\% \n% YAP Program :\n");
fprintf(stderr, "\% \n\% -------------------------------------\n\%\n");
fprintf(stderr, "\% Program Position\n\n", Yap_errorName(errno),
Yap_errorName(classno);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% Continuation: %s\n", (char *)HR);
Yap_detect_bug_location(B->cp_ap, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "\% Alternative: %s\n", (char *)HR);
if (HR > ASP || HR > LCL0) {
fprintf(stderr, "%% YAP ERROR: Global Collided against Local (%p--%p)\n",
fprintf(stderr, "\% YAP ERROR: Global Collided against Local (%p--%p)\n",
HR, ASP);
} else if (HeapTop > (ADDR)LOCAL_GlobalBase) {
fprintf(stderr,
"%% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
"\% YAP ERROR: Code Space Collided against Global (%p--%p)\n",
HeapTop, LOCAL_GlobalBase);
} else {
#if !USE_SYSTEM_MALLOC
fprintf(stderr, "%ldKB of Code Space (%p--%p)\n",
fprintf(stderr, "\%ldKB of Code Space (%p--%p)\n",
(long int)((CELL)HeapTop - (CELL)Yap_HeapBase) / 1024, Yap_HeapBase,
HeapTop);
#if USE_DL_MALLOC
@@ -1826,18 +1885,14 @@ void Yap_dump_stack(void) {
}
#endif
#endif
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%%\n%% PC: %s\n", (char *)HR);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
fprintf(stderr, "%% Continuation: %s\n", (char *)HR);
fprintf(stderr, "%% %luKB of Global Stack (%p--%p)\n",
fprintf(stderr, "\% %luKB of Global Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (HR - H0)) / 1024, H0, HR);
fprintf(stderr, "%% %luKB of Local Stack (%p--%p)\n",
fprintf(stderr, "\% %luKB of Local Stack (%p--%p)\n",
(unsigned long int)(sizeof(CELL) * (LCL0 - ASP)) / 1024, ASP, LCL0);
fprintf(stderr, "%% %luKB of Trail (%p--%p)\n",
fprintf(stderr, "\% %luKB of Trail (%p--%p)\n",
(unsigned long int)((ADDR)TR - LOCAL_TrailBase) / 1024,
LOCAL_TrailBase, TR);
fprintf(stderr, "%% Performed %ld garbage collections\n",
fprintf(stderr, "\% Performed %ld garbage collections\n",
(unsigned long int)LOCAL_GcCalls);
#if LOW_LEVEL_TRACER
{
@@ -1852,20 +1907,20 @@ void Yap_dump_stack(void) {
}
}
#endif
fprintf(stderr, "%% All Active Calls and\n");
fprintf(stderr, "%% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n");
fprintf(stderr, "\% All Active Calls and\n");
fprintf(stderr, "\% Goals With Alternatives Open (Global In "
"Use--Local In Use)\n%%\n");
while (b_ptr != NULL) {
while (env_ptr && env_ptr <= (CELL *)b_ptr) {
Yap_detect_bug_location(ipc, FIND_PRED_FROM_ENV, 256);
if (env_ptr == (CELL *)b_ptr && (choiceptr)env_ptr[E_CB] > b_ptr) {
b_ptr = b_ptr->cp_b;
fprintf(stderr, "%% %s\n", tp);
fprintf(stderr, "\% %s\n", tp);
} else {
fprintf(stderr, "%% %s\n", tp);
}
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "\% .....\n");
return;
}
ipc = (yamop *)(env_ptr[E_CP]);
@@ -1873,7 +1928,7 @@ void Yap_dump_stack(void) {
}
if (b_ptr) {
if (!max_count--) {
fprintf(stderr, "%% .....\n");
fprintf(stderr, "\%\** .....\n");
return;
}
if (b_ptr->cp_ap && /* tabling */
@@ -1882,7 +1937,7 @@ void Yap_dump_stack(void) {
b_ptr->cp_ap->opc != Yap_opcode(_Nstop)) {
/* we can safely ignore ; because there is always an upper env */
Yap_detect_bug_location(b_ptr->cp_ap, FIND_PRED_FROM_CP, 256);
fprintf(stderr, "%% %s (%luKB--%luKB)\n", tp,
fprintf(stderr, "\% %s (%luKB--%luKB)\n", tp,
(unsigned long int)((b_ptr->cp_h - H0) * sizeof(CELL) / 1024),
(unsigned long int)((ADDR)LCL0 - (ADDR)b_ptr) / 1024);
}
@@ -1947,7 +2002,7 @@ void DumpActiveGoals(USES_REGS1) {
op_numbers opnum;
if (!ONLOCAL(b_ptr) || b_ptr->cp_b == NULL)
break;
fprintf(stderr, "%p ", b_ptr);
fprintf(stderr, "\%p ", b_ptr);
pe = Yap_PredForChoicePt(b_ptr, &opnum);
if (opnum == _Nstop) {
fprintf(stderr, " ********** C-Code Interface Boundary ***********\n");
@@ -2035,33 +2090,34 @@ void Yap_detect_bug_location(yamop *yap_pc, int where_from, int psize) {
if ((cl = Yap_PredForCode(yap_pc, where_from, &pred_name, &pred_arity,
&pred_module)) == 0) {
/* system predicate */
fprintf(stderr, "%s", "meta-call");
fprintf(stderr, "\%s", "meta-call");
} else if (pred_module == 0) {
fprintf(stderr, "in prolog:%s/%lu", RepAtom(pred_name)->StrOfAE,
(unsigned long int)pred_arity);
} else if (cl < 0) {
fprintf(stderr, "%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
fprintf(stderr, "\%s:%s/%lu", RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity);
} else {
fprintf(stderr, "%s:%s/%lu at clause %lu",
fprintf(stderr, "\%s:%s/%lu at clause %lu",
RepAtom(AtomOfTerm(pred_module))->StrOfAE,
RepAtom(pred_name)->StrOfAE, (unsigned long int)pred_arity,
(unsigned long int)cl);
}
}
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop *codeptr, PredEntry *pe) {
static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p,
yamop *codeptr, PredEntry *pe) {
CACHE_REGS
if (pe->ModuleOfPred == PROLOG_MODULE)
p->prologPredModule = AtomName(AtomProlog);
else
p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred));
if (pe->ModuleOfPred == PROLOG_MODULE)
p->prologPredModule = AtomName(AtomProlog);
else
p->prologPredModule = AtomName(AtomOfTerm(pe->ModuleOfPred));
if (pe->ArityOfPE)
p->prologPredName = AtomName(NameOfFunctor(pe->FunctorOfPred));
else
p->prologPredName = AtomName((Atom)(pe->FunctorOfPred));
p->prologPredArity = pe->ArityOfPE;
p->prologPredFile = AtomName( pe->src.OwnerFile );
p->prologPredFile = AtomName(pe->src.OwnerFile);
p->prologPredLine = 0;
if (pe->src.OwnerFile) {
if (pe->PredFlags & MegaClausePredFlag) {
@@ -2095,23 +2151,23 @@ static yap_error_descriptor_t *add_bug_location(yap_error_descriptor_t *p, yamop
p->prologPredLine = 0;
}
}
}
else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
} else if (pe->OpcodeOfPred == UNDEF_OPCODE) {
p->prologPredFile = "undefined";
}
else {
} else {
// by default, user_input
p->prologPredFile = AtomName( AtomUserIn );
p->prologPredFile = AtomName(AtomUserIn);
p->prologPredLine = 0;
}
return p;
}
yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc0, void *b_ptr0, void *env0) {
yap_error_descriptor_t *Yap_pc_add_location(yap_error_descriptor_t *t,
void *pc0, void *b_ptr0,
void *env0) {
CACHE_REGS
yamop *xc = pc0;
yamop *xc = pc0;
// choiceptr b_ptr = b_ptr0;
//CELL *env = env0;
// CELL *env = env0;
PredEntry *pe;
if (PP == NULL) {
@@ -2122,13 +2178,15 @@ yap_error_descriptor_t * Yap_pc_add_location(yap_error_descriptor_t *t, void *pc
if (pe != NULL
// pe->ModuleOfPred != PROLOG_MODULE &&
// &&!(pe->PredFlags & HiddenPredFlag)
) {
) {
return add_bug_location(t, xc, pe);
}
return NULL;
}
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0, void *b_ptr0, void *env0, YAP_Int ignore_first) {
yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,
void *cp0, void *b_ptr0,
void *env0, YAP_Int ignore_first) {
yamop *cp = cp0;
choiceptr b_ptr = b_ptr0;
CELL *env = env0;
@@ -2139,18 +2197,18 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
if (pe == PredTrue)
return NULL;
if (ignore_first <= 0 &&
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(t, cp, pe);
} else {
if (NULL && b_ptr && b_ptr->cp_env < env) {
cp = b_ptr->cp_cp;
env = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
cp = b_ptr->cp_cp;
env = b_ptr->cp_env;
b_ptr = b_ptr->cp_b;
} else {
cp = (yamop *)env[E_CP];
env = ENV_Parent(env);
cp = (yamop *)env[E_CP];
env = ENV_Parent(env);
}
ignore_first--;
}
@@ -2158,15 +2216,10 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
}
/*
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first) {
while (true) {
if (b_ptr == NULL || env == NULL)
return TermNil;
PredEntry *pe = EnvPreg(cp);
if (pe == PredTrue)
return TermNil;
if (ignore_first <= 0 &&
pe
Term Yap_env_location(yamop *cp, choiceptr b_ptr, CELL *env, Int ignore_first)
{ while (true) { if (b_ptr == NULL || env == NULL) return TermNil; PredEntry
*pe = EnvPreg(cp); if (pe == PredTrue) return TermNil; if (ignore_first <= 0
&& pe
// pe->ModuleOfPred != PROLOG_MODULE &&s
&& !(pe->PredFlags & HiddenPredFlag)) {
return add_bug_location(cp, pe);
@@ -2185,30 +2238,25 @@ yap_error_descriptor_t *Yap_env_add_location(yap_error_descriptor_t *t,void *cp0
}
*/
static Term mkloc(yap_error_descriptor_t *t)
{
return TermNil;
}
static Term mkloc(yap_error_descriptor_t *t) { return TermNil; }
static Int clause_location(USES_REGS1) {
yap_error_descriptor_t t;
memset( &t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_pc_add_location(&t,P, B, ENV)), ARG1) &&
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 1)), ARG2);
memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_pc_add_location(&t, P, B, ENV)), ARG1) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 1)), ARG2);
}
static Int ancestor_location(USES_REGS1) {
yap_error_descriptor_t t;
memset( &t, 0, sizeof(yap_error_descriptor_t));
return
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 2)), ARG2) &&
Yap_unify(mkloc(Yap_env_add_location(&t,CP, B, ENV, 3)), ARG2);
memset(&t, 0, sizeof(yap_error_descriptor_t));
return Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 2)), ARG2) &&
Yap_unify(mkloc(Yap_env_add_location(&t, CP, B, ENV, 3)), ARG2);
}
void Yap_InitStInfo(void) {
CACHE_REGS
Term cm = CurrentModule;
Term cm = CurrentModule;
Yap_InitCPred("in_use", 2, in_use,
HiddenPredFlag | TestPredFlag | SafePredFlag | SyncPredFlag);