make opslot_slab an offset in current slab

Each OPSLOT allocated within an OPSLAB contains a pointer, opslot_slab,
which points back to the first (head) slab of the slab chain (i.e. not
necessarily to the slab which the op is contained in).

This commit changes the pointer to be a 16-bit offset from the start of
the current slab, and adds a pointer at the start of each slab which
points back to the head slab.

The mapping from an op to the head slab is now a two-step process: use
the op's slot's opslot_offset field to find the start of the current
slab, then use that slab's new opslab_head pointer to find the head
slab.

The advantage of this is that it reduces the storage per op.  (It
probably doesn't make any practical difference yet, due to alignment
issues, but that will will be sorted shortly in this branch.)

diff --git a/op.c b/op.c
index 91a7bbe..0ccde31 100644 (file)
--- a/op.c
+++ b/op.c
@@ -208,13 +208,26 @@ S_prune_chain_head(OP** op_p)
 #define SIZE_TO_PSIZE(x)       (((x) + sizeof(I32 *) - 1)/sizeof(I32 *))
 #define DIFF(o,p)              ((size_t)((I32 **)(p) - (I32**)(o)))
 
-/* malloc a new op slab (suitable for attaching to PL_compcv) */
+/* requires double parens and aTHX_ */
+#define DEBUG_S_warn(args)                                            \
+    DEBUG_S(                                                           \
+       PerlIO_printf(Perl_debug_log, "%s", SvPVx_nolen(Perl_mess args)) \
+    )
+
+
+/* malloc a new op slab (suitable for attaching to PL_compcv).
+ * sz is in units of pointers */
 
 static OPSLAB *
-S_new_slab(pTHX_ size_t sz)
+S_new_slab(pTHX_ OPSLAB *head, size_t sz)
 {
+    OPSLAB *slab;
+
+    /* opslot_offset is only U16 */
+    assert(sz  < U16_MAX);
+
 #ifdef PERL_DEBUG_READONLY_OPS
-    OPSLAB *slab = (OPSLAB *) mmap(0, sz * sizeof(I32 *),
+    slab = (OPSLAB *) mmap(0, sz * sizeof(I32 *),
                                   PROT_READ|PROT_WRITE,
                                   MAP_ANON|MAP_PRIVATE, -1, 0);
     DEBUG_m(PerlIO_printf(Perl_debug_log, "mapped %lu at %p\n",
@@ -225,21 +238,19 @@ S_new_slab(pTHX_ size_t sz)
     }
     slab->opslab_size = (U16)sz;
 #else
-    OPSLAB *slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *));
+    slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *));
 #endif
 #ifndef WIN32
     /* The context is unused in non-Windows */
     PERL_UNUSED_CONTEXT;
 #endif
     slab->opslab_first = (OPSLOT *)((I32 **)slab + sz - 1);
+    slab->opslab_head = head ? head : slab;
+    DEBUG_S_warn((aTHX_ "allocated new op slab  %p, head slab %p",
+        (void*)slab, (void*)(slab->opslab_head)));
     return slab;
 }
 
-/* requires double parens and aTHX_ */
-#define DEBUG_S_warn(args)                                            \
-    DEBUG_S(                                                           \
-       PerlIO_printf(Perl_debug_log, "%s", SvPVx_nolen(Perl_mess args)) \
-    )
 
 /* Returns a sz-sized block of memory (suitable for holding an op) from
  * a free slot in the chain of op slabs attached to PL_compcv.
@@ -277,7 +288,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
        details.  */
     if (!CvSTART(PL_compcv)) {
        CvSTART(PL_compcv) =
-           (OP *)(head_slab = S_new_slab(aTHX_ PERL_SLAB_SIZE));
+           (OP *)(head_slab = S_new_slab(aTHX_ NULL, PERL_SLAB_SIZE));
        CvSLABBED_on(PL_compcv);
        head_slab->opslab_refcnt = 2; /* one for the CV; one for the new OP */
     }
@@ -308,7 +319,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     }
 
 #define INIT_OPSLOT \
-           slot->opslot_slab = head_slab;              \
+           slot->opslot_offset = DIFF(slab2, slot) ;   \
            slot->opslot_next = slab2->opslab_first;    \
            slab2->opslab_first = slot;                 \
            o = &slot->opslot_op;                       \
@@ -332,7 +343,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
        /* Create a new slab.  Make this one twice as big. */
        slot = slab2->opslab_first;
        while (slot->opslot_next) slot = slot->opslot_next;
-       slab2 = S_new_slab(aTHX_
+       slab2 = S_new_slab(aTHX_ head_slab,
                            (DIFF(slab2, slot)+1)*2 > PERL_MAX_SLAB_SIZE
                                        ? PERL_MAX_SLAB_SIZE
                                        : (DIFF(slab2, slot)+1)*2);
@@ -348,8 +359,8 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
         < SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P)
        slot = &slab2->opslab_slots;
     INIT_OPSLOT;
-    DEBUG_S_warn((aTHX_ "allocating op at %p, head slab %p", (void*)o,
-        (void*)head_slab));
+    DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p, head slab %p",
+        (void*)o, (void*)slab2, (void*)head_slab));
 
   gotit:
     /* moresib == 0, op_sibling == 0 implies a solitary unattached op */
@@ -448,7 +459,7 @@ Perl_Slab_Free(pTHX_ void *op)
     o->op_type = OP_FREED;
     o->op_next = slab->opslab_freed;
     slab->opslab_freed = o;
-    DEBUG_S_warn((aTHX_ "free op at %p, recorded in slab %p", (void*)o, (void*)slab));
+    DEBUG_S_warn((aTHX_ "free op at %p, recorded in head slab %p", (void*)o, (void*)slab));
     OpslabREFCNT_dec_padok(slab);
 }
 

diff --git a/op.h b/op.h
index ad6cf7f..9a6d6fb 100644 (file)
--- a/op.h
+++ b/op.h
@@ -691,15 +691,16 @@ least an C<UNOP>.
 struct opslot {
     /* keep opslot_next first */
     OPSLOT *   opslot_next;            /* next slot */
-    OPSLAB *   opslot_slab;            /* owner */
+    U16         opslot_offset;      /* offset from start of slab (in ptr units) */
     OP         opslot_op;              /* the op itself */
 };
 
 struct opslab {
     OPSLOT *   opslab_first;           /* first op in this slab */
     OPSLAB *   opslab_next;            /* next slab */
+    OPSLAB *   opslab_head;            /* first slab in chain */
     OP *       opslab_freed;           /* chain of freed ops */
-    size_t     opslab_refcnt;          /* number of ops */
+    size_t     opslab_refcnt;          /* number of ops (head slab only) */
 # ifdef PERL_DEBUG_READONLY_OPS
     U16                opslab_size;            /* size of slab in pointers */
     bool       opslab_readonly;
@@ -711,7 +712,11 @@ struct opslab {
 # define OPSLOT_HEADER_P       (OPSLOT_HEADER/sizeof(I32 *))
 # define OpSLOT(o)             (assert_(o->op_slabbed) \
                                 (OPSLOT *)(((char *)o)-OPSLOT_HEADER))
-# define OpSLAB(o)             OpSLOT(o)->opslot_slab
+
+/* the first (head) opslab of the chain in which this op is allocated */
+# define OpSLAB(o) \
+    (((OPSLAB*)( (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset))->opslab_head)
+
 # define OpslabREFCNT_dec(slab)      \
        (((slab)->opslab_refcnt == 1) \
         ? opslab_free_nopad(slab)     \