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
2002-01-08 05:22:40 +00:00
parent fcbf07a251
commit 8496030d8a
10 changed files with 37 additions and 29 deletions
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -2086,11 +2086,13 @@ p_system_pred(void)
  PredEntry      *pe;

  Term t1 = Deref(ARG1);
+  SMALLUNSGN mod = LookupModule(Deref(ARG2));
+
 restart_system_pred:
  if (IsVarTerm(t1))
    return (FALSE);
  if (IsAtomTerm(t1)) {
-    pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), 0));
+    pe = RepPredProp(GetPredPropByAtom(AtomOfTerm(t1), mod));
  } else if (IsApplTerm(t1)) {
    Functor         funt = FunctorOfTerm(t1);
    if (IsExtensionFunctor(funt)) {
@@ -2109,12 +2111,12 @@ p_system_pred(void)
      t1 = ArgOfTerm(2, t1);
      goto restart_system_pred;
    }
-    pe = RepPredProp(GetPredPropByFunc(funt, 0));
+    pe = RepPredProp(GetPredPropByFunc(funt, mod));
  } else
    return (FALSE);
  if (EndOfPAEntr(pe))
    return(FALSE);
-  return(pe->ModuleOfPred == 0);
+  return(pe->ModuleOfPred == 0 || pe->PredFlags & (UserCPredFlag|CPredFlag|BinaryTestPredFlag|BasicPredFlag|TestPredFlag));
 }

 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("$set_pred_module", 2, p_set_pred_module, 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);
 }

--- a/Makefile.in
+++ b/Makefile.in
@@ -89,7 +89,7 @@ TEXI2PDF=texi2pdf
 #4.1VPATH=@srcdir@:@srcdir@/OPTYap
 CWD=$(PWD)
 #
-VERSION=Yap-4.3.20
+VERSION=Yap-4.3.21
 #

 TAG_HEADERS=  Tags_32bits.h Tags_32Ops.h Tags_32LowTag.h\
--- a/6
+++ b/6
@@ -1,13 +1,11 @@
 BEFORE 4.4:
 - mixed attributes and delays.
 - write infinite terms
- constraints in DB.
 - fix restore when code is moved around.
 - document new interface functions.
 - 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: don't stop from within system code.
- reports from Nikos.
+- reports from Nicos.
+- fix ensure_loaded/1.

 TO CHECK:
 - bad register allocation for a(X,Y) :- X is Y+2.3 ?
--- a/changes4.3.html
+++ b/changes4.3.html
@@ -16,7 +16,15 @@

 <h2>Yap-4.3.21:</h2>
 <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>
 </ul>

--- a/library/ordsets.yap
+++ b/library/ordsets.yap
@@ -13,7 +13,7 @@
 %   The benefit of the ordered representation is that the elementary
 %   set operations can be done in time proportional to the Sum of the
 %   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
 %   remembering to use it!

--- a/pl/debug.yap
+++ b/pl/debug.yap
@@ -33,7 +33,7 @@
 '$suspy'([],_,_) :- !.
 '$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
 '$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)));
 	'$undefined'(T,M) ->
 	 throw(error(existence_error(procedure,F/N),spy(F/N,S)));
@@ -45,12 +45,12 @@
 '$suspy'(A,nospy,M) :- '$noclausesfor'(A,M), !,
 	throw(error(existence_error(procedure,A),nospy(A))).
 '$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),
 	'$suspy2'(S,F,N,T,M).

 '$noclausesfor'(A,M) :- current_predicate(A,M:T),
-	\+ '$undefined'(T,M) , \+ '$system_predicate'(T) ,
+	\+ '$undefined'(T,M) , \+ '$system_predicate'(T,M) ,
 	!, fail .
 '$noclausesfor'(_,_).

@@ -368,7 +368,7 @@ debugging :-
 	  '$undefp'([M|G])
 	).
 '$spycalls'(G,M,_) :-
-	'$system_predicate'(G),
+	'$system_predicate'(G,M),
 	'$flags'(G,M,F,_),
 	F /\ 0xc00000 =:= 0,		% but not meta-predicate or cut transparent
 	!,
