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) = @_;
136 my $prefix = " " x $level;
137 for (; $$op; $op = $op->next) {
140 print $prefix, "goto $sym\n";
143 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
144 $op->$method($level);
147 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
149 print $prefix, uc($1), " => {\n";
150 walkoptree_exec($op->other, $method, $level + 1);
151 print $prefix, "}\n";
152 } elsif ($ppname eq "match" || $ppname eq "subst") {
153 my $pmreplstart = $op->pmreplstart;
155 print $prefix, "PMREPLSTART => {\n";
156 walkoptree_exec($pmreplstart, $method, $level + 1);
157 print $prefix, "}\n";
159 } elsif ($ppname eq "substcont") {
160 print $prefix, "SUBSTCONT => {\n";
161 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
162 print $prefix, "}\n";
164 } elsif ($ppname eq "enterloop") {
165 print $prefix, "REDO => {\n";
166 walkoptree_exec($op->redoop, $method, $level + 1);
167 print $prefix, "}\n", $prefix, "NEXT => {\n";
168 walkoptree_exec($op->nextop, $method, $level + 1);
169 print $prefix, "}\n", $prefix, "LAST => {\n";
170 walkoptree_exec($op->lastop, $method, $level + 1);
171 print $prefix, "}\n";
172 } elsif ($ppname eq "subst") {
173 my $replstart = $op->pmreplstart;
175 print $prefix, "SUBST => {\n";
176 walkoptree_exec($replstart, $method, $level + 1);
177 print $prefix, "}\n";
184 my ($symref, $method, $recurse, $prefix) = @_;
189 $prefix = '' unless defined $prefix;
190 while (($sym, $ref) = each %$symref) {
191 *glob = "*main::".$prefix.$sym;
193 $sym = $prefix . $sym;
194 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
195 walksymtable(\%glob, $method, $recurse, $sym);
198 svref_2object(\*glob)->EGV->$method();
209 my ($class, $section, $symtable, $default) = @_;
210 $output_fh ||= FileHandle->new_tmpfile;
211 my $obj = bless [-1, $section, $symtable, $default], $class;
212 $sections{$section} = $obj;
217 my ($class, $section) = @_;
218 return $sections{$section};
223 while (defined($_ = shift)) {
224 print $output_fh "$section->[1]\t$_\n";
231 return $section->[0];
236 return $section->[1];
241 return $section->[2];
246 return $section->[3];
250 my ($section, $fh, $format) = @_;
251 my $name = $section->name;
252 my $sym = $section->symtable || {};
253 my $default = $section->default;
255 seek($output_fh, 0, 0);
256 while (<$output_fh>) {
261 exists($sym->{$1}) ? $sym->{$1} : $default;
263 printf $fh $format, $_;
277 B - The Perl Compiler
285 The C<B> module supplies classes which allow a Perl program to delve
286 into its own innards. It is the module used to implement the
287 "backends" of the Perl compiler. Usage of the compiler does not
288 require knowledge of this module: see the F<O> module for the
289 user-visible part. The C<B> module is of use to those who want to
290 write new compiler backends. This documentation assumes that the
291 reader knows a fair amount about perl's internals including such
292 things as SVs, OPs and the internal symbol table and syntax tree
295 =head1 OVERVIEW OF CLASSES
297 The C structures used by Perl's internals to hold SV and OP
298 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
299 class hierarchy and the C<B> module gives access to them via a true
300 object hierarchy. Structure fields which point to other objects
301 (whether types of SV or types of OP) are represented by the C<B>
302 module as Perl objects of the appropriate class. The bulk of the C<B>
303 module is the methods for accessing fields of these structures. Note
304 that all access is read-only: you cannot modify the internals by
307 =head2 SV-RELATED CLASSES
309 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
310 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
311 the obvious way to the underlying C structures of similar names. The
312 inheritance hierarchy mimics the underlying C "inheritance". Access
313 methods correspond to the underlying C macros for field access,
314 usually with the leading "class indication" prefix removed (Sv, Av,
315 Hv, ...). The leading prefix is only left in cases where its removal
316 would cause a clash in method name. For example, C<GvREFCNT> stays
317 as-is since its abbreviation would clash with the "superclass" method
318 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
370 =head2 B::PVMG METHODS
380 =head2 B::MAGIC METHODS
398 =head2 B::PVLV METHODS
432 This method returns TRUE if the GP field of the GV is NULL.
564 =head2 OP-RELATED CLASSES
566 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
567 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
568 These classes correspond in
569 the obvious way to the underlying C structures of similar names. The
570 inheritance hierarchy mimics the underlying C "inheritance". Access
571 methods correspond to the underlying C structre field names, with the
572 leading "class indication" prefix removed (op_).
584 This returns the op name as a string (e.g. "add", "rv2av").
588 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
589 "PL_ppaddr[OP_RV2AV]").
593 This returns the op description from the global C PL_op_desc array
594 (e.g. "addition" "array deref").
608 =head2 B::UNOP METHOD
616 =head2 B::BINOP METHOD
624 =head2 B::LOGOP METHOD
632 =head2 B::LISTOP METHOD
640 =head2 B::PMOP METHODS
660 =head2 B::SVOP METHOD
670 =head2 B::PADOP METHOD
678 =head2 B::PVOP METHOD
686 =head2 B::LOOP METHODS
698 =head2 B::COP METHODS
716 =head1 FUNCTIONS EXPORTED BY C<B>
718 The C<B> module exports a variety of functions: some are simple
719 utility functions, others provide a Perl program with a way to
720 get an initial "handle" on an internal object.
726 Return the (faked) CV corresponding to the main part of the Perl
731 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
735 Returns the root op (i.e. an object in the appropriate B::OP-derived
736 class) of the main part of the Perl program.
740 Returns the starting op of the main part of the Perl program.
744 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
748 Returns the SV object corresponding to the C variable C<sv_undef>.
752 Returns the SV object corresponding to the C variable C<sv_yes>.
756 Returns the SV object corresponding to the C variable C<sv_no>.
758 =item amagic_generation
760 Returns the SV object corresponding to the C variable C<amagic_generation>.
762 =item walkoptree(OP, METHOD)
764 Does a tree-walk of the syntax tree based at OP and calls METHOD on
765 each op it visits. Each node is visited before its children. If
766 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
767 the method C<walkoptree_debug> is called on each op before METHOD is
770 =item walkoptree_debug(DEBUG)
772 Returns the current debugging flag for C<walkoptree>. If the optional
773 DEBUG argument is non-zero, it sets the debugging flag to that. See
774 the description of C<walkoptree> above for what the debugging flag
777 =item walksymtable(SYMREF, METHOD, RECURSE)
779 Walk the symbol table starting at SYMREF and call METHOD on each
780 symbol visited. When the walk reached package symbols "Foo::" it
781 invokes RECURSE and only recurses into the package if that sub
784 =item svref_2object(SV)
786 Takes any Perl variable and turns it into an object in the
787 appropriate B::OP-derived or B::SV-derived class. Apart from functions
788 such as C<main_root>, this is the primary way to get an initial
789 "handle" on a internal perl data structure which can then be followed
790 with the other access methods.
794 Return the PP function name (e.g. "pp_add") of op number OPNUM.
798 Returns a string in the form "0x..." representing the value of the
799 internal hash function used by perl on string STR.
803 Casts I to the internal I32 type used by that perl.
808 Does the equivalent of the C<-c> command-line option. Obviously, this
809 is only useful in a BEGIN block or else the flag is set too late.
814 Returns a double-quote-surrounded escaped version of STR which can
815 be used as a string in C source code.
819 Returns the class of an object without the part of the classname
820 preceding the first "::". This is used to turn "B::UNOP" into
825 In a perl compiled for threads, this returns a list of the special
826 per-thread threadsv variables.
832 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>