In perl.git, the branch blead has been updated <https://perl5.git.perl.org/perl.git/commitdiff/442d4b523eda1f5c8549c30d32b6539ec1c65ef9?hp=45f8e7b102987a417bf55438e858cedced8aedbe>
- Log ----------------------------------------------------------------- commit 442d4b523eda1f5c8549c30d32b6539ec1c65ef9 Merge: 45f8e7b102 dae3d2d55d Author: David Mitchell <[email protected]> Date: Mon Aug 5 11:35:08 2019 +0100 [MERGE] slim down opslot structure. When OPs are allocated from a slab (the normal case), what are actually allocated from the slab are opslot structs, which consist of an OP plus two pointers. The branch reduces those two pointers to two U16s, which saves 8 bytes per op on a 64-bit system. A further 8 bytes could be saved if those two U16s were included as extra fields in the OP structure (and the opslot struct disposed of), but unfortunately too much code does things like Zero(o) or Copy(o1,o2) which would obliterate the allocation info contained in those two U16s. commit dae3d2d55d7ff2ff2c79e397cf2e23ecead9ddff Author: David Mitchell <[email protected]> Date: Tue Jul 16 16:30:42 2019 +0100 Perl_opslab_force_free() adjust loop test Formerly, slots were allocated within a slab, but leaving the very top word in the slab as a NULL pointer which appeared as a fake slot so that a 'while (slot->opslot_next)' loop would stop. Since opslot_next has been eradicated and the NULL is no longer allocated, the loop condition for scanning all slots can be simplified slightly (with no change in functionality). commit 8c47b5bce7a3d69f27ab4e998ed5827d0c9964de Author: David Mitchell <[email protected]> Date: Tue Jul 16 16:14:58 2019 +0100 OPSLOT: replace opslot_next with opslot_size Currently, each allocated opslot has a pointer to the opslot that was allocated immediately above it. Replace this with a U16 opslot_size field giving the size of the opslot. The next opslot can then be found by adding slot->opslot_size * sizeof(void*) to slot. This saves space. commit c63fff64d7aa23894e5fa68504e177f77b72fce9 Author: David Mitchell <[email protected]> Date: Mon Jul 15 11:55:27 2019 +0100 struct opslot: document a field better commit 7b85c12a47eeaeb8aaaa0c95fdbdd48ecd5f929d Author: David Mitchell <[email protected]> Date: Sat Jul 13 20:27:45 2019 +0100 opslabs: change opslab_first to opslab_free_space Currently a OPSLAB maintains a pointer to the lowest allocated OPSLOT within the slab (slots are allocated downwards). Replace this pointer with a U16 indicating how many pointer-sized words are free below the lowest allocated slot. commit aa034fa00bac53c08ef0dd886ebf864da25d155a Author: David Mitchell <[email protected]> Date: Sat Jul 13 18:53:08 2019 +0100 OPSLAB: always have opslab_size field Currently this struct only has the opslab_size field on debugging builds. Change it so that this field is always present. This will make it easier to not need a fake partial OPSLOT at the end of the slab with a NULL opslot_next field, which will in turn simplify converting opslot_next into U16 size field shortly. commit 17b8f3a1378b3c300c2e4ab298a8418f720a6b84 Author: David Mitchell <[email protected]> Date: Sat Jul 13 18:43:30 2019 +0100 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.) commit bffbea3881b5993aeb432b80f7e06740077faa0d Author: David Mitchell <[email protected]> Date: Sat Jul 13 17:52:51 2019 +0100 Perl_Slab_Alloc(): rename 'slab' to 'head_slab' Rename this local var to better identify that it always points to the first slab in the slab chain, rather than to the current slab. ----------------------------------------------------------------------- Summary of changes: op.c | 130 ++++++++++++++++++++++++++++++++++++++++--------------------------- op.h | 23 +++++++----- 2 files changed, 92 insertions(+), 61 deletions(-) diff --git a/op.c b/op.c index 7081f7dceb..5d0b1dae3a 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", @@ -223,23 +236,23 @@ S_new_slab(pTHX_ size_t sz) perror("mmap failed"); abort(); } - slab->opslab_size = (U16)sz; #else - OPSLAB *slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *)); + slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *)); #endif + slab->opslab_size = (U16)sz; + #ifndef WIN32 /* The context is unused in non-Windows */ PERL_UNUSED_CONTEXT; #endif - slab->opslab_first = (OPSLOT *)((I32 **)slab + sz - 1); + slab->opslab_free_space = sz - DIFF(slab, &slab->opslab_slots); + slab->opslab_head = head ? head : slab; + DEBUG_S_warn((aTHX_ "allocated new op slab sz 0x%x, %p, head slab %p", + (unsigned int)slab->opslab_size, (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. @@ -250,11 +263,11 @@ S_new_slab(pTHX_ size_t sz) void * Perl_Slab_Alloc(pTHX_ size_t sz) { - OPSLAB *slab; + OPSLAB *head_slab; /* first slab in the chain */ OPSLAB *slab2; OPSLOT *slot; OP *o; - size_t opsz, space; + size_t opsz; /* We only allocate ops from the slab during subroutine compilation. We find the slab via PL_compcv, hence that must be non-NULL. It could @@ -277,11 +290,11 @@ Perl_Slab_Alloc(pTHX_ size_t sz) details. */ if (!CvSTART(PL_compcv)) { CvSTART(PL_compcv) = - (OP *)(slab = S_new_slab(aTHX_ PERL_SLAB_SIZE)); + (OP *)(head_slab = S_new_slab(aTHX_ NULL, PERL_SLAB_SIZE)); CvSLABBED_on(PL_compcv); - slab->opslab_refcnt = 2; /* one for the CV; one for the new OP */ + head_slab->opslab_refcnt = 2; /* one for the CV; one for the new OP */ } - else ++(slab = (OPSLAB *)CvSTART(PL_compcv))->opslab_refcnt; + else ++(head_slab = (OPSLAB *)CvSTART(PL_compcv))->opslab_refcnt; opsz = SIZE_TO_PSIZE(sz); sz = opsz + OPSLOT_HEADER_P; @@ -289,11 +302,15 @@ Perl_Slab_Alloc(pTHX_ size_t sz) /* The slabs maintain a free list of OPs. In particular, constant folding will free up OPs, so it makes sense to re-use them where possible. A freed up slot is used in preference to a new allocation. */ - if (slab->opslab_freed) { - OP **too = &slab->opslab_freed; + if (head_slab->opslab_freed) { + OP **too = &head_slab->opslab_freed; o = *too; - DEBUG_S_warn((aTHX_ "found free op at %p, slab %p", (void*)o, (void*)slab)); - while (o && DIFF(OpSLOT(o), OpSLOT(o)->opslot_next) < sz) { + DEBUG_S_warn((aTHX_ "found free op at %p, slab %p, head slab %p", + (void*)o, + (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset, + (void*)head_slab)); + + while (o && OpSLOT(o)->opslot_size < sz) { DEBUG_S_warn((aTHX_ "Alas! too small")); o = *(too = &o->op_next); if (o) { DEBUG_S_warn((aTHX_ "found another free op at %p", (void*)o)); } @@ -306,48 +323,45 @@ Perl_Slab_Alloc(pTHX_ size_t sz) } } -#define INIT_OPSLOT \ - slot->opslot_slab = slab; \ - slot->opslot_next = slab2->opslab_first; \ - slab2->opslab_first = slot; \ +#define INIT_OPSLOT(s) \ + slot->opslot_offset = DIFF(slab2, slot) ; \ + slot->opslot_size = s; \ + slab2->opslab_free_space -= s; \ o = &slot->opslot_op; \ o->op_slabbed = 1 /* The partially-filled slab is next in the chain. */ - slab2 = slab->opslab_next ? slab->opslab_next : slab; - if ((space = DIFF(&slab2->opslab_slots, slab2->opslab_first)) < sz) { + slab2 = head_slab->opslab_next ? head_slab->opslab_next : head_slab; + if (slab2->opslab_free_space < sz) { /* Remaining space is too small. */ - /* If we can fit a BASEOP, add it to the free chain, so as not to waste it. */ - if (space >= SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P) { + if (slab2->opslab_free_space >= SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P) { slot = &slab2->opslab_slots; - INIT_OPSLOT; + INIT_OPSLOT(slab2->opslab_free_space); o->op_type = OP_FREED; - o->op_next = slab->opslab_freed; - slab->opslab_freed = o; + o->op_next = head_slab->opslab_freed; + head_slab->opslab_freed = o; } /* 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_ - (DIFF(slab2, slot)+1)*2 > PERL_MAX_SLAB_SIZE - ? PERL_MAX_SLAB_SIZE - : (DIFF(slab2, slot)+1)*2); - slab2->opslab_next = slab->opslab_next; - slab->opslab_next = slab2; + slab2 = S_new_slab(aTHX_ head_slab, + slab2->opslab_size > PERL_MAX_SLAB_SIZE / 2 + ? PERL_MAX_SLAB_SIZE + : slab2->opslab_size * 2); + slab2->opslab_next = head_slab->opslab_next; + head_slab->opslab_next = slab2; } - assert(DIFF(&slab2->opslab_slots, slab2->opslab_first) >= sz); + assert(slab2->opslab_size >= sz); /* Create a new op slot */ - slot = (OPSLOT *)((I32 **)slab2->opslab_first - sz); + slot = (OPSLOT *) + ((I32 **)&slab2->opslab_slots + + slab2->opslab_free_space - sz); assert(slot >= &slab2->opslab_slots); - if (DIFF(&slab2->opslab_slots, slot) - < SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P) - slot = &slab2->opslab_slots; - INIT_OPSLOT; - DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p", (void*)o, (void*)slab)); + INIT_OPSLOT(sz); + 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 */ @@ -446,7 +460,10 @@ 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_ "freeing op at %p, slab %p, head slab %p", + (void*)o, + (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset, + (void*)slab)); OpslabREFCNT_dec_padok(slab); } @@ -514,10 +531,13 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab) PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE; slab2 = slab; do { - OPSLOT *slot; - for (slot = slab2->opslab_first; - slot->opslot_next; - slot = slot->opslot_next) { + OPSLOT *slot = (OPSLOT*) + ((I32**)&slab2->opslab_slots + slab2->opslab_free_space); + OPSLOT *end = (OPSLOT*) + ((I32**)slab2 + slab2->opslab_size); + for (; slot < end; + slot = (OPSLOT*) ((I32**)slot + slot->opslot_size) ) + { if (slot->opslot_op.op_type != OP_FREED && !(slot->opslot_op.op_savefree #ifdef DEBUGGING @@ -9263,10 +9283,13 @@ 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; + + /* upgrade loop from a LISTOP to a LOOPOP; + * keep it in-place if there's space */ if (loop->op_slabbed - && DIFF(loop, OpSLOT(loop)->opslot_next) - < SIZE_TO_PSIZE(sizeof(LOOP))) + && OpSLOT(loop)->opslot_size < SIZE_TO_PSIZE(sizeof(LOOP))) { + /* no space; allocate new op */ LOOP *tmp; NewOp(1234,tmp,1,LOOP); Copy(loop,tmp,1,LISTOP); @@ -9277,6 +9300,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) } else if (!loop->op_slabbed) { + /* loop was malloc()ed */ loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP)); OpLASTSIB_set(loop->op_last, (OP*)loop); } diff --git a/op.h b/op.h index ad6cf7fe49..057b4550dd 100644 --- a/op.h +++ b/op.h @@ -689,19 +689,22 @@ least an C<UNOP>. #ifdef PERL_CORE struct opslot { - /* keep opslot_next first */ - OPSLOT * opslot_next; /* next slot */ - OPSLAB * opslot_slab; /* owner */ + U16 opslot_size; /* size of this slot (in pointers) */ + 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 */ - OP * opslab_freed; /* chain of freed ops */ - size_t opslab_refcnt; /* number of ops */ + OPSLAB * opslab_head; /* first slab in chain */ + OP * opslab_freed; /* chain of freed ops (head only)*/ + size_t opslab_refcnt; /* number of ops (head slab only) */ + U16 opslab_size; /* size of slab in pointers, + including header */ + U16 opslab_free_space; /* space available in this slab + for allocating new ops (in ptr + units) */ # ifdef PERL_DEBUG_READONLY_OPS - U16 opslab_size; /* size of slab in pointers */ bool opslab_readonly; # endif OPSLOT opslab_slots; /* slots begin here */ @@ -711,7 +714,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) \ -- Perl5 Master Repository
