Eliminate PL_OP_SLAB_ALLOC

This commit eliminates the old slab allocator.  It had bugs in it, in
that ops would not be cleaned up properly after syntax errors.  So why
not fix it?  Well, the new slab allocator *is* the old one fixed.

Now that this is gone, we don’t have to worry as much about ops leak-
ing when errors occur, because it won’t happen any more.

Recent commits eliminated the only reason to hang on to it:
 PERL_DEBUG_READONLY_OPS required it.

diff --git a/cv.h b/cv.h
index f7b1b66..e2644e1 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -191,10 +191,6 @@ See L<perlguts/Autoloading with XSUBs>.
 /* Flags for newXS_flags  */
 #define XS_DYNAMIC_FILENAME    0x01    /* The filename isn't static  */
 
-#ifdef PL_OP_SLAB_ALLOC
-# define cv_forget_slab(cv)    NOOP
-#endif
-
 /*
 =head1 CV reference counts and CvOUTSIDE
 

diff --git a/embed.fnc b/embed.fnc
index c740da2..eb81d9c 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -281,9 +281,7 @@ ApdR        |SV*    |cv_const_sv    |NULLOK const CV *const cv
 : Used in pad.c
 pR     |SV*    |op_const_sv    |NULLOK const OP* o|NULLOK CV* cv
 Apd    |void   |cv_undef       |NN CV* cv
-#ifndef PL_OP_SLAB_ALLOC
 p      |void   |cv_forget_slab |NN CV *cv
-#endif
 Ap     |void   |cx_dump        |NN PERL_CONTEXT* cx
 Ap     |SV*    |filter_add     |NULLOK filter_t funcp|NULLOK SV* datasv
 Ap     |void   |filter_del     |NN filter_t funcp
@@ -969,7 +967,7 @@ p   |PerlIO*|nextargv       |NN GV* gv
 AnpP   |char*  |ninstr         |NN const char* big|NN const char* bigend \
                                |NN const char* little|NN const char* lend
 Ap     |void   |op_free        |NULLOK OP* arg
-#if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_CORE)
+#ifdef PERL_CORE
 p      |void   |opslab_free    |NN OPSLAB *slab
 p      |void   |opslab_free_nopad|NN OPSLAB *slab
 p      |void   |opslab_force_free|NN OPSLAB *slab
@@ -1784,13 +1782,8 @@ s        |void   |process_special_blocks |NN const char *const fullname\
 Xpa    |void*  |Slab_Alloc     |size_t sz
 Xp     |void   |Slab_Free      |NN void *op
 #if defined(PERL_DEBUG_READONLY_OPS)
-#    ifdef PL_OP_SLAB_ALLOC
-: Used in perl.c
-poxM   |void   |pending_Slabs_to_ro
-#    else
-#     if defined(PERL_CORE)
+#    if defined(PERL_CORE)
 px     |void   |Slab_to_ro     |NN OPSLAB *slab
-#      endif
 #    endif
 : Used in OpREFCNT_inc() in sv.c
 poxM   |OP *   |op_refcnt_inc  |NULLOK OP *o

diff --git a/embed.h b/embed.h
index 49bb248..5dca8e3 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -1053,6 +1053,7 @@
 #define coresub_op(a,b,c)      Perl_coresub_op(aTHX_ a,b,c)
 #define create_eval_scope(a)   Perl_create_eval_scope(aTHX_ a)
 #define cv_ckproto_len_flags(a,b,c,d,e)        Perl_cv_ckproto_len_flags(aTHX_ a,b,c,d,e)
+#define cv_forget_slab(a)      Perl_cv_forget_slab(aTHX_ a)
 #define cvgv_set(a,b)          Perl_cvgv_set(aTHX_ a,b)
 #define cvstash_set(a,b)       Perl_cvstash_set(aTHX_ a,b)
 #define deb_stack_all()                Perl_deb_stack_all(aTHX)
@@ -1234,13 +1235,6 @@
 #define package(a)             Perl_package(aTHX_ a)
 #define utilize(a,b,c,d,e)     Perl_utilize(aTHX_ a,b,c,d,e)
 #  endif
-#  if !(defined(PL_OP_SLAB_ALLOC))
-#    if defined(PERL_CORE)
-#      if defined(PERL_DEBUG_READONLY_OPS)
-#define Slab_to_ro(a)          Perl_Slab_to_ro(aTHX_ a)
-#      endif
-#    endif
-#  endif
 #  if !defined(HAS_GETENV_LEN)
 #define getenv_len(a,b)                Perl_getenv_len(aTHX_ a,b)
 #  endif
@@ -1275,14 +1269,6 @@
 #define utf16_textfilter(a,b,c)        S_utf16_textfilter(aTHX_ a,b,c)
 #    endif
 #  endif
-#  if !defined(PL_OP_SLAB_ALLOC)
-#define cv_forget_slab(a)      Perl_cv_forget_slab(aTHX_ a)
-#  endif
-#  if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_CORE)
-#define opslab_force_free(a)   Perl_opslab_force_free(aTHX_ a)
-#define opslab_free(a)         Perl_opslab_free(aTHX_ a)
-#define opslab_free_nopad(a)   Perl_opslab_free_nopad(aTHX_ a)
-#  endif
 #  if !defined(WIN32)
 #define do_exec3(a,b,c)                Perl_do_exec3(aTHX_ a,b,c)
 #  endif
@@ -1317,6 +1303,14 @@
 #define malloc_good_size       Perl_malloc_good_size
 #define malloced_size          Perl_malloced_size
 #  endif
+#  if defined(PERL_CORE)
+#define opslab_force_free(a)   Perl_opslab_force_free(aTHX_ a)
+#define opslab_free(a)         Perl_opslab_free(aTHX_ a)
+#define opslab_free_nopad(a)   Perl_opslab_free_nopad(aTHX_ a)
+#    if defined(PERL_DEBUG_READONLY_OPS)
+#define Slab_to_ro(a)          Perl_Slab_to_ro(aTHX_ a)
+#    endif
+#  endif
 #  if defined(PERL_CR_FILTER)
 #    if defined(PERL_IN_TOKE_C)
 #define cr_textfilter(a,b,c)   S_cr_textfilter(aTHX_ a,b,c)

diff --git a/embedvar.h b/embedvar.h
index 98efa6f..01f3db1 100644 (file)
--- a/embedvar.h
+++ b/embedvar.h
@@ -67,9 +67,6 @@
 #define PL_Mem                 (vTHX->IMem)
 #define PL_MemParse            (vTHX->IMemParse)
 #define PL_MemShared           (vTHX->IMemShared)
-#define PL_OpPtr               (vTHX->IOpPtr)
-#define PL_OpSlab              (vTHX->IOpSlab)
-#define PL_OpSpace             (vTHX->IOpSpace)
 #define PL_PerlSpace           (vTHX->IPerlSpace)
 #define PL_PosixAlnum          (vTHX->IPosixAlnum)
 #define PL_PosixAlpha          (vTHX->IPosixAlpha)
@@ -303,8 +300,6 @@
 #define PL_sighandlerp         (vTHX->Isighandlerp)
 #define PL_signalhook          (vTHX->Isignalhook)
 #define PL_signals             (vTHX->Isignals)
-#define PL_slab_count          (vTHX->Islab_count)
-#define PL_slabs               (vTHX->Islabs)
 #define PL_sort_RealCmp                (vTHX->Isort_RealCmp)
 #define PL_sortcop             (vTHX->Isortcop)
 #define PL_sortstash           (vTHX->Isortstash)

diff --git a/intrpvar.h b/intrpvar.h
index 330551b..f2be894 100644 (file)
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -808,17 +808,6 @@ PERLVARI(I, madskills,     bool,   FALSE)  /* preserve all syntactic info */
 PERLVARI(I, xmlfp,     PerlIO *, NULL)
 #endif
 
