From: Nicholas Clark Date: Tue, 20 Sep 2005 08:35:19 +0000 (+0000) Subject: Integrate: X-Git-Tag: perl-5.8.8~296 X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/740075a2a0fa8c9278468568966915c6b610fd7d Integrate: [ 24692] Create newSVpv_hek to reduce code duplication where HEKs need to be turned into SVs [ 24696] s/newSVpv_hek/newSVhek/g; # Lousy choice of name (just the tweak to newSVhek for passing in NULL from) [ 24697] Use newSVhek where we're generating SVs from package names p4raw-link: @24697 on //depot/perl: 5aaec2b4ba9ed3b1a9d1569e09bc40d19ec30f8c p4raw-link: @24696 on //depot/perl: c1b02ed82fa9b8892ce2668d35b6825f1fd3fb59 p4raw-link: @24692 on //depot/perl: bd08039be6ae803dd509ca33cf404bdcdd4bae99 p4raw-id: //depot/maint-5.8/perl@25509 p4raw-integrated: from //depot/perl@24697 'ignore' pp.c (@24619..) op.c (@24654..) toke.c (@24689..) p4raw-edited: from //depot/perl@24696 'edit in' embed.fnc (@24692..) p4raw-integrated: from //depot/perl@24696 'edit in' sv.c (@24692..) 'merge in' proto.h (@24689..) p4raw-integrated: from //depot/perl@24692 'edit in' embed.h hv.c (@24689..) 'merge in' global.sym (@24689..) --- diff --git a/embed.fnc b/embed.fnc index 48fa17d..e677eea 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1554,6 +1554,7 @@ ApR |OP* |ck_unpack |NN OP *o #endif Apd |bool |is_utf8_string_loclen|NN const U8 *s|STRLEN len|const U8 **ep|STRLEN *el +Apda |SV* |newSVhek |const HEK *hek END_EXTERN_C /* diff --git a/embed.h b/embed.h index 01a3b48..7aef82c 100644 --- a/embed.h +++ b/embed.h @@ -578,6 +578,7 @@ #define newSVnv Perl_newSVnv #define newSVpv Perl_newSVpv #define newSVpvn Perl_newSVpvn +#define newSVhek Perl_newSVhek #define newSVpvn_share Perl_newSVpvn_share #define newSVpvf Perl_newSVpvf #define vnewSVpvf Perl_vnewSVpvf @@ -2620,6 +2621,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 newSVhek(a) Perl_newSVhek(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 80ff9dd..9524085 100644 --- a/global.sym +++ b/global.sym @@ -320,6 +320,7 @@ Perl_newSVuv Perl_newSVnv Perl_newSVpv Perl_newSVpvn +Perl_newSVpv_hek Perl_newSVpvn_share Perl_newSVpvf Perl_vnewSVpvf diff --git a/hv.c b/hv.c index 10d5658..114c3d1 100644 --- a/hv.c +++ b/hv.c @@ -1850,39 +1850,7 @@ see C. 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(newSVhek(HeKEY_hek(entry))); } /* diff --git a/proto.h b/proto.h index d65842b..4cd51e9 100644 --- a/proto.h +++ b/proto.h @@ -1048,6 +1048,10 @@ PERL_CALLCONV SV* Perl_newSVpvn(pTHX_ const char* s, STRLEN len) __attribute__malloc__ __attribute__warn_unused_result__; +PERL_CALLCONV SV* Perl_newSVhek(pTHX_ const HEK *hek) + __attribute__malloc__ + __attribute__warn_unused_result__; + PERL_CALLCONV SV* Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash) __attribute__malloc__ __attribute__warn_unused_result__; diff --git a/sv.c b/sv.c index e160779..14cbfbd 100644 --- a/sv.c +++ b/sv.c @@ -6923,6 +6923,61 @@ 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. Returns a new (undefined) +SV if the hek is NULL. + +=cut +*/ + +SV * +Perl_newSVhek(pTHX_ const HEK *hek) +{ + if (!hek) { + SV *sv; + + new_SV(sv); + return sv; + } + + 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