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.15';
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
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';
65 # Stop "-w" from complaining about the lack of a real B::OBJECT class
70 my $name = (shift())->NAME;
72 # The regex below corresponds to the isCONTROLVAR macro
75 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
76 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
78 # When we say unicode_to_native we really mean ascii_to_native,
79 # which matters iff this is a non-ASCII platform (EBCDIC).
84 sub B::IV::int_value {
86 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
89 sub B::NULL::as_string() {""}
90 sub B::IV::as_string() {goto &B::IV::int_value}
91 sub B::PV::as_string() {goto &B::PV::PV}
98 my ($class, $value) = @_;
100 walkoptree_debug($value);
110 sub parents { \@parents }
115 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
118 sub walkoptree_slow {
119 my($op, $method, $level) = @_;
120 $op_count++; # just for statistics
122 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
123 $op->$method($level) if $op->can($method);
124 if ($$op && ($op->flags & OPf_KIDS)) {
126 unshift(@parents, $op);
127 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
128 walkoptree_slow($kid, $method, $level + 1);
132 if (class($op) eq 'PMOP'
133 && ref($op->pmreplroot)
134 && ${$op->pmreplroot}
135 && $op->pmreplroot->isa( 'B::OP' ))
137 unshift(@parents, $op);
138 walkoptree_slow($op->pmreplroot, $method, $level + 1);
144 return "Total number of OPs processed: $op_count\n";
148 my ($sec, $min, $hr) = localtime;
149 my ($user, $sys) = times;
150 sprintf("%02d:%02d:%02d user=$user sys=$sys",
151 $hr, $min, $sec, $user, $sys);
161 my ($obj, $value) = @_;
162 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
163 $symtable{sprintf("sym_%x", $$obj)} = $value;
168 return $symtable{sprintf("sym_%x", $$obj)};
171 sub walkoptree_exec {
172 my ($op, $method, $level) = @_;
175 my $prefix = " " x $level;
176 for (; $$op; $op = $op->next) {
179 print $prefix, "goto $sym\n";
182 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
183 $op->$method($level);
186 /^(d?or(assign)?|and(assign)?|mapwhile|grepwhile|entertry|range|cond_expr)$/)
188 print $prefix, uc($1), " => {\n";
189 walkoptree_exec($op->other, $method, $level + 1);
190 print $prefix, "}\n";
191 } elsif ($ppname eq "match" || $ppname eq "subst") {
192 my $pmreplstart = $op->pmreplstart;
194 print $prefix, "PMREPLSTART => {\n";
195 walkoptree_exec($pmreplstart, $method, $level + 1);
196 print $prefix, "}\n";
198 } elsif ($ppname eq "substcont") {
199 print $prefix, "SUBSTCONT => {\n";
200 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
201 print $prefix, "}\n";
203 } elsif ($ppname eq "enterloop") {
204 print $prefix, "REDO => {\n";
205 walkoptree_exec($op->redoop, $method, $level + 1);
206 print $prefix, "}\n", $prefix, "NEXT => {\n";
207 walkoptree_exec($op->nextop, $method, $level + 1);
208 print $prefix, "}\n", $prefix, "LAST => {\n";
209 walkoptree_exec($op->lastop, $method, $level + 1);
210 print $prefix, "}\n";
211 } elsif ($ppname eq "subst") {
212 my $replstart = $op->pmreplstart;
214 print $prefix, "SUBST => {\n";
215 walkoptree_exec($replstart, $method, $level + 1);
216 print $prefix, "}\n";
223 my ($symref, $method, $recurse, $prefix) = @_;
228 $prefix = '' unless defined $prefix;
229 while (($sym, $ref) = each %$symref) {
230 $fullname = "*main::".$prefix.$sym;
232 $sym = $prefix . $sym;
233 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
234 walksymtable(\%$fullname, $method, $recurse, $sym);
237 svref_2object(\*$fullname)->$method();
248 my ($class, $section, $symtable, $default) = @_;
249 $output_fh ||= FileHandle->new_tmpfile;
250 my $obj = bless [-1, $section, $symtable, $default], $class;
251 $sections{$section} = $obj;
256 my ($class, $section) = @_;
257 return $sections{$section};
262 while (defined($_ = shift)) {
263 print $output_fh "$section->[1]\t$_\n";
270 return $section->[0];
275 return $section->[1];
280 return $section->[2];
285 return $section->[3];
289 my ($section, $fh, $format) = @_;
290 my $name = $section->name;
291 my $sym = $section->symtable || {};
292 my $default = $section->default;
294 seek($output_fh, 0, 0);
295 while (<$output_fh>) {
300 exists($sym->{$1}) ? $sym->{$1} : $default;
302 printf $fh $format, $_;
316 B - The Perl Compiler
324 The C<B> module supplies classes which allow a Perl program to delve
325 into its own innards. It is the module used to implement the
326 "backends" of the Perl compiler. Usage of the compiler does not
327 require knowledge of this module: see the F<O> module for the
328 user-visible part. The C<B> module is of use to those who want to
329 write new compiler backends. This documentation assumes that the
330 reader knows a fair amount about perl's internals including such
331 things as SVs, OPs and the internal symbol table and syntax tree
336 The C<B> module contains a set of utility functions for querying the
337 current state of the Perl interpreter; typically these functions
338 return objects from the B::SV and B::OP classes, or their derived
339 classes. These classes in turn define methods for querying the
340 resulting objects about their own internal state.
342 =head1 Utility Functions
344 The C<B> module exports a variety of functions: some are simple
345 utility functions, others provide a Perl program with a way to
346 get an initial "handle" on an internal object.
348 =head2 Functions Returning C<B::SV>, C<B::AV>, C<B::HV>, and C<B::CV> objects
350 For descriptions of the class hierarchy of these objects and the
351 methods that can be called on them, see below, L<"OVERVIEW OF
352 CLASSES"> and L<"SV-RELATED CLASSES">.
358 Returns the SV object corresponding to the C variable C<sv_undef>.
362 Returns the SV object corresponding to the C variable C<sv_yes>.
366 Returns the SV object corresponding to the C variable C<sv_no>.
368 =item svref_2object(SVREF)
370 Takes a reference to any Perl value, and turns the referred-to value
371 into an object in the appropriate B::OP-derived or B::SV-derived
372 class. Apart from functions such as C<main_root>, this is the primary
373 way to get an initial "handle" on an internal perl data structure
374 which can then be followed with the other access methods.
376 The returned object will only be valid as long as the underlying OPs
377 and SVs continue to exist. Do not attempt to use the object after the
378 underlying structures are freed.
380 =item amagic_generation
382 Returns the SV object corresponding to the C variable C<amagic_generation>.
386 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
390 Returns the AV object (i.e. in class B::AV) representing CHECK blocks.
394 Returns the AV object (i.e. in class B::AV) representing UNITCHECK blocks.
398 Returns the AV object (i.e. in class B::AV) representing BEGIN blocks.
402 Returns the AV object (i.e. in class B::AV) representing END blocks.
406 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
410 Only when perl was compiled with ithreads.
414 Return the (faked) CV corresponding to the main part of the Perl
419 =head2 Functions for Examining the Symbol Table
423 =item walksymtable(SYMREF, METHOD, RECURSE, PREFIX)
425 Walk the symbol table starting at SYMREF and call METHOD on each
426 symbol (a B::GV object) visited. When the walk reaches package
427 symbols (such as "Foo::") it invokes RECURSE, passing in the symbol
428 name, and only recurses into the package if that sub returns true.
430 PREFIX is the name of the SYMREF you're walking.
434 # Walk CGI's symbol table calling print_subs on each symbol.
435 # Recurse only into CGI::Util::
436 walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' },
439 print_subs() is a B::GV method you have declared. Also see L<"B::GV
444 =head2 Functions Returning C<B::OP> objects or for walking op trees
446 For descriptions of the class hierarchy of these objects and the
447 methods that can be called on them, see below, L<"OVERVIEW OF
448 CLASSES"> and L<"OP-RELATED CLASSES">.
454 Returns the root op (i.e. an object in the appropriate B::OP-derived
455 class) of the main part of the Perl program.
459 Returns the starting op of the main part of the Perl program.
461 =item walkoptree(OP, METHOD)
463 Does a tree-walk of the syntax tree based at OP and calls METHOD on
464 each op it visits. Each node is visited before its children. If
465 C<walkoptree_debug> (see below) has been called to turn debugging on then
466 the method C<walkoptree_debug> is called on each op before METHOD is
469 =item walkoptree_debug(DEBUG)
471 Returns the current debugging flag for C<walkoptree>. If the optional
472 DEBUG argument is non-zero, it sets the debugging flag to that. See
473 the description of C<walkoptree> above for what the debugging flag
478 =head2 Miscellaneous Utility Functions
484 Return the PP function name (e.g. "pp_add") of op number OPNUM.
488 Returns a string in the form "0x..." representing the value of the
489 internal hash function used by perl on string STR.
493 Casts I to the internal I32 type used by that perl.
497 Does the equivalent of the C<-c> command-line option. Obviously, this
498 is only useful in a BEGIN block or else the flag is set too late.
502 Returns a double-quote-surrounded escaped version of STR which can
503 be used as a string in C source code.
505 =item perlstring(STR)
507 Returns a double-quote-surrounded escaped version of STR which can
508 be used as a string in Perl source code.
512 Returns the class of an object without the part of the classname
513 preceding the first C<"::">. This is used to turn C<"B::UNOP"> into
514 C<"UNOP"> for example.
518 In a perl compiled for threads, this returns a list of the special
519 per-thread threadsv variables.
526 =head1 OVERVIEW OF CLASSES
528 The C structures used by Perl's internals to hold SV and OP
529 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
530 class hierarchy and the C<B> module gives access to them via a true
531 object hierarchy. Structure fields which point to other objects
532 (whether types of SV or types of OP) are represented by the C<B>
533 module as Perl objects of the appropriate class.
535 The bulk of the C<B> module is the methods for accessing fields of
538 Note that all access is read-only. You cannot modify the internals by
539 using this module. Also, note that the B::OP and B::SV objects created
540 by this module are only valid for as long as the underlying objects
541 exist; their creation doesn't increase the reference counts of the
542 underlying objects. Trying to access the fields of a freed object will
543 give incomprehensible results, or worse.
545 =head2 SV-RELATED CLASSES
547 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
548 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
549 the obvious way to the underlying C structures of similar names. The
550 inheritance hierarchy mimics the underlying C "inheritance". For 5.9.1
555 +--------------+----------+------------+
557 B::PV B::IV B::NV B::RV
569 +-----+----+------+-----+-----+
571 B::BM B::AV B::GV B::HV B::CV B::IO
577 For 5.9.0 and earlier, PVLV is a direct subclass of PVMG, so the base
583 +------+-----+----+------+-----+-----+
585 B::PVLV B::BM B::AV B::GV B::HV B::CV B::IO
591 Access methods correspond to the underlying C macros for field access,
592 usually with the leading "class indication" prefix removed (Sv, Av,
593 Hv, ...). The leading prefix is only left in cases where its removal
594 would cause a clash in method name. For example, C<GvREFCNT> stays
595 as-is since its abbreviation would clash with the "superclass" method
596 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
608 Returns a reference to the regular scalar corresponding to this
609 B::SV object. In other words, this method is the inverse operation
610 to the svref_2object() subroutine. This scalar and other data it points
611 at should be considered read-only: modifying them is neither safe nor
612 guaranteed to have a sensible effect.
622 Returns the value of the IV, I<interpreted as
623 a signed integer>. This will be misleading
624 if C<FLAGS & SVf_IVisUV>. Perhaps you want the
625 C<int_value> method instead?
633 This method returns the value of the IV as an integer.
634 It differs from C<IV> in that it returns the correct
635 value regardless of whether it's stored signed or
668 This method is the one you usually want. It constructs a
669 string using the length and offset information in the struct:
670 for ordinary scalars it will return the string that you'd see
671 from Perl, even if it contains null characters.
675 Same as B::RV::RV, except that it will die() if the PV isn't
680 This method is less often useful. It assumes that the string
681 stored in the struct is null-terminated, and disregards the
684 It is the appropriate method to use if you need to get the name
685 of a lexical variable from a padname array. Lexical variable names
686 are always stored with a null terminator, and the length field
687 (SvCUR) is overloaded for other purposes and can't be relied on here.
691 =head2 B::PVMG Methods
701 =head2 B::MAGIC Methods
709 Only valid on r-magic, returns the string that generated the regexp.
719 Will die() if called on r-magic.
725 Only valid on r-magic, returns the integer value of the REGEX stored
730 =head2 B::PVLV Methods
764 This method returns TRUE if the GP field of the GV is NULL.
770 This method returns the name of the glob, but if the first
771 character of the name is a control character, then it converts
772 it to ^X first, so that *^G would return "^G" rather than "\cG".
774 It's useful if you want to print out the name of a variable.
775 If you restrict yourself to globs which exist at compile-time
776 then the result ought to be unambiguous, because code like
777 C<${"^G"} = 1> is compiled as two ops - a constant string and
778 a dereference (rv2gv) - so that the glob is created at runtime.
780 If you're working with globs at runtime, and need to disambiguate
781 *^G from *{"^G"}, then you should use the raw NAME method.
845 Takes one arguments ( 'stdin' | 'stdout' | 'stderr' ) and returns true
846 if the IoIFP of the object is equal to the handle whose name was
847 passed as argument ( i.e. $io->IsSTD('stderr') is true if
848 IoIFP($io) == PerlIO_stdin() ).
864 Like C<ARRAY>, but takes an index as an argument to get only one element,
865 rather than a list of all of them.
869 This method is deprecated if running under Perl 5.8, and is no longer present
870 if running under Perl 5.9
874 This method returns the AV specific flags. In Perl 5.9 these are now stored
875 in with the main SV flags, so this method is no longer present.
905 For constant subroutines, returns the constant SV returned by the subroutine.
931 This method is not present if running under Perl 5.9, as the PMROOT
932 information is no longer stored directly in the hash.
936 =head2 OP-RELATED CLASSES
938 C<B::OP>, C<B::UNOP>, C<B::BINOP>, C<B::LOGOP>, C<B::LISTOP>, C<B::PMOP>,
939 C<B::SVOP>, C<B::PADOP>, C<B::PVOP>, C<B::LOOP>, C<B::COP>.
941 These classes correspond in the obvious way to the underlying C
942 structures of similar names. The inheritance hierarchy mimics the
943 underlying C "inheritance":
947 +---------------+--------+--------+-------+
949 B::UNOP B::SVOP B::PADOP B::COP B::PVOP
960 Access methods correspond to the underlying C structre field names,
961 with the leading "class indication" prefix (C<"op_">) removed.
965 These methods get the values of similarly named fields within the OP
966 data structure. See top of C<op.h> for more info.
976 This returns the op name as a string (e.g. "add", "rv2av").
980 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
981 "PL_ppaddr[OP_RV2AV]").
985 This returns the op description from the global C PL_op_desc array
986 (e.g. "addition" "array deref").
1004 =head2 B::UNOP METHOD
1012 =head2 B::BINOP METHOD
1020 =head2 B::LOGOP METHOD
1028 =head2 B::LISTOP METHOD
1036 =head2 B::PMOP Methods
1058 Only when perl was compiled with ithreads.
1062 =head2 B::SVOP METHOD
1072 =head2 B::PADOP METHOD
1080 =head2 B::PVOP METHOD
1088 =head2 B::LOOP Methods
1100 =head2 B::COP Methods
1129 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>