Integrate:

[ 25754]
Subject: [PATCH] Stas' croak patch and then some
Date: Thu, 13 Oct 2005 16:42:12 -0500
Message-ID: <20051013214212.GA1122@petdance.com>

[ 25757]
gcc complains when it sees variables declared

	const register ...

switched them all to

	register const ...

[ 25779]
Make some casts explicit to keep VC++ 7 happy

Specifically, this silences the warnings from the following smoke:
http://www.nntp.perl.org/group/perl.daily-build.reports/32258
(Hmm. Looks like you need to decode the base64 yourself before you
can read that.)

[ 25803]
Subject: [PATCH] More consting, and DRY leads to shrinking object code
From: Andy Lester <andy@petdance.com>
Date: Tue, 18 Oct 2005 09:57:23 -0500
Message-ID: <20051018145723.GA4964@petdance.com>
p4raw-link: @25803 on //depot/perl: 823a54a3e80592bb1d7f6b5fc487f84a3411e104
p4raw-link: @25779 on //depot/perl: 585ec06d680e861557397efeb05210638532c6dc
p4raw-link: @25757 on //depot/perl: 0d46e09a6299ee39ec954683a582d25f5ea086c7
p4raw-link: @25754 on //depot/perl: 551405c409d33bc8cd0a20177c4ee21a204d18b5

p4raw-id: //depot/maint-5.8/perl@26688
p4raw-integrated: from //depot/perl@25803 'edit in' av.c (@25771..)
	mg.c (@25778..) 'merge in' hv.c (@25515..) gv.c (@25754..)
	pp_ctl.c (@25778..)
p4raw-integrated: from //depot/perl@25779 'merge in' numeric.c
	(@25304..) op.c (@25763..)
p4raw-integrated: from //depot/perl@25757 'edit in' pp_hot.c (@25322..)
	sv.c toke.c (@25754..) 'merge in' regexec.c (@25243..) pp.c
	(@25322..) util.c (@25737..)

diff --git a/av.c b/av.c
index 5b2a5c5..dc10879 100644 (file)
--- 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;
@@ -820,7 +816,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);
@@ -905,7 +901,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 0f19027..80e0470 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -306,8 +306,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",
@@ -324,9 +324,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 1598bda..b5fb9c2 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -834,13 +834,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 d9715cd..3987305 100644 (file)
--- 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;
@@ -571,6 +576,8 @@ 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 */
@@ -587,7 +594,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #endif
        break;
     case '\005':  /* ^E */
-        if (*(mg->mg_ptr+1) == '\0') {
+        if (nextchar == '\0') {
 #ifdef MACOS_TRADITIONAL
             {
                  char msg[256];
@@ -615,7 +622,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;
                  }
@@ -627,8 +634,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
@@ -648,7 +654,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
 #endif
             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 */
@@ -664,11 +670,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 {
@@ -680,7 +686,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)
@@ -690,28 +696,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) ;
            }
@@ -726,7 +732,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);
                }
@@ -769,7 +775,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/numeric.c b/numeric.c
index 7aba0bb..89d1bb6 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -151,7 +151,7 @@ Perl_grok_bin(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
     NV value_nv = 0;
 
     const UV max_div_2 = UV_MAX / 2;
-    const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+    const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
     char bit;
 
@@ -267,7 +267,7 @@ Perl_grok_hex(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
     NV value_nv = 0;
 
     const UV max_div_16 = UV_MAX / 16;
-    const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+    const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
 
     if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
@@ -381,7 +381,7 @@ Perl_grok_oct(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) {
     NV value_nv = 0;
 
     const UV max_div_8 = UV_MAX / 8;
-    const bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
+    const bool allow_underscores = (bool)(*flags & PERL_SCAN_ALLOW_UNDERSCORES);
     bool overflowed = FALSE;
 
     for (; len-- && *s; s++) {

diff --git a/op.c b/op.c
index f5192d6..70d18bb 100644 (file)
--- a/op.c
+++ b/op.c
@@ -2361,7 +2361,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
     unop->op_type = (OPCODE)type;
     unop->op_ppaddr = PL_ppaddr[type];
     unop->op_first = first;
-    unop->op_flags = flags | OPf_KIDS;
+    unop->op_flags = (U8)(flags | OPf_KIDS);
     unop->op_private = (U8)(1 | (flags >> 8));
     unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
@@ -2382,7 +2382,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     binop->op_type = (OPCODE)type;
     binop->op_ppaddr = PL_ppaddr[type];
     binop->op_first = first;
-    binop->op_flags = flags | OPf_KIDS;
+    binop->op_flags = (U8)(flags | OPf_KIDS);
     if (!last) {
        last = first;
        binop->op_private = (U8)(1 | (flags >> 8));
@@ -2680,7 +2680,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                j = rlen - 1;
            else
                cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
-           tbl[0x100] = rlen - j;
+           tbl[0x100] = (short)(rlen - j);
            for (i=0; i < (I32)rlen - j; i++)
                tbl[0x101+i] = r[j+i];
        }
@@ -3620,7 +3620,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     logop->op_type = (OPCODE)type;
     logop->op_ppaddr = PL_ppaddr[type];
     logop->op_first = first;
-    logop->op_flags = flags | OPf_KIDS;
+    logop->op_flags = (U8)(flags | OPf_KIDS);
     logop->op_other = LINKLIST(other);
     logop->op_private = (U8)(1 | (flags >> 8));
 
@@ -3670,7 +3670,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     logop->op_type = OP_COND_EXPR;
     logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
     logop->op_first = first;
-    logop->op_flags = flags | OPf_KIDS;
+    logop->op_flags = (U8)(flags | OPf_KIDS);
     logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);

diff --git a/pp.c b/pp.c
index aa699f4..3a18572 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3587,7 +3587,7 @@ PP(pp_uc)
        }
        s = (U8*)SvPV_force_nomg(sv, len);
        if (len) {
-           const register U8 *send = s + len;
+           register const U8 *send = s + len;
 
            if (IN_LOCALE_RUNTIME) {
                TAINT;
@@ -3714,7 +3714,7 @@ PP(pp_quotemeta)
     dSP; dTARGET;
     SV * const sv = TOPs;
     STRLEN len;
-    const register char *s = SvPV_const(sv,len);
+    register const char *s = SvPV_const(sv,len);
 
     SvUTF8_off(TARG);                          /* decontaminate */
     if (len) {

diff --git a/pp_ctl.c b/pp_ctl.c
index 6a093b6..6f3fc1b 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -195,7 +195,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) {
@@ -338,7 +338,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;
@@ -354,7 +354,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;
@@ -1086,7 +1086,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 ca20c6c..150d91f 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1233,8 +1233,8 @@ PP(pp_match)
     dSP; dTARG;
     register PMOP *pm = cPMOP;
     PMOP *dynpm = pm;
-    const register char *t;
-    const register char *s;
+    register const char *t;
+    register const char *s;
     const char *strend;
     I32 global;
     I32 r_flags = REXEC_CHECKED;
@@ -2563,7 +2563,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);
        }
@@ -2624,7 +2624,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/regexec.c b/regexec.c
index 290cb6a..d8a4f92 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -2315,7 +2315,7 @@ S_regmatch(pTHX_ regnode *prog)
 #if 0
     I32 firstcp = PL_savestack_ix;
 #endif
-    const register bool do_utf8 = PL_reg_match_utf8;
+    register const bool do_utf8 = PL_reg_match_utf8;
 #ifdef DEBUGGING
     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);

diff --git a/sv.c b/sv.c
index 7660670..dbdf368 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -2924,7 +2924,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)
@@ -3243,7 +3243,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);
@@ -3871,7 +3871,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);
 
