Change 28250 by [EMAIL PROTECTED] on 2006/05/20 11:29:26
Abolish cop_arybase. Signal a non zero $[ with a hint flag, and store
the value in the hints structure used for %^H.
Affected files ...
... //depot/perl/cop.h#117 edit
... //depot/perl/embed.fnc#381 edit
... //depot/perl/embed.h#604 edit
... //depot/perl/global.sym#303 edit
... //depot/perl/hv.c#317 edit
... //depot/perl/op.c#824 edit
... //depot/perl/perl.h#699 edit
... //depot/perl/proto.h#724 edit
Differences ...
==== //depot/perl/cop.h#117 (text) ====
Index: perl/cop.h
--- perl/cop.h#116~28049~ 2006-05-02 01:50:05.000000000 -0700
+++ perl/cop.h 2006-05-20 04:29:26.000000000 -0700
@@ -144,7 +144,6 @@
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 @@
# 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)
==== //depot/perl/embed.fnc#381 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#380~28206~ 2006-05-16 06:14:12.000000000 -0700
+++ perl/embed.fnc 2006-05-20 04:29:26.000000000 -0700
@@ -308,6 +308,9 @@
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 |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)
==== //depot/perl/embed.h#604 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#603~28205~ 2006-05-16 06:09:17.000000000 -0700
+++ perl/embed.h 2006-05-20 04:29:26.000000000 -0700
@@ -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)
==== //depot/perl/global.sym#303 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#302~28183~ 2006-05-12 13:57:07.000000000 -0700
+++ perl/global.sym 2006-05-20 04:29:26.000000000 -0700
@@ -164,6 +164,7 @@
Perl_hv_iterval
Perl_hv_ksplit
Perl_hv_magic
+Perl_refcounted_he_fetch
Perl_hv_store
Perl_hv_store_ent
Perl_hv_store_flags
==== //depot/perl/hv.c#317 (text) ====
Index: perl/hv.c
--- perl/hv.c#316~28245~ 2006-05-19 14:44:14.000000000 -0700
+++ perl/hv.c 2006-05-20 04:29:26.000000000 -0700
@@ -2552,6 +2552,51 @@
/* 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 @@
#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 @@
#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 @@
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
==== //depot/perl/op.c#824 (text) ====
Index: perl/op.c
--- perl/op.c#823~28248~ 2006-05-19 17:43:42.000000000 -0700
+++ perl/op.c 2006-05-20 04:29:26.000000000 -0700
@@ -3946,7 +3946,8 @@
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;
==== //depot/perl/perl.h#699 (text) ====
Index: perl/perl.h
--- perl/perl.h#698~28234~ 2006-05-19 08:17:00.000000000 -0700
+++ perl/perl.h 2006-05-20 04:29:26.000000000 -0700
@@ -4215,7 +4215,7 @@
#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 */
==== //depot/perl/proto.h#724 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#723~28206~ 2006-05-16 06:14:12.000000000 -0700
+++ perl/proto.h 2006-05-20 04:29:26.000000000 -0700
@@ -731,6 +731,9 @@
__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 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)
End of Patch.
