built-ins should not interfere with trace

new catch/throw design


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@281 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-01-08 05:22:40 +00:00
parent fcbf07a251
commit 8496030d8a
10 changed files with 37 additions and 29 deletions

View File

@ -2086,11 +2086,13 @@ p_system_pred(void)
PredEntry *pe; PredEntry *pe;
Term t1 = Deref(ARG1); Term t1 = Deref(ARG1);
SMALLUNSGN mod = LookupModule(Deref(ARG2));
restart_system_pred: restart_system_pred:
if (IsVarTerm(t1)) if (IsVarTerm(t1))
return (FALSE); return (FALSE);
if (IsAtomTerm(t1)) { if (IsAtomTerm(t1)) {
pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), 0)); pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), mod));
} else if (IsApplTerm(t1)) { } else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1); Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) { if (IsExtensionFunctor(funt)) {
@ -2109,12 +2111,12 @@ p_system_pred(void)
t1 = ArgOfTerm(2, t1); t1 = ArgOfTerm(2, t1);
goto restart_system_pred; goto restart_system_pred;
} }
pe = RepPredProp(GetPredPropByFunc(funt, 0)); pe = RepPredProp(GetPredPropByFunc(funt, mod));
} else } else
return (FALSE); return (FALSE);
if (EndOfPAEntr(pe)) if (EndOfPAEntr(pe))
return(FALSE); return(FALSE);
return(pe->ModuleOfPred == 0); return(pe->ModuleOfPred == 0 || pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|BasicPredFlag|TestPredFlag));
} }
static Int /* $cut_transparent(P) */ static Int /* $cut_transparent(P) */
@ -2188,7 +2190,7 @@ InitCdMgr(void)
InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag); InitCPred("$toggle_static_predicates_in_use", 0, p_toggle_static_predicates_in_use, SafePredFlag|SyncPredFlag);
InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag); InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag); InitCPred("$parent_pred", 3, p_parent_pred, SafePredFlag);
InitCPred("$system_predicate", 1, p_system_pred, SafePredFlag); InitCPred("$system_predicate", 2, p_system_pred, SafePredFlag);
InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag); InitCPred("$cut_transparent", 1, p_cut_transparent, SafePredFlag);
} }

View File

@ -89,7 +89,7 @@ TEXI2PDF=texi2pdf
#4.1VPATH=@srcdir@:@srcdir@/OPTYap #4.1VPATH=@srcdir@:@srcdir@/OPTYap
CWD=$(PWD) CWD=$(PWD)
# #
VERSION=Yap-4.3.20 VERSION=Yap-4.3.21
# #
TAG_HEADERS= Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\ TAG_HEADERS= Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\

6
TO_DO
View File

@ -1,13 +1,11 @@
BEFORE 4.4: BEFORE 4.4:
- mixed attributes and delays. - mixed attributes and delays.
- write infinite terms - write infinite terms
- constraints in DB.
- fix restore when code is moved around. - fix restore when code is moved around.
- document new interface functions. - document new interface functions.
- 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). - reports from Nicos.
- debugger: don't stop from within system code. - fix ensure_loaded/1.
- reports from Nikos.
TO CHECK: TO CHECK:
- bad register allocation for a(X,Y) :- X is Y+2.3 ? - bad register allocation for a(X,Y) :- X is Y+2.3 ?

View File

@ -16,7 +16,15 @@
<h2>Yap-4.3.21:</h2> <h2>Yap-4.3.21:</h2>
<ul> <ul>
<li>FIXED: open_socket would crash if no more available sockets.</li> <li>FIXED: heap library.</li>
<li>NEW: empty_heap/3.</li>
<li>FIXED: some system predicates are exported outside the
prolog module.</li>
<li>FIXED: calls to open/3, current_stream/3, tab/{1,2}, and format/3
might interfere with trace.</li>
<li>NEW: new catch/3 and throw/1 mechanism.</li>
<li>FIXED: p_socket would crash if no streams were
available (Ines Dutra).</li>
<li>FIXED: CLPQR complaints on importing private predicates.</li> <li>FIXED: CLPQR complaints on importing private predicates.</li>
</ul> </ul>

View File

@ -13,7 +13,7 @@
% The benefit of the ordered representation is that the elementary % The benefit of the ordered representation is that the elementary
% set operations can be done in time proportional to the Sum of the % set operations can be done in time proportional to the Sum of the
% argument sizes rather than their Product. Some of the unordered % argument sizes rather than their Product. Some of the unordered
% set routines, such as member/2, length/2,, select/3 can be used % set routines, such as member/2, length/2, select/3 can be used
% unchanged. The main difficulty with the ordered representation is % unchanged. The main difficulty with the ordered representation is
% remembering to use it! % remembering to use it!

