#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 ** const 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() 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
-#define new_HE() (HE*)safemalloc(sizeof(HE))
-#define del_HE(p) safefree((char*)p)
-#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
Perl_free_tied_hv_pool(pTHX)
{
- HE *ohe;
HE *he = PL_hv_fetch_ent_mh;
while (he) {
+ HE * const ohe = he;
Safefree(HeKEY_hek(he));
- ohe = he;
he = HeNEXT(he);
del_HE(ohe);
}
Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
{
HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
- (void)param;
+
+ PERL_UNUSED_ARG(param);
if (shared) {
/* We already shared this hash key. */
}
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 if (shared) {
/* This is hek_dup inlined, which seems to be important for speed
reasons. */
- HEK *source = HeKEY_hek(e);
+ HEK * const source = HeKEY_hek(e);
HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
if (shared) {
S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
const char *msg)
{
- SV *sv = sv_newmortal();
+ SV * const sv = sv_newmortal();
if (!(flags & HVhek_FREEKEY)) {
sv_setpvn(sv, key, klen);
}
Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
register U32 hash, int flags)
{
- HE *hek = hv_fetch_common (hv, NULL, key, klen, flags,
+ HE * const hek = hv_fetch_common (hv, NULL, key, klen, flags,
(HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
return hek ? &HeVAL(hek) : NULL;
}
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;
if (isLOWER(key[i])) {
/* Would be nice if we had a routine to do the
copy and upercase in a single pass through. */
- const char *nkey = strupr(savepvn(key,klen));
+ const char * const nkey = strupr(savepvn(key,klen));
/* Note that this fetch is for nkey (the uppercased
key) whereas the store is for key (the original) */
entry = hv_fetch_common(hv, Nullsv, nkey, klen,
} /* ISFETCH */
else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
- SV* svret;
/* I don't understand why hv_exists_ent has svret and sv,
whereas hv_exists only had one. */
- svret = sv_newmortal();
+ SV * const svret = sv_newmortal();
sv = sv_newmortal();
if (keysv || is_utf8) {
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
/* XXX This code isn't UTF8 clean. */
- const char *keysave = key;
+ char * const keysave = (char * const)key;
/* Will need to free this, so set FREEKEY flag. */
key = savepvn(key,klen);
key = (const char*)strupr((char*)key);
#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;
}
if (is_utf8) {
- const char *keysave = key;
+ char * const keysave = (char * const)key;
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
if (is_utf8)
flags |= HVhek_UTF8;
if (!(action & HV_FETCH_ISSTORE)
&& SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
unsigned long len;
- char *env = PerlEnv_ENVgetenv_len(key,&len);
+ const char * const env = PerlEnv_ENVgetenv_len(key,&len);
if (env) {
sv = newSVpvn(env,len);
SvTAINTED_on(sv);
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);
while (entry) {
/* We're going to trash this HE's next pointer when we chain it
into the new hash below, so store where we go next. */
- HE *next = HeNEXT(entry);
+ HE * const next = HeNEXT(entry);
UV hash;
HE **bep;
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;
HV *
Perl_newHV(pTHX)
{
- register HV *hv;
register XPVHV* xhv;
+ HV * const hv = (HV*)NEWSV(502,0);
- hv = (HV*)NEWSV(502,0);
sv_upgrade((SV *)hv, SVt_PVHV);
xhv = (XPVHV*)SvANY(hv);
SvPOK_off(hv);
HV *
Perl_newHVhv(pTHX_ HV *ohv)
{
- HV *hv = newHV();
+ HV * const hv = newHV();
STRLEN hv_max, hv_fill;
if (!ohv || (hv_fill = HvFILL(ohv)) == 0)
/* 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);
I32
Perl_hv_iterinit(pTHX_ HV *hv)
{
- HE *entry;
-
if (!hv)
Perl_croak(aTHX_ "Bad hash");
if (SvOOK(hv)) {
struct xpvhv_aux *iter = HvAUX(hv);
- entry = iter->xhv_eiter; /* HvEITER(hv) */
+ HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
HvLAZYDEL_off(hv);
hv_free_ent(hv, entry);
{
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 (HeKLEN(entry) == HEf_SVKEY) {
STRLEN len;
- char *p = SvPV(HeKEY_sv(entry), len);
+ char * const p = SvPV(HeKEY_sv(entry), len);
*retlen = len;
return p;
}
{
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
SV *
Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
{
- HE *he;
- if ( (he = hv_iternext_flags(hv, 0)) == NULL)
+ HE * const he = hv_iternext_flags(hv, 0);
+
+ if (!he)
return NULL;
*key = hv_iterkey(he, retlen);
return hv_iterval(hv, he);
}
/*
+
+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;
STATIC HEK *
S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
{
- register XPVHV* xhv;
register HE *entry;
register HE **oentry;
I32 found = 0;
Can't rehash the shared string table, so not sure if it's worth
counting the number of entries in the linked list
*/
- xhv = (XPVHV*)SvANY(PL_strtab);
+ register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
LOCK_STRTAB_MUTEX;
oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)];
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);
projects / p5sagit/p5-mst-13.2.git / blobdiff