IEEE math for the masses

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

diff --git a/pp.c b/pp.c
index 09b0c7c..2ba5b61 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -35,6 +35,14 @@
 extern Pid_t getpid (void);
 #endif
 
+/*
+ * Some BSDs and Cygwin default to POSIX math instead of IEEE.
+ * This switches them over to IEEE.
+ */
+#if defined(LIBM_LIB_VERSION)
+    _LIB_VERSION_TYPE _LIB_VERSION = _IEEE_;
+#endif
+
 /* variations on pp_null */
 
 PP(pp_stub)
@@ -159,7 +167,7 @@ PP(pp_rv2gv)
                if (SvREADONLY(sv))
                    Perl_croak(aTHX_ PL_no_modify);
                if (PL_op->op_private & OPpDEREF) {
-                   char *name;
+                   const char *name;
                    GV *gv;
                    if (cUNOP->op_targ) {
                        STRLEN len;
@@ -175,12 +183,11 @@ PP(pp_rv2gv)
                    if (SvTYPE(sv) < SVt_RV)
                        sv_upgrade(sv, SVt_RV);
                    if (SvPVX(sv)) {
-                       SvOOK_off(sv);          /* backoff */
-                       if (SvLEN(sv))
-                           Safefree(SvPVX(sv));
-                       SvLEN(sv)=SvCUR(sv)=0;
+                       SvPV_free(sv);
+                       SvLEN_set(sv, 0);
+                        SvCUR_set(sv, 0);
                    }
-                   SvRV(sv) = (SV*)gv;
+                   SvRV_set(sv, (SV*)gv);
                    SvROK_on(sv);
                    SvSETMAGIC(sv);
                    goto wasref;
@@ -493,7 +500,7 @@ S_refto(pTHX_ SV *sv)
     }
     rv = sv_newmortal();
     sv_upgrade(rv, SVt_RV);
-    SvRV(rv) = sv;
+    SvRV_set(rv, sv);
     SvROK_on(rv);
     return rv;
 }
@@ -502,7 +509,7 @@ PP(pp_ref)
 {
     dSP; dTARGET;
     SV *sv;
-    char *pv;
+    const char *pv;
 
     sv = POPs;
 
@@ -528,7 +535,7 @@ PP(pp_bless)
     else {
        SV *ssv = POPs;
        STRLEN len;
-       char *ptr;
+       const char *ptr;
 
        if (ssv && !SvGMAGICAL(ssv) && !SvAMAGIC(ssv) && SvROK(ssv))
            Perl_croak(aTHX_ "Attempt to bless into a reference");
@@ -548,7 +555,7 @@ PP(pp_gelem)
     GV *gv;
     SV *sv;
     SV *tmpRef;
-    char *elem;
+    const char *elem;
     dSP;
     STRLEN n_a;
 
@@ -597,7 +604,7 @@ PP(pp_gelem)
            break;
        case 'P':
            if (strEQ(elem2, "ACKAGE")) {
-               char *name = HvNAME(GvSTASH(gv));
+               const char *name = HvNAME(GvSTASH(gv));
                sv = newSVpv(name ? name : "__ANON__", 0);
            }
            break;
@@ -824,8 +831,7 @@ PP(pp_undef)
        break;
     default:
        if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
-           SvOOK_off(sv);
-           Safefree(SvPVX(sv));
+           SvPV_free(sv);
            SvPV_set(sv, Nullch);
            SvLEN_set(sv, 0);
        }
@@ -844,7 +850,7 @@ PP(pp_predec)
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MIN)
     {
-       --SvIVX(TOPs);
+       SvIV_set(TOPs, SvIVX(TOPs) - 1);
        SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
@@ -862,7 +868,7 @@ PP(pp_postinc)
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MAX)
     {
-       ++SvIVX(TOPs);
+       SvIV_set(TOPs, SvIVX(TOPs) + 1);
        SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
@@ -884,7 +890,7 @@ PP(pp_postdec)
     if (!SvREADONLY(TOPs) && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)
         && SvIVX(TOPs) != IV_MIN)
     {
-       --SvIVX(TOPs);
+       SvIV_set(TOPs, SvIVX(TOPs) - 1);
        SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
     }
     else
@@ -1488,13 +1494,13 @@ PP(pp_repeat)
            if (count < 1)
                SvCUR_set(TARG, 0);
            else {
-               IV max = count * len;
+               STRLEN max = (UV)count * len;
                if (len > ((MEM_SIZE)~0)/count)
                     Perl_croak(aTHX_ oom_string_extend);
                MEM_WRAP_CHECK_1(max, char, oom_string_extend);
-               SvGROW(TARG, (count * len) + 1);
+               SvGROW(TARG, max + 1);
                repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
-               SvCUR(TARG) *= count;
+               SvCUR_set(TARG, SvCUR(TARG) * count);
            }
            *SvEND(TARG) = '\0';
        }
