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
64 my $name = (shift())->NAME;
66 # The regex below corresponds to the isCONTROLVAR macro
69 $name =~ s/^([\cA-\cZ\c\\c[\c]\c?\c_\c^])/"^".chr(64 ^ ord($1))/e;
73 sub B::IV::int_value {
75 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
83 my ($class, $value) = @_;
85 walkoptree_debug($value);
95 sub parents { \@parents }
100 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
103 sub walkoptree_slow {
104 my($op, $method, $level) = @_;
105 $op_count++; # just for statistics
107 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
108 $op->$method($level);
109 if ($$op && ($op->flags & OPf_KIDS)) {
111 unshift(@parents, $op);
112 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
113 walkoptree_slow($kid, $method, $level + 1);
120 return "Total number of OPs processed: $op_count\n";
124 my ($sec, $min, $hr) = localtime;
125 my ($user, $sys) = times;
126 sprintf("%02d:%02d:%02d user=$user sys=$sys",
127 $hr, $min, $sec, $user, $sys);
137 my ($obj, $value) = @_;
138 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
139 $symtable{sprintf("sym_%x", $$obj)} = $value;
144 return $symtable{sprintf("sym_%x", $$obj)};
147 sub walkoptree_exec {
148 my ($op, $method, $level) = @_;
151 my $prefix = " " x $level;
152 for (; $$op; $op = $op->next) {
155 print $prefix, "goto $sym\n";
158 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
159 $op->$method($level);
162 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
164 print $prefix, uc($1), " => {\n";
165 walkoptree_exec($op->other, $method, $level + 1);
166 print $prefix, "}\n";
167 } elsif ($ppname eq "match" || $ppname eq "subst") {
168 my $pmreplstart = $op->pmreplstart;
170 print $prefix, "PMREPLSTART => {\n";
171 walkoptree_exec($pmreplstart, $method, $level + 1);
172 print $prefix, "}\n";
174 } elsif ($ppname eq "substcont") {
175 print $prefix, "SUBSTCONT => {\n";
176 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
177 print $prefix, "}\n";
179 } elsif ($ppname eq "enterloop") {
180 print $prefix, "REDO => {\n";
181 walkoptree_exec($op->redoop, $method, $level + 1);
182 print $prefix, "}\n", $prefix, "NEXT => {\n";
183 walkoptree_exec($op->nextop, $method, $level + 1);
184 print $prefix, "}\n", $prefix, "LAST => {\n";
185 walkoptree_exec($op->lastop, $method, $level + 1);
186 print $prefix, "}\n";
187 } elsif ($ppname eq "subst") {
188 my $replstart = $op->pmreplstart;
190 print $prefix, "SUBST => {\n";
191 walkoptree_exec($replstart, $method, $level + 1);
192 print $prefix, "}\n";
199 my ($symref, $method, $recurse, $prefix) = @_;
204 $prefix = '' unless defined $prefix;
205 while (($sym, $ref) = each %$symref) {
206 *glob = "*main::".$prefix.$sym;
208 $sym = $prefix . $sym;
209 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
210 walksymtable(\%glob, $method, $recurse, $sym);
213 svref_2object(\*glob)->EGV->$method();
224 my ($class, $section, $symtable, $default) = @_;
225 $output_fh ||= FileHandle->new_tmpfile;
226 my $obj = bless [-1, $section, $symtable, $default], $class;
227 $sections{$section} = $obj;
232 my ($class, $section) = @_;
233 return $sections{$section};
238 while (defined($_ = shift)) {
239 print $output_fh "$section->[1]\t$_\n";
246 return $section->[0];
251 return $section->[1];
256 return $section->[2];
261 return $section->[3];
265 my ($section, $fh, $format) = @_;
266 my $name = $section->name;
267 my $sym = $section->symtable || {};
268 my $default = $section->default;
270 seek($output_fh, 0, 0);
271 while (<$output_fh>) {
276 exists($sym->{$1}) ? $sym->{$1} : $default;
278 printf $fh $format, $_;
292 B - The Perl Compiler
300 The C<B> module supplies classes which allow a Perl program to delve
301 into its own innards. It is the module used to implement the
302 "backends" of the Perl compiler. Usage of the compiler does not
303 require knowledge of this module: see the F<O> module for the
304 user-visible part. The C<B> module is of use to those who want to
305 write new compiler backends. This documentation assumes that the
306 reader knows a fair amount about perl's internals including such
307 things as SVs, OPs and the internal symbol table and syntax tree
310 =head1 OVERVIEW OF CLASSES
312 The C structures used by Perl's internals to hold SV and OP
313 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
314 class hierarchy and the C<B> module gives access to them via a true
315 object hierarchy. Structure fields which point to other objects
316 (whether types of SV or types of OP) are represented by the C<B>
317 module as Perl objects of the appropriate class. The bulk of the C<B>
318 module is the methods for accessing fields of these structures. Note
319 that all access is read-only: you cannot modify the internals by
322 =head2 SV-RELATED CLASSES
324 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
325 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
326 the obvious way to the underlying C structures of similar names. The
327 inheritance hierarchy mimics the underlying C "inheritance". Access
328 methods correspond to the underlying C macros for field access,
329 usually with the leading "class indication" prefix removed (Sv, Av,
330 Hv, ...). The leading prefix is only left in cases where its removal
331 would cause a clash in method name. For example, C<GvREFCNT> stays
332 as-is since its abbreviation would clash with the "superclass" method
333 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
351 Returns the value of the IV, I<interpreted as
352 a signed integer>. This will be misleading
353 if C<FLAGS & SVf_IVisUV>. Perhaps you want the
354 C<int_value> method instead?
362 This method returns the value of the IV as an integer.
363 It differs from C<IV> in that it returns the correct
364 value regardless of whether it's stored signed or
397 This method is the one you usually want. It constructs a
398 string using the length and offset information in the struct:
399 for ordinary scalars it will return the string that you'd see
400 from Perl, even if it contains null characters.
404 This method is less often useful. It assumes that the string
405 stored in the struct is null-terminated, and disregards the
408 It is the appropriate method to use if you need to get the name
409 of a lexical variable from a padname array. Lexical variable names
410 are always stored with a null terminator, and the length field
411 (SvCUR) is overloaded for other purposes and can't be relied on here.
415 =head2 B::PVMG METHODS
425 =head2 B::MAGIC METHODS
443 =head2 B::PVLV METHODS
477 This method returns TRUE if the GP field of the GV is NULL.
483 This method returns the name of the glob, but if the first
484 character of the name is a control character, then it converts
485 it to ^X first, so that *^G would return "^G" rather than "\cG".
487 It's useful if you want to print out the name of a variable.
488 If you restrict yourself to globs which exist at compile-time
489 then the result ought to be unambiguous, because code like
490 C<${"^G"} = 1> is compiled as two ops - a constant string and
491 a dereference (rv2gv) - so that the glob is created at runtime.
493 If you're working with globs at runtime, and need to disambiguate
494 *^G from *{"^G"}, then you should use the raw NAME method.
624 =head2 OP-RELATED CLASSES
626 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
627 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
628 These classes correspond in
629 the obvious way to the underlying C structures of similar names. The
630 inheritance hierarchy mimics the underlying C "inheritance". Access
631 methods correspond to the underlying C structre field names, with the
632 leading "class indication" prefix removed (op_).
644 This returns the op name as a string (e.g. "add", "rv2av").
648 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
649 "PL_ppaddr[OP_RV2AV]").
653 This returns the op description from the global C PL_op_desc array
654 (e.g. "addition" "array deref").
668 =head2 B::UNOP METHOD
676 =head2 B::BINOP METHOD
684 =head2 B::LOGOP METHOD
692 =head2 B::LISTOP METHOD
700 =head2 B::PMOP METHODS
720 =head2 B::SVOP METHOD
730 =head2 B::PADOP METHOD
738 =head2 B::PVOP METHOD
746 =head2 B::LOOP METHODS
758 =head2 B::COP METHODS
776 =head1 FUNCTIONS EXPORTED BY C<B>
778 The C<B> module exports a variety of functions: some are simple
779 utility functions, others provide a Perl program with a way to
780 get an initial "handle" on an internal object.
786 Return the (faked) CV corresponding to the main part of the Perl
791 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
795 Returns the root op (i.e. an object in the appropriate B::OP-derived
796 class) of the main part of the Perl program.
800 Returns the starting op of the main part of the Perl program.
804 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
808 Returns the SV object corresponding to the C variable C<sv_undef>.
812 Returns the SV object corresponding to the C variable C<sv_yes>.
816 Returns the SV object corresponding to the C variable C<sv_no>.
818 =item amagic_generation
820 Returns the SV object corresponding to the C variable C<amagic_generation>.
822 =item walkoptree(OP, METHOD)
824 Does a tree-walk of the syntax tree based at OP and calls METHOD on
825 each op it visits. Each node is visited before its children. If
826 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
827 the method C<walkoptree_debug> is called on each op before METHOD is
830 =item walkoptree_debug(DEBUG)
832 Returns the current debugging flag for C<walkoptree>. If the optional
833 DEBUG argument is non-zero, it sets the debugging flag to that. See
834 the description of C<walkoptree> above for what the debugging flag
837 =item walksymtable(SYMREF, METHOD, RECURSE)
839 Walk the symbol table starting at SYMREF and call METHOD on each
840 symbol visited. When the walk reached package symbols "Foo::" it
841 invokes RECURSE and only recurses into the package if that sub
844 =item svref_2object(SV)
846 Takes any Perl variable and turns it into an object in the
847 appropriate B::OP-derived or B::SV-derived class. Apart from functions
848 such as C<main_root>, this is the primary way to get an initial
849 "handle" on a internal perl data structure which can then be followed
850 with the other access methods.
854 Return the PP function name (e.g. "pp_add") of op number OPNUM.
858 Returns a string in the form "0x..." representing the value of the
859 internal hash function used by perl on string STR.
863 Casts I to the internal I32 type used by that perl.
868 Does the equivalent of the C<-c> command-line option. Obviously, this
869 is only useful in a BEGIN block or else the flag is set too late.
874 Returns a double-quote-surrounded escaped version of STR which can
875 be used as a string in C source code.
879 Returns the class of an object without the part of the classname
880 preceding the first "::". This is used to turn "B::UNOP" into
885 In a perl compiled for threads, this returns a list of the special
886 per-thread threadsv variables.
892 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>