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);
69 # add to .xs for perl5.002
79 sub parents { \@parents }
84 return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
88 my($op, $method, $level) = @_;
89 $op_count++; # just for statistics
91 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
93 if ($$op && ($op->flags & OPf_KIDS)) {
95 unshift(@parents, $op);
96 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
97 walkoptree_slow($kid, $method, $level + 1);
104 return "Total number of OPs processed: $op_count\n";
108 my ($sec, $min, $hr) = localtime;
109 my ($user, $sys) = times;
110 sprintf("%02d:%02d:%02d user=$user sys=$sys",
111 $hr, $min, $sec, $user, $sys);
116 my ($obj, $value) = @_;
117 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
118 $symtable{sprintf("sym_%x", $$obj)} = $value;
123 return $symtable{sprintf("sym_%x", $$obj)};
126 sub walkoptree_exec {
127 my ($op, $method, $level) = @_;
129 my $prefix = " " x $level;
130 for (; $$op; $op = $op->next) {
133 print $prefix, "goto $sym\n";
136 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
137 $op->$method($level);
138 $ppname = $op->ppaddr;
139 if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
140 print $prefix, uc($1), " => {\n";
141 walkoptree_exec($op->other, $method, $level + 1);
142 print $prefix, "}\n";
143 } elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
144 my $pmreplstart = $op->pmreplstart;
146 print $prefix, "PMREPLSTART => {\n";
147 walkoptree_exec($pmreplstart, $method, $level + 1);
148 print $prefix, "}\n";
150 } elsif ($ppname eq "pp_substcont") {
151 print $prefix, "SUBSTCONT => {\n";
152 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
153 print $prefix, "}\n";
155 } elsif ($ppname eq "pp_cond_expr") {
156 # pp_cond_expr never returns op_next
157 print $prefix, "TRUE => {\n";
158 walkoptree_exec($op->true, $method, $level + 1);
159 print $prefix, "}\n";
162 } elsif ($ppname eq "pp_range") {
163 print $prefix, "TRUE => {\n";
164 walkoptree_exec($op->true, $method, $level + 1);
165 print $prefix, "}\n", $prefix, "FALSE => {\n";
166 walkoptree_exec($op->false, $method, $level + 1);
167 print $prefix, "}\n";
168 } elsif ($ppname eq "pp_enterloop") {
169 print $prefix, "REDO => {\n";
170 walkoptree_exec($op->redoop, $method, $level + 1);
171 print $prefix, "}\n", $prefix, "NEXT => {\n";
172 walkoptree_exec($op->nextop, $method, $level + 1);
173 print $prefix, "}\n", $prefix, "LAST => {\n";
174 walkoptree_exec($op->lastop, $method, $level + 1);
175 print $prefix, "}\n";
176 } elsif ($ppname eq "pp_subst") {
177 my $replstart = $op->pmreplstart;
179 print $prefix, "SUBST => {\n";
180 walkoptree_exec($replstart, $method, $level + 1);
181 print $prefix, "}\n";
188 my ($symref, $method, $recurse, $prefix) = @_;
193 $prefix = '' unless defined $prefix;
194 while (($sym, $ref) = each %$symref) {
197 $sym = $prefix . $sym;
198 if ($sym ne "main::" && &$recurse($sym)) {
199 walksymtable(\%glob, $method, $recurse, $sym);
202 svref_2object(\*glob)->EGV->$method();
213 my ($class, $section, $symtable, $default) = @_;
214 $output_fh ||= FileHandle->new_tmpfile;
215 my $obj = bless [-1, $section, $symtable, $default], $class;
216 $sections{$section} = $obj;
221 my ($class, $section) = @_;
222 return $sections{$section};
227 while (defined($_ = shift)) {
228 print $output_fh "$section->[1]\t$_\n";
235 return $section->[0];
240 return $section->[1];
245 return $section->[2];
250 return $section->[3];
254 my ($section, $fh, $format) = @_;
255 my $name = $section->name;
256 my $sym = $section->symtable || {};
257 my $default = $section->default;
259 seek($output_fh, 0, 0);
260 while (<$output_fh>) {
265 exists($sym->{$1}) ? $sym->{$1} : $default;
267 printf $fh $format, $_;
281 B - The Perl Compiler
289 The C<B> module supplies classes which allow a Perl program to delve
290 into its own innards. It is the module used to implement the
291 "backends" of the Perl compiler. Usage of the compiler does not
292 require knowledge of this module: see the F<O> module for the
293 user-visible part. The C<B> module is of use to those who want to
294 write new compiler backends. This documentation assumes that the
295 reader knows a fair amount about perl's internals including such
296 things as SVs, OPs and the internal symbol table and syntax tree
299 =head1 OVERVIEW OF CLASSES
301 The C structures used by Perl's internals to hold SV and OP
302 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
303 class hierarchy and the C<B> module gives access to them via a true
304 object hierarchy. Structure fields which point to other objects
305 (whether types of SV or types of OP) are represented by the C<B>
306 module as Perl objects of the appropriate class. The bulk of the C<B>
307 module is the methods for accessing fields of these structures. Note
308 that all access is read-only: you cannot modify the internals by
311 =head2 SV-RELATED CLASSES
313 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
314 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
315 the obvious way to the underlying C structures of similar names. The
316 inheritance hierarchy mimics the underlying C "inheritance". Access
317 methods correspond to the underlying C macros for field access,
318 usually with the leading "class indication" prefix removed (Sv, Av,
319 Hv, ...). The leading prefix is only left in cases where its removal
320 would cause a clash in method name. For example, C<GvREFCNT> stays
321 as-is since its abbreviation would clash with the "superclass" method
322 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
374 =head2 B::PVMG METHODS
384 =head2 B::MAGIC METHODS
402 =head2 B::PVLV METHODS
560 =head2 OP-RELATED CLASSES
562 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::CONDOP, B::LISTOP, B::PMOP,
563 B::SVOP, B::GVOP, 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 function name as a string (e.g. pp_add, pp_rv2av).
584 This returns the op description from the global C PL_op_desc array
585 (e.g. "addition" "array deref").
599 =head2 B::UNOP METHOD
607 =head2 B::BINOP METHOD
615 =head2 B::LOGOP METHOD
623 =head2 B::CONDOP METHODS
633 =head2 B::LISTOP METHOD
641 =head2 B::PMOP METHODS
661 =head2 B::SVOP METHOD
669 =head2 B::GVOP 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 walkoptree(OP, METHOD)
759 Does a tree-walk of the syntax tree based at OP and calls METHOD on
760 each op it visits. Each node is visited before its children. If
761 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
762 the method C<walkoptree_debug> is called on each op before METHOD is
765 =item walkoptree_debug(DEBUG)
767 Returns the current debugging flag for C<walkoptree>. If the optional
768 DEBUG argument is non-zero, it sets the debugging flag to that. See
769 the description of C<walkoptree> above for what the debugging flag
772 =item walksymtable(SYMREF, METHOD, RECURSE)
774 Walk the symbol table starting at SYMREF and call METHOD on each
775 symbol visited. When the walk reached package symbols "Foo::" it
776 invokes RECURSE and only recurses into the package if that sub
779 =item svref_2object(SV)
781 Takes any Perl variable and turns it into an object in the
782 appropriate B::OP-derived or B::SV-derived class. Apart from functions
783 such as C<main_root>, this is the primary way to get an initial
784 "handle" on a internal perl data structure which can then be followed
785 with the other access methods.
789 Return the PP function name (e.g. "pp_add") of op number OPNUM.
793 Returns a string in the form "0x..." representing the value of the
794 internal hash function used by perl on string STR.
798 Casts I to the internal I32 type used by that perl.
803 Does the equivalent of the C<-c> command-line option. Obviously, this
804 is only useful in a BEGIN block or else the flag is set too late.
809 Returns a double-quote-surrounded escaped version of STR which can
810 be used as a string in C source code.
814 Returns the class of an object without the part of the classname
815 preceding the first "::". This is used to turn "B::UNOP" into
820 In a perl compiled for threads, this returns a list of the special
821 per-thread threadsv variables.
823 =item byteload_fh(FILEHANDLE)
825 Load the contents of FILEHANDLE as bytecode. See documentation for
826 the B<Bytecode> module in F<B::Backend> for how to generate bytecode.
832 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>