-#ifdef PL_OP_SLAB_ALLOC
-PERLVAR(I, OpPtr,      I32 **)
-PERLVARI(I, OpSpace,   I32,    0)
-PERLVAR(I, OpSlab,     I32 *)
-
-# ifdef PERL_DEBUG_READONLY_OPS
-PERLVARI(I, slabs,     I32**,  NULL)   /* Array of slabs that have been allocated */
-PERLVARI(I, slab_count, U32,   0)      /* Size of the array */
-# endif
-#endif
-
 #ifdef DEBUG_LEAKING_SCALARS
 PERLVARI(I, sv_serial, U32,    0)      /* SV serial number, used in sv.c */
 #endif

diff --git a/makedef.pl b/makedef.pl
index 72d4a87..c1fd4c1 100644 (file)
--- a/makedef.pl
+++ b/makedef.pl
@@ -404,21 +404,6 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
                         );
 }
 
-unless ($define{'PL_OP_SLAB_ALLOC'}) {
-    ++$skip{$_} foreach qw(
-                     PL_OpPtr
-                     PL_OpSlab
-                     PL_OpSpace
-                        );
-}
-
-unless ($define{'PERL_DEBUG_READONLY_OPS'} && $define{'PL_OP_SLAB_ALLOC'}){
-    ++$skip{$_} foreach qw(
-                   PL_slab_count
-                   PL_slabs
-                        );
-}
-
 unless ($define{'PERL_NEED_APPCTX'}) {
     ++$skip{PL_appctx};
 }

