This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
doop.c consting, take 2
[perl5.git] / doop.c
diff --git a/doop.c b/doop.c
index cfc67cb..9583e04 100644 (file)
--- a/doop.c
+++ b/doop.c
@@ -26,24 +26,18 @@
 #endif
 
 STATIC I32
-S_do_trans_simple(pTHX_ SV *sv)
+S_do_trans_simple(pTHX_ SV * const sv)
 {
     dVAR;
-    U8 *s;
-    U8 *d;
-    const U8 *send;
-    U8 *dstart;
     I32 matches = 0;
-    const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
     STRLEN len;
+    U8 *s = (U8*)SvPV(sv,len);
+    U8 * const send = s+len;
 
     const short * const tbl = (short*)cPVOP->op_pv;
     if (!tbl)
        Perl_croak(aTHX_ "panic: do_trans_simple line %d",__LINE__);
 
-    s = (U8*)SvPV(sv, len);
-    send = s + len;
-
     /* First, take care of non-UTF-8 input strings, because they're easy */
     if (!SvUTF8(sv)) {
        while (s < send) {
@@ -55,66 +49,68 @@ S_do_trans_simple(pTHX_ SV *sv)
            s++;
        }
        SvSETMAGIC(sv);
-        return matches;
-    }
-
-    /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
-    if (grows)
-       Newx(d, len*2+1, U8);
-    else
-       d = s;
-    dstart = d;
-    while (s < send) {
-        STRLEN ulen;
-       I32 ch;
-
-        /* Need to check this, otherwise 128..255 won't match */
-       const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT);
-        if (c < 0x100 && (ch = tbl[c]) >= 0) {
-            matches++;
-           d = uvchr_to_utf8(d, ch);
-            s += ulen;
-        }
-       else { /* No match -> copy */
-           Move(s, d, ulen, U8);
-           d += ulen;
-           s += ulen;
-        }
-    }
-    if (grows) {
-       sv_setpvn(sv, (char*)dstart, d - dstart);
-       Safefree(dstart);
     }
     else {
-       *d = '\0';
-       SvCUR_set(sv, d - dstart);
+       const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
+       U8 *d;
+       U8 *dstart;
+
+       /* Allow for expansion: $_="a".chr(400); tr/a/\xFE/, FE needs encoding */
+       if (grows)
+           Newx(d, len*2+1, U8);
+       else
+           d = s;
+       dstart = d;
+       while (s < send) {
+           STRLEN ulen;
+           I32 ch;
+
+           /* Need to check this, otherwise 128..255 won't match */
+           const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT);
+           if (c < 0x100 && (ch = tbl[c]) >= 0) {
+               matches++;
+               d = uvchr_to_utf8(d, ch);
+               s += ulen;
+           }
+           else { /* No match -> copy */
+               Move(s, d, ulen, U8);
+               d += ulen;
+               s += ulen;
+           }
+       }
+       if (grows) {
+           sv_setpvn(sv, (char*)dstart, d - dstart);
+           Safefree(dstart);
+       }
+       else {
+           *d = '\0';
+           SvCUR_set(sv, d - dstart);
+       }
+       SvUTF8_on(sv);
+       SvSETMAGIC(sv);
     }
-    SvUTF8_on(sv);
-    SvSETMAGIC(sv);
     return matches;
 }
 
 STATIC I32
