Message-ID: <f1gj4usu5m76bv88a3ldptnmo6ld7d44ri@4ax.com>
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index 109d321..c7ebca3 100644 (file)
--- a/mg.c
+++ b/mg.c
  * come here, and I don't want to see no more magic,' he said, and fell silent."
  */
 
+/*
+=head1 Magical Functions
+*/
+
 #include "EXTERN.h"
 #define PERL_IN_MG_C
 #include "perl.h"
 #  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);
@@ -450,6 +458,14 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
                    Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
                return i;
            }
+           else {
+               if (ckWARN(WARN_UNINITIALIZED))
+                   report_uninit();
+           }
+       }
+       else {
+           if (ckWARN(WARN_UNINITIALIZED))
+               report_uninit();
        }
        return 0;
     case '+':
@@ -781,6 +797,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 +881,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 +933,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 +1008,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 +1031,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");
@@ -1058,13 +1081,24 @@ Perl_raise_signal(pTHX_ int sig)
 Signal_t
 Perl_csighandler(int sig)
 {
-#ifndef PERL_OLD_SIGNALS
+#ifdef PERL_GET_SIG_CONTEXT
+    dTHXa(PERL_GET_SIG_CONTEXT);
+#else
     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 +1107,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 +1170,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 +1196,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 +1207,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 +1963,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 +1976,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 '|':
        {
@@ -2257,8 +2320,8 @@ static SV* sig_sv;
 Signal_t
 Perl_sighandler(int sig)
 {
-#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
-    dTHXa(PL_curinterp);       /* fake TLS, because signals don't do TLS */
+#ifdef PERL_GET_SIG_CONTEXT
+    dTHXa(PERL_GET_SIG_CONTEXT);
 #else
     dTHX;
 #endif
@@ -2271,10 +2334,6 @@ Perl_sighandler(int sig)
     U32 flags = 0;
     XPV *tXpv = PL_Xpv;
 
-#if defined(WIN32) && defined(PERL_IMPLICIT_CONTEXT)
-    PERL_SET_THX(aTHX);        /* fake TLS, see above */
-#endif
-
     if (PL_savestack_ix + 15 <= PL_savestack_max)
        flags |= 1;
     if (PL_markstack_ptr < PL_markstack_max - 2)
@@ -2428,3 +2487,6 @@ unwind_handler_stack(pTHX_ void *p)
        SvREFCNT_dec(sig_sv);
 #endif
 }
+
+
+