change abort so that it won't be caught by handlers.

git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1179 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

C/errors.c

@@ -434,8 +434,8 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
       error_exit_yap (1);
     }
   case PURE_ABORT:
-    nt[0] = MkAtomTerm(Yap_LookupAtom(tmpbuf));
+    fprintf(stderr,"%% YAP execution aborted.\n");
-    fun = Yap_MkFunctor(Yap_LookupAtom("abort"),2);
+    fun = FunctorVar;
     serious = TRUE;
     break;
   case CALL_COUNTER_UNDERFLOW:
@@ -1614,7 +1614,7 @@ Yap_Error(yap_error_number type, Term where, char *format,...)
   }
   if (serious) {
     if (type == PURE_ABORT)
-      Yap_JumpToEnv(MkAtomTerm(Yap_LookupAtom("abort")));
+      Yap_JumpToEnv(MkAtomTerm(Yap_LookupAtom("$abort")));
     else
       Yap_JumpToEnv(Yap_MkApplTerm(fun, 2, nt));
     P = (yamop *)FAILCODE;

C/exec.c

@@ -1409,14 +1409,16 @@ JumpToEnv(Term t) {
       }
       if (B->cp_ap == NOCODE) {
 	/* up to the C-code to deal with this! */
+	UncaughtThrow = TRUE;
 	B->cp_h = H;
 	EX = t;
-	return(FALSE);
+	return FALSE;
       }
       B = B->cp_b;
     }
     /* uncaught throw */
     if (B == NULL) {
+      UncaughtThrow = TRUE;
       B = B0;
 #if PUSH_REGS
       restore_absmi_regs(&Yap_standard_regs);
@@ -1534,6 +1536,13 @@ Yap_InitYaamRegs(void)
   DelayedTrace = FALSE;
 }
 
+static Int
+p_uncaught_throw(void)
+{
+  Int out = UncaughtThrow;
+  UncaughtThrow = FALSE; /* just caught it */
+  return out;
+}
 
 void 
 Yap_InitExecFs(void)
@@ -1564,5 +1573,6 @@ Yap_InitExecFs(void)
   Yap_InitCPred("$clean_ifcp", 1, p_clean_ifcp, SafePredFlag|HiddenPredFlag);
   Yap_InitCPred("$jump_env_and_store_ball", 1, p_jump_env, HiddenPredFlag);
   Yap_InitCPred("$generate_pred_info", 4, p_generate_pred_info, HiddenPredFlag);
+  Yap_InitCPred("$uncaught_throw", 0, p_uncaught_throw, HiddenPredFlag);
 }
 

H/Heap.h

@@ -10,7 +10,7 @@
 * File:		Heap.h         						 *
 * mods:									 *
 * comments:	Heap Init Structure					 *
-* version:      $Id: Heap.h,v 1.71 2004-11-04 18:22:34 vsc Exp $	 *
+* version:      $Id: Heap.h,v 1.72 2004-11-19 21:32:53 vsc Exp $	 *
 *************************************************************************/
 
 /* information that can be stored in Code Space */
@@ -54,6 +54,7 @@ typedef struct worker_local_struct {
   UInt   i_pred_arity;
   yamop *prof_end;
   Int    start_line;
+  int    uncaught_throw;
   scratch_block scratchpad;
 #ifdef MULTI_ASSIGNMENT_VARIABLES
   Term   woken_goals;
@@ -65,7 +66,7 @@ typedef struct worker_local_struct {
   Int      tot_gc_time; /* total time spent in GC */
   Int      tot_gc_recovered; /* number of heap objects in all garbage collections */
   jmp_buf  gc_restore; /* where to jump if garbage collection crashes */
-  struct trail_frame *old_TR;
+  struct trail_frame *old_TR;  
   yamop trust_lu_code[3];
 } worker_local;
 
@@ -668,6 +669,7 @@ struct various_codes *heap_regs;
 #if defined(YAPOR) || defined(THREADS)
 #define  SignalLock               heap_regs->wl[worker_id].signal_lock
 #define  WPP                      heap_regs->wl[worker_id].wpp
+#define  UncaughtThrow            heap_regs->wl[worker_id].uncaught_throw
 #define  ActiveSignals            heap_regs->wl[worker_id].active_signals
 #define  DelayedTrace	          heap_regs->wl[worker_id].delayed_trace
 #define  IPredArity               heap_regs->wl[worker_id].i_pred_arity
@@ -690,6 +692,7 @@ struct various_codes *heap_regs;
 #define  DelayedTrace	          heap_regs->wl.delayed_trace
 #define  IPredArity               heap_regs->wl.i_pred_arity
 #define  ProfEnd                  heap_regs->wl.prof_end
+#define  UncaughtThrow            heap_regs->wl.uncaught_throw
 #define  StartLine                heap_regs->wl.start_line
 #define  ScratchPad               heap_regs->wl.scratchpad
 #ifdef  COROUTINING

pl/boot.yap

@@ -48,7 +48,7 @@ read_sig.
 '$init_system' :-
         % do catch as early as possible
 	(
-	 '$access_yap_flags'(15, 0) ->
+	 '$access_yap_flags'(15, 0), \+ '$uncaught_throw' ->
 	  '$version'
 	;
 	  true
@@ -1099,7 +1099,7 @@ throw(Ball) :-
 '$handle_throw'(_, _, _).
 '$handle_throw'(C, A, Ball) :-
         % reset info 
-	(C = Ball ->
+	(Ball \== '$abort', C = Ball ->
 	    '$execute'(A)
 	    ;
 	    throw(Ball)

pl/debug.yap

@@ -333,7 +333,7 @@ debugging :-
 '$loop_spy_event'('$fail_spy'(GoalNumber), _, _, _, _) :- !,
      throw('$fail_spy'(GoalNumber)).
 '$loop_spy_event'(abort, _, _, _, _) :- !,
-     throw(abort).
+     throw('$abort').
 '$loop_spy_event'(Event, GoalNumber, G, Module, InControl) :- !,
      '$system_catch'(
 		     ('$trace'(exception(Event),G,Module,GoalNumber),fail),

pl/errors.yap

@@ -11,8 +11,11 @@
 * File:		errors.yap						 *
 * comments:	error messages for YAP					 *
 *									 *
-* Last rev:     $Date: 2004-10-27 15:56:34 $,$Author: vsc $						 *
+* Last rev:     $Date: 2004-11-19 21:32:53 $,$Author: vsc $						 *
 * $Log: not supported by cvs2svn $
+* Revision 1.57  2004/10/27 15:56:34  vsc
+* bug fixes on memory overflows and on clauses :- fail being ignored by clause.
+*
 * Revision 1.56  2004/10/04 18:56:20  vsc
 * fixes for thread support
 * fix indexing bug (serious)
@@ -67,7 +70,7 @@
 '$process_error'(abort, top) :- !,
 	print_message(informational,abort(user)).
 '$process_error'(abort, _) :- !,
-	throw(abort).
+	throw('$abort').
 '$process_error'(error(Msg, Where), _) :- !,
 	'$set_fpu_exceptions',
 	'$print_message'(error,error(Msg, Where)).
@@ -113,7 +116,7 @@ print_message(Level, Mss) :-
 
 '$do_informational_message'(halt) :- !,
 	format(user_error, '% YAP execution halted~n', []).
-'$do_informational_message'(abort(_)) :- !,
+'$do_informational_message'('$abort') :- !,
 	format(user_error, '% YAP execution aborted~n', []).
 '$do_informational_message'(loading(_,user)) :- !.
 '$do_informational_message'(loading(What,AbsoluteFileName)) :- !,