summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embed.h4
-rwxr-xr-xembed.pl1
-rw-r--r--embedvar.h8
-rw-r--r--gv.c1
-rw-r--r--intrpvar.h4
-rw-r--r--mg.c9
-rw-r--r--perl.c5
-rw-r--r--perl.h5
-rw-r--r--perlapi.h4
-rw-r--r--proto.h1
-rw-r--r--sv.c2
11 files changed, 42 insertions, 2 deletions
diff --git a/embed.h b/embed.h
index 81af43e037..ce90e598af 100644
--- a/embed.h
+++ b/embed.h
@@ -518,6 +518,7 @@
#define call_method Perl_call_method
#define call_pv Perl_call_pv
#define call_sv Perl_call_sv
+#define despatch_signals Perl_despatch_signals
#define eval_pv Perl_eval_pv
#define eval_sv Perl_eval_sv
#define get_sv Perl_get_sv
@@ -1995,6 +1996,7 @@
#define call_method(a,b) Perl_call_method(aTHX_ a,b)
#define call_pv(a,b) Perl_call_pv(aTHX_ a,b)
#define call_sv(a,b) Perl_call_sv(aTHX_ a,b)
+#define despatch_signals() Perl_despatch_signals(aTHX)
#define eval_pv(a,b) Perl_eval_pv(aTHX_ a,b)
#define eval_sv(a,b) Perl_eval_sv(aTHX_ a,b)
#define get_sv(a,b) Perl_get_sv(aTHX_ a,b)
@@ -3910,6 +3912,8 @@
#define call_pv Perl_call_pv
#define Perl_call_sv CPerlObj::Perl_call_sv
#define call_sv Perl_call_sv
+#define Perl_despatch_signals CPerlObj::Perl_despatch_signals
+#define despatch_signals Perl_despatch_signals
#define Perl_eval_pv CPerlObj::Perl_eval_pv
#define eval_pv Perl_eval_pv
#define Perl_eval_sv CPerlObj::Perl_eval_sv
diff --git a/embed.pl b/embed.pl
index 371ba583bb..9c1025295f 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1848,6 +1848,7 @@ Apd |I32 |call_argv |const char* sub_name|I32 flags|char** argv
Apd |I32 |call_method |const char* methname|I32 flags
Apd |I32 |call_pv |const char* sub_name|I32 flags
Apd |I32 |call_sv |SV* sv|I32 flags
+p |void |despatch_signals
Apd |SV* |eval_pv |const char* p|I32 croak_on_error
Apd |I32 |eval_sv |SV* sv|I32 flags
Apd |SV* |get_sv |const char* name|I32 create
diff --git a/embedvar.h b/embedvar.h
index fddcd12733..205004ca1f 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -355,6 +355,7 @@
#define PL_preprocess (PERL_GET_INTERP->Ipreprocess)
#define PL_profiledata (PERL_GET_INTERP->Iprofiledata)
#define PL_psig_name (PERL_GET_INTERP->Ipsig_name)
+#define PL_psig_pend (PERL_GET_INTERP->Ipsig_pend)
#define PL_psig_ptr (PERL_GET_INTERP->Ipsig_ptr)
#define PL_ptr_table (PERL_GET_INTERP->Iptr_table)
#define PL_replgv (PERL_GET_INTERP->Ireplgv)
@@ -363,6 +364,7 @@
#define PL_runops (PERL_GET_INTERP->Irunops)
#define PL_sawampersand (PERL_GET_INTERP->Isawampersand)
#define PL_sh_path (PERL_GET_INTERP->Ish_path)
+#define PL_sig_pending (PERL_GET_INTERP->Isig_pending)
#define PL_sighandlerp (PERL_GET_INTERP->Isighandlerp)
#define PL_splitstr (PERL_GET_INTERP->Isplitstr)
#define PL_srand_called (PERL_GET_INTERP->Isrand_called)
@@ -634,6 +636,7 @@
#define PL_preprocess (vTHX->Ipreprocess)
#define PL_profiledata (vTHX->Iprofiledata)
#define PL_psig_name (vTHX->Ipsig_name)
+#define PL_psig_pend (vTHX->Ipsig_pend)
#define PL_psig_ptr (vTHX->Ipsig_ptr)
#define PL_ptr_table (vTHX->Iptr_table)
#define PL_replgv (vTHX->Ireplgv)
@@ -642,6 +645,7 @@
#define PL_runops (vTHX->Irunops)
#define PL_sawampersand (vTHX->Isawampersand)
#define PL_sh_path (vTHX->Ish_path)
+#define PL_sig_pending (vTHX->Isig_pending)
#define PL_sighandlerp (vTHX->Isighandlerp)
#define PL_splitstr (vTHX->Isplitstr)
#define PL_srand_called (vTHX->Isrand_called)
@@ -1049,6 +1053,7 @@
#define PL_preprocess (aTHXo->interp.Ipreprocess)
#define PL_profiledata (aTHXo->interp.Iprofiledata)
#define PL_psig_name (aTHXo->interp.Ipsig_name)
+#define PL_psig_pend (aTHXo->interp.Ipsig_pend)
#define PL_psig_ptr (aTHXo->interp.Ipsig_ptr)
#define PL_ptr_table (aTHXo->interp.Iptr_table)
#define PL_replgv (aTHXo->interp.Ireplgv)
@@ -1057,6 +1062,7 @@
#define PL_runops (aTHXo->interp.Irunops)
#define PL_sawampersand (aTHXo->interp.Isawampersand)
#define PL_sh_path (aTHXo->interp.Ish_path)
+#define PL_sig_pending (aTHXo->interp.Isig_pending)
#define PL_sighandlerp (aTHXo->interp.Isighandlerp)
#define PL_splitstr (aTHXo->interp.Isplitstr)
#define PL_srand_called (aTHXo->interp.Isrand_called)
@@ -1329,6 +1335,7 @@
#define PL_Ipreprocess PL_preprocess
#define PL_Iprofiledata PL_profiledata
#define PL_Ipsig_name PL_psig_name
+#define PL_Ipsig_pend PL_psig_pend
#define PL_Ipsig_ptr PL_psig_ptr
#define PL_Iptr_table PL_ptr_table
#define PL_Ireplgv PL_replgv
@@ -1337,6 +1344,7 @@
#define PL_Irunops PL_runops
#define PL_Isawampersand PL_sawampersand
#define PL_Ish_path PL_sh_path
+#define PL_Isig_pending PL_sig_pending
#define PL_Isighandlerp PL_sighandlerp
#define PL_Isplitstr PL_splitstr
#define PL_Isrand_called PL_srand_called
diff --git a/gv.c b/gv.c
index 8ee3f763c1..53389bfdae 100644
--- a/gv.c
+++ b/gv.c
@@ -753,6 +753,7 @@ Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type)
int sig_num[] = { SIG_NUM };
New(73, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
New(73, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ New(73, PL_psig_pend, sizeof(sig_num)/sizeof(*sig_num), int);
}
GvMULTI_on(gv);
hv = GvHVn(gv);
diff --git a/intrpvar.h b/intrpvar.h
index e9c3797be7..c9219041cc 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -464,6 +464,10 @@ PERLVAR(Ixpvlv_arenaroot,XPVLV*) /* list of allocated xpvlv areas */
PERLVAR(Ixpvbm_arenaroot,XPVBM*) /* list of allocated xpvbm areas */
PERLVAR(Ihe_arenaroot, XPV*) /* list of allocated he areas */
+PERLVAR(Ipsig_pend, int *) /* per-signal "count" of pending */
+PERLVARI(Isig_pending, int,0) /* Number if highest signal pending */
+
+
/* New variables must be added to the very end for binary compatibility.
* XSUB.h provides wrapper functions via perlapi.h that make this
* irrelevant, but not all code may be expected to #include XSUB.h. */
diff --git a/mg.c b/mg.c
index 9f05d3c2c4..50136e2bae 100644
--- a/mg.c
+++ b/mg.c
@@ -2145,6 +2145,15 @@ Perl_whichsig(pTHX_ char *sig)
return 0;
}
+void
+Perl_despatch_signals(pTHX)
+{
+#ifndef PERL_OLD_SIGNALS
+ /* This is just a dummy for now */
+#endif
+ PL_sig_pending = 0;
+}
+
static SV* sig_sv;
Signal_t
diff --git a/perl.c b/perl.c
index 4911e79f3e..a5f4e68b6b 100644
--- a/perl.c
+++ b/perl.c
@@ -724,6 +724,7 @@ perl_destruct(pTHXx)
Safefree(PL_op_mask);
Safefree(PL_psig_ptr);
Safefree(PL_psig_name);
+ Safefree(PL_psig_pend);
nuke_stacks();
PL_hints = 0; /* Reset hints. Should hints be per-interpreter ? */
@@ -789,12 +790,12 @@ perl_free(pTHXx)
# if defined(PERL_IMPLICIT_SYS)
void *host = w32_internal_host;
if (PerlProc_lasthost()) {
- PerlIO_cleanup();
+ PerlIO_cleanup();
}
PerlMem_free(aTHXx);
win32_delete_internal_host(host);
#else
- PerlIO_cleanup();
+ PerlIO_cleanup();
PerlMem_free(aTHXx);
#endif
# else
diff --git a/perl.h b/perl.h
index 19827a3101..bbea5dddd3 100644
--- a/perl.h
+++ b/perl.h
@@ -3338,6 +3338,11 @@ typedef struct am_table_short AMTS;
* Keep this check simple, or it may slow down execution
* massively.
*/
+
+#ifndef PERL_OLD_SIGNALS
+#define PERL_ASYNC_CHECK() if (PL_sig_pending) despatch_signals()
+#endif
+
#ifndef PERL_ASYNC_CHECK
#define PERL_ASYNC_CHECK() NOOP
#endif
diff --git a/perlapi.h b/perlapi.h
index a856dde94e..1912cccf92 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -450,6 +450,8 @@ START_EXTERN_C
#define PL_profiledata (*Perl_Iprofiledata_ptr(aTHXo))
#undef PL_psig_name
#define PL_psig_name (*Perl_Ipsig_name_ptr(aTHXo))
+#undef PL_psig_pend
+#define PL_psig_pend (*Perl_Ipsig_pend_ptr(aTHXo))
#undef PL_psig_ptr
#define PL_psig_ptr (*Perl_Ipsig_ptr_ptr(aTHXo))
#undef PL_ptr_table
@@ -466,6 +468,8 @@ START_EXTERN_C
#define PL_sawampersand (*Perl_Isawampersand_ptr(aTHXo))
#undef PL_sh_path
#define PL_sh_path (*Perl_Ish_path_ptr(aTHXo))
+#undef PL_sig_pending
+#define PL_sig_pending (*Perl_Isig_pending_ptr(aTHXo))
#undef PL_sighandlerp
#define PL_sighandlerp (*Perl_Isighandlerp_ptr(aTHXo))
#undef PL_splitstr
diff --git a/proto.h b/proto.h
index a8e849e941..00b2ef0246 100644
--- a/proto.h
+++ b/proto.h
@@ -591,6 +591,7 @@ PERL_CALLCONV I32 Perl_call_argv(pTHX_ const char* sub_name, I32 flags, char** a
PERL_CALLCONV I32 Perl_call_method(pTHX_ const char* methname, I32 flags);
PERL_CALLCONV I32 Perl_call_pv(pTHX_ const char* sub_name, I32 flags);
PERL_CALLCONV I32 Perl_call_sv(pTHX_ SV* sv, I32 flags);
+PERL_CALLCONV void Perl_despatch_signals(pTHX);
PERL_CALLCONV SV* Perl_eval_pv(pTHX_ const char* p, I32 croak_on_error);
PERL_CALLCONV I32 Perl_eval_sv(pTHX_ SV* sv, I32 flags);
PERL_CALLCONV SV* Perl_get_sv(pTHX_ const char* name, I32 create);
diff --git a/sv.c b/sv.c
index 341792412b..54eb4193b0 100644
--- a/sv.c
+++ b/sv.c
@@ -8869,6 +8869,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
int sig_num[] = { SIG_NUM };
Newz(0, PL_psig_ptr, sizeof(sig_num)/sizeof(*sig_num), SV*);
Newz(0, PL_psig_name, sizeof(sig_num)/sizeof(*sig_num), SV*);
+ Newz(0, PL_psig_pend, sizeof(sig_num)/sizeof(*sig_num), int*);
for (i = 1; PL_sig_name[i]; i++) {
PL_psig_ptr[i] = sv_dup_inc(proto_perl->Ipsig_ptr[i]);
PL_psig_name[i] = sv_dup_inc(proto_perl->Ipsig_name[i]);
@@ -8877,6 +8878,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
else {
PL_psig_ptr = (SV**)NULL;
PL_psig_name = (SV**)NULL;
+ PL_psig_pend = (int*)NULL;
}
/* thrdvar.h stuff */