In perl.git, the branch smoke-me/nicholas/merge-hv-split has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/34d6d453862a4b2db2b03735dbe1083b9b659d24?hp=e739c653b69150d3bbe873918ad5c265e6a421a7>
- Log -----------------------------------------------------------------
commit 34d6d453862a4b2db2b03735dbe1083b9b659d24
Author: Nicholas Clark <n...@ccl4.org>
Date: Thu Feb 21 20:22:32 2013 +0100
Replace the bulk of Perl_hv_ksplit() with a call to S_hsplit().
The code duplication that introduced hv_ksplit() as a fork of hsplit() back
with commit 72940dca186befa0 in Sept 1996 is finally healed.
M hv.c
commit 7ac6e4dfb86b97a7c9bd86e5d84896dc8b5e58d6
Author: Nicholas Clark <n...@ccl4.org>
Date: Thu Feb 21 19:58:04 2013 +0100
Tweak S_hsplit() to return early if there are no keys to process.
This mimics the behaviour in Perl_hv_ksplit().
Also remove a vestigial comment. The code it relates to was removed in
commit 7dc8663964c66a69 in Nov 2012.
M hv.c
commit dd235a0e94133556bc908a1699012b0f7382a000
Author: Nicholas Clark <n...@ccl4.org>
Date: Thu Feb 21 19:45:38 2013 +0100
Pass the current and desired hash sizes to S_hsplit().
Whilst this is slightly more work for its existing two callers, it will
permit Perl_hv_ksplit() to also call it.
Use STRLEN for the parameters, and change a local variable from I32 to
STRLEN to match.
M embed.fnc
M embed.h
M hv.c
M proto.h
commit c9ac69a29b25875725d5353196df0a8a9a39ae47
Author: Nicholas Clark <n...@ccl4.org>
Date: Thu Feb 21 19:16:44 2013 +0100
Move the code handling allocating a new buffer earlier in Perl_hv_ksplit().
This makes the rest of the code of Perl_hv_ksplit() closer to that of
S_hsplit().
M hv.c
commit 670b9fb476b153cacbe90a8c4fb173fad1f3dfc3
Author: Nicholas Clark <n...@ccl4.org>
Date: Thu Feb 21 17:22:23 2013 +0100
Refactor the loop logic in S_hsplit() and Perl_hv_ksplit() to converge.
Making the code as similar as possible will make it simpler to merge the
two.
M hv.c
commit 74df1c4c6ad1725eef9532008f624fd968a66f6c
Author: Nicholas Clark <n...@ccl4.org>
Date: Thu Feb 21 17:09:29 2013 +0100
Move the call to hv_clear_placeholders() from hsplit() to hv_common().
The relevant code calls Perl_hv_clear_placeholders() at split time, if there
are still placeholders left over from a (previously) restricted hash.
There are two callers to S_hsplit(), one from the regular HV code, and one
from the shared string table code. As the shared string table can't contain
placeholders, only the other call site could trigger this condition, so move
the code there. This simplifies S_hsplit(), and will make splitting the
shared string table marginally faster.
M hv.c
commit e6e332addf4d7c600618ce70fe495008cc1a3b21
Author: Nicholas Clark <n...@ccl4.org>
Date: Wed Feb 20 21:38:33 2013 +0100
Abolish STRANGE_MALLOC. Now all malloc()s are considered strange :-)
STRANGE_MALLOC was added in 5.002 beta 1 (4633a7c4bad06b47) as part of an
work around for typical mallocs, which had a bad interaction with perl's
allocation needs. Specifically, repeatedly extending an array and then
creating SV heads (such as when reading lines of a file into an array)
could end up with each reallocation for the array being unable to extend in
place, needing a fresh chunk of memory, and the released memory not being
suitable for use as more SV heads, so sitting unused. The solution was for
perl to recycle the old array body as SV heads, instead of returning it to
the system, passing the memory from the the AV code to the SV code using
offer_nice_chunk(), PL_nice_chunk and PL_nice_chunk_size.
STRANGE_MALLOC was actually a signal that the malloc() didn't need
protecting from itself, and to disable the work around.
offer_nice_chunk(), PL_nice_chunk and PL_nice_chunk_size were removed by
commit 9a87bd09eea1d037 in Nov 2010, without any ill effects, hence the
code used when STRANGE_MALLOC was *not* defined is essentially doing extra
work for no benefits.
From the lack of problems reported, one can assume that in the intervening
15 years malloc technology has got significantly improved, and it is
probably
better to be honest with it, rather than trying to second guess it.
Hence remove all the non-STRANGE_MALLOC code, and leave everyone using the
much simpler code. See also
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2005-11/msg00495.html
http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2013-01/msg00126.html
M av.c
M hv.c
-----------------------------------------------------------------------
Summary of changes:
av.c | 21 ----------
embed.fnc | 2 +-
embed.h | 2 +-
hv.c | 133 ++++++++++++++++---------------------------------------------
proto.h | 2 +-
5 files changed, 37 insertions(+), 123 deletions(-)
diff --git a/av.c b/av.c
index 3041cd2..44b5fbc 100644
--- a/av.c
+++ b/av.c
@@ -119,10 +119,6 @@ Perl_av_extend_guts(pTHX_ AV *av, I32 key, SSize_t *maxp,
SV ***allocp,
#endif
if (*allocp) {
-#if !defined(STRANGE_MALLOC) && !defined(MYMALLOC)
- MEM_SIZE bytes;
- IV itmp;
-#endif
#ifdef Perl_safesysmalloc_size
/* Whilst it would be quite possible to move this logic around
@@ -147,24 +143,7 @@ Perl_av_extend_guts(pTHX_ AV *av, I32 key, SSize_t *maxp,
SV ***allocp,
newmax = key + *maxp / 5;
resize:
MEM_WRAP_CHECK_1(newmax+1, SV*, oom_array_extend);
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
Renew(*allocp,newmax+1, SV*);
-#else
- bytes = (newmax + 1) * sizeof(const SV *);
-#define MALLOC_OVERHEAD 16
- itmp = MALLOC_OVERHEAD;
- while ((MEM_SIZE)(itmp - MALLOC_OVERHEAD) < bytes)
- itmp += itmp;
- itmp -= MALLOC_OVERHEAD;
- itmp /= sizeof(const SV *);
- assert(itmp > newmax);
- newmax = itmp - 1;
- assert(newmax >= *maxp);
- Newx(ary, newmax+1, SV*);
- Copy(*allocp, ary, *maxp+1, SV*);
- Safefree(*allocp);
- *allocp = ary;
-#endif
#ifdef Perl_safesysmalloc_size
resized:
#endif
diff --git a/embed.fnc b/embed.fnc
index a288c5a..c9832d4 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1769,7 +1769,7 @@ po |SV* |hfree_next_entry |NN HV *hv|NN
STRLEN *indexp
#endif
#if defined(PERL_IN_HV_C)
-s |void |hsplit |NN HV *hv
+s |void |hsplit |NN HV *hv|STRLEN const oldsize|STRLEN newsize
s |void |hfreeentries |NN HV *hv
s |SV* |hv_free_ent_ret|NN HV *hv|NN HE *entry
sa |HE* |new_he
diff --git a/embed.h b/embed.h
index c66eba9..9654979 100644
--- a/embed.h
+++ b/embed.h
@@ -1375,7 +1375,7 @@
# if defined(PERL_IN_HV_C)
#define clear_placeholders(a,b) S_clear_placeholders(aTHX_ a,b)
#define hfreeentries(a) S_hfreeentries(aTHX_ a)
-#define hsplit(a) S_hsplit(aTHX_ a)
+#define hsplit(a,b,c) S_hsplit(aTHX_ a,b,c)
#define hv_auxinit S_hv_auxinit
#define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_
a,b,c,d,e,f,g)
#define hv_free_ent_ret(a,b) S_hv_free_ent_ret(aTHX_ a,b)
diff --git a/hv.c b/hv.c
index 5f7ae85..9d619d0 100644
--- a/hv.c
+++ b/hv.c
@@ -796,7 +796,19 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key,
STRLEN klen,
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if ( DO_HSPLIT(xhv) ) {
- hsplit(hv);
+ const STRLEN oldsize = xhv->xhv_max + 1;
+
+ /* This logic was in S_hsplit, but as the shared string table can't
+ contain placeholders, and we are the only other caller of S_hsplit,
+ it could only trigger from this callsite. So move it here. */
+ if (HvPLACEHOLDERS_get(hv) && !SvREADONLY(hv)) {
+ /* Can make this clear any placeholders first for non-restricted
+ hashes, even though Storable rebuilds restricted hashes by
+ putting in all the placeholders (first) before turning on the
+ readonly flag, because Storable always pre-splits the hash. */
+ hv_clear_placeholders(hv);
+ }
+ hsplit(hv, oldsize, oldsize * 2);
}
if (return_svp) {
@@ -1085,13 +1097,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char
*key, STRLEN klen,
}
STATIC void
-S_hsplit(pTHX_ HV *hv)
+S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
{
dVAR;
- XPVHV* const xhv = (XPVHV*)SvANY(hv);
- const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
- I32 newsize = oldsize * 2;
- I32 i;
+ STRLEN i;
char *a = (char*) HvARRAY(hv);
HE **aep;
@@ -1100,16 +1109,7 @@ S_hsplit(pTHX_ HV *hv)
/*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n",
(void*)hv, (int) oldsize);*/
- if (HvPLACEHOLDERS_get(hv) && !SvREADONLY(hv)) {
- /* Can make this clear any placeholders first for non-restricted hashes,
- even though Storable rebuilds restricted hashes by putting in all the
- placeholders (first) before turning on the readonly flag, because
- Storable always pre-splits the hash. */
- hv_clear_placeholders(hv);
- }
-
PL_nomemok = TRUE;
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
if (!a) {
@@ -1119,48 +1119,34 @@ S_hsplit(pTHX_ HV *hv)
if (SvOOK(hv)) {
Move(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct
xpvhv_aux);
}
-#else
- Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
- if (!a) {
- PL_nomemok = FALSE;
- return;
- }
- Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
- Safefree(HvARRAY(hv));
-#endif
PL_nomemok = FALSE;
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);
/* zero 2nd half*/
- xhv->xhv_max = --newsize; /* HvMAX(hv) = --newsize */
+ HvMAX(hv) = --newsize;
HvARRAY(hv) = (HE**) a;
- aep = (HE**)a;
- for (i=0; i<oldsize; i++,aep++) {
- HE **oentry = aep;
- HE *entry = *aep;
- HE **bep;
+ if (!HvTOTALKEYS(hv)) /* skip rest if no entries */
+ return;
+
+ aep = (HE**)a;
+ for (i=0; i<oldsize; i++) {
+ HE **oentry = aep + i;
+ HE *entry = aep[i];
if (!entry) /* non-existent */
continue;
- bep = aep+oldsize;
do {
- if ((HeHASH(entry) & newsize) != (U32)i) {
+ U32 j = (HeHASH(entry) & newsize);
+ if (j != (U32)i) {
*oentry = HeNEXT(entry);
- HeNEXT(entry) = *bep;
- *bep = entry;
+ HeNEXT(entry) = aep[j];
+ aep[j] = entry;
}
else {
oentry = &HeNEXT(entry);
}
entry = *oentry;
} while (entry);
- /* I think we don't actually need to keep track of the longest length,
- merely flag if anything is too long. But for the moment while
- developing this code I'll track it. */
}
}
@@ -1171,9 +1157,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
XPVHV* xhv = (XPVHV*)SvANY(hv);
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
I32 newsize;
- I32 i;
char *a;
- HE **aep;
PERL_ARGS_ASSERT_HV_KSPLIT;
@@ -1190,61 +1174,11 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
a = (char *) HvARRAY(hv);
if (a) {
- PL_nomemok = TRUE;
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
- Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
- if (!a) {
- PL_nomemok = FALSE;
- return;
- }
- if (SvOOK(hv)) {
- Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1,
struct xpvhv_aux);
- }
-#else
- Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
- + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
- if (!a) {
- PL_nomemok = FALSE;
- return;
- }
- Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
- if (SvOOK(hv)) {
- Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
- }
- Safefree(HvARRAY(hv));
-#endif
- PL_nomemok = FALSE;
- Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char);
/* zero 2nd half*/
- }
- else {
- Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
- }
- xhv->xhv_max = --newsize; /* HvMAX(hv) = --newsize */
- HvARRAY(hv) = (HE **) a;
- if (!xhv->xhv_keys /* !HvTOTALKEYS(hv) */) /* skip rest if no entries */
- return;
-
- aep = (HE**)a;
- for (i=0; i<oldsize; i++,aep++) {
- HE **oentry = aep;
- HE *entry = *aep;
-
- if (!entry) /* non-existent */
- continue;
- do {
- I32 j = (HeHASH(entry) & newsize);
-
- if (j != i) {
- j -= i;
- *oentry = HeNEXT(entry);
- HeNEXT(entry) = aep[j];
- aep[j] = entry;
- }
- else
- oentry = &HeNEXT(entry);
- entry = *oentry;
- } while (entry);
+ hsplit(hv, oldsize, newsize);
+ } else {
+ Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+ xhv->xhv_max = --newsize;
+ HvARRAY(hv) = (HE **) a;
}
}
@@ -2696,7 +2630,8 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, U32
hash, int flags)
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
if (!next) { /* initial entry? */
} else if ( DO_HSPLIT(xhv) ) {
- hsplit(PL_strtab);
+ const STRLEN oldsize = xhv->xhv_max + 1;
+ hsplit(PL_strtab, oldsize, oldsize * 2);
}
}
diff --git a/proto.h b/proto.h
index 18f46cc..9192960 100644
--- a/proto.h
+++ b/proto.h
@@ -5701,7 +5701,7 @@ STATIC void S_hfreeentries(pTHX_ HV *hv)
#define PERL_ARGS_ASSERT_HFREEENTRIES \
assert(hv)
-STATIC void S_hsplit(pTHX_ HV *hv)
+STATIC void S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_HSPLIT \
assert(hv)
--
Perl5 Master Repository
