Add new step to run_byacc which:

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

diff --git a/pp.c b/pp.c
index d5e4dd7..ebdf3fd 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -341,7 +341,7 @@ PP(pp_av2arylen)
     if (!sv) {
        AvARYLEN(av) = sv = NEWSV(0,0);
        sv_upgrade(sv, SVt_IV);
-       sv_magic(sv, (SV*)av, '#', Nullch, 0);
+       sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
     }
     SETs(sv);
     RETURN;
@@ -354,7 +354,7 @@ PP(pp_pos)
     if (PL_op->op_flags & OPf_MOD || LVRET) {
        if (SvTYPE(TARG) < SVt_PVLV) {
            sv_upgrade(TARG, SVt_PVLV);
-           sv_magic(TARG, Nullsv, '.', Nullch, 0);
+           sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
        }
 
        LvTYPE(TARG) = '.';
@@ -370,7 +370,7 @@ PP(pp_pos)
        MAGIC* mg;
 
        if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
-           mg = mg_find(sv, 'g');
+           mg = mg_find(sv, PERL_MAGIC_regex_global);
            if (mg && mg->mg_len >= 0) {
                I32 i = mg->mg_len;
                if (DO_UTF8(sv))
@@ -715,7 +715,8 @@ PP(pp_study)
     }
 
     SvSCREAM_on(sv);
-    sv_magic(sv, Nullsv, 'g', Nullch, 0);      /* piggyback on m//g magic */
+    /* piggyback on m//g magic */
+    sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
     RETPUSHYES;
 }
 
