This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/mk_invlists.pl: Add dependency
[perl5.git] / regen / opcode.pl
index a261661..fe10584 100755 (executable)
@@ -122,6 +122,8 @@ 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)],
@@ -409,11 +411,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.
@@ -481,6 +484,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;
@@ -494,6 +504,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) {
@@ -503,6 +515,7 @@ EOF
             next unless defined $e;
             next if ref $e; # bit field, not flag
             push @{$combos{$e}{$bit}}, $op;
+            push @{$ops_using{$e}}, $op;
         }
     }
 
@@ -606,6 +619,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";
+
 }
 
 
@@ -1085,6 +1116,7 @@ my %opclass = (
     '-',  12,          # filestatop
     '}',  13,          # loopexop
     '.',  14,          # methop
+    '+',  15,          # unop_aux
 );
 
 my %opflags = (
@@ -1104,6 +1136,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;
@@ -1133,8 +1166,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"
@@ -1174,6 +1208,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) = @_;