This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove op_latefree(d)
authorFather Chrysostomos <sprout@cpan.org>
Sun, 15 Jul 2012 02:00:17 +0000 (19:00 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 15 Jul 2012 02:00:17 +0000 (19:00 -0700)
This was an early attempt to fix leaking of ops after syntax errors,
disabled because it was deemed to fragile.  The new slab allocator
(8be227a) has solved this problem another way, so latefree(d) no
longer serves any purpose.

dump.c
op.c
op.h
perly.c

diff --git a/dump.c b/dump.c
index ad3b960..ebfb3db 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -883,7 +883,7 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
 #ifdef DUMPADDR
     Perl_dump_indent(aTHX_ level, file, "ADDR = 0x%"UVxf" => 0x%"UVxf"\n", (UV)o, (UV)o->op_next);
 #endif
-    if (o->op_flags || o->op_latefree || o->op_latefreed || o->op_attached) {
+    if (o->op_flags) {
        SV * const tmpsv = newSVpvs("");
        switch (o->op_flags & OPf_WANT) {
        case OPf_WANT_VOID:
@@ -900,12 +900,6 @@ Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, const OP *o)
            break;
        }
        append_flags(tmpsv, o->op_flags, op_flags_names);
-       if (o->op_latefree)
-           sv_catpv(tmpsv, ",LATEFREE");
-       if (o->op_latefreed)
-           sv_catpv(tmpsv, ",LATEFREED");
-       if (o->op_attached)
-           sv_catpv(tmpsv, ",ATTACHED");
        Perl_dump_indent(aTHX_ level, file, "FLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : "");
        SvREFCNT_dec(tmpsv);
     }
diff --git a/op.c b/op.c
index 347d0f4..d5c5579 100644 (file)
--- a/op.c
+++ b/op.c
@@ -631,10 +631,6 @@ Perl_alloccopstash(pTHX_ HV *hv)
 static void
 S_op_destroy(pTHX_ OP *o)
 {
-    if (o->op_latefree) {
-       o->op_latefreed = 1;
-       return;
-    }
     FreeOp(o);
 }
 
@@ -659,11 +655,6 @@ Perl_op_free(pTHX_ OP *o)
        may be freed before their parents. */
     if (!o || o->op_type == OP_FREED)
        return;
-    if (o->op_latefreed) {
-       if (o->op_latefree)
-           return;
-       goto do_free;
-    }
 
     type = o->op_type;
     if (o->op_private & OPpREFCOUNTED) {
@@ -720,11 +711,6 @@ Perl_op_free(pTHX_ OP *o)
        type = (OPCODE)o->op_targ;
 
     op_clear(o);
-    if (o->op_latefree) {
-       o->op_latefreed = 1;
-       return;
-    }
-  do_free:
     FreeOp(o);
 #ifdef DEBUG_LEAKING_SCALARS
     if (PL_op == o)
@@ -3816,9 +3802,6 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
     o->op_type = (OPCODE)type;
     o->op_ppaddr = PL_ppaddr[type];
     o->op_flags = (U8)flags;
-    o->op_latefree = 0;
-    o->op_latefreed = 0;
-    o->op_attached = 0;
 
     o->op_next = o;
     o->op_private = (U8)(0 | (flags >> 8));
@@ -7144,7 +7127,6 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 #endif
            block = newblock;
     }
-    else block->op_attached = 1;
     CvROOT(cv) = CvLVALUE(cv)
                   ? newUNOP(OP_LEAVESUBLV, 0,
                             op_lvalue(scalarseq(block), OP_LEAVESUBLV))
diff --git a/op.h b/op.h
index ff2a540..3f1e250 100644 (file)
--- a/op.h
+++ b/op.h
  *     op_type         The type of the operation.
  *     op_opt          Whether or not the op has been optimised by the
  *                     peephole optimiser.
- *
- *                     See the comments in S_clear_yystack() for more
- *                     details on the following three flags:
- *
- *     op_latefree     tell op_free() to clear this op (and free any kids)
- *                     but not yet deallocate the struct. This means that
- *                     the op may be safely op_free()d multiple times
- *     op_latefreed    an op_latefree op has been op_free()d
- *     op_attached     this op (sub)tree has been attached to a CV
  *     op_slabbed      allocated via opslab
  *     op_savefree     on savestack via SAVEFREEOP
- *
- *     op_spare        a spare bit!
+ *     op_spare        Four spare bits!
  *     op_flags        Flags common to all operations.  See OPf_* below.
  *     op_private      Flags peculiar to a particular operation (BUT,
  *                     by default, set to the number of children until
@@ -61,12 +51,9 @@ typedef PERL_BITFIELD16 Optype;
     PADOFFSET  op_targ;                \
     PERL_BITFIELD16 op_type:9;         \
     PERL_BITFIELD16 op_opt:1;          \
-    PERL_BITFIELD16 op_latefree:1;     \
-    PERL_BITFIELD16 op_latefreed:1;    \
-    PERL_BITFIELD16 op_attached:1;     \
     PERL_BITFIELD16 op_slabbed:1;      \
     PERL_BITFIELD16 op_savefree:1;     \
-    PERL_BITFIELD16 op_spare:1;                \
+    PERL_BITFIELD16 op_spare:4;                \
     U8         op_flags;               \
     U8         op_private;
 #endif
diff --git a/perly.c b/perly.c
index a01b562..480894f 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -199,95 +199,10 @@ S_clear_yystack(pTHX_  const yy_parser *parser)
 
     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 
-    /* Freeing ops on the stack, and the op_latefree / op_latefreed /
-     * op_attached flags:
-     *
-     * When we pop tokens off the stack during error recovery, or when
-     * we pop all the tokens off the stack after a die during a shift or
-     * reduce (i.e. Perl_croak somewhere in yylex() or in one of the
-     * newFOO() functions), then it's possible that some of these tokens are
-     * of type opval, pointing to an OP. All these ops are orphans; each is
-     * its own miniature subtree that has not yet been attached to a
-     * larger tree. In this case, we should clearly free the op (making
-     * sure, for each op we free that we have PL_comppad pointing to the
-     * right place for freeing any SVs attached to the op in threaded
-     * builds.
-     *
-     * However, there is a particular problem if we die in newFOO() called
-     * by a reducing action; e.g.
-     *
-     *    foo : bar baz boz
-     *        { $$ = newFOO($1,$2,$3) }
-     *
-     * where
-     *  OP *newFOO { ....; if (...) croak; .... }
-     *
-     * In this case, when we come to clean bar baz and boz off the stack,
-     * we don't know whether newFOO() has already:
-     *    * freed them
-     *    * left them as is
-     *    * attached them to part of a larger tree
-     *    * attached them to PL_compcv
-     *    * attached them to PL_compcv then freed it (as in BEGIN {die } )
-     *
-     * To get round this problem, we set the flag op_latefree on every op
-     * that gets pushed onto the parser stack. If op_free() sees this
-     * flag, it clears the op and frees any children,, but *doesn't* free
-     * the op itself; instead it sets the op_latefreed flag. This means
-     * that we can safely call op_free() multiple times on each stack op.
-     * So, when clearing the stack, we first, for each op that was being
-     * reduced, call op_free with op_latefree=1. This ensures that all ops
-     * hanging off these op are freed, but the reducing ops themselves are
-     * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
-     * and free them. A little thought should convince you that this
-     * two-part approach to the reducing ops should handle the first three
-     * cases above safely.
-     *
-     * In the case of attaching to PL_compcv (currently just newATTRSUB
-     * does this), then  we set the op_attached flag on the op that has
-     * been so attached, then avoid doing the final op_free during
-     * cleanup, on the assumption that it will happen (or has already
-     * happened) when PL_compcv is freed.
-     *
-     * Note this is fairly fragile mechanism. A more robust approach
-     * would be to use two of these flag bits as 2-bit reference count
-     * field for each op, indicating whether it is pointed to from:
-     *   * a parent op
-     *   * the parser stack
-     *   * a CV
-     * but this would involve reworking all code (core and external) that
-     * manipulate op trees.
-     *
-     * XXX DAPM 17/1/07 I've decided its too fragile for now, and so have
-     * disabled it */
-
-#define DISABLE_STACK_FREE
-
-
-#ifdef DISABLE_STACK_FREE
     for (i=0; i< parser->yylen; i++) {
        SvREFCNT_dec(ps[-i].compcv);
     }
     ps -= parser->yylen;
-#else
-    /* clear any reducing ops (1st pass) */
-
-    for (i=0; i< parser->yylen; i++) {
-       LEAVE_SCOPE(ps[-i].savestack_ix);
-       if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
-           && ps[-i].val.opval) {
-           if ( ! (ps[-i].val.opval->op_attached
-                   && !ps[-i].val.opval->op_latefreed))
-           {
-               if (ps[-i].compcv != PL_compcv) {
-                   PL_compcv = ps[-i].compcv;
-                   PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
-               }
-               op_free(ps[-i].val.opval);
-           }
-       }
-    }
-#endif
 
     /* now free whole the stack, including the just-reduced ops */
 
@@ -301,11 +216,7 @@ S_clear_yystack(pTHX_  const yy_parser *parser)
                PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
            }
            YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
-#ifndef DISABLE_STACK_FREE
-           ps->val.opval->op_latefree  = 0;
-           if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
-#endif
-               op_free(ps->val.opval);
+           op_free(ps->val.opval);
        }
        SvREFCNT_dec(ps->compcv);
        ps--;
@@ -383,13 +294,6 @@ Perl_yyparse (pTHX_ int gramtype)
 
     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 
-#ifndef DISABLE_STACK_FREE
-    if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
-       ps->val.opval->op_latefree  = 1;
-       ps->val.opval->op_latefreed = 0;
-    }
-#endif
-
     parser->yylen = 0;
 
     {
@@ -546,20 +450,9 @@ Perl_yyparse (pTHX_ int gramtype)
 
     }
 
-    /* any just-reduced ops with the op_latefreed flag cleared need to be
-     * freed; the rest need the flag resetting */
     {
        int i;
        for (i=0; i< parser->yylen; i++) {
-#ifndef DISABLE_STACK_FREE
-           if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
-               && ps[-i].val.opval)
-           {
-               ps[-i].val.opval->op_latefree = 0;
-               if (ps[-i].val.opval->op_latefreed)
-                   op_free(ps[-i].val.opval);
-           }
-#endif
            SvREFCNT_dec(ps[-i].compcv);
        }
     }
@@ -620,7 +513,6 @@ Perl_yyparse (pTHX_ int gramtype)
                        PL_compcv = ps->compcv;
                        PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
                    }
-                   ps->val.opval->op_latefree  = 0;
                    op_free(ps->val.opval);
                }
                SvREFCNT_dec(ps->compcv);
@@ -670,7 +562,6 @@ Perl_yyparse (pTHX_ int gramtype)
                PL_compcv = ps->compcv;
                PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
            }
-           ps->val.opval->op_latefree  = 0;
            op_free(ps->val.opval);
        }
        SvREFCNT_dec(ps->compcv);