diff options
Diffstat (limited to 'contrib/perl5/ext/B/B.pm')
-rw-r--r-- | contrib/perl5/ext/B/B.pm | 104 |
1 files changed, 49 insertions, 55 deletions
diff --git a/contrib/perl5/ext/B/B.pm b/contrib/perl5/ext/B/B.pm index 75dcfb3..4512d91 100644 --- a/contrib/perl5/ext/B/B.pm +++ b/contrib/perl5/ext/B/B.pm @@ -6,15 +6,15 @@ # 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 +@ISA = qw(Exporter); +@EXPORT_OK = qw(minus_c ppname class peekop cast_I32 cstring cchar hash threadsv_names - main_root main_start main_cv svref_2object + 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'; @@ -38,10 +38,9 @@ use strict; @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'; @@ -65,10 +64,6 @@ sub debug { 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; @@ -81,7 +76,7 @@ sub parents { \@parents } # 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 { @@ -112,6 +107,11 @@ sub timing_info { } my %symtable; + +sub clearsym { + %symtable = (); +} + sub savesym { my ($obj, $value) = @_; # warn(sprintf("savesym: sym_%x => %s\n", $$obj, $value)); # debug @@ -135,37 +135,26 @@ sub walkoptree_exec { } 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"; @@ -173,7 +162,7 @@ sub walkoptree_exec { 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"; @@ -187,9 +176,12 @@ sub walkoptree_exec { 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)) { @@ -267,7 +259,7 @@ sub walksymtable { } } -bootstrap B; +XSLoader::load 'B'; 1; @@ -428,6 +420,10 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>). =over 4 +=item is_empty + +This method returns TRUE if the GP field of the GV is NULL. + =item NAME =item STASH @@ -450,6 +446,8 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>). =item LINE +=item FILE + =item FILEGV =item GvREFCNT @@ -518,7 +516,7 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>). =item GV -=item FILEGV +=item FILE =item DEPTH @@ -556,8 +554,8 @@ C<REFCNT> (corresponding to the C function C<SvREFCNT>). =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 @@ -572,9 +570,14 @@ leading "class indication" prefix removed (op_). =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 @@ -617,16 +620,6 @@ This returns the op description from the global C PL_op_desc array =back -=head2 B::CONDOP METHODS - -=over 4 - -=item true - -=item false - -=back - =head2 B::LISTOP METHOD =over 4 @@ -661,13 +654,15 @@ This returns the op description from the global C PL_op_desc array =item sv +=item gv + =back -=head2 B::GVOP METHOD +=head2 B::PADOP METHOD =over 4 -=item gv +=item padix =back @@ -699,7 +694,7 @@ This returns the op description from the global C PL_op_desc array =item stash -=item filegv +=item file =item cop_seq @@ -751,6 +746,10 @@ Returns the SV object corresponding to the C variable C<sv_yes>. 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 @@ -817,11 +816,6 @@ preceding the first "::". This is used to turn "B::UNOP" into 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 |