*/
/*
-=head1 Hash Manipulation Functions
+=head1 HV Handling
A HV structure represents a Perl hash. It consists mainly of an array
of pointers, each of which points to a linked list of HE structures. The
array is indexed by the hash function of the key, so each linked list
* you MUST change the logic in hv_ksplit()
*/
#define DO_HSPLIT(xhv) ( ((xhv)->xhv_keys + ((xhv)->xhv_keys >> 1)) > (xhv)->xhv_max )
-#define HV_FILL_THRESHOLD 31
static const char S_strtab_error[]
= "Cannot modify shared string table in hv_%s";
will own the only reference to the new SV, and your code doesn't need to do
anything further to tidy up. Note that C<hv_store_ent> only reads the C<key>;
unlike C<val> it does not take ownership of it, so maintaining the correct
-reference count on C<key> is entirely the caller's responsibility. C<hv_store>
+reference count on C<key> is entirely the caller's responsibility. The reason
+it does not take ownership, is that C<key> is not used after this function
+returns, and so can be freed immediately. C<hv_store>
is not implemented as a call to C<hv_store_ent>, and does not create a temporary
SV for the key, so if your key data is not already in SV form then use
C<hv_store> in preference to C<hv_store_ent>.
Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
int flags, int action, SV *val, U32 hash)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE **oentry;
if (SvIsCOW_shared_hash(keysv)) {
flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
} else {
- flags = is_utf8 ? HVhek_UTF8 : 0;
+ flags = 0;
}
} else {
is_utf8 = cBOOL(flags & HVhek_UTF8);
if (action & HV_DELETE) {
return (void *) hv_delete_common(hv, keysv, key, klen,
- flags, action, hash);
+ flags | (is_utf8 ? HVhek_UTF8 : 0),
+ action, hash);
}
xhv = (XPVHV*)SvANY(hv);
/* This cast somewhat evil, but I'm merely using NULL/
not NULL to return the boolean exists.
And I know hv is not NULL. */
- return SvTRUE(svret) ? (void *)hv : NULL;
+ return SvTRUE_NN(svret) ? (void *)hv : NULL;
}
#ifdef ENV_IS_CASELESS
else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
return sv;
}
+
+/*
+hv_pushkv(): push all the keys and/or values of a hash onto the stack.
+The rough Perl equivalents:
+ () = %hash;
+ () = keys %hash;
+ () = values %hash;
+
+Resets the hash's iterator.
+
+flags : 1 = push keys
+ 2 = push values
+ 1|2 = push keys and values
+ XXX use symbolic flag constants at some point?
+I might unroll the non-tied hv_iternext() in here at some point - DAPM
+*/
+
+void
+Perl_hv_pushkv(pTHX_ HV *hv, U32 flags)
+{
+ HE *entry;
+ bool tied = SvRMAGICAL(hv) && (mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied)
+#ifdef DYNAMIC_ENV_FETCH /* might not know number of keys yet */
+ || mg_find(MUTABLE_SV(hv), PERL_MAGIC_env)
+#endif
+ );
+ dSP;
+
+ PERL_ARGS_ASSERT_HV_PUSHKV;
+ assert(flags); /* must be pushing at least one of keys and values */
+
+ (void)hv_iterinit(hv);
+
+ if (tied) {
+ SSize_t ext = (flags == 3) ? 2 : 1;
+ while ((entry = hv_iternext(hv))) {
+ EXTEND(SP, ext);
+ if (flags & 1)
+ PUSHs(hv_iterkeysv(entry));
+ if (flags & 2)
+ PUSHs(hv_iterval(hv, entry));
+ }
+ }
+ else {
+ Size_t nkeys = HvUSEDKEYS(hv);
+ SSize_t ext;
+
+ if (!nkeys)
+ return;
+
+ /* 2*nkeys() should never be big enough to truncate or wrap */
+ assert(nkeys <= (SSize_t_MAX >> 1));
+ ext = nkeys * ((flags == 3) ? 2 : 1);
+
+ EXTEND_MORTAL(nkeys);
+ EXTEND(SP, ext);
+
+ while ((entry = hv_iternext(hv))) {
+ if (flags & 1) {
+ SV *keysv = newSVhek(HeKEY_hek(entry));
+ SvTEMP_on(keysv);
+ PL_tmps_stack[++PL_tmps_ix] = keysv;
+ PUSHs(keysv);
+ }
+ if (flags & 2)
+ PUSHs(HeVAL(entry));
+ }
+ }
+
+ PUTBACK;
+}
+
+
/*
=for apidoc hv_bucket_ratio
S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
int k_flags, I32 d_flags, U32 hash)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE **oentry;
sv_2mortal((SV *)gv)
);
}
- else if (klen == 3 && strEQs(key, "ISA") && GvAV(gv)) {
+ else if (memEQs(key, klen, "ISA") && GvAV(gv)) {
AV *isa = GvAV(gv);
MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa);
SV **svp, **end;
strip_magic:
svp = AvARRAY(isa);
- end = svp + AvFILLp(isa)+1;
+ end = svp + (AvFILLp(isa)+1);
while (svp < end) {
if (*svp)
mg_free_type(*svp, PERL_MAGIC_isaelem);
HV *
Perl_newHVhv(pTHX_ HV *ohv)
{
- dVAR;
HV * const hv = newHV();
STRLEN hv_max;
}
/*
-=for apidoc Am|HV *|hv_copy_hints_hv|HV *ohv
+=for apidoc hv_copy_hints_hv
A specialised version of L</newHVhv> for copying C<%^H>. C<ohv> must be
a pointer to a hash (which may have C<%^H> magic, but should be generally
/*
=for apidoc hv_clear
-Frees the all the elements of a hash, leaving it empty.
+Frees all the elements of a hash, leaving it empty.
The XS equivalent of C<%hash = ()>. See also L</hv_undef>.
See L</av_clear> for a note about the hash possibly being invalid on
void
Perl_hv_clear(pTHX_ HV *hv)
{
- dVAR;
SSize_t orig_ix;
XPVHV* xhv;
static void
S_clear_placeholders(pTHX_ HV *hv, U32 items)
{
- dVAR;
I32 i;
PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS;
void
Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
- dVAR;
struct xpvhv_aux *iter;
U32 hash;
HEK **spot;
if (iter->xhv_name_u.xhvnameu_name) {
if(iter->xhv_name_count) {
if(flags & HV_NAME_SETALL) {
- HEK ** const name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
- HEK **hekp = name + (
+ HEK ** const this_name = HvAUX(hv)->xhv_name_u.xhvnameu_names;
+ HEK **hekp = this_name + (
iter->xhv_name_count < 0
? -iter->xhv_name_count
: iter->xhv_name_count
);
- while(hekp-- > name+1)
+ while(hekp-- > this_name+1)
unshare_hek_or_pvn(*hekp, 0, 0, 0);
/* The first elem may be null. */
- if(*name) unshare_hek_or_pvn(*name, 0, 0, 0);
- Safefree(name);
+ if(*this_name) unshare_hek_or_pvn(*this_name, 0, 0, 0);
+ Safefree(this_name);
iter = HvAUX(hv); /* may been realloced */
spot = &iter->xhv_name_u.xhvnameu_name;
iter->xhv_name_count = 0;
void
Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
{
- dVAR;
struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv);
U32 hash;
restricted hashes may change, and the implementation currently is
insufficiently abstracted for any change to be tidy.
+=for apidoc Amnh||HV_ITERNEXT_WANTPLACEHOLDERS
+
=cut
*/
HE *
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
{
- dVAR;
XPVHV* xhv;
HE *entry;
HE *oldentry;
we should flag that it needs upgrading on keys or each. Also flag
that we need share_hek_flags to free the string. */
if (str != save) {
- dVAR;
PERL_HASH(hash, str, len);
flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
}
STATIC SV *
S_refcounted_he_value(pTHX_ const struct refcounted_he *he)
{
- dVAR;
SV *value;
PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE;
}
/*
-=for apidoc m|HV *|refcounted_he_chain_2hv|const struct refcounted_he *c|U32 flags
+=for apidoc refcounted_he_chain_2hv
Generates and returns a C<HV *> representing the content of a
C<refcounted_he> chain.
HV *
Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags)
{
- dVAR;
HV *hv;
U32 placeholders, max;
}
/*
-=for apidoc m|SV *|refcounted_he_fetch_pvn|const struct refcounted_he *chain|const char *keypv|STRLEN keylen|U32 hash|U32 flags
+=for apidoc refcounted_he_fetch_pvn
Search along a C<refcounted_he> chain for an entry with the key specified
by C<keypv> and C<keylen>. If C<flags> has the C<REFCOUNTED_HE_KEY_UTF8>
Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
const char *keypv, STRLEN keylen, U32 hash, U32 flags)
{
- dVAR;
U8 utf8_flag;
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN;
}
/*
-=for apidoc m|SV *|refcounted_he_fetch_pv|const struct refcounted_he *chain|const char *key|U32 hash|U32 flags
+=for apidoc refcounted_he_fetch_pv
Like L</refcounted_he_fetch_pvn>, but takes a nul-terminated string
instead of a string/length pair.
}
/*
-=for apidoc m|SV *|refcounted_he_fetch_sv|const struct refcounted_he *chain|SV *key|U32 hash|U32 flags
+=for apidoc refcounted_he_fetch_sv
Like L</refcounted_he_fetch_pvn>, but takes a Perl scalar instead of a
string/length pair.
}
/*
-=for apidoc m|struct refcounted_he *|refcounted_he_new_pvn|struct refcounted_he *parent|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags
+=for apidoc refcounted_he_new_pvn
Creates a new C<refcounted_he>. This consists of a single key/value
pair and a reference to an existing C<refcounted_he> chain (which may
Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent,
const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags)
{
- dVAR;
STRLEN value_len = 0;
const char *value_p = NULL;
bool is_pv;
}
/*
-=for apidoc m|struct refcounted_he *|refcounted_he_new_pv|struct refcounted_he *parent|const char *key|U32 hash|SV *value|U32 flags
+=for apidoc refcounted_he_new_pv
Like L</refcounted_he_new_pvn>, but takes a nul-terminated string instead
of a string/length pair.
}
/*
-=for apidoc m|struct refcounted_he *|refcounted_he_new_sv|struct refcounted_he *parent|SV *key|U32 hash|SV *value|U32 flags
+=for apidoc refcounted_he_new_sv
Like L</refcounted_he_new_pvn>, but takes a Perl scalar instead of a
string/length pair.
}
/*
-=for apidoc m|void|refcounted_he_free|struct refcounted_he *he
+=for apidoc refcounted_he_free
Decrements the reference count of a C<refcounted_he> by one. If the
reference count reaches zero the structure's memory is freed, which
void
Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
-#ifdef USE_ITHREADS
- dVAR;
-#endif
PERL_UNUSED_CONTEXT;
while (he) {
}
/*
-=for apidoc m|struct refcounted_he *|refcounted_he_inc|struct refcounted_he *he
+=for apidoc refcounted_he_inc
Increment the reference count of a C<refcounted_he>. The pointer to the
C<refcounted_he> is also returned. It is safe to pass a null pointer
struct refcounted_he *
Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
{
-#ifdef USE_ITHREADS
- dVAR;
-#endif
PERL_UNUSED_CONTEXT;
if (he) {
HINTS_REFCNT_LOCK;
}
/*
+=for apidoc_section $COP
=for apidoc cop_fetch_label
-Returns the label attached to a cop.
-The flags pointer may be set to C<SVf_UTF8> or 0.
+Returns the label attached to a cop, and stores its length in bytes into
+C<*len>.
+Upon return, C<*flags> will be set to either C<SVf_UTF8> or 0.
+
+Alternatively, use the macro C<L</CopLABEL_len_flags>>;
+or if you don't need to know if the label is UTF-8 or not, the macro
+C<L</CopLABEL_len>>;
+or if you additionally dont need to know the length, C<L</CopLABEL>>.
=cut
*/
Save a label into a C<cop_hints_hash>.
You need to set flags to C<SVf_UTF8>
-for a UTF-8 label.
+for a UTF-8 label. Any other flag is ignored.
=cut
*/
}
/*
+=for apidoc_section $HV
=for apidoc hv_assert
Check that a hash is in an internally consistent state.
void
Perl_hv_assert(pTHX_ HV *hv)
{
- dVAR;
HE* entry;
int withflags = 0;
int placeholders = 0;