[p5sagit/p5-mst-13.2.git] / ext / B / B.pm

#      B.pm
#
#      Copyright (c) 1996, 1997, 1998 Malcolm Beattie
#
#      You may distribute under the terms of either the GNU General Public
#      License or the Artistic License, as specified in the README file.
#
package B;
require DynaLoader;
require Exporter;
@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw(minus_c ppname
		class peekop cast_I32 cstring cchar hash threadsv_names
		main_root main_start main_cv svref_2object opnumber amagic_generation
		walkoptree walkoptree_slow walkoptree_exec walksymtable
		parents comppadlist sv_undef compile_stats timing_info init_av);
sub OPf_KIDS ();
use strict;
@B::SV::ISA = 'B::OBJECT';
@B::NULL::ISA = 'B::SV';
@B::PV::ISA = 'B::SV';
@B::IV::ISA = 'B::SV';
@B::NV::ISA = 'B::IV';
@B::RV::ISA = 'B::SV';
@B::PVIV::ISA = qw(B::PV B::IV);
@B::PVNV::ISA = qw(B::PV B::NV);
@B::PVMG::ISA = 'B::PVNV';
@B::PVLV::ISA = 'B::PVMG';
@B::BM::ISA = 'B::PVMG';
@B::AV::ISA = 'B::PVMG';
@B::GV::ISA = 'B::PVMG';
@B::HV::ISA = 'B::PVMG';
@B::CV::ISA = 'B::PVMG';
@B::IO::ISA = 'B::PVMG';
@B::FM::ISA = 'B::CV';

@B::OP::ISA = 'B::OBJECT';
@B::UNOP::ISA = 'B::OP';
@B::BINOP::ISA = 'B::UNOP';
@B::LOGOP::ISA = 'B::UNOP';
@B::LISTOP::ISA = 'B::BINOP';
@B::SVOP::ISA = 'B::OP';
@B::GVOP::ISA = 'B::OP';
@B::PVOP::ISA = 'B::OP';
@B::CVOP::ISA = 'B::OP';
@B::LOOP::ISA = 'B::LISTOP';
@B::PMOP::ISA = 'B::LISTOP';
@B::COP::ISA = 'B::OP';

@B::SPECIAL::ISA = 'B::OBJECT';

{
    # Stop "-w" from complaining about the lack of a real B::OBJECT class
    package B::OBJECT;
}

my $debug;
my $op_count = 0;
my @parents = ();

sub debug {
    my ($class, $value) = @_;
    $debug = $value;
    walkoptree_debug($value);
}

sub class {
    my $obj = shift;
    my $name = ref $obj;
    $name =~ s/^.*:://;
    return $name;
}

sub parents { \@parents }

# For debugging
sub peekop {
    my $op = shift;
    return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
}

sub walkoptree_slow {
    my($op, $method, $level) = @_;
    $op_count++; # just for statistics
    $level ||= 0;
    warn(sprintf("walkoptree: %d. %s\n", $level, peekop($op))) if $debug;
    $op->$method($level);
    if ($$op && ($op->flags & OPf_KIDS)) {
	my $kid;
	unshift(@parents, $op);
	for ($kid = $op->first; $$kid; $kid = $kid->sibling) {
	    walkoptree_slow($kid, $method, $level + 1);
	}
	shift @parents;
    }
}

sub compile_stats {
    return "Total number of OPs processed: $op_count\n";
}

sub timing_info {
    my ($sec, $min, $hr) = localtime;
    my ($user, $sys) = times;
    sprintf("%02d:%02d:%02d user=$user sys=$sys",
	    $hr, $min, $sec, $user, $sys);
}

my %symtable;
sub savesym {
    my ($obj, $value) = @_;
#    warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
    $symtable{sprintf("sym_%x", $$obj)} = $value;
}

sub objsym {
    my $obj = shift;
    return $symtable{sprintf("sym_%x", $$obj)};
}

