X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=f85fad315a8dd216bebe37c4709a02812345b745;hb=3f6d40bd7fe955329c1f574485922604c74d8097;hp=f0d803332929089da3eb3f024dc85fc1fa2a7236;hpb=59cd0e26eb6c10499b25d783562357dd68cc16f2;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index f0d8033..f85fad3 100644 --- a/hv.c +++ b/hv.c @@ -40,8 +40,11 @@ STATIC void S_more_he(pTHX) { dVAR; - HE* he = (HE*) Perl_get_arena(aTHX_ PERL_ARENA_SIZE, HE_SVSLOT); - HE * const heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1]; + /* We could generate this at compile time via (another) auxiliary C + program? */ + const size_t arena_size = Perl_malloc_good_size(PERL_ARENA_SIZE); + HE* he = (HE*) Perl_get_arena(aTHX_ arena_size, HE_SVSLOT); + HE * const heend = &he[arena_size / sizeof(HE) - 1]; PL_body_roots[HE_SVSLOT] = he; while (he < heend) { @@ -91,6 +94,8 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags) char *k; register HEK *hek; + PERL_ARGS_ASSERT_SAVE_HEK_FLAGS; + Newx(k, HEK_BASESIZE + len + 2, char); hek = (HEK*)k; Copy(str, HEK_KEY(hek), len, char); @@ -127,6 +132,7 @@ Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) { HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); + PERL_ARGS_ASSERT_HEK_DUP; PERL_UNUSED_ARG(param); if (shared) { @@ -147,6 +153,8 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) { HE *ret; + PERL_ARGS_ASSERT_HE_DUP; + if (!e) return NULL; /* look for it in the table first */ @@ -196,6 +204,9 @@ S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, const char *msg) { SV * const sv = sv_newmortal(); + + PERL_ARGS_ASSERT_HV_NOTALLOWED; + if (!(flags & HVhek_FREEKEY)) { sv_setpvn(sv, key, klen); } @@ -312,6 +323,8 @@ Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, STRLEN klen; int flags; + PERL_ARGS_ASSERT_HV_COMMON_KEY_LEN; + if (klen_i32 < 0) { klen = -klen_i32; flags = HVhek_UTF8; @@ -814,6 +827,9 @@ STATIC void S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store) { const MAGIC *mg = SvMAGIC(hv); + + PERL_ARGS_ASSERT_HV_MAGIC_CHECK; + *needs_copy = FALSE; *needs_store = TRUE; while (mg) { @@ -841,6 +857,8 @@ Perl_hv_scalar(pTHX_ HV *hv) { SV *sv; + PERL_ARGS_ASSERT_HV_SCALAR; + if (SvRMAGICAL(hv)) { MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied); if (mg) @@ -1054,6 +1072,8 @@ S_hsplit(pTHX_ HV *hv) int longest_chain = 0; int was_shared; + PERL_ARGS_ASSERT_HSPLIT; + /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n", (void*)hv, (int) oldsize);*/ @@ -1223,6 +1243,8 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) register HE *entry; register HE **oentry; + PERL_ARGS_ASSERT_HV_KSPLIT; + newsize = (I32) newmax; /* possible truncation here */ if (newsize != newmax || newmax <= oldsize) return; @@ -1418,6 +1440,8 @@ Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry) dVAR; SV *val; + PERL_ARGS_ASSERT_HV_FREE_ENT; + if (!entry) return; val = HeVAL(entry); @@ -1439,6 +1463,9 @@ void Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry) { dVAR; + + PERL_ARGS_ASSERT_HV_DELAYFREE_ENT; + if (!entry) return; /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */ @@ -1530,6 +1557,8 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv) dVAR; const U32 items = (U32)HvPLACEHOLDERS_get(hv); + PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS; + if (items) clear_placeholders(hv, items); } @@ -1540,6 +1569,8 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items) dVAR; I32 i; + PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS; + if (items == 0) return; @@ -1587,6 +1618,8 @@ S_hfreeentries(pTHX_ HV *hv) HEK *name; int attempts = 100; + PERL_ARGS_ASSERT_HFREEENTRIES; + if (!orig_array) return; @@ -1767,6 +1800,8 @@ S_hv_auxinit(HV *hv) { struct xpvhv_aux *iter; char *array; + PERL_ARGS_ASSERT_HV_AUXINIT; + if (!HvARRAY(hv)) { Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1) + sizeof(struct xpvhv_aux), char); @@ -1806,6 +1841,10 @@ value, you can get it through the macro C. I32 Perl_hv_iterinit(pTHX_ HV *hv) { + PERL_ARGS_ASSERT_HV_ITERINIT; + + /* FIXME: Are we not NULL, or do we croak? Place bets now! */ + if (!hv) Perl_croak(aTHX_ "Bad hash"); @@ -1830,6 +1869,8 @@ I32 * Perl_hv_riter_p(pTHX_ HV *hv) { struct xpvhv_aux *iter; + PERL_ARGS_ASSERT_HV_RITER_P; + if (!hv) Perl_croak(aTHX_ "Bad hash"); @@ -1841,6 +1882,8 @@ HE ** Perl_hv_eiter_p(pTHX_ HV *hv) { struct xpvhv_aux *iter; + PERL_ARGS_ASSERT_HV_EITER_P; + if (!hv) Perl_croak(aTHX_ "Bad hash"); @@ -1852,6 +1895,8 @@ void Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) { struct xpvhv_aux *iter; + PERL_ARGS_ASSERT_HV_RITER_SET; + if (!hv) Perl_croak(aTHX_ "Bad hash"); @@ -1870,6 +1915,8 @@ void Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) { struct xpvhv_aux *iter; + PERL_ARGS_ASSERT_HV_EITER_SET; + if (!hv) Perl_croak(aTHX_ "Bad hash"); @@ -1893,6 +1940,7 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) struct xpvhv_aux *iter; U32 hash; + PERL_ARGS_ASSERT_HV_NAME_SET; PERL_UNUSED_ARG(flags); if (len > I32_MAX) @@ -1916,7 +1964,10 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) AV ** Perl_hv_backreferences_p(pTHX_ HV *hv) { struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); + + PERL_ARGS_ASSERT_HV_BACKREFERENCES_P; PERL_UNUSED_CONTEXT; + return &(iter->xhv_backreferences); } @@ -1924,6 +1975,8 @@ void Perl_hv_kill_backrefs(pTHX_ HV *hv) { AV *av; + PERL_ARGS_ASSERT_HV_KILL_BACKREFS; + if (!SvOOK(hv)) return; @@ -1974,6 +2027,8 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) MAGIC* mg; struct xpvhv_aux *iter; + PERL_ARGS_ASSERT_HV_ITERNEXT_FLAGS; + if (!hv) Perl_croak(aTHX_ "Bad hash"); @@ -2098,6 +2153,8 @@ C. char * Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen) { + PERL_ARGS_ASSERT_HV_ITERKEY; + if (HeKLEN(entry) == HEf_SVKEY) { STRLEN len; char * const p = SvPV(HeKEY_sv(entry), len); @@ -2124,6 +2181,8 @@ see C. SV * Perl_hv_iterkeysv(pTHX_ register HE *entry) { + PERL_ARGS_ASSERT_HV_ITERKEYSV; + return sv_2mortal(newSVhek(HeKEY_hek(entry))); } @@ -2139,6 +2198,8 @@ C. SV * Perl_hv_iterval(pTHX_ HV *hv, register HE *entry) { + PERL_ARGS_ASSERT_HV_ITERVAL; + if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv, PERL_MAGIC_tied)) { SV* const sv = sv_newmortal(); @@ -2166,6 +2227,8 @@ Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen) { HE * const he = hv_iternext_flags(hv, 0); + PERL_ARGS_ASSERT_HV_ITERNEXTSV; + if (!he) return NULL; *key = hv_iterkey(he, retlen); @@ -2312,6 +2375,8 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash) int flags = 0; const char * const save = str; + PERL_ARGS_ASSERT_SHARE_HEK; + if (len < 0) { STRLEN tmplen = -len; is_utf8 = TRUE; @@ -2339,6 +2404,9 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) register HE *entry; const int flags_masked = flags & HVhek_MASK; const U32 hindex = hash & (I32) HvMAX(PL_strtab); + register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab); + + PERL_ARGS_ASSERT_SHARE_HEK_FLAGS; /* what follows is the moral equivalent of: @@ -2348,7 +2416,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags) Can't rehash the shared string table, so not sure if it's worth counting the number of entries in the linked list */ - register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab); + /* assert(xhv_array != 0) */ LOCK_STRTAB_MUTEX; entry = (HvARRAY(PL_strtab))[hindex]; @@ -2422,6 +2490,8 @@ Perl_hv_placeholders_p(pTHX_ HV *hv) dVAR; MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash); + PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P; + if (!mg) { mg = sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, 0); @@ -2439,6 +2509,8 @@ Perl_hv_placeholders_get(pTHX_ HV *hv) dVAR; MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash); + PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET; + return mg ? mg->mg_len : 0; } @@ -2448,6 +2520,8 @@ Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph) dVAR; MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_rhash); + PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET; + if (mg) { mg->mg_len = ph; } else if (ph) { @@ -2462,6 +2536,9 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) { dVAR; SV *value; + + PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE; + switch(he->refcounted_he_data[0] & HVrhek_typemask) { case HVrhek_undef: value = newSV(0); @@ -2823,6 +2900,8 @@ Perl_hv_assert(pTHX_ HV *hv) const I32 riter = HvRITER_get(hv); HE *eiter = HvEITER_get(hv); + PERL_ARGS_ASSERT_HV_ASSERT; + (void)hv_iterinit(hv); while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) {