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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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
 /*