This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Perl_pp_symlink and Perl_pp_link can be merged. The diff looks evil,
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index e2649d3..a13c6a6 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -53,11 +53,6 @@ PP(pp_stub)
     RETURN;
 }
 
-PP(pp_scalar)
-{
-    return NORMAL;
-}
-
 /* Pushy stuff. */
 
 PP(pp_padav)
@@ -127,11 +122,6 @@ PP(pp_padhv)
     RETURN;
 }
 
-PP(pp_padany)
-{
-    DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
-}
-
 /* Translations. */
 
 PP(pp_rv2gv)
@@ -273,7 +263,7 @@ PP(pp_rv2sv)
                gv = (GV*)gv_fetchsv(sv, TRUE, SVt_PV);
            }
        }
-       sv = GvSV(gv);
+       sv = GvSVn(gv);
     }
     if (PL_op->op_flags & OPf_MOD) {
        if (PL_op->op_private & OPpLVAL_INTRO) {
@@ -505,8 +495,8 @@ PP(pp_ref)
     const char *pv;
     SV * const sv = POPs;
 
-    if (sv && SvGMAGICAL(sv))
-       mg_get(sv);
+    if (sv)
+       SvGETMAGIC(sv);
 
     if (!sv || !SvROK(sv))
        RETPUSHNO;
@@ -531,7 +521,7 @@ PP(pp_bless)
        if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
            Perl_croak(aTHX_ "Attempt to bless into a reference");
        ptr = SvPV_const(ssv,len);
-       if (ckWARN(WARN_MISC) && len == 0)
+       if (len == 0 && ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC),
                   "Explicit blessing to '' (assuming package main)");
        stash = gv_stashpvn(ptr, len, TRUE);
@@ -642,8 +632,8 @@ PP(pp_study)
     if (pos > PL_maxscream) {
        if (PL_maxscream < 0) {
            PL_maxscream = pos + 80;
-           New(301, PL_screamfirst, 256, I32);
-           New(302, PL_screamnext, PL_maxscream, I32);
+           Newx(PL_screamfirst, 256, I32);
+           Newx(PL_screamnext, PL_maxscream, I32);
        }
        else {
            PL_maxscream = pos + pos / 4;
@@ -755,8 +745,7 @@ PP(pp_defined)
            RETPUSHYES;
        break;
     default:
-       if (SvGMAGICAL(sv))
-           mg_get(sv);
+       SvGETMAGIC(sv);
        if (SvOK(sv))
            RETPUSHYES;
     }
@@ -789,7 +778,7 @@ PP(pp_undef)
        hv_undef((HV*)sv);
        break;
     case SVt_PVCV:
-       if (ckWARN(WARN_MISC) && cv_const_sv((CV*)sv))
+       if (cv_const_sv((CV*)sv) && ckWARN(WARN_MISC))
            Perl_warner(aTHX_ packWARN(WARN_MISC), "Constant subroutine %s undefined",
                 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
        /* FALL THROUGH */
@@ -807,7 +796,7 @@ PP(pp_undef)
        else {
            GP *gp;
            gp_free((GV*)sv);
-           Newz(602, gp, 1, GP);
+           Newxz(gp, 1, GP);
            GvGP(sv) = gp_ref(gp);
            GvSV(sv) = NEWSV(72,0);
            GvLINE(sv) = CopLINE(PL_curcop);
@@ -900,36 +889,37 @@ PP(pp_pow)
        we're sure it is safe; otherwise we call pow() and try to convert to
        integer afterwards. */
     {
-        SvIV_please(TOPm1s);
-        if (SvIOK(TOPm1s)) {
-            bool baseuok = SvUOK(TOPm1s);
-            UV baseuv;
+       SvIV_please(TOPs);
+       if (SvIOK(TOPs)) {
+           SvIV_please(TOPm1s);
+           if (SvIOK(TOPm1s)) {
+               UV power;
+               bool baseuok;
+               UV baseuv;
 
-            if (baseuok) {
-                baseuv = SvUVX(TOPm1s);
-            } else {
-               const IV iv = SvIVX(TOPm1s);
-                if (iv >= 0) {
-                    baseuv = iv;
-                    baseuok = TRUE; /* effectively it's a UV now */
-                } else {
-                    baseuv = -iv; /* abs, baseuok == false records sign */
-                }
-            }
-            SvIV_please(TOPs);
-            if (SvIOK(TOPs)) {
-                UV power;
+               if (SvUOK(TOPs)) {
+                   power = SvUVX(TOPs);
+               } else {
+                   const IV iv = SvIVX(TOPs);
+                   if (iv >= 0) {
+                       power = iv;
+                   } else {
+                       goto float_it; /* Can't do negative powers this way.  */
+                   }
+               }
 
-                if (SvUOK(TOPs)) {
-                    power = SvUVX(TOPs);
-                } else {
-                    IV iv = SvIVX(TOPs);
-                    if (iv >= 0) {
-                        power = iv;
-                    } else {
-                        goto float_it; /* Can't do negative powers this way.  */
-                    }
-                }
+               baseuok = SvUOK(TOPm1s);
+               if (baseuok) {
+                   baseuv = SvUVX(TOPm1s);
+               } else {
+                   const IV iv = SvIVX(TOPm1s);
+                   if (iv >= 0) {
+                       baseuv = iv;
+                       baseuok = TRUE; /* effectively it's a UV now */
+                   } else {
+                       baseuv = -iv; /* abs, baseuok == false records sign */
+                   }
+               }
                 /* now we have integer ** positive integer. */
                 is_int = 1;
 
@@ -945,34 +935,28 @@ PP(pp_pow)
                        programmers to notice ** not doing what they mean. */
                     NV result = 1.0;
                     NV base = baseuok ? baseuv : -(NV)baseuv;
-                    int n = 0;
-
-                    for (; power; base *= base, n++) {
-                        /* Do I look like I trust gcc with long longs here?
-                           Do I hell.  */
-                       const UV bit = (UV)1 << (UV)n;
-                        if (power & bit) {
-                            result *= base;
-                            /* Only bother to clear the bit if it is set.  */
-                            power -= bit;
-                           /* Avoid squaring base again if we're done. */
-                           if (power == 0) break;
-                        }
-                    }
+
+                   if (power & 1) {
+                       result *= base;
+                   }
+                   while (power >>= 1) {
+                       base *= base;
+                       if (power & 1) {
+                           result *= base;
+                       }
+                   }
                     SP--;
                     SETn( result );
                     SvIV_please(TOPs);
                     RETURN;
                } else {
                    register unsigned int highbit = 8 * sizeof(UV);
-                   register unsigned int lowbit = 0;
-                   register unsigned int diff;
-                   bool odd_power = (bool)(power & 1);
-                   while ((diff = (highbit - lowbit) >> 1)) {
-                       if (baseuv & ~((1 << (lowbit + diff)) - 1))
-                           lowbit += diff;
-                       else 
-                           highbit -= diff;
+                   register unsigned int diff = 8 * sizeof(UV);
+                   while (diff >>= 1) {
+                       highbit -= diff;
+                       if (baseuv >> highbit) {
+                           highbit += diff;
+                       }
                    }
                    /* we now have baseuv < 2 ** highbit */
                    if (power * highbit <= 8 * sizeof(UV)) {
@@ -980,13 +964,14 @@ PP(pp_pow)
                           on same algorithm as above */
                        register UV result = 1;
                        register UV base = baseuv;
-                       register int n = 0;
-                       for (; power; base *= base, n++) {
-                           register const UV bit = (UV)1 << (UV)n;
-                           if (power & bit) {
+                       const bool odd_power = (bool)(power & 1);
+                       if (odd_power) {
+                           result *= base;
+                       }
+                       while (power >>= 1) {
+                           base *= base;
+                           if (power & 1) {
                                result *= base;
-                               power -= bit;
-                               if (power == 0) break;
                            }
                        }
                        SP--;
@@ -1388,8 +1373,7 @@ PP(pp_repeat)
   {
     register IV count;
     dPOPss;
-    if (SvGMAGICAL(sv))
-        mg_get(sv);
+    SvGETMAGIC(sv);
     if (SvIOKp(sv)) {
         if (SvUOK(sv)) {
              const UV uv = SvUV(sv);
@@ -2227,8 +2211,8 @@ PP(pp_bit_and)
     dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
     {
       dPOPTOPssrl;
-      if (SvGMAGICAL(left)) mg_get(left);
-      if (SvGMAGICAL(right)) mg_get(right);
+      SvGETMAGIC(left);
+      SvGETMAGIC(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
          const IV i = SvIV_nomg(left) & SvIV_nomg(right);
@@ -2252,8 +2236,8 @@ PP(pp_bit_xor)
     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
     {
       dPOPTOPssrl;
-      if (SvGMAGICAL(left)) mg_get(left);
-      if (SvGMAGICAL(right)) mg_get(right);
+      SvGETMAGIC(left);
+      SvGETMAGIC(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
          const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) ^ SvIV_nomg(right);
@@ -2277,8 +2261,8 @@ PP(pp_bit_or)
     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
     {
       dPOPTOPssrl;
-      if (SvGMAGICAL(left)) mg_get(left);
-      if (SvGMAGICAL(right)) mg_get(right);
+      SvGETMAGIC(left);
+      SvGETMAGIC(right);
       if (SvNIOKp(left) || SvNIOKp(right)) {
        if (PL_op->op_private & HINT_INTEGER) {
          const IV i = (USE_LEFT(left) ? SvIV_nomg(left) : 0) | SvIV_nomg(right);
@@ -2303,8 +2287,7 @@ PP(pp_negate)
     {
        dTOPss;
        const int flags = SvFLAGS(sv);
-       if (SvGMAGICAL(sv))
-           mg_get(sv);
+       SvGETMAGIC(sv);
        if ((flags & SVf_IOK) || ((flags & (SVp_IOK | SVp_NOK)) == SVp_IOK)) {
            /* It's publicly an integer, or privately an integer-not-float */
        oops_its_an_int:
@@ -2380,8 +2363,7 @@ PP(pp_complement)
     dSP; dTARGET; tryAMAGICun(compl);
     {
       dTOPss;
-      if (SvGMAGICAL(sv))
-         mg_get(sv);
+      SvGETMAGIC(sv);
       if (SvNIOKp(sv)) {
        if (PL_op->op_private & HINT_INTEGER) {
          const IV i = ~SvIV_nomg(sv);
@@ -2424,7 +2406,7 @@ PP(pp_complement)
          tmps -= len;
 
          if (nwide) {
-             Newz(0, result, targlen + 1, U8);
+             Newxz(result, targlen + 1, U8);
              while (tmps < send) {
                  const UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
                  tmps += UTF8SKIP(tmps);
@@ -2436,7 +2418,7 @@ PP(pp_complement)
              SvUTF8_on(TARG);
          }
          else {
-             Newz(0, result, nchar + 1, U8);
+             Newxz(result, nchar + 1, U8);
              while (tmps < send) {
                  const U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
                  tmps += UTF8SKIP(tmps);
@@ -2861,9 +2843,9 @@ PP(pp_abs)
       } else{
        const NV value = TOPn;
        if (value < 0.0)
-         SETn(value);
-       else
          SETn(-value);
+       else
+         SETn(value);
       }
     }
     RETURN;
@@ -3609,7 +3591,7 @@ PP(pp_uc)
        }
        s = (U8*)SvPV_force_nomg(sv, len);
        if (len) {
-           const register U8 *send = s + len;
+           register const U8 *send = s + len;
 
            if (IN_LOCALE_RUNTIME) {
                TAINT;
@@ -3736,7 +3718,7 @@ PP(pp_quotemeta)
     dSP; dTARGET;
     SV * const sv = TOPs;
     STRLEN len;
-    const register char *s = SvPV_const(sv,len);
+    register const char *s = SvPV_const(sv,len);
 
     SvUTF8_off(TARG);                          /* decontaminate */
     if (len) {
@@ -3860,16 +3842,6 @@ PP(pp_each)
     RETURN;
 }
 
-PP(pp_values)
-{
-    return do_kv();
-}
-
-PP(pp_keys)
-{
-    return do_kv();
-}
-
 PP(pp_delete)
 {
     dSP;
@@ -4199,7 +4171,7 @@ PP(pp_splice)
 
     if (diff < 0) {                            /* shrinking the area */
        if (newlen) {
-           New(451, tmparyval, newlen, SV*);   /* so remember insertion */
+           Newx(tmparyval, newlen, SV*);       /* so remember insertion */
            Copy(MARK, tmparyval, newlen, SV*);
        }
 
@@ -4259,7 +4231,7 @@ PP(pp_splice)
     }
     else {                                     /* no, expanding (or same) */
        if (length) {
-           New(452, tmparyval, length, SV*);   /* so remember deletion */
+           Newx(tmparyval, length, SV*);       /* so remember deletion */
            Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
        }
 
@@ -4341,18 +4313,19 @@ PP(pp_push)
        call_method("PUSH",G_SCALAR|G_DISCARD);
        LEAVE;
        SPAGAIN;
+       SP = ORIGMARK;
+       PUSHi( AvFILL(ary) + 1 );
     }
     else {
-       /* Why no pre-extend of ary here ? */
        for (++MARK; MARK <= SP; MARK++) {
            SV * const sv = NEWSV(51, 0);
            if (*MARK)
                sv_setsv(sv, *MARK);
-           av_push(ary, sv);
+           av_store(ary, AvFILLp(ary)+1, sv);
        }
+       SP = ORIGMARK;
+       PUSHi( AvFILLp(ary) + 1 );
     }
-    SP = ORIGMARK;
-    PUSHi( AvFILL(ary) + 1 );
     RETURN;
 }
 
@@ -4797,9 +4770,11 @@ PP(pp_lock)
     RETURN;
 }
 
-PP(pp_threadsv)
+
+PP(unimplemented_op)
 {
-    DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
+    DIE(aTHX_ "panic: unimplemented op %s (#%d) called", OP_NAME(PL_op),
+       PL_op->op_type);
 }
 
 /*