Add string- and number-specific bitop types

[perl5.git] / pp.c

diff --git a/pp.c b/pp.c
index 753385b..2cd2d5e 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -1649,6 +1649,7 @@ PP(pp_repeat)
     dSP; dATARGET;
     IV count;
     SV *sv;
+    bool infnan = FALSE;
 
     if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
        /* TODO: think of some way of doing list-repeat overloading ??? */
@@ -1691,19 +1692,27 @@ PP(pp_repeat)
         }
     }
     else if (SvNOKp(sv)) {
-        const NV nv = SvNV_nomg(sv);
-        if (nv < 0.0)
-              count = -1;   /* An arbitrary negative integer */
-        else
-             count = (IV)nv;
+        const NV nv = SvNV_nomg(sv);
+        infnan = Perl_isinfnan(nv);
+        if (UNLIKELY(infnan)) {
+            count = 0;
+        } else {
+            if (nv < 0.0)
+                count = -1;   /* An arbitrary negative integer */
+            else
+                count = (IV)nv;
+        }
     }
     else
-        count = SvIV_nomg(sv);
+       count = SvIV_nomg(sv);
 
-    if (count < 0) {
+    if (infnan) {
+        Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
+                       "Non-finite repeat count does nothing");
+    } else if (count < 0) {
         count = 0;
         Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
-                                         "Negative repeat count does nothing");
+                       "Negative repeat count does nothing");
     }
 
     if (GIMME_V == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
@@ -2215,6 +2224,34 @@ PP(pp_bit_and)
     }
 }
 
+PP(pp_nbit_and)
+{
+    dSP;
+    tryAMAGICbin_MG(band_amg, AMGf_assign);
+    {
+       dATARGET; dPOPTOPssrl;
+       if (PL_op->op_private & HINT_INTEGER) {
+         const IV i = SvIV_nomg(left) & SvIV_nomg(right);
+         SETi(i);
+       }
+       else {
+         const UV u = SvUV_nomg(left) & SvUV_nomg(right);
+         SETu(u);
+       }
+    }
+    RETURN;
+}
+
+PP(pp_sbit_and)
+{
+    dSP;
+    tryAMAGICbin_MG(sband_amg, AMGf_assign);
+    {
+       dATARGET; dPOPTOPssrl;
+       do_vop(OP_BIT_AND, TARG, left, right);
+       RETSETTARG;
+    }
+}
 
 /* also used for: pp_bit_xor() */
 
@@ -2252,6 +2289,50 @@ PP(pp_bit_or)
     }
 }
 
+/* also used for: pp_nbit_xor() */
+
+PP(pp_nbit_or)
+{
+    dSP;
+    const int op_type = PL_op->op_type;
+
+    tryAMAGICbin_MG((op_type == OP_NBIT_OR ? bor_amg : bxor_amg),
+                   AMGf_assign);
+    {
+       dATARGET; dPOPTOPssrl;
+       if (PL_op->op_private & HINT_INTEGER) {
+         const IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
+         const IV r = SvIV_nomg(right);
+         const IV result = op_type == OP_NBIT_OR ? (l | r) : (l ^ r);
+         SETi(result);
+       }
+       else {
+         const UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0);
+         const UV r = SvUV_nomg(right);
+         const UV result = op_type == OP_NBIT_OR ? (l | r) : (l ^ r);
+         SETu(result);
+       }
+    }
+    RETURN;
+}
+
+/* also used for: pp_sbit_xor() */
+
+PP(pp_sbit_or)
+{
+    dSP;
+    const int op_type = PL_op->op_type;
+
+    tryAMAGICbin_MG((op_type == OP_SBIT_OR ? sbor_amg : sbxor_amg),
+                   AMGf_assign);
+    {
+       dATARGET; dPOPTOPssrl;
+       do_vop(op_type == OP_SBIT_OR ? OP_BIT_OR : OP_BIT_XOR, TARG, left,
+              right);
+       RETSETTARG;
+    }
+}
+
 PERL_STATIC_INLINE bool
 S_negate_string(pTHX)
 {
@@ -2327,23 +2408,9 @@ PP(pp_not)
     return NORMAL;
 }
 
-PP(pp_complement)
+static void
+S_scomplement(pTHX_ SV *targ, SV *sv)
 {
-    dSP; dTARGET;
-    tryAMAGICun_MG(compl_amg, AMGf_numeric);
-    {
-      dTOPss;
-      if (SvNIOKp(sv)) {
-       if (PL_op->op_private & HINT_INTEGER) {
-         const IV i = ~SvIV_nomg(sv);
-         SETi(i);
-       }
-       else {
-         const UV u = ~SvUV_nomg(sv);
-         SETu(u);
-       }
-      }
-      else {
        U8 *tmps;
        I32 anum;
        STRLEN len;
@@ -2404,8 +2471,7 @@ PP(pp_complement)
              sv_usepvn_flags(TARG, (char*)result, nchar, SV_HAS_TRAILING_NUL);
              SvUTF8_off(TARG);
          }
-         SETTARG;
-         return NORMAL;
+         return;
        }
 #ifdef LIBERAL
        {
@@ -2420,12 +2486,62 @@ PP(pp_complement)
 #endif
        for ( ; anum > 0; anum--, tmps++)
            *tmps = ~*tmps;
+}
+
+PP(pp_complement)
+{
+    dSP; dTARGET;
+    tryAMAGICun_MG(compl_amg, AMGf_numeric);
+    {
+      dTOPss;
+      if (SvNIOKp(sv)) {
+       if (PL_op->op_private & HINT_INTEGER) {
+         const IV i = ~SvIV_nomg(sv);
+         SETi(i);
+       }
+       else {
+         const UV u = ~SvUV_nomg(sv);
+         SETu(u);
+       }
+      }
+      else {
+       S_scomplement(aTHX_ TARG, sv);
        SETTARG;
       }
       return NORMAL;
     }
 }
 
+PP(pp_ncomplement)
+{
+    dSP;
+    tryAMAGICun_MG(compl_amg, AMGf_numeric);
+    {
+       dTARGET; dTOPss;
+       if (PL_op->op_private & HINT_INTEGER) {
+         const IV i = ~SvIV_nomg(sv);
+         SETi(i);
+       }
+       else {
+         const UV u = ~SvUV_nomg(sv);
+         SETu(u);
+       }
+    }
+    return NORMAL;
+}
+
+PP(pp_scomplement)
+{
+    dSP;
+    tryAMAGICun_MG(scompl_amg, AMGf_numeric);
+    {
+       dTARGET; dTOPss;
+       S_scomplement(aTHX_ TARG, sv);
+       SETTARG;
+       return NORMAL;
+    }
+}
+
 /* integer versions of some of the above */
 
 PP(pp_i_multiply)
@@ -3202,7 +3318,7 @@ PP(pp_substr)
     }
     RETURN;
 
-bound_fail:
+  bound_fail:
     if (repl)
        Perl_croak(aTHX_ "substr outside of string");
     Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string");
@@ -6367,6 +6483,17 @@ PP(pp_lvavref)
     }
 }
 
+PP(pp_anonconst)
+{
+    dSP;
+    dTOPss;
+    SETs(sv_2mortal((SV *)newCONSTSUB(SvTYPE(CopSTASH(PL_curcop))==SVt_PVHV
+                                       ? CopSTASH(PL_curcop)
+                                       : NULL,
+                                     NULL, SvREFCNT_inc_simple_NN(sv))));
+    RETURN;
+}
+
 /*
  * Local variables:
  * c-indentation-style: bsd