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

integration work:

Browse Source 
- use SWI flags whenever possible
  - support by module unknown, escapes, strings
  - accesss thread info fom SWI
  - allow strings to be input as strings.
  - remove some unused flags.
This commit is contained in:
Vitor Santos Costa 2013-11-13 10:38:20 +00:00
parent 0d45ff8d37
commit 4fa9021a7b
33 changed files with 444 additions and 376 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/c_interface.c
View File

@ -3433,7 +3433,7 @@ YAP_SetCurrentModule(Term new)
{
CACHE_REGS
Term omod = CurrentModule;
CurrentModule = new;
LOCAL_SourceModule = CurrentModule = new;
return omod;
}

23
C/init.c
View File

@ -910,12 +910,10 @@ InitFlags(void)
yap_flags[YAP_MAX_INTEGER_FLAG] = (Int)(~((CELL)1 << (sizeof(Int)*8-1)));
yap_flags[YAP_MIN_INTEGER_FLAG] = (Int)(((CELL)1 << (sizeof(Int)*8-1)));
yap_flags[CHAR_CONVERSION_FLAG] = 1;
yap_flags[YAP_DOUBLE_QUOTES_FLAG] = 1;
yap_flags[YAP_TO_CHARS_FLAG] = ISO_TO_CHARS;
yap_flags[LANGUAGE_MODE_FLAG] = 0;
yap_flags[STRICT_ISO_FLAG] = FALSE;
yap_flags[SOURCE_MODE_FLAG] = FALSE;
yap_flags[CHARACTER_ESCAPE_FLAG] = SICSTUS_CHARACTER_ESCAPES;
yap_flags[WRITE_QUOTED_STRING_FLAG] = FALSE;
/* we do not garantee safe assert in parallel mode */
yap_flags[ALLOW_ASSERTING_STATIC_FLAG] = TRUE;
@ -1169,23 +1167,6 @@ Yap_InitThread(int new_id)
}
#endif
static void
InitFirstWorkerThreadHandle(void)
{
#ifdef THREADS
CACHE_REGS
LOCAL_ThreadHandle.id = 0;
LOCAL_ThreadHandle.in_use = TRUE;
LOCAL_ThreadHandle.default_yaam_regs =
&Yap_standard_regs;
LOCAL_ThreadHandle.pthread_handle = pthread_self();
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock, NULL);
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL);
LOCAL_ThreadHandle.tdetach = MkAtomTerm(AtomFalse);
LOCAL_ThreadHandle.ref_count = 1;
#endif
}
static void
InitScratchPad(int wid)
{
@ -1240,9 +1221,9 @@ InitCodes(void)
#if !THREADS
InitWorker(0);
#endif /* THREADS */
InitFirstWorkerThreadHandle();
Yap_InitFirstWorkerThreadHandle();
/* make sure no one else can use these two atoms */
CurrentModule = 0;
LOCAL_SourceModule = CurrentModule = 0;
Yap_ReleaseAtom(AtomOfTerm(TermReFoundVar));
/* make sure we have undefp defined */
/* predicates can only be defined after this point */

51
C/modules.c
View File

@ -21,10 +21,16 @@ static char SccsId[] = "%W% %G%";
#include "Yap.h"
#include "Yatom.h"
#include "YapHeap.h"
#include "pl-shared.h"
static Int p_current_module( USES_REGS1 );
static Int p_current_module1( USES_REGS1 );
static ModEntry *LookupModule(Term a);
unsigned int
getUnknownModule(ModEntry * m) {
return m->flags & UNKNOWN_MASK;
}
inline static ModEntry *
FetchModuleEntry(Atom at)
@ -56,6 +62,7 @@ GetModuleEntry(Atom at)
AtomEntry *ae = RepAtom(at);
ModEntry *new;
p0 = ae->PropsOfAE;
while (p0) {
ModEntry *me = RepModProp(p0);
@ -65,14 +72,21 @@ GetModuleEntry(Atom at)
}
p0 = me->NextOfPE;
}
new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->ModRWLock);
new->KindOfPE = ModProperty;
new->PredForME = NULL;
new->NextME = CurrentModules;
CurrentModules = new;
new->AtomOfME = ae;
AddPropToAtom(ae, (PropEntry *)new);
{
CACHE_REGS
new = (ModEntry *) Yap_AllocAtomSpace(sizeof(*new));
INIT_RWLOCK(new->ModRWLock);
new->KindOfPE = ModProperty;
new->PredForME = NULL;
new->NextME = CurrentModules;
CurrentModules = new;
new->AtomOfME = ae;
if (at == AtomProlog)
new->flags = UNKNOWN_FAIL|M_SYSTEM|M_CHARESCAPE;
else
new->flags = LookupModule(LOCAL_SourceModule)->flags;
AddPropToAtom(ae, (PropEntry *)new);
}
return new;
}
@ -100,14 +114,14 @@ Yap_Module_Name(PredEntry *ap)
}
static ModEntry *
LookupModule(Term a)
LookupModule(Term a )
{
Atom at;
ModEntry *me;
/* prolog module */
if (a == 0)
return GetModuleEntry(AtomOfTerm(TermProlog));
return GetModuleEntry(AtomProlog);
at = AtomOfTerm(a);
me = GetModuleEntry(at);
return me;
@ -120,6 +134,21 @@ Yap_Module(Term tmod)
return tmod;
}
ModEntry *
Yap_GetModuleEntry(Term mod)
{
ModEntry *me;
if (!(me = LookupModule(mod)))
return NULL;
return me;
}
Term
Yap_GetModuleFromEntry(ModEntry *me)
{
return MkAtomTerm(me->AtomOfME);;
}
struct pred_entry *
Yap_ModulePred(Term mod)
{
@ -163,6 +192,7 @@ p_current_module( USES_REGS1 )
CurrentModule = t;
LookupModule(CurrentModule);
}
LOCAL_SourceModule = CurrentModule;
return TRUE;
}
@ -180,6 +210,7 @@ p_change_module( USES_REGS1 )
Term mod = Deref(ARG1);
LookupModule(mod);
CurrentModule = mod;
LOCAL_SourceModule = mod;
return TRUE;
}

49
C/parser.c
View File

