This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Integrate mainline
[perl5.git] / ext / B / B.pm
CommitLineData
a798dbf2
MB
1# B.pm
2#
1a52ab62 3# Copyright (c) 1996, 1997, 1998 Malcolm Beattie
a798dbf2
MB
4#
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.
7#
8package B;
9426adcd 9use XSLoader ();
a798dbf2 10require Exporter;
9426adcd 11@ISA = qw(Exporter);
360eb788
NIS
12
13# walkoptree comes from B.pm (you are there), walkoptree comes from B.xs
f6c2d85b
JH
14@EXPORT_OK = qw(minus_c ppname save_BEGINs
15 class peekop cast_I32 cstring cchar hash threadsv_names
360eb788
NIS
16 main_root main_start main_cv svref_2object opnumber
17 amagic_generation
f6c2d85b
JH
18 walkoptree_slow walkoptree walkoptree_exec walksymtable
19 parents comppadlist sv_undef compile_stats timing_info
20 begin_av init_av end_av);
360eb788 21
4c1f658f 22sub OPf_KIDS ();
a798dbf2
MB
23use strict;
24@B::SV::ISA = 'B::OBJECT';
25@B::NULL::ISA = 'B::SV';
26@B::PV::ISA = 'B::SV';
27@B::IV::ISA = 'B::SV';
28@B::NV::ISA = 'B::IV';
29@B::RV::ISA = 'B::SV';
30@B::PVIV::ISA = qw(B::PV B::IV);
31@B::PVNV::ISA = qw(B::PV B::NV);
32@B::PVMG::ISA = 'B::PVNV';
33@B::PVLV::ISA = 'B::PVMG';
34@B::BM::ISA = 'B::PVMG';
35@B::AV::ISA = 'B::PVMG';
36@B::GV::ISA = 'B::PVMG';
37@B::HV::ISA = 'B::PVMG';
38@B::CV::ISA = 'B::PVMG';
276493cb
SM
39@B::IO::ISA = 'B::PVMG';
40@B::FM::ISA = 'B::CV';
a798dbf2
MB
41
42@B::OP::ISA = 'B::OBJECT';
43@B::UNOP::ISA = 'B::OP';
44@B::BINOP::ISA = 'B::UNOP';
45@B::LOGOP::ISA = 'B::UNOP';
a798dbf2
MB
46@B::LISTOP::ISA = 'B::BINOP';
47@B::SVOP::ISA = 'B::OP';
7934575e 48@B::PADOP::ISA = 'B::OP';
a798dbf2
MB
49@B::PVOP::ISA = 'B::OP';
50@B::CVOP::ISA = 'B::OP';
51@B::LOOP::ISA = 'B::LISTOP';
52@B::PMOP::ISA = 'B::LISTOP';
53@B::COP::ISA = 'B::OP';
54
55@B::SPECIAL::ISA = 'B::OBJECT';
56
57{
58 # Stop "-w" from complaining about the lack of a real B::OBJECT class
59 package B::OBJECT;
60}
61
62my $debug;
63my $op_count = 0;
64my @parents = ();
65
66sub debug {
67 my ($class, $value) = @_;
68 $debug = $value;
69 walkoptree_debug($value);
70}
71
a798dbf2
MB
72sub class {
73 my $obj = shift;
74 my $name = ref $obj;
75 $name =~ s/^.*:://;
76 return $name;
77}
78
79sub parents { \@parents }
80
81# For debugging
82sub peekop {
83 my $op = shift;
3f872cb9 84 return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
a798dbf2
MB
85}
86
360eb788 87sub walkoptree_slow {
a798dbf2
MB
88 my($op, $method, $level) = @_;
89 $op_count++; # just for statistics
90 $level ||= 0;
91 warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
92 $op->$method($level);
93 if ($$op && ($op->flags & OPf_KIDS)) {
94 my $kid;
95 unshift(@parents, $op);
96 for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
360eb788 97 walkoptree_slow($kid, $method, $level + 1);
a798dbf2
MB
98 }
99 shift @parents;
100 }
101}
102
103sub compile_stats {
104 return "Total number of OPs processed: $op_count\n";
105}
106
107sub timing_info {
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);
112}
113
114my %symtable;
2b8dc4d2
DM
115
116sub clearsym {
117 %symtable = ();
118}
119
a798dbf2
MB
120sub savesym {
121 my ($obj, $value) = @_;
122# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
123 $symtable{sprintf("sym_%x", $$obj)} = $value;
124}
125
126sub objsym {
127 my $obj = shift;
128 return $symtable{sprintf("sym_%x", $$obj)};
129}
130
131sub walkoptree_exec {
132 my ($op, $method, $level) = @_;
133 my ($sym, $ppname);
134 my $prefix = " " x $level;
135 for (; $$op; $op = $op->next) {
136 $sym = objsym($op);
137 if (defined($sym)) {
138 print $prefix, "goto $sym\n";
139 return;
140 }
141 savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
142 $op->$method($level);
3f872cb9 143 $ppname = $op->name;
1a67a97c 144 if ($ppname =~
3f872cb9 145 /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
1a67a97c 146 {
a798dbf2
MB
147 print $prefix, uc($1), " => {\n";
148 walkoptree_exec($op->other, $method, $level + 1);
149 print $prefix, "}\n";
3f872cb9 150 } elsif ($ppname eq "match" || $ppname eq "subst") {
a798dbf2
MB
151 my $pmreplstart = $op->pmreplstart;
152 if ($$pmreplstart) {
153 print $prefix, "PMREPLSTART => {\n";
154 walkoptree_exec($pmreplstart, $method, $level + 1);
155 print $prefix, "}\n";
156 }
3f872cb9 157 } elsif ($ppname eq "substcont") {
a798dbf2
MB
158 print $prefix, "SUBSTCONT => {\n";
159 walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
160 print $prefix, "}\n";
161 $op = $op->other;
3f872cb9 162 } elsif ($ppname eq "enterloop") {
a798dbf2
MB
163 print $prefix, "REDO => {\n";
164 walkoptree_exec($op->redoop, $method, $level + 1);
165 print $prefix, "}\n", $prefix, "NEXT => {\n";
166 walkoptree_exec($op->nextop, $method, $level + 1);
167 print $prefix, "}\n", $prefix, "LAST => {\n";
168 walkoptree_exec($op->lastop, $method, $level + 1);
169 print $prefix, "}\n";
3f872cb9 170 } elsif ($ppname eq "subst") {
a798dbf2
MB
171 my $replstart = $op->pmreplstart;
172 if ($$replstart) {
173 print $prefix, "SUBST => {\n";
174 walkoptree_exec($replstart, $method, $level + 1);
175 print $prefix, "}\n";
176 }
177 }
178 }
179}
180
181sub walksymtable {
182 my ($symref, $method, $recurse, $prefix) = @_;
183 my $sym;
0cc1d052 184 my $ref;
a798dbf2
MB
185 no strict 'vars';
186 local(*glob);
0cc1d052
NIS
187 $prefix = '' unless defined $prefix;
188 while (($sym, $ref) = each %$symref) {
8bac7e00 189 *glob = "*main::".$prefix.$sym;
a798dbf2
MB
190 if ($sym =~ /::$/) {
191 $sym = $prefix . $sym;
b4e94495 192 if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
a798dbf2
MB
193 walksymtable(\%glob, $method, $recurse, $sym);
194 }
195 } else {
196 svref_2object(\*glob)->EGV->$method();
197 }
198 }
199}
200
201{
202 package B::Section;
203 my $output_fh;
204 my %sections;
205
206 sub new {
207 my ($class, $section, $symtable, $default) = @_;
208 $output_fh ||= FileHandle->new_tmpfile;
209 my $obj = bless [-1, $section, $symtable, $default], $class;
210 $sections{$section} = $obj;
211 return $obj;
212 }
213
214 sub get {
215 my ($class, $section) = @_;
216 return $sections{$section};
217 }
218
219 sub add {
220 my $section = shift;
221 while (defined($_ = shift)) {
222 print $output_fh "$section->[1]\t$_\n";
223 $section->[0]++;
224 }
225 }
226
227 sub index {
228 my $section = shift;
229 return $section->[0];
230 }
231
232 sub name {
233 my $section = shift;
234 return $section->[1];
235 }
236
237 sub symtable {
238 my $section = shift;
239 return $section->[2];
240 }
241
242 sub default {
243 my $section = shift;
244 return $section->[3];
245 }
246
247 sub output {
248 my ($section, $fh, $format) = @_;
249 my $name = $section->name;
250 my $sym = $section->symtable || {};
251 my $default = $section->default;
252
253 seek($output_fh, 0, 0);
254 while (<$output_fh>) {
255 chomp;
256 s/^(.*?)\t//;
257 if ($1 eq $name) {
258 s{(s\\_[0-9a-f]+)} {
259 exists($sym->{$1}) ? $sym->{$1} : $default;
260 }ge;
261 printf $fh $format, $_;
262 }
263 }
264 }
265}
266
9426adcd 267XSLoader::load 'B';
a798dbf2
MB
268
2691;
7f20e9dd
GS
270
271__END__
272
273=head1 NAME
274
275B - The Perl Compiler
276
277=head1 SYNOPSIS
278
279 use B;
280
281=head1 DESCRIPTION
282
1a52ab62
MB
283The C<B> module supplies classes which allow a Perl program to delve
284into its own innards. It is the module used to implement the
285"backends" of the Perl compiler. Usage of the compiler does not
286require knowledge of this module: see the F<O> module for the
287user-visible part. The C<B> module is of use to those who want to
288write new compiler backends. This documentation assumes that the
289reader knows a fair amount about perl's internals including such
290things as SVs, OPs and the internal symbol table and syntax tree
291of a program.
292
293=head1 OVERVIEW OF CLASSES
294
295The C structures used by Perl's internals to hold SV and OP
296information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
297class hierarchy and the C<B> module gives access to them via a true
298object hierarchy. Structure fields which point to other objects
299(whether types of SV or types of OP) are represented by the C<B>
300module as Perl objects of the appropriate class. The bulk of the C<B>
301module is the methods for accessing fields of these structures. Note
302that all access is read-only: you cannot modify the internals by
303using this module.
304
305=head2 SV-RELATED CLASSES
306
307B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
308B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
309the obvious way to the underlying C structures of similar names. The
310inheritance hierarchy mimics the underlying C "inheritance". Access
311methods correspond to the underlying C macros for field access,
312usually with the leading "class indication" prefix removed (Sv, Av,
313Hv, ...). The leading prefix is only left in cases where its removal
314would cause a clash in method name. For example, C<GvREFCNT> stays
315as-is since its abbreviation would clash with the "superclass" method
316C<REFCNT> (corresponding to the C function C<SvREFCNT>).
317
318=head2 B::SV METHODS
319
320=over 4
321
322=item REFCNT
323
324=item FLAGS
325
326=back
327
328=head2 B::IV METHODS
329
330=over 4
331
332=item IV
333
334=item IVX
335
336=item needs64bits
337
338=item packiv
339
340=back
341
342=head2 B::NV METHODS
343
344=over 4
345
346=item NV
347
348=item NVX
349
350=back
351
352=head2 B::RV METHODS
353
354=over 4
355
356=item RV
357
358=back
359
360=head2 B::PV METHODS
361
362=over 4
363
364=item PV
365
366=back
367
368=head2 B::PVMG METHODS
369
370=over 4
371
372=item MAGIC
373
374=item SvSTASH
375
376=back
377
378=head2 B::MAGIC METHODS
379
380=over 4
381
382=item MOREMAGIC
383
384=item PRIVATE
385
386=item TYPE
387
388=item FLAGS
389
390=item OBJ
391
392=item PTR
393
394=back
395
396=head2 B::PVLV METHODS
397
398=over 4
399
400=item TARGOFF
401
402=item TARGLEN
403
404=item TYPE
405
406=item TARG
407
408=back
409
410=head2 B::BM METHODS
411
412=over 4
413
414=item USEFUL
415
416=item PREVIOUS
417
418=item RARE
419
420=item TABLE
421
422=back
423
424=head2 B::GV METHODS
425
426=over 4
427
87d7fd28
GS
428=item is_empty
429
430This method returns TRUE if the GP field of the GV is NULL.
431
1a52ab62
MB
432=item NAME
433
434=item STASH
435
436=item SV
437
438=item IO
439
440=item FORM
441
442=item AV
443
444=item HV
445
446=item EGV
447
448=item CV
449
450=item CVGEN
451
452=item LINE
453
b195d487
GS
454=item FILE
455
1a52ab62
MB
456=item FILEGV
457
458=item GvREFCNT
459
460=item FLAGS
461
462=back
463
464=head2 B::IO METHODS
465
466=over 4
467
468=item LINES
469
470=item PAGE
471
472=item PAGE_LEN
473
474=item LINES_LEFT
475
476=item TOP_NAME
477
478=item TOP_GV
479
480=item FMT_NAME
481
482=item FMT_GV
483
484=item BOTTOM_NAME
485
486=item BOTTOM_GV
487
488=item SUBPROCESS
489
490=item IoTYPE
491
492=item IoFLAGS
493
494=back
495
496=head2 B::AV METHODS
497
498=over 4
499
500=item FILL
501
502=item MAX
503
504=item OFF
505
506=item ARRAY
507
508=item AvFLAGS
509
510=back
511
512=head2 B::CV METHODS
513
514=over 4
515
516=item STASH
517
518=item START
519
520=item ROOT
521
522=item GV
523
57843af0
GS
524=item FILE
525
1a52ab62
MB
526=item DEPTH
527
528=item PADLIST
529
530=item OUTSIDE
531
532=item XSUB
533
534=item XSUBANY
535
5cfd8ad4
VB
536=item CvFLAGS
537
de3f1649
JT
538=item const_sv
539
1a52ab62
MB
540=back
541
542=head2 B::HV METHODS
543
544=over 4
545
546=item FILL
547
548=item MAX
549
550=item KEYS
551
552=item RITER
553
554=item NAME
555
556=item PMROOT
557
558=item ARRAY
559
560=back
561
562=head2 OP-RELATED CLASSES
563
1a67a97c 564B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
7934575e 565B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
1a52ab62
MB
566These classes correspond in
567the obvious way to the underlying C structures of similar names. The
568inheritance hierarchy mimics the underlying C "inheritance". Access
569methods correspond to the underlying C structre field names, with the
570leading "class indication" prefix removed (op_).
571
572=head2 B::OP METHODS
573
574=over 4
575
576=item next
577
578=item sibling
579
3f872cb9
GS
580=item name
581
582This returns the op name as a string (e.g. "add", "rv2av").
583
1a52ab62
MB
584=item ppaddr
585
dc333d64
GS
586This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
587"PL_ppaddr[OP_RV2AV]").
1a52ab62
MB
588
589=item desc
590
4369b173 591This returns the op description from the global C PL_op_desc array
1a52ab62
MB
592(e.g. "addition" "array deref").
593
594=item targ
595
596=item type
597
598=item seq
599
600=item flags
601
602=item private
603
604=back
605
606=head2 B::UNOP METHOD
607
608=over 4
609
610=item first
611
612=back
613
614=head2 B::BINOP METHOD
615
616=over 4
617
618=item last
619
620=back
621
622=head2 B::LOGOP METHOD
623
624=over 4
625
626=item other
627
628=back
629
1a52ab62
MB
630=head2 B::LISTOP METHOD
631
632=over 4
633
634=item children
635
636=back
637
638=head2 B::PMOP METHODS
639
640=over 4
641
642=item pmreplroot
643
644=item pmreplstart
645
646=item pmnext
647
648=item pmregexp
649
650=item pmflags
651
652=item pmpermflags
653
654=item precomp
655
656=back
657
658=head2 B::SVOP METHOD
659
660=over 4
661
662=item sv
663
065a1863
GS
664=item gv
665
1a52ab62
MB
666=back
667
7934575e 668=head2 B::PADOP METHOD
1a52ab62
MB
669
670=over 4
671
7934575e 672=item padix
1a52ab62
MB
673
674=back
675
676=head2 B::PVOP METHOD
677
678=over 4
679
680=item pv
681
682=back
683
684=head2 B::LOOP METHODS
685
686=over 4
687
688=item redoop
689
690=item nextop
691
692=item lastop
693
694=back
695
696=head2 B::COP METHODS
697
698=over 4
699
700=item label
701
702=item stash
703
57843af0 704=item file
1a52ab62
MB
705
706=item cop_seq
707
708=item arybase
709
710=item line
711
712=back
713
714=head1 FUNCTIONS EXPORTED BY C<B>
715
716The C<B> module exports a variety of functions: some are simple
717utility functions, others provide a Perl program with a way to
718get an initial "handle" on an internal object.
719
720=over 4
721
722=item main_cv
723
724Return the (faked) CV corresponding to the main part of the Perl
725program.
726
31d7d75a
NIS
727=item init_av
728
729Returns the AV object (i.e. in class B::AV) representing INIT blocks.
730
1a52ab62
MB
731=item main_root
732
733Returns the root op (i.e. an object in the appropriate B::OP-derived
734class) of the main part of the Perl program.
735
736=item main_start
737
738Returns the starting op of the main part of the Perl program.
739
740=item comppadlist
741
742Returns the AV object (i.e. in class B::AV) of the global comppadlist.
743
744=item sv_undef
745
746Returns the SV object corresponding to the C variable C<sv_undef>.
747
748=item sv_yes
749
750Returns the SV object corresponding to the C variable C<sv_yes>.
751
752=item sv_no
753
754Returns the SV object corresponding to the C variable C<sv_no>.
755
56eca212
GS
756=item amagic_generation
757
758Returns the SV object corresponding to the C variable C<amagic_generation>.
759
1a52ab62
MB
760=item walkoptree(OP, METHOD)
761
762Does a tree-walk of the syntax tree based at OP and calls METHOD on
763each op it visits. Each node is visited before its children. If
764C<walkoptree_debug> (q.v.) has been called to turn debugging on then
765the method C<walkoptree_debug> is called on each op before METHOD is
766called.
767
768=item walkoptree_debug(DEBUG)
769
770Returns the current debugging flag for C<walkoptree>. If the optional
771DEBUG argument is non-zero, it sets the debugging flag to that. See
772the description of C<walkoptree> above for what the debugging flag
773does.
774
775=item walksymtable(SYMREF, METHOD, RECURSE)
776
777Walk the symbol table starting at SYMREF and call METHOD on each
778symbol visited. When the walk reached package symbols "Foo::" it
779invokes RECURSE and only recurses into the package if that sub
780returns true.
781
782=item svref_2object(SV)
783
784Takes any Perl variable and turns it into an object in the
785appropriate B::OP-derived or B::SV-derived class. Apart from functions
786such as C<main_root>, this is the primary way to get an initial
787"handle" on a internal perl data structure which can then be followed
788with the other access methods.
789
790=item ppname(OPNUM)
791
792Return the PP function name (e.g. "pp_add") of op number OPNUM.
793
794=item hash(STR)
795
796Returns a string in the form "0x..." representing the value of the
797internal hash function used by perl on string STR.
798
799=item cast_I32(I)
800
801Casts I to the internal I32 type used by that perl.
802
803
804=item minus_c
805
806Does the equivalent of the C<-c> command-line option. Obviously, this
807is only useful in a BEGIN block or else the flag is set too late.
808
809
810=item cstring(STR)
811
812Returns a double-quote-surrounded escaped version of STR which can
813be used as a string in C source code.
814
815=item class(OBJ)
816
817Returns the class of an object without the part of the classname
818preceding the first "::". This is used to turn "B::UNOP" into
819"UNOP" for example.
820
821=item threadsv_names
822
823In a perl compiled for threads, this returns a list of the special
824per-thread threadsv variables.
825
1a52ab62 826=back
7f20e9dd
GS
827
828=head1 AUTHOR
829
830Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
831
832=cut