This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add a "return NORMAL" to a DIE at the end of a function to prevent compiler warnings...
[perl5.git] / cop.h
diff --git a/cop.h b/cop.h
index 85ec068..93154c8 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, 2005, 2006, 2007, by Larry Wall and others
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 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.
@@ -114,6 +114,7 @@ typedef struct jmpenv JMPENV;
     STMT_START {                                                       \
        DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n",    \
                         (void*)PL_top_env, (void*)cur_env.je_prev));                   \
+       assert(PL_top_env == &cur_env);                                 \
        PL_top_env = cur_env.je_prev;                                   \
     } STMT_END
 
@@ -232,11 +233,7 @@ struct cop {
 #define CopLINE_set(c,l)       (CopLINE(c) = (l))
 
 /* OutCopFILE() is CopFILE for output (caller, die, warn, etc.) */
-#ifdef MACOS_TRADITIONAL
-#  define OutCopFILE(c) MacPerl_MPWFileName(CopFILE(c))
-#else
-#  define OutCopFILE(c) CopFILE(c)
-#endif
+#define OutCopFILE(c) CopFILE(c)
 
 /* If $[ is non-zero, it's stored in cop_hints under the key "$[", and
    HINT_ARYBASE is set to indicate this.
@@ -250,12 +247,17 @@ struct cop {
 #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,      \
+           if ((c) == &PL_compiling) {                                 \
+               SV *val = newSViv(b);                                   \
+               (void)hv_stores(GvHV(PL_hintgv), "$[", val);            \
+               mg_set(val);                                            \
+               PL_hints |= HINT_ARYBASE;                               \
+           } else {                                                    \
+               (c)->cop_hints_hash                                     \
+                  = Perl_refcounted_he_new(aTHX_ (c)->cop_hints_hash,  \
                                        newSVpvs_flags("$[", SVs_TEMP), \
                                        sv_2mortal(newSViv(b)));        \
+           }                                                           \
        }                                                               \
     } STMT_END
 
@@ -298,8 +300,8 @@ struct block_format {
 
 #define PUSHSUB_BASE(cx)                                               \
        ENTRY_PROBE(GvENAME(CvGV(cv)),                                  \
-               CopFILE((COP*)CvSTART(cv)),                             \
-               CopLINE((COP*)CvSTART(cv)));                            \
+               CopFILE((const COP *)CvSTART(cv)),                      \
+               CopLINE((const COP *)CvSTART(cv)));                     \
                                                                        \
        cx->blk_sub.cv = cv;                                            \
        cx->blk_sub.olddepth = CvDEPTH(cv);                             \
@@ -347,9 +349,9 @@ struct block_format {
 
 #define POPSUB(cx,sv)                                                  \
     STMT_START {                                                       \
-       RETURN_PROBE(GvENAME(CvGV((CV*)cx->blk_sub.cv)),                \
-               CopFILE((COP*)CvSTART((CV*)cx->blk_sub.cv)),            \
-               CopLINE((COP*)CvSTART((CV*)cx->blk_sub.cv)));           \
+       RETURN_PROBE(GvENAME(CvGV((const CV*)cx->blk_sub.cv)),          \
+               CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),      \
+               CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)));     \
                                                                        \
        if (CxHASARGS(cx)) {                                            \
            POP_SAVEARRAY();                                            \
@@ -360,14 +362,14 @@ struct block_format {
                cx->blk_sub.argarray = newAV();                         \
                av_extend(cx->blk_sub.argarray, fill);                  \
                AvREIFY_only(cx->blk_sub.argarray);                     \
-               CX_CURPAD_SV(cx->blk_sub, 0) = (SV*)cx->blk_sub.argarray;       \
+               CX_CURPAD_SV(cx->blk_sub, 0) = MUTABLE_SV(cx->blk_sub.argarray); \
            }                                                           \
            else {                                                      \
                CLEAR_ARGARRAY(cx->blk_sub.argarray);                   \
            }                                                           \
        }                                                               \
-       sv = (SV*)cx->blk_sub.cv;                                       \
-       if (sv && (CvDEPTH((CV*)sv) = cx->blk_sub.olddepth))            \
+       sv = MUTABLE_SV(cx->blk_sub.cv);                                \
+       if (sv && (CvDEPTH((const CV*)sv) = cx->blk_sub.olddepth))      \
            sv = NULL;                                          \
     } STMT_END
 
@@ -610,7 +612,8 @@ struct subst {
 #define sb_rxres       cx_u.cx_subst.sbu_rxres
 #define sb_rx          cx_u.cx_subst.sbu_rx
 
-#define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],                        \
+#ifdef PERL_CORE
+#  define PUSHSUBST(cx) CXINC, cx = &cxstack[cxstack_ix],              \
        cx->sb_iters            = iters,                                \
        cx->sb_maxiters         = maxiters,                             \
        cx->sb_rflags           = r_flags,                              \
@@ -628,11 +631,12 @@ struct subst {
        rxres_save(&cx->sb_rxres, rx);                                  \
        (void)ReREFCNT_inc(rx)
 
-#define CxONCE(cx)             ((cx)->cx_type & CXp_ONCE)
-
-#define POPSUBST(cx) cx = &cxstack[cxstack_ix--];                      \
+#  define POPSUBST(cx) cx = &cxstack[cxstack_ix--];                    \
        rxres_free(&cx->sb_rxres);                                      \
        ReREFCNT_dec(cx->sb_rx)
+#endif
+
+#define CxONCE(cx)             ((cx)->cx_type & CXp_ONCE)
 
 struct context {
     union {
@@ -881,6 +885,7 @@ See L<perlcall/Lightweight Callbacks>.
        multicall_oldcatch = CATCH_GET;                                 \
        SAVETMPS; SAVEVPTR(PL_op);                                      \
        CATCH_SET(TRUE);                                                \
+       PUSHSTACKi(PERLSI_SORT);                                        \
        PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);              \
        PUSHSUB(cx);                                                    \
        if (++CvDEPTH(cv) >= 2) {                                       \
@@ -904,8 +909,10 @@ See L<perlcall/Lightweight Callbacks>.
        LEAVESUB(multicall_cv);                                         \
        CvDEPTH(multicall_cv)--;                                        \
        POPBLOCK(cx,PL_curpm);                                          \
+       POPSTACK;                                                       \
        CATCH_SET(multicall_oldcatch);                                  \
        LEAVE;                                                          \
+       SPAGAIN;                                                        \
     } STMT_END
 
 /*