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,14 +522,18 @@ number_chars( USES_REGS1 )
if (Yap_IsGroundTerm(t1)) {
Term tf;
tf = Yap_NumberToListOfAtoms(t1 PASS_REGS);
if (tf)
if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify( ARG2, tf );
}
} else {
/* ARG1 unbound */
Term t = Deref(ARG2);
Term tf = Yap_ListToNumber(t PASS_REGS);
if (tf)
if (tf) {
LOCAL_Error_TYPE = YAP_NO_ERROR;
return Yap_unify( ARG1, tf );
}
}
/* error handling */
if (LOCAL_Error_TYPE && Yap_HandleError( "number_chars/2" )) {

472
C/errors.c
View File

@ -8,9 +8,9 @@
* *
**************************************************************************
* *
* File: errors.c *
* File: errors.c *
* Last Rev: *
* Mods: *
* Mods: *
* Comments: Yap'S error handlers *
* *
*************************************************************************/
@ -29,7 +29,6 @@
#endif
#include "Foreign.h"
#if DEBUG
void Yap_PrintPredName(PredEntry *ap) {
CACHE_REGS
@ -95,7 +94,7 @@ bool Yap_Warning(const char *s, ...) {
Term ts[2];
const char *format;
char tmpbuf[MAXPATHLEN];
if (LOCAL_within_print_message) {
/* error within error */
fprintf(stderr, "%% WARNING WITHIN WARNING\n");
@ -103,21 +102,22 @@ bool Yap_Warning(const char *s, ...) {
}
LOCAL_DoingUndefp = 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) {
//fprintf(stderr, "warning message:\n");
//Yap_DebugPlWrite(twarning);
//fprintf(stderr, "\n");
// fprintf(stderr, "warning message:\n");
// Yap_DebugPlWrite(twarning);
// fprintf(stderr, "\n");
LOCAL_DoingUndefp = false;
LOCAL_within_print_message = false;
return true;
}
va_start(ap, s);
format = va_arg(ap, char *);
if (format != NULL) {
#if HAVE_VSNPRINTF
vsnprintf(tmpbuf, MAXPATHLEN-1, format, ap);
vsnprintf(tmpbuf, MAXPATHLEN - 1, format, ap);
#else
(void)vsprintf(tmpbuf, format, ap);
#endif
@ -134,10 +134,10 @@ bool Yap_Warning(const char *s, ...) {
bool Yap_PrintWarning(Term twarning) {
CACHE_REGS
PredEntry *pred = RepPredProp(PredPropByFunc(
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
FunctorPrintMessage, PROLOG_MODULE)); // PROCEDURE_print_message2;
bool rc;
Term ts[2];
if (LOCAL_within_print_message) {
/* error within error */
fprintf(stderr, "%% WARNING WITHIN WARNING\n");
@ -146,9 +146,9 @@ bool Yap_PrintWarning(Term twarning) {
LOCAL_DoingUndefp = true;
LOCAL_within_print_message = true;
if (pred->OpcodeOfPred == UNDEF_OPCODE) {
//fprintf(stderr, "warning message:\n");
//Yap_DebugPlWrite(twarning);
//fprintf(stderr, "\n");
// fprintf(stderr, "warning message:\n");
// Yap_DebugPlWrite(twarning);
// fprintf(stderr, "\n");
LOCAL_DoingUndefp = false;
LOCAL_within_print_message = false;
return true;
@ -165,7 +165,7 @@ int Yap_HandleError(const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
const char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
@ -173,30 +173,30 @@ int Yap_HandleError(const char *s, ...) {
serr = s;
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, ARG1, serr);
return (FALSE);
}
return TRUE;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
}
return TRUE;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, ARG1, serr);
return (FALSE);
}
return TRUE;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
}
return TRUE;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return (FALSE);
}
}
@ -204,7 +204,7 @@ int Yap_SWIHandleError(const char *s, ...) {
CACHE_REGS
yap_error_number err = LOCAL_Error_TYPE;
char *serr;
LOCAL_Error_TYPE = YAP_NO_ERROR;
if (LOCAL_ErrorMessage) {
serr = LOCAL_ErrorMessage;
@ -212,30 +212,30 @@ int Yap_SWIHandleError(const char *s, ...) {
serr = (char *)s;
}
switch (err) {
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, serr);
return (FALSE);
}
return TRUE;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
}
return TRUE;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
case RESOURCE_ERROR_STACK:
if (!Yap_gc(2, ENV, gc_P(P, CP))) {
Yap_Error(RESOURCE_ERROR_STACK, TermNil, serr);
return (FALSE);
}
return TRUE;
case RESOURCE_ERROR_AUXILIARY_STACK:
if (LOCAL_MAX_SIZE < (char *)AuxSp - AuxBase) {
LOCAL_MAX_SIZE += 1024;
}
if (!Yap_ExpandPreAllocCodeSpace(0, NULL, TRUE)) {
/* crash in flames */
Yap_Error(RESOURCE_ERROR_AUXILIARY_STACK, ARG1, serr);
return FALSE;
}
return TRUE;
case RESOURCE_ERROR_HEAP:
if (!Yap_growheap(FALSE, 0, NULL)) {
Yap_Error(RESOURCE_ERROR_HEAP, ARG2, serr);
return FALSE;
}
default:
Yap_Error(err, LOCAL_Error_Term, serr);
return (FALSE);
}
}
@ -250,7 +250,7 @@ void Yap_RestartYap(int flag) {
static void error_exit_yap(int value) {
CACHE_REGS
if (!(LOCAL_PrologMode & BootMode)) {
#if DEBUG
#endif
}
@ -280,46 +280,46 @@ static char tmpbuf[YAP_BUF_SIZE];
#undef E2
#undef END_ERRORS
#define BEGIN_ERROR_CLASSES() \
static Term mkerrorct(yap_error_class_number c, Term *ts) { \
switch (c) {
#define BEGIN_ERROR_CLASSES() \
static Term mkerrorct(yap_error_class_number c, Term *ts) { \
switch (c) {
#define ECLASS(CL, A, B) \
case CL: \
if (A == 0) \
return MkAtomTerm(Yap_LookupAtom(A)); \
else { \
return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(A), B), B, ts); \
}
#define ECLASS(CL, A, B) \
case CL: \
if (A == 0) \
return MkAtomTerm(Yap_LookupAtom(A)); \
else { \
return Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom(A), B), B, ts); \
}
#define END_ERROR_CLASSES() \
} \
}
#define END_ERROR_CLASSES() \
} \
}
#define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term *ts) { \
switch (e) {
#define BEGIN_ERRORS() \
static Term mkerrort(yap_error_number e, Term *ts) { \
switch (e) {
#define E0(A, B) \
case A: \
return mkerrorct(B, ts);
#define E0(A, B) \
case A: \
return mkerrorct(B, ts);
#define E(A, B, C) \
case A: \
ts -= 1; \
ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \
return mkerrorct(B, ts);
#define E(A, B, C) \
case A: \
ts -= 1; \
ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \
return mkerrorct(B, ts);
#define E2(A, B, C, D) \
case A: \
ts -= 2; \
ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \
ts[1] = MkAtomTerm(Yap_LookupAtom(D)); \
return mkerrorct(B, ts);
#define E2(A, B, C, D) \
case A: \
ts -= 2; \
ts[0] = MkAtomTerm(Yap_LookupAtom(C)); \
ts[1] = MkAtomTerm(Yap_LookupAtom(D)); \
return mkerrorct(B, ts);
#define END_ERRORS() \
} \
}
#define END_ERRORS() \
} \
}
#include "YapErrors.h"
@ -348,7 +348,8 @@ return mkerrorct(B, ts);
*
* + 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,
*
* + g=g(Goal): the goal that created this mess
@ -365,7 +366,7 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
Term tf, error_t, comment, culprit;
char *format;
char s[MAXPATHLEN];
/* disallow recursive error handling */
if (LOCAL_PrologMode & InErrorMode) {
fprintf(stderr, "%% ERROR WITHIN ERROR %d: %s\n", LOCAL_CurrentError,
@ -403,29 +404,30 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
Yap_exit(1);
}
if (LOCAL_PrologMode == BootMode) {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, 256);
Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
error_exit_yap(1);
}
va_start(ap, where);
format = va_arg(ap, char *);
if (format != NULL) {
va_start(ap, where);
format = va_arg(ap, char *);
if (format != NULL) {
#if HAVE_VSNPRINTF
(void)vsnprintf(s, MAXPATHLEN-1, format, ap);
(void)vsnprintf(s, MAXPATHLEN - 1, format, ap);
#else
(void)vsprintf(s, format, ap);
(void)vsprintf(s, format, ap);
#endif
//fprintf(stderr, "warning: ");
comment = MkAtomTerm(Yap_LookupAtom(s));
} else if (LOCAL_ErrorSay && LOCAL_ErrorSay[0])
comment = MkAtomTerm(Yap_LookupAtom( LOCAL_ErrorSay ) );
else
comment = TermNil;
va_end(ap);
if (P == (yamop *)(FAILCODE)) {
LOCAL_PrologMode &= ~InErrorMode;
return P;
}
// fprintf(stderr, "warning: ");
comment = MkAtomTerm(Yap_LookupAtom(s));
} else if (LOCAL_ErrorSay && LOCAL_ErrorSay[0]) {
comment = MkAtomTerm(Yap_LookupAtom(LOCAL_ErrorSay));
} else {
comment = TermNil;
}
va_end(ap);
if (P == (yamop *)(FAILCODE)) {
LOCAL_PrologMode &= ~InErrorMode;
return P;
}
/* PURE_ABORT may not have set where correctly, BootMode may not have the data
* terms ready */
if (type == ABORT_EVENT || LOCAL_PrologMode & BootMode) {
@ -462,136 +464,148 @@ yamop *Yap_Error__(const char *file, const char *function, int lineno,
#ifdef DEBUG
// DumpActiveGoals( USES_REGS1 );
#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) {
case SYSTEM_ERROR_INTERNAL: {
fprintf(stderr, "%% Internal YAP Error: %s exiting....\n", tmpbuf);
serious = TRUE;
if (LOCAL_PrologMode & BootMode) {
fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
} else {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
}
error_exit_yap(1);
}
case SYSTEM_ERROR_FATAL: {
fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf);
error_exit_yap(1);
}
case INTERRUPT_EVENT: {
error_exit_yap(1);
}
case ABORT_EVENT:
nt[0] = MkAtomTerm(AtomDAbort);
fun = FunctorVar;
serious = TRUE;
break;
case CALL_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomCallCounter));
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return (P);
case PRED_ENTRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomCallAndRetryCounter));
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return (P);
case RETRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomRetryCounter));
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return (P);
default: {
Term ts[3];
ts[2] = where;
nt[0] = mkerrort(type, ts + 2);
serious = TRUE;
if (LOCAL_PrologMode & BootMode) {
fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
} else {
Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
}
error_exit_yap(1);
}
case SYSTEM_ERROR_FATAL: {
fprintf(stderr, "%% Fatal YAP Error: %s exiting....\n", tmpbuf);
error_exit_yap(1);
}
case INTERRUPT_EVENT: {
error_exit_yap(1);
}
case ABORT_EVENT:
nt[0] = MkAtomTerm(AtomDAbort);
fun = FunctorVar;
serious = TRUE;
break;
case CALL_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomCallCounter));
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return (P);
case PRED_ENTRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomCallAndRetryCounter));
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return (P);
case RETRY_COUNTER_UNDERFLOW_EVENT:
/* Do a long jump */
LOCAL_ReductionsCounterOn = FALSE;
LOCAL_PredEntriesCounterOn = FALSE;
LOCAL_RetriesCounterOn = FALSE;
Yap_JumpToEnv(MkAtomTerm(AtomRetryCounter));
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return (P);
default: {
Term ts[3];
ts[2] = where;
nt[0] = mkerrort(type, ts + 2);
}
}
if (type != ABORT_EVENT) {
/* This is used by some complex procedures to detect there was an error */
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);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
} else {
strncpy(LOCAL_ErrorSay,
(char *)RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,
(char *) RepAtom(NameOfFunctor(FunctorOfTerm(nt[0])))->StrOfAE,
MAX_ERROR_MSG_SIZE);
LOCAL_ErrorMessage = LOCAL_ErrorSay;
}
switch (type) {
case RESOURCE_ERROR_HEAP:
case RESOURCE_ERROR_STACK:
case RESOURCE_ERROR_TRAIL:
comment = MkAtomTerm(Yap_LookupAtom(tmpbuf));
default:
nt[1] = TermNil;
if (comment != TermNil)
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")), comment),
nt[1]);
if (file && function) {
Term ts[3], t3;
ts[0] = MkAtomTerm(Yap_LookupAtom(file));
ts[1] = MkIntegerTerm(lineno);
ts[2] = MkAtomTerm(Yap_LookupAtom(function));
t3 = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("c"), 3), 3, ts);
nt[1] =
MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")), t3), nt[1]);
}
if ((culprit = Yap_pc_location(P, B, ENV)) != TermNil) {
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]);
}
}
}
switch (type) {
case RESOURCE_ERROR_HEAP:
case RESOURCE_ERROR_STACK:
case RESOURCE_ERROR_TRAIL:
comment = MkAtomTerm(Yap_LookupAtom(tmpbuf));
default:
nt[1] = TermNil;
if (comment != TermNil)
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("i")),comment), nt[1]);
if (file && function) {
Term ts[3], t3;
ts[0] = MkAtomTerm(Yap_LookupAtom(file));
ts[1] = MkIntegerTerm(lineno);
ts[2] = MkAtomTerm(Yap_LookupAtom(function));
t3 = Yap_MkApplTerm(Yap_MkFunctor(Yap_LookupAtom("c"),3),3,ts);
nt[1] = MkPairTerm(MkPairTerm(MkAtomTerm(Yap_LookupAtom("c")),t3), nt[1]);
}
if ((culprit=Yap_pc_location( P, B, ENV)) != TermNil ) {
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]);
}
}
/* disable active signals at this point */
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode &= ~InErrorMode;
/* we might be in the middle of a critical region */
if (LOCAL_InterruptsDisabled) {
LOCAL_InterruptsDisabled = 0;
LOCAL_UncaughtThrow = TRUE;
Yap_RestartYap(1);
}
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
#endif
/* wait if we we are in user code,
it's up to her to decide */
fun = FunctorError;
if (LOCAL_PrologMode & UserCCallMode) {
error_t = Yap_MkApplTerm(fun, 2, nt);
if (!(EX = Yap_StoreTermInDB(error_t, 2))) {
/* fat chance */
/* disable active signals at this point */
LOCAL_Signals = 0;
CalculateStackGap(PASS_REGS1);
LOCAL_PrologMode &= ~InErrorMode;
/* we might be in the middle of a critical region */
if (LOCAL_InterruptsDisabled) {
LOCAL_InterruptsDisabled = 0;
LOCAL_UncaughtThrow = TRUE;
Yap_RestartYap(1);
}
} else {
if (type == ABORT_EVENT) {
error_t = MkAtomTerm(AtomDAbort);
} else {
#if DEBUG
// DumpActiveGoals( PASS_REGS1 );
#endif
/* wait if we we are in user code,
it's up to her to decide */
fun = FunctorError;
if (LOCAL_PrologMode & UserCCallMode) {
error_t = Yap_MkApplTerm(fun, 2, nt);
if (!(EX = Yap_StoreTermInDB(error_t, 2))) {
/* fat chance */
Yap_RestartYap(1);
}
} else {
if (type == ABORT_EVENT) {
error_t = MkAtomTerm(AtomDAbort);
} else {
error_t = Yap_MkApplTerm(fun, 2, nt);
}
Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE;
}
Yap_JumpToEnv(error_t);
P = (yamop *)FAILCODE;
LOCAL_PrologMode &= ~InErrorMode;
return P;
}
LOCAL_PrologMode &= ~InErrorMode;
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 */
Yap_Error(LOCAL_matherror ,TermNil,NULL);
/* 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;
LOCAL_PrologMode = UserMode;
}

2646
C/scanner.c
View File

File diff suppressed because it is too large Load Diff

381
C/text.c
View File

@ -54,176 +54,99 @@ Globalize(Term v USES_REGS)
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
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;
Term *s; /* slow */
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);
*tailp = 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) {
*tailp = l;
*atoms = 0;
*wide = FALSE;
return 0;
}
if ( IsPairTerm(*l) )
{ intptr_t power = 1, lam = 0;
do
{ if ( power == lam )
{ s = l;
power *= 2;
lam = 0;
Term hd0 = HeadOfTerm(*l);
if (IsVarTerm(hd0)) {
return -INSTANTIATION_ERROR;
}
//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;
}
lam++;
} else if (*atoms == 2) {
if ( !IsAtomTerm(hd0) ) {
return -TYPE_ERROR_ATOM;
}
}
do {
int ch;
length++;
if (length == max) {
*st++ = '\0';
}
{ Term hd = Deref(RepPair(*l)[0]);
if (IsVarTerm(hd)) {
length = -INSTANTIATION_ERROR;
return -INSTANTIATION_ERROR;
} else if (IsAtomTerm(hd)) {
(*atoms)++;
/* if (*atoms < length)
{ *tailp = l; return -TYPE_ERROR_STRING; } */
if (*atoms < length)
{ *tailp = l; return -TYPE_ERROR_NUMBER; }
if (IsWideAtom(AtomOfTerm(hd))) {
if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') { length = -REPRESENTATION_ERROR_CHARACTER; }
*wide = TRUE;
int ch;
if ((RepAtom(AtomOfTerm(hd))->WStrOfAE)[1] != '\0') {
length = -REPRESENTATION_ERROR_CHARACTER;
}
ch = RepAtom(AtomOfTerm(hd))->WStrOfAE[0];
*wide = true;
} else {
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)) {
Int ch = IntegerOfTerm(hd);
if (/* *atoms|| */ch < 0) { *tailp = l; /*if (*atoms) length = -TYPE_ERROR_STRING;*/ length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO; }
else if (ch > 0x80) { *wide = TRUE; }
ch = IntegerOfTerm(hd);
if (*atoms) length = -TYPE_ERROR_ATOM;
else if (ch < 0) {
*tailp = l;
length = -DOMAIN_ERROR_NOT_LESS_THAN_ZERO;
} else {
*wide |= ch > 0x80;
}
} else {
length = -TYPE_ERROR_INTEGER;
}
@ -232,102 +155,70 @@ SkipListCodes(Term *l, Term **tailp, Int *atoms, bool *wide)
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;
do_derefa(v,l,derefa2_unk,derefa2_nonvar);
} while ( *l != *s && IsPairTerm(*l) );
}
if (IsVarTerm(*l)) {
return -INSTANTIATION_ERROR;
}
if ( *l != TermNil) {
return -TYPE_ERROR_LIST;
}
st[0] = '\0';
*tailp = l;
return length;
}
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;
Int n;
*widep = false;
n = SkipListCodes(&t, &r, &atoms, widep);
if (!buf) {
inp->sz = *lenp;
}
unsigned char *bufc = buf;
n = SkipListCodes(&bufc, &t, &r, atoms, widep, inp PASS_REGS);
if (n < 0) {
LOCAL_Error_TYPE = -n;
LOCAL_Error_Term = *r;
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;
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 = (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;
}
return bufc;
}
static void *
Yap_ListOfCodesToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
{
Int atoms = 0;
CELL *r = NULL;
Int n;
Int atoms = 1; // we only want lists of atoms
return to_buffer( buf, t, inp, widep, &atoms, lenp PASS_REGS);
}
*widep = false;
n = SkipListCodes(&t, &r, &atoms, widep);
if (n < 0) {
LOCAL_Error_TYPE = -n;
LOCAL_Error_Term = *r;
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_ListOfAtomsToBuffer(void *buf, Term t, seq_tv_t *inp, bool *widep, size_t *lenp USES_REGS)
{
Int atoms = 2; // we only want lists of integer codes
return to_buffer( buf, t, inp, widep, &atoms, lenp PASS_REGS);
}
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
@ -355,24 +246,32 @@ gen_type_error(int flags) {
void *
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;
bool wide;
/* we know what the term is */
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;
} else if (!IsAtomTerm(inp->val.t) && inp->type == YAP_STRING_ATOM) {
LOCAL_Error_TYPE = TYPE_ERROR_ATOM;
} else if (!IsStringTerm(inp->val.t) && inp->type == YAP_STRING_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) {
LOCAL_Error_TYPE = TYPE_ERROR_NUMBER;
}
LOCAL_Error_Term = inp->val.t;
}
}
if (LOCAL_Error_TYPE != YAP_NO_ERROR)
return NULL;
// this is a term, extract the UTF8 representation
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;
}
}
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
*minimal = TRUE;
*enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
*minimal = true;
*enc = ENC_ISO_UTF8;
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
*minimal = TRUE;
s = Yap_ListOfAtomsToBuffer( buf, inp->val.t, inp, &wide, lengp PASS_REGS);
if (!s) return NULL;
if (wide) { *enc = ENC_ISO_UTF8; }
else { *enc = ENC_ISO_LATIN1; }
*minimal = true;
*enc = ENC_ISO_UTF8;
return s;
}
if (inp->type & YAP_STRING_INT && IsIntegerTerm(inp->val.t)) {
if (buf) s = buf;
if (s0) s = s0;
else s = Yap_PreAllocCodeSpace();
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
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;
}
if (inp->type & YAP_STRING_FLOAT && IsFloatTerm(inp->val.t)) {
if (buf) s = buf;
if (s0) s = s0;
else s = Yap_PreAllocCodeSpace();
AUX_ERROR( inp->val.t, LOCAL_MAX_SIZE, s, char);
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 (inp->type & YAP_STRING_BIG && IsBigIntTerm(inp->val.t)) {
if (buf) s = buf;
if (s0) s = s0;
else s = Yap_PreAllocCodeSpace();
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);
@ -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)
{
char *s, *o;
if (buf) s = buf;
if (s0) s = s0;
else s = Yap_PreAllocCodeSpace();
size_t sz = LOCAL_MAX_SIZE-1;
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)
{
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 *cp = s, *buf0, *buf;
buf = buf0 = out->val.uc;
buf = buf0 = s0;
if (!buf)
return -1;
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
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
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 =
write_atom( inp, out, enc, minimal, leng PASS_REGS);
return out->val.a != NULL;
case YAP_STRING_INT:
case YAP_STRING_FLOAT:
case YAP_STRING_BIG:
case YAP_STRING_INT|YAP_STRING_FLOAT|YAP_STRING_BIG:
out->val.t =
write_number( inp, out, enc, minimal, leng PASS_REGS);
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;
}
static inline Term getAtomicGlobalPrologFlag(int id) {
return GLOBAL_Flags[id].at;
}
static inline void setAtomicLocalPrologFlag(int id, Term v) {
CACHE_REGS
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` */
/* 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
Prolog exceptions. If enabled:

2
H/Yapproto.h
View File

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

554
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++))
;
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);
UNLOCK(GLOBAL_Stream[sno].streamlock);
return t;

39
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, ...)
{
if (trueLocalPrologFlag(FILEERRORS_FLAG) == TermTrue||
if (trueLocalPrologFlag(FILEERRORS_FLAG)||
type == RESOURCE_ERROR_MAX_STREAMS /* do not catch resource errors */) {
va_list args;
const char *format;
@ -377,7 +377,11 @@ PlIOError__ (const char *file, const char *function, int lineno, yap_error_numb
va_start(args, culprit);
format = va_arg(args, char *);
vsnprintf(who, 1023, format, args);
if (format) {
vsnprintf(who, 1023, format, args);
} else {
who[0] ='\0';
}
va_end( args );
Yap_Error__(file, function, lineno, type, culprit, who);
/* and fail */
@ -1641,8 +1645,10 @@ Yap_OpenStream(FILE *fd, char *name, Term file_name, int flags)
return sno;
}
#define CheckStream( arg, kind, msg) CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
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;
arg = Deref (arg);
@ -1655,7 +1661,7 @@ CheckStream (Term arg, int kind, const char *msg)
if (sname == AtomUser) {
if (kind & Input_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");
return (-1);
}
@ -1666,7 +1672,7 @@ CheckStream (Term arg, int kind, const char *msg)
}
if ((sno = Yap_CheckAlias(sname)) < 0) {
UNLOCK(GLOBAL_Stream[sno].streamlock);
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg);
PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg);
return -1;
} else {
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)
{
Yap_Error(EXISTENCE_ERROR_STREAM, arg, msg);
PlIOError__(file, f, line, EXISTENCE_ERROR_STREAM, arg, msg);
return (-1);
}
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);
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);
PlIOError(PERMISSION_ERROR_OUTPUT_STREAM, arg, msg);
PlIOError__(file, f, line, PERMISSION_ERROR_OUTPUT_STREAM, arg, msg);
}
return (sno);
}
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
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;
if ((sno = CheckStream(arg, kind, (char *)msg)) < 0)
if ((sno = CheckStream__(file, f, line, arg, kind, msg)) < 0)
return -1;
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);
return -1;
}
@ -1763,7 +1768,7 @@ always_prompt_user( USES_REGS1 )
static Int
close1 (USES_REGS1)
{ /* '$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)
return (FALSE);
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;
extern Term Yap_InitSocketStream(int, socket_info, socket_domain);
extern int Yap_CheckStream(Term, int, const char *);
extern int Yap_CheckTextStream(Term, int, const char *);
#define Yap_CheckStream( arg, kind, msg) Yap_CheckStream__(__FILE__, __FUNCTION__, __LINE__, arg, kind, msg)
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 socket_domain Yap_GetSocketDomain(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;
startline = MkIntegerTerm(cline);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
if (errtok != LOCAL_toktide) {
errtok = LOCAL_toktide;
}
LOCAL_Error_TYPE = YAP_NO_ERROR;
errline = MkIntegerTerm(errtok->TokPos);
while (tok) {
Term ts[2];
@ -288,10 +287,14 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
} break;
case String_tok: {
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);
} break;
case WString_tok: {
Term t0 = Yap_WCharsToTDQ((wchar_t *)info, CurrentModule PASS_REGS);
if (!t0)
return 0;
ts[0] = Yap_MkApplTerm(Yap_MkFunctor(AtomString, 1), 1, &t0);
} break;
case BQString_tok: {
@ -343,9 +346,9 @@ Term Yap_syntax_error(TokEntry *errtok, int sno) {
tf[0] = MkStringTerm("");
/* file */
tf[2] = Yap_StreamUserName(sno);
tf[1] = Yap_MkApplTerm(FunctorSyntaxError, 4, tf);
tf[0] = MkAtomTerm(AtomSyntaxError);
return Yap_MkApplTerm(FunctorError, 2, tf);
clean_vars(LOCAL_VarTable);
clean_vars(LOCAL_AnonVarTable);
return Yap_MkApplTerm(FunctorSyntaxError, 4, tf);
}
typedef struct FEnv {
@ -379,6 +382,8 @@ static xarg *setClauseReadEnv(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
LOCAL_VarTable = NULL;
LOCAL_AnonVarTable = NULL;
re->cm = CurrentModule;
xarg *args = Yap_ArgListToVector(opts, read_defs, READ_END);
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_getenv( 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);
#ifdef MACYAP
static int chdir(char *);
@ -2134,7 +2134,6 @@ Yap_MathException__( USES_REGS1 )
return EVALUATION_ERROR_UNDEFINED;
}
if (raised ) {
feclearexcept(FE_ALL_EXCEPT);
if (raised & FE_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. */
static bool
set_fpu_exceptions(bool flag)
set_fpu_exceptions(Term flag)
{
if (flag) {
if (flag == TermTrue) {
#if HAVE_FESETEXCEPTFLAG
fexcept_t excepts;
return fesetexceptflag(&excepts, FE_DIVBYZERO| FE_UNDERFLOW|FE_OVERFLOW) == 0;
@ -3309,19 +3308,11 @@ MSCHandleSignal(DWORD dwCtrlType) {
}
bool
Yap_set_fpu_exceptions(bool flag)
Yap_set_fpu_exceptions(Term 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
p_host_type( USES_REGS1 ) {
@ -3732,7 +3723,6 @@ MSCHandleSignal(DWORD dwCtrlType) {
Yap_InitCPred ("$alarm", 4, p_alarm, SafePredFlag|SyncPredFlag);
Yap_InitCPred ("$getenv", 2, p_getenv, SafePredFlag);
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 ("$env_separator", 1, p_env_separator, 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) :-
Level \= top, !,
throw(error(permission_error(module,redefined,A),B)).
'$process_error'(error(Msg, Where), _) :- !,
'$set_fpu_exceptions'(true),
print_message(error,error(Msg, Where)).
'$process_error'(error(Msg, Where), _) :-
print_message(error,error(Msg, Where)), !.
'$process_error'(Throw, _) :-
print_message(error,error(unhandled_exception,Throw)).

12
pl/messages.yap
View File

@ -214,6 +214,8 @@ compose_message(Term, Level) -->
main_message( Term, Level ),
[nl,nl].
location(error(syntax_error(syntax_error(_,between(_,LN,_),FileName,_)),_ ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] .
location( error(_,Term), Level ) -->
{ source_location(F0, L),
stream_property(_Stream, alias(loop_stream)) }, !,
@ -226,15 +228,13 @@ location( error(_,Term), Level ) -->
[nl].
location(error(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] .
location(warning(_,syntax_error(_,between(_,LN,_),FileName,_) ), _ ) -->
[ '~a:~d:0: ' - [FileName,LN] ] .
location(style_check(_,LN,FileName,_ ), _ ) -->
% { stream_position_data( line_count, LN) },
!,
[ '~a:~d:0: ' - [FileName,LN] ] .
%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]],
[nl],
@ -262,8 +262,8 @@ main_message(error(consistency_error(Who)), _Source) -->
[ '~*|!!! has argument ~a not consistent with type.'-[8,Who] ].
main_message(error(domain_error(Who , Type), _Where), _Source) -->
[ '~*|!!! ~q does not belong to domain ~a,' - [8,Who,Type], nl ].
main_message(error(evaluation_error(What), _Where), _Source) -->
[ '~*|!!! caused ~a during evaluation of arithmetic expressions,' - [8,What], nl ].
main_message(error(evaluation_error(What, Who), _Where), _Source) -->
[ '~*|!!! ~w caused ~a during evaluation of arithmetic expressions,' - [8,Who,What], nl ].
main_message(error(existence_error(Type , Who), _Where), _Source) -->
[ '~*|!!! ~q ~q could not be found,' - [8,Type, Who], nl ].
main_message(error(permission_error(Op, Type, Id), _Where), _Source) -->
@ -283,7 +283,7 @@ consulting -->
stream_property(_Stream, alias(loop_stream)) }, !,
[ '~*| while consulting ~a:~d'-[10,F0,L] ],
[nl].
consulting --> [].
consulting --> [].
caller( error(_,Term), _) -->
{ lists:memberchk([p|p(M,Na,Ar,File,FilePos)], Term ) },