X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=f85fad315a8dd216bebe37c4709a02812345b745;hb=3f6d40bd7fe955329c1f574485922604c74d8097;hp=9523fb0b28d38efd17ad455e55f40a87d8dbb871;hpb=78ac7dd9596fbc525d458adec628f7d991dfe43a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/hv.c b/hv.c
index 9523fb0..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;
@@ -350,9 +363,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		SV* obj = mg->mg_obj;
 
 		if (!keysv) {
-		    keysv = sv_2mortal(newSVpvn(key, klen));
-		    if (flags & HVhek_UTF8)
-			SvUTF8_on(keysv);
+		    keysv = newSVpvn_flags(key, klen, SVs_TEMP |
+					   ((flags & HVhek_UTF8)
+					    ? SVf_UTF8 : 0));
 		}
 		
 		mg->mg_obj = keysv;         /* pass key */
@@ -391,11 +404,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		/* FIXME should be able to skimp on the HE/HEK here when
 		   HV_FETCH_JUST_SV is true.  */
 		if (!keysv) {
-		    keysv = newSVpvn(key, klen);
-		    if (is_utf8) {
-			SvUTF8_on(keysv);
-		    }
-		} else {
+		    keysv = newSVpvn_utf8(key, klen, is_utf8);
+  		} else {
 		    keysv = newSVsv(keysv);
 		}
                 sv = sv_newmortal();
@@ -472,8 +482,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
 		if (keysv || is_utf8) {
 		    if (!keysv) {
-			keysv = newSVpvn(key, klen);
-			SvUTF8_on(keysv);
+			keysv = newSVpvn_utf8(key, klen, TRUE);
 		    } else {
 			keysv = newSVsv(keysv);
 		    }
@@ -515,8 +524,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 		const bool save_taint = PL_tainted;
 		if (keysv || is_utf8) {
 		    if (!keysv) {
-			keysv = newSVpvn(key, klen);
-			SvUTF8_on(keysv);
+			keysv = newSVpvn_utf8(key, klen, TRUE);
 		    }
 		    if (PL_tainting)
 			PL_tainted = SvTAINTED(keysv);
@@ -819,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) {
@@ -846,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)
@@ -919,7 +932,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #ifdef ENV_IS_CASELESS
 		else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
 		    /* XXX This code isn't UTF8 clean.  */
-		    keysv = sv_2mortal(newSVpvn(key,klen));
+		    keysv = newSVpvn_flags(key, klen, SVs_TEMP);
 		    if (k_flags & HVhek_FREEKEY) {
 			Safefree(key);
 		    }
@@ -1059,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);*/
 
@@ -1228,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;
@@ -1423,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);
@@ -1444,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  */
@@ -1535,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);
 }
@@ -1545,6 +1569,8 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
     dVAR;
     I32 i;
 
+    PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
+
     if (items == 0)
 	return;
 
@@ -1592,6 +1618,8 @@ S_hfreeentries(pTHX_ HV *hv)
     HEK *name;
     int attempts = 100;
 
+    PERL_ARGS_ASSERT_HFREEENTRIES;
+
     if (!orig_array)
 	return;
 
@@ -1772,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);
@@ -1811,6 +1841,10 @@ value, you can get it through the macro C<HvFILL(tb)>.
 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");
 
@@ -1835,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");
 
@@ -1846,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");
 
@@ -1857,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");
 
@@ -1875,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");
 
@@ -1898,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)
@@ -1921,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);
 }
 
@@ -1929,6 +1975,8 @@ void
 Perl_hv_kill_backrefs(pTHX_ HV *hv) {
     AV *av;
 
+    PERL_ARGS_ASSERT_HV_KILL_BACKREFS;
+
     if (!SvOOK(hv))
 	return;
 
@@ -1979,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");
 
@@ -2103,6 +2153,8 @@ C<hv_iterinit>.
 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);
@@ -2129,6 +2181,8 @@ see C<hv_iterinit>.
 SV *
 Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
+    PERL_ARGS_ASSERT_HV_ITERKEYSV;
+
     return sv_2mortal(newSVhek(HeKEY_hek(entry)));
 }
 
@@ -2144,6 +2198,8 @@ C<hv_iterkey>.
 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();
@@ -2171,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);
@@ -2317,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;
@@ -2344,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:
 
@@ -2353,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];
@@ -2427,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);
 
@@ -2444,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;
 }
 
@@ -2453,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) {
@@ -2467,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);
@@ -2828,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))) {