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

dynamic predicates with no clauses are not undefined, so

Browse Source 
they should not point at UNDEFCODE but at FAIL_CODE


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@636 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-10-14 16:25:38 +00:00
parent ca930d6321
commit 78923655b5
10 changed files with 90 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
C/cdmgr.c
View File

@ -364,8 +364,12 @@ retract_all(PredEntry *p, int in_use)
p->FirstClause = fclause;
p->LastClause = lclause;
if (fclause == NIL) {
p->OpcodeOfPred = UNDEF_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
if (p->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
p->OpcodeOfPred = FAIL_OPCODE;
} else {
p->OpcodeOfPred = UNDEF_OPCODE;
}
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
p->StatisticsForPred.NOfEntries = 0;
p->StatisticsForPred.NOfHeadSuccesses = 0;
p->StatisticsForPred.NOfRetries = 0;
@ -879,7 +883,8 @@ addclause(Term t, CODEADDR cp, int mode, int mod)
if (!(p->PredFlags & DynamicPredFlag)) {
add_first_static(p, cp, spy_flag);
/* make sure we have a place to jump to */
if (p->OpcodeOfPred == UNDEF_OPCODE) {
if (p->OpcodeOfPred == UNDEF_OPCODE ||
p->OpcodeOfPred == FAIL_OPCODE) { /* log updates */
p->CodeOfPred = p->TrueCodeOfPred;
p->OpcodeOfPred = ((yamop *)(p->CodeOfPred))->opc;
}
@ -1252,7 +1257,11 @@ p_purge_clauses(void)
}
} while (q1 != pred->LastClause);
pred->FirstClause = pred->LastClause = NIL;
pred->OpcodeOfPred = UNDEF_OPCODE;
if (pred->PredFlags & (DynamicPredFlag|LogUpdatePredFlag)) {
pred->OpcodeOfPred = FAIL_OPCODE;
} else {
pred->OpcodeOfPred = UNDEF_OPCODE;
}
pred->TrueCodeOfPred =
pred->CodeOfPred =
(CODEADDR)(&(pred->OpcodeOfPred));
@ -1304,7 +1313,8 @@ p_setspy(void)
WRITE_UNLOCK(pred->PRWLock);
return (FALSE);
}
if (pred->OpcodeOfPred == UNDEF_OPCODE) {
if (pred->OpcodeOfPred == UNDEF_OPCODE ||
pred->OpcodeOfPred == FAIL_OPCODE) {
WRITE_UNLOCK(pred->PRWLock);
return (FALSE);
}
@ -1541,6 +1551,35 @@ p_is_dynamic(void)
return(out);
}
static Int
p_pred_exists(void)
{ /* '$pred_exists'(+P,+M) */
PredEntry *pe;
Term t = Deref(ARG1);
Term t2 = Deref(ARG2);
Int out;
SMALLUNSGN mod = LookupModule(t2);
if (IsVarTerm(t)) {
return (FALSE);
} else if (IsAtomTerm(t)) {
Atom at = AtomOfTerm(t);
pe = RepPredProp(PredPropByAtom(at, mod));
} else if (IsApplTerm(t)) {
Functor fun = FunctorOfTerm(t);
pe = RepPredProp(PredPropByFunc(fun, mod));
} else
return (FALSE);
if (pe == NIL)
return (FALSE);
READ_LOCK(pe->PRWLock);
if (pe->PredFlags & HiddenPredFlag)
return(FALSE);
out = (pe->OpcodeOfPred != UNDEF_OPCODE);
READ_UNLOCK(pe->PRWLock);
return(out);
}
static Int
p_set_pred_module(void)
{ /* '$set_pred_module'(+P,+Mod) */
@ -2542,6 +2581,7 @@ InitCdMgr(void)
InitCPred("$purge_clauses", 2, p_purge_clauses, SafePredFlag|SyncPredFlag);
InitCPred("$in_use", 2, p_in_use, TestPredFlag | SafePredFlag|SyncPredFlag);
InitCPred("$is_dynamic", 2, p_is_dynamic, TestPredFlag | SafePredFlag);
InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag);
InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag);
InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag);
InitCPred("$optimizer_on", 0, p_optimizer_on, SafePredFlag|SyncPredFlag);

6
C/dbase.c
View File

