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.
12 @EXPORT_OK = qw(minus_c ppname save_BEGINs
13 class peekop cast_I32 cstring cchar hash threadsv_names
14 main_root main_start main_cv svref_2object opnumber amagic_generation
15 walkoptree_slow walkoptree walkoptree_exec walksymtable
16 parents comppadlist sv_undef compile_stats timing_info
17 begin_av init_av end_av);
20 @B::SV::ISA = 'B::OBJECT';
21 @B::NULL::ISA = 'B::SV';
22 @B::PV::ISA = 'B::SV';
23 @B::IV::ISA = 'B::SV';
24 @B::NV::ISA = 'B::IV';
25 @B::RV::ISA = 'B::SV';
26 @B::PVIV::ISA = qw(B::PV B::IV);
27 @B::PVNV::ISA = qw(B::PV B::NV);
28 @B::PVMG::ISA = 'B::PVNV';
29 @B::PVLV::ISA = 'B::PVMG';
30 @B::BM::ISA = 'B::PVMG';
31 @B::AV::ISA = 'B::PVMG';
32 @B::GV::ISA = 'B::PVMG';
33 @B::HV::ISA = 'B::PVMG';
34 @B::CV::ISA = 'B::PVMG';
35 @B::IO::ISA = 'B::PVMG';
36 @B::FM::ISA = 'B::CV';
38 @B::OP::ISA = 'B::OBJECT';
39 @B::UNOP::ISA = 'B::OP';
40 @B::BINOP::ISA = 'B::UNOP';
41 @B::LOGOP::ISA = 'B::UNOP';
42 @B::LISTOP::ISA = 'B::BINOP';
43 @B::SVOP::ISA = 'B::OP';
44 @B::PADOP::ISA = 'B::OP';
45 @B::PVOP::ISA = 'B::OP';
46 @B::CVOP::ISA = 'B::OP';
47 @B::LOOP::ISA = 'B::LISTOP';
48 @B::PMOP::ISA = 'B::LISTOP';
49 @B::COP::ISA = 'B::OP';
51 @B::SPECIAL::ISA = 'B::OBJECT';
54 # Stop "-w" from complaining about the lack of a real B::OBJECT class
63 my ($class, $value) = @_;
65 walkoptree_debug($value);
75 sub parents { \@parents }
80 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
84 my($op, $method, $level) = @_;
85 $op_count++; # just for statistics
87 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
89 if ($$op && ($op->flags & OPf_KIDS)) {
91 unshift(@parents, $op);
92 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
93 walkoptree($kid, $method, $level + 1);
99 *walkoptree_slow = \&walkoptree; # Who is using this?
102 return "Total number of OPs processed: $op_count\n";
106 my ($sec, $min, $hr) = localtime;
107 my ($user, $sys) = times;
108 sprintf("%02d:%02d:%02d user=$user sys=$sys",
109 $hr, $min, $sec, $user, $sys);
119 my ($obj, $value) = @_;
120 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
121 $symtable{sprintf("sym_%x", $$obj)} = $value;
126 return $symtable{sprintf("sym_%x", $$obj)};
129 sub walkoptree_exec {
130 my ($op, $method, $level) = @_;
132 my $prefix = " " x $level;
133 for (; $$op; $op = $op->next) {
136 print $prefix, "goto $sym\n";
139 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
140 $op->$method($level);
143 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
145 print $prefix, uc($1), " => {\n";
146 walkoptree_exec($op->other, $method, $level + 1);
147 print $prefix, "}\n";
148 } elsif ($ppname eq "match" || $ppname eq "subst") {
149 my $pmreplstart = $op->pmreplstart;
151 print $prefix, "PMREPLSTART => {\n";
152 walkoptree_exec($pmreplstart, $method, $level + 1);
153 print $prefix, "}\n";
155 } elsif ($ppname eq "substcont") {
156 print $prefix, "SUBSTCONT => {\n";
157 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
158 print $prefix, "}\n";
160 } elsif ($ppname eq "enterloop") {
161 print $prefix, "REDO => {\n";
162 walkoptree_exec($op->redoop, $method, $level + 1);
163 print $prefix, "}\n", $prefix, "NEXT => {\n";
164 walkoptree_exec($op->nextop, $method, $level + 1);
165 print $prefix, "}\n", $prefix, "LAST => {\n";
166 walkoptree_exec($op->lastop, $method, $level + 1);
167 print $prefix, "}\n";
168 } elsif ($ppname eq "subst") {
169 my $replstart = $op->pmreplstart;
171 print $prefix, "SUBST => {\n";
172 walkoptree_exec($replstart, $method, $level + 1);
173 print $prefix, "}\n";
180 my ($symref, $method, $recurse, $prefix) = @_;
185 $prefix = '' unless defined $prefix;
186 while (($sym, $ref) = each %$symref) {
187 *glob = "*main::".$prefix.$sym;
189 $sym = $prefix . $sym;
190 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
191 walksymtable(\%glob, $method, $recurse, $sym);
194 svref_2object(\*glob)->EGV->$method();
205 my ($class, $section, $symtable, $default) = @_;
206 $output_fh ||= FileHandle->new_tmpfile;
207 my $obj = bless [-1, $section, $symtable, $default], $class;
208 $sections{$section} = $obj;
213 my ($class, $section) = @_;
214 return $sections{$section};
219 while (defined($_ = shift)) {
220 print $output_fh "$section->[1]\t$_\n";
227 return $section->[0];
232 return $section->[1];
237 return $section->[2];
242 return $section->[3];
246 my ($section, $fh, $format) = @_;
247 my $name = $section->name;
248 my $sym = $section->symtable || {};
249 my $default = $section->default;
251 seek($output_fh, 0, 0);
252 while (<$output_fh>) {
257 exists($sym->{$1}) ? $sym->{$1} : $default;
259 printf $fh $format, $_;
273 B - The Perl Compiler
281 The C<B> module supplies classes which allow a Perl program to delve
282 into its own innards. It is the module used to implement the
283 "backends" of the Perl compiler. Usage of the compiler does not
284 require knowledge of this module: see the F<O> module for the
285 user-visible part. The C<B> module is of use to those who want to
286 write new compiler backends. This documentation assumes that the
287 reader knows a fair amount about perl's internals including such
288 things as SVs, OPs and the internal symbol table and syntax tree
291 =head1 OVERVIEW OF CLASSES
293 The C structures used by Perl's internals to hold SV and OP
294 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
295 class hierarchy and the C<B> module gives access to them via a true
296 object hierarchy. Structure fields which point to other objects
297 (whether types of SV or types of OP) are represented by the C<B>
298 module as Perl objects of the appropriate class. The bulk of the C<B>
299 module is the methods for accessing fields of these structures. Note
300 that all access is read-only: you cannot modify the internals by
303 =head2 SV-RELATED CLASSES
305 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
306 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
307 the obvious way to the underlying C structures of similar names. The
308 inheritance hierarchy mimics the underlying C "inheritance". Access
309 methods correspond to the underlying C macros for field access,
310 usually with the leading "class indication" prefix removed (Sv, Av,
311 Hv, ...). The leading prefix is only left in cases where its removal
312 would cause a clash in method name. For example, C<GvREFCNT> stays
313 as-is since its abbreviation would clash with the "superclass" method
314 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
366 =head2 B::PVMG METHODS
376 =head2 B::MAGIC METHODS
394 =head2 B::PVLV METHODS
428 This method returns TRUE if the GP field of the GV is NULL.
560 =head2 OP-RELATED CLASSES
562 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
563 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
564 These classes correspond in
565 the obvious way to the underlying C structures of similar names. The
566 inheritance hierarchy mimics the underlying C "inheritance". Access
567 methods correspond to the underlying C structre field names, with the
568 leading "class indication" prefix removed (op_).
580 This returns the op name as a string (e.g. "add", "rv2av").
584 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
585 "PL_ppaddr[OP_RV2AV]").
589 This returns the op description from the global C PL_op_desc array
590 (e.g. "addition" "array deref").
604 =head2 B::UNOP METHOD
612 =head2 B::BINOP METHOD
620 =head2 B::LOGOP METHOD
628 =head2 B::LISTOP METHOD
636 =head2 B::PMOP METHODS
656 =head2 B::SVOP METHOD
666 =head2 B::PADOP METHOD
674 =head2 B::PVOP METHOD
682 =head2 B::LOOP METHODS
694 =head2 B::COP METHODS
712 =head1 FUNCTIONS EXPORTED BY C<B>
714 The C<B> module exports a variety of functions: some are simple
715 utility functions, others provide a Perl program with a way to
716 get an initial "handle" on an internal object.
722 Return the (faked) CV corresponding to the main part of the Perl
727 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
731 Returns the root op (i.e. an object in the appropriate B::OP-derived
732 class) of the main part of the Perl program.
736 Returns the starting op of the main part of the Perl program.
740 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
744 Returns the SV object corresponding to the C variable C<sv_undef>.
748 Returns the SV object corresponding to the C variable C<sv_yes>.
752 Returns the SV object corresponding to the C variable C<sv_no>.
754 =item amagic_generation
756 Returns the SV object corresponding to the C variable C<amagic_generation>.
758 =item walkoptree(OP, METHOD)
760 Does a tree-walk of the syntax tree based at OP and calls METHOD on
761 each op it visits. Each node is visited before its children. If
762 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
763 the method C<walkoptree_debug> is called on each op before METHOD is
766 =item walkoptree_debug(DEBUG)
768 Returns the current debugging flag for C<walkoptree>. If the optional
769 DEBUG argument is non-zero, it sets the debugging flag to that. See
770 the description of C<walkoptree> above for what the debugging flag
773 =item walksymtable(SYMREF, METHOD, RECURSE)
775 Walk the symbol table starting at SYMREF and call METHOD on each
776 symbol visited. When the walk reached package symbols "Foo::" it
777 invokes RECURSE and only recurses into the package if that sub
780 =item svref_2object(SV)
782 Takes any Perl variable and turns it into an object in the
783 appropriate B::OP-derived or B::SV-derived class. Apart from functions
784 such as C<main_root>, this is the primary way to get an initial
785 "handle" on a internal perl data structure which can then be followed
786 with the other access methods.
790 Return the PP function name (e.g. "pp_add") of op number OPNUM.
794 Returns a string in the form "0x..." representing the value of the
795 internal hash function used by perl on string STR.
799 Casts I to the internal I32 type used by that perl.
804 Does the equivalent of the C<-c> command-line option. Obviously, this
805 is only useful in a BEGIN block or else the flag is set too late.
810 Returns a double-quote-surrounded escaped version of STR which can
811 be used as a string in C source code.
815 Returns the class of an object without the part of the classname
816 preceding the first "::". This is used to turn "B::UNOP" into
821 In a perl compiled for threads, this returns a list of the special
822 per-thread threadsv variables.
828 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>