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

flags handling II

Browse Source
This commit is contained in:
Vitor Santos Costa 2016-05-12 11:49:40 +01:00
parent 70f6080857
commit d58c071200
1 changed files with 94 additions and 66 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

160
C/flags.c
View File

@ -8,9 +8,9 @@
* * * *
************************************************************************** **************************************************************************
* * * *
* File: flags.c * * File: flags.c *
* Last rev: * * Last rev: *
* mods: * * mods: *
* comments: abstract machine definitions * * comments: abstract machine definitions *
* * * *
*************************************************************************/ *************************************************************************/
@ -25,23 +25,27 @@
#define INIT_FLAGS 1 #define INIT_FLAGS 1
#include "Yap.h" #include "Yap.h"
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
static bool ro(Term inp); static Term ro(Term inp);
static bool nat(Term inp); static Term nat(Term inp);
static bool isatom(Term inp); static Term isatom(Term inp);
static bool booleanFlag(Term inp); static Term booleanFlag(Term inp);
// static bool string( Term inp ); // static bool string( Term inp );
// static bool list_atom( Term inp ); // static bool list_atom( Term inp );
static bool list_option(Term inp); static Term list_option(Term inp);
static bool argv(Term inp); static Term argv(Term inp);
static bool os_argv(Term inp); static Term os_argv(Term inp);
static bool agc_threshold(Term inp); static bool agc_threshold(Term inp);
static bool gc_margin(Term inp); static bool gc_margin(Term inp);
static bool executable(Term inp); static Term executable(Term inp);
static bool sys_thread_id(Term inp); static Term sys_thread_id(Term inp);
static Term sys_pid(Term inp);
static bool mkprompt(Term inp); static bool mkprompt(Term inp);
static bool synerr(Term inp); static Term synerr(Term inp);
static bool indexer(Term inp); static Term indexer(Term inp);
static bool getenc(Term inp); static bool getenc(Term inp);
static bool typein(Term inp); static bool typein(Term inp);
static bool dqf(Term t2); static bool dqf(Term t2);
@ -70,19 +74,19 @@ static flag_info local_flags_setup[] = {
#include "YapLFlagInfo.h" #include "YapLFlagInfo.h"
LZERO_FLAG}; LZERO_FLAG};
static bool indexer(Term inp) { static Term indexer(Term inp) {
if (inp == TermOff || inp == TermSingle || inp == TermCompact || if (inp == TermOff || inp == TermSingle || inp == TermCompact ||
inp == TermMulti || inp == TermOn || inp == TermMax) inp == TermMulti || inp == TermOn || inp == TermMax)
return true; return inp;
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag index in {off,single,compact,multi,on,max}"); "set_prolog_flag index in {off,single,compact,multi,on,max}");
return false; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag in {dec10,error,fail,quiet}"); "set_prolog_flag in {dec10,error,fail,quiet}");
return false; return TermZERO;
} }
static bool dqf1(ModEntry *new, Term t2 USES_REGS) { static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
@ -149,34 +153,36 @@ static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
} }
} }
static bool isaccess(Term inp) { static Term isaccess(Term inp) {
if (inp == TermReadWrite || inp == TermReadOnly) if (inp == TermReadWrite || inp == TermReadOnly)
return true; return inp;
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {read_write,read_only}"); "set_prolog_flag access in {read_write,read_only}");
return false; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {read_write,read_only}"); "set_prolog_flag access in {read_write,read_only}");
return false; return TermZERO;
} }
static bool isground(Term inp) { return Yap_IsGroundTerm(inp); } static Term isground(Term inp) {
return Yap_IsGroundTerm(inp) ? inp : TermZERO;
}
static bool flagscope(Term inp) { static Term flagscope(Term inp) {
if (inp == TermGlobal || inp == TermThread || inp == TermModule) if (inp == TermGlobal || inp == TermThread || inp == TermModule)
return true; return inp;
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp, Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {global,module,thread}"); "set_prolog_flag access in {global,module,thread}");
return false; return TermZERO;
} }
Yap_Error(TYPE_ERROR_ATOM, inp, Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {global,module,thread}"); "set_prolog_flag access in {global,module,thread}");
return false; return TermZERO;
} }
static bool mkprompt(Term inp) { static bool mkprompt(Term inp) {
@ -388,10 +394,10 @@ static bool typein(Term inp) {
} }
#endif #endif
static bool list_option(Term inp) { static Term 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 \"...\"");
return false; return inp;
} }
Term inp0 = inp; Term inp0 = inp;
if (IsPairTerm(inp)) { if (IsPairTerm(inp)) {
@ -409,26 +415,26 @@ static bool list_option(Term inp) {
} }
if (!Yap_IsGroundTerm(hd)) if (!Yap_IsGroundTerm(hd))
Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\""); Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
return false; return TermZERO;
} }
} while (IsPairTerm(inp)); } while (IsPairTerm(inp));
if (inp == TermNil) { if (inp == TermNil) {
return true; return inp0;
} }
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]"); Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return false; return TermZERO;
} else /* lone option */ { } else /* lone option */ {
if (IsAtomTerm(inp)) { if (IsAtomTerm(inp)) {
return true; return inp;
} else if (IsApplTerm(inp)) { } else if (IsApplTerm(inp)) {
Functor f = FunctorOfTerm(inp); Functor f = FunctorOfTerm(inp);
if (!IsExtensionFunctor(f) && ArityOfFunctor(f) == 1 && if (!IsExtensionFunctor(f) && ArityOfFunctor(f) == 1 &&
Yap_IsGroundTerm(ArgOfTerm(1, inp))) { Yap_IsGroundTerm(ArgOfTerm(1, inp))) {
return true; return inp;
} }
} }
} }
return false; return TermZERO;
} }
static bool agc_threshold(Term t) { static bool agc_threshold(Term t) {
@ -466,7 +472,7 @@ static bool gc_margin(Term t) {
} else { } else {
CACHE_REGS CACHE_REGS
Yap_PutValue(AtomGcMargin, MkIntegerTerm(i)); Yap_PutValue(AtomGcMargin, MkIntegerTerm(i));
return TRUE; return true;
} }
} }
} }
@ -522,26 +528,14 @@ static Term mk_os_argc_list(USES_REGS1) {
return (t); return (t);
} }
static bool argv(Term inp) { static Term argv(Term inp) {
CACHE_REGS CACHE_REGS
Term t = mk_argc_list(PASS_REGS1); return mk_argc_list(PASS_REGS1);
if (IsAtomOrIntTerm(t))
GLOBAL_Flags[ARGV_FLAG].at = t;
else {
GLOBAL_Flags[ARGV_FLAG].DBT = Yap_StoreTermInDB(t, 2);
}
return false;
} }
static bool os_argv(Term inp) { static Term os_argv(Term inp) {
CACHE_REGS CACHE_REGS
Term t = mk_os_argc_list(PASS_REGS1); return mk_os_argc_list(PASS_REGS1);
if (IsAtomOrIntTerm(t))
GLOBAL_Flags[OS_ARGV_FLAG].at = t;
else {
GLOBAL_Flags[OS_ARGV_FLAG].DBT = Yap_StoreTermInDB(t, 2);
}
return false;
} }
static FlagEntry * static FlagEntry *
@ -583,7 +577,7 @@ static void initFlag(flag_info *f, int fnum, bool global) {
WRITE_UNLOCK(ae->ARWLock); WRITE_UNLOCK(ae->ARWLock);
} }
static bool executable(Term inp) { static Term executable(Term inp) {
CACHE_REGS CACHE_REGS
if (GLOBAL_argv && GLOBAL_argv[0]) { if (GLOBAL_argv && GLOBAL_argv[0]) {
if (!Yap_AbsoluteFile(GLOBAL_argv[0], LOCAL_FileNameBuf, true)) if (!Yap_AbsoluteFile(GLOBAL_argv[0], LOCAL_FileNameBuf, true))
@ -591,10 +585,10 @@ static bool executable(Term inp) {
} else } else
strncpy(LOCAL_FileNameBuf, Yap_FindExecutable(), YAP_FILENAME_MAX - 1); strncpy(LOCAL_FileNameBuf, Yap_FindExecutable(), YAP_FILENAME_MAX - 1);
return Yap_unify(MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf)), inp); return MkAtomTerm(Yap_LookupAtom(LOCAL_FileNameBuf));
} }
static bool sys_thread_id(Term inp) { static Term sys_thread_id(Term inp) {
CACHE_REGS CACHE_REGS
int pid; int pid;
#ifdef HAVE_GETTID_SYSCALL #ifdef HAVE_GETTID_SYSCALL
@ -607,7 +601,19 @@ static bool sys_thread_id(Term inp) {
pid = 0; pid = 0;
#endif #endif
return Yap_unify(MkIntegerTerm(pid), inp); return MkIntegerTerm(pid);
}
static Term sys_pid(Term inp) {
CACHE_REGS
int pid;
#if defined(__MINGW32__) || _MSC_VER
pid = _getpid();
#else
pid = getpid();
#endif
return MkIntegerTerm(pid);
} }
static bool setYapFlagInModule(Term tflag, Term t2, Term mod) { static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
@ -926,6 +932,10 @@ static Int current_prolog_flag2(USES_REGS1) {
else else
tarr = LOCAL_Flags; tarr = LOCAL_Flags;
tout = tarr[fv->FlagOfVE].at; tout = tarr[fv->FlagOfVE].at;
if (tout == TermZERO) {
Yap_DebugPlWriteln(tflag);
return false;
}
if (IsVarTerm(tout)) if (IsVarTerm(tout))
tout = Yap_FetchTermFromDB(tarr[fv->FlagOfVE].DBT); tout = Yap_FetchTermFromDB(tarr[fv->FlagOfVE].DBT);
return (Yap_unify(ARG2, tout)); return (Yap_unify(ARG2, tout));
@ -978,10 +988,11 @@ 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", Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
AtomName(AtomOfTerm(fl))); "trying to set unknown flag \"%s\"",
AtomName(AtomOfTerm(tflag)));
} }
return FALSE; return false;
} }
if (fv->global) { if (fv->global) {
CACHE_REGS CACHE_REGS
@ -997,7 +1008,7 @@ bool setYapFlag(Term tflag, Term t2) {
CACHE_REGS CACHE_REGS
tarr = LOCAL_Flags; tarr = LOCAL_Flags;
} }
if (!(fv->type(t2))) if (!(t2 = fv->type(t2)))
return false; return false;
if (fv->helper && !(fv->helper(t2))) if (fv->helper && !(fv->helper(t2)))
return false; return false;
@ -1052,10 +1063,12 @@ Term getYapFlag(Term tflag) {
if (fl == TermSilent) { if (fl == TermSilent) {
return false; return false;
} 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(tflag))->StrOfAE);
} else { } else {
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, fl, "trying to read unknown flag %s", Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
RepAtom(AtomOfTerm(fl))->StrOfAE); "trying to use unknown flag %s",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
} }
return false; return false;
} }
@ -1178,7 +1191,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
return true; return true;
} else if (f == at2n) { } else if (f == at2n) {
if (!bootstrap) { if (!bootstrap) {
return 0; return false;
} }
if (!strcmp(s, "INT_MAX")) { if (!strcmp(s, "INT_MAX")) {
tarr->at = MkIntTerm(Int_MAX); tarr->at = MkIntTerm(Int_MAX);
@ -1224,7 +1237,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
char tmp[512]; char tmp[512];
Term t0; Term t0;
if (bootstrap) { if (bootstrap) {
return false; return true;
} }
t0 = AbsPair(HR); t0 = AbsPair(HR);
while (true) { while (true) {
@ -1248,6 +1261,20 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
return true; return true;
} }
} }
} else if (strcmp(s, "@boot") == 0) {
if (bootstrap) {
return true;
}
Term t = f(TermZERO);
if (t == TermZERO)
return false;
if (IsAtomOrIntTerm(t)) {
tarr->at = t;
} else {
tarr->DBT = Yap_StoreTermInDB(t, 2);
}
} else { } else {
Term t0; Term t0;
if (bootstrap) { if (bootstrap) {
@ -1271,6 +1298,7 @@ static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
} }
return true; return true;
} }
return false;
} }
#define PROLOG_FLAG_PROPERTY_DEFS() \ #define PROLOG_FLAG_PROPERTY_DEFS() \
@ -1344,8 +1372,8 @@ do_prolog_flag_property(Term tflag,
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;