diff --git a/op.c b/op.c
index 1ce69f1..e722b89 100644 (file)
--- a/op.c
+++ b/op.c
@@ -109,202 +109,29 @@ recursive, but it's recursive on basic blocks, not on tree nodes.
 #define CALL_RPEEP(o) PL_rpeepp(aTHX_ o)
 #define CALL_OPFREEHOOK(o) if (PL_opfreehook) PL_opfreehook(aTHX_ o)
 
-#if defined(PL_OP_SLAB_ALLOC)
-
-#ifdef PERL_DEBUG_READONLY_OPS
-#  define PERL_SLAB_SIZE 4096
-#  include <sys/mman.h>
-#endif
-
-#ifndef PERL_SLAB_SIZE
-#define PERL_SLAB_SIZE 2048
-#endif
-
-void *
-Perl_Slab_Alloc(pTHX_ size_t sz)
-{
-    dVAR;
-    /*
-     * To make incrementing use count easy PL_OpSlab is an I32 *
-     * To make inserting the link to slab PL_OpPtr is I32 **
-     * So compute size in units of sizeof(I32 *) as that is how Pl_OpPtr increments
-     * Add an overhead for pointer to slab and round up as a number of pointers
-     */
-    sz = (sz + 2*sizeof(I32 *) -1)/sizeof(I32 *);
-    if ((PL_OpSpace -= sz) < 0) {
-#ifdef PERL_DEBUG_READONLY_OPS
-       /* We need to allocate chunk by chunk so that we can control the VM
-          mapping */
-       PL_OpPtr = (I32**) mmap(0, PERL_SLAB_SIZE*sizeof(I32*), PROT_READ|PROT_WRITE,
-                       MAP_ANON|MAP_PRIVATE, -1, 0);
-
-       DEBUG_m(PerlIO_printf(Perl_debug_log, "mapped %lu at %p\n",
-                             (unsigned long) PERL_SLAB_SIZE*sizeof(I32*),
-                             PL_OpPtr));
-       if(PL_OpPtr == MAP_FAILED) {
-           perror("mmap failed");
-           abort();
-       }
-#else
-
-        PL_OpPtr = (I32 **) PerlMemShared_calloc(PERL_SLAB_SIZE,sizeof(I32*)); 
-#endif
-       if (!PL_OpPtr) {
-           return NULL;
-       }
-       /* We reserve the 0'th I32 sized chunk as a use count */
-       PL_OpSlab = (I32 *) PL_OpPtr;
-       /* Reduce size by the use count word, and by the size we need.
-        * Latter is to mimic the '-=' in the if() above
-        */
-       PL_OpSpace = PERL_SLAB_SIZE - (sizeof(I32)+sizeof(I32 **)-1)/sizeof(I32 **) - sz;
-       /* Allocation pointer starts at the top.
-          Theory: because we build leaves before trunk allocating at end
-          means that at run time access is cache friendly upward
-        */
-       PL_OpPtr += PERL_SLAB_SIZE;
-
-#ifdef PERL_DEBUG_READONLY_OPS
-       /* We remember this slab.  */
-       /* This implementation isn't efficient, but it is simple. */
-       PL_slabs = (I32**) realloc(PL_slabs, sizeof(I32**) * (PL_slab_count + 1));
-       PL_slabs[PL_slab_count++] = PL_OpSlab;
-       DEBUG_m(PerlIO_printf(Perl_debug_log, "Allocate %p\n", PL_OpSlab));
-#endif
-    }
-    assert( PL_OpSpace >= 0 );
-    /* Move the allocation pointer down */
-    PL_OpPtr   -= sz;
-    assert( PL_OpPtr > (I32 **) PL_OpSlab );
-    *PL_OpPtr   = PL_OpSlab;   /* Note which slab it belongs to */
-    (*PL_OpSlab)++;            /* Increment use count of slab */
-    assert( PL_OpPtr+sz <= ((I32 **) PL_OpSlab + PERL_SLAB_SIZE) );
-    assert( *PL_OpSlab > 0 );
-    return (void *)(PL_OpPtr + 1);
-}
-
-#ifdef PERL_DEBUG_READONLY_OPS
-void
-Perl_pending_Slabs_to_ro(pTHX) {
-    /* Turn all the allocated op slabs read only.  */
-    U32 count = PL_slab_count;
-    I32 **const slabs = PL_slabs;
-
-    /* Reset the array of pending OP slabs, as we're about to turn this lot
-       read only. Also, do it ahead of the loop in case the warn triggers,
-       and a warn handler has an eval */
-
-    PL_slabs = NULL;
-    PL_slab_count = 0;
-
-    /* Force a new slab for any further allocation.  */
-    PL_OpSpace = 0;
-
-    while (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
-S_Slab_to_rw(pTHX_ void *op)
-{
-    I32 * const * const ptr = (I32 **) op;
-    I32 * const slab = ptr[-1];
-
-    PERL_ARGS_ASSERT_SLAB_TO_RW;
-
-    assert( ptr-1 > (I32 **) slab );
-    assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
-    assert( *slab > 0 );
-    if(mprotect(slab, PERL_SLAB_SIZE*sizeof(I32*), PROT_READ|PROT_WRITE)) {
-       Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d",
-                 slab, (unsigned long) PERL_SLAB_SIZE*sizeof(I32*), errno);
-    }
-}
-
-#else
-#  define Slab_to_rw(op)
-#endif
-
-void
-Perl_Slab_Free(pTHX_ void *op)
-{
-    I32 * const * const ptr = (I32 **) op;
-    I32 * const slab = ptr[-1];
-    PERL_ARGS_ASSERT_SLAB_FREE;
-    assert( ptr-1 > (I32 **) slab );
-    assert( ptr < ( (I32 **) slab + PERL_SLAB_SIZE) );
-    assert( *slab > 0 );
-    Slab_to_rw(op);
-    if (--(*slab) == 0) {
-#  ifdef NETWARE
-#    define PerlMemShared PerlMem
-#  endif
-       
-#ifdef PERL_DEBUG_READONLY_OPS
-       U32 count = PL_slab_count;
-       /* Need to remove this slab from our list of slabs */
-       if (count) {
-           while (count--) {
-               if (PL_slabs[count] == slab) {
-                   dVAR;
-                   /* Found it. Move the entry at the end to overwrite it.  */
-                   DEBUG_m(PerlIO_printf(Perl_debug_log,
-                                         "Deallocate %p by moving %p from %lu to %lu\n",
-                                         PL_OpSlab,
-                                         PL_slabs[PL_slab_count - 1],
-                                         PL_slab_count, count));
-                   PL_slabs[count] = PL_slabs[--PL_slab_count];
-                   /* Could realloc smaller at this point, but probably not
-                      worth it.  */
-                   if(munmap(slab, PERL_SLAB_SIZE*sizeof(I32*))) {
-                       perror("munmap failed");
-                       abort();
-                   }
-                   break;
-               }
-           }
-       }
-#else
-    PerlMemShared_free(slab);
-#endif
-       if (slab == PL_OpSlab) {
-           PL_OpSpace = 0;
-       }
-    }
-}
-#else /* !defined(PL_OP_SLAB_ALLOC) */
-
 /* See the explanatory comments above struct opslab in op.h. */
 
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
 #  define PERL_SLAB_SIZE 128
 #  define PERL_MAX_SLAB_SIZE 4096
 #  include <sys/mman.h>
-# endif
+#endif
 
-# ifndef PERL_SLAB_SIZE
+#ifndef PERL_SLAB_SIZE
 #  define PERL_SLAB_SIZE 64
-# endif
-# ifndef PERL_MAX_SLAB_SIZE
+#endif
+#ifndef PERL_MAX_SLAB_SIZE
 #  define PERL_MAX_SLAB_SIZE 2048
-# endif
+#endif
 
 /* rounds up to nearest pointer */
-# define SIZE_TO_PSIZE(x)      (((x) + sizeof(I32 *) - 1)/sizeof(I32 *))
-# define DIFF(o,p)             ((size_t)((I32 **)(p) - (I32**)(o)))
+#define SIZE_TO_PSIZE(x)       (((x) + sizeof(I32 *) - 1)/sizeof(I32 *))
+#define DIFF(o,p)              ((size_t)((I32 **)(p) - (I32**)(o)))
 
 static OPSLAB *
 S_new_slab(pTHX_ size_t sz)
 {
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
     OPSLAB *slab = (OPSLAB *) mmap(0, sz * sizeof(I32 *),
                                   PROT_READ|PROT_WRITE,
                                   MAP_ANON|MAP_PRIVATE, -1, 0);
@@ -315,9 +142,9 @@ S_new_slab(pTHX_ size_t sz)
        abort();
     }
     slab->opslab_size = (U16)sz;
-# else
+#else
     OPSLAB *slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *));
