# License or the Artistic License, as specified in the README file.
#
package B;
-require DynaLoader;
+use XSLoader ();
require Exporter;
-@ISA = qw(Exporter DynaLoader);
-@EXPORT_OK = qw(minus_c ppname
+@ISA = qw(Exporter);
+
+# walkoptree_slow comes from B.pm (you are there),
+# walkoptree comes from B.xs
+@EXPORT_OK = qw(minus_c ppname save_BEGINs
class peekop cast_I32 cstring cchar hash threadsv_names
- main_root main_start main_cv svref_2object opnumber amagic_generation
- walkoptree walkoptree_slow walkoptree_exec walksymtable
- parents comppadlist sv_undef compile_stats timing_info init_av);
+ main_root main_start main_cv svref_2object opnumber
+ amagic_generation
+ walkoptree_slow walkoptree walkoptree_exec walksymtable
+ parents comppadlist sv_undef compile_stats timing_info
+ begin_av init_av end_av);
+
sub OPf_KIDS ();
use strict;
@B::SV::ISA = 'B::OBJECT';
@B::LOGOP::ISA = 'B::UNOP';
@B::LISTOP::ISA = 'B::BINOP';
@B::SVOP::ISA = 'B::OP';
-@B::GVOP::ISA = 'B::OP';
+@B::PADOP::ISA = 'B::OP';
@B::PVOP::ISA = 'B::OP';
@B::CVOP::ISA = 'B::OP';
@B::LOOP::ISA = 'B::LISTOP';
package B::OBJECT;
}
+sub B::GV::SAFENAME {
+ my $name = (shift())->NAME;
+
+ # The regex below corresponds to the isCONTROLVAR macro
+ # from toke.c
+
+ $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
+ chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
+
+ # When we say unicode_to_native we really mean ascii_to_native,
+ # which matters iff this is a non-ASCII platform (EBCDIC).
+
+ return $name;
+}
+
+sub B::IV::int_value {
+ my ($self) = @_;
+ return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
+}
+
+sub B::NULL::as_string() {""}
+sub B::IV::as_string() {goto &B::IV::int_value}
+sub B::PV::as_string() {goto &B::PV::PV}
+
my $debug;
my $op_count = 0;
my @parents = ();
sub walkoptree_exec {
my ($op, $method, $level) = @_;
+ $level ||= 0;
my ($sym, $ppname);
my $prefix = " " x $level;
for (; $$op; $op = $op->next) {
*glob = "*main::".$prefix.$sym;
if ($sym =~ /::$/) {
$sym = $prefix . $sym;
- if ($sym ne "main::" && &$recurse($sym)) {
+ if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
walksymtable(\%glob, $method, $recurse, $sym);
}
} else {
}
}
-bootstrap B;
+XSLoader::load 'B';
1;
=item IV
+Returns the value of the IV, I<interpreted as
+a signed integer>. This will be misleading
+if C<FLAGS & SVf_IVisUV>. Perhaps you want the
+C<int_value> method instead?
+
=item IVX
+=item UVX
+
+=item int_value
+
+This method returns the value of the IV as an integer.
+It differs from C<IV> in that it returns the correct
+value regardless of whether it's stored signed or
+unsigned.
+
=item needs64bits
=item packiv
=item PV
+This method is the one you usually want. It constructs a
+string using the length and offset information in the struct:
+for ordinary scalars it will return the string that you'd see
+from Perl, even if it contains null characters.
+
+=item PVX
+
+This method is less often useful. It assumes that the string
+stored in the struct is null-terminated, and disregards the
+length information.
+
+It is the appropriate method to use if you need to get the name
+of a lexical variable from a padname array. Lexical variable names
+are always stored with a null terminator, and the length field
+(SvCUR) is overloaded for other purposes and can't be relied on here.
+
=back
=head2 B::PVMG METHODS
=over 4
+=item is_empty
+
+This method returns TRUE if the GP field of the GV is NULL.
+
=item NAME
+=item SAFENAME
+
+This method returns the name of the glob, but if the first
+character of the name is a control character, then it converts
+it to ^X first, so that *^G would return "^G" rather than "\cG".
+
+It's useful if you want to print out the name of a variable.
+If you restrict yourself to globs which exist at compile-time
+then the result ought to be unambiguous, because code like
+C<${"^G"} = 1> is compiled as two ops - a constant string and
+a dereference (rv2gv) - so that the glob is created at runtime.
+
+If you're working with globs at runtime, and need to disambiguate
+*^G from *{"^G"}, then you should use the raw NAME method.
+
=item STASH
=item SV
=item LINE
+=item FILE
+
=item FILEGV
=item GvREFCNT
=item GV
-=item FILEGV
+=item FILE
=item DEPTH
=item CvFLAGS
+=item const_sv
+
=back
=head2 B::HV METHODS
=head2 OP-RELATED CLASSES
B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
-B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
+B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
These classes correspond in
the obvious way to the underlying C structures of similar names. The
inheritance hierarchy mimics the underlying C "inheritance". Access
=item ppaddr
-This returns the function name as a string (e.g. Perl_pp_add,
-Perl_pp_rv2av).
+This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
+"PL_ppaddr[OP_RV2AV]").
=item desc
=item sv
+=item gv
+
=back
-=head2 B::GVOP METHOD
+=head2 B::PADOP METHOD
=over 4
-=item gv
+=item padix
=back
=item stash
-=item filegv
+=item file
=item cop_seq
the description of C<walkoptree> above for what the debugging flag
does.
-=item walksymtable(SYMREF, METHOD, RECURSE)
+=item walksymtable(SYMREF, METHOD, RECURSE, PREFIX)
Walk the symbol table starting at SYMREF and call METHOD on each
-symbol visited. When the walk reached package symbols "Foo::" it
-invokes RECURSE and only recurses into the package if that sub
-returns true.
+symbol (a B::GV object) visited. When the walk reaches package
+symbols (such as "Foo::") it invokes RECURSE, passing in the symbol
+name, and only recurses into the package if that sub returns true.
+
+PREFIX is the name of the SYMREF you're walking.
+
+For example...
+
+ # Walk CGI's symbol table calling print_subs on each symbol.
+ # Only recurse into CGI::Util::
+ walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' },
+ 'CGI::');
+
+print_subs() is a B::GV method you have declared.
+
=item svref_2object(SV)
projects / p5sagit/p5-mst-13.2.git / blobdiff