Regen stuff.

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

diff --git a/pp_pack.c b/pp_pack.c
index 4cf3b93..486c4f7 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -2101,7 +2101,18 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg
                     afloat = _float_constants[0];   /* single prec. inf. */
                else afloat = (float)SvNV(fromstr);
 #else
+# if defined(VMS) && !defined(__IEEE_FP)
+/* IEEE fp overflow shenanigans are unavailable on VAX and optional
+ * on Alpha; fake it if we don't have them.
+ */
+               if (SvNV(fromstr) > FLT_MAX)
+                    afloat = FLT_MAX;
+               else if (SvNV(fromstr) < -FLT_MAX)
+                    afloat = -FLT_MAX;
+               else afloat = (float)SvNV(fromstr);
+# else
                afloat = (float)SvNV(fromstr);
+# endif
 #endif
                sv_catpvn(cat, (char *)&afloat, sizeof (float));
            }
@@ -2122,7 +2133,18 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg
                     adouble = _double_constants[0];   /* double prec. inf. */
                else adouble = (double)SvNV(fromstr);
 #else
+# if defined(VMS) && !defined(__IEEE_FP)
+/* IEEE fp overflow shenanigans are unavailable on VAX and optional
+ * on Alpha; fake it if we don't have them.
+ */
+               if (SvNV(fromstr) > DBL_MAX)
+                    adouble = DBL_MAX;
+               else if (SvNV(fromstr) < -DBL_MAX)
+                    adouble = -DBL_MAX;
+               else adouble = (double)SvNV(fromstr);
+# else
                adouble = (double)SvNV(fromstr);
+# endif
 #endif
                sv_catpvn(cat, (char *)&adouble, sizeof (double));
            }
@@ -2232,9 +2254,9 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg
        case 'w':
             while (len-- > 0) {
                fromstr = NEXTFROM;
-               adouble = SvNV(fromstr);
+               anv = SvNV(fromstr);
 
-               if (adouble < 0)
+               if (anv < 0)
                    Perl_croak(aTHX_ "Cannot compress negative numbers");
 
                 /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0,
@@ -2242,7 +2264,7 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg
                    any negative IVs will have already been got by the croak()
                    above. IOK is untrue for fractions, so we test them
                    against UV_MAX_P1.  */
-               if (SvIOK(fromstr) || adouble < UV_MAX_P1)
+               if (SvIOK(fromstr) || anv < UV_MAX_P1)
                {
                    char   buf[(sizeof(UV)*8)/7+1];
                    char  *in = buf + sizeof(buf);
@@ -2277,17 +2299,17 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg
                    SvREFCNT_dec(norm); /* free norm */
                 }
                else if (SvNOKp(fromstr)) {
-                   char   buf[sizeof(double) * 2];     /* 8/7 <= 2 */
+                   char   buf[sizeof(NV) * 2]; /* 8/7 <= 2 */
                    char  *in = buf + sizeof(buf);
 
-                    adouble = Perl_floor(adouble);
+                    anv = Perl_floor(anv);
                    do {
-                       double next = floor(adouble / 128);
-                       *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
+                       NV next = Perl_floor(anv / 128);
+                       *--in = (unsigned char)(anv - (next * 128)) | 0x80;
                        if (in <= buf)  /* this cannot happen ;-) */
                            Perl_croak(aTHX_ "Cannot compress integer");
-                       adouble = next;
-                   } while (adouble > 0);
+                       anv = next;
+                   } while (anv > 0);
                    buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
                    sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
                }