diff options
| -rw-r--r-- | embed.fnc | 1 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | hv.c | 34 | ||||
| -rw-r--r-- | sv.c | 47 |
5 files changed, 52 insertions, 33 deletions
@@ -533,6 +533,7 @@ Apda |SV* |newSVuv |UV u Apda |SV* |newSVnv |NV n Apda |SV* |newSVpv |const char* s|STRLEN len Apda |SV* |newSVpvn |const char* s|STRLEN len +Apda |SV* |newSVpv_hek |const HEK *hek Apda |SV* |newSVpvn_share |const char* s|I32 len|U32 hash Afpda |SV* |newSVpvf |const char* pat|... Ap |SV* |vnewSVpvf |const char* pat|va_list* args @@ -552,6 +552,7 @@ #define newSVnv Perl_newSVnv #define newSVpv Perl_newSVpv #define newSVpvn Perl_newSVpvn +#define newSVpv_hek Perl_newSVpv_hek #define newSVpvn_share Perl_newSVpvn_share #define newSVpvf Perl_newSVpvf #define vnewSVpvf Perl_vnewSVpvf @@ -2543,6 +2544,7 @@ #define newSVnv(a) Perl_newSVnv(aTHX_ a) #define newSVpv(a,b) Perl_newSVpv(aTHX_ a,b) #define newSVpvn(a,b) Perl_newSVpvn(aTHX_ a,b) +#define newSVpv_hek(a) Perl_newSVpv_hek(aTHX_ a) #define newSVpvn_share(a,b,c) Perl_newSVpvn_share(aTHX_ a,b,c) #define vnewSVpvf(a,b) Perl_vnewSVpvf(aTHX_ a,b) #define newSVrv(a,b) Perl_newSVrv(aTHX_ a,b) diff --git a/global.sym b/global.sym index f8c26bb216..8a1e9caa89 100644 --- a/global.sym +++ b/global.sym @@ -315,6 +315,7 @@ Perl_newSVuv Perl_newSVnv Perl_newSVpv Perl_newSVpvn +Perl_newSVpv_hek Perl_newSVpvn_share Perl_newSVpvf Perl_vnewSVpvf @@ -2059,39 +2059,7 @@ see C<hv_iterinit>. SV * Perl_hv_iterkeysv(pTHX_ register HE *entry) { - if (HeKLEN(entry) != HEf_SVKEY) { - HEK *hek = HeKEY_hek(entry); - const int flags = HEK_FLAGS(hek); - SV *sv; - - if (flags & HVhek_WASUTF8) { - /* Trouble :-) - Andreas would like keys he put in as utf8 to come back as utf8 - */ - STRLEN utf8_len = HEK_LEN(hek); - U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len); - - sv = newSVpvn ((char*)as_utf8, utf8_len); - SvUTF8_on (sv); - Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */ - } else if (flags & HVhek_REHASH) { - /* We don't have a pointer to the hv, so we have to replicate the - flag into every HEK. This hv is using custom a hasing - algorithm. Hence we can't return a shared string scalar, as - that would contain the (wrong) hash value, and might get passed - into an hv routine with a regular hash */ - - sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek)); - if (HEK_UTF8(hek)) - SvUTF8_on (sv); - } else { - sv = newSVpvn_share(HEK_KEY(hek), - (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)), - HEK_HASH(hek)); - } - return sv_2mortal(sv); - } - return sv_mortalcopy(HeKEY_sv(entry)); + return sv_2mortal(newSVpv_hek(HeKEY_hek(entry))); } /* @@ -7601,6 +7601,53 @@ Perl_newSVpvn(pTHX_ const char *s, STRLEN len) return sv; } + +/* +=for apidoc newSVpv_hek + +Creates a new SV from the hash key structure. It will generate scalars that +point to the shared string table where possible. + +=cut +*/ + +SV * +Perl_newSVpv_hek(pTHX_ const HEK *hek) +{ + if (HEK_LEN(hek) == HEf_SVKEY) { + return newSVsv(*(SV**)HEK_KEY(hek)); + } else { + const int flags = HEK_FLAGS(hek); + if (flags & HVhek_WASUTF8) { + /* Trouble :-) + Andreas would like keys he put in as utf8 to come back as utf8 + */ + STRLEN utf8_len = HEK_LEN(hek); + U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len); + SV *sv = newSVpvn ((char*)as_utf8, utf8_len); + + SvUTF8_on (sv); + Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */ + return sv; + } else if (flags & HVhek_REHASH) { + /* We don't have a pointer to the hv, so we have to replicate the + flag into every HEK. This hv is using custom a hasing + algorithm. Hence we can't return a shared string scalar, as + that would contain the (wrong) hash value, and might get passed + into an hv routine with a regular hash */ + + SV *sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek)); + if (HEK_UTF8(hek)) + SvUTF8_on (sv); + return sv; + } + /* This will be overwhelminly the most common case. */ + return newSVpvn_share(HEK_KEY(hek), + (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)), + HEK_HASH(hek)); + } +} + /* =for apidoc newSVpvn_share |