From: Andy Lester <andy@petdance.com>
Date: Sun, 27 Mar 2005 15:57:22 +0000 (-0600)
Subject: The core part of :
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=06b5626a89944244c0525ddbf02b7279497dc8e6;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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)
 {