From: Nicholas Clark Date: Sat, 20 May 2006 11:29:26 +0000 (+0000) Subject: Abolish cop_arybase. Signal a non zero $[ with a hint flag, and store X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7b0bddfae402018e486a2f1fa0daf4581b85b65b;p=p5sagit%2Fp5-mst-13.2.git Abolish cop_arybase. Signal a non zero $[ with a hint flag, and store the value in the hints structure used for %^H. p4raw-id: //depot/perl@28250 --- diff --git a/cop.h b/cop.h index ed6151e..749b128 100644 --- a/cop.h +++ b/cop.h @@ -144,7 +144,6 @@ struct cop { GV * cop_filegv; /* file the following line # is from */ #endif U32 cop_seq; /* parse sequence number */ - I32 cop_arybase; /* array base this line was compiled with */ line_t cop_line; /* line # of this command */ /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */ STRLEN * cop_warnings; /* lexical warnings bitmask */ @@ -230,10 +229,26 @@ struct cop { # define OutCopFILE(c) CopFILE(c) #endif -/* CopARYBASE is likely to be removed soon. */ -#define CopARYBASE(c) ((c)->cop_arybase) -#define CopARYBASE_get(c) ((c)->cop_arybase + 0) -#define CopARYBASE_set(c, b) STMT_START { (c)->cop_arybase = (b); } STMT_END +/* If $[ is non-zero, it's stored in cop_hints under the key "$[", and + HINT_ARYBASE is set to indicate this. + Setting it is ineficient due to the need to create 2 mortal SVs, but as + using $[ is highly discouraged, no sane Perl code will be using it. */ +#define CopARYBASE_get(c) \ + ((CopHINTS_get(c) & HINT_ARYBASE) \ + ? SvIV(Perl_refcounted_he_fetch(aTHX_ (c)->cop_hints, 0, "$[", 2, 0, \ + 0)) \ + : 0) +#define CopARYBASE_set(c, b) STMT_START { \ + if (b || ((c)->op_private & HINT_ARYBASE)) { \ + (c)->op_private |= HINT_ARYBASE; \ + if ((c) == &PL_compiling) \ + PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE; \ + (c)->cop_hints \ + = Perl_refcounted_he_new(aTHX_ (c)->cop_hints, \ + sv_2mortal(newSVpvs("$[")), \ + sv_2mortal(newSViv(b))); \ + } \ + } STMT_END /* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h) */ #define CopHINTS_get(c) ((c)->op_private + 0) diff --git a/embed.fnc b/embed.fnc index dac19c7..097023f 100644 --- a/embed.fnc +++ b/embed.fnc @@ -308,6 +308,9 @@ ApdR |SV* |hv_iterval |NN HV* tb|NN HE* entry Ap |void |hv_ksplit |NN HV* hv|IV newmax Apdbm |void |hv_magic |NN HV* hv|NULLOK GV* gv|int how dpoM |HV * |refcounted_he_chain_2hv|NULLOK const struct refcounted_he *c +XEpoM |SV * |refcounted_he_fetch|NN const struct refcounted_he *chain \ + |NULLOK SV *keysv|NULLOK const char *key \ + |STRLEN klen, int flags, U32 hash dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he dpoM |struct refcounted_he *|refcounted_he_new \ |NULLOK struct refcounted_he *const parent \ @@ -1094,6 +1097,7 @@ sM |SV* |hv_delete_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key sM |HE* |hv_fetch_common|NULLOK HV* tb|NULLOK SV* keysv|NULLOK const char* key \ |STRLEN klen|int flags|int action|NULLOK SV* val|U32 hash sM |void |clear_placeholders |NN HV* hb|U32 items +sM |SV * |refcounted_he_value |NN const struct refcounted_he *he #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) diff --git a/embed.h b/embed.h index 2d1e719..df7750c 100644 --- a/embed.h +++ b/embed.h @@ -1096,6 +1096,7 @@ #define hv_delete_common S_hv_delete_common #define hv_fetch_common S_hv_fetch_common #define clear_placeholders S_clear_placeholders +#define refcounted_he_value S_refcounted_he_value #endif #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) @@ -2460,6 +2461,10 @@ #define hv_ksplit(a,b) Perl_hv_ksplit(aTHX_ a,b) #ifdef PERL_CORE #endif +#if defined(PERL_CORE) || defined(PERL_EXT) +#endif +#ifdef PERL_CORE +#endif #define hv_store(a,b,c,d,e) Perl_hv_store(aTHX_ a,b,c,d,e) #define hv_store_ent(a,b,c,d) Perl_hv_store_ent(aTHX_ a,b,c,d) #define hv_store_flags(a,b,c,d,e,f) Perl_hv_store_flags(aTHX_ a,b,c,d,e,f) @@ -3257,6 +3262,7 @@ #define hv_delete_common(a,b,c,d,e,f,g) S_hv_delete_common(aTHX_ a,b,c,d,e,f,g) #define hv_fetch_common(a,b,c,d,e,f,g,h) S_hv_fetch_common(aTHX_ a,b,c,d,e,f,g,h) #define clear_placeholders(a,b) S_clear_placeholders(aTHX_ a,b) +#define refcounted_he_value(a) S_refcounted_he_value(aTHX_ a) #endif #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT) diff --git a/global.sym b/global.sym index dfe7eda..88fdd63 100644 --- a/global.sym +++ b/global.sym @@ -164,6 +164,7 @@ Perl_hv_iternext_flags Perl_hv_iterval Perl_hv_ksplit Perl_hv_magic +Perl_refcounted_he_fetch Perl_hv_store Perl_hv_store_ent Perl_hv_store_flags diff --git a/hv.c b/hv.c index b6bc29e..04a9ab3 100644 --- a/hv.c +++ b/hv.c @@ -2552,6 +2552,51 @@ Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph) /* else we don't need to add magic to record 0 placeholders. */ } +SV * +S_refcounted_he_value(pTHX_ const struct refcounted_he *he) +{ + SV *value; + switch(he->refcounted_he_data[0] & HVrhek_typemask) { + case HVrhek_undef: + value = newSV(0); + break; + case HVrhek_delete: + value = &PL_sv_placeholder; + break; + case HVrhek_IV: + value = (he->refcounted_he_data[0] & HVrhek_UV) + ? newSVuv(he->refcounted_he_val.refcounted_he_u_iv) + : newSViv(he->refcounted_he_val.refcounted_he_u_uv); + break; + case HVrhek_PV: + /* Create a string SV that directly points to the bytes in our + structure. */ + value = newSV(0); + sv_upgrade(value, SVt_PV); + SvPV_set(value, (char *) he->refcounted_he_data + 1); + SvCUR_set(value, he->refcounted_he_val.refcounted_he_u_len); + /* This stops anything trying to free it */ + SvLEN_set(value, 0); + SvPOK_on(value); + SvREADONLY_on(value); + if (he->refcounted_he_data[0] & HVrhek_UTF8) + SvUTF8_on(value); + break; + default: + Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %x", + he->refcounted_he_data[0]); + } + return value; +} + +#ifdef USE_ITHREADS +/* A big expression to find the key offset */ +#define REF_HE_KEY(chain) \ + ((((chain->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV) \ + ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ + + 1 + chain->refcounted_he_data) +#endif + /* =for apidoc refcounted_he_chain_2hv @@ -2597,11 +2642,7 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain) #ifdef USE_ITHREADS HeKEY_hek(entry) - = share_hek_flags(/* A big expression to find the key offset */ - (((chain->refcounted_he_data[0] - & HVrhek_typemask) == HVrhek_PV) - ? chain->refcounted_he_val.refcounted_he_u_len - + 1 : 0) + 1 + chain->refcounted_he_data, + = share_hek_flags(REF_HE_KEY(chain), chain->refcounted_he_keylen, chain->refcounted_he_hash, (chain->refcounted_he_data[0] @@ -2609,38 +2650,9 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain) #else HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek); #endif - - switch(chain->refcounted_he_data[0] & HVrhek_typemask) { - case HVrhek_undef: - value = newSV(0); - break; - case HVrhek_delete: - value = &PL_sv_placeholder; + value = refcounted_he_value(chain); + if (value == &PL_sv_placeholder) placeholders++; - break; - case HVrhek_IV: - value = (chain->refcounted_he_data[0] & HVrhek_UV) - ? newSVuv(chain->refcounted_he_val.refcounted_he_u_iv) - : newSViv(chain->refcounted_he_val.refcounted_he_u_uv); - break; - case HVrhek_PV: - /* Create a string SV that directly points to the bytes in our - structure. */ - value = newSV(0); - sv_upgrade(value, SVt_PV); - SvPV_set(value, (char *) chain->refcounted_he_data + 1); - SvCUR_set(value, chain->refcounted_he_val.refcounted_he_u_len); - /* This stops anything trying to free it */ - SvLEN_set(value, 0); - SvPOK_on(value); - SvREADONLY_on(value); - if (chain->refcounted_he_data[0] & HVrhek_UTF8) - SvUTF8_on(value); - break; - default: - Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %x", - chain->refcounted_he_data[0]); - } HeVAL(entry) = value; /* Link it into the chain. */ @@ -2671,6 +2683,60 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain) return hv; } +SV * +Perl_refcounted_he_fetch(pTHX_ const struct refcounted_he *chain, SV *keysv, + const char *key, STRLEN klen, int flags, U32 hash) +{ + /* Just to be awkward, if you're using this interface the UTF-8-or-not-ness + of your key has to exactly match that which is stored. */ + SV *value = &PL_sv_placeholder; + bool is_utf8; + + if (keysv) { + if (flags & HVhek_FREEKEY) + Safefree(key); + key = SvPV_const(keysv, klen); + flags = 0; + is_utf8 = (SvUTF8(keysv) != 0); + } else { + is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); + } + + if (!hash) { + if (keysv && (SvIsCOW_shared_hash(keysv))) { + hash = SvSHARED_HASH(keysv); + } else { + PERL_HASH(hash, key, klen); + } + } + + for (; chain; chain = chain->refcounted_he_next) { +#ifdef USE_ITHREADS + if (hash != chain->refcounted_he_hash) + continue; + if (klen != chain->refcounted_he_keylen) + continue; + if (memNE(REF_HE_KEY(chain),key,klen)) + continue; +#else + if (hash != HEK_HASH(chain->refcounted_he_hek)) + continue; + if (klen != HEK_LEN(chain->refcounted_he_hek)) + continue; + if (memNE(HEK_KEY(chain->refcounted_he_hek),key,klen)) + continue; +#endif + + value = sv_2mortal(refcounted_he_value(chain)); + break; + } + + if (flags & HVhek_FREEKEY) + Safefree(key); + + return value; +} + /* =for apidoc refcounted_he_new diff --git a/op.c b/op.c index f5e24fc..c86c184 100644 --- a/op.c +++ b/op.c @@ -3946,7 +3946,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) PL_hints |= HINT_BLOCK_SCOPE; } cop->cop_seq = seq; - CopARYBASE_set(cop, CopARYBASE_get(PL_curcop)); + /* CopARYBASE is now "virtual", in that it's stored as a flag bit in + CopHINTS and a possible value in cop_hints, so no need to copy it. */ cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings); if (specialCopIO(PL_curcop->cop_io)) cop->cop_io = PL_curcop->cop_io; diff --git a/perl.h b/perl.h index 5b4dbdd..f438ca0 100644 --- a/perl.h +++ b/perl.h @@ -4215,7 +4215,7 @@ enum { /* pass one of these to get_vtbl */ #define HINT_STRICT_REFS 0x00000002 /* strict pragma */ #define HINT_LOCALE 0x00000004 /* locale pragma */ #define HINT_BYTES 0x00000008 /* bytes pragma */ -/* #define HINT_notused10 0x00000010 */ +#define HINT_ARYBASE 0x00000010 /* $[ is non-zero */ /* Note: 20,40,80 used for NATIVE_HINTS */ /* currently defined by vms/vmsish.h */ diff --git a/proto.h b/proto.h index 0d8d7b1..609341f 100644 --- a/proto.h +++ b/proto.h @@ -731,6 +731,9 @@ PERL_CALLCONV void Perl_hv_ksplit(pTHX_ HV* hv, IV newmax) __attribute__nonnull__(pTHX_1); */ PERL_CALLCONV HV * Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *c); +PERL_CALLCONV SV * Perl_refcounted_he_fetch(pTHX_ const struct refcounted_he *chain, SV *keysv, const char *key, STRLEN klen, int flags, U32 hash) + __attribute__nonnull__(pTHX_1); + PERL_CALLCONV void Perl_refcounted_he_free(pTHX_ struct refcounted_he *he); PERL_CALLCONV struct refcounted_he * Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, SV *const key, SV *const value); PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash); @@ -2955,6 +2958,9 @@ STATIC HE* S_hv_fetch_common(pTHX_ HV* tb, SV* keysv, const char* key, STRLEN kl STATIC void S_clear_placeholders(pTHX_ HV* hb, U32 items) __attribute__nonnull__(pTHX_1); +STATIC SV * S_refcounted_he_value(pTHX_ const struct refcounted_he *he) + __attribute__nonnull__(pTHX_1); + #endif #if defined(PERL_IN_MG_C) || defined(PERL_DECL_PROT)