-# endif
+#endif
     slab->opslab_first = (OPSLOT *)((I32 **)slab + sz - 1);
     return slab;
 }
@@ -370,7 +197,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
        }
     }
 
-# define INIT_OPSLOT \
+#define INIT_OPSLOT \
            slot->opslot_slab = slab;                   \
            slot->opslot_next = slab2->opslab_first;    \
            slab2->opslab_first = slot;                 \
@@ -414,9 +241,9 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     return (void *)o;
 }
 
-# undef INIT_OPSLOT
+#undef INIT_OPSLOT
 
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
 void
 Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
 {
@@ -466,9 +293,9 @@ S_Slab_to_rw(pTHX_ void *op)
 /* This cannot possibly be right, but it was copied from the old slab
    allocator, to which it was originally added, without explanation, in
    commit 083fcd5. */
-# ifdef NETWARE
+#ifdef NETWARE
 #    define PerlMemShared PerlMem
-# endif
+#endif
 
 void
 Perl_Slab_Free(pTHX_ void *op)
@@ -518,19 +345,19 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
     assert(slab->opslab_refcnt == 1);
     for (; slab; slab = slab2) {
        slab2 = slab->opslab_next;
-# ifdef DEBUGGING
+#ifdef DEBUGGING
        slab->opslab_refcnt = ~(size_t)0;
-# endif
-# ifdef PERL_DEBUG_READONLY_OPS
+#endif
+#ifdef PERL_DEBUG_READONLY_OPS
        DEBUG_m(PerlIO_printf(Perl_debug_log, "Deallocate slab at %p\n",
                                               slab));
        if (munmap(slab, slab->opslab_size * sizeof(I32 *))) {
            perror("munmap failed");
            abort();
        }
-# else
+#else
        PerlMemShared_free(slab);
-# endif
+#endif
     }
 }
 
