Provide infrastructure for PERL_ASYNC_CHECK() style safe signals.

Provides all the "cost" but no benefit yet - it is to allow cost
to be measured, and implementation experiments (just in mg.c?).

p4raw-id: //depot/perlio@8457

diff --git a/embed.h b/embed.h
index 81af43e..ce90e59 100644 (file)
--- 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 371ba58..9c10252 100755 (executable)
--- 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 fddcd12..205004c 100644 (file)
--- 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 8ee3f76..53389bf 100644 (file)
--- 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 e9c3797..c921904 100644 (file)
--- 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 9f05d3c..50136e2 100644 (file)
--- 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 4911e79..a5f4e68 100644 (file)
--- 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 19827a3..bbea5dd 100644 (file)
--- 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 a856dde..1912ccc 100644 (file)
--- 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 a8e849e..00b2ef0 100644 (file)
--- 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 3417924..54eb419 100644 (file)
--- 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 */