Quell "used only once" warning in test suite

[perl5.git] / regen / opcode.pl

diff --git a/regen/opcode.pl b/regen/opcode.pl
index 10c708b..82454bb 100755 (executable)
--- a/regen/opcode.pl
+++ b/regen/opcode.pl
@@ -78,7 +78,7 @@ my %alias;
 # Format is "this function" => "does these op names"
 my @raw_alias = (
                 Perl_do_kv => [qw( keys values )],
-                Perl_unimplemented_op => [qw(padany mapstart custom)],
+                Perl_unimplemented_op => [qw(padany custom)],
                 # All the ops with a body of { return NORMAL; }
                 Perl_pp_null => [qw(scalar regcmaybe lineseq scope)],
 
@@ -122,19 +122,23 @@ my @raw_alias = (
                 Perl_pp_shift => ['pop'],
                 Perl_pp_sin => [qw(cos exp log sqrt)],
                 Perl_pp_bit_or => ['bit_xor'],
+                Perl_pp_nbit_or => ['nbit_xor'],
+                Perl_pp_sbit_or => ['sbit_xor'],
                 Perl_pp_rv2av => ['rv2hv'],
                 Perl_pp_akeys => ['avalues'],
-                Perl_pp_rkeys => [qw(rvalues reach)],
                 Perl_pp_trans => [qw(trans transr)],
                 Perl_pp_chop => [qw(chop chomp)],
                 Perl_pp_schop => [qw(schop schomp)],
                 Perl_pp_bind => {connect => '#ifdef HAS_SOCKET'},
-                Perl_pp_preinc => ['i_preinc', 'predec', 'i_predec'],
-                Perl_pp_postinc => ['i_postinc', 'postdec', 'i_postdec'],
+                Perl_pp_preinc => ['i_preinc'],
+                Perl_pp_predec => ['i_predec'],
+                Perl_pp_postinc => ['i_postinc'],
+                Perl_pp_postdec => ['i_postdec'],
                 Perl_pp_ehostent => [qw(enetent eprotoent eservent
                                         spwent epwent sgrent egrent)],
                 Perl_pp_shostent => [qw(snetent sprotoent sservent)],
                 Perl_pp_aelemfast => ['aelemfast_lex'],
+                Perl_pp_grepstart => ['mapstart'],
                );
 
 while (my ($func, $names) = splice @raw_alias, 0, 2) {
@@ -408,11 +412,12 @@ sub print_B_Op_private {
 @
 @=head1 DESCRIPTION
 @
-@This module provides three global hashes:
+@This module provides four global hashes:
 @
 @    %B::Op_private::bits
 @    %B::Op_private::defines
 @    %B::Op_private::labels
+@    %B::Op_private::ops_using
 @
 @which contain information about the per-op meanings of the bits in the
 @op_private field.
@@ -480,6 +485,13 @@ sub print_B_Op_private {
 @If the label equals '-', then Concise will treat the bit as a raw bit and
 @not try to display it symbolically.
 @
+@=head2 C<%ops_using>
+@
+@For each define, this gives a reference to an array of op names that use
+@the flag.
+@
+@    @ops_using_lvintro = @{ $B::Op_private::ops_using{OPp_LVAL_INTRO} };
+@
 @=cut
 
 package B::Op_private;
@@ -493,6 +505,8 @@ EOF
     my $v = (::perl_version())[3];
     print $fh qq{\nour \$VERSION = "$v";\n\n};
 
+    my %ops_using;
+
     # for each flag/bit combination, find the ops which use it
     my %combos;
     for my $op (sort keys %FLAGS) {
@@ -502,6 +516,7 @@ EOF
             next unless defined $e;
             next if ref $e; # bit field, not flag
             push @{$combos{$e}{$bit}}, $op;
+            push @{$ops_using{$e}}, $op;
         }
     }
 
@@ -605,6 +620,24 @@ EOF
     printf $fh "    %-23s  => '%s',\n", $_ , $LABELS{$_}  for sort keys %LABELS;
     print  $fh ");\n";
 
+    # %ops_using
+    print  $fh "\n\nour %ops_using = (\n";
+    # Save memory by using the same array wherever possible.
+    my %flag_by_op_list;
+    my $pending = '';
+    for my $flag (sort keys %ops_using) {
+        my $op_list = $ops_using{$flag} = "@{$ops_using{$flag}}";
+        if (!exists $flag_by_op_list{$op_list}) {
+            $flag_by_op_list{$op_list} = $flag;
+            printf $fh "    %-23s  => %s,\n", $flag , "[qw($op_list)]"
+        }
+        else {
+            $pending .= "\$ops_using{$flag} = "
+                      . "\$ops_using{$flag_by_op_list{$op_list}};\n";
+        }
+    }
+    print  $fh ");\n\n$pending";
+
 }
 
 
@@ -685,6 +718,8 @@ sub print_PL_op_private_tables {
         my $bitdef_count = 0;
 
         my %not_seen = %FLAGS;
+        my @seen_bitdefs;
+        my %seen_bitdefs;
 
         my $opnum = -1;
         for my $op (sort { $opnum{$a} <=> $opnum{$b} } keys %opnum) {
@@ -724,11 +759,17 @@ sub print_PL_op_private_tables {
             }
             if (@bitdefs) {
                 $bitdefs[-1] |= 1; # stop bit
-                $index = $bitdef_count;
-                $bitdef_count += @bitdefs;
-                $PL_op_private_bitdefs .= sprintf "    /* %-13s */ %s,\n",
-                        $op,
-                        join(', ', map(sprintf("0x%04x", $_), @bitdefs));
+                my $key = join(', ', map(sprintf("0x%04x", $_), @bitdefs));
+                if (!$seen_bitdefs{$key}) {
+                    $index = $bitdef_count;
+                    $bitdef_count += @bitdefs;
+                    push @seen_bitdefs,
+                         $seen_bitdefs{$key} = [$index, $key];
+                }
+                else {
+                    $index = $seen_bitdefs{$key}[0];
+                }
+                push @{$seen_bitdefs{$key}}, $op;
             }
             else {
                 $index = -1;
@@ -738,6 +779,10 @@ sub print_PL_op_private_tables {
         if (%not_seen) {
             die "panic: unprocessed ops: ". join(',', keys %not_seen);
         }
+        for (@seen_bitdefs) {
+            local $" = ", ";
+            $PL_op_private_bitdefs .= "    $$_[1], /* @$_[2..$#$_] */\n";
+        }
     }
 
 
@@ -801,7 +846,7 @@ $PL_op_private_labels
 
 
 /* PL_op_private_bitfields[]: details about each bit field type.
- * Each defintition consists of the following list of words:
+ * Each definition consists of the following list of words:
  *    bitmin
  *    label (index into PL_op_private_labels[]; -1 if no label)
  *    repeat for each enum entry (if any):
@@ -1072,6 +1117,7 @@ my %opclass = (
     '-',  12,          # filestatop
     '}',  13,          # loopexop
     '.',  14,          # methop
+    '+',  15,          # unop_aux
 );
 
 my %opflags = (
@@ -1082,7 +1128,7 @@ my %opflags = (
     'T' =>   8 | 16,   # ... which may be lexical
     'i' =>   0,                # always produces integer (unused since e7311069)
     'I' =>  32,                # has corresponding int op
-    'd' =>  64,                # danger, unknown side effects
+    'd' =>  64,                # danger, make temp copy in list assignment
     'u' => 128,                # defaults to $_
 );
 
@@ -1091,6 +1137,7 @@ my %OP_IS_FILETEST;       # /F-/
 my %OP_IS_FT_ACCESS;   # /F-+/
 my %OP_IS_NUMCOMPARE;  # /S</
 my %OP_IS_DIRHOP;      # /Fd/
+my %OP_IS_INFIX_BIT;   # /S\|/
 
 my $OCSHIFT = 8;
 my $OASHIFT = 12;
@@ -1120,8 +1167,9 @@ for my $op (@ops) {
            $OP_IS_FILETEST{$op} = $opnum{$op} if $arg =~ s/-//;
            $OP_IS_FT_ACCESS{$op} = $opnum{$op} if $arg =~ s/\+//;
         }
-       elsif ($arg =~ /^S</) {
+       elsif ($arg =~ /^S./) {
            $OP_IS_NUMCOMPARE{$op} = $opnum{$op} if $arg =~ s/<//;
+           $OP_IS_INFIX_BIT {$op} = $opnum{$op} if $arg =~ s/\|//;
        }
        my $argnum = ($arg =~ s/\?//) ? 8 : 0;
         die "op = $op, arg = $arg\n"
@@ -1161,6 +1209,7 @@ gen_op_is_macro( \%OP_IS_FILETEST, 'OP_IS_FILETEST');
 gen_op_is_macro( \%OP_IS_FT_ACCESS, 'OP_IS_FILETEST_ACCESS');
 gen_op_is_macro( \%OP_IS_NUMCOMPARE, 'OP_IS_NUMCOMPARE');
 gen_op_is_macro( \%OP_IS_DIRHOP, 'OP_IS_DIRHOP');
+gen_op_is_macro( \%OP_IS_INFIX_BIT, 'OP_IS_INFIX_BIT');
 
 sub gen_op_is_macro {
     my ($op_is, $macname) = @_;