improve mod flags & system flags
This commit is contained in:
parent
eabc869c69
commit
811808fc34
458
C/flags.c
458
C/flags.c
@ -15,14 +15,12 @@
|
|||||||
* *
|
* *
|
||||||
*************************************************************************/
|
*************************************************************************/
|
||||||
|
|
||||||
|
|
||||||
/** @file C/flags.c
|
/** @file C/flags.c
|
||||||
|
|
||||||
@ingroup Flags
|
@ingroup Flags
|
||||||
@{
|
@{
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
|
||||||
// this is where we define flags
|
// this is where we define flags
|
||||||
#define INIT_FLAGS 1
|
#define INIT_FLAGS 1
|
||||||
|
|
||||||
@ -56,35 +54,34 @@ static Int set_prolog_flag(USES_REGS1);
|
|||||||
#include "yapio.h"
|
#include "yapio.h"
|
||||||
#include "eval.h"
|
#include "eval.h"
|
||||||
|
|
||||||
#define YAP_FLAG( ID, NAME, WRITABLE, DEF, INIT, HELPER ) { NAME, WRITABLE, DEF, INIT, HELPER }
|
#define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) \
|
||||||
|
{ NAME, WRITABLE, DEF, INIT, HELPER }
|
||||||
|
|
||||||
#define GZERO_FLAG { NULL, false, NULL, NULL, NULL }
|
#define GZERO_FLAG \
|
||||||
#define LZERO_FLAG { NULL, false, NULL, NULL, NULL }
|
{ NULL, false, NULL, NULL, NULL }
|
||||||
|
#define LZERO_FLAG \
|
||||||
|
{ NULL, false, NULL, NULL, NULL }
|
||||||
|
|
||||||
static flag_info global_flags_setup[] = {
|
static flag_info global_flags_setup[] = {
|
||||||
#include "YapGFlagInfo.h"
|
#include "YapGFlagInfo.h"
|
||||||
GZERO_FLAG
|
GZERO_FLAG};
|
||||||
};
|
|
||||||
|
|
||||||
static flag_info local_flags_setup[] = {
|
static flag_info local_flags_setup[] = {
|
||||||
#include "YapLFlagInfo.h"
|
#include "YapLFlagInfo.h"
|
||||||
LZERO_FLAG
|
LZERO_FLAG};
|
||||||
};
|
|
||||||
|
|
||||||
static bool indexer(Term inp) {
|
static bool indexer(Term inp) {
|
||||||
if (inp == TermOff ||
|
if (inp == TermOff || inp == TermSingle || inp == TermCompact ||
|
||||||
inp == TermSingle||
|
inp == TermMulti || inp == TermOn || inp == TermMax)
|
||||||
inp == TermCompact||
|
|
||||||
inp == TermMulti||
|
|
||||||
inp == TermOn||
|
|
||||||
inp == TermMax )
|
|
||||||
return true;
|
return true;
|
||||||
|
|
||||||
if (IsAtomTerm(inp)) {
|
if (IsAtomTerm(inp)) {
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag index in {off,single,compact,multi,on,max}");
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
|
||||||
|
"set_prolog_flag index in {off,single,compact,multi,on,max}");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag in {dec10,error,fail,quiet}");
|
Yap_Error(TYPE_ERROR_ATOM, inp,
|
||||||
|
"set_prolog_flag in {dec10,error,fail,quiet}");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -105,10 +102,15 @@ static bool dqf1( ModEntry *new, Term t2 USES_REGS ) {
|
|||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
/* bad argument, but still an atom */
|
/* bad argument, but still an atom */
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted string flag, use one string, arom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
|
||||||
|
"string flag, use one string, "
|
||||||
|
"arom, codes or chars",
|
||||||
|
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||||
return false;
|
return false;
|
||||||
} else {
|
} else {
|
||||||
Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should be {string,atom,codes,chars}", RepAtom(AtomOfTerm(t2))->StrOfAE);
|
Yap_Error(TYPE_ERROR_ATOM, t2, "set_prolog_flag(double_quotes, %s), should "
|
||||||
|
"be {string,atom,codes,chars}",
|
||||||
|
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@ -119,8 +121,6 @@ static bool dqf1( ModEntry *new, Term t2 USES_REGS ) {
|
|||||||
return dqf1(new, t2 PASS_REGS);
|
return dqf1(new, t2 PASS_REGS);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
|
static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
|
||||||
new->flags &= ~(BCKQ_CHARS | BCKQ_CODES | BCKQ_ATOM | BCKQ_STRING);
|
new->flags &= ~(BCKQ_CHARS | BCKQ_CODES | BCKQ_ATOM | BCKQ_STRING);
|
||||||
if (IsAtomTerm(t2)) {
|
if (IsAtomTerm(t2)) {
|
||||||
@ -137,47 +137,48 @@ static bool bqf1( ModEntry *new, Term t2 USES_REGS ) {
|
|||||||
new->flags |= BCKQ_CHARS;
|
new->flags |= BCKQ_CHARS;
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted string flag, use one string, arom, codes or chars", RepAtom(AtomOfTerm(t2))->StrOfAE);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for backquoted "
|
||||||
|
"string flag, use one string, "
|
||||||
|
"arom, codes or chars",
|
||||||
|
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||||
return false;
|
return false;
|
||||||
} else {
|
} else {
|
||||||
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped", RepAtom(AtomOfTerm(t2))->StrOfAE);
|
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
|
||||||
|
RepAtom(AtomOfTerm(t2))->StrOfAE);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static bool isaccess(Term inp) {
|
static bool isaccess(Term inp) {
|
||||||
if (inp == TermReadWrite ||
|
if (inp == TermReadWrite || inp == TermReadOnly)
|
||||||
inp == TermReadOnly )
|
|
||||||
return true;
|
return true;
|
||||||
|
|
||||||
if (IsAtomTerm(inp)) {
|
if (IsAtomTerm(inp)) {
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag access in {read_write,read_only}");
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
|
||||||
|
"set_prolog_flag access in {read_write,read_only}");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag access in {read_write,read_only}");
|
Yap_Error(TYPE_ERROR_ATOM, inp,
|
||||||
|
"set_prolog_flag access in {read_write,read_only}");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
static bool isground( Term inp ) {
|
static bool isground(Term inp) { return Yap_IsGroundTerm(inp); }
|
||||||
return Yap_IsGroundTerm( inp );
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
static bool flagscope(Term inp) {
|
static bool flagscope(Term inp) {
|
||||||
if (inp == TermGlobal ||
|
if (inp == TermGlobal || inp == TermThread || inp == TermModule)
|
||||||
inp == TermThread ||
|
|
||||||
inp == TermModule)
|
|
||||||
return true;
|
return true;
|
||||||
|
|
||||||
if (IsAtomTerm(inp)) {
|
if (IsAtomTerm(inp)) {
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, "set_prolog_flag access in {global,module,thread}");
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
|
||||||
|
"set_prolog_flag access in {global,module,thread}");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag access in {global,module,thread}");
|
Yap_Error(TYPE_ERROR_ATOM, inp,
|
||||||
|
"set_prolog_flag access in {global,module,thread}");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
static bool mkprompt(Term inp) {
|
static bool mkprompt(Term inp) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
if (IsVarTerm(inp)) {
|
if (IsVarTerm(inp)) {
|
||||||
@ -187,7 +188,8 @@ static bool mkprompt( Term inp ) {
|
|||||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
strncpy( LOCAL_Prompt, (const char *)RepAtom( AtomOfTerm( inp ) )->StrOfAE, MAX_PROMPT );
|
strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE,
|
||||||
|
MAX_PROMPT);
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -208,7 +210,8 @@ static bool getenc( Term inp ) {
|
|||||||
static bool enablerl( Term inp ) {
|
static bool enablerl( Term inp ) {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
if (IsVarTerm(inp)) {
|
if (IsVarTerm(inp)) {
|
||||||
return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding) )) );
|
return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding)
|
||||||
|
)) );
|
||||||
}
|
}
|
||||||
if (!IsAtomTerm(inp) ) {
|
if (!IsAtomTerm(inp) ) {
|
||||||
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
|
||||||
@ -232,7 +235,8 @@ static bool typein( Term inp ) {
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
CurrentModule = inp;
|
CurrentModule = inp;
|
||||||
if (inp == TermProlog) CurrentModule = PROLOG_MODULE;
|
if (inp == TermProlog)
|
||||||
|
CurrentModule = PROLOG_MODULE;
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -388,7 +392,6 @@ static bool list_atom( Term inp ) {
|
|||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|
||||||
static bool list_option(Term inp) {
|
static bool list_option(Term inp) {
|
||||||
if (IsVarTerm(inp)) {
|
if (IsVarTerm(inp)) {
|
||||||
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
|
||||||
@ -404,8 +407,7 @@ static bool list_option( Term inp ) {
|
|||||||
}
|
}
|
||||||
if (IsApplTerm(hd)) {
|
if (IsApplTerm(hd)) {
|
||||||
Functor f = FunctorOfTerm(hd);
|
Functor f = FunctorOfTerm(hd);
|
||||||
if (!IsExtensionFunctor(f) &&
|
if (!IsExtensionFunctor(f) && ArityOfFunctor(f) == 1 &&
|
||||||
ArityOfFunctor(f) == 1 &&
|
|
||||||
Yap_IsGroundTerm(hd)) {
|
Yap_IsGroundTerm(hd)) {
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
@ -424,13 +426,11 @@ static bool list_option( Term inp ) {
|
|||||||
return true;
|
return true;
|
||||||
} else if (IsApplTerm(inp)) {
|
} else if (IsApplTerm(inp)) {
|
||||||
Functor f = FunctorOfTerm(inp);
|
Functor f = FunctorOfTerm(inp);
|
||||||
if (!IsExtensionFunctor(f) &&
|
if (!IsExtensionFunctor(f) && ArityOfFunctor(f) == 1 &&
|
||||||
ArityOfFunctor(f) == 1 &&
|
|
||||||
Yap_IsGroundTerm(ArgOfTerm(1, inp))) {
|
Yap_IsGroundTerm(ArgOfTerm(1, inp))) {
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
@ -548,12 +548,8 @@ static bool os_argv(Term inp) {
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
static FlagEntry *
|
static FlagEntry *
|
||||||
GetFlagProp(Atom a )
|
GetFlagProp(Atom a) { /* look property list of atom a for kind */
|
||||||
{ /* look property list of atom a for kind */
|
|
||||||
AtomEntry *ae = RepAtom(a);
|
AtomEntry *ae = RepAtom(a);
|
||||||
FlagEntry *pp;
|
FlagEntry *pp;
|
||||||
|
|
||||||
@ -567,9 +563,7 @@ GetFlagProp(Atom a )
|
|||||||
return pp;
|
return pp;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void
|
static void initFlag(flag_info *f, int fnum, bool global) {
|
||||||
initFlag(flag_info *f, int fnum, bool global)
|
|
||||||
{
|
|
||||||
Atom name = Yap_LookupAtom(f->name);
|
Atom name = Yap_LookupAtom(f->name);
|
||||||
AtomEntry *ae = RepAtom(name);
|
AtomEntry *ae = RepAtom(name);
|
||||||
WRITE_LOCK(ae->ARWLock);
|
WRITE_LOCK(ae->ARWLock);
|
||||||
@ -578,7 +572,9 @@ initFlag(flag_info *f, int fnum, bool global)
|
|||||||
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
|
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
|
||||||
if (fprop == NULL) {
|
if (fprop == NULL) {
|
||||||
WRITE_UNLOCK(ae->ARWLock);
|
WRITE_UNLOCK(ae->ARWLock);
|
||||||
Yap_Error(RESOURCE_ERROR_HEAP,TermNil,"not enough space for new Flag %s", ae->StrOfAE); return;
|
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
|
||||||
|
"not enough space for new Flag %s", ae->StrOfAE);
|
||||||
|
return;
|
||||||
}
|
}
|
||||||
fprop->KindOfPE = FlagProperty;
|
fprop->KindOfPE = FlagProperty;
|
||||||
fprop->FlagOfVE = fnum;
|
fprop->FlagOfVE = fnum;
|
||||||
@ -601,8 +597,7 @@ static bool executable(Term inp) {
|
|||||||
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), inp);
|
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), inp);
|
||||||
}
|
}
|
||||||
|
|
||||||
static bool sys_thread_id(Term inp)
|
static bool sys_thread_id(Term inp) {
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
int pid;
|
int pid;
|
||||||
#ifdef HAVE_GETTID_SYSCALL
|
#ifdef HAVE_GETTID_SYSCALL
|
||||||
@ -618,9 +613,7 @@ static bool sys_thread_id(Term inp)
|
|||||||
return Yap_unify(MkIntegerTerm(pid), inp);
|
return Yap_unify(MkIntegerTerm(pid), inp);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
|
||||||
static bool setYapFlagInModule( Term tflag, Term t2, Term mod )
|
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
ModEntry *new = Yap_GetModuleEntry(mod);
|
ModEntry *new = Yap_GetModuleEntry(mod);
|
||||||
@ -628,12 +621,26 @@ static bool setYapFlagInModule( Term tflag, Term t2, Term mod )
|
|||||||
return false;
|
return false;
|
||||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||||
if (!fv && !fv->global) {
|
if (!fv && !fv->global) {
|
||||||
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag, "trying to set unknown module flag");
|
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
|
||||||
|
"trying to set unknown module flag");
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
if (mod == USER_MODULE && !setYapFlag( tflag, t2) )
|
|
||||||
return false;
|
|
||||||
|
|
||||||
|
if (mod == USER_MODULE) {
|
||||||
|
flag_term *tarr = GLOBAL_Flags;
|
||||||
|
if (!(fv->type(t2)))
|
||||||
|
return false;
|
||||||
|
if (fv->helper && !(fv->helper(t2)))
|
||||||
|
return false;
|
||||||
|
Term tout = tarr[fv->FlagOfVE].at;
|
||||||
|
if (IsVarTerm(tout))
|
||||||
|
Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT);
|
||||||
|
if (IsAtomOrIntTerm(t2))
|
||||||
|
tarr[fv->FlagOfVE].at = t2;
|
||||||
|
else {
|
||||||
|
tarr[fv->FlagOfVE].DBT = Yap_StoreTermInDB(t2, 2);
|
||||||
|
}
|
||||||
|
}
|
||||||
// module specific stuff now
|
// module specific stuff now
|
||||||
|
|
||||||
if (fv->FlagOfVE == UNKNOWN_FLAG) {
|
if (fv->FlagOfVE == UNKNOWN_FLAG) {
|
||||||
@ -651,7 +658,10 @@ static bool setYapFlagInModule( Term tflag, Term t2, Term mod )
|
|||||||
new->flags |= (UNKNOWN_FAST_FAIL);
|
new->flags |= (UNKNOWN_FAST_FAIL);
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for unknown flag, use one of error, fail or warning.", RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
Yap_Error(
|
||||||
|
DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||||
|
"bad option %s for unknown flag, use one of error, fail or warning.",
|
||||||
|
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||||
return false;
|
return false;
|
||||||
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
|
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
|
||||||
return dqf1(new, t2 PASS_REGS);
|
return dqf1(new, t2 PASS_REGS);
|
||||||
@ -663,17 +673,19 @@ static bool setYapFlagInModule( Term tflag, Term t2, Term mod )
|
|||||||
new->flags &= ~(M_CHARESCAPE);
|
new->flags &= ~(M_CHARESCAPE);
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "bad option %s for character_escapes flag, use true or false", RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
|
||||||
|
"bad option %s for character_escapes flag, use true or false",
|
||||||
|
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||||
return false;
|
return false;
|
||||||
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
|
} else if (fv->FlagOfVE == BACKQUOTED_STRING_FLAG) {
|
||||||
return bqf1( new, t2 PASS_REGS );;
|
return bqf1(new, t2 PASS_REGS);
|
||||||
|
;
|
||||||
}
|
}
|
||||||
// bad key?
|
// bad key?
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Term getYapFlagInModule( Term tflag, Term mod )
|
static Term getYapFlagInModule(Term tflag, Term mod) {
|
||||||
{
|
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
ModEntry *new = Yap_GetModuleEntry(mod);
|
ModEntry *new = Yap_GetModuleEntry(mod);
|
||||||
if (!mod)
|
if (!mod)
|
||||||
@ -711,7 +723,8 @@ static Term getYapFlagInModule( Term tflag, Term mod )
|
|||||||
return TermAtom;
|
return TermAtom;
|
||||||
return TermString;
|
return TermString;
|
||||||
}
|
}
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped", RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
|
||||||
|
RepAtom(AtomOfTerm(tflag))->StrOfAE);
|
||||||
return 0L;
|
return 0L;
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -725,11 +738,11 @@ static Int cont_yap_flag( USES_REGS1) {
|
|||||||
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
|
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
|
||||||
Term modt = CurrentModule;
|
Term modt = CurrentModule;
|
||||||
tflag = Yap_StripModule(tflag, &modt);
|
tflag = Yap_StripModule(tflag, &modt);
|
||||||
while (i != gmax &&
|
while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG &&
|
||||||
i != UNKNOWN_FLAG &&
|
i != BACKQUOTED_STRING_FLAG)
|
||||||
i != CHARACTER_ESCAPES_FLAG &&
|
i++;
|
||||||
i != BACKQUOTED_STRING_FLAG) i++;
|
if (i == gmax)
|
||||||
if (i == gmax) cut_fail();
|
cut_fail();
|
||||||
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i + 1);
|
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i + 1);
|
||||||
{
|
{
|
||||||
Term lab = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
|
Term lab = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
|
||||||
@ -749,7 +762,8 @@ static Int cont_yap_flag( USES_REGS1) {
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
if (i >= gmax) {
|
if (i >= gmax) {
|
||||||
Yap_unify( ARG1, MkAtomTerm( Yap_LookupAtom(local_flags_setup[i-gmax].name ) ) );
|
Yap_unify(ARG1,
|
||||||
|
MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name)));
|
||||||
if (i == gmax + lmax - 1)
|
if (i == gmax + lmax - 1)
|
||||||
do_cut(0);
|
do_cut(0);
|
||||||
} else {
|
} else {
|
||||||
@ -774,8 +788,10 @@ static Int yap_flag(USES_REGS1) {
|
|||||||
}
|
}
|
||||||
do_cut(0);
|
do_cut(0);
|
||||||
|
|
||||||
if (!isatom(tflag)) return false;
|
if (!isatom(tflag))
|
||||||
if (!isatom(modt)) return false;
|
return false;
|
||||||
|
if (!isatom(modt))
|
||||||
|
return false;
|
||||||
if (IsVarTerm(Deref(ARG2))) {
|
if (IsVarTerm(Deref(ARG2))) {
|
||||||
Term flag = getYapFlagInModule(tflag, modt);
|
Term flag = getYapFlagInModule(tflag, modt);
|
||||||
if (flag == 0)
|
if (flag == 0)
|
||||||
@ -807,9 +823,11 @@ static Int cont_prolog_flag(USES_REGS1) {
|
|||||||
if (i >= gmax + lmax) {
|
if (i >= gmax + lmax) {
|
||||||
cut_fail();
|
cut_fail();
|
||||||
} else if (i >= gmax) {
|
} else if (i >= gmax) {
|
||||||
Yap_unify( ARG1, ( f = MkAtomTerm( Yap_LookupAtom(local_flags_setup[i-gmax].name ) ) ));
|
Yap_unify(ARG1, (f = MkAtomTerm(
|
||||||
|
Yap_LookupAtom(local_flags_setup[i - gmax].name))));
|
||||||
} else {
|
} else {
|
||||||
Yap_unify( ARG1, (f = MkAtomTerm( Yap_LookupAtom( global_flags_setup[i].name ) ) ) );
|
Yap_unify(ARG1,
|
||||||
|
(f = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name))));
|
||||||
}
|
}
|
||||||
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(++i);
|
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(++i);
|
||||||
flag = getYapFlag(f);
|
flag = getYapFlag(f);
|
||||||
@ -844,6 +862,41 @@ static Int prolog_flag(USES_REGS1) {
|
|||||||
return setYapFlag(Deref(ARG1), Deref(ARG3));
|
return setYapFlag(Deref(ARG1), Deref(ARG3));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Int cont_current_prolog_flag(USES_REGS1) {
|
||||||
|
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
|
||||||
|
while (i < GLOBAL_flagCount + LOCAL_flagCount) {
|
||||||
|
int gmax = GLOBAL_flagCount;
|
||||||
|
int lmax = LOCAL_flagCount;
|
||||||
|
Term flag, f;
|
||||||
|
|
||||||
|
if (i >= gmax + lmax) {
|
||||||
|
cut_fail();
|
||||||
|
} else if (i >= gmax) {
|
||||||
|
Yap_unify(ARG1, (f = MkAtomTerm(
|
||||||
|
Yap_LookupAtom(local_flags_setup[i - gmax].name))));
|
||||||
|
} else {
|
||||||
|
Yap_unify(ARG1,
|
||||||
|
(f = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name))));
|
||||||
|
}
|
||||||
|
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(++i);
|
||||||
|
flag = getYapFlag(f);
|
||||||
|
if (!Yap_unify(f, ARG2))
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
cut_fail();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Int current_prolog_flag(USES_REGS1) {
|
||||||
|
if (IsVarTerm(Deref(ARG1))) {
|
||||||
|
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
|
||||||
|
return cont_current_prolog_flag(PASS_REGS1);
|
||||||
|
}
|
||||||
|
do_cut(0);
|
||||||
|
Term flag = getYapFlag(Deref(ARG1));
|
||||||
|
if (flag == 0)
|
||||||
|
return false;
|
||||||
|
return Yap_unify(flag, ARG2);
|
||||||
|
}
|
||||||
|
|
||||||
/** @pred current_prolog_flag(? _Flag_,- _Value_) is iso
|
/** @pred current_prolog_flag(? _Flag_,- _Value_) is iso
|
||||||
|
|
||||||
@ -852,7 +905,7 @@ yap_flag/2 with the second argument unbound, and unifying the
|
|||||||
returned second argument with _Value_.
|
returned second argument with _Value_.
|
||||||
|
|
||||||
*/
|
*/
|
||||||
static Int current_prolog_flag( USES_REGS1 ) {
|
static Int current_prolog_flag2(USES_REGS1) {
|
||||||
Term tflag = Deref(ARG1);
|
Term tflag = Deref(ARG1);
|
||||||
Term tout = 0;
|
Term tout = 0;
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
@ -882,27 +935,24 @@ static Int current_prolog_flag( USES_REGS1 ) {
|
|||||||
return (Yap_unify(ARG2, tout));
|
return (Yap_unify(ARG2, tout));
|
||||||
}
|
}
|
||||||
|
|
||||||
void Yap_setModuleFlags(ModEntry *new, ModEntry *cme)
|
void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) {
|
||||||
{
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
|
|
||||||
Atom at = new->AtomOfME;
|
Atom at = new->AtomOfME;
|
||||||
if (at == AtomProlog || CurrentModule == PROLOG_MODULE) {
|
if (at == AtomProlog || CurrentModule == PROLOG_MODULE) {
|
||||||
new->flags = M_SYSTEM | UNKNOWN_ERROR |M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING;
|
new->flags =
|
||||||
|
M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING;
|
||||||
if (at == AtomUser)
|
if (at == AtomUser)
|
||||||
new->flags = UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING;
|
new->flags = UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING;
|
||||||
} else if (cme &&
|
} else if (cme && cme->flags && cme != new) {
|
||||||
cme->flags && cme != new) {
|
|
||||||
new->flags = cme->flags;
|
new->flags = cme->flags;
|
||||||
} else {
|
} else {
|
||||||
new->flags = ( UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING
|
new->flags = (UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING);
|
||||||
);
|
|
||||||
}
|
}
|
||||||
// printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags);
|
// printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags);
|
||||||
}
|
}
|
||||||
|
|
||||||
bool setYapFlag( Term tflag, Term t2 )
|
bool setYapFlag(Term tflag, Term t2) {
|
||||||
{
|
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
flag_term *tarr;
|
flag_term *tarr;
|
||||||
if (IsVarTerm(tflag)) {
|
if (IsVarTerm(tflag)) {
|
||||||
@ -912,8 +962,10 @@ bool setYapFlag( Term tflag, Term t2 )
|
|||||||
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
|
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
|
||||||
Term modt;
|
Term modt;
|
||||||
tflag = Yap_StripModule(tflag, &modt);
|
tflag = Yap_StripModule(tflag, &modt);
|
||||||
if (!isatom(tflag)) return false;
|
if (!isatom(tflag))
|
||||||
if (!isatom(modt)) return false;
|
return false;
|
||||||
|
if (!isatom(modt))
|
||||||
|
return false;
|
||||||
return setYapFlagInModule(tflag, t2, modt);
|
return setYapFlagInModule(tflag, t2, modt);
|
||||||
}
|
}
|
||||||
if (!IsAtomTerm(tflag)) {
|
if (!IsAtomTerm(tflag)) {
|
||||||
@ -930,13 +982,21 @@ bool setYapFlag( Term tflag, Term t2 )
|
|||||||
} else if (fl == TermWarning) {
|
} else if (fl == TermWarning) {
|
||||||
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
|
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
|
||||||
} else {
|
} else {
|
||||||
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to set unknown flag ~s", AtomName(AtomOfTerm(fl)));
|
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to set unknown flag ~s",
|
||||||
|
AtomName(AtomOfTerm(fl)));
|
||||||
}
|
}
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
if (fv->global)
|
if (fv->global) {
|
||||||
|
switch (fv->FlagOfVE) {
|
||||||
|
case UNKNOWN_FLAG:
|
||||||
|
case CHARACTER_ESCAPES_FLAG:
|
||||||
|
case BACKQUOTED_STRING_FLAG:
|
||||||
|
return setYapFlagInModule(tflag, t2, CurrentModule);
|
||||||
|
default:
|
||||||
tarr = GLOBAL_Flags;
|
tarr = GLOBAL_Flags;
|
||||||
else {
|
}
|
||||||
|
} else {
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
tarr = LOCAL_Flags;
|
tarr = LOCAL_Flags;
|
||||||
}
|
}
|
||||||
@ -955,8 +1015,7 @@ bool setYapFlag( Term tflag, Term t2 )
|
|||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
Term getYapFlag( Term tflag )
|
Term getYapFlag(Term tflag) {
|
||||||
{
|
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
flag_term *tarr;
|
flag_term *tarr;
|
||||||
if (IsVarTerm(tflag)) {
|
if (IsVarTerm(tflag)) {
|
||||||
@ -966,8 +1025,10 @@ Term getYapFlag( Term tflag )
|
|||||||
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
|
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
|
||||||
Term modt;
|
Term modt;
|
||||||
tflag = Yap_StripModule(tflag, &modt);
|
tflag = Yap_StripModule(tflag, &modt);
|
||||||
if (!isatom(tflag)) return false;
|
if (!isatom(tflag))
|
||||||
if (!isatom(modt)) return false;
|
return false;
|
||||||
|
if (!isatom(modt))
|
||||||
|
return false;
|
||||||
return getYapFlagInModule(tflag, modt);
|
return getYapFlagInModule(tflag, modt);
|
||||||
}
|
}
|
||||||
if (!IsAtomTerm(tflag)) {
|
if (!IsAtomTerm(tflag)) {
|
||||||
@ -1037,7 +1098,6 @@ static Int no_source(USES_REGS1) {
|
|||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/**
|
/**
|
||||||
@pred source_mode(- _O_,+ _N_)
|
@pred source_mode(- _O_,+ _N_)
|
||||||
|
|
||||||
@ -1047,9 +1107,7 @@ database. _O_ is unified with the previous state and the mode is set
|
|||||||
according to _N_.
|
according to _N_.
|
||||||
|
|
||||||
*/
|
*/
|
||||||
static Int
|
static Int source_mode(USES_REGS1) {
|
||||||
source_mode( USES_REGS1 )
|
|
||||||
{
|
|
||||||
Term targ;
|
Term targ;
|
||||||
bool current = trueGlobalPrologFlag(SOURCE_FLAG);
|
bool current = trueGlobalPrologFlag(SOURCE_FLAG);
|
||||||
if (current && !Yap_unify_constant(ARG1, TermTrue))
|
if (current && !Yap_unify_constant(ARG1, TermTrue))
|
||||||
@ -1061,14 +1119,14 @@ source_mode( USES_REGS1 )
|
|||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
|
||||||
static bool
|
flag_term *tarr) {
|
||||||
setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
|
|
||||||
{
|
|
||||||
errno = 0;
|
errno = 0;
|
||||||
|
|
||||||
if (f == boolean) {
|
if (f == boolean) {
|
||||||
if (!bootstrap) { return 0; }
|
if (!bootstrap) {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
if (!strcmp(s, "true")) {
|
if (!strcmp(s, "true")) {
|
||||||
tarr->at = TermTrue;
|
tarr->at = TermTrue;
|
||||||
return true;
|
return true;
|
||||||
@ -1085,14 +1143,18 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
|
|||||||
tarr->at = TermFalse;
|
tarr->at = TermFalse;
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be either true (on) or false (off)", s);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
|
||||||
|
"~s should be either true (on) or false (off)", s);
|
||||||
return false;
|
return false;
|
||||||
} else if (f == nat) {
|
} else if (f == nat) {
|
||||||
if (!bootstrap) { return 0; }
|
if (!bootstrap) {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
UInt r = strtoul(s, NULL, 10);
|
UInt r = strtoul(s, NULL, 10);
|
||||||
Term t;
|
Term t;
|
||||||
if (errno) {
|
if (errno) {
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be a positive integer)", s);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
|
||||||
|
"~s should be a positive integer)", s);
|
||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
@ -1104,7 +1166,9 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
|
|||||||
}
|
}
|
||||||
return true;
|
return true;
|
||||||
} else if (f == at2n) {
|
} else if (f == at2n) {
|
||||||
if (!bootstrap) { return 0; }
|
if (!bootstrap) {
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
if (!strcmp(s, "INT_MAX")) {
|
if (!strcmp(s, "INT_MAX")) {
|
||||||
tarr->at = MkIntTerm(Int_MAX);
|
tarr->at = MkIntTerm(Int_MAX);
|
||||||
return true;
|
return true;
|
||||||
@ -1129,22 +1193,58 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
|
|||||||
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
|
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
|
||||||
return true;
|
return true;
|
||||||
}
|
}
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be either true (on) or false (off)", s);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
|
||||||
|
"~s should be either true (on) or false (off)", s);
|
||||||
return false;
|
return false;
|
||||||
} else if (f == isatom) {
|
} else if (f == isatom) {
|
||||||
if (!bootstrap) { return false; }
|
if (!bootstrap) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
Atom r = Yap_LookupAtom(s);
|
Atom r = Yap_LookupAtom(s);
|
||||||
if (errno) {
|
if (errno) {
|
||||||
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil, "~s should be a positive integer)", s);
|
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
|
||||||
|
"~s should be a positive integer)", s);
|
||||||
tarr->at = TermNil;
|
tarr->at = TermNil;
|
||||||
}
|
}
|
||||||
tarr->at = MkAtomTerm(r);
|
tarr->at = MkAtomTerm(r);
|
||||||
return true;
|
return true;
|
||||||
|
} else if (f == options) {
|
||||||
|
CACHE_REGS
|
||||||
|
char tmp[512];
|
||||||
|
Term t0;
|
||||||
|
if (bootstrap) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
|
t0 = AbsPair(HR);
|
||||||
|
while (true) {
|
||||||
|
int i = 0, ch = s[0];
|
||||||
|
while (ch != '\0' && ch != ';') {
|
||||||
|
if (ch != ' ')
|
||||||
|
tmp[i++] = ch;
|
||||||
|
s++;
|
||||||
|
ch = *s;
|
||||||
|
}
|
||||||
|
tmp[i] = '\0';
|
||||||
|
HR += 2;
|
||||||
|
HR[-2] = MkAtomTerm(Yap_LookupAtom(tmp));
|
||||||
|
if (ch) {
|
||||||
|
HR[-1] = AbsPair(HR);
|
||||||
|
s++;
|
||||||
|
continue;
|
||||||
|
} else {
|
||||||
|
HR[-1] = TermNil;
|
||||||
|
tarr->DBT = Yap_StoreTermInDB(t0, 2);
|
||||||
|
return true;
|
||||||
|
}
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
Term t0;
|
Term t0;
|
||||||
if (bootstrap) { return false; }
|
if (bootstrap) {
|
||||||
|
return false;
|
||||||
|
}
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
t0 = Yap_StringToTerm(s, strlen(s)+1, &LOCAL_encoding, GLOBAL_MaxPriority, NULL);
|
t0 = Yap_StringToTerm(s, strlen(s) + 1, &LOCAL_encoding, GLOBAL_MaxPriority,
|
||||||
|
NULL);
|
||||||
if (!t0)
|
if (!t0)
|
||||||
return false;
|
return false;
|
||||||
if (IsAtomTerm(t0) || IsIntTerm(t0)) {
|
if (IsAtomTerm(t0) || IsIntTerm(t0)) {
|
||||||
@ -1170,32 +1270,28 @@ setInitialValue( bool bootstrap, flag_func f, const char *s,flag_term *tarr )
|
|||||||
|
|
||||||
#define PAR(x, y, z, w) z
|
#define PAR(x, y, z, w) z
|
||||||
|
|
||||||
typedef enum prolog_flag_property_enum_choices
|
typedef enum prolog_flag_property_enum_choices {
|
||||||
{
|
|
||||||
PROLOG_FLAG_PROPERTY_DEFS()
|
PROLOG_FLAG_PROPERTY_DEFS()
|
||||||
} prolog_flag_property_choices_t;
|
} prolog_flag_property_choices_t;
|
||||||
|
|
||||||
#undef PAR
|
#undef PAR
|
||||||
|
|
||||||
#define PAR(x,y,z, w) { x , y, z, w }
|
#define PAR(x, y, z, w) \
|
||||||
|
{ x, y, z, w }
|
||||||
|
|
||||||
|
static const param2_t prolog_flag_property_defs[] = {
|
||||||
static const param2_t prolog_flag_property_defs[] =
|
PROLOG_FLAG_PROPERTY_DEFS()};
|
||||||
{
|
|
||||||
PROLOG_FLAG_PROPERTY_DEFS()
|
|
||||||
};
|
|
||||||
#undef PAR
|
#undef PAR
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
static Int
|
static Int
|
||||||
do_prolog_flag_property (Term tflag, Term opts USES_REGS)
|
do_prolog_flag_property(Term tflag,
|
||||||
{ /* Init current_prolog_flag */
|
Term opts USES_REGS) { /* Init current_prolog_flag */
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
xarg *args;
|
xarg *args;
|
||||||
prolog_flag_property_choices_t i;
|
prolog_flag_property_choices_t i;
|
||||||
bool rc = true;
|
bool rc = true;
|
||||||
args = Yap_ArgList2ToVector ( opts, prolog_flag_property_defs, PROLOG_FLAG_PROPERTY_END );
|
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
|
||||||
|
PROLOG_FLAG_PROPERTY_END);
|
||||||
if (args == NULL) {
|
if (args == NULL) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
@ -1214,19 +1310,19 @@ do_prolog_flag_property (Term tflag, Term opts USES_REGS)
|
|||||||
switch (i) {
|
switch (i) {
|
||||||
case PROLOG_FLAG_PROPERTY_ACCESS:
|
case PROLOG_FLAG_PROPERTY_ACCESS:
|
||||||
if (fv->rw)
|
if (fv->rw)
|
||||||
rc = rc &&
|
rc = rc && Yap_unify(TermReadWrite,
|
||||||
Yap_unify(TermReadWrite, args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
|
args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
|
||||||
else
|
else
|
||||||
rc = rc &&
|
rc = rc && Yap_unify(TermReadOnly,
|
||||||
Yap_unify(TermReadOnly, args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
|
args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
|
||||||
break;
|
break;
|
||||||
case PROLOG_FLAG_PROPERTY_TYPE:
|
case PROLOG_FLAG_PROPERTY_TYPE:
|
||||||
if (fv->type == boolean)
|
if (fv->type == boolean)
|
||||||
rc = rc &&
|
rc = rc &&
|
||||||
Yap_unify(TermBoolean, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
Yap_unify(TermBoolean, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
||||||
else if (fv->type == isatom)
|
else if (fv->type == isatom)
|
||||||
rc = rc &&
|
rc =
|
||||||
Yap_unify(TermAtom, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
rc && Yap_unify(TermAtom, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
||||||
else if (fv->type == nat)
|
else if (fv->type == nat)
|
||||||
rc = rc &&
|
rc = rc &&
|
||||||
|
|
||||||
@ -1235,8 +1331,8 @@ do_prolog_flag_property (Term tflag, Term opts USES_REGS)
|
|||||||
rc = rc &&
|
rc = rc &&
|
||||||
Yap_unify(TermFloat, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
Yap_unify(TermFloat, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
||||||
else
|
else
|
||||||
rc = rc &&
|
rc =
|
||||||
Yap_unify(TermTerm, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
rc && Yap_unify(TermTerm, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
|
||||||
break;
|
break;
|
||||||
case PROLOG_FLAG_PROPERTY_KEEP:
|
case PROLOG_FLAG_PROPERTY_KEEP:
|
||||||
rc = rc && false;
|
rc = rc && false;
|
||||||
@ -1263,9 +1359,7 @@ do_prolog_flag_property (Term tflag, Term opts USES_REGS)
|
|||||||
return rc;
|
return rc;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int cont_prolog_flag_property(USES_REGS1) { /* current_prolog_flag */
|
||||||
cont_prolog_flag_property (USES_REGS1)
|
|
||||||
{ /* current_prolog_flag */
|
|
||||||
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
|
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
|
||||||
|
|
||||||
while (i < GLOBAL_flagCount + LOCAL_flagCount) {
|
while (i < GLOBAL_flagCount + LOCAL_flagCount) {
|
||||||
@ -1278,8 +1372,7 @@ cont_prolog_flag_property (USES_REGS1)
|
|||||||
} else if (i >= gmax) {
|
} else if (i >= gmax) {
|
||||||
lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name));
|
lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name));
|
||||||
} else {
|
} else {
|
||||||
if (i == UNKNOWN_FLAG ||
|
if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG ||
|
||||||
i == CHARACTER_ESCAPES_FLAG ||
|
|
||||||
i == BACKQUOTED_STRING_FLAG) {
|
i == BACKQUOTED_STRING_FLAG) {
|
||||||
Term labs[2];
|
Term labs[2];
|
||||||
labs[0] = MkVarTerm();
|
labs[0] = MkVarTerm();
|
||||||
@ -1305,12 +1398,11 @@ and `term` (that is, any ground term)
|
|||||||
|
|
||||||
* `access(+_Access_)` with _Access_ one of `read_only` or `read_write`
|
* `access(+_Access_)` with _Access_ one of `read_only` or `read_write`
|
||||||
|
|
||||||
* `scope(+_Scope_) the flag aplies to a `thread`, to a `module`, or is `global` to the system.
|
* `scope(+_Scope_) the flag aplies to a `thread`, to a `module`, or is
|
||||||
|
`global` to the system.
|
||||||
|
|
||||||
*/
|
*/
|
||||||
static Int
|
static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */
|
||||||
prolog_flag_property (USES_REGS1)
|
|
||||||
{ /* Init current_prolog_flag */
|
|
||||||
Term t1 = Deref(ARG1);
|
Term t1 = Deref(ARG1);
|
||||||
/* make valgrind happy by always filling in memory */
|
/* make valgrind happy by always filling in memory */
|
||||||
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
|
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
|
||||||
@ -1336,10 +1428,7 @@ prolog_flag_property (USES_REGS1)
|
|||||||
return false;
|
return false;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void newFlag(Term fl, Term val) {
|
||||||
static void
|
|
||||||
newFlag( Term fl, Term val )
|
|
||||||
{
|
|
||||||
flag_info f;
|
flag_info f;
|
||||||
int i = GLOBAL_flagCount;
|
int i = GLOBAL_flagCount;
|
||||||
|
|
||||||
@ -1356,21 +1445,21 @@ newFlag( Term fl, Term val )
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static Int
|
static Int do_create_prolog_flag(USES_REGS1) {
|
||||||
do_create_prolog_flag( USES_REGS1 )
|
|
||||||
{
|
|
||||||
FlagEntry *fv;
|
FlagEntry *fv;
|
||||||
xarg *args;
|
xarg *args;
|
||||||
prolog_flag_property_choices_t i;
|
prolog_flag_property_choices_t i;
|
||||||
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
|
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
|
||||||
|
|
||||||
args = Yap_ArgList2ToVector ( opts, prolog_flag_property_defs, PROLOG_FLAG_PROPERTY_END );
|
args = Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
|
||||||
|
PROLOG_FLAG_PROPERTY_END);
|
||||||
if (args == NULL) {
|
if (args == NULL) {
|
||||||
return FALSE;
|
return FALSE;
|
||||||
}
|
}
|
||||||
fv = GetFlagProp(AtomOfTerm(tflag));
|
fv = GetFlagProp(AtomOfTerm(tflag));
|
||||||
if (fv) {
|
if (fv) {
|
||||||
if (args[PROLOG_FLAG_PROPERTY_KEEP].used && args[PROLOG_FLAG_PROPERTY_KEEP].tvalue == TermTrue)
|
if (args[PROLOG_FLAG_PROPERTY_KEEP].used &&
|
||||||
|
args[PROLOG_FLAG_PROPERTY_KEEP].tvalue == TermTrue)
|
||||||
return true;
|
return true;
|
||||||
} else {
|
} else {
|
||||||
newFlag(tflag, tval);
|
newFlag(tflag, tval);
|
||||||
@ -1387,8 +1476,7 @@ do_create_prolog_flag( USES_REGS1 )
|
|||||||
else
|
else
|
||||||
fv->rw = false;
|
fv->rw = false;
|
||||||
break;
|
break;
|
||||||
case PROLOG_FLAG_PROPERTY_TYPE:
|
case PROLOG_FLAG_PROPERTY_TYPE: {
|
||||||
{
|
|
||||||
Term ttype = args[PROLOG_FLAG_PROPERTY_TYPE].tvalue;
|
Term ttype = args[PROLOG_FLAG_PROPERTY_TYPE].tvalue;
|
||||||
if (ttype == TermBoolean)
|
if (ttype == TermBoolean)
|
||||||
fv->type = boolean;
|
fv->type = boolean;
|
||||||
@ -1398,11 +1486,9 @@ do_create_prolog_flag( USES_REGS1 )
|
|||||||
fv->type = isfloat;
|
fv->type = isfloat;
|
||||||
else
|
else
|
||||||
fv->type = isground;
|
fv->type = isground;
|
||||||
}
|
} break;
|
||||||
break;
|
|
||||||
case PROLOG_FLAG_PROPERTY_SCOPE:
|
case PROLOG_FLAG_PROPERTY_SCOPE:
|
||||||
return
|
return false;
|
||||||
false;
|
|
||||||
case PROLOG_FLAG_PROPERTY_END:
|
case PROLOG_FLAG_PROPERTY_END:
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@ -1410,30 +1496,32 @@ do_create_prolog_flag( USES_REGS1 )
|
|||||||
}
|
}
|
||||||
// UNLOCK(GLOBAL_Prolog_Flag[sno].prolog_flaglock);
|
// UNLOCK(GLOBAL_Prolog_Flag[sno].prolog_flaglock);
|
||||||
return true;
|
return true;
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/**
|
/**
|
||||||
* Init System Prolog flags. This is done in two phases:
|
* Init System Prolog flags. This is done in two phases:
|
||||||
* early on, it takes care of the atomic flags that are required by other modules;
|
* early on, it takes care of the atomic flags that are required by other
|
||||||
|
*modules;
|
||||||
* later, it looks at flags that are structured terms
|
* later, it looks at flags that are structured terms
|
||||||
*
|
*
|
||||||
* @param bootstrap: wether this is done before stack initialization, or afterwards.
|
* @param bootstrap: wether this is done before stack initialization, or
|
||||||
|
*afterwards.
|
||||||
* Complex terms can only be built in the second step.
|
* Complex terms can only be built in the second step.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
void
|
void Yap_InitFlags(bool bootstrap) {
|
||||||
Yap_InitFlags( bool bootstrap) {
|
|
||||||
CACHE_REGS
|
CACHE_REGS
|
||||||
tr_fr_ptr tr0 = TR;
|
tr_fr_ptr tr0 = TR;
|
||||||
flag_info *f =
|
flag_info *f = global_flags_setup;
|
||||||
global_flags_setup;
|
|
||||||
GLOBAL_flagCount = 0;
|
GLOBAL_flagCount = 0;
|
||||||
if (bootstrap) {
|
if (bootstrap) {
|
||||||
GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm)*(2*sizeof(global_flags_setup)/sizeof(flag_info)));
|
GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(
|
||||||
|
sizeof(union flagTerm) *
|
||||||
|
(2 * sizeof(global_flags_setup) / sizeof(flag_info)));
|
||||||
}
|
}
|
||||||
while (f->name != NULL) {
|
while (f->name != NULL) {
|
||||||
bool itf = setInitialValue( bootstrap, f->def, f->init, GLOBAL_Flags+GLOBAL_flagCount );
|
bool itf = setInitialValue(bootstrap, f->def, f->init,
|
||||||
|
GLOBAL_Flags + GLOBAL_flagCount);
|
||||||
if (itf) {
|
if (itf) {
|
||||||
initFlag(f, GLOBAL_flagCount, true);
|
initFlag(f, GLOBAL_flagCount, true);
|
||||||
}
|
}
|
||||||
@ -1443,12 +1531,14 @@ Yap_InitFlags( bool bootstrap) {
|
|||||||
LOCAL_flagCount = 0;
|
LOCAL_flagCount = 0;
|
||||||
int nflags = sizeof(local_flags_setup) / sizeof(flag_info);
|
int nflags = sizeof(local_flags_setup) / sizeof(flag_info);
|
||||||
if (bootstrap)
|
if (bootstrap)
|
||||||
LOCAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm)*nflags);
|
LOCAL_Flags =
|
||||||
f =
|
(union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm) * nflags);
|
||||||
local_flags_setup;
|
f = local_flags_setup;
|
||||||
while (f->name != NULL) {
|
while (f->name != NULL) {
|
||||||
bool itf = setInitialValue( bootstrap, f->def, f->init, LOCAL_Flags+LOCAL_flagCount );
|
bool itf = setInitialValue(bootstrap, f->def, f->init,
|
||||||
// Term itf = Yap_StringToTerm(f->init, strlen(f->init)+1, LOCAL_encoding, GLOBAL_MaxPriority, &tp);
|
LOCAL_Flags + LOCAL_flagCount);
|
||||||
|
// Term itf = Yap_StringToTerm(f->init, strlen(f->init)+1,
|
||||||
|
// LOCAL_encoding, GLOBAL_MaxPriority, &tp);
|
||||||
if (itf) {
|
if (itf) {
|
||||||
initFlag(f, LOCAL_flagCount, false);
|
initFlag(f, LOCAL_flagCount, false);
|
||||||
}
|
}
|
||||||
@ -1456,24 +1546,30 @@ Yap_InitFlags( bool bootstrap) {
|
|||||||
f++;
|
f++;
|
||||||
}
|
}
|
||||||
if (!bootstrap) {
|
if (!bootstrap) {
|
||||||
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag, cont_yap_flag, 0);
|
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag,
|
||||||
|
cont_yap_flag, 0);
|
||||||
TR = tr0;
|
TR = tr0;
|
||||||
/** @pred prolog_flag(? _Flag_,- _Value__)
|
/** @pred prolog_flag(? _Flag_,- _Value__)
|
||||||
|
|
||||||
Obtain the value for a YAP Prolog flag, same as current_prolog_flag/2_.
|
Obtain the value for a YAP Prolog flag, same as current_prolog_flag/2_.
|
||||||
*/
|
*/
|
||||||
Yap_InitCPredBack("prolog_flag", 3, 1, prolog_flag, cont_yap_flag, 0);
|
Yap_InitCPredBack("prolog_flag", 3, 1, current_prolog_flag, cont_yap_flag,
|
||||||
|
0);
|
||||||
Yap_InitCPredBack("yap_flag", 3, 1, prolog_flag, cont_yap_flag, 0);
|
Yap_InitCPredBack("yap_flag", 3, 1, prolog_flag, cont_yap_flag, 0);
|
||||||
Yap_InitCPredBack("prolog_flag", 2, 1, prolog_flag, cont_yap_flag, 0);
|
Yap_InitCPredBack("prolog_flag", 2, 1, current_prolog_flag2,
|
||||||
|
cont_current_prolog_flag, 0);
|
||||||
|
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag2,
|
||||||
|
cont_current_prolog_flag, 0);
|
||||||
Yap_InitCPred("set_prolog_flag", 2, set_prolog_flag, SyncPredFlag);
|
Yap_InitCPred("set_prolog_flag", 2, set_prolog_flag, SyncPredFlag);
|
||||||
Yap_InitCPred("$create_prolog_flag", 3, do_create_prolog_flag, SyncPredFlag);
|
Yap_InitCPred("$create_prolog_flag", 3, do_create_prolog_flag,
|
||||||
|
SyncPredFlag);
|
||||||
Yap_InitCPredBack("yap_flag", 2, 1, yap_flag, cont_yap_flag, 0);
|
Yap_InitCPredBack("yap_flag", 2, 1, yap_flag, cont_yap_flag, 0);
|
||||||
Yap_InitCPredBack("prolog_flag_property", 2, 1, prolog_flag_property,cont_prolog_flag_property, 0);
|
Yap_InitCPredBack("prolog_flag_property", 2, 1, prolog_flag_property,
|
||||||
|
cont_prolog_flag_property, 0);
|
||||||
Yap_InitCPred("source", 0, source, SyncPredFlag);
|
Yap_InitCPred("source", 0, source, SyncPredFlag);
|
||||||
Yap_InitCPred("no_source", 0, no_source, SyncPredFlag);
|
Yap_InitCPred("no_source", 0, no_source, SyncPredFlag);
|
||||||
Yap_InitCPred("source_mode", 2, source_mode, SyncPredFlag);
|
Yap_InitCPred("source_mode", 2, source_mode, SyncPredFlag);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
/* Accessing and changing the flags for a predicate */
|
/* Accessing and changing the flags for a predicate */
|
||||||
|
Reference in New Issue
Block a user