From: Andy Lester <andy@petdance.com>
Date: Tue, 18 Oct 2005 09:57:23 +0000 (-0500)
Subject: More consting, and DRY leads to shrinking object code
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=823a54a3e80592bb1d7f6b5fc487f84a3411e104;p=p5sagit%2Fp5-mst-13.2.git

More consting, and DRY leads to shrinking object code
Message-ID: <20051018145723.GA4964@petdance.com>

p4raw-id: //depot/perl@25803
---

diff --git a/av.c b/av.c
index f2afa82..c71dd03 100644
--- a/av.c
+++ b/av.c
@@ -60,8 +60,8 @@ extended.
 void
 Perl_av_extend(pTHX_ AV *av, I32 key)
 {
-    MAGIC *mg;
-    if ((mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied))) {
+    MAGIC * const mg = SvTIED_mg((SV*)av, PERL_MAGIC_tied);
+    if (mg) {
 	dSP;
 	ENTER;
 	SAVETMPS;
@@ -92,7 +92,6 @@ Perl_av_extend(pTHX_ AV *av, I32 key)
 		while (tmp)
 		    ary[--tmp] = &PL_sv_undef;
 	    }
-	    
 	    if (key > AvMAX(av) - 10) {
 		newmax = key + AvMAX(av);
 		goto resize;
@@ -198,7 +197,7 @@ Perl_av_fetch(pTHX_ register AV *av, I32 key, I32 lval)
 
             if (tied_magic && key < 0) {
                 /* Handle negative array indices 20020222 MJD */
-                SV **negative_indices_glob = 
+		SV * const * const negative_indices_glob =
                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
                                                      tied_magic))), 
                              NEGATIVE_INDICES_VAR, 16, 0);
@@ -285,7 +284,7 @@ Perl_av_store(pTHX_ register AV *av, I32 key, SV *val)
             /* Handle negative array indices 20020222 MJD */
             if (key < 0) {
                 unsigned adjust_index = 1;
-                SV **negative_indices_glob = 
+		SV * const * const negative_indices_glob =
                     hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
                                                      tied_magic))), 
                              NEGATIVE_INDICES_VAR, 16, 0);
