Propagate const/mutable/not into the SvPV call for retrieving an
[p5sagit/p5-mst-13.2.git] / util.c
diff --git a/util.c b/util.c
index a0135e4..6df4ebf 100644 (file)
--- a/util.c
+++ b/util.c
@@ -261,7 +261,6 @@ Perl_delimcpy(pTHX_ register char *to, register const char *toend, register cons
 char *
 Perl_instr(pTHX_ register const char *big, register const char *little)
 {
-    register const char *s, *x;
     register I32 first;
 
     if (!little)
@@ -270,6 +269,7 @@ Perl_instr(pTHX_ register const char *big, register const char *little)
     if (!first)
        return (char*)big;
     while (*big) {
+       register const char *s, *x;
        if (*big++ != first)
            continue;
        for (x=big,s=little; *s; /**/ ) {
@@ -291,7 +291,6 @@ Perl_instr(pTHX_ register const char *big, register const char *little)
 char *
 Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const char *little, const char *lend)
 {
-    register const char *s, *x;
     register const I32 first = *little;
     register const char *littleend = lend;
 
@@ -301,6 +300,7 @@ Perl_ninstr(pTHX_ register const char *big, register const char *bigend, const c
        return Nullch;
     bigend -= littleend - little++;
     while (big <= bigend) {
+       register const char *s, *x;
        if (*big++ != first)
            continue;
        for (x=big,s=little; s < littleend; /**/ ) {
@@ -321,7 +321,6 @@ char *
 Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *little, const char *lend)
 {
     register const char *bigbeg;
-    register const char *s, *x;
     register const I32 first = *little;
     register const char *littleend = lend;
 
@@ -330,6 +329,7 @@ Perl_rninstr(pTHX_ register const char *big, const char *bigend, const char *lit
     bigbeg = big;
     big = bigend - (littleend - little++);
     while (big >= bigbeg) {
+       register const char *s, *x;
        if (*big-- != first)
            continue;
        for (x=big+2,s=little; s < littleend; /**/ ) {
@@ -384,13 +384,9 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     if (len == 0)              /* TAIL might be on a zero-length string. */
        return;
     if (len > 2) {
-       U8 mlen;
        const unsigned char *sb;
+       const U8 mlen = (len>255) ? 255 : (U8)len;
 
-       if (len > 255)
-           mlen = 255;
-       else
-           mlen = (U8)len;
        Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET);
        table = (unsigned char*)(SvPVX_mutable(sv) + len + FBM_TABLE_OFFSET);
        s = table - 1 - FBM_TABLE_OFFSET;       /* last char */
@@ -492,8 +488,8 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
            /* This should be better than FBM if c1 == c2, and almost
               as good otherwise: maybe better since we do less indirection.
               And we save a lot of memory by caching no table. */
-           register unsigned char c1 = little[0];
-           register unsigned char c2 = little[1];
+           const unsigned char c1 = little[0];
+           const unsigned char c2 = little[1];
 
            s = big + 1;
            bigend--;
@@ -595,7 +591,7 @@ Perl_fbm_instr(pTHX_ unsigned char *big, register unsigned char *bigend, SV *lit
                goto check_end;
            }
            else {              /* less expensive than calling strncmp() */
-               register unsigned char *olds = s;
+               register unsigned char * const olds = s;
 
                tmp = littlelen;
 
@@ -638,14 +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 *s, *x;
-    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
@@ -654,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;
@@ -662,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) {
@@ -687,6 +682,7 @@ Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift
     }
     big -= previous;
     do {
+       const register unsigned char *s, *x;
        if (pos >= stop_pos) break;
        if (big[pos] != first)
            continue;
@@ -708,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;
@@ -765,20 +761,15 @@ be freed with the C<Safefree()> function.
 char *
 Perl_savepv(pTHX_ const char *pv)
 {
-    register char *newaddr;
-#ifdef PERL_MALLOC_WRAP
-    STRLEN pvlen;
-#endif
     if (!pv)
        return Nullch;
+    else {
+       char *newaddr;
+       const STRLEN pvlen = strlen(pv)+1;
+       New(902,newaddr,pvlen,char);
+       return strcpy(newaddr,pv);
+    }
 
-#ifdef PERL_MALLOC_WRAP
-    pvlen = strlen(pv)+1;
-    New(902,newaddr,pvlen,char);
-#else
-    New(902,newaddr,strlen(pv)+1,char);
-#endif
-    return strcpy(newaddr,pv);
 }
 
 /* same thing but with a known length */
@@ -848,7 +839,7 @@ char *
 Perl_savesvpv(pTHX_ SV *sv)
 {
     STRLEN len;
-    const char *pv = SvPV(sv, len);
+    const char *pv = SvPV_const(sv, len);
     register char *newaddr;
 
     ++len;
@@ -1117,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 {
@@ -1212,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();
@@ -1265,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;
@@ -1275,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() */
@@ -1368,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) {
@@ -2521,9 +2512,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     Pid_t pid2;
     bool close_failed;
     int saved_errno = 0;
-#ifdef VMS
-    int saved_vaxc_errno;
-#endif
 #ifdef WIN32
     int saved_win32_errno;
 #endif
@@ -2541,9 +2529,6 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
 #endif
     if ((close_failed = (PerlIO_close(ptr) == EOF))) {
        saved_errno = errno;
-#ifdef VMS
-       saved_vaxc_errno = vaxc$errno;
-#endif
 #ifdef WIN32
        saved_win32_errno = GetLastError();
 #endif
@@ -2565,7 +2550,7 @@ Perl_my_pclose(pTHX_ PerlIO *ptr)
     rsignal_restore(SIGQUIT, &qstat);
 #endif
     if (close_failed) {
-       SETERRNO(saved_errno, saved_vaxc_errno);
+       SETERRNO(saved_errno, 0);
        return -1;
     }
     return(pid2 < 0 ? pid2 : status == 0 ? 0 : (errno = 0, status));
@@ -4064,7 +4049,7 @@ Perl_vnumify(pTHX_ SV *vs)
     len = av_len((AV *)vs);
     if ( len == -1 )
     {
-       Perl_sv_catpv(aTHX_ sv,"0");
+       sv_catpvn(sv,"0",1);
        return sv;
     }
     digit = SvIVX(*av_fetch((AV *)vs, 0, 0));
@@ -4081,14 +4066,14 @@ Perl_vnumify(pTHX_ SV *vs)
        if ( (int)PERL_ABS(digit) != 0 || len == 1 )
        {
            if ( digit < 0 ) /* alpha version */
-               Perl_sv_catpv(aTHX_ sv,"_");
+               sv_catpvn(sv,"_",1);
            /* Don't display additional trailing zeros */
            Perl_sv_catpvf(aTHX_ sv,"%03d", (int)PERL_ABS(digit));
        }
     }
     else /* len == 0 */
     {
-        Perl_sv_catpv(aTHX_ sv,"000");
+        sv_catpvn(sv,"000",3);
     }
     return sv;
 }
@@ -4117,7 +4102,7 @@ Perl_vnormal(pTHX_ SV *vs)
     len = av_len((AV *)vs);
     if ( len == -1 )
     {
-       Perl_sv_catpv(aTHX_ sv,"");
+       sv_catpvn(sv,"",0);
        return sv;
     }
     digit = SvIVX(*av_fetch((AV *)vs, 0, 0));
@@ -4133,7 +4118,7 @@ Perl_vnormal(pTHX_ SV *vs)
     
     if ( len <= 2 ) { /* short version, must be at least three */
        for ( len = 2 - len; len != 0; len-- )
-           Perl_sv_catpv(aTHX_ sv,".0");
+           sv_catpvn(sv,".0",2);
     }
 
     return sv;