This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Bump the VERSION of ExtUtils::Constant::Base.
[perl5.git] / op.c
diff --git a/op.c b/op.c
index 58dba8f..5436a71 100644 (file)
--- a/op.c
+++ b/op.c
@@ -186,7 +186,6 @@ Perl_pending_Slabs_to_ro(pTHX) {
        read only. Also, do it ahead of the loop in case the warn triggers,
        and a warn handler has an eval */
 
-    free(PL_slabs);
     PL_slabs = NULL;
     PL_slab_count = 0;
 
@@ -194,13 +193,15 @@ Perl_pending_Slabs_to_ro(pTHX) {
     PL_OpSpace = 0;
 
     while (count--) {
-       const void *start = slabs[count];
+       void *const start = slabs[count];
        const size_t size = PERL_SLAB_SIZE* sizeof(I32*);
        if(mprotect(start, size, PROT_READ)) {
            Perl_warn(aTHX_ "mprotect for %p %lu failed with %d",
                      start, (unsigned long) size, errno);
        }
     }
+
+    free(slabs);
 }
 
 STATIC void
@@ -216,6 +217,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 +268,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
@@ -394,6 +408,11 @@ S_op_destroy(pTHX_ OP *o)
     FreeOp(o);
 }
 
+#ifdef USE_ITHREADS
+#  define forget_pmop(a,b)     S_forget_pmop(aTHX_ a,b)
+#else
+#  define forget_pmop(a,b)     S_forget_pmop(aTHX_ a)
+#endif
 
 /* Destructor */
 
@@ -422,9 +441,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 +467,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);
     }
 
@@ -625,7 +642,11 @@ S_cop_free(pTHX_ COP* cop)
 }
 
 STATIC void
-S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
+S_forget_pmop(pTHX_ PMOP *const o
+#ifdef USE_ITHREADS
+             , U32 flags
+#endif
+             )
 {
     HV * const pmstash = PmopSTASH(o);
     if (pmstash && !SvIS_FREED(pmstash)) {
@@ -652,8 +673,12 @@ S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
            }
        }
     }
+    if (PL_curpm == o) 
+       PL_curpm = NULL;
+#ifdef USE_ITHREADS
     if (flags)
        PmopSTASH_free(o);
+#endif
 }
 
 STATIC void