From: Nicholas Clark Date: Fri, 10 Jun 2005 23:12:29 +0000 (+0000) Subject: More SvPV consting. And other related drive-by refactoring. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cfd0369c40b647df9444518ec26b924a57e14ac8;p=p5sagit%2Fp5-mst-13.2.git More SvPV consting. And other related drive-by refactoring. p4raw-id: //depot/perl@24800 --- diff --git a/regcomp.c b/regcomp.c index 6f28be4..02cece8 100644 --- a/regcomp.c +++ b/regcomp.c @@ -1069,7 +1069,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) { SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0); PerlIO_printf( Perl_debug_log, "%s:%3X=%04"UVXf" | ", - SvPV_nolen( *tmp ), + SvPV_nolen_const( *tmp ), TRIE_LIST_ITEM(state,charid).forid, (UV)TRIE_LIST_ITEM(state,charid).newstate ); @@ -1266,7 +1266,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { SV **tmp = av_fetch( trie->revcharmap, charid, 0); if ( tmp ) { - PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) ); + PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) ); } } @@ -1423,7 +1423,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *firs for( state = 0 ; state < trie->uniquecharcount ; state++ ) { SV **tmp = av_fetch( trie->revcharmap, state, 0); if ( tmp ) { - PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) ); + PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) ); } } PerlIO_printf( Perl_debug_log, "\n-----:-----------------------"); @@ -1564,7 +1564,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg SV *mysv=sv_newmortal(); regprop( mysv, scan); PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n", - (int)depth*2, "", SvPV_nolen(mysv), PTR2UV(scan)); + (int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan)); }); if (PL_regkind[(U8)OP(scan)] == EXACT) { @@ -1858,7 +1858,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg DEBUG_OPTIMISE_r({ regprop( mysv, tail ); PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n", - (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ), + (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen_const( mysv ), (RExC_seen_evals) ? "[EVAL]" : "" ); }); @@ -1895,16 +1895,16 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg DEBUG_OPTIMISE_r({ regprop( mysv, cur); PerlIO_printf( Perl_debug_log, "%*s%s", - (int)depth * 2 + 2," ", SvPV_nolen( mysv ) ); + (int)depth * 2 + 2," ", SvPV_nolen_const( mysv ) ); regprop( mysv, noper); PerlIO_printf( Perl_debug_log, " -> %s", - SvPV_nolen(mysv)); + SvPV_nolen_const(mysv)); if ( noper_next ) { regprop( mysv, noper_next ); PerlIO_printf( Perl_debug_log,"\t=> %s\t", - SvPV_nolen(mysv)); + SvPV_nolen_const(mysv)); } PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n", first, last, cur ); @@ -1922,20 +1922,20 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg if (!last ) { regprop( mysv, first); PerlIO_printf( Perl_debug_log, "%*s%s", - (int)depth * 2 + 2, "F:", SvPV_nolen( mysv ) ); + (int)depth * 2 + 2, "F:", SvPV_nolen_const( mysv ) ); regprop( mysv, NEXTOPER(first) ); PerlIO_printf( Perl_debug_log, " -> %s\n", - SvPV_nolen( mysv ) ); + SvPV_nolen_const( mysv ) ); } ); last = cur; DEBUG_OPTIMISE_r({ regprop( mysv, cur); PerlIO_printf( Perl_debug_log, "%*s%s", - (int)depth * 2 + 2, "N:", SvPV_nolen( mysv ) ); + (int)depth * 2 + 2, "N:", SvPV_nolen_const( mysv ) ); regprop( mysv, noper ); PerlIO_printf( Perl_debug_log, " -> %s\n", - SvPV_nolen( mysv ) ); + SvPV_nolen_const( mysv ) ); }); } } else { @@ -1964,7 +1964,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg regprop( mysv, cur); PerlIO_printf( Perl_debug_log, "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2, - " ", SvPV_nolen( mysv ), first, last, cur); + " ", SvPV_nolen_const( mysv ), first, last, cur); }); if ( last ) { @@ -2341,7 +2341,7 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg #if defined(SPARC64_GCC_WORKAROUND) I32 b = 0; STRLEN l = 0; - char *s = NULL; + const char *s = NULL; I32 old = 0; if (pos_before >= data->last_start_min) @@ -2350,14 +2350,14 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, I32 *deltap, reg b = data->last_start_min; l = 0; - s = SvPV(data->last_found, l); + s = SvPV_const(data->last_found, l); old = b - data->last_start_min; #else I32 b = pos_before >= data->last_start_min ? pos_before : data->last_start_min; STRLEN l; - char *s = SvPV(data->last_found, l); + const char *s = SvPV_const(data->last_found, l); I32 old = b - data->last_start_min; #endif @@ -5963,9 +5963,9 @@ Perl_re_intuit_string(pTHX_ regexp *prog) { /* Assume that RE_INTUIT is set */ GET_RE_DEBUG_FLAGS_DECL; DEBUG_COMPILE_r( - { STRLEN n_a; - const char *s = SvPV(prog->check_substr - ? prog->check_substr : prog->check_utf8, n_a); + { + const char *s = SvPV_nolen_const(prog->check_substr + ? prog->check_substr : prog->check_utf8); if (!PL_colorset) reginitcolors(); PerlIO_printf(Perl_debug_log, @@ -6148,7 +6148,7 @@ S_re_croak2(pTHX_ const char* pat1,const char* pat2,...) #endif msv = vmess(buf, &args); va_end(args); - message = SvPV(msv,l1); + message = SvPV_const(msv,l1); if (l1 > 512) l1 = 512; Copy(message, buf, l1 , char); @@ -6310,7 +6310,7 @@ S_dumpuntil(pTHX_ regnode *start, regnode *node, regnode *last, SV* sv, I32 l) PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n", (int)(2*(l+4)), "", PL_colors[0], - SvPV_nolen(*elem_ptr), + SvPV_nolen_const(*elem_ptr), PL_colors[1] ); /* diff --git a/regexec.c b/regexec.c index d412ef8..64149d4 100644 --- a/regexec.c +++ b/regexec.c @@ -1949,8 +1949,8 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } DEBUG_EXECUTE_r({ SV *prop = sv_newmortal(); - char *s0; - char *s1; + const char *s0; + const char *s1; int len0; int len1; @@ -1958,7 +1958,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * s0 = UTF ? pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60, UNI_DISPLAY_REGEX) : - SvPVX(prop); + SvPVX_const(prop); len0 = UTF ? SvCUR(dsv0) : SvCUR(prop); s1 = UTF ? sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s; @@ -1994,7 +1994,7 @@ Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char * } else { STRLEN len; - const char * const little = SvPV(float_real, len); + const char * const little = SvPV_const(float_real, len); if (SvTAIL(float_real)) { if (memEQ(strend - len + 1, little, len - 1)) @@ -2727,7 +2727,7 @@ S_regmatch(pTHX_ regnode *prog) "%*s %sonly one match : #%d <%s>%s\n", REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], accept_buff[ 0 ].wordnum, - tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr", + tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr", PL_colors[5] ); }); PL_reginput = (char *)accept_buff[ 0 ].endpos; @@ -2762,7 +2762,7 @@ S_regmatch(pTHX_ regnode *prog) PerlIO_printf( Perl_debug_log, "%*s %strying alternation #%d <%s> at 0x%p%s\n", REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], accept_buff[best].wordnum, - tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr",scan, + tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan, PL_colors[5] ); }); if ( best= (U8 *)SvPVX(sv)) { + while (src >= (const U8 *)SvPVX_const(sv)) { if (!NATIVE_IS_INVARIANT(*src)) { U8 ch = NATIVE_TO_ASCII(*src); *dst-- = (U8)UTF8_EIGHT_BIT_LO(ch); @@ -1675,7 +1675,7 @@ S_scan_const(pTHX_ char *start) char* e = strchr(s, '}'); SV *res; STRLEN len; - char *str; + const char *str; if (!e) { yyerror("Missing right brace on \\N{}"); @@ -1697,7 +1697,7 @@ S_scan_const(pTHX_ char *start) res, Nullsv, "\\N{...}" ); if (has_utf8) sv_utf8_upgrade(res); - str = SvPV(res,len); + str = SvPV_const(res,len); #ifdef EBCDIC_NEVER_MIND /* charnames uses pack U and that has been * recently changed to do the below uni->native @@ -1707,14 +1707,14 @@ S_scan_const(pTHX_ char *start) * gets revoked, but the semantics is still * desireable for charnames. --jhi */ { - UV uv = utf8_to_uvchr((U8*)str, 0); + UV uv = utf8_to_uvchr((const U8*)str, 0); if (uv < 0x100) { U8 tmpbuf[UTF8_MAXBYTES+1], *d; d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv)); sv_setpvn(res, (char *)tmpbuf, d - tmpbuf); - str = SvPV(res, len); + str = SvPV_const(res, len); } } #endif @@ -2226,7 +2226,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen) funcp = DPTR2FPTR(filter_t, IoANY(datasv)); DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_read %d: via function %p (%s)\n", - idx, datasv, SvPV_nolen(datasv))); + idx, datasv, SvPV_nolen_const(datasv))); /* Call function. The function is expected to */ /* call "FILTER_READ(idx+1, buf_sv)" first. */ /* Return: <0:error, =0:eof, >0:not eof */ @@ -2774,8 +2774,8 @@ Perl_yylex(pTHX) else { STRLEN blen; STRLEN llen; - const char *bstart = SvPV(CopFILESV(PL_curcop),blen); - const char *lstart = SvPV(x,llen); + const char *bstart = SvPV_const(CopFILESV(PL_curcop),blen); + const char *lstart = SvPV_const(x,llen); if (llen < blen) { bstart += blen - llen; if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') { @@ -3894,6 +3894,8 @@ Perl_yylex(pTHX) if (!s) missingterm((char*)0); yylval.ival = OP_CONST; + /* FIXME. I think that this can be const if char *d is replaced by + more localised variables. */ for (d = SvPV(PL_lex_stuff, len); len; len--, d++) { if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) { yylval.ival = OP_STRINGIFY; @@ -4272,7 +4274,7 @@ Perl_yylex(pTHX) /* Is there a prototype? */ if (SvPOK(cv)) { STRLEN len; - char *proto = SvPV((SV*)cv, len); + const char *proto = SvPV_const((SV*)cv, len); if (!len) TERM(FUNC0SUB); if (*proto == '$' && proto[1] == '\0') @@ -9645,7 +9647,7 @@ S_scan_inputsymbol(pTHX_ char *start) { register char *s = start; /* current position in buffer */ register char *d; - register char *e; + const char *e; char *end; I32 len; diff --git a/universal.c b/universal.c index 8f706cb..0a729e9 100644 --- a/universal.c +++ b/universal.c @@ -395,13 +395,13 @@ XS(XS_version_new) Perl_croak(aTHX_ "Usage: version::new(class, version)"); SP -= items; { - const char *classname = SvPV_nolen(ST(0)); + const char *classname = SvPV_nolen_const(ST(0)); SV *vs = ST(1); SV *rv; if (items == 3 ) { vs = sv_newmortal(); - Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen(ST(2))); + Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2))); } rv = new_version(vs); diff --git a/utf8.c b/utf8.c index 625d3b6..b26d5a6 100644 --- a/utf8.c +++ b/utf8.c @@ -1476,9 +1476,9 @@ Perl_to_utf8_case(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp, SV **swashp, const if ((hv = get_hv(special, FALSE)) && (svp = hv_fetch(hv, (const char*)tmpbuf, UNISKIP(uv1), FALSE)) && (*svp)) { - char *s; + const char *s; - s = SvPV(*svp, len); + s = SvPV_const(*svp, len); if (len == 1) len = uvuni_to_utf8(ustrp, NATIVE_TO_UNI(*(U8*)s)) - ustrp; else { @@ -1674,7 +1674,7 @@ Perl_swash_init(pTHX_ const char* pkg, const char* name, SV *listsv, I32 minbits POPSTACK; if (IN_PERL_COMPILETIME) { STRLEN len; - const char* pv = SvPV(tokenbufsv, len); + const char* pv = SvPV_const(tokenbufsv, len); Copy(pv, PL_tokenbuf, len+1, char); PL_curcop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK); @@ -1703,7 +1703,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8) U32 off; STRLEN slen; STRLEN needents; - U8 *tmps = NULL; + const U8 *tmps = NULL; U32 bit; SV *retval; U8 tmputf8[2]; @@ -1758,7 +1758,7 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8) SV** svp = hv_fetch(hv, (const char*)ptr, klen, FALSE); /* If not cached, generate it via utf8::SWASHGET */ - if (!svp || !SvPOK(*svp) || !(tmps = (U8*)SvPV(*svp, slen))) { + if (!svp || !SvPOK(*svp) || !(tmps = (const U8*)SvPV_const(*svp, slen))) { dSP; /* We use utf8n_to_uvuni() as we want an index into Unicode tables, not a native character number. @@ -1801,7 +1801,8 @@ Perl_swash_fetch(pTHX_ SV *sv, const U8 *ptr, bool do_utf8) PL_last_swash_hv = hv; PL_last_swash_klen = klen; - PL_last_swash_tmps = tmps; + /* FIXME change interpvar.h? */ + PL_last_swash_tmps = (U8 *) tmps; PL_last_swash_slen = slen; if (klen) Copy(ptr, PL_last_swash_key, klen, U8); @@ -1969,8 +1970,8 @@ The pointer to the PV of the dsv is returned. char * Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) { - return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv), - pvlim, flags); + return Perl_pv_uni_display(aTHX_ dsv, (const U8*)SvPVX_const(ssv), + SvCUR(ssv), pvlim, flags); } /* diff --git a/util.c b/util.c index ae831e4..6df4ebf 100644 --- a/util.c +++ b/util.c @@ -634,13 +634,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) { - register unsigned char *big; + const register unsigned char *big; register I32 pos; register I32 previous; register I32 first; - register unsigned char *little; + const register unsigned char *little; register I32 stop_pos; - register unsigned char *littleend; + const register unsigned char *littleend; I32 found = 0; if (*old_posp == -1 @@ -649,7 +649,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift cant_find: if ( BmRARE(littlestr) == '\n' && BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) { - little = (unsigned char *)(SvPVX(littlestr)); + little = (const unsigned char *)(SvPVX_const(littlestr)); littleend = little + SvCUR(littlestr); first = *little++; goto check_tail; @@ -657,12 +657,12 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift return Nullch; } - little = (unsigned char *)(SvPVX(littlestr)); + little = (const unsigned char *)(SvPVX_const(littlestr)); littleend = little + SvCUR(littlestr); first = *little++; /* The value of pos we can start at: */ previous = BmPREVIOUS(littlestr); - big = (unsigned char *)(SvPVX(bigstr)); + big = (const unsigned char *)(SvPVX_const(bigstr)); /* The value of pos we can stop at: */ stop_pos = SvCUR(bigstr) - end_shift - (SvCUR(littlestr) - 1 - previous); if (previous + start_shift > stop_pos) { @@ -682,7 +682,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift } big -= previous; do { - register unsigned char *s, *x; + const register unsigned char *s, *x; if (pos >= stop_pos) break; if (big[pos] != first) continue; @@ -704,7 +704,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift if (!SvTAIL(littlestr) || (end_shift > 0)) return Nullch; /* Ignore the trailing "\n". This code is not microoptimized */ - big = (unsigned char *)(SvPVX(bigstr) + SvCUR(bigstr)); + big = (const unsigned char *)(SvPVX_const(bigstr) + SvCUR(bigstr)); stop_pos = littleend - little; /* Actual littlestr len */ if (stop_pos == 0) return (char*)big; @@ -1108,22 +1108,22 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8) } } -STATIC char * +STATIC const char * S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen, I32* utf8) { dVAR; - char *message; + const char *message; if (pat) { SV *msv = vmess(pat, args); if (PL_errors && SvCUR(PL_errors)) { sv_catsv(PL_errors, msv); - message = SvPV(PL_errors, *msglen); + message = SvPV_const(PL_errors, *msglen); SvCUR_set(PL_errors, 0); } else - message = SvPV(msv,*msglen); + message = SvPV_const(msv,*msglen); *utf8 = SvUTF8(msv); } else { @@ -1203,7 +1203,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) JMPENV_JUMP(3); } else if (!message) - message = SvPVx(ERRSV, msglen); + message = SvPVx_const(ERRSV, msglen); write_to_stderr(message, msglen); my_failure_exit(); @@ -1256,7 +1256,7 @@ void Perl_vwarn(pTHX_ const char* pat, va_list *args) { dVAR; - char *message; + const char *message; HV *stash; GV *gv; CV *cv; @@ -1266,7 +1266,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) msv = vmess(pat, args); utf8 = SvUTF8(msv); - message = SvPV(msv, msglen); + message = SvPV_const(msv, msglen); if (PL_warnhook) { /* sv_2cv might call Perl_warn() */ @@ -1359,7 +1359,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) if (ckDEAD(err)) { SV * const msv = vmess(pat, args); STRLEN msglen; - const char *message = SvPV(msv, msglen); + const char *message = SvPV_const(msv, msglen); const I32 utf8 = SvUTF8(msv); if (PL_diehook) { diff --git a/xsutils.c b/xsutils.c index 7b968cf..b22a263 100644 --- a/xsutils.c +++ b/xsutils.c @@ -61,7 +61,7 @@ modify_SV_attributes(pTHX_ SV *sv, SV **retlist, SV **attrlist, int numattrs) for (nret = 0 ; numattrs && (attr = *attrlist++); numattrs--) { STRLEN len; - const char *name = SvPV(attr, len); + const char *name = SvPV_const(attr, len); const bool negated = (*name == '-'); if (negated) {