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^])/"^".
70 chr( utf8::unicode_to_native( 64 ^ ord($1) ))/e;
72 # When we say unicode_to_native we really mean ascii_to_native,
73 # which matters iff this is a non-ASCII platform (EBCDIC).
78 sub B::IV::int_value {
80 return (($self->FLAGS() & SVf_IVisUV()) ? $self->UVX : $self->IV);
88 my ($class, $value) = @_;
90 walkoptree_debug($value);
100 sub parents { \@parents }
105 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
108 sub walkoptree_slow {
109 my($op, $method, $level) = @_;
110 $op_count++; # just for statistics
112 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
113 $op->$method($level);
114 if ($$op && ($op->flags & OPf_KIDS)) {
116 unshift(@parents, $op);
117 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
118 walkoptree_slow($kid, $method, $level + 1);
125 return "Total number of OPs processed: $op_count\n";
129 my ($sec, $min, $hr) = localtime;
130 my ($user, $sys) = times;
131 sprintf("%02d:%02d:%02d user=$user sys=$sys",
132 $hr, $min, $sec, $user, $sys);
142 my ($obj, $value) = @_;
143 # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
144 $symtable{sprintf("sym_%x", $$obj)} = $value;
149 return $symtable{sprintf("sym_%x", $$obj)};
152 sub walkoptree_exec {
153 my ($op, $method, $level) = @_;
156 my $prefix = " " x $level;
157 for (; $$op; $op = $op->next) {
160 print $prefix, "goto $sym\n";
163 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
164 $op->$method($level);
167 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
169 print $prefix, uc($1), " => {\n";
170 walkoptree_exec($op->other, $method, $level + 1);
171 print $prefix, "}\n";
172 } elsif ($ppname eq "match" || $ppname eq "subst") {
173 my $pmreplstart = $op->pmreplstart;
175 print $prefix, "PMREPLSTART => {\n";
176 walkoptree_exec($pmreplstart, $method, $level + 1);
177 print $prefix, "}\n";
179 } elsif ($ppname eq "substcont") {
180 print $prefix, "SUBSTCONT => {\n";
181 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
182 print $prefix, "}\n";
184 } elsif ($ppname eq "enterloop") {
185 print $prefix, "REDO => {\n";
186 walkoptree_exec($op->redoop, $method, $level + 1);
187 print $prefix, "}\n", $prefix, "NEXT => {\n";
188 walkoptree_exec($op->nextop, $method, $level + 1);
189 print $prefix, "}\n", $prefix, "LAST => {\n";
190 walkoptree_exec($op->lastop, $method, $level + 1);
191 print $prefix, "}\n";
192 } elsif ($ppname eq "subst") {
193 my $replstart = $op->pmreplstart;
195 print $prefix, "SUBST => {\n";
196 walkoptree_exec($replstart, $method, $level + 1);
197 print $prefix, "}\n";
204 my ($symref, $method, $recurse, $prefix) = @_;
209 $prefix = '' unless defined $prefix;
210 while (($sym, $ref) = each %$symref) {
211 *glob = "*main::".$prefix.$sym;
213 $sym = $prefix . $sym;
214 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
215 walksymtable(\%glob, $method, $recurse, $sym);
218 svref_2object(\*glob)->EGV->$method();
229 my ($class, $section, $symtable, $default) = @_;
230 $output_fh ||= FileHandle->new_tmpfile;
231 my $obj = bless [-1, $section, $symtable, $default], $class;
232 $sections{$section} = $obj;
237 my ($class, $section) = @_;
238 return $sections{$section};
243 while (defined($_ = shift)) {
244 print $output_fh "$section->[1]\t$_\n";
251 return $section->[0];
256 return $section->[1];
261 return $section->[2];
266 return $section->[3];
270 my ($section, $fh, $format) = @_;
271 my $name = $section->name;
272 my $sym = $section->symtable || {};
273 my $default = $section->default;
275 seek($output_fh, 0, 0);
276 while (<$output_fh>) {
281 exists($sym->{$1}) ? $sym->{$1} : $default;
283 printf $fh $format, $_;
297 B - The Perl Compiler
305 The C<B> module supplies classes which allow a Perl program to delve
306 into its own innards. It is the module used to implement the
307 "backends" of the Perl compiler. Usage of the compiler does not
308 require knowledge of this module: see the F<O> module for the
309 user-visible part. The C<B> module is of use to those who want to
310 write new compiler backends. This documentation assumes that the
311 reader knows a fair amount about perl's internals including such
312 things as SVs, OPs and the internal symbol table and syntax tree
315 =head1 OVERVIEW OF CLASSES
317 The C structures used by Perl's internals to hold SV and OP
318 information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
319 class hierarchy and the C<B> module gives access to them via a true
320 object hierarchy. Structure fields which point to other objects
321 (whether types of SV or types of OP) are represented by the C<B>
322 module as Perl objects of the appropriate class. The bulk of the C<B>
323 module is the methods for accessing fields of these structures. Note
324 that all access is read-only: you cannot modify the internals by
327 =head2 SV-RELATED CLASSES
329 B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
330 B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
331 the obvious way to the underlying C structures of similar names. The
332 inheritance hierarchy mimics the underlying C "inheritance". Access
333 methods correspond to the underlying C macros for field access,
334 usually with the leading "class indication" prefix removed (Sv, Av,
335 Hv, ...). The leading prefix is only left in cases where its removal
336 would cause a clash in method name. For example, C<GvREFCNT> stays
337 as-is since its abbreviation would clash with the "superclass" method
338 C<REFCNT> (corresponding to the C function C<SvREFCNT>).
356 Returns the value of the IV, I<interpreted as
357 a signed integer>. This will be misleading
358 if C<FLAGS & SVf_IVisUV>. Perhaps you want the
359 C<int_value> method instead?
367 This method returns the value of the IV as an integer.
368 It differs from C<IV> in that it returns the correct
369 value regardless of whether it's stored signed or
402 This method is the one you usually want. It constructs a
403 string using the length and offset information in the struct:
404 for ordinary scalars it will return the string that you'd see
405 from Perl, even if it contains null characters.
409 This method is less often useful. It assumes that the string
410 stored in the struct is null-terminated, and disregards the
413 It is the appropriate method to use if you need to get the name
414 of a lexical variable from a padname array. Lexical variable names
415 are always stored with a null terminator, and the length field
416 (SvCUR) is overloaded for other purposes and can't be relied on here.
420 =head2 B::PVMG METHODS
430 =head2 B::MAGIC METHODS
448 =head2 B::PVLV METHODS
482 This method returns TRUE if the GP field of the GV is NULL.
488 This method returns the name of the glob, but if the first
489 character of the name is a control character, then it converts
490 it to ^X first, so that *^G would return "^G" rather than "\cG".
492 It's useful if you want to print out the name of a variable.
493 If you restrict yourself to globs which exist at compile-time
494 then the result ought to be unambiguous, because code like
495 C<${"^G"} = 1> is compiled as two ops - a constant string and
496 a dereference (rv2gv) - so that the glob is created at runtime.
498 If you're working with globs at runtime, and need to disambiguate
499 *^G from *{"^G"}, then you should use the raw NAME method.
629 =head2 OP-RELATED CLASSES
631 B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
632 B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
633 These classes correspond in
634 the obvious way to the underlying C structures of similar names. The
635 inheritance hierarchy mimics the underlying C "inheritance". Access
636 methods correspond to the underlying C structre field names, with the
637 leading "class indication" prefix removed (op_).
649 This returns the op name as a string (e.g. "add", "rv2av").
653 This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
654 "PL_ppaddr[OP_RV2AV]").
658 This returns the op description from the global C PL_op_desc array
659 (e.g. "addition" "array deref").
673 =head2 B::UNOP METHOD
681 =head2 B::BINOP METHOD
689 =head2 B::LOGOP METHOD
697 =head2 B::LISTOP METHOD
705 =head2 B::PMOP METHODS
725 =head2 B::SVOP METHOD
735 =head2 B::PADOP METHOD
743 =head2 B::PVOP METHOD
751 =head2 B::LOOP METHODS
763 =head2 B::COP METHODS
781 =head1 FUNCTIONS EXPORTED BY C<B>
783 The C<B> module exports a variety of functions: some are simple
784 utility functions, others provide a Perl program with a way to
785 get an initial "handle" on an internal object.
791 Return the (faked) CV corresponding to the main part of the Perl
796 Returns the AV object (i.e. in class B::AV) representing INIT blocks.
800 Returns the root op (i.e. an object in the appropriate B::OP-derived
801 class) of the main part of the Perl program.
805 Returns the starting op of the main part of the Perl program.
809 Returns the AV object (i.e. in class B::AV) of the global comppadlist.
813 Returns the SV object corresponding to the C variable C<sv_undef>.
817 Returns the SV object corresponding to the C variable C<sv_yes>.
821 Returns the SV object corresponding to the C variable C<sv_no>.
823 =item amagic_generation
825 Returns the SV object corresponding to the C variable C<amagic_generation>.
827 =item walkoptree(OP, METHOD)
829 Does a tree-walk of the syntax tree based at OP and calls METHOD on
830 each op it visits. Each node is visited before its children. If
831 C<walkoptree_debug> (q.v.) has been called to turn debugging on then
832 the method C<walkoptree_debug> is called on each op before METHOD is
835 =item walkoptree_debug(DEBUG)
837 Returns the current debugging flag for C<walkoptree>. If the optional
838 DEBUG argument is non-zero, it sets the debugging flag to that. See
839 the description of C<walkoptree> above for what the debugging flag
842 =item walksymtable(SYMREF, METHOD, RECURSE)
844 Walk the symbol table starting at SYMREF and call METHOD on each
845 symbol visited. When the walk reached package symbols "Foo::" it
846 invokes RECURSE and only recurses into the package if that sub
849 =item svref_2object(SV)
851 Takes any Perl variable and turns it into an object in the
852 appropriate B::OP-derived or B::SV-derived class. Apart from functions
853 such as C<main_root>, this is the primary way to get an initial
854 "handle" on a internal perl data structure which can then be followed
855 with the other access methods.
859 Return the PP function name (e.g. "pp_add") of op number OPNUM.
863 Returns a string in the form "0x..." representing the value of the
864 internal hash function used by perl on string STR.
868 Casts I to the internal I32 type used by that perl.
873 Does the equivalent of the C<-c> command-line option. Obviously, this
874 is only useful in a BEGIN block or else the flag is set too late.
879 Returns a double-quote-surrounded escaped version of STR which can
880 be used as a string in C source code.
884 Returns the class of an object without the part of the classname
885 preceding the first "::". This is used to turn "B::UNOP" into
890 In a perl compiled for threads, this returns a list of the special
891 per-thread threadsv variables.
897 Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>