This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/C/flags.c

1824 lines
53 KiB
C
Raw Normal View History

2015-06-18 01:59:07 +01:00
/*************************************************************************
2018-07-10 23:21:19 +01:00
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 2015- *
* *
**************************************************************************
* *
* File: flags.c *
* Last rev: *
* mods: *
* comments: abstract machine definitions *
* *
*************************************************************************/
2015-06-18 01:59:07 +01:00
2015-11-18 15:06:25 +00:00
/** @file C/flags.c
2015-06-18 01:59:07 +01:00
2018-05-10 13:11:56 +01:00
@brief Prolog parameter setting,
*/
/*
* @namespace prolog
*/
2015-06-18 01:59:07 +01:00
2018-05-10 13:11:56 +01:00
/**
2018-11-14 09:35:24 +00:00
2019-02-13 09:44:24 +00:00
@defgroup YAPFlagsC C-code to handle Prolog flags.
2018-04-27 17:37:42 +01:00
@ingroup YAPFlags
2018-11-14 09:35:24 +00:00
@{
2018-05-10 13:11:56 +01:00
@brief Low-level code to support flags.
2018-04-27 17:37:42 +01:00
2018-05-10 13:11:56 +01:00
Prolog Flags can be:
= thread-local or global
= module-based or module-independent.
= read-only or read-write
= System or User Defined.
= Have type boolean, number, atom constant or may be a general term.
2015-06-18 01:59:07 +01:00
*/
// this is where we define flags
#define INIT_FLAGS 1
#include "Yap.h"
2016-07-31 10:22:22 +01:00
#include "iopreds.h"
2016-05-12 11:49:40 +01:00
#if HAVE_UNISTD_H
#include <unistd.h>
#endif
2015-06-18 01:59:07 +01:00
2016-05-12 11:49:40 +01:00
static Term ro(Term inp);
static Term nat(Term inp);
static Term isatom(Term inp);
static Term booleanFlag(Term inp);
2016-01-03 01:32:04 +00:00
// static bool string( Term inp );
// static bool list_atom( Term inp );
2016-05-12 11:49:40 +01:00
static Term list_option(Term inp);
static Term argv(Term inp);
static Term os_argv(Term inp);
2016-01-03 01:32:04 +00:00
static bool agc_threshold(Term inp);
static bool gc_margin(Term inp);
2016-05-12 11:49:40 +01:00
static Term executable(Term inp);
static Term sys_thread_id(Term inp);
static Term sys_pid(Term inp);
2015-06-18 01:59:07 +01:00
static bool mkprompt(Term inp);
2016-05-12 11:49:40 +01:00
static Term synerr(Term inp);
static Term indexer(Term inp);
2016-10-16 19:11:44 +01:00
static Term stream(Term inp);
2015-06-18 01:59:07 +01:00
static bool getenc(Term inp);
2016-01-03 01:32:04 +00:00
static bool typein(Term inp);
2018-03-19 11:44:16 +00:00
static bool dqs(Term t2);
static bool bqs(Term t2);
static bool sqf(Term t2);
2016-12-04 18:52:42 +00:00
static bool set_error_stream(Term inp);
static bool set_input_stream(Term inp);
static bool set_output_stream(Term inp);
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
static void newFlag(Term fl, Term val);
2015-06-18 01:59:07 +01:00
static Int current_prolog_flag(USES_REGS1);
static Int set_prolog_flag(USES_REGS1);
2017-02-20 14:21:46 +00:00
#include "YapEval.h"
2018-07-10 23:21:19 +01:00
#include "Yatom.h"
2016-04-26 15:33:16 +01:00
#include "yapio.h"
2015-06-18 01:59:07 +01:00
2018-07-10 23:21:19 +01:00
#define YAP_FLAG(ID, NAME, WRITABLE, DEF, INIT, HELPER) \
{ NAME, WRITABLE, DEF, INIT, HELPER }
2018-05-10 13:11:56 +01:00
#define START_LOCAL_FLAGS static flag_info local_flags_setup[] = {
2018-07-10 23:21:19 +01:00
#define END_LOCAL_FLAGS \
LZERO_FLAG \
} \
;
2018-05-10 13:11:56 +01:00
#define START_GLOBAL_FLAGS static flag_info global_flags_setup[] = {
2018-07-10 23:21:19 +01:00
#define END_GLOBAL_FLAGS \
GZERO_FLAG \
} \
;
2015-06-18 01:59:07 +01:00
2018-07-10 23:21:19 +01:00
#define GZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
#define LZERO_FLAG \
{ NULL, false, NULL, NULL, NULL }
2015-06-18 01:59:07 +01:00
#include "YapGFlagInfo.h"
2016-01-03 01:32:04 +00:00
#include "YapLFlagInfo.h"
2016-05-12 11:49:40 +01:00
static Term indexer(Term inp) {
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (inp == TermOff || inp == TermSingle || inp == TermCompact ||
inp == TermMulti || inp == TermOn || inp == TermMax)
2016-05-12 11:49:40 +01:00
return inp;
2015-06-18 01:59:07 +01:00
if (IsAtomTerm(inp)) {
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag index in {off,single,compact,multi,on,max}");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2018-07-10 23:21:19 +01:00
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag index to an atom");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
static bool dqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(DBLQ_CHARS | DBLQ_CODES | DBLQ_ATOM | DBLQ_STRING);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(t2)) {
t2 = MkStringTerm(RepAtom(AtomOfTerm(t2))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (IsAtomTerm(t2)) {
2015-09-29 23:11:57 +01:00
if (t2 == TermString) {
2016-01-03 01:32:04 +00:00
new->flags |= DBLQ_STRING;
2015-09-29 23:11:57 +01:00
return true;
} else if (t2 == TermAtom) {
2016-01-03 01:32:04 +00:00
new->flags |= DBLQ_ATOM;
2015-09-29 23:11:57 +01:00
return true;
} else if (t2 == TermCodes) {
2016-01-03 01:32:04 +00:00
new->flags |= DBLQ_CODES;
2015-09-29 23:11:57 +01:00
return true;
} else if (t2 == TermChars) {
2016-01-03 01:32:04 +00:00
new->flags |= DBLQ_CHARS;
2015-09-29 23:11:57 +01:00
return true;
}
/* bad argument, but still an atom */
2018-07-10 23:21:19 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
2016-01-03 01:32:04 +00:00
RepAtom(AtomOfTerm(t2))->StrOfAE);
2015-09-29 23:11:57 +01:00
return false;
} else {
2018-07-10 23:21:19 +01:00
Yap_Error(TYPE_ERROR_ATOM, t2,
"set_prolog_flag(double_quotes, %s), should "
"be {string,atom,codes,chars}",
2016-01-03 01:32:04 +00:00
RepAtom(AtomOfTerm(t2))->StrOfAE);
2015-09-29 23:11:57 +01:00
return false;
2015-08-07 22:57:53 +01:00
}
}
2018-03-19 11:44:16 +00:00
static bool dqs(Term t2) {
2015-09-21 23:05:36 +01:00
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
2016-01-03 01:32:04 +00:00
return dqf1(new, t2 PASS_REGS);
2015-09-21 23:05:36 +01:00
}
2016-01-03 01:32:04 +00:00
static bool bqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(BCKQ_CHARS | BCKQ_CODES | BCKQ_ATOM | BCKQ_STRING);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(t2)) {
t2 = MkStringTerm(RepAtom(AtomOfTerm(t2))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (IsAtomTerm(t2)) {
if (t2 == TermString) {
new->flags |= BCKQ_STRING;
return true;
} else if (t2 == TermAtom) {
new->flags |= BCKQ_ATOM;
return true;
} else if (t2 == TermCodes) {
new->flags |= BCKQ_CODES;
return true;
} else if (t2 == TermChars) {
new->flags |= BCKQ_CHARS;
return true;
}
2018-07-10 23:21:19 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
2016-01-03 01:32:04 +00:00
RepAtom(AtomOfTerm(t2))->StrOfAE);
2015-09-29 23:11:57 +01:00
return false;
} else {
2016-01-03 01:32:04 +00:00
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
2015-09-29 23:11:57 +01:00
return false;
}
}
2016-01-03 01:32:04 +00:00
2018-03-19 11:44:16 +00:00
static bool bqs(Term t2) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
return bqf1(new, t2 PASS_REGS);
}
static bool sqf1(ModEntry *new, Term t2 USES_REGS) {
new->flags &= ~(SNGQ_CHARS | SNGQ_CODES | SNGQ_ATOM | SNGQ_STRING);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(t2)) {
t2 = MkStringTerm(RepAtom(AtomOfTerm(t2))->StrOfAE);
}
2018-03-19 11:44:16 +00:00
if (IsAtomTerm(t2)) {
if (t2 == TermString) {
new->flags |= SNGQ_STRING;
return true;
} else if (t2 == TermAtom) {
new->flags |= SNGQ_ATOM;
return true;
} else if (t2 == TermCodes) {
new->flags |= SNGQ_CODES;
return true;
} else if (t2 == TermChars) {
new->flags |= SNGQ_CHARS;
return true;
}
2018-07-10 23:21:19 +01:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for backquoted "
"string flag, use one string, "
"atom, codes or chars",
2018-03-19 11:44:16 +00:00
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
} else {
Yap_Error(TYPE_ERROR_ATOM, t2, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(t2))->StrOfAE);
return false;
}
}
static bool sqf(Term t2) {
CACHE_REGS
ModEntry *new = Yap_GetModuleEntry(CurrentModule);
return sqf1(new, t2 PASS_REGS);
}
2018-06-15 13:50:55 +01:00
2016-05-12 11:49:40 +01:00
static Term isaccess(Term inp) {
2016-01-03 01:32:04 +00:00
if (inp == TermReadWrite || inp == TermReadOnly)
2016-05-12 11:49:40 +01:00
return inp;
2015-06-18 01:59:07 +01:00
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (IsAtomTerm(inp)) {
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {read_write,read_only}");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {read_write,read_only}");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2016-10-16 19:11:44 +01:00
static Term stream(Term inp) {
2016-12-04 18:52:42 +00:00
if (IsVarTerm(inp))
2016-10-16 19:11:44 +01:00
return inp;
2018-07-10 23:21:19 +01:00
if (Yap_CheckStream(inp,
Input_Stream_f | Output_Stream_f | Append_Stream_f |
Socket_Stream_f,
2016-12-04 18:52:42 +00:00
"yap_flag/3") >= 0)
2016-10-16 23:18:51 +01:00
return inp;
return 0;
2016-10-16 19:11:44 +01:00
}
2016-12-04 18:52:42 +00:00
static bool set_error_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_error_stream));
2018-07-10 23:21:19 +01:00
return Yap_SetErrorStream(inp);
2016-10-16 19:11:44 +01:00
}
2016-12-04 18:52:42 +00:00
static bool set_input_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_input_stream));
2018-07-10 23:21:19 +01:00
return Yap_SetInputStream(inp);
2016-10-16 19:11:44 +01:00
}
2016-12-04 18:52:42 +00:00
static bool set_output_stream(Term inp) {
if (IsVarTerm(inp))
return Yap_unify(inp, Yap_StreamUserName(LOCAL_c_output_stream));
2018-07-10 23:21:19 +01:00
return Yap_SetOutputStream(inp);
2016-10-16 19:11:44 +01:00
}
2016-05-12 11:49:40 +01:00
static Term isground(Term inp) {
return Yap_IsGroundTerm(inp) ? inp : TermZERO;
}
2015-06-18 01:59:07 +01:00
2016-05-12 11:49:40 +01:00
static Term flagscope(Term inp) {
2016-01-03 01:32:04 +00:00
if (inp == TermGlobal || inp == TermThread || inp == TermModule)
2016-05-12 11:49:40 +01:00
return inp;
2015-06-18 01:59:07 +01:00
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (IsAtomTerm(inp)) {
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, inp,
"set_prolog_flag access in {global,module,thread}");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
Yap_Error(TYPE_ERROR_ATOM, inp,
"set_prolog_flag access in {global,module,thread}");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
static bool mkprompt(Term inp) {
CACHE_REGS
2015-06-18 01:59:07 +01:00
if (IsVarTerm(inp)) {
2016-01-03 01:32:04 +00:00
return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(LOCAL_Prompt)));
2018-11-14 09:35:24 +00:00
}
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
2015-06-18 01:59:07 +01:00
}
2018-07-21 01:56:48 +01:00
if (!IsAtomTerm(inp)) {
2015-06-18 01:59:07 +01:00
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
2016-01-03 01:32:04 +00:00
strncpy(LOCAL_Prompt, (const char *)RepAtom(AtomOfTerm(inp))->StrOfAE,
MAX_PROMPT);
2015-06-18 01:59:07 +01:00
return true;
}
2016-01-03 01:32:04 +00:00
static bool getenc(Term inp) {
CACHE_REGS
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
2016-02-18 12:10:58 +00:00
if (!IsVarTerm(inp) && !IsAtomTerm(inp)) {
Yap_Error(TYPE_ERROR_ATOM, inp, "get_encoding");
2015-06-18 01:59:07 +01:00
return false;
}
2016-04-26 15:33:16 +01:00
return Yap_unify(inp, MkAtomTerm(Yap_LookupAtom(enc_name(LOCAL_encoding))));
2015-06-18 01:59:07 +01:00
}
/*
static bool enablerl( Term inp ) {
2016-01-03 01:32:04 +00:00
CACHE_REGS
if (IsVarTerm(inp)) {
return Yap_unify( inp, MkAtomTerm( Yap_LookupAtom( enc_name(LOCAL_encoding)
)) );
}
if (!IsAtomTerm(inp) ) {
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
2016-02-18 12:10:58 +00:00
enc_id( RepAtom( AtomOfTerm( inp ) )->StrOfAE, ENC_OCTET );
2016-01-03 01:32:04 +00:00
return true;
2015-06-18 01:59:07 +01:00
}
*/
2016-01-03 01:32:04 +00:00
static bool typein(Term inp) {
CACHE_REGS
2015-06-18 01:59:07 +01:00
if (IsVarTerm(inp)) {
Term tin = CurrentModule;
if (tin == PROLOG_MODULE)
2016-01-03 01:32:04 +00:00
tin = TermProlog;
return Yap_unify(inp, tin);
2015-06-18 01:59:07 +01:00
}
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (!IsAtomTerm(inp)) {
2015-06-18 01:59:07 +01:00
Yap_Error(TYPE_ERROR_ATOM, inp, "set_prolog_flag");
return false;
}
CurrentModule = inp;
2016-01-03 01:32:04 +00:00
if (inp == TermProlog)
CurrentModule = PROLOG_MODULE;
2015-06-18 01:59:07 +01:00
return true;
}
#if 0
2016-01-03 01:32:04 +00:00
static Int p_has_yap_or(USES_REGS1) {
2015-06-18 01:59:07 +01:00
#ifdef YAPOR
2016-01-03 01:32:04 +00:00
return (TRUE);
2015-06-18 01:59:07 +01:00
#else
2016-01-03 01:32:04 +00:00
return (FALSE);
2015-06-18 01:59:07 +01:00
#endif
2016-01-03 01:32:04 +00:00
}
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
static Int p_has_eam(USES_REGS1) {
2015-06-18 01:59:07 +01:00
#ifdef BEAM
2016-01-03 01:32:04 +00:00
return (TRUE);
2015-06-18 01:59:07 +01:00
#else
2016-01-03 01:32:04 +00:00
return (FALSE);
2015-06-18 01:59:07 +01:00
#endif
2016-01-03 01:32:04 +00:00
}
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
static Int p_has_jit(USES_REGS1) {
2015-06-18 01:59:07 +01:00
#ifdef HAS_JIT
2016-01-03 01:32:04 +00:00
return (TRUE);
2015-06-18 01:59:07 +01:00
#else
2016-01-03 01:32:04 +00:00
return (FALSE);
#endif
}
static bool tabling( Term inp ) {
if (value == 0) { /* default */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
TabEnt_mode(tab_ent) = TabEnt_flags(tab_ent);
tab_ent = TabEnt_next(tab_ent);
}
yap_flags[TA BLING_MODE_FLAG] = 0;
} else if (value == 1) { /* batched */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_Batched(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_Batched(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 2) { /* local */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_Local(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_Local(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 3) { /* exec_answers */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_ExecAnswers(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_ExecAnswers(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 4) { /* load_answers */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_LoadAnswers(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_LoadAnswers(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 5) { /* local_trie */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_LocalTrie(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_LocalTrie(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 6) { /* global_trie */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_GlobalTrie(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_GlobalTrie(yap_flags[TABLING_MODE_FLAG]);
} else if (value == 7) { /* CoInductive */
tab_ent_ptr tab_ent = GLOBAL_root_tab_ent;
while (tab_ent) {
SetMode_CoInductive(TabEnt_mode(tab_ent));
tab_ent = TabEnt_next(tab_ent);
}
SetMode_CoInductive(yap_flags[TABLING_MODE_FLAG]);
}
}
static bool string( Term inp ) {
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
}
if (IsStringTerm( inp ))
return true;
Term inp0 = inp;
if (IsPairTerm(inp)) {
Term hd = HeadOfTerm(inp);
if (IsAtomTerm(hd)) {
do {
Term hd = HeadOfTerm(inp);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(hd)) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
} while (IsPairTerm( inp ) );
} else if (IsIntTerm(hd)) {
do {
Term hd = HeadOfTerm(inp);
if (!IsIntTerm(hd)) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
if (IntOfTerm(hd) < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, inp0, "set_prolog_flag in 0...");
return false;
}
} while (IsPairTerm( inp ) );
} else {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
}
if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_TEXT, inp0, "set_prolog_flag in \"...\"");
return false;
}
return true;
}
2018-07-03 10:45:22 +01:00
x static bool list_atom( Term inp ) {
2016-01-03 01:32:04 +00:00
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
return false;
}
Term inp0 = inp;
if (IsPairTerm(inp)) {
Term hd = HeadOfTerm(inp);
do {
2018-07-21 01:56:48 +01:00
if (IsStringTerm(hd)) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (!IsAtomTerm(hd)) {
Yap_Error(TYPE_ERROR_ATOM, inp0, "set_prolog_flag in \"...\"");
return false;
}
} while (IsPairTerm( inp ) );
}
if ( inp != TermNil ) {
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
return false;
}
return true;
}
2015-06-18 01:59:07 +01:00
#endif
2016-05-12 11:49:40 +01:00
static Term list_option(Term inp) {
2015-06-18 01:59:07 +01:00
if (IsVarTerm(inp)) {
Yap_Error(INSTANTIATION_ERROR, inp, "set_prolog_flag in \"...\"");
2016-05-12 11:49:40 +01:00
return inp;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
Term inp0 = inp;
2015-06-18 01:59:07 +01:00
if (IsPairTerm(inp)) {
do {
2016-01-03 01:32:04 +00:00
Term hd = HeadOfTerm(inp);
inp = TailOfTerm(inp);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(hd)) {
hd = MkStringTerm(RepAtom(AtomOfTerm(hd))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (IsAtomTerm(hd)) {
continue;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
if (IsApplTerm(hd)) {
Functor f = FunctorOfTerm(hd);
if (!IsExtensionFunctor(f) && ArityOfFunctor(f) == 1 &&
Yap_IsGroundTerm(hd)) {
continue;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
if (!Yap_IsGroundTerm(hd))
Yap_Error(INSTANTIATION_ERROR, hd, "set_prolog_flag in \"...\"");
2016-05-12 11:49:40 +01:00
return TermZERO;
2016-01-03 01:32:04 +00:00
}
} while (IsPairTerm(inp));
if (inp == TermNil) {
2016-05-12 11:49:40 +01:00
return inp0;
2016-01-03 01:32:04 +00:00
}
Yap_Error(TYPE_ERROR_LIST, inp0, "set_prolog_flag in [...]");
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
} else /* lone option */ {
2018-07-21 01:56:48 +01:00
if (IsStringTerm(inp)) {
inp = MkStringTerm(RepAtom(AtomOfTerm(inp))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (IsAtomTerm(inp)) {
2016-05-12 11:49:40 +01:00
return inp;
2016-01-03 01:32:04 +00:00
} else if (IsApplTerm(inp)) {
Functor f = FunctorOfTerm(inp);
if (!IsExtensionFunctor(f) && ArityOfFunctor(f) == 1 &&
Yap_IsGroundTerm(ArgOfTerm(1, inp))) {
2016-05-12 11:49:40 +01:00
return inp;
2016-01-03 01:32:04 +00:00
}
}
2015-06-18 01:59:07 +01:00
}
2016-05-12 11:49:40 +01:00
return TermZERO;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
static bool agc_threshold(Term t) {
2015-06-18 01:59:07 +01:00
t = Deref(t);
if (IsVarTerm(t)) {
CACHE_REGS
return Yap_unify(t, MkIntegerTerm(GLOBAL_AGcThreshold));
} else if (!IsIntegerTerm(t)) {
2016-01-03 01:32:04 +00:00
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
2015-06-18 01:59:07 +01:00
return FALSE;
} else {
Int i = IntegerOfTerm(t);
2016-01-03 01:32:04 +00:00
if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 agc_margin");
2015-06-18 01:59:07 +01:00
return FALSE;
} else {
GLOBAL_AGcThreshold = i;
return TRUE;
}
}
}
2016-01-03 01:32:04 +00:00
static bool gc_margin(Term t) {
2015-06-18 01:59:07 +01:00
t = Deref(t);
if (IsVarTerm(t)) {
return Yap_unify(t, Yap_GetValue(AtomGcMargin));
} else if (!IsIntegerTerm(t)) {
2016-01-03 01:32:04 +00:00
Yap_Error(TYPE_ERROR_INTEGER, t, "prolog_flag/2 agc_margin");
2015-06-18 01:59:07 +01:00
return FALSE;
} else {
Int i = IntegerOfTerm(t);
2016-01-03 01:32:04 +00:00
if (i < 0) {
Yap_Error(DOMAIN_ERROR_NOT_LESS_THAN_ZERO, t, "prolog_flag/2 gc_margin");
2015-06-18 01:59:07 +01:00
return FALSE;
} else {
CACHE_REGS
2016-01-03 01:32:04 +00:00
Yap_PutValue(AtomGcMargin, MkIntegerTerm(i));
2016-05-12 11:49:40 +01:00
return true;
2015-06-18 01:59:07 +01:00
}
}
}
static Term mk_argc_list(USES_REGS1) {
2015-08-07 22:57:53 +01:00
int i = 1;
2015-06-18 01:59:07 +01:00
Term t = TermNil;
while (i < GLOBAL_argc) {
char *arg = GLOBAL_argv[i];
/* check for -L -- */
if (arg[0] == '-' && arg[1] == 'L') {
arg += 2;
while (*arg != '\0' && (*arg == ' ' || *arg == '\t'))
arg++;
if (*arg == '-' && arg[1] == '-' && arg[2] == '\0') {
/* we found the separator */
int j;
for (j = GLOBAL_argc - 1; j > i + 1; --j) {
t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])), t);
}
return t;
} else if (GLOBAL_argv[i + 1] && GLOBAL_argv[i + 1][0] == '-' &&
GLOBAL_argv[i + 1][1] == '-' &&
GLOBAL_argv[i + 1][2] == '\0') {
/* we found the separator */
int j;
for (j = GLOBAL_argc - 1; j > i + 2; --j) {
t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])), t);
}
return t;
}
}
if (arg[0] == '-' && arg[1] == '-' && arg[2] == '\0') {
/* we found the separator */
int j;
for (j = GLOBAL_argc - 1; j > i; --j) {
t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(GLOBAL_argv[j])), t);
}
return (t);
}
i++;
}
return (t);
}
static Term mk_os_argc_list(USES_REGS1) {
int i = 0;
Term t = TermNil;
for (i = 0; i < GLOBAL_argc; i++) {
char *arg = GLOBAL_argv[i];
t = MkPairTerm(MkAtomTerm(Yap_LookupAtom(arg)), t);
}
return (t);
}
2016-05-12 11:49:40 +01:00
static Term argv(Term inp) {
2015-06-18 01:59:07 +01:00
CACHE_REGS
2016-05-12 11:49:40 +01:00
return mk_argc_list(PASS_REGS1);
2015-06-18 01:59:07 +01:00
}
2016-05-12 11:49:40 +01:00
static Term os_argv(Term inp) {
2015-06-18 01:59:07 +01:00
CACHE_REGS
2016-05-12 11:49:40 +01:00
return mk_os_argc_list(PASS_REGS1);
2015-06-18 01:59:07 +01:00
}
static FlagEntry *
2016-01-03 01:32:04 +00:00
GetFlagProp(Atom a) { /* look property list of atom a for kind */
2015-06-18 01:59:07 +01:00
AtomEntry *ae = RepAtom(a);
FlagEntry *pp;
READ_LOCK(ae->ARWLock);
pp = RepFlagProp(ae->PropsOfAE);
while (!EndOfPAEntr(pp) && pp->KindOfPE != FlagProperty)
pp = RepFlagProp(pp->NextOfPE);
READ_UNLOCK(ae->ARWLock);
return pp;
}
2016-01-03 01:32:04 +00:00
static void initFlag(flag_info *f, int fnum, bool global) {
Atom name = Yap_LookupAtom(f->name);
2015-06-18 01:59:07 +01:00
AtomEntry *ae = RepAtom(name);
WRITE_LOCK(ae->ARWLock);
2016-01-03 01:32:04 +00:00
FlagEntry *fprop = RepFlagProp(Yap_GetAPropHavingLock(name, FlagProperty));
2015-06-18 01:59:07 +01:00
if (fprop == NULL) {
2016-01-03 01:32:04 +00:00
fprop = (FlagEntry *)Yap_AllocAtomSpace(sizeof(FlagEntry));
2015-06-18 01:59:07 +01:00
if (fprop == NULL) {
WRITE_UNLOCK(ae->ARWLock);
2016-01-03 01:32:04 +00:00
Yap_Error(RESOURCE_ERROR_HEAP, TermNil,
"not enough space for new Flag %s", ae->StrOfAE);
return;
2015-06-18 01:59:07 +01:00
}
fprop->KindOfPE = FlagProperty;
fprop->FlagOfVE = fnum;
fprop->rw = f->writable;
fprop->global = global;
fprop->type = f->def;
fprop->helper = f->helper;
AddPropToAtom(ae, AbsFlagProp(fprop));
}
WRITE_UNLOCK(ae->ARWLock);
}
2016-05-12 11:49:40 +01:00
static Term executable(Term inp) {
2015-06-18 01:59:07 +01:00
2016-07-31 10:22:22 +01:00
return MkAtomTerm(Yap_LookupAtom(Yap_FindExecutable()));
2015-06-18 01:59:07 +01:00
}
2016-05-12 11:49:40 +01:00
static Term sys_thread_id(Term inp) {
2016-01-03 01:32:04 +00:00
CACHE_REGS
2015-06-18 01:59:07 +01:00
int pid;
#ifdef HAVE_GETTID_SYSCALL
pid = syscall(__NR_gettid);
2016-01-03 01:32:04 +00:00
#elif defined(HAVE_GETTID_MACRO)
2015-06-18 01:59:07 +01:00
pid = gettid();
#elif defined(__WINDOWS__)
pid = GetCurrentThreadId();
#else
pid = 0;
#endif
2016-05-12 11:49:40 +01:00
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);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
static bool setYapFlagInModule(Term tflag, Term t2, Term mod) {
2015-09-29 23:11:57 +01:00
CACHE_REGS
2015-06-18 01:59:07 +01:00
FlagEntry *fv;
ModEntry *me = Yap_GetModuleEntry(mod);
if (!me)
2015-06-18 01:59:07 +01:00
return false;
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
if (!fv && !fv->global) {
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown module flag");
2015-09-21 23:05:36 +01:00
return false;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
if (mod == USER_MODULE) {
flag_term *tarr = GLOBAL_Flags;
if (!(fv->type(t2)))
return false;
2018-06-15 13:50:55 +01:00
2016-01-03 01:32:04 +00:00
if (fv->helper && !(fv->helper(t2)))
return false;
Term tout = tarr[fv->FlagOfVE].at;
if (IsVarTerm(tout)) {
Term t;
while ((t = Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT)) == 0) {
2018-07-10 23:21:19 +01:00
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
return false;
}
}
} else if (IsAtomOrIntTerm(t2))
2016-01-03 01:32:04 +00:00
tarr[fv->FlagOfVE].at = t2;
else {
tarr[fv->FlagOfVE].DBT = Yap_StoreTermInDB(t2, 2);
}
}
// module specific stuff now
2015-06-18 01:59:07 +01:00
if (fv->FlagOfVE == UNKNOWN_FLAG) {
me->flags &= ~(UNKNOWN_MASK);
2015-06-18 01:59:07 +01:00
if (t2 == TermError) {
me->flags |= (UNKNOWN_ERROR);
2015-06-18 01:59:07 +01:00
return true;
} else if (t2 == TermFail) {
me->flags |= (UNKNOWN_FAIL);
2015-06-18 01:59:07 +01:00
return true;
} else if (t2 == TermWarning) {
me->flags |= (UNKNOWN_WARNING);
2015-06-18 01:59:07 +01:00
return true;
2015-12-15 09:18:36 +00:00
} else if (t2 == TermFastFail) {
me->flags |= (UNKNOWN_FAST_FAIL);
2015-12-15 09:18:36 +00:00
return true;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
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);
2015-06-18 01:59:07 +01:00
return false;
2015-09-29 23:11:57 +01:00
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
return dqf1(me, t2 PASS_REGS);
2015-06-18 01:59:07 +01:00
} else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) {
if (t2 == TermTrue) {
me->flags |= M_CHARESCAPE;
2015-06-18 01:59:07 +01:00
return true;
} else if (t2 == TermFalse) {
me->flags &= ~(M_CHARESCAPE);
2015-09-29 23:11:57 +01:00
return true;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2,
"bad option %s for character_escapes flag, use true or false",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
2015-06-18 01:59:07 +01:00
return false;
2018-03-19 11:44:16 +00:00
} else if (fv->FlagOfVE == BACK_QUOTES_FLAG) {
return bqf1(me, t2 PASS_REGS);
2018-03-19 11:44:16 +00:00
} else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) {
return sqf1(me, t2 PASS_REGS);
2015-06-18 01:59:07 +01:00
}
2015-09-29 23:11:57 +01:00
// bad key?
return false;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
static Term getYapFlagInModule(Term tflag, Term mod) {
2015-06-18 01:59:07 +01:00
FlagEntry *fv;
ModEntry *me = Yap_GetModuleEntry(mod);
2015-06-18 01:59:07 +01:00
if (!mod)
return false;
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
if (!fv && !fv->global) {
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "trying to set unknown flag");
return 0L;
}
2016-01-03 01:32:04 +00:00
// module specific stuff now
2015-06-18 01:59:07 +01:00
if (fv->FlagOfVE == UNKNOWN_FLAG) {
if (me->flags & UNKNOWN_ERROR)
2015-06-18 01:59:07 +01:00
return TermError;
if (me->flags & UNKNOWN_WARNING)
2015-06-18 01:59:07 +01:00
return TermWarning;
return TermFail;
} else if (fv->FlagOfVE == CHARACTER_ESCAPES_FLAG) {
if (me->flags & M_CHARESCAPE)
2015-06-18 01:59:07 +01:00
return TermTrue;
2018-03-19 11:44:16 +00:00
} else if (fv->FlagOfVE == BACK_QUOTES_FLAG) {
if (me->flags & BCKQ_CHARS)
2016-01-03 01:32:04 +00:00
return TermChars;
if (me->flags & BCKQ_CODES)
2016-01-03 01:32:04 +00:00
return TermCodes;
if (me->flags & BCKQ_ATOM)
2016-01-03 01:32:04 +00:00
return TermAtom;
return TermString;
2018-03-19 11:44:16 +00:00
} else if (fv->FlagOfVE == SINGLE_QUOTES_FLAG) {
if (me->flags & SNGQ_CHARS)
return TermChars;
if (me->flags & SNGQ_CODES)
return TermCodes;
if (me->flags & SNGQ_ATOM)
return TermAtom;
return TermString;
2016-01-03 01:32:04 +00:00
} else if (fv->FlagOfVE == DOUBLE_QUOTES_FLAG) {
if (me->flags & DBLQ_CHARS)
2016-01-03 01:32:04 +00:00
return TermChars;
if (me->flags & DBLQ_CODES)
2016-01-03 01:32:04 +00:00
return TermCodes;
if (me->flags & DBLQ_ATOM)
2016-01-03 01:32:04 +00:00
return TermAtom;
return TermString;
}
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, tflag, "flag %s is not module-scoped",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
2015-06-18 01:59:07 +01:00
return 0L;
}
2016-01-03 01:32:04 +00:00
static Int cont_yap_flag(USES_REGS1) {
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
2015-06-18 01:59:07 +01:00
int gmax = GLOBAL_flagCount;
int lmax = LOCAL_flagCount;
Term tflag = Deref(ARG1);
2016-01-03 01:32:04 +00:00
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i + 1);
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
2015-06-18 01:59:07 +01:00
Term modt = CurrentModule;
2016-01-03 01:32:04 +00:00
tflag = Yap_StripModule(tflag, &modt);
while (i != gmax && i != UNKNOWN_FLAG && i != CHARACTER_ESCAPES_FLAG &&
2018-07-10 23:21:19 +01:00
i != BACK_QUOTES_FLAG && i != SINGLE_QUOTES_FLAG &&
2018-03-19 11:44:16 +00:00
i != DOUBLE_QUOTES_FLAG)
2016-01-03 01:32:04 +00:00
i++;
if (i == gmax)
cut_fail();
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(i + 1);
2015-06-18 01:59:07 +01:00
{
2016-01-03 01:32:04 +00:00
Term lab = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
2015-06-18 01:59:07 +01:00
Term val = Deref(ARG2);
2016-01-03 01:32:04 +00:00
if (!Yap_unify(tflag, lab))
return false;
2015-06-18 01:59:07 +01:00
if (IsVarTerm(val)) {
2016-01-03 01:32:04 +00:00
Term oval = getYapFlagInModule(lab, modt);
if (oval == 0)
return false;
return Yap_unify(oval, val);
2015-06-18 01:59:07 +01:00
} else {
2016-01-03 01:32:04 +00:00
return setYapFlagInModule(tflag, val, modt);
2015-06-18 01:59:07 +01:00
}
}
return false;
}
2016-01-03 01:32:04 +00:00
if (i >= gmax) {
Yap_unify(ARG1,
MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name)));
if (i == gmax + lmax - 1)
2015-06-18 01:59:07 +01:00
do_cut(0);
2016-01-03 01:32:04 +00:00
} else {
Yap_unify(ARG1, MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name)));
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
Term flag = getYapFlag(Deref(ARG1));
return Yap_unify(flag, ARG2);
2015-06-18 01:59:07 +01:00
}
static Int yap_flag(USES_REGS1) {
Term tflag = Deref(ARG1);
2016-01-03 01:32:04 +00:00
if (IsVarTerm(tflag)) {
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
return cont_yap_flag(PASS_REGS1);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
2015-06-18 01:59:07 +01:00
Term modt;
2016-01-03 01:32:04 +00:00
tflag = Yap_StripModule(tflag, &modt);
2015-06-18 01:59:07 +01:00
if (IsVarTerm(tflag)) {
2016-01-03 01:32:04 +00:00
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
return cont_yap_flag(PASS_REGS1);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
do_cut(0);
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
if (!isatom(tflag))
return false;
if (!isatom(modt))
return false;
2015-06-18 01:59:07 +01:00
if (IsVarTerm(Deref(ARG2))) {
2016-01-03 01:32:04 +00:00
Term flag = getYapFlagInModule(tflag, modt);
2015-06-18 01:59:07 +01:00
if (flag == 0)
2016-01-03 01:32:04 +00:00
return false;
return Yap_unify(flag, ARG2);
2015-06-18 01:59:07 +01:00
} else {
2016-01-03 01:32:04 +00:00
return setYapFlagInModule(tflag, Deref(ARG2), modt);
2015-06-18 01:59:07 +01:00
}
}
2016-01-03 01:32:04 +00:00
do_cut(0);
2015-06-18 01:59:07 +01:00
if (IsVarTerm(Deref(ARG2))) {
2016-01-03 01:32:04 +00:00
Term flag = getYapFlag(Deref(ARG1));
2015-06-18 01:59:07 +01:00
if (flag == 0)
return false;
2016-01-03 01:32:04 +00:00
return Yap_unify(flag, ARG2);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
return set_prolog_flag(PASS_REGS1);
2015-06-18 01:59:07 +01:00
}
static Int cont_prolog_flag(USES_REGS1) {
2016-01-03 01:32:04 +00:00
int i = IntOfTerm(EXTRA_CBACK_ARG(3, 1));
while (i < GLOBAL_flagCount + LOCAL_flagCount) {
2015-06-18 01:59:07 +01:00
int gmax = GLOBAL_flagCount;
int lmax = LOCAL_flagCount;
Term flag, f;
2016-01-03 01:32:04 +00:00
if (i >= gmax + lmax) {
2015-06-18 01:59:07 +01:00
cut_fail();
} else if (i >= gmax) {
2016-01-03 01:32:04 +00:00
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))));
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(++i);
flag = getYapFlag(f);
if (!Yap_unify(flag, ARG2))
2016-01-03 01:32:04 +00:00
return false;
return setYapFlag(f, Deref(ARG3));
2015-06-18 01:59:07 +01:00
}
cut_fail();
}
/** @pred prolog_flag(? _Flag_,- _OldValue_,+ _NewValue_)
Obtain the value for a YAP Prolog flag and then set it to a new
value. Equivalent to first calling current_prolog_flag/2 with the
second argument _OldValue_ unbound and then calling
set_prolog_flag/2 with the third argument _NewValue_.
*/
static Int prolog_flag(USES_REGS1) {
2016-01-03 01:32:04 +00:00
if (IsVarTerm(Deref(ARG1))) {
EXTRA_CBACK_ARG(3, 1) = MkIntTerm(0);
return cont_prolog_flag(PASS_REGS1);
}
do_cut(0);
if (IsVarTerm(Deref(ARG3))) {
Term flag = getYapFlag(Deref(ARG1));
2015-06-18 01:59:07 +01:00
if (flag == 0)
return false;
2016-01-03 01:32:04 +00:00
return Yap_unify(flag, ARG2);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
return setYapFlag(Deref(ARG1), Deref(ARG3));
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
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);
return Yap_unify(flag, ARG2);
2016-01-03 01:32:04 +00:00
}
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);
}
2015-06-18 01:59:07 +01:00
/** @pred current_prolog_flag(? _Flag_,- _Value_) is iso
Obtain the value for a YAP Prolog flag. Equivalent to calling
yap_flag/2 with the second argument unbound, and unifying the
returned second argument with _Value_.
*/
2016-01-03 01:32:04 +00:00
static Int current_prolog_flag2(USES_REGS1) {
2015-06-18 01:59:07 +01:00
Term tflag = Deref(ARG1);
Term tout = 0;
FlagEntry *fv;
flag_term *tarr;
if (IsVarTerm(tflag)) {
2016-01-03 01:32:04 +00:00
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
return cont_yap_flag(PASS_REGS1);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
do_cut(0);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "current_prolog_flag/3");
return (FALSE);
}
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
if (!fv) {
// should itself depend on a flag
return FALSE;
}
if (fv->global)
tarr = GLOBAL_Flags;
else
tarr = LOCAL_Flags;
tout = tarr[fv->FlagOfVE].at;
2016-05-12 11:49:40 +01:00
if (tout == TermZERO) {
2017-05-08 18:51:29 +01:00
// Yap_DebugPlWriteln(tflag);
2016-05-12 11:49:40 +01:00
return false;
}
2015-06-18 01:59:07 +01:00
if (IsVarTerm(tout))
tout = Yap_FetchTermFromDB(tarr[fv->FlagOfVE].DBT);
return (Yap_unify(ARG2, tout));
}
2016-01-03 01:32:04 +00:00
void Yap_setModuleFlags(ModEntry *new, ModEntry *cme) {
2015-09-29 23:11:57 +01:00
CACHE_REGS
2015-06-18 01:59:07 +01:00
Atom at = new->AtomOfME;
2015-09-21 23:05:36 +01:00
if (at == AtomProlog || CurrentModule == PROLOG_MODULE) {
2018-07-10 23:21:19 +01:00
new->flags = M_SYSTEM | UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES |
BCKQ_STRING | SNGQ_ATOM;
2016-01-03 01:32:04 +00:00
if (at == AtomUser)
2018-07-10 23:21:19 +01:00
new->flags =
UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM;
2016-01-03 01:32:04 +00:00
} else if (cme && cme->flags && cme != new) {
2015-06-18 01:59:07 +01:00
new->flags = cme->flags;
2015-09-21 23:05:36 +01:00
} else {
2018-07-10 23:21:19 +01:00
new->flags =
(UNKNOWN_ERROR | M_CHARESCAPE | DBLQ_CODES | BCKQ_STRING | SNGQ_ATOM);
2015-09-21 23:05:36 +01:00
}
2016-01-03 01:32:04 +00:00
// printf("cme=%s new=%s flags=%x\n",cme,at->StrOfAE,new->flags);
2015-09-21 23:05:36 +01:00
}
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
bool setYapFlag(Term tflag, Term t2) {
2015-06-18 01:59:07 +01:00
FlagEntry *fv;
flag_term *tarr;
2016-01-03 01:32:04 +00:00
if (IsVarTerm(tflag)) {
2015-06-18 01:59:07 +01:00
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
2018-07-21 01:56:48 +01:00
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
2015-06-18 01:59:07 +01:00
Term modt;
2016-01-03 01:32:04 +00:00
tflag = Yap_StripModule(tflag, &modt);
if (!isatom(tflag))
return false;
if (!isatom(modt))
return false;
return setYapFlagInModule(tflag, t2, modt);
2015-06-18 01:59:07 +01:00
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
if (!fv) {
Term fl = GLOBAL_Flags[USER_FLAGS_FLAG].at;
if (fl == TermSilent) {
2016-01-03 01:32:04 +00:00
CACHE_REGS
Term t2 = Deref(ARG2);
newFlag(tflag, t2);
2015-06-18 01:59:07 +01:00
} else if (fl == TermWarning) {
Yap_Warning("Flag %s does not exist", RepAtom(AtomOfTerm(fl))->StrOfAE);
} else {
2016-05-12 11:49:40 +01:00
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to set unknown flag \"%s\"",
AtomName(AtomOfTerm(tflag)));
2015-06-18 01:59:07 +01:00
}
2016-05-12 11:49:40 +01:00
return false;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
if (fv->global) {
2016-01-06 12:31:53 +00:00
CACHE_REGS
2016-01-03 01:32:04 +00:00
switch (fv->FlagOfVE) {
case UNKNOWN_FLAG:
case CHARACTER_ESCAPES_FLAG:
2018-03-19 11:44:16 +00:00
case BACK_QUOTES_FLAG:
case DOUBLE_QUOTES_FLAG:
case SINGLE_QUOTES_FLAG:
2016-01-03 01:32:04 +00:00
return setYapFlagInModule(tflag, t2, CurrentModule);
default:
tarr = GLOBAL_Flags;
}
} else {
CACHE_REGS
tarr = LOCAL_Flags;
2015-06-18 01:59:07 +01:00
}
2016-05-12 11:49:40 +01:00
if (!(t2 = fv->type(t2)))
2015-06-18 01:59:07 +01:00
return false;
if (fv->helper && !(fv->helper(t2)))
return false;
Term tout = tarr[fv->FlagOfVE].at;
if (IsVarTerm(tout))
2016-01-03 01:32:04 +00:00
Yap_PopTermFromDB(tarr[fv->FlagOfVE].DBT);
2015-06-18 01:59:07 +01:00
if (IsAtomOrIntTerm(t2))
tarr[fv->FlagOfVE].at = t2;
else {
tarr[fv->FlagOfVE].DBT = Yap_StoreTermInDB(t2, 2);
}
return true;
}
Term Yap_UnknownFlag(Term mod) {
2016-04-26 15:33:16 +01:00
if (mod == PROLOG_MODULE)
mod = TermProlog;
2016-04-26 15:33:16 +01:00
ModEntry *fv = Yap_GetModuleEntry(mod);
if (fv == NULL)
2016-04-26 15:33:16 +01:00
fv = Yap_GetModuleEntry(TermUser);
if (fv->flags & UNKNOWN_ERROR)
return TermError;
if (fv->flags & UNKNOWN_WARNING)
return TermWarning;
return TermFail;
}
2016-01-03 01:32:04 +00:00
Term getYapFlag(Term tflag) {
2015-06-18 01:59:07 +01:00
FlagEntry *fv;
2018-10-11 07:47:28 +01:00
flag_term *tarr;
tflag = Deref(tflag);
if (IsVarTerm(tflag)) {
2015-06-18 01:59:07 +01:00
Yap_Error(INSTANTIATION_ERROR, tflag, "yap_flag/2");
return (FALSE);
}
2018-07-21 01:56:48 +01:00
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
2015-06-18 01:59:07 +01:00
Term modt;
2016-01-03 01:32:04 +00:00
tflag = Yap_StripModule(tflag, &modt);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (!isatom(tflag))
return false;
2018-07-21 01:56:48 +01:00
if (IsStringTerm(modt)) {
modt = MkStringTerm(RepAtom(AtomOfTerm(modt))->StrOfAE);
}
2016-01-03 01:32:04 +00:00
if (!isatom(modt))
return false;
return getYapFlagInModule(tflag, modt);
2015-06-18 01:59:07 +01:00
}
if (!IsAtomTerm(tflag)) {
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
2018-10-11 07:47:28 +01:00
if (tflag == TermSilent)
{
Yap_DebugPlWriteln(TermSilent);
}
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
if (!fv) {
Term fl = GLOBAL_Flags[USER_FLAGS_FLAG].at;
if (fl == TermSilent) {
2016-01-03 01:32:04 +00:00
return false;
2015-06-18 01:59:07 +01:00
} else if (fl == TermWarning) {
2016-05-12 11:49:40 +01:00
Yap_Warning("Flag ~s does not exist",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
2015-06-18 01:59:07 +01:00
} else {
2016-05-12 11:49:40 +01:00
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, tflag,
"trying to use unknown flag %s",
RepAtom(AtomOfTerm(tflag))->StrOfAE);
2015-06-18 01:59:07 +01:00
}
return false;
2015-06-18 01:59:07 +01:00
}
if (fv->global)
tarr = GLOBAL_Flags;
else {
2016-01-03 01:32:04 +00:00
CACHE_REGS
tarr = LOCAL_Flags;
2015-06-18 01:59:07 +01:00
}
Term tout = tarr[fv->FlagOfVE].at;
if (IsVarTerm(tout))
2016-01-03 01:32:04 +00:00
return Yap_FetchTermFromDB(tarr[fv->FlagOfVE].DBT);
2015-06-18 01:59:07 +01:00
else
return tout;
}
/** @pred set_prolog_flag(+ _Flag_,+ _Value_) is iso
Set the value for YAP Prolog flag `Flag`. Equivalent to
calling yap_flag/2 with both arguments bound.
*/
static Int set_prolog_flag(USES_REGS1) {
Term tflag = Deref(ARG1), t2 = Deref(ARG2);
2016-01-03 01:32:04 +00:00
return setYapFlag(tflag, t2);
}
2015-06-18 01:59:07 +01:00
/** @pred source
After executing this goal, YAP keeps information on the source
of the predicates that will be consulted. This enables the use of
2018-05-08 23:42:02 +01:00
listing/0, listing/1 and clause/2 for those
2015-06-18 01:59:07 +01:00
clauses.
The same as `source_mode(_,on)` or as declaring all newly defined
static procedures as `public`.
*/
static Int source(USES_REGS1) {
setBooleanGlobalPrologFlag(SOURCE_FLAG, true);
return true;
}
/** @pred no_source
2016-01-03 01:32:04 +00:00
The opposite to `source`.
2015-06-18 01:59:07 +01:00
The same as `source_mode(_,off)`.
*/
static Int no_source(USES_REGS1) {
setBooleanGlobalPrologFlag(SOURCE_FLAG, false);
return true;
}
/**
2016-01-03 01:32:04 +00:00
@pred source_mode(- _O_,+ _N_)
2015-06-18 01:59:07 +01:00
The state of source mode can either be on or off. When the source mode
is on, all clauses are kept both as compiled code and in a "hidden"
database. _O_ is unified with the previous state and the mode is set
according to _N_.
*/
2016-01-03 01:32:04 +00:00
static Int source_mode(USES_REGS1) {
2015-06-18 01:59:07 +01:00
Term targ;
bool current = trueGlobalPrologFlag(SOURCE_FLAG);
2016-01-03 01:32:04 +00:00
if (current && !Yap_unify_constant(ARG1, TermTrue))
2015-06-18 01:59:07 +01:00
return false;
2016-01-03 01:32:04 +00:00
if (!current && !Yap_unify_constant(ARG1, TermFalse))
2015-06-18 01:59:07 +01:00
return false;
targ = Deref(ARG2);
setYapFlag(TermSource, targ);
2015-06-18 01:59:07 +01:00
return true;
}
2016-01-03 01:32:04 +00:00
static bool setInitialValue(bool bootstrap, flag_func f, const char *s,
flag_term *tarr) {
2015-06-18 01:59:07 +01:00
errno = 0;
2016-12-04 18:52:42 +00:00
const char *ss = (const char *)s;
2015-06-18 01:59:07 +01:00
if (f == booleanFlag) {
2016-01-03 01:32:04 +00:00
if (!bootstrap) {
return 0;
}
2016-12-04 18:52:42 +00:00
const char *ss = (const char *)s;
if (!strcmp(ss, "true")) {
2015-06-18 01:59:07 +01:00
tarr->at = TermTrue;
return true;
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "false")) {
2016-01-03 01:32:04 +00:00
tarr->at = TermFalse;
return true;
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "on")) {
2016-01-03 01:32:04 +00:00
tarr->at = TermTrue;
2015-06-18 01:59:07 +01:00
return true;
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "off")) {
2016-01-03 01:32:04 +00:00
tarr->at = TermFalse;
2015-06-18 01:59:07 +01:00
return true;
}
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
2015-06-18 01:59:07 +01:00
return false;
} else if (f == nat) {
2016-01-03 01:32:04 +00:00
if (!bootstrap) {
return 0;
}
2016-12-04 18:52:42 +00:00
UInt r = strtoul(ss, NULL, 10);
2015-06-18 01:59:07 +01:00
Term t;
if (errno) {
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s);
2015-06-18 01:59:07 +01:00
return false;
}
CACHE_REGS
2016-01-03 01:32:04 +00:00
t = MkIntegerTerm(r);
2015-06-18 01:59:07 +01:00
if (IsIntTerm(t))
2016-01-03 01:32:04 +00:00
tarr->at = t;
2015-06-18 01:59:07 +01:00
else {
tarr->DBT = Yap_StoreTermInDB(t, 2);
}
return true;
} else if (f == at2n) {
2016-01-03 01:32:04 +00:00
if (!bootstrap) {
2016-05-12 11:49:40 +01:00
return false;
2016-01-03 01:32:04 +00:00
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "INT_MAX")) {
2015-06-18 01:59:07 +01:00
tarr->at = MkIntTerm(Int_MAX);
return true;
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "MAX_THREADS")) {
2016-01-03 01:32:04 +00:00
tarr->at = MkIntTerm(MAX_THREADS);
return true;
2015-06-18 01:59:07 +01:00
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "MAX_WORKERS")) {
2016-01-03 01:32:04 +00:00
tarr->at = MkIntTerm(MAX_WORKERS);
return true;
2015-06-18 01:59:07 +01:00
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "INT_MIN")) {
2016-01-03 01:32:04 +00:00
tarr->at = MkIntTerm(Int_MIN);
return true;
2015-06-18 01:59:07 +01:00
}
2016-12-04 18:52:42 +00:00
if (!strcmp(ss, "YAP_NUMERIC_VERSION")) {
2016-01-03 01:32:04 +00:00
tarr->at = MkIntTerm(atol(YAP_NUMERIC_VERSION));
return true;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be either true (on) or false (off)", s);
2015-06-18 01:59:07 +01:00
return false;
} else if (f == isatom) {
2016-01-03 01:32:04 +00:00
if (!bootstrap) {
return false;
}
2015-06-18 01:59:07 +01:00
Atom r = Yap_LookupAtom(s);
if (errno) {
2016-01-03 01:32:04 +00:00
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, TermNil,
"~s should be a positive integer)", s);
tarr->at = TermNil;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
tarr->at = MkAtomTerm(r);
2015-06-18 01:59:07 +01:00
return true;
2016-01-03 01:32:04 +00:00
} else if (f == options) {
CACHE_REGS
char tmp[512];
Term t0;
if (bootstrap) {
2016-05-12 11:49:40 +01:00
return true;
2016-01-03 01:32:04 +00:00
}
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;
}
}
2016-12-04 18:52:42 +00:00
} else if (strcmp(ss, "@boot") == 0) {
2016-05-12 11:49:40 +01:00
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);
}
2015-06-18 01:59:07 +01:00
} else {
Term t0;
2016-01-03 01:32:04 +00:00
if (bootstrap) {
return false;
}
2016-04-26 15:33:16 +01:00
CACHE_REGS
2018-07-10 23:21:19 +01:00
const char *us = (const char *)s;
t0 = Yap_BufferToTermWithPrioBindings(us, TermNil, 0L, strlen(s) + 1,
GLOBAL_MaxPriority);
2015-06-18 01:59:07 +01:00
if (!t0)
return false;
2018-07-21 01:56:48 +01:00
if (IsStringTerm(t0)) {
t0 = MkStringTerm(RepAtom(AtomOfTerm(t0))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (IsAtomTerm(t0) || IsIntTerm(t0)) {
2015-08-07 22:57:53 +01:00
// do yourself flags
if (t0 == MkAtomTerm(AtomQuery)) {
2016-01-03 01:32:04 +00:00
f(TermNil);
2015-08-07 22:57:53 +01:00
} else {
2016-01-03 01:32:04 +00:00
tarr->at = t0;
2015-08-07 22:57:53 +01:00
}
2015-06-18 01:59:07 +01:00
} else {
tarr->DBT = Yap_StoreTermInDB(t0, 2);
}
return true;
}
2016-05-12 11:49:40 +01:00
return false;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
#define PROLOG_FLAG_PROPERTY_DEFS() \
2016-04-26 15:33:16 +01:00
PAR("access", isaccess, PROLOG_FLAG_PROPERTY_ACCESS, "read_write") \
, PAR("type", isground, PROLOG_FLAG_PROPERTY_TYPE, "term"), \
2016-01-03 01:32:04 +00:00
PAR("scope", flagscope, PROLOG_FLAG_PROPERTY_SCOPE, "global"), \
2016-04-26 15:33:16 +01:00
PAR("keep", booleanFlag, PROLOG_FLAG_PROPERTY_KEEP, "false"), \
2016-01-03 01:32:04 +00:00
PAR(NULL, ok, PROLOG_FLAG_PROPERTY_END, 0)
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
#define PAR(x, y, z, w) z
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
typedef enum prolog_flag_property_enum_choices {
PROLOG_FLAG_PROPERTY_DEFS()
} prolog_flag_property_choices_t;
2015-06-18 01:59:07 +01:00
#undef PAR
2016-01-03 01:32:04 +00:00
#define PAR(x, y, z, w) \
{ x, y, z, w }
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
static const param2_t prolog_flag_property_defs[] = {
PROLOG_FLAG_PROPERTY_DEFS()};
2015-06-18 01:59:07 +01:00
#undef PAR
static Int
2016-01-03 01:32:04 +00:00
do_prolog_flag_property(Term tflag,
Term opts USES_REGS) { /* Init current_prolog_flag */
2015-06-18 01:59:07 +01:00
FlagEntry *fv;
xarg *args;
prolog_flag_property_choices_t i;
bool rc = true;
2018-07-10 23:21:19 +01:00
args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
2015-06-18 01:59:07 +01:00
if (args == NULL) {
2016-10-20 04:44:59 +01:00
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
2015-06-18 01:59:07 +01:00
}
2018-07-21 01:56:48 +01:00
if (IsStringTerm(tflag)) {
tflag = MkStringTerm(RepAtom(AtomOfTerm(tflag))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (!IsAtomTerm(tflag)) {
2016-01-03 01:32:04 +00:00
if (IsApplTerm(tflag) && FunctorOfTerm(tflag) == FunctorModule) {
2015-06-18 01:59:07 +01:00
Term modt = CurrentModule;
2016-01-03 01:32:04 +00:00
tflag = Yap_YapStripModule(tflag, &modt);
2015-06-18 01:59:07 +01:00
} else {
2016-05-14 02:25:51 +01:00
free(args);
2015-06-18 01:59:07 +01:00
Yap_Error(TYPE_ERROR_ATOM, tflag, "yap_flag/2");
return (FALSE);
}
}
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
for (i = 0; i < PROLOG_FLAG_PROPERTY_END; i++) {
2015-06-18 01:59:07 +01:00
if (args[i].used) {
switch (i) {
case PROLOG_FLAG_PROPERTY_ACCESS:
2016-01-03 01:32:04 +00:00
if (fv->rw)
rc = rc && Yap_unify(TermReadWrite,
args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
else
rc = rc && Yap_unify(TermReadOnly,
args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue);
break;
2015-06-18 01:59:07 +01:00
case PROLOG_FLAG_PROPERTY_TYPE:
if (fv->type == booleanFlag)
2016-01-03 01:32:04 +00:00
rc = rc &&
Yap_unify(TermBoolean, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
else if (fv->type == isatom)
rc =
rc && Yap_unify(TermAtom, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
else if (fv->type == nat)
rc = rc &&
Yap_unify(TermInteger, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
else if (fv->type == isfloat)
rc = rc &&
Yap_unify(TermFloat, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
else
2016-05-12 11:49:40 +01:00
rc =
rc && Yap_unify(TermTerm, args[PROLOG_FLAG_PROPERTY_TYPE].tvalue);
2016-01-03 01:32:04 +00:00
break;
case PROLOG_FLAG_PROPERTY_KEEP:
rc = rc && false;
break;
case PROLOG_FLAG_PROPERTY_SCOPE:
if (fv->global) {
if (fv->FlagOfVE == UNKNOWN_FLAG ||
fv->FlagOfVE == CHARACTER_ESCAPES_FLAG ||
2018-03-19 11:44:16 +00:00
fv->FlagOfVE == SINGLE_QUOTES_FLAG ||
fv->FlagOfVE == DOUBLE_QUOTES_FLAG ||
fv->FlagOfVE == BACK_QUOTES_FLAG)
2016-01-03 01:32:04 +00:00
Yap_unify(TermModule, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue);
rc = rc &&
Yap_unify(TermGlobal, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue);
} else
rc = rc &&
Yap_unify(TermThread, args[PROLOG_FLAG_PROPERTY_SCOPE].tvalue);
break;
2015-06-18 01:59:07 +01:00
case PROLOG_FLAG_PROPERTY_END:
2016-01-03 01:32:04 +00:00
/* break; */
Yap_Error(DOMAIN_ERROR_PROLOG_FLAG, opts, "Flag not supported by YAP");
2015-06-18 01:59:07 +01:00
}
}
}
2015-06-18 07:55:07 +01:00
// UNLOCK(GLOBAL_Prolog_Flag[sno].prolog_flaglock);
free(args);
2015-06-18 01:59:07 +01:00
return rc;
}
2016-01-03 01:32:04 +00:00
static Int cont_prolog_flag_property(USES_REGS1) { /* current_prolog_flag */
int i = IntOfTerm(EXTRA_CBACK_ARG(2, 1));
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
while (i < GLOBAL_flagCount + LOCAL_flagCount) {
2015-06-18 01:59:07 +01:00
int gmax = GLOBAL_flagCount;
int lmax = LOCAL_flagCount;
Term lab;
2016-01-03 01:32:04 +00:00
if (i >= gmax + lmax) {
2015-06-18 01:59:07 +01:00
cut_fail();
} else if (i >= gmax) {
2016-01-03 01:32:04 +00:00
lab = MkAtomTerm(Yap_LookupAtom(local_flags_setup[i - gmax].name));
} else {
if (i == UNKNOWN_FLAG || i == CHARACTER_ESCAPES_FLAG ||
2018-07-10 23:21:19 +01:00
i == SINGLE_QUOTES_FLAG || i == DOUBLE_QUOTES_FLAG ||
i == BACK_QUOTES_FLAG) {
2016-01-03 01:32:04 +00:00
Term labs[2];
labs[0] = MkVarTerm();
labs[1] = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
lab = Yap_MkApplTerm(FunctorModule, 2, labs);
2015-06-18 01:59:07 +01:00
} else {
2016-01-03 01:32:04 +00:00
lab = MkAtomTerm(Yap_LookupAtom(global_flags_setup[i].name));
2015-06-18 01:59:07 +01:00
}
}
2016-01-03 01:32:04 +00:00
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(++i);
2015-06-18 01:59:07 +01:00
Yap_unify(ARG1, lab);
return do_prolog_flag_property(lab, Deref(ARG2) PASS_REGS);
}
cut_fail();
}
/** @pred prolog_flag_property(+ _Flag_,+ _Prooperties_)
Report a property for a YAP Prolog flag. _Properties_ include
2016-01-03 01:32:04 +00:00
* `type(+_Type_)` with _Type_ one of `boolean`, `integer`, `float`, `atom`
2015-06-18 01:59:07 +01:00
and `term` (that is, any ground term)
2016-01-03 01:32:04 +00:00
* `access(+_Access_)` with _Access_ one of `read_only` or `read_write`
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
* `scope(+_Scope_) the flag aplies to a `thread`, to a `module`, or is
`global` to the system.
2015-06-18 01:59:07 +01:00
*/
2016-01-03 01:32:04 +00:00
static Int prolog_flag_property(USES_REGS1) { /* Init current_prolog_flag */
2015-06-18 01:59:07 +01:00
Term t1 = Deref(ARG1);
/* make valgrind happy by always filling in memory */
2016-01-03 01:32:04 +00:00
EXTRA_CBACK_ARG(2, 1) = MkIntTerm(0);
2018-07-21 01:56:48 +01:00
if (IsStringTerm(t1)) {
t1 = MkStringTerm(RepAtom(AtomOfTerm(t1))->StrOfAE);
}
2015-06-18 01:59:07 +01:00
if (IsVarTerm(t1)) {
2016-01-03 01:32:04 +00:00
return (cont_prolog_flag_property(PASS_REGS1));
2015-06-18 01:59:07 +01:00
} else {
2016-01-03 01:32:04 +00:00
if (IsApplTerm(t1) && FunctorOfTerm(t1) == FunctorModule) {
2015-06-18 01:59:07 +01:00
Term modt;
2016-01-03 01:32:04 +00:00
t1 = Yap_StripModule(t1, &modt);
if (IsAtomTerm(modt)) {
Int rc;
rc = cont_prolog_flag_property(PASS_REGS1);
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
return rc;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
} else if (IsAtomTerm(t1)) {
2015-06-18 01:59:07 +01:00
do_cut(0);
2016-01-03 01:32:04 +00:00
return do_prolog_flag_property(t1, Deref(ARG2) PASS_REGS);
2015-06-18 01:59:07 +01:00
} else {
Yap_Error(TYPE_ERROR_ATOM, t1, "prolog_flag_property/2");
}
}
return false;
}
2016-01-03 01:32:04 +00:00
static void newFlag(Term fl, Term val) {
flag_info f;
int i = GLOBAL_flagCount;
2015-06-18 01:59:07 +01:00
2016-01-03 01:32:04 +00:00
GLOBAL_flagCount++;
2015-09-21 23:05:36 +01:00
f.name = (char *)RepAtom(AtomOfTerm(fl))->StrOfAE;
2015-06-18 01:59:07 +01:00
f.writable = true;
2016-10-16 19:11:44 +01:00
f.helper = NULL;
2015-06-18 01:59:07 +01:00
f.def = ok;
2016-01-03 01:32:04 +00:00
initFlag(&f, i, true);
if (IsAtomOrIntTerm(val)) {
GLOBAL_Flags[i].at = val;
} else {
GLOBAL_Flags[i].DBT = Yap_StoreTermInDB(val, 2);
}
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
static Int do_create_prolog_flag(USES_REGS1) {
2015-06-18 01:59:07 +01:00
FlagEntry *fv;
xarg *args;
prolog_flag_property_choices_t i;
Term tflag = Deref(ARG1), tval = Deref(ARG2), opts = Deref(ARG3);
2018-07-10 23:21:19 +01:00
args =
Yap_ArgList2ToVector(opts, prolog_flag_property_defs,
PROLOG_FLAG_PROPERTY_END, DOMAIN_ERROR_PROLOG_FLAG);
2016-04-26 15:33:16 +01:00
if (args == NULL) {
2016-10-20 04:44:59 +01:00
Yap_Error(LOCAL_Error_TYPE, opts, NULL);
return false;
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
if (fv) {
2016-01-03 01:32:04 +00:00
if (args[PROLOG_FLAG_PROPERTY_KEEP].used &&
2016-05-14 02:25:51 +01:00
args[PROLOG_FLAG_PROPERTY_KEEP].tvalue == TermTrue) {
free(args);
2015-06-18 01:59:07 +01:00
return true;
2016-05-14 02:25:51 +01:00
}
2015-06-18 01:59:07 +01:00
} else {
2016-01-03 01:32:04 +00:00
newFlag(tflag, tval);
fv = GetFlagProp(AtomOfTerm(tflag));
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
for (i = 0; i < PROLOG_FLAG_PROPERTY_END; i++) {
2015-06-18 01:59:07 +01:00
if (args[i].used) {
switch (i) {
2016-01-03 01:32:04 +00:00
case PROLOG_FLAG_PROPERTY_KEEP:
break;
2015-06-18 01:59:07 +01:00
case PROLOG_FLAG_PROPERTY_ACCESS:
2016-01-03 01:32:04 +00:00
if (args[PROLOG_FLAG_PROPERTY_ACCESS].tvalue == TermReadWrite)
fv->rw = true;
else
fv->rw = false;
break;
case PROLOG_FLAG_PROPERTY_TYPE: {
Term ttype = args[PROLOG_FLAG_PROPERTY_TYPE].tvalue;
if (ttype == TermBoolean)
fv->type = booleanFlag;
2016-01-03 01:32:04 +00:00
else if (ttype == TermInteger)
fv->type = isatom;
else if (ttype == TermFloat)
fv->type = isfloat;
else
fv->type = isground;
} break;
case PROLOG_FLAG_PROPERTY_SCOPE:
2016-12-04 18:52:42 +00:00
free(args);
2016-01-03 01:32:04 +00:00
return false;
2015-06-18 01:59:07 +01:00
case PROLOG_FLAG_PROPERTY_END:
2016-01-03 01:32:04 +00:00
break;
2015-06-18 01:59:07 +01:00
}
}
}
2016-01-03 01:32:04 +00:00
// UNLOCK(GLOBAL_Prolog_Flag[sno].prolog_flaglock);
2016-05-14 02:25:51 +01:00
free(args);
2015-06-18 01:59:07 +01:00
return true;
}
/**
2018-07-10 23:21:19 +01:00
* 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;
* later, it looks at flags that are structured terms
*
* @param bootstrap: wether this is done before stack initialization, or
*afterwards.
* Complex terms can only be built in the second step.
*/
2016-01-03 01:32:04 +00:00
void Yap_InitFlags(bool bootstrap) {
CACHE_REGS
tr_fr_ptr tr0 = TR;
flag_info *f = global_flags_setup;
2015-06-18 01:59:07 +01:00
GLOBAL_flagCount = 0;
if (bootstrap) {
2016-01-03 01:32:04 +00:00
GLOBAL_Flags = (union flagTerm *)Yap_AllocCodeSpace(
sizeof(union flagTerm) *
(2 * sizeof(global_flags_setup) / sizeof(flag_info)));
2015-06-18 01:59:07 +01:00
}
while (f->name != NULL) {
2016-01-03 01:32:04 +00:00
bool itf = setInitialValue(bootstrap, f->def, f->init,
GLOBAL_Flags + GLOBAL_flagCount);
2015-06-18 01:59:07 +01:00
if (itf) {
2016-01-03 01:32:04 +00:00
initFlag(f, GLOBAL_flagCount, true);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
GLOBAL_flagCount++;
f++;
2016-04-26 15:33:16 +01:00
}
2015-06-18 01:59:07 +01:00
LOCAL_flagCount = 0;
2016-01-03 01:32:04 +00:00
int nflags = sizeof(local_flags_setup) / sizeof(flag_info);
2015-06-18 01:59:07 +01:00
if (bootstrap)
2016-01-03 01:32:04 +00:00
LOCAL_Flags =
(union flagTerm *)Yap_AllocCodeSpace(sizeof(union flagTerm) * nflags);
f = local_flags_setup;
2015-06-18 01:59:07 +01:00
while (f->name != NULL) {
2016-01-03 01:32:04 +00:00
bool itf = setInitialValue(bootstrap, f->def, f->init,
LOCAL_Flags + LOCAL_flagCount);
2016-12-04 18:52:42 +00:00
// Term itf = Yap_BufferToTermWithPrioBindings(f->init,
// strlen(f->init)+1,
// LOBAL_MaxPriority, &tp);
2015-06-18 01:59:07 +01:00
if (itf) {
2016-01-03 01:32:04 +00:00
initFlag(f, LOCAL_flagCount, false);
2015-06-18 01:59:07 +01:00
}
2016-01-03 01:32:04 +00:00
LOCAL_flagCount++;
2015-06-18 01:59:07 +01:00
f++;
}
2016-07-31 10:22:22 +01:00
// fix readline gettong set so early
if (GLOBAL_Stream[StdInStream].status & Readline_Stream_f) {
setBooleanGlobalPrologFlag(READLINE_FLAG, true);
}
2015-06-18 01:59:07 +01:00
if (!bootstrap) {
2016-01-03 01:32:04 +00:00
Yap_InitCPredBack("current_prolog_flag", 2, 1, current_prolog_flag,
cont_yap_flag, 0);
2015-07-06 11:53:50 +01:00
TR = tr0;
2018-07-15 13:44:55 +01:00
Yap_InitCPredBack("prolog_flag", 3, 1, prolog_flag, cont_yap_flag,
2016-01-03 01:32:04 +00:00
0);
2018-07-10 23:21:19 +01:00
Yap_InitCPredBack("yap_flag", 3, 1, yap_flag, cont_yap_flag, 0);
2016-01-03 01:32:04 +00:00
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);
2015-06-18 01:59:07 +01:00
Yap_InitCPred("set_prolog_flag", 2, set_prolog_flag, SyncPredFlag);
2016-01-03 01:32:04 +00:00
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("prolog_flag_property", 2, 1, prolog_flag_property,
cont_prolog_flag_property, 0);
Yap_InitCPred("source", 0, source, SyncPredFlag);
Yap_InitCPred("no_source", 0, no_source, SyncPredFlag);
2015-06-18 01:59:07 +01:00
Yap_InitCPred("source_mode", 2, source_mode, SyncPredFlag);
}
}
2016-01-03 01:32:04 +00:00
/* Accessing and changing the flags for a predicate */
2018-04-27 13:01:08 +01:00
// @}