diff --git a/ext/B/B.xs b/ext/B/B.xs index 0b8ef47cf21d..023f87830767 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -1393,6 +1393,19 @@ aux_list(o, cv) XSRETURN(len); } /* OP_MULTIDEREF */ + + case OP_MULTIPARAM: + { + struct op_multiparam_aux *p = (struct op_multiparam_aux *)aux; + EXTEND(SP, 3 + p->params + 1); + mPUSHu(p->params); + mPUSHu(p->opt_params); + PUSHs(sv_2mortal(p->slurpy ? newSVpvf("%c", p->slurpy) : &PL_sv_no)); + for(UV parami = 0; parami < p->params; parami++) + mPUSHu(p->param_padix[parami]); + mPUSHu(p->slurpy_padix); + XSRETURN(3 + p->params + 1); + } } /* switch */ diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm index 0bebe29f1fe2..bc5a832c889c 100644 --- a/lib/B/Deparse.pm +++ b/lib/B/Deparse.pm @@ -1180,6 +1180,54 @@ sub pad_subs { } +# deparse_multiparam(): +# TODO docs +sub deparse_multiparam { + my ($self, $topop, $cv) = @_; + + $topop = $topop->first; + return unless $$topop and $topop->name eq 'lineseq'; + + # last op should be nextstate + my $last = $topop->last; + return unless $$last + and ( _op_is_or_was($last, OP_NEXTSTATE) + or _op_is_or_was($last, OP_DBSTATE)); + + # first OP_NEXTSTATE + + my $o = $topop->first; + return unless $$o; + return if $o->label; + + # OP_MULTIPARAM + + $o = $o->sibling; + return unless $$o and $o->name eq 'multiparam'; + + my ($params, $opt_params, $slurpy, @rest) = $o->aux_list($cv); + my $mandatory_params = $params - $opt_params; + my @param_padix = splice @rest, 0, $params, (); + my ($slurpy_padix) = @rest; + + my @sig; + + # Initial scalars + foreach my $parami ( 0 .. $params-1 ) { + my $padix = $param_padix[$parami]; + $sig[$parami] = $padix ? $self->padname($padix) : + $parami < $mandatory_params ? '$' : '$='; + } + + # TODO: defaulting exprs of optional params + + if($slurpy) { + push @sig, $slurpy_padix ? $self->padname($slurpy_padix) : $slurpy; + } + + return join(", ", @sig); +} + # 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 @@ -1372,7 +1420,8 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL"); and $firstop->name eq 'null' and $firstop->targ == OP_ARGCHECK ) { - my ($mysig) = $self->deparse_argops($firstop, $cv); + my ($mysig) = $self->deparse_multiparam($firstop, $cv) // + $self->deparse_argops($firstop, $cv); if (defined $mysig) { $sig = $mysig; $firstop = $is_list ? $firstop->sibling : undef;