From 17b8f3a1378b3c300c2e4ab298a8418f720a6b84 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Sat, 13 Jul 2019 18:43:30 +0100 Subject: [PATCH] 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.) --- op.c | 41 ++++++++++++++++++++++++++--------------- op.h | 11 ++++++++--- 2 files changed, 34 insertions(+), 18 deletions(-) diff --git a/op.c b/op.c index 91a7bbe..0ccde31 100644 --- 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 --- a/op.h +++ b/op.h @@ -691,15 +691,16 @@ least an C. 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) \ -- 1.8.3.1