Change 33656 by [EMAIL PROTECTED] on 2008/04/07 11:29:51
Eliminate cop_label from struct cop by storing a label as the first
entry in the hints hash. Most statements don't have labels, so this
will save memory. Not sure how much.
Affected files ...
... //depot/perl/cop.h#179 edit
... //depot/perl/embed.fnc#609 edit
... //depot/perl/embed.h#756 edit
... //depot/perl/ext/B/B/Deparse.pm#192 edit
... //depot/perl/global.sym#354 edit
... //depot/perl/hv.c#372 edit
... //depot/perl/op.c#997 edit
... //depot/perl/proto.h#944 edit
Differences ...
==== //depot/perl/cop.h#179 (text) ====
Index: perl/cop.h
--- perl/cop.h#178~33655~ 2008-04-06 14:53:57.000000000 -0700
+++ perl/cop.h 2008-04-07 04:29:51.000000000 -0700
@@ -139,7 +139,7 @@
/* On LP64 putting this here takes advantage of the fact that BASEOP isn't
an exact multiple of 8 bytes to save structure padding. */
line_t cop_line; /* line # of this command */
- char * cop_label; /* label for this construct */
+ /* label for this construct is now stored in cop_hints_hash */
#ifdef USE_ITHREADS
char * cop_stashpv; /* package line was compiled in */
char * cop_file; /* file name the following line # is from */
@@ -191,18 +191,12 @@
? gv_stashpv(CopSTASHPV(c),GV_ADD) : NULL)
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : NULL)
# define CopSTASH_eq(c,hv) ((hv) && stashpv_hvname_match(c,hv))
-# define CopLABEL(c) ((c)->cop_label)
-# define CopLABEL_set(c,pv) (CopLABEL(c) = (pv))
# ifdef NETWARE
# define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
# define CopFILE_free(c) SAVECOPFILE_FREE(c)
-# define CopLABEL_free(c) SAVESHAREDPV(CopLABEL(c))
-# define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
# else
# define CopSTASH_free(c) PerlMemShared_free(CopSTASHPV(c))
# define CopFILE_free(c) (PerlMemShared_free(CopFILE(c)),(CopFILE(c) =
NULL))
-# define CopLABEL_free(c) (PerlMemShared_free(CopLABEL(c)),(CopLABEL(c) =
NULL))
-# define CopLABEL_alloc(pv) ((pv)?savesharedpv(pv):NULL)
# endif
#else
# define CopFILEGV(c) ((c)->cop_filegv)
@@ -219,19 +213,17 @@
# define CopFILE(c) (CopFILEGV(c) && GvSV(CopFILEGV(c)) \
? SvPVX(GvSV(CopFILEGV(c))) : NULL)
# define CopSTASH(c) ((c)->cop_stash)
-# define CopLABEL(c) ((c)->cop_label)
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c))
: NULL)
/* cop_stash is not refcounted */
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
-# define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
-# define CopLABEL_set(c,pv) (CopLABEL(c) = (pv))
# define CopSTASH_free(c)
# define CopFILE_free(c) (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) =
NULL))
-# define CopLABEL_free(c) (Safefree(CopLABEL(c)),(CopLABEL(c) = NULL))
#endif /* USE_ITHREADS */
+#define CopLABEL(c) Perl_fetch_cop_label(aTHX_ (c)->cop_hints_hash, NULL,
NULL)
+#define CopLABEL_alloc(pv) ((pv)?savepv(pv):NULL)
#define CopSTASH_ne(c,hv) (!CopSTASH_eq(c,hv))
#define CopLINE(c) ((c)->cop_line)
==== //depot/perl/embed.fnc#609 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#608~33627~ 2008-04-01 12:59:54.000000000 -0700
+++ perl/embed.fnc 2008-04-07 04:29:51.000000000 -0700
@@ -1979,7 +1979,8 @@
Apon |void |sys_init |NN int* argc|NN char*** argv
Apon |void |sys_init3 |NN int* argc|NN char*** argv|NN char*** env
Apon |void |sys_term
-
+ApM |const char *|fetch_cop_label|NULLOK struct refcounted_he *const chain \
+ |NULLOK STRLEN *len|NULLOK U32 *flags
END_EXTERN_C
/*
==== //depot/perl/embed.h#756 (text+w) ====
Index: perl/embed.h
--- perl/embed.h#755~33627~ 2008-04-01 12:59:54.000000000 -0700
+++ perl/embed.h 2008-04-07 04:29:51.000000000 -0700
@@ -1934,6 +1934,7 @@
#ifdef PERL_CORE
#define boot_core_mro Perl_boot_core_mro
#endif
+#define fetch_cop_label Perl_fetch_cop_label
#define ck_anoncode Perl_ck_anoncode
#define ck_bitop Perl_ck_bitop
#define ck_chdir Perl_ck_chdir
@@ -4253,6 +4254,7 @@
#ifdef PERL_CORE
#define boot_core_mro() Perl_boot_core_mro(aTHX)
#endif
+#define fetch_cop_label(a,b,c) Perl_fetch_cop_label(aTHX_ a,b,c)
#define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a)
#define ck_bitop(a) Perl_ck_bitop(aTHX_ a)
#define ck_chdir(a) Perl_ck_chdir(aTHX_ a)
==== //depot/perl/ext/B/B/Deparse.pm#192 (text) ====
Index: perl/ext/B/B/Deparse.pm
--- perl/ext/B/B/Deparse.pm#191~32910~ 2008-01-09 02:11:10.000000000 -0800
+++ perl/ext/B/B/Deparse.pm 2008-04-07 04:29:51.000000000 -0700
@@ -21,7 +21,7 @@
PMf_KEEP PMf_GLOBAL PMf_CONTINUE PMf_EVAL PMf_ONCE
PMf_MULTILINE PMf_SINGLELINE PMf_FOLD PMf_EXTENDED),
($] < 5.009 ? 'PMf_SKIPWHITE' : 'RXf_SKIPWHITE');
-$VERSION = 0.86;
+$VERSION = 0.87;
use strict;
use vars qw/$AUTOLOAD/;
use warnings ();
@@ -1456,6 +1456,7 @@
my %ignored_hints = (
'open<' => 1,
'open>' => 1,
+ ':' => 1,
);
sub declare_hinthash {
==== //depot/perl/global.sym#354 (text+w) ====
Index: perl/global.sym
--- perl/global.sym#353~33618~ 2008-03-31 12:48:26.000000000 -0700
+++ perl/global.sym 2008-04-07 04:29:51.000000000 -0700
@@ -770,4 +770,5 @@
Perl_sys_init
Perl_sys_init3
Perl_sys_term
+Perl_fetch_cop_label
# ex: set ro:
==== //depot/perl/hv.c#372 (text) ====
Index: perl/hv.c
--- perl/hv.c#371~33390~ 2008-02-27 11:11:12.000000000 -0800
+++ perl/hv.c 2008-04-07 04:29:51.000000000 -0700
@@ -2878,6 +2878,31 @@
}
}
+const char *
+Perl_fetch_cop_label(pTHX_ struct refcounted_he *const chain, STRLEN *len,
+ U32 *flags) {
+ if (!chain)
+ return NULL;
+#ifdef USE_ITHREADS
+ if (chain->refcounted_he_keylen != 1)
+ return NULL;
+ if (*REF_HE_KEY(chain) != ':')
+ return NULL;
+#else
+ if ((STRLEN)HEK_LEN(chain->refcounted_he_hek) != 1)
+ return NULL;
+ if (*HEK_KEY(chain->refcounted_he_hek) != ':')
+ return NULL;
+#endif
+ if (len)
+ *len = chain->refcounted_he_val.refcounted_he_u_len;
+ if (flags) {
+ *flags = ((chain->refcounted_he_data[0] & HVrhek_typemask)
+ == HVrhek_PV_UTF8) ? SVf_UTF8 : 0;
+ }
+ return chain->refcounted_he_data + 1;
+}
+
/*
=for apidoc hv_assert
==== //depot/perl/op.c#997 (text) ====
Index: perl/op.c
--- perl/op.c#996~33467~ 2008-03-10 14:34:23.000000000 -0700
+++ perl/op.c 2008-04-07 04:29:51.000000000 -0700
@@ -672,7 +672,6 @@
{
PERL_ARGS_ASSERT_COP_FREE;
- CopLABEL_free(cop);
CopFILE_free(cop);
CopSTASH_free(cop);
if (! specialWARN(cop->cop_warnings))
@@ -4369,10 +4368,6 @@
CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
cop->op_next = (OP*)cop;
- if (label) {
- CopLABEL_set(cop, label);
- PL_hints |= HINT_BLOCK_SCOPE;
- }
cop->cop_seq = seq;
/* CopARYBASE is now "virtual", in that it's stored as a flag bit in
CopHINTS and a possible value in cop_hints_hash, so no need to copy it.
@@ -4384,6 +4379,22 @@
cop->cop_hints_hash->refcounted_he_refcnt++;
HINTS_REFCNT_UNLOCK;
}
+ if (label) {
+ /* Proof of concept for now - for efficiency reasons these are likely
+ to end up being replaced by a custom function in hv.c */
+ SV *const key = newSVpvs(":");
+ SV *const value = newSVpv(label, 0);
+ cop->cop_hints_hash
+ = Perl_refcounted_he_new(aTHX_ cop->cop_hints_hash, key, value);
+
+ PL_hints |= HINT_BLOCK_SCOPE;
+ /* It seems that we need to defer freeing this pointer, as other parts
+ of the grammar end up wanting to copy it after this op has been
+ created. */
+ SAVEFREEPV(label);
+ SvREFCNT_dec(key);
+ SvREFCNT_dec(value);
+ }
if (PL_parser && PL_parser->copline == NOLINE)
CopLINE_set(cop, CopLINE(PL_curcop));
==== //depot/perl/proto.h#944 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#943~33627~ 2008-04-01 12:59:54.000000000 -0700
+++ perl/proto.h 2008-04-07 04:29:51.000000000 -0700
@@ -6566,7 +6566,7 @@
assert(argc); assert(argv); assert(env)
PERL_CALLCONV void Perl_sys_term(void);
-
+PERL_CALLCONV const char * Perl_fetch_cop_label(pTHX_ struct refcounted_he
*const chain, STRLEN *len, U32 *flags);
END_EXTERN_C
/*
End of Patch.