@@ -354,9 +353,8 @@ Creates a new AV.  The reference count is set to 1.
 AV *
 Perl_newAV(pTHX)
 {
-    register AV *av;
+    register AV * const av = (AV*)NEWSV(3,0);
 
-    av = (AV*)NEWSV(3,0);
     sv_upgrade((SV *)av, SVt_PVAV);
     /* sv_upgrade does AvREAL_only()  */
     AvALLOC(av) = 0;
@@ -378,9 +376,8 @@ will have a reference count of 1.
 AV *
 Perl_av_make(pTHX_ register I32 size, register SV **strp)
 {
-    register AV *av;
+    register AV * const av = (AV*)NEWSV(8,0);
 
-    av = (AV*)NEWSV(8,0);
     sv_upgrade((SV *) av,SVt_PVAV);
     /* sv_upgrade does AvREAL_only()  */
     if (size) {		/* "defined" was returning undef for size==0 anyway. */
@@ -404,10 +401,9 @@ Perl_av_make(pTHX_ register I32 size, register SV **strp)
 AV *
 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
 {
-    register AV *av;
     register SV** ary;
+    register AV * const av = (AV*)NEWSV(9,0);
 
-    av = (AV*)NEWSV(9,0);
     sv_upgrade((SV *)av, SVt_PVAV);
     Newx(ary,size+1,SV*);
     AvALLOC(av) = ary;
@@ -457,10 +453,10 @@ Perl_av_clear(pTHX_ register AV *av)
 	return;
 
     if (AvREAL(av)) {
-        SV** ary = AvARRAY(av);
+	SV** const ary = AvARRAY(av);
 	key = AvFILLp(av) + 1;
 	while (key) {
-	    SV * sv = ary[--key];
+	    SV * const sv = ary[--key];
 	    /* undef the slot before freeing the value, because a
 	     * destructor might try to modify this arrray */
 	    ary[key] = &PL_sv_undef;
@@ -805,7 +801,7 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
             if (key < 0) {
                 unsigned adjust_index = 1;
                 if (tied_magic) {
-                    SV **negative_indices_glob = 
+		    SV * const * const negative_indices_glob =
                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
                                                          tied_magic))), 
                                  NEGATIVE_INDICES_VAR, 16, 0);
@@ -890,7 +886,7 @@ Perl_av_exists(pTHX_ AV *av, I32 key)
             if (key < 0) {
                 unsigned adjust_index = 1;
                 if (tied_magic) {
-                    SV **negative_indices_glob = 
+		    SV * const * const negative_indices_glob =
                         hv_fetch(SvSTASH(SvRV(SvTIED_obj((SV *)av, 
                                                          tied_magic))), 
                                  NEGATIVE_INDICES_VAR, 16, 0);
diff --git a/gv.c b/gv.c
index a2b30a2..d222d28 100644
--- a/gv.c
+++ b/gv.c
@@ -302,8 +302,8 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 	/* NOTE: No support for tied ISA */
 	I32 items = AvFILLp(av) + 1;
 	while (items--) {
-	    SV* sv = *svp++;
-	    HV* basestash = gv_stashsv(sv, FALSE);
+	    SV* const sv = *svp++;
+	    HV* const basestash = gv_stashsv(sv, FALSE);
 	    if (!basestash) {
 		if (ckWARN(WARN_MISC))
 		    Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
@@ -320,9 +320,9 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
     /* if at top level, try UNIVERSAL */
 
     if (level == 0 || level == -1) {
-	HV* lastchance;
+	HV* const lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE);
 
-	if ((lastchance = gv_stashpvn("UNIVERSAL", 9, FALSE))) {
+	if (lastchance) {
 	    if ((gv = gv_fetchmeth(lastchance, name, len,
 				  (level >= 0) ? level + 1 : level - 1)))
 	    {
diff --git a/hv.c b/hv.c
index 8b41f77..9b90df2 100644
--- a/hv.c
+++ b/hv.c
@@ -879,13 +879,13 @@ Evaluates the hash in scalar context and returns the result. Handles magic when
 SV *
 Perl_hv_scalar(pTHX_ HV *hv)
 {
-    MAGIC *mg;
     SV *sv;
-    
-    if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
-        sv = magic_scalarpack(hv, mg);
-        return sv;
-    } 
+
+    if (SvRMAGICAL(hv)) {
+	MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+	if (mg)
+	    return magic_scalarpack(hv, mg);
+    }
 
     sv = sv_newmortal();
     if (HvFILL((HV*)hv)) 
diff --git a/mg.c b/mg.c
index 3ea8b82..17f9a24 100644
--- a/mg.c
+++ b/mg.c
@@ -369,13 +369,18 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen)
 	if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
 	    count += CALL_FPTR(vtbl->svt_copy)(aTHX_ sv, mg, nsv, key, klen);
 	}
-	else if (isUPPER(mg->mg_type)) {
-	    sv_magic(nsv,
-		     mg->mg_type == PERL_MAGIC_tied ? SvTIED_obj(sv, mg) :
-		     (mg->mg_type == PERL_MAGIC_regdata && mg->mg_obj)
-							? sv : mg->mg_obj,
-		     toLOWER(mg->mg_type), key, klen);
-	    count++;
+	else {
+	    const char type = mg->mg_type;
+	    if (isUPPER(type)) {
+		sv_magic(nsv,
+		     (type == PERL_MAGIC_tied)
+			? SvTIED_obj(sv, mg)
+			: (type == PERL_MAGIC_regdata && mg->mg_obj)
+			    ? sv
+			    : mg->mg_obj,
+		     toLOWER(type), key, klen);
+		count++;
+	    }
 	}
     }
     return count;
@@ -641,16 +646,18 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
     register char *s = NULL;
     register I32 i;
     register REGEXP *rx;
+    const char * const remaining = mg->mg_ptr + 1;
+    const char nextchar = *remaining;
 
     switch (*mg->mg_ptr) {
     case '\001':		/* ^A */
 	sv_setsv(sv, PL_bodytarget);
 	break;
     case '\003':		/* ^C, ^CHILD_ERROR_NATIVE */
-	if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 	    sv_setiv(sv, (IV)PL_minus_c);
 	}
-	else if (strEQ(mg->mg_ptr, "\003HILD_ERROR_NATIVE")) {
+	else if (strEQ(remaining, "HILD_ERROR_NATIVE")) {
 	    sv_setiv(sv, (IV)STATUS_NATIVE);
         }
 	break;
@@ -659,7 +666,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK));
 	break;
     case '\005':  /* ^E */
-	 if (*(mg->mg_ptr+1) == '\0') {
+	 if (nextchar == '\0') {
 #ifdef MACOS_TRADITIONAL
 	     {
 		  char msg[256];
@@ -687,7 +694,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		  sv_setpv(sv, errno ? Strerror(errno) : "");
 	     } else {
 		  if (errno != errno_isOS2) {
-		       int tmp = _syserrno();
+		       const int tmp = _syserrno();
 		       if (tmp)	/* 2nd call to _syserrno() makes it 0 */
 			    Perl_rc = tmp;
 		  }
@@ -699,8 +706,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	     {
 		  DWORD dwErr = GetLastError();
 		  sv_setnv(sv, (NV)dwErr);
-		  if (dwErr)
-		  {
+		  if (dwErr) {
 		       PerlProc_GetOSError(sv, dwErr);
 		  }
 		  else
@@ -721,7 +727,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	     SvRTRIM(sv);
 	     SvNOK_on(sv);	/* what a wonderful hack! */
 	 }
-	 else if (strEQ(mg->mg_ptr+1, "NCODING"))
+	 else if (strEQ(remaining, "NCODING"))
 	      sv_setsv(sv, PL_encoding);
 	 break;
     case '\006':		/* ^F */
@@ -737,11 +743,11 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	    sv_setsv(sv, &PL_sv_undef);
 	break;
     case '\017':		/* ^O & ^OPEN */
-	if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 	    sv_setpv(sv, PL_osname);
 	    SvTAINTED_off(sv);
 	}
-	else if (strEQ(mg->mg_ptr, "\017PEN")) {
+	else if (strEQ(remaining, "PEN")) {
 	    if (!PL_compiling.cop_io)
 		sv_setsv(sv, &PL_sv_undef);
             else {
@@ -753,7 +759,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	sv_setiv(sv, (IV)PL_perldb);
 	break;
     case '\023':		/* ^S */
-        if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 	    if (PL_lex_state != LEX_NOTPARSING)
 		SvOK_off(sv);
 	    else if (PL_in_eval)
@@ -763,28 +769,28 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 	}
 	break;
     case '\024':		/* ^T */
-        if (*(mg->mg_ptr+1) == '\0') {
+	if (nextchar == '\0') {
 #ifdef BIG_TIME
             sv_setnv(sv, PL_basetime);
 #else
             sv_setiv(sv, (IV)PL_basetime);
 #endif
         }
-        else if (strEQ(mg->mg_ptr, "\024AINT"))
+	else if (strEQ(remaining, "AINT"))
             sv_setiv(sv, PL_tainting
 		    ? (PL_taint_warn || PL_unsafe ? -1 : 1)
 		    : 0);
         break;
     case '\025':		/* $^UNICODE, $^UTF8LOCALE */
-        if (strEQ(mg->mg_ptr, "\025NICODE"))
+	if (strEQ(remaining, "NICODE"))
 	    sv_setuv(sv, (UV) PL_unicode);
-        else if (strEQ(mg->mg_ptr, "\025TF8LOCALE"))
+	else if (strEQ(remaining, "TF8LOCALE"))
 	    sv_setuv(sv, (UV) PL_utf8locale);
         break;
     case '\027':		/* ^W  & $^WARNING_BITS */
-	if (*(mg->mg_ptr+1) == '\0')
+	if (nextchar == '\0')
 	    sv_setiv(sv, (IV)((PL_dowarn & G_WARN_ON) ? TRUE : FALSE));
-	else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
+	else if (strEQ(remaining, "ARNING_BITS")) {
 	    if (PL_compiling.cop_warnings == pWARN_NONE) {
 	        sv_setpvn(sv, WARN_NONEstring, WARNsize) ;
 	    }
@@ -799,7 +805,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 		/* Get the bit mask for $warnings::Bits{all}, because
 		 * it could have been extended by warnings::register */
 		SV **bits_all;
-		HV *bits=get_hv("warnings::Bits", FALSE);
+		HV * const bits=get_hv("warnings::Bits", FALSE);
 		if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
 		    sv_setsv(sv, *bits_all);
 		}
@@ -842,7 +848,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 			SvUTF8_off(sv);
 		    if (PL_tainting) {
 			if (RX_MATCH_TAINTED(rx)) {
-			    MAGIC* mg = SvMAGIC(sv);
+			    MAGIC* const mg = SvMAGIC(sv);
 			    MAGIC* mgt;
 			    PL_tainted = 1;
 			    SvMAGIC_set(sv, mg->mg_moremagic);
diff --git a/pp_ctl.c b/pp_ctl.c
index 7191759..fd1bccd 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -222,7 +222,7 @@ PP(pp_substcont)
 				      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
 				      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
 	{
-	    SV *targ = cx->sb_targ;
+	    SV * const targ = cx->sb_targ;
 
 	    assert(cx->sb_strend >= s);
 	    if(cx->sb_strend > s) {
@@ -392,7 +392,7 @@ Perl_rxres_free(pTHX_ void **rsp)
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
-    register SV *tmpForm = *++MARK;
+    register SV * const tmpForm = *++MARK;
     register U32 *fpc;
     register char *t;
     const char *f;
@@ -408,7 +408,7 @@ PP(pp_formline)
     NV value;
     bool gotsome = FALSE;
     STRLEN len;
-    STRLEN fudge = SvPOK(tmpForm)
+    const STRLEN fudge = SvPOK(tmpForm)
 			? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
@@ -1153,7 +1153,7 @@ PP(pp_flop)
 	else {
 	    SV * const final = sv_mortalcopy(right);
 	    STRLEN len;
-	    const char *tmps = SvPV_const(final, len);
+	    const char * const tmps = SvPV_const(final, len);
 
 	    SV *sv = sv_mortalcopy(left);
 	    SvPV_force_nolen(sv);
diff --git a/pp_hot.c b/pp_hot.c
index a2890dc..eed2ef9 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2557,7 +2557,7 @@ S_get_db_sub(pTHX_ SV **svp, CV *cv)
 		    && (gv = (GV*)*svp) ))) {
 	    /* Use GV from the stack as a fallback. */
 	    /* GV is potentially non-unique, or contain different CV. */
-	    SV *tmp = newRV((SV*)cv);
+	    SV * const tmp = newRV((SV*)cv);
 	    sv_setsv(dbsv, tmp);
 	    SvREFCNT_dec(tmp);
 	}
@@ -2628,7 +2628,7 @@ PP(pp_entersub)
 	}
   got_rv:
 	{
-	    SV **sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
+	    SV * const * sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
 	    tryAMAGICunDEREF(to_cv);
 	}	
 	cv = (CV*)SvRV(sv);
diff --git a/sv.c b/sv.c
index 284209e..fc89183 100644
--- a/sv.c
+++ b/sv.c
@@ -429,18 +429,19 @@ Perl_sv_report_used(pTHX)
 static void
 do_clean_objs(pTHX_ SV *ref)
 {
-    SV* target;
-
-    if (SvROK(ref) && SvOBJECT(target = SvRV(ref))) {
-	DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(ref)));
-	if (SvWEAKREF(ref)) {
-	    sv_del_backref(target, ref);
-	    SvWEAKREF_off(ref);
-	    SvRV_set(ref, NULL);
-	} else {
-	    SvROK_off(ref);
-	    SvRV_set(ref, NULL);
-	    SvREFCNT_dec(target);
+    if (SvROK(ref)) {
+	SV * const target = SvRV(ref);
+	if (SvOBJECT(target)) {
+	    DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning object ref:\n "), sv_dump(ref)));
+	    if (SvWEAKREF(ref)) {
+		sv_del_backref(target, ref);
+		SvWEAKREF_off(ref);
+		SvRV_set(ref, NULL);
+	    } else {
+		SvROK_off(ref);
+		SvRV_set(ref, NULL);
+		SvREFCNT_dec(target);
+	    }
 	}
     }
 
@@ -2953,7 +2954,7 @@ static char *
 S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
 {
     char *ptr = buf + TYPE_CHARS(UV);
-    char *ebuf = ptr;
+    char * const ebuf = ptr;
     int sign;
 
     if (is_uv)
@@ -3272,7 +3273,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 	return (char *)"";
     }
     {
-	STRLEN len = s - SvPVX_const(sv);
+	const STRLEN len = s - SvPVX_const(sv);
 	if (lp) 
 	    *lp = len;
 	SvCUR_set(sv, len);
@@ -3913,7 +3914,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
     if (sflags & SVf_ROK) {
 	if (dtype >= SVt_PV) {
 	    if (dtype == SVt_PVGV) {
-		SV *sref = SvREFCNT_inc(SvRV(sstr));
+		SV * const sref = SvREFCNT_inc(SvRV(sstr));
 		SV *dref = 0;
 		const int intro = GvINTRO(dstr);
 
@@ -3967,7 +3968,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
 		    else
 			dref = (SV*)GvCV(dstr);
 		    if (GvCV(dstr) != (CV*)sref) {
-			CV* cv = GvCV(dstr);
+			CV* const cv = GvCV(dstr);
 			if (cv) {
 			    if (!GvCVGEN((GV*)dstr) &&
 				(CvROOT(cv) || CvXSUB(cv)))
@@ -7682,7 +7683,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
     default:
 	SvGETMAGIC(sv);
 	if (SvROK(sv)) {
-	    SV **sp = &sv;		/* Used in tryAMAGICunDEREF macro. */
+	    SV * const *sp = &sv;	/* Used in tryAMAGICunDEREF macro. */
 	    tryAMAGICunDEREF(to_cv);
 
 	    sv = SvRV(sv);
@@ -7743,8 +7744,8 @@ Perl_sv_true(pTHX_ register SV *sv)
     if (!sv)
 	return 0;
     if (SvPOK(sv)) {
-	register const XPV* tXpv;
-	if ((tXpv = (XPV*)SvANY(sv)) &&
+	register const XPV* const tXpv = (XPV*)SvANY(sv);
+	if (tXpv &&
 		(tXpv->xpv_cur > 1 ||
 		(tXpv->xpv_cur && *sv->sv_u.svu_pv != '0')))
 	    return 1;
@@ -8477,7 +8478,7 @@ bool
 Perl_sv_tainted(pTHX_ SV *sv)
 {
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
-	MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
+	const MAGIC * const mg = mg_find(sv, PERL_MAGIC_taint);
 	if (mg && (mg->mg_len & 1) )
 	    return TRUE;
     }