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

C/atomic.c

@@ -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" )) {

C/errors.c

@@ -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");
+    // fprintf(stderr, "warning message:\n");
-    //Yap_DebugPlWrite(twarning);
+    // Yap_DebugPlWrite(twarning);
-    //fprintf(stderr, "\n");
+    // 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");
+    // fprintf(stderr, "warning message:\n");
-    //Yap_DebugPlWrite(twarning);
+    // Yap_DebugPlWrite(twarning);
-    //fprintf(stderr, "\n");
+    // 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:
+  case RESOURCE_ERROR_STACK:
-      if (!Yap_gc(2, ENV, gc_P(P, CP))) {
+    if (!Yap_gc(2, ENV, gc_P(P, CP))) {
-        Yap_Error(RESOURCE_ERROR_STACK, ARG1, serr);
+      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);
+    }
+    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:
+  case RESOURCE_ERROR_STACK:
-      if (!Yap_gc(2, ENV, gc_P(P, CP))) {
+    if (!Yap_gc(2, ENV, gc_P(P, CP))) {
-        Yap_Error(RESOURCE_ERROR_STACK, TermNil, serr);
+      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);
+    }
+    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()					\
+#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"
 
@@ -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(P, FIND_PRED_FROM_ANYWHERE, 256);
-    Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE,  256);
+    Yap_detect_bug_location(CP, FIND_PRED_FROM_ANYWHERE, 256);
     error_exit_yap(1);
   }
-     va_start(ap, where);
+  va_start(ap, where);
-    format = va_arg(ap, char *);
+  format = va_arg(ap, char *);
-    if (format != NULL) {
+  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: ");
+    // 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);
+  }
-    if (P == (yamop *)(FAILCODE)) {
+  va_end(ap);
-      LOCAL_PrologMode &= ~InErrorMode;
+  if (P == (yamop *)(FAILCODE)) {
-      return P;
+    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;
+     serious = TRUE;
-      if (LOCAL_PrologMode & BootMode) {
+     if (LOCAL_PrologMode & BootMode) {
-        fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
+      fprintf(stderr, "%% YAP crashed while booting %s\n", tmpbuf);
-      } else {
+    } else {
-        Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
+      Yap_detect_bug_location(P, FIND_PRED_FROM_ANYWHERE, YAP_BUF_SIZE);
-        fprintf(stderr, "%% Bug found while executing %s\n", tmpbuf);
+      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);
     }
+    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) {
+    /* disable active signals at this point */
-    case RESOURCE_ERROR_HEAP:
+    LOCAL_Signals = 0;
-    case RESOURCE_ERROR_STACK:
+    CalculateStackGap(PASS_REGS1);
-    case RESOURCE_ERROR_TRAIL:
+    LOCAL_PrologMode &= ~InErrorMode;
-      comment  = MkAtomTerm(Yap_LookupAtom(tmpbuf));
+    /* we might be in the middle of a critical region */
-    default:
+    if (LOCAL_InterruptsDisabled) {
-      nt[1] = TermNil;
+      LOCAL_InterruptsDisabled = 0;
-      if (comment != TermNil)
+      LOCAL_UncaughtThrow = TRUE;
-        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 */
       Yap_RestartYap(1);
     }
-  } else {
+#if DEBUG
-    if (type == ABORT_EVENT) {
+//    DumpActiveGoals( PASS_REGS1 );
-      error_t = MkAtomTerm(AtomDAbort);
+#endif
-    } else {
+    /* 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;
-  
-}
-
-

C/exec.c

@@ -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;
             }

C/text.c

@@ -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
+    Term hd0 = HeadOfTerm(*l);
-    { if ( power == lam )
+    if (IsVarTerm(hd0)) {
-      { s = l;
+      return -INSTANTIATION_ERROR;
-	power *= 2;
+    }
-	lam = 0;
+    //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)
+	  if (*atoms < length)
-	     { *tailp = l; return -TYPE_ERROR_STRING; } */
+	     { *tailp = l; return -TYPE_ERROR_NUMBER; }
 	  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 {
 	    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);
+	   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 {
 	  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;
+  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) {
     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) {
+  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 *
 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
@@ -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;
+    *minimal = true;
-    *enc = ( wide ? ENC_WCHAR : ENC_ISO_LATIN1 );
+    *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;
+    *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;
   }
   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_INT|YAP_STRING_FLOAT|YAP_STRING_BIG:
-  case YAP_STRING_FLOAT:
-  case YAP_STRING_BIG:
     out->val.t =
       write_number( inp, out, enc, minimal, leng PASS_REGS);
     return out->val.t != 0;

H/YapFlags.h

@@ -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();

H/YapGFlagInfo.h

@@ -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:

H/Yapproto.h

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

os/chartypes.c

@@ -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;

os/iopreds.c

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

os/iopreds.h

@@ -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 *);
+#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 socket_domain   Yap_GetSocketDomain(int);
 extern socket_info   Yap_GetSocketStatus(int);

os/readterm.c

@@ -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);
+  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 {
@@ -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) {

os/sysbits.c

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

pl/errors.yap

@@ -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), _) :- !,
+'$process_error'(error(Msg, Where), _) :-
-	'$set_fpu_exceptions'(true),
+print_message(error,error(Msg, Where)), !.
-	print_message(error,error(Msg, Where)).
 '$process_error'(Throw, _) :-
 	print_message(error,error(unhandled_exception,Throw)).
-

pl/messages.yap

@@ -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) -->
+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) -->
 	[  '~*|!!!  ~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 ) },