This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add byte-order group modifiers to (un)pack templates.
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index fe0ca8a..9543884 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -1,10 +1,16 @@
 /*    cop.h
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    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.
  *
+ * Control ops (cops) are one of the three ops OP_NEXTSTATE, OP_DBSTATE,
+ * and OP_SETSTATE that (loosely speaking) are separate statements.
+ * They hold information important for lexical state and error reporting.
+ * At run time, PL_curcop is set to point to the most recently executed cop,
+ * and thus can be used to determine our current state.
  */
 
 struct cop {
@@ -31,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)
@@ -43,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)
@@ -56,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))
@@ -115,13 +121,32 @@ struct block_sub {
     PAD                *oldcomppad;
 };
 
-#define PUSHSUB(cx)                                                    \
+/* 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;                                  \
+       if (!CvDEPTH(cv)) {                                             \
+           (void)SvREFCNT_inc(cv);                                     \
+           (void)SvREFCNT_inc(cv);                                     \
+           SAVEFREESV(cv);                                             \
+       }
+
+
+#define PUSHSUB(cx)                                                    \
+       PUSHSUB_BASE(cx)                                                \
        cx->blk_sub.lval = PL_op->op_private &                          \
                              (OPpLVAL_INTRO|OPpENTERSUB_INARGS);
 
+/* variant for use by OP_DBSTATE, where op_private holds hint bits */
+#define PUSHSUB_DB(cx)                                                 \
+       PUSHSUB_BASE(cx)                                                \
+       cx->blk_sub.lval = 0;
+
+
 #define PUSHFORMAT(cx)                                                 \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.gv = gv;                                            \
@@ -318,6 +343,7 @@ struct block {
        PL_retstack_ix   = cx->blk_oldretsp,                            \
        pm               = cx->blk_oldpm,                               \
        gimme            = cx->blk_gimme;                               \
+       DEBUG_SCOPE("POPBLOCK");                                        \
        DEBUG_l( PerlIO_printf(Perl_debug_log, "Leaving block %ld, type %s\n",          \
                    (long)cxstack_ix+1,PL_block_type[CxTYPE(cx)]); )
 
@@ -327,7 +353,8 @@ struct block {
        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
+       PL_curpm         = cx->blk_oldpm;                               \
+       DEBUG_SCOPE("TOPBLOCK");
 
 /* substitution context */
 struct subst {
@@ -554,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)
+