#define HV_MAX_LENGTH_BEFORE_SPLIT 14
-static const char *const S_strtab_error
+static const char S_strtab_error[]
= "Cannot modify shared string table in hv_%s";
STATIC void
{
HE* he;
HE* heend;
- New(54, he, PERL_ARENA_SIZE/sizeof(HE), HE);
- HeNEXT(he) = PL_he_arenaroot;
- PL_he_arenaroot = he;
+ Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
+ HeNEXT(he) = (HE*) PL_body_arenaroots[HE_SVSLOT];
+ PL_body_arenaroots[HE_SVSLOT] = he;
heend = &he[PERL_ARENA_SIZE / sizeof(HE) - 1];
- PL_he_root = ++he;
+ PL_body_roots[HE_SVSLOT] = ++he;
while (he < heend) {
HeNEXT(he) = (HE*)(he + 1);
he++;
HeNEXT(he) = 0;
}
+#ifdef PURIFY
+
+#define new_HE() (HE*)safemalloc(sizeof(HE))
+#define del_HE(p) safefree((char*)p)
+
+#else
+
STATIC HE*
S_new_he(pTHX)
{
HE* he;
+ void **root = &PL_body_roots[HE_SVSLOT];
+
LOCK_SV_MUTEX;
- if (!PL_he_root)
+ if (!*root)
S_more_he(aTHX);
- he = PL_he_root;
- PL_he_root = HeNEXT(he);
+ he = *root;
+ *root = HeNEXT(he);
UNLOCK_SV_MUTEX;
return he;
}
-STATIC void
-S_del_he(pTHX_ HE *p)
-{
- LOCK_SV_MUTEX;
- HeNEXT(p) = (HE*)PL_he_root;
- PL_he_root = p;
- UNLOCK_SV_MUTEX;
-}
-
-#ifdef PURIFY
-
-#define new_HE() (HE*)safemalloc(sizeof(HE))
-#define del_HE(p) safefree((char*)p)
+#define new_HE() new_he()
+#define del_HE(p) \
+ STMT_START { \
+ LOCK_SV_MUTEX; \
+ HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \
+ PL_body_roots[HE_SVSLOT] = p; \
+ UNLOCK_SV_MUTEX; \
+ } STMT_END
-#else
-#define new_HE() new_he()
-#define del_HE(p) del_he(p)
#endif
char *k;
register HEK *hek;
- New(54, k, HEK_BASESIZE + len + 2, char);
+ Newx(k, HEK_BASESIZE + len + 2, char);
hek = (HEK*)k;
Copy(str, HEK_KEY(hek), len, char);
HEK_KEY(hek)[len] = 0;
return hek;
}
-/* free the pool of temporary HE/HEK pairs retunrned by hv_fetch_ent
+/* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent
* for tied hashes */
void
}
HE *
-Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
+Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
{
HE *ret;
HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
if (HeKLEN(e) == HEf_SVKEY) {
char *k;
- New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ Newx(k, HEK_BASESIZE + sizeof(SV*), char);
HeKEY_hek(ret) = (HEK*)k;
HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
}
else {
char *k;
entry = new_HE();
- New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ Newx(k, HEK_BASESIZE + sizeof(SV*), char);
HeKEY_hek(entry) = (HEK*)k;
}
HeNEXT(entry) = Nullhe;
#endif
) {
char *array;
- Newz(503, array,
+ Newxz(array,
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
HvARRAY(hv) = (HE**)array;
NULL is for %ENV with dynamic env fetch. But that should disappear
with magic in the previous code. */
char *array;
- Newz(503, array,
+ Newxz(array,
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
HvARRAY(hv) = (HE**)array;
while (mg) {
if (isUPPER(mg->mg_type)) {
*needs_copy = TRUE;
- switch (mg->mg_type) {
- case PERL_MAGIC_tied:
- case PERL_MAGIC_sig:
+ if (mg->mg_type == PERL_MAGIC_tied) {
*needs_store = FALSE;
return; /* We've set all there is to set. */
}
SV *
Perl_hv_scalar(pTHX_ HV *hv)
{
- MAGIC *mg;
SV *sv;
-
- if ((SvRMAGICAL(hv) && (mg = mg_find((SV*)hv, PERL_MAGIC_tied)))) {
- sv = magic_scalarpack(hv, mg);
- return sv;
- }
+
+ if (SvRMAGICAL(hv)) {
+ MAGIC * const mg = mg_find((SV*)hv, PERL_MAGIC_tied);
+ if (mg)
+ return magic_scalarpack(hv, mg);
+ }
sv = sv_newmortal();
if (HvFILL((HV*)hv))
Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
}
#else
- New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
if (!a) {
PL_nomemok = FALSE;
longest_chain, HvTOTALKEYS(hv), HvFILL(hv), 1+HvMAX(hv));*/
++newsize;
- Newz(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
if (SvOOK(hv)) {
Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
if (was_shared) {
/* Unshare it. */
- HEK *new_hek
+ HEK * const new_hek
= save_hek_flags(HeKEY(entry), HeKLEN(entry),
hash, HeKFLAGS(entry));
unshare_hek (HeKEY_hek(entry));
Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
}
#else
- New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+ (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
if (!a) {
PL_nomemok = FALSE;
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
}
else {
- Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+ Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
}
xhv->xhv_max = --newsize; /* HvMAX(hv) = --newsize */
HvARRAY(hv) = (HE **) a;
/* It's an ordinary hash, so copy it fast. AMS 20010804 */
STRLEN i;
const bool shared = !!HvSHAREKEYS(ohv);
- HE **ents, **oents = (HE **)HvARRAY(ohv);
+ HE **ents, ** const oents = (HE **)HvARRAY(ohv);
char *a;
- New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+ Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
ents = (HE**)a;
/* In each bucket... */
for (i = 0; i <= hv_max; i++) {
- HE *prev = NULL, *ent = NULL, *oent = oents[i];
+ HE *prev = NULL, *ent = NULL;
+ HE *oent = oents[i];
if (!oent) {
ents[i] = NULL;
}
/* Copy the linked list of entries. */
- for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
+ for (; oent; oent = HeNEXT(oent)) {
const U32 hash = HeHASH(oent);
const char * const key = HeKEY(oent);
const STRLEN len = HeKLEN(oent);
HvFILL(hv) = hv_fill;
HvTOTALKEYS(hv) = HvTOTALKEYS(ohv);
HvARRAY(hv) = ents;
- }
+ } /* not magical */
else {
/* Iterate over ohv, copying keys and values one at a time. */
HE *entry;
{
if (!entry)
return;
- if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME_get(hv))
- PL_sub_generation++; /* may be deletion of method from stash */
- sv_2mortal(HeVAL(entry)); /* free between statements */
+ /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */
+ sv_2mortal(SvREFCNT_inc(HeVAL(entry))); /* free between statements */
if (HeKLEN(entry) == HEf_SVKEY) {
- sv_2mortal(HeKEY_sv(entry));
- Safefree(HeKEY_hek(entry));
+ sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry)));
}
- else if (HvSHAREKEYS(hv))
- unshare_hek(HeKEY_hek(entry));
- else
- Safefree(HeKEY_hek(entry));
- del_HE(entry);
+ hv_free_ent(hv, entry);
}
/*
I32 riter;
I32 max;
struct xpvhv_aux *iter;
- if (!hv)
- return;
+
if (!HvARRAY(hv))
return;
entry = array[0];
for (;;) {
if (entry) {
- register HE *oentry = entry;
+ register HE * const oentry = entry;
entry = HeNEXT(entry);
hv_free_ent(hv, oentry);
}
if ((name = HvNAME_get(hv))) {
if(PL_stashcache)
hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
- Perl_hv_name_set(aTHX_ hv, 0, 0, 0);
+ hv_name_set(hv, Nullch, 0, 0);
}
SvFLAGS(hv) &= ~SVf_OOK;
Safefree(HvARRAY(hv));
char *array;
if (!HvARRAY(hv)) {
- Newz(0, array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
+ Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
+ sizeof(struct xpvhv_aux), char);
} else {
array = (char *) HvARRAY(hv);
{
struct xpvhv_aux *iter;
U32 hash;
- (void)flags;
+
+ PERL_UNUSED_ARG(flags);
if (SvOOK(hv)) {
iter = HvAUX(hv);
}
/*
+hv_iternext is implemented as a macro in hv.h
+
=for apidoc hv_iternext
Returns entries from a hash iterator. See C<hv_iterinit>.
your iterator immediately else the entry will leak - call C<hv_iternext> to
trigger the resource deallocation.
-=cut
-*/
-
-HE *
-Perl_hv_iternext(pTHX_ HV *hv)
-{
- return hv_iternext_flags(hv, 0);
-}
-
-/*
=for apidoc hv_iternext_flags
Returns entries from a hash iterator. See C<hv_iterinit> and C<hv_iternext>.
oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
if ((mg = SvTIED_mg((SV*)hv, PERL_MAGIC_tied))) {
- SV *key = sv_newmortal();
+ SV * const key = sv_newmortal();
if (entry) {
sv_setsv(key, HeSVKEY_force(entry));
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
/* one HE per MAGICAL hash */
iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
Zero(entry, 1, HE);
- Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
+ Newxz(k, HEK_BASESIZE + sizeof(SV*), char);
hek = (HEK*)k;
HeKEY_hek(entry) = hek;
HeKLEN(entry) = HEf_SVKEY;
return Null(HE*);
}
#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
- if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+ if (!entry && SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
prime_env_iter();
+#ifdef VMS
+ /* The prime_env_iter() on VMS just loaded up new hash values
+ * so the iteration count needs to be reset back to the beginning
+ */
+ hv_iterinit(hv);
+ iter = HvAUX(hv);
+ oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */
+#endif
+ }
#endif
/* hv_iterint now ensures this. */
{
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv, PERL_MAGIC_tied)) {
- SV* sv = sv_newmortal();
+ SV* const sv = sv_newmortal();
if (HeKLEN(entry) == HEf_SVKEY)
mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
else
}
/*
+
+Now a macro in hv.h
+
=for apidoc hv_magic
Adds magic to a hash. See C<sv_magic>.
=cut
*/
-void
-Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
-{
- sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
-}
-
-#if 0 /* use the macro from hv.h instead */
-
-char*
-Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
-{
- return HEK_KEY(share_hek(sv, len, hash));
-}
-
-#endif
-
/* possibly free a shared string if no one has access to it
* len and hash must both be valid for str.
*/
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
{
register XPVHV* xhv;
- register HE *entry;
+ HE *entry;
register HE **oentry;
HE **first;
bool found = 0;
bool is_utf8 = FALSE;
int k_flags = 0;
- const char *save = str;
+ const char * const save = str;
struct shared_he *he = 0;
if (hek) {
{
bool is_utf8 = FALSE;
int flags = 0;
- const char *save = str;
+ const char * const save = str;
if (len < 0) {
STRLEN tmplen = -len;
HEK directly from the HE.
*/
- New(0, k, STRUCT_OFFSET(struct shared_he,
+ Newx(k, STRUCT_OFFSET(struct shared_he,
shared_he_hek.hek_key[0]) + len + 2, char);
new_entry = (struct shared_he *)k;
entry = &(new_entry->shared_he_he);
https://perl5.git.perl.org / perl5.git / blobdiff