fix bug in current_predicate/2

fix bug in c_interface.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2221 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2008-04-28 23:02:32 +00:00
parent 89bdffe91e
commit f1d5e84918
5 changed files with 46 additions and 12 deletions

View File

@ -10,8 +10,11 @@
* File: c_interface.c *
* comments: c_interface primitives definition *
* *
* Last rev: $Date: 2008-04-11 16:30:27 $,$Author: ricroc $ *
* Last rev: $Date: 2008-04-28 23:02:32 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.115 2008/04/11 16:30:27 ricroc
* *** empty log message ***
*
* Revision 1.114 2008/04/04 13:35:41 vsc
* fix duplicate dependency frame at entry
*
@ -1305,6 +1308,8 @@ run_emulator(YAP_dogoalinfo *dgi)
ASP = (CELL *)(B+1);
B = B->cp_b;
HB = B->cp_h;
} else {
Yap_StartSlots();
}
P = dgi->p;
RECOVER_MACHINE_REGS();

View File

@ -11,8 +11,11 @@
* File: cdmgr.c *
* comments: Code manager *
* *
* Last rev: $Date: 2008-04-11 16:30:27 $,$Author: ricroc $ *
* Last rev: $Date: 2008-04-28 23:02:32 $,$Author: vsc $ *
* $Log: not supported by cvs2svn $
* Revision 1.227 2008/04/11 16:30:27 ricroc
* *** empty log message ***
*
* Revision 1.226 2008/04/01 22:28:41 vsc
* put YAPOR back to life.
*
@ -2886,6 +2889,22 @@ p_is_source(void)
return(out);
}
static Int
p_mk_d(void)
{ /* '$is_dynamic'(+P) */
PredEntry *pe;
pe = get_pred(Deref(ARG1), Deref(ARG2), "$is_source");
if (EndOfPAEntr(pe))
return FALSE;
LOCK(pe->PELock);
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
pe->OpcodeOfPred = FAIL_OPCODE;
}
UNLOCK(pe->PELock);
return TRUE;
}
static Int
p_is_dynamic(void)
{ /* '$is_dynamic'(+P) */
@ -3049,14 +3068,14 @@ p_kill_dynamic(void)
LOCK(pe->PELock);
if (!(pe->PredFlags & (DynamicPredFlag|LogUpdatePredFlag))) {
UNLOCK(pe->PELock);
return (FALSE);
return FALSE;
}
if (pe->cs.p_code.LastClause != pe->cs.p_code.FirstClause) {
UNLOCK(pe->PELock);
return (FALSE);
}
pe->cs.p_code.LastClause = pe->cs.p_code.FirstClause = NULL;
pe->OpcodeOfPred = UNDEF_OPCODE;
pe->OpcodeOfPred = FAIL_OPCODE;
pe->cs.p_code.TrueCodeOfPred = pe->CodeOfPred = (yamop *)(&(pe->OpcodeOfPred));
pe->PredFlags = pe->PredFlags & GoalExPredFlag;
UNLOCK(pe->PELock);
@ -6106,6 +6125,7 @@ Yap_InitCdMgr(void)
Yap_InitCPred("$is_expand_goal_or_meta_predicate", 2, p_is_expandgoalormetapredicate, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_log_updatable", 2, p_is_log_updatable, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$is_source", 2, p_is_source, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$mk_d", 2, p_mk_d, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$pred_exists", 2, p_pred_exists, TestPredFlag | SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$number_of_clauses", 3, p_number_of_clauses, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred("$undefined", 2, p_undefined, SafePredFlag|TestPredFlag|HiddenPredFlag);

View File

@ -17,6 +17,9 @@ xb
<h2>Yap-5.1.3:</h2>
<ul>
<li> FIXED: should init_slots when sucessfully exiting (obs from
Trevor Walker).</li>
<li> FIXED: predicate_property should work for empty dynamic predicates.</li>
<li> FIXED: scanning very large numbers (obs from Ryszard Szopa).</li>
<li> FIXED: regexp core-dump (obs from Ryszard Szopa).</li>
<li> FIXED: handle message_queue_create/1 with vars right (obs from

View File

@ -687,6 +687,12 @@ absolute_file_name(File,Opts,TrueFileName) :-
% all must try search in path
'$find_in_path'(user,_,user_input, _) :- !.
'$find_in_path'(user_input,_,user_input, _) :- !.
'$find_in_path'(library(F),_,_, _) :-
% make sure library_directory is open.
\+ clause(user:library_directory(_),_),
'$system_library_directories'(D),
assert(user:library_directory(D)),
fail.
'$find_in_path'(library(File),Opts,NewFile, Call) :- !,
'$dir_separator'(D),
atom_codes(A,[D]),

View File

@ -712,10 +712,10 @@ dynamic(X) :-
integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,Mod,F,F),
% LogUpd,BinaryTest,Safe,C,Dynamic,Compiled,Standard,Asm,
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$flags'(T, Mod, F, NF);
F /\ 0x00002000 =:= 0x00002000 -> true; % dynamic
F /\ 0x08000000 =:= 0x08000000 -> true ; % LU
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF);
( F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x00002000, '$flags'(T, Mod, F, NF), '$mk_d'(T,Mod);
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
F /\ 0x00000400 =:= 0x00000400, '$undefined'(T,Mod) -> F1 is F /\ \(0x400), N1F is F1 \/ 0x00002000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$dynamic2'(X,Mod) :-
@ -725,10 +725,10 @@ dynamic(X) :-
'$logical_updatable'(A/N,Mod) :- integer(N), atom(A), !,
functor(T,A,N), '$flags'(T,Mod,F,F),
(
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$flags'(T,Mod,F,NF);
F /\ 0x08000000 =:= 0x08000000 -> true ; % LU
F /\ 0x00002000 =:= 0x00002000 -> true; % dynamic
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF);
F/\ 0x19D1FA80 =:= 0, '$undefined'(T,Mod) -> NF is F \/ 0x08000400, '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
F /\ 0x08000000 =:= 0x08000000 -> '$mk_d'(T,Mod) ; % LU
F /\ 0x00002000 =:= 0x00002000 -> '$mk_d'(T,Mod); % dynamic
F /\ 0x00000400 =:= 0x00000400 , '$undefined'(T,Mod) -> N1F is F \/ 0x08000000, NF is N1F /\ \(0x00400000), '$flags'(T,Mod,F,NF), '$mk_d'(T,Mod);
'$do_error'(permission_error(modify,static_procedure,A/N),dynamic(Mod:A/N))
).
'$logical_updatable'(X,Mod) :-