This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove binary compat from #23156 (remove PL_retstack)
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index 04eb7c0..fb119b2 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, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 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.
@@ -37,11 +37,11 @@ struct cop {
 #  define CopFILEGV(c)         (CopFILE(c) \
                                 ? gv_fetchfile(CopFILE(c)) : Nullgv)
                                 
- #ifdef NETWARE
-  #define CopFILE_set(c,pv)    ((c)->cop_file = savepv(pv))
- #else
-  #define CopFILE_set(c,pv)    ((c)->cop_file = savesharedpv(pv))
- #endif
+#  ifdef NETWARE
+#    define CopFILE_set(c,pv)  ((c)->cop_file = savepv(pv))
+#  else
+#    define CopFILE_set(c,pv)  ((c)->cop_file = savesharedpv(pv))
+#  endif
 
 #  define CopFILESV(c)         (CopFILE(c) \
                                 ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
@@ -49,11 +49,11 @@ struct cop {
                                 ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
 #  define CopSTASHPV(c)                ((c)->cop_stashpv)
 
-  #ifdef NETWARE
-    #define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
-  #else
-    #define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = savesharedpv(pv))
-  #endif
+#  ifdef NETWARE
+#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
+#  else
+#    define CopSTASHPV_set(c,pv)       ((c)->cop_stashpv = savesharedpv(pv))
+#  endif
 
 #  define CopSTASH(c)          (CopSTASHPV(c) \
                                 ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
@@ -62,17 +62,17 @@ struct cop {
                                 && (CopSTASHPV(c) == HvNAME(hv)        \
                                     || (CopSTASHPV(c) && HvNAME(hv)    \
                                         && strEQ(CopSTASHPV(c), HvNAME(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))      
-  #endif
+#  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))      
+#  endif
 #else
 #  define CopFILEGV(c)         ((c)->cop_filegv)
 #  define CopFILEGV_set(c,gv)  ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
@@ -119,13 +119,24 @@ struct block_sub {
     U8         hasargs;
     U8         lval;           /* XXX merge lval and hasargs? */
     PAD                *oldcomppad;
+    OP *       retop;  /* op to execute on exit from sub */
 };
 
-/* base for the next two macros. Don't use directly */
+/* base for the next two macros. Don't use directly.
+ * Note that the refcnt of the cv is incremented twice;  The CX one is
+ * decremented by LEAVESUB, the other by LEAVE. */
+
 #define PUSHSUB_BASE(cx)                                               \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
-       cx->blk_sub.hasargs = hasargs;
+       cx->blk_sub.hasargs = hasargs;                                  \
+       cx->blk_sub.retop = Nullop;                                             \
+       if (!CvDEPTH(cv)) {                                             \
+           (void)SvREFCNT_inc(cv);                                     \
+           (void)SvREFCNT_inc(cv);                                     \
+           SAVEFREESV(cv);                                             \
+       }
+
 
 #define PUSHSUB(cx)                                                    \
        PUSHSUB_BASE(cx)                                                \
@@ -141,6 +152,7 @@ struct block_sub {
 #define PUSHFORMAT(cx)                                                 \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.gv = gv;                                            \
+       cx->blk_sub.retop = Nullop;                                     \
        cx->blk_sub.hasargs = 0;                                        \
        cx->blk_sub.dfoutgv = PL_defoutgv;                              \
        (void)SvREFCNT_inc(cx->blk_sub.dfoutgv)
@@ -200,6 +212,7 @@ struct block_eval {
     OP *       old_eval_root;
     SV *       cur_text;
     CV *       cv;
+    OP *       retop;  /* op to execute on exit from eval */
 };
 
 #define PUSHEVAL(cx,n,fgv)                                             \
@@ -210,6 +223,7 @@ struct block_eval {
        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;                                    \
     } STMT_END
 
 #define POPEVAL(cx)                                                    \
@@ -289,7 +303,6 @@ struct block_loop {
 struct block {
     I32                blku_oldsp;     /* stack pointer to copy stuff down to */
     COP *      blku_oldcop;    /* old curcop pointer */
-    I32                blku_oldretsp;  /* return stack index */
     I32                blku_oldmarksp; /* mark stack index */
     I32                blku_oldscopesp;        /* scope stack index */
     PMOP *     blku_oldpm;     /* values of pattern match vars */
@@ -303,7 +316,6 @@ struct block {
 };
 #define blk_oldsp      cx_u.cx_blk.blku_oldsp
 #define blk_oldcop     cx_u.cx_blk.blku_oldcop
-#define blk_oldretsp   cx_u.cx_blk.blku_oldretsp
 #define blk_oldmarksp  cx_u.cx_blk.blku_oldmarksp
 #define blk_oldscopesp cx_u.cx_blk.blku_oldscopesp
 #define blk_oldpm      cx_u.cx_blk.blku_oldpm
@@ -319,7 +331,6 @@ struct block {
        cx->blk_oldcop          = PL_curcop,                            \
        cx->blk_oldmarksp       = PL_markstack_ptr - PL_markstack,      \
        cx->blk_oldscopesp      = PL_scopestack_ix,                     \
-       cx->blk_oldretsp        = PL_retstack_ix,                       \
        cx->blk_oldpm           = PL_curpm,                             \
        cx->blk_gimme           = (U8)gimme;                            \
        DEBUG_l( PerlIO_printf(Perl_debug_log, "Entering block %ld, type %s\n", \
@@ -331,7 +342,6 @@ struct block {
        PL_curcop        = cx->blk_oldcop,                              \
        PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
        PL_scopestack_ix = cx->blk_oldscopesp,                          \
-       PL_retstack_ix   = cx->blk_oldretsp,                            \
        pm               = cx->blk_oldpm,                               \
        gimme            = cx->blk_gimme;                               \
        DEBUG_SCOPE("POPBLOCK");                                        \
@@ -343,7 +353,6 @@ struct block {
        PL_stack_sp      = PL_stack_base + cx->blk_oldsp,               \
        PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,            \
        PL_scopestack_ix = cx->blk_oldscopesp,                          \
-       PL_retstack_ix   = cx->blk_oldretsp,                            \
        PL_curpm         = cx->blk_oldpm;                               \
        DEBUG_SCOPE("TOPBLOCK");
 
@@ -572,3 +581,7 @@ typedef struct stackinfo PERL_SI;
            POPSTACK;                                                   \
        }                                                               \
     } STMT_END
+
+#define IN_PERL_COMPILETIME    (PL_curcop == &PL_compiling)
+#define IN_PERL_RUNTIME                (PL_curcop != &PL_compiling)
+