From 7f54acb5361af2f8143ab325317af5d7be3421b3 Mon Sep 17 00:00:00 2001 From: Costa Vitor Date: Wed, 3 Jun 2009 10:09:14 -0500 Subject: [PATCH 1/5] separate standard alarm from virtual alarm. timeout uses virtual alarm #112 --- C/exec.c | 2 +- C/sysbits.c | 27 +++++++++++++++++++++++++++ H/Yap.h | 3 ++- H/iatoms.h | 1 + H/ratoms.h | 1 + H/tatoms.h | 2 ++ library/hacks.yap | 6 +++--- misc/ATOMS | 1 + pl/signals.yap | 2 ++ 9 files changed, 40 insertions(+), 5 deletions(-) diff --git a/C/exec.c b/C/exec.c index 311b7f210..b7c7a8851 100644 --- a/C/exec.c +++ b/C/exec.c @@ -1497,9 +1497,9 @@ clean_trail(Term t, Term t0) } else { Bind(pt, t); Yap_WakeUp(pt); + return; } } - return; } pt1--; } else if (IsApplTerm(d1)) { diff --git a/C/sysbits.c b/C/sysbits.c index 0a894dd67..ae524c875 100644 --- a/C/sysbits.c +++ b/C/sysbits.c @@ -1563,6 +1563,24 @@ HandleALRM(int s) #endif +#if !defined(_WIN32) +/* this routine is called if the system activated the alarm */ +static RETSIGTYPE +#if (defined(__svr4__) || defined(__SVR4)) +HandleVTALRM (int s, siginfo_t *x, ucontext_t *y) +#else +HandleVTALRM(int s) +#endif +{ + my_signal (SIGVTALRM, HandleVTALRM); + /* force the system to creep */ + Yap_signal (YAP_VTALARM_SIGNAL); + /* now, say what is going on */ + Yap_PutValue(AtomAlarm, MkAtomTerm(AtomTrue)); +} +#endif + + /* * This function is called after a normal interrupt had been caught. * It allows 6 possibilities: abort, continue, trace, debug, help, exit. @@ -1651,6 +1669,7 @@ InitSignals (void) my_signal (SIGUSR2, ReceiveSignal); my_signal (SIGHUP, ReceiveSignal); my_signal (SIGALRM, HandleALRM); + my_signal (SIGVTALRM, HandleVTALRM); #endif #ifdef SIGPIPE my_signal (SIGPIPE, ReceiveSignal); @@ -2779,6 +2798,11 @@ p_first_signal(void) UNLOCK(SignalLock); return Yap_unify(ARG1, MkAtomTerm(AtomSigAlarm)); } + if (ActiveSignals & YAP_VTALARM_SIGNAL) { + ActiveSignals &= ~YAP_VTALARM_SIGNAL; + UNLOCK(SignalLock); + return Yap_unify(ARG1, MkAtomTerm(AtomSigVTAlarm)); + } if (ActiveSignals & YAP_DELAY_CREEP_SIGNAL) { ActiveSignals &= ~(YAP_CREEP_SIGNAL|YAP_DELAY_CREEP_SIGNAL); #ifdef THREADS @@ -2864,6 +2888,9 @@ p_continue_signals(void) if (ActiveSignals & YAP_ALARM_SIGNAL) { Yap_signal(YAP_ALARM_SIGNAL); } + if (ActiveSignals & YAP_VTALARM_SIGNAL) { + Yap_signal(YAP_VTALARM_SIGNAL); + } if (ActiveSignals & YAP_CREEP_SIGNAL) { Yap_signal(YAP_CREEP_SIGNAL); } diff --git a/H/Yap.h b/H/Yap.h index 64156f425..4e34f2b5a 100644 --- a/H/Yap.h +++ b/H/Yap.h @@ -578,7 +578,8 @@ typedef enum YAP_STATISTICS_SIGNAL = 0x8000, /* received statistics */ 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_PIPE_SIGNAL = 0x40000, /* call atom garbage collector asap */ + YAP_VTALARM_SIGNAL = 0x80000 /* received SIGVTALARM */ } yap_signals; #define NUMBER_OF_YAP_FLAGS LAST_FLAG diff --git a/H/iatoms.h b/H/iatoms.h index b6b54be00..77010f735 100644 --- a/H/iatoms.h +++ b/H/iatoms.h @@ -238,6 +238,7 @@ AtomSigTrace = Yap_LookupAtom("sig_trace"); AtomSigUsr1 = Yap_LookupAtom("sig_usr1"); AtomSigUsr2 = Yap_LookupAtom("sig_usr2"); + AtomSigVTAlarm = Yap_LookupAtom("sig_vtalarm"); AtomSigWakeUp = Yap_LookupAtom("sig_wake_up"); AtomSlash = Yap_LookupAtom("/"); AtomSocket = Yap_LookupAtom("socket"); diff --git a/H/ratoms.h b/H/ratoms.h index 2da5050ce..ee5772999 100644 --- a/H/ratoms.h +++ b/H/ratoms.h @@ -240,6 +240,7 @@ AtomSigTrace = AtomAdjust(AtomSigTrace); AtomSigUsr1 = AtomAdjust(AtomSigUsr1); AtomSigUsr2 = AtomAdjust(AtomSigUsr2); + AtomSigVTAlarm = AtomAdjust(AtomSigVTAlarm); AtomSigWakeUp = AtomAdjust(AtomSigWakeUp); AtomSlash = AtomAdjust(AtomSlash); AtomSocket = AtomAdjust(AtomSocket); diff --git a/H/tatoms.h b/H/tatoms.h index 8ba2889e6..879829aca 100644 --- a/H/tatoms.h +++ b/H/tatoms.h @@ -482,6 +482,8 @@ #define AtomSigUsr1 Yap_heap_regs->AtomSigUsr1_ Atom AtomSigUsr2_; #define AtomSigUsr2 Yap_heap_regs->AtomSigUsr2_ + Atom AtomSigVTAlarm_; +#define AtomSigVTAlarm Yap_heap_regs->AtomSigVTAlarm_ Atom AtomSigWakeUp_; #define AtomSigWakeUp Yap_heap_regs->AtomSigWakeUp_ Atom AtomSlash_; diff --git a/library/hacks.yap b/library/hacks.yap index 3b22640aa..445882b29 100644 --- a/library/hacks.yap +++ b/library/hacks.yap @@ -39,13 +39,13 @@ run_formats([Com-Args|StackInfo], Stream) :- virtual_alarm(Interval, Goal, Left) :- Interval == 0, !, virtual_alarm(0, 0, Left0, _), - on_signal(sig_alarm, _, Goal), + on_signal(sig_vtalarm, _, Goal), Left = Left0. virtual_alarm(Interval, Goal, Left) :- integer(Interval), !, - on_signal(sig_alarm, _, Goal), + on_signal(sig_vtalarm, _, Goal), virtual_alarm(Interval, 0, Left, _). virtual_alarm(Interval.USecs, Goal, Left.LUSecs) :- - on_signal(sig_alarm, _, Goal), + on_signal(sig_vtalarm, _, Goal), virtual_alarm(Interval, USecs, Left, LUSecs). diff --git a/misc/ATOMS b/misc/ATOMS index c06a650e3..2fac16546 100644 --- a/misc/ATOMS +++ b/misc/ATOMS @@ -249,6 +249,7 @@ A SigStatistics N "sig_statistic" A SigTrace N "sig_trace" A SigUsr1 N "sig_usr1" A SigUsr2 N "sig_usr2" +A SigVTAlarm N "sig_vtalarm" A SigWakeUp N "sig_wake_up" A Slash N "/" A Socket N "socket" diff --git a/pl/signals.yap b/pl/signals.yap index cfc9ca572..c44270975 100644 --- a/pl/signals.yap +++ b/pl/signals.yap @@ -96,6 +96,8 @@ % Unix signals '$do_signal'(sig_alarm, G) :- '$signal_handler'(sig_alarm, G). +'$do_signal'(sig_vtalarm, G) :- + '$signal_handler'(sig_vtalarm, G). '$do_signal'(sig_hup, G) :- '$signal_handler'(sig_hup, G). '$do_signal'(sig_usr1, G) :- From 8a20da66398335f08e143828f2798d7b7fb0892d Mon Sep 17 00:00:00 2001 From: Costa Vitor Date: Wed, 3 Jun 2009 10:11:41 -0500 Subject: [PATCH 2/5] fix clean_call handling by top level (regression #110) --- pl/corout.yap | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pl/corout.yap b/pl/corout.yap index f9ac3e8e8..f59023dbc 100644 --- a/pl/corout.yap +++ b/pl/corout.yap @@ -518,7 +518,7 @@ frozen(V, LG) :- '$purge_done_goals'(['$redo_freeze'(_Done, _, CallCleanup)|G0], GF) :- nonvar(CallCleanup), % be careful about possibly adding extra binding at this point. - CallCleanup = _:T, nonvar(T), T = '$clean_call'(_), !, + CallCleanup = _:T, nonvar(T), T = '$clean_call'(_,_), !, '$purge_done_goals'(G0, GF). '$purge_done_goals'(['$redo_eq'(Done, _, _, _)|G0], GF) :- nonvar(Done), !, '$purge_done_goals'(G0, GF). @@ -764,7 +764,7 @@ call_residue(Goal,Residue) :- '$attgoals_for_prolog'(AllAtts, V, DonesSoFar, MoreDonesSoFar, GoalListI, GoalList0). '$attgoal_for_prolog'('$redo_dif'(Done, X, Y), Done, prolog:dif(X,Y)). -'$attgoal_for_prolog'('$redo_freeze'(_, _, _:'$clean_call'(_)), _, _) :- !, fail. +'$attgoal_for_prolog'('$redo_freeze'(_, _, _:'$clean_call'(_,_)), _, _) :- !, fail. '$attgoal_for_prolog'('$redo_freeze'(Done, V, Goal), Done, prolog:freeze(V,Goal)). '$attgoal_for_prolog'('$redo_eq'(Done, X, Y, Goal), Done, prolog:when(X=Y,Goal)). '$attgoal_for_prolog'('$redo_ground'(Done, X, Goal), Done, prolog:when(ground(X),Goal)). From efb72f7d0e757088daaf0b1a6fcd8900c17ed0d2 Mon Sep 17 00:00:00 2001 From: Costa Vitor Date: Wed, 3 Jun 2009 10:25:21 -0500 Subject: [PATCH 3/5] make sure we send unsigned chars to writing routine (obs from Simon Strobl) --- C/write.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/C/write.c b/C/write.c index f9ac76810..5d3b44c06 100644 --- a/C/write.c +++ b/C/write.c @@ -119,7 +119,7 @@ static void wrputs(char *s, wrf writewch) /* writes a string */ { while (*s) { - wrputc(*s++, writewch); + wrputc((unsigned char)(*s++), writewch); } } From 51d1c442d66d1e99e03c35cbd9133423606cd200 Mon Sep 17 00:00:00 2001 From: Costa Vitor Date: Wed, 3 Jun 2009 10:43:40 -0500 Subject: [PATCH 4/5] fix not_empty_list #92 --- pl/messages.yap | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pl/messages.yap b/pl/messages.yap index 2a87e915c..79261d37e 100644 --- a/pl/messages.yap +++ b/pl/messages.yap @@ -316,7 +316,7 @@ domain_error(mutable, Opt) --> !, [ 'invalid id mutable ~w' - [Opt] ]. domain_error(module_decl_options, Opt) --> !, [ 'expect module declaration options, found ~w' - [Opt] ]. -domain_error(not_empty_list, Opt) --> !, +domain_error(non_empty_list, Opt) --> !, [ 'found empty list' - [Opt] ]. domain_error(not_less_than_zero, Opt) --> !, [ 'number ~w less than zero' - [Opt] ]. From 5da51d615d89b2db82b13679c1a5fe43bb2be6d2 Mon Sep 17 00:00:00 2001 From: Costa Vitor Date: Wed, 3 Jun 2009 15:27:53 -0500 Subject: [PATCH 5/5] fix crashes in 64-bit mode with unknown predicates. --- C/globals.c | 2 +- H/Yapproto.h | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/C/globals.c b/C/globals.c index 3255a80db..bd3b35820 100644 --- a/C/globals.c +++ b/C/globals.c @@ -1174,7 +1174,7 @@ p_nb_linkval(void) return TRUE; } -int +Term Yap_SetGlobalVal(Atom at, Term t0) { Term to; diff --git a/H/Yapproto.h b/H/Yapproto.h index 5882a592e..21914c2db 100644 --- a/H/Yapproto.h +++ b/H/Yapproto.h @@ -188,7 +188,7 @@ void STD_PROTO(Yap_inform_profiler_of_clause,(struct yami *,struct yami *,struct /* globals.c */ Term STD_PROTO(Yap_NewArena,(UInt,CELL *)); void STD_PROTO(Yap_InitGlobals,(void)); -int STD_PROTO(Yap_SetGlobalVal, (Atom, Term)); +Term STD_PROTO(Yap_SetGlobalVal, (Atom, Term)); void STD_PROTO(Yap_AllocateDefaultArena, (Int, Int)); /* grow.c */