summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--op.c70
-rw-r--r--op.h45
-rw-r--r--opcode.h638
-rwxr-xr-xopcode.pl196
-rw-r--r--pp.h17
-rw-r--r--pp.sym1
-rw-r--r--pp_proto.h1
7 files changed, 545 insertions, 423 deletions
diff --git a/op.c b/op.c
index 091a768dcd..44700dd3e5 100644
--- a/op.c
+++ b/op.c
@@ -805,6 +805,10 @@ Perl_scalar(pTHX_ OP *o)
|| o->op_type == OP_RETURN)
return o;
+ if ((o->op_private & OPpTARGET_MY)
+ && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ return scalar(o); /* As if inside SASSIGN */
+
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
switch (o->op_type) {
@@ -884,6 +888,10 @@ Perl_scalarvoid(pTHX_ OP *o)
|| o->op_type == OP_RETURN)
return o;
+ if ((o->op_private & OPpTARGET_MY)
+ && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ return scalar(o); /* As if inside SASSIGN */
+
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
switch (o->op_type) {
@@ -1083,6 +1091,10 @@ Perl_list(pTHX_ OP *o)
|| o->op_type == OP_RETURN)
return o;
+ if ((o->op_private & OPpTARGET_MY)
+ && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ return o; /* As if inside SASSIGN */
+
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
switch (o->op_type) {
@@ -1190,6 +1202,10 @@ Perl_mod(pTHX_ OP *o, I32 type)
if (!o || PL_error_count)
return o;
+ if ((o->op_private & OPpTARGET_MY)
+ && (PL_opargs[o->op_type] & OA_TARGLEX)) /* OPp share the meaning */
+ return o;
+
switch (o->op_type) {
case OP_UNDEF:
PL_modcount++;
@@ -1830,7 +1846,7 @@ Perl_fold_constants(pTHX_ register OP *o)
if (PL_opargs[type] & OA_RETSCALAR)
scalar(o);
- if (PL_opargs[type] & OA_TARGET)
+ if (PL_opargs[type] & OA_TARGET && !o->op_targ)
o->op_targ = pad_alloc(type, SVs_PADTMP);
/* integerize op, unless it happens to be C<-foo>.
@@ -2191,7 +2207,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
}
binop = (BINOP*)CHECKOP(type, binop);
- if (binop->op_next)
+ if (binop->op_next || binop->op_type != type)
return (OP*)binop;
binop->op_last = binop->op_first->op_sibling;
@@ -5084,6 +5100,38 @@ Perl_ck_fun_locale(pTHX_ OP *o)
}
OP *
+Perl_ck_sassign(pTHX_ OP *o)
+{
+ OP *kid = cLISTOPo->op_first;
+ /* has a disposable target? */
+ if ((PL_opargs[kid->op_type] & OA_TARGLEX)
+ && !(kid->op_flags & OPf_STACKED))
+ {
+ OP *kkid = kid->op_sibling;
+
+ /* Can just relocate the target. */
+ if (kkid && kkid->op_type == OP_PADSV) {
+ /* Concat has problems if target is equal to right arg. */
+ if (kid->op_type == OP_CONCAT
+ && kLISTOP->op_first->op_sibling->op_type == OP_PADSV
+ && kLISTOP->op_first->op_sibling->op_targ == kkid->op_targ)
+ {
+ return o;
+ }
+ kid->op_targ = kkid->op_targ;
+ /* Now we do not need PADSV and SASSIGN. */
+ kid->op_sibling = o->op_sibling; /* NULL */
+ cLISTOPo->op_first = NULL;
+ op_free(o);
+ op_free(kkid);
+ kid->op_private |= OPpTARGET_MY; /* Used for context settings */
+ return kid;
+ }
+ }
+ return o;
+}
+
+OP *
Perl_ck_scmp(pTHX_ OP *o)
{
o->op_private = 0;
@@ -5592,8 +5640,24 @@ Perl_peep(pTHX_ register OP *o)
case OP_LC:
case OP_LCFIRST:
case OP_QUOTEMETA:
- if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
+ if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
+ if (o->op_next->op_private & OPpTARGET_MY) {
+ if ((o->op_type == OP_CONST) /* no target */
+ || (o->op_flags & OPf_STACKED) /* chained concats */
+ || (o->op_type == OP_CONCAT
+ /* Concat has problems if target is equal to right arg. */
+ && (((LISTOP*)o)->op_first->op_sibling->op_type
+ == OP_PADSV)
+ && (((LISTOP*)o)->op_first->op_sibling->op_targ
+ == o->op_next->op_targ))) {
+ goto ignore_optimization;
+ } else {
+ o->op_targ = o->op_next->op_targ;
+ }
+ }
null(o->op_next);
+ }
+ ignore_optimization:
o->op_seq = PL_op_seqmax++;
break;
case OP_STUB:
diff --git a/op.h b/op.h
index a13df7752e..8c6f336ca2 100644
--- a/op.h
+++ b/op.h
@@ -131,6 +131,10 @@ typedef U32 PADOFFSET;
#define OPpLVAL_DEFER 16 /* Defer creation of array/hash elem */
/* for OP_RV2?V, lower bits carry hints */
+/* Private for OPs with TARGLEX */
+ /* (lower bits may carry MAXARG) */
+#define OPpTARGET_MY 16 /* Target is PADMY. */
+
/* Private for OP_CONST */
#define OPpCONST_STRICT 8 /* bearword subject to strict 'subs' */
#define OPpCONST_ENTERED 16 /* Has been entered as symbol. */
@@ -302,27 +306,30 @@ struct loop {
#define OA_OTHERINT 32
#define OA_DANGEROUS 64
#define OA_DEFGV 128
+#define OA_TARGLEX 256
/* The next 4 bits encode op class information */
-#define OA_CLASS_MASK (15 << 8)
-
-#define OA_BASEOP (0 << 8)
-#define OA_UNOP (1 << 8)
-#define OA_BINOP (2 << 8)
-#define OA_LOGOP (3 << 8)
-#define OA_CONDOP (4 << 8)
-#define OA_LISTOP (5 << 8)
-#define OA_PMOP (6 << 8)
-#define OA_SVOP (7 << 8)
-#define OA_GVOP (8 << 8)
-#define OA_PVOP_OR_SVOP (9 << 8)
-#define OA_LOOP (10 << 8)
-#define OA_COP (11 << 8)
-#define OA_BASEOP_OR_UNOP (12 << 8)
-#define OA_FILESTATOP (13 << 8)
-#define OA_LOOPEXOP (14 << 8)
-
-#define OASHIFT 12
+#define OCSHIFT 9
+
+#define OA_CLASS_MASK (15 << OCSHIFT)
+
+#define OA_BASEOP (0 << OCSHIFT)
+#define OA_UNOP (1 << OCSHIFT)
+#define OA_BINOP (2 << OCSHIFT)
+#define OA_LOGOP (3 << OCSHIFT)
+#define OA_CONDOP (4 << OCSHIFT)
+#define OA_LISTOP (5 << OCSHIFT)
+#define OA_PMOP (6 << OCSHIFT)
+#define OA_SVOP (7 << OCSHIFT)
+#define OA_GVOP (8 << OCSHIFT)
+#define OA_PVOP_OR_SVOP (9 << OCSHIFT)
+#define OA_LOOP (10 << OCSHIFT)
+#define OA_COP (11 << OCSHIFT)
+#define OA_BASEOP_OR_UNOP (12 << OCSHIFT)
+#define OA_FILESTATOP (13 << OCSHIFT)
+#define OA_LOOPEXOP (14 << OCSHIFT)
+
+#define OASHIFT 13
/* Remaining nybbles of PL_opargs */
#define OA_SCALAR 1
diff --git a/opcode.h b/opcode.h
index fc09bd335d..80506b3e33 100644
--- a/opcode.h
+++ b/opcode.h
@@ -1470,7 +1470,7 @@ EXT OP * (CPERLscope(*PL_check)[]) (pTHX_ OP *op) = {
Perl_ck_null, /* subst */
Perl_ck_null, /* substcont */
Perl_ck_null, /* trans */
- Perl_ck_null, /* sassign */
+ Perl_ck_sassign,/* sassign */
Perl_ck_null, /* aassign */
Perl_ck_spair, /* chop */
Perl_ck_null, /* schop */
@@ -1791,351 +1791,351 @@ EXT U32 PL_opargs[];
EXT U32 PL_opargs[] = {
0x00000000, /* null */
0x00000000, /* stub */
- 0x00001c04, /* scalar */
+ 0x00003804, /* scalar */
0x00000004, /* pushmark */
0x00000014, /* wantarray */
- 0x00000704, /* const */
- 0x00000844, /* gvsv */
- 0x00000844, /* gv */
- 0x00011240, /* gelem */
+ 0x00000e04, /* const */
+ 0x00001044, /* gvsv */
+ 0x00001044, /* gv */
+ 0x00022440, /* gelem */
0x00000044, /* padsv */
0x00000040, /* padav */
0x00000040, /* padhv */
0x00000040, /* padany */
- 0x00000640, /* pushre */
- 0x00000144, /* rv2gv */
- 0x00000144, /* rv2sv */
- 0x00000114, /* av2arylen */
- 0x00000140, /* rv2cv */
- 0x00000700, /* anoncode */
- 0x00001c04, /* prototype */
- 0x00002101, /* refgen */
- 0x00001106, /* srefgen */
- 0x00009c8c, /* ref */
- 0x00091504, /* bless */
- 0x00000c08, /* backtick */
- 0x00099508, /* glob */
- 0x00000c08, /* readline */
- 0x00000c08, /* rcatline */
- 0x00001104, /* regcmaybe */
- 0x00001104, /* regcreset */
- 0x00001304, /* regcomp */
- 0x00000640, /* match */
- 0x00000604, /* qr */
- 0x00001654, /* subst */
- 0x00000354, /* substcont */
- 0x00001914, /* trans */
+ 0x00000c40, /* pushre */
+ 0x00000244, /* rv2gv */
+ 0x00000244, /* rv2sv */
+ 0x00000214, /* av2arylen */
+ 0x00000240, /* rv2cv */
+ 0x00000e00, /* anoncode */
+ 0x00003804, /* prototype */
+ 0x00004201, /* refgen */
+ 0x00002206, /* srefgen */
+ 0x0001388c, /* ref */
+ 0x00122a04, /* bless */
+ 0x00001808, /* backtick */
+ 0x00132a08, /* glob */
+ 0x00001808, /* readline */
+ 0x00001808, /* rcatline */
+ 0x00002204, /* regcmaybe */
+ 0x00002204, /* regcreset */
+ 0x00002604, /* regcomp */
+ 0x00000c40, /* match */
+ 0x00000c04, /* qr */
+ 0x00002c54, /* subst */
+ 0x00000654, /* substcont */
+ 0x00003214, /* trans */
0x00000004, /* sassign */
- 0x00022208, /* aassign */
- 0x00002c0d, /* chop */
- 0x00009c8c, /* schop */
- 0x00002c0d, /* chomp */
- 0x00009c8c, /* schomp */
- 0x00009c94, /* defined */
- 0x00009c04, /* undef */
- 0x00009c84, /* study */
- 0x00009c8c, /* pos */
- 0x00001164, /* preinc */
- 0x00001154, /* i_preinc */
- 0x00001164, /* predec */
- 0x00001154, /* i_predec */
- 0x0000116c, /* postinc */
- 0x0000115c, /* i_postinc */
- 0x0000116c, /* postdec */
- 0x0000115c, /* i_postdec */
- 0x0001120e, /* pow */
- 0x0001122e, /* multiply */
- 0x0001121e, /* i_multiply */
- 0x0001122e, /* divide */
- 0x0001121e, /* i_divide */
- 0x0001123e, /* modulo */
- 0x0001121e, /* i_modulo */
- 0x00012209, /* repeat */
- 0x0001122e, /* add */
- 0x0001121e, /* i_add */
- 0x0001122e, /* subtract */
- 0x0001121e, /* i_subtract */
- 0x0001120e, /* concat */
- 0x0000150e, /* stringify */
- 0x0001120e, /* left_shift */
- 0x0001120e, /* right_shift */
- 0x00011236, /* lt */
- 0x00011216, /* i_lt */
- 0x00011236, /* gt */
- 0x00011216, /* i_gt */
- 0x00011236, /* le */
- 0x00011216, /* i_le */
- 0x00011236, /* ge */
- 0x00011216, /* i_ge */
- 0x00011236, /* eq */
- 0x00011216, /* i_eq */
- 0x00011236, /* ne */
- 0x00011216, /* i_ne */
- 0x0001123e, /* ncmp */
- 0x0001121e, /* i_ncmp */
- 0x00011216, /* slt */
- 0x00011216, /* sgt */
- 0x00011216, /* sle */
- 0x00011216, /* sge */
- 0x00011216, /* seq */
- 0x00011216, /* sne */
- 0x0001121e, /* scmp */
- 0x0001120e, /* bit_and */
- 0x0001120e, /* bit_xor */
- 0x0001120e, /* bit_or */
- 0x0000112e, /* negate */
- 0x0000111e, /* i_negate */
- 0x00001116, /* not */
- 0x0000110e, /* complement */
- 0x0001150e, /* atan2 */
- 0x00009c8e, /* sin */
- 0x00009c8e, /* cos */
- 0x00009c0c, /* rand */
- 0x00009c04, /* srand */
- 0x00009c8e, /* exp */
- 0x00009c8e, /* log */
- 0x00009c8e, /* sqrt */
- 0x00009c8e, /* int */
- 0x00009c8e, /* hex */
- 0x00009c8e, /* oct */
- 0x00009c8e, /* abs */
- 0x00009c9c, /* length */
- 0x0991150c, /* substr */
- 0x0011151c, /* vec */
- 0x0091151c, /* index */
- 0x0091151c, /* rindex */
- 0x0002150f, /* sprintf */
- 0x00021505, /* formline */
- 0x00009c9e, /* ord */
- 0x00009c8e, /* chr */
- 0x0001150e, /* crypt */
- 0x00009c8e, /* ucfirst */
- 0x00009c8e, /* lcfirst */
- 0x00009c8e, /* uc */
- 0x00009c8e, /* lc */
- 0x00009c8e, /* quotemeta */
- 0x00000148, /* rv2av */
- 0x00013804, /* aelemfast */
- 0x00013204, /* aelem */
- 0x00023501, /* aslice */
- 0x00004c08, /* each */
- 0x00004c08, /* values */
- 0x00004c08, /* keys */
- 0x00001c00, /* delete */
- 0x00001c14, /* exists */
- 0x00000148, /* rv2hv */
- 0x00014204, /* helem */
- 0x00024501, /* hslice */
- 0x00011500, /* unpack */
- 0x0002150d, /* pack */
- 0x00111508, /* split */
- 0x0002150d, /* join */
- 0x00002501, /* list */
- 0x00224200, /* lslice */
- 0x00002505, /* anonlist */
- 0x00002505, /* anonhash */
- 0x02993501, /* splice */
- 0x0002351d, /* push */
- 0x00003c04, /* pop */
- 0x00003c04, /* shift */
- 0x0002351d, /* unshift */
- 0x0002d501, /* sort */
- 0x00002509, /* reverse */
- 0x00025541, /* grepstart */
- 0x00000348, /* grepwhile */
- 0x00025541, /* mapstart */
- 0x00000348, /* mapwhile */
- 0x00011400, /* range */
- 0x00011100, /* flip */
- 0x00000100, /* flop */
- 0x00000300, /* and */
- 0x00000300, /* or */
- 0x00011306, /* xor */
- 0x00000440, /* cond_expr */
- 0x00000304, /* andassign */
- 0x00000304, /* orassign */
- 0x00000140, /* method */
- 0x00002149, /* entersub */
- 0x00000100, /* leavesub */
- 0x00009c08, /* caller */
- 0x0000251d, /* warn */
- 0x0000255d, /* die */
- 0x00009c14, /* reset */
- 0x00000500, /* lineseq */
- 0x00000b04, /* nextstate */
- 0x00000b04, /* dbstate */
+ 0x00044408, /* aassign */
+ 0x0000590d, /* chop */
+ 0x0001398c, /* schop */
+ 0x0000590d, /* chomp */
+ 0x0001398c, /* schomp */
+ 0x00013894, /* defined */
+ 0x00013804, /* undef */
+ 0x00013884, /* study */
+ 0x0001388c, /* pos */
+ 0x00002264, /* preinc */
+ 0x00002254, /* i_preinc */
+ 0x00002264, /* predec */
+ 0x00002254, /* i_predec */
+ 0x0000236c, /* postinc */
+ 0x0000235c, /* i_postinc */
+ 0x0000236c, /* postdec */
+ 0x0000235c, /* i_postdec */
+ 0x0002250e, /* pow */
+ 0x0002252e, /* multiply */
+ 0x0002251e, /* i_multiply */
+ 0x0002252e, /* divide */
+ 0x0002251e, /* i_divide */
+ 0x0002253e, /* modulo */
+ 0x0002251e, /* i_modulo */
+ 0x00024409, /* repeat */
+ 0x0002252e, /* add */
+ 0x0002251e, /* i_add */
+ 0x0002252e, /* subtract */
+ 0x0002251e, /* i_subtract */
+ 0x0002250e, /* concat */
+ 0x00002b0e, /* stringify */
+ 0x0002250e, /* left_shift */
+ 0x0002250e, /* right_shift */
+ 0x00022436, /* lt */
+ 0x00022416, /* i_lt */
+ 0x00022436, /* gt */
+ 0x00022416, /* i_gt */
+ 0x00022436, /* le */
+ 0x00022416, /* i_le */
+ 0x00022436, /* ge */
+ 0x00022416, /* i_ge */
+ 0x00022436, /* eq */
+ 0x00022416, /* i_eq */
+ 0x00022436, /* ne */
+ 0x00022416, /* i_ne */
+ 0x0002243e, /* ncmp */
+ 0x0002241e, /* i_ncmp */
+ 0x00022416, /* slt */
+ 0x00022416, /* sgt */
+ 0x00022416, /* sle */
+ 0x00022416, /* sge */
+ 0x00022416, /* seq */
+ 0x00022416, /* sne */
+ 0x0002241e, /* scmp */
+ 0x0002250e, /* bit_and */
+ 0x0002250e, /* bit_xor */
+ 0x0002250e, /* bit_or */
+ 0x0000232e, /* negate */
+ 0x0000231e, /* i_negate */
+ 0x00002216, /* not */
+ 0x0000230e, /* complement */
+ 0x00022b0e, /* atan2 */
+ 0x0001398e, /* sin */
+ 0x0001398e, /* cos */
+ 0x0001390c, /* rand */
+ 0x00013804, /* srand */
+ 0x0001398e, /* exp */
+ 0x0001398e, /* log */
+ 0x0001398e, /* sqrt */
+ 0x0001398e, /* int */
+ 0x0001398e, /* hex */
+ 0x0001398e, /* oct */
+ 0x0001398e, /* abs */
+ 0x0001399c, /* length */
+ 0x13222a0c, /* substr */
+ 0x00222a1c, /* vec */
+ 0x01222b1c, /* index */
+ 0x01222b1c, /* rindex */
+ 0x00042b0f, /* sprintf */
+ 0x00042a05, /* formline */
+ 0x0001399e, /* ord */
+ 0x0001398e, /* chr */
+ 0x00022b0e, /* crypt */
+ 0x0001388e, /* ucfirst */
+ 0x0001388e, /* lcfirst */
+ 0x0001388e, /* uc */
+ 0x0001388e, /* lc */
+ 0x0001398e, /* quotemeta */
+ 0x00000248, /* rv2av */
+ 0x00027004, /* aelemfast */
+ 0x00026404, /* aelem */
+ 0x00046a01, /* aslice */
+ 0x00009808, /* each */
+ 0x00009808, /* values */
+ 0x00009808, /* keys */
+ 0x00003800, /* delete */
+ 0x00003814, /* exists */
+ 0x00000248, /* rv2hv */
+ 0x00028404, /* helem */
+ 0x00048a01, /* hslice */
+ 0x00022a00, /* unpack */
+ 0x00042a0d, /* pack */
+ 0x00222a08, /* split */
+ 0x00042b0d, /* join */
+ 0x00004a01, /* list */
+ 0x00448400, /* lslice */
+ 0x00004a05, /* anonlist */
+ 0x00004a05, /* anonhash */
+ 0x05326a01, /* splice */
+ 0x00046b1d, /* push */
+ 0x00007804, /* pop */
+ 0x00007804, /* shift */
+ 0x00046b1d, /* unshift */
+ 0x0005aa01, /* sort */
+ 0x00004a09, /* reverse */
+ 0x0004aa41, /* grepstart */
+ 0x00000648, /* grepwhile */
+ 0x0004aa41, /* mapstart */
+ 0x00000648, /* mapwhile */
+ 0x00022800, /* range */
+ 0x00022200, /* flip */
+ 0x00000200, /* flop */
+ 0x00000600, /* and */
+ 0x00000600, /* or */
+ 0x00022606, /* xor */
+ 0x00000840, /* cond_expr */
+ 0x00000604, /* andassign */
+ 0x00000604, /* orassign */
+ 0x00000240, /* method */
+ 0x00004249, /* entersub */
+ 0x00000200, /* leavesub */
+ 0x00013808, /* caller */
+ 0x00004a1d, /* warn */
+ 0x00004a5d, /* die */
+ 0x00013814, /* reset */
+ 0x00000a00, /* lineseq */
+ 0x00001604, /* nextstate */
+ 0x00001604, /* dbstate */
0x00000004, /* unstack */
0x00000000, /* enter */
- 0x00000500, /* leave */
- 0x00000500, /* scope */
- 0x00000a40, /* enteriter */
+ 0x00000a00, /* leave */
+ 0x00000a00, /* scope */
+ 0x00001440, /* enteriter */
0x00000000, /* iter */
- 0x00000a40, /* enterloop */
- 0x00000200, /* leaveloop */
- 0x00002541, /* return */
- 0x00000e44, /* last */
- 0x00000e44, /* next */
- 0x00000e44, /* redo */
- 0x00000e44, /* dump */
- 0x00000e44, /* goto */
- 0x00009c44, /* exit */
- 0x0009651c, /* open */
- 0x0000ec14, /* close */
- 0x00066514, /* pipe_op */
- 0x00006c1c, /* fileno */
- 0x00009c1c, /* umask */
- 0x00006c04, /* binmode */
- 0x00217555, /* tie */
- 0x00007c14, /* untie */
- 0x00007c04, /* tied */
- 0x00114514, /* dbmopen */
- 0x00004c14, /* dbmclose */
- 0x01111508, /* sselect */
- 0x0000e50c, /* select */
- 0x0000ec0c, /* getc */
- 0x0917651d, /* read */
- 0x0000ec54, /* enterwrite */
- 0x00000100, /* leavewrite */
- 0x0002e515, /* prtf */
- 0x0002e515, /* print */
- 0x09116504, /* sysopen */
- 0x00116504, /* sysseek */
- 0x0917651d, /* sysread */
- 0x0991651d, /* syswrite */
- 0x0911651d, /* send */
- 0x0117651d, /* recv */
- 0x0000ec14, /* eof */
- 0x0000ec0c, /* tell */
- 0x00116504, /* seek */
- 0x00011514, /* truncate */
- 0x0011650c, /* fcntl */
- 0x0011650c, /* ioctl */
- 0x0001651c, /* flock */
- 0x01116514, /* socket */
- 0x11166514, /* sockpair */
- 0x00016514, /* bind */
- 0x00016514, /* connect */
- 0x00016514, /* listen */
- 0x0006651c, /* accept */
- 0x0001651c, /* shutdown */
- 0x00116514, /* gsockopt */
- 0x01116514, /* ssockopt */
- 0x00006c14, /* getsockname */
- 0x00006c14, /* getpeername */
- 0x00006d80, /* lstat */
- 0x00006d80, /* stat */
- 0x00006d94, /* ftrread */
- 0x00006d94, /* ftrwrite */
- 0x00006d94, /* ftrexec */
- 0x00006d94, /* fteread */
- 0x00006d94, /* ftewrite */
- 0x00006d94, /* fteexec */
- 0x00006d94, /* ftis */
- 0x00006d94, /* fteowned */
- 0x00006d94, /* ftrowned */
- 0x00006d94, /* ftzero */
- 0x00006d9c, /* ftsize */
- 0x00006d8c, /* ftmtime */
- 0x00006d8c, /* ftatime */
- 0x00006d8c, /* ftctime */
- 0x00006d94, /* ftsock */
- 0x00006d94, /* ftchr */
- 0x00006d94, /* ftblk */
- 0x00006d94, /* ftfile */
- 0x00006d94, /* ftdir */
- 0x00006d94, /* ftpipe */
- 0x00006d94, /* ftlink */
- 0x00006d94, /* ftsuid */
- 0x00006d94, /* ftsgid */
- 0x00006d94, /* ftsvtx */
- 0x00006d14, /* fttty */
- 0x00006d94, /* fttext */
- 0x00006d94, /* ftbinary */
- 0x00009c1c, /* chdir */
- 0x0000251d, /* chown */
- 0x00009c9c, /* chroot */
- 0x0000259d, /* unlink */
- 0x0000251d, /* chmod */
- 0x0000251d, /* utime */
- 0x0001151c, /* rename */
- 0x0001151c, /* link */
- 0x0001151c, /* symlink */
- 0x00009c8c, /* readlink */
- 0x0001151c, /* mkdir */
- 0x00009c9c, /* rmdir */
- 0x00016514, /* open_dir */
- 0x00006c00, /* readdir */
- 0x00006c0c, /* telldir */
- 0x00016504, /* seekdir */
- 0x00006c04, /* rewinddir */
- 0x00006c14, /* closedir */
+ 0x00001440, /* enterloop */
+ 0x00000400, /* leaveloop */
+ 0x00004a41, /* return */
+ 0x00001c44, /* last */
+ 0x00001c44, /* next */
+ 0x00001c44, /* redo */
+ 0x00001c44, /* dump */
+ 0x00001c44, /* goto */
+ 0x00013844, /* exit */
+ 0x0012ca1c, /* open */
+ 0x0001d814, /* close */
+ 0x000cca14, /* pipe_op */
+ 0x0000d81c, /* fileno */
+ 0x0001381c, /* umask */
+ 0x0000d804, /* binmode */
+ 0x0042ea55, /* tie */
+ 0x0000f814, /* untie */
+ 0x0000f804, /* tied */
+ 0x00228a14, /* dbmopen */
+ 0x00009814, /* dbmclose */
+ 0x02222a08, /* sselect */
+ 0x0001ca0c, /* select */
+ 0x0001d80c, /* getc */
+ 0x122eca1d, /* read */
+ 0x0001d854, /* enterwrite */
+ 0x00000200, /* leavewrite */
+ 0x0005ca15, /* prtf */
+ 0x0005ca15, /* print */
+ 0x1222ca04, /* sysopen */
+ 0x0022ca04, /* sysseek */
+ 0x122eca1d, /* sysread */
+ 0x1322ca1d, /* syswrite */
+ 0x1222ca1d, /* send */
+ 0x022eca1d, /* recv */
+ 0x0001d814, /* eof */
+ 0x0001d80c, /* tell */
+ 0x0022ca04, /* seek */
+ 0x00022a14, /* truncate */
+ 0x0022ca0c, /* fcntl */
+ 0x0022ca0c, /* ioctl */
+ 0x0002cb1c, /* flock */
+ 0x0222ca14, /* socket */
+ 0x222cca14, /* sockpair */
+ 0x0002ca14, /* bind */
+ 0x0002ca14, /* connect */
+ 0x0002ca14, /* listen */
+ 0x000cca1c, /* accept */
+ 0x0002ca1c, /* shutdown */
+ 0x0022ca14, /* gsockopt */
+ 0x0222ca14, /* ssockopt */
+ 0x0000d814, /* getsockname */
+ 0x0000d814, /* getpeername */
+ 0x0000da80, /* lstat */
+ 0x0000da80, /* stat */
+ 0x0000da94, /* ftrread */
+ 0x0000da94, /* ftrwrite */
+ 0x0000da94, /* ftrexec */
+ 0x0000da94, /* fteread */
+ 0x0000da94, /* ftewrite */
+ 0x0000da94, /* fteexec */
+ 0x0000da94, /* ftis */
+ 0x0000da94, /* fteowned */
+ 0x0000da94, /* ftrowned */
+ 0x0000da94, /* ftzero */
+ 0x0000da9c, /* ftsize */
+ 0x0000da8c, /* ftmtime */
+ 0x0000da8c, /* ftatime */
+ 0x0000da8c, /* ftctime */
+ 0x0000da94, /* ftsock */
+ 0x0000da94, /* ftchr */
+ 0x0000da94, /* ftblk */
+ 0x0000da94, /* ftfile */
+ 0x0000da94, /* ftdir */
+ 0x0000da94, /* ftpipe */
+ 0x0000da94, /* ftlink */
+ 0x0000da94, /* ftsuid */
+ 0x0000da94, /* ftsgid */
+ 0x0000da94, /* ftsvtx */
+ 0x0000da14, /* fttty */
+ 0x0000da94, /* fttext */
+ 0x0000da94, /* ftbinary */
+ 0x0001391c, /* chdir */
+ 0x00004b1d, /* chown */
+ 0x0001399c, /* chroot */
+ 0x00004b9d, /* unlink */
+ 0x00004b1d, /* chmod */
+ 0x00004b1d, /* utime */
+ 0x00022b1c, /* rename */
+ 0x00022b1c, /* link */
+ 0x00022b1c, /* symlink */
+ 0x0001388c, /* readlink */
+ 0x00022b1c, /* mkdir */
+ 0x0001399c, /* rmdir */
+ 0x0002ca14, /* open_dir */
+ 0x0000d800, /* readdir */
+ 0x0000d80c, /* telldir */
+ 0x0002ca04, /* seekdir */
+ 0x0000d804, /* rewinddir */
+ 0x0000d814, /* closedir */
0x0000001c, /* fork */
- 0x0000001c, /* wait */
- 0x0001151c, /* waitpid */
- 0x0002951d, /* system */
- 0x0002955d, /* exec */
- 0x0000255d, /* kill */
- 0x0000001c, /* getppid */
- 0x00009c1c, /* getpgrp */
- 0x0009951c, /* setpgrp */
- 0x0001151c, /* getpriority */
- 0x0011151c, /* setpriority */
- 0x0000001c, /* time */
+ 0x0000011c, /* wait */
+ 0x00022b1c, /* waitpid */
+ 0x00052b1d, /* system */
+ 0x00052b5d, /* exec */
+ 0x00004b5d, /* kill */
+ 0x0000011c, /* getppid */
+ 0x0001391c, /* getpgrp */
+ 0x00132b1c, /* setpgrp */
+ 0x00022b1c, /* getpriority */
+ 0x00222b1c, /* setpriority */
+ 0x0000011c, /* time */
0x00000000, /* tms */
- 0x00009c08, /* localtime */
- 0x00009c08, /* gmtime */
- 0x00009c9c, /* alarm */
- 0x00009c1c, /* sleep */
- 0x0011151d, /* shmget */
- 0x0011151d, /* shmctl */
- 0x0111151d, /* shmread */
- 0x0111151d, /* shmwrite */
- 0x0001151d, /* msgget */
- 0x0011151d, /* msgctl */
- 0x0011151d, /* msgsnd */
- 0x1111151d, /* msgrcv */
- 0x0011151d, /* semget */
- 0x0111151d, /* semctl */
- 0x0001151d, /* semop */
- 0x00009cc0, /* require */
- 0x00001140, /* dofile */
- 0x00001c40, /* entereval */
- 0x00001100, /* leaveeval */
- 0x00000300, /* entertry */
- 0x00000500, /* leavetry */
- 0x00001c00, /* ghbyname */
- 0x00011500, /* ghbyaddr */
+ 0x00013808, /* localtime */
+ 0x00013808, /* gmtime */
+ 0x0001389c, /* alarm */
+ 0x0001391c, /* sleep */
+ 0x00222a1d, /* shmget */
+ 0x00222a1d, /* shmctl */
+ 0x02222a1d, /* shmread */
+ 0x02222a1d, /* shmwrite */
+ 0x00022a1d, /* msgget */
+ 0x00222a1d, /* msgctl */
+ 0x00222a1d, /* msgsnd */
+ 0x22222a1d, /* msgrcv */
+ 0x00222a1d, /* semget */
+ 0x02222a1d, /* semctl */
+ 0x00022a1d, /* semop */
+ 0x000138c0, /* require */
+ 0x00002240, /* dofile */
+ 0x00003840, /* entereval */
+ 0x00002200, /* leaveeval */
+ 0x00000600, /* entertry */
+ 0x00000a00, /* leavetry */
+ 0x00003800, /* ghbyname */
+ 0x00022a00, /* ghbyaddr */
0x00000000, /* ghostent */
- 0x00001c00, /* gnbyname */
- 0x00011500, /* gnbyaddr */
+ 0x00003800, /* gnbyname */
+ 0x00022a00, /* gnbyaddr */
0x00000000, /* gnetent */
- 0x00001c00, /* gpbyname */
- 0x00001500, /* gpbynumber */
+ 0x00003800, /* gpbyname */
+ 0x00002a00, /* gpbynumber */
0x00000000, /* gprotoent */
- 0x00011500, /* gsbyname */
- 0x00011500, /* gsbyport */
+ 0x00022a00, /* gsbyname */
+ 0x00022a00, /* gsbyport */
0x00000000, /* gservent */
- 0x00001c14, /* shostent */
- 0x00001c14, /* snetent */
- 0x00001c14, /* sprotoent */
- 0x00001c14, /* sservent */
+ 0x00003814, /* shostent */
+ 0x00003814, /* snetent */
+ 0x00003814, /* sprotoent */
+ 0x00003814, /* sservent */
0x00000014, /* ehostent */
0x00000014, /* enetent */
0x00000014, /* eprotoent */
0x00000014, /* eservent */
- 0x00001c00, /* gpwnam */
- 0x00001c00, /* gpwuid */
+ 0x00003800, /* gpwnam */
+ 0x00003800, /* gpwuid */
0x00000000, /* gpwent */
0x00000014, /* spwent */
0x00000014, /* epwent */
- 0x00001c00, /* ggrnam */
- 0x00001c00, /* ggrgid */
+ 0x00003800, /* ggrnam */
+ 0x00003800, /* ggrgid */
0x00000000, /* ggrent */
0x00000014, /* sgrent */
0x00000014, /* egrent */
0x0000000c, /* getlogin */
- 0x0002151d, /* syscall */
- 0x00001c04, /* lock */
+ 0x00042a1d, /* syscall */
+ 0x00003804, /* lock */
0x00000044, /* threadsv */
};
#endif
diff --git a/opcode.pl b/opcode.pl
index 50a767b2fc..3718292315 100755
--- a/opcode.pl
+++ b/opcode.pl
@@ -181,17 +181,20 @@ for (@ops) {
$argsum |= 2 if $flags =~ /f/; # fold constants
$argsum |= 4 if $flags =~ /s/; # always produces scalar
$argsum |= 8 if $flags =~ /t/; # needs target scalar
+ $argsum |= (8|256) if $flags =~ /T/; # ... which may be lexical
$argsum |= 16 if $flags =~ /i/; # always produces integer
$argsum |= 32 if $flags =~ /I/; # has corresponding int op
$argsum |= 64 if $flags =~ /d/; # danger, unknown side effects
$argsum |= 128 if $flags =~ /u/; # defaults to $_
$flags =~ /([\W\d_])/ or die qq[Opcode "$_" has no class indicator];
- $argsum |= $opclass{$1} << 8;
- $mul = 4096; # 2 ^ OASHIFT
+ $argsum |= $opclass{$1} << 9;
+ $mul = 0x2000; # 2 ^ OASHIFT
for $arg (split(' ',$args{$_})) {
$argnum = ($arg =~ s/\?//) ? 8 : 0;
$argnum += $argnum{$arg};
+ warn "# Conflicting bit 32 for '$_'.\n"
+ if $argnum & 8 and $mul == 0x10000000;
$argsum += $argnum * $mul;
$mul <<= 4;
}
@@ -237,6 +240,43 @@ sub tab {
$t;
}
###########################################################################
+
+# Some comments about 'T' opcode classifier:
+
+# Safe to set if the ppcode uses:
+# tryAMAGICbin, tryAMAGICun, SETn, SETi, SETu, PUSHn, PUSHTARG, SETTARG,
+# SETs(TARG), XPUSHn, XPUSHu,
+
+# Unsafe to set if the ppcode uses dTARG or [X]RETPUSH[YES|NO|UNDEF]
+
+# lt and friends do SETs (including ncmp, but not scmp)
+
+# pp.c pos substr each not OK (RETPUSHUNDEF)
+# substr vec also not OK due to LV to target (are they???)
+# ref not OK (RETPUSHNO)
+# trans not OK (dTARG; TARG = sv_newmortal();)
+# ucfirst etc not OK: TMP arg processed inplace
+# each repeat not OK too due to array context
+# pack split - unknown whether they are safe
+
+# pp_hot.c
+# readline - unknown whether it is safe
+# match subst not OK (dTARG)
+# grepwhile not OK (not always setting)
+
+# pp_ctl.c
+# mapwhile flip caller not OK (not always setting)
+
+# pp_sys.c
+# backtick glob warn die not OK (not always setting)
+# warn not OK (RETPUSHYES)
+# open fileno getc sysread syswrite ioctl accept shutdown
+# ftsize(etc) readlink telldir fork alarm getlogin not OK (RETPUSHUNDEF)
+# umask select not OK (XPUSHs(&PL_sv_undef);)
+# fileno getc sysread syswrite tell not OK (meth("FILENO" "GETC"))
+# sselect shm* sem* msg* syscall - unknown whether they are safe
+# gmtime not OK (list context)
+
__END__
# Nothing.
@@ -297,13 +337,13 @@ trans character translation ck_null is" S
# Lvalue operators.
# sassign is special-cased for op class
-sassign scalar assignment ck_null s0
+sassign scalar assignment ck_sassign s0
aassign list assignment ck_null t2 L L
-chop chop ck_spair mts% L
-schop scalar chop ck_null stu% S?
-chomp safe chop ck_spair mts% L
-schomp scalar safe chop ck_null stu% S?
+chop chop ck_spair mTs% L
+schop scalar chop ck_null sTu% S?
+chomp safe chop ck_spair mTs% L
+schomp scalar safe chop ck_null sTu% S?
defined defined operator ck_defined isu% S?
undef undef operator ck_lfun s% S?
study study ck_fun su% S?
@@ -313,32 +353,32 @@ preinc preincrement ck_lfun dIs1 S
i_preinc integer preincrement ck_lfun dis1 S
predec predecrement ck_lfun dIs1 S
i_predec integer predecrement ck_lfun dis1 S
-postinc postincrement ck_lfun dIst1 S
-i_postinc integer postincrement ck_lfun dist1 S
-postdec postdecrement ck_lfun dIst1 S
-i_postdec integer postdecrement ck_lfun dist1 S
+postinc postincrement ck_lfun dIsT1 S
+i_postinc integer postincrement ck_lfun disT1 S
+postdec postdecrement ck_lfun dIsT1 S
+i_postdec integer postdecrement ck_lfun disT1 S
# Ordinary operators.
-pow exponentiation ck_null fst2 S S
+pow exponentiation ck_null fsT2 S S
-multiply multiplication ck_null Ifst2 S S
-i_multiply integer multiplication ck_null ifst2 S S
-divide division ck_null Ifst2 S S
-i_divide integer division ck_null ifst2 S S
-modulo modulus ck_null Iifst2 S S
-i_modulo integer modulus ck_null ifst2 S S
+multiply multiplication ck_null IfsT2 S S
+i_multiply integer multiplication ck_null ifsT2 S S
+divide division ck_null IfsT2 S S
+i_divide integer division ck_null ifsT2 S S
+modulo modulus ck_null IifsT2 S S
+i_modulo integer modulus ck_null ifsT2 S S
repeat repeat ck_repeat mt2 L S
-add addition ck_null Ifst2 S S
-i_add integer addition ck_null ifst2 S S
-subtract subtraction ck_null Ifst2 S S
-i_subtract integer subtraction ck_null ifst2 S S
-concat concatenation ck_concat fst2 S S
-stringify string ck_fun fst@ S
+add addition ck_null IfsT2 S S
+i_add integer addition ck_null ifsT2 S S
+subtract subtraction ck_null IfsT2 S S
+i_subtract integer subtraction ck_null ifsT2 S S
+concat concatenation ck_concat fsT2 S S
+stringify string ck_fun fsT@ S
-left_shift left bitshift ck_bitop fst2 S S
-right_shift right bitshift ck_bitop fst2 S S
+left_shift left bitshift ck_bitop fsT2 S S
+right_shift right bitshift ck_bitop fsT2 S S
lt numeric lt ck_null Iifs2 S S
i_lt integer lt ck_null ifs2 S S
@@ -363,52 +403,52 @@ seq string eq ck_null ifs2 S S
sne string ne ck_null ifs2 S S
scmp string comparison ck_scmp ifst2 S S
-bit_and bitwise and ck_bitop fst2 S S
-bit_xor bitwise xor ck_bitop fst2 S S
-bit_or bitwise or ck_bitop fst2 S S
+bit_and bitwise and ck_bitop fsT2 S S
+bit_xor bitwise xor ck_bitop fsT2 S S
+bit_or bitwise or ck_bitop fsT2 S S
-negate negate ck_null Ifst1 S
-i_negate integer negate ck_null ifst1 S
+negate negate ck_null IfsT1 S
+i_negate integer negate ck_null ifsT1 S
not not ck_null ifs1 S
-complement 1's complement ck_bitop fst1 S
+complement 1's complement ck_bitop fsT1 S
# High falutin' math.
-atan2 atan2 ck_fun fst@ S S
-sin sin ck_fun fstu% S?
-cos cos ck_fun fstu% S?
-rand rand ck_fun st% S?
+atan2 atan2 ck_fun fsT@ S S
+sin sin ck_fun fsTu% S?
+cos cos ck_fun fsTu% S?
+rand rand ck_fun sT% S?
srand srand ck_fun s% S?
-exp exp ck_fun fstu% S?
-log log ck_fun fstu% S?
-sqrt sqrt ck_fun fstu% S?
+exp exp ck_fun fsTu% S?
+log log ck_fun fsTu% S?
+sqrt sqrt ck_fun fsTu% S?
# Lowbrow math.
-int int ck_fun fstu% S?
-hex hex ck_fun fstu% S?
-oct oct ck_fun fstu% S?
-abs abs ck_fun fstu% S?
+int int ck_fun fsTu% S?
+hex hex ck_fun fsTu% S?
+oct oct ck_fun fsTu% S?
+abs abs ck_fun fsTu% S?
# String stuff.
-length length ck_lengthconst istu% S?
+length length ck_lengthconst isTu% S?
substr substr ck_fun st@ S S S? S?
vec vec ck_fun ist@ S S S
-index index ck_index ist@ S S S?
-rindex rindex ck_index ist@ S S S?
+index index ck_index isT@ S S S?
+rindex rindex ck_index isT@ S S S?
-sprintf sprintf ck_fun_locale mfst@ S L
+sprintf sprintf ck_fun_locale mfsT@ S L
formline formline ck_fun ms@ S L
-ord ord ck_fun ifstu% S?
-chr chr ck_fun fstu% S?
-crypt crypt ck_fun fst@ S S
+ord ord ck_fun ifsTu% S?
+chr chr ck_fun fsTu% S?
+crypt crypt ck_fun fsT@ S S
ucfirst upper case first ck_fun_locale fstu% S?
lcfirst lower case first ck_fun_locale fstu% S?
uc upper case ck_fun_locale fstu% S?
lc lower case ck_fun_locale fstu% S?
-quotemeta quote metachars ck_fun fstu% S?
+quotemeta quote metachars ck_fun fsTu% S?
# Arrays.
@@ -433,7 +473,7 @@ hslice hash slice ck_null m@ H L
unpack unpack ck_fun @ S S
pack pack ck_fun mst@ S L
split split ck_split t@ S S S
-join join ck_fun mst@ S L
+join join ck_fun msT@ S L
# List operators.
@@ -443,10 +483,10 @@ anonlist anonymous list ck_fun ms@ L
anonhash anonymous hash ck_fun ms@ L
splice splice ck_fun m@ A S? S? L
-push push ck_fun imst@ A L
+push push ck_fun imsT@ A L
pop pop ck_shift s% A
shift shift ck_shift s% A
-unshift unshift ck_fun imst@ A L
+unshift unshift ck_fun imsT@ A L
sort sort ck_sort m@ C? L
reverse reverse ck_fun mt@ L
@@ -544,7 +584,7 @@ truncate truncate ck_trunc is@ S S
fcntl fcntl ck_fun st@ F S S
ioctl ioctl ck_fun st@ F S S
-flock flock ck_fun ist@ F S
+flock flock ck_fun isT@ F S
# Sockets.
@@ -597,18 +637,18 @@ ftbinary -B ck_ftst isu- F
# File calls.
-chdir chdir ck_fun ist% S?
-chown chown ck_fun imst@ L
-chroot chroot ck_fun istu% S?
-unlink unlink ck_fun imstu@ L
-chmod chmod ck_fun imst@ L
-utime utime ck_fun imst@ L
-rename rename ck_fun ist@ S S
-link link ck_fun ist@ S S
-symlink symlink ck_fun ist@ S S
+chdir chdir ck_fun isT% S?
+chown chown ck_fun imsT@ L
+chroot chroot ck_fun isTu% S?
+unlink unlink ck_fun imsTu@ L
+chmod chmod ck_fun imsT@ L
+utime utime ck_fun imsT@ L
+rename rename ck_fun isT@ S S
+link link ck_fun isT@ S S
+symlink symlink ck_fun isT@ S S
readlink readlink ck_fun stu% S?
-mkdir mkdir ck_fun ist@ S S
-rmdir rmdir ck_fun istu% S?
+mkdir mkdir ck_fun isT@ S S
+rmdir rmdir ck_fun isTu% S?
# Directory calls.
@@ -622,25 +662,25 @@ closedir closedir ck_fun is% F
# Process control.
fork fork ck_null ist0
-wait wait ck_null ist0
-waitpid waitpid ck_fun ist@ S S
-system system ck_exec imst@ S? L
-exec exec ck_exec dimst@ S? L
-kill kill ck_fun dimst@ L
-getppid getppid ck_null ist0
-getpgrp getpgrp ck_fun ist% S?
-setpgrp setpgrp ck_fun ist@ S? S?
-getpriority getpriority ck_fun ist@ S S
-setpriority setpriority ck_fun ist@ S S S
+wait wait ck_null isT0
+waitpid waitpid ck_fun isT@ S S
+system system ck_exec imsT@ S? L
+exec exec ck_exec dimsT@ S? L
+kill kill ck_fun dimsT@ L
+getppid getppid ck_null isT0
+getpgrp getpgrp ck_fun isT% S?
+setpgrp setpgrp ck_fun isT@ S? S?
+getpriority getpriority ck_fun isT@ S S
+setpriority setpriority ck_fun isT@ S S S
# Time calls.
-time time ck_null ist0
+time time ck_null isT0
tms times ck_null 0
localtime localtime ck_fun t% S?
gmtime gmtime ck_fun t% S?
alarm alarm ck_fun istu% S?
-sleep sleep ck_fun ist% S?
+sleep sleep ck_fun isT% S?
# Shared memory.
diff --git a/pp.h b/pp.h
index 9fd3365361..0eac5a56f9 100644
--- a/pp.h
+++ b/pp.h
@@ -98,6 +98,7 @@
#define XPUSHn(n) STMT_START { sv_setnv(TARG, (NV)(n)); XPUSHTARG; } STMT_END
#define XPUSHi(i) STMT_START { sv_setiv(TARG, (IV)(i)); XPUSHTARG; } STMT_END
#define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#define XPUSHundef STMT_START { SvOK_off(TARG); XPUSHs(TARG); } STMT_END
#define SETs(s) (*sp = s)
#define SETTARG STMT_START { SvSETMAGIC(TARG); SETs(TARG); } STMT_END
@@ -151,7 +152,9 @@
#define RETSETUNDEF RETURNX(SETs(&PL_sv_undef))
#define ARGTARG PL_op->op_targ
-#define MAXARG PL_op->op_private
+
+ /* See OPpTARGET_MY: */
+#define MAXARG (PL_op->op_private & 15)
#define SWITCHSTACK(f,t) \
STMT_START { \
@@ -209,8 +212,8 @@
#define FORCE_SETs(sv) STMT_START { sv_setsv(TARG, (sv)); SETTARG; } STMT_END
-#define tryAMAGICun tryAMAGICunSET
-#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN)
+#define tryAMAGICun(meth) tryAMAGICunW(meth,SETsvUN,0,RETURN)
+#define tryAMAGICunSET(meth) tryAMAGICunW(meth,SETs,0,RETURN)
#define tryAMAGICunTARGET(meth, shift) \
{ dSP; sp--; /* get TARGET from below PL_stack_sp */ \
{ dTARGETSTACKED; \
@@ -225,7 +228,13 @@
#define opASSIGN (PL_op->op_flags & OPf_STACKED)
#define SETsv(sv) STMT_START { \
- if (opASSIGN) { sv_setsv(TARG, (sv)); SETTARG; } \
+ if (opASSIGN || (SvFLAGS(TARG) & SVs_PADMY)) \
+ { sv_setsv(TARG, (sv)); SETTARG; } \
+ else SETs(sv); } STMT_END
+
+#define SETsvUN(sv) STMT_START { \
+ if (SvFLAGS(TARG) & SVs_PADMY) \
+ { sv_setsv(TARG, (sv)); SETTARG; } \
else SETs(sv); } STMT_END
/* newSVsv does not behave as advertised, so we copy missing
diff --git a/pp.sym b/pp.sym
index d3747af05d..1d8513a097 100644
--- a/pp.sym
+++ b/pp.sym
@@ -22,6 +22,7 @@ Perl_ck_repeat
Perl_ck_require
Perl_ck_rfun
Perl_ck_rvconst
+Perl_ck_sassign
Perl_ck_scmp
Perl_ck_select
Perl_ck_shift
diff --git a/pp_proto.h b/pp_proto.h
index b3d092b8fb..7f253d7162 100644
--- a/pp_proto.h
+++ b/pp_proto.h
@@ -22,6 +22,7 @@ PERL_CKDEF(Perl_ck_repeat)
PERL_CKDEF(Perl_ck_require)
PERL_CKDEF(Perl_ck_rfun)
PERL_CKDEF(Perl_ck_rvconst)
+PERL_CKDEF(Perl_ck_sassign)
PERL_CKDEF(Perl_ck_scmp)
PERL_CKDEF(Perl_ck_select)
PERL_CKDEF(Perl_ck_shift)