add PL_signalhook to hook into signal dispatch

This is initially intended for threads::shared and shouldn't (yet)
be considered part of the public API.

diff --git a/embedvar.h b/embedvar.h
index 609e107..428147f 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -273,6 +273,7 @@
 #define PL_sharehook           (vTHX->Isharehook)
 #define PL_sig_pending         (vTHX->Isig_pending)
 #define PL_sighandlerp         (vTHX->Isighandlerp)
+#define PL_signalhook          (vTHX->Isignalhook)
 #define PL_signals             (vTHX->Isignals)
 #define PL_slab_count          (vTHX->Islab_count)
 #define PL_slabs               (vTHX->Islabs)
@@ -601,6 +602,7 @@
 #define PL_Isharehook          PL_sharehook
 #define PL_Isig_pending                PL_sig_pending
 #define PL_Isighandlerp                PL_sighandlerp
+#define PL_Isignalhook         PL_signalhook
 #define PL_Isignals            PL_signals
 #define PL_Islab_count         PL_slab_count
 #define PL_Islabs              PL_slabs

diff --git a/intrpvar.h b/intrpvar.h
index bfa613c..eb398fc 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -655,6 +655,8 @@ PERLVARI(Iunlockhook,       share_proc_t,   MEMBER_TO_FPTR(PERL_UNLOCK_HOOK))
 
 PERLVARI(Ithreadhook,  thrhook_proc_t, MEMBER_TO_FPTR(Perl_nothreadhook))
 
+PERLVARI(Isignalhook,  despatch_signals_proc_t, MEMBER_TO_FPTR(Perl_despatch_signals))
+
 PERLVARI(Ihash_seed, UV, 0)            /* Hash initializer */
 
 PERLVARI(Irehash_seed, UV, 0)          /* 582 hash initializer */

diff --git a/perl.h b/perl.h
index c21aaa9..ea18d32 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4189,6 +4189,7 @@ typedef void (CPERLscope(*share_proc_t)) (pTHX_ SV *sv);
 typedef int  (CPERLscope(*thrhook_proc_t)) (pTHX);
 typedef OP* (CPERLscope(*PPADDR_t)[]) (pTHX);
 typedef bool (CPERLscope(*destroyable_proc_t)) (pTHX_ SV *sv);
+typedef void (CPERLscope(*despatch_signals_proc_t)) (pTHX);
 
 /* _ (for $_) must be first in the following list (DEFSV requires it) */
 #define THREADSV_NAMES "_123456789&`'+/.,\\\";^-%=|~:\001\005!@"
@@ -5677,7 +5678,7 @@ typedef struct am_table_short AMTS;
 
 #ifndef PERL_MICRO
 #      ifndef PERL_ASYNC_CHECK
-#              define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
+#              define PERL_ASYNC_CHECK() if (PL_sig_pending) CALL_FPTR(PL_signalhook)(aTHX)
 #      endif
 #endif
 

diff --git a/perlapi.h b/perlapi.h
index 5b7c50b..506d72c 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -582,6 +582,8 @@ END_EXTERN_C
 #define PL_sig_pending         (*Perl_Isig_pending_ptr(aTHX))
 #undef  PL_sighandlerp
 #define PL_sighandlerp         (*Perl_Isighandlerp_ptr(aTHX))
+#undef  PL_signalhook
+#define PL_signalhook          (*Perl_Isignalhook_ptr(aTHX))
 #undef  PL_signals
 #define PL_signals             (*Perl_Isignals_ptr(aTHX))
 #undef  PL_slab_count

diff --git a/sv.c b/sv.c
index cb85ca6..c9e6f9e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12451,6 +12451,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_unlockhook      = proto_perl->Iunlockhook;
     PL_threadhook      = proto_perl->Ithreadhook;
     PL_destroyhook     = proto_perl->Idestroyhook;
+    PL_signalhook      = proto_perl->Isignalhook;
 
 #ifdef THREADS_HAVE_PIDS
     PL_ppid            = proto_perl->Ippid;