View File

@ -33,7 +33,7 @@
'$suspy'([],_,_) :- !. '$suspy'([],_,_) :- !.
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ). '$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
'$suspy'(F/N,S,M) :- !, functor(T,F,N), '$suspy'(F/N,S,M) :- !, functor(T,F,N),
( '$system_predicate'(T) -> ( '$system_predicate'(T,M) ->
throw(error(permission_error(access,private_procedure,F/N),spy(F/N,S))); throw(error(permission_error(access,private_procedure,F/N),spy(F/N,S)));
'$undefined'(T,M) -> '$undefined'(T,M) ->
throw(error(existence_error(procedure,F/N),spy(F/N,S))); throw(error(existence_error(procedure,F/N),spy(F/N,S)));
@ -45,12 +45,12 @@
'$suspy'(A,nospy,M) :- '$noclausesfor'(A,M), !, '$suspy'(A,nospy,M) :- '$noclausesfor'(A,M), !,
throw(error(existence_error(procedure,A),nospy(A))). throw(error(existence_error(procedure,A),nospy(A))).
'$suspy'(A,S,M) :- current_predicate(A,M:T), '$suspy'(A,S,M) :- current_predicate(A,M:T),
\+ '$undefined'(T,M), \+ '$system_predicate'(T), \+ '$undefined'(T,M), \+ '$system_predicate'(T,M),
functor(T,F,N), functor(T,F,N),
'$suspy2'(S,F,N,T,M). '$suspy2'(S,F,N,T,M).
'$noclausesfor'(A,M) :- current_predicate(A,M:T), '$noclausesfor'(A,M) :- current_predicate(A,M:T),
\+ '$undefined'(T,M) , \+ '$system_predicate'(T) , \+ '$undefined'(T,M) , \+ '$system_predicate'(T,M) ,
!, fail . !, fail .
'$noclausesfor'(_,_). '$noclausesfor'(_,_).
@ -368,7 +368,7 @@ debugging :-
'$undefp'([M|G]) '$undefp'([M|G])
). ).
'$spycalls'(G,M,_) :- '$spycalls'(G,M,_) :-
'$system_predicate'(G), '$system_predicate'(G,M),
'$flags'(G,M,F,_), '$flags'(G,M,F,_),
F /\ 0xc00000 =:= 0, % but not meta-predicate or cut transparent F /\ 0xc00000 =:= 0, % but not meta-predicate or cut transparent
!, !,

View File

@ -296,8 +296,8 @@ module(N) :-
'$prepare_body_with_correct_modules'(fail,_,fail) :- !. '$prepare_body_with_correct_modules'(fail,_,fail) :- !.
'$prepare_body_with_correct_modules'(false,_,false) :- !. '$prepare_body_with_correct_modules'(false,_,false) :- !.
'$prepare_body_with_correct_modules'(M:G,_,M:G) :- !. '$prepare_body_with_correct_modules'(M:G,_,M:G) :- !.
'$prepare_body_with_correct_modules'(G,_,G) :- '$prepare_body_with_correct_modules'(G,M,G) :-
'$system_predicate'(G), !. '$system_predicate'(G,M), !.
'$prepare_body_with_correct_modules'(G,M,M:G). '$prepare_body_with_correct_modules'(G,M,M:G).
@ -410,8 +410,8 @@ module(N) :-
'$pred_goal_expansion_on', '$pred_goal_expansion_on',
user:goal_expansion(G,M,GI), !, user:goal_expansion(G,M,GI), !,
'$module_expansion'(GI,G1,G2,M,CM,TM,HVars). '$module_expansion'(GI,G1,G2,M,CM,TM,HVars).
'$complete_goal_expansion'(G, _, _, _, G, GF, _) :- '$complete_goal_expansion'(G, _, _, M, G, GF, _) :-
'$system_predicate'(G), !, '$system_predicate'(G,M), !,
'$c_built_in'(G,GF). '$c_built_in'(G,GF).
'$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !. '$complete_goal_expansion'(G, Mod, _, Mod, G, G, _) :- !.
'$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _). '$complete_goal_expansion'(G, GMod, _, _, GMod:G, GMod:G, _).
@ -504,8 +504,8 @@ module(N) :-
'$process_expanded_arg'(\+V, M, \+NV) :- !, '$process_expanded_arg'(\+V, M, \+NV) :- !,
'$process_expanded_arg'(V, M, NV). '$process_expanded_arg'(V, M, NV).
'$process_expanded_arg'(M:A, _, M:A) :- !. '$process_expanded_arg'(M:A, _, M:A) :- !.
%'$process_expanded_arg'(G, _, G) :- %'$process_expanded_arg'(G, M, G) :-
% '$system_predicate'(G), !. % '$system_predicate'(G,M), !.
'$process_expanded_arg'(A, M, M:A). '$process_expanded_arg'(A, M, M:A).
'$not_in_vars'(_,[]). '$not_in_vars'(_,[]).
@ -607,8 +607,8 @@ source_module(Mod) :-
'$preprocess_body_before_mod_change'(false,_,_,false) :- !. '$preprocess_body_before_mod_change'(false,_,_,false) :- !.
'$preprocess_body_before_mod_change'(G,M,UVars,M:NG) :- '$preprocess_body_before_mod_change'(G,M,UVars,M:NG) :-
'$meta_expansion'(M, M, G, NG, UVars), !. '$meta_expansion'(M, M, G, NG, UVars), !.
'$preprocess_body_before_mod_change'(G,_,_,G) :- '$preprocess_body_before_mod_change'(G,M,_,G) :-
'$system_predicate'(G), !. '$system_predicate'(G,M), !.
'$preprocess_body_before_mod_change'(G,M,_,M:G). '$preprocess_body_before_mod_change'(G,M,_,M:G).
:- '$switch_log_upd'(0). :- '$switch_log_upd'(0).