@@ -539,9 +366,9 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab)
 {
     OPSLAB *slab2;
     OPSLOT *slot;
-# ifdef DEBUGGING
+#ifdef DEBUGGING
     size_t savestack_count = 0;
-# endif
+#endif
     PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE;
     slab2 = slab;
     do {
@@ -550,9 +377,9 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab)
             slot = slot->opslot_next) {
            if (slot->opslot_op.op_type != OP_FREED
             && !(slot->opslot_op.op_savefree
-# ifdef DEBUGGING
+#ifdef DEBUGGING
                  && ++savestack_count
-# endif
+#endif
                 )
            ) {
                assert(slot->opslot_op.op_slabbed);
@@ -564,16 +391,15 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab)
     } while ((slab2 = slab2->opslab_next));
     /* > 1 because the CV still holds a reference count. */
     if (slab->opslab_refcnt > 1) { /* still referenced by the savestack */
-# ifdef DEBUGGING
+#ifdef DEBUGGING
        assert(savestack_count == slab->opslab_refcnt-1);
-# endif
+#endif
        return;
     }
    free:
     opslab_free(slab);
 }
 
-#endif
 #ifdef PERL_DEBUG_READONLY_OPS
 OP *
 Perl_op_refcnt_inc(pTHX_ OP *o)
