From: David Mitchell <davem@iabyn.com>
Date: Fri, 4 Jun 2010 15:18:05 +0000 (+0100)
Subject: add PL_signalhook to hook into signal dispatch
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92f022bbf8c129c6f2379a382f1eaaa5c7bd9f3f;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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;