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.00';
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
22 walkoptree_slow walkoptree walkoptree_exec walksymtable
23 parents comppadlist sv_undef compile_stats timing_info
24 begin_av init_av end_av regex_padav);
28 @B::SV::ISA = 'B::OBJECT';
29 @B::NULL::ISA = 'B::SV';
30 @B::PV::ISA = 'B::SV';
31 @B::IV::ISA = 'B::SV';
32 @B::NV::ISA = 'B::IV';
33 @B::RV::ISA = 'B::SV';
34 @B::PVIV::ISA = qw(B::PV B::IV);
35 @B::PVNV::ISA = qw(B::PV B::NV);
36 @B::PVMG::ISA = 'B::PVNV';
37 @B::PVLV::ISA = 'B::PVMG';
38 @B::BM::ISA = 'B::PVMG';
39 @B::AV::ISA = 'B::PVMG';
40 @B::GV::ISA = 'B::PVMG';
41 @B::HV::ISA = 'B::PVMG';
42 @B::CV::ISA = 'B::PVMG';
43 @B::IO::ISA = 'B::PVMG';
44 @B::FM::ISA = 'B::CV';
46 @B::OP::ISA = 'B::OBJECT';
47 @B::UNOP::ISA = 'B::OP';
48 @B::BINOP::ISA = 'B::UNOP';
49 @B::LOGOP::ISA = 'B::UNOP';
50 @B::LISTOP::ISA = 'B::BINOP';
51 @B::SVOP::ISA = 'B::OP';
52 @B::PADOP::ISA = 'B::OP';
53 @B::PVOP::ISA = 'B::OP';
54 @B::CVOP::ISA = 'B::OP';
55 @B::LOOP::ISA = 'B::LISTOP';
56 @B::PMOP::ISA = 'B::LISTOP';
57 @B::COP::ISA = 'B::OP';
59 @B::SPECIAL::ISA = 'B::OBJECT';
62 # Stop "-w" from complaining about the lack of a real B::OBJECT class
67 my $name = (shift())->NAME;
69 # The regex below corresponds to the isCONTROLVAR macro
72 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
73 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
75 # When we say unicode_to_native we really mean ascii_to_native,
76 # which matters iff this is a non-ASCII platform (EBCDIC).
81 sub B::IV::int_value {
83 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
86 sub B::NULL::as_string() {""}
87 sub B::IV::as_string() {goto &B::IV::int_value}
88 sub B::PV::as_string() {goto &B::PV::PV}
95 my ($class, $value) = @_;
97 walkoptree_debug($value);
107 sub parents { \@parents }
112 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
115 sub walkoptree_slow {
116 my($op, $method, $level) = @_;
117 $op_count++; # just for statistics
119 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
120 $op->$method($level);
121 if ($$op && ($op->flags & OPf_KIDS)) {
123 unshift(@parents, $op);
124 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
125 walkoptree_slow($kid, $method, $level + 1);
132 return "Total number of OPs processed: $op_count\n";
136 my ($sec, $min, $hr) = localtime;
137 my ($user, $sys) = times;
138 sprintf("%02d:%02d:%02d user=$user sys=$sys",
139 $hr, $min, $sec, $user, $sys);
149 my ($obj, $value) = @_;
150 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
151 $symtable{sprintf("sym_%x", $$obj)} = $value;
156 return $symtable{sprintf("sym_%x", $$obj)};
159 sub walkoptree_exec {
160 my ($op, $method, $level) = @_;
163 my $prefix = " " x $level;
164 for (; $$op; $op = $op->next) {
167 print $prefix, "goto $sym\n";
170 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
171 $op->$method($level);
174 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
176 print $prefix, uc($1), " => {\n";
177 walkoptree_exec($op->other, $method, $level + 1);
178 print $prefix, "}\n";
179 } elsif ($ppname eq "match" || $ppname eq "subst") {
180 my $pmreplstart = $op->pmreplstart;
182 print $prefix, "PMREPLSTART => {\n";
183 walkoptree_exec($pmreplstart, $method, $level + 1);
184 print $prefix, "}\n";
186 } elsif ($ppname eq "substcont") {
187 print $prefix, "SUBSTCONT => {\n";
188 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
189 print $prefix, "}\n";
191 } elsif ($ppname eq "enterloop") {
192 print $prefix, "REDO => {\n";
193 walkoptree_exec($op->redoop, $method, $level + 1);
194 print $prefix, "}\n", $prefix, "NEXT => {\n";
195 walkoptree_exec($op->nextop, $method, $level + 1);
196 print $prefix, "}\n", $prefix, "LAST => {\n";
197 walkoptree_exec($op->lastop, $method, $level + 1);
198 print $prefix, "}\n";
199 } elsif ($ppname eq "subst") {
200 my $replstart = $op->pmreplstart;
202 print $prefix, "SUBST => {\n";
203 walkoptree_exec($replstart, $method, $level + 1);
204 print $prefix, "}\n";
211 my ($symref, $method, $recurse, $prefix) = @_;
216 $prefix = '' unless defined $prefix;
217 while (($sym, $ref) = each %$symref) {
218 $fullname = "*main::".$prefix.$sym;
220 $sym = $prefix . $sym;
221 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
222 walksymtable(\%$fullname, $method, $recurse, $sym);
225 svref_2object(\*$fullname)->$method();
236 my ($class, $section, $symtable, $default) = @_;
237 $output_fh ||= FileHandle->new_tmpfile;
238 my $obj = bless [-1, $section, $symtable, $default], $class;
239 $sections{$section} = $obj;
244 my ($class, $section) = @_;
245 return $sections{$section};
250 while (defined($_ = shift)) {
251 print $output_fh "$section->[1]\t$_\n";
258 return $section->[0];
263 return $section->[1];
268 return $section->[2];
273 return $section->[3];
277 my ($section, $fh, $format) = @_;
278 my $name = $section->name;
279 my $sym = $section->symtable || {};
280 my $default = $section->default;
282 seek($output_fh, 0, 0);
283 while (<$output_fh>) {
288 exists($sym->{$1}) ? $sym->{$1} : $default;
290 printf $fh $format, $_;
304 B - The Perl Compiler
312 The C<B> module supplies classes which allow a Perl program to delve
313 into its own innards. It is the module used to implement the
314 "backends" of the Perl compiler. Usage of the compiler does not
315 require knowledge of this module: see the F<O> module for the
316 user-visible part. The C<B> module is of use to those who want to
317 write new compiler backends. This documentation assumes that the
318 reader knows a fair amount about perl's internals including such
319 things as SVs, OPs and the internal symbol table and syntax tree
322 =head1 OVERVIEW OF CLASSES
324 The C structures used by Perl's internals to hold SV and OP
325 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
326 class hierarchy and the C<B> module gives access to them via a true
327 object hierarchy. Structure fields which point to other objects
328 (whether types of SV or types of OP) are represented by the C<B>
329 module as Perl objects of the appropriate class. The bulk of the C<B>
330 module is the methods for accessing fields of these structures. Note
331 that all access is read-only: you cannot modify the internals by
334 =head2 SV-RELATED CLASSES
336 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
337 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
338 the obvious way to the underlying C structures of similar names. The
339 inheritance hierarchy mimics the underlying C "inheritance". Access
340 methods correspond to the underlying C macros for field access,
341 usually with the leading "class indication" prefix removed (Sv, Av,
342 Hv, ...). The leading prefix is only left in cases where its removal
343 would cause a clash in method name. For example, C<GvREFCNT> stays
344 as-is since its abbreviation would clash with the "superclass" method
345 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
363 Returns the value of the IV, I<interpreted as
364 a signed integer>. This will be misleading
365 if C<FLAGS & SVf_IVisUV>. Perhaps you want the
366 C<int_value> method instead?
374 This method returns the value of the IV as an integer.
375 It differs from C<IV> in that it returns the correct
376 value regardless of whether it's stored signed or
409 This method is the one you usually want. It constructs a
410 string using the length and offset information in the struct:
411 for ordinary scalars it will return the string that you'd see
412 from Perl, even if it contains null characters.
416 Same as B::RV::RV, except that it will die() if the PV isn't
421 This method is less often useful. It assumes that the string
422 stored in the struct is null-terminated, and disregards the
425 It is the appropriate method to use if you need to get the name
426 of a lexical variable from a padname array. Lexical variable names
427 are always stored with a null terminator, and the length field
428 (SvCUR) is overloaded for other purposes and can't be relied on here.
432 =head2 B::PVMG METHODS
442 =head2 B::MAGIC METHODS
450 Only valid on r-magic, returns the string that generated the regexp.
460 Will die() if called on r-magic.
466 Only valid on r-magic, returns the integer value of the REGEX stored
471 =head2 B::PVLV METHODS
505 This method returns TRUE if the GP field of the GV is NULL.
511 This method returns the name of the glob, but if the first
512 character of the name is a control character, then it converts
513 it to ^X first, so that *^G would return "^G" rather than "\cG".
515 It's useful if you want to print out the name of a variable.
516 If you restrict yourself to globs which exist at compile-time
517 then the result ought to be unambiguous, because code like
518 C<${"^G"} = 1> is compiled as two ops - a constant string and
519 a dereference (rv2gv) - so that the glob is created at runtime.
521 If you're working with globs at runtime, and need to disambiguate
522 *^G from *{"^G"}, then you should use the raw NAME method.
586 Takes one arguments ( 'stdin' | 'stdout' | 'stderr' ) and returns true
587 if the IoIFP of the object is equal to the handle whose name was
588 passed as argument ( i.e. $io->IsSTD('stderr') is true if
589 IoIFP($io) == PerlIO_stdin() ).
633 For constant subroutines, returns the constant SV returned by the subroutine.
661 =head2 OP-RELATED CLASSES
663 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
664 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
665 These classes correspond in
666 the obvious way to the underlying C structures of similar names. The
667 inheritance hierarchy mimics the underlying C "inheritance". Access
668 methods correspond to the underlying C structre field names, with the
669 leading "class indication" prefix removed (op_).
681 This returns the op name as a string (e.g. "add", "rv2av").
685 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
686 "PL_ppaddr[OP_RV2AV]").
690 This returns the op description from the global C PL_op_desc array
691 (e.g. "addition" "array deref").
705 =head2 B::UNOP METHOD
713 =head2 B::BINOP METHOD
721 =head2 B::LOGOP METHOD
729 =head2 B::LISTOP METHOD
737 =head2 B::PMOP METHODS
759 Only when perl was compiled with ithreads.
763 =head2 B::SVOP METHOD
773 =head2 B::PADOP METHOD
781 =head2 B::PVOP METHOD
789 =head2 B::LOOP METHODS
801 =head2 B::COP METHODS
819 =head1 FUNCTIONS EXPORTED BY C<B>
821 The C<B> module exports a variety of functions: some are simple
822 utility functions, others provide a Perl program with a way to
823 get an initial "handle" on an internal object.
829 Return the (faked) CV corresponding to the main part of the Perl
834 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
838 Returns the AV object (i.e. in class B::AV) representing BEGIN blocks.
842 Returns the AV object (i.e. in class B::AV) representing END blocks.
846 Returns the root op (i.e. an object in the appropriate B::OP-derived
847 class) of the main part of the Perl program.
851 Returns the starting op of the main part of the Perl program.
855 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
859 Only when perl was compiled with ithreads.
863 Returns the SV object corresponding to the C variable C<sv_undef>.
867 Returns the SV object corresponding to the C variable C<sv_yes>.
871 Returns the SV object corresponding to the C variable C<sv_no>.
873 =item amagic_generation
875 Returns the SV object corresponding to the C variable C<amagic_generation>.
877 =item walkoptree(OP, METHOD)
879 Does a tree-walk of the syntax tree based at OP and calls METHOD on
880 each op it visits. Each node is visited before its children. If
881 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
882 the method C<walkoptree_debug> is called on each op before METHOD is
885 =item walkoptree_debug(DEBUG)
887 Returns the current debugging flag for C<walkoptree>. If the optional
888 DEBUG argument is non-zero, it sets the debugging flag to that. See
889 the description of C<walkoptree> above for what the debugging flag
892 =item walksymtable(SYMREF, METHOD, RECURSE, PREFIX)
894 Walk the symbol table starting at SYMREF and call METHOD on each
895 symbol (a B::GV object) visited. When the walk reaches package
896 symbols (such as "Foo::") it invokes RECURSE, passing in the symbol
897 name, and only recurses into the package if that sub returns true.
899 PREFIX is the name of the SYMREF you're walking.
903 # Walk CGI's symbol table calling print_subs on each symbol.
904 # Only recurse into CGI::Util::
905 walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' },
908 print_subs() is a B::GV method you have declared.
911 =item svref_2object(SV)
913 Takes any Perl variable and turns it into an object in the
914 appropriate B::OP-derived or B::SV-derived class. Apart from functions
915 such as C<main_root>, this is the primary way to get an initial
916 "handle" on an internal perl data structure which can then be followed
917 with the other access methods.
921 Return the PP function name (e.g. "pp_add") of op number OPNUM.
925 Returns a string in the form "0x..." representing the value of the
926 internal hash function used by perl on string STR.
930 Casts I to the internal I32 type used by that perl.
935 Does the equivalent of the C<-c> command-line option. Obviously, this
936 is only useful in a BEGIN block or else the flag is set too late.
941 Returns a double-quote-surrounded escaped version of STR which can
942 be used as a string in C source code.
946 Returns the class of an object without the part of the classname
947 preceding the first "::". This is used to turn "B::UNOP" into
952 In a perl compiled for threads, this returns a list of the special
953 per-thread threadsv variables.
959 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>