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

Merge ssh://git.dcc.fc.up.pt/yap-6.3

Browse Source
This commit is contained in:
Vitor Santos Costa 2015-10-18 23:44:50 +01:00
commit 390e9e0557
16 changed files with 2029 additions and 2163 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
C/atomic.c
View File

@ -522,15 +522,19 @@ number_chars( USES_REGS1 )
if (Yap_IsGroundTerm(t1)) { if (Yap_IsGroundTerm(t1)) {
Term tf; Term tf;
tf = Yap_NumberToListOfAtoms(t1 PASS_REGS); tf = Yap_NumberToListOfAtoms(t1 PASS_REGS);
if (tf) if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify( ARG2, tf ); return Yap_unify( ARG2, tf );
}
} else { } else {
/* ARG1 unbound */ /* ARG1 unbound */
Term t = Deref(ARG2); Term t = Deref(ARG2);
Term tf = Yap_ListToNumber(t PASS_REGS); Term tf = Yap_ListToNumber(t PASS_REGS);
if (tf) if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify( ARG1, tf ); return Yap_unify( ARG1, tf );
} }
}
/* error handling */ /* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "number_chars/2" )) { if (LOCAL_Error_TYPE && Yap_HandleError( "number_chars/2" )) {
goto restart_aux; goto restart_aux;

42
C/errors.c
View File

@ -29,7 +29,6 @@
#endif #endif
#include "Foreign.h" #include "Foreign.h"
#if DEBUG #if DEBUG
void Yap_PrintPredName(PredEntry *ap) { void Yap_PrintPredName(PredEntry *ap) {
CACHE_REGS CACHE_REGS
@ -103,7 +102,8 @@ bool Yap_Warning(const char *s, ...) {
} }
LOCAL_DoingUndefp = true; LOCAL_DoingUndefp = true;
LOCAL_within_print_message = true; LOCAL_within_print_message = true;
pred = RepPredProp(PredPropByFunc(FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2 pred = RepPredProp(PredPropByFunc(FunctorPrintMessage,
PROLOG_MODULE)); // PROCEDURE_print_message2
if (pred->OpcodeOfPred == UNDEF_OPCODE) { if (pred->OpcodeOfPred == UNDEF_OPCODE) {
// fprintf(stderr, "warning message:\n"); // fprintf(stderr, "warning message:\n");
// Yap_DebugPlWrite(twarning); // Yap_DebugPlWrite(twarning);
@ -348,7 +348,8 @@ return mkerrorct(B, ts);
* *
* + e=p(mod, name, arity, cl, file, lin): where the code was entered; * + e=p(mod, name, arity, cl, file, lin): where the code was entered;
* *
* + p=p(mod, name, arity, cl, file, line): the prolog procedure that caused the bug, * + p=p(mod, name, arity, cl, file, line): the prolog procedure that caused
*the bug,
*and optionally, *and optionally,
* *
* + g=g(Goal): the goal that created this mess * + g=g(Goal): the goal that created this mess
@ -417,10 +418,11 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
#endif #endif
// fprintf(stderr, "warning: "); // fprintf(stderr, "warning: ");
comment = MkAtomTerm(Yap_LookupAtom(s)); comment = MkAtomTerm(Yap_LookupAtom(s));
} else if (LOCAL_ErrorSay && LOCAL_ErrorSay[0]) } else if (LOCAL_ErrorSay && LOCAL_ErrorSay[0]) {
comment = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorSay)); comment = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorSay));
else } else {
comment = TermNil; comment = TermNil;
}
va_end(ap); va_end(ap);
if (P == (yamop *)(FAILCODE)) { if (P == (yamop *)(FAILCODE)) {
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
@ -462,6 +464,15 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
#ifdef DEBUG #ifdef DEBUG
// DumpActiveGoals( USES_REGS1 ); // DumpActiveGoals( USES_REGS1 );
#endif /* DEBUG */ #endif /* DEBUG */
if (!IsVarTerm(where) &&
IsApplTerm(where) &&
FunctorOfTerm(where) == FunctorError) {
error_t = where;
Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
}
switch (type) { switch (type) {
case SYSTEM_ERROR_INTERNAL: { case SYSTEM_ERROR_INTERNAL: {
fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf); fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf);
@ -518,6 +529,9 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
ts[2] = where; ts[2] = where;
nt[0] = mkerrort(type, ts + 2); nt[0] = mkerrort(type, ts + 2);
} }
} }
if (type != ABORT_EVENT) { if (type != ABORT_EVENT) {
/* This is used by some complex procedures to detect there was an error */ /* This is used by some complex procedures to detect there was an error */
@ -531,7 +545,6 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
MAX_ERROR_MSG_SIZE); MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay; LOCAL_ErrorMessage = LOCAL_ErrorSay;
} }
}
switch (type) { switch (type) {
case RESOURCE_ERROR_HEAP: case RESOURCE_ERROR_HEAP:
case RESOURCE_ERROR_STACK: case RESOURCE_ERROR_STACK:
@ -540,20 +553,25 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
default: default:
nt[1] = TermNil; nt[1] = TermNil;
if (comment != TermNil) if (comment != TermNil)
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")),comment), nt[1]); nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")), comment),
nt[1]);
if (file && function) { if (file && function) {
Term ts[3], t3; Term ts[3], t3;
ts[0] = MkAtomTerm(Yap_LookupAtom(file)); ts[0] = MkAtomTerm(Yap_LookupAtom(file));
ts[1] = MkIntegerTerm(lineno); ts[1] = MkIntegerTerm(lineno);
ts[2] = MkAtomTerm(Yap_LookupAtom(function)); ts[2] = MkAtomTerm(Yap_LookupAtom(function));
t3 = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("c"), 3), 3, ts); t3 = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("c"), 3), 3, ts);
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")),t3), nt[1]); nt[1] =
MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")), t3), nt[1]);
} }
if ((culprit = Yap_pc_location(P, B, ENV)) != TermNil) { if ((culprit = Yap_pc_location(P, B, ENV)) != TermNil) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")),culprit), nt[1]); nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("p")), culprit),
nt[1]);
} }
if ((culprit = Yap_env_location(CP, B, ENV, 0)) != TermNil) { if ((culprit = Yap_env_location(CP, B, ENV, 0)) != TermNil) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")),culprit), nt[1]); nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), culprit),
nt[1]);
}
} }
} }
/* disable active signals at this point */ /* disable active signals at this point */
@ -583,7 +601,6 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
error_t = MkAtomTerm(AtomDAbort); error_t = MkAtomTerm(AtomDAbort);
} else { } else {
error_t = Yap_MkApplTerm(fun, 2, nt); error_t = Yap_MkApplTerm(fun, 2, nt);
} }
Yap_JumpToEnv(error_t); Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
@ -591,7 +608,4 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
LOCAL_PrologMode &= ~InErrorMode; LOCAL_PrologMode &= ~InErrorMode;
return P; return P;
} }

2
C/exec.c
View File

@ -1133,7 +1133,7 @@ exec_absmi(bool top, yap_reset_t reset_mode USES_REGS)
/* must be done here, otherwise siglongjmp will clobber all the registers */ /* must be done here, otherwise siglongjmp will clobber all the registers */
Yap_Error(LOCAL_matherror ,TermNil,NULL); Yap_Error(LOCAL_matherror ,TermNil,NULL);
/* reset the registers so that we don't have trash in abstract machine */ /* reset the registers so that we don't have trash in abstract machine */
Yap_set_fpu_exceptions(true); Yap_set_fpu_exceptions(getAtomicGlobalPrologFlag(ARITHMETIC_EXCEPTIONS_FLAG));
P = (yamop *)FAILCODE; P = (yamop *)FAILCODE;
LOCAL_PrologMode = UserMode; LOCAL_PrologMode = UserMode;
} }

156
C/scanner.c
View File

