X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB.pm;h=b39659d1c9cc60a9391fc7f4a78c822386f21b94;hb=445a12f622bad7d38f7d9dd52674ccc07f19205c;hp=0fff04de87271d2bef6d6b288a673f3c06cd4781;hpb=4369b1735f5aa251358acad5be8ee26dfbfb02ef;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B.pm b/ext/B/B.pm index 0fff04d..b39659d 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -9,12 +9,12 @@ package B; require DynaLoader; require Exporter; @ISA = qw(Exporter DynaLoader); -@EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname +@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); - + 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,7 +38,6 @@ 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'; @@ -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; @@ -136,7 +131,9 @@ 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)$/) { + if ($ppname =~ + /^pp_(or|and|mapwhile|grepwhile|entertry|range|cond_expr)$/) + { print $prefix, uc($1), " => {\n"; walkoptree_exec($op->other, $method, $level + 1); print $prefix, "}\n"; @@ -152,19 +149,6 @@ sub walkoptree_exec { 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); @@ -187,9 +171,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)) { @@ -556,7 +543,7 @@ C (corresponding to the C function C). =head2 OP-RELATED CLASSES -B::OP, B::UNOP, B::BINOP, B::LOGOP, B::CONDOP, B::LISTOP, B::PMOP, +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 @@ -617,16 +604,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 @@ -722,6 +699,10 @@ get an initial "handle" on an internal object. 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 @@ -747,6 +728,10 @@ Returns the SV object corresponding to the C variable C. Returns the SV object corresponding to the C variable C. +=item amagic_generation + +Returns the SV object corresponding to the C variable C. + =item walkoptree(OP, METHOD) Does a tree-walk of the syntax tree based at OP and calls METHOD on @@ -813,11 +798,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 module in F for how to generate bytecode. - =back =head1 AUTHOR