3 # Copyright (c) 1996, 1997, 1998 Malcolm Beattie
5 # You may distribute under the terms of either the GNU General Public
6 # License or the Artistic License, as specified in the README file.
10 our $VERSION = '1.16';
16 # walkoptree_slow comes from B.pm (you are there),
17 # walkoptree comes from B.xs
18 @EXPORT_OK = qw(minus_c ppname save_BEGINs
19 class peekop cast_I32 cstring cchar hash threadsv_names
20 main_root main_start main_cv svref_2object opnumber
21 sub_generation amagic_generation perlstring
22 walkoptree_slow walkoptree walkoptree_exec walksymtable
23 parents comppadlist sv_undef compile_stats timing_info
24 begin_av init_av check_av end_av regex_padav dowarn defstash
25 curstash warnhook diehook inc_gv @optype @specialsv_name
27 push @EXPORT_OK, qw(unitcheck_av) if $] > 5.009;
31 @B::SV::ISA = 'B::OBJECT';
32 @B::NULL::ISA = 'B::SV';
33 @B::PV::ISA = 'B::SV';
34 @B::IV::ISA = 'B::SV';
35 @B::NV::ISA = 'B::SV';
36 @B::RV::ISA = 'B::SV';
37 @B::PVIV::ISA = qw(B::PV B::IV);
38 @B::PVNV::ISA = qw(B::PVIV B::NV);
39 @B::PVMG::ISA = 'B::PVNV';
40 # Change in the inheritance hierarchy post 5.9.0
41 @B::PVLV::ISA = $] > 5.009 ? 'B::GV' : 'B::PVMG';
42 @B::BM::ISA = 'B::PVMG';
43 @B::AV::ISA = 'B::PVMG';
44 @B::GV::ISA = 'B::PVMG';
45 @B::HV::ISA = 'B::PVMG';
46 @B::CV::ISA = 'B::PVMG';
47 @B::IO::ISA = 'B::PVMG';
48 @B::FM::ISA = 'B::CV';
50 @B::OP::ISA = 'B::OBJECT';
51 @B::UNOP::ISA = 'B::OP';
52 @B::BINOP::ISA = 'B::UNOP';
53 @B::LOGOP::ISA = 'B::UNOP';
54 @B::LISTOP::ISA = 'B::BINOP';
55 @B::SVOP::ISA = 'B::OP';
56 @B::PADOP::ISA = 'B::OP';
57 @B::PVOP::ISA = 'B::OP';
58 @B::LOOP::ISA = 'B::LISTOP';
59 @B::PMOP::ISA = 'B::LISTOP';
60 @B::COP::ISA = 'B::OP';
62 @B::SPECIAL::ISA = 'B::OBJECT';
64 @B::optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
65 # bytecode.pl contained the following comment:
66 # Nullsv *must* come first in the following so that the condition
67 # ($$sv == 0) can continue to be used to test (sv == Nullsv).
68 @B::specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no
69 (SV*)pWARN_ALL (SV*)pWARN_NONE (SV*)pWARN_STD);
72 # Stop "-w" from complaining about the lack of a real B::OBJECT class
77 my $name = (shift())->NAME;
79 # The regex below corresponds to the isCONTROLVAR macro
82 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
83 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
85 # When we say unicode_to_native we really mean ascii_to_native,
86 # which matters iff this is a non-ASCII platform (EBCDIC).
91 sub B::IV::int_value {
93 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
96 sub B::NULL::as_string() {""}
97 sub B::IV::as_string() {goto &B::IV::int_value}
98 sub B::PV::as_string() {goto &B::PV::PV}
105 my ($class, $value) = @_;
107 walkoptree_debug($value);
117 sub parents { \@parents }
122 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
125 sub walkoptree_slow {
126 my($op, $method, $level) = @_;
127 $op_count++; # just for statistics
129 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
130 $op->$method($level) if $op->can($method);
131 if ($$op && ($op->flags & OPf_KIDS)) {
133 unshift(@parents, $op);
134 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
135 walkoptree_slow($kid, $method, $level + 1);
139 if (class($op) eq 'PMOP'
140 && ref($op->pmreplroot)
141 && ${$op->pmreplroot}
142 && $op->pmreplroot->isa( 'B::OP' ))
144 unshift(@parents, $op);
145 walkoptree_slow($op->pmreplroot, $method, $level + 1);
151 return "Total number of OPs processed: $op_count\n";
155 my ($sec, $min, $hr) = localtime;
156 my ($user, $sys) = times;
157 sprintf("%02d:%02d:%02d user=$user sys=$sys",
158 $hr, $min, $sec, $user, $sys);
168 my ($obj, $value) = @_;
169 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
170 $symtable{sprintf("sym_%x", $$obj)} = $value;
175 return $symtable{sprintf("sym_%x", $$obj)};
178 sub walkoptree_exec {
179 my ($op, $method, $level) = @_;
182 my $prefix = " " x $level;
183 for (; $$op; $op = $op->next) {
186 print $prefix, "goto $sym\n";
189 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
190 $op->$method($level);
193 /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/)
195 print $prefix, uc($1), " => {\n";
196 walkoptree_exec($op->other, $method, $level + 1);
197 print $prefix, "}\n";
198 } elsif ($ppname eq "match" || $ppname eq "subst") {
199 my $pmreplstart = $op->pmreplstart;
201 print $prefix, "PMREPLSTART => {\n";
202 walkoptree_exec($pmreplstart, $method, $level + 1);
203 print $prefix, "}\n";
205 } elsif ($ppname eq "substcont") {
206 print $prefix, "SUBSTCONT => {\n";
207 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
208 print $prefix, "}\n";
210 } elsif ($ppname eq "enterloop") {
211 print $prefix, "REDO => {\n";
212 walkoptree_exec($op->redoop, $method, $level + 1);
213 print $prefix, "}\n", $prefix, "NEXT => {\n";
214 walkoptree_exec($op->nextop, $method, $level + 1);
215 print $prefix, "}\n", $prefix, "LAST => {\n";
216 walkoptree_exec($op->lastop, $method, $level + 1);
217 print $prefix, "}\n";
218 } elsif ($ppname eq "subst") {
219 my $replstart = $op->pmreplstart;
221 print $prefix, "SUBST => {\n";
222 walkoptree_exec($replstart, $method, $level + 1);
223 print $prefix, "}\n";
230 my ($symref, $method, $recurse, $prefix) = @_;
235 $prefix = '' unless defined $prefix;
236 while (($sym, $ref) = each %$symref) {
237 $fullname = "*main::".$prefix.$sym;
239 $sym = $prefix . $sym;
240 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
241 walksymtable(\%$fullname, $method, $recurse, $sym);
244 svref_2object(\*$fullname)->$method();
255 my ($class, $section, $symtable, $default) = @_;
256 $output_fh ||= FileHandle->new_tmpfile;
257 my $obj = bless [-1, $section, $symtable, $default], $class;
258 $sections{$section} = $obj;
263 my ($class, $section) = @_;
264 return $sections{$section};
269 while (defined($_ = shift)) {
270 print $output_fh "$section->[1]\t$_\n";
277 return $section->[0];
282 return $section->[1];
287 return $section->[2];
292 return $section->[3];
296 my ($section, $fh, $format) = @_;
297 my $name = $section->name;
298 my $sym = $section->symtable || {};
299 my $default = $section->default;
301 seek($output_fh, 0, 0);
302 while (<$output_fh>) {
307 exists($sym->{$1}) ? $sym->{$1} : $default;
309 printf $fh $format, $_;
323 B - The Perl Compiler
331 The C<B> module supplies classes which allow a Perl program to delve
332 into its own innards. It is the module used to implement the
333 "backends" of the Perl compiler. Usage of the compiler does not
334 require knowledge of this module: see the F<O> module for the
335 user-visible part. The C<B> module is of use to those who want to
336 write new compiler backends. This documentation assumes that the
337 reader knows a fair amount about perl's internals including such
338 things as SVs, OPs and the internal symbol table and syntax tree
343 The C<B> module contains a set of utility functions for querying the
344 current state of the Perl interpreter; typically these functions
345 return objects from the B::SV and B::OP classes, or their derived
346 classes. These classes in turn define methods for querying the
347 resulting objects about their own internal state.
349 =head1 Utility Functions
351 The C<B> module exports a variety of functions: some are simple
352 utility functions, others provide a Perl program with a way to
353 get an initial "handle" on an internal object.
355 =head2 Functions Returning C<B::SV>, C<B::AV>, C<B::HV>, and C<B::CV> objects
357 For descriptions of the class hierarchy of these objects and the
358 methods that can be called on them, see below, L<"OVERVIEW OF
359 CLASSES"> and L<"SV-RELATED CLASSES">.
365 Returns the SV object corresponding to the C variable C<sv_undef>.
369 Returns the SV object corresponding to the C variable C<sv_yes>.
373 Returns the SV object corresponding to the C variable C<sv_no>.
375 =item svref_2object(SVREF)
377 Takes a reference to any Perl value, and turns the referred-to value
378 into an object in the appropriate B::OP-derived or B::SV-derived
379 class. Apart from functions such as C<main_root>, this is the primary
380 way to get an initial "handle" on an internal perl data structure
381 which can then be followed with the other access methods.
383 The returned object will only be valid as long as the underlying OPs
384 and SVs continue to exist. Do not attempt to use the object after the
385 underlying structures are freed.
387 =item amagic_generation
389 Returns the SV object corresponding to the C variable C<amagic_generation>.
393 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
397 Returns the AV object (i.e. in class B::AV) representing CHECK blocks.
401 Returns the AV object (i.e. in class B::AV) representing UNITCHECK blocks.
405 Returns the AV object (i.e. in class B::AV) representing BEGIN blocks.
409 Returns the AV object (i.e. in class B::AV) representing END blocks.
413 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
417 Only when perl was compiled with ithreads.
421 Return the (faked) CV corresponding to the main part of the Perl
426 =head2 Functions for Examining the Symbol Table
430 =item walksymtable(SYMREF, METHOD, RECURSE, PREFIX)
432 Walk the symbol table starting at SYMREF and call METHOD on each
433 symbol (a B::GV object) visited. When the walk reaches package
434 symbols (such as "Foo::") it invokes RECURSE, passing in the symbol
435 name, and only recurses into the package if that sub returns true.
437 PREFIX is the name of the SYMREF you're walking.
441 # Walk CGI's symbol table calling print_subs on each symbol.
442 # Recurse only into CGI::Util::
443 walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' },
446 print_subs() is a B::GV method you have declared. Also see L<"B::GV
451 =head2 Functions Returning C<B::OP> objects or for walking op trees
453 For descriptions of the class hierarchy of these objects and the
454 methods that can be called on them, see below, L<"OVERVIEW OF
455 CLASSES"> and L<"OP-RELATED CLASSES">.
461 Returns the root op (i.e. an object in the appropriate B::OP-derived
462 class) of the main part of the Perl program.
466 Returns the starting op of the main part of the Perl program.
468 =item walkoptree(OP, METHOD)
470 Does a tree-walk of the syntax tree based at OP and calls METHOD on
471 each op it visits. Each node is visited before its children. If
472 C<walkoptree_debug> (see below) has been called to turn debugging on then
473 the method C<walkoptree_debug> is called on each op before METHOD is
476 =item walkoptree_debug(DEBUG)
478 Returns the current debugging flag for C<walkoptree>. If the optional
479 DEBUG argument is non-zero, it sets the debugging flag to that. See
480 the description of C<walkoptree> above for what the debugging flag
485 =head2 Miscellaneous Utility Functions
491 Return the PP function name (e.g. "pp_add") of op number OPNUM.
495 Returns a string in the form "0x..." representing the value of the
496 internal hash function used by perl on string STR.
500 Casts I to the internal I32 type used by that perl.
504 Does the equivalent of the C<-c> command-line option. Obviously, this
505 is only useful in a BEGIN block or else the flag is set too late.
509 Returns a double-quote-surrounded escaped version of STR which can
510 be used as a string in C source code.
512 =item perlstring(STR)
514 Returns a double-quote-surrounded escaped version of STR which can
515 be used as a string in Perl source code.
519 Returns the class of an object without the part of the classname
520 preceding the first C<"::">. This is used to turn C<"B::UNOP"> into
521 C<"UNOP"> for example.
525 In a perl compiled for threads, this returns a list of the special
526 per-thread threadsv variables.
530 =head2 Exported utility variabiles
536 my $op_type = $optype[$op_type_num];
538 A simple mapping of the op type number to its type (like 'COP' or 'BINOP').
540 =item @specialsv_name
542 my $sv_name = $specialsv_name[$sv_index];
544 Certain SV types are considered 'special'. They're represented by
545 B::SPECIAL and are referred to by a number from the specialsv_list.
546 This array maps that number back to the name of the SV (like 'Nullsv'
552 =head1 OVERVIEW OF CLASSES
554 The C structures used by Perl's internals to hold SV and OP
555 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
556 class hierarchy and the C<B> module gives access to them via a true
557 object hierarchy. Structure fields which point to other objects
558 (whether types of SV or types of OP) are represented by the C<B>
559 module as Perl objects of the appropriate class.
561 The bulk of the C<B> module is the methods for accessing fields of
564 Note that all access is read-only. You cannot modify the internals by
565 using this module. Also, note that the B::OP and B::SV objects created
566 by this module are only valid for as long as the underlying objects
567 exist; their creation doesn't increase the reference counts of the
568 underlying objects. Trying to access the fields of a freed object will
569 give incomprehensible results, or worse.
571 =head2 SV-RELATED CLASSES
573 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
574 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
575 the obvious way to the underlying C structures of similar names. The
576 inheritance hierarchy mimics the underlying C "inheritance". For 5.9.1
581 +--------------+----------+------------+
583 B::PV B::IV B::NV B::RV
595 +-----+----+------+-----+-----+
597 B::BM B::AV B::GV B::HV B::CV B::IO
603 For 5.9.0 and earlier, PVLV is a direct subclass of PVMG, so the base
609 +------+-----+----+------+-----+-----+
611 B::PVLV B::BM B::AV B::GV B::HV B::CV B::IO
617 Access methods correspond to the underlying C macros for field access,
618 usually with the leading "class indication" prefix removed (Sv, Av,
619 Hv, ...). The leading prefix is only left in cases where its removal
620 would cause a clash in method name. For example, C<GvREFCNT> stays
621 as-is since its abbreviation would clash with the "superclass" method
622 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
634 Returns a reference to the regular scalar corresponding to this
635 B::SV object. In other words, this method is the inverse operation
636 to the svref_2object() subroutine. This scalar and other data it points
637 at should be considered read-only: modifying them is neither safe nor
638 guaranteed to have a sensible effect.
648 Returns the value of the IV, I<interpreted as
649 a signed integer>. This will be misleading
650 if C<FLAGS & SVf_IVisUV>. Perhaps you want the
651 C<int_value> method instead?
659 This method returns the value of the IV as an integer.
660 It differs from C<IV> in that it returns the correct
661 value regardless of whether it's stored signed or
694 This method is the one you usually want. It constructs a
695 string using the length and offset information in the struct:
696 for ordinary scalars it will return the string that you'd see
697 from Perl, even if it contains null characters.
701 Same as B::RV::RV, except that it will die() if the PV isn't
706 This method is less often useful. It assumes that the string
707 stored in the struct is null-terminated, and disregards the
710 It is the appropriate method to use if you need to get the name
711 of a lexical variable from a padname array. Lexical variable names
712 are always stored with a null terminator, and the length field
713 (SvCUR) is overloaded for other purposes and can't be relied on here.
717 =head2 B::PVMG Methods
727 =head2 B::MAGIC Methods
735 Only valid on r-magic, returns the string that generated the regexp.
745 Will die() if called on r-magic.
751 Only valid on r-magic, returns the integer value of the REGEX stored
756 =head2 B::PVLV Methods
790 This method returns TRUE if the GP field of the GV is NULL.
796 This method returns the name of the glob, but if the first
797 character of the name is a control character, then it converts
798 it to ^X first, so that *^G would return "^G" rather than "\cG".
800 It's useful if you want to print out the name of a variable.
801 If you restrict yourself to globs which exist at compile-time
802 then the result ought to be unambiguous, because code like
803 C<${"^G"} = 1> is compiled as two ops - a constant string and
804 a dereference (rv2gv) - so that the glob is created at runtime.
806 If you're working with globs at runtime, and need to disambiguate
807 *^G from *{"^G"}, then you should use the raw NAME method.
871 Takes one arguments ( 'stdin' | 'stdout' | 'stderr' ) and returns true
872 if the IoIFP of the object is equal to the handle whose name was
873 passed as argument ( i.e. $io->IsSTD('stderr') is true if
874 IoIFP($io) == PerlIO_stdin() ).
890 Like C<ARRAY>, but takes an index as an argument to get only one element,
891 rather than a list of all of them.
895 This method is deprecated if running under Perl 5.8, and is no longer present
896 if running under Perl 5.9
900 This method returns the AV specific flags. In Perl 5.9 these are now stored
901 in with the main SV flags, so this method is no longer present.
931 For constant subroutines, returns the constant SV returned by the subroutine.
957 This method is not present if running under Perl 5.9, as the PMROOT
958 information is no longer stored directly in the hash.
962 =head2 OP-RELATED CLASSES
964 C<B::OP>, C<B::UNOP>, C<B::BINOP>, C<B::LOGOP>, C<B::LISTOP>, C<B::PMOP>,
965 C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>.
967 These classes correspond in the obvious way to the underlying C
968 structures of similar names. The inheritance hierarchy mimics the
969 underlying C "inheritance":
973 +---------------+--------+--------+-------+
975 B::UNOP B::SVOP B::PADOP B::COP B::PVOP
986 Access methods correspond to the underlying C structre field names,
987 with the leading "class indication" prefix (C<"op_">) removed.
991 These methods get the values of similarly named fields within the OP
992 data structure. See top of C<op.h> for more info.
1002 This returns the op name as a string (e.g. "add", "rv2av").
1006 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
1007 "PL_ppaddr[OP_RV2AV]").
1011 This returns the op description from the global C PL_op_desc array
1012 (e.g. "addition" "array deref").
1028 =head2 B::UNOP METHOD
1036 =head2 B::BINOP METHOD
1044 =head2 B::LOGOP METHOD
1052 =head2 B::LISTOP METHOD
1060 =head2 B::PMOP Methods
1080 Only when perl was compiled with ithreads.
1084 =head2 B::SVOP METHOD
1094 =head2 B::PADOP METHOD
1102 =head2 B::PVOP METHOD
1110 =head2 B::LOOP Methods
1122 =head2 B::COP Methods
1151 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>