Use packed addresses for the seen tracking hash, rather than

"stringified" references. These use less memory, and should be faster
as there is no call to sprintf().

p4raw-id: //depot/perl@28960

diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index dce243d..44b8023 100644 (file)
--- a/ext/Data/Dumper/Dumper.pm
+++ b/ext/Data/Dumper/Dumper.pm
@@ -9,7 +9,7 @@
 
 package Data::Dumper;
 
-$VERSION = '2.121_09';
+$VERSION = '2.121_10';
 
 #$| = 1;
 
@@ -101,16 +101,26 @@ sub new {
   return bless($s, $c);
 }
 
-sub init_refaddr_format {
-  require Config;
-  my $f = $Config::Config{uvxformat};
-  $f =~ tr/"//d;
-  our $refaddr_format = "0x%" . $f;
-}
+if ($] >= 5.006) {
+  # Packed numeric addresses take less memory. Plus pack is faster than sprintf
+  *init_refaddr_format = sub {};
 
-sub format_refaddr {
-  require Scalar::Util;
-  sprintf our $refaddr_format, Scalar::Util::refaddr(shift);
+  *format_refaddr  = sub {
+    require Scalar::Util;
+    pack "J", Scalar::Util::refaddr(shift);
+  };
+} else {
+  *init_refaddr_format = sub {
+    require Config;
+    my $f = $Config::Config{uvxformat};
+    $f =~ tr/"//d;
+    our $refaddr_format = "0x%" . $f;
+  };
+
+  *format_refaddr = sub {
+    require Scalar::Util;
+    sprintf our $refaddr_format, Scalar::Util::refaddr(shift);
+  }
 }
 
 #

diff --git a/ext/Data/Dumper/Dumper.xs b/ext/Data/Dumper/Dumper.xs
index 0fc7bbd..36383dc 100644 (file)
--- a/ext/Data/Dumper/Dumper.xs
+++ b/ext/Data/Dumper/Dumper.xs
@@ -4,6 +4,10 @@
 #include "XSUB.h"
 #include "ppport.h"
 
+#if PERL_VERSION < 6
+#  define DD_USE_OLD_ID_FORMAT
+#endif
+
 static I32 num_q (const char *s, STRLEN slen);
 static I32 esc_q (char *dest, const char *src, STRLEN slen);
 static I32 esc_q_utf8 (pTHX_ SV *sv, const char *src, STRLEN slen);
@@ -252,7 +256,13 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
 {
     char tmpbuf[128];
     U32 i;
-    char *c, *r, *realpack, id[128];
+    char *c, *r, *realpack;
+#ifdef DD_USE_OLD_ID_FORMAT
+    char id[128];
+#else
+    UV id_buffer;
+    char *const id = (char *)&id_buffer;
+#endif
     SV **svp;
     SV *sv, *ipad, *ival;
     SV *blesspad = Nullsv;
@@ -288,7 +298,12 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
        
        ival = SvRV(val);
        realtype = SvTYPE(ival);
+#ifdef DD_USE_OLD_ID_FORMAT
         idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(ival));
+#else
+       id_buffer = PTR2UV(ival);
+       idlen = sizeof(id_buffer);
+#endif
        if (SvOBJECT(ival))
            realpack = HvNAME_get(SvSTASH(ival));
        else
@@ -339,7 +354,11 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
                    return 1;
                }
                else {
+#ifdef DD_USE_OLD_ID_FORMAT
                    warn("ref name not found for %s", id);
+#else
+                   warn("ref name not found for 0x%"UVxf, PTR2UV(ival));
+#endif
                    return 0;
                }
            }
@@ -765,7 +784,12 @@ DD_dump(pTHX_ SV *val, const char *name, STRLEN namelen, SV *retval, HV *seenhv,
        STRLEN i;
        
        if (namelen) {
+#ifdef DD_USE_OLD_ID_FORMAT
            idlen = my_snprintf(id, sizeof(id), "0x%"UVxf, PTR2UV(val));
+#else
+           id_buffer = PTR2UV(val);
+           idlen = sizeof(id_buffer);
+#endif
            if ((svp = hv_fetch(seenhv, id, idlen, FALSE)) &&
                (sv = *svp) && SvROK(sv) &&
                (seenentry = (AV*)SvRV(sv)))