diff options
author | Nicholas Clark <nick@ccl4.org> | 2006-10-07 17:16:01 +0000 |
---|---|---|
committer | Nicholas Clark <nick@ccl4.org> | 2006-10-07 17:16:01 +0000 |
commit | e52c0e5ac309b0c21b42bc1225acdeaa1ca6b14a (patch) | |
tree | a8e7b288cfce94a8e16d95675c05bf47f5c8f08e /ext/Data/Dumper | |
parent | 383d9087d85942bfbdcb8d799deecaa09c2664a0 (diff) | |
download | perl-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/Data/Dumper')
-rw-r--r-- | ext/Data/Dumper/Dumper.pm | 30 | ||||
-rw-r--r-- | ext/Data/Dumper/Dumper.xs | 26 |
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))) |