Change 29543 by [EMAIL PROTECTED] on 2006/12/13 01:47:34
fix parser leaks caused by croaking while shifting or reducing
e.g. these no longer leak:
eval q[my $x; local $x] while 1;
eval q[$s = sub <> {}] while 1;
Affected files ...
... //depot/perl/op.c#857 edit
... //depot/perl/op.h#159 edit
... //depot/perl/perly.c#92 edit
Differences ...
==== //depot/perl/op.c#857 (text) ====
Index: perl/op.c
--- perl/op.c#856~29429~ 2006-12-01 02:28:36.000000000 -0800
+++ perl/op.c 2006-12-12 17:47:34.000000000 -0800
@@ -287,6 +287,11 @@
if (!o || o->op_static)
return;
+ if (o->op_latefreed) {
+ if (o->op_latefree)
+ return;
+ goto do_free;
+ }
type = o->op_type;
if (o->op_private & OPpREFCOUNTED) {
@@ -327,6 +332,11 @@
cop_free((COP*)o);
op_clear(o);
+ if (o->op_latefree) {
+ o->op_latefreed = 1;
+ return;
+ }
+ do_free:
FreeOp(o);
#ifdef DEBUG_LEAKING_SCALARS
if (PL_op == o)
@@ -2712,6 +2722,8 @@
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_next = o;
o->op_private = (U8)(0 | (flags >> 8));
==== //depot/perl/op.h#159 (text) ====
Index: perl/op.h
--- perl/op.h#158~29488~ 2006-12-08 14:20:41.000000000 -0800
+++ perl/op.h 2006-12-12 17:47:34.000000000 -0800
@@ -22,7 +22,11 @@
* op_static Whether or not the op is statically defined.
* This flag is used by the B::C compiler backend
* and indicates that the op should not be freed.
- * op_spare Five spare bits!
+ * 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_spare three 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
@@ -54,7 +58,9 @@
unsigned op_type:9; \
unsigned op_opt:1; \
unsigned op_static:1; \
- unsigned op_spare:5; \
+ unsigned op_latefree:1; \
+ unsigned op_latefreed:1; \
+ unsigned op_spare:3; \
U8 op_flags; \
U8 op_private;
#endif
==== //depot/perl/perly.c#92 (text) ====
Index: perl/perly.c
--- perl/perly.c#91~29508~ 2006-12-11 03:41:10.000000000 -0800
+++ perl/perly.c 2006-12-12 17:47:34.000000000 -0800
@@ -162,7 +162,7 @@
PerlIO_printf(Perl_debug_log, " %8.8s",
yyvs[start+i].opval
? PL_op_name[yyvs[start+i].opval->op_type]
- : "(NULL)"
+ : "(Nullop)"
);
break;
#ifndef PERL_IN_MADLY_C
@@ -287,19 +287,77 @@
S_clear_yystack(pTHX_ const void *p)
{
yystack_positions *y = (yystack_positions*) p;
+ int i;
if (!y->yyss)
return;
YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
- y->yyvsp -= y->yylen; /* ignore the tokens that have just been reduced */
- y->yyssp -= y->yylen;
- y->yypsp -= y->yylen;
+
+ /* Freeing ops on the stack, and the op_latefree/op_latefreed 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 (ie Perl_croak somewhere in yylex(), or in one of the
+ * newFOO() functions, then its 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 shoould clearly free the op (making
+ * sure, for each op we free thyat 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 { .... 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 it
+ * * attached them to part of a larger tree
+ *
+ * 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 themselces are
+ * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
+ * and free them. A little though should convince you that this
+ * two-part approach to the reducing ops should handle all three cases
+ * above safely.
+ */
+
+ /* free any reducing ops (1st pass) */
+
+ for (i=0; i< y->yylen; i++) {
+ if (yy_type_tab[yystos[y->yyssp[-i]]] == toketype_opval
+ && y->yyvsp[-i].opval) {
+ if (y->yypsp[-i] != PL_comppad) {
+ PAD_RESTORE_LOCAL(y->yypsp[-i]);
+ }
+ op_free(y->yyvsp[-i].opval);
+ }
+ }
+
+ /* now free whole the stack, including the just-reduced ops */
+
while (y->yyssp > y->yyss) {
- if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval) {
+ if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval
+ && y->yyvsp->opval)
+ {
if (*y->yypsp != PL_comppad) {
PAD_RESTORE_LOCAL(*y->yypsp);
}
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+ y->yyvsp->opval->op_latefree = 0;
op_free(y->yyvsp->opval);
}
y->yyvsp--;
@@ -431,8 +489,6 @@
yynerrs = 0;
yychar = YYEMPTY; /* Cause a token to be read. */
- YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-
goto yysetstate;
/*------------------------------------------------------------.
@@ -445,8 +501,20 @@
yyssp++;
yysetstate:
+ YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
*yyssp = yystate;
+ if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
+ yyvsp->opval->op_latefree = 1;
+ yyvsp->opval->op_latefreed = 0;
+ }
+
+ ss_save->yyss = yyss;
+ ss_save->yyssp = yyssp;
+ ss_save->yyvsp = yyvsp;
+ ss_save->yypsp = yypsp;
+ ss_save->yylen = 0;
+
if (yyss + yystacksize - 1 <= yyssp) {
/* Get the current used size of the three stacks, in elements. */
const YYSIZE_T yysize = yyssp - yyss + 1;
@@ -485,6 +553,12 @@
if (yyss + yystacksize - 1 <= yyssp)
YYABORT;
+
+ ss_save->yyss = yyss;
+ ss_save->yyssp = yyssp;
+ ss_save->yyvsp = yyvsp;
+ ss_save->yypsp = yypsp;
+ ss_save->yylen = 0;
}
goto yybackup;
@@ -567,7 +641,6 @@
yyerrstatus--;
yystate = yyn;
- YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
goto yynewstate;
@@ -641,6 +714,21 @@
}
+ /* 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< yylen; i++) {
+ if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
+ && yyvsp[-i].opval)
+ {
+ yyvsp[-i].opval->op_latefree = 0;
+ if (yyvsp[-i].opval->op_latefreed)
+ op_free(yyvsp[-i].opval);
+ }
+ }
+ }
+
yyvsp -= yylen;
yyssp -= yylen;
yypsp -= yylen;
@@ -648,14 +736,11 @@
yynsp -= yylen;
#endif
-
*++yyvsp = yyval;
*++yypsp = PL_comppad;
-
#ifdef DEBUGGING
*++yynsp = (const char *)(yytname [yyr1[yyn]]);
#endif
-
/* Now shift the result of the reduction. Determine what state
that goes to, based on the state we popped back to and the rule
number reduced by. */
@@ -668,8 +753,6 @@
else
yystate = yydefgoto[yyn - YYNTOKENS];
- YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-
#ifdef DEBUGGING
/* tmp push yystate for stack print; this is normally pushed later in
* yynewstate */
@@ -750,11 +833,14 @@
/* Pop the rest of the stack. */
while (yyss < yyssp) {
YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
- if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
+ if (yy_type_tab[yystos[*yyssp]] == toketype_opval
+ && yyvsp->opval)
+ {
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
if (*yypsp != PL_comppad) {
PAD_RESTORE_LOCAL(*yypsp);
}
+ yyvsp->opval->op_latefree = 0;
op_free(yyvsp->opval);
}
YYPOPSTACK;
@@ -794,11 +880,12 @@
YYABORT;
YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
- if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
+ if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
if (*yypsp != PL_comppad) {
PAD_RESTORE_LOCAL(*yypsp);
}
+ yyvsp->opval->op_latefree = 0;
op_free(yyvsp->opval);
}
yyvsp--;
@@ -823,7 +910,6 @@
#endif
yystate = yyn;
- YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
goto yynewstate;
End of Patch.
