From: Nick Ing-Simmons Date: Tue, 16 Jan 2001 22:07:26 +0000 (+0000) Subject: Provide infrastructure for PERL_ASYNC_CHECK() style safe signals. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ce08f86c8b1d404b3d9fec75a102b8cd65f8766a;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 */