summaryrefslogtreecommitdiff
path: root/Master/tlpkg/tlperl/lib/Devel/Peek.pm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/tlpkg/tlperl/lib/Devel/Peek.pm')
-rwxr-xr-xMaster/tlpkg/tlperl/lib/Devel/Peek.pm570
1 files changed, 570 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/Devel/Peek.pm b/Master/tlpkg/tlperl/lib/Devel/Peek.pm
new file mode 100755
index 00000000000..2fced312f2e
--- /dev/null
+++ b/Master/tlpkg/tlperl/lib/Devel/Peek.pm
@@ -0,0 +1,570 @@
+# Devel::Peek - A data debugging tool for the XS programmer
+# The documentation is after the __END__
+
+package Devel::Peek;
+
+$VERSION = '1.04';
+$XS_VERSION = $VERSION;
+$VERSION = eval $VERSION;
+
+require Exporter;
+use XSLoader ();
+
+@ISA = qw(Exporter);
+@EXPORT = qw(Dump mstat DeadCode DumpArray DumpWithOP DumpProg
+ fill_mstats mstats_fillhash mstats2hash runops_debug debug_flags);
+@EXPORT_OK = qw(SvREFCNT SvREFCNT_inc SvREFCNT_dec CvGV);
+%EXPORT_TAGS = ('ALL' => [@EXPORT, @EXPORT_OK]);
+
+XSLoader::load 'Devel::Peek';
+
+sub import {
+ my $c = shift;
+ my $ops_rx = qr/^:opd(=[stP]*)?\b/;
+ my @db = grep m/$ops_rx/, @_;
+ @_ = grep !m/$ops_rx/, @_;
+ if (@db) {
+ die "Too many :opd options" if @db > 1;
+ runops_debug(1);
+ my $flags = ($db[0] =~ m/$ops_rx/ and $1);
+ $flags = 'st' unless defined $flags;
+ my $f = 0;
+ $f |= 2 if $flags =~ /s/;
+ $f |= 8 if $flags =~ /t/;
+ $f |= 64 if $flags =~ /P/;
+ $^D |= $f if $f;
+ }
+ unshift @_, $c;
+ goto &Exporter::import;
+}
+
+sub DumpWithOP ($;$) {
+ local($Devel::Peek::dump_ops)=1;
+ my $depth = @_ > 1 ? $_[1] : 4 ;
+ Dump($_[0],$depth);
+}
+
+$D_flags = 'psltocPmfrxuLHXDSTR';
+
+sub debug_flags (;$) {
+ my $out = "";
+ for my $i (0 .. length($D_flags)-1) {
+ $out .= substr $D_flags, $i, 1 if $^D & (1<<$i);
+ }
+ my $arg = shift;
+ my $num = $arg;
+ if (defined $arg and $arg =~ /\D/) {
+ die "unknown flags in debug_flags()" if $arg =~ /[^-$D_flags]/;
+ my ($on,$off) = split /-/, "$arg-";
+ $num = $^D;
+ $num |= (1<<index($D_flags, $_)) for split //, $on;
+ $num &= ~(1<<index($D_flags, $_)) for split //, $off;
+ }
+ $^D = $num if defined $arg;
+ $out
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Devel::Peek - A data debugging tool for the XS programmer
+
+=head1 SYNOPSIS
+
+ use Devel::Peek;
+ Dump( $a );
+ Dump( $a, 5 );
+ DumpArray( 5, $a, $b, ... );
+ mstat "Point 5";
+
+ use Devel::Peek ':opd=st';
+
+=head1 DESCRIPTION
+
+Devel::Peek contains functions which allows raw Perl datatypes to be
+manipulated from a Perl script. This is used by those who do XS programming
+to check that the data they are sending from C to Perl looks as they think
+it should look. The trick, then, is to know what the raw datatype is
+supposed to look like when it gets to Perl. This document offers some tips
+and hints to describe good and bad raw data.
+
+It is very possible that this document will fall far short of being useful
+to the casual reader. The reader is expected to understand the material in
+the first few sections of L<perlguts>.
+
+Devel::Peek supplies a C<Dump()> function which can dump a raw Perl
+datatype, and C<mstat("marker")> function to report on memory usage
+(if perl is compiled with corresponding option). The function
+DeadCode() provides statistics on the data "frozen" into inactive
+C<CV>. Devel::Peek also supplies C<SvREFCNT()>, C<SvREFCNT_inc()>, and
+C<SvREFCNT_dec()> which can query, increment, and decrement reference
+counts on SVs. This document will take a passive, and safe, approach
+to data debugging and for that it will describe only the C<Dump()>
+function.
+
+Function C<DumpArray()> allows dumping of multiple values (useful when you
+need to analyze returns of functions).
+
+The global variable $Devel::Peek::pv_limit can be set to limit the
+number of character printed in various string values. Setting it to 0
+means no limit.
+
+If C<use Devel::Peek> directive has a C<:opd=FLAGS> argument,
+this switches on debugging of opcode dispatch. C<FLAGS> should be a
+combination of C<s>, C<t>, and C<P> (see B<-D> flags in L<perlrun>).
+C<:opd> is a shortcut for C<:opd=st>.
+
+=head2 Runtime debugging
+
+C<CvGV($cv)> return one of the globs associated to a subroutine reference $cv.
+
+debug_flags() returns a string representation of C<$^D> (similar to
+what is allowed for B<-D> flag). When called with a numeric argument,
+sets $^D to the corresponding value. When called with an argument of
+the form C<"flags-flags">, set on/off bits of C<$^D> corresponding to
+letters before/after C<->. (The returned value is for C<$^D> before
+the modification.)
+
+runops_debug() returns true if the current I<opcode dispatcher> is the
+debugging one. When called with an argument, switches to debugging or
+non-debugging dispatcher depending on the argument (active for
+newly-entered subs/etc only). (The returned value is for the dispatcher before the modification.)
+
+=head2 Memory footprint debugging
+
+When perl is compiled with support for memory footprint debugging
+(default with Perl's malloc()), Devel::Peek provides an access to this API.
+
+Use mstat() function to emit a memory state statistic to the terminal.
+For more information on the format of output of mstat() see
+L<perldebguts/Using C<$ENV{PERL_DEBUG_MSTATS}>>.
+
+Three additional functions allow access to this statistic from Perl.
+First, use C<mstats_fillhash(%hash)> to get the information contained
+in the output of mstat() into %hash. The field of this hash are
+
+ minbucket nbuckets sbrk_good sbrk_slack sbrked_remains sbrks start_slack
+ topbucket topbucket_ev topbucket_odd total total_chain total_sbrk totfree
+
+Two additional fields C<free>, C<used> contain array references which
+provide per-bucket count of free and used chunks. Two other fields
+C<mem_size>, C<available_size> contain array references which provide
+the information about the allocated size and usable size of chunks in
+each bucket. Again, see L<perldebguts/Using C<$ENV{PERL_DEBUG_MSTATS}>>
+for details.
+
+Keep in mind that only the first several "odd-numbered" buckets are
+used, so the information on size of the "odd-numbered" buckets which are
+not used is probably meaningless.
+
+The information in
+
+ mem_size available_size minbucket nbuckets
+
+is the property of a particular build of perl, and does not depend on
+the current process. If you do not provide the optional argument to
+the functions mstats_fillhash(), fill_mstats(), mstats2hash(), then
+the information in fields C<mem_size>, C<available_size> is not
+updated.
+
+C<fill_mstats($buf)> is a much cheaper call (both speedwise and
+memory-wise) which collects the statistic into $buf in
+machine-readable form. At a later moment you may need to call
+C<mstats2hash($buf, %hash)> to use this information to fill %hash.
+
+All three APIs C<fill_mstats($buf)>, C<mstats_fillhash(%hash)>, and
+C<mstats2hash($buf, %hash)> are designed to allocate no memory if used
+I<the second time> on the same $buf and/or %hash.
+
+So, if you want to collect memory info in a cycle, you may call
+
+ $#buf = 999;
+ fill_mstats($_) for @buf;
+ mstats_fillhash(%report, 1); # Static info too
+
+ foreach (@buf) {
+ # Do something...
+ fill_mstats $_; # Collect statistic
+ }
+ foreach (@buf) {
+ mstats2hash($_, %report); # Preserve static info
+ # Do something with %report
+ }
+
+=head1 EXAMPLES
+
+The following examples don't attempt to show everything as that would be a
+monumental task, and, frankly, we don't want this manpage to be an internals
+document for Perl. The examples do demonstrate some basics of the raw Perl
+datatypes, and should suffice to get most determined people on their way.
+There are no guidewires or safety nets, nor blazed trails, so be prepared to
+travel alone from this point and on and, if at all possible, don't fall into
+the quicksand (it's bad for business).
+
+Oh, one final bit of advice: take L<perlguts> with you. When you return we
+expect to see it well-thumbed.
+
+=head2 A simple scalar string
+
+Let's begin by looking a simple scalar which is holding a string.
+
+ use Devel::Peek;
+ $a = "hello";
+ Dump $a;
+
+The output:
+
+ SV = PVIV(0xbc288)
+ REFCNT = 1
+ FLAGS = (POK,pPOK)
+ IV = 0
+ PV = 0xb2048 "hello"\0
+ CUR = 5
+ LEN = 6
+
+This says C<$a> is an SV, a scalar. The scalar is a PVIV, a string.
+Its reference count is 1. It has the C<POK> flag set, meaning its
+current PV field is valid. Because POK is set we look at the PV item
+to see what is in the scalar. The \0 at the end indicate that this
+PV is properly NUL-terminated.
+If the FLAGS had been IOK we would look
+at the IV item. CUR indicates the number of characters in the PV.
+LEN indicates the number of bytes requested for the PV (one more than
+CUR, in this case, because LEN includes an extra byte for the
+end-of-string marker).
+
+=head2 A simple scalar number
+
+If the scalar contains a number the raw SV will be leaner.
+
+ use Devel::Peek;
+ $a = 42;
+ Dump $a;
+
+The output:
+
+ SV = IV(0xbc818)
+ REFCNT = 1
+ FLAGS = (IOK,pIOK)
+ IV = 42
+
+This says C<$a> is an SV, a scalar. The scalar is an IV, a number. Its
+reference count is 1. It has the C<IOK> flag set, meaning it is currently
+being evaluated as a number. Because IOK is set we look at the IV item to
+see what is in the scalar.
+
+=head2 A simple scalar with an extra reference
+
+If the scalar from the previous example had an extra reference:
+
+ use Devel::Peek;
+ $a = 42;
+ $b = \$a;
+ Dump $a;
+
+The output:
+
+ SV = IV(0xbe860)
+ REFCNT = 2
+ FLAGS = (IOK,pIOK)
+ IV = 42
+
+Notice that this example differs from the previous example only in its
+reference count. Compare this to the next example, where we dump C<$b>
+instead of C<$a>.
+
+=head2 A reference to a simple scalar
+
+This shows what a reference looks like when it references a simple scalar.
+
+ use Devel::Peek;
+ $a = 42;
+ $b = \$a;
+ Dump $b;
+
+The output:
+
+ SV = RV(0xf041c)
+ REFCNT = 1
+ FLAGS = (ROK)
+ RV = 0xbab08
+ SV = IV(0xbe860)
+ REFCNT = 2
+ FLAGS = (IOK,pIOK)
+ IV = 42
+
+Starting from the top, this says C<$b> is an SV. The scalar is an RV, a
+reference. It has the C<ROK> flag set, meaning it is a reference. Because
+ROK is set we have an RV item rather than an IV or PV. Notice that Dump
+follows the reference and shows us what C<$b> was referencing. We see the
+same C<$a> that we found in the previous example.
+
+Note that the value of C<RV> coincides with the numbers we see when we
+stringify $b. The addresses inside RV() and IV() are addresses of
+C<X***> structure which holds the current state of an C<SV>. This
+address may change during lifetime of an SV.
+
+=head2 A reference to an array
+
+This shows what a reference to an array looks like.
+
+ use Devel::Peek;
+ $a = [42];
+ Dump $a;
+
+The output:
+
+ SV = RV(0xf041c)
+ REFCNT = 1
+ FLAGS = (ROK)
+ RV = 0xb2850
+ SV = PVAV(0xbd448)
+ REFCNT = 1
+ FLAGS = ()
+ IV = 0
+ NV = 0
+ ARRAY = 0xb2048
+ ALLOC = 0xb2048
+ FILL = 0
+ MAX = 0
+ ARYLEN = 0x0
+ FLAGS = (REAL)
+ Elt No. 0 0xb5658
+ SV = IV(0xbe860)
+ REFCNT = 1
+ FLAGS = (IOK,pIOK)
+ IV = 42
+
+This says C<$a> is an SV and that it is an RV. That RV points to
+another SV which is a PVAV, an array. The array has one element,
+element zero, which is another SV. The field C<FILL> above indicates
+the last element in the array, similar to C<$#$a>.
+
+If C<$a> pointed to an array of two elements then we would see the
+following.
+
+ use Devel::Peek 'Dump';
+ $a = [42,24];
+ Dump $a;
+
+The output:
+
+ SV = RV(0xf041c)
+ REFCNT = 1
+ FLAGS = (ROK)
+ RV = 0xb2850
+ SV = PVAV(0xbd448)
+ REFCNT = 1
+ FLAGS = ()
+ IV = 0
+ NV = 0
+ ARRAY = 0xb2048
+ ALLOC = 0xb2048
+ FILL = 0
+ MAX = 0
+ ARYLEN = 0x0
+ FLAGS = (REAL)
+ Elt No. 0 0xb5658
+ SV = IV(0xbe860)
+ REFCNT = 1
+ FLAGS = (IOK,pIOK)
+ IV = 42
+ Elt No. 1 0xb5680
+ SV = IV(0xbe818)
+ REFCNT = 1
+ FLAGS = (IOK,pIOK)
+ IV = 24
+
+Note that C<Dump> will not report I<all> the elements in the array,
+only several first (depending on how deep it already went into the
+report tree).
+
+=head2 A reference to a hash
+
+The following shows the raw form of a reference to a hash.
+
+ use Devel::Peek;
+ $a = {hello=>42};
+ Dump $a;
+
+The output:
+
+ SV = RV(0x8177858) at 0x816a618
+ REFCNT = 1
+ FLAGS = (ROK)
+ RV = 0x814fc10
+ SV = PVHV(0x8167768) at 0x814fc10
+ REFCNT = 1
+ FLAGS = (SHAREKEYS)
+ IV = 1
+ NV = 0
+ ARRAY = 0x816c5b8 (0:7, 1:1)
+ hash quality = 100.0%
+ KEYS = 1
+ FILL = 1
+ MAX = 7
+ RITER = -1
+ EITER = 0x0
+ Elt "hello" HASH = 0xc8fd181b
+ SV = IV(0x816c030) at 0x814fcf4
+ REFCNT = 1
+ FLAGS = (IOK,pIOK)
+ IV = 42
+
+This shows C<$a> is a reference pointing to an SV. That SV is a PVHV, a
+hash. Fields RITER and EITER are used by C<L<each>>.
+
+The "quality" of a hash is defined as the total number of comparisons needed
+to access every element once, relative to the expected number needed for a
+random hash. The value can go over 100%.
+
+The total number of comparisons is equal to the sum of the squares of the
+number of entries in each bucket. For a random hash of C<<n>> keys into
+C<<k>> buckets, the expected value is:
+
+ n + n(n-1)/2k
+
+=head2 Dumping a large array or hash
+
+The C<Dump()> function, by default, dumps up to 4 elements from a
+toplevel array or hash. This number can be increased by supplying a
+second argument to the function.
+
+ use Devel::Peek;
+ $a = [10,11,12,13,14];
+ Dump $a;
+
+Notice that C<Dump()> prints only elements 10 through 13 in the above code.
+The following code will print all of the elements.
+
+ use Devel::Peek 'Dump';
+ $a = [10,11,12,13,14];
+ Dump $a, 5;
+
+=head2 A reference to an SV which holds a C pointer
+
+This is what you really need to know as an XS programmer, of course. When
+an XSUB returns a pointer to a C structure that pointer is stored in an SV
+and a reference to that SV is placed on the XSUB stack. So the output from
+an XSUB which uses something like the T_PTROBJ map might look something like
+this:
+
+ SV = RV(0xf381c)
+ REFCNT = 1
+ FLAGS = (ROK)
+ RV = 0xb8ad8
+ SV = PVMG(0xbb3c8)
+ REFCNT = 1
+ FLAGS = (OBJECT,IOK,pIOK)
+ IV = 729160
+ NV = 0
+ PV = 0
+ STASH = 0xc1d10 "CookBookB::Opaque"
+
+This shows that we have an SV which is an RV. That RV points at another
+SV. In this case that second SV is a PVMG, a blessed scalar. Because it is
+blessed it has the C<OBJECT> flag set. Note that an SV which holds a C
+pointer also has the C<IOK> flag set. The C<STASH> is set to the package
+name which this SV was blessed into.
+
+The output from an XSUB which uses something like the T_PTRREF map, which
+doesn't bless the object, might look something like this:
+
+ SV = RV(0xf381c)
+ REFCNT = 1
+ FLAGS = (ROK)
+ RV = 0xb8ad8
+ SV = PVMG(0xbb3c8)
+ REFCNT = 1
+ FLAGS = (IOK,pIOK)
+ IV = 729160
+ NV = 0
+ PV = 0
+
+=head2 A reference to a subroutine
+
+Looks like this:
+
+ SV = RV(0x798ec)
+ REFCNT = 1
+ FLAGS = (TEMP,ROK)
+ RV = 0x1d453c
+ SV = PVCV(0x1c768c)
+ REFCNT = 2
+ FLAGS = ()
+ IV = 0
+ NV = 0
+ COMP_STASH = 0x31068 "main"
+ START = 0xb20e0
+ ROOT = 0xbece0
+ XSUB = 0x0
+ XSUBANY = 0
+ GVGV::GV = 0x1d44e8 "MY" :: "top_targets"
+ FILE = "(eval 5)"
+ DEPTH = 0
+ PADLIST = 0x1c9338
+
+This shows that
+
+=over 4
+
+=item *
+
+the subroutine is not an XSUB (since C<START> and C<ROOT> are
+non-zero, and C<XSUB> is zero);
+
+=item *
+
+that it was compiled in the package C<main>;
+
+=item *
+
+under the name C<MY::top_targets>;
+
+=item *
+
+inside a 5th eval in the program;
+
+=item *
+
+it is not currently executed (see C<DEPTH>);
+
+=item *
+
+it has no prototype (C<PROTOTYPE> field is missing).
+
+=back
+
+=head1 EXPORTS
+
+C<Dump>, C<mstat>, C<DeadCode>, C<DumpArray>, C<DumpWithOP> and
+C<DumpProg>, C<fill_mstats>, C<mstats_fillhash>, C<mstats2hash> by
+default. Additionally available C<SvREFCNT>, C<SvREFCNT_inc> and
+C<SvREFCNT_dec>.
+
+=head1 BUGS
+
+Readers have been known to skip important parts of L<perlguts>, causing much
+frustration for all.
+
+=head1 AUTHOR
+
+Ilya Zakharevich ilya@math.ohio-state.edu
+
+Copyright (c) 1995-98 Ilya Zakharevich. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+Author of this software makes no claim whatsoever about suitability,
+reliability, edability, editability or usability of this product, and
+should not be kept liable for any damage resulting from the use of
+it. If you can use it, you are in luck, if not, I should not be kept
+responsible. Keep a handy copy of your backup tape at hand.
+
+=head1 SEE ALSO
+
+L<perlguts>, and L<perlguts>, again.
+
+=cut