--- a/pl/modules.yap
+++ b/pl/modules.yap
@@ -296,8 +296,8 @@ module(N) :-
 '$prepare_body_with_correct_modules'(fail,_,fail) :- !.
 '$prepare_body_with_correct_modules'(false,_,false) :- !.
 '$prepare_body_with_correct_modules'(M:G,_,M:G) :- !.
-'$prepare_body_with_correct_modules'(G,_,G) :-
-	'$system_predicate'(G), !.
+'$prepare_body_with_correct_modules'(G,M,G) :-
+	'$system_predicate'(G,M), !.
 '$prepare_body_with_correct_modules'(G,M,M:G).


@@ -410,8 +410,8 @@ module(N) :-
 	'$pred_goal_expansion_on',
 	user:goal_expansion(G,M,GI), !,
 	'$module_expansion'(GI,G1,G2,M,CM,TM,HVars).
-'$complete_goal_expansion'(G, _, _, _, G, GF, _) :-
-	'$system_predicate'(G), !,
+'$complete_goal_expansion'(G, _, _, M, G, GF, _) :-
+	'$system_predicate'(G,M), !,
 	'$c_built_in'(G,GF).
 '$complete_goal_expansion'(G, Mod, _, Mod, G, 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'(M:A, _, M:A) :- !.
-%'$process_expanded_arg'(G, _, G) :-
-%	'$system_predicate'(G), !.
+%'$process_expanded_arg'(G, M, G) :-
+%	'$system_predicate'(G,M), !.
 '$process_expanded_arg'(A, M, M:A).
 	
 '$not_in_vars'(_,[]).
@@ -607,8 +607,8 @@ source_module(Mod) :-
 '$preprocess_body_before_mod_change'(false,_,_,false) :- !.
 '$preprocess_body_before_mod_change'(G,M,UVars,M:NG) :-
 	'$meta_expansion'(M, M, G, NG, UVars), !.
-'$preprocess_body_before_mod_change'(G,_,_,G) :-
-	'$system_predicate'(G), !.
+'$preprocess_body_before_mod_change'(G,M,_,G) :-
+	'$system_predicate'(G,M), !.
 '$preprocess_body_before_mod_change'(G,M,_,M:G).

 :- '$switch_log_upd'(0).
--- a/pl/preds.yap
+++ b/pl/preds.yap
@@ -247,7 +247,7 @@ clause(V,Q) :-
 	'$some_recordedp'(M:P), !,
 	 '$recordedp'(M:P,(P:-Q),_).
 '$clause'(P,M,Q) :-
-	( '$system_predicate'(P) -> true ;
+	( '$system_predicate'(P,M) -> true ;
 	    '$number_of_clauses'(P,M,N), N > 0 ),
 	functor(P,Name,Arity),
 	throw(error(permission_error(access,private_procedure,Name/Arity),
@@ -466,7 +466,7 @@ abolish(X) :-
 '$abolishs'(G, M) :- '$in_use'(G, M), !,
 	functor(G,Name,Arity),
 	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),
 	throw(error(permission_error(modify,static_procedure,Name/Arity),abolish(M:G))).
 '$abolishs'(G, Module) :-
--- a/pl/strict_iso.yap
+++ b/pl/strict_iso.yap
@@ -24,7 +24,7 @@
 	'$iso_check_a_goal'(G2,(G1|G2),G0).
 '$iso_check_goal'(G,G0) :- 
 	'$access_yap_flags'(9,1),
-	'$system_predicate'(G),
+	'$system_predicate'(G,0),
 	(
            '$iso_builtin'(G)
 	->
@@ -58,7 +58,7 @@
 '$iso_check_a_goal'((_|_),_,_) :- !.
 '$iso_check_a_goal'(G,_,G0) :- 
 	'$access_yap_flags'(9,1),
-	'$system_predicate'(G),
+	'$system_predicate'(G,0),
 	(
            '$iso_builtin'(G)
 	->
@@ -85,7 +85,7 @@
 	'$check_iso_strict_goal'(B).

 '$check_iso_strict_goal'(G) :-
-	'$system_predicate'(G), !,
+	'$system_predicate'(G,0), !,
 	'$check_iso_system_goal'(G).
 '$check_iso_strict_goal'(_).