Under PERL_DEBUG_READONLY_OPS don't panic if you can't find the slab

being freed. Also, need to set the slab to read/write before
incrementing or decrementing an op's reference count.
With this we can build all extentions, and run test_harness.

p4raw-id: //depot/perl@30867

diff --git a/embed.fnc b/embed.fnc
index 99252c2..7e2cc35 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1227,6 +1227,8 @@ Apa       |void*  |Slab_Alloc     |size_t sz
 Ap     |void   |Slab_Free      |NN void *op
 #  if defined(PERL_DEBUG_READONLY_OPS)
 poxM   |void   |pending_Slabs_to_ro
+poxM   |OP *   |op_refcnt_inc  |NULLOK OP *o
+poxM   |PADOFFSET      |op_refcnt_dec  |NN OP *o
 #    if defined(PERL_IN_OP_C)
 s      |void   |Slab_to_rw     |NN void *op
 #    endif

diff --git a/op.c b/op.c
index 58dba8f..fc1ea70 100644 (file)
--- a/op.c
+++ b/op.c
@@ -216,6 +216,24 @@ S_Slab_to_rw(pTHX_ void *op)
                  slab, (unsigned long) PERL_SLAB_SIZE*sizeof(I32*), errno);
     }
 }
+
+OP *
+Perl_op_refcnt_inc(pTHX_ OP *o)
+{
+    if(o) {
+       Slab_to_rw(o);
+       ++o->op_targ;
+    }
+    return o;
+
+}
+
+PADOFFSET
+Perl_op_refcnt_dec(pTHX_ OP *o)
+{
+    Slab_to_rw(o);
+    return --o->op_targ;
+}
 #else
 #  define Slab_to_rw(op)
 #endif
@@ -249,17 +267,12 @@ Perl_Slab_Free(pTHX_ void *op)
                    PL_slabs[count] = PL_slabs[--PL_slab_count];
                    /* Could realloc smaller at this point, but probably not
                       worth it.  */
-                   goto gotcha;
+                   if(munmap(slab, PERL_SLAB_SIZE*sizeof(I32*))) {
+                       perror("munmap failed");
+                       abort();
+                   }
+                   break;
                }
-               
-           }
-           Perl_croak(aTHX_
-                      "panic: Couldn't find slab at %p (%lu allocated)",
-                      slab, (unsigned long) PL_slabs);
-       gotcha:
-           if(munmap(slab, PERL_SLAB_SIZE*sizeof(I32*))) {
-               perror("munmap failed");
-               abort();
            }
        }
 #else
@@ -422,9 +435,6 @@ Perl_op_free(pTHX_ OP *o)
        case OP_LEAVEWRITE:
            {
            PADOFFSET refcnt;
-#ifdef PERL_DEBUG_READONLY_OPS
-           Slab_to_rw(o);
-#endif
            OP_REFCNT_LOCK;
            refcnt = OpREFCNT_dec(o);
            OP_REFCNT_UNLOCK;
@@ -451,12 +461,13 @@ Perl_op_free(pTHX_ OP *o)
     if (type == OP_NULL)
        type = (OPCODE)o->op_targ;
 
+#ifdef PERL_DEBUG_READONLY_OPS
+    Slab_to_rw(o);
+#endif
+
     /* 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) {
-#ifdef PERL_DEBUG_READONLY_OPS
-       Slab_to_rw(o);
-#endif
        cop_free((COP*)o);
     }
 

diff --git a/op.h b/op.h
index 2141e2b..2631fa8 100644 (file)
--- a/op.h
+++ b/op.h
@@ -590,8 +590,13 @@ struct loop {
 #endif
 
 #define OpREFCNT_set(o,n)              ((o)->op_targ = (n))
-#define OpREFCNT_inc(o)                        ((o) ? (++(o)->op_targ, (o)) : NULL)
-#define OpREFCNT_dec(o)                        (--(o)->op_targ)
+#ifdef PERL_DEBUG_READONLY_OPS
+#  define OpREFCNT_inc(o)              Perl_op_refcnt_inc(aTHX_ o)
+#  define OpREFCNT_dec(o)              Perl_op_refcnt_dec(aTHX_ o)
+#else
+#  define OpREFCNT_inc(o)              ((o) ? (++(o)->op_targ, (o)) : NULL)
+#  define OpREFCNT_dec(o)              (--(o)->op_targ)
+#endif
 
 /* flags used by Perl_load_module() */
 #define PERL_LOADMOD_DENY              0x1

diff --git a/proto.h b/proto.h
index 436fa79..8bab32e 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -3331,6 +3331,10 @@ PERL_CALLCONV void       Perl_Slab_Free(pTHX_ void *op)
 
 #  if defined(PERL_DEBUG_READONLY_OPS)
 PERL_CALLCONV void     Perl_pending_Slabs_to_ro(pTHX);
+PERL_CALLCONV OP *     Perl_op_refcnt_inc(pTHX_ OP *o);
+PERL_CALLCONV PADOFFSET        Perl_op_refcnt_dec(pTHX_ OP *o)
+                       __attribute__nonnull__(pTHX_1);
+
 #    if defined(PERL_IN_OP_C)
 STATIC void    S_Slab_to_rw(pTHX_ void *op)
                        __attribute__nonnull__(pTHX_1);