diff options
| -rw-r--r-- | dump.c | 2 | ||||
| -rw-r--r-- | embed.h | 4 | ||||
| -rwxr-xr-x | embed.pl | 1 | ||||
| -rw-r--r-- | op.c | 96 | ||||
| -rw-r--r-- | proto.h | 1 |
5 files changed, 63 insertions, 41 deletions
@@ -391,7 +391,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o) else PerlIO_printf(file, "DONE\n"); if (o->op_targ) { - if (o->op_type == OP_NULL || o->op_type == OP_SETSTATE) + if (o->op_type == OP_NULL) Perl_dump_indent(aTHX_ level, file, " (was %s)\n", PL_op_name[o->op_targ]); else Perl_dump_indent(aTHX_ level, file, "TARG = %d\n", o->op_targ); @@ -764,6 +764,7 @@ #define scalarboolean S_scalarboolean #define too_few_arguments S_too_few_arguments #define too_many_arguments S_too_many_arguments +#define op_clear S_op_clear #define null S_null #define pad_findlex S_pad_findlex #define newDEFSVOP S_newDEFSVOP @@ -2076,6 +2077,7 @@ #define scalarboolean(a) S_scalarboolean(aTHX_ a) #define too_few_arguments(a,b) S_too_few_arguments(aTHX_ a,b) #define too_many_arguments(a,b) S_too_many_arguments(aTHX_ a,b) +#define op_clear(a) S_op_clear(aTHX_ a) #define null(a) S_null(aTHX_ a) #define pad_findlex(a,b,c,d,e,f,g) S_pad_findlex(aTHX_ a,b,c,d,e,f,g) #define newDEFSVOP() S_newDEFSVOP(aTHX) @@ -4109,6 +4111,8 @@ #define too_few_arguments S_too_few_arguments #define S_too_many_arguments CPerlObj::S_too_many_arguments #define too_many_arguments S_too_many_arguments +#define S_op_clear CPerlObj::S_op_clear +#define op_clear S_op_clear #define S_null CPerlObj::S_null #define null S_null #define S_pad_findlex CPerlObj::S_pad_findlex @@ -1800,6 +1800,7 @@ s |OP* |no_fh_allowed |OP *o s |OP* |scalarboolean |OP *o s |OP* |too_few_arguments|OP *o|char* name s |OP* |too_many_arguments|OP *o|char* name +s |void |op_clear |OP* o s |void |null |OP* o s |PADOFFSET|pad_findlex |char* name|PADOFFSET newoff|U32 seq \ |CV* startcv|I32 cx_ix|I32 saweval|U32 flags @@ -648,6 +648,7 @@ void Perl_op_free(pTHX_ OP *o) { register OP *kid, *nextkid; + OPCODE type; if (!o || o->op_seq == (U16)-1) return; @@ -658,22 +659,42 @@ Perl_op_free(pTHX_ OP *o) op_free(kid); } } + type = o->op_type; + if (type == OP_NULL) + type = o->op_targ; + + /* COP* is not cleared by op_clear() so that we may track line + * numbers etc even after null() */ + if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE) + cop_free((COP*)o); + + op_clear(o); + +#ifdef PL_OP_SLAB_ALLOC + if ((char *) o == PL_OpPtr) + { + } +#else + Safefree(o); +#endif +} +STATIC void +S_op_clear(pTHX_ OP *o) +{ switch (o->op_type) { - case OP_NULL: - o->op_targ = 0; /* Was holding old type, if any. */ - break; - case OP_ENTEREVAL: - o->op_targ = 0; /* Was holding hints. */ + case OP_NULL: /* Was holding old type, if any. */ + case OP_ENTEREVAL: /* Was holding hints. */ +#ifdef USE_THREADS + case OP_THREADSV: /* Was holding index into thr->threadsv AV. */ +#endif + o->op_targ = 0; break; #ifdef USE_THREADS case OP_ENTERITER: if (!(o->op_flags & OPf_SPECIAL)) break; /* FALL THROUGH */ - case OP_THREADSV: - o->op_targ = 0; /* Was holding index into thr->threadsv AV. */ - break; #endif /* USE_THREADS */ default: if (!(o->op_flags & OPf_REF) @@ -684,16 +705,11 @@ Perl_op_free(pTHX_ OP *o) case OP_GV: case OP_AELEMFAST: SvREFCNT_dec(cGVOPo->op_gv); - break; - case OP_SETSTATE: - o->op_targ = 0; /* Was holding old type. */ - /* FALL THROUGH */ - case OP_NEXTSTATE: - case OP_DBSTATE: - cop_free((COP*)o); + cGVOPo->op_gv = Nullgv; break; case OP_CONST: SvREFCNT_dec(cSVOPo->op_sv); + cSVOPo->op_sv = Nullsv; break; case OP_GOTO: case OP_NEXT: @@ -703,31 +719,29 @@ Perl_op_free(pTHX_ OP *o) break; /* FALL THROUGH */ case OP_TRANS: - if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) + if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) { SvREFCNT_dec(cSVOPo->op_sv); - else + cSVOPo->op_sv = Nullsv; + } + else { Safefree(cPVOPo->op_pv); + cPVOPo->op_pv = Nullch; + } break; case OP_SUBST: op_free(cPMOPo->op_pmreplroot); + cPMOPo->op_pmreplroot = Nullop; /* FALL THROUGH */ case OP_PUSHRE: case OP_MATCH: case OP_QR: ReREFCNT_dec(cPMOPo->op_pmregexp); + cPMOPo->op_pmregexp = (REGEXP*)NULL; break; } if (o->op_targ > 0) pad_free(o->op_targ); - -#ifdef PL_OP_SLAB_ALLOC - if ((char *) o == PL_OpPtr) - { - } -#else - Safefree(o); -#endif } STATIC void @@ -742,10 +756,9 @@ S_cop_free(pTHX_ COP* cop) STATIC void S_null(pTHX_ OP *o) { - if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE) - cop_free((COP*)o); - if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0) - pad_free(o->op_targ); + if (o->op_type == OP_NULL) + return; + op_clear(o); o->op_targ = o->op_type; o->op_type = OP_NULL; o->op_ppaddr = PL_ppaddr[OP_NULL]; @@ -886,9 +899,12 @@ Perl_scalarvoid(pTHX_ OP *o) SV* sv; U8 want; - if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE || - (o->op_type == OP_NULL && - (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE))) + if (o->op_type == OP_NEXTSTATE + || o->op_type == OP_SETSTATE + || o->op_type == OP_DBSTATE + || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE + || o->op_targ == OP_SETSTATE + || o->op_targ == OP_DBSTATE))) { dTHR; PL_curcop = (COP*)o; /* for warning below */ @@ -1018,8 +1034,7 @@ Perl_scalarvoid(pTHX_ OP *o) } } } - null(o); /* don't execute a constant */ - SvREFCNT_dec(sv); /* don't even remember it */ + null(o); /* don't execute or even remember it */ break; case OP_POSTINC: @@ -1690,9 +1705,6 @@ Perl_scope(pTHX_ OP *o) o->op_ppaddr = PL_ppaddr[OP_SCOPE]; kid = ((LISTOP*)o)->op_first; if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){ - if (kid->op_targ > 0) - pad_free(kid->op_targ); - kid->op_targ = kid->op_type; kid->op_type = OP_SETSTATE; kid->op_ppaddr = PL_ppaddr[OP_SETSTATE]; } @@ -3890,7 +3902,7 @@ Perl_op_const_sv(pTHX_ OP *o, CV *cv) for (; o; o = o->op_next) { OPCODE type = o->op_type; - if(sv && o->op_next == o) + if (sv && o->op_next == o) return sv; if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) continue; @@ -5653,6 +5665,7 @@ Perl_peep(pTHX_ register OP *o) PL_op_seqmax++; PL_op = o; switch (o->op_type) { + case OP_SETSTATE: case OP_NEXTSTATE: case OP_DBSTATE: PL_curcop = ((COP*)o); /* for warnings */ @@ -5701,8 +5714,12 @@ Perl_peep(pTHX_ register OP *o) } goto nothin; case OP_NULL: - if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) + if (o->op_targ == OP_NEXTSTATE + || o->op_targ == OP_DBSTATE + || o->op_targ == OP_SETSTATE) + { PL_curcop = ((COP*)o); + } goto nothin; case OP_SCALAR: case OP_LINESEQ: @@ -5737,7 +5754,6 @@ Perl_peep(pTHX_ register OP *o) <= 255 && i >= 0) { - SvREFCNT_dec(((SVOP*)pop)->op_sv); null(o->op_next); null(pop->op_next); null(pop); @@ -773,6 +773,7 @@ STATIC OP* S_no_fh_allowed(pTHX_ OP *o); STATIC OP* S_scalarboolean(pTHX_ OP *o); STATIC OP* S_too_few_arguments(pTHX_ OP *o, char* name); STATIC OP* S_too_many_arguments(pTHX_ OP *o, char* name); +STATIC void S_op_clear(pTHX_ OP* o); STATIC void S_null(pTHX_ OP* o); STATIC PADOFFSET S_pad_findlex(pTHX_ char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval, U32 flags); STATIC OP* S_newDEFSVOP(pTHX); |