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

latest swi flgs

Browse Source
This commit is contained in:
Vítor Santos Costa
2013-11-13 23:48:54 +00:00
parent 14747fd0bf
commit 5b46b6bd1a
4 changed files with 83 additions and 53 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
H/pl-global.h
View File

@@ -176,7 +176,11 @@ typedef struct {
} atoms;
struct
{
{ int os_argc; /* main(int argc, char **argv) */
char ** os_argv;
int appl_argc; /* Application options */
char ** appl_argv;
int notty; /* -tty: donot use ioctl() */
int optimise; /* -O: optimised compilation */
} cmdline;

4
H/pl-yap.h
View File

@@ -161,8 +161,8 @@ atomLength(Atom atom)
#define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A)
#define MODULE_user Yap_GetModuleEntry(Yap_LookupAtom("user"))
#define MODULE_system Yap_GetModuleEntry(Yap_LookupAtom("system"))
#define MODULE_user Yap_GetModuleEntry(MkAtomTerm(Yap_LookupAtom("user")))
#define MODULE_system Yap_GetModuleEntry(MkAtomTerm(Yap_LookupAtom("system")))
#define MODULE_parse Yap_GetModuleEntry(LOCAL_SourceModule)
extern term_t Yap_CvtTerm(term_t ts);

2
include/SWI-Prolog.h
View File

@@ -807,6 +807,8 @@ PL_EXPORT(int) PL_unify_mpq(term_t t, mpq_t mpz);
#endif
PL_EXPORT(int) PL_current_prolog_flag(atom_t name, int type, void *ptr);
void swi_install(void);
X_API int PL_warning(const char *msg, ...);

124
os/pl-prologflag.c
View File

@@ -73,12 +73,10 @@ option, but 90% of the prolog flags are read-only or never changed and
we want to be able to have a lot of flags and don't harm thread_create/3
too much.
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
#ifndef __YAP_PROLOG__
static void setArgvPrologFlag(void);
#endif
static void setArgvPrologFlag(const char *flag, int argc, char **argv);
static void setTZPrologFlag(void);
static void setVersionPrologFlag(void);
static atom_t lookupAtomFlag(atom_t key);
static void initPrologFlagTable(void);
@@ -100,6 +98,8 @@ following arguments are to be provided:
FT_BOOL TRUE/FALSE, *PLFLAG_
FT_INTEGER intptr_t
FT_INT64 int64_t
FT_FLOAT double
FT_ATOM const char *
FT_TERM a term
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
@@ -241,6 +241,7 @@ freeSymbolPrologFlagTable(Symbol s)
}
#endif
int
setDoubleQuotes(atom_t a, unsigned int *flagp)
{ GET_LD
@@ -542,14 +543,16 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
succeed;
} else
{ atom_t how = lookupAtomFlag(ATOM_user_flags);
{ atom_t how;
if ( how == ATOM_error )
return PL_error(NULL, 0, NULL, ERR_EXISTENCE,
ATOM_prolog_flag, key);
else if ( how == ATOM_warning )
Sdprintf("WARNING: Flag %s: new Prolog flags must be created using "
"create_prolog_flag/3\n", stringAtom(k));
if ( PL_current_prolog_flag(ATOM_user_flags, PL_ATOM, &how) )
{ if ( how == ATOM_error )
return PL_error(NULL, 0, NULL, ERR_EXISTENCE,
ATOM_prolog_flag, key);
else if ( how == ATOM_warning )
Sdprintf("WARNING: Flag %s: new Prolog flags must be created using "
"create_prolog_flag/3\n", stringAtom(k));
}
goto anyway;
}
@@ -588,7 +591,6 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
break; /* don't change value */
#endif
}
/* set the flag value */
f->value.a = (val ? ATOM_true : ATOM_false);
@@ -728,8 +730,8 @@ PRED_IMPL("create_prolog_flag", 3, create_prolog_flag, PL_FA_ISO)
}
static atom_t
lookupAtomFlag(atom_t key)
static prolog_flag *
lookupFlag(atom_t key)
{ GET_LD
Symbol s;
prolog_flag *f = NULL;
@@ -744,15 +746,53 @@ lookupAtomFlag(atom_t key)
f = s->value;
}
if ( f )
{ assert((f->flags&FT_MASK) == FT_ATOM);
return f->value.a;
return f;
}
int
PL_current_prolog_flag(atom_t name, int type, void *value)
{ prolog_flag *f;
if ( (f=lookupFlag(name)) )
{ switch(type)
{ case PL_ATOM:
if ( (f->flags&FT_MASK) == FT_ATOM )
{ atom_t *vp = value;
*vp = f->value.a;
return TRUE;
}
return FALSE;
case PL_INTEGER:
if ( (f->flags&FT_MASK) == FT_INTEGER )
{ int64_t *vp = value;
*vp = f->value.i;
return TRUE;
}
return FALSE;
case PL_FLOAT:
if ( (f->flags&FT_MASK) == FT_FLOAT )
{ double *vp = value;
*vp = f->value.f;
return TRUE;
}
return FALSE;
case PL_TERM:
if ( (f->flags&FT_MASK) == FT_TERM )
{ term_t *vp = value;
term_t t = *vp;
return PL_recorded(f->value.t, t);
}
return FALSE;
}
}
return NULL_ATOM;
return FALSE;
}
static int
unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
{ GET_LD
@@ -1108,9 +1148,6 @@ initPrologFlags(void)
#else
setPrologFlag("threads", FT_BOOL|FF_READONLY, FALSE, 0);
#endif
#ifdef ASSOCIATE_SRC
setPrologFlag("associate", FT_ATOM, ASSOCIATE_SRC);
#endif
#ifdef O_DDE
setPrologFlag("dde", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
@@ -1158,10 +1195,13 @@ initPrologFlags(void)
setPrologFlag("integer_rounding_function", FT_ATOM|FF_READONLY, "toward_zero");
setPrologFlag("max_arity", FT_ATOM|FF_READONLY, "unbounded");
setPrologFlag("answer_format", FT_ATOM, "~p");
setPrologFlag("colon_sets_calling_context", FT_BOOL, TRUE, 0);
setPrologFlag("colon_sets_calling_context", FT_BOOL|FF_READONLY, TRUE, 0);
setPrologFlag("character_escapes", FT_BOOL, TRUE, PLFLAG_CHARESCAPE);
setPrologFlag("char_conversion", FT_BOOL, FALSE, PLFLAG_CHARCONVERSION);
setPrologFlag("backquoted_string", FT_BOOL, FALSE, PLFLAG_BACKQUOTED_STRING);
#ifdef O_QUASIQUOTATIONS
setPrologFlag("quasi_quotations", FT_BOOL, TRUE, PLFLAG_QUASI_QUOTES);
#endif
setPrologFlag("write_attributes", FT_ATOM, "ignore");
setPrologFlag("stream_type_check", FT_ATOM, "loose");
setPrologFlag("occurs_check", FT_ATOM, "false");
@@ -1177,6 +1217,7 @@ initPrologFlags(void)
setPrologFlag("verbose_load", FT_ATOM, "normal");
setPrologFlag("verbose_autoload", FT_BOOL, FALSE, 0);
setPrologFlag("verbose_file_search", FT_BOOL, FALSE, 0);
setPrologFlag("sandboxed_load", FT_BOOL, FALSE, 0);
setPrologFlag("allow_variable_name_as_functor", FT_BOOL, FALSE,
ALLOW_VARNAME_FUNCTOR);
setPrologFlag("toplevel_var_size", FT_INTEGER, 1000);
@@ -1187,6 +1228,9 @@ initPrologFlags(void)
#ifdef __unix__
setPrologFlag("unix", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
#ifdef __APPLE__
setPrologFlag("apple", FT_BOOL|FF_READONLY, TRUE, 0);
#endif
setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
@@ -1201,43 +1245,23 @@ initPrologFlags(void)
#endif
#if defined(__DATE__) && defined(__TIME__)
{ char buf[100];
Ssprintf(buf, "%s, %s", __DATE__, __TIME__);
setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, buf);
}
setPrologFlag("compiled_at", FT_ATOM|FF_READONLY, __DATE__ ", " __TIME__);
#endif
/* Flags copied by YAP */
setPrologFlag("optimise", FT_BOOL, GD->cmdline.optimise, PLFLAG_OPTIMISE);
/* FLAGS used by PLStream */
setPrologFlag("tty_control", FT_BOOL|FF_READONLY,
truePrologFlag(PLFLAG_TTY_CONTROL), PLFLAG_TTY_CONTROL);
setPrologFlag("encoding", FT_ATOM, stringAtom(encoding_to_atom(LD->encoding)));
setPrologFlag("file_name_variables", FT_BOOL, FALSE, PLFLAG_FILEVARS);
setPrologFlag("fileerrors", FT_BOOL, TRUE, PLFLAG_FILEERRORS);
setPrologFlag("readline", FT_BOOL/*|FF_READONLY*/, FALSE, 0);
#ifndef __YAP_PROLOG__
setArgvPrologFlag();
#endif /* YAP_PROLOG */
setTZPrologFlag();
#ifndef __YAP_PROLOG__
setOSPrologFlags();
#endif /* YAP_PROLOG */
setVersionPrologFlag();
setArgvPrologFlag("os_argv", GD->cmdline.os_argc, GD->cmdline.os_argv);
setArgvPrologFlag("argv", GD->cmdline.appl_argc, GD->cmdline.appl_argv);
}
#ifndef __YAP_PROLOG__
static void
setArgvPrologFlag(void)
setArgvPrologFlag(const char *flag, int argc, char **argv)
{ GET_LD
fid_t fid = PL_open_foreign_frame();
term_t e = PL_new_term_ref();
term_t l = PL_new_term_ref();
int argc = GD->cmdline.argc;
char **argv = GD->cmdline.argv;
int n;
PL_put_nil(l);
@@ -1248,11 +1272,10 @@ setArgvPrologFlag(void)
fatalError("Could not set Prolog flag argv: not enough stack");
}
setPrologFlag("argv", FT_TERM, l);
setPrologFlag(flag, FT_TERM, l);
PL_discard_foreign_frame(fid);
}
#endif
static void
setTZPrologFlag(void)
@@ -1261,6 +1284,7 @@ setTZPrologFlag(void)
setPrologFlag("timezone", FT_INTEGER|FF_READONLY, timezone);
}
static void
setVersionPrologFlag(void)
{ GET_LD
@@ -1284,20 +1308,20 @@ setVersionPrologFlag(void)
setGITVersion();
}
void
cleanupPrologFlags(void)
{ if ( GD->prolog_flag.table )
{ Table t = GD->prolog_flag.table;
GD->prolog_flag.table = NULL;
#ifdef O_PLMT
t->free_symbol = freeSymbolPrologFlagTable;
#endif
destroyHTable(t);
}
}
/*******************************
* PUBLISH PREDICATES *
*******************************/