@@ -2523,7 +2529,7 @@ STATIC
 PP(pp_i_modulo_0)
 {
      /* This is the vanilla old i_modulo. */
-     dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+     dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
      {
          dPOPTOPiirl;
          if (!right)
@@ -2540,7 +2546,7 @@ PP(pp_i_modulo_1)
      /* This is the i_modulo with the workaround for the _moddi3 bug
       * in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
       * See below for pp_i_modulo. */
-     dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+     dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
      {
          dPOPTOPiirl;
          if (!right)
@@ -2553,7 +2559,7 @@ PP(pp_i_modulo_1)
 
 PP(pp_i_modulo)
 {
-     dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+     dVAR; dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
      {
          dPOPTOPiirl;
          if (!right)
@@ -2995,11 +3001,11 @@ PP(pp_substr)
     I32 pos;
     I32 rem;
     I32 fail;
-    I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
-    char *tmps;
-    I32 arybase = PL_curcop->cop_arybase;
+    const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+    const char *tmps;
+    const I32 arybase = PL_curcop->cop_arybase;
     SV *repl_sv = NULL;
-    char *repl = 0;
+    const char *repl = 0;
     STRLEN repl_len;
     int num_args = PL_op->op_private & 7;
     bool repl_need_utf8_upgrade = FALSE;
@@ -3395,8 +3401,8 @@ PP(pp_chr)
 
 PP(pp_crypt)
 {
-    dSP; dTARGET;
 #ifdef HAS_CRYPT
+    dSP; dTARGET;
     dPOPTOPssrl;
     STRLEN n_a;
     STRLEN len;
@@ -3583,8 +3589,10 @@ PP(pp_uc)
            SETs(TARG);
        }
        else {
+           STRLEN min = len + 1;
+
            (void)SvUPGRADE(TARG, SVt_PV);
-           SvGROW(TARG, len + 1);
+           SvGROW(TARG, min);
            (void)SvPOK_only(TARG);
            d = (U8*)SvPVX(TARG);
            send = s + len;
@@ -3592,14 +3600,16 @@ PP(pp_uc)
                STRLEN u = UTF8SKIP(s);
 
                toUPPER_utf8(s, tmpbuf, &ulen);
-               if (ulen > u) {
+               if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
+                   /* If the eventually required minimum size outgrows
+                    * the available space, we need to grow. */
                    UV o = d - (U8*)SvPVX(TARG);
 
                    /* If someone uppercases one million U+03B0s we
                     * SvGROW() one million times.  Or we could try
                     * guessing how much to allocate without allocating
                     * too much. Such is life. */
-                   SvGROW(TARG, SvLEN(TARG) + ulen - u);
+                   SvGROW(TARG, min);
                    d = (U8*)SvPVX(TARG) + o;
                }
                Copy(tmpbuf, d, ulen, U8);
@@ -3662,8 +3672,10 @@ PP(pp_lc)
            SETs(TARG);
        }
        else {
+           STRLEN min = len + 1;
+
            (void)SvUPGRADE(TARG, SVt_PV);
-           SvGROW(TARG, len + 1);
+           SvGROW(TARG, min);
            (void)SvPOK_only(TARG);
            d = (U8*)SvPVX(TARG);
            send = s + len;
@@ -3690,14 +3702,16 @@ PP(pp_lc)
                      * See lib/unicore/SpecialCasing.txt.
                      */
                }
-               if (ulen > u) {
+               if (ulen > u && (SvLEN(TARG) < (min += ulen - u))) {
+                   /* If the eventually required minimum size outgrows
+                    * the available space, we need to grow. */
                    UV o = d - (U8*)SvPVX(TARG);
 
                    /* If someone lowercases one million U+0130s we
                     * SvGROW() one million times.  Or we could try
                     * guessing how much to allocate without allocating.
                     * too much.  Such is life. */
-                   SvGROW(TARG, SvLEN(TARG) + ulen - u);
+                   SvGROW(TARG, min);
                    d = (U8*)SvPVX(TARG) + o;
                }
                Copy(tmpbuf, d, ulen, U8);
@@ -4136,7 +4150,7 @@ PP(pp_anonhash)
 
 PP(pp_splice)
 {
-    dSP; dMARK; dORIGMARK;
+    dVAR; dSP; dMARK; dORIGMARK;
     register AV *ary = (AV*)*++MARK;
     register SV **src;
     register SV **dst;
@@ -4250,7 +4264,7 @@ PP(pp_splice)
                    *dst-- = *src--;
            }
            dst = AvARRAY(ary);
-           SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
+           SvPV_set(ary, (char*)(AvARRAY(ary) - diff)); /* diff is negative */
            AvMAX(ary) += diff;
        }
        else {
@@ -4287,7 +4301,7 @@ PP(pp_splice)
                    dst = src - diff;
                    Move(src, dst, offset, SV*);
                }
-               SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
+               SvPV_set(ary, (char*)(AvARRAY(ary) - diff));/* diff is positive */
                AvMAX(ary) += diff;
                AvFILLp(ary) += diff;
            }
@@ -4343,7 +4357,7 @@ PP(pp_splice)
 
 PP(pp_push)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
     register AV *ary = (AV*)*++MARK;
     register SV *sv = &PL_sv_undef;
     MAGIC *mg;
@@ -4398,7 +4412,7 @@ PP(pp_shift)
 
 PP(pp_unshift)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
     register AV *ary = (AV*)*++MARK;
     register SV *sv;
     register I32 i = 0;
@@ -4500,7 +4514,7 @@ PP(pp_reverse)
 
 PP(pp_split)
 {
-    dSP; dTARG;
+    dVAR; dSP; dTARG;
     AV *ary;
     register IV limit = POPi;                  /* note, negative is forever */
     SV *sv = POPs;