X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=4369e4ae10c0f0d5e71a20ce8a3ae0ae2199e1f7;hb=582ed04c91818c6c9bf5b51c84f67b7c565925a7;hp=109d32171a4f676365d5d17a92e435db85f081e2;hpb=85b332e26be39e8deb56070cb1034370beeee539;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 109d321..4369e4a 100644 --- a/mg.c +++ b/mg.c @@ -25,9 +25,13 @@ # endif #endif -/* if you only have signal() and it resets on each signal, SIGNAL_FIX fixes */ +/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */ #if !defined(HAS_SIGACTION) && defined(VMS) -# define SIGNAL_FIX +# define FAKE_PERSISTENT_SIGNAL_HANDLERS +#endif +/* if we're doing kill() with sys$sigprc on VMS, FAKE_DEFAULT_SIGNAL_HANDLERS */ +#if defined(KILL_BY_SIGPRC) +# define FAKE_DEFAULT_SIGNAL_HANDLERS #endif static void restore_magic(pTHX_ void *p); @@ -781,6 +785,8 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) case ',': break; case '\\': + if (PL_ors_sv) + sv_setpv(sv,SvPVX(PL_ors_sv)); break; case '#': sv_setpv(sv,PL_ofmt); @@ -863,7 +869,6 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) register char *s; char *ptr; STRLEN len, klen; - I32 i; s = SvPV(sv,len); ptr = MgPV(mg,klen); @@ -916,6 +921,7 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) while (s < strend) { char tmpbuf[256]; struct stat st; + I32 i; s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf, s, strend, ':', &i); s++; @@ -990,10 +996,15 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) return 0; } -#ifdef SIGNAL_FIX -static int sig_ignoring_initted = 0; +#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS)||defined(FAKE_DEFAULT_SIGNAL_HANDLERS) +static int sig_handlers_initted = 0; +#endif +#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS static int sig_ignoring[SIG_SIZE]; /* which signals we are ignoring */ #endif +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS +static int sig_defaulting[SIG_SIZE]; +#endif #ifndef PERL_MICRO int @@ -1008,13 +1019,13 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) sv_setsv(sv,PL_psig_ptr[i]); else { Sighandler_t sigstate; -#ifdef SIGNAL_FIX - if (sig_ignoring_initted && sig_ignoring[i]) - sigstate = SIG_IGN; - else -#endif sigstate = rsignal_state(i); - +#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS + if (sig_handlers_initted && sig_ignoring[i]) sigstate = SIG_IGN; +#endif +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + if (sig_handlers_initted && sig_defaulting[i]) sigstate = SIG_DFL; +#endif /* cache state so we don't fetch it again */ if(sigstate == SIG_IGN) sv_setpv(sv,"IGNORE"); @@ -1061,10 +1072,19 @@ Perl_csighandler(int sig) #ifndef PERL_OLD_SIGNALS dTHX; #endif -#ifdef SIGNAL_FIX +#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS (void) rsignal(sig, &Perl_csighandler); if (sig_ignoring[sig]) return; #endif +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + if (sig_defaulting[sig]) +#ifdef KILL_BY_SIGPRC + exit((Perl_sig_to_vmscondition(sig)&STS$M_COND_ID)|STS$K_SEVERE|STS$M_INHIB_MSG); +#else + exit(1); +#endif +#endif + #ifdef PERL_OLD_SIGNALS /* Call the perl level handler now with risk we may be in malloc() etc. */ (*PL_sighandlerp)(sig); @@ -1073,6 +1093,27 @@ Perl_csighandler(int sig) #endif } +#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) +void +Perl_csighandler_init(void) +{ + int sig; + if (sig_handlers_initted) return; + + for (sig = 1; sig < SIG_SIZE; sig++) { +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + dTHX; + sig_defaulting[sig] = 1; + (void) rsignal(sig, &Perl_csighandler); +#endif +#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS + sig_ignoring[sig] = 0; +#endif + } + sig_handlers_initted = 1; +} +#endif + void Perl_despatch_signals(pTHX) { @@ -1115,14 +1156,15 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s); return 0; } -#ifdef SIGNAL_FIX - if (!sig_ignoring_initted) { - int j; - for (j = 0; j < SIG_SIZE; j++) sig_ignoring[j] = 0; - sig_ignoring_initted = 1; - } +#if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) + if (!sig_handlers_initted) Perl_csighandler_init(); +#endif +#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS sig_ignoring[i] = 0; #endif +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + sig_defaulting[i] = 0; +#endif SvREFCNT_dec(PL_psig_name[i]); SvREFCNT_dec(PL_psig_ptr[i]); PL_psig_ptr[i] = SvREFCNT_inc(sv); @@ -1140,7 +1182,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) s = SvPV_force(sv,len); if (strEQ(s,"IGNORE")) { if (i) { -#ifdef SIGNAL_FIX +#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS sig_ignoring[i] = 1; (void)rsignal(i, &Perl_csighandler); #else @@ -1151,7 +1193,14 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) } else if (strEQ(s,"DEFAULT") || !*s) { if (i) +#ifdef FAKE_DEFAULT_SIGNAL_HANDLERS + { + sig_defaulting[i] = 1; + (void)rsignal(i, &Perl_csighandler); + } +#else (void)rsignal(i, SIG_DFL); +#endif else *svp = 0; } @@ -1900,7 +1949,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) SAVESPTR(PL_last_in_gv); } else if (SvOK(sv) && GvIO(PL_last_in_gv)) - IoLINES(GvIOp(PL_last_in_gv)) = (long)SvIV(sv); + IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv); break; case '^': Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); @@ -1913,15 +1962,15 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchpv(s,TRUE, SVt_PVIO); break; case '=': - IoPAGE_LEN(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '-': - IoLINES_LEFT(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L) IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L; break; case '%': - IoPAGE(GvIOp(PL_defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); + IoPAGE(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)); break; case '|': {