The core part of :

Subject: [PATCH] Consting seven
Message-ID: <20050327215722.GC20451@petdance.com>

p4raw-id: //depot/perl@24094

diff --git a/embed.fnc b/embed.fnc
index b66185b..0fe73ec 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1073,14 +1073,14 @@ s       |OP*    |dofindlabel    |OP *o|const char *label|OP **opstack|OP **oplimit
 s      |OP*    |doparseform    |SV *sv
 sn     |bool   |num_overflow   |NV value|I32 fldsize|I32 frcsize
 s      |I32    |dopoptoeval    |I32 startingblock
-s      |I32    |dopoptolabel   |char *label
+s      |I32    |dopoptolabel   |const char *label
 s      |I32    |dopoptoloop    |I32 startingblock
 s      |I32    |dopoptosub     |I32 startingblock
 s      |I32    |dopoptosub_at  |PERL_CONTEXT* cxstk|I32 startingblock
 s      |void   |save_lines     |AV *array|SV *sv
 s      |OP*    |doeval         |int gimme|OP** startop|CV* outside|U32 seq
 s      |PerlIO *|doopen_pm     |const char *name|const char *mode
-s      |bool   |path_is_absolute|char *name
+s      |bool   |path_is_absolute|const char *name
 #endif
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
@@ -1153,7 +1153,7 @@ Es        |U8*    |reghop         |U8 *pos|I32 off
 Es     |U8*    |reghop3        |U8 *pos|I32 off|U8 *lim
 Es     |U8*    |reghopmaybe    |U8 *pos|I32 off
 Es     |U8*    |reghopmaybe3   |U8 *pos|I32 off|U8 *lim
-Es     |char*  |find_byclass   |regexp * prog|regnode *c|char *s|char *strend|char *startpos|I32 norun
+Es     |char*  |find_byclass   |regexp * prog|regnode *c|char *s|char *strend|I32 norun
 Es     |void   |to_utf8_substr |regexp * prog
 Es     |void   |to_byte_substr |regexp * prog
 #endif

diff --git a/embed.h b/embed.h
index 1cca988..d44d411 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -4274,7 +4274,7 @@
 #define reghopmaybe3(a,b,c)    S_reghopmaybe3(aTHX_ a,b,c)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
-#define find_byclass(a,b,c,d,e,f)      S_find_byclass(aTHX_ a,b,c,d,e,f)
+#define find_byclass(a,b,c,d,e)        S_find_byclass(aTHX_ a,b,c,d,e)
 #endif
 #if defined(PERL_CORE) || defined(PERL_EXT)
 #define to_utf8_substr(a)      S_to_utf8_substr(aTHX_ a)

diff --git a/perl.c b/perl.c
index 118c1f4..806ba39 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2569,7 +2569,7 @@ Perl_moreswitches(pTHX_ char *s)
        /* The following permits -d:Mod to accepts arguments following an =
           in the fashion that -MSome::Mod does. */
        if (*s == ':' || *s == '=') {
-           char *start;
+            const char *start;
            SV *sv;
            sv = newSVpv("use Devel::", 0);
            start = ++s;

diff --git a/perlio.c b/perlio.c
index 4d2b6a9..46afce7 100644 (file)
--- a/perlio.c
+++ b/perlio.c
@@ -4744,6 +4744,7 @@ PerlIO_getname(PerlIO *f, char *buf)
     (void)f;
     (void)buf;
     Perl_croak(aTHX_ "Don't know how to get file name");
+    return Nullch;
 #endif
 }
 

diff --git a/pp_ctl.c b/pp_ctl.c
index 7ba6d0a..5b850d2 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1195,13 +1195,12 @@ static const char *context_name[] = {
 };
 
 STATIC I32
