This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Downgrading a fixed or floating substring of a pattern whilst matching
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index f0429b1..d75d2f1 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.
  */
@@ -237,7 +267,7 @@ struct block_sub {
     GV *       dfoutgv;
     AV *       savearray;
     AV *       argarray;
-    long       olddepth;
+    I32                olddepth;
     U8         hasargs;
     U8         lval;           /* XXX merge lval and hasargs? */
     PAD                *oldcomppad;
@@ -254,8 +284,8 @@ struct block_sub {
        cx->blk_sub.hasargs = hasargs;                                  \
        cx->blk_sub.retop = NULL;                                       \
        if (!CvDEPTH(cv)) {                                             \
-           (void)SvREFCNT_inc(cv);                                     \
-           (void)SvREFCNT_inc(cv);                                     \
+           SvREFCNT_inc_simple_void_NN(cv);                            \
+           SvREFCNT_inc_simple_void_NN(cv);                            \
            SAVEFREESV(cv);                                             \
        }
 
@@ -277,7 +307,7 @@ struct block_sub {
        cx->blk_sub.retop = NULL;                                       \
        cx->blk_sub.hasargs = 0;                                        \
        cx->blk_sub.dfoutgv = PL_defoutgv;                              \
-       (void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
+       SvREFCNT_inc_void(cx->blk_sub.dfoutgv)
 
 #define POP_SAVEARRAY()                                                \
     STMT_START {                                                       \
@@ -290,7 +320,7 @@ struct block_sub {
 #define CLEAR_ARGARRAY(ary) \
     STMT_START {                                                       \
        AvMAX(ary) += AvARRAY(ary) - AvALLOC(ary);                      \
-       SvPV_set(ary, (char*)AvALLOC(ary));                             \
+       AvARRAY(ary) = AvALLOC(ary);                                    \
        AvFILLp(ary) = -1;                                              \
     } STMT_END
 
@@ -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);                  \
@@ -328,8 +358,8 @@ struct block_sub {
 
 /* eval context */
 struct block_eval {
-    I32                old_in_eval;
-    I32                old_op_type;
+    U8         old_in_eval;
+    U16                old_op_type;
     SV *       old_namesv;
     OP *       old_eval_root;
     SV *       cur_text;
@@ -363,21 +393,39 @@ struct block_eval {
 struct block_loop {
     char *     label;
     I32                resetsp;
-    OP *       redo_op;
-    OP *       next_op;
-    OP *       last_op;
+    LOOP *     my_op;  /* My op, that contains redo, next and last ops.  */
+    /* (except for non_ithreads we need to modify next_op in pp_ctl.c, hence
+       why next_op is conditionally defined below.)  */
 #ifdef USE_ITHREADS
     void *     iterdata;
     PAD                *oldcomppad;
 #else
+    OP *       next_op;
     SV **      itervar;
 #endif
     SV *       itersave;
+    /* (from inspection of source code) for a .. range of strings this is the
+       current string.  */
     SV *       iterlval;
+    /* (from inspection of source code) for a foreach loop this is the array
+       being iterated over. For a .. range of numbers it's the current value.
+       A check is often made on the SvTYPE of iterary to determine whether
+       we are iterating over an array or a range. (numbers or strings)  */
     AV *       iterary;
     IV         iterix;
+    /* (from inspection of source code) for a .. range of numbers this is the
+       maximum value.  */
     IV         itermax;
 };
+/* It might be possible to squeeze this structure further. As best I can tell
+   itermax and iterlval are never used at the same time, so it might be possible
+   to make them into a union. However, I'm not confident that there are enough
+   flag bits/NULLable pointers in this structure alone to encode which is
+   active. There is, however, U8 of space free in struct block, which could be
+   used. Right now it may not be worth squeezing this structure further, as it's
+   the largest part of struct block, and currently struct block is 64 bytes on
+   an ILP32 system, which will give good cache alignment.
+*/
 
 #ifdef USE_ITHREADS
 #  define CxITERVAR(c)                                                 \
@@ -402,12 +450,19 @@ struct block_loop {
            cx->blk_loop.itersave = NULL;
 #endif
 
+#ifdef USE_ITHREADS
+#  define PUSHLOOP_OP_NEXT             /* No need to do anything.  */
+#  define CX_LOOP_NEXTOP_GET(cx)       ((cx)->blk_loop.my_op->op_nextop + 0)
+#else
+#  define PUSHLOOP_OP_NEXT             cx->blk_loop.next_op = cLOOP->op_nextop
+#  define CX_LOOP_NEXTOP_GET(cx)       ((cx)->blk_loop.next_op + 0)
+#endif
+
 #define PUSHLOOP(cx, dat, s)                                           \
        cx->blk_loop.label = PL_curcop->cop_label;                      \
        cx->blk_loop.resetsp = s - PL_stack_base;                       \
-       cx->blk_loop.redo_op = cLOOP->op_redoop;                        \
-       cx->blk_loop.next_op = cLOOP->op_nextop;                        \
-       cx->blk_loop.last_op = cLOOP->op_lastop;                        \
+       cx->blk_loop.my_op = cLOOP;                                     \
+       PUSHLOOP_OP_NEXT;                                               \
        cx->blk_loop.iterlval = NULL;                                   \
        cx->blk_loop.iterary = NULL;                                    \
        cx->blk_loop.iterix = -1;                                       \
@@ -417,7 +472,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;                         \
            }                                                           \
@@ -440,12 +495,14 @@ struct block_givwhen {
 
 /* context common to subroutines, evals and loops */
 struct block {
+    U16                blku_type;      /* what kind of context this is */
+    U8         blku_gimme;     /* is this block running in list context? */
+    U8         blku_spare;     /* Padding to match with struct subst */
     I32                blku_oldsp;     /* stack pointer to copy stuff down to */
     COP *      blku_oldcop;    /* old curcop pointer */
     I32                blku_oldmarksp; /* mark stack index */
     I32                blku_oldscopesp;        /* scope stack index */
     PMOP *     blku_oldpm;     /* values of pattern match vars */
-    U8         blku_gimme;     /* is this block running in list context? */
 
     union {
        struct block_sub        blku_sub;
@@ -499,12 +556,13 @@ struct block {
 
 /* substitution context */
 struct subst {
+    U16                sbu_type;       /* what kind of context this is */
+    U8         sbu_once;       /* Actually both booleans, but U8 to matches */
+    U8         sbu_rxtainted;  /* struct block */
     I32                sbu_iters;
     I32                sbu_maxiters;
     I32                sbu_rflags;
     I32                sbu_oldsave;
-    bool       sbu_once;
-    bool       sbu_rxtainted;
     char *     sbu_orig;
     SV *       sbu_dstr;
     SV *       sbu_targ;
@@ -542,21 +600,23 @@ struct subst {
        cx->sb_s                = s,                                    \
        cx->sb_m                = m,                                    \
        cx->sb_strend           = strend,                               \
-       cx->sb_rxres            = Null(void*),                          \
+       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 */
     union {
        struct block    cx_blk;
        struct subst    cx_subst;
     } cx_u;
 };
+#define cx_type cx_u.cx_subst.sbu_type
 
 #define CXTYPEMASK     0xff
 #define CXt_NULL       0
@@ -646,6 +706,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 +865,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:
+ */