diff options
-rw-r--r-- | embed.fnc | 1 | ||||
-rw-r--r-- | embed.h | 1 | ||||
-rw-r--r-- | mg.c | 64 | ||||
-rw-r--r-- | proto.h | 2 |
4 files changed, 59 insertions, 9 deletions
@@ -1691,6 +1691,7 @@ ATp |Signal_t |csighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap Tp |Signal_t |sighandler |int sig ATp |Signal_t |csighandler |int sig #endif +ATp |Signal_t |perly_sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe Ap |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n Ap |I32 |start_subparse |I32 is_format|U32 flags Xp |void |init_named_cv |NN CV *cv|NN OP *nameop @@ -432,6 +432,7 @@ #define parse_stmtseq(a) Perl_parse_stmtseq(aTHX_ a) #define parse_subsignature(a) Perl_parse_subsignature(aTHX_ a) #define parse_termexpr(a) Perl_parse_termexpr(aTHX_ a) +#define perly_sighandler Perl_perly_sighandler #define pmop_dump(a) Perl_pmop_dump(aTHX_ a) #define pop_scope() Perl_pop_scope(aTHX) #define pregcomp(a,b) Perl_pregcomp(aTHX_ a,b) @@ -1533,11 +1533,20 @@ Perl_csighandler(int sig) (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)) /* Call the perl level handler now-- * with risk we may be in malloc() or being destructed etc. */ + { + if (PL_sighandlerp == Perl_sighandler) + /* default handler, so can call perly_sighandler() directly + * rather than via Perl_sighandler, passing the extra + * 'safe = false' arg + */ + Perl_perly_sighandler(sig, NULL, NULL, 1 /* XXX tmp safe */); + else #ifdef PERL_USE_3ARG_SIGHANDLER - (*PL_sighandlerp)(sig, NULL, NULL); + (*PL_sighandlerp)(sig, NULL, NULL); #else - (*PL_sighandlerp)(sig); + (*PL_sighandlerp)(sig); #endif + } else { if (!PL_psig_pend) return; /* Set a flag to say this signal is pending, that is awaiting delivery after @@ -1615,11 +1624,19 @@ Perl_despatch_signals(pTHX) } #endif PL_psig_pend[sig] = 0; + if (PL_sighandlerp == Perl_sighandler) + /* default handler, so can call perly_sighandler() directly + * rather than via Perl_sighandler, passing the extra + * 'safe = true' arg + */ + Perl_perly_sighandler(sig, NULL, NULL, 1 /* safe */); + else #ifdef PERL_USE_3ARG_SIGHANDLER - (*PL_sighandlerp)(sig, NULL, NULL); + (*PL_sighandlerp)(sig, NULL, NULL); #else - (*PL_sighandlerp)(sig); + (*PL_sighandlerp)(sig); #endif + #ifdef HAS_SIGPROCMASK if (!was_blocked) LEAVE; @@ -3319,12 +3336,35 @@ Perl_whichsig_pvn(pTHX_ const char *sig, STRLEN len) return -1; } -Signal_t #ifdef PERL_USE_3ARG_SIGHANDLER + +Signal_t Perl_sighandler(int sig, Siginfo_t *sip, void *uap) +{ + Perl_perly_sighandler(sig, sip, uap, 0); +} + #else + +Signal_t Perl_sighandler(int sig) +{ + Perl_perly_sighandler(sig, NULL, NULL, 0); +} + #endif + +/* Invoke the perl-level signal handler. This function is called either + * directly from one of the C-level signals handlers (Perl_sighandler or + * Perl_csighandler), or for safe signals, later from + * Perl_despatch_signals() at a suitable safe point during execution. + * + * 'safe' is a boolean indicating the latter call path. + */ + +Signal_t +Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, + void *uap PERL_UNUSED_DECL, bool safe) { #ifdef PERL_GET_SIG_CONTEXT dTHXa(PERL_GET_SIG_CONTEXT); @@ -3456,10 +3496,13 @@ Perl_sighandler(int sig) * blocked by the system when we entered. */ #ifdef HAS_SIGPROCMASK -#if defined(HAS_SIGACTION) && defined(SA_SIGINFO) - if (sip || uap) -#endif - { + if (!safe) { + /* safe signals called via dispatch_signals() set up a + * savestack destructor, unblock_sigmask(), to + * automatically unblock the handler at the end. If + * instead we get here directly, we have to do it + * ourselves + */ sigset_t set; sigemptyset(&set); sigaddset(&set,sig); @@ -3467,6 +3510,9 @@ Perl_sighandler(int sig) } #else /* Not clear if this will work */ + /* XXX not clear if this should be protected by 'if (safe)' + * too */ + (void)rsignal(sig, SIG_IGN); (void)rsignal(sig, PL_csighandlerp); #endif @@ -2647,6 +2647,8 @@ PERL_CALLCONV int perl_parse(PerlInterpreter *my_perl, XSINIT_t xsinit, int argc PERL_CALLCONV int perl_run(PerlInterpreter *my_perl); #define PERL_ARGS_ASSERT_PERL_RUN \ assert(my_perl) +PERL_CALLCONV Signal_t Perl_perly_sighandler(int sig, Siginfo_t *info, void *uap, bool safe); +#define PERL_ARGS_ASSERT_PERLY_SIGHANDLER PERL_CALLCONV void Perl_pmop_dump(pTHX_ PMOP* pm); #define PERL_ARGS_ASSERT_PMOP_DUMP PERL_CALLCONV OP* Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, UV flags, I32 floor); |