Merge branch 'master' of ../yap-6.2

C/absmi.c

@@ -1861,7 +1861,6 @@ Yap_absmi(int inp)
 #else
       B = B->cp_b;
 #endif	/* YAPOR */
-      goto fail;
       ENDBOp();
 
 #ifdef YAPOR
@@ -2652,6 +2651,12 @@ Yap_absmi(int inp)
     NoStackCall:
       PP = PREG->u.Osbpp.p0;
       /* on X86 machines S will not actually be holding the pointer to pred */
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	goto fail;
+      }
       if (ActiveSignals & YAP_CREEP_SIGNAL) {
 	PredEntry *ap = PREG->u.Osbpp.p;
 	SREG = (CELL *) ap;
@@ -2687,6 +2692,12 @@ Yap_absmi(int inp)
       {
 	CELL cut_b = LCL0-(CELL *)(SREG[E_CB]);
 
+	if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	  ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	  if (!ActiveSignals)
+	    CreepFlag = CalculateStackGap();
+	  goto fail;
+	}
 	/* 
 	   don't do a creep here; also, if our instruction is followed by
 	   a execute_c, just wait a bit more */
@@ -2735,6 +2746,12 @@ Yap_absmi(int inp)
       if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
 	goto do_commit_b_y;
       }
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	FAIL();
+      }
       if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
 	SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs,0));
 	XREGS[0] = YREG[PREG->u.yp.y];
@@ -2751,6 +2768,12 @@ Yap_absmi(int inp)
       if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
 	goto do_commit_b_x;
       }
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	FAIL();
+      }
       if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
 	SREG = (CELL *)RepPredProp(Yap_GetPredPropByFunc(FunctorRestoreRegs,0));
 #if USE_THREADED_CODE
@@ -2777,8 +2800,15 @@ Yap_absmi(int inp)
 
       /* Problem: have I got an environment or not? */
     NoStackFail:
+      if (ActiveSignals && ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	/* we're happy */
+	goto fail;
+      }
       /* find something to fool S */
-      if (!ActiveSignals || ActiveSignals & YAP_CDOVF_SIGNAL) {
+      if (!ActiveSignals || ActiveSignals & (YAP_CDOVF_SIGNAL)) {
 	goto fail;
       }
       if (!(ActiveSignals & YAP_CREEP_SIGNAL)) {
@@ -2793,6 +2823,12 @@ Yap_absmi(int inp)
 
       /* don't forget I cannot creep at ; */
     NoStackEither:
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	goto fail;
+      }
       PP = PREG->u.Osblp.p0;
       if (ActiveSignals & YAP_CREEP_SIGNAL) {
 	goto either_notest;
@@ -2870,6 +2906,12 @@ Yap_absmi(int inp)
       goto creep;
 
     NoStackDExecute:
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	goto fail;
+      }
       PP = PREG->u.pp.p0;
       if (ActiveSignals & YAP_CREEP_SIGNAL) {
 	PredEntry *ap = PREG->u.pp.p;
@@ -2942,6 +2984,12 @@ Yap_absmi(int inp)
 
       /* try performing garbage collection */
 
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	goto fail;
+      }
       ASP = YREG+E_CB;
       if (ASP > (CELL *)PROTECT_FROZEN_B(B))
 	ASP = (CELL *)PROTECT_FROZEN_B(B);
@@ -2985,6 +3033,12 @@ Yap_absmi(int inp)
       /* and now CREEP */
 
     creep:
+      if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	if (!ActiveSignals)
+	  CreepFlag = CalculateStackGap();
+	goto fail;
+      }
 #if  defined(_MSC_VER) || defined(__MINGW32__)
 	/* I need this for Windows and other systems where SIGINT
 	   is not proceesed by same thread as absmi */
@@ -13848,6 +13902,12 @@ Yap_absmi(int inp)
 
 	ENDD(d0);
       NoStackPExecute2:
+	if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	  ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	  if (!ActiveSignals)
+	    CreepFlag = CalculateStackGap();
+	  goto fail;
+	}
 	PP = PredMetaCall;
 	SREG = (CELL *) pen;
 	ASP = ENV_YREG;
@@ -14047,6 +14107,12 @@ Yap_absmi(int inp)
 
 	ENDD(d0);
       NoStackPExecute:
+	if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	  ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	  if (!ActiveSignals)
+	    CreepFlag = CalculateStackGap();
+	  goto fail;
+	}
 	PP = PredMetaCall;
 	SREG = (CELL *) pen;
 	ASP = ENV_YREG;
@@ -14317,6 +14383,12 @@ Yap_absmi(int inp)
 	ENDD(d0);
 	ENDP(pt0);
       NoStackPTExecute:
