This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Fix change 28770 to cope with the strange 32 bit bool type on VMS.
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index b6f900c..e9d786f 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -1,7 +1,7 @@
 /*    cop.h
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -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
 
@@ -123,7 +123,7 @@ typedef struct jmpenv JMPENV;
        if (PL_top_env->je_prev)                                \
            PerlProc_longjmp(PL_top_env->je_buf, (v));          \
        if ((v) == 2)                                           \
-           PerlProc_exit(STATUS_NATIVE_EXPORT);                \
+           PerlProc_exit(STATUS_EXIT);                         \
        PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");     \
        PerlProc_exit(1);                                       \
     } STMT_END
@@ -143,19 +143,20 @@ 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;
 };
 
-#define Nullcop Null(COP*)
-
 #ifdef USE_ITHREADS
 #  define CopFILE(c)           ((c)->cop_file)
 #  define CopFILEGV(c)         (CopFILE(c) \
-                                ? gv_fetchfile(CopFILE(c)) : Nullgv)
+                                ? gv_fetchfile(CopFILE(c)) : NULL)
                                 
 #  ifdef NETWARE
 #    define CopFILE_set(c,pv)  ((c)->cop_file = savepv(pv))
@@ -164,50 +165,54 @@ struct cop {
 #  endif
 
 #  define CopFILESV(c)         (CopFILE(c) \
-                                ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
+                                ? GvSV(gv_fetchfile(CopFILE(c))) : NULL)
 #  define CopFILEAV(c)         (CopFILE(c) \
-                                ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
+                                ? GvAV(gv_fetchfile(CopFILE(c))) : NULL)
+#  ifdef DEBUGGING
+#    define CopFILEAVx(c)      (assert(CopFILE(c)), \
+                                  GvAV(gv_fetchfile(CopFILE(c))))
+#  else
+#    define CopFILEAVx(c)      (GvAV(gv_fetchfile(CopFILE(c))))
+#  endif
 #  define CopSTASHPV(c)                ((c)->cop_stashpv)
 
 #  ifdef NETWARE
-#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#    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) : Nullhv)
-#  define CopSTASH_set(c,hv)   CopSTASHPV_set(c, (hv) ? HvNAME_get(hv) : Nullch)
-#  define CopSTASH_eq(c,hv)    ((hv)                                   \
-                                && (CopSTASHPV(c) == HvNAME_get(hv)    \
-                                    || (CopSTASHPV(c) && HvNAME_get(hv)\
-                                        && strEQ(CopSTASHPV(c), HvNAME_get(hv)))))
+                                ? 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)
-#  else
-#    define CopSTASH_free(c)   PerlMemShared_free(CopSTASHPV(c))      
-#  endif
-
-#  ifdef NETWARE
 #    define CopFILE_free(c) SAVECOPFILE_FREE(c)
 #  else
-#    define CopFILE_free(c)    (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = Nullch))      
+#    define CopSTASH_free(c)   PerlMemShared_free(CopSTASHPV(c))
+#    define CopFILE_free(c)    (PerlMemShared_free(CopFILE(c)),(CopFILE(c) = NULL))
 #  endif
 #else
 #  define CopFILEGV(c)         ((c)->cop_filegv)
 #  define CopFILEGV_set(c,gv)  ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
 #  define CopFILE_set(c,pv)    CopFILEGV_set((c), gv_fetchfile(pv))
-#  define CopFILESV(c)         (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
-#  define CopFILEAV(c)         (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
-#  define CopFILE(c)           (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
+#  define CopFILESV(c)         (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : NULL)
+#  define CopFILEAV(c)         (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : NULL)
+#  ifdef DEBUGGING
+#    define CopFILEAVx(c)      (assert(CopFILEGV(c)), GvAV(CopFILEGV(c)))
+#  else
+#    define CopFILEAVx(c)      (GvAV(CopFILEGV(c)))
+# endif
+#  define CopFILE(c)           (CopFILESV(c) ? SvPVX(CopFILESV(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)) : Nullch)
+#  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) = Nullgv))
+#  define CopFILE_free(c)      (SvREFCNT_dec(CopFILEGV(c)),(CopFILEGV(c) = NULL))
 
 #endif /* USE_ITHREADS */
 
@@ -224,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.
  */
@@ -235,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;
@@ -250,10 +282,10 @@ struct block_sub {
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
        cx->blk_sub.hasargs = hasargs;                                  \
-       cx->blk_sub.retop = Nullop;                                             \
+       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);                                             \
        }
 
@@ -272,10 +304,10 @@ struct block_sub {
 #define PUSHFORMAT(cx)                                                 \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.gv = gv;                                            \
-       cx->blk_sub.retop = Nullop;                                     \
+       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 {                                                       \
@@ -298,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);                  \
@@ -311,7 +343,7 @@ struct block_sub {
        }                                                               \
        sv = (SV*)cx->blk_sub.cv;                                       \
        if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth))            \
