[MERGE] eliminate OP_PUSHRE and optimise split()

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 8d7f1e2..40c3100 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -791,20 +791,20 @@ first_symbol(const char *pat, const char *patend) {
 
 =for apidoc unpackstring
 
 
 =for apidoc unpackstring
 

-The engine implementing the unpack() Perl function.
+The engine implementing the C<unpack()> Perl function.

 
 

-Using the template pat..patend, this function unpacks the string
-s..strend into a number of mortal SVs, which it pushes onto the perl
-argument (@_) stack (so you will need to issue a C<PUTBACK> before and
+Using the template C<pat..patend>, this function unpacks the string
+C<s..strend> into a number of mortal SVs, which it pushes onto the perl
+argument (C<@_>) stack (so you will need to issue a C<PUTBACK> before and

 C<SPAGAIN> after the call to this function).  It returns the number of
 pushed elements.
 
 C<SPAGAIN> after the call to this function).  It returns the number of
 pushed elements.
 

-The strend and patend pointers should point to the byte following the last
-character of each string.
+The C<strend> and C<patend> pointers should point to the byte following the
+last character of each string.

 
 Although this function returns its values on the perl argument stack, it
 doesn't take any parameters from that stack (and thus in particular
 
 Although this function returns its values on the perl argument stack, it
 doesn't take any parameters from that stack (and thus in particular

-there's no need to do a PUSHMARK before calling it, unlike L</call_pv> for
+there's no need to do a C<PUSHMARK> before calling it, unlike L</call_pv> for

 example).
 
 =cut */
 example).
 
 =cut */


@@ -1826,7 +1826,7 @@ PP(pp_unpack)
 {
     dSP;
     dPOPPOPssrl;
 {
     dSP;
     dPOPPOPssrl;

-    I32 gimme = GIMME_V;
+    U8 gimme = GIMME_V;

     STRLEN llen;
     STRLEN rlen;
     const char *pat = SvPV_const(left,  llen);
     STRLEN llen;
     STRLEN rlen;
     const char *pat = SvPV_const(left,  llen);


@@ -1948,7 +1948,7 @@ S_div128(pTHX_ SV *pnum, bool *done)
 /*
 =for apidoc packlist
 
 /*
 =for apidoc packlist
 

-The engine implementing pack() Perl function.
+The engine implementing C<pack()> Perl function.

 
 =cut
 */
 
 =cut
 */


@@ -2488,7 +2488,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (howlen == e_star) len = fromlen;
            field_len = (len+1)/2;
            GROWING(utf8, cat, start, cur, field_len);
            if (howlen == e_star) len = fromlen;
            field_len = (len+1)/2;
            GROWING(utf8, cat, start, cur, field_len);

-           if (!utf8 && len > (I32)fromlen) len = fromlen;
+           if (!utf8_source && len > (I32)fromlen) len = fromlen;

            bits = 0;
            l = 0;
            if (datumtype == 'H')
            bits = 0;
            l = 0;
            if (datumtype == 'H')


@@ -2674,7 +2674,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);

-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)

                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */


@@ -2684,15 +2684,17 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else
                    afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else

-#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+#  if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)

                if(Perl_isnan(anv))
                    afloat = (float)NV_NAN;
                else
                if(Perl_isnan(anv))
                    afloat = (float)NV_NAN;
                else

-#endif
+#  endif
+#  ifdef NV_INF

                 /* a simple cast to float is undefined if outside
                  * the range of values that can be represented */
                afloat = (float)(anv >  FLT_MAX ?  NV_INF :
                                  anv < -FLT_MAX ? -NV_INF : anv);
                 /* a simple cast to float is undefined if outside
                  * the range of values that can be represented */
                afloat = (float)(anv >  FLT_MAX ?  NV_INF :
                                  anv < -FLT_MAX ? -NV_INF : anv);

+#  endif

 # endif
                 PUSH_VAR(utf8, cur, afloat, needs_swap);
            }
 # endif
                 PUSH_VAR(utf8, cur, afloat, needs_swap);
            }


@@ -2703,7 +2705,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);

-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)

                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */


@@ -3040,7 +3042,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
                     * of pack() (and all copies of the result) are
                     * gone.
                     */

-                   if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
+                   if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1)
+                        || (SvPADTMP(fromstr) &&

                             !SvREADONLY(fromstr)))) {
                        Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
                                       "Attempt to pack pointer to temporary value");
                             !SvREADONLY(fromstr)))) {
                        Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
                                       "Attempt to pack pointer to temporary value");