+	if (ActiveSignals & YAP_FAIL_SIGNAL) {
+	  ActiveSignals &= ~YAP_FAIL_SIGNAL;
+	  if (!ActiveSignals)
+	    CreepFlag = CalculateStackGap();
+	  goto fail;
+	}
 	PP = NULL;
 	WRITEBACK_Y_AS_ENV();
 	SREG = (CELL *) pen;

C/c_interface.c

@@ -480,6 +480,7 @@ X_API int     STD_PROTO(YAP_RecoverSlots,(int));
 X_API Int     STD_PROTO(YAP_ArgsToSlots,(int));
 X_API void    STD_PROTO(YAP_SlotsToArgs,(int, Int));
 X_API void    STD_PROTO(YAP_Throw,(Term));
+X_API void    STD_PROTO(YAP_AsyncThrow,(Term));
 X_API void    STD_PROTO(YAP_Halt,(int));
 X_API Term   *STD_PROTO(YAP_TopOfLocalStack,(void));
 X_API void   *STD_PROTO(YAP_Predicate,(Atom,UInt,Term));
@@ -2833,6 +2834,16 @@ YAP_Throw(Term t)
   RECOVER_MACHINE_REGS();
 }
 
+X_API void
+YAP_AsyncThrow(Term t)
+{
+  BACKUP_MACHINE_REGS();
+  Yap_PrologMode |= AsyncIntMode;
+  Yap_JumpToEnv(t);
+  Yap_PrologMode &= ~AsyncIntMode;
+  RECOVER_MACHINE_REGS();
+}
+
 X_API void
 YAP_Halt(int i)
 {

C/errors.c

@@ -455,6 +455,9 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
     where = TermNil;
     Yap_PrologMode &= ~AbortMode;
     Yap_PrologMode |= InErrorMode;
+    /* make sure failure will be seen at next port */
+    if (Yap_PrologMode & AsyncIntMode)
+      Yap_signal(YAP_FAIL_SIGNAL);
     P = FAILCODE;
   } else {
     if (IsVarTerm(where)) {
@@ -1874,7 +1877,6 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
     } else {
       if (type == PURE_ABORT) {
 	Yap_JumpToEnv(MkAtomTerm(AtomDAbort));
-	CreepFlag = LCL0-ASP;
       } else
 	Yap_JumpToEnv(Yap_MkApplTerm(fun, 2, nt));
       P = (yamop *)FAILCODE;

C/exec.c

@@ -971,6 +971,8 @@ exec_absmi(int top)
 	ASP = (CELL *)PROTECT_FROZEN_B(B);
 	Yap_StartSlots();
 	LOCK(SignalLock);
+	/* forget any signals active, we're reborne */
+	ActiveSignals = 0;
 	CreepFlag = CalculateStackGap();
 	Yap_PrologMode = UserMode;
 	UNLOCK(SignalLock);
@@ -1002,6 +1004,10 @@ exec_absmi(int top)
   Yap_CloseSlots();
   out = Yap_absmi(0);
   Yap_StartSlots();
+  /* make sure we don't leave a FAIL signal hanging around */ 
+  ActiveSignals &= ~YAP_FAIL_SIGNAL;
+  if (!ActiveSignals)
+    CreepFlag = CalculateStackGap();
   return out;
 }
 
@@ -1505,6 +1511,10 @@ JumpToEnv(Term t) {
 	EX = BallTerm;
 	BallTerm = NULL;
 	P = (yamop *)FAILCODE;
+	/* make sure failure will be seen at next port */
+	if (Yap_PrologMode & AsyncIntMode) {
+	  Yap_signal(YAP_FAIL_SIGNAL);
+	}
 	HB = B->cp_h;
 	return TRUE;
       }
@@ -1546,6 +1556,9 @@ JumpToEnv(Term t) {
   /* B->cp_h = H; */
   /* I could backtrack here, but it is easier to leave the unwinding
      to the emulator */
+  if (Yap_PrologMode & AsyncIntMode) {
+    Yap_signal(YAP_FAIL_SIGNAL);
+  }
   P = (yamop *)FAILCODE;
   HB = B->cp_h;
   /* try to recover space */

C/sysbits.c

@@ -1545,6 +1545,7 @@ void (*handler)(int);
 
 static int
 InteractSIGINT(int ch) {
+  Yap_PrologMode |= AsyncIntMode;
   switch (ch) {
   case 'a':
     /* abort computation */
@@ -1554,40 +1555,49 @@ InteractSIGINT(int ch) {
       Yap_Error(PURE_ABORT, TermNil, "abort from console");
       /* in case someone mangles the P register */
     }
+    Yap_PrologMode &= ~AsyncIntMode;
     return -1;
   case 'b':
     /* continue */
     Yap_signal (YAP_BREAK_SIGNAL);
+    Yap_PrologMode &= ~AsyncIntMode;
     return 1;
   case 'c':
     /* continue */
     return 1;
   case 'd':
     Yap_signal (YAP_DEBUG_SIGNAL);
+    Yap_PrologMode &= ~AsyncIntMode;
     /* enter debug mode */
     return 1;
   case 'e':
     /* exit */
+    Yap_PrologMode &= ~AsyncIntMode;
     Yap_exit(0);
     return -1;
   case 'g':
     /* exit */
     Yap_signal (YAP_STACK_DUMP_SIGNAL);
+    Yap_PrologMode &= ~AsyncIntMode;
     return -1;
   case 't':
     /* start tracing */
     Yap_signal (YAP_TRACE_SIGNAL);
+    Yap_PrologMode &= ~AsyncIntMode;
     return 1;
 #ifdef LOW_LEVEL_TRACER
   case 'T':
     toggle_low_level_trace();
+    Yap_PrologMode &= ~AsyncIntMode;
     return 1;
 #endif
   case 's':
     /* show some statistics */
     Yap_signal (YAP_STATISTICS_SIGNAL);
+    Yap_PrologMode &= ~AsyncIntMode;
     return 1;
   case EOF:
+    Yap_PrologMode &= ~AsyncIntMode;
     return(0);
     break;
   case 'h':
@@ -1598,6 +1608,7 @@ InteractSIGINT(int ch) {
     fprintf(Yap_stderr, "  a for abort\n  c for continue\n  d for debug\n");
     fprintf(Yap_stderr, "  e for exit\n  g for stack dump\n  s for statistics\n  t for trace\n");
     fprintf(Yap_stderr, "  b for break\n");
+    Yap_PrologMode &= ~AsyncIntMode;
     return(0);
   }
 }
@@ -2987,8 +2998,16 @@ p_first_signal(void)
     UNLOCK(SignalLock);
     return Yap_unify(ARG1, MkAtomTerm(AtomSigStatistics));
   }
+  if (ActiveSignals & YAP_FAIL_SIGNAL) {
+    ActiveSignals &= ~YAP_FAIL_SIGNAL;
 #ifdef THREADS
     pthread_mutex_unlock(&(MY_ThreadHandle.tlock));
+#endif  
+    UNLOCK(SignalLock);
+    return Yap_unify(ARG1, MkAtomTerm(AtomFail));
+  }
+#ifdef THREADS
+  pthread_mutex_unlock(&(MY_ThreadHandle.tlock));
 #endif  
   UNLOCK(SignalLock);
   return FALSE;
@@ -3040,6 +3059,9 @@ p_continue_signals(void)
   if (ActiveSignals & YAP_STATISTICS_SIGNAL) {
     Yap_signal(YAP_STATISTICS_SIGNAL);
   }
+  if (ActiveSignals & YAP_FAIL_SIGNAL) {
+    Yap_signal(YAP_FAIL_SIGNAL);
+  }
 #ifdef THREADS
   pthread_mutex_unlock(&(MY_ThreadHandle.tlock));
 #endif  

H/Yap.h

@@ -620,7 +620,8 @@ typedef enum
   YAP_DELAY_CREEP_SIGNAL = 0x10000,	/* received a creep but should not do it */
   YAP_AGC_SIGNAL = 0x20000,	/* call atom garbage collector asap */
   YAP_PIPE_SIGNAL = 0x40000,	/* call atom garbage collector asap */
-  YAP_VTALARM_SIGNAL = 0x80000	/* received SIGVTALARM */
+  YAP_VTALARM_SIGNAL = 0x80000,	/* received SIGVTALARM */
+  YAP_FAIL_SIGNAL = 0x100000	/* P = FAILCODE */
 } yap_signals;
 
 #define NUMBER_OF_YAP_FLAGS  LAST_FLAG
@@ -1186,6 +1187,7 @@ typedef enum
   UserCCallMode = 0x4000,	/* In User C-call Code */
   MallocMode = 0x8000,		/* Doing malloc, realloc, free */
   SystemMode = 0x10000,		/* in system mode */
+  AsyncIntMode = 0x20000	/* YAP has just been interrupted from the outside */
 } prolog_exec_mode;
 
 extern Int Yap_PrologMode;

include/YapInterface.h

@@ -435,6 +435,9 @@ extern X_API void PROTO(YAP_SlotsToArgs,(int, YAP_Int));
 /*  void  YAP_Throw()  */
 extern X_API void PROTO(YAP_Throw,(YAP_Term));
 
+/*  void  YAP_AsyncThrow()  */
+extern X_API void PROTO(YAP_AsyncThrow,(YAP_Term));
+
 /*  int  YAP_LookupModule()  */
 #define YAP_LookupModule(T)  (T)
 

pl/signals.yap

@@ -89,6 +89,9 @@
 	'$continue_signals',
 	statistics,
 	'$execute0'(G,M).
+% the next one should never be called...
+'$do_signal'(fail, [_|_]) :-
+	fail.
 '$do_signal'(sig_stack_dump, [M|G]) :-
 	'$continue_signals',
 	'$stack_dump',