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

fix error handling;

Browse Source 
[] should complain if compiling over code in use


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@228 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2001-12-12 19:36:51 +00:00
parent 482875421f
commit 4cda9b3ad1
2 changed files with 67 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

104
C/cdmgr.c
View File

@ -39,7 +39,7 @@ STATIC_PROTO(void asserta_dynam_clause, (PredEntry *, CODEADDR));
STATIC_PROTO(void assertz_stat_clause, (PredEntry *, CODEADDR, int)); STATIC_PROTO(void assertz_stat_clause, (PredEntry *, CODEADDR, int));
STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, CODEADDR)); STATIC_PROTO(void assertz_dynam_clause, (PredEntry *, CODEADDR));
STATIC_PROTO(void expand_consult, (void)); STATIC_PROTO(void expand_consult, (void));
STATIC_PROTO(int not_was_reconsulted, (PredEntry *, int)); STATIC_PROTO(int not_was_reconsulted, (PredEntry *, Term, int));
#if EMACS #if EMACS
STATIC_PROTO(int last_clause_number, (PredEntry *)); STATIC_PROTO(int last_clause_number, (PredEntry *));
#endif #endif
@ -102,7 +102,7 @@ static_in_use(PredEntry *p, int check_everything)
return (FALSE); return (FALSE);
} }
if (STATIC_PREDICATES_MARKED) { if (STATIC_PREDICATES_MARKED) {
return (pflags & InUseMask); return (p->StateOfPred & InUseMask);
} else { } else {
/* This code does not work for YAPOR or THREADS!!!!!!!! */ /* This code does not work for YAPOR or THREADS!!!!!!!! */
return(search_for_static_predicate_in_use(p, TRUE /*check_everything*/)); return(search_for_static_predicate_in_use(p, TRUE /*check_everything*/));
@ -287,7 +287,7 @@ RemoveIndexation(PredEntry *ap)
RemoveLogUpdIndex(ClauseCodeToClause(ap->TrueCodeOfPred)); RemoveLogUpdIndex(ClauseCodeToClause(ap->TrueCodeOfPred));
else { else {
Clause *cl = ClauseCodeToClause(ap->TrueCodeOfPred); Clause *cl = ClauseCodeToClause(ap->TrueCodeOfPred);
if (static_in_use(ap, FALSE)) { if (static_in_use(ap, TRUE)) {
Int Arity = ap->ArityOfPE; Int Arity = ap->ArityOfPE;
ErrorMessage = ErrorSay; ErrorMessage = ErrorSay;
@ -342,6 +342,9 @@ retract_all(PredEntry *p)
int multifile_pred = p->PredFlags & MultiFileFlag; int multifile_pred = p->PredFlags & MultiFileFlag;
CODEADDR fclause = NIL, lclause = NIL; CODEADDR fclause = NIL, lclause = NIL;
if (static_in_use(p, TRUE)) {
}
q = p->FirstClause; q = p->FirstClause;
if (q != NIL) { if (q != NIL) {
do { do {
@ -733,7 +736,7 @@ static void expand_consult(void)
/* p was already locked */ /* p was already locked */
static int static int
not_was_reconsulted(PredEntry *p, int mode) not_was_reconsulted(PredEntry *p, Term t, int mode)
{ {
register consult_obj *fp; register consult_obj *fp;
Prop p0 = AbsProp((PropEntry *)p); Prop p0 = AbsProp((PropEntry *)p);
@ -748,8 +751,27 @@ not_was_reconsulted(PredEntry *p, int mode)
expand_consult(); expand_consult();
--ConsultSp; --ConsultSp;
ConsultSp->p = p0; ConsultSp->p = p0;
if (ConsultBase[1].mode) /* we are in reconsult mode */ if (ConsultBase[1].mode) /* we are in reconsult mode */ {
if (static_in_use(p, TRUE)) {
Int Arity = p->ArityOfPE;
ErrorMessage = ErrorSay;
Error_Term = t;
Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
if (Arity == 0)
sprintf(ErrorMessage, "predicate %s is in use", RepAtom((Atom)(p->FunctorOfPred))->StrOfAE);
else
sprintf(ErrorMessage,
#if SHORT_INTS
"predicate %s/%ld is in use",
#else
"predicate %s/%d is in use",
#endif
RepAtom(NameOfFunctor(p->FunctorOfPred))->StrOfAE, Arity);
return(FALSE);
}
retract_all(p); retract_all(p);
}
if (!(p->PredFlags & MultiFileFlag)) { if (!(p->PredFlags & MultiFileFlag)) {
p->OwnerFile = YapConsultingFile(); p->OwnerFile = YapConsultingFile();
} }
@ -769,13 +791,13 @@ addcl_permission_error(AtomEntry *ap, Int Arity)
Error_Term = t; Error_Term = t;
Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE; Error_TYPE = PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE;
if (Arity == 0) if (Arity == 0)
sprintf(ErrorMessage, "in use static predicate %s", ap->StrOfAE); sprintf(ErrorMessage, "static predicate %s is in use", ap->StrOfAE);
else else
sprintf(ErrorMessage, sprintf(ErrorMessage,
#if SHORT_INTS #if SHORT_INTS
"in use static predicate %s/%ld", "static predicate %s/%ld is in use",
#else #else
"in use static predicate %s/%d", "static predicate %s/%d is in use",
#endif #endif
ap->StrOfAE, Arity); ap->StrOfAE, Arity);
} }
@ -808,7 +830,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
PutValue(AtomAbol, TermNil); PutValue(AtomAbol, TermNil);
WRITE_LOCK(p->PRWLock); WRITE_LOCK(p->PRWLock);
/* we are redefining a prolog module predicate */ /* we are redefining a prolog module predicate */
if (mod != 0 && p->ModuleOfPred == 0) { if (p->ModuleOfPred == 0 && mod != 0) {
WRITE_UNLOCK(p->PRWLock); WRITE_UNLOCK(p->PRWLock);
addcl_permission_error(RepAtom(at), Arity); addcl_permission_error(RepAtom(at), Arity);
return; return;
@ -827,7 +849,7 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
if (p->PredFlags & SpiedPredFlag) if (p->PredFlags & SpiedPredFlag)
spy_flag = TRUE; spy_flag = TRUE;
if (mode == consult) if (mode == consult)
not_was_reconsulted(p, TRUE); not_was_reconsulted(p, t, TRUE);
if (!is_dynamic(p)) { if (!is_dynamic(p)) {
Clause *clp = ClauseCodeToClause(cp); Clause *clp = ClauseCodeToClause(cp);
clp->ClFlags |= StaticMask; clp->ClFlags |= StaticMask;
@ -998,7 +1020,7 @@ where_new_clause(pred_prop, mode)
{ {
PredEntry *p = RepPredProp(pred_prop); PredEntry *p = RepPredProp(pred_prop);
if (mode == consult && not_was_reconsulted(p, FALSE)) if (mode == consult && not_was_reconsulted(p, TermNil, FALSE))
return (1); return (1);
else else
return (last_clause_number(p) + 1); return (last_clause_number(p) + 1);
@ -1697,7 +1719,6 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
*/ */
while (b_ptr > (choiceptr)env_ptr) { while (b_ptr > (choiceptr)env_ptr) {
PredEntry *pe = EnvPreg(env_ptr[E_CP]); PredEntry *pe = EnvPreg(env_ptr[E_CP]);
if (p == pe) fprintf(stderr,"vsc: live environment\n");
if (p == pe) return(TRUE); if (p == pe) return(TRUE);
if (env_ptr != NULL) if (env_ptr != NULL)
env_ptr = (CELL *)(env_ptr[E_E]); env_ptr = (CELL *)(env_ptr[E_E]);
@ -1729,7 +1750,6 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p); pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p);
} }
if (pe == p) { if (pe == p) {
fprintf(stderr,"vsc: choice-point\n");
if (check_everything) return(TRUE); if (check_everything) return(TRUE);
READ_LOCK(pe->PRWLock); READ_LOCK(pe->PRWLock);
if (p->PredFlags & IndexedPredFlag) { if (p->PredFlags & IndexedPredFlag) {
@ -1754,21 +1774,16 @@ search_for_static_predicate_in_use(PredEntry *p, int check_everything)
static void static void
mark_pred(int mark, PredEntry *pe) mark_pred(int mark, PredEntry *pe)
{ {
/* if the predicate is static mark it */
if (pe->ModuleOfPred) {
WRITE_LOCK(pe->PRWLock); WRITE_LOCK(pe->PRWLock);
if (mark) { if (mark) {
/* if the predicate is static mark it */
if (!(pe->PredFlags & (BasicPredFlag|StandardPredFlag|DynamicPredFlag|CPredFlag)) &&
pe->ModuleOfPred != 0) {
pe->StateOfPred |= InUseMask; pe->StateOfPred |= InUseMask;
}
} else { } else {
if (!(pe->PredFlags & (BasicPredFlag|StandardPredFlag|DynamicPredFlag|CPredFlag)) && pe->StateOfPred &= ~InUseMask;
(pe->StateOfPred & InUseMask) &&
pe->ModuleOfPred != 0) {
pe->StateOfPred ^= InUseMask;
}
} }
WRITE_UNLOCK(pe->PRWLock); WRITE_UNLOCK(pe->PRWLock);
}
} }
/* go up the chain of choice_points and environments, /* go up the chain of choice_points and environments,
@ -1783,36 +1798,46 @@ do_toggle_static_predicates_in_use(int mask)
if (b_ptr == NULL) if (b_ptr == NULL)
return; return;
do { do {
PredEntry *pe;
/* check first environments that are younger than our latest choicepoint */ /* check first environments that are younger than our latest choicepoint */
while (b_ptr > (choiceptr)env_ptr) { while (b_ptr > (choiceptr)env_ptr) {
PredEntry *pe = EnvPreg(env_ptr[E_CP]); PredEntry *pe = EnvPreg(env_ptr[E_CP]);
if (pe != NIL) if (pe != NULL)
mark_pred(mask, pe); mark_pred(mask, pe);
env_ptr = (CELL *)(env_ptr[E_E]); env_ptr = (CELL *)(env_ptr[E_E]);
} }
/* now mark the choicepoint */ /* now mark the choicepoint */
{ {
PredEntry *pe;
op_numbers opnum; op_numbers opnum;
restart_cp:
opnum = op_from_opcode(b_ptr->cp_ap->opc); opnum = op_from_opcode(b_ptr->cp_ap->opc);
if (opnum == _or_else || opnum == _or_last) { switch(opnum) {
case _or_else:
case _or_last:
#ifdef YAPOR #ifdef YAPOR
pe = PredFromOr(b_ptr->cp_cp->u.ldl.bl); pe = PredFromOr(b_ptr->cp_cp->u.ldl.bl);
#else #else
pe = PredFromOr(b_ptr->cp_cp->u.sla.l2); pe = PredFromOr(b_ptr->cp_cp->u.sla.l2);
#endif /* YAPOR */ #endif /* YAPOR */
} else if (opnum == _Nstop) { break;
pe = NIL; case _Nstop:
} else { pe = NULL;
break;
case _retry_profiled:
opnum = op_from_opcode(NEXTOP(b_ptr->cp_ap,l)->opc);
goto restart_cp;
default:
pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p); pe = (PredEntry *)(b_ptr->cp_ap->u.ld.p);
} }
if (pe != NIL) if (pe != NULL)
mark_pred(mask, pe); mark_pred(mask, pe);
env_ptr = b_ptr->cp_env; env_ptr = b_ptr->cp_env;
b_ptr = b_ptr->cp_b; b_ptr = b_ptr->cp_b;
} }
} while (b_ptr != NULL); } while (b_ptr != NULL);
/* mark or unmark all predicates */
STATIC_PREDICATES_MARKED = mask;
} }
#endif #endif
@ -1842,8 +1867,6 @@ p_toggle_static_predicates_in_use(void)
mask = IntOfTerm(t); mask = IntOfTerm(t);
} }
do_toggle_static_predicates_in_use(mask); do_toggle_static_predicates_in_use(mask);
/* mark or unmark all predicates */
STATIC_PREDICATES_MARKED = mask;
#endif #endif
return(TRUE); return(TRUE);
} }
@ -1863,9 +1886,9 @@ code_in_pred(PredEntry *pp, Atom *pat, Int *parity, CODEADDR codeptr) {
codeptr <= pp->TrueCodeOfPred + SizeOfBlock(pp->TrueCodeOfPred)) { codeptr <= pp->TrueCodeOfPred + SizeOfBlock(pp->TrueCodeOfPred)) {
*parity = pp->ArityOfPE; *parity = pp->ArityOfPE;
if (pp->ArityOfPE) { if (pp->ArityOfPE) {
*pat = (Atom)(pp->FunctorOfPred);
} else {
*pat = NameOfFunctor(pp->FunctorOfPred); *pat = NameOfFunctor(pp->FunctorOfPred);
} else {
*pat = (Atom)(pp->FunctorOfPred);
} }
READ_UNLOCK(pp->PRWLock); READ_UNLOCK(pp->PRWLock);
return(-1); return(-1);
@ -1876,9 +1899,9 @@ code_in_pred(PredEntry *pp, Atom *pat, Int *parity, CODEADDR codeptr) {
/* we found it */ /* we found it */
*parity = pp->ArityOfPE; *parity = pp->ArityOfPE;
if (pp->ArityOfPE) { if (pp->ArityOfPE) {
*pat = (Atom)(pp->FunctorOfPred);
} else {
*pat = NameOfFunctor(pp->FunctorOfPred); *pat = NameOfFunctor(pp->FunctorOfPred);
} else {
*pat = (Atom)(pp->FunctorOfPred);
} }
READ_UNLOCK(pp->PRWLock); READ_UNLOCK(pp->PRWLock);
return(i); return(i);
@ -1895,20 +1918,21 @@ code_in_pred(PredEntry *pp, Atom *pat, Int *parity, CODEADDR codeptr) {
Int Int
PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) { PredForCode(CODEADDR codeptr, Atom *pat, Int *parity, SMALLUNSGN *pmodule) {
Int found; Int found = 0;
Int i_table; Int i_table;
for (i_table = 0; i_table < NoOfModules; ++i_table) { /* should we allow the user to see hidden predicates? */
for (i_table = NoOfModules-1; i_table >= 0; --i_table) {
PredEntry *pp = ModulePred[i_table]; PredEntry *pp = ModulePred[i_table];
while (pp != NULL) { while (pp != NULL) {
if ((found = code_in_pred(pp, pat, parity, codeptr)) != 0) { if ((found = code_in_pred(pp, pat, parity, codeptr)) != 0) {
break; *pmodule = i_table;
return(found);
} }
pp = pp->NextPredOfModule; pp = pp->NextPredOfModule;
} }
} }
/* should we allow the user to see hidden predicates? */ return(0);
return(found);
} }
static Int static Int

1
TO_DO
View File

@ -7,7 +7,6 @@ BEFORE 4.4:
- mask when installing. - mask when installing.
- debugger: leash(full). [-user]. a(X) :- call(setof(Z,call(c(Z)),X)). a(X) :- b(X). b(X) :- c(X). c(1). c(2). end_of_file. spy a/1. a(X). - debugger: leash(full). [-user]. a(X) :- call(setof(Z,call(c(Z)),X)). a(X) :- b(X). b(X) :- c(X). c(1). c(2). end_of_file. spy a/1. a(X).
- debugger: don't stop from within system code. - debugger: don't stop from within system code.
- error handling.
- reports from Nikos. - reports from Nikos.
TO CHECK: TO CHECK: