X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=fb47f1f7ed74500784aaeb5fc6489742e874c28e;hb=a11019f8bfc1b4438fdb32560361d443c701e293;hp=1423df06f08a6b45820aecaf13e661750ebdaf46;hpb=0565a181ab920bd3cc76f2ab45d62768abfcaf8d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 1423df0..fb47f1f 100644
--- a/mg.c
+++ b/mg.c
@@ -1,7 +1,7 @@
 /*    mg.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005 by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -40,14 +40,17 @@ tie.
 #include "perl.h"
 
 #if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
-#  ifndef NGROUPS
-#    define NGROUPS 32
-#  endif
 #  ifdef I_GRP
 #    include <grp.h>
 #  endif
 #endif
 
+#if defined(HAS_SETGROUPS)
+#  ifndef NGROUPS
+#    define NGROUPS 32
+#  endif
+#endif
+
 #ifdef __hpux
 #  include <sys/pstat.h>
 #endif
@@ -80,6 +83,7 @@ struct magic_state {
 STATIC void
 S_save_magic(pTHX_ I32 mgs_ix, SV *sv)
 {
+    dVAR;
     MGS* mgs;
     assert(SvMAGICAL(sv));
 #ifdef PERL_OLD_COPY_ON_WRITE
@@ -136,6 +140,7 @@ Do magic after a value is retrieved from the SV.  See C<sv_magic>.
 int
 Perl_mg_get(pTHX_ SV *sv)
 {
+    dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     const bool was_temp = (bool)SvTEMP(sv);
     int have_new = 0;
@@ -216,6 +221,7 @@ Do magic after a value is assigned to the SV.  See C<sv_magic>.
 int
 Perl_mg_set(pTHX_ SV *sv)
 {
+    dVAR;
     const I32 mgs_ix = SSNEW(sizeof(MGS));
     MAGIC* mg;
     MAGIC* nextmg;
@@ -248,6 +254,7 @@ Report on the SV's length.  See C<sv_magic>.
 U32
 Perl_mg_length(pTHX_ SV *sv)
 {
+    dVAR;
     MAGIC* mg;
     STRLEN len;
 
@@ -399,6 +406,7 @@ doesn't (eg taint, pos).
 void
 Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
 {
+    dVAR;
     MAGIC *mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	const MGVTBL* const vtbl = mg->mg_virtual;
@@ -427,15 +435,12 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
 	    continue;
 	}
 		
-	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy) {
-	    /* XXX calling the copy method is probably not correct. DAPM */
-	    (void)CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv,
-				    mg->mg_ptr, mg->mg_len);
-	}
-	else {
+	if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local)
+	    (void)CALL_FPTR(vtbl->svt_local)(aTHX_ nsv, mg);
+	else
 	    sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl,
 			    mg->mg_ptr, mg->mg_len);
-	}
+
 	/* container types should remain read-only across localization */
 	SvFLAGS(nsv) |= SvREADONLY(sv);
     }
@@ -485,14 +490,16 @@ Perl_mg_free(pTHX_ SV *sv)
 U32
 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 {
-    register const REGEXP *rx;
+    dVAR;
     PERL_UNUSED_ARG(sv);
 
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-	if (mg->mg_obj)		/* @+ */
-	    return rx->nparens;
-	else			/* @- */
-	    return rx->lastparen;
+    if (PL_curpm) {
+	register const REGEXP * const rx = PM_GETRE(PL_curpm);
+	if (rx) {
+	    return mg->mg_obj
+		? rx->nparens       /* @+ */
+		: rx->lastparen;    /* @- */
+	}
     }
 
     return (U32)-1;
@@ -501,32 +508,34 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
 {
-    register REGEXP *rx;
-
-    if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
-        register const I32 paren = mg->mg_len;
-        register I32 s;
-        register I32 t;
-	if (paren < 0)
-	    return 0;
-	if (paren <= (I32)rx->nparens &&
-	    (s = rx->startp[paren]) != -1 &&
-	    (t = rx->endp[paren]) != -1)
-	    {
-                register I32 i;
-		if (mg->mg_obj)		/* @+ */
-		    i = t;
-		else			/* @- */
-		    i = s;
+    dVAR;
+    if (PL_curpm) {
+	register const REGEXP * const rx = PM_GETRE(PL_curpm);
+	if (rx) {
+	    register const I32 paren = mg->mg_len;
+	    register I32 s;
+	    register I32 t;
+	    if (paren < 0)
+		return 0;
+	    if (paren <= (I32)rx->nparens &&
+		(s = rx->startp[paren]) != -1 &&
+		(t = rx->endp[paren]) != -1)
+		{
+		    register I32 i;
+		    if (mg->mg_obj)		/* @+ */
+			i = t;
+		    else			/* @- */
+			i = s;
+
+		    if (i > 0 && RX_MATCH_UTF8(rx)) {
+			const char * const b = rx->subbeg;
+			if (b)
+			    i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+		    }
 
-		if (i > 0 && RX_MATCH_UTF8(rx)) {
-		    const char * const b = rx->subbeg;
-		    if (b)
-		        i = Perl_utf8_length(aTHX_ (U8*)b, (U8*)(b+i));
+		    sv_setiv(sv, i);
 		}
-
-		sv_setiv(sv, i);
-	    }
+	}
     }
     return 0;
 }
@@ -542,6 +551,7 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
 U32
 Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     register I32 paren;
     register I32 i;
     register const REGEXP *rx;
@@ -633,9 +643,11 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 
 #define SvRTRIM(sv) STMT_START { \
     STRLEN len = SvCUR(sv); \
-    while (len > 0 && isSPACE(SvPVX(sv)[len-1])) \
+    char * const p = SvPVX(sv); \
+    while (len > 0 && isSPACE(p[len-1])) \
 	--len; \
     SvCUR_set(sv, len); \
+    p[len] = '\0'; \
 } STMT_END
 
 int
@@ -806,7 +818,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		 * it could have been extended by warnings::register */
 		SV **bits_all;
 		HV * const bits=get_hv("warnings::Bits", FALSE);
-		if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
+		if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
 		    sv_setsv(sv, *bits_all);
 		}
 	        else {
@@ -841,7 +853,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 
 	      getrx:
 		if (i >= 0) {
-		    int oldtainted = PL_tainted;
+		    const int oldtainted = PL_tainted;
 		    TAINT_NOT;
 		    sv_setpvn(sv, s, i);
 		    PL_tainted = oldtainted;
@@ -992,25 +1004,22 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	break;
     case '(':
 	sv_setiv(sv, (IV)PL_gid);
-#ifdef HAS_GETGROUPS
-	Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_gid);
-#endif
 	goto add_groups;
     case ')':
 	sv_setiv(sv, (IV)PL_egid);
-#ifdef HAS_GETGROUPS
-	Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, (long unsigned int)PL_egid);
-#endif
       add_groups:
 #ifdef HAS_GETGROUPS
 	{
-	    Groups_t gary[NGROUPS];
-	    I32 j = getgroups(NGROUPS,gary);
-	    while (--j >= 0)
-		Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f, (long unsigned int)gary[j]);
+	    Groups_t *gary = NULL;
+	    I32 i, num_groups = getgroups(0, gary);
+            Newx(gary, num_groups, Groups_t);
+            num_groups = getgroups(num_groups, gary);
+	    for (i = 0; i < num_groups; i++)
+		Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
+            Safefree(gary);
 	}
-#endif
 	(void)SvIOK_on(sv);	/* what a wonderful hack! */
+#endif
 	break;
 #ifndef MACOS_TRADITIONAL
     case '0':
@@ -1034,20 +1043,17 @@ int
 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
-    const char *s;
-    const char *ptr;
     STRLEN len, klen;
-
-    s = SvPV_const(sv,len);
-    ptr = MgPV_const(mg,klen);
+    const char *s = SvPV_const(sv,len);
+    const char * const ptr = MgPV_const(mg,klen);
     my_setenv(ptr, s);
 
 #ifdef DYNAMIC_ENV_FETCH
      /* We just undefd an environment var.  Is a replacement */
      /* waiting in the wings? */
     if (!len) {
-	SV **valp;
-	if ((valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE)))
+	SV ** const valp = hv_fetch(GvHVn(PL_envgv), ptr, klen, FALSE);
+	if (valp)
 	    s = SvPV_const(*valp, len);
     }
 #endif
@@ -1121,6 +1127,8 @@ Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
+    PERL_UNUSED_ARG(mg);
 #if defined(VMS)
     Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system");
 #else
@@ -1157,13 +1165,14 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
 static void
 restore_sigmask(pTHX_ SV *save_sv)
 {
-    const sigset_t *ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
+    const sigset_t * const ossetp = (const sigset_t *) SvPV_nolen_const( save_sv );
     (void)sigprocmask(SIG_SETMASK, ossetp, (sigset_t *)0);
 }
 #endif
 int
 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     /* Are we fetching a signal entry? */
     const I32 i = whichsig(MgPV_nolen_const(mg));
     if (i > 0) {
@@ -1199,7 +1208,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     register const char * const s = MgPV_nolen_const(mg);
     PERL_UNUSED_ARG(sv);
     if (*s == '_') {
-	SV** svp = 0;
+	SV** svp = NULL;
 	if (strEQ(s,"__DIE__"))
 	    svp = &PL_diehook;
 	else if (strEQ(s,"__WARN__"))
@@ -1208,7 +1217,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 	    Perl_croak(aTHX_ "No such hook: %s", s);
 	if (svp && *svp) {
             SV * const to_dec = *svp;
-	    *svp = 0;
+	    *svp = NULL;
     	    SvREFCNT_dec(to_dec);
 	}
     }
@@ -1243,7 +1252,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
     		PL_psig_name[i]=0;
     	    }
     	    if(PL_psig_ptr[i]) {
-                SV *to_dec=PL_psig_ptr[i];
+		SV * const to_dec=PL_psig_ptr[i];
     		PL_psig_ptr[i]=0;
 		LEAVE;
     		SvREFCNT_dec(to_dec);
@@ -1258,6 +1267,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
 static void
 S_raise_signal(pTHX_ int sig)
 {
+    dVAR;
     /* Set a flag to say this signal is pending */
     PL_psig_pend[sig]++;
     /* And one to say _a_ signal is pending */
@@ -1320,6 +1330,7 @@ Perl_csighandler_init(void)
 void
 Perl_despatch_signals(pTHX)
 {
+    dVAR;
     int sig;
     PL_sig_pending = 0;
     for (sig = 1; sig < SIG_SIZE; sig++) {
@@ -1338,12 +1349,12 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 {
     dVAR;
     I32 i;
-    SV** svp = 0;
+    SV** svp = NULL;
     /* Need to be careful with SvREFCNT_dec(), because that can have side
      * effects (due to closures). We must make sure that the new disposition
      * is in place before it is called.
      */
-    SV* to_dec = 0;
+    SV* to_dec = NULL;
     STRLEN len;
 #ifdef HAS_SIGPROCMASK
     sigset_t set, save;
@@ -1361,7 +1372,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	i = 0;
 	if (*svp) {
 	    to_dec = *svp;
-	    *svp = 0;
+	    *svp = NULL;
 	}
     }
     else {
@@ -1440,7 +1451,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 	 * tell whether HINT_STRICT_REFS is in force or not.
 	 */
 	if (!strchr(s,':') && !strchr(s,'\''))
-	    sv_insert(sv, 0, 0, "main::", 6);
+	    Perl_sv_insert(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"));
 	if (i)
 	    (void)rsignal(i, PL_csighandlerp);
 	else
@@ -1459,6 +1470,7 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     PL_sub_generation++;
@@ -1468,6 +1480,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setamagic(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     PERL_UNUSED_ARG(mg);
     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
@@ -1511,6 +1524,7 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
 STATIC int
 S_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, const char *meth, I32 flags, int n, SV *val)
 {
+    dVAR;
     dSP;
 
     PUSHMARK(SP);
@@ -1687,6 +1701,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
 int
 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     GV * const gv = PL_DBline;
     const I32 i = SvTRUE(sv);
     SV ** const svp = av_fetch(GvAV(gv),
@@ -1707,6 +1722,7 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 {
+    dVAR;
     const AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
 	sv_setiv(sv, AvFILL(obj) + PL_curcop->cop_arybase);
@@ -1719,6 +1735,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
 int
 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     AV * const obj = (AV*)mg->mg_obj;
     if (obj) {
 	av_fill(obj, SvIV(sv) - PL_curcop->cop_arybase);
@@ -1733,6 +1750,7 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     /* during global destruction, mg_obj may already have been freed */
     if (PL_in_clean_all)
@@ -1754,6 +1772,7 @@ Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     SV* const lsv = LvTARG(sv);
 
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
@@ -1773,6 +1792,7 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     SV* const lsv = LvTARG(sv);
     SSize_t pos;
     STRLEN len;
@@ -1785,7 +1805,7 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
     if (!mg) {
 	if (!SvOK(sv))
 	    return 0;
-	sv_magic(lsv, (SV*)0, PERL_MAGIC_regex_global, Nullch, 0);
+	sv_magic(lsv, NULL, PERL_MAGIC_regex_global, NULL, 0);
 	mg = mg_find(lsv, PERL_MAGIC_regex_global);
     }
     else if (!SvOK(sv)) {
@@ -1844,7 +1864,7 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
 
     if (!SvOK(sv))
 	return 0;
-    gv = gv_fetchsv(sv,TRUE, SVt_PVGV);
+    gv =  gv_fetchsv(sv, GV_ADD, SVt_PVGV);
     if (sv == (SV*)gv)
 	return 0;
     if (GvGP(sv))
@@ -1878,6 +1898,7 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     STRLEN len;
     const char *tmps = SvPV_const(sv, len);
     SV * const lsv = LvTARG(sv);
@@ -1911,6 +1932,7 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1));
     return 0;
@@ -1919,6 +1941,7 @@ Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     PERL_UNUSED_ARG(sv);
     /* update taint status unless we're restoring at scope exit */
     if (PL_localizing != 2) {
@@ -1936,12 +1959,11 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
     SV * const lsv = LvTARG(sv);
     PERL_UNUSED_ARG(mg);
 
-    if (!lsv) {
+    if (lsv)
+	sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
+    else
 	SvOK_off(sv);
-	return 0;
-    }
 
-    sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
     return 0;
 }
 
@@ -1956,6 +1978,7 @@ Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     SV *targ = Nullsv;
     if (LvTARGLEN(sv)) {
 	if (mg->mg_obj) {
@@ -2001,6 +2024,7 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
 void
 Perl_vivify_defelem(pTHX_ SV *sv)
 {
+    dVAR;
     MAGIC *mg;
     SV *value = Nullsv;
 
@@ -2036,42 +2060,7 @@ Perl_vivify_defelem(pTHX_ SV *sv)
 int
 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
 {
-    AV *const av = (AV*)mg->mg_obj;
-    SV **svp = AvARRAY(av);
-    PERL_UNUSED_ARG(sv);
-
-    /* Not sure why the av can get freed ahead of its sv, but somehow it does
-       in ext/B/t/bytecode.t test 15 (involving print <DATA>)  */
-    if (svp && !SvIS_FREED(av)) {
-	SV *const *const last = svp + AvFILLp(av);
-
-	while (svp <= last) {
-	    if (*svp) {
-		SV *const referrer = *svp;
-		if (SvWEAKREF(referrer)) {
-		    /* XXX Should we check that it hasn't changed? */
-		    SvRV_set(referrer, 0);
-		    SvOK_off(referrer);
-		    SvWEAKREF_off(referrer);
-		} else if (SvTYPE(referrer) == SVt_PVGV ||
-			   SvTYPE(referrer) == SVt_PVLV) {
-		    /* You lookin' at me?  */
-		    assert(GvSTASH(referrer));
-		    assert(GvSTASH(referrer) == (HV*)sv);
-		    GvSTASH(referrer) = 0;
-		} else {
-		    Perl_croak(aTHX_
-			       "panic: magic_killbackrefs (flags=%"UVxf")",
-			       (UV)SvFLAGS(referrer));
-		}
-
-		*svp = Nullsv;
-	    }
-	    svp++;
-	}
-    }
-    SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
-    return 0;
+    return Perl_sv_kill_backrefs(aTHX_ sv, (AV*)mg->mg_obj);
 }
 
 int
@@ -2121,6 +2110,7 @@ Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_freeregexp(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     regexp * const re = (regexp *)mg->mg_obj;
     PERL_UNUSED_ARG(sv);
 
@@ -2160,6 +2150,7 @@ Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
 int
 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 {
+    dVAR;
     register const char *s;
     I32 i;
     STRLEN len;
@@ -2304,12 +2295,12 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
     case '^':
 	Safefree(IoTOP_NAME(GvIOp(PL_defoutgv)));
 	s = IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-	IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
+	IoTOP_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
 	break;
     case '~':
 	Safefree(IoFMT_NAME(GvIOp(PL_defoutgv)));
 	s = IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv);
-	IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv,TRUE, SVt_PVIO);
+	IoFMT_GV(GvIOp(PL_defoutgv)) =  gv_fetchsv(sv, GV_ADD, SVt_PVIO);
 	break;
     case '=':
 	IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
@@ -2482,22 +2473,28 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 #ifdef HAS_SETGROUPS
 	{
 	    const char *p = SvPV_const(sv, len);
-	    Groups_t gary[NGROUPS];
-
-	    while (isSPACE(*p))
-		++p;
-	    PL_egid = Atol(p);
-	    for (i = 0; i < NGROUPS; ++i) {
-		while (*p && !isSPACE(*p))
-		    ++p;
-		while (isSPACE(*p))
-		    ++p;
-		if (!*p)
-		    break;
-		gary[i] = Atol(p);
-	    }
-	    if (i)
-		(void)setgroups(i, gary);
+            Groups_t *gary = NULL;
+
+            while (isSPACE(*p))
+                ++p;
+            PL_egid = Atol(p);
+            for (i = 0; i < NGROUPS; ++i) {
+                while (*p && !isSPACE(*p))
+                    ++p;
+                while (isSPACE(*p))
+                    ++p;
+                if (!*p)
+                    break;
+                if(!gary)
+                    Newx(gary, i + 1, Groups_t);
+                else
+                    Renew(gary, i + 1, Groups_t);
+                gary[i] = Atol(p);
+            }
+            if (i)
+                (void)setgroups(i, gary);
+            if (gary)
+                Safefree(gary);
 	}
 #else  /* HAS_SETGROUPS */
 	PL_egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -2537,7 +2534,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	/* The BSDs don't show the argv[] in ps(1) output, they
 	 * show a string from the process struct and provide
 	 * the setproctitle() routine to manipulate that. */
-	{
+	if (PL_origalen != 1) {
 	    s = SvPV_const(sv, len);
 #   if __FreeBSD_version > 410001
 	    /* The leading "-" removes the "perl: " prefix,
@@ -2558,35 +2555,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
 	}
 #endif
 #if defined(__hpux) && defined(PSTAT_SETCMD)
-	{
+	if (PL_origalen != 1) {
 	     union pstun un;
 	     s = SvPV_const(sv, len);
 	     un.pst_command = (char *)s;
 	     pstat(PSTAT_SETCMD, un, len, 0, 0);
 	}
 #endif
-	/* PL_origalen is set in perl_parse(). */
-	s = SvPV_force(sv,len);
-	if (len >= (STRLEN)PL_origalen-1) {
-	    /* Longer than original, will be truncated. We assume that
-             * PL_origalen bytes are available. */
-	    Copy(s, PL_origargv[0], PL_origalen-1, char);
+	if (PL_origalen > 1) {
+	    /* PL_origalen is set in perl_parse(). */
+	    s = SvPV_force(sv,len);
+	    if (len >= (STRLEN)PL_origalen-1) {
+		/* Longer than original, will be truncated. We assume that
+		 * PL_origalen bytes are available. */
+		Copy(s, PL_origargv[0], PL_origalen-1, char);
+	    }
+	    else {
+		/* Shorter than original, will be padded. */
+		Copy(s, PL_origargv[0], len, char);
+		PL_origargv[0][len] = 0;
+		memset(PL_origargv[0] + len + 1,
+		       /* Is the space counterintuitive?  Yes.
+			* (You were expecting \0?)  
+			* Does it work?  Seems to.  (In Linux 2.4.20 at least.)
+			* --jhi */
+		       (int)' ',
+		       PL_origalen - len - 1);
+	    }
+	    PL_origargv[0][PL_origalen-1] = 0;
+	    for (i = 1; i < PL_origargc; i++)
+		PL_origargv[i] = 0;
 	}
-	else {
-	    /* Shorter than original, will be padded. */
-	    Copy(s, PL_origargv[0], len, char);
-	    PL_origargv[0][len] = 0;
-	    memset(PL_origargv[0] + len + 1,
-		   /* Is the space counterintuitive?  Yes.
-		    * (You were expecting \0?)  
-		    * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
-		    * --jhi */
-		   (int)' ',
-		   PL_origalen - len - 1);
-	}
-	PL_origargv[0][PL_origalen-1] = 0;
-	for (i = 1; i < PL_origargc; i++)
-	    PL_origargv[i] = 0;
 	UNLOCK_DOLLARZERO_MUTEX;
 	break;
 #endif
@@ -2661,7 +2660,7 @@ Perl_sighandler(int sig)
     if (!SvROK(PL_psig_ptr[sig]) || !(cv = (CV*)SvRV(PL_psig_ptr[sig]))
 	|| SvTYPE(cv) != SVt_PVCV) {
 	HV *st;
-	cv = sv_2cv(PL_psig_ptr[sig],&st,&gv,TRUE);
+	cv = sv_2cv(PL_psig_ptr[sig], &st, &gv, GV_ADD);
     }
 
     if (!cv || !CvROOT(cv)) {
@@ -2766,6 +2765,7 @@ cleanup:
 static void
 S_restore_magic(pTHX_ const void *p)
 {
+    dVAR;
     MGS* const mgs = SSPTR(PTR2IV(p), MGS*);
     SV* const sv = mgs->mgs_sv;
 
@@ -2827,7 +2827,6 @@ S_unwind_handler_stack(pTHX_ const void *p)
 
     if (flags & 1)
 	PL_savestack_ix -= 5; /* Unprotect save in progress. */
-    /* cxstack_ix-- Not needed, die already unwound it. */
 #if !defined(PERL_IMPLICIT_CONTEXT)
     if (flags & 64)
 	SvREFCNT_dec(PL_sig_sv);