This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
create t/re/speed.t, t/re/speed_thr.t
[perl5.git] / cv.h
diff --git a/cv.h b/cv.h
index cd722f3..8ba1c5c 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -13,7 +13,6 @@
 struct xpvcv {
     _XPV_HEAD;
     _XPVCV_COMMON;
 struct xpvcv {
     _XPV_HEAD;
     _XPVCV_COMMON;
-    I32        xcv_depth;      /* >= 2 indicates recursive call */
 };
 
 /*
 };
 
 /*
@@ -27,10 +26,10 @@ Null CV pointer.
 =head1 CV Manipulation Functions
 
 This section documents functions to manipulate CVs which are code-values,
 =head1 CV Manipulation Functions
 
 This section documents functions to manipulate CVs which are code-values,
-or subroutines. For more information, see L<perlguts>.
+or subroutines.  For more information, see L<perlguts>.
 
 =for apidoc Am|HV*|CvSTASH|CV* cv
 
 =for apidoc Am|HV*|CvSTASH|CV* cv
-Returns the stash of the CV. A stash is the symbol table hash, containing
+Returns the stash of the CV.  A stash is the symbol table hash, containing
 the package-scoped variables in the package where the subroutine was defined.
 For more information, see L<perlguts>.
 
 the package-scoped variables in the package where the subroutine was defined.
 For more information, see L<perlguts>.
 
@@ -50,8 +49,9 @@ See L<perlguts/Autoloading with XSUBs>.
 #define CvROOT(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root
 #define CvXSUB(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub
 #define CvXSUBANY(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany
 #define CvROOT(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root
 #define CvXSUB(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub
 #define CvXSUBANY(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_xsubany
-#define CvGV(sv)       (0+((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv)
+#define CvGV(sv)       S_CvGV(aTHX_ (CV *)(sv))
 #define CvGV_set(cv,gv)        Perl_cvgv_set(aTHX_ cv, gv)
 #define CvGV_set(cv,gv)        Perl_cvgv_set(aTHX_ cv, gv)
+#define CvHASGV(cv)    cBOOL(SvANY(cv)->xcv_gv_u.xcv_gv)
 #define CvFILE(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file
 #ifdef USE_ITHREADS
 #  define CvFILE_set_from_cop(sv, cop) \
 #define CvFILE(sv)     ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_file
 #ifdef USE_ITHREADS
 #  define CvFILE_set_from_cop(sv, cop) \
@@ -61,26 +61,7 @@ See L<perlguts/Autoloading with XSUBs>.
     (CvFILE(sv) = CopFILE(cop), CvDYNFILE_off(sv))
 #endif
 #define CvFILEGV(sv)   (gv_fetchfile(CvFILE(sv)))
     (CvFILE(sv) = CopFILE(cop), CvDYNFILE_off(sv))
 #endif
 #define CvFILEGV(sv)   (gv_fetchfile(CvFILE(sv)))
-PERL_STATIC_INLINE I32 *
-S_CvDEPTHp(const CV * const sv)
-{
-    return SvTYPE(sv) == SVt_PVCV
-       ? &((XPVCV*)SvANY(sv))->xcv_depth
-#if defined(_MSC_VER) && _MSC_VER < 1300
-       : &((XPVCV*)SvANY(sv))->xpvcuru_fmdepth;
-#else
-       : &((XPVCV*)SvANY(sv))->xpv_cur_u.xpvcuru_fmdepth;
-#endif
-}
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-#  define CvDEPTH(sv) (*({const CV *const _cvdepth = (const CV *)sv; \
-                         assert(SvTYPE(_cvdepth) == SVt_PVCV         \
-                             || SvTYPE(_cvdepth) == SVt_PVFM);        \
-                         S_CvDEPTHp(_cvdepth);                         \
-                       }))
-#else
-#  define CvDEPTH(sv)  (*S_CvDEPTHp((const CV *)sv))
-#endif
+#define CvDEPTH(sv)    (*S_CvDEPTHp((const CV *)sv))
 #define CvPADLIST(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist
 #define CvOUTSIDE(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside
 #define CvFLAGS(sv)    ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags
 #define CvPADLIST(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist
 #define CvOUTSIDE(sv)  ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside
 #define CvFLAGS(sv)    ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags
@@ -123,6 +104,8 @@ S_CvDEPTHp(const CV * const sv)
 #define CVf_DYNFILE    0x1000  /* The filename isn't static  */
 #define CVf_AUTOLOAD   0x2000  /* SvPVX contains AUTOLOADed sub name  */
 #define CVf_HASEVAL    0x4000  /* contains string eval  */
 #define CVf_DYNFILE    0x1000  /* The filename isn't static  */
 #define CVf_AUTOLOAD   0x2000  /* SvPVX contains AUTOLOADed sub name  */
 #define CVf_HASEVAL    0x4000  /* contains string eval  */
+#define CVf_NAMED      0x8000  /* Has a name HEK */
+#define CVf_LEXICAL    0x10000 /* Omit package from name */
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS      (CVf_METHOD|CVf_LVALUE)
 
 /* This symbol for optimised communication between toke.c and op.c: */
 #define CVf_BUILTIN_ATTRS      (CVf_METHOD|CVf_LVALUE)
@@ -200,28 +183,53 @@ S_CvDEPTHp(const CV * const sv)
 #define CvHASEVAL_on(cv)       (CvFLAGS(cv) |= CVf_HASEVAL)
 #define CvHASEVAL_off(cv)      (CvFLAGS(cv) &= ~CVf_HASEVAL)
 
 #define CvHASEVAL_on(cv)       (CvFLAGS(cv) |= CVf_HASEVAL)
 #define CvHASEVAL_off(cv)      (CvFLAGS(cv) &= ~CVf_HASEVAL)
 
+#define CvNAMED(cv)            (CvFLAGS(cv) & CVf_NAMED)
+#define CvNAMED_on(cv)         (CvFLAGS(cv) |= CVf_NAMED)
+#define CvNAMED_off(cv)                (CvFLAGS(cv) &= ~CVf_NAMED)
+
+#define CvLEXICAL(cv)          (CvFLAGS(cv) & CVf_LEXICAL)
+#define CvLEXICAL_on(cv)       (CvFLAGS(cv) |= CVf_LEXICAL)
+#define CvLEXICAL_off(cv)      (CvFLAGS(cv) &= ~CVf_LEXICAL)
+
 /* Flags for newXS_flags  */
 #define XS_DYNAMIC_FILENAME    0x01    /* The filename isn't static  */
 
 /* Flags for newXS_flags  */
 #define XS_DYNAMIC_FILENAME    0x01    /* The filename isn't static  */
 
+PERL_STATIC_INLINE HEK *
+CvNAME_HEK(CV *sv)
+{
+    return CvNAMED(sv)
+       ? ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_hek
+       : 0;
+}
+/* This lowers the refernce count of the previous value, but does *not*
+   increment the reference count of the new value. */
+#define CvNAME_HEK_set(cv, hek) ( \
+       CvNAME_HEK((CV *)(cv))                                           \
+           ? unshare_hek(SvANY((CV *)(cv))->xcv_gv_u.xcv_hek)    \
+           : (void)0,                                             \
+       ((XPVCV*)MUTABLE_PTR(SvANY(cv)))->xcv_gv_u.xcv_hek = (hek), \
+       CvNAMED_on(cv)                                               \
+    )
+
 /*
 =head1 CV reference counts and CvOUTSIDE
 
 =for apidoc m|bool|CvWEAKOUTSIDE|CV *cv
 
 Each CV has a pointer, C<CvOUTSIDE()>, to its lexically enclosing
 /*
 =head1 CV reference counts and CvOUTSIDE
 
 =for apidoc m|bool|CvWEAKOUTSIDE|CV *cv
 
 Each CV has a pointer, C<CvOUTSIDE()>, to its lexically enclosing
-CV (if any). Because pointers to anonymous sub prototypes are
+CV (if any).  Because pointers to anonymous sub prototypes are
 stored in C<&> pad slots, it is a possible to get a circular reference,
 stored in C<&> pad slots, it is a possible to get a circular reference,
-with the parent pointing to the child and vice-versa. To avoid the
+with the parent pointing to the child and vice-versa.  To avoid the
 ensuing memory leak, we do not increment the reference count of the CV
 pointed to by C<CvOUTSIDE> in the I<one specific instance> that the parent
 ensuing memory leak, we do not increment the reference count of the CV
 pointed to by C<CvOUTSIDE> in the I<one specific instance> that the parent
-has a C<&> pad slot pointing back to us. In this case, we set the
-C<CvWEAKOUTSIDE> flag in the child. This allows us to determine under what
+has a C<&> pad slot pointing back to us.  In this case, we set the
+C<CvWEAKOUTSIDE> flag in the child.  This allows us to determine under what
 circumstances we should decrement the refcount of the parent when freeing
 the child.
 
 There is a further complication with non-closure anonymous subs (i.e. those
 circumstances we should decrement the refcount of the parent when freeing
 the child.
 
 There is a further complication with non-closure anonymous subs (i.e. those
-that do not refer to any lexicals outside that sub). In this case, the
-anonymous prototype is shared rather than being cloned. This has the
+that do not refer to any lexicals outside that sub).  In this case, the
+anonymous prototype is shared rather than being cloned.  This has the
 consequence that the parent may be freed while there are still active
 children, eg
 
 consequence that the parent may be freed while there are still active
 children, eg
 
@@ -237,16 +245,16 @@ and the freed BEGIN is accessed.
 To avoid this, whenever a CV and its associated pad is freed, any
 C<&> entries in the pad are explicitly removed from the pad, and if the
 refcount of the pointed-to anon sub is still positive, then that
 To avoid this, whenever a CV and its associated pad is freed, any
 C<&> entries in the pad are explicitly removed from the pad, and if the
 refcount of the pointed-to anon sub is still positive, then that
-child's C<CvOUTSIDE> is set to point to its grandparent. This will only
+child's C<CvOUTSIDE> is set to point to its grandparent.  This will only
 occur in the single specific case of a non-closure anon prototype
 having one or more active references (such as C<$a> above).
 
 One other thing to consider is that a CV may be merely undefined
 occur in the single specific case of a non-closure anon prototype
 having one or more active references (such as C<$a> above).
 
 One other thing to consider is that a CV may be merely undefined
-rather than freed, eg C<undef &foo>. In this case, its refcount may
+rather than freed, eg C<undef &foo>.  In this case, its refcount may
 not have reached zero, but we still delete its pad and its C<CvROOT> etc.
 Since various children may still have their C<CvOUTSIDE> pointing at this
 undefined CV, we keep its own C<CvOUTSIDE> for the time being, so that
 not have reached zero, but we still delete its pad and its C<CvROOT> etc.
 Since various children may still have their C<CvOUTSIDE> pointing at this
 undefined CV, we keep its own C<CvOUTSIDE> for the time being, so that
-the chain of lexical scopes is unbroken. For example, the following
+the chain of lexical scopes is unbroken.  For example, the following
 should print 123:
 
     my $x = 123;
 should print 123:
 
     my $x = 123;
@@ -260,6 +268,12 @@ should print 123:
 
 typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);
 
 
 typedef OP *(*Perl_call_checker)(pTHX_ OP *, GV *, SV *);
 
+#define CALL_CHECKER_REQUIRE_GV        MGf_REQUIRE_GV
+
+#ifdef PERL_CORE
+# define CV_UNDEF_KEEP_NAME    1
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd
 /*
  * Local variables:
  * c-indentation-style: bsd