@@ -825,11 +651,9 @@ Perl_op_free(pTHX_ OP *o)
     dVAR;
     OPCODE type;
 
-#ifndef PL_OP_SLAB_ALLOC
     /* Though ops may be freed twice, freeing the op after its slab is a
        big no-no. */
     assert(!o || !o->op_slabbed || OpSLAB(o)->opslab_refcnt != ~(size_t)0); 
-#endif
     /* During the forced freeing of ops after compilation failure, kidops
        may be freed before their parents. */
     if (!o || o->op_type == OP_FREED)
@@ -6521,11 +6345,9 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     /* for my  $x () sets OPpLVAL_INTRO;
      * for our $x () sets OPpOUR_INTRO */
     loop->op_private = (U8)iterpflags;
-#ifndef PL_OP_SLAB_ALLOC
     if (loop->op_slabbed
      && DIFF(loop, OpSLOT(loop)->opslot_next)
         < SIZE_TO_PSIZE(sizeof(LOOP)))
-#endif
     {
        LOOP *tmp;
        NewOp(1234,tmp,1,LOOP);
@@ -6533,10 +6355,8 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
        S_op_destroy(aTHX_ (OP*)loop);
        loop = tmp;
     }
-#ifndef PL_OP_SLAB_ALLOC
     else if (!loop->op_slabbed)
        loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
-#endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, newOP(OP_ITER, 0), block, cont, 0);
     if (madsv)
@@ -7041,7 +6861,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
         o ? SvPV_const(o_is_gv ? (SV *)o : cSVOPo->op_sv, namlen) : NULL;
     bool has_name;
     bool name_is_utf8 = o && !o_is_gv && SvUTF8(cSVOPo->op_sv);
-#if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_DEBUG_READONLY_OPS)
+#ifdef PERL_DEBUG_READONLY_OPS
     OPSLAB *slab = NULL;
 #endif
 
@@ -7314,14 +7134,12 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
                   : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     CvROOT(cv)->op_private |= OPpREFCOUNTED;
     OpREFCNT_set(CvROOT(cv), 1);
-#ifndef PL_OP_SLAB_ALLOC
     /* The cv no longer needs to hold a refcount on the slab, as CvROOT
        itself has a refcount. */
     CvSLABBED_off(cv);
     OpslabREFCNT_dec_padok((OPSLAB *)CvSTART(cv));
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
     slab = (OPSLAB *)CvSTART(cv);
-# endif
 #endif
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
@@ -7379,7 +7197,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
     if (PL_parser)
        PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
-#if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_DEBUG_READONLY_OPS)
+#ifdef PERL_DEBUG_READONLY_OPS
     /* Watch out for BEGIN blocks */
     if (slab && gv && isGV(gv) && GvCV(gv)) Slab_to_ro(slab);
 #endif

diff --git a/op.h b/op.h
index ceedf35..ff2a540 100644 (file)
--- a/op.h
+++ b/op.h
@@ -739,7 +739,7 @@ least an C<UNOP>.
  * cating an op if there are no freed ops available or big enough.
  */
 
-#if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_CORE)
+#ifdef PERL_CORE
 struct opslot {
     /* keep opslot_next first */
     OPSLOT *   opslot_next;            /* next slot */

diff --git a/pad.c b/pad.c
index f61bdf4..0077e5b 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -355,15 +355,12 @@ Perl_cv_undef(pTHX_ CV *cv)
 
        PAD_SAVE_SETNULLPAD();
 
-#ifndef PL_OP_SLAB_ALLOC
        if (slabbed) OpslabREFCNT_dec_padok(OpSLAB(CvROOT(cv)));
-#endif
        op_free(CvROOT(cv));
        CvROOT(cv) = NULL;
        CvSTART(cv) = NULL;
        LEAVE;
     }