@@ -783,11 +784,13 @@ PP(pp_defined)
        RETPUSHNO;
     switch (SvTYPE(sv)) {
     case SVt_PVAV:
-       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+       if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
+               || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
            RETPUSHYES;
        break;
     case SVt_PVHV:
-       if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+       if (HvARRAY(sv) || SvGMAGICAL(sv)
+               || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
            RETPUSHYES;
        break;
     case SVt_PVCV:
@@ -1090,13 +1093,13 @@ PP(pp_modulo)
 {
     dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
     {
-       UV left;
-       UV right;
+       UV left  = 0;
+       UV right = 0;
        bool left_neg;
        bool right_neg;
        bool use_double = 0;
-       NV dright;
-       NV dleft;
+       NV dright = 0.0;
+       NV dleft  = 0.0;
 
        if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
            IV i = SvIVX(POPs);
@@ -1262,8 +1265,8 @@ PP(pp_subtract)
        /* 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.  */
-       register UV auv;
-       bool auvok;
+       register UV auv = 0;
+       bool auvok = FALSE;
        bool a_valid = 0;
 
        if (!useleft) {
@@ -1908,7 +1911,7 @@ PP(pp_slt)
     dSP; tryAMAGICbinSET(slt,0);
     {
       dPOPTOPssrl;
-      int cmp = ((PL_op->op_private & OPpLOCALE)
+      int cmp = (IN_LOCALE_RUNTIME
                 ? sv_cmp_locale(left, right)
                 : sv_cmp(left, right));
       SETs(boolSV(cmp < 0));
@@ -1921,7 +1924,7 @@ PP(pp_sgt)
     dSP; tryAMAGICbinSET(sgt,0);
     {
       dPOPTOPssrl;
-      int cmp = ((PL_op->op_private & OPpLOCALE)
+      int cmp = (IN_LOCALE_RUNTIME
                 ? sv_cmp_locale(left, right)
                 : sv_cmp(left, right));
       SETs(boolSV(cmp > 0));
@@ -1934,7 +1937,7 @@ PP(pp_sle)
     dSP; tryAMAGICbinSET(sle,0);
     {
       dPOPTOPssrl;
-      int cmp = ((PL_op->op_private & OPpLOCALE)
+      int cmp = (IN_LOCALE_RUNTIME
                 ? sv_cmp_locale(left, right)
                 : sv_cmp(left, right));
       SETs(boolSV(cmp <= 0));
@@ -1947,7 +1950,7 @@ PP(pp_sge)
     dSP; tryAMAGICbinSET(sge,0);
     {
       dPOPTOPssrl;
-      int cmp = ((PL_op->op_private & OPpLOCALE)
+      int cmp = (IN_LOCALE_RUNTIME
                 ? sv_cmp_locale(left, right)
                 : sv_cmp(left, right));
       SETs(boolSV(cmp >= 0));
@@ -1978,15 +1981,9 @@ PP(pp_sne)
 PP(pp_scmp)
 {
     dSP; dTARGET;  tryAMAGICbin(scmp,0);
-#ifndef NV_PRESERVES_UV
-    if (SvROK(TOPs) && SvROK(TOPm1s)) {
-       SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
-       RETURN;
-    }
-#endif
     {
       dPOPTOPssrl;
-      int cmp = ((PL_op->op_private & OPpLOCALE)
+      int cmp = (IN_LOCALE_RUNTIME
                 ? sv_cmp_locale(left, right)
                 : sv_cmp(left, right));
       SETi( cmp );
@@ -2601,7 +2598,16 @@ PP(pp_int)
                  SETu(U_V(value));
              } else {
 #if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+#   ifdef HAS_MODFL_POW32_BUG
+/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
+                { 
+                    NV offset = Perl_modf(value, &value);
+                    (void)Perl_modf(offset, &offset);
+                    value += offset;
+                }
+#   else
                  (void)Perl_modf(value, &value);
+#   endif
 #else
                  double tmp = (double)value;
                  (void)Perl_modf(tmp, &tmp);
@@ -2615,7 +2621,16 @@ PP(pp_int)
                  SETi(I_V(value));
              } else {
 #if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+#   ifdef HAS_MODFL_POW32_BUG
+/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
+                 {
+                     NV offset = Perl_modf(-value, &value);
+                     (void)Perl_modf(offset, &offset);
+                     value += offset;
+                 }
+#   else
                  (void)Perl_modf(-value, &value);
+#   endif
                  value = -value;
 #else
                  double tmp = (double)value;
@@ -2719,7 +2734,7 @@ PP(pp_substr)
 {
     dSP; dTARGET;
     SV *sv;
-    I32 len;
+    I32 len = 0;
     STRLEN curlen;
     STRLEN utf8_curlen;
     I32 pos;
@@ -2814,6 +2829,9 @@ PP(pp_substr)
            sv_pos_u2b(sv, &pos, &rem);
        tmps += pos;
        sv_setpvn(TARG, tmps, rem);
+#ifdef USE_LOCALE_COLLATE
+       sv_unmagic(TARG, PERL_MAGIC_collxfrm);
+#endif
        if (utf8_curlen)
            SvUTF8_on(TARG);
        if (repl) {
@@ -2848,7 +2866,7 @@ PP(pp_substr)
 
            if (SvTYPE(TARG) < SVt_PVLV) {
                sv_upgrade(TARG, SVt_PVLV);
-               sv_magic(TARG, Nullsv, 'x', Nullch, 0);
+               sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
            }
 
            LvTYPE(TARG) = 'x';
@@ -2878,7 +2896,7 @@ PP(pp_vec)
     if (lvalue) {                      /* it's an lvalue! */
        if (SvTYPE(TARG) < SVt_PVLV) {
            sv_upgrade(TARG, SVt_PVLV);
-           sv_magic(TARG, Nullsv, 'v', Nullch, 0);
+           sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
        }
        LvTYPE(TARG) = 'v';
        if (LvTARG(TARG) != src) {
@@ -3001,7 +3019,7 @@ PP(pp_chr)
 
     (void)SvUPGRADE(TARG,SVt_PV);
 
-    if (value > 255 && !IN_BYTE) {
+    if (value > 255 && !IN_BYTES) {
        SvGROW(TARG, UNISKIP(value)+1);
        tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
        SvCUR_set(TARG, tmps - SvPVX(TARG));
@@ -3054,7 +3072,7 @@ PP(pp_ucfirst)
        U8 *tend;
        UV uv;
 
-       if (PL_op->op_private & OPpLOCALE) {
+       if (IN_LOCALE_RUNTIME) {
            TAINT;
            SvTAINTED_on(sv);
            uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
@@ -3086,7 +3104,7 @@ PP(pp_ucfirst)
        }
        s = (U8*)SvPV_force(sv, slen);
        if (*s) {
-           if (PL_op->op_private & OPpLOCALE) {
+           if (IN_LOCALE_RUNTIME) {
                TAINT;
                SvTAINTED_on(sv);
                *s = toUPPER_LC(*s);
@@ -3113,7 +3131,7 @@ PP(pp_lcfirst)
        U8 *tend;
        UV uv;
 
-       if (PL_op->op_private & OPpLOCALE) {
+       if (IN_LOCALE_RUNTIME) {
            TAINT;
            SvTAINTED_on(sv);
            uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
@@ -3145,7 +3163,7 @@ PP(pp_lcfirst)
        }
        s = (U8*)SvPV_force(sv, slen);
        if (*s) {
-           if (PL_op->op_private & OPpLOCALE) {
+           if (IN_LOCALE_RUNTIME) {
                TAINT;
                SvTAINTED_on(sv);
                *s = toLOWER_LC(*s);
@@ -3184,7 +3202,7 @@ PP(pp_uc)
            (void)SvPOK_only(TARG);
            d = (U8*)SvPVX(TARG);
            send = s + len;
-           if (PL_op->op_private & OPpLOCALE) {
+           if (IN_LOCALE_RUNTIME) {
                TAINT;
                SvTAINTED_on(TARG);
                while (s < send) {
@@ -3216,7 +3234,7 @@ PP(pp_uc)
        if (len) {
            register U8 *send = s + len;
 
-           if (PL_op->op_private & OPpLOCALE) {
+           if (IN_LOCALE_RUNTIME) {
                TAINT;
                SvTAINTED_on(sv);
                for (; s < send; s++)
@@ -3258,7 +3276,7 @@ PP(pp_lc)
            (void)SvPOK_only(TARG);
            d = (U8*)SvPVX(TARG);
            send = s + len;
-           if (PL_op->op_private & OPpLOCALE) {
+           if (IN_LOCALE_RUNTIME) {
                TAINT;
                SvTAINTED_on(TARG);
                while (s < send) {
@@ -3291,7 +3309,7 @@ PP(pp_lc)
        if (len) {
            register U8 *send = s + len;
 
-           if (PL_op->op_private & OPpLOCALE) {
+           if (IN_LOCALE_RUNTIME) {
                TAINT;
                SvTAINTED_on(sv);
                for (; s < send; s++)
@@ -3713,7 +3731,7 @@ PP(pp_splice)
     SV **tmparyval = 0;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -3907,7 +3925,7 @@ PP(pp_push)
     register SV *sv = &PL_sv_undef;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -3963,7 +3981,7 @@ PP(pp_unshift)
     register I32 i = 0;
     MAGIC *mg;
 
-    if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+    if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
        *MARK-- = SvTIED_obj((SV*)ary, mg);
        PUSHMARK(MARK);
        PUTBACK;
@@ -4117,7 +4135,7 @@ PP(pp_unpack)
     register char *patend = pat + llen;
     I32 datumtype;
     register I32 len;
-    register I32 bits;
+    register I32 bits = 0;
     register char *str;
 
     /* These must not be in registers: */
@@ -4137,8 +4155,8 @@ PP(pp_unpack)
     float afloat;
     double adouble;
     I32 checksum = 0;
-    register U32 culong;
-    NV cdouble;
+    register U32 culong = 0;
+    NV cdouble = 0.0;
     int commas = 0;
     int star;
 #ifdef PERL_NATINT_PACK
@@ -5465,9 +5483,26 @@ PP(pp_pack)
        case 'c':
            while (len-- > 0) {
                fromstr = NEXTFROM;
-               aint = SvIV(fromstr);
-               achar = aint;
-               sv_catpvn(cat, &achar, sizeof(char));
+               switch (datumtype) {
+               case 'C':
+                   aint = SvIV(fromstr);
+                   if ((aint < 0 || aint > 255) &&
+                       ckWARN(WARN_PACK))
+                       Perl_warner(aTHX_ WARN_PACK,
+                                   "Character in \"C\" format wrapped");
+                   achar = aint & 255;
+                   sv_catpvn(cat, &achar, sizeof(char));
+                   break;
+               case 'c':
+                   aint = SvIV(fromstr);
+                   if ((aint < -128 || aint > 127) &&
+                       ckWARN(WARN_PACK))
+                       Perl_warner(aTHX_ WARN_PACK,
+                                   "Character in \"c\" format wrapped");
+                   achar = aint & 255;
+                   sv_catpvn(cat, &achar, sizeof(char));
+                   break;
+               }
            }
            break;
        case 'U':
@@ -5846,7 +5881,7 @@ PP(pp_split)
        av_extend(ary,0);
        av_clear(ary);
        SPAGAIN;
-       if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+       if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
            PUSHMARK(SP);
            XPUSHs(SvTIED_obj((SV*)ary, mg));
        }
@@ -6093,7 +6128,7 @@ PP(pp_split)
 void
 Perl_unlock_condpair(pTHX_ void *svv)
 {
-    MAGIC *mg = mg_find((SV*)svv, 'm');
+    MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
 
     if (!mg)
        Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");