This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Re: Not OK: perl v5.6.1 +fools-gold on darwin 1.3 (UNINSTALLED)
[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
76ef7183
JH
368This method is the one you usually want. It constructs a
369string using the length and offset information in the struct:
370for ordinary scalars it will return the string that you'd see
371from Perl, even if it contains null characters.
372
0b40bd6d
RH
373=item PVX
374
76ef7183
JH
375This method is less often useful. It assumes that the string
376stored in the struct is null-terminated, and disregards the
377length information.
378
379It is the appropriate method to use if you need to get the name
380of a lexical variable from a padname array. Lexical variable names
381are always stored with a null terminator, and the length field
382(SvCUR) is overloaded for other purposes and can't be relied on here.
383
1a52ab62
MB
384=back
385
386=head2 B::PVMG METHODS
387
388=over 4
389
390=item MAGIC
391
392=item SvSTASH
393
394=back
395
396=head2 B::MAGIC METHODS
397
398=over 4
399
400=item MOREMAGIC
401
402=item PRIVATE
403
404=item TYPE
405
406=item FLAGS
407
408=item OBJ
409
410=item PTR
411
412=back
413
414=head2 B::PVLV METHODS
415
416=over 4
417
418=item TARGOFF
419
420=item TARGLEN
421
422=item TYPE
423
424=item TARG
425
426=back
427
428=head2 B::BM METHODS
429
430=over 4
431
432=item USEFUL
433
434=item PREVIOUS
435
436=item RARE
437
438=item TABLE
439
440=back
441
442=head2 B::GV METHODS
443
444=over 4
445
87d7fd28
GS
446=item is_empty
447
448This method returns TRUE if the GP field of the GV is NULL.
449
1a52ab62
MB
450=item NAME
451
452=item STASH
453
454=item SV
455
456=item IO
457
458=item FORM
459
460=item AV
461
462=item HV
463
464=item EGV
465
466=item CV
467
468=item CVGEN
469
470=item LINE
471
b195d487
GS
472=item FILE
473
1a52ab62
MB
474=item FILEGV
475
476=item GvREFCNT
477
478=item FLAGS
479
480=back
481
482=head2 B::IO METHODS
483
484=over 4
485
486=item LINES
487
488=item PAGE
489
490=item PAGE_LEN
491
492=item LINES_LEFT
493
494=item TOP_NAME
495
496=item TOP_GV
497
498=item FMT_NAME
499
500=item FMT_GV
501
502=item BOTTOM_NAME
503
504=item BOTTOM_GV
505
506=item SUBPROCESS
507
508=item IoTYPE
509
510=item IoFLAGS
511
512=back
513
514=head2 B::AV METHODS
515
516=over 4
517
518=item FILL
519
520=item MAX
521
522=item OFF
523
524=item ARRAY
525
526=item AvFLAGS
527
528=back
529
530=head2 B::CV METHODS
531
532=over 4
533
534=item STASH
535
536=item START
537
538=item ROOT
539
540=item GV
541
57843af0
GS
542=item FILE
543
1a52ab62
MB
544=item DEPTH
545
546=item PADLIST
547
548=item OUTSIDE
549
550=item XSUB
551
552=item XSUBANY
553
5cfd8ad4
VB
554=item CvFLAGS
555
de3f1649
JT
556=item const_sv
557
1a52ab62
MB
558=back
559
560=head2 B::HV METHODS
561
562=over 4
563
564=item FILL
565
566=item MAX
567
568=item KEYS
569
570=item RITER
571
572=item NAME
573
574=item PMROOT
575
576=item ARRAY
577
578=back
579
580=head2 OP-RELATED CLASSES
581
1a67a97c 582B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
7934575e 583B::SVOP, B::PADOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
1a52ab62
MB
584These classes correspond in
585the obvious way to the underlying C structures of similar names. The
586inheritance hierarchy mimics the underlying C "inheritance". Access
587methods correspond to the underlying C structre field names, with the
588leading "class indication" prefix removed (op_).
589
590=head2 B::OP METHODS
591
592=over 4
593
594=item next
595
596=item sibling
597
3f872cb9
GS
598=item name
599
600This returns the op name as a string (e.g. "add", "rv2av").
601
1a52ab62
MB
602=item ppaddr
603
dc333d64
GS
604This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
605"PL_ppaddr[OP_RV2AV]").
1a52ab62
MB
606
607=item desc
608
4369b173 609This returns the op description from the global C PL_op_desc array
1a52ab62
MB
610(e.g. "addition" "array deref").
611
612=item targ
613
614=item type
615
616=item seq
617
618=item flags
619
620=item private
621
622=back
623
624=head2 B::UNOP METHOD
625
626=over 4
627
628=item first
629
630=back
631
632=head2 B::BINOP METHOD
633
634=over 4
635
636=item last
637
638=back
639
640=head2 B::LOGOP METHOD
641
642=over 4
643
644=item other
645
646=back
647
1a52ab62
MB
648=head2 B::LISTOP METHOD
649
650=over 4
651
652=item children
653
654=back
655
656=head2 B::PMOP METHODS
657
658=over 4
659
660=item pmreplroot
661
662=item pmreplstart
663
664=item pmnext
665
666=item pmregexp
667
668=item pmflags
669
670=item pmpermflags
671
672=item precomp
673
674=back
675
676=head2 B::SVOP METHOD
677
678=over 4
679
680=item sv
681
065a1863
GS
682=item gv
683
1a52ab62
MB
684=back
685
7934575e 686=head2 B::PADOP METHOD
1a52ab62
MB
687
688=over 4
689
7934575e 690=item padix
1a52ab62
MB
691
692=back
693
694=head2 B::PVOP METHOD
695
696=over 4
697
698=item pv
699
700=back
701
702=head2 B::LOOP METHODS
703
704=over 4
705
706=item redoop
707
708=item nextop
709
710=item lastop
711
712=back
713
714=head2 B::COP METHODS
715
716=over 4
717
718=item label
719
720=item stash
721
57843af0 722=item file
1a52ab62
MB
723
724=item cop_seq
725
726=item arybase
727
728=item line
729
730=back
731
732=head1 FUNCTIONS EXPORTED BY C<B>
733
734The C<B> module exports a variety of functions: some are simple
735utility functions, others provide a Perl program with a way to
736get an initial "handle" on an internal object.
737
738=over 4
739
740=item main_cv
741
742Return the (faked) CV corresponding to the main part of the Perl
743program.
744
31d7d75a
NIS
745=item init_av
746
747Returns the AV object (i.e. in class B::AV) representing INIT blocks.
748
1a52ab62
MB
749=item main_root
750
751Returns the root op (i.e. an object in the appropriate B::OP-derived
752class) of the main part of the Perl program.
753
754=item main_start
755
756Returns the starting op of the main part of the Perl program.
757
758=item comppadlist
759
760Returns the AV object (i.e. in class B::AV) of the global comppadlist.
761
762=item sv_undef
763
764Returns the SV object corresponding to the C variable C<sv_undef>.
765
766=item sv_yes
767
768Returns the SV object corresponding to the C variable C<sv_yes>.
769
770=item sv_no
771
772Returns the SV object corresponding to the C variable C<sv_no>.
773
56eca212
GS
774=item amagic_generation
775
776Returns the SV object corresponding to the C variable C<amagic_generation>.
777
1a52ab62
MB
778=item walkoptree(OP, METHOD)
779
780Does a tree-walk of the syntax tree based at OP and calls METHOD on
781each op it visits. Each node is visited before its children. If
782C<walkoptree_debug> (q.v.) has been called to turn debugging on then
783the method C<walkoptree_debug> is called on each op before METHOD is
784called.
785
786=item walkoptree_debug(DEBUG)
787
788Returns the current debugging flag for C<walkoptree>. If the optional
789DEBUG argument is non-zero, it sets the debugging flag to that. See
790the description of C<walkoptree> above for what the debugging flag
791does.
792
793=item walksymtable(SYMREF, METHOD, RECURSE)
794
795Walk the symbol table starting at SYMREF and call METHOD on each
796symbol visited. When the walk reached package symbols "Foo::" it
797invokes RECURSE and only recurses into the package if that sub
798returns true.
799
800=item svref_2object(SV)
801
802Takes any Perl variable and turns it into an object in the
803appropriate B::OP-derived or B::SV-derived class. Apart from functions
804such as C<main_root>, this is the primary way to get an initial
805"handle" on a internal perl data structure which can then be followed
806with the other access methods.
807
808=item ppname(OPNUM)
809
810Return the PP function name (e.g. "pp_add") of op number OPNUM.
811
812=item hash(STR)
813
814Returns a string in the form "0x..." representing the value of the
815internal hash function used by perl on string STR.
816
817=item cast_I32(I)
818
819Casts I to the internal I32 type used by that perl.
820
821
822=item minus_c
823
824Does the equivalent of the C<-c> command-line option. Obviously, this
825is only useful in a BEGIN block or else the flag is set too late.
826
827
828=item cstring(STR)
829
830Returns a double-quote-surrounded escaped version of STR which can
831be used as a string in C source code.
832
833=item class(OBJ)
834
835Returns the class of an object without the part of the classname
836preceding the first "::". This is used to turn "B::UNOP" into
837"UNOP" for example.
838
839=item threadsv_names
840
841In a perl compiled for threads, this returns a list of the special
842per-thread threadsv variables.
843
1a52ab62 844=back
7f20e9dd
GS
845
846=head1 AUTHOR
847
848Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
849
850=cut