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