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