-           sv = Nullsv;                                                \
+           sv = NULL;                                          \
     } STMT_END
 
 #define LEAVESUB(sv)                                                   \
@@ -326,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;
@@ -340,11 +372,11 @@ struct block_eval {
     STMT_START {                                                       \
        cx->blk_eval.old_in_eval = PL_in_eval;                          \
        cx->blk_eval.old_op_type = PL_op->op_type;                      \
-       cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : Nullsv);          \
+       cx->blk_eval.old_namesv = (n ? newSVpv(n,0) : NULL);            \
        cx->blk_eval.old_eval_root = PL_eval_root;                      \
        cx->blk_eval.cur_text = PL_linestr;                             \
-       cx->blk_eval.cv = Nullcv; /* set by doeval(), as applicable */  \
-       cx->blk_eval.retop = Nullop;                                    \
+       cx->blk_eval.cv = NULL; /* set by doeval(), as applicable */    \
+       cx->blk_eval.retop = NULL;                                      \
        cx->blk_eval.cur_top_env = PL_top_env;                          \
     } STMT_END
 
@@ -361,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)                                                 \
@@ -390,50 +440,75 @@ struct block_loop {
        if ((cx->blk_loop.iterdata = (idata)))                          \
            cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));       \
        else                                                            \
-           cx->blk_loop.itersave = Nullsv;
+           cx->blk_loop.itersave = NULL;
 #else
 #  define CxITERVAR(c)         ((c)->blk_loop.itervar)
 #  define CX_ITERDATA_SET(cx,ivar)                                     \
        if ((cx->blk_loop.itervar = (SV**)(ivar)))                      \
            cx->blk_loop.itersave = SvREFCNT_inc(*CxITERVAR(cx));       \
        else                                                            \
-           cx->blk_loop.itersave = Nullsv;
+           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.iterlval = Nullsv;                                 \
-       cx->blk_loop.iterary = Nullav;                                  \
+       cx->blk_loop.my_op = cLOOP;                                     \
+       PUSHLOOP_OP_NEXT;                                               \
+       cx->blk_loop.iterlval = NULL;                                   \
+       cx->blk_loop.iterary = NULL;                                    \
        cx->blk_loop.iterix = -1;                                       \
        CX_ITERDATA_SET(cx,dat);
 
 #define POPLOOP(cx)                                                    \
        SvREFCNT_dec(cx->blk_loop.iterlval);                            \
        if (CxITERVAR(cx)) {                                            \
-           SV **s_v_p = CxITERVAR(cx);                                 \
-           sv_2mortal(*s_v_p);                                         \
-           *s_v_p = cx->blk_loop.itersave;                             \
+            if (SvPADMY(cx->blk_loop.itersave)) {                      \
+               SV ** const s_v_p = CxITERVAR(cx);                      \
+               sv_2mortal(*s_v_p);                                     \
+               *s_v_p = cx->blk_loop.itersave;                         \
+           }                                                           \
+           else {                                                      \
+               SvREFCNT_dec(cx->blk_loop.itersave);                    \
+           }                                                           \
        }                                                               \
        if (cx->blk_loop.iterary && cx->blk_loop.iterary != PL_curstack)\
            SvREFCNT_dec(cx->blk_loop.iterary);
 
+/* given/when context */
+struct block_givwhen {
+       OP *leave_op;
+};
+
+#define PUSHGIVEN(cx)                                                  \
+       cx->blk_givwhen.leave_op = cLOGOP->op_other;
+
+#define PUSHWHEN PUSHGIVEN
+
 /* 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;
        struct block_eval       blku_eval;
        struct block_loop       blku_loop;
+       struct block_givwhen    blku_givwhen;
     } blk_u;
 };
 #define blk_oldsp      cx_u.cx_blk.blku_oldsp
@@ -445,6 +520,7 @@ struct block {
 #define blk_sub                cx_u.cx_blk.blk_u.blku_sub
 #define blk_eval       cx_u.cx_blk.blk_u.blku_eval
 #define blk_loop       cx_u.cx_blk.blk_u.blku_loop
+#define blk_givwhen    cx_u.cx_blk.blk_u.blku_givwhen
 
 /* Enter a block. */
 #define PUSHBLOCK(cx,t,sp) CXINC, cx = &cxstack[cxstack_ix],           \
@@ -480,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;
@@ -523,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
@@ -547,13 +626,21 @@ struct context {
 #define CXt_SUBST      4
 #define CXt_BLOCK      5
 #define CXt_FORMAT     6
+#define CXt_GIVEN      7
+#define CXt_WHEN       8
+
+/* private flags for CXt_SUB and CXt_NULL */
+#define CXp_MULTICALL  0x00000400      /* part of a multicall (so don't
+                                          tear down context on exit). */ 
 
 /* private flags for CXt_EVAL */
 #define CXp_REAL       0x00000100      /* truly eval'', not a lookalike */
 #define CXp_TRYBLOCK   0x00000200      /* eval{}, not eval'' or similar */
 
