summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Mitchell <davem@iabyn.com>2016-07-09 10:41:08 +0100
committerDavid Mitchell <davem@iabyn.com>2016-08-03 20:54:40 +0100
commit4fa06845e75d453a3101cff32e24c5b743f9819e (patch)
tree71f5473b348e99044ad80eab8a2416a3c8f9a177
parent6cb4123eb32087e8546f1056ca7b4e761c28d9b7 (diff)
downloadperl-4fa06845e75d453a3101cff32e24c5b743f9819e.tar.gz
add OP_ARGELEM, OP_ARGDEFELEM, OP_ARGCHECK ops
Currently subroutine signature parsing emits many small discrete ops to implement arg handling. This commit replaces them with a couple of ops per signature element, plus an initial signature check op. These new ops are added to the OP tree during parsing, so will be visible to hooks called up to and including peephole optimisation. It is intended soon that the peephole optimiser will take these per-element ops, and replace them with a single OP_SIGNATURE op which handles the whole signature in a single go. So normally these ops wont actually get executed much. But adding these intermediate-level ops gives three advantages: 1) it allows the parser to efficiently generate subtrees containing individual signature elements, which can't be done if only OP_SIGNATURE or discrete ops are available; 2) prior to optimisation, it provides a simple and straightforward representation of the signature; 3) hooks can mess with the signature OP subtree in ways that make it no longer possible to optimise into an OP_SIGNATURE, but which can still be executed, deparsed etc (if less efficiently). This code: use feature "signatures"; sub f($a, $, $b = 1, @c) {$a} under 'perl -MO=Concise,f' now gives: d <1> leavesub[1 ref] K/REFC,1 ->(end) - <@> lineseq KP ->d 1 <;> nextstate(main 84 foo:6) v:%,469762048 ->2 2 <+> argcheck(3,1,@) v ->3 3 <;> nextstate(main 81 foo:6) v:%,469762048 ->4 4 <+> argelem(0)[$a:81,84] v/SV ->5 5 <;> nextstate(main 82 foo:6) v:%,469762048 ->6 8 <+> argelem(2)[$b:82,84] vKS/SV ->9 6 <|> argdefelem(other->7)[2] sK ->8 7 <$> const(IV 1) s ->8 9 <;> nextstate(main 83 foo:6) v:%,469762048 ->a a <+> argelem(3)[@c:83,84] v/AV ->b - <;> ex-nextstate(main 84 foo:6) v:%,469762048 ->b b <;> nextstate(main 84 foo:6) v:%,469762048 ->c c <0> padsv[$a:81,84] s ->d The argcheck(3,1,@) op knows the number of positional params (3), the number of optional params (1), and whether it has an array / hash slurpy element at the end. This op is responsible for checking that @_ contains the right number of args. A simple argelem(0)[$a] op does the equivalent of 'my $a = $_[0]'. Similarly, argelem(3)[@c] is equivalent to 'my @c = @_[3..$#_]'. If it has a child, it gets its arg from the stack rather than using $_[N]. Currently the only used child is the logop argdefelem. argdefelem(other->7)[2] is equivalent to '@_ > 2 ? $_[2] : other'. [ These ops currently assume that the lexical var being introduced is undef/empty and non-magival etc. This is an incorrect assumption and is fixed in a few commits' time ]
Diffstat
-rw-r--r--dump.c1
-rw-r--r--embed.fnc5
-rw-r--r--embed.h3
-rw-r--r--ext/B/B.pm2
-rw-r--r--ext/B/B.xs32
-rw-r--r--ext/B/B/Concise.pm8
-rw-r--r--ext/Opcode/Opcode.pm4
-rw-r--r--lib/B/Deparse.pm62
-rw-r--r--lib/B/Op_private.pm37
-rw-r--r--op.c40
-rw-r--r--opcode.h145
-rw-r--r--opnames.h417
-rw-r--r--perly.act500
-rw-r--r--perly.h2
-rw-r--r--perly.tab40
-rw-r--r--perly.y190
-rw-r--r--pod/perldiag.pod20
-rw-r--r--pp.c206
-rw-r--r--pp_hot.c22
-rw-r--r--pp_proto.h3
-rw-r--r--proto.h7
-rw-r--r--regen/op_private12
-rw-r--r--regen/opcodes3
-rw-r--r--t/op/signatures.t17
-rw-r--r--toke.c38
25 files changed, 1031 insertions, 785 deletions
diff --git a/dump.c b/dump.c
index c168162791..5b3dfca62f 100644
--- a/dump.c
+++ b/dump.c
@@ -2514,6 +2514,7 @@ Perl_debop(pTHX_ const OP *o)
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
+ case OP_ARGELEM:
S_deb_padvar(aTHX_ o->op_targ, 1, 1);
break;
diff --git a/embed.fnc b/embed.fnc
index 6505d18afd..adccf0c8e3 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -298,6 +298,7 @@ Anprd |void |croak_xs_usage |NN const CV *const cv \
|NN const char *const params
npr |void |croak_no_mem
nprX |void |croak_popstack
+fnrp |void |croak_caller|NULLOK const char* pat|...
fnprx |void |noperl_die|NN const char* pat|...
#if defined(WIN32)
norx |void |win32_croak_not_implemented|NN const char * fname
@@ -2533,7 +2534,7 @@ s |int |intuit_more |NN char *s
s |I32 |lop |I32 f|int x|NN char *s
rs |void |missingterm |NULLOK char *s
s |void |no_op |NN const char *const what|NULLOK char *s
-s |int |pending_ident
+s |int |pending_ident |bool is_sig
sR |I32 |sublex_done
sR |I32 |sublex_push
sR |I32 |sublex_start
@@ -2990,6 +2991,4 @@ XEop |void |dtrace_probe_op |NN const OP *op
XEop |void |dtrace_probe_phase|enum perl_phase phase
#endif
-xpo |OP* |check_arity |int arity |bool max
-
: ex: set ts=8 sts=4 sw=4 noet:
diff --git a/embed.h b/embed.h
index e5cd19365c..930ea9142d 100644
--- a/embed.h
+++ b/embed.h
@@ -1202,6 +1202,7 @@
#define core_prototype(a,b,c,d) Perl_core_prototype(aTHX_ a,b,c,d)
#define coresub_op(a,b,c) Perl_coresub_op(aTHX_ a,b,c)
#define create_eval_scope(a,b) Perl_create_eval_scope(aTHX_ a,b)
+#define croak_caller Perl_croak_caller
#define croak_no_mem Perl_croak_no_mem
#define croak_popstack Perl_croak_popstack
#define custom_op_get_field(a,b) Perl_custom_op_get_field(aTHX_ a,b)
@@ -1786,7 +1787,7 @@
#define missingterm(a) S_missingterm(aTHX_ a)
#define no_op(a,b) S_no_op(aTHX_ a,b)
#define parse_ident(a,b,c,d,e,f) S_parse_ident(aTHX_ a,b,c,d,e,f)
-#define pending_ident() S_pending_ident(aTHX)
+#define pending_ident(a) S_pending_ident(aTHX_ a)
#define scan_const(a) S_scan_const(aTHX_ a)
#define scan_formline(a) S_scan_formline(aTHX_ a)
#define scan_heredoc(a) S_scan_heredoc(aTHX_ a)
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 5c1e5997b8..ffe97248d6 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -15,7 +15,7 @@ require Exporter;
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.62';
+ $B::VERSION = '1.63';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
diff --git a/ext/B/B.xs b/ext/B/B.xs
index b4b6a40ac5..4e35c03c81 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -1325,14 +1325,30 @@ string(o, cv)
B::CV cv
PREINIT:
SV *ret;
+ UNOP_AUX_item *aux;
PPCODE:
+ aux = cUNOP_AUXo->op_aux;
switch (o->op_type) {
case OP_MULTIDEREF:
ret = multideref_stringify(o, cv);
break;
+
+ case OP_ARGELEM:
+ ret = sv_2mortal(Perl_newSVpvf(aTHX_ "%"UVuf,
+ PTR2UV(aux)));
+ break;
+
+ case OP_ARGCHECK:
+ ret = Perl_newSVpvf(aTHX_ "%"UVuf",%"UVuf, aux[0].uv, aux[1].uv);
+ if (aux[2].iv)
+ Perl_sv_catpvf(aTHX_ ret, ",%c", (char)aux[2].iv);
+ ret = sv_2mortal(ret);
+ break;
+
default:
ret = sv_2mortal(newSVpvn("", 0));
}
+
ST(0) = ret;
XSRETURN(1);
@@ -1346,12 +1362,28 @@ void
aux_list(o, cv)
B::OP o
B::CV cv
+ PREINIT:
+ UNOP_AUX_item *aux;
PPCODE:
PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
+ aux = cUNOP_AUXo->op_aux;
switch (o->op_type) {
default:
XSRETURN(0); /* by default, an empty list */
+ case OP_ARGELEM:
+ XPUSHs(sv_2mortal(newSVuv(PTR2UV(aux))));
+ XSRETURN(1);
+ break;
+
+ case OP_ARGCHECK:
+ EXTEND(SP, 3);
+ PUSHs(sv_2mortal(newSVuv(aux[0].uv)));
+ PUSHs(sv_2mortal(newSVuv(aux[1].uv)));
+ PUSHs(sv_2mortal(aux[2].iv ? Perl_newSVpvf(aTHX_ "%c",
+ (char)aux[2].iv) : &PL_sv_no));
+ break;
+
case OP_MULTIDEREF:
#ifdef USE_ITHREADS
# define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm
index 311e0e738a..26eb8c569f 100644
--- a/ext/B/B/Concise.pm
+++ b/ext/B/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.997";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw( set_style set_style_standard add_callback
concise_subref concise_cv concise_main
@@ -820,6 +820,7 @@ sub concise_op {
$h{targarg} = join '; ', @targarg;
$h{targarglife} = join '; ', @targarglife;
}
+
$h{arg} = "";
$h{svclass} = $h{svaddr} = $h{svval} = "";
if ($h{class} eq "PMOP") {
@@ -884,6 +885,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) {
diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm
index 9d667c276b..f4925324f3 100644
--- a/ext/Opcode/Opcode.pm
+++ b/ext/Opcode/Opcode.pm
@@ -6,7 +6,7 @@ use strict;
our($VERSION, @ISA, @EXPORT_OK);
-$VERSION = "1.35";
+$VERSION = "1.36";
use Carp;
use Exporter ();
@@ -312,7 +312,7 @@ invert_opset function.
av2arylen
rv2hv helem hslice kvhslice each values keys exists delete
- aeach akeys avalues multideref
+ aeach akeys avalues multideref argelem argdefelem argcheck
preinc i_preinc predec i_predec postinc i_postinc
postdec i_postdec int hex oct abs pow multiply i_multiply
diff --git a/lib/B/Deparse.pm b/lib/B/Deparse.pm
index 9879d678b1..7e4c55ce1a 100644
--- a/lib/B/Deparse.pm
+++ b/lib/B/Deparse.pm
@@ -46,7 +46,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
MDEREF_SHIFT
);
-$VERSION = '1.37';
+$VERSION = '1.38';
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
@@ -1256,6 +1256,11 @@ Carp::confess("SPECIAL in deparse_sub") if $cv->isa("B::SPECIAL");
push @ops, $o;
}
$body = $self->lineseq(undef, 0, @ops).";";
+ if ($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);
@@ -5772,6 +5777,61 @@ 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] : ";
+ $expr .= $self->deparse($op->first, $cx);
+ return $expr;
+}
+
+
1;
__END__
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 7931cb2bff..23ce78e6ee 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -208,6 +208,17 @@ my @bf = (
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,
@@ -237,7 +248,7 @@ $bits{abs}{0} = $bf[0];
@{$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[7], $bf[7], $bf[1], $bf[1]);
+@{$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];
@@ -247,6 +258,9 @@ $bits{andassign}{0} = $bf[0];
$bits{anonconst}{0} = $bf[0];
@{$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];
@@ -290,7 +304,7 @@ $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[7], $bf[7], '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[4], $bf[4], $bf[4], $bf[4]);
@@ -361,7 +375,7 @@ $bits{grepwhile}{0} = $bf[0];
@{$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[7], $bf[7], $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]);
@@ -409,7 +423,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[8], $bf[8], $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];
@@ -443,7 +457,7 @@ $bits{orassign}{0} = $bf[0];
$bits{ord}{0} = $bf[0];
@{$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[7], $bf[7]);
+@{$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];
@@ -464,7 +478,7 @@ $bits{readlink}{0} = $bf[0];
@{$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[8], $bf[8], $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];
@@ -480,9 +494,9 @@ $bits{rewinddir}{0} = $bf[0];
$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[7], $bf[7], '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[7], $bf[7], $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]);
@@ -571,6 +585,10 @@ 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,
@@ -665,6 +683,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',
diff --git a/op.c b/op.c
index 058e81c6ce..ec13eaa9d4 100644
--- a/op.c
+++ b/op.c
@@ -929,6 +929,7 @@ Perl_op_clear(pTHX_ OP *o)
/* FALLTHROUGH */
case OP_ENTERTRY:
case OP_ENTEREVAL: /* Was holding hints. */
+ case OP_ARGDEFELEM: /* Was holding signature index. */
o->op_targ = 0;
break;
default:
@@ -1052,6 +1053,10 @@ Perl_op_clear(pTHX_ OP *o)
break;
+ case OP_ARGCHECK:
+ PerlMemShared_free(cUNOP_AUXo->op_aux);
+ break;
+
case OP_MULTIDEREF:
{
UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
@@ -15018,41 +15023,6 @@ const_av_xsub(pTHX_ CV* cv)
XSRETURN(AvFILLp(av)+1);
}
-/* return an optree that checks for too few or too many args -
- * used for subroutine signatures
- */
-OP *
-Perl_check_arity(pTHX_ int arity, bool max)
-{
- return
- newSTATEOP(0, NULL,
- newLOGOP(OP_OR, 0,
- newBINOP((max ? OP_LE : OP_GE), 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))
- ),
- newSVOP(OP_CONST, 0, newSViv(arity))
- ),
- op_convert_list(OP_DIE, 0,
- op_convert_list(OP_SPRINTF, 0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0,
- max
- ? newSVpvs("Too many arguments for subroutine at %s line %d.\n")
- : newSVpvs("Too few arguments for subroutine at %s line %d.\n")
- ),
- newSLICEOP(0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0, newSViv(1)),
- newSVOP(OP_CONST, 0, newSViv(2))),
- newOP(OP_CALLER, 0)
- )
- )
- )
- )
- )
- );
-}
/*
* ex: set ts=8 sts=4 sw=4 et:
diff --git a/opcode.h b/opcode.h
index 0aaefb64a4..24f5a672f6 100644
--- a/opcode.h
+++ b/opcode.h
@@ -334,6 +334,9 @@ EXTCONST char* const PL_op_name[] = {
"entersub",
"leavesub",
"leavesublv",
+ "argcheck",
+ "argelem",
+ "argdefelem",
"caller",
"warn",
"die",
@@ -736,6 +739,9 @@ EXTCONST char* const PL_op_desc[] = {
"subroutine entry",
"subroutine exit",
"lvalue subroutine return",
+ "check subroutine arguments",
+ "subroutine argument",
+ "subroutine argument default value",
"caller",
"warn",
"die",
@@ -1152,6 +1158,9 @@ EXT Perl_ppaddr_t PL_ppaddr[] /* or perlvars.h */
Perl_pp_entersub,
Perl_pp_leavesub,
Perl_pp_leavesublv,
+ Perl_pp_argcheck,
+ Perl_pp_argelem,
+ Perl_pp_argdefelem,
Perl_pp_caller,
Perl_pp_warn,
Perl_pp_die,
@@ -1564,6 +1573,9 @@ EXT Perl_check_t PL_check[] /* or perlvars.h */
Perl_ck_subr, /* entersub */
Perl_ck_null, /* leavesub */
Perl_ck_null, /* leavesublv */
+ Perl_ck_null, /* argcheck */
+ Perl_ck_null, /* argelem */
+ Perl_ck_null, /* argdefelem */
Perl_ck_fun, /* caller */
Perl_ck_fun, /* warn */
Perl_ck_fun, /* die */
@@ -1970,6 +1982,9 @@ EXTCONST U32 PL_opargs[] = {
0x00002141, /* entersub */
0x00000100, /* leavesub */
0x00000100, /* leavesublv */
+ 0x00000f00, /* argcheck */
+ 0x00000f00, /* argelem */
+ 0x00000300, /* argdefelem */
0x00009b08, /* caller */
0x0000240d, /* warn */
0x0000240d, /* die */
@@ -2184,12 +2199,14 @@ EXTCONST U32 PL_opargs[] = {
END_EXTERN_C
+#define OPpARGELEM_SV 0x00
#define OPpLVREF_SV 0x00
#define OPpARG1_MASK 0x01
#define OPpCOREARGS_DEREF1 0x01
#define OPpENTERSUB_INARGS 0x01
#define OPpSORT_NUMERIC 0x01
#define OPpTRANS_FROM_UTF 0x01
+#define OPpARGELEM_AV 0x02
#define OPpCONST_NOVER 0x02
#define OPpCOREARGS_DEREF2 0x02
#define OPpEVAL_HAS_HH 0x02
@@ -2199,6 +2216,7 @@ END_EXTERN_C
#define OPpSORT_INTEGER 0x02
#define OPpTRANS_TO_UTF 0x02
#define OPpARG2_MASK 0x03
+#define OPpARGELEM_HV 0x04
#define OPpCONST_SHORTCIRCUIT 0x04
#define OPpDONT_INIT_GV 0x04
#define OPpENTERSUB_HASTARG 0x04
@@ -2208,6 +2226,7 @@ END_EXTERN_C
#define OPpSLICEWARNING 0x04
#define OPpSORT_REVERSE 0x04
#define OPpTRANS_IDENTICAL 0x04
+#define OPpARGELEM_MASK 0x06
#define OPpARG3_MASK 0x07
#define OPpPADRANGE_COUNTSHIFT 0x07
#define OPpCONST_STRICT 0x08
@@ -2411,6 +2430,7 @@ EXTCONST I16 PL_op_private_bitfields[] = {
0, 8, -1,
0, 8, -1,
0, 8, -1,
+ 1, -1, 0, 507, 1, 26, 2, 276, -1,
4, -1, 1, 157, 2, 164, 3, 171, -1,
4, -1, 0, 507, 1, 26, 2, 276, 3, 103, -1,
@@ -2609,27 +2629,30 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
137, /* entersub */
144, /* leavesub */
144, /* leavesublv */
- 146, /* caller */
+ 0, /* argcheck */
+ 146, /* argelem */
+ 0, /* argdefelem */
+ 148, /* caller */
48, /* warn */
48, /* die */
48, /* reset */
-1, /* lineseq */
- 148, /* nextstate */
- 148, /* dbstate */
+ 150, /* nextstate */
+ 150, /* dbstate */
-1, /* unstack */
-1, /* enter */
- 149, /* leave */
+ 151, /* leave */
-1, /* scope */
- 151, /* enteriter */
- 155, /* iter */
+ 153, /* enteriter */
+ 157, /* iter */
-1, /* enterloop */
- 156, /* leaveloop */
+ 158, /* leaveloop */
-1, /* return */
- 158, /* last */
- 158, /* next */
- 158, /* redo */
- 158, /* dump */
- 158, /* goto */
+ 160, /* last */
+ 160, /* next */
+ 160, /* redo */
+ 160, /* dump */
+ 160, /* goto */
48, /* exit */
0, /* method_named */
0, /* method_super */
@@ -2641,7 +2664,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* leavewhen */
-1, /* break */
-1, /* continue */
- 160, /* open */
+ 162, /* open */
48, /* close */
48, /* pipe_op */
48, /* fileno */
@@ -2687,33 +2710,33 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* getpeername */
0, /* lstat */
0, /* stat */
- 165, /* ftrread */
- 165, /* ftrwrite */
- 165, /* ftrexec */
- 165, /* fteread */
- 165, /* ftewrite */
- 165, /* fteexec */
- 170, /* ftis */
- 170, /* ftsize */
- 170, /* ftmtime */
- 170, /* ftatime */
- 170, /* ftctime */
- 170, /* ftrowned */
- 170, /* fteowned */
- 170, /* ftzero */
- 170, /* ftsock */
- 170, /* ftchr */
- 170, /* ftblk */
- 170, /* ftfile */
- 170, /* ftdir */
- 170, /* ftpipe */
- 170, /* ftsuid */
- 170, /* ftsgid */
- 170, /* ftsvtx */
- 170, /* ftlink */
- 170, /* fttty */
- 170, /* fttext */
- 170, /* ftbinary */
+ 167, /* ftrread */
+ 167, /* ftrwrite */
+ 167, /* ftrexec */
+ 167, /* fteread */
+ 167, /* ftewrite */
+ 167, /* fteexec */
+ 172, /* ftis */
+ 172, /* ftsize */
+ 172, /* ftmtime */
+ 172, /* ftatime */
+ 172, /* ftctime */
+ 172, /* ftrowned */
+ 172, /* fteowned */
+ 172, /* ftzero */
+ 172, /* ftsock */
+ 172, /* ftchr */
+ 172, /* ftblk */
+ 172, /* ftfile */
+ 172, /* ftdir */
+ 172, /* ftpipe */
+ 172, /* ftsuid */
+ 172, /* ftsgid */
+ 172, /* ftsvtx */
+ 172, /* ftlink */
+ 172, /* fttty */
+ 172, /* fttext */
+ 172, /* ftbinary */
77, /* chdir */
77, /* chown */
71, /* chroot */
@@ -2733,17 +2756,17 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* rewinddir */
0, /* closedir */
-1, /* fork */
- 174, /* wait */
+ 176, /* wait */
77, /* waitpid */
77, /* system */
77, /* exec */
77, /* kill */
- 174, /* getppid */
+ 176, /* getppid */
77, /* getpgrp */
77, /* setpgrp */
77, /* getpriority */
77, /* setpriority */
- 174, /* time */
+ 176, /* time */
-1, /* tms */
0, /* localtime */
48, /* gmtime */
@@ -2763,7 +2786,7 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* require */
0, /* dofile */
-1, /* hintseval */
- 175, /* entereval */
+ 177, /* entereval */
144, /* leaveeval */
0, /* entertry */
-1, /* leavetry */
@@ -2802,18 +2825,18 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
0, /* lock */
0, /* once */
-1, /* custom */
- 181, /* coreargs */
- 185, /* avhvswitch */
+ 183, /* coreargs */
+ 187, /* avhvswitch */
3, /* runcv */
0, /* fc */
-1, /* padcv */
-1, /* introcv */
-1, /* clonecv */
- 187, /* padrange */
- 189, /* refassign */
- 195, /* lvref */
- 201, /* lvrefslice */
- 202, /* lvavref */
+ 189, /* padrange */
+ 191, /* refassign */
+ 197, /* lvref */
+ 203, /* lvrefslice */
+ 204, /* lvavref */
0, /* anonconst */
};
@@ -2833,19 +2856,19 @@ EXTCONST I16 PL_op_private_bitdef_ix[] = {
*/
EXTCONST U16 PL_op_private_bitdefs[] = {
- 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
+ 0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, values, pop, shift, grepstart, grepwhile, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, method, argcheck, argdefelem, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
0x2b5c, 0x3d59, /* pushmark */
0x00bd, /* wantarray, runcv */
0x03b8, 0x17f0, 0x3e0c, 0x38c8, 0x2f25, /* const */
0x2b5c, 0x3079, /* gvsv */
0x1655, /* gv */
0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
- 0x2b5c, 0x3d58, 0x02b7, /* padsv */
+ 0x2b5c, 0x3d58, 0x03d7, /* padsv */
0x2b5c, 0x3d58, 0x2c4c, 0x3a49, /* padav */
0x2b5c, 0x3d58, 0x0534, 0x05d0, 0x2c4c, 0x3a49, /* padhv */
0x3819, /* pushre, match, qr, subst */
- 0x2b5c, 0x19d8, 0x02b6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
- 0x2b5c, 0x3078, 0x02b6, 0x3e04, 0x0003, /* rv2sv */
+ 0x2b5c, 0x19d8, 0x03d6, 0x2c4c, 0x2e48, 0x3e04, 0x0003, /* rv2gv */
+ 0x2b5c, 0x3078, 0x03d6, 0x3e04, 0x0003, /* rv2sv */
0x2c4c, 0x0003, /* av2arylen, pos, akeys, keys */
0x2dbc, 0x0e18, 0x0b74, 0x028c, 0x3fc8, 0x3e04, 0x0003, /* rv2cv */
0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
@@ -2862,7 +2885,7 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2c4c, 0x0067, /* vec */
0x2b5c, 0x3078, 0x2c4c, 0x3a48, 0x3e04, 0x0003, /* rv2av */
0x025f, /* aelemfast, aelemfast_lex */
- 0x2b5c, 0x2a58, 0x02b6, 0x2c4c, 0x0067, /* aelem, helem */
+ 0x2b5c, 0x2a58, 0x03d6, 0x2c4c, 0x0067, /* aelem, helem */
0x2b5c, 0x2c4c, 0x3a49, /* aslice, hslice */
0x2c4d, /* kvaslice, kvhslice */
0x2b5c, 0x3998, 0x0003, /* delete */
@@ -2875,8 +2898,9 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x26cc, 0x0003, /* reverse */
0x28f8, 0x0003, /* flip, flop */
0x2b5c, 0x0003, /* cond_expr */
- 0x2b5c, 0x0e18, 0x02b6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
+ 0x2b5c, 0x0e18, 0x03d6, 0x028c, 0x3fc8, 0x3e04, 0x2481, /* entersub */
0x33d8, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+ 0x02aa, 0x0003, /* argelem */
0x00bc, 0x018f, /* caller */
0x21f5, /* nextstate, dbstate */
0x29fc, 0x33d9, /* leave */
@@ -2892,8 +2916,8 @@ EXTCONST U16 PL_op_private_bitdefs[] = {
0x2d1c, 0x0018, 0x1144, 0x1061, /* coreargs */
0x2c4c, 0x00c7, /* avhvswitch */
0x2b5c, 0x01fb, /* padrange */
- 0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0067, /* refassign */
- 0x2b5c, 0x3d58, 0x03d6, 0x284c, 0x1748, 0x0003, /* lvref */
+ 0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0067, /* refassign */
+ 0x2b5c, 0x3d58, 0x04f6, 0x284c, 0x1748, 0x0003, /* lvref */
0x2b5d, /* lvrefslice */
0x2b5c, 0x3d58, 0x0003, /* lvavref */
@@ -3092,6 +3116,9 @@ EXTCONST U8 PL_op_private_valid[] = {
/* ENTERSUB */ (OPpENTERSUB_INARGS|OPpHINT_STRICT_REFS|OPpENTERSUB_HASTARG|OPpENTERSUB_AMPER|OPpDEREF|OPpENTERSUB_DB|OPpLVAL_INTRO),
/* LEAVESUB */ (OPpARG1_MASK|OPpREFCOUNTED),
/* LEAVESUBLV */ (OPpARG1_MASK|OPpREFCOUNTED),
+ /* ARGCHECK */ (OPpARG1_MASK),
+ /* ARGELEM */ (OPpARG1_MASK|OPpARGELEM_MASK),
+ /* ARGDEFELEM */ (OPpARG1_MASK),
/* CALLER */ (OPpARG4_MASK|OPpOFFBYONE),
/* WARN */ (OPpARG4_MASK),
/* DIE */ (OPpARG4_MASK),
diff --git a/opnames.h b/opnames.h
index 99b19d0b99..e04d331a7c 100644
--- a/opnames.h
+++ b/opnames.h
@@ -202,216 +202,219 @@ typedef enum opcode {
OP_ENTERSUB = 185,
OP_LEAVESUB = 186,
OP_LEAVESUBLV = 187,
- OP_CALLER = 188,
- OP_WARN = 189,
- OP_DIE = 190,
- OP_RESET = 191,
- OP_LINESEQ = 192,
- OP_NEXTSTATE = 193,
- OP_DBSTATE = 194,
- OP_UNSTACK = 195,
- OP_ENTER = 196,
- OP_LEAVE = 197,
- OP_SCOPE = 198,
- OP_ENTERITER = 199,
- OP_ITER = 200,
- OP_ENTERLOOP = 201,
- OP_LEAVELOOP = 202,
- OP_RETURN = 203,
- OP_LAST = 204,
- OP_NEXT = 205,
- OP_REDO = 206,
- OP_DUMP = 207,
- OP_GOTO = 208,
- OP_EXIT = 209,
- OP_METHOD_NAMED = 210,
- OP_METHOD_SUPER = 211,
- OP_METHOD_REDIR = 212,
- OP_METHOD_REDIR_SUPER = 213,
- OP_ENTERGIVEN = 214,
- OP_LEAVEGIVEN = 215,
- OP_ENTERWHEN = 216,
- OP_LEAVEWHEN = 217,
- OP_BREAK = 218,
- OP_CONTINUE = 219,
- OP_OPEN = 220,
- OP_CLOSE = 221,
- OP_PIPE_OP = 222,
- OP_FILENO = 223,
- OP_UMASK = 224,
- OP_BINMODE = 225,
- OP_TIE = 226,
- OP_UNTIE = 227,
- OP_TIED = 228,
- OP_DBMOPEN = 229,
- OP_DBMCLOSE = 230,
- OP_SSELECT = 231,
- OP_SELECT = 232,
- OP_GETC = 233,
- OP_READ = 234,
- OP_ENTERWRITE = 235,
- OP_LEAVEWRITE = 236,
- OP_PRTF = 237,
- OP_PRINT = 238,
- OP_SAY = 239,
- OP_SYSOPEN = 240,
- OP_SYSSEEK = 241,
- OP_SYSREAD = 242,
- OP_SYSWRITE = 243,
- OP_EOF = 244,
- OP_TELL = 245,
- OP_SEEK = 246,
- OP_TRUNCATE = 247,
- OP_FCNTL = 248,
- OP_IOCTL = 249,
- OP_FLOCK = 250,
- OP_SEND = 251,
- OP_RECV = 252,
- OP_SOCKET = 253,
- OP_SOCKPAIR = 254,
- OP_BIND = 255,
- OP_CONNECT = 256,
- OP_LISTEN = 257,
- OP_ACCEPT = 258,
- OP_SHUTDOWN = 259,
- OP_GSOCKOPT = 260,
- OP_SSOCKOPT = 261,
- OP_GETSOCKNAME = 262,
- OP_GETPEERNAME = 263,
- OP_LSTAT = 264,
- OP_STAT = 265,
- OP_FTRREAD = 266,
- OP_FTRWRITE = 267,
- OP_FTREXEC = 268,
- OP_FTEREAD = 269,
- OP_FTEWRITE = 270,
- OP_FTEEXEC = 271,
- OP_FTIS = 272,
- OP_FTSIZE = 273,
- OP_FTMTIME = 274,
- OP_FTATIME = 275,
- OP_FTCTIME = 276,
- OP_FTROWNED = 277,
- OP_FTEOWNED = 278,
- OP_FTZERO = 279,
- OP_FTSOCK = 280,
- OP_FTCHR = 281,
- OP_FTBLK = 282,
- OP_FTFILE = 283,
- OP_FTDIR = 284,
- OP_FTPIPE = 285,
- OP_FTSUID = 286,
- OP_FTSGID = 287,
- OP_FTSVTX = 288,
- OP_FTLINK = 289,
- OP_FTTTY = 290,
- OP_FTTEXT = 291,
- OP_FTBINARY = 292,
- OP_CHDIR = 293,
- OP_CHOWN = 294,
- OP_CHROOT = 295,
- OP_UNLINK = 296,
- OP_CHMOD = 297,
- OP_UTIME = 298,
- OP_RENAME = 299,
- OP_LINK = 300,
- OP_SYMLINK = 301,
- OP_READLINK = 302,
- OP_MKDIR = 303,
- OP_RMDIR = 304,
- OP_OPEN_DIR = 305,
- OP_READDIR = 306,
- OP_TELLDIR = 307,
- OP_SEEKDIR = 308,
- OP_REWINDDIR = 309,
- OP_CLOSEDIR = 310,
- OP_FORK = 311,
- OP_WAIT = 312,
- OP_WAITPID = 313,
- OP_SYSTEM = 314,
- OP_EXEC = 315,
- OP_KILL = 316,
- OP_GETPPID = 317,
- OP_GETPGRP = 318,
- OP_SETPGRP = 319,
- OP_GETPRIORITY = 320,
- OP_SETPRIORITY = 321,
- OP_TIME = 322,
- OP_TMS = 323,
- OP_LOCALTIME = 324,
- OP_GMTIME = 325,
- OP_ALARM = 326,
- OP_SLEEP = 327,
- OP_SHMGET = 328,
- OP_SHMCTL = 329,
- OP_SHMREAD = 330,
- OP_SHMWRITE = 331,
- OP_MSGGET = 332,
- OP_MSGCTL = 333,
- OP_MSGSND = 334,
- OP_MSGRCV = 335,
- OP_SEMOP = 336,
- OP_SEMGET = 337,
- OP_SEMCTL = 338,
- OP_REQUIRE = 339,
- OP_DOFILE = 340,
- OP_HINTSEVAL = 341,
- OP_ENTEREVAL = 342,
- OP_LEAVEEVAL = 343,
- OP_ENTERTRY = 344,
- OP_LEAVETRY = 345,
- OP_GHBYNAME = 346,
- OP_GHBYADDR = 347,
- OP_GHOSTENT = 348,
- OP_GNBYNAME = 349,
- OP_GNBYADDR = 350,
- OP_GNETENT = 351,
- OP_GPBYNAME = 352,
- OP_GPBYNUMBER = 353,
- OP_GPROTOENT = 354,
- OP_GSBYNAME = 355,
- OP_GSBYPORT = 356,
- OP_GSERVENT = 357,
- OP_SHOSTENT = 358,
- OP_SNETENT = 359,
- OP_SPROTOENT = 360,
- OP_SSERVENT = 361,
- OP_EHOSTENT = 362,
- OP_ENETENT = 363,
- OP_EPROTOENT = 364,
- OP_ESERVENT = 365,
- OP_GPWNAM = 366,
- OP_GPWUID = 367,
- OP_GPWENT = 368,
- OP_SPWENT = 369,
- OP_EPWENT = 370,
- OP_GGRNAM = 371,
- OP_GGRGID = 372,
- OP_GGRENT = 373,
- OP_SGRENT = 374,
- OP_EGRENT = 375,
- OP_GETLOGIN = 376,
- OP_SYSCALL = 377,
- OP_LOCK = 378,
- OP_ONCE = 379,
- OP_CUSTOM = 380,
- OP_COREARGS = 381,
- OP_AVHVSWITCH = 382,
- OP_RUNCV = 383,
- OP_FC = 384,
- OP_PADCV = 385,
- OP_INTROCV = 386,
- OP_CLONECV = 387,
- OP_PADRANGE = 388,
- OP_REFASSIGN = 389,
- OP_LVREF = 390,
- OP_LVREFSLICE = 391,
- OP_LVAVREF = 392,
- OP_ANONCONST = 393,
+ OP_ARGCHECK = 188,
+ OP_ARGELEM = 189,
+ OP_ARGDEFELEM = 190,
+ OP_CALLER = 191,
+ OP_WARN = 192,
+ OP_DIE = 193,
+ OP_RESET = 194,
+ OP_LINESEQ = 195,
+ OP_NEXTSTATE = 196,
+ OP_DBSTATE = 197,
+ OP_UNSTACK = 198,
+ OP_ENTER = 199,
+ OP_LEAVE = 200,
+ OP_SCOPE = 201,
+ OP_ENTERITER = 202,
+ OP_ITER = 203,
+ OP_ENTERLOOP = 204,
+ OP_LEAVELOOP = 205,
+ OP_RETURN = 206,
+ OP_LAST = 207,
+ OP_NEXT = 208,
+ OP_REDO = 209,
+ OP_DUMP = 210,
+ OP_GOTO = 211,
+ OP_EXIT = 212,
+ OP_METHOD_NAMED = 213,
+ OP_METHOD_SUPER = 214,
+ OP_METHOD_REDIR = 215,
+ OP_METHOD_REDIR_SUPER = 216,
+ OP_ENTERGIVEN = 217,
+ OP_LEAVEGIVEN = 218,
+ OP_ENTERWHEN = 219,
+ OP_LEAVEWHEN = 220,
+ OP_BREAK = 221,
+ OP_CONTINUE = 222,
+ OP_OPEN = 223,
+ OP_CLOSE = 224,
+ OP_PIPE_OP = 225,
+ OP_FILENO = 226,
+ OP_UMASK = 227,
+ OP_BINMODE = 228,
+ OP_TIE = 229,
+ OP_UNTIE = 230,
+ OP_TIED = 231,
+ OP_DBMOPEN = 232,
+ OP_DBMCLOSE = 233,
+ OP_SSELECT = 234,
+ OP_SELECT = 235,
+ OP_GETC = 236,
+ OP_READ = 237,
+ OP_ENTERWRITE = 238,
+ OP_LEAVEWRITE = 239,
+ OP_PRTF = 240,
+ OP_PRINT = 241,
+ OP_SAY = 242,
+ OP_SYSOPEN = 243,
+ OP_SYSSEEK = 244,
+ OP_SYSREAD = 245,
+ OP_SYSWRITE = 246,
+ OP_EOF = 247,
+ OP_TELL = 248,
+ OP_SEEK = 249,
+ OP_TRUNCATE = 250,
+ OP_FCNTL = 251,
+ OP_IOCTL = 252,
+ OP_FLOCK = 253,
+ OP_SEND = 254,
+ OP_RECV = 255,
+ OP_SOCKET = 256,
+ OP_SOCKPAIR = 257,
+ OP_BIND = 258,
+ OP_CONNECT = 259,
+ OP_LISTEN = 260,
+ OP_ACCEPT = 261,
+ OP_SHUTDOWN = 262,
+ OP_GSOCKOPT = 263,
+ OP_SSOCKOPT = 264,
+ OP_GETSOCKNAME = 265,
+ OP_GETPEERNAME = 266,
+ OP_LSTAT = 267,
+ OP_STAT = 268,
+ OP_FTRREAD = 269,
+ OP_FTRWRITE = 270,
+ OP_FTREXEC = 271,
+ OP_FTEREAD = 272,
+ OP_FTEWRITE = 273,
+ OP_FTEEXEC = 274,
+ OP_FTIS = 275,
+ OP_FTSIZE = 276,
+ OP_FTMTIME = 277,
+ OP_FTATIME = 278,
+ OP_FTCTIME = 279,
+ OP_FTROWNED = 280,
+ OP_FTEOWNED = 281,
+ OP_FTZERO = 282,
+ OP_FTSOCK = 283,
+ OP_FTCHR = 284,
+ OP_FTBLK = 285,
+ OP_FTFILE = 286,
+ OP_FTDIR = 287,
+ OP_FTPIPE = 288,
+ OP_FTSUID = 289,
+ OP_FTSGID = 290,
+ OP_FTSVTX = 291,
+ OP_FTLINK = 292,
+ OP_FTTTY = 293,
+ OP_FTTEXT = 294,
+ OP_FTBINARY = 295,
+ OP_CHDIR = 296,
+ OP_CHOWN = 297,
+ OP_CHROOT = 298,
+ OP_UNLINK = 299,
+ OP_CHMOD = 300,
+ OP_UTIME = 301,
+ OP_RENAME = 302,
+ OP_LINK = 303,
+ OP_SYMLINK = 304,
+ OP_READLINK = 305,
+ OP_MKDIR = 306,
+ OP_RMDIR = 307,
+ OP_OPEN_DIR = 308,
+ OP_READDIR = 309,
+ OP_TELLDIR = 310,
+ OP_SEEKDIR = 311,
+ OP_REWINDDIR = 312,
+ OP_CLOSEDIR = 313,
+ OP_FORK = 314,
+ OP_WAIT = 315,
+ OP_WAITPID = 316,
+ OP_SYSTEM = 317,
+ OP_EXEC = 318,
+ OP_KILL = 319,
+ OP_GETPPID = 320,
+ OP_GETPGRP = 321,
+ OP_SETPGRP = 322,
+ OP_GETPRIORITY = 323,
+ OP_SETPRIORITY = 324,
+ OP_TIME = 325,
+ OP_TMS = 326,
+ OP_LOCALTIME = 327,
+ OP_GMTIME = 328,
+ OP_ALARM = 329,
+ OP_SLEEP = 330,
+ OP_SHMGET = 331,
+ OP_SHMCTL = 332,
+ OP_SHMREAD = 333,
+ OP_SHMWRITE = 334,
+ OP_MSGGET = 335,
+ OP_MSGCTL = 336,
+ OP_MSGSND = 337,
+ OP_MSGRCV = 338,
+ OP_SEMOP = 339,
+ OP_SEMGET = 340,
+ OP_SEMCTL = 341,
+ OP_REQUIRE = 342,
+ OP_DOFILE = 343,
+ OP_HINTSEVAL = 344,
+ OP_ENTEREVAL = 345,
+ OP_LEAVEEVAL = 346,
+ OP_ENTERTRY = 347,
+ OP_LEAVETRY = 348,
+ OP_GHBYNAME = 349,
+ OP_GHBYADDR = 350,
+ OP_GHOSTENT = 351,
+ OP_GNBYNAME = 352,
+ OP_GNBYADDR = 353,
+ OP_GNETENT = 354,
+ OP_GPBYNAME = 355,
+ OP_GPBYNUMBER = 356,
+ OP_GPROTOENT = 357,
+ OP_GSBYNAME = 358,
+ OP_GSBYPORT = 359,
+ OP_GSERVENT = 360,
+ OP_SHOSTENT = 361,
+ OP_SNETENT = 362,
+ OP_SPROTOENT = 363,
+ OP_SSERVENT = 364,
+ OP_EHOSTENT = 365,
+ OP_ENETENT = 366,
+ OP_EPROTOENT = 367,
+ OP_ESERVENT = 368,
+ OP_GPWNAM = 369,
+ OP_GPWUID = 370,
+ OP_GPWENT = 371,
+ OP_SPWENT = 372,
+ OP_EPWENT = 373,
+ OP_GGRNAM = 374,
+ OP_GGRGID = 375,
+ OP_GGRENT = 376,
+ OP_SGRENT = 377,
+ OP_EGRENT = 378,
+ OP_GETLOGIN = 379,
+ OP_SYSCALL = 380,
+ OP_LOCK = 381,
+ OP_ONCE = 382,
+ OP_CUSTOM = 383,
+ OP_COREARGS = 384,
+ OP_AVHVSWITCH = 385,
+ OP_RUNCV = 386,
+ OP_FC = 387,
+ OP_PADCV = 388,
+ OP_INTROCV = 389,
+ OP_CLONECV = 390,
+ OP_PADRANGE = 391,
+ OP_REFASSIGN = 392,
+ OP_LVREF = 393,
+ OP_LVREFSLICE = 394,
+ OP_LVAVREF = 395,
+ OP_ANONCONST = 396,
OP_max
} opcode;
-#define MAXO 394
+#define MAXO 397
#define OP_FREED MAXO
/* the OP_IS_* macros are optimized to a simple range check because
diff --git a/perly.act b/perly.act
index 020b742db2..07e5fc29a4 100644
--- a/perly.act
+++ b/perly.act
@@ -798,32 +798,28 @@ case 2:
case 96:
#line 644 "perly.y" /* yacc.c:1646 */
- {
- (yyval.opval) = (ps[0].val.opval);
- PL_parser->in_my = 0;
- }
+ { (yyval.opval) = (ps[0].val.opval); }
break;
case 97:
-#line 652 "perly.y" /* yacc.c:1646 */
+#line 649 "perly.y" /* yacc.c:1646 */
{ (yyval.ival) = '@'; }
break;
case 98:
-#line 654 "perly.y" /* yacc.c:1646 */
+#line 651 "perly.y" /* yacc.c:1646 */
{ (yyval.ival) = '%'; }
break;
case 99:
-#line 658 "perly.y" /* yacc.c:1646 */
+#line 655 "perly.y" /* yacc.c:1646 */
{
- I32 sigil = (ps[-2].val.ival);
- OP *var = (ps[-1].val.opval);
+ I32 sigil = (ps[-2].val.ival);
+ OP *var = (ps[-1].val.opval);
OP *defexpr = (ps[0].val.opval);
- int type = (sigil == '@' ? OP_PADAV : OP_PADHV);
if (PL_parser->sig_slurpy)
yyerror("Multiple slurpy parameters not allowed");
@@ -833,154 +829,113 @@ case 2:
yyerror("a slurpy parameter may not have "
"a default value");
- if (var) {
- OP *slice;
-
- var->op_type = type;
- var->op_ppaddr = PL_ppaddr[type];
- var->op_flags = (OPf_WANT_LIST | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
-
- slice = PL_parser->sig_elems
- ? op_prepend_elem(OP_ASLICE,
- newOP(OP_PUSHMARK, 0),
- newLISTOP(OP_ASLICE, 0,
- list(newRANGE(0,
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)),
- newUNOP(OP_AV2ARYLEN, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_AV2ARYLEN)))),
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_ASLICE)))
- : newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv));
- (yyval.opval) = newSTATEOP(0, NULL,
- newASSIGNOP(OPf_STACKED, var, 0, slice));
- }
- else
- (yyval.opval) = (OP*)NULL;
+ (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
break;
case 100:
-#line 705 "perly.y" /* yacc.c:1646 */
+#line 674 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 101:
-#line 707 "perly.y" /* yacc.c:1646 */
+#line 676 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP(OP_NULL, 0); }
break;
case 102:
-#line 709 "perly.y" /* yacc.c:1646 */
+#line 678 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 103:
-#line 715 "perly.y" /* yacc.c:1646 */
+#line 684 "perly.y" /* yacc.c:1646 */
{
OP *var = (ps[-1].val.opval);
OP *defexpr = (ps[0].val.opval);
- OP *argn = NULL;
- OP *expr = NULL;
if (PL_parser->sig_slurpy)
yyerror("Slurpy parameter not last");
PL_parser->sig_elems++;
- if (var) {
- var->op_type = OP_PADSV;
- var->op_ppaddr = PL_ppaddr[OP_PADSV];
- var->op_flags = (OPf_WANT_SCALAR | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
- }
-
- /* $_[N] */
- argn = newBINOP(OP_AELEM, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_RV2AV),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems - 1)));
-
if (defexpr) {
PL_parser->sig_optelems++;
- /* is it '$var=undef', '$=' ? */
- if ( ( defexpr->op_type == OP_NULL
- || defexpr->op_type == OP_UNDEF)
+
+ if ( defexpr->op_type == OP_NULL
&& !(defexpr->op_flags & OPf_KIDS))
{
- if (var) {
- /* '$=' is legal, '$var=' isn't */
- if (defexpr->op_type == OP_NULL)
- yyerror("Optional parameter "
- "lacks default expression");
- else
- expr = argn;
- }
+ /* handle '$=' special case */
+ if (var)
+ yyerror("Optional parameter "
+ "lacks default expression");
op_free(defexpr);
}
- else {
- /* @_ >= N */
- OP *ge_op =
- newBINOP(OP_GE, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)));
-
- expr = var
- ? newCONDOP(0, ge_op, argn, defexpr)
- : newLOGOP(OP_OR, 0, ge_op, defexpr);
+ else {
+ /* a normal '=default' expression */
+ OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+ defexpr,
+ LINKLIST(defexpr));
+ /* re-purpose op_targ to hold @_ index */
+ defop->op_targ = PL_parser->sig_elems - 1;
+
+ if (var) {
+ var->op_flags |= OPf_STACKED;
+ (void)op_sibling_splice(var,
+ NULL, 0, defop);
+ scalar(defop);
+ }
+ else
+ var = newUNOP(OP_NULL, 0, defop);
+
+ LINKLIST(var);
+ /* NB: normally the first child of a
+ * logop is executed before the logop,
+ * and it pushes a boolean result
+ * ready for the logop. For ARGDEFELEM,
+ * the op itself does the boolean
+ * calculation, so set the first op to
+ * it instead.
+ */
+ var->op_next = defop;
+ defexpr->op_next = var;
}
}
else {
if (PL_parser->sig_optelems)
yyerror("Mandatory parameter "
"follows optional parameter");
- expr = argn;
}
- if (var)
- expr = newASSIGNOP(OPf_STACKED, var, 0, expr);
- if (expr)
- (yyval.opval) = op_prepend_elem(OP_LINESEQ,
- newSTATEOP(0, NULL, NULL),
- expr);
- else
- (yyval.opval) = (OP*)NULL;
+ (yyval.opval) = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
break;
case 104:
-#line 793 "perly.y" /* yacc.c:1646 */
+#line 748 "perly.y" /* yacc.c:1646 */
{ parser->expect = XSIGVAR; (yyval.opval) = (ps[0].val.opval); }
break;
case 105:
-#line 795 "perly.y" /* yacc.c:1646 */
+#line 750 "perly.y" /* yacc.c:1646 */
{ parser->expect = XSIGVAR; (yyval.opval) = (ps[0].val.opval); }
break;
case 106:
-#line 801 "perly.y" /* yacc.c:1646 */
+#line 756 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[-1].val.opval); }
break;
case 107:
-#line 803 "perly.y" /* yacc.c:1646 */
+#line 758 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval));
}
@@ -988,25 +943,25 @@ case 2:
break;
case 108:
-#line 807 "perly.y" /* yacc.c:1646 */
+#line 762 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 109:
-#line 812 "perly.y" /* yacc.c:1646 */
+#line 767 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 110:
-#line 814 "perly.y" /* yacc.c:1646 */
+#line 769 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 111:
-#line 818 "perly.y" /* yacc.c:1646 */
+#line 773 "perly.y" /* yacc.c:1646 */
{
ENTER;
SAVEINT(PL_parser->sig_elems);
@@ -1021,11 +976,11 @@ case 2:
break;
case 112:
-#line 830 "perly.y" /* yacc.c:1646 */
+#line 785 "perly.y" /* yacc.c:1646 */
{
- OP *sigops = (ps[-1].val.opval);
- int min_arity =
- PL_parser->sig_elems - PL_parser->sig_optelems;
+ OP *sigops = (ps[-1].val.opval);
+ UNOP_AUX_item *aux;
+ OP *check;
assert(FEATURE_SIGNATURES_IS_ENABLED);
@@ -1034,52 +989,21 @@ case 2:
packWARN(WARN_EXPERIMENTAL__SIGNATURES),
"The signatures feature is experimental");
- /* handle odd/even for %foo */
- if (PL_parser->sig_slurpy == '%') {
- OP *chkop =
- newLOGOP(
- (PL_parser->sig_elems & 1)
- ? OP_OR : OP_AND,
- 0,
- newBINOP(OP_BIT_AND, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0, newSViv(1))),
- op_convert_list(OP_DIE, 0,
- op_convert_list(OP_SPRINTF, 0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0,
- newSVpvs("Odd name/value argument for subroutine at %s line %d.\n")),
- newSLICEOP(0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0, newSViv(1)),
- newSVOP(OP_CONST, 0, newSViv(2))),
- newOP(OP_CALLER, 0))))));
- if (PL_parser->sig_optelems)
- chkop = newLOGOP(OP_AND, 0,
- newBINOP(OP_GT, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems))),
- chkop);
- sigops = op_prepend_elem(OP_LINESEQ,
- chkop, sigops);
-
- }
- if (min_arity)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_ min_arity,
- FALSE),
- sigops);
- if (!PL_parser->sig_slurpy)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_
- PL_parser->sig_elems, TRUE),
- sigops);
-
- (yyval.opval) = op_append_elem(OP_LINESEQ, sigops,
- newSTATEOP(0, NULL, NULL));
+ aux = (UNOP_AUX_item*)PerlMemShared_malloc(
+ sizeof(UNOP_AUX_item) * 3);
+ aux[0].uv = PL_parser->sig_elems;
+ aux[1].uv = PL_parser->sig_optelems;
+ aux[2].iv = PL_parser->sig_slurpy;
+ check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+ sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
+ sigops = op_prepend_elem(OP_LINESEQ,
+ newSTATEOP(0, NULL, NULL),
+ sigops);
+ /* a nextstate at the end handles context
+ * correctly for an empty sub body */
+ (yyval.opval) = op_append_elem(OP_LINESEQ,
+ sigops,
+ newSTATEOP(0, NULL, NULL));
parser->expect = XATTRBLOCK;
LEAVE;
@@ -1088,37 +1012,37 @@ case 2:
break;
case 114:
-#line 898 "perly.y" /* yacc.c:1646 */
+#line 822 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 115:
-#line 903 "perly.y" /* yacc.c:1646 */
+#line 827 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 116:
-#line 905 "perly.y" /* yacc.c:1646 */
+#line 829 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 117:
-#line 907 "perly.y" /* yacc.c:1646 */
+#line 831 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 119:
-#line 913 "perly.y" /* yacc.c:1646 */
+#line 837 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[-1].val.opval); }
break;
case 120:
-#line 915 "perly.y" /* yacc.c:1646 */
+#line 839 "perly.y" /* yacc.c:1646 */
{
OP* term = (ps[0].val.opval);
(yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term);
@@ -1127,7 +1051,7 @@ case 2:
break;
case 122:
-#line 924 "perly.y" /* yacc.c:1646 */
+#line 848 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED,
op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) );
}
@@ -1135,7 +1059,7 @@ case 2:
break;
case 123:
-#line 928 "perly.y" /* yacc.c:1646 */
+#line 852 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED,
op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) );
}
@@ -1143,7 +1067,7 @@ case 2:
break;
case 124:
-#line 932 "perly.y" /* yacc.c:1646 */
+#line 856 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)),
@@ -1153,7 +1077,7 @@ case 2:
break;
case 125:
-#line 938 "perly.y" /* yacc.c:1646 */
+#line 862 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, scalar((ps[-2].val.opval)),
newMETHOP(OP_METHOD, 0, (ps[0].val.opval))));
@@ -1162,7 +1086,7 @@ case 2:
break;
case 126:
-#line 943 "perly.y" /* yacc.c:1646 */
+#line 867 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)),
@@ -1172,7 +1096,7 @@ case 2:
break;
case 127:
-#line 949 "perly.y" /* yacc.c:1646 */
+#line 873 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)),
@@ -1182,26 +1106,26 @@ case 2:
break;
case 128:
-#line 955 "perly.y" /* yacc.c:1646 */
+#line 879 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); }
break;
case 129:
-#line 957 "perly.y" /* yacc.c:1646 */
+#line 881 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); }
break;
case 130:
-#line 959 "perly.y" /* yacc.c:1646 */
+#line 883 "perly.y" /* yacc.c:1646 */
{ SvREFCNT_inc_simple_void(PL_compcv);
(yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, (OP*)NULL, (ps[0].val.opval)); }
break;
case 131:
-#line 962 "perly.y" /* yacc.c:1646 */
+#line 886 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST,
op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval)));
@@ -1210,20 +1134,20 @@ case 2:
break;
case 134:
-#line 977 "perly.y" /* yacc.c:1646 */
+#line 901 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); }
break;
case 135:
-#line 979 "perly.y" /* yacc.c:1646 */
+#line 903 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval)));
}
break;
case 136:
-#line 982 "perly.y" /* yacc.c:1646 */
+#line 906 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_AELEM, 0,
ref(newAVREF((ps[-4].val.opval)),OP_RV2AV),
scalar((ps[-1].val.opval)));
@@ -1232,7 +1156,7 @@ case 2:
break;
case 137:
-#line 987 "perly.y" /* yacc.c:1646 */
+#line 911 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_AELEM, 0,
ref(newAVREF((ps[-3].val.opval)),OP_RV2AV),
scalar((ps[-1].val.opval)));
@@ -1241,14 +1165,14 @@ case 2:
break;
case 138:
-#line 992 "perly.y" /* yacc.c:1646 */
+#line 916 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval)));
}
break;
case 139:
-#line 995 "perly.y" /* yacc.c:1646 */
+#line 919 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_HELEM, 0,
ref(newHVREF((ps[-5].val.opval)),OP_RV2HV),
jmaybe((ps[-2].val.opval))); }
@@ -1256,7 +1180,7 @@ case 2:
break;
case 140:
-#line 999 "perly.y" /* yacc.c:1646 */
+#line 923 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP(OP_HELEM, 0,
ref(newHVREF((ps[-4].val.opval)),OP_RV2HV),
jmaybe((ps[-2].val.opval))); }
@@ -1264,14 +1188,14 @@ case 2:
break;
case 141:
-#line 1003 "perly.y" /* yacc.c:1646 */
+#line 927 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar((ps[-3].val.opval)))); }
break;
case 142:
-#line 1006 "perly.y" /* yacc.c:1646 */
+#line 930 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[-1].val.opval),
newCVREF(0, scalar((ps[-4].val.opval))))); }
@@ -1279,7 +1203,7 @@ case 2:
break;
case 143:
-#line 1011 "perly.y" /* yacc.c:1646 */
+#line 935 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[-1].val.opval),
newCVREF(0, scalar((ps[-3].val.opval))))); }
@@ -1287,44 +1211,44 @@ case 2:
break;
case 144:
-#line 1015 "perly.y" /* yacc.c:1646 */
+#line 939 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
newCVREF(0, scalar((ps[-2].val.opval)))); }
break;
case 145:
-#line 1018 "perly.y" /* yacc.c:1646 */
+#line 942 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); }
break;
case 146:
-#line 1020 "perly.y" /* yacc.c:1646 */
+#line 944 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); }
break;
case 147:
-#line 1022 "perly.y" /* yacc.c:1646 */
+#line 946 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (OP*)NULL); }
break;
case 148:
-#line 1027 "perly.y" /* yacc.c:1646 */
+#line 951 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); }
break;
case 149:
-#line 1029 "perly.y" /* yacc.c:1646 */
+#line 953 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 150:
-#line 1031 "perly.y" /* yacc.c:1646 */
+#line 955 "perly.y" /* yacc.c:1646 */
{ if ((ps[-1].val.ival) != OP_REPEAT)
scalar((ps[-2].val.opval));
(yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval)));
@@ -1333,111 +1257,111 @@ case 2:
break;
case 151:
-#line 1036 "perly.y" /* yacc.c:1646 */
+#line 960 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 152:
-#line 1038 "perly.y" /* yacc.c:1646 */
+#line 962 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 153:
-#line 1040 "perly.y" /* yacc.c:1646 */
+#line 964 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 154:
-#line 1042 "perly.y" /* yacc.c:1646 */
+#line 966 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 155:
-#line 1044 "perly.y" /* yacc.c:1646 */
+#line 968 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 156:
-#line 1046 "perly.y" /* yacc.c:1646 */
+#line 970 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 157:
-#line 1048 "perly.y" /* yacc.c:1646 */
+#line 972 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); }
break;
case 158:
-#line 1050 "perly.y" /* yacc.c:1646 */
+#line 974 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 159:
-#line 1052 "perly.y" /* yacc.c:1646 */
+#line 976 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 160:
-#line 1054 "perly.y" /* yacc.c:1646 */
+#line 978 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 161:
-#line 1056 "perly.y" /* yacc.c:1646 */
+#line 980 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 162:
-#line 1061 "perly.y" /* yacc.c:1646 */
+#line 985 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); }
break;
case 163:
-#line 1063 "perly.y" /* yacc.c:1646 */
+#line 987 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 164:
-#line 1066 "perly.y" /* yacc.c:1646 */
+#line 990 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); }
break;
case 165:
-#line 1068 "perly.y" /* yacc.c:1646 */
+#line 992 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); }
break;
case 166:
-#line 1070 "perly.y" /* yacc.c:1646 */
+#line 994 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_POSTINC, 0,
op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); }
break;
case 167:
-#line 1073 "perly.y" /* yacc.c:1646 */
+#line 997 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_POSTDEC, 0,
op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));}
break;
case 168:
-#line 1076 "perly.y" /* yacc.c:1646 */
+#line 1000 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_convert_list(OP_JOIN, 0,
op_append_elem(
OP_LIST,
@@ -1452,52 +1376,52 @@ case 2:
break;
case 169:
-#line 1087 "perly.y" /* yacc.c:1646 */
+#line 1011 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_PREINC, 0,
op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); }
break;
case 170:
-#line 1090 "perly.y" /* yacc.c:1646 */
+#line 1014 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_PREDEC, 0,
op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); }
break;
case 171:
-#line 1097 "perly.y" /* yacc.c:1646 */
+#line 1021 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONLIST((ps[-1].val.opval)); }
break;
case 172:
-#line 1099 "perly.y" /* yacc.c:1646 */
+#line 1023 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONLIST((OP*)NULL);}
break;
case 173:
-#line 1101 "perly.y" /* yacc.c:1646 */
+#line 1025 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONHASH((ps[-2].val.opval)); }
break;
case 174:
-#line 1103 "perly.y" /* yacc.c:1646 */
+#line 1027 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newANONHASH((OP*)NULL); }
break;
case 175:
-#line 1105 "perly.y" /* yacc.c:1646 */
+#line 1029 "perly.y" /* yacc.c:1646 */
{ SvREFCNT_inc_simple_void(PL_compcv);
(yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); }
break;
case 176:
-#line 1108 "perly.y" /* yacc.c:1646 */
+#line 1032 "perly.y" /* yacc.c:1646 */
{
OP *body;
if (parser->copline > (line_t)(ps[-2].val.ival))
@@ -1511,103 +1435,103 @@ case 2:
break;
case 177:
-#line 1122 "perly.y" /* yacc.c:1646 */
+#line 1046 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));}
break;
case 178:
-#line 1124 "perly.y" /* yacc.c:1646 */
+#line 1048 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));}
break;
case 183:
-#line 1132 "perly.y" /* yacc.c:1646 */
+#line 1056 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); }
break;
case 184:
-#line 1134 "perly.y" /* yacc.c:1646 */
+#line 1058 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); }
break;
case 185:
-#line 1136 "perly.y" /* yacc.c:1646 */
+#line 1060 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); }
break;
case 186:
-#line 1138 "perly.y" /* yacc.c:1646 */
+#line 1062 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 187:
-#line 1140 "perly.y" /* yacc.c:1646 */
+#line 1064 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = localize((ps[0].val.opval),0); }
break;
case 188:
-#line 1142 "perly.y" /* yacc.c:1646 */
+#line 1066 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens((ps[-1].val.opval)); }
break;
case 189:
-#line 1144 "perly.y" /* yacc.c:1646 */
+#line 1068 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 190:
-#line 1146 "perly.y" /* yacc.c:1646 */
+#line 1070 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens(newNULLLIST()); }
break;
case 191:
-#line 1148 "perly.y" /* yacc.c:1646 */
+#line 1072 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 192:
-#line 1150 "perly.y" /* yacc.c:1646 */
+#line 1074 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 193:
-#line 1152 "perly.y" /* yacc.c:1646 */
+#line 1076 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 194:
-#line 1154 "perly.y" /* yacc.c:1646 */
+#line 1078 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 195:
-#line 1156 "perly.y" /* yacc.c:1646 */
+#line 1080 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));}
break;
case 196:
-#line 1158 "perly.y" /* yacc.c:1646 */
+#line 1082 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 197:
-#line 1160 "perly.y" /* yacc.c:1646 */
+#line 1084 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_ASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_ASLICE, 0,
@@ -1621,7 +1545,7 @@ case 2:
break;
case 198:
-#line 1170 "perly.y" /* yacc.c:1646 */
+#line 1094 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_KVASLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_KVASLICE, 0,
@@ -1635,7 +1559,7 @@ case 2:
break;
case 199:
-#line 1180 "perly.y" /* yacc.c:1646 */
+#line 1104 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_HSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_HSLICE, 0,
@@ -1649,7 +1573,7 @@ case 2:
break;
case 200:
-#line 1190 "perly.y" /* yacc.c:1646 */
+#line 1114 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_prepend_elem(OP_KVHSLICE,
newOP(OP_PUSHMARK, 0),
newLISTOP(OP_KVHSLICE, 0,
@@ -1663,26 +1587,26 @@ case 2:
break;
case 201:
-#line 1200 "perly.y" /* yacc.c:1646 */
+#line 1124 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 202:
-#line 1202 "perly.y" /* yacc.c:1646 */
+#line 1126 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); }
break;
case 203:
-#line 1204 "perly.y" /* yacc.c:1646 */
+#line 1128 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval)));
}
break;
case 204:
-#line 1207 "perly.y" /* yacc.c:1646 */
+#line 1131 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval))));
@@ -1691,7 +1615,7 @@ case 2:
break;
case 205:
-#line 1212 "perly.y" /* yacc.c:1646 */
+#line 1136 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval))));
}
@@ -1699,130 +1623,130 @@ case 2:
break;
case 206:
-#line 1216 "perly.y" /* yacc.c:1646 */
+#line 1140 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSVREF((ps[-3].val.opval)); }
break;
case 207:
-#line 1218 "perly.y" /* yacc.c:1646 */
+#line 1142 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[-3].val.opval)); }
break;
case 208:
-#line 1220 "perly.y" /* yacc.c:1646 */
+#line 1144 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newHVREF((ps[-3].val.opval)); }
break;
case 209:
-#line 1222 "perly.y" /* yacc.c:1646 */
+#line 1146 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, 0,
scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); }
break;
case 210:
-#line 1225 "perly.y" /* yacc.c:1646 */
+#line 1149 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); }
break;
case 211:
-#line 1227 "perly.y" /* yacc.c:1646 */
+#line 1151 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL);
PL_hints |= HINT_BLOCK_SCOPE; }
break;
case 212:
-#line 1230 "perly.y" /* yacc.c:1646 */
+#line 1154 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); }
break;
case 213:
-#line 1232 "perly.y" /* yacc.c:1646 */
+#line 1156 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); }
break;
case 214:
-#line 1234 "perly.y" /* yacc.c:1646 */
+#line 1158 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[0].val.ival), 0); }
break;
case 215:
-#line 1236 "perly.y" /* yacc.c:1646 */
+#line 1160 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); }
break;
case 216:
-#line 1238 "perly.y" /* yacc.c:1646 */
+#line 1162 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); }
break;
case 217:
-#line 1240 "perly.y" /* yacc.c:1646 */
+#line 1164 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); }
break;
case 218:
-#line 1242 "perly.y" /* yacc.c:1646 */
+#line 1166 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); }
break;
case 219:
-#line 1244 "perly.y" /* yacc.c:1646 */
+#line 1168 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); }
break;
case 220:
-#line 1246 "perly.y" /* yacc.c:1646 */
+#line 1170 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED,
op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); }
break;
case 221:
-#line 1249 "perly.y" /* yacc.c:1646 */
+#line 1173 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[0].val.ival), 0); }
break;
case 222:
-#line 1251 "perly.y" /* yacc.c:1646 */
+#line 1175 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newOP((ps[-2].val.ival), 0);}
break;
case 223:
-#line 1253 "perly.y" /* yacc.c:1646 */
+#line 1177 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 224:
-#line 1255 "perly.y" /* yacc.c:1646 */
+#line 1179 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[-2].val.opval); }
break;
case 225:
-#line 1257 "perly.y" /* yacc.c:1646 */
+#line 1181 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); }
break;
case 226:
-#line 1259 "perly.y" /* yacc.c:1646 */
+#line 1183 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = ((ps[-2].val.ival) == OP_NOT)
? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0)))
: newOP((ps[-2].val.ival), OPf_SPECIAL); }
@@ -1830,13 +1754,13 @@ case 2:
break;
case 227:
-#line 1263 "perly.y" /* yacc.c:1646 */
+#line 1187 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); }
break;
case 228:
-#line 1265 "perly.y" /* yacc.c:1646 */
+#line 1189 "perly.y" /* yacc.c:1646 */
{
if ( (ps[0].val.opval)->op_type != OP_TRANS
&& (ps[0].val.opval)->op_type != OP_TRANSR
@@ -1851,13 +1775,13 @@ case 2:
break;
case 229:
-#line 1276 "perly.y" /* yacc.c:1646 */
+#line 1200 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); }
break;
case 232:
-#line 1280 "perly.y" /* yacc.c:1646 */
+#line 1204 "perly.y" /* yacc.c:1646 */
{
(yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
@@ -1866,109 +1790,109 @@ case 2:
break;
case 234:
-#line 1289 "perly.y" /* yacc.c:1646 */
+#line 1213 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); }
break;
case 235:
-#line 1291 "perly.y" /* yacc.c:1646 */
+#line 1215 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = localize((ps[0].val.opval),1); }
break;
case 236:
-#line 1293 "perly.y" /* yacc.c:1646 */
+#line 1217 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); }
break;
case 237:
-#line 1298 "perly.y" /* yacc.c:1646 */
+#line 1222 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens((ps[-1].val.opval)); }
break;
case 238:
-#line 1300 "perly.y" /* yacc.c:1646 */
+#line 1224 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = sawparens(newNULLLIST()); }
break;
case 239:
-#line 1303 "perly.y" /* yacc.c:1646 */
+#line 1227 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 240:
-#line 1305 "perly.y" /* yacc.c:1646 */
+#line 1229 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 241:
-#line 1307 "perly.y" /* yacc.c:1646 */
+#line 1231 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 242:
-#line 1312 "perly.y" /* yacc.c:1646 */
+#line 1236 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 243:
-#line 1314 "perly.y" /* yacc.c:1646 */
+#line 1238 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 244:
-#line 1318 "perly.y" /* yacc.c:1646 */
+#line 1242 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 245:
-#line 1320 "perly.y" /* yacc.c:1646 */
+#line 1244 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 246:
-#line 1324 "perly.y" /* yacc.c:1646 */
+#line 1248 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (OP*)NULL; }
break;
case 247:
-#line 1326 "perly.y" /* yacc.c:1646 */
+#line 1250 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
case 248:
-#line 1332 "perly.y" /* yacc.c:1646 */
+#line 1256 "perly.y" /* yacc.c:1646 */
{ parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); }
break;
case 256:
-#line 1349 "perly.y" /* yacc.c:1646 */
+#line 1273 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); }
break;
case 257:
-#line 1353 "perly.y" /* yacc.c:1646 */
+#line 1277 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newSVREF((ps[0].val.opval)); }
break;
case 258:
-#line 1357 "perly.y" /* yacc.c:1646 */
+#line 1281 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[0].val.opval));
if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival);
}
@@ -1976,7 +1900,7 @@ case 2:
break;
case 259:
-#line 1363 "perly.y" /* yacc.c:1646 */
+#line 1287 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newHVREF((ps[0].val.opval));
if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival);
}
@@ -1984,61 +1908,61 @@ case 2:
break;
case 260:
-#line 1369 "perly.y" /* yacc.c:1646 */
+#line 1293 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[0].val.opval)); }
break;
case 261:
-#line 1371 "perly.y" /* yacc.c:1646 */
+#line 1295 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[-3].val.opval)); }
break;
case 262:
-#line 1375 "perly.y" /* yacc.c:1646 */
+#line 1299 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newGVREF(0,(ps[0].val.opval)); }
break;
case 264:
-#line 1380 "perly.y" /* yacc.c:1646 */
+#line 1304 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newAVREF((ps[-2].val.opval)); }
break;
case 266:
-#line 1385 "perly.y" /* yacc.c:1646 */
+#line 1309 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newHVREF((ps[-2].val.opval)); }
break;
case 268:
-#line 1390 "perly.y" /* yacc.c:1646 */
+#line 1314 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); }
break;
case 269:
-#line 1395 "perly.y" /* yacc.c:1646 */
+#line 1319 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = scalar((ps[0].val.opval)); }
break;
case 270:
-#line 1397 "perly.y" /* yacc.c:1646 */
+#line 1321 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = scalar((ps[0].val.opval)); }
break;
case 271:
-#line 1399 "perly.y" /* yacc.c:1646 */
+#line 1323 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = op_scope((ps[0].val.opval)); }
break;
case 272:
-#line 1402 "perly.y" /* yacc.c:1646 */
+#line 1326 "perly.y" /* yacc.c:1646 */
{ (yyval.opval) = (ps[0].val.opval); }
break;
@@ -2049,6 +1973,6 @@ case 2:
/* Generated from:
- * 719f2ad40259ac9c064749d399f2c7d1e1131abbc8c1f1ec0558cac2d8f2bc4c perly.y
+ * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
* 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
* ex: set ro: */
diff --git a/perly.h b/perly.h
index 8c8c459f3c..25c69c5383 100644
--- a/perly.h
+++ b/perly.h
@@ -181,6 +181,6 @@ int yyparse (void);
/* Generated from:
- * 719f2ad40259ac9c064749d399f2c7d1e1131abbc8c1f1ec0558cac2d8f2bc4c perly.y
+ * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
* 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
* ex: set ro: */
diff --git a/perly.tab b/perly.tab
index f6685b856b..997be30c97 100644
--- a/perly.tab
+++ b/perly.tab
@@ -78,25 +78,25 @@ static const yytype_uint16 yyrline[] =
510, 512, 514, 516, 518, 520, 522, 525, 531, 532,
537, 548, 549, 555, 561, 562, 567, 570, 574, 579,
583, 587, 588, 592, 598, 603, 608, 609, 614, 615,
- 620, 621, 623, 628, 630, 642, 643, 651, 653, 657,
- 705, 706, 708, 714, 792, 794, 800, 802, 806, 812,
- 813, 818, 817, 897, 898, 902, 904, 906, 908, 912,
- 914, 919, 923, 927, 931, 937, 942, 948, 954, 956,
- 959, 958, 969, 970, 974, 978, 981, 986, 991, 994,
- 998, 1002, 1005, 1010, 1014, 1017, 1019, 1021, 1026, 1028,
- 1030, 1035, 1037, 1039, 1041, 1043, 1045, 1047, 1049, 1051,
- 1053, 1055, 1060, 1062, 1065, 1067, 1069, 1072, 1075, 1086,
- 1089, 1096, 1098, 1100, 1102, 1104, 1107, 1121, 1123, 1127,
- 1128, 1129, 1130, 1131, 1133, 1135, 1137, 1139, 1141, 1143,
- 1145, 1147, 1149, 1151, 1153, 1155, 1157, 1159, 1169, 1179,
- 1189, 1199, 1201, 1203, 1206, 1211, 1215, 1217, 1219, 1221,
- 1224, 1226, 1229, 1231, 1233, 1235, 1237, 1239, 1241, 1243,
- 1245, 1248, 1250, 1252, 1254, 1256, 1258, 1262, 1265, 1264,
- 1277, 1278, 1279, 1284, 1288, 1290, 1292, 1297, 1299, 1302,
- 1304, 1306, 1311, 1313, 1318, 1319, 1324, 1325, 1331, 1335,
- 1336, 1337, 1340, 1341, 1344, 1345, 1348, 1352, 1356, 1362,
- 1368, 1370, 1374, 1378, 1379, 1383, 1384, 1388, 1389, 1394,
- 1396, 1398, 1401
+ 620, 621, 623, 628, 630, 642, 643, 648, 650, 654,
+ 674, 675, 677, 683, 747, 749, 755, 757, 761, 767,
+ 768, 773, 772, 821, 822, 826, 828, 830, 832, 836,
+ 838, 843, 847, 851, 855, 861, 866, 872, 878, 880,
+ 883, 882, 893, 894, 898, 902, 905, 910, 915, 918,
+ 922, 926, 929, 934, 938, 941, 943, 945, 950, 952,
+ 954, 959, 961, 963, 965, 967, 969, 971, 973, 975,
+ 977, 979, 984, 986, 989, 991, 993, 996, 999, 1010,
+ 1013, 1020, 1022, 1024, 1026, 1028, 1031, 1045, 1047, 1051,
+ 1052, 1053, 1054, 1055, 1057, 1059, 1061, 1063, 1065, 1067,
+ 1069, 1071, 1073, 1075, 1077, 1079, 1081, 1083, 1093, 1103,
+ 1113, 1123, 1125, 1127, 1130, 1135, 1139, 1141, 1143, 1145,
+ 1148, 1150, 1153, 1155, 1157, 1159, 1161, 1163, 1165, 1167,
+ 1169, 1172, 1174, 1176, 1178, 1180, 1182, 1186, 1189, 1188,
+ 1201, 1202, 1203, 1208, 1212, 1214, 1216, 1221, 1223, 1226,
+ 1228, 1230, 1235, 1237, 1242, 1243, 1248, 1249, 1255, 1259,
+ 1260, 1261, 1264, 1265, 1268, 1269, 1272, 1276, 1280, 1286,
+ 1292, 1294, 1298, 1302, 1303, 1307, 1308, 1312, 1313, 1318,
+ 1320, 1322, 1325
};
#endif
@@ -1109,6 +1109,6 @@ static const toketypes yy_type_tab[] =
};
/* Generated from:
- * 719f2ad40259ac9c064749d399f2c7d1e1131abbc8c1f1ec0558cac2d8f2bc4c perly.y
+ * 6deb43709ef5dcefc6a8b7059606df5a86eae75b6a769e7451f39368b1de5d9d perly.y
* 3e1dff60f26df8933d7aed0c0e87177a0f022c14800c0707eb62a7db4196ac98 regen_perly.pl
* ex: set ro: */
diff --git a/perly.y b/perly.y
index f28124d9f4..2f3647fc0b 100644
--- a/perly.y
+++ b/perly.y
@@ -641,10 +641,7 @@ myattrlist: COLONATTR THING
sigvarname: /* NULL */
{ $$ = (OP*)NULL; }
| PRIVATEREF
- {
- $$ = $1;
- PL_parser->in_my = 0;
- }
+ { $$ = $1; }
;
sigslurpsigil:
@@ -656,10 +653,9 @@ sigslurpsigil:
/* @, %, @foo, %foo */
sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
{
- I32 sigil = $1;
- OP *var = $2;
+ I32 sigil = $1;
+ OP *var = $2;
OP *defexpr = $3;
- int type = (sigil == '@' ? OP_PADAV : OP_PADHV);
if (PL_parser->sig_slurpy)
yyerror("Multiple slurpy parameters not allowed");
@@ -669,34 +665,7 @@ sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */
yyerror("a slurpy parameter may not have "
"a default value");
- if (var) {
- OP *slice;
-
- var->op_type = type;
- var->op_ppaddr = PL_ppaddr[type];
- var->op_flags = (OPf_WANT_LIST | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
-
- slice = PL_parser->sig_elems
- ? op_prepend_elem(OP_ASLICE,
- newOP(OP_PUSHMARK, 0),
- newLISTOP(OP_ASLICE, 0,
- list(newRANGE(0,
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)),
- newUNOP(OP_AV2ARYLEN, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_AV2ARYLEN)))),
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_ASLICE)))
- : newUNOP(OP_RV2AV, 0, newGVOP(OP_GV, 0, PL_defgv));
- $$ = newSTATEOP(0, NULL,
- newASSIGNOP(OPf_STACKED, var, 0, slice));
- }
- else
- $$ = (OP*)NULL;
+ $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
;
@@ -715,75 +684,61 @@ sigscalarelem:
{
OP *var = $2;
OP *defexpr = $3;
- OP *argn = NULL;
- OP *expr = NULL;
if (PL_parser->sig_slurpy)
yyerror("Slurpy parameter not last");
PL_parser->sig_elems++;
- if (var) {
- var->op_type = OP_PADSV;
- var->op_ppaddr = PL_ppaddr[OP_PADSV];
- var->op_flags = (OPf_WANT_SCALAR | OPf_MOD);
- var->op_private = OPpLVAL_INTRO;
- }
-
- /* $_[N] */
- argn = newBINOP(OP_AELEM, 0,
- ref(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv)),
- OP_RV2AV),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems - 1)));
-
if (defexpr) {
PL_parser->sig_optelems++;
- /* is it '$var=undef', '$=' ? */
- if ( ( defexpr->op_type == OP_NULL
- || defexpr->op_type == OP_UNDEF)
+
+ if ( defexpr->op_type == OP_NULL
&& !(defexpr->op_flags & OPf_KIDS))
{
- if (var) {
- /* '$=' is legal, '$var=' isn't */
- if (defexpr->op_type == OP_NULL)
- yyerror("Optional parameter "
- "lacks default expression");
- else
- expr = argn;
- }
+ /* handle '$=' special case */
+ if (var)
+ yyerror("Optional parameter "
+ "lacks default expression");
op_free(defexpr);
}
- else {
- /* @_ >= N */
- OP *ge_op =
- newBINOP(OP_GE, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems)));
-
- expr = var
- ? newCONDOP(0, ge_op, argn, defexpr)
- : newLOGOP(OP_OR, 0, ge_op, defexpr);
+ else {
+ /* a normal '=default' expression */
+ OP *defop = (OP*)alloc_LOGOP(OP_ARGDEFELEM,
+ defexpr,
+ LINKLIST(defexpr));
+ /* re-purpose op_targ to hold @_ index */
+ defop->op_targ = PL_parser->sig_elems - 1;
+
+ if (var) {
+ var->op_flags |= OPf_STACKED;
+ (void)op_sibling_splice(var,
+ NULL, 0, defop);
+ scalar(defop);
+ }
+ else
+ var = newUNOP(OP_NULL, 0, defop);
+
+ LINKLIST(var);
+ /* NB: normally the first child of a
+ * logop is executed before the logop,
+ * and it pushes a boolean result
+ * ready for the logop. For ARGDEFELEM,
+ * the op itself does the boolean
+ * calculation, so set the first op to
+ * it instead.
+ */
+ var->op_next = defop;
+ defexpr->op_next = var;
}
}
else {
if (PL_parser->sig_optelems)
yyerror("Mandatory parameter "
"follows optional parameter");
- expr = argn;
}
- if (var)
- expr = newASSIGNOP(OPf_STACKED, var, 0, expr);
- if (expr)
- $$ = op_prepend_elem(OP_LINESEQ,
- newSTATEOP(0, NULL, NULL),
- expr);
- else
- $$ = (OP*)NULL;
+ $$ = var ? newSTATEOP(0, NULL, var) : (OP*)NULL;
}
;
@@ -828,9 +783,9 @@ subsignature: '('
siglistornull
')'
{
- OP *sigops = $3;
- int min_arity =
- PL_parser->sig_elems - PL_parser->sig_optelems;
+ OP *sigops = $3;
+ UNOP_AUX_item *aux;
+ OP *check;
assert(FEATURE_SIGNATURES_IS_ENABLED);
@@ -839,52 +794,21 @@ subsignature: '('
packWARN(WARN_EXPERIMENTAL__SIGNATURES),
"The signatures feature is experimental");
- /* handle odd/even for %foo */
- if (PL_parser->sig_slurpy == '%') {
- OP *chkop =
- newLOGOP(
- (PL_parser->sig_elems & 1)
- ? OP_OR : OP_AND,
- 0,
- newBINOP(OP_BIT_AND, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0, newSViv(1))),
- op_convert_list(OP_DIE, 0,
- op_convert_list(OP_SPRINTF, 0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0,
- newSVpvs("Odd name/value argument for subroutine at %s line %d.\n")),
- newSLICEOP(0,
- op_append_list(OP_LIST,
- newSVOP(OP_CONST, 0, newSViv(1)),
- newSVOP(OP_CONST, 0, newSViv(2))),
- newOP(OP_CALLER, 0))))));
- if (PL_parser->sig_optelems)
- chkop = newLOGOP(OP_AND, 0,
- newBINOP(OP_GT, 0,
- scalar(newUNOP(OP_RV2AV, 0,
- newGVOP(OP_GV, 0, PL_defgv))),
- newSVOP(OP_CONST, 0,
- newSViv(PL_parser->sig_elems))),
- chkop);
- sigops = op_prepend_elem(OP_LINESEQ,
- chkop, sigops);
-
- }
- if (min_arity)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_ min_arity,
- FALSE),
- sigops);
- if (!PL_parser->sig_slurpy)
- sigops = op_prepend_elem(OP_LINESEQ,
- Perl_check_arity(aTHX_
- PL_parser->sig_elems, TRUE),
- sigops);
-
- $$ = op_append_elem(OP_LINESEQ, sigops,
- newSTATEOP(0, NULL, NULL));
+ aux = (UNOP_AUX_item*)PerlMemShared_malloc(
+ sizeof(UNOP_AUX_item) * 3);
+ aux[0].uv = PL_parser->sig_elems;
+ aux[1].uv = PL_parser->sig_optelems;
+ aux[2].iv = PL_parser->sig_slurpy;
+ check = newUNOP_AUX(OP_ARGCHECK, 0, NULL, aux);
+ sigops = op_prepend_elem(OP_LINESEQ, check, sigops);
+ sigops = op_prepend_elem(OP_LINESEQ,
+ newSTATEOP(0, NULL, NULL),
+ sigops);
+ /* a nextstate at the end handles context
+ * correctly for an empty sub body */
+ $$ = op_append_elem(OP_LINESEQ,
+ sigops,
+ newSTATEOP(0, NULL, NULL));
parser->expect = XATTRBLOCK;
LEAVE;
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 19e9dffdb3..557fadd830 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -6043,6 +6043,12 @@ uc(), or ucfirst() (or their string-inlined versions), but you
specified an illegal mapping.
See L<perlunicode/"User-Defined Character Properties">.
+=item Too %s arguments for subroutine
+
+(F) A subroutine using a signature received too few or too many arguments
+than required by the signature. The caller of the subroutine is
+presumably at fault.
+
=item Too deeply nested ()-groups
(F) Your template contains ()-groups with a ridiculously deep nesting level.
@@ -6052,13 +6058,6 @@ See L<perlunicode/"User-Defined Character Properties">.
(F) There has to be at least one argument to syscall() to specify the
system call to call, silly dilly.
-=item Too few arguments for subroutine
-
-(F) A subroutine using a signature received fewer arguments than required
-by the signature. The caller of the subroutine is presumably at fault.
-Inconveniently, this error will be reported at the location of the
-subroutine, not that of the caller.
-
=item Too late for "-%s" option
(X) The #! line (or local equivalent) in a Perl script contains the
@@ -6089,13 +6088,6 @@ BEGIN block.
(F) The function requires fewer arguments than you specified.
-=item Too many arguments for subroutine
-
-(F) A subroutine using a signature received more arguments than required
-by the signature. The caller of the subroutine is presumably at fault.
-Inconveniently, this error will be reported at the location of the
-subroutine, not that of the caller.
-
=item Too many )'s
(A) You've accidentally run your script through B<csh> instead of Perl.
diff --git a/pp.c b/pp.c
index 8498469d6f..1fba3d97b6 100644
--- a/pp.c
+++ b/pp.c
@@ -6615,6 +6615,212 @@ PP(pp_anonconst)
RETURN;
}
+
+/* process one subroutine argument - typically when the sub has a signature:
+ * introduce PL_curpad[op_targ] and assign to it the value
+ * for $: (OPf_STACKED ? *sp : $_[N])
+ * for @/%: @_[N..$#_]
+ *
+ * It's equivalent to
+ * my $foo = $_[N];
+ * or
+ * my $foo = (value-on-stack)
+ * or
+ * my @foo = @_[N..$#_]
+ * etc
+ *
+ * It assumes that the pad var is currently uninitialised, so this op
+ * should only be used at the start of a sub, where its not possible to
+ * skip the op (e.g. no 'my $x if $cond' stuff for example).
+ */
+
+PP(pp_argelem)
+{
+ dTARG;
+ SV *val;
+ SV ** padentry;
+ OP *o = PL_op;
+ AV *defav = GvAV(PL_defgv); /* @_ */
+ UV ix = PTR2UV(cUNOP_AUXo->op_aux);
+ IV argc;
+ SV **argv;
+
+ assert(!SvMAGICAL(defav));
+
+ /* do 'my $var, @var or %var' action */
+ padentry = &(PAD_SVl(o->op_targ));
+ save_clearsv(padentry);
+ targ = *padentry;
+
+ if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_SV) {
+ if (o->op_flags & OPf_STACKED) {
+ dSP;
+ val = POPs;
+ PUTBACK;
+ }
+ else {
+ /* should already have been checked */
+ assert(ix < I32_MAX && AvFILLp(defav) >= (I32)ix);
+ val = AvARRAY(defav)[ix];
+ if (UNLIKELY(!val))
+ val = &PL_sv_undef;
+ }
+
+ /* $var = $val */
+
+ /* cargo-culted from pp_sassign */
+ assert(TAINTING_get || !TAINT_get);
+ if (UNLIKELY(TAINT_get) && !SvTAINTED(val))
+ TAINT_NOT;
+
+ /* Short-cut assignment of IV and RV values as these are
+ * common and simple. For RVs, it's likely that on
+ * subsequent calls to a function, targ is already of the
+ * correct storage class */
+ if (LIKELY(!SvMAGICAL(val))) {
+ /* just an IV */
+ if ((SvFLAGS(val) & (SVf_IOK|SVf_NOK|SVf_POK|SVf_IVisUV)) == SVf_IOK) {
+ IV i = SvIVX(val);
+ if (LIKELY(SvTYPE(targ) == SVt_IV)) {
+ assert(!SvOK(targ));
+ assert(!SvMAGICAL(targ));
+ (void)SvIOK_only(targ);
+ SvIV_set(targ, i);
+ }
+ else
+ sv_setiv(targ, i);
+ }
+ else if (SvROK(val) && SvTYPE(targ) == SVt_IV) {
+ /* quick ref assignment */
+ assert(!SvOK(targ));
+ SvRV_set(targ, SvREFCNT_inc(SvRV(val)));
+ SvROK_on(targ);
+ }
+ else
+ sv_setsv(targ, val);
+ }
+ else
+ sv_setsv(targ, val);
+ return o->op_next;
+ }
+
+ /* must be AV or HV */
+
+ assert(!(o->op_flags & OPf_STACKED));
+ argc = ((IV)AvFILLp(defav) + 1) - (IV)ix;
+ assert(!SvMAGICAL(targ));
+ if (argc <= 0)
+ return o->op_next;
+ argv = AvARRAY(defav) + ix;
+ assert(argv);
+
+ /* This is a copy of the relevant parts of pp_aassign().
+ * We *know* that @foo / %foo is a plain empty lexical at this point,
+ * so we can avoid a lot of the extra baggage.
+ * We know, because all the usual tricks like 'my @a if 0',
+ * 'foo: my @a = ...; goto foo' can't be done with signatures.
+ */
+ if ((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_AV) {
+ UV i = 0;
+
+ assert(AvFILLp((AV*)targ) == -1); /* can skip av_clear() */
+ av_extend((AV*)targ, argc);
+
+ while (argc--) {
+ SV *tmpsv;
+ SV *arg = *argv++;
+ tmpsv = newSV(0);
+ sv_setsv(tmpsv, arg);
+ av_store((AV*)targ, i++, tmpsv);
+ TAINT_NOT;
+ }
+
+ }
+ else {
+ assert((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_HV);
+
+ assert(argc % 2 == 0);
+ assert(!HvTOTALKEYS(targ)); /* can skip hv_clear() */
+
+ while (argc) {
+ SV *tmpsv;
+ SV *key = *argv++;
+ SV *val = *argv++;
+
+ assert(key); assert(val);
+ argc -= 2;
+ if (UNLIKELY(SvGMAGICAL(key)))
+ key = sv_mortalcopy(key);
+ tmpsv = newSV(0);
+ sv_setsv(tmpsv, val);
+ hv_store_ent((HV*)targ, key, tmpsv, 0);
+ TAINT_NOT;
+ }
+ }
+
+ return o->op_next;
+}
+
+/* Handle a default value for one subroutine argument (typically as part
+ * of a subroutine signature).
+ * It's equivalent to
+ * @_ > op_targ ? $_[op_targ] : result_of(op_other)
+ *
+ * Intended to be used where op_next is an OP_ARGELEM
+ *
+ * We abuse the op_targ field slightly: it's an index into @_ rather than
+ * into PL_curpad.
+ */
+
+PP(pp_argdefelem)
+{
+ OP * const o = PL_op;
+ AV *defav = GvAV(PL_defgv); /* @_ */
+ PADOFFSET ix = o->op_targ;
+
+ assert(!SvMAGICAL(defav));
+ assert(ix < I32_MAX);
+ if (AvFILLp(defav) >= (I32)ix) {
+ dSP;
+ XPUSHs(AvARRAY(defav)[ix]);
+ RETURN;
+ }
+ return cLOGOPo->op_other;
+}
+
+
+
+/* Check a a subs arguments - i.e. that it has the correct number of args
+ * (and anything else we might think of in future). Typically used with
+ * signatured subs.
+ */
+
+PP(pp_argcheck)
+{
+ OP * const o = PL_op;
+ UNOP_AUX_item *aux = cUNOP_AUXo->op_aux;
+ UV params = aux[0].uv;
+ UV opt_params = aux[1].uv;
+ char slurpy = (char)(aux[2].iv);
+ AV *defav = GvAV(PL_defgv); /* @_ */
+ UV argc;
+ bool too_few;
+
+ assert(!SvMAGICAL(defav));
+ argc = (UV)(AvFILLp(defav) + 1);
+ too_few = (argc < (params - opt_params));
+
+ if (UNLIKELY(too_few || (!slurpy && argc > params)))
+ Perl_croak_caller("Too %s arguments for subroutine",
+ too_few ? "few" : "many");
+
+ if (UNLIKELY(slurpy == '%' && argc > params && (argc - params) % 2))
+ Perl_croak_caller("Odd name/value argument for subroutine");
+
+
+ return NORMAL;
+}
+
/*
* ex: set ts=8 sts=4 sw=4 et:
*/
diff --git a/pp_hot.c b/pp_hot.c
index 87346871d6..3f37ce4e32 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -4023,6 +4023,28 @@ Perl_sub_crush_depth(pTHX_ CV *cv)
}
}
+
+
+/* like croak, but report in context of caller */
+
+void
+Perl_croak_caller(const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ const PERL_CONTEXT *cx = caller_cx(0, NULL);
+
+ /* make error appear at call site */
+ assert(cx);
+ PL_curcop = cx->blk_oldcop;
+
+ va_start(args, pat);
+ vcroak(pat, &args);
+ NOT_REACHED; /* NOTREACHED */
+ va_end(args);
+}
+
+
PP(pp_aelem)
{
dSP;
diff --git a/pp_proto.h b/pp_proto.h
index fd54df8e45..16b1729348 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -19,6 +19,9 @@ PERL_CALLCONV OP *Perl_pp_anoncode(pTHX);
PERL_CALLCONV OP *Perl_pp_anonconst(pTHX);
PERL_CALLCONV OP *Perl_pp_anonhash(pTHX);
PERL_CALLCONV OP *Perl_pp_anonlist(pTHX);
+PERL_CALLCONV OP *Perl_pp_argcheck(pTHX);
+PERL_CALLCONV OP *Perl_pp_argdefelem(pTHX);
+PERL_CALLCONV OP *Perl_pp_argelem(pTHX);
PERL_CALLCONV OP *Perl_pp_aslice(pTHX);
PERL_CALLCONV OP *Perl_pp_atan2(pTHX);
PERL_CALLCONV OP *Perl_pp_av2arylen(pTHX);
diff --git a/proto.h b/proto.h
index 0da11b8ab5..eb92412778 100644
--- a/proto.h
+++ b/proto.h
@@ -267,7 +267,6 @@ PERL_CALLCONV U32 Perl_cast_ulong(NV f)
PERL_CALLCONV UV Perl_cast_uv(NV f)
__attribute__warn_unused_result__;
-PERL_CALLCONV OP* Perl_check_arity(pTHX_ int arity, bool max);
PERL_CALLCONV bool Perl_check_utf8_print(pTHX_ const U8 *s, const STRLEN len);
#define PERL_ARGS_ASSERT_CHECK_UTF8_PRINT \
assert(s)
@@ -548,6 +547,10 @@ PERL_CALLCONV_NO_RET void Perl_croak(pTHX_ const char* pat, ...)
__attribute__noreturn__
__attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2);
+PERL_CALLCONV_NO_RET void Perl_croak_caller(const char* pat, ...)
+ __attribute__noreturn__
+ __attribute__format__null_ok__(__printf__,1,2);
+
PERL_STATIC_NO_RET void S_croak_memory_wrap(void)
__attribute__noreturn__;
@@ -5494,7 +5497,7 @@ STATIC void S_no_op(pTHX_ const char *const what, char *s);
STATIC void S_parse_ident(pTHX_ char **s, char **d, char * const e, int allow_package, bool is_utf8, bool check_dollar);
#define PERL_ARGS_ASSERT_PARSE_IDENT \
assert(s); assert(d); assert(e)
-STATIC int S_pending_ident(pTHX);
+STATIC int S_pending_ident(pTHX_ bool is_sig);
STATIC char* S_scan_const(pTHX_ char *start)
__attribute__warn_unused_result__;
#define PERL_ARGS_ASSERT_SCAN_CONST \
diff --git a/regen/op_private b/regen/op_private
index e291295cd0..478144273c 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -762,6 +762,18 @@ addbits('multideref',
addbits('avhvswitch', '0..1' => { });
+addbits('argelem',
+ '1..2' => {
+ mask_def => 'OPpARGELEM_MASK',
+ enum => [ qw(
+ 0 OPpARGELEM_SV SV
+ 1 OPpARGELEM_AV AV
+ 2 OPpARGELEM_HV HV
+ )],
+ },
+);
+
+
1;
# ex: set ts=8 sts=4 sw=4 et:
diff --git a/regen/opcodes b/regen/opcodes
index b70ff923a9..57dd363c1c 100644
--- a/regen/opcodes
+++ b/regen/opcodes
@@ -299,6 +299,9 @@ method method lookup ck_method d.
entersub subroutine entry ck_subr dm1 L
leavesub subroutine exit ck_null 1
leavesublv lvalue subroutine return ck_null 1
+argcheck check subroutine arguments ck_null +
+argelem subroutine argument ck_null +
+argdefelem subroutine argument default value ck_null |
caller caller ck_fun t% S?
warn warn ck_fun imst@ L
die die ck_fun imst@ L
diff --git a/t/op/signatures.t b/t/op/signatures.t
index 3db1b40aa0..6470586c81 100644
--- a/t/op/signatures.t
+++ b/t/op/signatures.t
@@ -1297,6 +1297,23 @@ is scalar(t117()), undef;
is scalar(@{[ t117(333, 444) ]}), 0;
is scalar(t117(333, 444)), undef;
+sub t145 ($=3) { }
+is scalar(t145()), undef;
+
+{
+ my $want;
+ sub want { $want = wantarray ? "list"
+ : defined(wantarray) ? "scalar" : "void"; 1 }
+
+ sub t144 ($a = want()) { $a }
+ t144();
+ is ($want, "scalar", "default expression is scalar in void context");
+ my $x = t144();
+ is ($want, "scalar", "default expression is scalar in scalar context");
+ () = t144();
+ is ($want, "scalar", "default expression is scalar in list context");
+}
+
use File::Spec::Functions;
my $keywords_file = catfile(updir,'regen','keywords.pl');
open my $kh, $keywords_file
diff --git a/toke.c b/toke.c
index 09d15a950d..74313dc459 100644
--- a/toke.c
+++ b/toke.c
@@ -4545,7 +4545,8 @@ Perl_yylex(pTHX)
PL_lex_allbrackets--;
next_type &= 0xffff;
}
- return REPORT(next_type == 'p' ? pending_ident() : next_type);
+ return REPORT(next_type == 'p' ? pending_ident(0)
+ : next_type == 'P' ? pending_ident(1) : next_type);
}
}
@@ -4837,16 +4838,14 @@ Perl_yylex(pTHX)
s = skipspace(s);
if (isIDFIRST_lazy_if(s, UTF)) {
char *dest = PL_tokenbuf + 1;
- /* on next call to yylex this causes pending_ident()
- * to allocmy() etc */
- PL_in_my = KEY_my;
/* read var name, including sigil, into PL_tokenbuf */
PL_tokenbuf[0] = sigil;
parse_ident(&s, &dest, dest + sizeof(PL_tokenbuf) - 1,
0, cBOOL(UTF), FALSE);
*dest = '\0';
assert(PL_tokenbuf[1]); /* we have a variable name */
- force_ident_maybe_lex(sigil);
+ NEXTVAL_NEXTTOKE.ival = sigil;
+ force_next('P'); /* force a signature pending identifier */
}
PL_expect = XOPERATOR;
break;
@@ -8535,6 +8534,9 @@ Perl_yylex(pTHX)
Looks up an identifier in the pad or in a package
+ is_sig indicates that this is a subroutine signature variable
+ rather than a plain pad var.
+
Returns:
PRIVATEREF if this is a lexical name.
BAREWORD if this belongs to a package.
@@ -8551,7 +8553,7 @@ Perl_yylex(pTHX)
*/
static int
-S_pending_ident(pTHX)
+S_pending_ident(pTHX_ bool is_sig)
{
PADOFFSET tmp = 0;
const char pit = (char)pl_yylval.ival;
@@ -8568,7 +8570,7 @@ S_pending_ident(pTHX)
if it's a legal name, the OP is a PADANY.
*/
- if (PL_in_my) {
+ if (is_sig || PL_in_my) {
if (PL_in_my == KEY_our) { /* "our" is merely analogous to "my" */
if (has_colon)
yyerror_pv(Perl_form(aTHX_ "No package name allowed for "
@@ -8577,6 +8579,7 @@ S_pending_ident(pTHX)
tmp = allocmy(PL_tokenbuf, tokenbuf_len, UTF ? SVf_UTF8 : 0);
}
else {
+ OP *o;
if (has_colon) {
/* "my" variable %s can't be in a package */
/* PL_no_myglob is constant */
@@ -8589,9 +8592,26 @@ S_pending_ident(pTHX)
GCC_DIAG_RESTORE;
}
- pl_yylval.opval = newOP(OP_PADANY, 0);
- pl_yylval.opval->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
+ if (is_sig) {
+ /* A signature 'padop' needs in addition, an op_first to
+ * point to a child sigdefelem, and an extra field to hold
+ * the signature index. We can achieve both by using an
+ * UNOP_AUX and (ab)using the op_aux field to hold the
+ * index. If we ever need more fields, use a real malloced
+ * aux strut instead.
+ */
+ o = newUNOP_AUX(OP_ARGELEM, 0, NULL,
+ INT2PTR(UNOP_AUX_item *,
+ (UV)(PL_parser->sig_elems)));
+ o->op_private |= ( PL_tokenbuf[0] == '$' ? OPpARGELEM_SV
+ : PL_tokenbuf[0] == '@' ? OPpARGELEM_AV
+ : OPpARGELEM_HV);
+ }
+ else
+ o = newOP(OP_PADANY, 0);
+ o->op_targ = allocmy(PL_tokenbuf, tokenbuf_len,
UTF ? SVf_UTF8 : 0);
+ pl_yylval.opval = o;
return PRIVATEREF;
}
}
View Lorry Controller Status