From: Stephen McCamant Date: Tue, 15 Jul 2003 09:57:26 +0000 (-0400) Subject: [PATCH] Increment cop_seqmax in utilize() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=8ec8fbef8c5eb2490dc99115adb2487f3bf9ddab;p=p5sagit%2Fp5-mst-13.2.git [PATCH] Increment cop_seqmax in utilize() Date: Tue, 15 Jul 2003 09:57:26 -0400 Message-ID: <16148.2118.348073.76671@syllepsis.MIT.EDU> Subject: [PATCH] B::Concise 0.56: refcount and BEGIN improvements From: Stephen McCamant Date: Tue, 15 Jul 2003 09:57:31 -0400 Message-ID: <16148.2123.305325.480187@syllepsis.MIT.EDU> p4raw-id: //depot/perl@20166 --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 5014cc9..755c837 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -3,16 +3,23 @@ package B::Concise; # This program is free software; you can redistribute and/or modify it # under the same terms as Perl itself. -use strict; -use warnings; +# Note: we need to keep track of how many use declarations/BEGIN +# blocks this module uses, so we can avoid printing them when user +# asks for the BEGIN blocks in her program. Update the comments and +# the count in concise_specials if you add or delete one. The +# -MO=Concise counts as use #1. -use Exporter (); +use strict; # use #2 +use warnings; # uses #3 and #4, since warnings uses Carp -our $VERSION = "0.55"; +use Exporter (); # use #5 + +our $VERSION = "0.56"; our @ISA = qw(Exporter); our @EXPORT_OK = qw(set_style set_style_standard add_callback - concise_cv concise_main); + concise_subref concise_cv concise_main); +# use #6 use B qw(class ppname main_start main_root main_cv cstring svref_2object SVf_IOK SVf_NOK SVf_POK SVf_IVisUV SVf_FAKE OPf_KIDS CVf_ANON); @@ -61,9 +68,17 @@ sub add_callback { push @callbacks, @_; } -sub concise_cv { - my ($order, $cvref) = @_; - my $cv = svref_2object($cvref); +sub concise_subref { + my($order, $subref) = @_; + concise_cv_obj($order, svref_2object($subref)); +} + +# This should have been called concise_subref, but it was exported +# under this name in versions before 0.56 +sub concise_cv { concise_subref(@_); } + +sub concise_cv_obj { + my ($order, $cv) = @_; $curcv = $cv; sequence($cv->START); if ($order eq "exec") { @@ -92,6 +107,21 @@ sub concise_main { } } +sub concise_specials { + my($name, $order, @cv_s) = @_; + my $i = 1; + if ($name eq "BEGIN") { + splice(@cv_s, 0, 7); # skip 7 BEGIN blocks in this file + } elsif ($name eq "CHECK") { + pop @cv_s; # skip the CHECK block that calls us + } + for my $cv (@cv_s) { + print "$name $i:\n"; + $i++; + concise_cv_obj($order, $cv); + } +} + my $start_sym = "\e(0"; # "\cN" sometimes also works my $end_sym = "\e(B"; # "\cO" respectively @@ -146,10 +176,28 @@ sub compile { return sub { if (@args) { for my $objname (@args) { - $objname = "main::" . $objname unless $objname =~ /::/; - print "$objname:\n"; - eval "concise_cv(\$order, \\&$objname)"; - die "concise_cv($order, \\&$objname) failed: $@" if $@; + if ($objname eq "BEGIN") { + concise_specials("BEGIN", $order, + B::begin_av->isa("B::AV") ? + B::begin_av->ARRAY : ()); + } elsif ($objname eq "INIT") { + concise_specials("INIT", $order, + B::init_av->isa("B::AV") ? + B::init_av->ARRAY : ()); + } elsif ($objname eq "CHECK") { + concise_specials("CHECK", $order, + B::check_av->isa("B::AV") ? + B::check_av->ARRAY : ()); + } elsif ($objname eq "END") { + concise_specials("END", $order, + B::end_av->isa("B::AV") ? + B::end_av->ARRAY : ()); + } else { + $objname = "main::" . $objname unless $objname =~ /::/; + print "$objname:\n"; + eval "concise_subref(\$order, \\&$objname)"; + die "concise_subref($order, \\&$objname) failed: $@" if $@; + } } } if (!@args or $do_main) { @@ -166,7 +214,7 @@ my %opclass = ('OP' => "0", 'UNOP' => "1", 'BINOP' => "2", 'LOGOP' => "|", 'LISTOP' => "@", 'PMOP' => "/", 'SVOP' => "\$", 'GVOP' => "*", 'PVOP' => '"', 'LOOP' => "{", 'COP' => ";", 'PADOP' => "#"); -no warnings 'qw'; # "Possible attempt to put comments..." +no warnings 'qw'; # "Possible attempt to put comments..."; use #7 my @linenoise = qw'# () sc ( @? 1 $* gv *{ m$ m@ m% m? p/ *$ $ $# & a& pt \\ s\\ rf bl ` *? <> ?? ?/ r/ c/ // qr s/ /c y/ = @= C sC Cp sp df un BM po +1 +I @@ -430,8 +478,15 @@ sub concise_op { $h{extarg} = $h{targ} = $op->targ; $h{extarg} = "" unless $h{extarg}; if ($h{name} eq "null" and $h{targ}) { + # targ holds the old type $h{exname} = "ex-" . substr(ppname($h{targ}), 3); $h{extarg} = ""; + } elsif ($op->name =~ /^leave(sub(lv)?|write)?$/) { + # targ potentially holds a reference count + if ($op->private & 64) { + my $refs = "ref" . ($h{targ} != 1 ? "s" : ""); + $h{targarglife} = $h{targarg} = "$h{targ} $refs"; + } } elsif ($h{targ}) { my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}]; if (defined $padname and class($padname) ne "SPECIAL") { @@ -640,7 +695,7 @@ sub tree { # Remember, this needs to stay the last things in the module. # Why is this different for MacOS? Does it matter? -my $cop_seq_mnum = $^O eq 'MacOS' ? 10 : 9; +my $cop_seq_mnum = $^O eq 'MacOS' ? 12 : 11; $cop_seq_base = svref_2object(eval 'sub{0;}')->START->cop_seq + $cop_seq_mnum; 1; @@ -674,7 +729,7 @@ Here's is a short example of output, using the default formatting conventions : % perl -MO=Concise -e '$a = $b + 42' - 8 <@> leave[t1] vKP/REFC ->(end) + 8 <@> leave[1 ref] vKP/REFC ->(end) 1 <0> enter ->2 2 <;> nextstate(main 1 -e:1) v ->3 7 <2> sassign vKS/2 ->8 @@ -709,9 +764,11 @@ Finally an arrow points to the sequence number of the next op. =head1 OPTIONS Arguments that don't start with a hyphen are taken to be the names of -subroutines to print the OPs of; if no such functions are specified, the -main body of the program (outside any subroutines, and not including use'd -or require'd files) is printed. +subroutines to print the OPs of; if no such functions are specified, +the main body of the program (outside any subroutines, and not +including use'd or require'd files) is printed. Passing C, +C, C, or C will cause all of the corresponding +special blocks to be printed. =over 4 diff --git a/ext/B/B/Terse.pm b/ext/B/B/Terse.pm index 5d568f1..401dfc2 100644 --- a/ext/B/B/Terse.pm +++ b/ext/B/B/Terse.pm @@ -1,20 +1,20 @@ package B::Terse; -our $VERSION = '1.01'; +our $VERSION = '1.02'; use strict; use B qw(class); use B::Asmdata qw(@specialsv_name); -use B::Concise qw(concise_cv set_style_standard); +use B::Concise qw(concise_subref set_style_standard); use Carp; sub terse { - my ($order, $cvref) = @_; + my ($order, $subref) = @_; set_style_standard("terse"); if ($order eq "exec") { - concise_cv('exec', $cvref); + concise_subref('exec', $subref); } else { - concise_cv('basic', $cvref); + concise_subref('basic', $subref); } } diff --git a/op.c b/op.c index 304cf46..1366976 100644 --- a/op.c +++ b/op.c @@ -2931,6 +2931,7 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) PL_hints |= HINT_BLOCK_SCOPE; PL_copline = NOLINE; PL_expect = XSTATE; + PL_cop_seqmax++; /* Purely for B::*'s benefit */ } /*