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

Merge ssh://ssh.dcc.fc.up.pt:31064//home/vsc/yap

Browse Source
This commit is contained in:
Vitor Santos Costa 2018-09-30 00:12:13 +01:00
commit 50b13a15a0
9 changed files with 191 additions and 156 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:

236
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);
@ -85,7 +85,7 @@ static void InitConsultStack(void) {
LOCAL_ConsultCapacity = InitialConsultCapacity;
LOCAL_ConsultBase = LOCAL_ConsultSp =
LOCAL_ConsultLow + LOCAL_ConsultCapacity;
}
s
void Yap_ResetConsultStack(void) {
CACHE_REGS
@ -1386,7 +1386,7 @@ static void expand_consult(void) {
new_cs = new_cl + InitialConsultCapacity;
/* start copying */
memmove((void *)new_cs, (void *)LOCAL_ConsultLow,
OldConsultCapacity * sizeof(consult_obj));
OldConsultCapacity * sizeof(consult_obj));
/* copying done, release old space */
Yap_FreeCodeSpace((char *)LOCAL_ConsultLow);
/* next, set up pointers correctly */
@ -1452,33 +1452,36 @@ 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)
)
);
}
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)));
}
PredEntry *Yap_PredFromClause(Term t USES_REGS) {
Term cmod = LOCAL_SourceModule;
@ -1649,7 +1652,7 @@ Atom Yap_source_file_name(void) {
}
/**
* @brief we cannot add clauses to the proceduree
* @brief we cannot add clauses to the procedure
*
* @param p predicate
*
@ -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);
@ -2043,7 +2048,7 @@ static Int p_compile(USES_REGS1) { /* '$compile'(+C,+Flags,+C0,-Ref) */
Yap_addclause(t, code_adr, t1, mod, &ARG5);
YAPLeaveCriticalSection();
}
if (LOCAL_ErrorMessage ) {
if (LOCAL_ErrorMessage) {
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
YAPLeaveCriticalSection();
return false;
@ -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;
@ -3081,75 +3091,101 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
void Yap_HidePred(PredEntry *pe) {
if (pe->PredFlags & HiddenPredFlag)
return;
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag);
char newMod[1024];
strncpy(newMod, "$$$--hidden-module--",1023);
Term cmod = pe->ModuleOfPred;
if (cmod == PROLOG_MODULE)
strncat(newMod, "prolog", 1023-strlen(newMod));
else
strncat(newMod, RepAtom(AtomOfTerm(cmod))->StrOfAE, 1023-strlen(newMod));
pe->ModuleOfPred = MkAtomTerm(Yap_LookupAtom(newMod));
}
if (pe->NextOfPE) {
UInt hash = PRED_HASH(pe->FunctorOfPred, CurrentModule, PredHashTableSize);
READ_LOCK(PredHashRWLock);
PredEntry *p, **op = PredHash+hash;
p = *op;
static Int /* $system_predicate(P) */
p_stash_predicate(USES_REGS1) {
PredEntry *pe;
while (p) {
if (p == pe) {
*op = p->NextPredOfHash;
break;
}
op = &p->NextPredOfHash;
p = p->NextPredOfHash;
}
pe->NextPredOfHash = NULL;
}
{
Prop *op, p;
if (pe->ArityOfPE == 0) {
op = &RepAtom(AtomOfTerm((Term)(pe->FunctorOfPred)))->PropsOfAE;
} else {
op = &pe->FunctorOfPred->PropsOfFE;
}
p = *op;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "stash_predicate/1");
while (p) {
if (p == AbsPredProp(pe)) {
*op = p->NextOfPE;
break;
}
op = &p->NextOfPE;
p = p->NextOfPE;
}
pe->NextOfPE = RepAtom(AtomFoundVar)->PropsOfAE;
RepAtom(AtomFoundVar)->PropsOfAE = AbsPredProp(pe);
}
if (pe && !(pe->PredFlags & SystemPredFlags)) Yap_HidePred(pe);
return TRUE;
}
{
PredEntry *p,
**op = &Yap_GetModuleEntry(Yap_Module(pe->ModuleOfPred))->PredForME;
p = *op;
static Int /* $system_predicate(P) */
hide_predicate(USES_REGS1) {
PredEntry *pe;
pe = Yap_get_pred(Deref(ARG1), Deref(ARG2), "hide_predicate/1");
if (pe) Yap_HidePred(pe);
return TRUE;
while (p) {
if (p == pe) {
*op = p->NextPredOfModule;
break;
}
op = &p->NextPredOfModule;
p = p->NextPredOfModule;
}
pe->NextPredOfModule = NULL;
}
}
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 (pe->PredFlags & HiddenPredFlag);
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);
/*
char ns[1024];
const char *s = (pe->ModuleOfPred == PROLOG_MODULE ?
"__prolog__stash__" :
snprintf(sn,1023,"__%s__".RepAtom(AtomOfTerm( pe->ModuleOfPred ))));
pe->ModuleOfPred = MkAtomTerm(Yap_LookupAtom(s));
*/
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,
@ -4740,8 +4776,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);

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

