summaryrefslogtreecommitdiff
path: root/ext
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2006-10-07 17:16:01 +0000
committerNicholas Clark <nick@ccl4.org>2006-10-07 17:16:01 +0000
commite52c0e5ac309b0c21b42bc1225acdeaa1ca6b14a (patch)
treea8e7b288cfce94a8e16d95675c05bf47f5c8f08e /ext
parent383d9087d85942bfbdcb8d799deecaa09c2664a0 (diff)
downloadperl-e52c0e5ac309b0c21b42bc1225acdeaa1ca6b14a.tar.gz
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
Diffstat (limited to 'ext')
-rw-r--r--ext/Data/Dumper/Dumper.pm30
-rw-r--r--ext/Data/Dumper/Dumper.xs26
2 files changed, 45 insertions, 11 deletions
diff --git a/ext/Data/Dumper/Dumper.pm b/ext/Data/Dumper/Dumper.pm
index dce243d8c5..44b802365d 100644
--- 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 0fc7bbdd46..36383dc5f9 100644
--- 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)))