diff options
-rw-r--r-- | op.c | 70 | ||||
-rw-r--r-- | op.h | 45 | ||||
-rw-r--r-- | opcode.h | 638 | ||||
-rwxr-xr-x | opcode.pl | 196 | ||||
-rw-r--r-- | pp.h | 17 | ||||
-rw-r--r-- | pp.sym | 1 | ||||
-rw-r--r-- | pp_proto.h | 1 |
7 files changed, 545 insertions, 423 deletions
@@ -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: @@ -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 @@ -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 @@ -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. @@ -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 @@ -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) |