[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 <smcc@mit.edu>
Date: Tue, 15 Jul 2003 09:57:31 -0400
Message-ID: <16148.2123.305325.480187@syllepsis.MIT.EDU>

p4raw-id: //depot/perl@20166

3 files changed, 81 insertions, 23 deletions

diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 5014cc9874..755c837d32 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<BEGIN>,
+C<CHECK>, C<INIT>, or C<END> 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 5d568f1269..401dfc2668 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 304cf4695f..1366976c1f 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 */
 }
 
 /*