This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
In make_ext.pl, only fudge the Makefile.PL timestamp when generating it.
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index e6650a2..9f3762e 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -138,7 +138,7 @@ typedef struct jmpenv JMPENV;
            PerlProc_longjmp(PL_top_env->je_buf, (v));          \
        if ((v) == 2)                                           \
            PerlProc_exit(STATUS_EXIT);                         \
-       PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");     \
+       PerlIO_printf(PerlIO_stderr(), "panic: top_env, v=%d\n", (int)v); \
        PerlProc_exit(1);                                       \
     } STMT_END
 
@@ -387,7 +387,7 @@ struct cop {
     line_t      cop_line;       /* line # of this command */
     /* label for this construct is now stored in cop_hints_hash */
 #ifdef USE_ITHREADS
-    char *     cop_stashpv;    /* package line was compiled in */
+    PADOFFSET  cop_stashoff;   /* package line was compiled in */
     char *     cop_file;       /* file name the following line # is from */
 #else
     HV *       cop_stash;      /* package line was compiled in */
@@ -425,23 +425,14 @@ struct cop {
 #  else
 #    define CopFILEAVx(c)      (GvAV(gv_fetchfile(CopFILE(c))))
 #  endif
-#  define CopSTASHPV(c)                ((c)->cop_stashpv)
 
+#  define CopSTASH(c)           PL_stashpad[(c)->cop_stashoff]
+#  define CopSTASH_set(c,hv)   ((c)->cop_stashoff = (hv)               \
+                                   ? alloccopstash(hv)                 \
+                                   : 0)
 #  ifdef NETWARE
-#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = ((pv) ? savepv(pv) : NULL))
-#  else
-#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = savesharedpv(pv))
-#  endif
-
-#  define CopSTASH(c)          (CopSTASHPV(c) \
-                                ? 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))
-#  ifdef NETWARE
-#    define CopSTASH_free(c) SAVECOPSTASH_FREE(c)
 #    define CopFILE_free(c) SAVECOPFILE_FREE(c)
 #  else
-#    define CopSTASH_free(c)   PerlMemShared_free(CopSTASHPV(c))
 #    define CopFILE_free(c)    (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
 #  endif
 #else
@@ -460,15 +451,15 @@ struct cop {
                                    ? SvPVX(GvSV(CopFILEGV(c))) : NULL)
 #  define CopSTASH(c)          ((c)->cop_stash)
 #  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 CopSTASH_free(c)     
 #  define CopFILE_free(c)      (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
 
 #endif /* USE_ITHREADS */
 
+#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 CopHINTHASH_get(c)     ((COPHH*)((c)->cop_hints_hash))
 #define CopHINTHASH_set(c,h)   ((c)->cop_hints_hash = (h))
 
@@ -542,7 +533,9 @@ be zero.
 #define cop_hints_2hv(cop, flags) \
     cophh_2hv(CopHINTHASH_get(cop), flags)
 
-#define CopLABEL(c)  Perl_fetch_cop_label(aTHX_ (c), NULL, NULL)
+#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)
 #define CopLABEL_alloc(pv)     ((pv)?savepv(pv):NULL)
 
 #define CopSTASH_ne(c,hv)      (!CopSTASH_eq(c,hv))
@@ -554,30 +547,6 @@ be zero.
 /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
 #define OutCopFILE(c) CopFILE(c)
 
-/* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
-   HINT_ARYBASE is set to indicate this.
-   Setting it is inefficient due to the need to create 2 mortal SVs, but as
-   using $[ is highly discouraged, no sane Perl code will be using it.  */
-#define CopARYBASE_get(c)      \
-       ((CopHINTS_get(c) & HINT_ARYBASE)                               \
-        ? SvIV(cop_hints_fetch_pvs((c), "$[", 0))                      \
-        : 0)
-#define CopARYBASE_set(c, b) STMT_START { \
-       if (b || ((c)->cop_hints & HINT_ARYBASE)) {                     \
-           (c)->cop_hints |= HINT_ARYBASE;                             \
-           if ((c) == &PL_compiling) {                                 \
-               SV *val = newSViv(b);                                   \
-               (void)hv_stores(GvHV(PL_hintgv), "$[", val);            \
-               mg_set(val);                                            \
-               PL_hints |= HINT_ARYBASE;                               \
-           } else {                                                    \
-               CopHINTHASH_set((c),                                    \
-                   cophh_store_pvs(CopHINTHASH_get((c)), "$[",         \
-                       sv_2mortal(newSViv(b)), 0));                    \
-           }                                                           \
-       }                                                               \
-    } STMT_END
-
 /* FIXME NATIVE_HINTS if this is changed from op_private (see perl.h)  */
 #define CopHINTS_get(c)                ((c)->cop_hints + 0)
 #define CopHINTS_set(c, h)     STMT_START {                            \
@@ -643,7 +612,7 @@ struct block_format {
                   ? 0 : Perl_was_lvalue_sub(aTHX);                     \
        PUSHSUB_BASE(cx)                                                \
        cx->blk_u16 = PL_op->op_private &                               \
-                         (phlags|OPpENTERSUB_DEREF);                   \
+                         (phlags|OPpDEREF);                            \
     }
 
 /* variant for use by OP_DBSTATE, where op_private holds hint bits */
@@ -791,6 +760,8 @@ struct block_loop {
         : (SV**)NULL)
 
 #define CxLABEL(c)     (0 + CopLABEL((c)->blk_oldcop))
+#define CxLABEL_len(c,len)     (0 + CopLABEL_len((c)->blk_oldcop, len))
+#define CxLABEL_len_flags(c,len,flags) (0 + CopLABEL_len_flags((c)->blk_oldcop, len, flags))
 #define CxHASARGS(c)   (((c)->cx_type & CXp_HASARGS) == CXp_HASARGS)
 #define CxLVAL(c)      (0 + (c)->blk_u16)
 
@@ -1250,8 +1221,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */