invalid cop_free of nullified cop. How to fix?

[Reini Urban]

While testing B::C I got to the problem that already nullified cop's
are being freed, causing
"Bad free() ignored (RMAGIC, PERL_CORE)"

This problem exists in 5.10 and blead.
The straightforward patch would be:

--- op.c.orig 2008-04-07 16:49:32.000000000 +0200
+++ op.c 2008-04-15 13:58:38.828125000 +0200
@@ -505,6 +505,8 @@
/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */
if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
+ /* But do not clear already nullified ops */
+ if (o->op_type > 0 && o->op_paddr != &Perl_pp_null)
cop_free((COP*)o);
}

In the debugger we see the o being a baseop, but after the cast to COP*
we try to do a
CopLABEL_free(cop);
on a field which is really the op_next ptr of the next op.

Breakpoint 1, S_cop_free (cop=0x62c05c) at op.c:645
645 CopLABEL_free(cop);
(gdb) p *cop
$2 = {op_next = 0x62c318, op_sibling = 0x62c198,
op_ppaddr = 0x56b77c <Perl_pp_null>, op_targ = 177, op_type = 0, op_opt = 0,
op_latefree = 1, op_latefreed = 0, op_attached = 0, op_spare = 0,
op_flags = 1 '\001', op_private = 0 '\0', cop_line = 6472496,
cop_label = 0x62c330 "\030Âb", cop_stash = 0x56b79e, cop_filegv = 0x0,
cop_hints = 132099, cop_seq = 6472520, cop_warnings = 0x62c130,
cop_hints_hash = 0x56b79e}
(gdb) up
#1 0x004d3091 in Perl_op_free (o=0x62c05c) at op.c:486
486 cop_free((COP*)o);
(gdb) l
481 #endif
482
483 /* COP* is not cleared by op_clear() so that we may track line
484 * numbers etc even after null() */
485 if (type == OP_NEXTSTATE || type == OP_SETSTATE || type ==
OP_DBSTATE) {
486 cop_free((COP*)o);
487 }
488
489 op_clear(o);
490 if (o->op_latefree) {
(gdb) p type
$3 = 177
(gdb) p *o
$4 = {op_next = 0x62c318, op_sibling = 0x62c198,
op_ppaddr = 0x56b77c <Perl_pp_null>, op_targ = 177, op_type = 0, op_opt = 0,
op_latefree = 1, op_latefreed = 0, op_attached = 0, op_spare = 0,
op_flags = 1 '\001', op_private = 0 '\0'}

So my fix is straightforward.
But I don't know why
if (type == OP_NULL)
type = (OPCODE)o->op_targ;
is executed so early, which brings our bad cop back to life.
Why this?
I don't understand why we try to unprotect the op slab also.

So my preferred fix would be:

--- op.c.orig 2008-04-07 16:49:32.000000000 +0200
+++ op.c 2008-04-15 14:06:16.625000000 +0200
@@ -495,8 +495,6 @@
op_free(kid);
}
}
- if (type == OP_NULL)
- type = (OPCODE)o->op_targ;

#ifdef PERL_DEBUG_READONLY_OPS
Slab_to_rw(o);
@@ -508,6 +506,8 @@
cop_free((COP*)o);
}

+ if (type == OP_NULL)
+ type = (OPCODE)o->op_targ;
op_clear(o);
if (o->op_latefree) {
o->op_latefreed = 1;

--
Reini Urban
http://phpwiki.org/ http://murbreak.at/

[Rafael Garcia-Suarez]

On 15/04/2008, Reini Urban <rur...@x-ray.at> wrote:
> So my fix is straightforward.
> But I don't know why
> if (type == OP_NULL)
> type = (OPCODE)o->op_targ;
> is executed so early, which brings our bad cop back to life.
> Why this?

Doing evil things with B::C ?

> I don't understand why we try to unprotect the op slab also.

Probably to be able to free the CopFILE / CopSTASH.

> So my preferred fix would be:
>
> --- op.c.orig 2008-04-07 16:49:32.000000000 +0200
> +++ op.c 2008-04-15 14:06:16.625000000 +0200

Looks correct and logical. Thanks, applied as #33687 to blead.

[Nicholas Clark]

On Tue, Apr 15, 2008 at 03:17:44PM +0200, Rafael Garcia-Suarez wrote:
> On 15/04/2008, Reini Urban <rur...@x-ray.at> wrote:
> > So my fix is straightforward.
> > But I don't know why
> > if (type == OP_NULL)
> > type = (OPCODE)o->op_targ;
> > is executed so early, which brings our bad cop back to life.
> > Why this?
>
> Doing evil things with B::C ?
>
> > I don't understand why we try to unprotect the op slab also.
>
> Probably to be able to free the CopFILE / CopSTASH.

IIRC, it's because CopFILE_free() writes to the op:

# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))

# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))

Nicholas Clark

[Reini Urban]

2008/4/15, Nicholas Clark <ni...@ccl4.org>:

So then I'll have to find a regression and maybe add an assertion for CORE,
with a nullified cop, but some existing CopFILE. Hmm.
Cause I'm not sure if the applied patch #33687 is correct in this case.

[Rafael Garcia-Suarez]

On 15/04/2008, Reini Urban <rur...@x-ray.at> wrote:
> >
> > IIRC, it's because CopFILE_free() writes to the op:
> >
> > # define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
> >
> > # define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
>
>
> So then I'll have to find a regression and maybe add an assertion for CORE,
> with a nullified cop, but some existing CopFILE. Hmm.
> Cause I'm not sure if the applied patch #33687 is correct in this case.

I've now complemented it with 33695, see below.
But now, I'm not sure that those two lines are still really needed:

if (type == OP_NULL)
type = (OPCODE)o->op_targ;

Change 33695 by rgs@stcosmo on 2008/04/15 15:54:31

Call cop_free on nullified cops too
(this is a followup to 33687)

Affected files ...

... //depot/perl/op.c#1001 edit

Differences ...

==== //depot/perl/op.c#1001 (text) ====

@@ -502,7 +502,10 @@

/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */

- if (type == OP_NEXTSTATE || type == OP_DBSTATE) {
+ if (type == OP_NEXTSTATE || type == OP_DBSTATE
+ || (type == OP_NULL /* the COP might have been null'ed */
+ && ((OPCODE)o->op_targ == OP_NEXTSTATE
+ || (OPCODE)o->op_targ == OP_DBSTATE))) {
cop_free((COP*)o);
}