Display characters as Unicode for clarity

[p5sagit/p5-mst-13.2.git] / pp_hot.c

diff --git a/pp_hot.c b/pp_hot.c
index ab36593..a8c06b8 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -227,7 +227,7 @@ PP(pp_unstack)
 
 PP(pp_concat)
 {
-  dVAR; dSP; dATARGET; tryAMAGICbin(concat,opASSIGN);
+  dVAR; dSP; dATARGET; tryAMAGICbin_MG(concat_amg, AMGf_assign);
   {
     dPOPTOPssrl;
     bool lbyte;
@@ -236,9 +236,8 @@ PP(pp_concat)
     bool rbyte = FALSE;
     bool rcopied = FALSE;
 
-    if (TARG == right && right != left) {
-       /* mg_get(right) may happen here ... */
-       rpv = SvPV_const(right, rlen);
+    if (TARG == right && right != left) { /* $r = $l.$r */
+       rpv = SvPV_nomg_const(right, rlen);
        rbyte = !DO_UTF8(right);
        right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
        rpv = SvPV_const(right, rlen);  /* no point setting UTF-8 here */
@@ -247,7 +246,7 @@ PP(pp_concat)
 
     if (TARG != left) {
         STRLEN llen;
-        const char* const lpv = SvPV_const(left, llen);        /* mg_get(left) may happen here */
+        const char* const lpv = SvPV_nomg_const(left, llen);
        lbyte = !DO_UTF8(left);
        sv_setpvn(TARG, lpv, llen);
        if (!lbyte)
@@ -257,7 +256,6 @@ PP(pp_concat)
     }
     else { /* TARG == left */
         STRLEN llen;
-       SvGETMAGIC(left);               /* or mg_get(left) may happen here */
        if (!SvOK(TARG)) {
            if (left == right && ckWARN(WARN_UNINITIALIZED))
                report_uninit(right);
@@ -269,9 +267,11 @@ PP(pp_concat)
            SvUTF8_off(TARG);
     }
 
-    /* or mg_get(right) may happen here */
     if (!rcopied) {
-       rpv = SvPV_const(right, rlen);
+       if (left == right)
+           /* $a.$a: do magic twice: tied might return different 2nd time */
+           SvGETMAGIC(right);
+       rpv = SvPV_nomg_const(right, rlen);
        rbyte = !DO_UTF8(right);
     }
     if (lbyte != rbyte) {
@@ -281,7 +281,7 @@ PP(pp_concat)
            if (!rcopied)
                right = newSVpvn_flags(rpv, rlen, SVs_TEMP);
            sv_utf8_upgrade_nomg(right);
-           rpv = SvPV_const(right, rlen);
+           rpv = SvPV_nomg_const(right, rlen);
        }
     }
     sv_catpvn_nomg(TARG, rpv, rlen);
@@ -329,7 +329,8 @@ PP(pp_readline)
 
 PP(pp_eq)
 {
-    dVAR; dSP; tryAMAGICbinSET(eq,0);
+    dVAR; dSP;
+    tryAMAGICbin_MG(eq_amg, AMGf_set);
 #ifndef NV_PRESERVES_UV
     if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
         SP--;
@@ -338,12 +339,12 @@ PP(pp_eq)
     }
 #endif
 #ifdef PERL_PRESERVE_IVUV
-    SvIV_please(TOPs);
+    SvIV_please_nomg(TOPs);
     if (SvIOK(TOPs)) {
        /* Unless the left argument is integer in range we are going
           to have to use NV maths. Hence only attempt to coerce the
           right argument if we know the left is integer.  */
-      SvIV_please(TOPm1s);
+      SvIV_please_nomg(TOPm1s);
        if (SvIOK(TOPm1s)) {
            const bool auvok = SvUOK(TOPm1s);
            const bool buvok = SvUOK(TOPs);
@@ -388,13 +389,13 @@ PP(pp_eq)
 #endif
     {
 #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
-      dPOPTOPnnrl;
+      dPOPTOPnnrl_nomg;
       if (Perl_isnan(left) || Perl_isnan(right))
          RETSETNO;
       SETs(boolSV(left == right));
 #else
-      dPOPnv;
-      SETs(boolSV(TOPn == value));
+      dPOPnv_nomg;
+      SETs(boolSV(SvNV_nomg(TOPs) == value));
 #endif
       RETURN;
     }
@@ -491,9 +492,10 @@ PP(pp_defined)
 PP(pp_add)
 {
     dVAR; dSP; dATARGET; bool useleft; SV *svl, *svr;
-    tryAMAGICbin(add,opASSIGN);
-    svl = sv_2num(TOPm1s);
-    svr = sv_2num(TOPs);
+    tryAMAGICbin_MG(add_amg, AMGf_assign|AMGf_numeric);
+    svr = TOPs;
+    svl = TOPm1s;
+
     useleft = USE_LEFT(svl);
 #ifdef PERL_PRESERVE_IVUV
     /* We must see if we can perform the addition with integers if possible,
@@ -542,7 +544,8 @@ PP(pp_add)
        unsigned code below is actually shorter than the old code. :-)
     */
 
-    SvIV_please(svr);
+    SvIV_please_nomg(svr);
+
     if (SvIOK(svr)) {
        /* Unless the left argument is integer in range we are going to have to
           use NV maths. Hence only attempt to coerce the right argument if
@@ -559,7 +562,7 @@ PP(pp_add)
               lots of code to speed up what is probably a rarish case.  */
        } else {
            /* Left operand is defined, so is it IV? */
-           SvIV_please(svl);
+           SvIV_please_nomg(svl);
            if (SvIOK(svl)) {
                if ((auvok = SvUOK(svl)))
                    auv = SvUVX(svl);
@@ -642,14 +645,14 @@ PP(pp_add)
     }
 #endif
     {
-       NV value = SvNV(svr);
+       NV value = SvNV_nomg(svr);
        (void)POPs;
        if (!useleft) {
            /* left operand is undef, treat as zero. + 0.0 is identity. */
            SETn(value);
            RETURN;
        }
-       SETn( value + SvNV(svl) );
+       SETn( value + SvNV_nomg(svl) );
        RETURN;
     }
 }
@@ -817,8 +820,9 @@ PP(pp_rv2av)
     const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV;
     const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV;
 
+    if (!(PL_op->op_private & OPpDEREFed))
+       SvGETMAGIC(sv);
     if (SvROK(sv)) {
-      wasref:
        tryAMAGICunDEREF_var(is_pp_rv2av ? to_av_amg : to_hv_amg);
 
        sv = SvRV(sv);
@@ -855,11 +859,6 @@ PP(pp_rv2av)
            GV *gv;
        
            if (!isGV_with_GP(sv)) {
-               if (SvGMAGICAL(sv)) {
-                   mg_get(sv);
-                   if (SvROK(sv))
-                       goto wasref;
-               }
                gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash,
                                     type, &sp);
                if (!gv)
@@ -2107,6 +2106,11 @@ PP(pp_subst)
        EXTEND(SP,1);
     }
 
+    /* In non-destructive replacement mode, duplicate target scalar so it
+     * remains unchanged. */
+    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+       TARG = newSVsv(TARG);
+
 #ifdef PERL_OLD_COPY_ON_WRITE
     /* Awooga. Awooga. "bool" types that are actually char are dangerous,
        because they make integers such as 256 "false".  */
@@ -2230,7 +2234,10 @@ PP(pp_subst)
        if (!matched)
        {
            SPAGAIN;
-           PUSHs(&PL_sv_no);
+           if (rpm->op_pmflags & PMf_NONDESTRUCT)
+               PUSHs(TARG);
+           else
+               PUSHs(&PL_sv_no);
            LEAVE_SCOPE(oldsave);
            RETURN;
        }
@@ -2284,7 +2291,10 @@ PP(pp_subst)
            }
            TAINT_IF(rxtainted & 1);
            SPAGAIN;
-           PUSHs(&PL_sv_yes);
+           if (rpm->op_pmflags & PMf_NONDESTRUCT)
+               PUSHs(TARG);
+           else
+               PUSHs(&PL_sv_yes);
        }
        else {
            do {
@@ -2313,7 +2323,10 @@ PP(pp_subst)
            }
            TAINT_IF(rxtainted & 1);
            SPAGAIN;
-           mPUSHi((I32)iters);
+           if (rpm->op_pmflags & PMf_NONDESTRUCT)
+               PUSHs(TARG);
+           else
+               mPUSHi((I32)iters);
        }
        (void)SvPOK_only_UTF8(TARG);
        TAINT_IF(rxtainted);
@@ -2399,7 +2412,10 @@ PP(pp_subst)
 
        TAINT_IF(rxtainted & 1);
        SPAGAIN;
-       mPUSHi((I32)iters);
+       if (rpm->op_pmflags & PMf_NONDESTRUCT)
+           PUSHs(TARG);
+       else
+           mPUSHi((I32)iters);
 
        (void)SvPOK_only(TARG);
        if (doutf8)
@@ -2415,7 +2431,10 @@ PP(pp_subst)
 nope:
 ret_no:
     SPAGAIN;
-    PUSHs(&PL_sv_no);
+    if (rpm->op_pmflags & PMf_NONDESTRUCT)
+       PUSHs(TARG);
+    else
+       PUSHs(&PL_sv_no);
     LEAVE_SCOPE(oldsave);
     RETURN;
 }