From: Nicholas Clark <nick@ccl4.org>
Date: Mon, 7 Apr 2008 11:29:51 +0000 (+0000)
Subject: Eliminate cop_label from struct cop by storing a label as the first
X-Git-Tag: GitLive-blead~894
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/dca6062a863d0e957d067cc75f9e13b2e28b1090

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.

p4raw-id: //depot/perl@33656
---

diff --git a/cop.h b/cop.h
index d1e46da..85ec068 100644
--- a/cop.h
+++ b/cop.h
@@ -139,7 +139,7 @@ struct cop {
     /* 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 @@ struct cop {
 				 ? 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 @@ struct cop {
 #  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)
diff --git a/embed.fnc b/embed.fnc
index af39856..316cfe5 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1979,7 +1979,8 @@ p	|void   |boot_core_mro
 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
 /*
diff --git a/embed.h b/embed.h
index df3a26c..117da37 100644
--- a/embed.h
+++ b/embed.h
@@ -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)
diff --git a/ext/B/B/Deparse.pm b/ext/B/B/Deparse.pm
index b0435ae..12e029b 100644
--- a/ext/B/B/Deparse.pm
+++ b/ext/B/B/Deparse.pm
@@ -21,7 +21,7 @@ use B qw(class main_root main_start main_cv svref_2object opnumber perlstring
 	 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 @@ sub declare_hints {
 my %ignored_hints = (
     'open<' => 1,
     'open>' => 1,
+    ':'     => 1,
 );
 
 sub declare_hinthash {
diff --git a/global.sym b/global.sym
index 870b77b..f00e96d 100644
--- a/global.sym
+++ b/global.sym
@@ -770,4 +770,5 @@ Perl_mro_method_changed_in
 Perl_sys_init
 Perl_sys_init3
 Perl_sys_term
+Perl_fetch_cop_label
 # ex: set ro:
diff --git a/hv.c b/hv.c
index f85fad3..98cdc31 100644
--- a/hv.c
+++ b/hv.c
@@ -2878,6 +2878,31 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) {
     }
 }
 
+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
 
diff --git a/op.c b/op.c
index db2a67b..3997fac 100644
--- a/op.c
+++ b/op.c
@@ -672,7 +672,6 @@ S_cop_free(pTHX_ COP* cop)
 {
     PERL_ARGS_ASSERT_COP_FREE;
 
-    CopLABEL_free(cop);
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
@@ -4369,10 +4368,6 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
     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 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	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));
diff --git a/proto.h b/proto.h
index 33977b8..6773000 100644
--- a/proto.h
+++ b/proto.h
@@ -6566,7 +6566,7 @@ PERL_CALLCONV void	Perl_sys_init3(int* argc, char*** argv, char*** env)
 	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
 /*