X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=4369e4ae10c0f0d5e71a20ce8a3ae0ae2199e1f7;hb=582ed04c91818c6c9bf5b51c84f67b7c565925a7;hp=3608e6ab63bfe96809e1440af56857bd65532a3f;hpb=0a3788024daeeff27b99d9992ad4f1eb40663b1a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 3608e6a..4369e4a 100644
--- a/mg.c
+++ b/mg.c
@@ -25,6 +25,15 @@
 #  endif
 #endif
 
+/* if you only have signal() and it resets on each signal, FAKE_PERSISTENT_SIGNAL_HANDLERS fixes */
+#if !defined(HAS_SIGACTION) && defined(VMS)
+#  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);
 static void unwind_handler_stack(pTHX_ void *p);
 
@@ -776,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);
@@ -858,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);
@@ -911,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++;
@@ -985,6 +996,16 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
     return 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
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
@@ -997,8 +1018,14 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     	if(PL_psig_ptr[i])
     	    sv_setsv(sv,PL_psig_ptr[i]);
     	else {
-    	    Sighandler_t sigstate = rsignal_state(i);
-
+    	    Sighandler_t sigstate;
+    	    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");
@@ -1042,15 +1069,51 @@ Perl_raise_signal(pTHX_ int sig)
 Signal_t
 Perl_csighandler(int sig)
 {
+#ifndef PERL_OLD_SIGNALS
+    dTHX;
+#endif
+#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);
 #else
-    dTHX;
     Perl_raise_signal(aTHX_ 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)
 {
@@ -1093,6 +1156,15 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 		Perl_warner(aTHX_ WARN_SIGNAL, "No such signal: SIG%s", s);
 	    return 0;
 	}
+#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);
@@ -1109,14 +1181,26 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
     }
     s = SvPV_force(sv,len);
     if (strEQ(s,"IGNORE")) {
-	if (i)
+	if (i) {
+#ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
+	    sig_ignoring[i] = 1;
+	    (void)rsignal(i, &Perl_csighandler);
+#else
 	    (void)rsignal(i, SIG_IGN);
-	else
+#endif
+	} else
 	    *svp = 0;
     }
     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;
     }
@@ -1865,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)));
@@ -1878,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 '|':
 	{