@ -3318,7 +3318,7 @@ MyEraseClause(Clause *clau)
} else {
FreeCodeSpace(((char *) ClauseCodeToClause(pred->CodeOfPred)));
pred->LastClause = pred->FirstClause = NIL;
p->OpcodeOfPred = UNDEF_OPCODE;
p->OpcodeOfPred = FAIL_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred =
(CODEADDR)(&(p->OpcodeOfPred));
}
@ -3428,7 +3428,7 @@ PrepareToEraseLogUpdClause(Clause *clau, DBRef dbr)
p->StateOfPred = StaticMask;
}
} else {
p->OpcodeOfPred = UNDEF_OPCODE;
p->OpcodeOfPred = FAIL_OPCODE;
p->TrueCodeOfPred = p->CodeOfPred = (CODEADDR)(&(p->OpcodeOfPred));
}
} else {
@ -3514,7 +3514,7 @@ PrepareToEraseClause(Clause *clau, DBRef dbr)
/* nothing left here, let's clean the shop */
FreeCodeSpace(((char *) ClauseCodeToClause(pred->CodeOfPred)));
pred->LastClause = pred->FirstClause = NIL;
pred->OpcodeOfPred = UNDEF_OPCODE;
pred->OpcodeOfPred = FAIL_OPCODE;
pred->TrueCodeOfPred = pred->CodeOfPred =
(CODEADDR)(&(pred->OpcodeOfPred));
} else if (clau_code == pred->FirstClause) {

3
C/errors.c
View File

@ -300,7 +300,8 @@ cl_position(yamop *ptr)
fprintf(stderr," %s\n", tp);
}
static void dump_stack()
static void
dump_stack(void)
{
choiceptr b_ptr = B;
CELL *env_ptr = ENV;

1
C/init.c
View File

@ -818,6 +818,7 @@ InitCodes(void)
heap_regs->yescode.opc = opcode(_Ystop);
heap_regs->undef_op = opcode(_undef_p);
heap_regs->index_op = opcode(_index_pred);
heap_regs->fail_op = opcode(_op_fail);
heap_regs->nocode.opc = opcode(_Nstop);

4
H/Heap.h
View File

@ -10,7 +10,7 @@
* File: Heap.h *
* mods: *
* comments: Heap Init Structure *
* version: $Id: Heap.h,v 1.31 2002-09-23 17:06:12 vsc Exp $ *
* version: $Id: Heap.h,v 1.32 2002-10-14 16:25:33 vsc Exp $ *
*************************************************************************/
/* information that can be stored in Code Space */
@ -134,6 +134,7 @@ typedef struct various_codes {
char prompt[MAX_PROMPT];
OPCODE undef_op;
OPCODE index_op;
OPCODE fail_op;
yamop *retry_recorded_code,
*retry_recorded_k_code,
*retry_drecorded_code,
@ -352,6 +353,7 @@ typedef struct various_codes {
#define yap_flags heap_regs->yap_flags_field
#define UNDEF_OPCODE heap_regs->undef_op
#define INDEX_OPCODE heap_regs->index_op
#define FAIL_OPCODE heap_regs->fail_op
#define HashChain heap_regs->hash_chain
#define INT_KEYS_SIZE heap_regs->int_keys_size
#define INT_KEYS_TIMESTAMP heap_regs->int_keys_timestamp

1
H/rheap.h
View File

@ -68,6 +68,7 @@ restore_codes(void)
heap_regs->yescode.opc = opcode(_Ystop);
heap_regs->undef_op = opcode(_undef_p);
heap_regs->index_op = opcode(_index_pred);
heap_regs->fail_op = opcode(_op_fail);
heap_regs->nocode.opc = opcode(_Nstop);
#ifdef YAPOR
INIT_YAMOP_LTT(&(heap_regs->nocode), 1);

1
pl/boot.yap
View File

@ -840,7 +840,6 @@ not(A) :-
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
user:unknown_predicate_handler(G,M,NG), !,
'$execute'(M:NG).
'$undefp'([M|G]) :- '$is_dynamic'(G, M), !, fail.
'$undefp'([M|G]) :-
'$recorded'('$unknown','$unknown'(M:G,US),_), !,
'$execute'(user:US).

2
pl/errors.yap
View File

@ -203,6 +203,8 @@ print_message(Level, Mss) :-
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$repeat',0,prolog,ClNo,Gs,[cl(repeat,0,prolog,ClNo)|NGs]) :- !,
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$recorded_with_key',3,prolog,ClNo,Gs,[cl(recorded,3,prolog,ClNo)|NGs]) :- !,
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$consult',2,prolog,ClNo,Gs,[cl(consult,1,prolog,ClNo)|NGs]) :- !,
'$preprocess_stack'(Gs, NGs).
'$beautify_hidden_goal'('$findall_with_common_vars',_,prolog,ClNo,Gs,[cl(findall,4,prolog,ClNo)|NGs]) :- !,

57
pl/preds.yap
View File

@ -18,20 +18,20 @@
% The next predicates are applicable only
% to dynamic code
asserta(V) :- var(V), !,
'$do_error'(instantiation_error,asserta(V)).
asserta(Mod:C) :- !,
'$assert'(C,Mod,first,_,asserta(Mod:C)).
asserta(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,first,_,asserta(C)).
assertz(V) :- var(V), !,
'$do_error'(instantiation_error,assertz(V)).
assertz(Mod:C) :- !,
'$assert'(C,Mod,last,_,assertz(Mod:C)).
assertz(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assertz(C)).
assert(V) :- var(V), !,
'$do_error'(instantiation_error,assert(V)).
assert(Mod:C) :- !,
'$assert'(C,Mod,last,_,assert(Mod:C)).
assert(C) :-
'$current_module'(Mod),
'$assert'(C,Mod,last,_,assert(C)).
@ -94,20 +94,20 @@ assert(C) :-
'$do_error'(permission_error(modify,static_procedure,Na/Ar),P)
).
assert_static(V) :- var(V), !,
'$do_error'(instantiation_error,assert_static(V)).
assert_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assert_static(Mod:C)).
assert_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assert_static(C)).
asserta_static(V) :- var(V), !,
'$do_error'(instantiation_error,asserta_static(V)).
asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,first,_,asserta_static(Mod:C)).
asserta_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,first,_,asserta_static(C)).
assertz_static(V) :- var(V), !,
'$do_error'(instantiation_error,assertz_static(V)).
asserta_static(Mod:C) :- !,
'$assert_static'(C,Mod,last,_,assertz_static(Mod:C)).
assertz_static(C) :-
'$current_module'(Mod),
'$assert_static'(C,Mod,last,_,assertz_static(C)).
@ -211,20 +211,20 @@ assertz_static(C) :-
fail.
'$erase_all_mf_dynamic'(_,_,_).
asserta(V,R) :- var(V), !,
'$do_error'(instantiation_error,asserta(V,R)).
asserta(M:C,R) :- !,
'$assert_dynamic'(C,M,first,R,asserta(M:C,R)).
asserta(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,first,R,asserta(C,R)).
assertz(V,R) :- var(V), !,
'$do_error'(instantiation_error,assertz(V,R)).
assertz(M:C,R) :- !,
'$assert_dynamic'(C,M,last,R,assertz(M:C,R)).
assertz(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assertz(C,R)).
assert(V,R) :- var(V), !,
'$do_error'(instantiation_error,assert(V,R)).
assert(M:C,R) :- !,
'$assert_dynamic'(C,M,last,R,assert(M:C,R)).
assert(C,R) :-
'$current_module'(M),
'$assert_dynamic'(C,M,last,R,assert(C,R)).
@ -278,6 +278,8 @@ clause(V,Q,R) :-
clause(Mod:P,Q,R))
).
retract(M:C) :- !,
'$retract'(C,M).
retract(C) :-
'$current_module'(M),
'$retract'(C,M).
@ -301,11 +303,12 @@ retract(C) :-
'$fetch_predicate_indicator_from_clause'(C, PI),
'$do_error'(permission_error(modify,static_procedure,PI),retract(M:C)).
retract(C,R) :- !,
retract(M:C,R) :- !,
'$retract'(C,M,R).
retract(C,R) :-
'$current_module'(M),
'$retract'(C,M,R).
'$retract'(V,M,R) :- var(V), !,
'$do_error'(instantiation_error,retract(M:V,R)).
'$retract'(M:C,_,R) :- !,
@ -336,6 +339,8 @@ retract(C,R) :- !,
functor(C, Na, Ar).
retractall(M:V) :-
'$retractall'(V,M).
retractall(V) :- !,
'$current_module'(M),
'$retractall'(V,M).
@ -378,12 +383,16 @@ abolish(N,A) :-
( '$is_dynamic'(T, M) -> '$abolishd'(T,M) ;
/* else */ '$abolishs'(T,M) ).
abolish(M:X) :- !,
'$abolish'(X,M).
abolish(X) :-
'$current_module'(M),
'$abolish'(X,M).
'$abolish'(X,M) :-
'$access_yap_flags'(8, 2), !,
'$current_module'(M),
'$new_abolish'(X,M).
abolish(X) :-
'$current_module'(M),
'$abolish'(X, M) :-
'$old_abolish'(X,M).
'$new_abolish'(V,M) :- var(V), !,
@ -606,7 +615,7 @@ dynamic_predicate(P,Sem) :-
F\/16'400000 \== 0.
hide_predicate(V) :- var(V), !,
'$do_error'(instantiation_error,hide_predicate(X)).
'$do_error'(instantiation_error,hide_predicate(V)).
hide_predicate(M:P) :- !,
'$hide_predicate2'(P, M).
hide_predicate(P) :-

6
pl/utils.yap
View File

@ -368,13 +368,11 @@ system_predicate(P) :-
'$current_predicate_no_modules'(M,A,T) :-
'$current_predicate'(M,A,Arity),
\+ '$hidden'(A),
functor(T,A,Arity),
'$pred_exists'(T,M).
'$current_predicate3'(M,A/Arity) :- !,
'$current_predicate'(M,A,Arity),
\+ '$hidden'(A),
functor(T,A,Arity),
'$pred_exists'(T,M).
'$current_predicate3'(M,BadSpec) :- % only for the predicate
@ -598,10 +596,6 @@ predicate_property(Pred,Prop) :-
% this predicate shows the code produced by the compiler
'$show_code' :- '$debug'(0'f).
'$pred_exists'(Pred,M) :- '$is_dynamic'(Pred,M), !.
'$pred_exists'(Pred,M) :- \+ '$undefined'(Pred,M).
grow_heap(X) :- '$grow_heap'(X).
grow_stack(X) :- '$grow_stack'(X).