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
68 my ($class, $value) = @_;
70 walkoptree_debug($value);
80 sub parents { \@parents }
85 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
89 my($op, $method, $level) = @_;
90 $op_count++; # just for statistics
92 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
94 if ($$op && ($op->flags & OPf_KIDS)) {
96 unshift(@parents, $op);
97 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
98 walkoptree_slow($kid, $method, $level + 1);
105 return "Total number of OPs processed: $op_count\n";
109 my ($sec, $min, $hr) = localtime;
110 my ($user, $sys) = times;
111 sprintf("%02d:%02d:%02d user=$user sys=$sys",
112 $hr, $min, $sec, $user, $sys);
122 my ($obj, $value) = @_;
123 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
124 $symtable{sprintf("sym_%x", $$obj)} = $value;
129 return $symtable{sprintf("sym_%x", $$obj)};
132 sub walkoptree_exec {
133 my ($op, $method, $level) = @_;
135 my $prefix = " " x $level;
136 for (; $$op; $op = $op->next) {
139 print $prefix, "goto $sym\n";
142 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
143 $op->$method($level);
146 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
148 print $prefix, uc($1), " => {\n";
149 walkoptree_exec($op->other, $method, $level + 1);
150 print $prefix, "}\n";
151 } elsif ($ppname eq "match" || $ppname eq "subst") {
152 my $pmreplstart = $op->pmreplstart;
154 print $prefix, "PMREPLSTART => {\n";
155 walkoptree_exec($pmreplstart, $method, $level + 1);
156 print $prefix, "}\n";
158 } elsif ($ppname eq "substcont") {
159 print $prefix, "SUBSTCONT => {\n";
160 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
161 print $prefix, "}\n";
163 } elsif ($ppname eq "enterloop") {
164 print $prefix, "REDO => {\n";
165 walkoptree_exec($op->redoop, $method, $level + 1);
166 print $prefix, "}\n", $prefix, "NEXT => {\n";
167 walkoptree_exec($op->nextop, $method, $level + 1);
168 print $prefix, "}\n", $prefix, "LAST => {\n";
169 walkoptree_exec($op->lastop, $method, $level + 1);
170 print $prefix, "}\n";
171 } elsif ($ppname eq "subst") {
172 my $replstart = $op->pmreplstart;
174 print $prefix, "SUBST => {\n";
175 walkoptree_exec($replstart, $method, $level + 1);
176 print $prefix, "}\n";
183 my ($symref, $method, $recurse, $prefix) = @_;
188 $prefix = '' unless defined $prefix;
189 while (($sym, $ref) = each %$symref) {
190 *glob = "*main::".$prefix.$sym;
192 $sym = $prefix . $sym;
193 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
194 walksymtable(\%glob, $method, $recurse, $sym);
197 svref_2object(\*glob)->EGV->$method();
208 my ($class, $section, $symtable, $default) = @_;
209 $output_fh ||= FileHandle->new_tmpfile;
210 my $obj = bless [-1, $section, $symtable, $default], $class;
211 $sections{$section} = $obj;
216 my ($class, $section) = @_;
217 return $sections{$section};
222 while (defined($_ = shift)) {
223 print $output_fh "$section->[1]\t$_\n";
230 return $section->[0];
235 return $section->[1];
240 return $section->[2];
245 return $section->[3];
249 my ($section, $fh, $format) = @_;
250 my $name = $section->name;
251 my $sym = $section->symtable || {};
252 my $default = $section->default;
254 seek($output_fh, 0, 0);
255 while (<$output_fh>) {
260 exists($sym->{$1}) ? $sym->{$1} : $default;
262 printf $fh $format, $_;
276 B - The Perl Compiler
284 The C<B> module supplies classes which allow a Perl program to delve
285 into its own innards. It is the module used to implement the
286 "backends" of the Perl compiler. Usage of the compiler does not
287 require knowledge of this module: see the F<O> module for the
288 user-visible part. The C<B> module is of use to those who want to
289 write new compiler backends. This documentation assumes that the
290 reader knows a fair amount about perl's internals including such
291 things as SVs, OPs and the internal symbol table and syntax tree
294 =head1 OVERVIEW OF CLASSES
296 The C structures used by Perl's internals to hold SV and OP
297 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
298 class hierarchy and the C<B> module gives access to them via a true
299 object hierarchy. Structure fields which point to other objects
300 (whether types of SV or types of OP) are represented by the C<B>
301 module as Perl objects of the appropriate class. The bulk of the C<B>
302 module is the methods for accessing fields of these structures. Note
303 that all access is read-only: you cannot modify the internals by
306 =head2 SV-RELATED CLASSES
308 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
309 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
310 the obvious way to the underlying C structures of similar names. The
311 inheritance hierarchy mimics the underlying C "inheritance". Access
312 methods correspond to the underlying C macros for field access,
313 usually with the leading "class indication" prefix removed (Sv, Av,
314 Hv, ...). The leading prefix is only left in cases where its removal
315 would cause a clash in method name. For example, C<GvREFCNT> stays
316 as-is since its abbreviation would clash with the "superclass" method
317 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
369 =head2 B::PVMG METHODS
379 =head2 B::MAGIC METHODS
397 =head2 B::PVLV METHODS
431 This method returns TRUE if the GP field of the GV is NULL.
563 =head2 OP-RELATED CLASSES
565 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
566 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
567 These classes correspond in
568 the obvious way to the underlying C structures of similar names. The
569 inheritance hierarchy mimics the underlying C "inheritance". Access
570 methods correspond to the underlying C structre field names, with the
571 leading "class indication" prefix removed (op_).
583 This returns the op name as a string (e.g. "add", "rv2av").
587 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
588 "PL_ppaddr[OP_RV2AV]").
592 This returns the op description from the global C PL_op_desc array
593 (e.g. "addition" "array deref").
607 =head2 B::UNOP METHOD
615 =head2 B::BINOP METHOD
623 =head2 B::LOGOP METHOD
631 =head2 B::LISTOP METHOD
639 =head2 B::PMOP METHODS
659 =head2 B::SVOP METHOD
669 =head2 B::PADOP METHOD
677 =head2 B::PVOP METHOD
685 =head2 B::LOOP METHODS
697 =head2 B::COP METHODS
715 =head1 FUNCTIONS EXPORTED BY C<B>
717 The C<B> module exports a variety of functions: some are simple
718 utility functions, others provide a Perl program with a way to
719 get an initial "handle" on an internal object.
725 Return the (faked) CV corresponding to the main part of the Perl
730 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
734 Returns the root op (i.e. an object in the appropriate B::OP-derived
735 class) of the main part of the Perl program.
739 Returns the starting op of the main part of the Perl program.
743 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
747 Returns the SV object corresponding to the C variable C<sv_undef>.
751 Returns the SV object corresponding to the C variable C<sv_yes>.
755 Returns the SV object corresponding to the C variable C<sv_no>.
757 =item amagic_generation
759 Returns the SV object corresponding to the C variable C<amagic_generation>.
761 =item walkoptree(OP, METHOD)
763 Does a tree-walk of the syntax tree based at OP and calls METHOD on
764 each op it visits. Each node is visited before its children. If
765 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
766 the method C<walkoptree_debug> is called on each op before METHOD is
769 =item walkoptree_debug(DEBUG)
771 Returns the current debugging flag for C<walkoptree>. If the optional
772 DEBUG argument is non-zero, it sets the debugging flag to that. See
773 the description of C<walkoptree> above for what the debugging flag
776 =item walksymtable(SYMREF, METHOD, RECURSE)
778 Walk the symbol table starting at SYMREF and call METHOD on each
779 symbol visited. When the walk reached package symbols "Foo::" it
780 invokes RECURSE and only recurses into the package if that sub
783 =item svref_2object(SV)
785 Takes any Perl variable and turns it into an object in the
786 appropriate B::OP-derived or B::SV-derived class. Apart from functions
787 such as C<main_root>, this is the primary way to get an initial
788 "handle" on a internal perl data structure which can then be followed
789 with the other access methods.
793 Return the PP function name (e.g. "pp_add") of op number OPNUM.
797 Returns a string in the form "0x..." representing the value of the
798 internal hash function used by perl on string STR.
802 Casts I to the internal I32 type used by that perl.
807 Does the equivalent of the C<-c> command-line option. Obviously, this
808 is only useful in a BEGIN block or else the flag is set too late.
813 Returns a double-quote-surrounded escaped version of STR which can
814 be used as a string in C source code.
818 Returns the class of an object without the part of the classname
819 preceding the first "::". This is used to turn "B::UNOP" into
824 In a perl compiled for threads, this returns a list of the special
825 per-thread threadsv variables.
831 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>