This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove PMROOT and replace it with a small shell script. Er, magic.
[perl5.git] / hv.h
diff --git a/hv.h b/hv.h
index 3475c87..7a6009b 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -1,6 +1,7 @@
 /*    hv.h
  *
- *    Copyright (c) 1991-2001, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2005, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -23,6 +24,9 @@ struct hek {
     U32                hek_hash;       /* hash of key */
     I32                hek_len;        /* length of hash key */
     char       hek_key[1];     /* variable-length hash key */
+    /* the hash-key is \0-terminated */
+    /* after the \0 there is a byte for flags, such as whether the key
+       is UTF-8 */
 };
 
 /* hash structure: */
@@ -33,24 +37,48 @@ struct xpvhv {
     STRLEN     xhv_max;        /* subscript of last element of xhv_array */
     IV         xhv_keys;       /* how many elements in the array */
     NV         xnv_nv;         /* numeric value, if any */
+#define xhv_placeholders xnv_nv
     MAGIC*     xmg_magic;      /* magic for scalar array */
     HV*                xmg_stash;      /* class package */
 
     I32                xhv_riter;      /* current root of iterator */
     HE         *xhv_eiter;     /* current entry of iterator */
-    PMOP       *xhv_pmroot;    /* list of pm's for this package */
+    /* list of pm's for this package is now stored in symtab magic.  */
     char       *xhv_name;      /* name, if a symbol table */
 };
 
 /* hash a key */