@ -437,9 +437,7 @@ writing, writing a BOM can be requested using the option
static Term float_send(char *, int); static Term float_send(char *, int);
static Term get_num(int *, int *, struct stream_desc *, char *, UInt, int); static Term get_num(int *, int *, struct stream_desc *, char *, UInt, int);
static void static void Yap_setCurrentSourceLocation(struct stream_desc *s) {
Yap_setCurrentSourceLocation( struct stream_desc *s )
{
CACHE_REGS CACHE_REGS
#if HAVE_SOCKET #if HAVE_SOCKET
if (s->status & Socket_Stream_f) if (s->status & Socket_Stream_f)
@ -469,7 +467,8 @@ 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, BK, SY, SY, BK, SY, SY, SY, BS, SL, DC, SY, SY, CC, SY, QT, BK,
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,
@ -581,6 +580,14 @@ typedef struct scanner_extra_alloc {
void *filler; void *filler;
} ScannerExtraBlock; } ScannerExtraBlock;
static void InitScannerMemory(void) {
CACHE_REGS
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Size = 0;
LOCAL_ScannerStack = (char *)TR;
LOCAL_ScannerExtraBlocks = NULL;
}
static char *AllocScannerMemory(unsigned int size) { static char *AllocScannerMemory(unsigned int size) {
CACHE_REGS CACHE_REGS
char *AuxSpScan; char *AuxSpScan;
@ -687,7 +694,8 @@ static int send_error_message(char s[]) {
return 0; return 0;
} }
static wchar_t read_quoted_char(int *scan_nextp, struct stream_desc* inp_stream) { static wchar_t read_quoted_char(int *scan_nextp,
struct stream_desc *inp_stream) {
int ch; int ch;
/* escape sequence */ /* escape sequence */
@ -1095,38 +1103,91 @@ Term Yap_scan_num(StreamDesc *inp) {
Term out; Term out;
int sign = 1; int sign = 1;
int ch, cherr; int ch, cherr;
char *ptr; char *ptr, *mp;
int kind;
void *old_tr = TR;
LOCAL_ErrorMessage = NULL; InitScannerMemory();
LOCAL_ScannerStack = (char *)TR; LOCAL_VarTable = LOCAL_AnonVarTable = NULL;
LOCAL_ScannerExtraBlocks = NULL;
if (!(ptr = AllocScannerMemory(4096))) { if (!(ptr = AllocScannerMemory(4096))) {
LOCAL_ErrorMessage = "Trail Overflow"; LOCAL_ErrorMessage = "Trail Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL; LOCAL_Error_TYPE = RESOURCE_ERROR_TRAIL;
return TermNil; return 0;
} }
TokEntry *tokptr = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
tokptr->TokPos = GetCurInpPos(inp);
ch = getchr(inp); ch = getchr(inp);
while (chtype(ch) == BS) {
ch = getchr(inp);
}
if (ch == '-') { if (ch == '-') {
sign = -1; sign = -1;
ch = getchr(inp); ch = getchr(inp);
} else if (ch == '+') { } else if (ch == '+') {
ch = getchr(inp); ch = getchr(inp);
} }
if (chtype(ch) != NU) { if (chtype(ch) == NU) {
Yap_clean_tokenizer((TokEntry *)LOCAL_ScannerStack, NULL, NULL);
return TermNil;
}
cherr = '\0'; cherr = '\0';
if (ASP - HR < 1024) if (ASP - HR < 1024) {
return TermNil; Yap_clean_tokenizer(old_tr, NULL, NULL);
LOCAL_ErrorMessage = "Stack Overflow";
LOCAL_Error_TYPE = RESOURCE_ERROR_STACK;
return 0;
}
out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */ out = get_num(&ch, &cherr, inp, ptr, 4096, sign); /* */
}
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr) {
CACHE_REGS
char *s = ptr;
int sign = 1;
out = 0;
if (s[0] == '+') {
s++;
}
if (s[0] == '-') {
s++;
sign = -1;
}
if (strcmp(s, "inf") == 0) {
if (sign > 0) {
out = MkFloatTerm(INFINITY);
} else {
out = MkFloatTerm(-INFINITY);
}
}
if (strcmp(s, "nan") == 0) {
if (sign > 0) {
out = MkFloatTerm(NAN);
} else {
out = MkFloatTerm(-NAN);
}
}
if (out == 0) {
TokEntry *e, *ef;
size_t len = strlen(ptr);
mp = AllocScannerMemory(len + 1);
tokptr->Tok = Ord(kind = String_tok);
tokptr->TokInfo = Unsigned(mp);
e = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
ef = (TokEntry *)AllocScannerMemory(sizeof(TokEntry));
tokptr->TokNext = e;
e->Tok = Error_tok;
if (!LOCAL_ErrorMessage)
LOCAL_ErrorMessage =
"syntax error while converting from a string to a number";
e->TokInfo = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorMessage));
e->TokPos = GetCurInpPos(inp);
e->TokNext = ef;
ef->Tok = Ord(kind = eot_tok);
ef->TokPos = GetCurInpPos(inp);
ef->TokNext = NULL;
LOCAL_tokptr = tokptr;
LOCAL_toktide = e;
LOCAL_ErrorMessage = NULL;
LOCAL_Error_Term = Yap_syntax_error(e, inp - GLOBAL_Stream);
LOCAL_Error_TYPE = SYNTAX_ERROR;
}
}
PopScannerMemory(ptr, 4096); PopScannerMemory(ptr, 4096);
Yap_clean_tokenizer((TokEntry *)LOCAL_ScannerStack, NULL, NULL); Yap_clean_tokenizer(old_tr, NULL, NULL);
if (LOCAL_ErrorMessage != NULL || ch != -1 || cherr)
return TermNil;
return out; return out;
} }
@ -1141,9 +1202,7 @@ Term Yap_scan_num(StreamDesc *inp) {
return l; \ return l; \
} }
const char * const char *Yap_tokRep(TokEntry *tokptr) {
Yap_tokRep(TokEntry *tokptr)
{
CACHE_REGS CACHE_REGS
Term info = tokptr->TokInfo; Term info = tokptr->TokInfo;
char *b, *buf = LOCAL_FileNameBuf2; char *b, *buf = LOCAL_FileNameBuf2;
@ -1154,13 +1213,14 @@ Yap_tokRep(TokEntry *tokptr)
case Name_tok: case Name_tok:
return (char *)RepAtom((Atom)info)->StrOfAE; return (char *)RepAtom((Atom)info)->StrOfAE;
case Number_tok: case Number_tok:
if ((b = Yap_TermToString(info, buf, sze, &length, &LOCAL_encoding, flags)) != buf) { if ((b = Yap_TermToString(info, buf, sze, &length, &LOCAL_encoding,
if (b) free(b); flags)) != buf) {
if (b)
free(b);
return NULL; return NULL;
} }
return buf; return buf;
case Var_tok: case Var_tok: {
{
VarEntry *varinfo = (VarEntry *)info; VarEntry *varinfo = (VarEntry *)info;
return varinfo->VarRep; return varinfo->VarRep;
} }
@ -1168,8 +1228,8 @@ Yap_tokRep(TokEntry *tokptr)
case BQString_tok: case BQString_tok:
return (char *)info; return (char *)info;
case WString_tok: case WString_tok:
case WBQString_tok: case WBQString_tok: {
{ wchar_t *op = (wchar_t *)info; wchar_t *op = (wchar_t *)info;
wchar_t c; wchar_t c;
unsigned char *bp = (unsigned char *)buf; unsigned char *bp = (unsigned char *)buf;
while ((c = *op++)) { while ((c = *op++)) {
@ -1182,8 +1242,7 @@ Yap_tokRep(TokEntry *tokptr)
return "<ERR>"; return "<ERR>";
case eot_tok: case eot_tok:
return "<EOT>"; return "<EOT>";
case Ponctuation_tok: case Ponctuation_tok: {
{
buf[1] = '\0'; buf[1] = '\0';
if ((info) == 'l') { if ((info) == 'l') {
buf[0] = '('; buf[0] = '(';
@ -1198,7 +1257,6 @@ Yap_tokRep(TokEntry *tokptr)
} }
} }
static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) { static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) {
CELL *h0 = HR; CELL *h0 = HR;
HR += 5; HR += 5;
@ -1214,8 +1272,7 @@ static void open_comment(int ch, StreamDesc *inp_stream USES_REGS) {
LOCAL_CommentsTail = h0 + 1; LOCAL_CommentsTail = h0 + 1;
h0 += 2; h0 += 2;
h0[0] = (CELL)FunctorMinus; h0[0] = (CELL)FunctorMinus;
h0[1] = Yap_StreamPosition(inp_stream-GLOBAL_Stream h0[1] = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
);
h0[2] = TermNil; h0[2] = TermNil;
LOCAL_CommentsNextChar = h0 + 2; LOCAL_CommentsNextChar = h0 + 2;
LOCAL_CommentsBuff = (wchar_t *)malloc(1024 * sizeof(wchar_t)); LOCAL_CommentsBuff = (wchar_t *)malloc(1024 * sizeof(wchar_t));
@ -1244,9 +1301,7 @@ static void close_comment(USES_REGS1) {
// mark that we reached EOF, // mark that we reached EOF,
// next token will be end_of_file) // next token will be end_of_file)
static void static void mark_eof(struct stream_desc *inp_stream) {
mark_eof( struct stream_desc * inp_stream )
{
inp_stream->status |= Push_Eof_Stream_f; inp_stream->status |= Push_Eof_Stream_f;
} }
@ -1297,8 +1352,8 @@ static wchar_t *ch_to_wide(char *base, char *charp) {
} \ } \
} }
TokEntry *Yap_tokenizer( struct stream_desc *inp_stream, TokEntry *Yap_tokenizer(struct stream_desc *inp_stream, bool store_comments,
bool store_comments, Term *tposp) { Term *tposp) {
CACHE_REGS CACHE_REGS
TokEntry *t, *l, *p; TokEntry *t, *l, *p;
@ -1308,12 +1363,9 @@ TokEntry *Yap_tokenizer( struct stream_desc *inp_stream,
wchar_t *wcharp; wchar_t *wcharp;
struct qq_struct_t *cur_qq = NULL; struct qq_struct_t *cur_qq = NULL;
LOCAL_ErrorMessage = NULL; InitScannerMemory();
LOCAL_Error_Size = 0;
LOCAL_VarTable = NULL; LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL; LOCAL_AnonVarTable = NULL;
LOCAL_ScannerStack = (char *)TR;
LOCAL_ScannerExtraBlocks = NULL;
l = NULL; l = NULL;
p = NULL; /* Just to make lint happy */ p = NULL; /* Just to make lint happy */
ch = getchr(inp_stream); ch = getchr(inp_stream);
@ -1420,7 +1472,8 @@ huge_var_error:
} }
add_ch_to_buff(ch); add_ch_to_buff(ch);
} }
while (ch == '\'' && isvar &&trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) { while (ch == '\'' && isvar &&
trueGlobalPrologFlag(VARIABLE_NAMES_MAY_END_WITH_QUOTES_FLAG)) {
if (charp == (char *)AuxSp - 1024) { if (charp == (char *)AuxSp - 1024) {
goto huge_var_error; goto huge_var_error;
} }
@ -1666,7 +1719,6 @@ quoted_string:
} else { } else {
t->Tok = Ord(kind = BQString_tok); t->Tok = Ord(kind = BQString_tok);
} }
} }
} else { } else {
if (wcharp) { if (wcharp) {
@ -1750,8 +1802,7 @@ quoted_string:
goto restart; goto restart;
} }
enter_symbol: enter_symbol:
if (och == '.' && if (och == '.' && (chtype(ch) == BS || chtype(ch) == EF || ch == '%')) {
(chtype(ch) == BS || chtype(ch) == EF || ch == '%')) {
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
if (chtype(ch) == EF) if (chtype(ch) == EF)
mark_eof(inp_stream); mark_eof(inp_stream);
@ -1989,7 +2040,6 @@ enter_symbol:
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
return l; return l;
default: default:
#if DEBUG #if DEBUG
fprintf(stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch)); fprintf(stderr, "\n++++ token: wrong char type %c %d\n", ch, chtype(ch));
@ -1998,8 +2048,7 @@ enter_symbol:
} }
#if DEBUG #if DEBUG
if (GLOBAL_Option[2]) if (GLOBAL_Option[2])
fprintf(stderr, "[Token %d %s]", Ord(kind), fprintf(stderr, "[Token %d %s]", Ord(kind), Yap_tokRep(t));
Yap_tokRep( t ));
#endif #endif
if (LOCAL_ErrorMessage) { if (LOCAL_ErrorMessage) {
/* insert an error token to inform the system of what happened */ /* insert an error token to inform the system of what happened */
@ -2024,8 +2073,7 @@ enter_symbol:
return (l); return (l);
} }
void Yap_clean_tokenizer(TokEntry *tokstart, void Yap_clean_tokenizer(TokEntry *tokstart, VarEntry *vartable,
VarEntry *vartable,
VarEntry *anonvartable) { VarEntry *anonvartable) {
CACHE_REGS CACHE_REGS
struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks; struct scanner_extra_alloc *ptr = LOCAL_ScannerExtraBlocks;

379
C/text.c
View File

@ -54,176 +54,99 @@ Globalize(Term v USES_REGS)
return v; return v;
} }
static char *
get_string_from_list( Term t, seq_tv_t *inp, char *s, int atoms USES_REGS)
{
char *s0 = s;
size_t max = -1;
if (inp->type & YAP_STRING_TRUNC) {
max = inp->max;
}
if (TRUE /* atoms == -1 */) {
while (t != TermNil) {
Term h = HeadOfTerm(t);
if (IsAtomTerm(h)) {
Atom at;
if (IsWideAtom(at = AtomOfTerm(h)))
*s++ = RepAtom(at)->WStrOfAE[0];
else
*s++ = (unsigned char)(RepAtom(at)->StrOfAE[0]);
} else {
*s++ = IntOfTerm(h);
}
if (--max == 0) {
*s++ = 0;
return s0;
}
t = TailOfTerm(t);
}
} else if (atoms) {
while (t != TermNil) {
Atom at;
if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t)))) {
int i = RepAtom(at)->WStrOfAE[0];
if (i <= 0) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL;
}
*s++ = i;
} else
*s++ = RepAtom(at)->StrOfAE[0];
if (--max == 0) {
*s++ = 0;
return s0;
}
t = TailOfTerm(t);
}
} else {
while (t != TermNil) {
Int i = IntOfTerm(HeadOfTerm(t));
if (i <= 0 || i > 255) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL;
}
*s++ = i;
if (--max == 0) {
*s++ = '\0';
return s0;
}
t = TailOfTerm(t);
}
}
*s++ = '\0';
return s0;
}
static wchar_t *
get_wide_from_list( Term t, seq_tv_t *inp, wchar_t *s, int atoms USES_REGS)
{
wchar_t *s0 = s;
size_t max = -1;
if (inp->type & YAP_STRING_TRUNC) {
max = inp->max;
}
if (TRUE /* atoms == -1*/) {
while (t != TermNil) {
Term h = HeadOfTerm(t);
if (IsAtomTerm(h)) {
Atom at;
if (IsWideAtom(at = AtomOfTerm(h)))
*s++ = RepAtom(at)->WStrOfAE[0];
else
*s++ = (unsigned char)(RepAtom(at)->StrOfAE[0]);
} else {
*s++ = IntOfTerm(h);
}
if (--max == 0) {
*s++ = 0;
return s0;
}
t = TailOfTerm(t);
}
} else if (atoms) {
while (t != TermNil) {
Atom at;
if (IsWideAtom(at = AtomOfTerm(HeadOfTerm(t))))
*s++ = RepAtom(at)->WStrOfAE[0];
else
*s++ = (unsigned char)(RepAtom(at)->StrOfAE[0]);
if (--max == 0) {
*s++ = 0;
return s0;
}
t = TailOfTerm(t);
}
} else {
while (t != TermNil) {
int code;
*s++ = code = IntOfTerm(HeadOfTerm(t));
if (code <= 0) {
LOCAL_Error_TYPE = REPRESENTATION_ERROR_CHARACTER_CODE;
return NULL;
}
if (--max == 0) {
*s++ = 0;
return s0;
}
t = TailOfTerm(t);
}
}
*s++ = '\0';
return s0;
}
static Int static Int
SkipListCodes(Term *l, Term **tailp, Int *atoms, bool *wide) SkipListCodes(unsigned char **bufp, Term *l, Term **tailp, Int *atoms, bool *wide, seq_tv_t *inp USES_REGS)
{ {
Int length = 0; Int length = 0;
Term *s; /* slow */ Term *s; /* slow */
Term v; /* temporary */ Term v; /* temporary */
*wide = false;
size_t max = 1;
unsigned char *st0 = *bufp, *st;
unsigned char *smax = NULL;
do_derefa(v,l,derefa_unk,derefa_nonvar); do_derefa(v,l,derefa_unk,derefa_nonvar);
*tailp = l;
s = l; s = l;
*wide = false;
if (inp->type & YAP_STRING_TRUNC) {
max = inp->max;
} else {
max = 0; // basically, this will never be reached;
}
if (!st0) {
*bufp = st0 = (unsigned char *)Yap_PreAllocCodeSpace();
smax = (unsigned char *)AuxTop-8; // give 8 bytes for max UTF-8 size + '\0';
} else if (inp->sz > 0) {
smax = st0+(inp->sz-8); // give 8 bytes for max UTF-8 size + '\0';
} else {
// AUX_ERROR( *l, 2*(length+1), st0, unsigned char);
return 0;
}
*bufp = st = st0;
if (*l == TermNil) { if (*l == TermNil) {
*tailp = l;
*atoms = 0;
*wide = FALSE;
return 0; return 0;
} }
if ( IsPairTerm(*l) ) if ( IsPairTerm(*l) )
{ intptr_t power = 1, lam = 0; { intptr_t power = 1, lam = 0;
do Term hd0 = HeadOfTerm(*l);
{ if ( power == lam ) if (IsVarTerm(hd0)) {
{ s = l; return -INSTANTIATION_ERROR;
power *= 2;
lam = 0;
} }
lam++; //are we looking for atoms/codes?
// whatever the case, we should be consistent throughout,
// so we should be consistent with the first arg.
if (*atoms == 1) {
if ( !IsIntegerTerm(hd0) ) {
return -INSTANTIATION_ERROR;
}
} else if (*atoms == 2) {
if ( !IsAtomTerm(hd0) ) {
return -TYPE_ERROR_ATOM;
}
}
do {
int ch;
length++; length++;
if (length == max) {
*st++ = '\0';
}
{ Term hd = Deref(RepPair(*l)[0]); { Term hd = Deref(RepPair(*l)[0]);
if (IsVarTerm(hd)) { if (IsVarTerm(hd)) {
length = -INSTANTIATION_ERROR; return -INSTANTIATION_ERROR;
} else if (IsAtomTerm(hd)) { } else if (IsAtomTerm(hd)) {
(*atoms)++; (*atoms)++;
/* if (*atoms < length) if (*atoms < length)
{ *tailp = l; return -TYPE_ERROR_STRING; } */ { *tailp = l; return -TYPE_ERROR_NUMBER; }
if (IsWideAtom(AtomOfTerm(hd))) { if (IsWideAtom(AtomOfTerm(hd))) {
if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER; } int ch;
*wide = TRUE; if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') {
length = -REPRESENTATION_ERROR_CHARACTER;
}
ch = RepAtom(AtomOfTerm(hd))->WStrOfAE[0];
*wide = true;
} else { } else {
AtomEntry *ae = RepAtom(AtomOfTerm(hd)); AtomEntry *ae = RepAtom(AtomOfTerm(hd));
if ((ae->StrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER_CODE; } if ((ae->StrOfAE)[1] != '\0') {
length = -REPRESENTATION_ERROR_CHARACTER;
} else {
ch = RepAtom(AtomOfTerm(hd))->StrOfAE[0];
*wide |= ch > 0x80;
}
} }
} else if (IsIntegerTerm(hd)) { } else if (IsIntegerTerm(hd)) {
Int ch = IntegerOfTerm(hd); ch = IntegerOfTerm(hd);
if (/* *atoms|| */ch < 0) { *tailp = l; /*if (*atoms) length = -TYPE_ERROR_STRING;*/ length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO; } if (*atoms) length = -TYPE_ERROR_ATOM;
else if (ch > 0x80) { *wide = TRUE; } else if (ch < 0) {
*tailp = l;
length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
} else {
*wide |= ch > 0x80;
}
} else { } else {
length = -TYPE_ERROR_INTEGER; length = -TYPE_ERROR_INTEGER;
} }
@ -232,102 +155,70 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, bool *wide)
return length; return length;
} }
} }
// now copy char to buffer
size_t chsz = put_utf8( st, ch );
if (smax <= st+chsz) {
*st++ = '\0';
*tailp = l;
return length;
} else {
st += chsz;
}
l = RepPair(*l)+1; l = RepPair(*l)+1;
do_derefa(v,l,derefa2_unk,derefa2_nonvar); do_derefa(v,l,derefa2_unk,derefa2_nonvar);
} while ( *l != *s && IsPairTerm(*l) ); } while ( *l != *s && IsPairTerm(*l) );
} }
if (IsVarTerm(*l)) {
return -INSTANTIATION_ERROR;
}
if ( *l != TermNil) {
return -TYPE_ERROR_LIST;
}
st[0] = '\0';
*tailp = l; *tailp = l;
return length; return length;
} }
static void * static void *
Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS) to_buffer(void *buf, Term t, seq_tv_t *inp, bool *widep, Int *atoms, size_t *lenp USES_REGS)
{ {
Int atoms = 0;
CELL *r = NULL; CELL *r = NULL;
Int n; Int n;
*widep = false; if (!buf) {
n = SkipListCodes(&t, &r, &atoms, widep); inp->sz = *lenp;
}
unsigned char *bufc = buf;
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
if (n < 0) { if (n < 0) {
LOCAL_Error_TYPE = -n; LOCAL_Error_TYPE = -n;
LOCAL_Error_Term = *r; LOCAL_Error_Term = *r;
return NULL; return NULL;
} }
if (*r != TermNil) {
if (IsVarTerm(*r))
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
else
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = *r;
return NULL;
}
/* if (n && !atoms) {
LOCAL_Error_Term = t;
LOCAL_Error_TYPE = TYPE_ERROR_CHARACTER;
return NULL;
}
*/
*lenp = n; *lenp = n;
if (*widep) { return bufc;
wchar_t *s;
if (buf) s = buf;
else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->WStrOfAE;
AUX_ERROR( t, 2*(n+1), s, wchar_t);
s = get_wide_from_list( t, inp, s, atoms PASS_REGS);
return s;
} else {
char *s;
if (buf) s = buf;
else s = (char *)((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
AUX_ERROR( t, 2*(n+1), s, char);
s = get_string_from_list( t, inp, s, atoms PASS_REGS);
return s;
}
} }
static void * static void *
Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS) Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
{ {
Int atoms = 0; Int atoms = 1; // we only want lists of atoms
CELL *r = NULL; return to_buffer( buf, t, inp, widep, &atoms, lenp PASS_REGS);
Int n; }
*widep = false; static void *
n = SkipListCodes(&t, &r, &atoms, widep); Yap_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
if (n < 0) { {
LOCAL_Error_TYPE = -n; Int atoms = 2; // we only want lists of integer codes
LOCAL_Error_Term = *r; return to_buffer( buf, t, inp, widep, &atoms, lenp PASS_REGS);
return NULL;
}
if (*r != TermNil) {
if (IsVarTerm(*r))
LOCAL_Error_TYPE = INSTANTIATION_ERROR;
else
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
LOCAL_Error_Term = *r;
return NULL;
}
if (n && atoms)
return NULL;
*lenp = n;
if (*widep) {
wchar_t *s;
if (buf) s = buf;
else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->WStrOfAE;
AUX_ERROR( t, 2*(n+1), s, wchar_t);
s = get_wide_from_list( t, inp, s, atoms PASS_REGS);
return s;
} else {
char *s;
if (buf) s = buf;
else s = ((AtomEntry *)Yap_PreAllocCodeSpace())->StrOfAE;
AUX_ERROR( t, 2*(n+1), (char *)s, char);
s = ( char *)get_string_from_list( t, inp, (char *)s, atoms PASS_REGS);
return s;
} }
static void *
Yap_ListToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
{
Int atoms = 0; // we accept both types of lists.
return to_buffer( buf, t, inp, widep, &atoms, lenp PASS_REGS);
} }
#if USE_GEN_TYPE_ERROR #if USE_GEN_TYPE_ERROR
@ -355,24 +246,32 @@ gen_type_error(int flags) {
void * void *
Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *lengp USES_REGS) Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *lengp USES_REGS)
{ {
char *s; char *s, *s0 = buf;
wchar_t *ws; wchar_t *ws;
bool wide; bool wide;
/* we know what the term is */ /* we know what the term is */
if ( !(inp->type & (YAP_STRING_CHARS|YAP_STRING_WCHARS))) if ( !(inp->type & (YAP_STRING_CHARS|YAP_STRING_WCHARS)))
{ {
if (IsVarTerm(inp->val.t) && !(inp->type & YAP_STRING_TERM)) { if ( !(inp->type & YAP_STRING_TERM)) {
if (IsVarTerm(inp->val.t)) {
LOCAL_Error_TYPE = INSTANTIATION_ERROR; LOCAL_Error_TYPE = INSTANTIATION_ERROR;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) { } else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM; LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) { } else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_STRING) {
LOCAL_Error_TYPE = TYPE_ERROR_STRING; LOCAL_Error_TYPE = TYPE_ERROR_STRING;
}else if (!IsPairTerm(inp->val.t) &&
!IsStringTerm(inp->val.t) &&
inp->type == (YAP_STRING_ATOMS_CODES|YAP_STRING_STRING)) {
LOCAL_Error_TYPE = TYPE_ERROR_LIST;
} else if (!IsNumTerm(inp->val.t) && (inp->type & ( YAP_STRING_INT|YAP_STRING_FLOAT| YAP_STRING_BIG)) == inp->type) { } else if (!IsNumTerm(inp->val.t) && (inp->type & ( YAP_STRING_INT|YAP_STRING_FLOAT| YAP_STRING_BIG)) == inp->type) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER; LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
} }
LOCAL_Error_Term = inp->val.t; LOCAL_Error_Term = inp->val.t;
} }
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR)
return NULL;
// this is a term, extract the UTF8 representation // this is a term, extract the UTF8 representation
if ( IsStringTerm(inp->val.t) && if ( IsStringTerm(inp->val.t) &&
@ -401,23 +300,30 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
return s; return s;
} }
} }
if (inp->type & YAP_STRING_CODES && (s = Yap_ListOfCodesToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { if (((inp->type &(YAP_STRING_CODES|YAP_STRING_ATOMS)) ==
(YAP_STRING_CODES|YAP_STRING_ATOMS))) {
s = Yap_ListToBuffer( s0, inp->val.t, inp, &wide, lengp PASS_REGS);
// this is a term, extract to a sfer, and representation is wide // this is a term, extract to a sfer, and representation is wide
*minimal = TRUE; *minimal = true;
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 ); *enc = ENC_ISO_UTF8;
return s; return s;
} }
if (inp->type & YAP_STRING_ATOMS && (s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS))) { if (inp->type == YAP_STRING_CODES) {
s = Yap_ListOfCodesToBuffer( s0, inp->val.t, inp, &wide, lengp PASS_REGS);
// this is a term, extract to a sfer, and representation is wide
*minimal = true;
*enc = ENC_ISO_UTF8;
return s;
}
if (inp->type == YAP_STRING_ATOMS) {
s = Yap_ListOfAtomsToBuffer( s0, inp->val.t, inp, &wide, lengp PASS_REGS);
// this is a term, extract to a buffer, and representation is wide // this is a term, extract to a buffer, and representation is wide
*minimal = TRUE; *minimal = true;
s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS); *enc = ENC_ISO_UTF8;
if (!s) return NULL;
if (wide) { *enc = ENC_ISO_UTF8; }
else { *enc = ENC_ISO_LATIN1; }
return s; return s;
} }
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) { if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
if (buf) s = buf; if (s0) s = s0;
else s = Yap_PreAllocCodeSpace(); else s = Yap_PreAllocCodeSpace();
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) { if (snprintf(s, LOCAL_MAX_SIZE-1, Int_FORMAT, IntegerOfTerm(inp->val.t)) < 0) {
@ -428,7 +334,7 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
return s; return s;
} }
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) { if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
if (buf) s = buf; if (s0) s = s0;
else s = Yap_PreAllocCodeSpace(); else s = Yap_PreAllocCodeSpace();
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
if ( !Yap_FormatFloat( FloatOfTerm(inp->val.t), &s, LOCAL_MAX_SIZE-1 ) ) { if ( !Yap_FormatFloat( FloatOfTerm(inp->val.t), &s, LOCAL_MAX_SIZE-1 ) ) {
@ -440,7 +346,7 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
} }
#if USE_GMP #if USE_GMP
if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) { if (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
if (buf) s = buf; if (s0) s = s0;
else s = Yap_PreAllocCodeSpace(); else s = Yap_PreAllocCodeSpace();
if ( !Yap_mpz_to_string( Yap_BigIntOfTerm(inp->val.t), s, LOCAL_MAX_SIZE-1 , 10 ) ) { if ( !Yap_mpz_to_string( Yap_BigIntOfTerm(inp->val.t), s, LOCAL_MAX_SIZE-1 , 10 ) ) {
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char); AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
@ -453,7 +359,7 @@ Yap_readText( void *buf, seq_tv_t *inp, encoding_t *enc, int *minimal, size_t *l
if (inp->type & YAP_STRING_TERM) if (inp->type & YAP_STRING_TERM)
{ {
char *s, *o; char *s, *o;
if (buf) s = buf; if (s0) s = s0;
else s = Yap_PreAllocCodeSpace(); else s = Yap_PreAllocCodeSpace();
size_t sz = LOCAL_MAX_SIZE-1; size_t sz = LOCAL_MAX_SIZE-1;
encoding_t enc = ENC_ISO_UTF8; encoding_t enc = ENC_ISO_UTF8;
@ -872,7 +778,7 @@ write_wbuffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
} }
static size_t size_t
write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{ {
size_t min = 0, max = leng, sz_end; size_t min = 0, max = leng, sz_end;
@ -916,7 +822,7 @@ write_buffer( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
unsigned char *s = s0, *lim = s + (max = strnlen(s0, max)); unsigned char *s = s0, *lim = s + (max = strnlen(s0, max));
unsigned char *cp = s, *buf0, *buf; unsigned char *cp = s, *buf0, *buf;
buf = buf0 = out->val.uc; buf = buf0 = s0;
if (!buf) if (!buf)
return -1; return -1;
while (*cp && cp < lim) { while (*cp && cp < lim) {
@ -1056,13 +962,18 @@ write_length( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng
static Term static Term
write_number( void *s0, seq_tv_t *out, encoding_t enc, int minimal, int size USES_REGS) write_number( void *s0, seq_tv_t *out, encoding_t enc, int minimal, int size USES_REGS)
{ {
return Yap_StringToNumberTerm(s0, &enc); Term o;
return
Yap_StringToNumberTerm(s0, &enc);
} }
static Term static Term
string_to_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS) string_to_term( void *s0, seq_tv_t *out, encoding_t enc, int minimal, size_t leng USES_REGS)
{ {
return Yap_StringToTerm(s0, strlen(s0)+1, &enc, 1200, NULL); printf("TR0=%p\n", TR);
Term o = out->val.t = Yap_StringToTerm(s0, strlen(s0)+1, &enc, 1200, NULL);
printf("TRF=%p\n", TR);
return o;
} }
@ -1091,9 +1002,7 @@ write_Text( void *inp, seq_tv_t *out, encoding_t enc, int minimal, size_t leng U
out->val.a = out->val.a =
write_atom( inp, out, enc, minimal, leng PASS_REGS); write_atom( inp, out, enc, minimal, leng PASS_REGS);
return out->val.a != NULL; return out->val.a != NULL;
case YAP_STRING_INT: case YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG:
case YAP_STRING_FLOAT:
case YAP_STRING_BIG:
out->val.t = out->val.t =
write_number( inp, out, enc, minimal, leng PASS_REGS); write_number( inp, out, enc, minimal, leng PASS_REGS);
return out->val.t != 0; return out->val.t != 0;

4
H/YapFlags.h
View File

@ -207,6 +207,10 @@ static inline void setAtomicGlobalPrologFlag(int id, Term v) {
GLOBAL_Flags[id].at = v; GLOBAL_Flags[id].at = v;
} }
static inline Term getAtomicGlobalPrologFlag(int id) {
return GLOBAL_Flags[id].at;
}
static inline void setAtomicLocalPrologFlag(int id, Term v) { static inline void setAtomicLocalPrologFlag(int id, Term v) {
CACHE_REGS CACHE_REGS
check_refs_to_ltable(); check_refs_to_ltable();

2
H/YapGFlagInfo.h
View File

@ -44,7 +44,7 @@ YAP_FLAG( ALLOW_ASSERT_FOR_STATIC_PREDICATES, "allow_assert_for_static_predica
/* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, "allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**< `allow_variable_name_as_functor` */ /* YAP_FLAG( ALLOW_VARIABLE_NAME_AS_FUNCTOR_FLAG, "allow_variable_name_as_functor", true, boolean, "false" , NULL ), /\**< `allow_variable_name_as_functor` */
/* allow A(X) *\/ */ /* allow A(X) *\/ */
YAP_FLAG( ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p" , NULL ), /** `arithmetic_exceptions ` YAP_FLAG( ANSWER_FORMAT_FLAG, "answer_format", true, isatom, "~p" , Yap_set_fpu_exceptions ), /** `arithmetic_exceptions `
Read-write flag telling whether arithmetic exceptions generate Read-write flag telling whether arithmetic exceptions generate
Prolog exceptions. If enabled: Prolog exceptions. If enabled:

2
H/Yapproto.h
View File

@ -379,7 +379,7 @@ int Yap_IsOpMaxPrio(Atom);
/* sysbits.c */ /* sysbits.c */
void Yap_InitPageSize(void); void Yap_InitPageSize(void);
bool Yap_set_fpu_exceptions(bool); bool Yap_set_fpu_exceptions(Term);
UInt Yap_cputime(void); UInt Yap_cputime(void);
Int Yap_walltime(void); Int Yap_walltime(void);
int Yap_dir_separator(int); int Yap_dir_separator(int);

216
os/charsio.c
View File

@ -67,9 +67,7 @@ INLINE_ONLY inline EXTERN Term MkCharTerm (Int c);
* *
* @return the term. * @return the term.
*/ */
INLINE_ONLY inline EXTERN Term INLINE_ONLY inline EXTERN Term MkCharTerm(Int c) {
MkCharTerm (Int c)
{
wchar_t cs[2]; wchar_t cs[2];
if (c < 0) if (c < 0)
return MkAtomTerm(AtomEof); return MkAtomTerm(AtomEof);
@ -78,7 +76,6 @@ MkCharTerm (Int c)
return MkAtomTerm(Yap_LookupMaybeWideAtom(cs)); return MkAtomTerm(Yap_LookupMaybeWideAtom(cs));
} }
/** /**
* CharOfAtom: convert an atom into a single character. * CharOfAtom: convert an atom into a single character.
* *
@ -86,9 +83,7 @@ MkCharTerm (Int c)
* *
* @return the char . * @return the char .
*/ */
INLINE_ONLY inline EXTERN Int INLINE_ONLY inline EXTERN Int CharOfAtom(Atom at) {
CharOfAtom (Atom at)
{
if (IsWideAtom(at)) { if (IsWideAtom(at)) {
return at->WStrOfAE[0]; return at->WStrOfAE[0];
} else { } else {
@ -96,14 +91,11 @@ CharOfAtom (Atom at)
} }
} }
static int static int plUnGetc(int sno, int ch) {
plUnGetc( int sno, int ch )
{
return ungetc(ch, GLOBAL_Stream[sno].file); return ungetc(ch, GLOBAL_Stream[sno].file);
} }
Int Yap_peek( int sno ) Int Yap_peek(int sno) {
{
CACHE_REGS CACHE_REGS
Int ocharcount, olinecount, olinepos; Int ocharcount, olinecount, olinepos;
StreamDesc *s; StreamDesc *s;
@ -130,8 +122,7 @@ Int Yap_peek( int sno )
return ch; return ch;
} }
static Int dopeek_byte( int sno ) static Int dopeek_byte(int sno) {
{
Int ocharcount, olinecount, olinepos; Int ocharcount, olinecount, olinepos;
StreamDesc *s; StreamDesc *s;
Int ch; Int ch;
@ -149,9 +140,7 @@ static Int dopeek_byte( int sno )
return ch; return ch;
} }
static Int static Int at_end_of_stream(USES_REGS1) { /* at_end_of_stream */
at_end_of_stream ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckStream(ARG1, Input_Stream_f, NULL); int sno = Yap_CheckStream(ARG1, Input_Stream_f, NULL);
Int out; Int out;
@ -170,9 +159,7 @@ at_end_of_stream ( USES_REGS1 )
return out; return out;
} }
static Int static Int at_end_of_stream_0(USES_REGS1) { /* at_end_of_stream */
at_end_of_stream_0 ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
Int out; Int out;
@ -185,27 +172,18 @@ at_end_of_stream_0 ( USES_REGS1 )
return out; return out;
} }
static int yap_fflush(sno) {
static int
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 | Socket_Stream_f | Pipe_Stream_f |
InMemory_Stream_f|
Socket_Stream_f|
Pipe_Stream_f|
Free_Stream_f))) { Free_Stream_f))) {
return (fflush(GLOBAL_Stream[sno].file)); return (fflush(GLOBAL_Stream[sno].file));
} else } else
return (0); return (0);
} }
static Int get(USES_REGS1) { /* '$get'(Stream,-N) */
static Int
get ( USES_REGS1 )
{ /* '$get'(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get/2");
int ch; int ch;
Int status; Int status;
@ -219,9 +197,7 @@ get ( USES_REGS1 )
return (Yap_unify_constant(ARG2, MkIntegerTerm(ch))); return (Yap_unify_constant(ARG2, MkIntegerTerm(ch)));
} }
static Int static Int get_char(USES_REGS1) { /* '$get'(Stream,-N) */
get_char ( USES_REGS1 )
{ /* '$get'(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get/2");
int ch; int ch;
Int status; Int status;
@ -234,9 +210,7 @@ get_char ( USES_REGS1 )
return (Yap_unify_constant(ARG2, MkCharTerm(ch))); return (Yap_unify_constant(ARG2, MkCharTerm(ch)));
} }
static Int static Int get_code(USES_REGS1) { /* get0(Stream,-N) */
get_code ( USES_REGS1 )
{ /* get0(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get0/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get0/2");
Int status; Int status;
Int out; Int out;
@ -249,10 +223,7 @@ get_code ( USES_REGS1 )
return (Yap_unify_constant(ARG2, MkIntegerTerm(out))); return (Yap_unify_constant(ARG2, MkIntegerTerm(out)));
} }
static Int get_1(USES_REGS1) { /* get_code1(Stream,-N) */
static Int
get_1 ( USES_REGS1 )
{ /* get_code1(Stream,-N) */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
int ch; int ch;
Int status; Int status;
@ -265,9 +236,7 @@ get_1 ( USES_REGS1 )
return (Yap_unify_constant(ARG2, MkIntegerTerm(ch))); return (Yap_unify_constant(ARG2, MkIntegerTerm(ch)));
} }
static Int static Int getcode_1(USES_REGS1) { /* get0(Stream,-N) */
getcode_1 ( USES_REGS1 )
{ /* get0(Stream,-N) */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
Int status; Int status;
Int out; Int out;
@ -279,9 +248,7 @@ getcode_1 ( USES_REGS1 )
return (Yap_unify_constant(ARG1, MkIntegerTerm(out))); return (Yap_unify_constant(ARG1, MkIntegerTerm(out)));
} }
static Int static Int getchar_1(USES_REGS1) { /* get0(Stream,-N) */
getchar_1 ( USES_REGS1 )
{ /* get0(Stream,-N) */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
Int status; Int status;
Int out; Int out;
@ -293,10 +260,7 @@ getchar_1 ( USES_REGS1 )
return (Yap_unify_constant(ARG1, MkCharTerm(out))); return (Yap_unify_constant(ARG1, MkCharTerm(out)));
} }
static Int get0_line_codes(USES_REGS1) { /* '$get0'(Stream,-N) */
static Int
get0_line_codes ( USES_REGS1 )
{ /* '$get0'(Stream,-N) */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get0/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "get0/2");
Int status; Int status;
Term out; Term out;
@ -315,9 +279,7 @@ get0_line_codes ( USES_REGS1 )
return Yap_unify(out, ARG2); return Yap_unify(out, ARG2);
} }
static Int static Int get_byte(USES_REGS1) { /* '$get_byte'(Stream,-N) */
get_byte ( USES_REGS1 )
{ /* '$get_byte'(Stream,-N) */
int sno = Yap_CheckStream(ARG1, Input_Stream_f, "get_byte/2"); int sno = Yap_CheckStream(ARG1, Input_Stream_f, "get_byte/2");
Int status; Int status;
Term out; Term out;
@ -337,9 +299,7 @@ get_byte ( USES_REGS1 )
return Yap_unify_constant(ARG2, out); return Yap_unify_constant(ARG2, out);
} }
static Int static Int get_byte_1(USES_REGS1) { /* '$get_byte'(Stream,-N) */
get_byte_1 ( USES_REGS1 )
{ /* '$get_byte'(Stream,-N) */
int sno = LOCAL_c_input_stream; int sno = LOCAL_c_input_stream;
Int status; Int status;
Term out; Term out;
@ -358,9 +318,7 @@ get_byte_1 ( USES_REGS1 )
return Yap_unify_constant(ARG1, out); return Yap_unify_constant(ARG1, out);
} }
static Int static Int put_code_1(USES_REGS1) { /* '$put'(,N) */
put_code_1 ( USES_REGS1 )
{ /* '$put'(,N) */
int sno = LOCAL_c_output_stream, ch; int sno = LOCAL_c_output_stream, ch;
Term t2; Term t2;
@ -384,9 +342,7 @@ put_code_1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int put_code(USES_REGS1) { /* '$put'(Stream,N) */
put_code ( USES_REGS1 )
{ /* '$put'(Stream,N) */
int ch; int ch;
Term t2; Term t2;
int sno; int sno;
@ -419,9 +375,7 @@ put_code ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int put_char_1(USES_REGS1) { /* '$put'(,N) */
put_char_1 ( USES_REGS1 )
{ /* '$put'(,N) */
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
Term t2; Term t2;
int ch; int ch;
@ -451,9 +405,7 @@ put_char_1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int put_char(USES_REGS1) { /* '$put'(Stream,N) */
put_char ( USES_REGS1 )
{ /* '$put'(Stream,N) */
Term t2; Term t2;
int ch; int ch;
int sno; int sno;
@ -485,9 +437,7 @@ put_char ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int tab_1(USES_REGS1) { /* nl */
tab_1 ( USES_REGS1 )
{ /* nl */
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
Term t2; Term t2;
Int tabs, i; Int tabs, i;
@ -519,9 +469,7 @@ tab_1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int tab(USES_REGS1) { /* nl(Stream) */
tab ( USES_REGS1 )
{ /* nl(Stream) */
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
Term t2; Term t2;
Int tabs, i; Int tabs, i;
@ -555,9 +503,7 @@ tab ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int nl_1(USES_REGS1) { /* nl */
nl_1 ( USES_REGS1 )
{ /* nl */
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
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) {
@ -574,9 +520,7 @@ nl_1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int nl(USES_REGS1) { /* nl(Stream) */
nl ( USES_REGS1 )
{ /* nl(Stream) */
int sno = Yap_CheckTextStream(ARG1, Output_Stream_f, "nl/1"); int sno = Yap_CheckTextStream(ARG1, Output_Stream_f, "nl/1");
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
@ -594,9 +538,7 @@ nl ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int put_byte(USES_REGS1) { /* '$put_byte'(Stream,N) */
put_byte ( USES_REGS1 )
{ /* '$put_byte'(Stream,N) */
Term t2; Term t2;
Int ch; Int ch;
if (IsVarTerm(t2 = Deref(ARG2))) { if (IsVarTerm(t2 = Deref(ARG2))) {
@ -628,9 +570,7 @@ put_byte ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int put_byte_1(USES_REGS1) { /* '$put_byte'(Stream,N) */
put_byte_1 ( USES_REGS1 )
{ /* '$put_byte'(Stream,N) */
Term t2; Term t2;
Int ch; Int ch;
int sno = LOCAL_c_output_stream; int sno = LOCAL_c_output_stream;
@ -657,10 +597,7 @@ put_byte_1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int skip_1(USES_REGS1) { /* '$skip'(Stream,N) */
static Int
skip_1 ( USES_REGS1 )
{ /* '$skip'(Stream,N) */
Int n; Int n;
Term t2; Term t2;
int sno; int sno;
@ -685,9 +622,7 @@ skip_1 ( USES_REGS1 )
return (TRUE); return (TRUE);
} }
static Int static Int skip(USES_REGS1) { /* '$skip'(Stream,N) */
skip ( USES_REGS1 )
{ /* '$skip'(Stream,N) */
Int n; Int n;
Term t2; Term t2;
int sno; int sno;
@ -720,9 +655,7 @@ skip ( USES_REGS1 )
* @param +_Stream_ * @param +_Stream_
* *
*/ */
static Int static Int flush_output(USES_REGS1) { /* flush_output(Stream) */
flush_output ( USES_REGS1 )
{ /* flush_output(Stream) */
int sno = Yap_CheckStream(ARG1, Output_Stream_f, "flush_output/1"); int sno = Yap_CheckStream(ARG1, Output_Stream_f, "flush_output/1");
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
@ -734,21 +667,18 @@ flush_output ( USES_REGS1 )
/** /**
* @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_output */
flush_output0 ( USES_REGS1 )
{ /* flush_output */
yap_fflush(LOCAL_c_output_stream); yap_fflush(LOCAL_c_output_stream);
return (TRUE); return (TRUE);
} }
static Int static Int flush_all_streams(USES_REGS1) { /* $flush_all_streams */
flush_all_streams ( USES_REGS1 )
{ /* $flush_all_streams */
#if BROKEN_FFLUSH_NULL #if BROKEN_FFLUSH_NULL
int i; int i;
for (i = 0; i < MaxStreams; ++i) { for (i = 0; i < MaxStreams; ++i) {
@ -782,9 +712,7 @@ 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) { /* at_end_of_stream */
peek_code ( USES_REGS1 )
{ /* at_end_of_stream */
/* the next character is a EOF */ /* the next character is a EOF */
int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
Int ch; Int ch;
@ -797,14 +725,15 @@ peek_code ( USES_REGS1 )
return FALSE; return FALSE;
} }
if ((ch = Yap_peek(sno)) < 0) { if ((ch = Yap_peek(sno)) < 0) {
#ifdef PEEK_EOF
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return false;
#endif
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify_constant(ARG2, MkIntTerm(ch))); return (Yap_unify_constant(ARG2, MkIntTerm(ch)));
} }
/** @pred peek_code( - _C_) is iso /** @pred peek_code( - _C_) is iso
@ -814,9 +743,7 @@ 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) { /* at_end_of_stream */
peek_code_1 ( USES_REGS1 )
{ /* 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;
@ -828,14 +755,15 @@ peek_code_1 ( USES_REGS1 )
return FALSE; return FALSE;
} }
if ((ch = Yap_peek(sno)) < 0) { if ((ch = Yap_peek(sno)) < 0) {
#ifdef PEEK_EOF
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return false;
#endif
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify_constant(ARG1, MkIntTerm(ch))); return (Yap_unify_constant(ARG1, MkIntTerm(ch)));
} }
/** @pred peek_byte(+Stream, - _C_) is iso /** @pred peek_byte(+Stream, - _C_) is iso
@ -843,9 +771,7 @@ If _C_ is unbound, or is a character code, and _Stream_ is a
binary stream, read the next byte from the current stream and unify its binary stream, read the next byte from the current stream and unify its
code with _C_, while leaving the current stream position unaltered. code with _C_, while leaving the current stream position unaltered.
*/ */
static Int static Int peek_byte(USES_REGS1) { /* at_end_of_stream */
peek_byte ( USES_REGS1 )
{ /* 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_byte/2"); int sno = Yap_CheckStream(ARG1, Input_Stream_f, "peek_byte/2");
Int ch; Int ch;
@ -858,14 +784,15 @@ peek_byte ( USES_REGS1 )
return (FALSE); return (FALSE);
} }
if ((ch = dopeek_byte(sno)) < 0) { if ((ch = dopeek_byte(sno)) < 0) {
#ifdef PEEK_EOF
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return false;
#endif
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify_constant(ARG2, MkIntTerm(ch))); return (Yap_unify_constant(ARG2, MkIntTerm(ch)));
} }
/** @pred peek_byte( - _C_) is iso /** @pred peek_byte( - _C_) is iso
@ -873,9 +800,7 @@ If _C_ is unbound, or is a character code, and _Stream_ is a
binary stream, read the next byte from the current stream and unify its binary stream, read the next byte from the current stream and unify its
code with _C_, while leaving the current stream position unaltered. code with _C_, while leaving the current stream position unaltered.
*/ */
static Int static Int peek_byte_1(USES_REGS1) { /* at_end_of_stream */
peek_byte_1 ( USES_REGS1 )
{ /* 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;
@ -889,14 +814,15 @@ peek_byte_1 ( USES_REGS1 )
return (FALSE); return (FALSE);
} }
if ((ch = dopeek_byte(sno)) < 0) { if ((ch = dopeek_byte(sno)) < 0) {
#ifdef PEEK_EOF
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return false;
#endif
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return (Yap_unify_constant(ARG2, MkIntTerm(ch))); return (Yap_unify_constant(ARG2, MkIntTerm(ch)));
} }
/** @pred peek_char(+_S_, - _C_) is iso /** @pred peek_char(+_S_, - _C_) is iso
@ -904,16 +830,14 @@ If _C_ is unbound, or is a character code, and the stream _S_ is a
binary stream, read the next byte from the current stream and unify the binary stream, read the next byte from the current stream and unify the
atom with _C_, while leaving the stream position unaltered. 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_CheckTextStream(ARG1, Input_Stream_f, "peek/2"); int sno = Yap_CheckTextStream(ARG1, Input_Stream_f, "peek/2");
wchar_t wsinp[2]; wchar_t wsinp[2];
Int ch; Int ch;
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_INPUT_TEXT_STREAM, ARG1, "peek_byte/2"); Yap_Error(PERMISSION_ERROR_INPUT_TEXT_STREAM, ARG1, "peek_byte/2");
@ -921,7 +845,7 @@ peek_char ( USES_REGS1 )
} }
if ((ch = Yap_peek(sno)) < 0) { if ((ch = Yap_peek(sno)) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
wsinp[1] = '\0'; wsinp[1] = '\0';
@ -936,9 +860,7 @@ If _C_ is unbound, or is a character code, and the current input stream is a
binary stream, read the next byte from the current stream and unify the binary stream, read the next byte from the current stream and unify the
atom with _C_, while leaving the stream position unaltered. 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];
@ -947,7 +869,8 @@ peek_char_1 ( USES_REGS1 )
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
if ((ch = Yap_peek(sno)) < 0) { if ((ch = Yap_peek(sno)) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return false; return Yap_unify_constant(ARG2, MkAtomTerm(AtomEof));
// return false;
} }
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
wsinp[1] = '\0'; wsinp[1] = '\0';
@ -955,7 +878,6 @@ peek_char_1 ( USES_REGS1 )
return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp))); return Yap_unify_constant(ARG2, MkAtomTerm(Yap_LookupMaybeWideAtom(wsinp)));
} }
/** @pred peek(+ _S_, - _C_) is deprecated /** @pred peek(+ _S_, - _C_) is deprecated
@ -977,23 +899,11 @@ leaving the current stream position unaltered.
*/ */
void Yap_flush(void) { CACHE_REGS(void)flush_all_streams(PASS_REGS1); }
void Yap_FlushStreams(void) { CACHE_REGS(void)flush_all_streams(PASS_REGS1); }
void Yap_flush(void) void Yap_InitCharsio(void) {
{
CACHE_REGS
(void)flush_all_streams(PASS_REGS1);
}
void Yap_FlushStreams(void)
{
CACHE_REGS
(void)flush_all_streams(PASS_REGS1);
}
void
Yap_InitCharsio( void )
{
Yap_InitCPred("get", 2, get, SafePredFlag | SyncPredFlag); Yap_InitCPred("get", 2, get, SafePredFlag | SyncPredFlag);
Yap_InitCPred("get_code", 2, get_code, SafePredFlag | SyncPredFlag); Yap_InitCPred("get_code", 2, get_code, SafePredFlag | SyncPredFlag);
Yap_InitCPred("get_char", 2, get_char, SafePredFlag | SyncPredFlag); Yap_InitCPred("get_char", 2, get_char, SafePredFlag | SyncPredFlag);
@ -1002,7 +912,8 @@ Yap_InitCharsio( void )
Yap_InitCPred("get_code", 1, getcode_1, SafePredFlag | SyncPredFlag); Yap_InitCPred("get_code", 1, getcode_1, SafePredFlag | SyncPredFlag);
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); Yap_InitCPred("get_byte", 2, get_byte, SafePredFlag | SyncPredFlag);
Yap_InitCPred("get_byte", 1, get_byte_1, SafePredFlag | SyncPredFlag); 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);
@ -1020,12 +931,15 @@ Yap_InitCharsio( void )
Yap_InitCPred("nl", 0, nl_1, SafePredFlag | SyncPredFlag); Yap_InitCPred("nl", 0, nl_1, SafePredFlag | SyncPredFlag);
Yap_InitCPred("nl", 1, nl, SafePredFlag | SyncPredFlag); Yap_InitCPred("nl", 1, nl, SafePredFlag | SyncPredFlag);
Yap_InitCPred ("$flush_all_streams", 0, flush_all_streams, SafePredFlag|SyncPredFlag|HiddenPredFlag); Yap_InitCPred("$flush_all_streams", 0, flush_all_streams,
SafePredFlag | SyncPredFlag | HiddenPredFlag);
Yap_InitCPred("flush_output", 1, flush_output, SafePredFlag | SyncPredFlag); Yap_InitCPred("flush_output", 1, flush_output, SafePredFlag | SyncPredFlag);
Yap_InitCPred("flush_output", 0, flush_output0, SafePredFlag | SyncPredFlag); Yap_InitCPred("flush_output", 0, flush_output0, SafePredFlag | SyncPredFlag);
Yap_InitCPred ("at_end_of_stream", 1, at_end_of_stream, SafePredFlag|SyncPredFlag); Yap_InitCPred("at_end_of_stream", 1, at_end_of_stream,
Yap_InitCPred ("at_end_of_stream_0", 0, at_end_of_stream_0, SafePredFlag|SyncPredFlag); SafePredFlag | SyncPredFlag);
Yap_InitCPred("at_end_of_stream_0", 0, at_end_of_stream_0,
SafePredFlag | SyncPredFlag);
// Yap_InitCPred ("$past_eof", 1, past_eof, SafePredFlag|SyncPredFlag); // Yap_InitCPred ("$past_eof", 1, past_eof, SafePredFlag|SyncPredFlag);
Yap_InitCPred("peek", 2, peek_code, SafePredFlag | SyncPredFlag); Yap_InitCPred("peek", 2, peek_code, SafePredFlag | SyncPredFlag);
Yap_InitCPred("peek_code", 2, peek_code, SafePredFlag | SyncPredFlag); Yap_InitCPred("peek_code", 2, peek_code, SafePredFlag | SyncPredFlag);
@ -1039,6 +953,4 @@ Yap_InitCharsio( void )
Yap_InitCPred("skip1", 1, skip_1, SafePredFlag | SyncPredFlag); Yap_InitCPred("skip1", 1, skip_1, SafePredFlag | SyncPredFlag);
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);
} }

25
os/chartypes.c
View File

@ -68,31 +68,6 @@ Term Yap_StringToNumberTerm(char *s, encoding_t *encp) {
while (*s && isblank(*s++)) while (*s && isblank(*s++))
; ;
t = Yap_scan_num(GLOBAL_Stream + sno); t = Yap_scan_num(GLOBAL_Stream + sno);
if (t == TermNil) {
CACHE_REGS
int sign = 1;
if (s[0] == '+') {
s++;
}
if (s[0] == '-') {
s++;
sign = -1;
}
if (strcmp(s, "inf") == 0) {
if (sign > 0) {
return MkFloatTerm(INFINITY);
} else {
return MkFloatTerm(-INFINITY);
}
}
if (strcmp(s, "nan") == 0) {
if (sign > 0) {
return MkFloatTerm(NAN);
} else {
return MkFloatTerm(-NAN);
}
}
}
Yap_CloseStream(sno); Yap_CloseStream(sno);
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return t; return t;

35
os/iopreds.c
View File

@ -369,7 +369,7 @@ Int
PlIOError__ (const char *file, const char *function, int lineno, yap_error_number type, Term culprit, ...) PlIOError__ (const char *file, const char *function, int lineno, yap_error_number type, Term culprit, ...)
{ {
if (trueLocalPrologFlag(FILEERRORS_FLAG) == TermTrue|| if (trueLocalPrologFlag(FILEERRORS_FLAG)||
type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) { type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) {
va_list args; va_list args;
const char *format; const char *format;
@ -377,7 +377,11 @@ PlIOError__ (const char *file, const char *function, int lineno, yap_error_numb
va_start(args, culprit); va_start(args, culprit);
format = va_arg(args, char *); format = va_arg(args, char *);
if (format) {
vsnprintf(who, 1023, format, args); vsnprintf(who, 1023, format, args);
} else {
who[0] ='\0';
}
va_end( args ); va_end( args );
Yap_Error__(file, function, lineno, type, culprit, who); Yap_Error__(file, function, lineno, type, culprit, who);
/* and fail */ /* and fail */
@ -1641,8 +1645,10 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
return sno; return sno;
} }
#define CheckStream( arg, kind, msg) CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
static int static int
CheckStream (Term arg, int kind, const char *msg) CheckStream__ (const char *file, const char *f, int line, Term arg, int kind, const char *msg)
{ {
int sno = -1; int sno = -1;
arg = Deref (arg); arg = Deref (arg);
@ -1655,7 +1661,7 @@ CheckStream (Term arg, int kind, const char *msg)
if (sname == AtomUser) { if (sname == AtomUser) {
if (kind & Input_Stream_f) { if (kind & Input_Stream_f) {
if (kind & (Output_Stream_f|Append_Stream_f)) { if (kind & (Output_Stream_f|Append_Stream_f)) {
PlIOError(PERMISSION_ERROR_INPUT_STREAM, arg, PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg,
"ambiguous use of 'user' as a stream"); "ambiguous use of 'user' as a stream");
return (-1); return (-1);
} }
@ -1666,7 +1672,7 @@ CheckStream (Term arg, int kind, const char *msg)
} }
if ((sno = Yap_CheckAlias(sname)) < 0) { if ((sno = Yap_CheckAlias(sname)) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg);
return -1; return -1;
} else { } else {
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
@ -1685,38 +1691,37 @@ CheckStream (Term arg, int kind, const char *msg)
} }
if (GLOBAL_Stream[sno].status & Free_Stream_f) if (GLOBAL_Stream[sno].status & Free_Stream_f)
{ {
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg); PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg);
return (-1); return (-1);
} }
LOCK(GLOBAL_Stream[sno].streamlock); LOCK(GLOBAL_Stream[sno].streamlock);
if (( kind & Input_Stream_f) && !(GLOBAL_Stream[sno].status & Input_Stream_f)) if (( GLOBAL_Stream[sno].status & Input_Stream_f) && !(kind & Input_Stream_f))
{ {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(PERMISSION_ERROR_INPUT_STREAM, arg, msg); PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_STREAM, arg, msg);
} }
if ((kind & (Append_Stream_f|Output_Stream_f)) && ! (GLOBAL_Stream[sno].status & Output_Stream_f)) if ((GLOBAL_Stream[sno].status & (Append_Stream_f|Output_Stream_f)) && ! ( kind & Output_Stream_f))
{ {
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
PlIOError(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg); PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg);
} }
return (sno); return (sno);
} }
int int
Yap_CheckStream (Term arg, int kind, const char *msg) Yap_CheckStream__ (const char *file, const char *f, int line, Term arg, int kind, const char *msg)
{ {
return CheckStream(arg, kind, (char *)msg); return CheckStream__(file, f, line, arg, kind, msg);
} }
int int
Yap_CheckTextStream (Term arg, int kind, const char *msg) Yap_CheckTextStream__ (const char *file, const char *f, int line, Term arg, int kind, const char *msg)
{ {
int sno; int sno;
if ((sno = CheckStream(arg, kind, (char *)msg)) < 0) if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0)
return -1; return -1;
if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) { if ((GLOBAL_Stream[sno].status & Binary_Stream_f)) {
PlIOError(PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, msg); PlIOError__(file, f, line, PERMISSION_ERROR_INPUT_BINARY_STREAM, arg, msg);
UNLOCK(GLOBAL_Stream[sno].streamlock); UNLOCK(GLOBAL_Stream[sno].streamlock);
return -1; return -1;
} }

6
os/iopreds.h
View File

@ -51,8 +51,10 @@ typedef enum{ /* we accept two domains for the moment, IPV6 may follow */
} socket_domain; } socket_domain;
extern Term Yap_InitSocketStream(int, socket_info, socket_domain); extern Term Yap_InitSocketStream(int, socket_info, socket_domain);
extern int Yap_CheckStream(Term, int, const char *); #define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckTextStream(Term, int, const char *); extern int Yap_CheckStream__(const char *, const char *, int , Term, int, const char *);
#define Yap_CheckTextStream( arg, kind, msg) Yap_CheckTextStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
extern int Yap_CheckTextStream__(const char *, const char *, int , Term, int, const char *);
extern int Yap_CheckSocketStream(Term, const char *); extern int Yap_CheckSocketStream(Term, const char *);
extern socket_domain Yap_GetSocketDomain(int); extern socket_domain Yap_GetSocketDomain(int);
extern socket_info Yap_GetSocketStatus(int); extern socket_info Yap_GetSocketStatus(int);

15
os/readterm.c
View File

@ -225,11 +225,10 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
*tailp = TermNl; *tailp = TermNl;
startline = MkIntegerTerm(cline); startline = MkIntegerTerm(cline);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
if (errtok != LOCAL_toktide) { if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide; errtok = LOCAL_toktide;
} }
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos); errline = MkIntegerTerm(errtok->TokPos);
while (tok) { while (tok) {
Term ts[2]; Term ts[2];
@ -288,10 +287,14 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
} break; } break;
case String_tok: { case String_tok: {
Term t0 = Yap_CharsToTDQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS); Term t0 = Yap_CharsToTDQ((char *)info, CurrentModule, ENC_ISO_LATIN1 PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; } break;
case WString_tok: { case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS); Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0); ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break; } break;
case BQString_tok: { case BQString_tok: {
@ -343,9 +346,9 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
tf[0] = MkStringTerm(""); tf[0] = MkStringTerm("");
/* file */ /* file */
tf[2] = Yap_StreamUserName(sno); tf[2] = Yap_StreamUserName(sno);
tf[1] = Yap_MkApplTerm(FunctorSyntaxError, 4, tf); clean_vars(LOCAL_VarTable);
tf[0] = MkAtomTerm(AtomSyntaxError); clean_vars(LOCAL_AnonVarTable);
return Yap_MkApplTerm(FunctorError, 2, tf); return Yap_MkApplTerm(FunctorSyntaxError, 4, tf);
} }
typedef struct FEnv { typedef struct FEnv {
@ -379,6 +382,8 @@ static xarg *setClauseReadEnv(Term opts, FEnv *fe, struct renv *re,
int inp_stream); int inp_stream);
static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) { static xarg *setReadEnv(Term opts, FEnv *fe, struct renv *re, int inp_stream) {
CACHE_REGS CACHE_REGS
LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL;
re->cm = CurrentModule; re->cm = CurrentModule;
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END); xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
if (args == NULL) { if (args == NULL) {

18
os/sysbits.c
View File

@ -136,7 +136,7 @@ static void InitRandom(void);
static Int p_alarm( USES_REGS1 ); static Int p_alarm( USES_REGS1 );
static Int p_getenv( USES_REGS1 ); static Int p_getenv( USES_REGS1 );
static Int p_putenv( USES_REGS1 ); static Int p_putenv( USES_REGS1 );
static bool set_fpu_exceptions(bool); static bool set_fpu_exceptions(Term);
static char *expandVars(const char *pattern, char *expanded, int maxlen); static char *expandVars(const char *pattern, char *expanded, int maxlen);
#ifdef MACYAP #ifdef MACYAP
static int chdir(char *); static int chdir(char *);
@ -2134,7 +2134,6 @@ Yap_MathException__( USES_REGS1 )
return EVALUATION_ERROR_UNDEFINED; return EVALUATION_ERROR_UNDEFINED;
} }
if (raised ) { if (raised ) {
feclearexcept(FE_ALL_EXCEPT); feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_OVERFLOW) { if (raised & FE_OVERFLOW) {
return EVALUATION_ERROR_FLOAT_OVERFLOW; return EVALUATION_ERROR_FLOAT_OVERFLOW;
@ -3238,9 +3237,9 @@ MSCHandleSignal(DWORD dwCtrlType) {
/* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */ /* by default Linux with glibc is IEEE compliant anyway..., but we will pretend it is not. */
static bool static bool
set_fpu_exceptions(bool flag) set_fpu_exceptions(Term flag)
{ {
if (flag) { if (flag == TermTrue) {
#if HAVE_FESETEXCEPTFLAG #if HAVE_FESETEXCEPTFLAG
fexcept_t excepts; fexcept_t excepts;
return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0; return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0;
@ -3309,19 +3308,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
} }
bool bool
Yap_set_fpu_exceptions(bool flag) Yap_set_fpu_exceptions(Term flag)
{ {
return set_fpu_exceptions(flag); return set_fpu_exceptions(flag);
} }
static Int
p_set_fpu_exceptions( USES_REGS1 ) {
if (Deref(ARG1) == MkAtomTerm(AtomTrue)) {
return set_fpu_exceptions(true);
} else {
return set_fpu_exceptions( false );
}
}
static Int static Int
p_host_type( USES_REGS1 ) { p_host_type( USES_REGS1 ) {
@ -3732,7 +3723,6 @@ MSCHandleSignal(DWORD dwCtrlType) {
Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag); Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$putenv", 2, p_putenv, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$set_fpu_exceptions",1, p_set_fpu_exceptions, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag); Yap_InitCPred ("$host_type", 1, p_host_type, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag); Yap_InitCPred ("$env_separator", 1, p_env_separator, SafePredFlag);
Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag); Yap_InitCPred ("$unix", 0, p_unix, SafePredFlag);

6
pl/errors.yap
View File

@ -259,9 +259,7 @@ to allow user-control.
'$process_error'(error(permission_error(module,redefined,A),B), Level) :- '$process_error'(error(permission_error(module,redefined,A),B), Level) :-
Level \= top, !, Level \= top, !,
throw(error(permission_error(module,redefined,A),B)). throw(error(permission_error(module,redefined,A),B)).
'$process_error'(error(Msg, Where), _) :- !, '$process_error'(error(Msg, Where), _) :-
'$set_fpu_exceptions'(true), print_message(error,error(Msg, Where)), !.
print_message(error,error(Msg, Where)).
'$process_error'(Throw, _) :- '$process_error'(Throw, _) :-
print_message(error,error(unhandled_exception,Throw)). print_message(error,error(unhandled_exception,Throw)).

10
pl/messages.yap
View File

@ -214,6 +214,8 @@ compose_message(Term, Level) -->
main_message( Term, Level ), main_message( Term, Level ),
[nl,nl]. [nl,nl].
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)),_ ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] .
location( error(_,Term), Level ) --> location( error(_,Term), Level ) -->
{ source_location(F0, L), { source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !, stream_property(_Stream, alias(loop_stream)) }, !,
@ -226,15 +228,13 @@ location( error(_,Term), Level ) -->
[nl]. [nl].
location(error(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) --> location(error(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0: ' - [FileName,LN] ] .
location(warning(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] .
location(style_check(_,LN,FileName,_ ), _ ) --> location(style_check(_,LN,FileName,_ ), _ ) -->
% { stream_position_data( line_count, LN) }, % { stream_position_data( line_count, LN) },
!, !,
[ '~a:~d:0: ' - [FileName,LN] ] . [ '~a:~d:0: ' - [FileName,LN] ] .
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
main_message( error(syntax_error,syntax_error(Msg,between(L0,LM,LF),_Stream,Term)), _ ) --> main_message( error(syntax_error(Msg,between(L0,LM,LF),_Stream,Term)), _ ) -->
!, !,
['~*|!!! syntax error: ~s' - [10,Msg]], ['~*|!!! syntax error: ~s' - [10,Msg]],
[nl], [nl],
@ -262,8 +262,8 @@ main_message(error(consistency_error(Who)), _Source) -->
[ '~*|!!! has argument ~a not consistent with type.'-[8,Who] ]. [ '~*|!!! has argument ~a not consistent with type.'-[8,Who] ].
main_message(error(domain_error(Who , Type), _Where), _Source) --> main_message(error(domain_error(Who , Type), _Where), _Source) -->
[ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ]. [ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ].
main_message(error(evaluation_error(What), _Where), _Source) --> main_message(error(evaluation_error(What, Who), _Where), _Source) -->
[ '~*|!!! caused ~a during evaluation of arithmetic expressions,' - [8,What], nl ]. [ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [8,Who,What], nl ].
main_message(error(existence_error(Type , Who), _Where), _Source) --> main_message(error(existence_error(Type , Who), _Where), _Source) -->
[ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ]. [ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ].
main_message(error(permission_error(Op, Type, Id), _Where), _Source) --> main_message(error(permission_error(Op, Type, Id), _Where), _Source) -->