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

syntax error handling

This commit is contained in:
Vítor Santos Costa 2015-07-27 22:22:44 -05:00
parent 36058116f5
commit dbdae6a930
18 changed files with 338 additions and 4027 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
C/parser.c
View File

@ -147,6 +147,9 @@ dot with single quotes.
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
#if HAVE_STDARG_H
#include <stdarg.h>
#endif
#ifdef __STDC__XXX #ifdef __STDC__XXX
#define Volatile volatile #define Volatile volatile
@ -164,6 +167,21 @@ static Term ParseArgs( Atom, wchar_t, JMPBUFF *, Term CACHE_TYPE);
static Term ParseList( JMPBUFF *CACHE_TYPE); static Term ParseList( JMPBUFF *CACHE_TYPE);
static Term ParseTerm( int, JMPBUFF *CACHE_TYPE); static Term ParseTerm( int, JMPBUFF *CACHE_TYPE);
static void
syntax_msg( const char *msg, ...)
{
CACHE_REGS
va_list ap;
if (LOCAL_toktide == LOCAL_tokptr) {
va_start(ap, msg);
vsnprintf( LOCAL_FileNameBuf2, YAP_FILENAME_MAX-1, msg, ap );
LOCAL_ErrorMessage = LOCAL_FileNameBuf2;
LOCAL_Error_TYPE = SYNTAX_ERROR;
va_end(ap);
}
}
#define TRY(S, P) \ #define TRY(S, P) \
{ \ { \
Volatile JMPBUFF *saveenv, newenv; \ Volatile JMPBUFF *saveenv, newenv; \
@ -205,6 +223,54 @@ static Term ParseTerm( int, JMPBUFF *CACHE_TYPE);
#define FAIL siglongjmp(FailBuff->JmpBuff, 1) #define FAIL siglongjmp(FailBuff->JmpBuff, 1)
static const char *tokRep(TokEntry *tokptr)
{
CACHE_REGS
Term info = tokptr->TokInfo;
char *b, *buf = LOCAL_FileNameBuf2;
size_t length, sze = YAP_FILENAME_MAX-1;
UInt flags = 0;
switch (tokptr->Tok) {
case Name_tok:
return RepAtom((Atom)info)->StrOfAE;
case Number_tok:
if ((b = Yap_TermToString(info, buf, sze, &length,LOCAL_encoding, flags)) != buf) {
if (b) free(b);
return NULL;
}
return buf;
case Var_tok:
{
VarEntry *varinfo = (VarEntry *)info;
return varinfo->VarRep;
}
case String_tok:
case BQString_tok:
return (char *)info;
case WString_tok:
case WBQString_tok:
return utf8_wcscpy(buf, (wchar_t *)info);
case Error_tok:
return "<ERR>";
case eot_tok:
return "<EOT>";
case Ponctuation_tok:
{
buf[1] = '\0';
if ((info) == 'l') {
buf[0] = '(';
} else {
buf[0] = (char)info;
}
}
return buf;
case QuasiQuotes_tok:
case WQuasiQuotes_tok:
return "<QQ>";
}
}
VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table */ VarEntry *Yap_LookupVar(const char *var) /* lookup variable in variables table */
{ {
CACHE_REGS CACHE_REGS
@ -430,16 +496,18 @@ int Yap_IsPosfixOp(Atom op, int *pptr, int *lpptr) {
inline static void GNextToken(USES_REGS1) { inline static void GNextToken(USES_REGS1) {
if (LOCAL_tokptr->Tok == Ord(eot_tok)) if (LOCAL_tokptr->Tok == Ord(eot_tok))
return; return;
if (LOCAL_tokptr == LOCAL_toktide) if (LOCAL_tokptr == LOCAL_toktide) {
LOCAL_toktide = LOCAL_tokptr = LOCAL_tokptr->TokNext; LOCAL_toktide = LOCAL_tokptr = LOCAL_tokptr->TokNext;
else } else
LOCAL_tokptr = LOCAL_tokptr->TokNext; LOCAL_tokptr = LOCAL_tokptr->TokNext;
} }
inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) { inline static void checkfor(wchar_t c, JMPBUFF *FailBuff USES_REGS) {
if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) || if (LOCAL_tokptr->Tok != Ord(Ponctuation_tok) ||
LOCAL_tokptr->TokInfo != (Term)c) LOCAL_tokptr->TokInfo != (Term)c) {
syntax_msg("expected to find \'%c\', found %s", tokRep(LOCAL_tokptr));
FAIL; FAIL;
}
NextToken; NextToken;
} }
@ -517,12 +585,12 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
func = Yap_MkFunctor(a, 1); func = Yap_MkFunctor(a, 1);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; syntax_msg("Heap Overflow");
FAIL; FAIL;
} }
t = Yap_MkApplTerm(func, nargs, p); t = Yap_MkApplTerm(func, nargs, p);
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
return TermNil; return TermNil;
} }
NextToken; NextToken;
@ -532,7 +600,7 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
while (1) { while (1) {
Term *tp = (Term *)ParserAuxSp; Term *tp = (Term *)ParserAuxSp;
if (ParserAuxSp + 1 > LOCAL_TrailTop) { if (ParserAuxSp + 1 > LOCAL_TrailTop) {
LOCAL_ErrorMessage = "Trail Overflow"; syntax_msg("Trail Overflow");
FAIL; FAIL;
} }
*tp++ = Unsigned(ParseTerm( 999, FailBuff PASS_REGS)); *tp++ = Unsigned(ParseTerm( 999, FailBuff PASS_REGS));
@ -550,12 +618,12 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
* order * order
*/ */
if (HR > ASP - (nargs + 1)) { if (HR > ASP - (nargs + 1)) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} }
func = Yap_MkFunctor(a, nargs); func = Yap_MkFunctor(a, nargs);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; syntax_msg("Heap Overflow");
FAIL; FAIL;
} }
#ifdef SFUNC #ifdef SFUNC
@ -570,7 +638,7 @@ static Term ParseArgs( Atom a, wchar_t close, JMPBUFF *FailBuff,
t = Yap_MkApplTerm(func, nargs, p); t = Yap_MkApplTerm(func, nargs, p);
#endif #endif
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
return TermNil; return TermNil;
} }
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
@ -609,7 +677,7 @@ loop:
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
to_store[1] = TermNil; to_store[1] = TermNil;
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} else { } else {
to_store[1] = AbsPair(HR); to_store[1] = AbsPair(HR);
@ -622,8 +690,10 @@ loop:
} else { } else {
to_store[1] = MkAtomTerm(AtomNil); to_store[1] = MkAtomTerm(AtomNil);
} }
} else } else {
FAIL; syntax_msg("looking for symbol ',','|' got symbol '%s'", tokRep(LOCAL_tokptr) );
FAIL;
}
return (o); return (o);
} }
@ -693,13 +763,13 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
/* build appl on the heap */ /* build appl on the heap */
func = Yap_MkFunctor((Atom)t, 1); func = Yap_MkFunctor((Atom)t, 1);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; syntax_msg( "Heap Overflow" );
FAIL; FAIL;
} t = ParseTerm( oprprio, FailBuff PASS_REGS); } t = ParseTerm( oprprio, FailBuff PASS_REGS);
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg( "Stack Overflow" );
FAIL; FAIL;
} curprio = opprio; } curprio = opprio;
, break;) , break;)
@ -722,7 +792,8 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile char *p = (char *)LOCAL_tokptr->TokInfo; Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS); t = Yap_CharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
FAIL; syntax_msg( "could not convert \'%s\'", (char *)LOCAL_tokptr->TokInfo );
FAIL;
} }
NextToken; NextToken;
} break; } break;
@ -732,7 +803,8 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo; Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS); t = Yap_WCharsToTDQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
FAIL; syntax_msg( "could not convert \'%S\'", (wchar_t *)LOCAL_tokptr->TokInfo );
FAIL;
} }
NextToken; NextToken;
} break; } break;
@ -742,6 +814,7 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile char *p = (char *)LOCAL_tokptr->TokInfo; Volatile char *p = (char *)LOCAL_tokptr->TokInfo;
t = Yap_CharsToTBQ(p, CurrentModule PASS_REGS); t = Yap_CharsToTBQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
syntax_msg( "could not convert \'%s\"", (char *)LOCAL_tokptr->TokInfo );
FAIL; FAIL;
} }
NextToken; NextToken;
@ -752,6 +825,7 @@ static Term ParseTerm( int prio, JMPBUFF *FailBuff USES_REGS) {
Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo; Volatile wchar_t *p = (wchar_t *)LOCAL_tokptr->TokInfo;
t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS); t = Yap_WCharsToTBQ(p, CurrentModule PASS_REGS);
if (!t) { if (!t) {
syntax_msg( "could not convert \"%S\"", (wchar_t *)LOCAL_tokptr->TokInfo );
FAIL; FAIL;
} }
NextToken; NextToken;
@ -766,6 +840,7 @@ case Var_tok:
break; break;
case Error_tok: case Error_tok:
syntax_msg( "found ill-formed \"%s\"", tokRep(LOCAL_tokptr) );
FAIL; FAIL;
case Ponctuation_tok: case Ponctuation_tok:
@ -799,12 +874,13 @@ case Var_tok:
t = Yap_MkApplTerm(FunctorBraces, 1, &t); t = Yap_MkApplTerm(FunctorBraces, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} }
checkfor('}', FailBuff PASS_REGS); checkfor('}', FailBuff PASS_REGS);
break; break;
default: default:
syntax_msg("unexpected ponctuation signal %s", tokRep(LOCAL_tokptr));
FAIL; FAIL;
} }
break; break;
@ -848,19 +924,23 @@ case Var_tok:
NextToken; NextToken;
t = ParseTerm( 1200, FailBuff PASS_REGS); t = ParseTerm( 1200, FailBuff PASS_REGS);
if (LOCAL_tokptr->Tok != QuasiQuotes_tok) { if (LOCAL_tokptr->Tok != QuasiQuotes_tok) {
syntax_msg( "expected to find quasi quotes, got \"%s\"", , tokRep(LOCAL_tokptr) );
FAIL; FAIL;
} }
if (!(is_quasi_quotation_syntax(t, &at))) if (!(is_quasi_quotation_syntax(t, &at))) {
syntax_msg( "bad quasi quotation syntax, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL; FAIL;
}
/* Arg 2: the content */ /* Arg 2: the content */
tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4); tn = Yap_MkNewApplTerm(SWIFunctorToFunctor(FUNCTOR_quasi_quotation4), 4);
tnp = RepAppl(tn) + 1; tnp = RepAppl(tn) + 1;
tnp[0] = MkAtomTerm(at); tnp[0] = MkAtomTerm(at);
if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)), if (!get_quasi_quotation(Yap_InitSlot(ArgOfTerm(2, tn)),
&qq->text, &qq->text,
qq->text + strlen((const char *)qq->text))) qq->text + strlen((const char *)qq->text))) {
FAIL; syntax_msg( "could not get quasi quotation, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL;
}
if (positions) { if (positions) {
intptr_t qqend = qq->end.charno; intptr_t qqend = qq->end.charno;
@ -869,6 +949,7 @@ case Var_tok:
FUNCTOR_minus2, PL_INTPTR, FUNCTOR_minus2, PL_INTPTR,
qq->mid.charno + 2, /* end of | token */ qq->mid.charno + 2, /* end of | token */
PL_INTPTR, qqend - 2)) /* end minus "|}" */ PL_INTPTR, qqend - 2)) /* end minus "|}" */
syntax_msg( "failed to unify quasi quotation, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL; FAIL;
} }
@ -878,14 +959,16 @@ case Var_tok:
t = ArgOfTerm(4, tn); t = ArgOfTerm(4, tn);
if (!(to = PL_new_term_ref()) || if (!(to = PL_new_term_ref()) ||
!PL_unify_list(LOCAL_qq_tail, to, LOCAL_qq_tail) || !PL_unify_list(LOCAL_qq_tail, to, LOCAL_qq_tail) ||
!PL_unify(to, Yap_InitSlot(tn ))) !PL_unify(to, Yap_InitSlot(tn ))) {
syntax_msg( "failed to unify quasi quotation, at \"%s\"", tokRep(LOCAL_tokptr) );
FAIL; FAIL;
}
} }
#endif #endif
NextToken; NextToken;
break; break;
default: default:
syntax_msg( "expected operator, got \'%s\'", tokRep(LOCAL_tokptr) );
FAIL; FAIL;
} }
@ -900,7 +983,7 @@ case Var_tok:
Volatile int oldprio = curprio; Volatile int oldprio = curprio;
TRY3(func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2); TRY3(func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 2);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; syntax_msg("Heap Overflow");
FAIL; FAIL;
} NextToken; } NextToken;
{ {
@ -910,7 +993,7 @@ case Var_tok:
t = Yap_MkApplTerm(func, 2, args); t = Yap_MkApplTerm(func, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} }
}, },
@ -923,13 +1006,13 @@ case Var_tok:
/* parse as posfix operator */ /* parse as posfix operator */
Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1); Functor func = Yap_MkFunctor((Atom)LOCAL_tokptr->TokInfo, 1);
if (func == NULL) { if (func == NULL) {
LOCAL_ErrorMessage = "Heap Overflow"; syntax_msg("Heap Overflow");
FAIL; FAIL;
} }
t = Yap_MkApplTerm(func, 1, &t); t = Yap_MkApplTerm(func, 1, &t);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} }
curprio = opprio; curprio = opprio;
@ -948,7 +1031,7 @@ case Var_tok:
t = Yap_MkApplTerm(FunctorComma, 2, args); t = Yap_MkApplTerm(FunctorComma, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} }
curprio = 1000; curprio = 1000;
@ -963,7 +1046,7 @@ case Var_tok:
t = Yap_MkApplTerm(FunctorVBar, 2, args); t = Yap_MkApplTerm(FunctorVBar, 2, args);
/* check for possible overflow against local stack */ /* check for possible overflow against local stack */
if (HR > ASP - 4096) { if (HR > ASP - 4096) {
LOCAL_ErrorMessage = "Stack Overflow"; syntax_msg("Stack Overflow");
FAIL; FAIL;
} }
curprio = opprio; curprio = opprio;
@ -992,8 +1075,10 @@ case Var_tok:
continue; continue;
} }
} }
if (LOCAL_tokptr->Tok <= Ord(WString_tok)) if (LOCAL_tokptr->Tok <= Ord(WString_tok)) {
syntax_msg( "expected operator, got \'%s\'", tokRep(LOCAL_tokptr) );
FAIL; FAIL;
}
break; break;
} }
#if DEBUG #if DEBUG
@ -1014,6 +1099,10 @@ Term Yap_Parse(UInt prio) {
if (!sigsetjmp(FailBuff.JmpBuff, 0)) { if (!sigsetjmp(FailBuff.JmpBuff, 0)) {
t = ParseTerm(prio, &FailBuff PASS_REGS); t = ParseTerm(prio, &FailBuff PASS_REGS);
if (LOCAL_Error_TYPE == SYNTAX_ERROR) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
LOCAL_ErrorMessage = NULL;
}
// if (LOCAL_tokptr->Tok != Ord(eot_tok)) // if (LOCAL_tokptr->Tok != Ord(eot_tok))
// return (0L); // return (0L);
return (t); return (t);

7
C/scanner.c
View File

@ -469,8 +469,7 @@ static char chtype0[NUMBER_OF_CHARS + 1] = {
BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS, BS,
/* sp ! " # $ % & ' ( ) * + , - . / */ /* sp ! " # $ % & ' ( ) * + , - . / */
BS, SL, DC, SY, SY, CC, SY, QT, BK, BS, SL, DC, SY, SY, CC, SY, QT, BK, BK, SY, SY, BK, SY, SY, SY,
BK, SY, SY, BK, SY, SY, SY,
/* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */ /* 0 1 2 3 4 5 6 7 8 9 : ; < = > ? */
NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU, NU,
@ -893,7 +892,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
ch = getchr(inp_stream); ch = getchr(inp_stream);
if (base == 0) { if (base == 0) {
CACHE_REGS CACHE_REGS
wchar_t ascii = ch; wchar_t ascii = ch;
int scan_extra = TRUE; int scan_extra = TRUE;
if (ch == '\\' && if (ch == '\\' &&
@ -925,7 +924,7 @@ static Term get_num(int *chp, int *chbuffp, StreamDesc *inp_stream, char *s,
has_overflow = (has_overflow || TRUE); has_overflow = (has_overflow || TRUE);
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
} }
} else if (ch == 'x' && base == 0) { } else if (ch == 'x' && base == 0) {
might_be_float = FALSE; might_be_float = FALSE;
if (--max_size == 0) { if (--max_size == 0) {

2
C/threads.c
View File

@ -51,7 +51,7 @@ blob_type_t PL_Message_Queue = {
#if DEBUG_LOCKS||DEBUG_PE_LOCKS #if DEBUG_LOCKS||DEBUG_PE_LOCKS
int debug_locks = FALSE, debug_pe_locks = FALSE; bool debug_locks = true, debug_pe_locks = true;
static Int p_debug_locks( USES_REGS1 ) { debug_pe_locks = 1; return TRUE; } static Int p_debug_locks( USES_REGS1 ) { debug_pe_locks = 1; return TRUE; }
static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; debug_pe_locks = 0; return TRUE; } static Int p_nodebug_locks( USES_REGS1 ) { debug_locks = 0; debug_pe_locks = 0; return TRUE; }

3792
C/x.c
View File

File diff suppressed because it is too large Load Diff

20
H/Yap.h
View File

@ -847,6 +847,26 @@ LOG0(const char *f, int l, const char *fmt, ...)
#define REGS_LOG( ... ) #define REGS_LOG( ... )
#endif #endif
// YAP lexicon
/* Character types for tokenizer and write.c */
typedef enum char_kind_t {
BG = 0, /* initial state */
UC = 1, /* Upper case */
UL = 2, /* Underline */
LC = 3, /* Lower case */
NU = 4, /* digit */
QT = 5, /* single quote */
DC = 6, /* double quote */
SY = 7, /* Symbol character */
SL = 8, /* Solo character */
BK = 9, /* Brackets & friends */
BS = 10, /* Blank */
EF = 11, /* End of File marker */
CC = 12 /* comment,char % */
} charkind_t;
#ifndef __ANDROID__ #ifndef __ANDROID__
#define __android_log_print( ... ) #define __android_log_print( ... )
#endif #endif

2
H/iatoms.h
View File

@ -500,7 +500,7 @@
FunctorStreamEOS = Yap_MkFunctor(AtomEndOfStream,1); FunctorStreamEOS = Yap_MkFunctor(AtomEndOfStream,1);
FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,4); FunctorStreamPos = Yap_MkFunctor(AtomStreamPos,4);
FunctorString1 = Yap_MkFunctor(AtomString,1); FunctorString1 = Yap_MkFunctor(AtomString,1);
FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,7); FunctorSyntaxError = Yap_MkFunctor(AtomSyntaxError,5);
FunctorShortSyntaxError = Yap_MkFunctor(AtomSyntaxError,1); FunctorShortSyntaxError = Yap_MkFunctor(AtomSyntaxError,1);
FunctorTermExpansion = Yap_MkFunctor(AtomTermExpansion,2); FunctorTermExpansion = Yap_MkFunctor(AtomTermExpansion,2);
FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2); FunctorThreadRun = Yap_MkFunctor(AtomTopThreadGoal,2);

16
OPTYap/locks_pthread.h
View File

@ -32,7 +32,7 @@ int Yap_ThreadID( void );
#define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR)) #define DESTROY_LOCK(LOCK_VAR) pthread_mutex_destroy(&(LOCK_VAR))
#define TRY_LOCK(LOCK_VAR) pthread_mutex_trylock(&(LOCK_VAR)) #define TRY_LOCK(LOCK_VAR) pthread_mutex_trylock(&(LOCK_VAR))
#if DEBUG_LOCKS #if DEBUG_LOCKS
extern int debug_locks; extern bool debug_locks;
#define LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) ) #define LOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: LOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_lock(&(LOCK_VAR)) )
#define UNLOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: UNLOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_unlock(&(LOCK_VAR)) ) #define UNLOCK(LOCK_VAR) (void)(fprintf(debugf, "[%d] %s:%d: UNLOCK(%p)\n", Yap_ThreadID(),__BASE_FILE__, __LINE__,&(LOCK_VAR)) && pthread_mutex_unlock(&(LOCK_VAR)) )
@ -41,21 +41,21 @@ extern int debug_locks;
#define UNLOCK(LOCK_VAR) pthread_mutex_unlock(&(LOCK_VAR)) #define UNLOCK(LOCK_VAR) pthread_mutex_unlock(&(LOCK_VAR))
#endif #endif
static inline int static inline bool
xIS_LOCKED(pthread_mutex_t *LOCK_VAR) { xIS_LOCKED(pthread_mutex_t *LOCK_VAR) {
if (pthread_mutex_trylock(LOCK_VAR) == 0) { if (pthread_mutex_trylock(LOCK_VAR) == 0) {
pthread_mutex_unlock(LOCK_VAR); pthread_mutex_unlock(LOCK_VAR);
return TRUE; return true;
} }
return FALSE; return false;
} }
static inline int static inline bool
xIS_UNLOCKED(pthread_mutex_t *LOCK_VAR) { xIS_UNLOCKED(pthread_mutex_t *LOCK_VAR) {
if (pthread_mutex_trylock(LOCK_VAR) == 0) { if (pthread_mutex_trylock(LOCK_VAR) == 0) {
pthread_mutex_unlock(LOCK_VAR); pthread_mutex_unlock(LOCK_VAR);
return FALSE; return false;
} }
return TRUE; return true;
} }
#define IS_LOCKED(LOCK_VAR) xIS_LOCKED(&(LOCK_VAR)) #define IS_LOCKED(LOCK_VAR) xIS_LOCKED(&(LOCK_VAR))
@ -65,7 +65,7 @@ xIS_UNLOCKED(pthread_mutex_t *LOCK_VAR) {
#define INIT_RWLOCK(X) pthread_rwlock_init(&(X), NULL) #define INIT_RWLOCK(X) pthread_rwlock_init(&(X), NULL)
#define DESTROY_RWLOCK(X) pthread_rwlock_destroy(&(X)) #define DESTROY_RWLOCK(X) pthread_rwlock_destroy(&(X))
#if DEBUG_PE_LOCKS #if DEBUG_PE_LOCKS
extern int debug_pe_locks; extern bool debug_pe_locks;
#define READ_LOCK(X) ((debug_pe_locks ? \ #define READ_LOCK(X) ((debug_pe_locks ? \
fprintf(debugf, "[%d] %s:%d: RLOCK(%p)\n", \ fprintf(debugf, "[%d] %s:%d: RLOCK(%p)\n", \

2
include/YapError.h
View File

@ -23,9 +23,7 @@ typedef enum
FATAL_ERROR, FATAL_ERROR,
INTERNAL_ERROR, INTERNAL_ERROR,
INTERNAL_COMPILER_ERROR, INTERNAL_COMPILER_ERROR,
#if !YAP_JIT
NOJIT_ERROR, /* I added */ NOJIT_ERROR, /* I added */
#endif
PURE_ABORT, PURE_ABORT,
CALL_COUNTER_UNDERFLOW, CALL_COUNTER_UNDERFLOW,
/* ISO_ERRORS */ /* ISO_ERRORS */

2
misc/ATOMS
View File

@ -505,7 +505,7 @@ F Stream Stream 1
F StreamEOS EndOfStream 1 F StreamEOS EndOfStream 1
F StreamPos StreamPos 4 F StreamPos StreamPos 4
F String1 String 1 F String1 String 1
F SyntaxError SyntaxError 7 F SyntaxError SyntaxError 5
F ShortSyntaxError SyntaxError 1 F ShortSyntaxError SyntaxError 1
F TermExpansion TermExpansion 2 F TermExpansion TermExpansion 2
F ThreadRun TopThreadGoal 2 F ThreadRun TopThreadGoal 2

112
os/charsio.c
View File

@ -38,7 +38,7 @@ static char SccsId[] = "%W% %G%";
#if HAVE_IO_H #if HAVE_IO_H
/* Windows */ /* Windows */
#include <io.h> #include <io.h>
#endif #endif
#if HAVE_SOCKET #if HAVE_SOCKET
#include <winsock2.h> #include <winsock2.h>
#endif #endif
@ -60,12 +60,12 @@ static Int flush_all_streams( USES_REGS1);
INLINE_ONLY inline EXTERN Term MkCharTerm (Int c); INLINE_ONLY inline EXTERN Term MkCharTerm (Int c);
/** /**
* MkCharTerm: convert a character into a single atom. * MkCharTerm: convert a character into a single atom.
* *
* @param c the character code * @param c the character code
* *
* @return the term. * @return the term.
*/ */
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term
MkCharTerm (Int c) MkCharTerm (Int c)
@ -77,12 +77,12 @@ MkCharTerm (Int c)
} }
/** /**
* CharOfAtom: convert an atom into a single character. * CharOfAtom: convert an atom into a single character.
* *
* @param at the atom * @param at the atom
* *
* @return the char . * @return the char .
*/ */
INLINE_ONLY inline EXTERN Int INLINE_ONLY inline EXTERN Int
CharOfAtom (Atom at) CharOfAtom (Atom at)
@ -99,7 +99,7 @@ CharOfAtom (Atom at)
static Int static Int
at_end_of_stream ( USES_REGS1 ) at_end_of_stream ( USES_REGS1 )
{ /* at_end_of_stream */ { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "past_eof/1"); int sno = Yap_CheckStream (ARG1, Input_Stream_f, "past_eof/1");
Int out; Int out;
@ -117,7 +117,7 @@ at_end_of_stream ( USES_REGS1 )
static Int static Int
at_end_of_stream_0 ( USES_REGS1 ) at_end_of_stream_0 ( USES_REGS1 )
{ /* at_end_of_stream */ { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
Int out; Int out;
@ -137,7 +137,7 @@ yap_fflush( sno)
{ {
Yap_ReadlineFlush( sno ); Yap_ReadlineFlush( sno );
if ( (GLOBAL_Stream[sno].status & Output_Stream_f) && if ( (GLOBAL_Stream[sno].status & Output_Stream_f) &&
! (GLOBAL_Stream[sno].status & ! (GLOBAL_Stream[sno].status &
(Null_Stream_f| (Null_Stream_f|
InMemory_Stream_f| InMemory_Stream_f|
Socket_Stream_f| Socket_Stream_f|
@ -295,7 +295,7 @@ get0_line_codes ( USES_REGS1 )
} }
out = read_line(sno); out = read_line(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
if (rewind) if (rewind)
return Yap_unify(MkPairTerm(MkIntegerTerm(ch),out), ARG2); return Yap_unify(MkPairTerm(MkIntegerTerm(ch),out), ARG2);
else else
return Yap_unify(out,ARG2); return Yap_unify(out,ARG2);
@ -347,7 +347,7 @@ put_code_1 ( USES_REGS1 )
{ /* '$put'(,N) */ { /* '$put'(,N) */
int sno = LOCAL_c_output_stream, ch; int sno = LOCAL_c_output_stream, ch;
Term t2; Term t2;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE; return FALSE;
@ -367,7 +367,7 @@ put_code_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2))); GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2)));
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -379,7 +379,7 @@ put_code ( USES_REGS1 )
int ch; int ch;
Term t2; Term t2;
int sno; int sno;
if (IsVarTerm(t2 = Deref(ARG2))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_code/1");
return FALSE; return FALSE;
@ -398,11 +398,11 @@ put_code ( USES_REGS1 )
Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2"); Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "put/2");
return(FALSE); return(FALSE);
} }
GLOBAL_Stream[sno].stream_wputc (sno, ch); GLOBAL_Stream[sno].stream_wputc (sno, ch);
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -414,7 +414,7 @@ put_char_1 ( USES_REGS1 )
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
Term t2; Term t2;
int ch; int ch;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE; return FALSE;
@ -434,7 +434,7 @@ put_char_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, ch); GLOBAL_Stream[sno].stream_wputc (sno, ch);
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -446,7 +446,7 @@ put_char ( USES_REGS1 )
Term t2; Term t2;
int ch; int ch;
int sno; int sno;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1"); Yap_Error(INSTANTIATION_ERROR, t2, "put_char/1");
return FALSE; return FALSE;
@ -468,7 +468,7 @@ put_char ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2))); GLOBAL_Stream[sno].stream_wputc (sno, (int) IntegerOfTerm (Deref (ARG2)));
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -490,7 +490,7 @@ tab_1 ( USES_REGS1 )
Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1"); Yap_Error(DOMAIN_ERROR_OUT_OF_RANGE, t2, "tab/1");
return FALSE; return FALSE;
} }
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) { if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
@ -502,7 +502,7 @@ tab_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, ' '); GLOBAL_Stream[sno].stream_wputc (sno, ' ');
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -527,7 +527,7 @@ tab ( USES_REGS1 )
sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1"); sno = Yap_CheckStream (ARG1, Output_Stream_f, "nl/1");
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
if (GLOBAL_Stream[sno].status & Binary_Stream_f) { if (GLOBAL_Stream[sno].status & Binary_Stream_f) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0"); Yap_Error(PERMISSION_ERROR_OUTPUT_BINARY_STREAM, ARG1, "nl/0");
@ -538,7 +538,7 @@ tab ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, ' '); GLOBAL_Stream[sno].stream_wputc (sno, ' ');
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -557,7 +557,7 @@ nl_1 ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, 10); GLOBAL_Stream[sno].stream_wputc (sno, 10);
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -577,7 +577,7 @@ nl ( USES_REGS1 )
GLOBAL_Stream[sno].stream_wputc (sno, 10); GLOBAL_Stream[sno].stream_wputc (sno, 10);
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -610,7 +610,7 @@ put_byte ( USES_REGS1 )
GLOBAL_Stream[sno].stream_putc(sno, ch); GLOBAL_Stream[sno].stream_putc(sno, ch);
/* /*
* if (!(GLOBAL_Stream[sno].status & Null_Stream_f)) * if (!(GLOBAL_Stream[sno].status & Null_Stream_f))
* yap_fflush(GLOBAL_Stream[sno].file); * yap_fflush(GLOBAL_Stream[sno].file);
*/ */
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (TRUE); return (TRUE);
@ -652,7 +652,7 @@ skip_1 ( USES_REGS1 )
Term t2; Term t2;
int sno; int sno;
int ch; int ch;
if (IsVarTerm(t2 = Deref(ARG1))) { if (IsVarTerm(t2 = Deref(ARG1))) {
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2"); Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE; return FALSE;
@ -679,7 +679,7 @@ skip ( USES_REGS1 )
Term t2; Term t2;
int sno; int sno;
int ch; int ch;
if (IsVarTerm(t2 = Deref(ARG2))) { if (IsVarTerm(t2 = Deref(ARG2))) {
Yap_Error(INSTANTIATION_ERROR, t2, "skip/2"); Yap_Error(INSTANTIATION_ERROR, t2, "skip/2");
return FALSE; return FALSE;
@ -698,14 +698,14 @@ skip ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
/** /**
* @pred flush_output(+Stream) * @pred flush_output(+Stream)
* *
* Flush the stream _Stream_, that is, make sure all pending output is committed * Flush the stream _Stream_, that is, make sure all pending output is committed
* before any further execution. * before any further execution.
* *
* @param +_Stream_ * @param +_Stream_
* *
*/ */
static Int static Int
flush_output ( USES_REGS1 ) flush_output ( USES_REGS1 )
@ -718,13 +718,13 @@ flush_output ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
/** /**
* @pred flush_output * @pred flush_output
* *
* Flush the current output stream, that is, make sure all pending output is committed * Flush the current output stream, that is, make sure all pending output is committed
* before any further execution. By default this is user_output, but it may be * before any further execution. By default this is user_output, but it may be
* changed by current_output/1. * changed by current_output/1.
* *
*/ */
static Int static Int
flush_output0 ( USES_REGS1 ) flush_output0 ( USES_REGS1 )
@ -746,7 +746,7 @@ flush_all_streams ( USES_REGS1 )
#else #else
fflush (NULL); fflush (NULL);
#endif #endif
return TRUE; return TRUE;
} }
@ -755,7 +755,7 @@ static Int dopeek( int sno )
Int ocharcount, olinecount, olinepos; Int ocharcount, olinecount, olinepos;
StreamDesc *s; StreamDesc *s;
Int ch; Int ch;
s = GLOBAL_Stream+sno; s = GLOBAL_Stream+sno;
ocharcount = s->charcount; ocharcount = s->charcount;
olinecount = s->linecount; olinecount = s->linecount;
@ -784,7 +784,7 @@ static Int dopeek( int sno )
If _C_ is unbound, or is the code for a character, and If _C_ is unbound, or is the code for a character, and
the stream _S_ is a text stream, read the next character from the the stream _S_ is a text stream, read the next character from the
current stream and unify its code with _C_, while current stream and unify its code with _C_, while
leaving the current stream position unaltered. leaving the current stream position unaltered.
*/ */
@ -794,13 +794,13 @@ leaving the current stream position unaltered.
If _C_ is unbound, or is the code for a character, and If _C_ is unbound, or is the code for a character, and
the stream _S_ is a text stream, read the next character from the the stream _S_ is a text stream, read the next character from the
current stream and unify its code with _C_, while current stream and unify its code with _C_, while
leaving the current stream position unaltered. leaving the current stream position unaltered.
*/ */
static Int static Int
peek_code ( USES_REGS1 ) peek_code ( USES_REGS1 )
{ /* at_end_of_stream */ { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2");
Int ch; Int ch;
@ -824,13 +824,13 @@ peek_code ( USES_REGS1 )
If _C_ is unbound, or is the code for a character, and If _C_ is unbound, or is the code for a character, and
the current input stream is a text stream, read the next character from the the current input stream is a text stream, read the next character from the
current stream and unify its code with _C_, while current stream and unify its code with _C_, while
leaving the current stream position unaltered. leaving the current stream position unaltered.
*/ */
static Int static Int
peek_code_1 ( USES_REGS1 ) peek_code_1 ( USES_REGS1 )
{ /* at_end_of_stream */ { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
Int ch; Int ch;
@ -857,7 +857,7 @@ code with _C_, while leaving the current stream position unaltered.
static Int static Int
peek_byte ( USES_REGS1 ) peek_byte ( USES_REGS1 )
{ /* at_end_of_stream */ { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2");
Int ch; Int ch;
@ -885,7 +885,7 @@ code with _C_, while leaving the current stream position unaltered.
static Int static Int
peek_byte_1 ( USES_REGS1 ) peek_byte_1 ( USES_REGS1 )
{ /* at_end_of_stream */ { /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
Int ch; Int ch;
@ -915,8 +915,8 @@ atom with _C_, while leaving the stream position unaltered.
*/ */
static Int static Int
peek_char ( USES_REGS1 ) peek_char ( USES_REGS1 )
{ {
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2"); int sno = Yap_CheckStream (ARG1, Input_Stream_f, "peek/2");
wchar_t wsinp[2]; wchar_t wsinp[2];
Int ch; Int ch;
@ -947,12 +947,12 @@ atom with _C_, while leaving the stream position unaltered.
*/ */
static Int static Int
peek_char_1 ( USES_REGS1 ) peek_char_1 ( USES_REGS1 )
{ {
/* the next character is a EOF */ /* the next character is a EOF */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
wchar_t wsinp[2]; wchar_t wsinp[2];
Int ch; Int ch;
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
if ((ch = dopeek( sno )) < 0) { if ((ch = dopeek( sno )) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
@ -971,7 +971,7 @@ peek_char_1 ( USES_REGS1 )
If _C_ is unbound, or is the code for a character, and If _C_ is unbound, or is the code for a character, and
the stream _S_ is a text stream, read the next character from the the stream _S_ is a text stream, read the next character from the
current stream and unify its code with _C_, while current stream and unify its code with _C_, while
leaving the current stream position unaltered. leaving the current stream position unaltered.
Please use the ISO built-in peek_code/2. Please use the ISO built-in peek_code/2.
*/ */
@ -982,7 +982,7 @@ Please use the ISO built-in peek_code/2.
If _C_ is unbound, or is the code for a character, and If _C_ is unbound, or is the code for a character, and
the currrent input stream is a text stream, read the next character from the the currrent input stream is a text stream, read the next character from the
current stream and unify its code with _C_, while current stream and unify its code with _C_, while
leaving the current stream position unaltered. leaving the current stream position unaltered.
*/ */
@ -1012,8 +1012,8 @@ Yap_InitCharsio( void )
Yap_InitCPred ("get_char", 1, getchar_1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("get_char", 1, getchar_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("get0", 1, getcode_1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("get0", 1, getcode_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$get0_line_codes", 2, get0_line_codes, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("$get0_line_codes", 2, get0_line_codes, SafePredFlag|SyncPredFlag|HiddenPredFlag);
Yap_InitCPred ("get_byte", 2, get_byte, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("get_byte", 2, get_byte, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("get_byte", 1, get_byte_1, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred ("get_byte", 1, get_byte_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("put", 1, put_code_1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("put", 1, put_code_1, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("put", 2, put_code, SafePredFlag|SyncPredFlag); Yap_InitCPred ("put", 2, put_code, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("put_code", 1, put_code_1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("put_code", 1, put_code_1, SafePredFlag|SyncPredFlag);
@ -1049,5 +1049,5 @@ Yap_InitCharsio( void )
Yap_InitCPred ("tab", 2, tab, SafePredFlag|SyncPredFlag); Yap_InitCPred ("tab", 2, tab, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("tab1", 1, tab_1, SafePredFlag|SyncPredFlag); Yap_InitCPred ("tab1", 1, tab_1, SafePredFlag|SyncPredFlag);
} }

12
os/format.c
View File

@ -658,7 +658,17 @@ doformat(volatile Term otail, volatile Term oargs, int sno USES_REGS)
if (targ > tnum-1) if (targ > tnum-1)
goto do_consistency_error; goto do_consistency_error;
t = targs[targ++]; t = targs[targ++];
if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) { if (IsVarTerm(t))
goto do_instantiation_error;
if (IsStringTerm(t)) {
if (has_repeats)
goto do_consistency_error;
yhandle_t sl = Yap_StartSlots();
// stream is already locked.
Yap_plwrite (t, GLOBAL_Stream+sno, 0, Handle_vars_f|To_heap_f, 1200);
Yap_CloseSlots(sl);
LOCAL_FormatInfo = &finfo;
} else if (!format_print_str (sno, repeats, has_repeats, t, f_putc)) {
goto do_default_error; goto do_default_error;
} }
break; break;

16
os/iopreds.h
View File

@ -13,8 +13,12 @@ static char SccsId[] = "%W% %G%";
#ifndef IOPREDS_H #ifndef IOPREDS_H
#define IOPREDS_H 1 #define IOPREDS_H 1
#include <stdlib.h>
#include "Yap.h"
#include "Atoms.h"
/* /*
* This file defines main data-structure for stream management, * This file defines main data-structure for stream management,
* *
*/ */
@ -95,18 +99,18 @@ typedef struct read_data_t
unsigned char *base; /* base of clause */ unsigned char *base; /* base of clause */
unsigned char *end; /* end of the clause */ unsigned char *end; /* end of the clause */
unsigned char *token_start; /* start of most recent read token */ unsigned char *token_start; /* start of most recent read token */
int magic; /* RD_MAGIC */ int magic; /* RD_MAGIC */
struct stream_desc *stream; struct stream_desc *stream;
FILE *f; /* file. of known */ FILE *f; /* file. of known */
Term position; /* Line, line pos, char and byte */ Term position; /* Line, line pos, char and byte */
void *posp; /* position pointer */ void *posp; /* position pointer */
size_t posi; /* position number */ size_t posi; /* position number */
Term subtpos; /* Report Subterm positions */ Term subtpos; /* Report Subterm positions */
bool cycles; /* Re-establish cycles */ bool cycles; /* Re-establish cycles */
yapSourceLocation start_of_term; /* Position of start of term */ yapSourceLocation start_of_term; /* Position of start of term */
ModEntry* module; /* Current source module */ struct mod_entry* module; /* Current source module */
unsigned int flags; /* Module syntax flags */ unsigned int flags; /* Module syntax flags */
int styleCheck; /* style-checking mask */ int styleCheck; /* style-checking mask */
bool backquoted_string; /* Read `hello` as string */ bool backquoted_string; /* Read `hello` as string */
@ -119,7 +123,7 @@ typedef struct read_data_t
Term exception; /* raised exception */ Term exception; /* raised exception */
Term variables; /* report variables */ Term variables; /* report variables */
Term singles; /* Report singleton variables */ Term singles; /* Report singleton variables */
Term varnames; /* Report variables+names */ Term varnames; /* Report variables+names */
int strictness; /* Strictness level */ int strictness; /* Strictness level */
#ifdef O_QUASIQUOTATIONS #ifdef O_QUASIQUOTATIONS
@ -327,7 +331,7 @@ INLINE_ONLY inline EXTERN void count_output_char(int ch, StreamDesc *s);
Term Yap_StreamUserName(int sno); Term Yap_StreamUserName(int sno);
INLINE_ONLY inline EXTERN void INLINE_ONLY inline EXTERN void
count_output_char(int ch, StreamDesc *s) count_output_char(int ch, StreamDesc *s)
{ {
if (ch == '\n') if (ch == '\n')

103
os/readterm.c
View File

@ -230,25 +230,32 @@ static const param_t read_defs[] =
* + * +
*/ */
Term Term
Yap_syntax_error (TokEntry * tokptr, int sno) Yap_syntax_error (TokEntry * errtok, int sno)
{ {
CACHE_REGS CACHE_REGS
Term info; Term info;
Term out = MkIntTerm(0);
Term startline, errline, endline; Term startline, errline, endline;
Term tf[7]; Term tf[5];
Term *error = tf+3; Term *tailp = tf+4;
CELL *Hi = HR; CELL *Hi = HR;
UInt count = 0; UInt count = 0;
Term tcount = MkIntegerTerm(count);
startline = MkIntegerTerm(tokptr->TokPos); TokEntry * tok = LOCAL_tokptr;
Int cline = tok->TokPos;
*tailp = TermNil;
startline = MkIntegerTerm(cline);
clean_vars(LOCAL_VarTable); clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable); clean_vars(LOCAL_AnonVarTable);
while (1) { if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
errline = MkIntegerTerm( errtok->TokPos );
while (tok) {
Term ts[2]; Term ts[2];
if (HR > ASP-1024) { if (HR > ASP-1024) {
tf[3] = TermNil; tf[4] = TermNil;
errline = MkIntegerTerm(0); errline = MkIntegerTerm(0);
endline = MkIntegerTerm( 0 ); endline = MkIntegerTerm( 0 );
count = 0; count = 0;
@ -256,12 +263,16 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
HR = Hi; HR = Hi;
break; break;
} }
if (tokptr == LOCAL_toktide) { if (tok->TokPos != cline) {
errline = MkIntegerTerm( tokptr->TokPos ); *tailp = MkPairTerm(MkAtomTerm(AtomNil),TermNil);
out = MkIntegerTerm(count); tailp = RepPair(*tailp)+1;
} }
info = tokptr->TokInfo; if (tok == errtok && tok->Tok != Error_tok) {
switch (tokptr->Tok) { *tailp = MkPairTerm(MkAtomTerm(AtomError),TermNil);
tailp = RepPair(*tailp)+1;
}
info = tok->TokInfo;
switch (tok->Tok) {
case Name_tok: case Name_tok:
{ {
Term t0[1]; Term t0[1];
@ -270,7 +281,7 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
} }
break; break;
case Number_tok: case Number_tok:
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tokptr->TokInfo)); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomNumber,1),1,&(tok->TokInfo));
break; break;
case Var_tok: case Var_tok:
{ {
@ -312,10 +323,17 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
} }
break; break;
case Error_tok: case Error_tok:
case eot_tok: {
break; ts[0] = MkAtomTerm(AtomError);
}
break;
case eot_tok:
endline = MkIntegerTerm(tok->TokPos);
ts[0] = MkAtomTerm(AtomDot);
break;
case Ponctuation_tok: case Ponctuation_tok:
{ {
char s[2]; char s[2];
s[1] = '\0'; s[1] = '\0';
if ((info) == 'l') { if ((info) == 'l') {
@ -325,21 +343,14 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
} }
ts[0] = MkAtomTerm(Yap_LookupAtom(s)); ts[0] = MkAtomTerm(Yap_LookupAtom(s));
} }
} }
if (tokptr->Tok == Ord (eot_tok)) { tok = tok->TokNext;
*error = TermNil; if (!tok)
endline = MkIntegerTerm(tokptr->TokPos); break;
break; *tailp = MkPairTerm(ts[0], TermNil);
} else if (tokptr->Tok != Ord (Error_tok)) { tailp = RepPair(*tailp)+1;
ts[1] = MkIntegerTerm(tokptr->TokPos); }
*error = MkPairTerm(Yap_MkApplTerm(FunctorMinus,2,ts),TermNil);
error = RepPair(*error)+1;
count++;
}
tokptr = tokptr->TokNext;
}
{ {
Term tcount = MkIntegerTerm(count);
Term t[3]; Term t[3];
tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,&tcount); tf[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomRead,1),1,&tcount);
@ -348,11 +359,17 @@ Yap_syntax_error (TokEntry * tokptr, int sno)
t[2] = endline; t[2] = endline;
tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t); tf[1] = Yap_MkApplTerm(Yap_MkFunctor(AtomBetween,3),3,t);
} }
tf[2] = tf[3] = TermDot; /* 0: id */
tf[4] = MkIntegerTerm(count); /* 1: strat, error, end line */
tf[5] = out; /*2 msg */
tf[6] = Yap_StreamUserName(sno); if (LOCAL_ErrorMessage)
return(Yap_MkApplTerm(FunctorSyntaxError,7,tf)); tf[2] = MkStringTerm(LOCAL_ErrorMessage);
else
tf[2] = MkStringTerm("");
/* file */
tf[3] = Yap_StreamUserName(sno);
/* tf[4] = ; */
return(Yap_MkApplTerm(FunctorSyntaxError,5,tf));
} }
typedef struct FEnv { typedef struct FEnv {
@ -360,6 +377,7 @@ typedef struct FEnv {
Term tpos; /// initial position of the term to be read. Term tpos; /// initial position of the term to be read.
Term t; /// the output term Term t; /// the output term
TokEntry *tokstart; /// the token list TokEntry *tokstart; /// the token list
TokEntry *toklast; /// the last token
CELL *old_H; /// initial H, will be reset on stack overflow. CELL *old_H; /// initial H, will be reset on stack overflow.
tr_fr_ptr old_TR; /// initial TR tr_fr_ptr old_TR; /// initial TR
xarg *args; /// input args xarg *args; /// input args
@ -712,8 +730,6 @@ parseError(REnv *re, FEnv *fe, int inp_stream)
{ {
CACHE_REGS CACHE_REGS
fe->t = 0; fe->t = 0;
TokEntry * tokstart =
LOCAL_tokptr;
if (LOCAL_Error_TYPE == OUT_OF_TRAIL_ERROR || if (LOCAL_Error_TYPE == OUT_OF_TRAIL_ERROR ||
LOCAL_Error_TYPE == OUT_OF_AUXSPACE_ERROR || LOCAL_Error_TYPE == OUT_OF_AUXSPACE_ERROR ||
LOCAL_Error_TYPE == OUT_OF_HEAP_ERROR || LOCAL_Error_TYPE == OUT_OF_HEAP_ERROR ||
@ -725,7 +741,7 @@ parseError(REnv *re, FEnv *fe, int inp_stream)
/* just fail */ /* just fail */
return YAP_PARSING_FINISHED; return YAP_PARSING_FINISHED;
} else { } else {
Term terr = Yap_syntax_error(tokstart, inp_stream); Term terr = Yap_syntax_error(fe->toklast, inp_stream);
if (ParserErrorStyle ==TermError) { if (ParserErrorStyle ==TermError) {
LOCAL_ErrorMessage = "SYNTAX ERROR"; LOCAL_ErrorMessage = "SYNTAX ERROR";
Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage); Yap_Error(SYNTAX_ERROR,terr,LOCAL_ErrorMessage);
@ -747,6 +763,8 @@ parse(REnv *re, FEnv *fe, int inp_stream)
LOCAL_tokptr; LOCAL_tokptr;
fe->t = Yap_Parse(re->prio); fe->t = Yap_Parse(re->prio);
fe->toklast = LOCAL_tokptr;
LOCAL_tokptr = tokstart;
if (fe->t == 0 || LOCAL_ErrorMessage) if (fe->t == 0 || LOCAL_ErrorMessage)
return YAP_PARSING_ERROR; return YAP_PARSING_ERROR;
TR = (tr_fr_ptr)LOCAL_ScannerStack; TR = (tr_fr_ptr)LOCAL_ScannerStack;
@ -760,7 +778,6 @@ parse(REnv *re, FEnv *fe, int inp_stream)
first_char = tokstart->TokPos; first_char = tokstart->TokPos;
#endif /* EMACS */ #endif /* EMACS */
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable); Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable);
LOCAL_tokptr = NULL;
return YAP_PARSING_FINISHED; return YAP_PARSING_FINISHED;
} }
@ -775,7 +792,7 @@ parse(REnv *re, FEnv *fe, int inp_stream)
* *
* @return the term or 0 in case of error. * @return the term or 0 in case of error.
* *
* Implemenfayubluses a state machine: default is init, scan, parse, complete. * Implementation uses a state machine: default is init, scan, parse, complete.
* *
* *
*/ */

15
os/yapio.h
View File

@ -31,21 +31,6 @@
#ifndef _PL_WRITE_ #ifndef _PL_WRITE_
/* Character types for tokenizer and write.c */
#define UC 1 /* Upper case */
#define UL 2 /* Underline */
#define LC 3 /* Lower case */
#define NU 4 /* digit */
#define QT 5 /* single quote */
#define DC 6 /* double quote */
#define SY 7 /* Symbol character */
#define SL 8 /* Solo character */
#define BK 9 /* Brackets & friends */
#define BS 10 /* Blank */
#define EF 11 /* End of File marker */
#define CC 12 /* comment char % */
#define EOFCHAR EOF #define EOFCHAR EOF
#endif #endif

3
pl/boot.yap
View File

@ -237,8 +237,7 @@ private(_).
'$cut_by'/1, '$cut_by'/1,
'$disable_debugging'/0, '$disable_debugging'/0,
'$do_live'/0, '$do_live'/0,
'$ '$'/0,
'/0,
'$find_goal_definition'/4, '$find_goal_definition'/4,
'$handle_throw'/3, '$handle_throw'/3,
'$head_and_body'/3, '$head_and_body'/3,

4
pl/errors.yap
View File

@ -341,9 +341,9 @@ print_message(_, Term) :-
'$print_system_message'(_, banner, _) :- '$print_system_message'(_, banner, _) :-
current_prolog_flag(verbose, silent), !. current_prolog_flag(verbose, silent), !.
'$print_system_message'(Term, Level, Lines) :- '$print_system_message'(Term, Level, Lines) :-
( Level == error -> Term \= error(syntax_error(_), _) ; Level == warning ), ( Level == error -> true ; Level == warning ),
'$messages':prefix(Level, LinePrefix, Stream, Lines2, Lines), '$messages':prefix(Level, LinePrefix, Stream, Lines2, Lines),
'$messages':file_location(LinesF, Lines2), !, '$messages':file_location(Term, LinesF, Lines2), !,
flush_output(user_output), flush_output(user_output),
flush_output(user_error), flush_output(user_error),
print_message_lines(Stream, LinePrefix, [nl|LinesF]). print_message_lines(Stream, LinePrefix, [nl|LinesF]).

2
pl/init.yap
View File

@ -240,7 +240,7 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- set_prolog_flag(generate_debug_info,true). :- set_prolog_flag(generate_debug_info,true).
:- recorda('$dialect',yap,_). grep:- recorda('$dialect',yap,_).
% %
% cleanup ensure loaded and recover some data-base space. % cleanup ensure loaded and recover some data-base space.

106
pl/messages.yap
View File

@ -67,14 +67,13 @@ handling in YAP:
:- multifile user:generate_message_hook/3. :- multifile user:generate_message_hook/3.
file_location --> file_location(syntax_error(_,between(_,LN,_),_,FileName,_)) -->
{ source_location(FileName, LN) }, [ '~a:~d:0: ' - [FileName,LN] ],
file_position(FileName,LN). { source_location(FileName, LN) }.
file_location(_) -->
file_position(user_input,LN) --> [ '~a:~d:0: ' - [FileName,LN] ],
[ 'user_input:~d:0: ' - [LN] ]. { source_location(FileName, LN) }.
file_position(FileName,LN) -->
[ '~a:~d:0: ' - [FileName,LN] ].
generate_message(Term, Lines, []) :- generate_message(Term, Lines, []) :-
user:generate_message_hook(Term, [], Lines), !. user:generate_message_hook(Term, [], Lines), !.
@ -121,7 +120,7 @@ generate_message(error(Error,Context)) -->
system_message(error(Error,Context)), system_message(error(Error,Context)),
stack_dump(error(Error,Context)). stack_dump(error(Error,Context)).
generate_message(M) --> generate_message(M) -->
file_location, file_location(M),
system_message(M), system_message(M),
stack_dump(M). stack_dump(M).
@ -133,10 +132,10 @@ stack_dump(error(_,_)) -->
'$hacks':display_stack_info(CPs, Envs, 20, CP). '$hacks':display_stack_info(CPs, Envs, 20, CP).
stack_dump(_) --> []. stack_dump(_) --> [].
prolog_message(X,Y,Z) :- prolog_message(X) -->
system_message(X,Y,Z). system_message(X).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
system_message(query(_QueryResult,_)) --> []. system_message(query(_QueryResult,_)) --> [].
system_message(format(Msg, Args)) --> system_message(format(Msg, Args)) -->
[Msg - Args]. [Msg - Args].
@ -212,6 +211,11 @@ system_message(myddas_version(Version)) -->
[ 'MYDDAS version ~a' - [Version] ]. [ 'MYDDAS version ~a' - [Version] ].
system_message(yes) --> system_message(yes) -->
[ 'yes' ]. [ 'yes' ].
system_message( syntax_error(read(_R),between(L0,LM,LF),Msg,_,Term) ) -->
!,
['SYNTAX ERROR: ~s' - [Msg]],
[nl],
syntax_error_term( between(L0,LM,LF), Term ).
system_message(error(Msg,Info)) --> system_message(error(Msg,Info)) -->
( { var(Msg) } ; { var(Info)} ), !, ( { var(Msg) } ; { var(Info)} ), !,
['bad error ~w' - [error(Msg,Info)]]. ['bad error ~w' - [error(Msg,Info)]].
@ -346,34 +350,9 @@ system_message(error(resource_error(trail), Where)) -->
[ 'RESOURCE ERROR- not enough trail space' - [Where] ]. [ 'RESOURCE ERROR- not enough trail space' - [Where] ].
system_message(error(signal(SIG,_), _)) --> system_message(error(signal(SIG,_), _)) -->
[ 'UNEXPECTED SIGNAL: ~a' - [SIG] ]. [ 'UNEXPECTED SIGNAL: ~a' - [SIG] ].
system_message(error(syntax_error(_), [syntax_error(G,_,Msg,[],_,0,File)|_])) -->
[ 'SYNTAX ERROR at "~a", goal ~q: ~a' - [File,G,Msg] ].
% SWI like I/O error message. % SWI like I/O error message.
system_message(error(syntax_error(end_of_clause), [stream(Stream, Line, _, _)|_])) --> system_message(error(syntax_error(end_of_clause), [stream(Stream, Line, _, _)|_])) -->
[ 'SYNTAX ERROR ~a, stream ~w, near line ~d.' - ['Unexpected end of clause',Stream,Line] ]. [ 'SYNTAX ERROR ~a, stream ~w, near line ~d.' - ['Unexpected end of clause',Stream,Line] ].
system_message(error(syntax_error(read(_R),between(_L0,_LM,_LF),_Dot,Term,Pos,Start,File))) -->
{ Term = [_|_] },
['SYNTAX ERROR' - []],
syntax_error_line(File, Start, Pos),
syntax_error_term(10, Pos, Term),
[ '.' ].
system_message(error(system_error, Where)) -->
[ 'SYSTEM ERROR- ~w' - [Where] ].
system_message(error(internal_compiler_error, Where)) -->
[ 'INTERNAL COMPILER ERROR- ~w' - [Where] ].
system_message(error(system_error(Message), Where)) -->
[ 'SYSTEM ERROR- ~w at ~w]' - [Message,Where] ].
system_message(error(timeout_error(T,Obj), _Where)) -->
[ 'TIMEOUT ERROR- operation ~w on object ~w' - [T,Obj] ].
system_message(error(type_error(T,_,Err,M), _Where)) -->
[ 'TYPE ERROR- ~w: expected ~w, got ~w' - [T,Err,M] ].
system_message(error(type_error(TE,W), Where)) -->
{ object_name(TE, M) }, !,
[ 'TYPE ERROR- ~w: expected ~a, got ~w' - [Where,M,W] ].
system_message(error(type_error(TE,W), Where)) -->
[ 'TYPE ERROR- ~w: expected ~q, got ~w' - [Where,TE,W] ].
system_message(error(unknown, Where)) -->
[ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ].
system_message(error(unhandled_exception,Throw)) --> system_message(error(unhandled_exception,Throw)) -->
[ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ]. [ 'UNHANDLED EXCEPTION - message ~w unknown' - [Throw] ].
system_message(error(uninstantiation_error(TE), _Where)) --> system_message(error(uninstantiation_error(TE), _Where)) -->
@ -500,43 +479,46 @@ list_of_preds([P|L]) -->
['~q' - [P]], ['~q' - [P]],
list_of_preds(L). list_of_preds(L).
syntax_error_term(between(I,I,I),L) -->
!,
syntax_error_tokens(L).
syntax_error_term(between(I,_J,L),LTaL) -->
[' term from line ~d to line ~d' - [I,L] ],
syntax_error_tokens(LTaL).
syntax_error_line('', _,_) --> !, syntax_error_tokens([]) --> [].
[':~n' ]. syntax_error_tokens([T|L]) -->
syntax_error_line(File, Position,_) -->
[' at ~a, near line ~d:~n' - [File,Position]].
syntax_error_term(0,J,L) -->
['~n' ],
syntax_error_term(10,J,L).
syntax_error_term(_,0,L) --> !,
[ '~n<==== HERE ====>~n' ],
syntax_error_term(10,-1,L).
syntax_error_term(_,_,[]) --> !.
syntax_error_term(I,J,[T-_P|R]) -->
syntax_error_token(T), syntax_error_token(T),
{ syntax_error_tokens(L).
I1 is I-1,
J1 is J-1
},
syntax_error_term(I1,J1,R).
syntax_error_token(atom(A)) --> !, syntax_error_token(atom(A)) --> !,
[ ' ~a' - [A] ]. [ '~a' - [A] ].
syntax_error_token(number(N)) --> !, syntax_error_token(number(N)) --> !,
[ ' ~w' - [N] ]. [ '~w' - [N] ].
syntax_error_token(var(_,S,_)) --> !, syntax_error_token(var(_,S,_)) --> !,
[ ' ~s' - [S] ]. [ '~s' - [S] ].
syntax_error_token(string(S)) --> !, syntax_error_token(string(S)) --> !,
[ ' ""~s"' - [S] ]. [ '\"~s\"' - [S] ].
syntax_error_token(error) --> !,
[ '~n<==== HERE ====>~n' ].
syntax_error_token('[]') --> !,
[ nl ].
syntax_error_token('(') --> !, syntax_error_token('(') --> !,
[ '(' ]. [ '(' ].
syntax_error_token('(') --> !,
[ '{' ].
syntax_error_token('(') --> !,
[ '[' ].
syntax_error_token(')') --> !, syntax_error_token(')') --> !,
[ ' )' ]. [ ' )' ].
syntax_error_token(')') --> !,
[ ']' ].
syntax_error_token(')') --> !,
[ '}' ].
syntax_error_token(',') --> !, syntax_error_token(',') --> !,
[ ' ,' ]. [ ',' ].
syntax_error_token(A) --> !, syntax_error_token(A) --> !,
[ ' ~a' - [A] ]. [ '~a' - [A] ].
% print_message_lines(+Stream, +Prefix, +Lines) % print_message_lines(+Stream, +Prefix, +Lines)
@ -571,7 +553,7 @@ the _Prefix_ is printed too.
*/ */
prolog:print_message_lines(_S, _, []) :- !. prolog:print_message_lines(_S, _, []) :- !.
prolog:print_message_lines(_S, P, [at_same_line|Lines]) :- !, prolog:print_message_lines(S, P, [at_same_line|Lines]) :- !,
'$messages':print_message_line(S, Lines, Rest), '$messages':print_message_line(S, Lines, Rest),
prolog:print_message_lines(S, P, Rest). prolog:print_message_lines(S, P, Rest).
prolog:print_message_lines(S, kind(Kind), Lines) :- !, prolog:print_message_lines(S, kind(Kind), Lines) :- !,