sub walkoptree_exec {
    my ($op, $method, $level) = @_;
    my ($sym, $ppname);
    my $prefix = "    " x $level;
    for (; $$op; $op = $op->next) {
	$sym = objsym($op);
	if (defined($sym)) {
	    print $prefix, "goto $sym\n";
	    return;
	}
	savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
	$op->$method($level);
	$ppname = $op->name;
	if ($ppname =~
	    /^(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/)
	{
	    print $prefix, uc($1), " => {\n";
	    walkoptree_exec($op->other, $method, $level + 1);
	    print $prefix, "}\n";
	} elsif ($ppname eq "match" || $ppname eq "subst") {
	    my $pmreplstart = $op->pmreplstart;
	    if ($$pmreplstart) {
		print $prefix, "PMREPLSTART => {\n";
		walkoptree_exec($pmreplstart, $method, $level + 1);
		print $prefix, "}\n";
	    }
	} elsif ($ppname eq "substcont") {
	    print $prefix, "SUBSTCONT => {\n";
	    walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
	    print $prefix, "}\n";
	    $op = $op->other;
	} elsif ($ppname eq "enterloop") {
	    print $prefix, "REDO => {\n";
	    walkoptree_exec($op->redoop, $method, $level + 1);
	    print $prefix, "}\n", $prefix, "NEXT => {\n";
	    walkoptree_exec($op->nextop, $method, $level + 1);
	    print $prefix, "}\n", $prefix, "LAST => {\n";
	    walkoptree_exec($op->lastop,  $method, $level + 1);
	    print $prefix, "}\n";
	} elsif ($ppname eq "subst") {
	    my $replstart = $op->pmreplstart;
	    if ($$replstart) {
		print $prefix, "SUBST => {\n";
		walkoptree_exec($replstart, $method, $level + 1);
		print $prefix, "}\n";
	    }
	}
    }
}

sub walksymtable {
    my ($symref, $method, $recurse, $prefix) = @_;
    my $sym;
    my $ref;
    no strict 'vars';
    local(*glob);
    $prefix = '' unless defined $prefix;
    while (($sym, $ref) = each %$symref) {
	*glob = "*main::".$prefix.$sym;
	if ($sym =~ /::$/) {
	    $sym = $prefix . $sym;
	    if ($sym ne "main::" && &$recurse($sym)) {
		walksymtable(\%glob, $method, $recurse, $sym);
	    }
	} else {
	    svref_2object(\*glob)->EGV->$method();
	}
    }
}

{
    package B::Section;
    my $output_fh;
    my %sections;
    
    sub new {
	my ($class, $section, $symtable, $default) = @_;
	$output_fh ||= FileHandle->new_tmpfile;
	my $obj = bless [-1, $section, $symtable, $default], $class;
	$sections{$section} = $obj;
	return $obj;
    }
    
    sub get {
	my ($class, $section) = @_;
	return $sections{$section};
    }

    sub add {
	my $section = shift;
	while (defined($_ = shift)) {
	    print $output_fh "$section->[1]\t$_\n";
	    $section->[0]++;
	}
    }

    sub index {
	my $section = shift;
	return $section->[0];
    }

    sub name {
	my $section = shift;
	return $section->[1];
    }

    sub symtable {
	my $section = shift;
	return $section->[2];
    }
	
    sub default {
	my $section = shift;
	return $section->[3];
    }
	
    sub output {
	my ($section, $fh, $format) = @_;
	my $name = $section->name;
	my $sym = $section->symtable || {};
	my $default = $section->default;

	seek($output_fh, 0, 0);
	while (<$output_fh>) {
	    chomp;
	    s/^(.*?)\t//;
	    if ($1 eq $name) {
		s{(s\\_[0-9a-f]+)} {
		    exists($sym->{$1}) ? $sym->{$1} : $default;
		}ge;
		printf $fh $format, $_;
	    }
	}
    }
}

bootstrap B;

1;

__END__

=head1 NAME

B - The Perl Compiler

=head1 SYNOPSIS

	use B;

=head1 DESCRIPTION

The C<B> module supplies classes which allow a Perl program to delve
into its own innards. It is the module used to implement the
"backends" of the Perl compiler. Usage of the compiler does not
require knowledge of this module: see the F<O> module for the
user-visible part. The C<B> module is of use to those who want to
write new compiler backends. This documentation assumes that the
reader knows a fair amount about perl's internals including such
things as SVs, OPs and the internal symbol table and syntax tree
of a program.

=head1 OVERVIEW OF CLASSES

The C structures used by Perl's internals to hold SV and OP
information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
class hierarchy and the C<B> module gives access to them via a true
object hierarchy. Structure fields which point to other objects
(whether types of SV or types of OP) are represented by the C<B>
module as Perl objects of the appropriate class. The bulk of the C<B>
module is the methods for accessing fields of these structures. Note
that all access is read-only: you cannot modify the internals by
using this module.

=head2 SV-RELATED CLASSES

B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
the obvious way to the underlying C structures of similar names. The
inheritance hierarchy mimics the underlying C "inheritance". Access
methods correspond to the underlying C macros for field access,
usually with the leading "class indication" prefix removed (Sv, Av,
Hv, ...). The leading prefix is only left in cases where its removal
would cause a clash in method name. For example, C<GvREFCNT> stays
as-is since its abbreviation would clash with the "superclass" method
C<REFCNT> (corresponding to the C function C<SvREFCNT>).

=head2 B::SV METHODS

=over 4

=item REFCNT

=item FLAGS

=back

=head2 B::IV METHODS

=over 4

=item IV

=item IVX

=item needs64bits

=item packiv

=back

=head2 B::NV METHODS

=over 4

=item NV

=item NVX

=back

=head2 B::RV METHODS

=over 4

=item RV

=back

=head2 B::PV METHODS

=over 4

=item PV

=back

=head2 B::PVMG METHODS

=over 4

=item MAGIC

=item SvSTASH

=back

=head2 B::MAGIC METHODS

=over 4

=item MOREMAGIC

=item PRIVATE

=item TYPE

=item FLAGS

=item OBJ

=item PTR

=back

=head2 B::PVLV METHODS

=over 4

=item TARGOFF

=item TARGLEN

=item TYPE

=item TARG

=back

=head2 B::BM METHODS

=over 4

=item USEFUL

=item PREVIOUS

=item RARE

=item TABLE

=back

=head2 B::GV METHODS

=over 4

=item NAME

=item STASH

=item SV

=item IO

=item FORM

=item AV

=item HV

=item EGV

=item CV

=item CVGEN

=item LINE

=item FILEGV

=item GvREFCNT

=item FLAGS

=back

=head2 B::IO METHODS

=over 4

=item LINES

=item PAGE

=item PAGE_LEN

=item LINES_LEFT

=item TOP_NAME

=item TOP_GV

=item FMT_NAME

=item FMT_GV

=item BOTTOM_NAME

=item BOTTOM_GV

=item SUBPROCESS

=item IoTYPE

=item IoFLAGS

=back

=head2 B::AV METHODS

=over 4

=item FILL

=item MAX

=item OFF

=item ARRAY

=item AvFLAGS

=back

=head2 B::CV METHODS

=over 4

=item STASH

=item START

=item ROOT

=item GV

=item FILEGV

=item DEPTH

=item PADLIST

=item OUTSIDE

=item XSUB

=item XSUBANY

=item CvFLAGS

=back

=head2 B::HV METHODS

=over 4

=item FILL

=item MAX

=item KEYS

=item RITER

=item NAME

=item PMROOT

=item ARRAY

=back

=head2 OP-RELATED CLASSES

B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
These classes correspond in
the obvious way to the underlying C structures of similar names. The
inheritance hierarchy mimics the underlying C "inheritance". Access
methods correspond to the underlying C structre field names, with the
leading "class indication" prefix removed (op_).

=head2 B::OP METHODS

=over 4

=item next

=item sibling

=item name

This returns the op name as a string (e.g. "add", "rv2av").

=item ppaddr

This returns the function name as a string (e.g. Perl_pp_add,
Perl_pp_rv2av).

=item desc

This returns the op description from the global C PL_op_desc array
(e.g. "addition" "array deref").

=item targ

=item type

=item seq

=item flags

=item private

=back

=head2 B::UNOP METHOD

=over 4

=item first

=back

=head2 B::BINOP METHOD

=over 4

=item last

=back

=head2 B::LOGOP METHOD

=over 4

=item other

=back

=head2 B::LISTOP METHOD

=over 4

=item children

=back

=head2 B::PMOP METHODS

=over 4

=item pmreplroot

=item pmreplstart

=item pmnext

=item pmregexp

=item pmflags

=item pmpermflags

=item precomp

=back

=head2 B::SVOP METHOD

=over 4

=item sv

=back

=head2 B::GVOP METHOD

=over 4

=item gv

=back

=head2 B::PVOP METHOD

=over 4

=item pv

=back

=head2 B::LOOP METHODS

=over 4

=item redoop

=item nextop

=item lastop

=back

=head2 B::COP METHODS

=over 4

=item label

=item stash

=item filegv

=item cop_seq

=item arybase

=item line

=back

=head1 FUNCTIONS EXPORTED BY C<B>

The C<B> module exports a variety of functions: some are simple
utility functions, others provide a Perl program with a way to
get an initial "handle" on an internal object.

=over 4

=item main_cv

Return the (faked) CV corresponding to the main part of the Perl
program.

=item init_av

Returns the AV object (i.e. in class B::AV) representing INIT blocks.

=item main_root

Returns the root op (i.e. an object in the appropriate B::OP-derived
class) of the main part of the Perl program.

=item main_start

Returns the starting op of the main part of the Perl program.

=item comppadlist

Returns the AV object (i.e. in class B::AV) of the global comppadlist.

=item sv_undef

Returns the SV object corresponding to the C variable C<sv_undef>.

=item sv_yes

Returns the SV object corresponding to the C variable C<sv_yes>.

=item sv_no

Returns the SV object corresponding to the C variable C<sv_no>.

=item amagic_generation

Returns the SV object corresponding to the C variable C<amagic_generation>.

=item walkoptree(OP, METHOD)

Does a tree-walk of the syntax tree based at OP and calls METHOD on
each op it visits. Each node is visited before its children. If
C<walkoptree_debug> (q.v.) has been called to turn debugging on then
the method C<walkoptree_debug> is called on each op before METHOD is
called.

=item walkoptree_debug(DEBUG)

Returns the current debugging flag for C<walkoptree>. If the optional
DEBUG argument is non-zero, it sets the debugging flag to that. See
the description of C<walkoptree> above for what the debugging flag
does.

=item walksymtable(SYMREF, METHOD, RECURSE)

Walk the symbol table starting at SYMREF and call METHOD on each
symbol visited. When the walk reached package symbols "Foo::" it
invokes RECURSE and only recurses into the package if that sub
returns true.

=item svref_2object(SV)

Takes any Perl variable and turns it into an object in the
appropriate B::OP-derived or B::SV-derived class. Apart from functions
such as C<main_root>, this is the primary way to get an initial
"handle" on a internal perl data structure which can then be followed
with the other access methods.

=item ppname(OPNUM)

Return the PP function name (e.g. "pp_add") of op number OPNUM.

=item hash(STR)

Returns a string in the form "0x..." representing the value of the
internal hash function used by perl on string STR.

=item cast_I32(I)

Casts I to the internal I32 type used by that perl.


=item minus_c

Does the equivalent of the C<-c> command-line option. Obviously, this
is only useful in a BEGIN block or else the flag is set too late.


=item cstring(STR)

Returns a double-quote-surrounded escaped version of STR which can
be used as a string in C source code.

=item class(OBJ)

Returns the class of an object without the part of the classname
preceding the first "::". This is used to turn "B::UNOP" into
"UNOP" for example.

=item threadsv_names

In a perl compiled for threads, this returns a list of the special
per-thread threadsv variables.

=back

=head1 AUTHOR

Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>

=cut
Commit	Line	Data
a798dbf2	1	# B.pm
a798dbf2	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	#
	8	package B;
	9	require DynaLoader;
	10	require 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	17	sub OPf_KIDS ();
a798dbf2	18	use 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';
276493cb	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';
a798dbf2	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
	57	my $debug;
	58	my $op_count = 0;
	59	my @parents = ();
	60
	61	sub debug {
	62	my ($class, $value) = @_;
	63	$debug = $value;
	64	walkoptree_debug($value);
	65	}
	66
a798dbf2	67	sub class {
	68	my $obj = shift;
	69	my $name = ref $obj;
	70	$name =~ s/^.*:://;
	71	return $name;
	72	}
	73
	74	sub parents { \@parents }
	75
	76	# For debugging
	77	sub peekop {
	78	my $op = shift;
3f872cb9	79	return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
a798dbf2	80	}
	81
	82	sub 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
	98	sub compile_stats {
	99	return "Total number of OPs processed: $op_count\n";
	100	}
	101
	102	sub 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
	109	my %symtable;
	110	sub 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
	116	sub objsym {
	117	my $obj = shift;
	118	return $symtable{sprintf("sym_%x", $$obj)};
	119	}
	120
	121	sub 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);
