diff --git a/C/errors.c b/C/errors.c index 7006e320d..5d5035aad 100644 --- a/C/errors.c +++ b/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)); - fun = Yap_MkFunctor(Yap_LookupAtom("abort"),2); + fprintf(stderr,"%% YAP execution aborted.\n"); + 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; diff --git a/C/exec.c b/C/exec.c index fc08e2cf7..c9c353cc5 100644 --- a/C/exec.c +++ b/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); } diff --git a/H/Heap.h b/H/Heap.h index 18137bd9d..1329cf42a 100644 --- a/H/Heap.h +++ b/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 diff --git a/pl/boot.yap b/pl/boot.yap index 1cc77f482..26dc4aac7 100644 --- a/pl/boot.yap +++ b/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) diff --git a/pl/debug.yap b/pl/debug.yap index b2b6841fd..db2c2593a 100644 --- a/pl/debug.yap +++ b/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), diff --git a/pl/errors.yap b/pl/errors.yap index 196a39c52..cf224f002 100644 --- a/pl/errors.yap +++ b/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)) :- !,