-S_dopoptolabel(pTHX_ char *label)
+S_dopoptolabel(pTHX_ const char *label)
 {
     register I32 i;
-    register PERL_CONTEXT *cx;
 
     for (i = cxstack_ix; i >= 0; i--) {
-       cx = &cxstack[i];
+       register const PERL_CONTEXT *cx = &cxstack[i];
        switch (CxTYPE(cx)) {
        case CXt_SUBST:
        case CXt_SUB:
@@ -1238,9 +1237,7 @@ Perl_dowantarray(pTHX)
 I32
 Perl_block_gimme(pTHX)
 {
-    I32 cxix;
-
-    cxix = dopoptosub(cxstack_ix);
+    const I32 cxix = dopoptosub(cxstack_ix);
     if (cxix < 0)
        return G_VOID;
 
@@ -1261,9 +1258,7 @@ Perl_block_gimme(pTHX)
 I32
 Perl_is_lvalue_sub(pTHX)
 {
-    I32 cxix;
-
-    cxix = dopoptosub(cxstack_ix);
+    const I32 cxix = dopoptosub(cxstack_ix);
     assert(cxix >= 0);  /* We should only be called from inside subs */
 
     if (cxstack[cxix].blk_sub.lval && CvLVALUE(cxstack[cxix].blk_sub.cv))
@@ -1282,9 +1277,8 @@ STATIC I32
 S_dopoptosub_at(pTHX_ PERL_CONTEXT *cxstk, I32 startingblock)
 {
     I32 i;
-    register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
-       cx = &cxstk[i];
+        register const PERL_CONTEXT *cx = &cxstk[i];
        switch (CxTYPE(cx)) {
        default:
            continue;
@@ -1302,9 +1296,8 @@ STATIC I32
 S_dopoptoeval(pTHX_ I32 startingblock)
 {
     I32 i;
-    register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
-       cx = &cxstack[i];
+       register const PERL_CONTEXT *cx = &cxstack[i];
        switch (CxTYPE(cx)) {
        default:
            continue;
@@ -1320,9 +1313,8 @@ STATIC I32
 S_dopoptoloop(pTHX_ I32 startingblock)
 {
     I32 i;
-    register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
-       cx = &cxstack[i];
+       register const PERL_CONTEXT *cx = &cxstack[i];
        switch (CxTYPE(cx)) {
        case CXt_SUBST:
        case CXt_SUB:
@@ -1346,12 +1338,11 @@ S_dopoptoloop(pTHX_ I32 startingblock)
 void
 Perl_dounwind(pTHX_ I32 cxix)
 {
-    register PERL_CONTEXT *cx;
     I32 optype;
 
     while (cxstack_ix > cxix) {
        SV *sv;
-       cx = &cxstack[cxstack_ix];
+        register PERL_CONTEXT *cx = &cxstack[cxstack_ix];
        DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
                              (long) cxstack_ix, PL_block_type[CxTYPE(cx)]));
        /* Note: we don't need to restore the base context info till the end. */
@@ -1405,7 +1396,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
            if (PL_in_eval & EVAL_KEEPERR) {
                 static const char prefix[] = "\t(in cleanup) ";
                SV *err = ERRSV;
-               char *e = Nullch;
+                const char *e = Nullch;
                if (!SvPOK(err))
                    sv_setpv(err,"");
                else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
@@ -1555,7 +1546,7 @@ PP(pp_caller)
     PERL_SI *top_si = PL_curstackinfo;
     I32 dbcxix;
     I32 gimme;
-    char *stashname;
+    const char *stashname;
     SV *sv;
     I32 count = 0;
 
@@ -1664,7 +1655,7 @@ PP(pp_caller)
        && CopSTASH_eq(PL_curcop, PL_debstash))
     {
        AV *ary = cx->blk_sub.argarray;
-       int off = AvARRAY(ary) - AvALLOC(ary);
+        const int off = AvARRAY(ary) - AvALLOC(ary);
 
        if (!PL_dbargs) {
            GV* tmpgv;
@@ -2652,9 +2643,9 @@ PP(pp_cswitch)
 STATIC void
 S_save_lines(pTHX_ AV *array, SV *sv)
 {
-    register char *s = SvPVX(sv);
-    register char *send = SvPVX(sv) + SvCUR(sv);
-    register char *t;
+    register const char *s = SvPVX(sv);
+    register const char *send = SvPVX(sv) + SvCUR(sv);
+    register const char *t;
     register I32 line = 1;
 
     while (s && s < send) {
@@ -2684,7 +2675,7 @@ STATIC OP *
 S_docatch(pTHX_ OP *o)
 {
     int ret;
-    OP *oldop = PL_op;
+    OP * const oldop = PL_op;
     OP *retop;
     volatile PERL_SI *cursi = PL_curstackinfo;
     dJMPENV;
@@ -2835,15 +2826,14 @@ than in in the scope of the debugger itself).
 CV*
 Perl_find_runcv(pTHX_ U32 *db_seqp)
 {
-    I32                 ix;
     PERL_SI     *si;
-    PERL_CONTEXT *cx;
 
     if (db_seqp)
        *db_seqp = PL_curcop->cop_seq;
     for (si = PL_curstackinfo; si; si = si->si_prev) {
+        I32 ix;
        for (ix = si->si_cxix; ix >= 0; ix--) {
-           cx = &(si->si_cxstack[ix]);
+           const PERL_CONTEXT *cx = &(si->si_cxstack[ix]);
            if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
                CV *cv = cx->blk_sub.cv;
                /* skip DB:: code */
@@ -2937,7 +2927,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
        lex_end();
        LEAVE;
        if (optype == OP_REQUIRE) {
-           char* msg = SvPVx(ERRSV, n_a);
+            const char* msg = SvPVx(ERRSV, n_a);
            SV *nsv = cx->blk_eval.old_namesv;
            (void)hv_store(GvHVn(PL_incgv), SvPVX(nsv), SvCUR(nsv),
                           &PL_sv_undef, 0);
@@ -2945,7 +2935,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
                *msg ? msg : "Unknown error\n");
        }
        else if (startop) {
-           char* msg = SvPVx(ERRSV, n_a);
+            const char* msg = SvPVx(ERRSV, n_a);
 
            POPBLOCK(cx,PL_curpm);
            POPEVAL(cx);
@@ -2953,7 +2943,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
                       (*msg ? msg : "Unknown error\n"));
        }
        else {
-           char* msg = SvPVx(ERRSV, n_a);
+            const char* msg = SvPVx(ERRSV, n_a);
            if (!*msg) {
                sv_setpv(ERRSV, "Compilation error");
            }
@@ -3014,7 +3004,7 @@ S_doopen_pm(pTHX_ const char *name, const char *mode)
 
     if (namelen > 3 && strEQ(name + namelen - 3, ".pm")) {
        SV *pmcsv = Perl_newSVpvf(aTHX_ "%s%c", name, 'c');
-       char *pmc = SvPV_nolen(pmcsv);
+       const char * const pmc = SvPV_nolen(pmcsv);
        Stat_t pmstat;
        Stat_t pmcstat;
        if (PerlLIO_stat(pmc, &pmcstat) < 0) {
@@ -3462,7 +3452,7 @@ PP(pp_leaveeval)
     I32 gimme;
     register PERL_CONTEXT *cx;
     OP *retop;
-    U8 save_flags = PL_op -> op_flags;
+    const U8 save_flags = PL_op -> op_flags;
     I32 optype;
 
     POPBLOCK(cx,newpm);
@@ -3719,9 +3709,7 @@ S_doparseform(pTHX_ SV *sv)
                while (*s == '#')
                    s++;
                if (*s == '.') {
-                   char *f;
-                   s++;
-                   f = s;
+                    const char * const f = ++s;
                    while (*s == '#')
                        s++;
                    arg |= 256 + (s - f);
@@ -3738,9 +3726,7 @@ S_doparseform(pTHX_ SV *sv)
                 while (*s == '#')
                     s++;
                 if (*s == '.') {
-                    char *f;
-                    s++;
-                    f = s;
+                    const char * const f = ++s;
                     while (*s == '#')
                         s++;
                     arg |= 256 + (s - f);
@@ -3910,7 +3896,7 @@ run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 /* perhaps someone can come up with a better name for
    this?  it is not really "absolute", per se ... */
 static bool
-S_path_is_absolute(pTHX_ char *name)
+S_path_is_absolute(pTHX_ const char *name)
 {
     if (PERL_FILE_IS_ABSOLUTE(name)
 #ifdef MACOS_TRADITIONAL

diff --git a/proto.h b/proto.h
index a25b59c..3ab47d8 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1032,14 +1032,14 @@ STATIC OP*      S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **opli
 STATIC OP*     S_doparseform(pTHX_ SV *sv);
 STATIC bool    S_num_overflow(NV value, I32 fldsize, I32 frcsize);
 STATIC I32     S_dopoptoeval(pTHX_ I32 startingblock);
-STATIC I32     S_dopoptolabel(pTHX_ char *label);
+STATIC I32     S_dopoptolabel(pTHX_ const char *label);
 STATIC I32     S_dopoptoloop(pTHX_ I32 startingblock);
 STATIC I32     S_dopoptosub(pTHX_ I32 startingblock);
 STATIC I32     S_dopoptosub_at(pTHX_ PERL_CONTEXT* cxstk, I32 startingblock);
 STATIC void    S_save_lines(pTHX_ AV *array, SV *sv);
 STATIC OP*     S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq);
 STATIC PerlIO *        S_doopen_pm(pTHX_ const char *name, const char *mode);
-STATIC bool    S_path_is_absolute(pTHX_ char *name);
+STATIC bool    S_path_is_absolute(pTHX_ const char *name);
 #endif
 
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
@@ -1105,7 +1105,7 @@ STATIC U8*        S_reghop(pTHX_ U8 *pos, I32 off);
 STATIC U8*     S_reghop3(pTHX_ U8 *pos, I32 off, U8 *lim);
 STATIC U8*     S_reghopmaybe(pTHX_ U8 *pos, I32 off);
 STATIC U8*     S_reghopmaybe3(pTHX_ U8 *pos, I32 off, U8 *lim);
-STATIC char*   S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun);
+STATIC char*   S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, I32 norun);
 STATIC void    S_to_utf8_substr(pTHX_ regexp * prog);
 STATIC void    S_to_byte_substr(pTHX_ regexp * prog);
 #endif

diff --git a/regcomp.c b/regcomp.c
index 834488a..30c492b 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -2795,7 +2795,7 @@ Perl_reginitcolors(pTHX)
        }
     } else {
        while (i < 6)
-           PL_colors[i++] = "";
+           PL_colors[i++] = (char *)"";
     }
     PL_colorset = 1;
 }

diff --git a/regexec.c b/regexec.c
index 5933f1a..959159b 100644 (file)
--- a/regexec.c
+++ b/regexec.c
@@ -857,8 +857,8 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
           regstclass does not come from lookahead...  */
        /* If regstclass takes bytelength more than 1: If charlength==1, OK.
           This leaves EXACTF only, which is dealt with in find_byclass().  */
-       U8* str = (U8*)STRING(prog->regstclass);
-       int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
+        const U8* str = (U8*)STRING(prog->regstclass);
+        const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
                    ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
                    : 1);
        char *endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
@@ -867,11 +867,10 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
                   ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
                           cl_l, strend)
                   : strend);
-       char *startpos = strbeg;
 
        t = s;
        cache_re(prog);
-       s = find_byclass(prog, prog->regstclass, s, endpos, startpos, 1);
+        s = find_byclass(prog, prog->regstclass, s, endpos, 1);
        if (!s) {
 #ifdef DEBUGGING
            const char *what = 0;
@@ -964,7 +963,7 @@ Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
 
 /* We know what class REx starts with.  Try to find this position... */
 STATIC char *
-S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *startpos, I32 norun)
+S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, I32 norun)
 {
        I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
        char *m;
@@ -1963,7 +1962,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
                          len0, len0, s0,
                          len1, len1, s1);
        });
-       if (find_byclass(prog, c, s, strend, startpos, 0))
+        if (find_byclass(prog, c, s, strend, 0))
            goto got_it;
        DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
     }
@@ -1989,7 +1988,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *
            }
            else {
                STRLEN len;
-               char *little = SvPV(float_real, len);
+                const char * const little = SvPV(float_real, len);
 
                if (SvTAIL(float_real)) {
                    if (memEQ(strend - len + 1, little, len - 1))
@@ -4892,6 +4891,7 @@ S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
 static void
 restore_pos(pTHX_ void *arg)
 {
+    (void)arg; /* unused */
     if (PL_reg_eval_set) {
        if (PL_reg_oldsaved) {
            PL_reg_re->subbeg = PL_reg_oldsaved;

diff --git a/util.c b/util.c
index b6a2ebc..b3cb7a6 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1068,7 +1068,7 @@ Perl_write_to_stderr(pTHX_ const char* message, int msglen)
 
 void S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8);
 
-char *
+STATIC char *
 S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
                    I32* utf8)
 {