@ -1,15 +1,20 @@
# set(CMAKE_MACOSX_RPATH 1)
SET(CMAKE_INSTALL_RPATH_USE_LINK_PATH TRUE)
add_lib(jplYap jpl.h jpl.c hacks.h)
include_directories (${JAVA_INCLUDE_PATH} ${JAVA_INCLUDE_PATH2} ${JAVA_AWT_PATH} )
target_link_libraries(jplYap libYap ${JAVA_JVM_LIBRARY} ${JAVA_AWT_LIBRARY})
if (APPLE)
get_filename_component ( JAVA_AWT_DIR ${JAVA_AWT_LIBRARY} DIRECTORY)
find_library (JLI jli ${JAVA_AWT_DIR}/jli)
endif()
target_link_libraries(jplYap libYap ${JLI} ${JNI_LIBRARIES})
set_target_properties(jplYap PROPERTIES
OUTPUT_NAME jpl
INSTALL_RPATH_USE_LINK_PATH TRUE )
INSTALL_RPATH_USE_LINK_PATH TRUE
)
# set(YAP_SYSTEM_OPTIONS "jpl " ${YAP_SYSTEM_OPTIONS} PARENT_SCOPE)
install(TARGETS jplYap

10
packages/yap-lbfgs/yap_lbfgs.c
View File

@ -73,7 +73,7 @@ static lbfgsfloatval_t evaluate(
if (result==FALSE) {
printf("ERROR: the evaluate call failed in YAP.\n");
// Goal did not succeed
YAP_ShutdownGoal( TRUE );
YAP_ShutdownGoal( false );
return FALSE;
}
@ -90,7 +90,7 @@ static lbfgsfloatval_t evaluate(
}
YAP_ShutdownGoal( TRUE );
YAP_ShutdownGoal( false );
return rc;
}
@ -112,7 +112,7 @@ static int progress(
YAP_Bool result;
YAP_Int s1;
YAP_Term t[9],t2[2], v;
YAP_Term t[10],t2[2], v;
t[0] = YAP_MkFloatTerm(fx);
t[1] = YAP_MkIntTerm((YAP_Int)local_x);
t[1] = YAP_MkApplTerm(ffloats, 1, t+1);
@ -137,21 +137,19 @@ static int progress(
//optimizer_status=OPTIMIZER_STATUS_RUNNING;
YAP_Term o = YAP_GetFromSlot( s1 );
YAP_ShutdownGoal( false );
if (result==FALSE) {
printf("ERROR: the progress call failed in YAP.\n");
// Goal did not succeed
YAP_ShutdownGoal( TRUE );
return -1;
}
if (YAP_IsIntTerm(o)) {
int v = YAP_IntOfTerm(o);
//YAP_ShutdownGoal( TRUE );
return (int)v;
}
YAP_ShutdownGoal( TRUE );
fprintf(stderr, "ERROR: The progress call back function did not return an integer as last argument\n");
return 1;
}

15
pl/bootlists.yap
View File

@ -3,7 +3,7 @@
* @author VITOR SANTOS COSTA <vsc@VITORs-MBP.lan>
* @date Thu Nov 19 09:54:00 2015
*
* @addtogroup lists
* @addtogroup lists
* @{
*/
@ -77,19 +77,8 @@ lists:append([H|T], L, [H|R]) :-
/** @pred delete(+ _List_, ? _Element_, ? _Residue_)
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
True when _List_ is a list, in which _Element_ may or may not
occur, and _Residue_ is a copy of _List_ with all elements
identical to _Element_ deleted.
:- set_prolog_flag(source, false). % disable source.
eeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeeee
*/
lists:delete([], _, []).
lists:delete([Head|List], Elem, Residue) :-
Head = Elem,
lists:delete(List, Elem, Residue).
lists:delete([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, Residue).
% length of a list.

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),