@ -567,17 +567,22 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
Volatile char *p = (char *) LOCAL_tokptr->TokInfo;
if (*p == 0)
t = MkAtomTerm(AtomNil);
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS)
t = Yap_StringToListOfAtoms(p);
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_ATOM) {
Atom at = Yap_LookupAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else
t = Yap_StringToList(p);
else {
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & DBLQ_CHARS)
t = Yap_StringToListOfAtoms(p);
else if (flags & DBLQ_ATOM) {
Atom at = Yap_LookupAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else if (flags & DBLQ_STRING) {
t = Yap_MkBlobStringTerm(p, strlen(p));
} else
t = Yap_StringToList(p);
}
NextToken;
}
break;
@ -587,12 +592,22 @@ ParseTerm(int prio, JMPBUFF *FailBuff USES_REGS)
Volatile wchar_t *p = (wchar_t *) LOCAL_tokptr->TokInfo;
if (*p == 0)
t = MkAtomTerm(AtomNil);
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_CHARS)
t = Yap_WideStringToListOfAtoms(p);
else if (yap_flags[YAP_DOUBLE_QUOTES_FLAG] == STRING_AS_ATOM)
t = MkAtomTerm(Yap_LookupWideAtom(p));
else
t = Yap_WideStringToList(p);
else {
unsigned int flags = Yap_GetModuleEntry(CurrentModule)->flags;
if (flags & DBLQ_CHARS)
t = Yap_WideStringToListOfAtoms(p);
else if (flags & DBLQ_ATOM) {
Atom at = Yap_LookupWideAtom(p);
if (at == NIL) {
LOCAL_ErrorMessage = "Heap Overflow";
FAIL;
}
t = MkAtomTerm(at);
} else if (flags & DBLQ_STRING) {
t = Yap_MkBlobWideStringTerm(p, wcslen(p));
} else
t = Yap_WideStringToList(p);
}
if (t == 0L) {
LOCAL_ErrorMessage = "Stack Overflow";
FAIL;

40
C/pl-yap.c
View File

@ -1321,8 +1321,48 @@ Yap_source_file_name( void )
return YAP_AtomFromSWIAtom(source_file_name);
}
atom_t
accessLevel(void)
{ GET_LD
switch(LD->prolog_flag.access_level)
{ case ACCESS_LEVEL_USER: return ATOM_user;
case ACCESS_LEVEL_SYSTEM: return ATOM_system;
}
return NULL_ATOM;
}
int
getAccessLevelMask(atom_t a, access_level_t *val)
{ if ( a == ATOM_user )
*val = ACCESS_LEVEL_USER;
else if ( a == ATOM_system )
*val = ACCESS_LEVEL_SYSTEM;
else
return FALSE;
return TRUE;
}
int
currentBreakLevel(void)
{ GET_LD
return LD->break_level;
}
#if THREADS
PL_thread_info_t *
SWI_thread_info(int tid, PL_thread_info_t *info)
{
if (info)
REMOTE_PL_local_data_p(tid)->thread.info = info;
return REMOTE_PL_local_data_p(tid)->thread.info;
}
static int
recursive_attr(pthread_mutexattr_t **ap)
{ static int done;

60
C/scanner.c
View File

@ -280,8 +280,8 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
int ch;
/* escape sequence */
restart:
ch = getchrq(inp_stream);
do_switch:
switch (ch) {
case 10:
return 0;
@ -292,17 +292,8 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
case 'b':
return '\b';
case 'c':
if (yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
return send_error_message("invalid escape sequence \\c");
} else {
/* sicstus */
ch = getchrq(inp_stream);
if (chtype(ch) == SL) {
goto restart;
} else {
return 'c';
}
}
while (chtype((ch = getchrq(inp_stream))) == BS);
goto do_switch;
case 'd':
return 127;
case 'e':
@ -314,10 +305,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
case 'r':
return '\r';
case 's': /* space */
if (yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
return send_error_message("invalid escape sequence \\s");
} else
return ' ';
return ' ';
case 't':
return '\t';
case 'u':
@ -369,7 +357,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
case '`':
return '`';
case '^':
if (yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
if (FALSE /*yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES */) {
return send_error_message("invalid escape sequence");
} else {
ch = getchrq(inp_stream);
@ -393,7 +381,7 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
case '7':
/* character in octal: maximum of 3 digits, terminates with \ */
/* follow ISO */
if (TRUE || yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
{
unsigned char so_far = ch-'0';
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') {/* octal */
@ -416,27 +404,10 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
} else {
return send_error_message("invalid octal escape sequence");
}
} else {
/* sicstus */
unsigned char so_far = ch-'0';
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') {/* octal */
so_far = so_far*8+(ch-'0');
ch = getchrq(inp_stream);
if (ch >= '0' && ch < '8') { /* octal */
return so_far*8+(ch-'0');
} else {
*scan_nextp = FALSE;
return so_far;
}
} else {
*scan_nextp = FALSE;
return so_far;
}
}
case 'x':
/* hexadecimal character (YAP allows empty hexadecimal */
if (yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
{
unsigned char so_far = 0;
ch = getchrq(inp_stream);
if (my_isxdigit(ch,'f','F')) {/* hexa */
@ -462,17 +433,6 @@ read_quoted_char(int *scan_nextp, IOSTREAM *inp_stream)
} else {
return send_error_message("invalid hexadecimal escape sequence");
}
} else {
/* sicstus mode */
unsigned char so_far = 0;
ch = getchrq(inp_stream);
so_far = (chtype(ch) == NU ? ch - '0' :
my_isupper(ch) ? ch - 'A' + 10 :
my_islower(ch) ? ch - 'a' +10 : 0);
ch = getchrq(inp_stream);
return so_far*16 + (chtype(ch) == NU ? ch - '0' :
my_isupper(ch) ? ch - 'A' +10 :
my_islower(ch) ? ch - 'a' + 10 : 0);
}
default:
/* accept sequence. Note that the ISO standard does not
@ -531,7 +491,7 @@ get_num(int *chp, int *chbuffp, IOSTREAM *inp_stream, char *s, UInt max_size, in
int scan_extra = TRUE;
if (ch == '\\' &&
yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES) {
Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) {
ascii = read_quoted_char(&scan_extra, inp_stream);
}
/* a quick way to represent ASCII */
@ -1114,7 +1074,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
LOCAL_ErrorMessage = "Heap Overflow While Scanning: please increase code space (-h)";
break;
}
if (ch == 10 && yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES) {
if (ch == 10 && FALSE /*yap_flags[CHARACTER_ESCAPE_FLAG] == ISO_CHARACTER_ESCAPES */) {
/* in ISO a new line terminates a string */
LOCAL_ErrorMessage = "layout character \n inside quotes";
break;
@ -1125,7 +1085,7 @@ Yap_tokenizer(IOSTREAM *inp_stream, int store_comments, Term *tposp)
break;
add_ch_to_buff(ch);
ch = getchrq(inp_stream);
} else if (ch == '\\' && yap_flags[CHARACTER_ESCAPE_FLAG] != CPROLOG_CHARACTER_ESCAPES) {
} else if (ch == '\\' && Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE) {
int scan_next = TRUE;
if ((ch = read_quoted_char(&scan_next, inp_stream))) {
add_ch_to_buff(ch);

12
C/stdpreds.c
View File

@ -1654,11 +1654,6 @@ p_set_yap_flags( USES_REGS1 )
return(FALSE);
yap_flags[CHAR_CONVERSION_FLAG] = value;
break;
case YAP_DOUBLE_QUOTES_FLAG:
if (value < 0 || value > 2)
return(FALSE);
yap_flags[YAP_DOUBLE_QUOTES_FLAG] = value;
break;
case YAP_TO_CHARS_FLAG:
if (value != 0 && value != 1)
return(FALSE);
@ -1684,13 +1679,6 @@ p_set_yap_flags( USES_REGS1 )
return(FALSE);
yap_flags[SOURCE_MODE_FLAG] = value;
break;
case CHARACTER_ESCAPE_FLAG:
if (value != ISO_CHARACTER_ESCAPES
&& value != CPROLOG_CHARACTER_ESCAPES
&& value != SICSTUS_CHARACTER_ESCAPES)
return(FALSE);
yap_flags[CHARACTER_ESCAPE_FLAG] = value;
break;
case WRITE_QUOTED_STRING_FLAG:
if (value != 0 && value != 1)
return(FALSE);

71
C/threads.c
View File

@ -23,6 +23,7 @@ static char SccsId[] = "%W% %G%";
#include "YapHeap.h"
#include "eval.h"
#include "yapio.h"
#include "pl-shared.h"
#include <stdio.h>
#if HAVE_STRING_H
#include <string.h>
@ -51,6 +52,27 @@ static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; return TRUE; }
*
*/
static void
set_system_thread_id(int wid, PL_thread_info_t *info)
{
if (!info)
info = (PL_thread_info_t *)malloc(sizeof(PL_thread_info_t));
info = SWI_thread_info(wid, info);
info->tid = pthread_self();
info->has_tid = TRUE;
#ifdef HAVE_GETTID_SYSCALL
info->pid = syscall(__NR_gettid);
#else
#ifdef HAVE_GETTID_MACRO
info->pid = gettid();
#else
#ifdef __WINDOWS__
info->w32id = GetCurrentThreadId();
#endif
#endif
#endif
}
static int
allocate_new_tid(void)
{
@ -237,6 +259,7 @@ setup_engine(int myworker_id, int init_thread)
CACHE_REGS
REGSTORE *standard_regs;
set_system_thread_id( myworker_id, NULL );
standard_regs = (REGSTORE *)calloc(1,sizeof(REGSTORE));
if (!standard_regs)
return FALSE;
@ -244,7 +267,7 @@ setup_engine(int myworker_id, int init_thread)
/* create the YAAM descriptor */
REMOTE_ThreadHandle(myworker_id).default_yaam_regs = standard_regs;
Yap_InitExStacks(myworker_id, REMOTE_ThreadHandle(myworker_id).tsize, REMOTE_ThreadHandle(myworker_id).ssize);
CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod;
LOCAL_SourceModule = CurrentModule = REMOTE_ThreadHandle(myworker_id).cmod;
Yap_InitTime( myworker_id );
Yap_InitYaamRegs( myworker_id );
REFRESH_CACHE_REGS
@ -509,7 +532,6 @@ Yap_thread_create_engine(thread_attr *ops)
Int
Yap_thread_attach_engine(int wid)
{
CACHE_REGS
/*
already locked
MUTEX_LOCK(&(REMOTE_ThreadHandle(wid).tlock));
@ -517,13 +539,14 @@ Yap_thread_attach_engine(int wid)
if (REMOTE_ThreadHandle(wid).ref_count ) {
REMOTE_ThreadHandle(wid).ref_count++;
REMOTE_ThreadHandle(wid).pthread_handle = pthread_self();
set_system_thread_id(wid, SWI_thread_info(wid, NULL));
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
return TRUE;
}
REMOTE_ThreadHandle(wid).pthread_handle = pthread_self();
set_system_thread_id(wid, SWI_thread_info(wid, NULL));
REMOTE_ThreadHandle(wid).ref_count++;
pthread_setspecific(Yap_yaamregs_key, (const void *)REMOTE_ThreadHandle(wid).current_yaam_regs);
REFRESH_CACHE_REGS;
MUTEX_UNLOCK(&(REMOTE_ThreadHandle(wid).tlock));
return TRUE;
}
@ -955,6 +978,43 @@ p_thread_unlock( USES_REGS1 )
return TRUE;
}
intptr_t
system_thread_id(PL_thread_info_t *info)
{ if ( !info )
{ CACHE_REGS
if ( LOCAL )
info = SWI_thread_info(worker_id, NULL);
else
return -1;
}
#ifdef __linux__
return info->pid;
#else
#ifdef __WINDOWS__
return info->w32id;
#else
return (intptr_t)info->tid;
#endif
#endif
}
void
Yap_InitFirstWorkerThreadHandle(void)
{
CACHE_REGS
LOCAL_ThreadHandle.id = 0;
LOCAL_ThreadHandle.in_use = TRUE;
LOCAL_ThreadHandle.default_yaam_regs =
&Yap_standard_regs;
LOCAL_ThreadHandle.pthread_handle = pthread_self();
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock, NULL);
pthread_mutex_init(&REMOTE_ThreadHandle(0).tlock_status, NULL);
LOCAL_ThreadHandle.tdetach = MkAtomTerm(AtomFalse);
LOCAL_ThreadHandle.ref_count = 1;
set_system_thread_id(0, NULL);
}
void Yap_InitThreadPreds(void)
{
Yap_InitCPred("$no_threads", 0, p_no_threads, 0);
@ -1057,6 +1117,11 @@ p_max_workers(void)
return Yap_unify(ARG1,MkIntTerm(1));
}
void
Yap_InitFirstWorkerThreadHandle(void)
{
}
void Yap_InitThreadPreds(void)
{
Yap_InitCPred("$max_workers", 1, p_max_workers, 0);

11
C/write.c
View File

@ -463,7 +463,8 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
static void
write_quoted(int ch, int quote, wrf stream)
{
if (yap_flags[CHARACTER_ESCAPE_FLAG] == CPROLOG_CHARACTER_ESCAPES) {
CACHE_REGS
if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
wrputc(ch, stream);
if (ch == '\'')
wrputc('\'', stream); /* be careful about quotes */
@ -514,12 +515,8 @@ write_quoted(int ch, int quote, wrf stream)
if ( ch <= 0xff ) {
char esc[8];
if (yap_flags[CHARACTER_ESCAPE_FLAG] == SICSTUS_CHARACTER_ESCAPES) {
sprintf(esc, "\\%03o", ch);
} else {
/* last backslash in ISO mode */
sprintf(esc, "\\%03o\\", ch);
}
/* last backslash in ISO mode */
sprintf(esc, "\\%03o\\", ch);
wrputs(esc, stream);
}
}

5
H/Yap.h
View File

@ -348,12 +348,10 @@ typedef enum
YAP_MAX_INTEGER_FLAG = 3,
YAP_MIN_INTEGER_FLAG = 4,
CHAR_CONVERSION_FLAG = 5,
YAP_DOUBLE_QUOTES_FLAG = 6,
YAP_TO_CHARS_FLAG = 7,
LANGUAGE_MODE_FLAG = 8,
STRICT_ISO_FLAG = 9,
SOURCE_MODE_FLAG = 11,
CHARACTER_ESCAPE_FLAG = 12,
WRITE_QUOTED_STRING_FLAG = 13,
ALLOW_ASSERTING_STATIC_FLAG = 14,
HALT_AFTER_CONSULT_FLAG = 15,
@ -378,6 +376,9 @@ typedef enum
#define ISO_CHARACTER_ESCAPES 1
#define SICSTUS_CHARACTER_ESCAPES 2
/* stuff we want to use in standard YAP code */
#include "pl-shared.h"
typedef enum
{
INDEX_MODE_OFF = 0,

4
H/Yapproto.h
View File

@ -302,6 +302,9 @@ void Yap_NewModulePred(Term, struct pred_entry *);
Term Yap_StripModule(Term, Term *);
void Yap_InitModules(void);
void Yap_InitModulesC(void);
struct mod_entry *Yap_GetModuleEntry(Term tmod);
Term Yap_GetModuleFromEntry(struct mod_entry *me);
#if HAVE_MPI
/* mpi.c */
@ -385,6 +388,7 @@ void Yap_WinError(char *);
/* threads.c */
void Yap_InitThreadPreds(void);
void Yap_InitFirstWorkerThreadHandle(void);
#if THREADS
int Yap_InitThread(int);
#endif

11
H/Yatom.h
View File

@ -358,6 +358,7 @@ typedef struct mod_entry
#if defined(YAPOR) || defined(THREADS)
rwlock_t ModRWLock; /* a read-write lock to protect the entry */
#endif
unsigned int flags; /* Module local flags (from SWI compat) */
struct mod_entry *NextME; /* next module */
} ModEntry;
@ -1537,15 +1538,7 @@ Atom Yap_GetOp(OpEntry *, int *, int);
Prop Yap_GetAProp(Atom, PropFlags);
Prop Yap_GetAPropHavingLock(AtomEntry *, PropFlags);
typedef enum
{
PROLOG_MODULE = 0,
USER_MODULE = 1,
IDB_MODULE = 2,
ATTRIBUTES_MODULE = 3,
CHARSIO_MODULE = 4,
TERMS_MODULE = 5
} default_modules;
#define PROLOG_MODULE 0
#include "YapHeap.h"

4
H/dlocals.h
View File

@ -412,4 +412,8 @@
#define LOCAL_search_atoms LOCAL->search_atoms_
#define REMOTE_search_atoms(wid) REMOTE(wid)->search_atoms_
#define LOCAL_debugstatus LOCAL->debugstatus_
#define REMOTE_debugstatus(wid) REMOTE(wid)->debugstatus_
#define LOCAL_SourceModule LOCAL->SourceModule_
#define REMOTE_SourceModule(wid) REMOTE(wid)->SourceModule_

2
H/hlocals.h
View File

@ -232,4 +232,6 @@ typedef struct worker_local {
UInt exo_arg_;
struct scan_atoms* search_atoms_;
pl_debugstatus_t debugstatus_;
Term SourceModule_;
} w_local;

2
H/ilocals.h
View File

@ -232,4 +232,6 @@ static void InitWorker(int wid) {
REMOTE_exo_arg(wid) = 0;
REMOTE_SourceModule(wid) = 0;
}

42
H/pl-global.h
View File

@ -1,29 +1,3 @@
typedef struct _PL_thread_info_t
{ int pl_tid; /* Prolog thread id */
size_t local_size; /* Stack sizes */
size_t global_size;
size_t trail_size;
size_t stack_size; /* system (C-) stack */
int (*cancel)(int id); /* cancel function */
int open_count; /* for PL_thread_detach_engine() */
bool detached; /* detached thread */
int status; /* PL_THREAD_* */
pthread_t tid; /* Thread identifier */
int has_tid; /* TRUE: tid = valid */
#ifdef __linux__
pid_t pid; /* for identifying */
#endif
#ifdef __WINDOWS__
unsigned long w32id; /* Win32 thread HANDLE */
#endif
struct PL_local_data *thread_data; /* The thread-local data */
module_t module; /* Module for starting goal */
record_t goal; /* Goal to start thread */
record_t return_value; /* Value (term) returned */
atom_t name; /* Name of the thread */
ldata_status_t ldata_status; /* status of forThreadLocalData() */
} PL_thread_info_t;
typedef struct
{ size_t localSize; /* size of local stack */
size_t globalSize; /* size of global stack */
@ -225,6 +199,7 @@ typedef struct PL_local_data {
access_level_t access_level; /* Current access level */
} prolog_flag;
int break_level; /* break */
void * glob_info; /* pl-glob.c */
IOENC encoding; /* default I/O encoding */
@ -261,6 +236,20 @@ typedef struct PL_local_data {
} exception;
const char *float_format; /* floating point format */
#ifdef O_PLMT
struct
{ //intptr_t magic; /* PL_THREAD_MAGIC (checking) */
struct _PL_thread_info_t *info; /* info structure */
//unsigned forall_flags; /* forThreadLocalData() flags */
/* Communication */
//message_queue messages; /* Message queue */
//struct _thread_sig *sig_head; /* Head of signal queue */
//struct _thread_sig *sig_tail; /* Tail of signal queue */
//struct _at_exit_goal *exit_goals; /* thread_at_exit/1 goals */
//DefinitionChain local_definitions; /* P_THREAD_LOCAL predicates */
} thread;
#endif
struct {
buffer _discardable_buffer; /* PL_*() character buffers */
buffer _buffer_ring[BUFFER_RING_SIZE];
@ -280,6 +269,7 @@ typedef struct PL_local_data {
} PL_local_data_t;
#define usedStack(D) 0
#define features (LD->feature.mask)

23
H/pl-incl.h
View File

@ -53,6 +53,8 @@
#define SWIP "swi_"
#include "pl-shared.h"
/* try not to pollute the SWI space */
#ifdef P
#undef P
@ -184,15 +186,12 @@ typedef enum
#if __YAP_PROLOG__
#include "pl-yap.h"
#if _WIN32
#ifndef THREADS
typedef int pthread_t;
#endif
#define __WINDOWS__ 1
#else
#include <pthread.h>
#endif
#endif
typedef uintptr_t PL_atomic_t; /* same a word */
typedef uintptr_t PL_atomic_t; /* same size as a word */
#define MAXSIGNAL 64
@ -449,13 +448,6 @@ typedef struct
char *home; /* systems home directory */
} pl_defaults_t;
typedef enum
{ LDATA_IDLE = 0,
LDATA_SIGNALLED,
LDATA_ANSWERING,
LDATA_ANSWERED
} ldata_status_t;
typedef struct tempfile * TempFile; /* pl-os.c */
typedef struct canonical_dir * CanonicalDir; /* pl-os.c */
@ -545,11 +537,6 @@ typedef struct redir_context
#include "pl-file.h"
typedef enum
{ ACCESS_LEVEL_USER = 0, /* Default user view */
ACCESS_LEVEL_SYSTEM /* Allow low-level access */
} access_level_t;
#define SYSTEM_MODE (LD->prolog_flag.access_level == ACCESS_LEVEL_SYSTEM)
#define PL_malloc_atomic malloc
@ -842,7 +829,7 @@ COMMON(access_level_t) setAccessLevel(access_level_t new_level);
/**** stuff from pl-error.c ****/
extern void outOfCore(void);
extern void fatalError(const char *fm, ...);
extern int callProlog(void * module, term_t goal, int flags, term_t *ex);
extern int callProlog(module_t module, term_t goal, int flags, term_t *ex);
extern word notImplemented(char *name, int arity);
/**** stuff from pl-ctype.c ****/
@ -1020,6 +1007,8 @@ static inline void freeHeap(void *mem, size_t n)
YAP_FreeSpaceFromYap(mem);
}
extern atom_t accessLevel(void);
int currentBreakLevel(void);
extern const PL_extension PL_predicates_from_ctype[];
extern const PL_extension PL_predicates_from_file[];

105
H/pl-shared.h Normal file
View File

@ -0,0 +1,105 @@
#ifndef PL_SHARED_INCLUDE
#define PL_SHARED_INCLUDE
#ifndef _FLI_H_INCLUDED
typedef void *record_t;
typedef int bool;
typedef struct mod_entry *module_t;
typedef uintptr_t atom_t;
#endif
typedef enum
{ ACCESS_LEVEL_USER = 0, /* Default user view */
ACCESS_LEVEL_SYSTEM /* Allow low-level access */
} access_level_t;
typedef enum
{ LDATA_IDLE = 0,
LDATA_SIGNALLED,
LDATA_ANSWERING,
LDATA_ANSWERED
} ldata_status_t;
#if _WIN32
#ifndef THREADS
typedef int pthread_t;
#endif
#endif
#if THREADS
typedef struct _PL_thread_info_t
{ int pl_tid; /* Prolog thread id */
size_t local_size; /* Stack sizes */
size_t global_size;
size_t trail_size;
size_t stack_size; /* system (C-) stack */
int (*cancel)(int id); /* cancel function */
int open_count; /* for PL_thread_detach_engine() */
bool detached; /* detached thread */
int status; /* PL_THREAD_* */
pthread_t tid; /* Thread identifier */
int has_tid; /* TRUE: tid = valid */
#ifdef __linux__
pid_t pid; /* for identifying */
#endif
#ifdef __WINDOWS__
unsigned long w32id; /* Win32 thread HANDLE */
#endif
struct PL_local_data *thread_data; /* The thread-local data */
module_t module; /* Module for starting goal */
record_t goal; /* Goal to start thread */
record_t return_value; /* Value (term) returned */
atom_t name; /* Name of the thread */
ldata_status_t ldata_status; /* status of forThreadLocalData() */
} PL_thread_info_t;
PL_thread_info_t *SWI_thread_info(int tid, PL_thread_info_t *info);
intptr_t system_thread_id(PL_thread_info_t *info);
#endif
/* Flags on module. Most of these flags are copied to the read context
in pl-read.c.
*/
#define M_SYSTEM (0x0001) /* system module */
#define M_CHARESCAPE (0x0002) /* module */
#define DBLQ_CHARS (0x0004) /* "ab" --> ['a', 'b'] */
#define DBLQ_ATOM (0x0008) /* "ab" --> 'ab' */
#define DBLQ_STRING (0x0010) /* "ab" --> "ab" */
#define DBLQ_MASK (DBLQ_CHARS|DBLQ_ATOM|DBLQ_STRING)
#define UNKNOWN_FAIL (0x0020) /* module */
#define UNKNOWN_WARNING (0x0040) /* module */
#define UNKNOWN_ERROR (0x0080) /* module */
#define UNKNOWN_MASK (UNKNOWN_ERROR|UNKNOWN_WARNING|UNKNOWN_FAIL)
extern unsigned int
getUnknownModule(module_t m);
typedef enum
{ DBG_OFF = 0, /* no debugging */
DBG_ON, /* switch on in current environment */
DBG_ALL /* switch on globally */
} debug_type;
typedef struct debuginfo
{ size_t skiplevel; /* current skip level */
bool tracing; /* are we tracing? */
debug_type debugging; /* are we debugging? */
int leashing; /* ports we are leashing */
int visible; /* ports that are visible */
bool showContext; /* tracer shows context module */
int styleCheck; /* source style checking */
int suspendTrace; /* tracing is suspended now */
//LocalFrame retryFrame; /* Frame to retry */
} pl_debugstatus_t;
#define debugstatus LOCAL_debugstatus /* status of the debugger */
#endif /* PL_SHARED_INCLUDE */

19
H/pl-yap.h
View File

@ -97,6 +97,10 @@ COMMON(int) IsAbsolutePath(const char *spec);
COMMON(bool) sysError(const char *fm, ...);
COMMON(int) setDoubleQuotes(atom_t a, unsigned int *flagp);
COMMON(int) getAccessLevelMask(atom_t a, access_level_t *val);
/* TBD */
extern word globalString(size_t size, char *s);
@ -113,6 +117,7 @@ PL_blob_t* YAP_find_blob_type(YAP_Atom at);
void PL_license(const char *license, const char *module);
#define arityFunctor(f) YAP_PLArityOfSWIFunctor(f)
#define stringAtom(w) YAP_AtomName(YAP_AtomFromSWIAtom(w))
@ -147,16 +152,18 @@ atomLength(Atom atom)
#define argTermP(w,i) ((Word)((YAP_ArgsOfTerm(w)+(i))))
#define deRef(t) while (IsVarTerm(*(t)) && !IsUnboundVar(t)) { t = (CELL *)(*(t)); }
#define canBind(t) FALSE // VSC: to implement
#define MODULE_user YAP_ModuleUser()
#define _PL_predicate(A,B,C,D) PL_predicate(A,B,C)
#define predicateHasClauses(A) (YAP_NumberOfClausesForPredicate((YAP_PredEntryPtr)A) != 0)
#define lookupModule(A) Yap_Module(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
#define lookupModule(A) Yap_GetModuleEntry(MkAtomTerm(YAP_AtomFromSWIAtom(A)))
#define charEscapeWriteOption(A) FALSE // VSC: to implement
#define wordToTermRef(A) YAP_InitSlot(*(A))
#define isTaggedInt(A) IsIntegerTerm(A)
#define valInt(A) IntegerOfTerm(A)
#define MODULE_parse ((Module)CurrentModule)
#define MODULE_user Yap_GetModuleEntry(Yap_LookupAtom("user"))
#define MODULE_system Yap_GetModuleEntry(Yap_LookupAtom("system"))
#define MODULE_parse Yap_GetModuleEntry(LOCAL_SourceModule)
extern term_t Yap_CvtTerm(term_t ts);
@ -192,6 +199,8 @@ charCode(Term w)
#endif /* __YAP_PROLOG__ */
unsigned int getUnknownModule(module_t m);
#if IN_PL_OS_C
static int
stripostfix(const char *s, const char *e)
@ -231,4 +240,8 @@ unblockSignal(int sig)
atom_t ATOM_;
#if THREADS
intptr_t system_thread_id(PL_thread_info_t *info);
#endif
#endif /* PL_YAP_H */

2
H/rlocals.h
View File

@ -229,6 +229,8 @@ static void RestoreWorker(int wid USES_REGS) {

4
docs/yap.tex
View File

@ -1320,7 +1320,7 @@ feed). The last example escapes the escape character.
Escape sequences were not available in C-Prolog and in original
versions of YAP up to 4.2.0. Escape sequences can be disable by using:
@example
@code{:- yap_flag(character_escapes,off).}
@code{:- yap_flag(character_escapes,false).}
@end example
@ -8080,7 +8080,7 @@ reading terms. The default value for this flag is @code{off} except in
@item character_escapes [ISO]
@findex character_escapes (yap_flag/2 option)
@* Writable flag telling whether a character escapes are enables,
@code{on}, or disabled, @code{off}. The default value for this flag is
@code{true}, or disabled, @code{false}. The default value for this flag is
@code{on}.
@c You can also use @code{cprolog} mode, which corresponds to @code{off},

2
include/SWI-Prolog.h
View File

@ -138,7 +138,7 @@ typedef unsigned long uintptr_t;
#define PL_HAVE_TERM_T
typedef uintptr_t term_t;
#endif
typedef void *module_t;
typedef struct mod_entry *module_t;
typedef void *record_t;
typedef uintptr_t atom_t;
typedef YAP_Term *predicate_t;

24
library/dialect/swi/fli/swi.c
View File

@ -533,7 +533,7 @@ X_API int PL_get_module(term_t ts, module_t *m)
YAP_Term t = Yap_GetFromSlot(ts PASS_REGS);
if (!IsAtomTerm(t) )
return FALSE;
*m = (module_t)t;
*m = Yap_GetModuleEntry(t);
return TRUE;
}
@ -546,7 +546,7 @@ X_API module_t PL_new_module(atom_t swiat)
WRITE_LOCK(RepAtom(at)->ARWLock);
t = Yap_Module(MkAtomTerm(at));
WRITE_UNLOCK(RepAtom(at)->ARWLock);
return (module_t)t;
return Yap_GetModuleEntry(t);
}
/* SWI: int PL_get_atom(term_t t, YAP_Atom *a)
@ -2060,26 +2060,30 @@ PL_is_initialised(int *argcp, char ***argvp)
X_API module_t
PL_context(void)
{
return (module_t)YAP_CurrentModule();
CACHE_REGS
return Yap_GetModuleEntry(LOCAL_SourceModule);
}
X_API int
PL_strip_module(term_t raw, module_t *m, term_t plain)
{
CACHE_REGS
YAP_Term t = YAP_StripModule(Yap_GetFromSlot(raw PASS_REGS),(YAP_Term *)m);
YAP_Term m0;
if (*m)
m0 = MkAtomTerm((*m)->AtomOfME);
else
m0 = USER_MODULE;
YAP_Term t = YAP_StripModule(Yap_GetFromSlot(raw PASS_REGS), &m0);
if (!t)
return FALSE;
*m = Yap_GetModuleEntry(m0);
Yap_PutInSlot(plain, t PASS_REGS);
return TRUE;
}
X_API atom_t PL_module_name(module_t m)
{
Atom at = AtomOfTerm((Term)m);
WRITE_LOCK(RepAtom(at)->ARWLock);
Yap_Module(MkAtomTerm(at));
WRITE_UNLOCK(RepAtom(at)->ARWLock);
Atom at = m->AtomOfME;
return AtomToSWIAtom(at);
}
@ -2167,9 +2171,9 @@ X_API void PL_predicate_info(predicate_t p,atom_t *name, int *arity, module_t *m
aname = (Atom)(pd->FunctorOfPred);
}
if (pd->ModuleOfPred && m)
*m = (module_t)pd->ModuleOfPred;
*m = Yap_GetModuleEntry(pd->ModuleOfPred);
else if (m)
*m = (module_t)TermProlog;
*m = Yap_GetModuleEntry(TermProlog);
if (name)
*name = AtomToSWIAtom(aname);
}

2
library/dialect/swi/fli/swi.h
View File

@ -105,7 +105,7 @@ SWIModuleToModule(module_t m)
{
CACHE_REGS
if (m)
return (CELL)m;
return MkAtomTerm(m->AtomOfME);
if (CurrentModule)
return CurrentModule;
return USER_MODULE;

4
misc/LOCALS
View File

@ -265,4 +265,8 @@ UInt exo_arg =0
// atom completion
struct scan_atoms* search_atoms void
pl_debugstatus_t debugstatus void
Term SourceModule =0
END_WORKER_LOCAL

14
os/pl-prologflag.c
View File

@ -24,6 +24,7 @@
/*#define O_DEBUG 1*/
#include "pl-incl.h"
#ifdef __YAP_PROLOG__
#include "Yatom.h"
#include "pl-ctype.h"
#include "eval.h"
#else
@ -240,7 +241,6 @@ freeSymbolPrologFlagTable(Symbol s)
}
#endif
#ifndef __YAP_PROLOG__
int
setDoubleQuotes(atom_t a, unsigned int *flagp)
{ GET_LD
@ -364,7 +364,6 @@ setOccursCheck(atom_t a)
}
}
#endif /* __YAP_PROLOG__ */
static int
setEncoding(atom_t a)
@ -603,7 +602,6 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
if ( !PL_get_atom_ex(value, &a) )
return FALSE;
#ifndef __YAP_PROLOG__
if ( k == ATOM_double_quotes )
{ rval = setDoubleQuotes(a, &m->flags);
} else if ( k == ATOM_unknown )
@ -614,9 +612,7 @@ set_prolog_flag_unlocked(term_t key, term_t value, int flags)
{ rval = setOccursCheck(a);
} else if ( k == ATOM_access_level )
{ rval = setAccessLevelFromAtom(a);
} else
#endif
if ( k == ATOM_encoding )
} else if ( k == ATOM_encoding )
{ rval = setEncoding(a);
} else if ( k == ATOM_stream_type_check )
{ rval = setStreamTypeCheck(a);
@ -763,7 +759,6 @@ static int
unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
{ GET_LD
#ifndef __YAP_PROLOG__
if ( key == ATOM_character_escapes )
{ atom_t v = (true(m, M_CHARESCAPE) ? ATOM_true : ATOM_false);
@ -817,7 +812,6 @@ unify_prolog_flag_value(Module m, atom_t key, prolog_flag *f, term_t val)
} else if ( key == ATOM_access_level )
{ return PL_unify_atom(val, accessLevel());
}
#endif /* YAP_PROLOG */
switch(f->flags & FT_MASK)
{ case FT_BOOL:
@ -1175,7 +1169,9 @@ initPrologFlags(void)
setPrologFlag("occurs_check", FT_ATOM, "false");
setPrologFlag("access_level", FT_ATOM, "user");
setPrologFlag("double_quotes", FT_ATOM, "codes");
#ifndef __YAP_PROLOG__
#ifdef __YAP_PROLOG__
setPrologFlag("unknown", FT_ATOM, "fail");
#else
setPrologFlag("unknown", FT_ATOM, "error");
#endif
setPrologFlag("debug", FT_BOOL, FALSE, 0);

4
os/pl-write.c
View File

@ -60,7 +60,7 @@ typedef struct
int max_depth; /* depth limit */
int depth; /* current depth */
atom_t spacing; /* Where to insert spaces */
Term module; /* Module for operators */
module_t module; /* Module for operators */
IOSTREAM *out; /* stream to write to */
term_t portray_goal; /* call/2 activated portray hook */
term_t write_options; /* original write options */
@ -241,7 +241,7 @@ writeTopTerm(term_t t, int prec, write_options *options)
if (flags & PL_WRT_BLOB_PORTRAY)
yap_flag |= Blob_Portray_f;
old_module = CurrentModule;
CurrentModule = options->module;
CurrentModule = Yap_GetModuleFromEntry(options->module);
Yap_plwrite(Yap_GetFromSlot(t PASS_REGS), options->out, options->max_depth, yap_flag, prec);
CurrentModule = old_module;
return TRUE;

2
packages/pldoc

@ -1 +1 @@
Subproject commit 34ef10c71d1577dcde1e5437949cc202638ed671
Subproject commit 1e324d30b913edbe78cc4b923cde7998013cbfb0

57
pl/boot.yap
View File

@ -930,13 +930,13 @@ not(G) :- \+ '$execute'(G).
(
'$get_undefined_pred'(G, M, Goal, NM)
->
'$exit_undefp'
'$exit_undefp',
Goal \= fail,
'$complete_goal'(M, Goal, NM, G, NG)
;
once('$find_undefp_handler'(G, M, Goal, NM))
),
!,
Goal \= fail,
'$complete_goal'(M, Goal, NM, G, NG).
'$find_undefp_handler'(G, M),
NG = G, NM = M
).
'$complete_goal'(M, G, CurMod, G0, NG) :-
(
@ -951,36 +951,37 @@ not(G) :- \+ '$execute'(G).
functor(G, Na, Ar),
user:exception(undefined_predicate,M:Na/Ar,Action), !,
'$exit_undefp',
(
Action == fail
->
NG = fail
;
Action == retry
->
NG = G
;
Action == error
->
'$unknown_error'(M:G)
;
'$do_error'(type_error(atom, Action),M:G)
).
'$find_undefp_handler'(G,M) :-
'$exit_undefp',
'$swi_current_prolog_flag'(M:unknown, Action),
(
Action == fail
->
NG = fail
fail
;
Action == retry
Action == warning
->
NG = G
'$unknown_warning'(M:G),
fail
;
Action = error
->
'$unknown_error'(M:G)
;
'$do_error'(type_error(atom, Action),M:G)
).
'$find_undefp_handler'(G,M,NG,user) :-
\+ '$undefined'(unknown_predicate_handler(_,_,_), user),
'$system_catch'(unknown_predicate_handler(G,M,NG), user, Error, '$leave_undefp'(Error)), !,
'$exit_undefp'.
'$find_undefp_handler'(G,M,US,user) :-
recorded('$unknown','$unknown'(M:G,US),_), !,
'$exit_undefp'.
'$find_undefp_handler'(_,_,_,_) :-
'$exit_undefp',
fail.
'$leave_undefp'(Ball) :-
'$exit_undefp',
throw(Ball).
'$silent_bootstrap'(F) :-
'$init_globals',

59
pl/control.yap
View File

@ -152,63 +152,8 @@ setup_call_catcher_cleanup(Setup, Goal, Catcher, Cleanup) :-
% informs about what the user wants to be done when
% there are no clauses for a certain predicate */
unknown(V0,V) :-
'$current_module'(M),
'$unknown'(V0,V,M).
% query mode
'$unknown'(V0,V,_) :- var(V), !,
'$ask_unknown_flag'(V),
V = V0.
% handle modules.
'$unknown'(V0,Mod:Handler,_) :-
'$unknown'(V0,Handler,Mod).
% check if we have one we like.
'$unknown'(_,New,Mod) :-
'$valid_unknown_handler'(New,Mod), fail.
% clean up previous unknown predicate handlers
'$unknown'(Old,New,Mod) :-
recorded('$unknown','$unknown'(_,MyOld),Ref), !,
erase(Ref),
'$cleanup_unknown_handler'(MyOld,Old),
'$new_unknown'(New, Mod).
% store the new one.
'$unknown'(fail,New,Mod) :-
'$new_unknown'(New, Mod).
'$valid_unknown_handler'(V,_) :-
var(V), !,
'$do_error'(instantiation_error,yap_flag(unknown,V)).
'$valid_unknown_handler'(fail,_) :- !.
'$valid_unknown_handler'(error,_) :- !.
'$valid_unknown_handler'(warning,_) :- !.
'$valid_unknown_handler'(S,M) :-
functor(S,_,1),
arg(1,S,A),
var(A),
\+ '$undefined'(S,M),
!.
'$valid_unknown_handler'(S,_) :-
'$do_error'(domain_error(flag_value,unknown+S),yap_flag(unknown,S)).
'$ask_unknown_flag'(Old) :-
recorded('$unknown','$unknown'(_,MyOld),_), !,
'$cleanup_unknown_handler'(MyOld,Old).
'$ask_unknown_flag'(fail).
'$cleanup_unknown_handler'('$unknown_error'(_),error) :- !.
'$cleanup_unknown_handler'('$unknown_warning'(_),warning) :- !.
'$cleanup_unknown_handler'(Handler, Handler).
'$new_unknown'(fail,_) :- !.
'$new_unknown'(error,_) :- !,
recorda('$unknown','$unknown'(P,'$unknown_error'(P)),_).
'$new_unknown'(warning,_) :- !,
recorda('$unknown','$unknown'(P,'$unknown_warning'(P)),_).
'$new_unknown'(X,M) :-
arg(1,X,A),
recorda('$unknown','$unknown'(A,M:X),_).
unknown(V0, V) :-
prolog_flag(unknown, V0, V).
'$unknown_error'(Mod:Goal) :-
functor(Goal,Name,Arity),

97
pl/flags.yap
View File

@ -102,20 +102,6 @@ yap_flag(enhanced,off) :- set_value('$enhanced',[]).
yap_flag(agc_margin,Margin) :-
'$agc_threshold'(Margin).
%
% SWI compatibility flag
%
yap_flag(debug_on_error,X) :-
var(X), !,
X = false.
yap_flag(debug_on_error,true) :- !,
X = true,
'$do_error'(domain_error(flag_value,debug_on_error+X),yap_flag(debug_on_error,X)).
yap_flag(debug_on_error,false) :- !.
yap_flag(debug_on_error,X) :-
'$do_error'(domain_error(flag_value,debug_on_error+X),yap_flag(debug_on_error,X)).
%
% show state of $
@ -138,28 +124,6 @@ yap_flag(dollar_as_lower_case,off) :-
yap_flag(call_counting,X) :- (var(X); X = on; X = off), !,
'$is_call_counted'(X).
yap_flag(open_shared_object,X) :-
var(X), !,
('$open_shared_objects' -> X = true ; X = false).
yap_flag(open_shared_object,X) :-
(X = true ; X = false), !,
'$do_error'(permission_error(modify,flag,open_shared_object),yap_flag(open_shared_object,X)).
yap_flag(open_shared_object,X) :-
'$do_error'(domain_error(flag_value,open_shared_object+X),yap_flag(open_shared_object,X)).
yap_flag(open_shared_object,X) :-
var(X), !,
('$open_shared_objects' -> X = true ; X = false).
yap_flag(open_shared_object,X) :-
(X = true ; X = false), !,
'$do_error'(permission_error(modify,flag,open_shared_object),yap_flag(open_shared_object,X)).
yap_flag(open_shared_object,X) :-
'$do_error'(domain_error(flag_value,open_shared_object+X),yap_flag(open_shared_object,X)).
yap_flag(shared_object_extension,X) :-
'$obj_suffix'([_|String]),
atom_codes(X, String).
:- set_value('$associate',yap).
yap_flag(associate,X) :-
@ -433,12 +397,6 @@ yap_flag(system_options,X) :-
'$system_options'(wam_profiler) :-
\+ '$undefined'(reset_op_counters, prolog).
yap_flag(unknown,X) :-
var(X), !,
unknown(X,_).
yap_flag(unknown,N) :-
unknown(_,N).
yap_flag(to_chars_mode,X) :-
var(X), !,
( '$access_yap_flags'(7,0) -> X = quintus ; X = iso ).
@ -449,16 +407,6 @@ yap_flag(to_chars_mode,iso) :- !,
yap_flag(to_chars_mode,X) :-
'$do_error'(domain_error(flag_value,to_chars_mode+X),yap_flag(to_chars_mode,X)).
yap_flag(character_escapes,X) :-
var(X), !,
'$access_yap_flags'(12,Y),
'$transl_to_character_escape_modes'(Y,X).
yap_flag(character_escapes,X) :- !,
'$transl_to_character_escape_modes'(Y,X), !,
'$set_yap_flags'(12,Y).
yap_flag(character_escapes,X) :-
'$do_error'(domain_error(flag_value,character_escapes+X),yap_flag(to_chars_mode,X)).
yap_flag(update_semantics,X) :-
var(X), !,
( '$log_upd'(I) -> '$convert_upd_sem'(I,X) ).
@ -511,23 +459,6 @@ yap_flag(prompt_alternatives_on,groundness) :- !,
yap_flag(prompt_alternatives_on,X) :-
'$do_error'(domain_error(flag_value,prompt_alternatives_on+X),yap_flag(prompt_alternatives_on,X)).
'$user_flags'(error).
yap_flag(user_flags,OUT) :-
var(OUT), !,
'$user_flags'(OUT).
yap_flag(user_flags,silent) :- !,
'$purge_clauses'('$user_flags'(_),prolog),
'$compile'('$user_flags'(silent),0,'$user_flags'(silent),prolog).
yap_flag(user_flags,warning) :- !,
'$purge_clauses'('$user_flags'(_),prolog),
'$compile'('$user_flags'(warning),0,'$user_flags'(warning),prolog).
yap_flag(user_flags,error) :- !,
'$purge_clauses'('$user_flags'(_),prolog),
'$compile'('$user_flags'(error),0,'$user_flags'(error),prolog).
yap_flag(user_flags,X) :-
'$do_error'(domain_error(flag_value,user_flags+X),yap_flag(user_flags,X)).
yap_flag(stack_dump_on_error,OUT) :-
var(OUT), !,
'$access_yap_flags'(17,X),
@ -609,9 +540,7 @@ yap_flag(max_threads,X) :-
'$yap_system_flag'(answer_format).
'$yap_system_flag'(argv).
'$yap_system_flag'(char_conversion).
'$yap_system_flag'(character_escapes).
'$yap_system_flag'(chr_toplevel_show_store).
'$yap_system_flag'(debug_on_error ).
'$yap_system_flag'(debugger_print_options).
'$yap_system_flag'(discontiguous_warnings).
'$yap_system_flag'(dollar_as_lower_case).
@ -638,12 +567,10 @@ yap_flag(max_threads,X) :-
'$yap_system_flag'(max_threads).
'$yap_system_flag'(n_of_integer_keys_in_db).
'$yap_system_flag'(open_expands_filename).
'$yap_system_flag'(open_shared_object).
'$yap_system_flag'(profiling).
'$yap_system_flag'(prompt_alternatives_on).
'$yap_system_flag'(redefine_warnings).
'$yap_system_flag'(shared_object_search_path).
'$yap_system_flag'(shared_object_extension).
'$yap_system_flag'(single_var_warnings).
'$yap_system_flag'(source).
'$yap_system_flag'(stack_dump_on_error).
@ -654,10 +581,8 @@ yap_flag(max_threads,X) :-
'$yap_system_flag'(toplevel_hook).
'$yap_system_flag'(toplevel_print_options).
'$yap_system_flag'(typein_module).
'$yap_system_flag'(unknown).
'$yap_system_flag'(update_semantics).
'$yap_system_flag'(user_error).
'$yap_system_flag'(user_flags).
'$yap_system_flag'(user_input).
'$yap_system_flag'(user_output).
'$yap_system_flag'(variable_names_may_end_with_quotes).
@ -678,7 +603,7 @@ yap_flag(max_threads,X) :-
'$syntax_check_single_var'(_,off),
'$syntax_check_discontiguous'(_,off),
'$syntax_check_multiple'(_,off),
'$set_yap_flags'(12,0), % disable character escapes.
'$swi_set_prolog_flag'(character_escapes, false), % disable character escapes.
'$set_yap_flags'(14,1),
'$set_fpu_exceptions',
unknown(_,fail).
@ -694,7 +619,7 @@ yap_flag(max_threads,X) :-
'$force_char_conversion',
'$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$set_yap_flags'(12,1),
'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
'$set_fpu_exceptions',
'$swi_set_prolog_flag'(fileerrors, true),
unknown(_,error).
@ -714,15 +639,10 @@ yap_flag(max_threads,X) :-
% ALLOW_ASSERTING_STATIC
'$set_yap_flags'(14,0),
% CHARACTER_ESCAPE
'$set_yap_flags'(12,1),
'$swi_set_prolog_flag'(character_escapes, true), % disable character escapes.
'$set_fpu_exceptions',
unknown(_,error).
'$transl_to_character_escape_modes'(0,off) :- !.
'$transl_to_character_escape_modes'(0,cprolog).
'$transl_to_character_escape_modes'(2,on) :- !.
'$transl_to_character_escape_modes'(1,iso).
'$transl_to_character_escape_modes'(2,sicstus).
'$convert_upd_sem'(0,immediate).
'$convert_upd_sem'(1,logical).
@ -750,12 +670,16 @@ yap_flag(max_threads,X) :-
current_prolog_flag(V,Out) :-
var(V), !,
'$show_yap_flag_opts'(V,NOut),
'$yap_flag'(V,NOut),
NOut = Out.
current_prolog_flag(V,Out) :-
atom(V), !,
yap_flag(V,NOut),
NOut = Out.
current_prolog_flag(M:V,Out) :-
current_module(M), atom(V), !,
yap_flag(M:V,NOut),
NOut = Out.
current_prolog_flag(V,Out) :-
'$do_error'(type_error(atom,V),current_prolog_flag(V,Out)).
@ -765,6 +689,9 @@ set_prolog_flag(F,V) :-
set_prolog_flag(F,V) :-
var(V), !,
'$do_error'(instantiation_error,set_prolog_flag(F,V)).
set_prolog_flag(M:V,Out) :-
current_module(M), atom(V), !,
'$swi_set_prolog_flag'(M:V,Out).
set_prolog_flag(F,V) :-
\+ atom(F), !,
'$do_error'(type_error(atom,F),set_prolog_flag(F,V)).
@ -775,7 +702,7 @@ set_prolog_flag(F,V) :-
'$yap_system_flag'(F), !,
yap_flag(F,V).
set_prolog_flag(F,V) :-
'$user_flags'(UFlag),
'$swi_current_prolog_flag'(user_flags, UFlag),
(
UFlag = silent ->
create_prolog_flag(F, V, [])

2
pl/init.yap
View File

@ -272,7 +272,7 @@ file_search_path(path, C) :-
lists:member(C, B)
).
:- yap_flag(unknown,error).
:- yap_flag(user:unknown,error).
:- stream_property(user_input, tty(true)) -> set_prolog_flag(readline, true) ; true.

11
pl/qly.yap
View File

@ -120,7 +120,6 @@ save_program(File, _Goal) :-
;
'$do_error'(type_error(atom,B),G)
).
%% '$cvt_qsave_flag'(class(_B), G, class(_B)).
%% '$cvt_qsave_flag'(autoload(_B), G, autoload(_B)).
%% '$cvt_qsave_flag'(op(_B), G, op(_B)).
%% '$cvt_qsave_flag'(stand_alone(_B), G, stand_alone(_B)).
@ -132,12 +131,16 @@ save_program(File, _Goal) :-
% there is some ordering between flags.
'$x_yap_flag'(goal, Goal).
'$x_yap_flag'(language, V).
'$x_yap_flag'(M:unknown, V) :-
current_module(M),
yap_flag(M:unknown, V).
'$x_yap_flag'(X, V) :-
yap_flag(X, V),
X \= language,
X \= readline,
X \= timezone,
X \= tty_control,
X \= undefined,
X \= user_input,
X \= user_output,
X \= user_error,
@ -209,6 +212,12 @@ save_program(File, _Goal) :-
erase(R),
'$do_startup_reconsult'(M:B),
fail.
'$init_from_saved_state_and_args' :-
recorded('$restore_flag', unknown(M:B), R),
erase(R),
writeln(M:B),
yap_flag(M:unknown,B),
fail.
'$init_from_saved_state_and_args' :-
'$startup_goals',
fail.