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

hide

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-09-26 01:16:07 +01:00
parent 13d609867c
commit a01ba3383b
8 changed files with 166 additions and 200 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
C/alloc.c
View File

@ -395,8 +395,9 @@ void Yap_InitHeap(void *heap_addr) {
#if HAVE_MALLINFO
struct mallinfo mi = mallinfo();
return mi.uordblks - (LOCAL_TrailTop-LOCAL_GlobalBase);
#endif
#else
return Yap_ClauseSpace+Yap_IndexSpace_Tree+Yap_LUClauseSpace+Yap_LUIndexSpace_CP;
#endif
}
static void InitExStacks(int wid, int Trail, int Stack) {

4
C/arith0.c
View File

@ -173,7 +173,9 @@ eval0(Int fi) {
}
case op_heapused:
/// - heapused
/// Heap (data-base) space used, in bytes.
/// Heap (data-base) space used, in bytes. In fact YAP either reports
/// the total memory malloced, or the amount of allocated space in
/// predicates.
///
RINT(Yap_HeapUsed());
case op_localsp:

254
C/cdmgr.c
View File

@ -32,10 +32,10 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#if HAVE_STRING_H
#include <string.h>
#endif
#include <Yatom.h>
#include <assert.h>
#include <heapgc.h>
#include <iopreds.h>
#include <Yatom.h>
static void retract_all(PredEntry *, int);
static void add_first_static(PredEntry *, yamop *, int);
@ -1452,34 +1452,37 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
return TRUE; /* careful */
}
static yamop * addcl_permission_error(const char *file, const char *function, int lineno, AtomEntry *ap, Int Arity, int in_use) {
static yamop *addcl_permission_error(const char *file, const char *function,
int lineno, AtomEntry *ap, Int Arity,
int in_use) {
CACHE_REGS
Term culprit;
if (Arity == 0)
culprit = MkAtomTerm(AbsAtom(ap));
else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity);
return
(in_use ?
(Arity == 0 ?
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s is in use", ap->StrOfAE)
:
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use", ap->StrOfAE, Arity)
)
:
(Arity == 0 ?
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"system predicate %s is in use", ap->StrOfAE)
:
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"system predicate %s/" Int_FORMAT, ap->StrOfAE, Arity)
)
);
return (in_use
? (Arity == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "static predicate %s is in use",
ap->StrOfAE)
: Yap_Error__(
false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
"static predicate %s/" Int_FORMAT " is in use",
ap->StrOfAE, Arity))
: (Arity == 0
? Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s is in use",
ap->StrOfAE)
: Yap_Error__(false, file, function, lineno,
PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
culprit, "system predicate %s/" Int_FORMAT,
ap->StrOfAE, Arity)));
}
PredEntry *Yap_PredFromClause(Term t USES_REGS) {
Term cmod = LOCAL_SourceModule;
arity_t extra_arity = 0;
@ -1737,7 +1740,8 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
PELOCK(20, p);
/* we are redefining a prolog module predicate */
if (Yap_constPred(p)) {
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), Arity,
FALSE);
UNLOCKPE(30, p);
return false;
}
@ -1767,7 +1771,8 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
disc[2] = Yap_Module_Name(p);
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomDiscontiguous, 3), 3, disc);
sc[1] = MkIntegerTerm(Yap_source_line_no());
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "source %s ", RepAtom(LOCAL_SourceFileName)->StrOfAE);
__android_log_print(ANDROID_LOG_INFO, "YAPDroid", "source %s ",
RepAtom(LOCAL_SourceFileName)->StrOfAE);
sc[2] = MkAtomTerm(LOCAL_SourceFileName);
sc[3] = t;
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc);
@ -2435,12 +2440,14 @@ static Int new_multifile(USES_REGS1) {
}
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__,RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__,RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
pe->PredFlags &= ~UndefPredFlag;
@ -2674,7 +2681,8 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__,RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->PredFlags & LogUpdatePredFlag) {
@ -2687,7 +2695,8 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
}
if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
if (pe->OpcodeOfPred == UNDEF_OPCODE) {
@ -2737,7 +2746,8 @@ static Int new_meta_pred(USES_REGS1) {
}
if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity, FALSE);
addcl_permission_error(__FILE__, __FUNCTION__, __LINE__, RepAtom(at), arity,
FALSE);
return false;
}
pe->PredFlags |= MetaPredFlag;
@ -3082,132 +3092,88 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
void Yap_HidePred(PredEntry *pe) {
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
if (pe->NextOfPE) {
UInt hash = PRED_HASH(pe->FunctorOfPred, CurrentModule, PredHashTableSize);
READ_LOCK(PredHashRWLock);
PredEntry *p, **op = PredHash+hash;
p = *op;
while (p) {
if (p == pe) {
*op = p->NextPredOfHash;
break;
}
op = &p->NextPredOfHash;
p = p->NextPredOfHash;
}
}
{
Prop *op, p;
if (pe->ArityOfPE == 0) {
op = &RepAtom(AtomOfTerm((Term)(pe->FunctorOfPred)))->PropsOfAE;
} else {
op = &pe->FunctorOfPred->PropsOfFE;
}
p = *op;
while (p) {
if (p == AbsPredProp(pe)) {
*op = p->NextOfPE;
break;
}
op = &p->NextOfPE;
p = p->NextOfPE;
}
}
static Int /* $system_predicate(P) */
p_stash_predicate(USES_REGS1) {
PredEntry *pe;
{
PredEntry *p,
**op = &Yap_GetModuleEntry(Yap_Module(pe->ModuleOfPred))->PredForME;
p = *op;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return (FALSE);
while (p) {
if (p == pe) {
*op = p->NextPredOfModule;
break;
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1");
return (FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1");
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return TRUE;
} else
return FALSE;
if (EndOfPAEntr(pe))
return FALSE;
Yap_HidePred(pe);
return TRUE;
op = &p->NextPredOfModule;
p = p->NextPredOfModule;
}
static Int /* $system_predicate(P) */
hide_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
Atom a = AtomOfTerm(t1);
pe = RepPredProp(Yap_GetPredPropByAtom(a, mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return (FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1");
return (FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1");
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return true;
} else
return false;
if (EndOfPAEntr(pe))
return false;
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
return true;
}
static Int /* $hidden_predicate(P) */
p_hidden_predicate(USES_REGS1) {
PredEntry *pe;
Term t1 = Deref(ARG1);
Term mod = Deref(ARG2);
restart_system_pred:
if (IsVarTerm(t1))
return (FALSE);
if (IsAtomTerm(t1)) {
pe = RepPredProp(Yap_GetPredPropByAtom(AtomOfTerm(t1), mod));
} else if (IsApplTerm(t1)) {
Functor funt = FunctorOfTerm(t1);
if (IsExtensionFunctor(funt)) {
return (FALSE);
}
if (funt == FunctorModule) {
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1");
return (FALSE);
}
if (!IsAtomTerm(nmod)) {
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1");
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
}
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod));
} else if (IsPairTerm(t1)) {
return (TRUE);
hide_predicate(USES_REGS1) {
PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
if (pe) {
Yap_HidePred(pe);
return true;
} else
return (FALSE);
if (EndOfPAEntr(pe))
return (FALSE);
return false;
}
static Int /* $hidden_predicate(P) */
stash_predicate(USES_REGS1) {
PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
if (pe) {
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
return true;
} else
return false;
}
static Int /* $hidden_predicate(P) */
hidden_predicate(USES_REGS1) {
PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
if (pe)
return (pe->PredFlags & HiddenPredFlag);
else
return false;
}
static Int fetch_next_lu_clause(PredEntry *pe, yamop *i_code, Term th, Term tb,
@ -4798,8 +4764,8 @@ void Yap_InitCdMgr(void) {
Yap_InitCPred("$set_pred_module", 2, p_set_pred_module, SafePredFlag);
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag);
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag);
Yap_InitCPred("$stash_predicate", 2, stash_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, hidden_predicate, SafePredFlag);
Yap_InitCPred("$log_update_clause", 4, p_log_update_clause, SyncPredFlag);
Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause,
SafePredFlag | SyncPredFlag);

5
packages/jpl/src/c/CMakeLists.txt
View File

@ -5,7 +5,12 @@ add_lib(jplYap jpl.h jpl.c hacks.h)
include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} )
if (MAC)
target_link_libraries(jplYap libYap /System/Library/Frameworks/CoreFoundation.framework/Versions/A/CoreFoundation
/System/Library/PrivateFrameworks/JavaLaunching.framework/Versions/A/JavaLaunching)
else()
target_link_libraries(jplYap libYap ${JAVA_JVM_LIBRARY} ${JAVA_AWT_LIBRARY})
endif()
set_target_properties(jplYap PROPERTIES
OUTPUT_NAME jpl

12
pl/bootlists.yap
View File

@ -91,18 +91,6 @@ lists:delete([Head|List], Elem, Residue) :-
lists:delete([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, Residue).
% reverse(List, Reversed)
% is true when List and Reversed are lists with the same elements
% but in opposite orders. rev/2 is a synonym for reverse/2.
lists:reverse(List, Reversed) :-
lists:reverse(List, [], Reversed).
lists:reverse([], Reversed, Reversed).
lists:reverse([Head|Tail], Sofar, Reversed) :-
lists:reverse(Tail, [Head|Sofar], Reversed).
:- set_prolog_flag(source, false). % disable source.

10
pl/preds.yap
View File

@ -440,11 +440,15 @@ stash_predicate(P0) :-
/** @pred hide_predicate(+ _Pred_)
Make predicate _Pred_ invisible to `current_predicate/2`,
`listing`, and friends.
**/
hide_predicate(P0) :-
'$yap_strip_module'(P0, M, P),
must_be_of_type(callable, M:P),
strip_module(P0, M, P),
nonvar(P),
P = N/A,
!,
functor(S,N,A).
hide_predicate(P0) :-
strip_module(P0, M, P),
'$hide_predicate'(P, M).
/** @pred predicate_property( _P_, _Prop_) is iso

4
pl/protect.yap
View File

@ -48,7 +48,7 @@ prolog:'$protect' :-
'$new_system_predicate'(Name,Arity,M),
sub_atom(Name,0,1,_, '$'),
functor(P,Name,Arity),
'$hide_predicate'(P,M),
%'$hide_predicate'(P,M),
fail.
prolog:'$protect' :-
current_atom(Name),
@ -81,5 +81,5 @@ prolog:'$protect'.
'$visible'('$qq_open').
'$visible'('$live').
'$visible'('$init_prolog').
'$visible'('$x_yap_flag' ).
%% @}

54
pl/qly.yap
View File

@ -135,32 +135,32 @@ qend_program :-
halt(0).
'$save_program_status'(Flags, G) :-
findall(F-V, '$x_yap_flag'(F,V),L),
findall(F-V, 'x_yap_flag'(F,V),L),
recordz('$program_state',L,_),
'$cvt_qsave_flags'(Flags, G),
'cvt_qsave_flags'(Flags, G),
fail.
'$save_program_status'(_Flags, _G).
'$cvt_qsave_flags'(Flags, G) :-
'cvt_qsave_flags'(Flags, G) :-
nonvar(Flags),
strip_module(Flags, M, LFlags),
'$skip_list'(_Len, LFlags, []),
'$cvt_qsave_lflags'(LFlags, G, M).
'$cvt_qsave_flags'(Flags, G,_OFlags) :-
'cvt_qsave_lflags'(LFlags, G, M).
'cvt_qsave_flags'(Flags, G,_OFlags) :-
var(Flags),
'$do_error'(instantiation_error,G).
'$cvt_qsave_flags'(Flags, G,_OFlags) :-
'cvt_qsave_flags'(Flags, G,_OFlags) :-
'$do_error'(type_error(list,Flags),G).
'$cvt_qsave_lflags'([], _, _).
'$cvt_qsave_lflags'([Flag|Flags], G, M) :-
'$cvt_qsave_flag'(Flag, G, M),
'$cvt_qsave_lflags'(Flags, G, M).
'cvt_qsave_lflags'([], _, _).
'cvt_qsave_lflags'([Flag|Flags], G, M) :-
'cvt_qsave_flag'(Flag, G, M),
'cvt_qsave_lflags'(Flags, G, M).
'$cvt_qsave_flag'(Flag, G, _) :-
'cvt_qsave_flag'(Flag, G, _) :-
var(Flag), !,
'$do_error'(instantiation_error,G).
'$cvt_qsave_flag'(local(B), G, _) :- !,
'cvt_qsave_flag'(local(B), G, _) :- !,
( number(B) ->
(
B > 0 -> recordz('$restore_flag',local(B),_) ;
@ -169,7 +169,7 @@ qend_program :-
;
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(global(B), G, _) :- !,
'cvt_qsave_flag'(global(B), G, _) :- !,
( number(B) ->
(
B > 0 -> recordz('$restore_flag',global(B),_) ;
@ -178,7 +178,7 @@ qend_program :-
;
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(stack(B), G, _) :- !,
'cvt_qsave_flag'(stack(B), G, _) :- !,
( number(B) ->
(
B > 0 -> recordz('$restore_flag',stack(B),_) ;
@ -187,7 +187,7 @@ qend_program :-
;
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(trail(B), G, _) :- !,
'cvt_qsave_flag'(trail(B), G, _) :- !,
( number(B) ->
(
B > 0 -> recordz('$restore_flag',trail(B),_) ;
@ -196,7 +196,7 @@ qend_program :-
;
'$do_error'(type_error(integer,B),G)
).
'$cvt_qsave_flag'(goal(B), G, M) :- !,
'cvt_qsave_flag'(goal(B), G, M) :- !,
( callable(B) ->
strip_module(M:B, M1, G1),
recordz('$restore_flag',goal(M1:G1),_)
@ -204,7 +204,7 @@ qend_program :-
strip_module(M:B, M1, G1),
'$do_error'(type_error(callable,G1),G)
).
'$cvt_qsave_flag'(toplevel(B), G, M) :- !,
'cvt_qsave_flag'(toplevel(B), G, M) :- !,
( callable(B) ->
strip_module(M:B, M1, G1),
recordz('$restore_flag',toplevel(M1:G1),_)
@ -212,27 +212,27 @@ qend_program :-
strip_module(M:B, M1, G1),
'$do_error'(type_error(callable,G1),G)
).
'$cvt_qsave_flag'(init_file(B), G, M) :- !,
'cvt_qsave_flag'(init_file(B), G, M) :- !,
( atom(B) ->
recordz('$restore_flag', init_file(M:B), _)
;
'$do_error'(type_error(atom,B),G)
).
%% '$cvt_qsave_flag'(autoload(_B), G, autoload(_B)).
%% '$cvt_qsave_flag'(op(_B), G, op(_B)).
%% '$cvt_qsave_flag'(stand_alone(_B), G, stand_alone(_B)).
%% '$cvt_qsave_flag'(emulator(_B), G, emulator(_B)).
%% '$cvt_qsave_flag'(foreign(_B), G, foreign(_B)).
'$cvt_qsave_flag'(Opt, G, _M) :-
%% 'cvt_qsave_flag'(autoload(_B), G, autoload(_B)).
%% 'cvt_qsave_flag'(op(_B), G, op(_B)).
%% 'cvt_qsave_flag'(stand_alone(_B), G, stand_alone(_B)).
%% 'cvt_qsave_flag'(emulator(_B), G, emulator(_B)).
%% 'cvt_qsave_flag'(foreign(_B), G, foreign(_B)).
'cvt_qsave_flag'(Opt, G, _M) :-
'$do_error'(domain_error(qsave_program,Opt), G).
% there is some ordering between flags.
'$x_yap_flag'(language, V) :-
'x_yap_flag'(language, V) :-
yap_flag(language, V).
'$x_yap_flag'(M:P, V) :-
'x_yap_flag'(M:P, V) :-
current_module(M),
yap_flag(M:P, V).
'$x_yap_flag'(X, V) :-
'x_yap_flag'(X, V) :-
prolog_flag_property(X, [access(read_write)]),
atom(X),
yap_flag(X, V),