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(byteload_fh byteload_string minus_c ppname
13 class peekop cast_I32 cstring cchar hash threadsv_names
14 main_root main_start main_cv svref_2object opnumber
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::CONDOP::ISA = 'B::UNOP';
42 @B::LISTOP::ISA = 'B::BINOP';
43 @B::SVOP::ISA = 'B::OP';
44 @B::GVOP::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->ppaddr);
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_slow($kid, $method, $level + 1);
100 return "Total number of OPs processed: $op_count\n";
104 my ($sec, $min, $hr) = localtime;
105 my ($user, $sys) = times;
106 sprintf("%02d:%02d:%02d user=$user sys=$sys",
107 $hr, $min, $sec, $user, $sys);
112 my ($obj, $value) = @_;
113 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
114 $symtable{sprintf("sym_%x", $$obj)} = $value;
119 return $symtable{sprintf("sym_%x", $$obj)};
122 sub walkoptree_exec {
123 my ($op, $method, $level) = @_;
125 my $prefix = " " x $level;
126 for (; $$op; $op = $op->next) {
129 print $prefix, "goto $sym\n";
132 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
133 $op->$method($level);
134 $ppname = $op->ppaddr;
135 if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
136 print $prefix, uc($1), " => {\n";
137 walkoptree_exec($op->other, $method, $level + 1);
138 print $prefix, "}\n";
139 } elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
140 my $pmreplstart = $op->pmreplstart;
142 print $prefix, "PMREPLSTART => {\n";
143 walkoptree_exec($pmreplstart, $method, $level + 1);
144 print $prefix, "}\n";
146 } elsif ($ppname eq "pp_substcont") {
147 print $prefix, "SUBSTCONT => {\n";
148 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
149 print $prefix, "}\n";
151 } elsif ($ppname eq "pp_cond_expr") {
152 # pp_cond_expr never returns op_next
153 print $prefix, "TRUE => {\n";
154 walkoptree_exec($op->true, $method, $level + 1);
155 print $prefix, "}\n";
158 } elsif ($ppname eq "pp_range") {
159 print $prefix, "TRUE => {\n";
160 walkoptree_exec($op->true, $method, $level + 1);
161 print $prefix, "}\n", $prefix, "FALSE => {\n";
162 walkoptree_exec($op->false, $method, $level + 1);
163 print $prefix, "}\n";
164 } elsif ($ppname eq "pp_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 "pp_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::" && &$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
556 =head2 OP-RELATED CLASSES
558 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::CONDOP, B::LISTOP, B::PMOP,
559 B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
560 These classes correspond in
561 the obvious way to the underlying C structures of similar names. The
562 inheritance hierarchy mimics the underlying C "inheritance". Access
563 methods correspond to the underlying C structre field names, with the
564 leading "class indication" prefix removed (op_).
576 This returns the function name as a string (e.g. pp_add, pp_rv2av).
580 This returns the op description from the global C PL_op_desc array
581 (e.g. "addition" "array deref").
595 =head2 B::UNOP METHOD
603 =head2 B::BINOP METHOD
611 =head2 B::LOGOP METHOD
619 =head2 B::CONDOP METHODS
629 =head2 B::LISTOP METHOD
637 =head2 B::PMOP METHODS
657 =head2 B::SVOP METHOD
665 =head2 B::GVOP METHOD
673 =head2 B::PVOP METHOD
681 =head2 B::LOOP METHODS
693 =head2 B::COP METHODS
711 =head1 FUNCTIONS EXPORTED BY C<B>
713 The C<B> module exports a variety of functions: some are simple
714 utility functions, others provide a Perl program with a way to
715 get an initial "handle" on an internal object.
721 Return the (faked) CV corresponding to the main part of the Perl
726 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
730 Returns the root op (i.e. an object in the appropriate B::OP-derived
731 class) of the main part of the Perl program.
735 Returns the starting op of the main part of the Perl program.
739 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
743 Returns the SV object corresponding to the C variable C<sv_undef>.
747 Returns the SV object corresponding to the C variable C<sv_yes>.
751 Returns the SV object corresponding to the C variable C<sv_no>.
753 =item walkoptree(OP, METHOD)
755 Does a tree-walk of the syntax tree based at OP and calls METHOD on
756 each op it visits. Each node is visited before its children. If
757 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
758 the method C<walkoptree_debug> is called on each op before METHOD is
761 =item walkoptree_debug(DEBUG)
763 Returns the current debugging flag for C<walkoptree>. If the optional
764 DEBUG argument is non-zero, it sets the debugging flag to that. See
765 the description of C<walkoptree> above for what the debugging flag
768 =item walksymtable(SYMREF, METHOD, RECURSE)
770 Walk the symbol table starting at SYMREF and call METHOD on each
771 symbol visited. When the walk reached package symbols "Foo::" it
772 invokes RECURSE and only recurses into the package if that sub
775 =item svref_2object(SV)
777 Takes any Perl variable and turns it into an object in the
778 appropriate B::OP-derived or B::SV-derived class. Apart from functions
779 such as C<main_root>, this is the primary way to get an initial
780 "handle" on a internal perl data structure which can then be followed
781 with the other access methods.
785 Return the PP function name (e.g. "pp_add") of op number OPNUM.
789 Returns a string in the form "0x..." representing the value of the
790 internal hash function used by perl on string STR.
794 Casts I to the internal I32 type used by that perl.
799 Does the equivalent of the C<-c> command-line option. Obviously, this
800 is only useful in a BEGIN block or else the flag is set too late.
805 Returns a double-quote-surrounded escaped version of STR which can
806 be used as a string in C source code.
810 Returns the class of an object without the part of the classname
811 preceding the first "::". This is used to turn "B::UNOP" into
816 In a perl compiled for threads, this returns a list of the special
817 per-thread threadsv variables.
819 =item byteload_fh(FILEHANDLE)
821 Load the contents of FILEHANDLE as bytecode. See documentation for
822 the B<Bytecode> module in F<B::Backend> for how to generate bytecode.
828 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>