-S_do_trans_count(pTHX_ SV *sv)
+S_do_trans_count(pTHX_ SV * const sv)
 {
     dVAR;
-    const U8 *s;
-    const U8 *send;
-    I32 matches = 0;
     STRLEN len;
+    const U8 *s = (const U8*)SvPV_const(sv, len);
+    const U8 * const send = s + len;
+    I32 matches = 0;
 
     const short * const tbl = (short*)cPVOP->op_pv;
     if (!tbl)
        Perl_croak(aTHX_ "panic: do_trans_count line %d",__LINE__);
 
-    s = (const U8*)SvPV_const(sv, len);
-    send = s + len;
-
-    if (!SvUTF8(sv))
+    if (!SvUTF8(sv)) {
        while (s < send) {
             if (tbl[*s++] >= 0)
                 matches++;
        }
+    }
     else {
        const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
        while (s < send) {
@@ -133,27 +129,22 @@ S_do_trans_count(pTHX_ SV *sv)
 }
 
 STATIC I32
-S_do_trans_complex(pTHX_ SV *sv)
+S_do_trans_complex(pTHX_ SV * const sv)
 {
     dVAR;
-    U8 *s;
-    U8 *send;
-    U8 *d;
-    U8 *dstart;
-    I32 isutf8;
+    STRLEN len;
+    U8 *s = (U8*)SvPV(sv, len);
+    U8 * const send = s+len;
     I32 matches = 0;
-    STRLEN len, rlen = 0;
 
     const short * const tbl = (short*)cPVOP->op_pv;
     if (!tbl)
        Perl_croak(aTHX_ "panic: do_trans_complex line %d",__LINE__);
 
-    s = (U8*)SvPV(sv, len);
-    isutf8 = SvUTF8(sv);
-    send = s + len;
+    if (!SvUTF8(sv)) {
+       U8 *d = s;
+       U8 * const dstart = d;
 
-    if (!isutf8) {
-       dstart = d = s;
        if (PL_op->op_private & OPpTRANS_SQUASH) {
            const U8* p = send;
            while (s < send) {
@@ -188,10 +179,13 @@ S_do_trans_complex(pTHX_ SV *sv)
        *d = '\0';
        SvCUR_set(sv, d - dstart);
     }
-    else { /* isutf8 */
+    else { /* is utf8 */
        const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
        const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
        const I32 del = PL_op->op_private & OPpTRANS_DELETE;
+       U8 *d;
+       U8 *dstart;
+       STRLEN rlen = 0;
 
        if (grows)
            Newx(d, len*2+1, U8);
@@ -215,7 +209,7 @@ S_do_trans_complex(pTHX_ SV *sv)
 
                if (comp > 0xff) {
                    if (!complement) {
-                       Copy(s, d, len, U8);
+                       Move(s, d, len, U8);
                        d += len;
                    }
                    else {
@@ -243,7 +237,7 @@ S_do_trans_complex(pTHX_ SV *sv)
                    continue;
                }
                else if (ch == -1) {    /* -1 is unmapped character */
-                   Copy(s, d, len, U8);
+                   Move(s, d, len, U8);
                    d += len;
                }
                else if (ch == -2)      /* -2 is delete character */
@@ -278,7 +272,7 @@ S_do_trans_complex(pTHX_ SV *sv)
                    matches++;
                }
                else if (ch == -1) {    /* -1 is unmapped character */
-                   Copy(s, d, len, U8);
+                   Move(s, d, len, U8);
                    d += len;
                }
                else if (ch == -2)      /* -2 is delete character */
@@ -301,7 +295,7 @@ S_do_trans_complex(pTHX_ SV *sv)
 }
 
 STATIC I32
-S_do_trans_simple_utf8(pTHX_ SV *sv)
+S_do_trans_simple_utf8(pTHX_ SV * const sv)
 {
     dVAR;
     U8 *s;
@@ -319,12 +313,10 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)
     const UV none = svp ? SvUV(*svp) : 0x7fffffff;
     const UV extra = none + 1;
     UV final = 0;
-    I32 isutf8;
     U8 hibit = 0;
 
     s = (U8*)SvPV(sv, len);
-    isutf8 = SvUTF8(sv);
-    if (!isutf8) {
+    if (!SvUTF8(sv)) {
        const U8 *t = s;
        const U8 * const e = s + len;
        while (t < e) {
@@ -402,7 +394,7 @@ S_do_trans_simple_utf8(pTHX_ SV *sv)
 }
 
 STATIC I32
-S_do_trans_count_utf8(pTHX_ SV *sv)
+S_do_trans_count_utf8(pTHX_ SV * const sv)
 {
     dVAR;
     const U8 *s;
@@ -446,7 +438,7 @@ S_do_trans_count_utf8(pTHX_ SV *sv)
 }
 
 STATIC I32
-S_do_trans_complex_utf8(pTHX_ SV *sv)
+S_do_trans_complex_utf8(pTHX_ SV * const sv)
 {
     dVAR;
     U8 *start, *send;
@@ -467,8 +459,7 @@ S_do_trans_complex_utf8(pTHX_ SV *sv)
     U8 hibit = 0;
 
     U8 *s = (U8*)SvPV(sv, len);
-    const I32 isutf8 = SvUTF8(sv);
-    if (!isutf8) {
+    if (!SvUTF8(sv)) {
        const U8 *t = s;
        const U8 * const e = s + len;
        while (t < e) {
@@ -1197,6 +1188,8 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
     rsave = rc = SvPV_nomg_const(right, rightlen);
     len = leftlen < rightlen ? leftlen : rightlen;
     lensave = len;
+    SvCUR_set(sv, len);
+    (void)SvPOK_only(sv);
     if ((left_utf || right_utf) && (sv == left || sv == right)) {
        needlen = optype == OP_BIT_AND ? len : leftlen + rightlen;
        Newxz(dc, needlen + 1, char);
@@ -1214,11 +1207,9 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
        needlen = ((optype == OP_BIT_AND)
                    ? len : (leftlen > rightlen ? leftlen : rightlen));
        Newxz(dc, needlen + 1, char);
-       (void)sv_usepvn(sv, dc, needlen);
+       sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL);
        dc = SvPVX(sv);         /* sv_usepvn() calls Renew() */
     }
-    SvCUR_set(sv, len);
-    (void)SvPOK_only(sv);
     if (left_utf || right_utf) {
        UV duc, luc, ruc;
        char *dcorig = dc;
@@ -1282,6 +1273,11 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
                *SvEND(sv) = '\0';
            Safefree(dcsave);
            break;
+       default:
+           if (sv == left || sv == right)
+               Safefree(dcorig);
+           Perl_croak(aTHX_ "panic: do_vop called for op %u (%s)",
+                       (unsigned)optype, PL_op_name[optype]);
        }
        SvUTF8_on(sv);
        goto finish;
Unnamed repository; edit this file 'description' to name the repository.