From: Charles Lane Date: Thu, 29 Nov 2001 14:18:51 +0000 (-0500) Subject: VMS pre7 default signal handling X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2e34cc90b22e8d09149d579a4d5db71a1836c9ca;p=p5sagit%2Fp5-mst-13.2.git VMS pre7 default signal handling Message-Id: <011129141454.666c6@DUPHY4.Physics.Drexel.Edu> p4raw-id: //depot/perl@13371 --- diff --git a/mg.c b/mg.c index 84a63d0..2a80760 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 7ecb29f..fc2ae30 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 a21c9e3..573f254 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 ***);