VMS pre7 default signal handling

Message-Id: <011129141454.666c6@DUPHY4.Physics.Drexel.Edu>

p4raw-id: //depot/perl@13371

3 files changed, 85 insertions, 20 deletions

diff --git a/mg.c b/mg.c
index 84a63d0ee6..2a80760722 100644
--- a/mg.c
+++ b/mg.c
@@ -29,6 +29,10 @@
 #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);
@@ -992,10 +996,15 @@ 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_initted = 0;
 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
@@ -1010,13 +1019,13 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
     	    sv_setsv(sv,PL_psig_ptr[i]);
     	else {
     	    Sighandler_t sigstate;
+    	    sigstate = rsignal_state(i);
 #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS
-    	    if (sig_ignoring_initted && sig_ignoring[i]) 
-    	      sigstate = SIG_IGN;
-    	    else
+    	    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
-    	    sigstate = rsignal_state(i);
-
     	    /* cache state so we don't fetch it again */
     	    if(sigstate == SIG_IGN)
     	    	sv_setpv(sv,"IGNORE");
@@ -1067,6 +1076,15 @@ Perl_csighandler(int sig)
     (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);
@@ -1075,6 +1093,26 @@ 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
+        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)
 {
@@ -1117,14 +1155,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
-	if (!sig_ignoring_initted) {
-	    int j;
-	    for (j = 0; j < SIG_SIZE; j++) sig_ignoring[j] = 0;
-	    sig_ignoring_initted = 1;
-	}
 	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);
@@ -1153,7 +1192,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;
     }
diff --git a/vms/vms.c b/vms/vms.c
index 7ecb29fed5..fc2ae303f1 100644
--- a/vms/vms.c
+++ b/vms/vms.c
@@ -1125,14 +1125,10 @@ Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act,
 
 #define _MY_SIG_MAX 17
 
-int
-Perl_my_kill(int pid, int sig)
+unsigned int
+Perl_sig_to_vmscondition(int sig)
 {
-    int iss;
-    int sys$sigprc(unsigned int *pidadr,
-                     struct dsc$descriptor_s *prcname,
-                     unsigned int code);
-    static unsigned long sig_code[_MY_SIG_MAX+1] = 
+    static unsigned int sig_code[_MY_SIG_MAX+1] = 
     {
         0,                  /*  0 ZERO     */
         SS$_HANGUP,         /*  1 SIGHUP   */
@@ -1167,11 +1163,28 @@ Perl_my_kill(int pid, int sig)
     }
 #endif
 
-    if (!pid || sig < _SIG_MIN || sig > _SIG_MAX || sig > _MY_SIG_MAX || !sig_code[sig]) {
+    if (sig < _SIG_MIN) return 0;
+    if (sig > _MY_SIG_MAX) return 0;
+    return sig_code[sig];
+}
+
+
+int
+Perl_my_kill(int pid, int sig)
+{
+    int iss;
+    unsigned int code;
+    int sys$sigprc(unsigned int *pidadr,
+                     struct dsc$descriptor_s *prcname,
+                     unsigned int code);
+
+    code = Perl_sig_to_vmscondition(sig);
+
+    if (!pid || !code) {
         return -1;
     }
 
-    iss = sys$sigprc((unsigned int *)&pid,0,sig_code[sig]);
+    iss = sys$sigprc((unsigned int *)&pid,0,code);
     if (iss&1) return 0;
 
     switch (iss) {
@@ -4387,6 +4400,10 @@ vms_image_init(int *argcp, char ***argvp)
                                  { sizeof rsz, JPI$_RIGHTS_SIZE, &rsz, &dummy},
                                  {          0,                0,    0,      0} };
 
+#ifdef KILL_BY_SIGPRC
+    (void) Perl_csighandler_init();
+#endif
+
   _ckvmssts_noperl(sys$getjpiw(0,NULL,NULL,jpilist,iosb,NULL,NULL));
   _ckvmssts_noperl(iosb[0]);
   for (i = 0; i < sizeof iprv / sizeof(unsigned long int); i++) {
diff --git a/vms/vmsish.h b/vms/vmsish.h
index a21c9e3982..573f254cb8 100644
--- a/vms/vmsish.h
+++ b/vms/vmsish.h
@@ -773,7 +773,9 @@ FILE *	Perl_my_tmpfile ();
 int	Perl_my_sigaction (pTHX_ int, const struct sigaction*, struct sigaction*);
 #endif
 #ifdef KILL_BY_SIGPRC
+unsigned int	Perl_sig_to_vmscondition (int);
 int	Perl_my_kill (int, int);
+void	Perl_csighandler_init (void);
 #endif
 int	Perl_my_utime (pTHX_ char *, struct utimbuf *);
 void	Perl_vms_image_init (int *, char ***);