diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/B')
-rw-r--r-- | Master/tlpkg/tlperl/lib/B/Concise.pm | 173 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/B/Debug.pm | 2 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/B/Deparse.pm | 452 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/B/Op_private.pm | 278 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/B/Terse.pm | 4 | ||||
-rw-r--r-- | Master/tlpkg/tlperl/lib/B/Xref.pm | 4 |
6 files changed, 602 insertions, 311 deletions
diff --git a/Master/tlpkg/tlperl/lib/B/Concise.pm b/Master/tlpkg/tlperl/lib/B/Concise.pm index 311e0e738a9..315e00a4b67 100644 --- a/Master/tlpkg/tlperl/lib/B/Concise.pm +++ b/Master/tlpkg/tlperl/lib/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.996"; +our $VERSION = "0.999"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -28,6 +28,8 @@ our %EXPORT_TAGS = # 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 OPf_SPECIAL + OPf_STACKED + OPpSPLIT_ASSIGN OPpSPLIT_LEX CVf_ANON PAD_FAKELEX_ANON PAD_FAKELEX_MULTI SVf_ROK); my %style = @@ -595,31 +597,43 @@ require B::Op_private; our %hints; # used to display each COP's op_hints values # strict refs, subs, vars -@hints{2,512,1024,32,64,128} = ('$', '&', '*', 'x$', 'x&', 'x*'); +@hints{0x2,0x200,0x400,0x20,0x40,0x80} = ('$', '&', '*', 'x$', 'x&', 'x*'); # integers, locale, bytes -@hints{1,4,8,16} = ('i', 'l', 'b'); +@hints{0x1,0x4,0x8,0x10} = ('i', 'l', 'b'); # block scope, localise %^H, $^OPEN (in), $^OPEN (out) -@hints{256,131072,262144,524288} = ('{','%','<','>'); +@hints{0x100,0x20000,0x40000,0x80000} = ('{','%','<','>'); # overload new integer, float, binary, string, re -@hints{4096,8192,16384,32768,65536} = ('I', 'F', 'B', 'S', 'R'); +@hints{0x1000,0x2000,0x4000,0x8000,0x10000} = ('I', 'F', 'B', 'S', 'R'); # taint and eval -@hints{1048576,2097152} = ('T', 'E'); -# filetest access, UTF-8 -@hints{4194304,8388608} = ('X', 'U'); +@hints{0x100000,0x200000} = ('T', 'E'); +# filetest access, use utf8, unicode_strings feature +@hints{0x400000,0x800000,0x800} = ('X', 'U', 'us'); -sub _flags { - my($hash, $x) = @_; +# pick up the feature hints constants. +# Note that we're relying on non-API parts of feature.pm, +# but its less naughty than just blindly copying those constants into +# this src file. +# +require feature; + +sub hints_flags { + my($x) = @_; my @s; - for my $flag (sort {$b <=> $a} keys %$hash) { - if ($hash->{$flag} and $x & $flag and $x >= $flag) { + for my $flag (sort {$b <=> $a} keys %hints) { + if ($hints{$flag} and $x & $flag and $x >= $flag) { $x -= $flag; - push @s, $hash->{$flag}; + push @s, $hints{$flag}; } } - push @s, $x if $x; + if ($x & $feature::hint_mask) { + push @s, "fea=" . (($x & $feature::hint_mask) >> $feature::hint_shift); + $x &= ~$feature::hint_mask; + } + push @s, sprintf "0x%x", $x if $x; return join(",", @s); } + # return a string like 'LVINTRO,1' for the op $name with op_private # value $x @@ -677,11 +691,6 @@ sub private_flags { return join ",", @flags; } -sub hints_flags { - my($x) = @_; - _flags(\%hints, $x); -} - sub concise_sv { my($sv, $hr, $preferpv) = @_; $hr->{svclass} = class($sv); @@ -755,6 +764,50 @@ sub fill_srclines { $srclines{$fullnm} = \@l; } +# Given a pad target, return the pad var's name and cop range / +# fakeness, or failing that, its target number. +# e.g. +# ('$i', '$i:5,7') +# or +# ('$i', '$i:fake:a') +# or +# ('t5', 't5') + +sub padname { + my ($targ) = @_; + + my ($targarg, $targarglife); + my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$targ]; + if (defined $padname and class($padname) ne "SPECIAL" and + $padname->LEN) + { + $targarg = $padname->PVX; + if ($padname->FLAGS & SVf_FAKE) { + # These changes relate to the jumbo closure fix. + # See changes 19939 and 20005 + my $fake = ''; + $fake .= 'a' + if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON; + $fake .= 'm' + if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI; + $fake .= ':' . $padname->PARENT_PAD_INDEX + if $curcv->CvFLAGS & CVf_ANON; + $targarglife = "$targarg:FAKE:$fake"; + } + else { + my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base; + my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base; + $finish = "end" if $finish == 999999999 - $cop_seq_base; + $targarglife = "$targarg:$intro,$finish"; + } + } else { + $targarglife = $targarg = "t" . $targ; + } + return $targarg, $targarglife; +} + + + sub concise_op { my ($op, $level, $format) = @_; my %h; @@ -787,39 +840,14 @@ sub concise_op { : 1; my (@targarg, @targarglife); for my $i (0..$count-1) { - my ($targarg, $targarglife); - my $padname = (($curcv->PADLIST->ARRAY)[0]->ARRAY)[$h{targ}+$i]; - if (defined $padname and class($padname) ne "SPECIAL" and - $padname->LEN) - { - $targarg = $padname->PVX; - if ($padname->FLAGS & SVf_FAKE) { - # These changes relate to the jumbo closure fix. - # See changes 19939 and 20005 - my $fake = ''; - $fake .= 'a' - if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_ANON; - $fake .= 'm' - if $padname->PARENT_FAKELEX_FLAGS & PAD_FAKELEX_MULTI; - $fake .= ':' . $padname->PARENT_PAD_INDEX - if $curcv->CvFLAGS & CVf_ANON; - $targarglife = "$targarg:FAKE:$fake"; - } - else { - my $intro = $padname->COP_SEQ_RANGE_LOW - $cop_seq_base; - my $finish = int($padname->COP_SEQ_RANGE_HIGH) - $cop_seq_base; - $finish = "end" if $finish == 999999999 - $cop_seq_base; - $targarglife = "$targarg:$intro,$finish"; - } - } else { - $targarglife = $targarg = "t" . ($h{targ}+$i); - } + my ($targarg, $targarglife) = padname($h{targ} + $i); push @targarg, $targarg; push @targarglife, $targarglife; } $h{targarg} = join '; ', @targarg; $h{targarglife} = join '; ', @targarglife; } + $h{arg} = ""; $h{svclass} = $h{svaddr} = $h{svval} = ""; if ($h{class} eq "PMOP") { @@ -837,22 +865,35 @@ sub concise_op { $extra = " replstart->" . seq($op->pmreplstart); } } - elsif ($op->name eq 'pushre') { - # with C<@stash_array = split(/pat/, str);>, - # *stash_array is stored in /pat/'s pmreplroot. - my $gv = $op->pmreplroot; - if (!ref($gv)) { - # threaded: the value is actually a pad offset for where - # the GV is kept (op_pmtargetoff) - if ($gv) { - $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME; - } - } - else { - # unthreaded: its a GV (if it exists) - $gv = (ref($gv) eq "B::GV") ? $gv->NAME : undef; - } - $extra = " => \@$gv" if $gv; + elsif ($op->name eq 'split') { + if ( ($op->private & OPpSPLIT_ASSIGN) # @array = split + && (not $op->flags & OPf_STACKED)) # @{expr} = split + { + # with C<@array = split(/pat/, str);>, + # array is stored in /pat/'s pmreplroot; either + # as an integer index into the pad (for a lexical array) + # or as GV for a package array (which will be a pad index + # on threaded builds) + + if ($op->private & $B::Op_private::defines{'OPpSPLIT_LEX'}) { + my $off = $op->pmreplroot; # union with op_pmtargetoff + my ($name, $full) = padname($off); + $extra = " => $full"; + } + else { + # union with op_pmtargetoff, op_pmtargetgv + my $gv = $op->pmreplroot; + if (!ref($gv)) { + # the value is actually a pad offset + $gv = (($curcv->PADLIST->ARRAY)[1]->ARRAY)[$gv]->NAME; + } + else { + # unthreaded: its a GV + $gv = $gv->NAME; + } + $extra = " => \@$gv"; + } + } } $h{arg} = "($precomp$extra)"; } elsif ($h{class} eq "PVOP" and $h{name} !~ '^transr?\z') { @@ -884,6 +925,11 @@ sub concise_op { undef $lastnext; $h{arg} = "(other->" . seq($op->other) . ")"; $h{otheraddr} = sprintf("%#x", $ {$op->other}); + if ($h{name} eq "argdefelem") { + # targ used for element index + $h{targarglife} = $h{targarg} = ""; + $h{arg} .= "[" . $op->targ . "]"; + } } elsif ($h{class} eq "SVOP" or $h{class} eq "PADOP") { unless ($h{name} eq 'aelemfast' and $op->flags & OPf_SPECIAL) { @@ -1591,6 +1637,9 @@ string if this is not a COP. Here are the symbols used: X filetest access U utf-8 + us use feature 'unicode_strings' + fea=NNN feature bundle number + =item B<#hintsval> The numeric value of the COP's hint flags, or an empty string if this is not diff --git a/Master/tlpkg/tlperl/lib/B/Debug.pm b/Master/tlpkg/tlperl/lib/B/Debug.pm index fd66405bac3..e295635d359 100644 --- a/Master/tlpkg/tlperl/lib/B/Debug.pm +++ b/Master/tlpkg/tlperl/lib/B/Debug.pm @@ -1,6 +1,6 @@ package B::Debug; -our $VERSION = '1.23'; +our $VERSION = '1.24'; use strict; require 5.006; diff --git a/Master/tlpkg/tlperl/lib/B/Deparse.pm b/Master/tlpkg/tlperl/lib/B/Deparse.pm index 9879d678b17..3166415b54a 100644 --- a/Master/tlpkg/tlperl/lib/B/Deparse.pm +++ b/Master/tlpkg/tlperl/lib/B/Deparse.pm @@ -16,6 +16,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring OPpTRANS_SQUASH OPpTRANS_DELETE OPpTRANS_COMPLEMENT OPpTARGET_MY OPpEXISTS_SUB OPpSORT_NUMERIC OPpSORT_INTEGER OPpREPEAT_DOLIST OPpSORT_REVERSE OPpMULTIDEREF_EXISTS OPpMULTIDEREF_DELETE + OPpSPLIT_ASSIGN OPpSPLIT_LEX SVf_IOK SVf_NOK SVf_ROK SVf_POK SVpad_OUR SVf_FAKE SVs_RMG SVs_SMG SVs_PADTMP SVpad_TYPED CVf_METHOD CVf_LVALUE @@ -46,7 +47,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring MDEREF_SHIFT ); -$VERSION = '1.37'; +$VERSION = '1.40'; use strict; use vars qw/$AUTOLOAD/; use warnings (); @@ -460,6 +461,7 @@ sub _pessimise_walk_exe { sub pessimise { my ($self, $root, $start) = @_; + no warnings 'recursion'; # walk tree in root-to-branch order $self->_pessimise_walk($root); @@ -474,6 +476,9 @@ sub null { return class($op) eq "NULL"; } + +# Add a CV to the list of subs that still need deparsing. + sub todo { my $self = shift; my($cv, $is_form, $name) = @_; @@ -490,55 +495,27 @@ sub todo { push @{$self->{'subs_todo'}}, [$seq, $cv, $is_form, $name]; } + +# Pop the next sub from the todo list and deparse it + sub next_todo { my $self = shift; my $ent = shift @{$self->{'subs_todo'}}; - my $cv = $ent->[1]; - if (ref $ent->[3]) { # lexical sub - my @text; + my ($seq, $cv, $is_form, $name) = @$ent; - # At this point, we may not yet have deparsed the hints that allow - # lexical subroutines to be recognized. So adjust the current - # hints and deparse them. - # When lex subs cease being experimental, we should be able to - # remove this code. - { - local $^H = $self->{'hints'}; - local %^H = %{ $self->{'hinthash'} || {} }; - local ${^WARNING_BITS} = $self->{'warnings'}; - feature->import("lexical_subs"); - warnings->unimport("experimental::lexical_subs"); - # Here we depend on the fact that individual features - # will always set the feature bundle to ‘custom’ - # (== $feature::hint_mask). If we had another specific bundle - # enabled previously, normalise it. - if (($self->{'hints'} & $feature::hint_mask) - != $feature::hint_mask) - { - if ($self->{'hinthash'}) { - delete $self->{'hinthash'}{$_} - for grep /^feature_/, keys %{$self->{'hinthash'}}; - } - else { $self->{'hinthash'} = {} } - $self->{'hinthash'} - = _features_from_bundle(@$self{'hints','hinthash'}); - } - push @text, $self->declare_hinthash($self->{'hinthash'}, \%^H, - $self->{indent_size}, $^H); - push @text, $self->declare_warnings($self->{'warnings'}, - ${^WARNING_BITS}) - unless ($self->{'warnings'} // 'u') - eq (${^WARNING_BITS } // 'u'); - $self->{'warnings'} = ${^WARNING_BITS}; - $self->{'hints'} = $^H; - $self->{'hinthash'} = {%^H}; - } + # any 'use strict; package foo' that should come before the sub + # declaration to sync with the first COP of the sub + my $pragmata = ''; + if ($cv and !null($cv->START) and is_state($cv->START)) { + $pragmata = $self->pragmata($cv->START); + } - # Now emit the sub itself. - my $padname = $ent->[3]; - my $flags = $padname->FLAGS; + if (ref $name) { # lexical sub + # emit the sub. + my @text; + my $flags = $name->FLAGS; push @text, - !$cv || $ent->[0] <= $padname->COP_SEQ_RANGE_LOW + !$cv || $seq <= $name->COP_SEQ_RANGE_LOW ? $self->keyword($flags & SVpad_OUR ? "our" : $flags & SVpad_STATE @@ -548,7 +525,7 @@ sub next_todo { # XXX We would do $self->keyword("sub"), but ‘my CORE::sub’ # doesn’t work and ‘my sub’ ignores a &sub in scope. I.e., # we have a core bug here. - push @text, "sub " . substr $padname->PVX, 1; + push @text, "sub " . substr $name->PVX, 1; if ($cv) { # my sub foo { } push @text, " " . $self->deparse_sub($cv); @@ -558,19 +535,31 @@ sub next_todo { # my sub foo; push @text, ";\n"; } - return join "", @text; + return $pragmata . join "", @text; } + my $gv = $cv->GV; - my $name = $ent->[3] // $self->gv_name($gv); - if ($ent->[2]) { - return $self->keyword("format") . " $name =\n" - . $self->deparse_format($ent->[1]). "\n"; + $name //= $self->gv_name($gv); + if ($is_form) { + return $pragmata . $self->keyword("format") . " $name =\n" + . $self->deparse_format($cv). "\n"; } else { my $use_dec; if ($name eq "BEGIN") { $use_dec = $self->begin_is_use($cv); if (defined ($use_dec) and $self->{'expand'} < 5) { - return () if 0 == length($use_dec); + return $pragmata if 0 == length($use_dec); + + # XXX bit of a hack: Test::More's use_ok() method + # builds a fake use statement which deparses as, e.g. + # use Net::Ping (@{$args[0];}); + # As well as being superfluous (the use_ok() is deparsed + # too) and ugly, it fails under use strict and otherwise + # makes use of a lexical var that's not in scope. + # So strip it out. + return $pragmata + if $use_dec =~ /^use \S+ \(@\{\$args\[0\];\}\);/; + $use_dec =~ s/^(use|no)\b/$self->keyword($1)/e; } } @@ -591,7 +580,7 @@ sub next_todo { } } if ($use_dec) { - return "$p$l$use_dec"; + return "$pragmata$p$l$use_dec"; } if ( $name !~ /::/ and $self->lex_in_scope("&$name") || $self->lex_in_scope("&$name", 1) ) @@ -600,13 +589,14 @@ sub next_todo { } elsif (defined $stash) { $name =~ s/^\Q$stash\E::(?!\z|.*::)//; } - my $ret = "${p}${l}" . $self->keyword("sub") . " $name " + my $ret = "$pragmata${p}${l}" . $self->keyword("sub") . " $name " . $self->deparse_sub($cv); $self->{'subs_declared'}{$name} = 1; return $ret; } } + # Return a "use" declaration for this BEGIN block, if appropriate sub begin_is_use { my ($self, $cv) = @_; @@ -1221,22 +1211,132 @@ sub pad_subs { sort {$a->[0] <=> $b->[0]} @{$self->{'subs_todo'}}, @todo } + +# deparse_argops(): deparse, if possible, a sequence of argcheck + argelem +# ops into a subroutine signature. If successful, return the first op +# following the signature ops plus the signature string; else return the +# empty list. +# +# Normally a bunch of argelem ops will have been generated by the +# signature parsing, but it's possible that ops have been added manually +# or altered. In this case we "return ()" and fall back to general +# deparsing of the individual sigelems as 'my $x = $_[N]' etc. +# +# We're only called if the first two ops are nextstate and argcheck. + +sub deparse_argops { + my ($self, $firstop, $cv) = @_; + + my @sig; + my $o = $firstop; + return if $o->label; #first nextstate; + + # OP_ARGCHECK + + $o = $o->sibling; + my ($params, $opt_params, $slurpy) = $o->aux_list($cv); + my $mandatory = $params - $opt_params; + my $seen_slurpy = 0; + my $last_ix = -1; + + # keep looking for valid nextstate + argelem pairs + + while (1) { + # OP_NEXTSTATE + $o = $o->sibling; + last unless $$o; + last unless $o->name =~ /^(next|db)state$/; + last if $o->label; + + # OP_ARGELEM + my $o2 = $o->sibling; + last unless $$o2; + + if ($o2->name eq 'argelem') { + my $ix = $o2->string($cv); + while (++$last_ix < $ix) { + push @sig, $last_ix < $mandatory ? '$' : '$='; + } + my $var = $self->padname($o2->targ); + if ($var =~ /^[@%]/) { + return if $seen_slurpy; + $seen_slurpy = 1; + return if $ix != $params or !$slurpy + or substr($var,0,1) ne $slurpy; + } + else { + return if $ix >= $params; + } + if ($o2->flags & OPf_KIDS) { + my $kid = $o2->first; + return unless $$kid and $kid->name eq 'argdefelem'; + my $def = $self->deparse($kid->first, 7); + $def = "($def)" if $kid->first->flags & OPf_PARENS; + $var .= " = $def"; + } + push @sig, $var; + } + elsif ($o2->name eq 'null' + and ($o2->flags & OPf_KIDS) + and $o2->first->name eq 'argdefelem') + { + # special case - a void context default expression: $ = expr + + my $defop = $o2->first; + my $ix = $defop->targ; + while (++$last_ix < $ix) { + push @sig, $last_ix < $mandatory ? '$' : '$='; + } + return if $last_ix >= $params + or $last_ix < $mandatory; + my $def = $self->deparse($defop->first, 7); + $def = "($def)" if $defop->first->flags & OPf_PARENS; + push @sig, '$ = ' . $def; + } + else { + last; + } + + $o = $o2; + } + + while (++$last_ix < $params) { + push @sig, $last_ix < $mandatory ? '$' : '$='; + } + push @sig, $slurpy if $slurpy and !$seen_slurpy; + + return ($o, join(', ', @sig)); +} + +# Deparse a sub. Returns everything except the 'sub foo', +# e.g. ($$) : method { ...; } +# or ($a, $b) : prototype($$) lvalue; + sub deparse_sub { my $self = shift; my $cv = shift; - my $proto = ""; + my @attrs; + my $protosig; # prototype or signature (what goes in the (....)) + Carp::confess("NULL in deparse_sub") if !defined($cv) || $cv->isa("B::NULL"); Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); local $self->{'curcop'} = $self->{'curcop'}; + + my $has_sig = $self->{hinthash}{feature_signatures}; if ($cv->FLAGS & SVf_POK) { - $proto = "(". $cv->PV . ") "; + my $proto = $cv->PV; + if ($has_sig) { + push @attrs, "prototype($proto)"; + } + else { + $protosig = $proto; + } } if ($cv->CvFLAGS & (CVf_METHOD|CVf_LOCKED|CVf_LVALUE|CVf_ANONCONST)) { - $proto .= ": "; - $proto .= "lvalue " if $cv->CvFLAGS & CVf_LVALUE; - $proto .= "locked " if $cv->CvFLAGS & CVf_LOCKED; - $proto .= "method " if $cv->CvFLAGS & CVf_METHOD; - $proto .= "const " if $cv->CvFLAGS & CVf_ANONCONST; + push @attrs, "lvalue" if $cv->CvFLAGS & CVf_LVALUE; + push @attrs, "locked" if $cv->CvFLAGS & CVf_LOCKED; + push @attrs, "method" if $cv->CvFLAGS & CVf_METHOD; + push @attrs, "const" if $cv->CvFLAGS & CVf_ANONCONST; } local($self->{'curcv'}) = $cv; @@ -1251,11 +1351,36 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); $self->pessimise($root, $cv->START); my $lineseq = $root->first; if ($lineseq->name eq "lineseq") { - my @ops; - for(my$o=$lineseq->first; $$o; $o=$o->sibling) { + my $firstop = $lineseq->first; + + if ($has_sig) { + my $o2; + # try to deparse first few ops as a signature if possible + if ( $$firstop + and $firstop->name =~ /^(next|db)state$/ + and (($o2 = $firstop->sibling)) + and $$o2) + { + if ($o2->name eq 'argcheck') { + my ($nexto, $sig) = $self->deparse_argops($firstop, $cv); + if (defined $nexto) { + $firstop = $nexto; + $protosig = $sig; + } + } + } + } + + my @ops; + for (my $o = $firstop; $$o; $o=$o->sibling) { push @ops, $o; } $body = $self->lineseq(undef, 0, @ops).";"; + if (!$has_sig and $ops[-1]->name =~ /^(next|db)state$/) { + # this handles void context in + # use feature signatures; sub ($=1) {} + $body .= "\n()"; + } my $scope_en = $self->find_scope_en($lineseq); if (defined $scope_en) { my $subs = join"", $self->seq_subs($scope_en); @@ -1265,17 +1390,21 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); else { $body = $self->deparse($root->first, 0); } + $body = "{\n\t$body\n\b}"; } else { my $sv = $cv->const_sv; if ($$sv) { # uh-oh. inlinable sub... format it differently - return $proto . "{ " . $self->const($sv, 0) . " }\n"; + $body = "{ " . $self->const($sv, 0) . " }\n"; } else { # XSUB? (or just a declaration) - return "$proto;\n"; + $body = ';' } } - return $proto ."{\n\t$body\n\b}" ."\n"; + $protosig = defined $protosig ? "($protosig) " : ""; + my $attrs = ''; + $attrs = ': ' . join('', map "$_ ", @attrs) if @attrs; + return "$protosig$attrs$body\n"; } sub deparse_format { @@ -1934,18 +2063,15 @@ sub _features_from_bundle { return $hh; } -# Notice how subs and formats are inserted between statements here; -# also $[ assignments and pragmas. -sub pp_nextstate { +# generate any pragmas, 'package foo' etc needed to synchronise +# with the given cop + +sub pragmata { my $self = shift; - my($op, $cx) = @_; - $self->{'curcop'} = $op; + my($op) = @_; + my @text; - push @text, $self->cop_subs($op); - if (@text) { - # Special marker to swallow up the semicolon - push @text, "\cK"; - } + my $stash = $op->stashpv; if ($stash ne $self->{'curstash'}) { push @text, $self->keyword("package") . " $stash;\n"; @@ -2024,6 +2150,29 @@ sub pp_nextstate { $self->{'hinthash'} = $newhh; } + return join("", @text); +} + + +# Notice how subs and formats are inserted between statements here; +# also $[ assignments and pragmas. +sub pp_nextstate { + my $self = shift; + my($op, $cx) = @_; + $self->{'curcop'} = $op; + + my @text; + + my @subs = $self->cop_subs($op); + if (@subs) { + # Special marker to swallow up the semicolon + push @subs, "\cK"; + } + push @text, @subs; + + push @text, $self->pragmata($op); + + # This should go after of any branches that add statements, to # increase the chances that it refers to the same line it did in # the original program. @@ -4021,7 +4170,11 @@ sub pp_multideref { if ($op->first && ($op->first->flags & OPf_KIDS)) { # arbitrary initial expression, e.g. f(1,2,3)->[...] - $text .= $self->deparse($op->first, 24); + my $expr = $self->deparse($op->first, 24); + # stop "exists (expr)->{...}" being interpreted as + #"(exists (expr))->{...}" + $expr = "+$expr" if $expr =~ /^\(/; + $text .= $expr; } my @items = $op->aux_list($self->{curcv}); @@ -5478,7 +5631,7 @@ sub matchop { my($op, $cx, $name, $delim) = @_; my $kid = $op->first; my ($binop, $var, $re) = ("", "", ""); - if ($op->flags & OPf_STACKED) { + if ($op->name ne 'split' && $op->flags & OPf_STACKED) { $binop = 1; $var = $self->deparse($kid, 20); $kid = $kid->sibling; @@ -5517,7 +5670,13 @@ sub matchop { } elsif (!$have_kid) { $re = re_uninterp(escape_re(re_unback($op->precomp))); } elsif ($kid->name ne 'regcomp') { - carp("found ".$kid->name." where regcomp expected"); + if ($op->name eq 'split') { + # split has other kids, not just regcomp + $re = re_uninterp(escape_re(re_unback($op->precomp))); + } + else { + carp("found ".$kid->name." where regcomp expected"); + } } else { ($re, $quote) = $self->regcomp($kid, 21); } @@ -5557,64 +5716,58 @@ sub matchop { } sub pp_match { matchop(@_, "m", "/") } -sub pp_pushre { matchop(@_, "m", "/") } sub pp_qr { matchop(@_, "qr", "") } sub pp_runcv { unop(@_, "__SUB__"); } sub pp_split { - maybe_targmy(@_, \&split); -} -sub split { my $self = shift; my($op, $cx) = @_; my($kid, @exprs, $ary, $expr); + my $stacked = $op->flags & OPf_STACKED; + $kid = $op->first; + $kid = $kid->sibling if $kid->name eq 'regcomp'; + for (; !null($kid); $kid = $kid->sibling) { + push @exprs, $self->deparse($kid, 6); + } - # For our kid (an OP_PUSHRE), pmreplroot is never actually the - # root of a replacement; it's either empty, or abused to point to - # the GV for an array we split into (an optimization to save - # assignment overhead). Depending on whether we're using ithreads, - # this OP* holds either a GV* or a PADOFFSET. Luckily, B.xs - # figures out for us which it is. - my $replroot = $kid->pmreplroot; - my $gv = 0; - my $stacked = $op->flags & OPf_STACKED; - if (ref($replroot) eq "B::GV") { - $gv = $replroot; - } elsif (!ref($replroot) and $replroot > 0) { - $gv = $self->padval($replroot); - } elsif ($kid->targ) { - $ary = $self->padname($kid->targ) - } elsif ($stacked) { - $ary = $self->deparse($op->last, 7); - } - $ary = $self->maybe_local(@_, + unshift @exprs, $self->matchop($op, $cx, "m", "/"); + + if ($op->private & OPpSPLIT_ASSIGN) { + # With C<@array = split(/pat/, str);>, + # array is stored in split's pmreplroot; either + # as an integer index into the pad (for a lexical array) + # or as GV for a package array (which will be a pad index + # on threaded builds) + # With my/our @array = split(/pat/, str), the array is instead + # accessed via an extra padav/rv2av op at the end of the + # split's kid ops. + + if ($stacked) { + $ary = pop @exprs; + } + else { + if ($op->private & OPpSPLIT_LEX) { + $ary = $self->padname($op->pmreplroot); + } + else { + # union with op_pmtargetoff, op_pmtargetgv + my $gv = $op->pmreplroot; + $gv = $self->padval($gv) if !ref($gv); + $ary = $self->maybe_local(@_, $self->stash_variable('@', $self->gv_name($gv), $cx)) - if $gv; - - # Skip the last kid when OPf_STACKED is set, since it is the array - # on the left. - for (; !null($stacked ? $kid->sibling : $kid); $kid = $kid->sibling) { - push @exprs, $self->deparse($kid, 6); + } + if ($op->private & OPpLVAL_INTRO) { + $ary = $op->private & OPpSPLIT_LEX ? "my $ary" : "local $ary"; + } + } } # handle special case of split(), and split(' ') that compiles to /\s+/ - # Under 5.10, the reflags may be undef if the split regexp isn't a constant - # Under 5.17.5-5.17.9, the special flag is on split itself. - $kid = $op->first; - if ( $op->flags & OPf_SPECIAL - or ( - $kid->flags & OPf_SPECIAL - and ( $] < 5.009 ? $kid->pmflags & PMf_SKIPWHITE() - : ($kid->reflags || 0) & RXf_SKIPWHITE() - ) - ) - ) { - $exprs[0] = "' '"; - } + $exprs[0] = q{' '} if ($op->reflags // 0) & RXf_SKIPWHITE(); $expr = "split(" . join(", ", @exprs) . ")"; if ($ary) { @@ -5772,6 +5925,63 @@ sub pp_lvavref { : &pp_padsv) . ')' } + +sub pp_argcheck { + my $self = shift; + my($op, $cx) = @_; + my ($params, $opt_params, $slurpy) = $op->aux_list($self->{curcv}); + my $mandatory = $params - $opt_params; + my $check = ''; + + $check .= <<EOF if !$slurpy; +die sprintf("Too many arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless \@_ <= $params; +EOF + + $check .= <<EOF if $mandatory > 0; +die sprintf("Too few arguments for subroutine at %s line %d.\\n", (caller)[1, 2]) unless \@_ >= $mandatory; +EOF + + my $cond = ($params & 1) ? 'unless' : 'if'; + $check .= <<EOF if $slurpy eq '%'; +die sprintf("Odd name/value argument for subroutine at %s line %d.\\n", (caller)[1, 2]) if \@_ > $params && ((\@_ - $params) & 1); +EOF + + $check =~ s/;\n\z//; + return $check; +} + + +sub pp_argelem { + my $self = shift; + my($op, $cx) = @_; + my $var = $self->padname($op->targ); + my $ix = $op->string($self->{curcv}); + my $expr; + if ($op->flags & OPf_KIDS) { + $expr = $self->deparse($op->first, 7); + } + elsif ($var =~ /^[@%]/) { + $expr = $ix ? "\@_[$ix .. \$#_]" : '@_'; + } + else { + $expr = "\$_[$ix]"; + } + return "my $var = $expr"; +} + + +sub pp_argdefelem { + my $self = shift; + my($op, $cx) = @_; + my $ix = $op->targ; + my $expr = "\@_ >= " . ($ix+1) . " ? \$_[$ix] : "; + my $def = $self->deparse($op->first, 7); + $def = "($def)" if $op->first->flags & OPf_PARENS; + $expr .= $self->deparse($op->first, $cx); + return $expr; +} + + 1; __END__ @@ -6256,7 +6466,7 @@ which is not, consequently, deparsed correctly. =item * Lexical (my) variables declared in scopes external to a subroutine -appear in code2ref output text as package variables. This is a tricky +appear in coderef2text output text as package variables. This is a tricky problem, as perl has no native facility for referring to a lexical variable defined within a different scope, although L<PadWalker> is a good start. diff --git a/Master/tlpkg/tlperl/lib/B/Op_private.pm b/Master/tlpkg/tlperl/lib/B/Op_private.pm index c6c8906c442..849da095dda 100644 --- a/Master/tlpkg/tlperl/lib/B/Op_private.pm +++ b/Master/tlpkg/tlperl/lib/B/Op_private.pm @@ -118,7 +118,7 @@ package B::Op_private; our %bits; -our $VERSION = "5.024001"; +our $VERSION = "5.026001"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); @@ -133,10 +133,10 @@ $bits{$_}{5} = 'OPpHUSH_VMSISH' for qw(dbstate nextstate); $bits{$_}{1} = 'OPpITER_REVERSED' for qw(enteriter iter); $bits{$_}{7} = 'OPpLVALUE' for qw(leave leaveloop); $bits{$_}{6} = 'OPpLVAL_DEFER' for qw(aelem helem multideref); -$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv); +$bits{$_}{7} = 'OPpLVAL_INTRO' for qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv split); $bits{$_}{2} = 'OPpLVREF_ELEM' for qw(lvref refassign); $bits{$_}{3} = 'OPpLVREF_ITER' for qw(lvref refassign); -$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); +$bits{$_}{3} = 'OPpMAYBE_LVSUB' for qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec); $bits{$_}{4} = 'OPpMAYBE_TRUEBOOL' for qw(padhv rv2hv); $bits{$_}{7} = 'OPpOFFBYONE' for qw(caller runcv wantarray); $bits{$_}{5} = 'OPpOPEN_IN_CRLF' for qw(backtick open); @@ -147,7 +147,6 @@ $bits{$_}{6} = 'OPpOUR_INTRO' for qw(enteriter gvsv rv2av rv2hv rv2sv split); $bits{$_}{6} = 'OPpPAD_STATE' for qw(lvavref lvref padav padhv padsv pushmark refassign); $bits{$_}{7} = 'OPpPV_IS_UTF8' for qw(dump goto last next redo); $bits{$_}{6} = 'OPpREFCOUNTED' for qw(leave leaveeval leavesub leavesublv leavewrite); -$bits{$_}{6} = 'OPpRUNTIME' for qw(match pushre qr subst substcont); $bits{$_}{2} = 'OPpSLICEWARNING' for qw(aslice hslice padav padhv rv2av rv2hv); $bits{$_}{4} = 'OPpTARGET_MY' for qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid); $bits{$_}{5} = 'OPpTRANS_COMPLEMENT' for qw(trans transr); @@ -175,6 +174,13 @@ my @bf = ( bitmask => 3, }, { + label => 'offset', + mask_def => 'OPpAVHVSWITCH_MASK', + bitmin => 0, + bitmax => 1, + bitmask => 3, + }, + { label => '-', mask_def => 'OPpARG3_MASK', bitmin => 0, @@ -189,7 +195,7 @@ my @bf = ( bitmask => 15, }, { - label => '-', + label => 'range', mask_def => 'OPpPADRANGE_COUNTMASK', bitcount_def => 'OPpPADRANGE_COUNTSHIFT', bitmin => 0, @@ -197,12 +203,23 @@ my @bf = ( bitmask => 127, }, { - label => '-', + label => 'key', bitmin => 0, bitmax => 7, bitmask => 255, }, { + mask_def => 'OPpARGELEM_MASK', + bitmin => 1, + bitmax => 2, + bitmask => 6, + enum => [ + 0, 'OPpARGELEM_SV', 'SV', + 1, 'OPpARGELEM_AV', 'AV', + 2, 'OPpARGELEM_HV', 'HV', + ], + }, + { mask_def => 'OPpDEREF', bitmin => 4, bitmax => 5, @@ -229,52 +246,56 @@ my @bf = ( @{$bits{aassign}}{6,5,4,1,0} = ('OPpASSIGN_COMMON_SCALAR', 'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', $bf[1], $bf[1]); $bits{abs}{0} = $bf[0]; -@{$bits{accept}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{accept}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{add}}{1,0} = ($bf[1], $bf[1]); $bits{aeach}{0} = $bf[0]; -@{$bits{aelem}}{5,4,1,0} = ($bf[6], $bf[6], $bf[1], $bf[1]); -@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); -@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); +@{$bits{aelem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]); +@{$bits{aelemfast}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]); +@{$bits{aelemfast_lex}}{7,6,5,4,3,2,1,0} = ($bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6], $bf[6]); $bits{akeys}{0} = $bf[0]; $bits{alarm}{0} = $bf[0]; $bits{and}{0} = $bf[0]; $bits{andassign}{0} = $bf[0]; $bits{anonconst}{0} = $bf[0]; -@{$bits{anonhash}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{anonlist}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{atan2}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{anonhash}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{anonlist}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +$bits{argcheck}{0} = $bf[0]; +$bits{argdefelem}{0} = $bf[0]; +@{$bits{argelem}}{2,1,0} = ($bf[7], $bf[7], $bf[0]); +@{$bits{atan2}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{av2arylen}{0} = $bf[0]; $bits{avalues}{0} = $bf[0]; +@{$bits{avhvswitch}}{1,0} = ($bf[2], $bf[2]); $bits{backtick}{0} = $bf[0]; -@{$bits{bind}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{binmode}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{bind}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{binmode}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{bit_and}}{1,0} = ($bf[1], $bf[1]); @{$bits{bit_or}}{1,0} = ($bf[1], $bf[1]); @{$bits{bit_xor}}{1,0} = ($bf[1], $bf[1]); -@{$bits{bless}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{caller}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{chdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{chmod}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{bless}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{caller}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{chdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{chmod}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{chomp}{0} = $bf[0]; $bits{chop}{0} = $bf[0]; -@{$bits{chown}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{chown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{chr}{0} = $bf[0]; $bits{chroot}{0} = $bf[0]; -@{$bits{close}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{close}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{closedir}{0} = $bf[0]; $bits{complement}{0} = $bf[0]; @{$bits{concat}}{1,0} = ($bf[1], $bf[1]); $bits{cond_expr}{0} = $bf[0]; -@{$bits{connect}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{connect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{const}}{6,4,3,2,1} = ('OPpCONST_BARE', 'OPpCONST_ENTERED', 'OPpCONST_STRICT', 'OPpCONST_SHORTCIRCUIT', 'OPpCONST_NOVER'); @{$bits{coreargs}}{7,6,1,0} = ('OPpCOREARGS_PUSHMARK', 'OPpCOREARGS_SCALARMOD', 'OPpCOREARGS_DEREF2', 'OPpCOREARGS_DEREF1'); $bits{cos}{0} = $bf[0]; -@{$bits{crypt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{crypt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{dbmclose}{0} = $bf[0]; -@{$bits{dbmopen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{dbmopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{defined}{0} = $bf[0]; @{$bits{delete}}{6,0} = ('OPpSLICE', $bf[0]); -@{$bits{die}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{die}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{divide}}{1,0} = ($bf[1], $bf[1]); $bits{dofile}{0} = $bf[0]; $bits{dor}{0} = $bf[0]; @@ -284,23 +305,23 @@ $bits{each}{0} = $bf[0]; @{$bits{entereval}}{5,4,3,2,1,0} = ('OPpEVAL_RE_REPARSING', 'OPpEVAL_COPHH', 'OPpEVAL_BYTES', 'OPpEVAL_UNICODE', 'OPpEVAL_HAS_HH', $bf[0]); $bits{entergiven}{0} = $bf[0]; $bits{enteriter}{3} = 'OPpITER_DEF'; -@{$bits{entersub}}{5,4,0} = ($bf[6], $bf[6], 'OPpENTERSUB_INARGS'); +@{$bits{entersub}}{5,4,0} = ($bf[8], $bf[8], 'OPpENTERSUB_INARGS'); $bits{entertry}{0} = $bf[0]; $bits{enterwhen}{0} = $bf[0]; -@{$bits{enterwrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{eof}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{enterwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{eof}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{eq}}{1,0} = ($bf[1], $bf[1]); -@{$bits{exec}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{exec}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{exists}}{6,0} = ('OPpEXISTS_SUB', $bf[0]); -@{$bits{exit}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{exit}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{exp}{0} = $bf[0]; $bits{fc}{0} = $bf[0]; -@{$bits{fcntl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{fileno}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{fcntl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{fileno}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{flip}{0} = $bf[0]; -@{$bits{flock}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{flock}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{flop}{0} = $bf[0]; -@{$bits{formline}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{formline}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{ftatime}{0} = $bf[0]; $bits{ftbinary}{0} = $bf[0]; $bits{ftblk}{0} = $bf[0]; @@ -330,32 +351,32 @@ $bits{fttty}{0} = $bf[0]; $bits{ftzero}{0} = $bf[0]; @{$bits{ge}}{1,0} = ($bf[1], $bf[1]); @{$bits{gelem}}{1,0} = ($bf[1], $bf[1]); -@{$bits{getc}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{getc}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{getpeername}{0} = $bf[0]; -@{$bits{getpgrp}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{getpriority}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{getpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{getpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{getsockname}{0} = $bf[0]; $bits{ggrgid}{0} = $bf[0]; $bits{ggrnam}{0} = $bf[0]; -@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ghbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{ghbyname}{0} = $bf[0]; -@{$bits{glob}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gmtime}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{glob}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gmtime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gnbyaddr}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{gnbyname}{0} = $bf[0]; $bits{goto}{0} = $bf[0]; $bits{gpbyname}{0} = $bf[0]; -@{$bits{gpbynumber}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{gpbynumber}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{gpwnam}{0} = $bf[0]; $bits{gpwuid}{0} = $bf[0]; $bits{grepstart}{0} = $bf[0]; $bits{grepwhile}{0} = $bf[0]; -@{$bits{gsbyname}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gsbyport}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{gsockopt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{gsbyname}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gsbyport}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{gsockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{gt}}{1,0} = ($bf[1], $bf[1]); $bits{gv}{5} = 'OPpEARLY_CV'; -@{$bits{helem}}{5,4,1,0} = ($bf[6], $bf[6], $bf[1], $bf[1]); +@{$bits{helem}}{5,4,1,0} = ($bf[8], $bf[8], $bf[1], $bf[1]); $bits{hex}{0} = $bf[0]; @{$bits{i_add}}{1,0} = ($bf[1], $bf[1]); @{$bits{i_divide}}{1,0} = ($bf[1], $bf[1]); @@ -374,12 +395,12 @@ $bits{i_postinc}{0} = $bf[0]; $bits{i_predec}{0} = $bf[0]; $bits{i_preinc}{0} = $bf[0]; @{$bits{i_subtract}}{1,0} = ($bf[1], $bf[1]); -@{$bits{index}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{index}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{int}{0} = $bf[0]; -@{$bits{ioctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{join}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ioctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{join}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{keys}{0} = $bf[0]; -@{$bits{kill}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{kill}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{last}{0} = $bf[0]; $bits{lc}{0} = $bf[0]; $bits{lcfirst}{0} = $bf[0]; @@ -393,9 +414,9 @@ $bits{leavewhen}{0} = $bf[0]; $bits{leavewrite}{0} = $bf[0]; @{$bits{left_shift}}{1,0} = ($bf[1], $bf[1]); $bits{length}{0} = $bf[0]; -@{$bits{link}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{link}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{list}{6} = 'OPpLIST_GUESSED'; -@{$bits{listen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{listen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{localtime}{0} = $bf[0]; $bits{lock}{0} = $bf[0]; $bits{log}{0} = $bf[0]; @@ -403,7 +424,7 @@ $bits{log}{0} = $bf[0]; $bits{lstat}{0} = $bf[0]; @{$bits{lt}}{1,0} = ($bf[1], $bf[1]); $bits{lvavref}{0} = $bf[0]; -@{$bits{lvref}}{5,4,0} = ($bf[7], $bf[7], $bf[0]); +@{$bits{lvref}}{5,4,0} = ($bf[9], $bf[9], $bf[0]); $bits{mapstart}{0} = $bf[0]; $bits{mapwhile}{0} = $bf[0]; $bits{method}{0} = $bf[0]; @@ -411,12 +432,12 @@ $bits{method_named}{0} = $bf[0]; $bits{method_redir}{0} = $bf[0]; $bits{method_redir_super}{0} = $bf[0]; $bits{method_super}{0} = $bf[0]; -@{$bits{mkdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{mkdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{modulo}}{1,0} = ($bf[1], $bf[1]); -@{$bits{msgctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgrcv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{msgsnd}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{msgctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgrcv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{msgsnd}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{multideref}}{5,4,0} = ('OPpMULTIDEREF_DELETE', 'OPpMULTIDEREF_EXISTS', $bf[0]); @{$bits{multiply}}{1,0} = ($bf[1], $bf[1]); @{$bits{nbit_and}}{1,0} = ($bf[1], $bf[1]); @@ -430,15 +451,15 @@ $bits{next}{0} = $bf[0]; $bits{not}{0} = $bf[0]; $bits{oct}{0} = $bf[0]; $bits{once}{0} = $bf[0]; -@{$bits{open}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{open_dir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{open}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{open_dir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{or}{0} = $bf[0]; $bits{orassign}{0} = $bf[0]; $bits{ord}{0} = $bf[0]; -@{$bits{pack}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4], $bf[4], $bf[4], $bf[4]); -@{$bits{padsv}}{5,4} = ($bf[6], $bf[6]); -@{$bits{pipe_op}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{pack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{padrange}}{6,5,4,3,2,1,0} = ($bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5], $bf[5]); +@{$bits{padsv}}{5,4} = ($bf[8], $bf[8]); +@{$bits{pipe_op}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{pop}{0} = $bf[0]; $bits{pos}{0} = $bf[0]; $bits{postdec}{0} = $bf[0]; @@ -447,36 +468,36 @@ $bits{postinc}{0} = $bf[0]; $bits{predec}{0} = $bf[0]; $bits{preinc}{0} = $bf[0]; $bits{prototype}{0} = $bf[0]; -@{$bits{push}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{push}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{quotemeta}{0} = $bf[0]; -@{$bits{rand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{range}{0} = $bf[0]; -@{$bits{read}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{read}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{readdir}{0} = $bf[0]; $bits{readline}{0} = $bf[0]; $bits{readlink}{0} = $bf[0]; -@{$bits{recv}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{recv}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{redo}{0} = $bf[0]; $bits{ref}{0} = $bf[0]; -@{$bits{refassign}}{5,4,1,0} = ($bf[7], $bf[7], $bf[1], $bf[1]); +@{$bits{refassign}}{5,4,1,0} = ($bf[9], $bf[9], $bf[1], $bf[1]); $bits{refgen}{0} = $bf[0]; $bits{regcmaybe}{0} = $bf[0]; $bits{regcomp}{0} = $bf[0]; $bits{regcreset}{0} = $bf[0]; -@{$bits{rename}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rename}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{repeat}}{6,1,0} = ('OPpREPEAT_DOLIST', $bf[1], $bf[1]); $bits{require}{0} = $bf[0]; -@{$bits{reset}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{reset}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{reverse}}{3,0} = ('OPpREVERSE_INPLACE', $bf[0]); $bits{rewinddir}{0} = $bf[0]; @{$bits{right_shift}}{1,0} = ($bf[1], $bf[1]); -@{$bits{rindex}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{rindex}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{rmdir}{0} = $bf[0]; $bits{rv2av}{0} = $bf[0]; @{$bits{rv2cv}}{7,5,0} = ('OPpENTERSUB_NOPAREN', 'OPpMAY_RETURN_CONSTANT', $bf[0]); -@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[6], $bf[6], 'OPpDONT_INIT_GV', $bf[0]); +@{$bits{rv2gv}}{6,5,4,2,0} = ('OPpALLOW_FAKE', $bf[8], $bf[8], 'OPpDONT_INIT_GV', $bf[0]); $bits{rv2hv}{0} = $bf[0]; -@{$bits{rv2sv}}{5,4,0} = ($bf[6], $bf[6], $bf[0]); +@{$bits{rv2sv}}{5,4,0} = ($bf[8], $bf[8], $bf[0]); @{$bits{sassign}}{7,6,1,0} = ('OPpASSIGN_CV_TO_GV', 'OPpASSIGN_BACKWARDS', $bf[1], $bf[1]); @{$bits{sbit_and}}{1,0} = ($bf[1], $bf[1]); @{$bits{sbit_or}}{1,0} = ($bf[1], $bf[1]); @@ -486,76 +507,76 @@ $bits{schomp}{0} = $bf[0]; $bits{schop}{0} = $bf[0]; @{$bits{scmp}}{1,0} = ($bf[1], $bf[1]); $bits{scomplement}{0} = $bf[0]; -@{$bits{seek}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{seekdir}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{select}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{semop}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{send}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{seek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{seekdir}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{select}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{semop}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{send}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{seq}}{1,0} = ($bf[1], $bf[1]); -@{$bits{setpgrp}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{setpriority}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{setpgrp}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{setpriority}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sge}}{1,0} = ($bf[1], $bf[1]); @{$bits{sgt}}{1,0} = ($bf[1], $bf[1]); $bits{shift}{0} = $bf[0]; -@{$bits{shmctl}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmget}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmread}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{shmwrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{shmctl}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmget}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{shmwrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{shostent}{0} = $bf[0]; -@{$bits{shutdown}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{shutdown}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sin}{0} = $bf[0]; @{$bits{sle}}{1,0} = ($bf[1], $bf[1]); -@{$bits{sleep}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sleep}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{slt}}{1,0} = ($bf[1], $bf[1]); @{$bits{smartmatch}}{1,0} = ($bf[1], $bf[1]); @{$bits{sne}}{1,0} = ($bf[1], $bf[1]); $bits{snetent}{0} = $bf[0]; -@{$bits{socket}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sockpair}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{socket}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{sort}}{6,5,4,3,2,1,0} = ('OPpSORT_STABLE', 'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC'); -@{$bits{splice}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -$bits{split}{7} = 'OPpSPLIT_IMPLIM'; -@{$bits{sprintf}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{split}}{4,3,2} = ('OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX', 'OPpSPLIT_IMPLIM'); +@{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sprotoent}{0} = $bf[0]; $bits{sqrt}{0} = $bf[0]; -@{$bits{srand}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{srand}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{srefgen}{0} = $bf[0]; -@{$bits{sselect}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{sselect}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{sservent}{0} = $bf[0]; -@{$bits{ssockopt}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{ssockopt}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{stat}{0} = $bf[0]; -@{$bits{stringify}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{stringify}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{study}{0} = $bf[0]; $bits{substcont}{0} = $bf[0]; -@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[2], $bf[2], $bf[2]); +@{$bits{substr}}{4,2,1,0} = ('OPpSUBSTR_REPL_FIRST', $bf[3], $bf[3], $bf[3]); @{$bits{subtract}}{1,0} = ($bf[1], $bf[1]); -@{$bits{symlink}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{syscall}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysopen}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysread}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{sysseek}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{system}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{syswrite}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{tell}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{symlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{syscall}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysopen}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysread}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{sysseek}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{system}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{syswrite}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{tell}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{telldir}{0} = $bf[0]; -@{$bits{tie}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{tie}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{tied}{0} = $bf[0]; -@{$bits{truncate}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{truncate}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{uc}{0} = $bf[0]; $bits{ucfirst}{0} = $bf[0]; -@{$bits{umask}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{umask}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{undef}{0} = $bf[0]; -@{$bits{unlink}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{unpack}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{unshift}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{unlink}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{unpack}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{unshift}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{untie}{0} = $bf[0]; -@{$bits{utime}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{utime}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); $bits{values}{0} = $bf[0]; @{$bits{vec}}{1,0} = ($bf[1], $bf[1]); -@{$bits{waitpid}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); -@{$bits{warn}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]); +@{$bits{waitpid}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); +@{$bits{warn}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]); @{$bits{xor}}{1,0} = ($bf[1], $bf[1]); @@ -565,11 +586,16 @@ our %defines = ( OPpARG2_MASK => 3, OPpARG3_MASK => 7, OPpARG4_MASK => 15, + OPpARGELEM_AV => 2, + OPpARGELEM_HV => 4, + OPpARGELEM_MASK => 6, + OPpARGELEM_SV => 0, OPpASSIGN_BACKWARDS => 64, OPpASSIGN_COMMON_AGG => 16, OPpASSIGN_COMMON_RC1 => 32, OPpASSIGN_COMMON_SCALAR => 64, OPpASSIGN_CV_TO_GV => 128, + OPpAVHVSWITCH_MASK => 3, OPpCONST_BARE => 64, OPpCONST_ENTERED => 16, OPpCONST_NOVER => 2, @@ -634,7 +660,6 @@ our %defines = ( OPpREFCOUNTED => 64, OPpREPEAT_DOLIST => 64, OPpREVERSE_INPLACE => 8, - OPpRUNTIME => 64, OPpSLICE => 64, OPpSLICEWARNING => 4, OPpSORT_DESCEND => 16, @@ -644,7 +669,9 @@ our %defines = ( OPpSORT_QSORT => 32, OPpSORT_REVERSE => 4, OPpSORT_STABLE => 64, - OPpSPLIT_IMPLIM => 128, + OPpSPLIT_ASSIGN => 16, + OPpSPLIT_IMPLIM => 4, + OPpSPLIT_LEX => 8, OPpSUBSTR_REPL_FIRST => 16, OPpTARGET_MY => 16, OPpTRANS_COMPLEMENT => 32, @@ -659,6 +686,9 @@ our %defines = ( our %labels = ( OPpALLOW_FAKE => 'FAKE', + OPpARGELEM_AV => 'AV', + OPpARGELEM_HV => 'HV', + OPpARGELEM_SV => 'SV', OPpASSIGN_BACKWARDS => 'BKWARD', OPpASSIGN_COMMON_AGG => 'COM_AGG', OPpASSIGN_COMMON_RC1 => 'COM_RC1', @@ -724,7 +754,6 @@ our %labels = ( OPpREFCOUNTED => 'REFC', OPpREPEAT_DOLIST => 'DOLIST', OPpREVERSE_INPLACE => 'INPLACE', - OPpRUNTIME => 'RTIME', OPpSLICE => 'SLICE', OPpSLICEWARNING => 'SLICEWARN', OPpSORT_DESCEND => 'DESC', @@ -734,7 +763,9 @@ our %labels = ( OPpSORT_QSORT => 'QSORT', OPpSORT_REVERSE => 'REV', OPpSORT_STABLE => 'STABLE', + OPpSPLIT_ASSIGN => 'ASSIGN', OPpSPLIT_IMPLIM => 'IMPLIM', + OPpSPLIT_LEX => 'LEX', OPpSUBSTR_REPL_FIRST => 'REPL1ST', OPpTARGET_MY => 'TARGMY', OPpTRANS_COMPLEMENT => 'COMPL', @@ -770,9 +801,9 @@ our %ops_using = ( OPpLIST_GUESSED => [qw(list)], OPpLVALUE => [qw(leave leaveloop)], OPpLVAL_DEFER => [qw(aelem helem multideref)], - OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv)], + OPpLVAL_INTRO => [qw(aelem aslice cond_expr delete enteriter entersub gvsv helem hslice list lvavref lvref lvrefslice multideref padav padhv padrange padsv pushmark refassign rv2av rv2gv rv2hv rv2sv split)], OPpLVREF_ELEM => [qw(lvref refassign)], - OPpMAYBE_LVSUB => [qw(aassign aelem aslice av2arylen helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], + OPpMAYBE_LVSUB => [qw(aassign aelem akeys aslice av2arylen avhvswitch helem hslice keys kvaslice kvhslice multideref padav padhv pos rv2av rv2gv rv2hv substr vec)], OPpMAYBE_TRUEBOOL => [qw(padhv rv2hv)], OPpMULTIDEREF_DELETE => [qw(multideref)], OPpOFFBYONE => [qw(caller runcv wantarray)], @@ -783,11 +814,10 @@ our %ops_using = ( OPpREFCOUNTED => [qw(leave leaveeval leavesub leavesublv leavewrite)], OPpREPEAT_DOLIST => [qw(repeat)], OPpREVERSE_INPLACE => [qw(reverse)], - OPpRUNTIME => [qw(match pushre qr subst substcont)], OPpSLICE => [qw(delete)], OPpSLICEWARNING => [qw(aslice hslice padav padhv rv2av rv2hv)], OPpSORT_DESCEND => [qw(sort)], - OPpSPLIT_IMPLIM => [qw(split)], + OPpSPLIT_ASSIGN => [qw(split)], OPpSUBSTR_REPL_FIRST => [qw(substr)], OPpTARGET_MY => [qw(abs add atan2 chdir chmod chomp chown chr chroot concat cos crypt divide exec exp flock getpgrp getppid getpriority hex i_add i_divide i_modulo i_multiply i_subtract index int kill left_shift length link log mkdir modulo multiply nbit_and nbit_or nbit_xor ncomplement oct ord pow push rand rename right_shift rindex rmdir schomp scomplement setpgrp setpriority sin sleep sqrt srand stringify subtract symlink system time unlink unshift utime wait waitpid)], OPpTRANS_COMPLEMENT => [qw(trans transr)], @@ -824,6 +854,8 @@ $ops_using{OPpSORT_NUMERIC} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_QSORT} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_REVERSE} = $ops_using{OPpSORT_DESCEND}; $ops_using{OPpSORT_STABLE} = $ops_using{OPpSORT_DESCEND}; +$ops_using{OPpSPLIT_IMPLIM} = $ops_using{OPpSPLIT_ASSIGN}; +$ops_using{OPpSPLIT_LEX} = $ops_using{OPpSPLIT_ASSIGN}; $ops_using{OPpTRANS_DELETE} = $ops_using{OPpTRANS_COMPLEMENT}; $ops_using{OPpTRANS_FROM_UTF} = $ops_using{OPpTRANS_COMPLEMENT}; $ops_using{OPpTRANS_GROWS} = $ops_using{OPpTRANS_COMPLEMENT}; diff --git a/Master/tlpkg/tlperl/lib/B/Terse.pm b/Master/tlpkg/tlperl/lib/B/Terse.pm index 8e551c5a62f..1749f326a13 100644 --- a/Master/tlpkg/tlperl/lib/B/Terse.pm +++ b/Master/tlpkg/tlperl/lib/B/Terse.pm @@ -1,6 +1,6 @@ package B::Terse; -our $VERSION = '1.06'; +our $VERSION = '1.07'; use strict; use B qw(class @specialsv_name); @@ -33,7 +33,7 @@ sub indent { # Don't use this, at least on OPs in subroutines: it has no way of # getting to the pad, and will give wrong answers or crash. sub B::OP::terse { - carp "B::OP::terse is deprecated; use B::Concise instead"; + carp "B::OP::terse is deprecated and will go away in Perl 5.28; use B::Concise instead"; B::Concise::b_terse(@_); } diff --git a/Master/tlpkg/tlperl/lib/B/Xref.pm b/Master/tlpkg/tlperl/lib/B/Xref.pm index 8beb243f71f..255ee890bd5 100644 --- a/Master/tlpkg/tlperl/lib/B/Xref.pm +++ b/Master/tlpkg/tlperl/lib/B/Xref.pm @@ -1,6 +1,6 @@ package B::Xref; -our $VERSION = '1.05'; +our $VERSION = '1.06'; =head1 NAME @@ -449,7 +449,7 @@ sub compile { last OPTION; } elsif ($opt eq "o") { $arg ||= shift @options; - open(STDOUT, ">$arg") or return "$arg: $!\n"; + open(STDOUT, '>', $arg) or return "$arg: $!\n"; } elsif ($opt eq "d") { $nodefs = 1; } elsif ($opt eq "r") { |