Removing so_locations once is enough.

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

diff --git a/sv.c b/sv.c
index 4bdf847..ef46563 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1068,7 +1068,7 @@ S_not_a_number(pTHX_ SV *sv)
        Perl_warner(aTHX_ WARN_NUMERIC, "Argument \"%s\" isn't numeric", tmpbuf);
 }
 
-/* the number can be converted to _integer_ with atol() */
+/* the number can be converted to integer with atol() or atoll() */
 #define IS_NUMBER_TO_INT_BY_ATOL 0x01
 #define IS_NUMBER_TO_INT_BY_ATOF 0x02 /* atol() may be != atof() */
 #define IS_NUMBER_NOT_IV        0x04 /* (IV)atof() may be != atof() */
@@ -1125,7 +1125,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
     if (SvNOKp(sv)) {
        /* We can cache the IV/UV value even if it not good enough
         * to reconstruct NV, since the conversion to PV will prefer
-        * NV over IV/UV.                               XXXX 64-bit?
+        * NV over IV/UV.
         */
 
        if (SvTYPE(sv) == SVt_NV)
@@ -1138,10 +1138,17 @@ Perl_sv_2iv(pTHX_ register SV *sv)
            SvUVX(sv) = U_V(SvNVX(sv));
            SvIsUV_on(sv);
          ret_iv_max:
+#ifdef IV_IS_QUAD
+           DEBUG_c(PerlIO_printf(Perl_debug_log, 
+                                 "0x%" PERL_PRIx64 " 2iv(%" PERL_PRIu64 " => %" PERL_PRId64 ") (as unsigned)\n",
+                                 (UV)sv,
+                                 (UV)SvUVX(sv), (IV)SvUVX(sv)));
+#else
            DEBUG_c(PerlIO_printf(Perl_debug_log, 
                                  "0x%lx 2iv(%lu => %ld) (as unsigned)\n",
                                  (unsigned long)sv,
                                  (unsigned long)SvUVX(sv), (long)(IV)SvUVX(sv)));
+#endif
            return (IV)SvUVX(sv);
        }
     }
@@ -1169,7 +1176,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
            (void)SvNOK_on(sv);
            (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIgldbl ")\n",
                                  (unsigned long)sv, SvNVX(sv)));
 #else
            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
@@ -1189,7 +1196,7 @@ Perl_sv_2iv(pTHX_ register SV *sv)
            if (SvTYPE(sv) == SVt_PV)
                sv_upgrade(sv, SVt_PVIV);
            (void)SvIOK_on(sv);
-           SvIVX(sv) = atol(SvPVX(sv)); /* XXXX 64-bit? */
+           SvIVX(sv) = Atol(SvPVX(sv));
        }
        else {                          /* Not a number.  Cache 0. */
            dTHR;
@@ -1263,7 +1270,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
     if (SvNOKp(sv)) {
        /* We can cache the IV/UV value even if it not good enough
         * to reconstruct NV, since the conversion to PV will prefer
-        * NV over IV/UV.                               XXXX 64-bit?
+        * NV over IV/UV.
         */
        if (SvTYPE(sv) == SVt_NV)
            sv_upgrade(sv, SVt_PVNV);
@@ -1275,10 +1282,17 @@ Perl_sv_2uv(pTHX_ register SV *sv)
        else {
            SvIVX(sv) = I_V(SvNVX(sv));
          ret_zero:
+#ifdef IV_IS_QUAD
+           DEBUG_c(PerlIO_printf(Perl_debug_log, 
+                                 "0x%" PERL_PRIx64 " 2uv(%" PERL_PRId64 " => %" PERL_PRIu64 ") (as signed)\n",
+                                 (unsigned long)sv,(long)SvIVX(sv),
+                                 (long)(UV)SvIVX(sv)));
+#else
            DEBUG_c(PerlIO_printf(Perl_debug_log, 
                                  "0x%lx 2uv(%ld => %lu) (as signed)\n",
                                  (unsigned long)sv,(long)SvIVX(sv),
                                  (long)(UV)SvIVX(sv)));
+#endif
            return (UV)SvIVX(sv);
        }
     }
@@ -1298,7 +1312,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
             * - otherwise future conversion to NV will be wrong.  */
            NV d;
 
-           d = Atof(SvPVX(sv));        /* XXXX 64-bit? */
+           d = Atof(SvPVX(sv));
 
            if (SvTYPE(sv) < SVt_PVNV)
                sv_upgrade(sv, SVt_PVNV);
@@ -1306,7 +1320,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
            (void)SvNOK_on(sv);
            (void)SvIOK_on(sv);
 #if defined(USE_LONG_DOUBLE)
-           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+           DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIg64 ")\n",
                                  (unsigned long)sv, SvNVX(sv)));
 #else
            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%g)\n",
