summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorRick Delaney <rick@consumercontact.com>2008-01-06 09:14:39 -0500
committerNicholas Clark <nick@ccl4.org>2008-01-29 18:29:08 +0000
commit8f72649d0143d6763aa40011ed827fbf31f8af5e (patch)
tree53f17aaf180bc303a4711fa967194dd9175a6642 /op.c
parent99664c53420406fc575370bc5ef714cb27a54b74 (diff)
downloadperl-8f72649d0143d6763aa40011ed827fbf31f8af5e.tar.gz
Integrate:
[ 32891] Subject: [PATCH] Big slowdown in 5.10 @_ parameter passing Message-ID: <20080106191439.GF13935@bort.ca> p4raw-link: @32891 on //depot/perl: fafafbaf705adfdf05ff97b6ab5149ba4ee3c039 p4raw-id: //depot/maint-5.10/perl@33110 p4raw-integrated: from //depot/perl@32891 'merge in' op.c (@32888..)
Diffstat (limited to 'op.c')
-rw-r--r--op.c110
1 files changed, 61 insertions, 49 deletions
diff --git a/op.c b/op.c
index e68b86fbf7..1280b7d2a8 100644
--- a/op.c
+++ b/op.c
@@ -3977,6 +3977,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
static const char no_list_state[] = "Initialization of state variables"
" in list context currently forbidden";
OP *curop;
+ bool maybe_common_vars = TRUE;
PL_modcount = 0;
/* Grandfathering $[ assignment here. Bletch.*/
@@ -3994,6 +3995,65 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
o = newBINOP(OP_AASSIGN, flags, list(force_list(right)), curop);
o->op_private = (U8)(0 | (flags >> 8));
+ if ((left->op_type == OP_LIST
+ || (left->op_type == OP_NULL && left->op_targ == OP_LIST)))
+ {
+ OP* lop = ((LISTOP*)left)->op_first;
+ maybe_common_vars = FALSE;
+ while (lop) {
+ if (lop->op_type == OP_PADSV ||
+ lop->op_type == OP_PADAV ||
+ lop->op_type == OP_PADHV ||
+ lop->op_type == OP_PADANY) {
+ if (!(lop->op_private & OPpLVAL_INTRO))
+ maybe_common_vars = TRUE;
+
+ if (lop->op_private & OPpPAD_STATE) {
+ if (left->op_private & OPpLVAL_INTRO) {
+ /* Each variable in state($a, $b, $c) = ... */
+ }
+ else {
+ /* Each state variable in
+ (state $a, my $b, our $c, $d, undef) = ... */
+ }
+ yyerror(no_list_state);
+ } else {
+ /* Each my variable in
+ (state $a, my $b, our $c, $d, undef) = ... */
+ }
+ } else if (lop->op_type == OP_UNDEF ||
+ lop->op_type == OP_PUSHMARK) {
+ /* undef may be interesting in
+ (state $a, undef, state $c) */
+ } else {
+ /* Other ops in the list. */
+ maybe_common_vars = TRUE;
+ }
+ lop = lop->op_sibling;
+ }
+ }
+ else if ((left->op_private & OPpLVAL_INTRO)
+ && ( left->op_type == OP_PADSV
+ || left->op_type == OP_PADAV
+ || left->op_type == OP_PADHV
+ || left->op_type == OP_PADANY))
+ {
+ maybe_common_vars = FALSE;
+ if (left->op_private & OPpPAD_STATE) {
+ /* All single variable list context state assignments, hence
+ state ($a) = ...
+ (state $a) = ...
+ state @a = ...
+ state (@a) = ...
+ (state @a) = ...
+ state %a = ...
+ state (%a) = ...
+ (state %a) = ...
+ */
+ yyerror(no_list_state);
+ }
+ }
+
/* PL_generation sorcery:
* an assignment like ($a,$b) = ($c,$d) is easier than
* ($a,$b) = ($c,$a), since there is no need for temporary vars.
@@ -4008,7 +4068,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
* to store these values, evil chicanery is done with SvUVX().
*/
- {
+ if (maybe_common_vars) {
OP *lastop = o;
PL_generation++;
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -4069,54 +4129,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
o->op_private |= OPpASSIGN_COMMON;
}
- if ((left->op_type == OP_LIST
- || (left->op_type == OP_NULL && left->op_targ == OP_LIST))) {
- OP* lop = ((LISTOP*)left)->op_first;
- while (lop) {
- if (lop->op_type == OP_PADSV ||
- lop->op_type == OP_PADAV ||
- lop->op_type == OP_PADHV ||
- lop->op_type == OP_PADANY) {
- if (lop->op_private & OPpPAD_STATE) {
- if (left->op_private & OPpLVAL_INTRO) {
- /* Each variable in state($a, $b, $c) = ... */
- }
- else {
- /* Each state variable in
- (state $a, my $b, our $c, $d, undef) = ... */
- }
- yyerror(no_list_state);
- } else {
- /* Each my variable in
- (state $a, my $b, our $c, $d, undef) = ... */
- }
- } else {
- /* Other ops in the list. undef may be interesting in
- (state $a, undef, state $c) */
- }
- lop = lop->op_sibling;
- }
- }
- else if (((left->op_private & (OPpLVAL_INTRO | OPpPAD_STATE))
- == (OPpLVAL_INTRO | OPpPAD_STATE))
- && ( left->op_type == OP_PADSV
- || left->op_type == OP_PADAV
- || left->op_type == OP_PADHV
- || left->op_type == OP_PADANY))
- {
- /* All single variable list context state assignments, hence
- state ($a) = ...
- (state $a) = ...
- state @a = ...
- state (@a) = ...
- (state @a) = ...
- state %a = ...
- state (%a) = ...
- (state %a) = ...
- */
- yyerror(no_list_state);
- }
-
if (right && right->op_type == OP_SPLIT && !PL_madskills) {
OP* tmpop = ((LISTOP*)right)->op_first;
if (tmpop && (tmpop->op_type == OP_PUSHRE)) {