3f872cb9	133	$ppname = $op->name;
1a67a97c	134	if ($ppname =~
3f872cb9	135	/^(or\|and\|mapwhile\|grepwhile\|entertry\|range\|cond_expr)$/)
1a67a97c	136	{
a798dbf2	137	print $prefix, uc($1), " => {\n";
	138	walkoptree_exec($op->other, $method, $level + 1);
	139	print $prefix, "}\n";
3f872cb9	140	} elsif ($ppname eq "match" \|\| $ppname eq "subst") {
a798dbf2	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	}
3f872cb9	147	} elsif ($ppname eq "substcont") {
a798dbf2	148	print $prefix, "SUBSTCONT => {\n";
	149	walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
	150	print $prefix, "}\n";
	151	$op = $op->other;
3f872cb9	152	} elsif ($ppname eq "enterloop") {
a798dbf2	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";
3f872cb9	160	} elsif ($ppname eq "subst") {
a798dbf2	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
	171	sub walksymtable {
	172	my ($symref, $method, $recurse, $prefix) = @_;
	173	my $sym;
0cc1d052	174	my $ref;
a798dbf2	175	no strict 'vars';
a798dbf2	176	local(*glob);
0cc1d052	177	$prefix = '' unless defined $prefix;
0cc1d052	178	while (($sym, $ref) = each %$symref) {
8bac7e00	179	glob = "main::".$prefix.$sym;
a798dbf2	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
257	bootstrap B;
258
259	1;
7f20e9dd	260
	261	__END__
	262
	263	=head1 NAME
	264
	265	B - The Perl Compiler
	266
	267	=head1 SYNOPSIS
	268
	269	use B;
	270
	271	=head1 DESCRIPTION
	272
1a52ab62	273	The C<B> module supplies classes which allow a Perl program to delve
	274	into its own innards. It is the module used to implement the
	275	"backends" of the Perl compiler. Usage of the compiler does not
	276	require knowledge of this module: see the F<O> module for the
	277	user-visible part. The C<B> module is of use to those who want to
	278	write new compiler backends. This documentation assumes that the
	279	reader knows a fair amount about perl's internals including such
	280	things as SVs, OPs and the internal symbol table and syntax tree
	281	of a program.
	282
	283	=head1 OVERVIEW OF CLASSES
	284
	285	The C structures used by Perl's internals to hold SV and OP
	286	information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
	287	class hierarchy and the C<B> module gives access to them via a true
	288	object hierarchy. Structure fields which point to other objects
	289	(whether types of SV or types of OP) are represented by the C<B>
	290	module as Perl objects of the appropriate class. The bulk of the C<B>
	291	module is the methods for accessing fields of these structures. Note
	292	that all access is read-only: you cannot modify the internals by
	293	using this module.
	294
	295	=head2 SV-RELATED CLASSES
	296
	297	B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
	298	B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
	299	the obvious way to the underlying C structures of similar names. The
	300	inheritance hierarchy mimics the underlying C "inheritance". Access
	301	methods correspond to the underlying C macros for field access,
	302	usually with the leading "class indication" prefix removed (Sv, Av,
	303	Hv, ...). The leading prefix is only left in cases where its removal
	304	would cause a clash in method name. For example, C<GvREFCNT> stays
	305	as-is since its abbreviation would clash with the "superclass" method
	306	C<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	520	=item CvFLAGS
5cfd8ad4	521
1a52ab62	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	546	B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
1a52ab62	547	B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
	548	These classes correspond in
	549	the obvious way to the underlying C structures of similar names. The
	550	inheritance hierarchy mimics the underlying C "inheritance". Access
	551	methods correspond to the underlying C structre field names, with the
	552	leading "class indication" prefix removed (op_).
	553
	554	=head2 B::OP METHODS
	555
	556	=over 4
	557
	558	=item next
	559
	560	=item sibling
	561
3f872cb9	562	=item name
	563
	564	This returns the op name as a string (e.g. "add", "rv2av").
	565
1a52ab62	566	=item ppaddr
1a52ab62	567
3f872cb9	568	This returns the function name as a string (e.g. Perl_pp_add,
3f872cb9	569	Perl_pp_rv2av).
1a52ab62	570
	571	=item desc
	572
4369b173	573	This returns the op description from the global C PL_op_desc array
1a52ab62	574	(e.g. "addition" "array deref").
	575
	576	=item targ
	577
	578	=item type
	579
	580	=item seq
	581
	582	=item flags
	583
	584	=item private
	585
	586	=back
	587
	588	=head2 B::UNOP METHOD
	589
	590	=over 4
	591
	592	=item first
	593
	594	=back
	595
	596	=head2 B::BINOP METHOD
	597
	598	=over 4
	599
	600	=item last
	601
	602	=back
	603
	604	=head2 B::LOGOP METHOD
	605
	606	=over 4
	607
	608	=item other
	609
	610	=back
	611
1a52ab62	612	=head2 B::LISTOP METHOD
	613
	614	=over 4
	615
	616	=item children
	617
	618	=back
	619
	620	=head2 B::PMOP METHODS
	621
	622	=over 4
	623
	624	=item pmreplroot
	625
	626	=item pmreplstart
	627
	628	=item pmnext
	629
	630	=item pmregexp
	631
	632	=item pmflags
	633
	634	=item pmpermflags
	635
	636	=item precomp
	637
	638	=back
	639
	640	=head2 B::SVOP METHOD
	641
	642	=over 4
	643
	644	=item sv
	645
	646	=back
	647
	648	=head2 B::GVOP METHOD
	649
	650	=over 4
	651
	652	=item gv
	653
	654	=back
	655
	656	=head2 B::PVOP METHOD
	657
	658	=over 4
	659
	660	=item pv
	661
	662	=back
	663
	664	=head2 B::LOOP METHODS
	665
	666	=over 4
	667
	668	=item redoop
	669
	670	=item nextop
	671
	672	=item lastop
	673
	674	=back
	675
676	=head2 B::COP METHODS
677
678	=over 4
679
680	=item label
681
682	=item stash
683
684	=item filegv
685
686	=item cop_seq
687
688	=item arybase
689
690	=item line
691
692	=back
693
694	=head1 FUNCTIONS EXPORTED BY C<B>
695
696	The C<B> module exports a variety of functions: some are simple
697	utility functions, others provide a Perl program with a way to
698	get an initial "handle" on an internal object.
699
700	=over 4
701
702	=item main_cv
703
704	Return the (faked) CV corresponding to the main part of the Perl
705	program.
706
31d7d75a	707	=item init_av
	708
	709	Returns the AV object (i.e. in class B::AV) representing INIT blocks.
	710
1a52ab62	711	=item main_root
	712
	713	Returns the root op (i.e. an object in the appropriate B::OP-derived
	714	class) of the main part of the Perl program.
	715
	716	=item main_start
	717
	718	Returns the starting op of the main part of the Perl program.
	719
	720	=item comppadlist
	721
	722	Returns the AV object (i.e. in class B::AV) of the global comppadlist.
	723
	724	=item sv_undef
	725
	726	Returns the SV object corresponding to the C variable C<sv_undef>.
	727
	728	=item sv_yes
	729
	730	Returns the SV object corresponding to the C variable C<sv_yes>.
	731
	732	=item sv_no
	733
	734	Returns the SV object corresponding to the C variable C<sv_no>.
	735
56eca212	736	=item amagic_generation
	737
	738	Returns the SV object corresponding to the C variable C<amagic_generation>.
	739
1a52ab62	740	=item walkoptree(OP, METHOD)
	741
	742	Does a tree-walk of the syntax tree based at OP and calls METHOD on
	743	each op it visits. Each node is visited before its children. If
	744	C<walkoptree_debug> (q.v.) has been called to turn debugging on then
	745	the method C<walkoptree_debug> is called on each op before METHOD is
	746	called.
	747
	748	=item walkoptree_debug(DEBUG)
	749
	750	Returns the current debugging flag for C<walkoptree>. If the optional
	751	DEBUG argument is non-zero, it sets the debugging flag to that. See
	752	the description of C<walkoptree> above for what the debugging flag
	753	does.
	754
	755	=item walksymtable(SYMREF, METHOD, RECURSE)
	756
	757	Walk the symbol table starting at SYMREF and call METHOD on each
	758	symbol visited. When the walk reached package symbols "Foo::" it
	759	invokes RECURSE and only recurses into the package if that sub
	760	returns true.
	761
	762	=item svref_2object(SV)
	763
	764	Takes any Perl variable and turns it into an object in the
	765	appropriate B::OP-derived or B::SV-derived class. Apart from functions
	766	such as C<main_root>, this is the primary way to get an initial
	767	"handle" on a internal perl data structure which can then be followed
	768	with the other access methods.
	769
	770	=item ppname(OPNUM)
	771
	772	Return the PP function name (e.g. "pp_add") of op number OPNUM.
	773
	774	=item hash(STR)
	775
	776	Returns a string in the form "0x..." representing the value of the
	777	internal hash function used by perl on string STR.
	778
	779	=item cast_I32(I)
	780
	781	Casts I to the internal I32 type used by that perl.
	782
	783
	784	=item minus_c
	785
	786	Does the equivalent of the C<-c> command-line option. Obviously, this
	787	is only useful in a BEGIN block or else the flag is set too late.
	788
	789
	790	=item cstring(STR)
	791
	792	Returns a double-quote-surrounded escaped version of STR which can
	793	be used as a string in C source code.
	794
	795	=item class(OBJ)
	796
	797	Returns the class of an object without the part of the classname
	798	preceding the first "::". This is used to turn "B::UNOP" into
	799	"UNOP" for example.
	800
	801	=item threadsv_names
	802
	803	In a perl compiled for threads, this returns a list of the special
804	per-thread threadsv variables.
805
1a52ab62	806	=back
7f20e9dd	807
	808	=head1 AUTHOR
	809
	810	Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
	811
	812	=cut