@@ -1326,7 +1340,7 @@ Perl_sv_2uv(pTHX_ register SV *sv)
            if (SvTYPE(sv) == SVt_PV)
                sv_upgrade(sv, SVt_PVIV);
            (void)SvIOK_on(sv);
-           SvIVX(sv) = (IV)atol(SvPVX(sv)); /* XXXX 64-bit? */
+           SvIVX(sv) = (IV)Atol(SvPVX(sv));
        }
        else if (numtype) {             /* Non-negative */
            /* The NV may be reconstructed from UV - safe to cache UV,
@@ -1336,10 +1350,10 @@ Perl_sv_2uv(pTHX_ register SV *sv)
            (void)SvIOK_on(sv);
            (void)SvIsUV_on(sv);
 #ifdef HAS_STRTOUL
-           SvUVX(sv) = strtoul(SvPVX(sv), Null(char**), 10); /* XXXX 64-bit? */
+           SvUVX(sv) = Strtoul(SvPVX(sv), Null(char**), 10);
 #else                  /* no atou(), but we know the number fits into IV... */
                        /* The only problem may be if it is negative... */
-           SvUVX(sv) = (UV)atol(SvPVX(sv)); /* XXXX 64-bit? */
+           SvUVX(sv) = (UV)Atol(SvPVX(sv));
 #endif
        }
        else {                          /* Not a number.  Cache 0. */
@@ -1424,7 +1438,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
        DEBUG_c({
            RESTORE_NUMERIC_STANDARD();
-           PerlIO_printf(Perl_debug_log, "0x%lx num(%Lg)\n",
+           PerlIO_printf(Perl_debug_log, "0x%lx num(%" PERL_PRIg64 ")\n",
                          (unsigned long)sv, SvNVX(sv));
            RESTORE_NUMERIC_LOCAL();
        });
@@ -1463,7 +1477,7 @@ Perl_sv_2nv(pTHX_ register SV *sv)
 #if defined(USE_LONG_DOUBLE)
     DEBUG_c({
        RESTORE_NUMERIC_STANDARD();
-       PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%Lg)\n",
+       PerlIO_printf(Perl_debug_log, "0x%lx 2nv(%" PERL_PRIg64 ")\n",
                      (unsigned long)sv, SvNVX(sv));
        RESTORE_NUMERIC_LOCAL();
     });
@@ -1485,7 +1499,7 @@ S_asIV(pTHX_ SV *sv)
     NV d;
 
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
-       return atol(SvPVX(sv));         /* XXXX 64-bit? */
+       return Atol(SvPVX(sv));
     if (!numtype) {
        dTHR;
        if (ckWARN(WARN_NUMERIC))
@@ -1502,7 +1516,7 @@ S_asUV(pTHX_ SV *sv)
 
 #ifdef HAS_STRTOUL
     if (numtype & IS_NUMBER_TO_INT_BY_ATOL)
-       return strtoul(SvPVX(sv), Null(char**), 10);
+       return Strtoul(SvPVX(sv), Null(char**), 10);
 #endif
     if (!numtype) {
        dTHR;
@@ -1528,8 +1542,6 @@ S_asUV(pTHX_ SV *sv)
 I32
 Perl_looks_like_number(pTHX_ SV *sv)
 {
-    /* XXXX 64-bit?  It may be not IS_NUMBER_TO_INT_BY_ATOL, but
-     * using atof() may lose precision. */
     register char *s;
     register char *send;
     register char *sbegin;
@@ -1683,11 +1695,18 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
            *lp = SvCUR(sv);
            return SvPVX(sv);
        }
-       if (SvIOKp(sv)) {               /* XXXX 64-bit? */
+       if (SvIOKp(sv)) {
+#ifdef IV_IS_QUAD
+           if (SvIsUV(sv)) 
+               (void)sprintf(tmpbuf,"%" PERL_PRIu64,(UV)SvUVX(sv));
+           else
+               (void)sprintf(tmpbuf,"%" PERL_PRId64,(IV)SvIVX(sv));
+#else
            if (SvIsUV(sv)) 
                (void)sprintf(tmpbuf,"%lu",(unsigned long)SvUVX(sv));
            else
                (void)sprintf(tmpbuf,"%ld",(long)SvIVX(sv));
+#endif
            tsv = Nullsv;
            goto tokensave;
        }
@@ -1785,8 +1804,11 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
                    Perl_sv_setpvf(aTHX_ tsv, "%s=%s", HvNAME(SvSTASH(sv)), s);
                else
                    sv_setpv(tsv, s);
-               /* XXXX 64-bit? */
+#ifdef IV_IS_QUAD
+               Perl_sv_catpvf(aTHX_ tsv, "(0x%" PERL_PRIx64")", (UV)sv);
+#else
                Perl_sv_catpvf(aTHX_ tsv, "(0x%lx)", (unsigned long)sv);
+#endif
                goto tokensaveref;
            }
            *lp = strlen(s);
@@ -4803,15 +4825,20 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 
        switch (*q) {
        case 'l':
-#if 0  /* when quads have better support within Perl */
-           if (*(q + 1) == 'l') {
+#ifdef HAS_QUAD
+             if (*(q + 1) == 'l') {    /* lld */
                intsize = 'q';
                q += 2;
                break;
-           }
+            }
+       case 'L':                       /* Ld */
+       case 'q':                       /* qd */
+           intsize = 'q';
+           q++;
+           break;
 #endif
-           /* FALL THROUGH */
        case 'h':
+           /* FALL THROUGH */
        case 'V':
            intsize = *q++;
            break;
@@ -4908,6 +4935,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                default:        iv = va_arg(*args, int); break;
                case 'l':       iv = va_arg(*args, long); break;
                case 'V':       iv = va_arg(*args, IV); break;
+#ifdef HAS_QUAD
+               case 'q':       iv = va_arg(*args, Quad_t); break;
+#endif
                }
            }
            else {
@@ -4917,6 +4947,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                default:        iv = (int)iv; break;
                case 'l':       iv = (long)iv; break;
                case 'V':       break;
+#ifdef HAS_QUAD
+               case 'q':       iv = (Quad_t)iv; break;
+#endif
                }
            }
            if (iv >= 0) {
@@ -4960,6 +4993,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                default:   uv = va_arg(*args, unsigned); break;
                case 'l':  uv = va_arg(*args, unsigned long); break;
                case 'V':  uv = va_arg(*args, UV); break;
+#ifdef HAS_QUAD
+               case 'q':  uv = va_arg(*args, Quad_t); break;
+#endif
                }
            }
            else {
@@ -4969,6 +5005,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                default:        uv = (unsigned)uv; break;
                case 'l':       uv = (unsigned long)uv; break;
                case 'V':       break;
+#ifdef HAS_QUAD
+               case 'q':       uv = (Quad_t)uv; break;
+#endif
                }
            }
 
@@ -5061,7 +5100,10 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
            *--eptr = '\0';
            *--eptr = c;
 #ifdef USE_LONG_DOUBLE
-           *--eptr = 'L';
+           {
+               char* p = PRIfldbl + sizeof(PRIfldbl) - 3;
+               while (p >= PRIfldbl) { *--eptr = *p-- }
+           }
 #endif
            if (has_precis) {
                base = precis;
@@ -5113,6 +5155,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                default:        *(va_arg(*args, int*)) = i; break;
                case 'l':       *(va_arg(*args, long*)) = i; break;
                case 'V':       *(va_arg(*args, IV*)) = i; break;
+#ifdef HAS_QUAD
+               case 'q':       *(va_arg(*args, Quad_t*)) = i; break;
+#endif
                }
            }
            else if (svix < svmax)