Provide infrastructure for PERL_ASYNC_CHECK() style safe signals.

[p5sagit/p5-mst-13.2.git] / mg.c

diff --git a/mg.c b/mg.c
index 0ac0742..50136e2 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1,6 +1,6 @@
 /*    mg.c
  *
- *    Copyright (c) 1991-2000, Larry Wall
+ *    Copyright (c) 1991-2001, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -261,6 +261,8 @@ MAGIC*
 Perl_mg_find(pTHX_ SV *sv, int type)
 {
     MAGIC* mg;
+    if (!sv)
+        return 0;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        if (mg->mg_type == type)
            return mg;
@@ -311,11 +313,12 @@ Perl_mg_free(pTHX_ SV *sv)
        moremagic = mg->mg_moremagic;
        if (vtbl && vtbl->svt_free)
            CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg);
-       if (mg->mg_ptr && mg->mg_type != 'g')
+       if (mg->mg_ptr && mg->mg_type != 'g') {
            if (mg->mg_len >= 0)
                Safefree(mg->mg_ptr);
            else if (mg->mg_len == HEf_SVKEY)
                SvREFCNT_dec((SV*)mg->mg_ptr);
+       }
        if (mg->mg_flags & MGf_REFCOUNTED)
            SvREFCNT_dec(mg->mg_obj);
        Safefree(mg);
@@ -324,6 +327,7 @@ Perl_mg_free(pTHX_ SV *sv)
     return 0;
 }
 
+
 #if !defined(NSIG) || defined(M_UNIX) || defined(M_XENIX)
 #include <signal.h>
 #endif
@@ -364,6 +368,11 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
                    i = t;
                else                    /* @- */
                    i = s;
+               
+               if (i > 0 && DO_UTF8(PL_reg_sv)) {
+                   char *b = rx->subbeg;
+                   i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+               }
                sv_setiv(sv,i);
            }
     }
@@ -406,7 +415,7 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
                    i = Perl_utf8_length(aTHX_ (U8*)s, (U8*)send);
                }
                if (i < 0)
-                   Perl_croak(aTHX_ "panic: magic_len: %d", i);
+                   Perl_croak(aTHX_ "panic: magic_len: %"IVdf, (IV)i);
                return i;
            }
        }
@@ -922,6 +931,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
     }
     FreeEnvironmentStrings(envv);
 #      else
+#ifdef USE_ENVIRON_ARRAY
 #          ifndef PERL_USE_SAFE_PUTENV
     I32 i;
 
@@ -934,6 +944,7 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 
     environ[0] = Nullch;
 
+#endif /* USE_ENVIRON_ARRAY */
 #      endif /* WIN32 */
 #   endif /* PERL_IMPLICIT_SYS */
 #endif /* VMS */
@@ -1393,12 +1404,14 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
     I32 offs = LvTARGOFF(sv);
     I32 rem = LvTARGLEN(sv);
 
+    if (SvUTF8(lsv))
+       sv_pos_u2b(lsv, &offs, &rem);
     if (offs > len)
        offs = len;
     if (rem + offs > len)
        rem = len - offs;
     sv_setpvn(sv, tmps + offs, (STRLEN)rem);
-    if (DO_UTF8(lsv))
+    if (SvUTF8(lsv))
         SvUTF8_on(sv);
     return 0;
 }
@@ -1407,8 +1420,26 @@ int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
     STRLEN len;
-    char *tmps = SvPV(sv,len);
-    sv_insert(LvTARG(sv),LvTARGOFF(sv),LvTARGLEN(sv), tmps, len);
+    char *tmps = SvPV(sv, len);
+    SV *lsv = LvTARG(sv);
+    I32 lvoff = LvTARGOFF(sv);
+    I32 lvlen = LvTARGLEN(sv);
+
+    if (DO_UTF8(sv)) {
+       sv_utf8_upgrade(lsv);
+       sv_pos_u2b(lsv, &lvoff, &lvlen);
+       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       SvUTF8_on(lsv);
+    }
+    else if (SvUTF8(lsv)) {
+       sv_pos_u2b(lsv, &lvoff, &lvlen);
+       tmps = (char*)bytes_to_utf8((U8*)tmps, &len);
+       sv_insert(lsv, lvoff, lvlen, tmps, len);
+       Safefree(tmps);
+    }
+    else
+        sv_insert(lsv, lvoff, lvlen, tmps, len);
+
     return 0;
 }
 
@@ -2114,6 +2145,15 @@ Perl_whichsig(pTHX_ char *sig)
     return 0;
 }
 
+void
+Perl_despatch_signals(pTHX)
+{
+#ifndef PERL_OLD_SIGNALS
+ /* This is just a dummy for now */
+#endif
+ PL_sig_pending = 0;
+}
+
 static SV* sig_sv;
 
 Signal_t
@@ -2195,9 +2235,26 @@ Perl_sighandler(int sig)
     PUSHs(sv);
     PUTBACK;
 
-    call_sv((SV*)cv, G_DISCARD);
+    call_sv((SV*)cv, G_DISCARD|G_EVAL);
 
     POPSTACK;
+    if (SvTRUE(ERRSV)) {
+#ifdef HAS_SIGPROCMASK
+       /* Handler "died", for example to get out of a restart-able read().
+        * Before we re-do that on its behalf re-enable the signal which was
+        * blocked by the system when we entered.
+        */
+       sigset_t set;
+       sigemptyset(&set);
+       sigaddset(&set,sig);
+       sigprocmask(SIG_UNBLOCK, &set, NULL);
+#else
+       /* Not clear if this will work */
+       (void)rsignal(sig, SIG_IGN);
+       (void)rsignal(sig, PL_sighandlerp);
+#endif
+       Perl_die(aTHX_ Nullch);
+    }
 cleanup:
     if (flags & 1)
        PL_savestack_ix -= 8; /* Unprotect save in progress. */