-/* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins */
-/* from requirements by Colin Plumb. */
-/* (http://burtleburtle.net/bob/hash/doobs.html) */
+/* FYI: This is the "One-at-a-Time" algorithm by Bob Jenkins
+ * from requirements by Colin Plumb.
+ * (http://burtleburtle.net/bob/hash/doobs.html) */
+/* The use of a temporary pointer and the casting games
+ * is needed to serve the dual purposes of
+ * (a) the hashed data being interpreted as "unsigned char" (new since 5.8,
+ *     a "char" can be either signed or signed, depending on the compiler)
+ * (b) catering for old code that uses a "char"
+ *
+ * The "hash seed" feature was added in Perl 5.8.1 to perturb the results
+ * to avoid "algorithmic complexity attacks".
+ *
+ * If USE_HASH_SEED is defined, hash randomisation is done by default
+ * If USE_HASH_SEED_EXPLICIT is defined, hash randomisation is done
+ * only if the environment variable PERL_HASH_SEED is set.
+ * For maximal control, one can define PERL_HASH_SEED.
+ * (see also perl.c:perl_parse()).
+ */
+#ifndef PERL_HASH_SEED
+#   if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
+#       define PERL_HASH_SEED  PL_hash_seed
+#   else
+#       define PERL_HASH_SEED  0
+#   endif
+#endif
 #define PERL_HASH(hash,str,len) \
      STMT_START        { \
-       register const char *s_PeRlHaSh = str; \
+       register const char *s_PeRlHaSh_tmp = str; \
+       register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
        register I32 i_PeRlHaSh = len; \
-       register U32 hash_PeRlHaSh = 0; \
+       register U32 hash_PeRlHaSh = PERL_HASH_SEED; \
        while (i_PeRlHaSh--) { \
            hash_PeRlHaSh += *s_PeRlHaSh++; \
            hash_PeRlHaSh += (hash_PeRlHaSh << 10); \
@@ -61,15 +89,40 @@ struct xpvhv {
        (hash) = (hash_PeRlHaSh + (hash_PeRlHaSh << 15)); \
     } STMT_END
 
+/* Only hv.c and mod_perl should be doing this.  */
+#ifdef PERL_HASH_INTERNAL_ACCESS
+#define PERL_HASH_INTERNAL(hash,str,len) \
+     STMT_START        { \
+       register const char *s_PeRlHaSh_tmp = str; \
+       register const unsigned char *s_PeRlHaSh = (const unsigned char *)s_PeRlHaSh_tmp; \
+       register I32 i_PeRlHaSh = len; \
+       register U32 hash_PeRlHaSh = PL_rehash_seed; \
+       while (i_PeRlHaSh--) { \
+           hash_PeRlHaSh += *s_PeRlHaSh++; \
+           hash_PeRlHaSh += (hash_PeRlHaSh << 10); \
+           hash_PeRlHaSh ^= (hash_PeRlHaSh >> 6); \
+       } \
+       hash_PeRlHaSh += (hash_PeRlHaSh << 3); \
+       hash_PeRlHaSh ^= (hash_PeRlHaSh >> 11); \
+       (hash) = (hash_PeRlHaSh + (hash_PeRlHaSh << 15)); \
+    } STMT_END
+#endif
+
 /*
+=head1 Hash Manipulation Functions
+
 =for apidoc AmU||HEf_SVKEY
 This flag, used in the length slot of hash entries and magic structures,
 specifies the structure contains an C<SV*> pointer where a C<char*> pointer
 is to be expected. (For information only--not to be used).
 
+=head1 Handy Values
+
 =for apidoc AmU||Nullhv
 Null HV pointer.
 
+=head1 Hash Manipulation Functions
+
 =for apidoc Am|char*|HvNAME|HV* stash
 Returns the package name of a stash.  See C<SvSTASH>, C<CvSTASH>.
 
@@ -126,20 +179,53 @@ C<SV*>.
 #define HvARRAY(hv)    (*(HE***)&((XPVHV*)  SvANY(hv))->xhv_array)
 #define HvFILL(hv)     ((XPVHV*)  SvANY(hv))->xhv_fill
 #define HvMAX(hv)      ((XPVHV*)  SvANY(hv))->xhv_max
-#define HvKEYS(hv)     ((XPVHV*)  SvANY(hv))->xhv_keys
 #define HvRITER(hv)    ((XPVHV*)  SvANY(hv))->xhv_riter
 #define HvEITER(hv)    ((XPVHV*)  SvANY(hv))->xhv_eiter
-#define HvPMROOT(hv)   ((XPVHV*)  SvANY(hv))->xhv_pmroot
 #define HvNAME(hv)     ((XPVHV*)  SvANY(hv))->xhv_name
 
+/* the number of keys (including any placeholers) */
+#define XHvTOTALKEYS(xhv)      ((xhv)->xhv_keys)
+
+/* The number of placeholders in the enumerated-keys hash */
+#define XHvPLACEHOLDERS(xhv)   ((xhv)->xhv_placeholders)
+
+/* the number of keys that exist() (i.e. excluding placeholders) */
+#define XHvUSEDKEYS(xhv)      (XHvTOTALKEYS(xhv) - (IV)XHvPLACEHOLDERS(xhv))
+
+/*
+ * HvKEYS gets the number of keys that actually exist(), and is provided
+ * for backwards compatibility with old XS code. The core uses HvUSEDKEYS
+ * (keys, excluding placeholdes) and HvTOTALKEYS (including placeholders)
+ */
+#define HvKEYS(hv)             XHvUSEDKEYS((XPVHV*)  SvANY(hv))
+#define HvUSEDKEYS(hv)         XHvUSEDKEYS((XPVHV*)  SvANY(hv))
+#define HvTOTALKEYS(hv)                XHvTOTALKEYS((XPVHV*)  SvANY(hv))
+#define HvPLACEHOLDERS(hv)     XHvPLACEHOLDERS((XPVHV*)  SvANY(hv))
+
 #define HvSHAREKEYS(hv)                (SvFLAGS(hv) & SVphv_SHAREKEYS)
 #define HvSHAREKEYS_on(hv)     (SvFLAGS(hv) |= SVphv_SHAREKEYS)
 #define HvSHAREKEYS_off(hv)    (SvFLAGS(hv) &= ~SVphv_SHAREKEYS)
 
+/* This is an optimisation flag. It won't be set if all hash keys have a 0
+ * flag. Currently the only flags relate to utf8.
+ * Hence it won't be set if all keys are 8 bit only. It will be set if any key
+ * is utf8 (including 8 bit keys that were entered as utf8, and need upgrading
+ * when retrieved during iteration. It may still be set when there are no longer
+ * any utf8 keys.
+ * See HVhek_ENABLEHVKFLAGS for the trigger.
+ */
+#define HvHASKFLAGS(hv)                (SvFLAGS(hv) & SVphv_HASKFLAGS)
+#define HvHASKFLAGS_on(hv)     (SvFLAGS(hv) |= SVphv_HASKFLAGS)
+#define HvHASKFLAGS_off(hv)    (SvFLAGS(hv) &= ~SVphv_HASKFLAGS)
+
 #define HvLAZYDEL(hv)          (SvFLAGS(hv) & SVphv_LAZYDEL)
 #define HvLAZYDEL_on(hv)       (SvFLAGS(hv) |= SVphv_LAZYDEL)
 #define HvLAZYDEL_off(hv)      (SvFLAGS(hv) &= ~SVphv_LAZYDEL)
 
+#define HvREHASH(hv)           (SvFLAGS(hv) & SVphv_REHASH)
+#define HvREHASH_on(hv)                (SvFLAGS(hv) |= SVphv_REHASH)
+#define HvREHASH_off(hv)       (SvFLAGS(hv) &= ~SVphv_REHASH)
+
 /* Maybe amagical: */
 /* #define HV_AMAGICmb(hv)      (SvFLAGS(hv) & (SVpgv_badAM | SVpgv_AM)) */
 
@@ -160,7 +246,10 @@ C<SV*>.
 #define HeKEY_sv(he)           (*(SV**)HeKEY(he))
 #define HeKLEN(he)             HEK_LEN(HeKEY_hek(he))
 #define HeKUTF8(he)  HEK_UTF8(HeKEY_hek(he))
+#define HeKWASUTF8(he)  HEK_WASUTF8(HeKEY_hek(he))
+#define HeKREHASH(he)  HEK_REHASH(HeKEY_hek(he))
 #define HeKLEN_UTF8(he)  (HeKUTF8(he) ? -HeKLEN(he) : HeKLEN(he))
+#define HeKFLAGS(he)  HEK_FLAGS(HeKEY_hek(he))
 #define HeVAL(he)              (he)->hent_val
 #define HeHASH(he)             HEK_HASH(HeKEY_hek(he))
 #define HePV(he,lp)            ((HeKLEN(he) == HEf_SVKEY) ?            \
@@ -185,10 +274,40 @@ C<SV*>.
 #define HEK_HASH(hek)          (hek)->hek_hash
 #define HEK_LEN(hek)           (hek)->hek_len
 #define HEK_KEY(hek)           (hek)->hek_key
-#define HEK_UTF8(hek)  (*(HEK_KEY(hek)+HEK_LEN(hek)))
+#define HEK_FLAGS(hek) (*((unsigned char *)(HEK_KEY(hek))+HEK_LEN(hek)+1))
+
+#define HVhek_UTF8     0x01 /* Key is utf8 encoded. */
+#define HVhek_WASUTF8  0x02 /* Key is bytes here, but was supplied as utf8. */
+#define HVhek_REHASH   0x04 /* This key is in an hv using a custom HASH . */
+#define HVhek_FREEKEY  0x100 /* Internal flag to say key is malloc()ed.  */
+#define HVhek_PLACEHOLD        0x200 /* Internal flag to create placeholder.
+                               * (may change, but Storable is a core module) */
+#define HVhek_MASK     0xFF
+
+/* Which flags enable HvHASKFLAGS? Somewhat a hack on a hack, as
+   HVhek_REHASH is only needed because the rehash flag has to be duplicated
+   into all keys as hv_iternext has no access to the hash flags. At this
+   point Storable's tests get upset, because sometimes hashes are "keyed"
+   and sometimes not, depending on the order of data insertion, and whether
+   it triggered rehashing. So currently HVhek_REHAS is exempt.
+*/
+   
+#define HVhek_ENABLEHVKFLAGS   (HVhek_MASK - HVhek_REHASH)
+
+#define HEK_UTF8(hek)          (HEK_FLAGS(hek) & HVhek_UTF8)
+#define HEK_UTF8_on(hek)       (HEK_FLAGS(hek) |= HVhek_UTF8)
+#define HEK_UTF8_off(hek)      (HEK_FLAGS(hek) &= ~HVhek_UTF8)
+#define HEK_WASUTF8(hek)       (HEK_FLAGS(hek) & HVhek_WASUTF8)
+#define HEK_WASUTF8_on(hek)    (HEK_FLAGS(hek) |= HVhek_WASUTF8)
+#define HEK_WASUTF8_off(hek)   (HEK_FLAGS(hek) &= ~HVhek_WASUTF8)
+#define HEK_REHASH(hek)                (HEK_FLAGS(hek) & HVhek_REHASH)
+#define HEK_REHASH_on(hek)     (HEK_FLAGS(hek) |= HVhek_REHASH)
 
 /* calculate HV array allocation */
-#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
+#ifndef PERL_USE_LARGE_HV_ALLOC
+/* Default to allocating the correct size - default to assuming that malloc()
+   is not broken and is efficient at allocating blocks sized at powers-of-two.
+*/   
 #  define PERL_HV_ARRAY_ALLOC_BYTES(size) ((size) * sizeof(HE*))
 #else
 #  define MALLOC_OVERHEAD 16
@@ -198,6 +317,9 @@ C<SV*>.
                         : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD)
 #endif
 
+/* Flags for hv_iternext_flags.  */
+#define HV_ITERNEXT_WANTPLACEHOLDERS   0x01    /* Don't skip placeholders.  */
+
 /* available as a function in hv.c */
 #define Perl_sharepvn(sv, len, hash) HEK_KEY(share_hek(sv, len, hash))
 #define sharepvn(sv, len, hash)             Perl_sharepvn(sv, len, hash)