From 3654af445825b5d018f99b6a899cef48882d9b39 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 23 Jun 2020 14:19:43 +1000 Subject: [PATCH 1/2] Revert "op.h: Add additional padding to struct opslab to ensure proper alignment" This reverts commit a760468c9355bafaee57e94f13705c0ea925d9ca. This change is fragile, the next change avoids the need for such manual padding. --- op.h | 3 --- 1 file changed, 3 deletions(-) diff --git a/op.h b/op.h index b9f6da82c9d0..fc21f03cda41 100644 --- a/op.h +++ b/op.h @@ -713,9 +713,6 @@ struct opslab { units) */ # ifdef PERL_DEBUG_READONLY_OPS bool opslab_readonly; - U8 opslab_padding; /* padding to ensure that opslab_slots is always */ -# else - U16 opslab_padding; /* located at an offset with 32-bit alignment */ # endif OPSLOT opslab_slots; /* slots begin here */ }; From 18fc536852e560ad338a8fd87b120f8836b55a15 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 25 Jun 2020 15:26:32 +1000 Subject: [PATCH 2/2] re-work opslab handling to avoid non-portable alignment assumptions Fixes #17871 The op slab allocator code made the assumption that since OP and hence OPSLOT contain pointers, the base of each of those would be an integral number of sizeof(pointer) (pointer units) from the beginning of OPSLAB. This assumption is non-portable, and broke calculating the location of the slab based on the address of the op slot and the op slot offset on m68k platforms. To avoid that, this change now stores the opslot_offset as the offset in pointer units from the beginning of opslab_slots rather than from the beginning of the slab. If alignment on a pointer boundary for OPs is required, the compiler will align opslab_opslots and since we work in pointer units from there, any allocated op slots will also be aligned. If we assume PADOFFSET is no larger than a pointer and requires no stricter alignment and structures in themselves have no stricter alignment requirements then since we work in pointer units all core OP structures should have sufficient alignment (if this isn't true, then it's not a new problem, and not the problem I'm trying to solve here.) I haven't been able to test this on m68k hardware (the emulator I tried to use can't maintain a network connection.) --- op.c | 84 +++++++++++++++++++++++++++++++----------------------------- op.h | 9 +++++-- 2 files changed, 51 insertions(+), 42 deletions(-) diff --git a/op.c b/op.c index 0ddc710fbaf3..9e1b8518a0ce 100644 --- a/op.c +++ b/op.c @@ -207,7 +207,10 @@ S_prune_chain_head(OP** op_p) /* 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 DIFF(o,p) \ + (assert(((char *)(p) - (char *)(o)) % sizeof(I32**) == 0), \ + ((size_t)((I32 **)(p) - (I32**)(o)))) /* requires double parens and aTHX_ */ #define DEBUG_S_warn(args) \ @@ -215,20 +218,29 @@ S_prune_chain_head(OP** op_p) PerlIO_printf(Perl_debug_log, "%s", SvPVx_nolen(Perl_mess args)) \ ) +/* opslot_size includes the size of the slot header, and an op can't be smaller than BASEOP */ +#define OPSLOT_SIZE_BASE (SIZE_TO_PSIZE(sizeof(OPSLOT))) + +/* the number of bytes to allocate for a slab with sz * sizeof(I32 **) space for op */ +#define OpSLABSizeBytes(sz) \ + ((sz) * sizeof(I32 *) + STRUCT_OFFSET(OPSLAB, opslab_slots)) /* malloc a new op slab (suitable for attaching to PL_compcv). - * sz is in units of pointers */ + * sz is in units of pointers from the beginning of opslab_opslots */ static OPSLAB * S_new_slab(pTHX_ OPSLAB *head, size_t sz) { OPSLAB *slab; + size_t sz_bytes = OpSLABSizeBytes(sz); /* opslot_offset is only U16 */ - assert(sz < U16_MAX); + assert(sz < U16_MAX); + /* room for at least one op */ + assert(sz >= OPSLOT_SIZE_BASE); #ifdef PERL_DEBUG_READONLY_OPS - slab = (OPSLAB *) mmap(0, sz * sizeof(I32 *), + slab = (OPSLAB *) mmap(0, sz_bytes, PROT_READ|PROT_WRITE, MAP_ANON|MAP_PRIVATE, -1, 0); DEBUG_m(PerlIO_printf(Perl_debug_log, "mapped %lu at %p\n", @@ -238,7 +250,8 @@ S_new_slab(pTHX_ OPSLAB *head, size_t sz) abort(); } #else - slab = (OPSLAB *)PerlMemShared_calloc(sz, sizeof(I32 *)); + slab = (OPSLAB *)PerlMemShared_malloc(sz_bytes); + Zero(slab, sz_bytes, char); #endif slab->opslab_size = (U16)sz; @@ -246,7 +259,7 @@ S_new_slab(pTHX_ OPSLAB *head, size_t sz) /* The context is unused in non-Windows */ PERL_UNUSED_CONTEXT; #endif - slab->opslab_free_space = sz - DIFF(slab, &slab->opslab_slots); + slab->opslab_free_space = sz; 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, @@ -254,8 +267,6 @@ S_new_slab(pTHX_ OPSLAB *head, size_t sz) return slab; } -/* opslot_size includes the size of the slot header, and an op can't be smaller than BASEOP */ -#define OPSLOT_SIZE_BASE (SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P) #define OPSLOT_SIZE_TO_INDEX(sz) ((sz) - OPSLOT_SIZE_BASE) #define link_freed_op(slab, o) S_link_freed_op(aTHX_ slab, o) @@ -308,7 +319,7 @@ Perl_Slab_Alloc(pTHX_ size_t sz) OPSLAB *slab2; OPSLOT *slot; OP *o; - size_t opsz; + size_t sz_in_p; /* size in pointer units, including the OPSLOT header */ /* 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 @@ -337,18 +348,17 @@ Perl_Slab_Alloc(pTHX_ size_t sz) } else ++(head_slab = (OPSLAB *)CvSTART(PL_compcv))->opslab_refcnt; - opsz = SIZE_TO_PSIZE(sz); - sz = opsz + OPSLOT_HEADER_P; + sz_in_p = SIZE_TO_PSIZE(sz + OPSLOT_HEADER); /* The head slab for each CV maintains 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 (head_slab->opslab_freed && - OPSLOT_SIZE_TO_INDEX(sz) < head_slab->opslab_freed_size) { + OPSLOT_SIZE_TO_INDEX(sz_in_p) < head_slab->opslab_freed_size) { U16 base_index; /* look for a large enough size with any freed ops */ - for (base_index = OPSLOT_SIZE_TO_INDEX(sz); + for (base_index = OPSLOT_SIZE_TO_INDEX(sz_in_p); base_index < head_slab->opslab_freed_size && !head_slab->opslab_freed[base_index]; ++base_index) { } @@ -358,18 +368,16 @@ Perl_Slab_Alloc(pTHX_ size_t sz) o = head_slab->opslab_freed[base_index]; DEBUG_S_warn((aTHX_ "realloced op at %p, slab %p, head slab %p", - (void*)o, - (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset, - (void*)head_slab)); + (void *)o, (void *)OpMySLAB(o), (void *)head_slab)); head_slab->opslab_freed[base_index] = o->op_next; - Zero(o, opsz, I32 *); + Zero(o, sz, char); o->op_slabbed = 1; goto gotit; } } #define INIT_OPSLOT(s) \ - slot->opslot_offset = DIFF(slab2, slot) ; \ + slot->opslot_offset = DIFF(&slab2->opslab_slots, slot) ; \ slot->opslot_size = s; \ slab2->opslab_free_space -= s; \ o = &slot->opslot_op; \ @@ -377,14 +385,16 @@ Perl_Slab_Alloc(pTHX_ size_t sz) /* The partially-filled slab is next in the chain. */ slab2 = head_slab->opslab_next ? head_slab->opslab_next : head_slab; - if (slab2->opslab_free_space < sz) { + if (slab2->opslab_free_space < sz_in_p) { /* Remaining space is too small. */ /* If we can fit a BASEOP, add it to the free chain, so as not to waste it. */ - if (slab2->opslab_free_space >= SIZE_TO_PSIZE(sizeof(OP)) + OPSLOT_HEADER_P) { + if (slab2->opslab_free_space >= OPSLOT_SIZE_BASE) { slot = &slab2->opslab_slots; INIT_OPSLOT(slab2->opslab_free_space); o->op_type = OP_FREED; + DEBUG_S_warn((aTHX_ "linked unused op space at %p, slab %p, head slab %p", + (void *)o, (void *)slab2, (void *)head_slab)); link_freed_op(head_slab, o); } @@ -396,14 +406,12 @@ Perl_Slab_Alloc(pTHX_ size_t sz) slab2->opslab_next = head_slab->opslab_next; head_slab->opslab_next = slab2; } - assert(slab2->opslab_size >= sz); + assert(slab2->opslab_size >= sz_in_p); /* Create a new op slot */ - slot = (OPSLOT *) - ((I32 **)&slab2->opslab_slots - + slab2->opslab_free_space - sz); + slot = OpSLOToff(slab2, slab2->opslab_free_space - sz_in_p); assert(slot >= &slab2->opslab_slots); - INIT_OPSLOT(sz); + INIT_OPSLOT(sz_in_p); DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p, head slab %p", (void*)o, (void*)slab2, (void*)head_slab)); @@ -427,9 +435,9 @@ Perl_Slab_to_ro(pTHX_ OPSLAB *slab) slab->opslab_readonly = 1; for (; slab; slab = slab->opslab_next) { /*DEBUG_U(PerlIO_printf(Perl_debug_log,"mprotect ->ro %lu at %p\n", - (unsigned long) slab->opslab_size, slab));*/ - if (mprotect(slab, slab->opslab_size * sizeof(I32 *), PROT_READ)) - Perl_warn(aTHX_ "mprotect for %p %lu failed with %d", slab, + (unsigned long) slab->opslab_size, (void *)slab));*/ + if (mprotect(slab, OpSLABSizeBytes(slab->opslab_size), PROT_READ)) + Perl_warn(aTHX_ "mprotect for %p %lu failed with %d", (void *)slab, (unsigned long)slab->opslab_size, errno); } } @@ -445,10 +453,10 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab) slab2 = slab; for (; slab2; slab2 = slab2->opslab_next) { /*DEBUG_U(PerlIO_printf(Perl_debug_log,"mprotect ->rw %lu at %p\n", - (unsigned long) size, slab2));*/ - if (mprotect((void *)slab2, slab2->opslab_size * sizeof(I32 *), + (unsigned long) size, (void *)slab2));*/ + if (mprotect((void *)slab2, OpSLABSizeBytes(slab2->opslab_size), PROT_READ|PROT_WRITE)) { - Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d", slab, + Perl_warn(aTHX_ "mprotect RW for %p %lu failed with %d", (void *)slab, (unsigned long)slab2->opslab_size, errno); } } @@ -504,9 +512,7 @@ Perl_Slab_Free(pTHX_ void *op) o->op_type = OP_FREED; link_freed_op(slab, o); DEBUG_S_warn((aTHX_ "freeing op at %p, slab %p, head slab %p", - (void*)o, - (I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset, - (void*)slab)); + (void*)o, (void *)OpMySLAB(o), (void*)slab)); OpslabREFCNT_dec_padok(slab); } @@ -550,7 +556,7 @@ Perl_opslab_free(pTHX_ OPSLAB *slab) #ifdef PERL_DEBUG_READONLY_OPS DEBUG_m(PerlIO_printf(Perl_debug_log, "Deallocate slab at %p\n", (void*)slab)); - if (munmap(slab, slab->opslab_size * sizeof(I32 *))) { + if (munmap(slab, OpSLABSizeBytes(slab->opslab_size))) { perror("munmap failed"); abort(); } @@ -575,10 +581,8 @@ Perl_opslab_force_free(pTHX_ OPSLAB *slab) PERL_ARGS_ASSERT_OPSLAB_FORCE_FREE; slab2 = slab; do { - OPSLOT *slot = (OPSLOT*) - ((I32**)&slab2->opslab_slots + slab2->opslab_free_space); - OPSLOT *end = (OPSLOT*) - ((I32**)slab2 + slab2->opslab_size); + OPSLOT *slot = OpSLOToff(slab2, slab2->opslab_free_space); + OPSLOT *end = OpSLOToff(slab2, slab2->opslab_size); for (; slot < end; slot = (OPSLOT*) ((I32**)slot + slot->opslot_size) ) { @@ -10233,7 +10237,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont) * keep it in-place if there's space */ if (loop->op_slabbed && OpSLOT(loop)->opslot_size - < SIZE_TO_PSIZE(sizeof(LOOP)) + OPSLOT_HEADER_P) + < SIZE_TO_PSIZE(sizeof(LOOP) + OPSLOT_HEADER)) { /* no space; allocate new op */ LOOP *tmp; diff --git a/op.h b/op.h index fc21f03cda41..6e7dc3120f4e 100644 --- a/op.h +++ b/op.h @@ -718,13 +718,18 @@ struct opslab { }; # define OPSLOT_HEADER STRUCT_OFFSET(OPSLOT, opslot_op) -# define OPSLOT_HEADER_P (OPSLOT_HEADER/sizeof(I32 *)) # define OpSLOT(o) (assert_(o->op_slabbed) \ (OPSLOT *)(((char *)o)-OPSLOT_HEADER)) +/* the slab that owns this op */ +# define OpMySLAB(o) \ + ((OPSLAB*)((char *)((I32**)OpSLOT(o) - OpSLOT(o)->opslot_offset)-STRUCT_OFFSET(struct opslab, opslab_slots))) /* 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) + (OpMySLAB(o)->opslab_head) +/* calculate the slot given the owner slab and an offset */ +#define OpSLOToff(slab, offset) \ + ((OPSLOT*)(((I32 **)&(slab)->opslab_slots)+(offset))) # define OpslabREFCNT_dec(slab) \ (((slab)->opslab_refcnt == 1) \