We shouldn't try to decrement the refcount of PL_warnhook

[perl5.git] / cop.h

diff --git a/cop.h b/cop.h
index ef92d8e..bfaea57 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -100,7 +100,7 @@ typedef struct jmpenv JMPENV;
 #define JMPENV_PUSH(v) \
     STMT_START {                                                       \
        DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",     \
-                        &cur_env, PL_top_env));                        \
+                        (void*)&cur_env, (void*)PL_top_env));                  \
        cur_env.je_prev = PL_top_env;                                   \
        OP_REG_TO_MEM;                                                  \
        cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, SCOPE_SAVES_SIGNAL_MASK);              \
@@ -113,7 +113,7 @@ typedef struct jmpenv JMPENV;
 #define JMPENV_POP \
     STMT_START {                                                       \
        DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n",    \
-                        PL_top_env, cur_env.je_prev));                 \
+                        (void*)PL_top_env, (void*)cur_env.je_prev));                   \
        PL_top_env = cur_env.je_prev;                                   \
     } STMT_END
 
@@ -143,11 +143,14 @@ struct cop {
     HV *       cop_stash;      /* package line was compiled in */
     GV *       cop_filegv;     /* file the following line # is from */
 #endif
+    U32                cop_hints;      /* hints bits from pragmata */
     U32                cop_seq;        /* parse sequence number */
-    I32                cop_arybase;    /* array base this line was compiled with */
     line_t      cop_line;       /* line # of this command */
-    SV *       cop_warnings;   /* lexical warnings bitmask */
-    SV *       cop_io;         /* lexical IO defaults */
+    /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *:  */
+    STRLEN *   cop_warnings;   /* lexical warnings bitmask */
+    /* compile time state of %^H.  See the comment in op.c for how this is
+       used to recreate a hash to return from caller.  */
+    struct refcounted_he * cop_hints_hash;
 };
 
 #ifdef USE_ITHREADS
@@ -226,6 +229,33 @@ struct cop {
 #  define OutCopFILE(c) CopFILE(c)
 #endif
 
+/* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
+   HINT_ARYBASE is set to indicate this.
+   Setting it is ineficient 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(Perl_refcounted_he_fetch(aTHX_ (c)->cop_hints_hash, 0,  \
+                                        "$[", 2, 0, 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)                                   \
+               PL_hints |= HINT_LOCALIZE_HH | HINT_ARYBASE;            \
+           (c)->cop_hints_hash                                         \
+              = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash,      \
+                                       sv_2mortal(newSVpvs("$[")),     \
+                                       sv_2mortal(newSViv(b)));        \
+       }                                                               \
+    } 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 {                            \
+                                   (c)->cop_hints = (h);               \
+                               } STMT_END
+
 /*
  * Here we have some enormously heavy (or at least ponderous) wizardry.
  */
@@ -254,8 +284,8 @@ struct block_sub {
        cx->blk_sub.hasargs = hasargs;                                  \
        cx->blk_sub.retop = NULL;                                       \
        if (!CvDEPTH(cv)) {                                             \
-           SvREFCNT_inc_void(cv);                                      \
-           SvREFCNT_inc_void(cv);                                      \
+           SvREFCNT_inc_simple_void_NN(cv);                            \
+           SvREFCNT_inc_simple_void_NN(cv);                            \
            SAVEFREESV(cv);                                             \
        }
 
@@ -300,7 +330,7 @@ struct block_sub {
            POP_SAVEARRAY();                                            \
            /* abandon @_ if it got reified */                          \
            if (AvREAL(cx->blk_sub.argarray)) {                         \
-               SSize_t fill = AvFILLp(cx->blk_sub.argarray);           \
+               const SSize_t fill = AvFILLp(cx->blk_sub.argarray);     \
                SvREFCNT_dec(cx->blk_sub.argarray);                     \
                cx->blk_sub.argarray = newAV();                         \
                av_extend(cx->blk_sub.argarray, fill);                  \
@@ -417,7 +447,7 @@ struct block_loop {
        SvREFCNT_dec(cx->blk_loop.iterlval);                            \
        if (CxITERVAR(cx)) {                                            \
             if (SvPADMY(cx->blk_loop.itersave)) {                      \
-               SV **s_v_p = CxITERVAR(cx);                             \
+               SV ** const s_v_p = CxITERVAR(cx);                      \
                sv_2mortal(*s_v_p);                                     \
                *s_v_p = cx->blk_loop.itersave;                         \
            }                                                           \
@@ -545,10 +575,12 @@ struct subst {
        cx->sb_rxres            = NULL,                                 \
        cx->sb_rx               = rx,                                   \
        cx->cx_type             = CXt_SUBST;                            \
-       rxres_save(&cx->sb_rxres, rx)
+       rxres_save(&cx->sb_rxres, rx);                                  \
+       (void)ReREFCNT_inc(rx)
 
 #define POPSUBST(cx) cx = &cxstack[cxstack_ix--];                      \
-       rxres_free(&cx->sb_rxres)
+       rxres_free(&cx->sb_rxres);                                      \
+       ReREFCNT_dec(cx->sb_rx)
 
 struct context {
     U32                cx_type;        /* what kind of context this is */
@@ -646,6 +678,8 @@ L<perlcall>.
 #define G_KEEPERR      16      /* Append errors to $@, don't overwrite it */
 #define G_NODEBUG      32      /* Disable debugging at toplevel.  */
 #define G_METHOD       64       /* Calling method. */
+#define G_FAKINGEVAL  256      /* Faking en eval context for call_sv or
+                                  fold_constants. */
 
 /* flag bits for PL_in_eval */
 #define EVAL_NULL      0       /* not in an eval */
@@ -803,3 +837,13 @@ See L<perlcall/Lightweight Callbacks>.
        CATCH_SET(multicall_oldcatch);                                  \
        LEAVE;                                                          \
     } STMT_END
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */