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;

126
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,11 +102,12 @@ 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);
//fprintf(stderr, "\n"); // fprintf(stderr, "\n");
LOCAL_DoingUndefp = false; LOCAL_DoingUndefp = false;
LOCAL_within_print_message = false; LOCAL_within_print_message = false;
return true; return true;
@ -117,7 +117,7 @@ bool Yap_Warning(const char *s, ...) {
format = va_arg(ap, char *); format = va_arg(ap, char *);
if (format != NULL) { if (format != NULL) {
#if HAVE_VSNPRINTF #if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN-1, format, ap); vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap);
#else #else
(void)vsprintf(tmpbuf, format, ap); (void)vsprintf(tmpbuf, format, ap);
#endif #endif
@ -146,9 +146,9 @@ bool Yap_PrintWarning(Term twarning) {
LOCAL_DoingUndefp = true; LOCAL_DoingUndefp = true;
LOCAL_within_print_message = true; LOCAL_within_print_message = true;
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);
//fprintf(stderr, "\n"); // fprintf(stderr, "\n");
LOCAL_DoingUndefp = false; LOCAL_DoingUndefp = false;
LOCAL_within_print_message = false; LOCAL_within_print_message = false;
return true; return true;
@ -281,45 +281,45 @@ static char tmpbuf[YAP_BUF_SIZE];
#undef END_ERRORS #undef END_ERRORS
#define BEGIN_ERROR_CLASSES() \ #define BEGIN_ERROR_CLASSES() \
static Term mkerrorct(yap_error_class_number c, Term *ts) { \ static Term mkerrorct(yap_error_class_number c, Term *ts) { \
switch (c) { switch (c) {
#define ECLASS(CL, A, B) \ #define ECLASS(CL, A, B) \
case CL: \ case CL: \
if (A == 0) \ if (A == 0) \
return MkAtomTerm(Yap_LookupAtom(A)); \ return MkAtomTerm(Yap_LookupAtom(A)); \
else { \ else { \
return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(A), B), B, ts); \ return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(A), B), B, ts); \
} }
#define END_ERROR_CLASSES() \ #define END_ERROR_CLASSES() \
} \ } \
} }
#define BEGIN_ERRORS() \ #define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term *ts) { \ static Term mkerrort(yap_error_number e, Term *ts) { \
switch (e) { switch (e) {
#define E0(A, B) \ #define E0(A, B) \
case A: \ case A: \
return mkerrorct(B, ts); return mkerrorct(B, ts);
#define E(A, B, C) \ #define E(A, B, C) \
case A: \ case A: \
ts -= 1; \ ts -= 1; \
ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \ ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \
return mkerrorct(B, ts); return mkerrorct(B, ts);
#define E2(A, B, C, D) \ #define E2(A, B, C, D) \
case A: \ case A: \
ts -= 2; \ ts -= 2; \
ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \ ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \
ts[1] = MkAtomTerm(Yap_LookupAtom(D)); \ ts[1] = MkAtomTerm(Yap_LookupAtom(D)); \
return mkerrorct(B, ts); return mkerrorct(B, ts);
#define END_ERRORS() \ #define END_ERRORS() \
} \ } \
} }
#include "YapErrors.h" #include "YapErrors.h"
@ -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
@ -411,16 +412,17 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
format = va_arg(ap, char *); format = va_arg(ap, char *);
if (format != NULL) { if (format != NULL) {
#if HAVE_VSNPRINTF #if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN-1, format, ap); (void)vsnprintf(s, MAXPATHLEN - 1, format, ap);
#else #else
(void)vsprintf(s, format, ap); (void)vsprintf(s, format, ap);
#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,20 +529,22 @@ 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 */
if (IsAtomTerm(nt[0])) { if (IsAtomTerm(nt[0])) {
strncpy(LOCAL_ErrorSay, (char *)RepAtom(AtomOfTerm(nt[0]))->StrOfAE, strncpy(LOCAL_ErrorSay, (char *) RepAtom(AtomOfTerm(nt[0]))->StrOfAE,
MAX_ERROR_MSG_SIZE); MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay; LOCAL_ErrorMessage = LOCAL_ErrorSay;
} else { } else {
strncpy(LOCAL_ErrorSay, strncpy(LOCAL_ErrorSay,
(char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE, (char *) RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,
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) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")), culprit),
nt[1]);
} }
if ((culprit=Yap_env_location( CP, B, ENV, 0)) != TermNil ) {
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("e")),culprit), nt[1]);
} }
} }
/* disable active signals at this point */ /* disable active signals at this point */
@ -567,7 +585,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
Yap_RestartYap(1); Yap_RestartYap(1);
} }
#if DEBUG #if DEBUG
// DumpActiveGoals( PASS_REGS1 ); // DumpActiveGoals( PASS_REGS1 );
#endif #endif
/* wait if we we are in user code, /* wait if we we are in user code,
it's up to her to decide */ it's up to her to decide */
@ -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;
} }

238
C/scanner.c
View File

@ -437,17 +437,15 @@ 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)
LOCAL_SourceFileName = AtomSocket; LOCAL_SourceFileName = AtomSocket;
else else
#endif #endif
if (s->status & Pipe_Stream_f) if (s->status & Pipe_Stream_f)
LOCAL_SourceFileName =AtomPipe; LOCAL_SourceFileName = AtomPipe;
else if (s->status & InMemory_Stream_f) else if (s->status & InMemory_Stream_f)
LOCAL_SourceFileName = AtomCharsio; LOCAL_SourceFileName = AtomCharsio;
else else
@ -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,
@ -513,27 +512,27 @@ static char chtype0[NUMBER_OF_CHARS + 1] = {
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
/* Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß */ /* Ð Ñ Ò Ó Ô Õ Ö × Ø Ù Ú Û Ü Ý Þ ß */
#ifdef vms #ifdef vms
UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC, UC,
UC, UC, UC, UC, UC, UC, LC, UC, UC, UC, UC, UC, UC, LC,
#else #else
UC, UC, UC, UC, UC, UC, UC, SY, UC, UC, UC, UC, UC, UC, UC, UC, SY, UC,
UC, UC, UC, UC, UC, UC, LC, UC, UC, UC, UC, UC, UC, LC,
#endif #endif
/* à á â ã ä å æ ç è é ê ë ì í î ï */ /* à á â ã ä å æ ç è é ê ë ì í î ï */
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
/* ð ñ ò ó ô õ ö ÷ ø ù ú û ü cannot write the last /* ð ñ ò ó ô õ ö ÷ ø ù ú û ü cannot write the last
* three because of lcc */ * three because of lcc */
#ifdef vms #ifdef vms
LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC, LC,
LC, LC, LC, LC, LC, LC, LC LC, LC, LC, LC, LC, LC, LC
#else #else
LC, LC, LC, LC, LC, LC, LC, SY, LC, LC, LC, LC, LC, LC, LC, LC, SY, LC,
LC, LC, LC, LC, LC, LC, LC LC, LC, LC, LC, LC, LC, LC
#endif #endif
}; };
typedef struct scanner_internals { typedef struct scanner_internals {
@ -567,13 +566,13 @@ int Yap_wide_chtype(Int ch) {
// standard get char, uses conversion table // standard get char, uses conversion table
// and converts to wide // and converts to wide
#define getchr(inp) inp->stream_wgetc_for_read(inp-GLOBAL_Stream) #define getchr(inp) inp->stream_wgetc_for_read(inp - GLOBAL_Stream)
// get char for quoted data, eg, quoted atoms and so on // get char for quoted data, eg, quoted atoms and so on
// converts to wide // converts to wide
#define getchrq(inp) inp->stream_wgetc(inp-GLOBAL_Stream) #define getchrq(inp) inp->stream_wgetc(inp - GLOBAL_Stream)
// get char for UTF-8 quoted data, eg, quoted strings // get char for UTF-8 quoted data, eg, quoted strings
// reads bytes // reads bytes
#define getchru(inp) inp->stream_getc_utf8(inp-GLOBAL_Stream) #define getchru(inp) inp->stream_getc_utf8(inp - GLOBAL_Stream)
/* in case there is an overflow */ /* in case there is an overflow */
typedef struct scanner_extra_alloc { typedef struct scanner_extra_alloc {
@ -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,10 +694,11 @@ 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 */
do_switch: do_switch:
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
switch (ch) { switch (ch) {
@ -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,26 +1202,25 @@ 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;
size_t length, sze = YAP_FILENAME_MAX-1; size_t length, sze = YAP_FILENAME_MAX - 1;
UInt flags = 0; UInt flags = 0;
switch (tokptr->Tok) { switch (tokptr->Tok) {
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,22 +1228,21 @@ 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++)) {
bp += put_utf8(bp, c); bp += put_utf8(bp, c);
} }
bp[0]='\0'; bp[0] = '\0';
return buf; return buf;
} }
case Error_tok: case Error_tok:
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;
} }
@ -1289,7 +1344,7 @@ static wchar_t *ch_to_wide(char *base, char *charp) {
} }
#define add_ch_to_utf8_buff(ch) \ #define add_ch_to_utf8_buff(ch) \
{ \ { \
if ((ch & 0xff) == ch) { \ if ((ch & 0xff) == ch) { \
*charp++ = ch; \ *charp++ = ch; \
} else { \ } else { \
@ -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,19 +1363,16 @@ 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);
while (chtype(ch) == BS) { while (chtype(ch) == BS) {
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
*tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream); *tposp = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream); Yap_setCurrentSourceLocation(inp_stream);
LOCAL_StartLineCount = inp_stream->linecount; LOCAL_StartLineCount = inp_stream->linecount;
LOCAL_StartLinePos = inp_stream->linepos; LOCAL_StartLinePos = inp_stream->linepos;
@ -1346,7 +1398,7 @@ TokEntry *Yap_tokenizer( struct stream_desc *inp_stream,
else else
p->TokNext = t; p->TokNext = t;
p = t; p = t;
restart: restart:
while (chtype(ch) == BS) { while (chtype(ch) == BS) {
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
@ -1358,7 +1410,7 @@ restart:
if (store_comments) { if (store_comments) {
CHECK_SPACE(); CHECK_SPACE();
open_comment(ch, inp_stream PASS_REGS); open_comment(ch, inp_stream PASS_REGS);
continue_comment: continue_comment:
while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF) { while ((ch = getchr(inp_stream)) != 10 && chtype(ch) != EF) {
CHECK_SPACE(); CHECK_SPACE();
extend_comment(ch PASS_REGS); extend_comment(ch PASS_REGS);
@ -1385,7 +1437,7 @@ continue_comment:
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
CHECK_SPACE(); CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream); *tposp = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream); Yap_setCurrentSourceLocation(inp_stream);
} }
goto restart; goto restart;
@ -1400,7 +1452,7 @@ continue_comment:
case LC: case LC:
och = ch; och = ch;
ch = getchr(inp_stream); ch = getchr(inp_stream);
scan_name: scan_name:
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE; TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage; charp = TokImage;
wcharp = NULL; wcharp = NULL;
@ -1408,7 +1460,7 @@ scan_name:
add_ch_to_buff(och); add_ch_to_buff(och);
for (; chtype(ch) <= NU; ch = getchr(inp_stream)) { for (; chtype(ch) <= NU; ch = getchr(inp_stream)) {
if (charp == (char *)AuxSp - 1024) { if (charp == (char *)AuxSp - 1024) {
huge_var_error: huge_var_error:
/* huge atom or variable, we are in trouble */ /* huge atom or variable, we are in trouble */
LOCAL_ErrorMessage = "Code Space Overflow due to huge atom"; LOCAL_ErrorMessage = "Code Space Overflow due to huge atom";
LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK; LOCAL_Error_TYPE = RESOURCE_ERROR_AUXILIARY_STACK;
@ -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;
} }
@ -1573,7 +1626,7 @@ huge_var_error:
case QT: case QT:
case DC: case DC:
quoted_string: quoted_string:
TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE; TokImage = (char *)((AtomEntry *)(Yap_PreAllocCodeSpace()))->StrOfAE;
charp = TokImage; charp = TokImage;
quote = ch; quote = ch;
@ -1634,7 +1687,7 @@ quoted_string:
} else { } else {
*charp = '\0'; *charp = '\0';
} }
if (quote == '"'||quote == '`') { if (quote == '"' || quote == '`') {
if (wcharp) { if (wcharp) {
mp = AllocScannerMemory(sizeof(wchar_t) * (len + 1)); mp = AllocScannerMemory(sizeof(wchar_t) * (len + 1));
} else { } else {
@ -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) {
@ -1700,7 +1752,7 @@ quoted_string:
if (ch == '`') if (ch == '`')
goto quoted_string; goto quoted_string;
if (ch == '.') { if (ch == '.') {
int nch = Yap_peek(inp_stream-GLOBAL_Stream); int nch = Yap_peek(inp_stream - GLOBAL_Stream);
if (chtype(nch) == BS || chtype(nch) == EF || nch == '%') { if (chtype(nch) == BS || chtype(nch) == EF || nch == '%') {
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
if (chtype(ch) == EF) if (chtype(ch) == EF)
@ -1743,15 +1795,14 @@ quoted_string:
ch = getchr(inp_stream); ch = getchr(inp_stream);
} }
CHECK_SPACE(); CHECK_SPACE();
*tposp = Yap_StreamPosition(inp_stream-GLOBAL_Stream); *tposp = Yap_StreamPosition(inp_stream - GLOBAL_Stream);
Yap_setCurrentSourceLocation(inp_stream); Yap_setCurrentSourceLocation(inp_stream);
} }
} }
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);
@ -1860,9 +1911,9 @@ enter_symbol:
cur_qq = qq; cur_qq = qq;
} }
t->TokInfo = (CELL)qq; t->TokInfo = (CELL)qq;
if (inp_stream->status & Seekable_Stream_f ) { if (inp_stream->status & Seekable_Stream_f) {
qq->start.byteno = fseek (inp_stream->file, 0, 0); qq->start.byteno = fseek(inp_stream->file, 0, 0);
}else { } else {
qq->start.byteno = inp_stream->charcount - 1; qq->start.byteno = inp_stream->charcount - 1;
} }
qq->start.lineno = inp_stream->linecount; qq->start.lineno = inp_stream->linecount;
@ -1895,9 +1946,9 @@ enter_symbol:
} }
cur_qq = NULL; cur_qq = NULL;
t->TokInfo = (CELL)qq; t->TokInfo = (CELL)qq;
if (inp_stream->status & Seekable_Stream_f ) { if (inp_stream->status & Seekable_Stream_f) {
qq->mid.byteno = fseek (inp_stream->file, 0, 0); qq->mid.byteno = fseek(inp_stream->file, 0, 0);
}else { } else {
qq->mid.byteno = inp_stream->charcount - 1; qq->mid.byteno = inp_stream->charcount - 1;
} }
qq->mid.lineno = inp_stream->linecount; qq->mid.lineno = inp_stream->linecount;
@ -1925,8 +1976,8 @@ enter_symbol:
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
if (ch != '}') { if (ch != '}') {
} else { } else {
charp = ( char *)put_utf8((unsigned char *)charp, och); charp = (char *)put_utf8((unsigned char *)charp, och);
charp = ( char *)put_utf8((unsigned char *)charp, ch); charp = (char *)put_utf8((unsigned char *)charp, ch);
/* we're done */ /* we're done */
break; break;
} }
@ -1936,7 +1987,7 @@ enter_symbol:
t->Tok = Ord(kind = eot_tok); t->Tok = Ord(kind = eot_tok);
break; break;
} else { } else {
charp = ( char *)put_utf8((unsigned char *)charp, ch); charp = (char *)put_utf8((unsigned char *)charp, ch);
ch = getchrq(inp_stream); ch = getchrq(inp_stream);
} }
if (charp > (char *)AuxSp - 1024) { if (charp > (char *)AuxSp - 1024) {
@ -1961,9 +2012,9 @@ enter_symbol:
strncpy(mp, TokImage, len + 1); strncpy(mp, TokImage, len + 1);
qq->text = (unsigned char *)mp; qq->text = (unsigned char *)mp;
Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage); Yap_ReleasePreAllocCodeSpace((CODEADDR)TokImage);
if (inp_stream->status & Seekable_Stream_f ) { if (inp_stream->status & Seekable_Stream_f) {
qq->end.byteno = fseek (inp_stream->file, 0, 0); qq->end.byteno = fseek(inp_stream->file, 0, 0);
}else { } else {
qq->end.byteno = inp_stream->charcount - 1; qq->end.byteno = inp_stream->charcount - 1;
} }
qq->end.lineno = inp_stream->linecount; qq->end.lineno = inp_stream->linecount;
@ -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;

381
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) { static void *
if (IsVarTerm(*r)) Yap_ListToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
LOCAL_Error_TYPE = INSTANTIATION_ERROR; {
else Int atoms = 0; // we accept both types of lists.
LOCAL_Error_TYPE = TYPE_ERROR_LIST; return to_buffer( buf, t, inp, widep, &atoms, lenp PASS_REGS);
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;
}
} }
#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);

526
os/charsio.c
View File

File diff suppressed because it is too large Load Diff

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;

37
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;
} }
@ -1763,7 +1768,7 @@ always_prompt_user( USES_REGS1 )
static Int static Int
close1 (USES_REGS1) close1 (USES_REGS1)
{ /* '$close'(+GLOBAL_Stream) */ { /* '$close'(+GLOBAL_Stream) */
Int sno = CheckStream (ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2"); Int sno = CheckStream(ARG1, (Input_Stream_f | Output_Stream_f | Socket_Stream_f), "close/2");
if (sno < 0) if (sno < 0)
return (FALSE); return (FALSE);
if (sno <= StdErrStream) { if (sno <= StdErrStream) {

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) -->