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