@@ -3925,7 +3925,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)))
@@ -6458,7 +6458,7 @@ thats_really_all_folks:
 
 screamer2:
        if (rslen) {
-            const register STDCHAR *bpe = buf + sizeof(buf);
+            register const STDCHAR *bpe = buf + sizeof(buf);
            bp = buf;
            while ((i = PerlIO_getc(fp)) != EOF && (*bp++ = (STDCHAR)i) != rslast && bp < bpe)
                ; /* keep reading */
@@ -7344,7 +7344,7 @@ Perl_sv_2cv(pTHX_ SV *sv, HV **st, GV **gvp, I32 lref)
        if (SvGMAGICAL(sv))
            mg_get(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);
@@ -7405,8 +7405,8 @@ Perl_sv_true(pTHX_ register SV *sv)
     if (!sv)
        return 0;
     if (SvPOK(sv)) {
-       const register XPV* tXpv;
-       if ((tXpv = (XPV*)SvANY(sv)) &&
+       register const XPV* const tXpv = (XPV*)SvANY(sv);
+       if (tXpv &&
                (tXpv->xpv_cur > 1 ||
                (tXpv->xpv_cur && *tXpv->xpv_pv != '0')))
            return 1;
@@ -8139,7 +8139,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) || ((mg->mg_len & 2) && mg->mg_obj == sv)))
            return TRUE;
     }

diff --git a/toke.c b/toke.c
index fac5b1b..07f4648 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -455,7 +455,7 @@ S_missingterm(pTHX_ char *s)
 #endif
        ) {
        *tmpbuf = '^';
-       tmpbuf[1] = toCTRL(PL_multi_close);
+       tmpbuf[1] = (char)toCTRL(PL_multi_close);
        tmpbuf[2] = '\0';
        s = tmpbuf;
     }
@@ -1170,7 +1170,7 @@ S_tokeq(pTHX_ SV *sv)
 STATIC I32
 S_sublex_start(pTHX)
 {
-    const register I32 op_type = yylval.ival;
+    register const I32 op_type = yylval.ival;
 
     if (op_type == OP_NULL) {
        yylval.opval = PL_lex_op;

diff --git a/util.c b/util.c
index 5990121..b65b39d 100644 (file)
--- a/util.c
+++ b/util.c
@@ -364,7 +364,7 @@ Analyses the string in order to make fast searches on it using fbm_instr()
 void
 Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 {
-    const register U8 *s;
+    register const U8 *s;
     register U32 i;
     STRLEN len;
     I32 rarest = 0;
@@ -569,7 +569,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 
     {  /* Do actual FBM.  */
        register const unsigned char *table = little + littlelen + FBM_TABLE_OFFSET;
-       const register unsigned char *oldlittle;
+       register const unsigned char *oldlittle;
 
        if (littlelen > (STRLEN)(bigend - big))
            return Nullch;
@@ -631,13 +631,13 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
 char *
 Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
 {
-    const register unsigned char *big;
+    register const unsigned char *big;
     register I32 pos;
     register I32 previous;
     register I32 first;
-    const register unsigned char *little;
+    register const unsigned char *little;
     register I32 stop_pos;
-    const register unsigned char *littleend;
+    register const unsigned char *littleend;
     I32 found = 0;
 
     if (*old_posp == -1
@@ -679,7 +679,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     }
     big -= previous;
     do {
-       const register unsigned char *s, *x;
+       register const unsigned char *s, *x;
        if (pos >= stop_pos) break;
        if (big[pos] != first)
            continue;
@@ -1567,7 +1567,7 @@ I32
 Perl_setenv_getix(pTHX_ char *nam)
 {
     register I32 i;
-    const register I32 len = strlen(nam);
+    register const I32 len = strlen(nam);
 
     for (i = 0; environ[i]; i++) {
        if (