-#ifndef PL_OP_SLAB_ALLOC
     else if (slabbed && CvSTART(cv)) {
        ENTER;
        PAD_SAVE_SETNULLPAD();
@@ -374,9 +371,8 @@ Perl_cv_undef(pTHX_ CV *cv)
 
        LEAVE;
     }
-# ifdef DEBUGGING
+#ifdef DEBUGGING
     else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
-# endif
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     CvGV_set(cv, NULL);
@@ -490,14 +486,13 @@ Perl_cv_undef(pTHX_ CV *cv)
     CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
 }
 
-#ifndef PL_OP_SLAB_ALLOC
 void
 Perl_cv_forget_slab(pTHX_ CV *cv)
 {
     const bool slabbed = !!CvSLABBED(cv);
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
     OPSLAB *slab = NULL;
-# endif
+#endif
 
     PERL_ARGS_ASSERT_CV_FORGET_SLAB;
 
@@ -505,27 +500,26 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
 
     CvSLABBED_off(cv);
 
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
-# else
+#else
     if      (CvROOT(cv))  OpslabREFCNT_dec(OpSLAB(CvROOT(cv)));
     else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv));
-# endif
-# ifdef DEBUGGING
+#endif
+#ifdef DEBUGGING
     else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
-# endif
+#endif
 
-# ifdef PERL_DEBUG_READONLY_OPS
+#ifdef PERL_DEBUG_READONLY_OPS
     if (slab) {
        size_t refcnt;
        refcnt = slab->opslab_refcnt;
        OpslabREFCNT_dec(slab);
        if (refcnt > 1) Slab_to_ro(slab);
     }
-# endif
-}
 #endif
+}
 
 /*
 =for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash

diff --git a/perl.c b/perl.c
index 2c2cdab..a4a05f5 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1218,12 +1218,6 @@ perl_destruct(pTHXx)
 #endif
     PL_sv_count = 0;
 
-#if defined(PERL_DEBUG_READONLY_OPS) && defined(PL_OP_SLAB_ALLOC)
-    free(PL_slabs);
-    PL_slabs = NULL;
-    PL_slab_count = 0;
-#endif
-
 #if defined(PERLIO_LAYERS)
     /* No more IO - including error messages ! */
     PerlIO_cleanup(aTHX);
@@ -2394,12 +2388,8 @@ S_run_body(pTHX_ I32 oldscope)
            call_list(oldscope, PL_initav);
        }
 #ifdef PERL_DEBUG_READONLY_OPS
-# ifdef PL_OP_SLAB_ALLOC
-       Perl_pending_Slabs_to_ro(aTHX);
-# else
        if (PL_main_root && PL_main_root->op_slabbed)
            Slab_to_ro(OpSLAB(PL_main_root));
-# endif
 #endif
     }
 

diff --git a/perl.h b/perl.h
index cf35ded..fe65904 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -2409,7 +2409,7 @@ typedef struct padop PADOP;
 typedef struct pvop PVOP;
 typedef struct loop LOOP;
 
-#if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_CORE)
+#ifdef PERL_CORE
 typedef struct opslab OPSLAB;
 typedef struct opslot OPSLOT;
 #endif
@@ -4693,9 +4693,6 @@ EXTCONST char PL_bincompat_options[] =
 #  ifdef PERL_USES_PL_PIDSTATUS
                             " PERL_USES_PL_PIDSTATUS"
 #  endif
-#  ifdef PL_OP_SLAB_ALLOC
-                            " PL_OP_SLAB_ALLOC"
-#  endif
 #  ifdef USE_64_BIT_ALL
                             " USE_64_BIT_ALL"
 #  endif

diff --git a/proto.h b/proto.h
index 53c0ee0..946e9fe 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -693,6 +693,11 @@ PERL_CALLCONV CV*  Perl_cv_clone(pTHX_ CV* proto)
 PERL_CALLCONV SV*      Perl_cv_const_sv(pTHX_ const CV *const cv)
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV void     Perl_cv_forget_slab(pTHX_ CV *cv)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CV_FORGET_SLAB        \
+       assert(cv)
+
 PERL_CALLCONV void     Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckfun_p, SV **ckobj_p)
                        __attribute__nonnull__(pTHX_1)
                        __attribute__nonnull__(pTHX_2)
