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.
13 # walkoptree_slow comes from B.pm (you are there),
14 # walkoptree comes from B.xs
15 @EXPORT_OK = qw(minus_c ppname save_BEGINs
16 class peekop cast_I32 cstring cchar hash threadsv_names
17 main_root main_start main_cv svref_2object opnumber
19 walkoptree_slow walkoptree walkoptree_exec walksymtable
20 parents comppadlist sv_undef compile_stats timing_info
21 begin_av init_av end_av);
25 @B::SV::ISA = 'B::OBJECT';
26 @B::NULL::ISA = 'B::SV';
27 @B::PV::ISA = 'B::SV';
28 @B::IV::ISA = 'B::SV';
29 @B::NV::ISA = 'B::IV';
30 @B::RV::ISA = 'B::SV';
31 @B::PVIV::ISA = qw(B::PV B::IV);
32 @B::PVNV::ISA = qw(B::PV B::NV);
33 @B::PVMG::ISA = 'B::PVNV';
34 @B::PVLV::ISA = 'B::PVMG';
35 @B::BM::ISA = 'B::PVMG';
36 @B::AV::ISA = 'B::PVMG';
37 @B::GV::ISA = 'B::PVMG';
38 @B::HV::ISA = 'B::PVMG';
39 @B::CV::ISA = 'B::PVMG';
40 @B::IO::ISA = 'B::PVMG';
41 @B::FM::ISA = 'B::CV';
43 @B::OP::ISA = 'B::OBJECT';
44 @B::UNOP::ISA = 'B::OP';
45 @B::BINOP::ISA = 'B::UNOP';
46 @B::LOGOP::ISA = 'B::UNOP';
47 @B::LISTOP::ISA = 'B::BINOP';
48 @B::SVOP::ISA = 'B::OP';
49 @B::PADOP::ISA = 'B::OP';
50 @B::PVOP::ISA = 'B::OP';
51 @B::CVOP::ISA = 'B::OP';
52 @B::LOOP::ISA = 'B::LISTOP';
53 @B::PMOP::ISA = 'B::LISTOP';
54 @B::COP::ISA = 'B::OP';
56 @B::SPECIAL::ISA = 'B::OBJECT';
59 # Stop "-w" from complaining about the lack of a real B::OBJECT class
64 my $name = (shift())->NAME;
66 # The regex below corresponds to the isCONTROLVAR macro
69 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".
70 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
72 # When we say unicode_to_native we really mean ascii_to_native,
73 # which matters iff this is a non-ASCII platform (EBCDIC).
78 sub B::IV::int_value {
80 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
83 sub B::NULL::as_string() {""}
84 sub B::IV::as_string() {goto &B::IV::int_value}
85 sub B::PV::as_string() {goto &B::PV::PV}
92 my ($class, $value) = @_;
94 walkoptree_debug($value);
104 sub parents { \@parents }
109 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
112 sub walkoptree_slow {
113 my($op, $method, $level) = @_;
114 $op_count++; # just for statistics
116 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
117 $op->$method($level);
118 if ($$op && ($op->flags & OPf_KIDS)) {
120 unshift(@parents, $op);
121 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
122 walkoptree_slow($kid, $method, $level + 1);
129 return "Total number of OPs processed: $op_count\n";
133 my ($sec, $min, $hr) = localtime;
134 my ($user, $sys) = times;
135 sprintf("%02d:%02d:%02d user=$user sys=$sys",
136 $hr, $min, $sec, $user, $sys);
146 my ($obj, $value) = @_;
147 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
148 $symtable{sprintf("sym_%x", $$obj)} = $value;
153 return $symtable{sprintf("sym_%x", $$obj)};
156 sub walkoptree_exec {
157 my ($op, $method, $level) = @_;
160 my $prefix = " " x $level;
161 for (; $$op; $op = $op->next) {
164 print $prefix, "goto $sym\n";
167 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
168 $op->$method($level);
171 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
173 print $prefix, uc($1), " => {\n";
174 walkoptree_exec($op->other, $method, $level + 1);
175 print $prefix, "}\n";
176 } elsif ($ppname eq "match" || $ppname eq "subst") {
177 my $pmreplstart = $op->pmreplstart;
179 print $prefix, "PMREPLSTART => {\n";
180 walkoptree_exec($pmreplstart, $method, $level + 1);
181 print $prefix, "}\n";
183 } elsif ($ppname eq "substcont") {
184 print $prefix, "SUBSTCONT => {\n";
185 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
186 print $prefix, "}\n";
188 } elsif ($ppname eq "enterloop") {
189 print $prefix, "REDO => {\n";
190 walkoptree_exec($op->redoop, $method, $level + 1);
191 print $prefix, "}\n", $prefix, "NEXT => {\n";
192 walkoptree_exec($op->nextop, $method, $level + 1);
193 print $prefix, "}\n", $prefix, "LAST => {\n";
194 walkoptree_exec($op->lastop, $method, $level + 1);
195 print $prefix, "}\n";
196 } elsif ($ppname eq "subst") {
197 my $replstart = $op->pmreplstart;
199 print $prefix, "SUBST => {\n";
200 walkoptree_exec($replstart, $method, $level + 1);
201 print $prefix, "}\n";
208 my ($symref, $method, $recurse, $prefix) = @_;
213 $prefix = '' unless defined $prefix;
214 while (($sym, $ref) = each %$symref) {
215 *glob = "*main::".$prefix.$sym;
217 $sym = $prefix . $sym;
218 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
219 walksymtable(\%glob, $method, $recurse, $sym);
222 svref_2object(\*glob)->EGV->$method();
233 my ($class, $section, $symtable, $default) = @_;
234 $output_fh ||= FileHandle->new_tmpfile;
235 my $obj = bless [-1, $section, $symtable, $default], $class;
236 $sections{$section} = $obj;
241 my ($class, $section) = @_;
242 return $sections{$section};
247 while (defined($_ = shift)) {
248 print $output_fh "$section->[1]\t$_\n";
255 return $section->[0];
260 return $section->[1];
265 return $section->[2];
270 return $section->[3];
274 my ($section, $fh, $format) = @_;
275 my $name = $section->name;
276 my $sym = $section->symtable || {};
277 my $default = $section->default;
279 seek($output_fh, 0, 0);
280 while (<$output_fh>) {
285 exists($sym->{$1}) ? $sym->{$1} : $default;
287 printf $fh $format, $_;
301 B - The Perl Compiler
309 The C<B> module supplies classes which allow a Perl program to delve
310 into its own innards. It is the module used to implement the
311 "backends" of the Perl compiler. Usage of the compiler does not
312 require knowledge of this module: see the F<O> module for the
313 user-visible part. The C<B> module is of use to those who want to
314 write new compiler backends. This documentation assumes that the
315 reader knows a fair amount about perl's internals including such
316 things as SVs, OPs and the internal symbol table and syntax tree
319 =head1 OVERVIEW OF CLASSES
321 The C structures used by Perl's internals to hold SV and OP
322 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
323 class hierarchy and the C<B> module gives access to them via a true
324 object hierarchy. Structure fields which point to other objects
325 (whether types of SV or types of OP) are represented by the C<B>
326 module as Perl objects of the appropriate class. The bulk of the C<B>
327 module is the methods for accessing fields of these structures. Note
328 that all access is read-only: you cannot modify the internals by
331 =head2 SV-RELATED CLASSES
333 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
334 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
335 the obvious way to the underlying C structures of similar names. The
336 inheritance hierarchy mimics the underlying C "inheritance". Access
337 methods correspond to the underlying C macros for field access,
338 usually with the leading "class indication" prefix removed (Sv, Av,
339 Hv, ...). The leading prefix is only left in cases where its removal
340 would cause a clash in method name. For example, C<GvREFCNT> stays
341 as-is since its abbreviation would clash with the "superclass" method
342 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
360 Returns the value of the IV, I<interpreted as
361 a signed integer>. This will be misleading
362 if C<FLAGS & SVf_IVisUV>. Perhaps you want the
363 C<int_value> method instead?
371 This method returns the value of the IV as an integer.
372 It differs from C<IV> in that it returns the correct
373 value regardless of whether it's stored signed or
406 This method is the one you usually want. It constructs a
407 string using the length and offset information in the struct:
408 for ordinary scalars it will return the string that you'd see
409 from Perl, even if it contains null characters.
413 This method is less often useful. It assumes that the string
414 stored in the struct is null-terminated, and disregards the
417 It is the appropriate method to use if you need to get the name
418 of a lexical variable from a padname array. Lexical variable names
419 are always stored with a null terminator, and the length field
420 (SvCUR) is overloaded for other purposes and can't be relied on here.
424 =head2 B::PVMG METHODS
434 =head2 B::MAGIC METHODS
452 =head2 B::PVLV METHODS
486 This method returns TRUE if the GP field of the GV is NULL.
492 This method returns the name of the glob, but if the first
493 character of the name is a control character, then it converts
494 it to ^X first, so that *^G would return "^G" rather than "\cG".
496 It's useful if you want to print out the name of a variable.
497 If you restrict yourself to globs which exist at compile-time
498 then the result ought to be unambiguous, because code like
499 C<${"^G"} = 1> is compiled as two ops - a constant string and
500 a dereference (rv2gv) - so that the glob is created at runtime.
502 If you're working with globs at runtime, and need to disambiguate
503 *^G from *{"^G"}, then you should use the raw NAME method.
633 =head2 OP-RELATED CLASSES
635 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
636 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
637 These classes correspond in
638 the obvious way to the underlying C structures of similar names. The
639 inheritance hierarchy mimics the underlying C "inheritance". Access
640 methods correspond to the underlying C structre field names, with the
641 leading "class indication" prefix removed (op_).
653 This returns the op name as a string (e.g. "add", "rv2av").
657 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
658 "PL_ppaddr[OP_RV2AV]").
662 This returns the op description from the global C PL_op_desc array
663 (e.g. "addition" "array deref").
677 =head2 B::UNOP METHOD
685 =head2 B::BINOP METHOD
693 =head2 B::LOGOP METHOD
701 =head2 B::LISTOP METHOD
709 =head2 B::PMOP METHODS
729 =head2 B::SVOP METHOD
739 =head2 B::PADOP METHOD
747 =head2 B::PVOP METHOD
755 =head2 B::LOOP METHODS
767 =head2 B::COP METHODS
785 =head1 FUNCTIONS EXPORTED BY C<B>
787 The C<B> module exports a variety of functions: some are simple
788 utility functions, others provide a Perl program with a way to
789 get an initial "handle" on an internal object.
795 Return the (faked) CV corresponding to the main part of the Perl
800 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
804 Returns the root op (i.e. an object in the appropriate B::OP-derived
805 class) of the main part of the Perl program.
809 Returns the starting op of the main part of the Perl program.
813 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
817 Returns the SV object corresponding to the C variable C<sv_undef>.
821 Returns the SV object corresponding to the C variable C<sv_yes>.
825 Returns the SV object corresponding to the C variable C<sv_no>.
827 =item amagic_generation
829 Returns the SV object corresponding to the C variable C<amagic_generation>.
831 =item walkoptree(OP, METHOD)
833 Does a tree-walk of the syntax tree based at OP and calls METHOD on
834 each op it visits. Each node is visited before its children. If
835 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
836 the method C<walkoptree_debug> is called on each op before METHOD is
839 =item walkoptree_debug(DEBUG)
841 Returns the current debugging flag for C<walkoptree>. If the optional
842 DEBUG argument is non-zero, it sets the debugging flag to that. See
843 the description of C<walkoptree> above for what the debugging flag
846 =item walksymtable(SYMREF, METHOD, RECURSE, PREFIX)
848 Walk the symbol table starting at SYMREF and call METHOD on each
849 symbol (a B::GV object) visited. When the walk reaches package
850 symbols (such as "Foo::") it invokes RECURSE, passing in the symbol
851 name, and only recurses into the package if that sub returns true.
853 PREFIX is the name of the SYMREF you're walking.
857 # Walk CGI's symbol table calling print_subs on each symbol.
858 # Only recurse into CGI::Util::
859 walksymtable(\%CGI::, 'print_subs', sub { $_[0] eq 'CGI::Util::' },
862 print_subs() is a B::GV method you have declared.
865 =item svref_2object(SV)
867 Takes any Perl variable and turns it into an object in the
868 appropriate B::OP-derived or B::SV-derived class. Apart from functions
869 such as C<main_root>, this is the primary way to get an initial
870 "handle" on a internal perl data structure which can then be followed
871 with the other access methods.
875 Return the PP function name (e.g. "pp_add") of op number OPNUM.
879 Returns a string in the form "0x..." representing the value of the
880 internal hash function used by perl on string STR.
884 Casts I to the internal I32 type used by that perl.
889 Does the equivalent of the C<-c> command-line option. Obviously, this
890 is only useful in a BEGIN block or else the flag is set too late.
895 Returns a double-quote-surrounded escaped version of STR which can
896 be used as a string in C source code.
900 Returns the class of an object without the part of the classname
901 preceding the first "::". This is used to turn "B::UNOP" into
906 In a perl compiled for threads, this returns a list of the special
907 per-thread threadsv variables.
913 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>