View File

@ -247,7 +247,7 @@ clause(V,Q) :-
'$some_recordedp'(M:P), !, '$some_recordedp'(M:P), !,
'$recordedp'(M:P,(P:-Q),_). '$recordedp'(M:P,(P:-Q),_).
'$clause'(P,M,Q) :- '$clause'(P,M,Q) :-
( '$system_predicate'(P) -> true ; ( '$system_predicate'(P,M) -> true ;
'$number_of_clauses'(P,M,N), N > 0 ), '$number_of_clauses'(P,M,N), N > 0 ),
functor(P,Name,Arity), functor(P,Name,Arity),
throw(error(permission_error(access,private_procedure,Name/Arity), throw(error(permission_error(access,private_procedure,Name/Arity),
@ -466,7 +466,7 @@ abolish(X) :-
'$abolishs'(G, M) :- '$in_use'(G, M), !, '$abolishs'(G, M) :- '$in_use'(G, M), !,
functor(G,Name,Arity), functor(G,Name,Arity),
throw(error(permission_error(modify,static_procedure_in_use,Name/Arity),abolish(M:G))). throw(error(permission_error(modify,static_procedure_in_use,Name/Arity),abolish(M:G))).
'$abolishs'(G, M) :- '$system_predicate'(G), !, '$abolishs'(G, M) :- '$system_predicate'(G,M), !,
functor(G,Name,Arity), functor(G,Name,Arity),
throw(error(permission_error(modify,static_procedure,Name/Arity),abolish(M:G))). throw(error(permission_error(modify,static_procedure,Name/Arity),abolish(M:G))).
'$abolishs'(G, Module) :- '$abolishs'(G, Module) :-

View File

@ -24,7 +24,7 @@
'$iso_check_a_goal'(G2,(G1|G2),G0). '$iso_check_a_goal'(G2,(G1|G2),G0).
'$iso_check_goal'(G,G0) :- '$iso_check_goal'(G,G0) :-
'$access_yap_flags'(9,1), '$access_yap_flags'(9,1),
'$system_predicate'(G), '$system_predicate'(G,0),
( (
'$iso_builtin'(G) '$iso_builtin'(G)
-> ->
@ -58,7 +58,7 @@
'$iso_check_a_goal'((_|_),_,_) :- !. '$iso_check_a_goal'((_|_),_,_) :- !.
'$iso_check_a_goal'(G,_,G0) :- '$iso_check_a_goal'(G,_,G0) :-
'$access_yap_flags'(9,1), '$access_yap_flags'(9,1),
'$system_predicate'(G), '$system_predicate'(G,0),
( (
'$iso_builtin'(G) '$iso_builtin'(G)
-> ->
@ -85,7 +85,7 @@
'$check_iso_strict_goal'(B). '$check_iso_strict_goal'(B).
'$check_iso_strict_goal'(G) :- '$check_iso_strict_goal'(G) :-
'$system_predicate'(G), !, '$system_predicate'(G,0), !,
'$check_iso_system_goal'(G). '$check_iso_system_goal'(G).
'$check_iso_strict_goal'(_). '$check_iso_strict_goal'(_).