This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
si_cxsubix not restored on goto &XS_sub
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index 37895e6..f9bf852 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -190,7 +190,7 @@ associated with the key.
     Perl_refcounted_he_fetch_pvn(aTHX_ cophh, keypv, keylen, hash, flags)
 
 /*
-=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|"literal string" key|U32 flags
+=for apidoc Amx|SV *|cophh_fetch_pvs|const COPHH *cophh|"key"|U32 flags
 
 Like L</cophh_fetch_pvn>, but takes a literal string instead
 of a string/length pair, and no precomputed hash.
@@ -296,7 +296,7 @@ be stored with referential integrity, but will be coerced to strings.
     Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, value, flags)
 
 /*
-=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|"literal string" key|SV *value|U32 flags
+=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|"key"|SV *value|U32 flags
 
 Like L</cophh_store_pvn>, but takes a literal string instead
 of a string/length pair, and no precomputed hash.
@@ -353,7 +353,7 @@ hash of the key string, or zero if it has not been precomputed.
        (SV *)NULL, flags)
 
 /*
-=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|"literal string" key|U32 flags
+=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|"key"|U32 flags
 
 Like L</cophh_delete_pvn>, but takes a literal string instead
 of a string/length pair, and no precomputed hash.
@@ -493,7 +493,7 @@ associated with the key.
     cophh_fetch_pvn(CopHINTHASH_get(cop), keypv, keylen, hash, flags)
 
 /*
-=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|"literal string" key|U32 flags
+=for apidoc Am|SV *|cop_hints_fetch_pvs|const COP *cop|"key"|U32 flags
 
 Like L</cop_hints_fetch_pvn>, but takes a literal string
 instead of a string/length pair, and no precomputed hash.
@@ -541,6 +541,24 @@ be zero.
 #define cop_hints_2hv(cop, flags) \
     cophh_2hv(CopHINTHASH_get(cop), flags)
 
+/*
+=for apidoc Am|const char *|CopLABEL|COP *const cop
+
+Returns the label attached to a cop.
+
+=for apidoc Am|const char *|CopLABEL_len|COP *const cop|STRLEN *len
+
+Returns the label attached to a cop, and stores its length in bytes into
+C<*len>.
+
+=for apidoc Am|const char *|CopLABEL_len_flags|COP *const cop|STRLEN *len|U32 *flags
+
+Returns the label attached to a cop, and stores its length in bytes into
+C<*len>.  Upon return, C<*flags> will be set to either C<SVf_UTF8> or 0.
+
+=cut
+*/
+
 #define CopLABEL(c)  Perl_cop_fetch_label(aTHX_ (c), NULL, NULL)
 #define CopLABEL_len(c,len)  Perl_cop_fetch_label(aTHX_ (c), len, NULL)
 #define CopLABEL_len_flags(c,len,flags)  Perl_cop_fetch_label(aTHX_ (c), len, flags)
