Integrate with Sarathy.
[p5sagit/p5-mst-13.2.git] / pp.c
diff --git a/pp.c b/pp.c
index a42c611..a1b088a 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -943,15 +943,15 @@ PP(pp_divide)
     djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
     {
       dPOPPOPnnrl;
-      double value;
+      NV value;
       if (right == 0.0)
        DIE(aTHX_ "Illegal division by zero");
 #ifdef SLOPPYDIVIDE
       /* insure that 20./5. == 4. */
       {
        IV k;
-       if ((double)I_V(left)  == left &&
-           (double)I_V(right) == right &&
+       if ((NV)I_V(left)  == left &&
+           (NV)I_V(right) == right &&
            (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
            value = k;
        }
@@ -976,8 +976,8 @@ PP(pp_modulo)
        bool left_neg;
        bool right_neg;
        bool use_double = 0;
-       double dright;
-       double dleft;
+       NV dright;
+       NV dleft;
 
        if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
            IV i = SvIVX(POPs);
@@ -1007,7 +1007,7 @@ PP(pp_modulo)
        }
 
        if (use_double) {
-           double dans;
+           NV dans;
 
 #if 1
 /* Somehow U_V is pessimized even if CASTFLAGS is 0 */
@@ -1034,7 +1034,7 @@ PP(pp_modulo)
            if (!dright)
                DIE(aTHX_ "Illegal modulus zero");
 
-           dans = fmod(dleft, dright);
+           dans = Perl_fmod(dleft, dright);
            if ((left_neg != right_neg) && dans)
                dans = dright - dans;
            if (right_neg)
@@ -1057,7 +1057,7 @@ PP(pp_modulo)
                if (ans <= ~((UV)IV_MAX)+1)
                    sv_setiv(TARG, ~ans+1);
                else
-                   sv_setnv(TARG, -(double)ans);
+                   sv_setnv(TARG, -(NV)ans);
            }
            else
                sv_setuv(TARG, ans);
@@ -1624,7 +1624,7 @@ PP(pp_atan2)
     djSP; dTARGET; tryAMAGICbin(atan2,0);
     {
       dPOPTOPnnrl;
-      SETn(atan2(left, right));
+      SETn(Perl_atan2(left, right));
       RETURN;
     }
 }
@@ -1633,9 +1633,9 @@ PP(pp_sin)
 {
     djSP; dTARGET; tryAMAGICun(sin);
     {
-      double value;
+      NV value;
       value = POPn;
-      value = sin(value);
+      value = Perl_sin(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1645,9 +1645,9 @@ PP(pp_cos)
 {
     djSP; dTARGET; tryAMAGICun(cos);
     {
-      double value;
+      NV value;
       value = POPn;
-      value = cos(value);
+      value = Perl_cos(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1671,7 +1671,7 @@ extern double drand48 (void);
 PP(pp_rand)
 {
     djSP; dTARGET;
-    double value;
+    NV value;
     if (MAXARG < 1)
        value = 1.0;
     else
@@ -1787,9 +1787,9 @@ PP(pp_exp)
 {
     djSP; dTARGET; tryAMAGICun(exp);
     {
-      double value;
+      NV value;
       value = POPn;
-      value = exp(value);
+      value = Perl_exp(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1799,13 +1799,13 @@ PP(pp_log)
 {
     djSP; dTARGET; tryAMAGICun(log);
     {
-      double value;
+      NV value;
       value = POPn;
       if (value <= 0.0) {
        RESTORE_NUMERIC_STANDARD();
        DIE(aTHX_ "Can't take log of %g", value);
       }
-      value = log(value);
+      value = Perl_log(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1815,13 +1815,13 @@ PP(pp_sqrt)
 {
     djSP; dTARGET; tryAMAGICun(sqrt);
     {
-      double value;
+      NV value;
       value = POPn;
       if (value < 0.0) {
        RESTORE_NUMERIC_STANDARD();
        DIE(aTHX_ "Can't take sqrt of %g", value);
       }
-      value = sqrt(value);
+      value = Perl_sqrt(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1831,7 +1831,7 @@ PP(pp_int)
 {
     djSP; dTARGET;
     {
-      double value = TOPn;
+      NV value = TOPn;
       IV iv;
 
       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
@@ -1840,9 +1840,9 @@ PP(pp_int)
       }
       else {
        if (value >= 0.0)
-         (void)modf(value, &value);
+         (void)Perl_modf(value, &value);
        else {
-         (void)modf(-value, &value);
+         (void)Perl_modf(-value, &value);
          value = -value;
        }
        iv = I_V(value);
@@ -1859,7 +1859,7 @@ PP(pp_abs)
 {
     djSP; dTARGET; tryAMAGICun(abs);
     {
-      double value = TOPn;
+      NV value = TOPn;
       IV iv;
 
       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
@@ -2308,26 +2308,26 @@ PP(pp_ucfirst)
            s = (U8*)SvPV_force(sv, slen);
            Copy(tmpbuf, s, ulen, U8);
        }
-       RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-       dTARGET;
-       sv_setsv(TARG, sv);
-       sv = TARG;
-       SETs(sv);
-    }
-    s = (U8*)SvPV_force(sv, slen);
-    if (*s) {
-       if (PL_op->op_private & OPpLOCALE) {
-           TAINT;
-           SvTAINTED_on(sv);
-           *s = toUPPER_LC(*s);
+    } else {
+       if (!SvPADTMP(sv)) {
+           dTARGET;
+           sv_setsv(TARG, sv);
+           sv = TARG;
+           SETs(sv);
+       }
+       s = (U8*)SvPV_force(sv, slen);
+       if (*s) {
+           if (PL_op->op_private & OPpLOCALE) {
+               TAINT;
+               SvTAINTED_on(sv);
+               *s = toUPPER_LC(*s);
+           }
+           else
+               *s = toUPPER(*s);
        }
-       else
-           *s = toUPPER(*s);
     }
-
+    if (SvSMAGICAL(sv))
+       mg_set(sv);
     RETURN;
 }
 
@@ -2364,27 +2364,27 @@ PP(pp_lcfirst)
            s = (U8*)SvPV_force(sv, slen);
            Copy(tmpbuf, s, ulen, U8);
        }
-       RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-       dTARGET;
-       sv_setsv(TARG, sv);
-       sv = TARG;
-       SETs(sv);
-    }
-    s = (U8*)SvPV_force(sv, slen);
-    if (*s) {
-       if (PL_op->op_private & OPpLOCALE) {
-           TAINT;
-           SvTAINTED_on(sv);
-           *s = toLOWER_LC(*s);
+    } else {
+       if (!SvPADTMP(sv)) {
+           dTARGET;
+           sv_setsv(TARG, sv);
+           sv = TARG;
+           SETs(sv);
        }
-       else
-           *s = toLOWER(*s);
+       s = (U8*)SvPV_force(sv, slen);
+       if (*s) {
+           if (PL_op->op_private & OPpLOCALE) {
+               TAINT;
+               SvTAINTED_on(sv);
+               *s = toLOWER_LC(*s);
+           }
+           else
+               *s = toLOWER(*s);
+       }
+       SETs(sv);
     }
-
-    SETs(sv);
+    if (SvSMAGICAL(sv))
+       mg_set(sv);
     RETURN;
 }
 
@@ -2405,56 +2405,55 @@ PP(pp_uc)
        if (!len) {
            sv_setpvn(TARG, "", 0);
            SETs(TARG);
-           RETURN;
-       }
-
-       (void)SvUPGRADE(TARG, SVt_PV);
-       SvGROW(TARG, (len * 2) + 1);
-       (void)SvPOK_only(TARG);
-       d = (U8*)SvPVX(TARG);
-       send = s + len;
-       if (PL_op->op_private & OPpLOCALE) {
-           TAINT;
-           SvTAINTED_on(TARG);
-           while (s < send) {
-               d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
-               s += ulen;
+       } else {
+           (void)SvUPGRADE(TARG, SVt_PV);
+           SvGROW(TARG, (len * 2) + 1);
+           (void)SvPOK_only(TARG);
+           d = (U8*)SvPVX(TARG);
+           send = s + len;
+           if (PL_op->op_private & OPpLOCALE) {
+               TAINT;
+               SvTAINTED_on(TARG);
+               while (s < send) {
+                   d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+                   s += ulen;
+               }
            }
-       }
-       else {
-           while (s < send) {
-               d = uv_to_utf8(d, toUPPER_utf8( s ));
-               s += UTF8SKIP(s);
+           else {
+               while (s < send) {
+                   d = uv_to_utf8(d, toUPPER_utf8( s ));
+                   s += UTF8SKIP(s);
+               }
            }
+           *d = '\0';
+           SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+           SETs(TARG);
        }
-       *d = '\0';
-       SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
-       SETs(TARG);
-       RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-       dTARGET;
-       sv_setsv(TARG, sv);
-       sv = TARG;
-       SETs(sv);
-    }
-
-    s = (U8*)SvPV_force(sv, len);
-    if (len) {
-       register U8 *send = s + len;
-
-       if (PL_op->op_private & OPpLOCALE) {
-           TAINT;
-           SvTAINTED_on(sv);
-           for (; s < send; s++)
-               *s = toUPPER_LC(*s);
+    } else {
+       if (!SvPADTMP(sv)) {
+           dTARGET;
+           sv_setsv(TARG, sv);
+           sv = TARG;
+           SETs(sv);
        }
-       else {
-           for (; s < send; s++)
-               *s = toUPPER(*s);
+       s = (U8*)SvPV_force(sv, len);
+       if (len) {
+           register U8 *send = s + len;
+
+           if (PL_op->op_private & OPpLOCALE) {
+               TAINT;
+               SvTAINTED_on(sv);
+               for (; s < send; s++)
+                   *s = toUPPER_LC(*s);
+           }
+           else {
+               for (; s < send; s++)
+                   *s = toUPPER(*s);
+           }
        }
     }
+    if (SvSMAGICAL(sv))
+       mg_set(sv);
     RETURN;
 }
 
@@ -2475,56 +2474,56 @@ PP(pp_lc)
        if (!len) {
            sv_setpvn(TARG, "", 0);
            SETs(TARG);
-           RETURN;
-       }
-
-       (void)SvUPGRADE(TARG, SVt_PV);
-       SvGROW(TARG, (len * 2) + 1);
-       (void)SvPOK_only(TARG);
-       d = (U8*)SvPVX(TARG);
-       send = s + len;
-       if (PL_op->op_private & OPpLOCALE) {
-           TAINT;
-           SvTAINTED_on(TARG);
-           while (s < send) {
-               d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
-               s += ulen;
+       } else {
+           (void)SvUPGRADE(TARG, SVt_PV);
+           SvGROW(TARG, (len * 2) + 1);
+           (void)SvPOK_only(TARG);
+           d = (U8*)SvPVX(TARG);
+           send = s + len;
+           if (PL_op->op_private & OPpLOCALE) {
+               TAINT;
+               SvTAINTED_on(TARG);
+               while (s < send) {
+                   d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+                   s += ulen;
+               }
            }
-       }
-       else {
-           while (s < send) {
-               d = uv_to_utf8(d, toLOWER_utf8(s));
-               s += UTF8SKIP(s);
+           else {
+               while (s < send) {
+                   d = uv_to_utf8(d, toLOWER_utf8(s));
+                   s += UTF8SKIP(s);
+               }
            }
+           *d = '\0';
+           SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+           SETs(TARG);
+       }
+    } else {
+       if (!SvPADTMP(sv)) {
+           dTARGET;
+           sv_setsv(TARG, sv);
+           sv = TARG;
+           SETs(sv);
        }
-       *d = '\0';
-       SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
-       SETs(TARG);
-       RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-       dTARGET;
-       sv_setsv(TARG, sv);
-       sv = TARG;
-       SETs(sv);
-    }
 
-    s = (U8*)SvPV_force(sv, len);
-    if (len) {
-       register U8 *send = s + len;
+       s = (U8*)SvPV_force(sv, len);
+       if (len) {
+           register U8 *send = s + len;
 
-       if (PL_op->op_private & OPpLOCALE) {
-           TAINT;
-           SvTAINTED_on(sv);
-           for (; s < send; s++)
-               *s = toLOWER_LC(*s);
-       }
-       else {
-           for (; s < send; s++)
-               *s = toLOWER(*s);
+           if (PL_op->op_private & OPpLOCALE) {
+               TAINT;
+               SvTAINTED_on(sv);
+               for (; s < send; s++)
+                   *s = toLOWER_LC(*s);
+           }
+           else {
+               for (; s < send; s++)
+                   *s = toLOWER(*s);
+           }
        }
     }
+    if (SvSMAGICAL(sv))
+       mg_set(sv);
     RETURN;
 }
 
@@ -2572,6 +2571,8 @@ PP(pp_quotemeta)
     else
        sv_setpvn(TARG, s, len);
     SETs(TARG);
+    if (SvSMAGICAL(TARG))
+       mg_set(TARG);
     RETURN;
 }
 
@@ -3192,7 +3193,9 @@ PP(pp_reverse)
                        s += UTF8SKIP(s);
                        down = (char*)(s - 1);
                        if (s > send || !((*down & 0xc0) == 0x80)) {
-                           Perl_warn(aTHX_ "Malformed UTF-8 character");
+                           if (ckWARN_d(WARN_UTF8))
+                               Perl_warner(aTHX_ WARN_UTF8,
+                                           "Malformed UTF-8 character");
                            break;
                        }
                        while (down > up) {
@@ -3294,7 +3297,7 @@ PP(pp_unpack)
     double adouble;
     I32 checksum = 0;
     register U32 culong;
-    double cdouble;
+    NV cdouble;
     int commas = 0;
 #ifdef PERL_NATINT_PACK
     int natint;                /* native integer */
@@ -3558,7 +3561,7 @@ PP(pp_unpack)
                    auint = utf8_to_uv((U8*)s, &along);
                    s += along;
                    if (checksum > 32)
-                       cdouble += (double)auint;
+                       cdouble += (NV)auint;
                    else
                        culong += auint;
                }
@@ -3718,7 +3721,7 @@ PP(pp_unpack)
                    Copy(s, &aint, 1, int);
                    s += sizeof(int);
                    if (checksum > 32)
-                       cdouble += (double)aint;
+                       cdouble += (NV)aint;
                    else
                        culong += aint;
                }
@@ -3769,7 +3772,7 @@ PP(pp_unpack)
                    Copy(s, &auint, 1, unsigned int);
                    s += sizeof(unsigned int);
                    if (checksum > 32)
-                       cdouble += (double)auint;
+                       cdouble += (NV)auint;
                    else
                        culong += auint;
                }
@@ -3808,7 +3811,7 @@ PP(pp_unpack)
                        COPYNN(s, &along, sizeof(long));
                        s += sizeof(long);
                        if (checksum > 32)
-                           cdouble += (double)along;
+                           cdouble += (NV)along;
                        else
                            culong += along;
                    }
@@ -3824,7 +3827,7 @@ PP(pp_unpack)
 #endif
                        s += SIZE32;
                        if (checksum > 32)
-                           cdouble += (double)along;
+                           cdouble += (NV)along;
                        else
                            culong += along;
                    }
@@ -3878,7 +3881,7 @@ PP(pp_unpack)
                        COPYNN(s, &aulong, sizeof(unsigned long));
                        s += sizeof(unsigned long);
                        if (checksum > 32)
-                           cdouble += (double)aulong;
+                           cdouble += (NV)aulong;
                        else
                            culong += aulong;
                    }
@@ -3898,7 +3901,7 @@ PP(pp_unpack)
                            aulong = vtohl(aulong);
 #endif
                        if (checksum > 32)
-                           cdouble += (double)aulong;
+                           cdouble += (NV)aulong;
                        else
                            culong += aulong;
                    }
@@ -4030,7 +4033,7 @@ PP(pp_unpack)
                if (aquad >= IV_MIN && aquad <= IV_MAX)
                    sv_setiv(sv, (IV)aquad);
                else
-                   sv_setnv(sv, (double)aquad);
+                   sv_setnv(sv, (NV)aquad);
                PUSHs(sv_2mortal(sv));
            }
            break;
@@ -4051,7 +4054,7 @@ PP(pp_unpack)
                if (auquad <= UV_MAX)
                    sv_setuv(sv, (UV)auquad);
                else
-                   sv_setnv(sv, (double)auquad);
+                   sv_setnv(sv, (NV)auquad);
                PUSHs(sv_2mortal(sv));
            }
            break;
@@ -4076,7 +4079,7 @@ PP(pp_unpack)
                    Copy(s, &afloat, 1, float);
                    s += sizeof(float);
                    sv = NEWSV(47, 0);
-                   sv_setnv(sv, (double)afloat);
+                   sv_setnv(sv, (NV)afloat);
                    PUSHs(sv_2mortal(sv));
                }
            }
@@ -4100,7 +4103,7 @@ PP(pp_unpack)
                    Copy(s, &adouble, 1, double);
                    s += sizeof(double);
                    sv = NEWSV(48, 0);
-                   sv_setnv(sv, (double)adouble);
+                   sv_setnv(sv, (NV)adouble);
                    PUSHs(sv_2mortal(sv));
                }
            }
@@ -4168,7 +4171,7 @@ PP(pp_unpack)
            sv = NEWSV(42, 0);
            if (strchr("fFdD", datumtype) ||
              (checksum > 32 && strchr("iIlLNU", datumtype)) ) {
-               double trouble;
+               NV trouble;
 
                adouble = 1.0;
                while (checksum >= 16) {
@@ -4184,7 +4187,7 @@ PP(pp_unpack)
                along = (1 << checksum) - 1;
                while (cdouble < 0.0)
                    cdouble += adouble;
-               cdouble = modf(cdouble / adouble, &trouble) * adouble;
+               cdouble = Perl_modf(cdouble / adouble, &trouble) * adouble;
                sv_setnv(sv, cdouble);
            }
            else {
@@ -4661,7 +4664,7 @@ PP(pp_pack)
        case 'w':
             while (len-- > 0) {
                fromstr = NEXTFROM;
-               adouble = floor(SvNV(fromstr));
+               adouble = Perl_floor(SvNV(fromstr));
 
                if (adouble < 0)
                    Perl_croak(aTHX_ "Cannot compress negative numbers");
@@ -4991,17 +4994,19 @@ PP(pp_split)
            s = m;
        }
     }
-    else if (rx->check_substr && !rx->nparens
+    else if ((rx->reganch & RE_USE_INTUIT) && !rx->nparens
             && (rx->reganch & ROPT_CHECK_ALL)
             && !(rx->reganch & ROPT_ANCH)) {
-       int tail = SvTAIL(rx->check_substr) != 0;
+       int tail = (rx->reganch & RE_INTUIT_TAIL);
+       SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
+       char c;
 
-       i = SvCUR(rx->check_substr);
-       if (i == 1 && !tail) {
-           i = *SvPVX(rx->check_substr);
+       len = rx->minlen;
+       if (len == 1 && !tail) {
+           c = *SvPV(csv,len);
            while (--limit) {
                /*SUPPRESS 530*/
-               for (m = s; m < strend && *m != i; m++) ;
+               for (m = s; m < strend && *m != c; m++) ;
                if (m >= strend)
                    break;
                dstr = NEWSV(30, m-s);
@@ -5015,8 +5020,8 @@ PP(pp_split)
        else {
 #ifndef lint
            while (s < strend && --limit &&
-             (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
-                   rx->check_substr, PL_multiline ? FBMrf_MULTILINE : 0)) )
+             (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
+                            csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
 #endif
            {
                dstr = NEWSV(31, m-s);
@@ -5024,14 +5029,18 @@ PP(pp_split)
                if (make_mortal)
                    sv_2mortal(dstr);
                XPUSHs(dstr);
-               s = m + i - tail;       /* Fake \n at the end */
+               s = m + len;            /* Fake \n at the end */
            }
        }
     }
     else {
        maxiters += (strend - s) * rx->nparens;
-       while (s < strend && --limit &&
-              CALLREGEXEC(aTHX_ rx, s, strend, orig, 1, sv, NULL, 0))
+       while (s < strend && --limit
+/*            && (!rx->check_substr 
+                  || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
+                                                0, NULL))))
+*/            && CALLREGEXEC(aTHX_ rx, s, strend, orig,
+                             1 /* minend */, sv, NULL, 0))
        {
            TAINT_IF(RX_MATCH_TAINTED(rx));
            if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
@@ -5171,7 +5180,7 @@ PP(pp_lock)
        DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
                              (unsigned long)thr, (unsigned long)sv);)
        MUTEX_UNLOCK(MgMUTEXP(mg));
-       save_destructor(Perl_unlock_condpair, sv);
+       SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
     }
 #endif /* USE_THREADS */
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV