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