@@ -4869,17 +4874,6 @@ PERL_CALLCONV void       Perl_utilize(pTHX_ int aver, I32 floor, OP* version, OP* idop
        assert(idop)
 
 #endif
-#if !(defined(PL_OP_SLAB_ALLOC))
-#  if defined(PERL_CORE)
-#    if defined(PERL_DEBUG_READONLY_OPS)
-PERL_CALLCONV void     Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_SLAB_TO_RO    \
-       assert(slab)
-
-#    endif
-#  endif
-#endif
 #if !(defined(USE_ITHREADS))
 #  if defined(PERL_IN_OP_C)
 STATIC void    S_forget_pmop(pTHX_ PMOP *const o)
@@ -5010,30 +5004,6 @@ STATIC I32       S_utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen)
 
 #  endif
 #endif
-#if !defined(PL_OP_SLAB_ALLOC)
-PERL_CALLCONV void     Perl_cv_forget_slab(pTHX_ CV *cv)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_CV_FORGET_SLAB        \
-       assert(cv)
-
-#endif
-#if !defined(PL_OP_SLAB_ALLOC) && defined(PERL_CORE)
-PERL_CALLCONV void     Perl_opslab_force_free(pTHX_ OPSLAB *slab)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE     \
-       assert(slab)
-
-PERL_CALLCONV void     Perl_opslab_free(pTHX_ OPSLAB *slab)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_OPSLAB_FREE   \
-       assert(slab)
-
-PERL_CALLCONV void     Perl_opslab_free_nopad(pTHX_ OPSLAB *slab)
-                       __attribute__nonnull__(pTHX_1);
-#define PERL_ARGS_ASSERT_OPSLAB_FREE_NOPAD     \
-       assert(slab)
-
-#endif
 #if !defined(SETUID_SCRIPTS_ARE_SECURE_NOW)
 #  if defined(PERL_IN_PERL_C)
 STATIC void    S_validate_suid(pTHX_ PerlIO *rsfp)
@@ -5294,6 +5264,30 @@ PERL_CALLCONV short      Perl_my_swap(pTHX_ short s)
 #if defined(NO_MATHOMS)
 /* PERL_CALLCONV void  Perl_sv_nounlocking(pTHX_ SV *sv); */
 #endif
+#if defined(PERL_CORE)
+PERL_CALLCONV void     Perl_opslab_force_free(pTHX_ OPSLAB *slab)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE     \
+       assert(slab)
+
+PERL_CALLCONV void     Perl_opslab_free(pTHX_ OPSLAB *slab)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_OPSLAB_FREE   \
+       assert(slab)
+
+PERL_CALLCONV void     Perl_opslab_free_nopad(pTHX_ OPSLAB *slab)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_OPSLAB_FREE_NOPAD     \
+       assert(slab)
+
+#  if defined(PERL_DEBUG_READONLY_OPS)
+PERL_CALLCONV void     Perl_Slab_to_ro(pTHX_ OPSLAB *slab)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SLAB_TO_RO    \
+       assert(slab)
+
+#  endif
+#endif
 #if defined(PERL_CR_FILTER)
 #  if defined(PERL_IN_TOKE_C)
 STATIC I32     S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen);
@@ -5318,9 +5312,6 @@ STATIC void       S_Slab_to_rw(pTHX_ void *op)
        assert(op)
 
 #  endif
-#  if defined(PL_OP_SLAB_ALLOC)
-PERL_CALLCONV void     Perl_pending_Slabs_to_ro(pTHX);
-#  endif
 #endif
 #if defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION)
 /* PERL_CALLCONV bool  Perl_do_exec(pTHX_ const char* cmd)

diff --git a/sv.c b/sv.c
index 4c09cb2..dd78927 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12950,11 +12950,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_compiling = proto_perl->Icompiling;
 
-#if defined(PERL_DEBUG_READONLY_OPS) && defined(PL_OP_SLAB_ALLOC)
-    PL_slabs = NULL;
-    PL_slab_count = 0;
-#endif
-
     /* pseudo environmental stuff */
     PL_origargc                = proto_perl->Iorigargc;
     PL_origargv                = proto_perl->Iorigargv;