[perl5.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(byteload_fh byteload_string minus_c ppname
		class peekop cast_I32 cstring cchar hash threadsv_names
		main_root main_start main_cv svref_2object
		walkoptree walkoptree_slow walkoptree_exec walksymtable
		parents comppadlist sv_undef compile_stats timing_info);

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::CONDOP::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 OPf_KIDS;
# add to .xs for perl5.002
sub OPf_KIDS () { 4 }

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->ppaddr);
}

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->ppaddr;
	if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
	    print $prefix, uc($1), " => {\n";
	    walkoptree_exec($op->other, $method, $level + 1);
	    print $prefix, "}\n";
	} elsif ($ppname eq "pp_match" || $ppname eq "pp_subst") {
	    my $pmreplstart = $op->pmreplstart;
	    if ($$pmreplstart) {
		print $prefix, "PMREPLSTART => {\n";
		walkoptree_exec($pmreplstart, $method, $level + 1);
		print $prefix, "}\n";
	    }
	} elsif ($ppname eq "pp_substcont") {
	    print $prefix, "SUBSTCONT => {\n";
	    walkoptree_exec($op->other->pmreplstart, $method, $level + 1);
	    print $prefix, "}\n";
	    $op = $op->other;
	} elsif ($ppname eq "pp_cond_expr") {
	    # pp_cond_expr never returns op_next
	    print $prefix, "TRUE => {\n";
	    walkoptree_exec($op->true, $method, $level + 1);
	    print $prefix, "}\n";
	    $op = $op->false;
	    redo;
	} elsif ($ppname eq "pp_range") {
	    print $prefix, "TRUE => {\n";
	    walkoptree_exec($op->true, $method, $level + 1);
	    print $prefix, "}\n", $prefix, "FALSE => {\n";
	    walkoptree_exec($op->false, $method, $level + 1);
	    print $prefix, "}\n";
	} elsif ($ppname eq "pp_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 "pp_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;
    no strict 'vars';
    local(*glob);
    while (($sym, *glob) = each %$symref) {
	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::CONDOP, 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 ppaddr

This returns the function name as a string (e.g. pp_add, pp_rv2av).

=item desc

This returns the op description from the global C 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::CONDOP METHODS

=over 4

=item true

=item false

=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 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 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.

=item byteload_fh(FILEHANDLE)

Load the contents of FILEHANDLE as bytecode. See documentation for
the B<Bytecode> module in F<B::Backend> for how to generate bytecode.

=back

=head1 AUTHOR

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

=cut
Commit	Line	Data
a798dbf2 MB	1	# B.pm
a798dbf2 MB	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	#
	8	package B;
	9	require DynaLoader;
	10	require 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
	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 SM	34	@B::IO::ISA = 'B::PVMG';
276493cb SM	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';
	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
	58	my $debug;
	59	my $op_count = 0;
	60	my @parents = ();
	61
	62	sub 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
	70	sub OPf_KIDS () { 4 }
	71
	72	sub class {
	73	my $obj = shift;
	74	my $name = ref $obj;
	75	$name =~ s/^.*:://;
	76	return $name;
	77	}
	78
	79	sub parents { \@parents }
	80
	81	# For debugging
	82	sub peekop {
	83	my $op = shift;
	84	return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
	85	}
	86
	87	sub 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
103	sub compile_stats {
104	return "Total number of OPs processed: $op_count\n";
105	}
106
107	sub 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
114	my %symtable;
115	sub 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
121	sub objsym {
122	my $obj = shift;
123	return $symtable{sprintf("sym_%x", $$obj)};
124	}
125
126	sub 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
187	sub 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
270	bootstrap B;
271
272	1;
7f20e9dd GS	273
	274	__END__
	275
	276	=head1 NAME
	277
	278	B - The Perl Compiler
	279
	280	=head1 SYNOPSIS
	281
	282	use B;
	283
	284	=head1 DESCRIPTION
	285
1a52ab62 MB	286	The C<B> module supplies classes which allow a Perl program to delve
	287	into its own innards. It is the module used to implement the
	288	"backends" of the Perl compiler. Usage of the compiler does not
	289	require knowledge of this module: see the F<O> module for the
	290	user-visible part. The C<B> module is of use to those who want to
	291	write new compiler backends. This documentation assumes that the
	292	reader knows a fair amount about perl's internals including such
	293	things as SVs, OPs and the internal symbol table and syntax tree
	294	of a program.
	295
	296	=head1 OVERVIEW OF CLASSES
	297
	298	The C structures used by Perl's internals to hold SV and OP
	299	information (PVIV, AV, HV, ..., OP, SVOP, UNOP, ...) are modelled on a
	300	class hierarchy and the C<B> module gives access to them via a true
	301	object hierarchy. Structure fields which point to other objects
	302	(whether types of SV or types of OP) are represented by the C<B>
	303	module as Perl objects of the appropriate class. The bulk of the C<B>
	304	module is the methods for accessing fields of these structures. Note
	305	that all access is read-only: you cannot modify the internals by
	306	using this module.
	307
	308	=head2 SV-RELATED CLASSES
	309
	310	B::IV, B::NV, B::RV, B::PV, B::PVIV, B::PVNV, B::PVMG, B::BM, B::PVLV,
	311	B::AV, B::HV, B::CV, B::GV, B::FM, B::IO. These classes correspond in
	312	the obvious way to the underlying C structures of similar names. The
	313	inheritance hierarchy mimics the underlying C "inheritance". Access
	314	methods correspond to the underlying C macros for field access,
	315	usually with the leading "class indication" prefix removed (Sv, Av,
	316	Hv, ...). The leading prefix is only left in cases where its removal
	317	would cause a clash in method name. For example, C<GvREFCNT> stays
	318	as-is since its abbreviation would clash with the "superclass" method
	319	C<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
5cfd8ad4 VB	533	=item CvFLAGS
5cfd8ad4 VB	534
1a52ab62 MB	535	=back
	536
	537	=head2 B::HV METHODS
	538
	539	=over 4
	540
	541	=item FILL
	542
	543	=item MAX
	544
	545	=item KEYS
	546
	547	=item RITER
	548
	549	=item NAME
	550
	551	=item PMROOT
	552
	553	=item ARRAY
	554
	555	=back
	556
	557	=head2 OP-RELATED CLASSES
	558
	559	B::OP, B::UNOP, B::BINOP, B::LOGOP, B::CONDOP, B::LISTOP, B::PMOP,
	560	B::SVOP, B::GVOP, B::PVOP, B::CVOP, B::LOOP, B::COP.
	561	These classes correspond in
	562	the obvious way to the underlying C structures of similar names. The
	563	inheritance hierarchy mimics the underlying C "inheritance". Access
	564	methods correspond to the underlying C structre field names, with the
	565	leading "class indication" prefix removed (op_).
	566
	567	=head2 B::OP METHODS
	568
	569	=over 4
	570
	571	=item next
	572
	573	=item sibling
	574
	575	=item ppaddr
	576
	577	This returns the function name as a string (e.g. pp_add, pp_rv2av).
	578
	579	=item desc
	580
	581	This returns the op description from the global C op_desc array
	582	(e.g. "addition" "array deref").
	583
	584	=item targ
	585
	586	=item type
	587
	588	=item seq
	589
	590	=item flags
	591
	592	=item private
	593
	594	=back
	595
	596	=head2 B::UNOP METHOD
	597
	598	=over 4
599
600	=item first
601
602	=back
603
604	=head2 B::BINOP METHOD
605
606	=over 4
607
608	=item last
609
610	=back
611
612	=head2 B::LOGOP METHOD
613
614	=over 4
615
616	=item other
617
618	=back
619
620	=head2 B::CONDOP METHODS
621
622	=over 4
623
624	=item true
625
626	=item false
627
628	=back
629
630	=head2 B::LISTOP METHOD
631
632	=over 4
633
634	=item children
635
636	=back
637
638	=head2 B::PMOP METHODS
639
640	=over 4
641
642	=item pmreplroot
643
644	=item pmreplstart
645
646	=item pmnext
647
648	=item pmregexp
649
650	=item pmflags
651
652	=item pmpermflags
653
654	=item precomp
655
656	=back
657
658	=head2 B::SVOP METHOD
659
660	=over 4
661
662	=item sv
663
664	=back
665
666	=head2 B::GVOP METHOD
667
668	=over 4
669
670	=item gv
671
672	=back
673
674	=head2 B::PVOP METHOD
675
676	=over 4
677
678	=item pv
679
680	=back
681
682	=head2 B::LOOP METHODS
683
684	=over 4
685
686	=item redoop
687
688	=item nextop
689
690	=item lastop
691
692	=back
693
694	=head2 B::COP METHODS
695
696	=over 4
697
698	=item label
699
700	=item stash
701
702	=item filegv
703
704	=item cop_seq
705
706	=item arybase
707
708	=item line
709
710	=back
711
712	=head1 FUNCTIONS EXPORTED BY C<B>
713
714	The C<B> module exports a variety of functions: some are simple
715	utility functions, others provide a Perl program with a way to
716	get an initial "handle" on an internal object.
717
718	=over 4
719
720	=item main_cv
721
722	Return the (faked) CV corresponding to the main part of the Perl
723	program.
724
725	=item main_root
726
727	Returns the root op (i.e. an object in the appropriate B::OP-derived
728	class) of the main part of the Perl program.
729
730	=item main_start
731
732	Returns the starting op of the main part of the Perl program.
733
734	=item comppadlist
735
736	Returns the AV object (i.e. in class B::AV) of the global comppadlist.
737
738	=item sv_undef
739
740	Returns the SV object corresponding to the C variable C<sv_undef>.
741
742	=item sv_yes
743
744	Returns the SV object corresponding to the C variable C<sv_yes>.
745
746	=item sv_no
747
748	Returns the SV object corresponding to the C variable C<sv_no>.
749
750	=item walkoptree(OP, METHOD)
751
752	Does a tree-walk of the syntax tree based at OP and calls METHOD on
753	each op it visits. Each node is visited before its children. If
754	C<walkoptree_debug> (q.v.) has been called to turn debugging on then
755	the method C<walkoptree_debug> is called on each op before METHOD is
756	called.
757
758	=item walkoptree_debug(DEBUG)
759
760	Returns the current debugging flag for C<walkoptree>. If the optional
761	DEBUG argument is non-zero, it sets the debugging flag to that. See
762	the description of C<walkoptree> above for what the debugging flag
763	does.
764
765	=item walksymtable(SYMREF, METHOD, RECURSE)
766
767	Walk the symbol table starting at SYMREF and call METHOD on each
768	symbol visited. When the walk reached package symbols "Foo::" it
769	invokes RECURSE and only recurses into the package if that sub
770	returns true.
771
772	=item svref_2object(SV)
773
774	Takes any Perl variable and turns it into an object in the
775	appropriate B::OP-derived or B::SV-derived class. Apart from functions
776	such as C<main_root>, this is the primary way to get an initial
777	"handle" on a internal perl data structure which can then be followed
778	with the other access methods.
779
780	=item ppname(OPNUM)
781
782	Return the PP function name (e.g. "pp_add") of op number OPNUM.
783
784	=item hash(STR)
785
786	Returns a string in the form "0x..." representing the value of the
787	internal hash function used by perl on string STR.
788
789	=item cast_I32(I)
790
791	Casts I to the internal I32 type used by that perl.
792
793
794	=item minus_c
795
796	Does the equivalent of the C<-c> command-line option. Obviously, this
797	is only useful in a BEGIN block or else the flag is set too late.
798
799
800	=item cstring(STR)
801
802	Returns a double-quote-surrounded escaped version of STR which can
803	be used as a string in C source code.
804
805	=item class(OBJ)
806
807	Returns the class of an object without the part of the classname
808	preceding the first "::". This is used to turn "B::UNOP" into
809	"UNOP" for example.
810
811	=item threadsv_names
812
813	In a perl compiled for threads, this returns a list of the special
814	per-thread threadsv variables.
815
816	=item byteload_fh(FILEHANDLE)
817
818	Load the contents of FILEHANDLE as bytecode. See documentation for
819	the B<Bytecode> module in F<B::Backend> for how to generate bytecode.
820
821	=back
7f20e9dd GS	822
	823	=head1 AUTHOR
	824
	825	Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
	826
	827	=cut