diff options
| -rw-r--r-- | perl.h | 6 | ||||
| -rw-r--r-- | sv.c | 100 | ||||
| -rw-r--r-- | sv.h | 10 |
3 files changed, 52 insertions, 64 deletions
@@ -3453,9 +3453,6 @@ typedef struct magic_state MGS; /* struct magic_state defined in mg.c */ struct scan_data_t; /* Used in S_* functions in regcomp.c */ struct regnode_charclass_class; /* Used in S_* functions in regcomp.c */ -/* Keep next first in this structure, because sv_free_arenas take - advantage of this to share code between the pte arenas and the SV - body arenas */ struct ptr_tbl_ent { struct ptr_tbl_ent* next; const void* oldval; @@ -3466,6 +3463,9 @@ struct ptr_tbl { struct ptr_tbl_ent** tbl_ary; UV tbl_max; UV tbl_items; + struct ptr_tbl_arena *tbl_arena; + struct ptr_tbl_ent *tbl_arena_next; + struct ptr_tbl_ent *tbl_arena_end; }; #if defined(iAPX286) || defined(M_I286) || defined(I80286) @@ -689,7 +689,6 @@ Perl_sv_free_arenas(pTHX) 2. regular body arenas 3. arenas for reduced-size bodies 4. Hash-Entry arenas - 5. pte arenas (thread related) Arena types 2 & 3 are chained by body-type off an array of arena-root pointers, which is indexed by svtype. Some of the @@ -708,12 +707,6 @@ Perl_sv_free_arenas(pTHX) HE, HEK arenas are managed separately, with separate code, but may be merge-able later.. - - PTE arenas are not sv-bodies, but they share these mid-level - mechanics, so are considered here. The new mid-level mechanics rely - on the sv_type of the body being allocated, so we just reserve one - of the unused body-slots for PTEs, then use it in those (2) PTE - contexts below (line ~10k) */ /* get_arena(size): this creates custom-sized arenas @@ -852,13 +845,6 @@ PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the bodies_by_type[SVt_NULL] slot is not used, as the table is not available in hv.c. -PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless, -they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can -just use the same allocation semantics. At first, PTEs were also -overloaded to a non-body sv-type, but this yielded hard-to-find malloc -bugs, so was simplified by claiming a new slot. This choice has no -consequence at this time. - */ struct body_details { @@ -921,14 +907,11 @@ static const struct body_details bodies_by_type[] = { implemented. */ { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 }, - /* IVs are in the head, so the allocation size is 0. - However, the slot is overloaded for PTEs. */ - { sizeof(struct ptr_tbl_ent), /* This is used for PTEs. */ + /* IVs are in the head, so the allocation size is 0. */ + { 0, sizeof(IV), /* This is used to copy out the IV body. */ STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV, - NOARENA /* IVS don't need an arena */, - /* But PTEs need to know the size of their arena */ - FIT_ARENA(0, sizeof(struct ptr_tbl_ent)) + NOARENA /* IVS don't need an arena */, 0 }, /* 8 bytes on most ILP32 with IEEE doubles */ @@ -1455,7 +1438,7 @@ Perl_sv_upgrade(pTHX_ register SV *const sv, svtype new_type) (unsigned long)new_type); } - if (old_type > SVt_IV) { /* SVt_IVs are overloaded for PTEs */ + if (old_type > SVt_IV) { #ifdef PURIFY my_safefree(old_body); #else @@ -5676,15 +5659,9 @@ Perl_sv_clear(pTHX_ register SV *const sv) if (type <= SVt_IV) { /* See the comment in sv.h about the collusion between this early - return and the overloading of the NULL and IV slots in the size - table. */ - if (SvROK(sv)) { - SV * const target = SvRV(sv); - if (SvWEAKREF(sv)) - sv_del_backref(target, sv); - else - SvREFCNT_dec(target); - } + return and the overloading of the NULL slots in the size table. */ + if (SvROK(sv)) + goto free_rv; SvFLAGS(sv) &= SVf_BREAK; SvFLAGS(sv) |= SVTYPEMASK; return; @@ -5836,11 +5813,14 @@ Perl_sv_clear(pTHX_ register SV *const sv) /* Don't even bother with turning off the OOK flag. */ } if (SvROK(sv)) { - SV * const target = SvRV(sv); - if (SvWEAKREF(sv)) - sv_del_backref(target, sv); - else - SvREFCNT_dec(target); + free_rv: + { + SV * const target = SvRV(sv); + if (SvWEAKREF(sv)) + sv_del_backref(target, sv); + else + SvREFCNT_dec(target); + } } #ifdef PERL_OLD_COPY_ON_WRITE else if (SvPVX_const(sv)) { @@ -10737,6 +10717,11 @@ Perl_mg_dup(pTHX_ MAGIC *mg, CLONE_PARAMS *const param) #endif /* USE_ITHREADS */ +struct ptr_tbl_arena { + struct ptr_tbl_arena *next; + struct ptr_tbl_ent array[1023/3]; /* as ptr_tbl_ent has 3 pointers. */ +}; + /* create a new pointer-mapping table */ PTR_TBL_t * @@ -10748,6 +10733,9 @@ Perl_ptr_table_new(pTHX) Newx(tbl, 1, PTR_TBL_t); tbl->tbl_max = 511; tbl->tbl_items = 0; + tbl->tbl_arena = NULL; + tbl->tbl_arena_next = NULL; + tbl->tbl_arena_end = NULL; Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*); return tbl; } @@ -10755,14 +10743,6 @@ Perl_ptr_table_new(pTHX) #define PTR_TABLE_HASH(ptr) \ ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17))) -/* - we use the PTE_SVSLOT 'reservation' made above, both here (in the - following define) and at call to new_body_inline made below in - Perl_ptr_table_store() - */ - -#define del_pte(p) del_body_type(p, PTE_SVSLOT) - /* map an existing pointer using a table */ STATIC PTR_TBL_ENT_t * @@ -10807,7 +10787,18 @@ Perl_ptr_table_store(pTHX_ PTR_TBL_t *const tbl, const void *const oldsv, void * } else { const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max; - new_body_inline(tblent, PTE_SVSLOT); + if (tbl->tbl_arena_next == tbl->tbl_arena_end) { + struct ptr_tbl_arena *new_arena; + + Newx(new_arena, 1, struct ptr_tbl_arena); + new_arena->next = tbl->tbl_arena; + tbl->tbl_arena = new_arena; + tbl->tbl_arena_next = new_arena->array; + tbl->tbl_arena_end = new_arena->array + + sizeof(new_arena->array) / sizeof(new_arena->array[0]); + } + + tblent = tbl->tbl_arena_next++; tblent->oldval = oldsv; tblent->newval = newsv; @@ -10860,20 +10851,21 @@ void Perl_ptr_table_clear(pTHX_ PTR_TBL_t *const tbl) { if (tbl && tbl->tbl_items) { - register PTR_TBL_ENT_t * const * const array = tbl->tbl_ary; - UV riter = tbl->tbl_max; + struct ptr_tbl_arena *arena = tbl->tbl_arena; - do { - PTR_TBL_ENT_t *entry = array[riter]; + Zero(tbl->tbl_ary, tbl->tbl_max + 1, struct ptr_tbl_ent **); - while (entry) { - PTR_TBL_ENT_t * const oentry = entry; - entry = entry->next; - del_pte(oentry); - } - } while (riter--); + while (arena) { + struct ptr_tbl_arena *next = arena->next; + + Safefree(arena); + arena = next; + }; tbl->tbl_items = 0; + tbl->tbl_arena = NULL; + tbl->tbl_arena_next = NULL; + tbl->tbl_arena_end = NULL; } } @@ -76,13 +76,9 @@ typedef enum { #endif /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL - and SVt_IV, so never reaches the clause at the end that uses - sv_type_details->body_size to determine whether to call safefree(). Hence - body_size can be set no-zero to record the size of PTEs and HEs, without - fear of bogus frees. */ -#ifdef PERL_IN_SV_C -#define PTE_SVSLOT SVt_IV -#endif + so never reaches the clause at the end that uses sv_type_details->body_size + to determine whether to call safefree(). Hence body_size can be set + non-zero to record the size of HEs, without fear of bogus frees. */ #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST) #define HE_SVSLOT SVt_NULL #endif |