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 #if HAVE_MALLINFO
struct mallinfo mi = mallinfo(); struct mallinfo mi = mallinfo();
return mi.uordblks - (LOCAL_TrailTop-LOCAL_GlobalBase); return mi.uordblks - (LOCAL_TrailTop-LOCAL_GlobalBase);
#endif #else
return Yap_ClauseSpace+Yap_IndexSpace_Tree+Yap_LUClauseSpace+Yap_LUIndexSpace_CP; return Yap_ClauseSpace+Yap_IndexSpace_Tree+Yap_LUClauseSpace+Yap_LUIndexSpace_CP;
#endif
} }
static void InitExStacks(int wid, int Trail, int Stack) { 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: case op_heapused:
/// - 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()); RINT(Yap_HeapUsed());
case op_localsp: case op_localsp:

274
C/cdmgr.c
View File

@ -32,10 +32,10 @@ static char SccsId[] = "@(#)cdmgr.c 1.1 05/02/98";
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
#include <Yatom.h>
#include <assert.h> #include <assert.h>
#include <heapgc.h> #include <heapgc.h>
#include <iopreds.h> #include <iopreds.h>
#include <Yatom.h>
static void retract_all(PredEntry *, int); static void retract_all(PredEntry *, int);
static void add_first_static(PredEntry *, yamop *, int); static void add_first_static(PredEntry *, yamop *, int);
@ -1386,7 +1386,7 @@ static void expand_consult(void) {
new_cs = new_cl + InitialConsultCapacity; new_cs = new_cl + InitialConsultCapacity;
/* start copying */ /* start copying */
memmove((void *)new_cs, (void *)LOCAL_ConsultLow, memmove((void *)new_cs, (void *)LOCAL_ConsultLow,
OldConsultCapacity * sizeof(consult_obj)); OldConsultCapacity * sizeof(consult_obj));
/* copying done, release old space */ /* copying done, release old space */
Yap_FreeCodeSpace((char *)LOCAL_ConsultLow); Yap_FreeCodeSpace((char *)LOCAL_ConsultLow);
/* next, set up pointers correctly */ /* next, set up pointers correctly */
@ -1452,33 +1452,36 @@ static int not_was_reconsulted(PredEntry *p, Term t, int mode) {
return TRUE; /* careful */ 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 CACHE_REGS
Term culprit; Term culprit;
if (Arity == 0) if (Arity == 0)
culprit = MkAtomTerm(AbsAtom(ap)); culprit = MkAtomTerm(AbsAtom(ap));
else else
culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap),Arity), Arity); culprit = Yap_MkNewApplTerm(Yap_MkFunctor(AbsAtom(ap), Arity), Arity);
return return (in_use
(in_use ? ? (Arity == 0
(Arity == 0 ? ? Yap_Error__(false, file, function, lineno,
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
"static predicate %s is in use", ap->StrOfAE) culprit, "static predicate %s is in use",
: ap->StrOfAE)
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, : Yap_Error__(
"static predicate %s/" Int_FORMAT " is in use", ap->StrOfAE, Arity) false, file, function, lineno,
) PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit,
: "static predicate %s/" Int_FORMAT " is in use",
(Arity == 0 ? ap->StrOfAE, Arity))
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, : (Arity == 0
"system predicate %s is in use", ap->StrOfAE) ? Yap_Error__(false, file, function, lineno,
: PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE,
Yap_Error__(false, file, function, lineno, PERMISSION_ERROR_MODIFY_STATIC_PROCEDURE, culprit, culprit, "system predicate %s is in use",
"system predicate %s/" Int_FORMAT, ap->StrOfAE, Arity) 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) { PredEntry *Yap_PredFromClause(Term t USES_REGS) {
Term cmod = LOCAL_SourceModule; Term cmod = LOCAL_SourceModule;
@ -1737,7 +1740,8 @@ bool Yap_addclause(Term t, yamop *cp, Term tmode, Term mod, Term *t4ref)
PELOCK(20, p); PELOCK(20, p);
/* we are redefining a prolog module predicate */ /* we are redefining a prolog module predicate */
if (Yap_constPred(p)) { 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); UNLOCKPE(30, p);
return false; 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); disc[2] = Yap_Module_Name(p);
sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomDiscontiguous, 3), 3, disc); sc[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomDiscontiguous, 3), 3, disc);
sc[1] = MkIntegerTerm(Yap_source_line_no()); 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[2] = MkAtomTerm(LOCAL_SourceFileName);
sc[3] = t; sc[3] = t;
t = Yap_MkApplTerm(Yap_MkFunctor(AtomStyleCheck, 4), 4, sc); 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); Yap_addclause(t, code_adr, t1, mod, &ARG5);
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
} }
if (LOCAL_ErrorMessage ) { if (LOCAL_ErrorMessage) {
Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage); Yap_Error(LOCAL_Error_TYPE, ARG1, LOCAL_ErrorMessage);
YAPLeaveCriticalSection(); YAPLeaveCriticalSection();
return false; return false;
@ -2435,12 +2440,14 @@ static Int new_multifile(USES_REGS1) {
} }
if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) { if (pe->PredFlags & (TabledPredFlag | ForeignPredFlags)) {
UNLOCKPE(26, pe); 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; return false;
} }
if (pe->cs.p_code.NOfClauses) { if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe); 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; return false;
} }
pe->PredFlags &= ~UndefPredFlag; pe->PredFlags &= ~UndefPredFlag;
@ -2674,7 +2681,8 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
(UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag | (UserCPredFlag | CArgsPredFlag | NumberDBPredFlag | AtomDBPredFlag |
TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) { TestPredFlag | AsmPredFlag | CPredFlag | BinaryPredFlag)) {
UNLOCKPE(30, pe); 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; return false;
} }
if (pe->PredFlags & LogUpdatePredFlag) { if (pe->PredFlags & LogUpdatePredFlag) {
@ -2687,7 +2695,8 @@ static Int mk_dynamic(USES_REGS1) { /* '$make_dynamic'(+P) */
} }
if (pe->cs.p_code.NOfClauses != 0) { if (pe->cs.p_code.NOfClauses != 0) {
UNLOCKPE(26, pe); 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; return false;
} }
if (pe->OpcodeOfPred == UNDEF_OPCODE) { if (pe->OpcodeOfPred == UNDEF_OPCODE) {
@ -2737,7 +2746,8 @@ static Int new_meta_pred(USES_REGS1) {
} }
if (pe->cs.p_code.NOfClauses) { if (pe->cs.p_code.NOfClauses) {
UNLOCKPE(26, pe); 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; return false;
} }
pe->PredFlags |= MetaPredFlag; pe->PredFlags |= MetaPredFlag;
@ -3082,132 +3092,88 @@ static Int p_clean_up_dead_clauses(USES_REGS1) {
void Yap_HidePred(PredEntry *pe) { void Yap_HidePred(PredEntry *pe) {
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag); 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;
static Int /* $system_predicate(P) */ while (p) {
p_stash_predicate(USES_REGS1) { if (p == pe) {
PredEntry *pe; *op = p->NextPredOfHash;
break;
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)) { op = &p->NextPredOfHash;
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1"); p = p->NextPredOfHash;
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
} }
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod)); }
} else if (IsPairTerm(t1)) { {
return TRUE; Prop *op, p;
} else if (pe->ArityOfPE == 0) {
return FALSE; op = &RepAtom(AtomOfTerm((Term)(pe->FunctorOfPred)))->PropsOfAE;
if (EndOfPAEntr(pe)) } else {
return FALSE; op = &pe->FunctorOfPred->PropsOfFE;
Yap_HidePred(pe);
return TRUE;
}
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) { p = *op;
Term nmod = ArgOfTerm(1, t1);
if (IsVarTerm(nmod)) { while (p) {
Yap_Error(INSTANTIATION_ERROR, ARG1, "hide_predicate/1"); if (p == AbsPredProp(pe)) {
return (FALSE); *op = p->NextOfPE;
break;
} }
if (!IsAtomTerm(nmod)) { op = &p->NextOfPE;
Yap_Error(TYPE_ERROR_ATOM, ARG1, "hide_predicate/1"); p = p->NextOfPE;
return (FALSE);
}
t1 = ArgOfTerm(2, t1);
goto restart_system_pred;
} }
pe = RepPredProp(Yap_GetPredPropByFunc(funt, mod)); }
} else if (IsPairTerm(t1)) {
return true; {
} else PredEntry *p,
return false; **op = &Yap_GetModuleEntry(Yap_Module(pe->ModuleOfPred))->PredForME;
if (EndOfPAEntr(pe)) p = *op;
return false;
pe->PredFlags |= (HiddenPredFlag | NoSpyPredFlag | NoTracePredFlag); while (p) {
return true; if (p == pe) {
*op = p->NextPredOfModule;
break;
}
op = &p->NextPredOfModule;
p = p->NextPredOfModule;
}
}
} }
static Int /* $hidden_predicate(P) */ static Int /* $hidden_predicate(P) */
p_hidden_predicate(USES_REGS1) { hide_predicate(USES_REGS1) {
PredEntry *pe; PredEntry *pe =
Yap_get_pred(Deref(ARG1), Deref(ARG2), "while checking for a procedure");
Term t1 = Deref(ARG1); if (pe) {
Term mod = Deref(ARG2); Yap_HidePred(pe);
return true;
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);
} else } else
return (FALSE); return false;
if (EndOfPAEntr(pe)) }
return (FALSE);
return (pe->PredFlags & HiddenPredFlag); 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, 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_module", 2, p_set_pred_module, SafePredFlag);
Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag); Yap_InitCPred("$set_pred_owner", 2, p_set_pred_owner, SafePredFlag);
Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag); Yap_InitCPred("$hide_predicate", 2, hide_predicate, SafePredFlag);
Yap_InitCPred("$stash_predicate", 2, p_stash_predicate, SafePredFlag); Yap_InitCPred("$stash_predicate", 2, stash_predicate, SafePredFlag);
Yap_InitCPred("$hidden_predicate", 2, p_hidden_predicate, SafePredFlag); Yap_InitCPred("$hidden_predicate", 2, hidden_predicate, SafePredFlag);
Yap_InitCPred("$log_update_clause", 4, p_log_update_clause, SyncPredFlag); Yap_InitCPred("$log_update_clause", 4, p_log_update_clause, SyncPredFlag);
Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause, Yap_InitCPred("$continue_log_update_clause", 5, p_continue_log_update_clause,
SafePredFlag | SyncPredFlag); 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} ) 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}) target_link_libraries(jplYap libYap ${JAVA_JVM_LIBRARY} ${JAVA_AWT_LIBRARY})
endif()
set_target_properties(jplYap PROPERTIES set_target_properties(jplYap PROPERTIES
OUTPUT_NAME jpl 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([Head|List], Elem, [Head|Residue]) :-
lists:delete(List, Elem, 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. :- set_prolog_flag(source, false). % disable source.

10
pl/preds.yap
View File

@ -440,11 +440,15 @@ stash_predicate(P0) :-
/** @pred hide_predicate(+ _Pred_) /** @pred hide_predicate(+ _Pred_)
Make predicate _Pred_ invisible to `current_predicate/2`, Make predicate _Pred_ invisible to `current_predicate/2`,
`listing`, and friends. `listing`, and friends.
**/ **/
hide_predicate(P0) :- hide_predicate(P0) :-
'$yap_strip_module'(P0, M, P), strip_module(P0, M, P),
must_be_of_type(callable, M:P), nonvar(P),
P = N/A,
!,
functor(S,N,A).
hide_predicate(P0) :-
strip_module(P0, M, P),
'$hide_predicate'(P, M). '$hide_predicate'(P, M).
/** @pred predicate_property( _P_, _Prop_) is iso /** @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), '$new_system_predicate'(Name,Arity,M),
sub_atom(Name,0,1,_, '$'), sub_atom(Name,0,1,_, '$'),
functor(P,Name,Arity), functor(P,Name,Arity),
'$hide_predicate'(P,M), %'$hide_predicate'(P,M),
fail. fail.
prolog:'$protect' :- prolog:'$protect' :-
current_atom(Name), current_atom(Name),
@ -81,5 +81,5 @@ prolog:'$protect'.
'$visible'('$qq_open'). '$visible'('$qq_open').
'$visible'('$live'). '$visible'('$live').
'$visible'('$init_prolog'). '$visible'('$init_prolog').
'$visible'('$x_yap_flag' ).
%% @} %% @}

54
pl/qly.yap
View File

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