X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/dd6eeb566bc026ec48f300f3234d1d92ca5e566c..216b41c2e7ca756cac276d5de6435f6dac31b86f:/regen/opcode.pl diff --git a/regen/opcode.pl b/regen/opcode.pl index a261661..fe10584 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -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