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.
11 @ISA = qw(Exporter DynaLoader);
12 @EXPORT_OK = qw(minus_c ppname
13 class peekop cast_I32 cstring cchar hash threadsv_names
14 main_root main_start main_cv svref_2object opnumber amagic_generation
15 walkoptree walkoptree_slow walkoptree_exec walksymtable
16 parents comppadlist sv_undef compile_stats timing_info init_av);
19 @B::SV::ISA = 'B::OBJECT';
20 @B::NULL::ISA = 'B::SV';
21 @B::PV::ISA = 'B::SV';
22 @B::IV::ISA = 'B::SV';
23 @B::NV::ISA = 'B::IV';
24 @B::RV::ISA = 'B::SV';
25 @B::PVIV::ISA = qw(B::PV B::IV);
26 @B::PVNV::ISA = qw(B::PV B::NV);
27 @B::PVMG::ISA = 'B::PVNV';
28 @B::PVLV::ISA = 'B::PVMG';
29 @B::BM::ISA = 'B::PVMG';
30 @B::AV::ISA = 'B::PVMG';
31 @B::GV::ISA = 'B::PVMG';
32 @B::HV::ISA = 'B::PVMG';
33 @B::CV::ISA = 'B::PVMG';
34 @B::IO::ISA = 'B::PVMG';
35 @B::FM::ISA = 'B::CV';
37 @B::OP::ISA = 'B::OBJECT';
38 @B::UNOP::ISA = 'B::OP';
39 @B::BINOP::ISA = 'B::UNOP';
40 @B::LOGOP::ISA = 'B::UNOP';
41 @B::LISTOP::ISA = 'B::BINOP';
42 @B::SVOP::ISA = 'B::OP';
43 @B::GVOP::ISA = 'B::OP';
44 @B::PVOP::ISA = 'B::OP';
45 @B::CVOP::ISA = 'B::OP';
46 @B::LOOP::ISA = 'B::LISTOP';
47 @B::PMOP::ISA = 'B::LISTOP';
48 @B::COP::ISA = 'B::OP';
50 @B::SPECIAL::ISA = 'B::OBJECT';
53 # Stop "-w" from complaining about the lack of a real B::OBJECT class
62 my ($class, $value) = @_;
64 walkoptree_debug($value);
74 sub parents { \@parents }
79 return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
83 my($op, $method, $level) = @_;
84 $op_count++; # just for statistics
86 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
88 if ($$op && ($op->flags & OPf_KIDS)) {
90 unshift(@parents, $op);
91 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
92 walkoptree_slow($kid, $method, $level + 1);
99 return "Total number of OPs processed: $op_count\n";
103 my ($sec, $min, $hr) = localtime;
104 my ($user, $sys) = times;
105 sprintf("%02d:%02d:%02d user=$user sys=$sys",
106 $hr, $min, $sec, $user, $sys);
111 my ($obj, $value) = @_;
112 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
113 $symtable{sprintf("sym_%x", $$obj)} = $value;
118 return $symtable{sprintf("sym_%x", $$obj)};
121 sub walkoptree_exec {
122 my ($op, $method, $level) = @_;
124 my $prefix = " " x $level;
125 for (; $$op; $op = $op->next) {
128 print $prefix, "goto $sym\n";
131 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
132 $op->$method($level);
133 $ppname = $op->ppaddr;
135 /^pp_(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
137 print $prefix, uc($1), " => {\n";
138 walkoptree_exec($op->other, $method, $level + 1);
139 print $prefix, "}\n";
140 } elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
141 my $pmreplstart = $op->pmreplstart;
143 print $prefix, "PMREPLSTART => {\n";
144 walkoptree_exec($pmreplstart, $method, $level + 1);
145 print $prefix, "}\n";
147 } elsif ($ppname eq "pp_substcont") {
148 print $prefix, "SUBSTCONT => {\n";
149 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
150 print $prefix, "}\n";
152 } elsif ($ppname eq "pp_enterloop") {
153 print $prefix, "REDO => {\n";
154 walkoptree_exec($op->redoop, $method, $level + 1);
155 print $prefix, "}\n", $prefix, "NEXT => {\n";
156 walkoptree_exec($op->nextop, $method, $level + 1);
157 print $prefix, "}\n", $prefix, "LAST => {\n";
158 walkoptree_exec($op->lastop, $method, $level + 1);
159 print $prefix, "}\n";
160 } elsif ($ppname eq "pp_subst") {
161 my $replstart = $op->pmreplstart;
163 print $prefix, "SUBST => {\n";
164 walkoptree_exec($replstart, $method, $level + 1);
165 print $prefix, "}\n";
172 my ($symref, $method, $recurse, $prefix) = @_;
177 $prefix = '' unless defined $prefix;
178 while (($sym, $ref) = each %$symref) {
179 *glob = "*main::".$prefix.$sym;
181 $sym = $prefix . $sym;
182 if ($sym ne "main::" && &$recurse($sym)) {
183 walksymtable(\%glob, $method, $recurse, $sym);
186 svref_2object(\*glob)->EGV->$method();
197 my ($class, $section, $symtable, $default) = @_;
198 $output_fh ||= FileHandle->new_tmpfile;
199 my $obj = bless [-1, $section, $symtable, $default], $class;
200 $sections{$section} = $obj;
205 my ($class, $section) = @_;
206 return $sections{$section};
211 while (defined($_ = shift)) {
212 print $output_fh "$section->[1]\t$_\n";
219 return $section->[0];
224 return $section->[1];
229 return $section->[2];
234 return $section->[3];
238 my ($section, $fh, $format) = @_;
239 my $name = $section->name;
240 my $sym = $section->symtable || {};
241 my $default = $section->default;
243 seek($output_fh, 0, 0);
244 while (<$output_fh>) {
249 exists($sym->{$1}) ? $sym->{$1} : $default;
251 printf $fh $format, $_;
265 B - The Perl Compiler
273 The C<B> module supplies classes which allow a Perl program to delve
274 into its own innards. It is the module used to implement the
275 "backends" of the Perl compiler. Usage of the compiler does not
276 require knowledge of this module: see the F<O> module for the
277 user-visible part. The C<B> module is of use to those who want to
278 write new compiler backends. This documentation assumes that the
279 reader knows a fair amount about perl's internals including such
280 things as SVs, OPs and the internal symbol table and syntax tree
283 =head1 OVERVIEW OF CLASSES
285 The C structures used by Perl's internals to hold SV and OP
286 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
287 class hierarchy and the C<B> module gives access to them via a true
288 object hierarchy. Structure fields which point to other objects
289 (whether types of SV or types of OP) are represented by the C<B>
290 module as Perl objects of the appropriate class. The bulk of the C<B>
291 module is the methods for accessing fields of these structures. Note
292 that all access is read-only: you cannot modify the internals by
295 =head2 SV-RELATED CLASSES
297 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
298 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
299 the obvious way to the underlying C structures of similar names. The
300 inheritance hierarchy mimics the underlying C "inheritance". Access
301 methods correspond to the underlying C macros for field access,
302 usually with the leading "class indication" prefix removed (Sv, Av,
303 Hv, ...). The leading prefix is only left in cases where its removal
304 would cause a clash in method name. For example, C<GvREFCNT> stays
305 as-is since its abbreviation would clash with the "superclass" method
306 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
358 =head2 B::PVMG METHODS
368 =head2 B::MAGIC METHODS
386 =head2 B::PVLV METHODS
544 =head2 OP-RELATED CLASSES
546 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
547 B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
548 These classes correspond in
549 the obvious way to the underlying C structures of similar names. The
550 inheritance hierarchy mimics the underlying C "inheritance". Access
551 methods correspond to the underlying C structre field names, with the
552 leading "class indication" prefix removed (op_).
564 This returns the function name as a string (e.g. pp_add, pp_rv2av).
568 This returns the op description from the global C PL_op_desc array
569 (e.g. "addition" "array deref").
583 =head2 B::UNOP METHOD
591 =head2 B::BINOP METHOD
599 =head2 B::LOGOP METHOD
607 =head2 B::LISTOP METHOD
615 =head2 B::PMOP METHODS
635 =head2 B::SVOP METHOD
643 =head2 B::GVOP METHOD
651 =head2 B::PVOP METHOD
659 =head2 B::LOOP METHODS
671 =head2 B::COP METHODS
689 =head1 FUNCTIONS EXPORTED BY C<B>
691 The C<B> module exports a variety of functions: some are simple
692 utility functions, others provide a Perl program with a way to
693 get an initial "handle" on an internal object.
699 Return the (faked) CV corresponding to the main part of the Perl
704 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
708 Returns the root op (i.e. an object in the appropriate B::OP-derived
709 class) of the main part of the Perl program.
713 Returns the starting op of the main part of the Perl program.
717 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
721 Returns the SV object corresponding to the C variable C<sv_undef>.
725 Returns the SV object corresponding to the C variable C<sv_yes>.
729 Returns the SV object corresponding to the C variable C<sv_no>.
731 =item amagic_generation
733 Returns the SV object corresponding to the C variable C<amagic_generation>.
735 =item walkoptree(OP, METHOD)
737 Does a tree-walk of the syntax tree based at OP and calls METHOD on
738 each op it visits. Each node is visited before its children. If
739 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
740 the method C<walkoptree_debug> is called on each op before METHOD is
743 =item walkoptree_debug(DEBUG)
745 Returns the current debugging flag for C<walkoptree>. If the optional
746 DEBUG argument is non-zero, it sets the debugging flag to that. See
747 the description of C<walkoptree> above for what the debugging flag
750 =item walksymtable(SYMREF, METHOD, RECURSE)
752 Walk the symbol table starting at SYMREF and call METHOD on each
753 symbol visited. When the walk reached package symbols "Foo::" it
754 invokes RECURSE and only recurses into the package if that sub
757 =item svref_2object(SV)
759 Takes any Perl variable and turns it into an object in the
760 appropriate B::OP-derived or B::SV-derived class. Apart from functions
761 such as C<main_root>, this is the primary way to get an initial
762 "handle" on a internal perl data structure which can then be followed
763 with the other access methods.
767 Return the PP function name (e.g. "pp_add") of op number OPNUM.
771 Returns a string in the form "0x..." representing the value of the
772 internal hash function used by perl on string STR.
776 Casts I to the internal I32 type used by that perl.
781 Does the equivalent of the C<-c> command-line option. Obviously, this
782 is only useful in a BEGIN block or else the flag is set too late.
787 Returns a double-quote-surrounded escaped version of STR which can
788 be used as a string in C source code.
792 Returns the class of an object without the part of the classname
793 preceding the first "::". This is used to turn "B::UNOP" into
798 In a perl compiled for threads, this returns a list of the special
799 per-thread threadsv variables.
805 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>