@@ -567,6 +585,7 @@ be zero.
 /* subroutine context */
 struct block_sub {
     OP *       retop;  /* op to execute on exit from sub */
+    I32         old_cxsubix;  /* previous value of si_cxsubix */
     /* Above here is the same for sub, format and eval.  */
     PAD                *prevcomppad; /* the caller's PL_comppad */
     CV *       cv;
@@ -579,6 +598,7 @@ struct block_sub {
 /* format context */
 struct block_format {
     OP *       retop;  /* op to execute on exit from sub */
+    I32         old_cxsubix;  /* previous value of si_cxsubix */
     /* Above here is the same for sub, format and eval.  */
     PAD                *prevcomppad; /* the caller's PL_comppad */
     CV *       cv;
@@ -645,6 +665,7 @@ struct block_format {
 /* eval context */
 struct block_eval {
     OP *       retop;  /* op to execute on exit from eval */
+    I32         old_cxsubix;  /* previous value of si_cxsubix */
     /* Above here is the same for sub, format and eval.  */
     SV *       old_namesv;
     OP *       old_eval_root;
@@ -721,9 +742,10 @@ struct block_loop {
 
 
 
-/* when context */
-struct block_when {
+/* given/when context */
+struct block_givwhen {
        OP *leave_op;
+        SV *defsv_save; /* the original $_ */
 };
 
 
@@ -747,7 +769,7 @@ struct block {
        struct block_format     blku_format;
        struct block_eval       blku_eval;
        struct block_loop       blku_loop;
-       struct block_when       blku_when;
+       struct block_givwhen    blku_givwhen;
     } blk_u;
 };
 #define blk_oldsp      cx_u.cx_blk.blku_oldsp
@@ -763,7 +785,7 @@ struct block {
 #define blk_format     cx_u.cx_blk.blk_u.blku_format
 #define blk_eval       cx_u.cx_blk.blk_u.blku_eval
 #define blk_loop       cx_u.cx_blk.blk_u.blku_loop
-#define blk_when       cx_u.cx_blk.blk_u.blku_when
+#define blk_givwhen    cx_u.cx_blk.blk_u.blku_givwhen
 
 #define CX_DEBUG(cx, action)                                           \
     DEBUG_l(                                                           \
@@ -858,9 +880,14 @@ struct context {
 #define CXt_NULL       0 /* currently only used for sort BLOCK */
 #define CXt_WHEN       1
 #define CXt_BLOCK      2
-/* be careful of the ordering of these six. Macros like CxTYPE_is_LOOP,
+/* When micro-optimising :-) keep GIVEN next to the LOOPs, as these 5 share a
+   jump table in pp_ctl.c
+   The first 4 don't have a 'case' in at least one switch statement in pp_ctl.c
+*/
+#define CXt_GIVEN      3
+
+/* be careful of the ordering of these five. Macros like CxTYPE_is_LOOP,
  * CxFOREACH compare ranges */
-#define CXt_LOOP_GIVEN 3 /* given (...)    { ...; } */
 #define CXt_LOOP_ARY   4 /* for (@ary)     { ...; } */
 #define CXt_LOOP_LAZYSV        5 /* for ('a'..'z') { ...; } */
 #define CXt_LOOP_LAZYIV        6 /* for (1..9)     { ...; } */
@@ -899,7 +926,7 @@ struct context {
 #define CXp_ONCE       0x10    /* What was sbu_once in struct subst */
 
 #define CxTYPE(c)      ((c)->cx_type & CXTYPEMASK)
-#define CxTYPE_is_LOOP(c) (   CxTYPE(cx) >= CXt_LOOP_GIVEN              \
+#define CxTYPE_is_LOOP(c) (   CxTYPE(cx) >= CXt_LOOP_ARY                \
                            && CxTYPE(cx) <= CXt_LOOP_PLAIN)
 #define CxMULTICALL(c) ((c)->cx_type & CXp_MULTICALL)
 #define CxREALEVAL(c)  (((c)->cx_type & (CXTYPEMASK|CXp_REAL))         \
@@ -916,27 +943,27 @@ struct context {
 */
 
 /*
-=for apidoc AmU||G_SCALAR
+=for apidoc AmnU||G_SCALAR
 Used to indicate scalar context.  See C<L</GIMME_V>>, C<L</GIMME>>, and
 L<perlcall>.
 
-=for apidoc AmU||G_ARRAY
+=for apidoc AmnU||G_ARRAY
 Used to indicate list context.  See C<L</GIMME_V>>, C<L</GIMME>> and
 L<perlcall>.
 
-=for apidoc AmU||G_VOID
+=for apidoc AmnU||G_VOID
 Used to indicate void context.  See C<L</GIMME_V>> and L<perlcall>.
 
-=for apidoc AmU||G_DISCARD
+=for apidoc AmnU||G_DISCARD
 Indicates that arguments returned from a callback should be discarded.  See
 L<perlcall>.
 
-=for apidoc AmU||G_EVAL
+=for apidoc AmnU||G_EVAL
 
 Used to force a Perl C<eval> wrapper around a callback.  See
 L<perlcall>.
 
-=for apidoc AmU||G_NOARGS
+=for apidoc AmnU||G_NOARGS
 
 Indicates that no arguments are being sent to a callback.  See
 L<perlcall>.
@@ -950,23 +977,24 @@ L<perlcall>.
 #define G_WANT         3
 
 /* extra flags for Perl_call_* routines */
-#define G_DISCARD      4       /* Call FREETMPS.
+#define G_DISCARD         0x4  /* Call FREETMPS.
                                   Don't change this without consulting the
                                   hash actions codes defined in hv.h */
-#define G_EVAL         8       /* Assume eval {} around subroutine call. */
-#define G_NOARGS       16      /* Don't construct a @_ array. */
-#define G_KEEPERR      32      /* Warn for errors, don't overwrite $@ */
-#define G_NODEBUG      64      /* Disable debugging at toplevel.  */
-#define G_METHOD      128       /* Calling method. */
-#define G_FAKINGEVAL  256      /* Faking an eval context for call_sv or
+#define G_EVAL           0x8   /* Assume eval {} around subroutine call. */
+#define G_NOARGS         0x10  /* Don't construct a @_ array. */
+#define G_KEEPERR        0x20  /* Warn for errors, don't overwrite $@ */
+#define G_NODEBUG        0x40  /* Disable debugging at toplevel.  */
+#define G_METHOD         0x80   /* Calling method. */
+#define G_FAKINGEVAL    0x100  /* Faking an eval context for call_sv or
                                   fold_constants. */
-#define G_UNDEF_FILL  512      /* Fill the stack with &PL_sv_undef
+#define G_UNDEF_FILL    0x200  /* Fill the stack with &PL_sv_undef
                                   A special case for UNSHIFT in
                                   Perl_magic_methcall().  */
-#define G_WRITING_TO_STDERR 1024 /* Perl_write_to_stderr() is calling
+#define G_WRITING_TO_STDERR 0x400 /* Perl_write_to_stderr() is calling
                                    Perl_magic_methcall().  */
-#define G_RE_REPARSING 0x800     /* compiling a run-time /(?{..})/ */
-#define G_METHOD_NAMED 4096    /* calling named method, eg without :: or ' */
+#define G_RE_REPARSING  0x800   /* compiling a run-time /(?{..})/ */
+#define G_METHOD_NAMED 0x1000  /* calling named method, eg without :: or ' */
+#define G_RETHROW      0x2000  /* eval_sv(): re-throw any error */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL      0       /* not in an eval */
@@ -1001,6 +1029,7 @@ struct stackinfo {
     struct stackinfo * si_next;
     I32                        si_cxix;        /* current context index */
     I32                        si_cxmax;       /* maximum allocated index */
+    I32                        si_cxsubix;     /* topmost sub/eval/format */
     I32                        si_type;        /* type of runlevel */
     I32                        si_markoff;     /* offset where markstack begins for us.
                                         * currently used only with DEBUGGING,
@@ -1047,6 +1076,7 @@ typedef struct stackinfo PERL_SI;
        }                                                               \
        next->si_type = type;                                           \
        next->si_cxix = -1;                                             \
+       next->si_cxsubix = -1;                                          \
         PUSHSTACK_INIT_HWM(next);                                       \
        AvFILLp(next->si_stack) = 0;                                    \
        SWITCHSTACK(PL_curstack,next->si_stack);                        \
@@ -1092,17 +1122,17 @@ typedef struct stackinfo PERL_SI;
 /*
 =head1 Multicall Functions
 
-=for apidoc Ams||dMULTICALL
+=for apidoc Amns||dMULTICALL
 Declare local variables for a multicall.  See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
-=for apidoc Ams||PUSH_MULTICALL
+=for apidoc Ams||PUSH_MULTICALL|CV* the_cv
 Opening bracket for a lightweight callback.
 See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
-=for apidoc Ams||MULTICALL
+=for apidoc Amns||MULTICALL
 Make a lightweight callback.  See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
-=for apidoc Ams||POP_MULTICALL
+=for apidoc Amns||POP_MULTICALL
 Closing bracket for a lightweight callback.
 See L<perlcall/LIGHTWEIGHT CALLBACKS>.