# License or the Artistic License, as specified in the README file.
#
package B;
-require DynaLoader;
+use XSLoader ();
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);
-
+@ISA = qw(Exporter);
+@EXPORT_OK =
+ qw(minus_c ppname save_BEGINs
+ class peekop cast_I32 cstring cchar hash threadsv_names
+ main_root main_start main_cv svref_2object opnumber amagic_generation
+ walkoptree_slow walkoptree_exec walksymtable
+ parents comppadlist sv_undef compile_stats timing_info
+ begin_av init_av end_av);
+sub OPf_KIDS ();
use strict;
@B::SV::ISA = 'B::OBJECT';
@B::NULL::ISA = 'B::SV';
@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::PADOP::ISA = 'B::OP';
@B::PVOP::ISA = 'B::OP';
@B::CVOP::ISA = 'B::OP';
@B::LOOP::ISA = 'B::LISTOP';
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;
# For debugging
sub peekop {
my $op = shift;
- return sprintf("%s (0x%x) %s", class($op), $$op, $op->ppaddr);
+ return sprintf("%s (0x%x) %s", class($op), $$op, $op->name);
}
sub walkoptree_slow {
}
my %symtable;
+
+sub clearsym {
+ %symtable = ();
+}
+
sub savesym {
my ($obj, $value) = @_;
# warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug
}
savesym($op, sprintf("%s (0x%lx)", class($op), $$op));
$op->$method($level);
- $ppname = $op->ppaddr;
- if ($ppname =~ /^pp_(or|and|mapwhile|grepwhile|entertry)$/) {
+ $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 "pp_match" || $ppname eq "pp_subst") {
+ } 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 "pp_substcont") {
+ } 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 "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") {
+ } elsif ($ppname eq "enterloop") {
print $prefix, "REDO => {\n";
walkoptree_exec($op->redoop, $method, $level + 1);
print $prefix, "}\n", $prefix, "NEXT => {\n";
print $prefix, "}\n", $prefix, "LAST => {\n";
walkoptree_exec($op->lastop, $method, $level + 1);
print $prefix, "}\n";
- } elsif ($ppname eq "pp_subst") {
+ } elsif ($ppname eq "subst") {
my $replstart = $op->pmreplstart;
if ($$replstart) {
print $prefix, "SUBST => {\n";
sub walksymtable {
my ($symref, $method, $recurse, $prefix) = @_;
my $sym;
+ my $ref;
no strict 'vars';
local(*glob);
- while (($sym, *glob) = each %$symref) {
+ $prefix = '' unless defined $prefix;
+ while (($sym, $ref) = each %$symref) {
+ *glob = "*main::".$prefix.$sym;
if ($sym =~ /::$/) {
$sym = $prefix . $sym;
- if ($sym ne "main::" && &$recurse($sym)) {
+ if ($sym ne "main::" && $sym ne "<none>::" && &$recurse($sym)) {
walksymtable(\%glob, $method, $recurse, $sym);
}
} else {
}
}
-bootstrap B;
+XSLoader::load 'B';
1;
=over 4
+=item is_empty
+
+This method returns TRUE if the GP field of the GV is NULL.
+
=item NAME
=item STASH
=item LINE
+=item FILE
+
=item FILEGV
=item GvREFCNT
=item GV
-=item FILEGV
+=item FILE
=item DEPTH
=item CvFLAGS
+=item const_sv
+
=back
=head2 B::HV METHODS
=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.
+B::OP, B::UNOP, B::BINOP, B::LOGOP, B::LISTOP, B::PMOP,
+B::SVOP, B::PADOP, 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
=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. pp_add, pp_rv2av).
+This returns the function name as a string (e.g. "PL_ppaddr[OP_ADD]",
+"PL_ppaddr[OP_RV2AV]").
=item desc
=back
-=head2 B::CONDOP METHODS
-
-=over 4
-
-=item true
-
-=item false
-
-=back
-
=head2 B::LISTOP METHOD
=over 4
=item sv
+=item gv
+
=back
-=head2 B::GVOP METHOD
+=head2 B::PADOP METHOD
=over 4
-=item gv
+=item padix
=back
=item stash
-=item filegv
+=item file
=item cop_seq
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
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
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
https://perl5.git.perl.org / perl5.git / blobdiff