-#ifdef USE_ITHREADS
 /* private flags for CXt_LOOP */
+#define CXp_FOREACH    0x00000200      /* a foreach loop */
+#define CXp_FOR_DEF    0x00000400      /* foreach using $_ */
+#ifdef USE_ITHREADS
 #  define CXp_PADVAR   0x00000100      /* itervar lives on pad, iterdata
                                           has pad offset; if not set,
                                           iterdata holds GV* */
@@ -562,10 +649,16 @@ struct context {
 #endif
 
 #define CxTYPE(c)      ((c)->cx_type & CXTYPEMASK)
+#define CxMULTICALL(c) (((c)->cx_type & CXp_MULTICALL)                 \
+                        == CXp_MULTICALL)
 #define CxREALEVAL(c)  (((c)->cx_type & (CXt_EVAL|CXp_REAL))           \
                         == (CXt_EVAL|CXp_REAL))
 #define CxTRYBLOCK(c)  (((c)->cx_type & (CXt_EVAL|CXp_TRYBLOCK))       \
                         == (CXt_EVAL|CXp_TRYBLOCK))
+#define CxFOREACH(c)   (((c)->cx_type & (CXt_LOOP|CXp_FOREACH))        \
+                         == (CXt_LOOP|CXp_FOREACH))
+#define CxFOREACHDEF(c)        (((c)->cx_type & (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))\
+                        == (CXt_LOOP|CXp_FOREACH|CXp_FOR_DEF))
 
 #define CXINC (cxstack_ix < cxstack_max ? ++cxstack_ix : (cxstack_ix = cxinc()))
 
@@ -613,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 */
@@ -686,7 +781,7 @@ typedef struct stackinfo PERL_SI;
 #define POPSTACK \
     STMT_START {                                                       \
        dSP;                                                            \
-       PERL_SI *prev = PL_curstackinfo->si_prev;                       \
+       PERL_SI * const prev = PL_curstackinfo->si_prev;                \
        if (!prev) {                                                    \
            PerlIO_printf(Perl_error_log, "panic: POPSTACK\n");         \
            my_exit(1);                                                 \
@@ -707,3 +802,76 @@ typedef struct stackinfo PERL_SI;
 #define IN_PERL_COMPILETIME    (PL_curcop == &PL_compiling)
 #define IN_PERL_RUNTIME                (PL_curcop != &PL_compiling)
 
+/*
+=head1 Multicall Functions
+
+=for apidoc Ams||dMULTICALL
+Declare local variables for a multicall. See L<perlcall/Lightweight Callbacks>.
+
+=for apidoc Ams||PUSH_MULTICALL
+Opening bracket for a lightweight callback.
+See L<perlcall/Lightweight Callbacks>.
+
+=for apidoc Ams||MULTICALL
+Make a lightweight callback. See L<perlcall/Lightweight Callbacks>.
+
+=for apidoc Ams||POP_MULTICALL
+Closing bracket for a lightweight callback.
+See L<perlcall/Lightweight Callbacks>.
+
+=cut
+*/
+
+#define dMULTICALL \
+    SV **newsp;                        /* set by POPBLOCK */                   \
+    PERL_CONTEXT *cx;                                                  \
+    CV *multicall_cv;                                                  \
+    OP *multicall_cop;                                                 \
+    bool multicall_oldcatch;                                           \
+    U8 hasargs = 0             /* used by PUSHSUB */
+
+#define PUSH_MULTICALL(the_cv) \
+    STMT_START {                                                       \
+       CV * const _nOnclAshIngNamE_ = the_cv;                          \
+       CV * const cv = _nOnclAshIngNamE_;                              \
+       AV * const padlist = CvPADLIST(cv);                             \
+       ENTER;                                                          \
+       multicall_oldcatch = CATCH_GET;                                 \
+       SAVETMPS; SAVEVPTR(PL_op);                                      \
+       CATCH_SET(TRUE);                                                \
+       PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);              \
+       PUSHSUB(cx);                                                    \
+       if (++CvDEPTH(cv) >= 2) {                                       \
+           PERL_STACK_OVERFLOW_CHECK();                                \
+           Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));                  \
+       }                                                               \
+       SAVECOMPPAD();                                                  \
+       PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));                       \
+       multicall_cv = cv;                                              \
+       multicall_cop = CvSTART(cv);                                    \
+    } STMT_END
+
+#define MULTICALL \
+    STMT_START {                                                       \
+       PL_op = multicall_cop;                                          \
+       CALLRUNOPS(aTHX);                                               \
+    } STMT_END
+
+#define POP_MULTICALL \
+    STMT_START {                                                       \
+       LEAVESUB(multicall_cv);                                         \
+       CvDEPTH(multicall_cv)--;                                        \
+       POPBLOCK(cx,PL_curpm);                                          \
+       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:
+ */