rename POPFOO() to CX_POPFOO()

[perl5.git] / perl.c

diff --git a/perl.c b/perl.c
index 69cdf8e..c86daa9 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -3,7 +3,7 @@
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
  *    2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012
- *     by Larry Wall and others
+ *    2013, 2014, 2015, 2016 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.
@@ -392,6 +392,7 @@ perl_construct(pTHXx)
     PL_GCB_invlist = _new_invlist_C_array(_Perl_GCB_invlist);
     PL_SB_invlist = _new_invlist_C_array(_Perl_SB_invlist);
     PL_WB_invlist = _new_invlist_C_array(_Perl_WB_invlist);
+    PL_LB_invlist = _new_invlist_C_array(_Perl_LB_invlist);
 
     ENTER;
 }
@@ -1070,6 +1071,7 @@ perl_destruct(pTHXx)
         PL_XPosix_ptrs[i] = NULL;
     }
     PL_GCB_invlist = NULL;
+    PL_LB_invlist = NULL;
     PL_SB_invlist = NULL;
     PL_WB_invlist = NULL;
 
@@ -1485,8 +1487,8 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
         const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
 
         if (s && strEQ(s, "1")) {
-            unsigned char *seed= PERL_HASH_SEED;
-            unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
+            const unsigned char *seed= PERL_HASH_SEED;
+            const unsigned char *seed_end= PERL_HASH_SEED + PERL_HASH_SEED_BYTES;
             PerlIO_printf(Perl_debug_log, "HASH_FUNCTION = %s HASH_SEED = 0x", PERL_HASH_FUNC);
             while (seed < seed_end) {
                 PerlIO_printf(Perl_debug_log, "%02x", *seed++);
@@ -1806,15 +1808,20 @@ S_Internals_V(pTHX_ CV *cv)
     PUSHs(Perl_newSVpvn_flags(aTHX_ non_bincompat_options,
                              sizeof(non_bincompat_options) - 1, SVs_TEMP));
 
-#ifdef __DATE__
-#  ifdef __TIME__
+#ifndef PERL_BUILD_DATE
+#  ifdef __DATE__
+#    ifdef __TIME__
+#      define PERL_BUILD_DATE __DATE__ " " __TIME__
+#    else
+#      define PERL_BUILD_DATE __DATE__
+#    endif
+#  endif
+#endif
+
+#ifdef PERL_BUILD_DATE
     PUSHs(Perl_newSVpvn_flags(aTHX_
-                             STR_WITH_LEN("Compiled at " __DATE__ " " __TIME__),
+                             STR_WITH_LEN("Compiled at " PERL_BUILD_DATE),
                              SVs_TEMP));
-#  else
-    PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN("Compiled on " __DATE__),
-                             SVs_TEMP));
-#  endif
 #else
     PUSHs(&PL_sv_undef);
 #endif
@@ -2699,12 +2706,11 @@ I32
 Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
                        /* See G_* flags in cop.h */
 {
-    dVAR; dSP;
+    dVAR;
     LOGOP myop;                /* fake syntax tree node */
     METHOP method_op;
     I32 oldmark;
     VOL I32 retval = 0;
-    I32 oldscope;
     bool oldcatch = CATCH_GET;
     int ret;
     OP* const oldop = PL_op;
@@ -2729,11 +2735,13 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
     SAVEOP();
     PL_op = (OP*)&myop;
 
-    EXTEND(PL_stack_sp, 1);
-    if (!(flags & G_METHOD_NAMED))
-        *++PL_stack_sp = sv;
+    if (!(flags & G_METHOD_NAMED)) {
+       dSP;
+       EXTEND(SP, 1);
+       PUSHs(sv);
+       PUTBACK;
+    }
     oldmark = TOPMARK;
-    oldscope = PL_scopestack_ix;
 
     if (PERLDB_SUB && PL_curstash != PL_debstash
           /* Handle first BEGIN of -d. */
@@ -2767,10 +2775,12 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
        CATCH_SET(oldcatch);
     }
     else {
+        I32 old_cxix;
        myop.op_other = (OP*)&myop;
-       PL_markstack_ptr--;
+       (void)POPMARK;
+        old_cxix = cxstack_ix;
        create_eval_scope(flags|G_FAKINGEVAL);
-       PL_markstack_ptr++;
+       (void)INCMARK;
 
        JMPENV_PUSH(ret);
 
@@ -2810,8 +2820,13 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
            break;
        }
 
-       if (PL_scopestack_ix > oldscope)
+        /* if we croaked, depending on how we croaked the eval scope
+         * may or may not have already been popped */
+       if (cxstack_ix > old_cxix) {
+            assert(cxstack_ix == old_cxix + 1);
+            assert(CxTYPE(CX_CUR()) == CXt_EVAL);
            delete_eval_scope();
+        }
        JMPENV_POP;
     }
 
@@ -2842,9 +2857,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
                        /* See G_* flags in cop.h */
 {
     dVAR;
-    dSP;
     UNOP myop;         /* fake syntax tree node */
-    VOL I32 oldmark = SP - PL_stack_base;
+    VOL I32 oldmark;
     VOL I32 retval = 0;
     int ret;
     OP* const oldop = PL_op;
@@ -2860,8 +2874,13 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     SAVEOP();
     PL_op = (OP*)&myop;
     Zero(&myop, 1, UNOP);
-    EXTEND(PL_stack_sp, 1);
-    *++PL_stack_sp = sv;
+    {
+       dSP;
+       oldmark = SP - PL_stack_base;
+       EXTEND(SP, 1);
+       PUSHs(sv);
+       PUTBACK;
+    }
 
     if (!(flags & G_NOARGS))
        myop.op_flags = OPf_STACKED;
@@ -3521,7 +3540,7 @@ S_minus_v(pTHX)
 #endif
 
        PerlIO_printf(PIO_stdout,
-                     "\n\nCopyright 1987-2015, Larry Wall\n");
+                     "\n\nCopyright 1987-2016, Larry Wall\n");
 #ifdef MSDOS
        PerlIO_printf(PIO_stdout,
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -3771,7 +3790,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
        const char * const err = "Failed to create a fake bit bucket";
        if (strEQ(scriptname, BIT_BUCKET)) {
 #ifdef HAS_MKSTEMP /* Hopefully mkstemp() is safe here. */
-            int old_umask = umask(0600);
+            int old_umask = umask(0177);
            int tmpfd = mkstemp(tmpname);
             umask(old_umask);
            if (tmpfd > -1) {
@@ -3827,6 +3846,14 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, bool *suidscript)
     return rsfp;
 }
 
+/* Mention
+ * I_SYSSTATVFS        HAS_FSTATVFS
+ * I_SYSMOUNT
+ * I_STATFS    HAS_FSTATFS     HAS_GETFSSTAT
+ * I_MNTENT    HAS_GETMNTENT   HAS_HASMNTOPT
+ * here so that metaconfig picks them up. */
+
+
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 /* Don't even need this function.  */
 #else
@@ -4364,12 +4391,12 @@ S_init_perllib(pTHX)
         */
        char buf[256];
        int idx = 0;
-       if (my_trnlnm("PERL5LIB",buf,0))
+       if (vmstrnenv("PERL5LIB",buf,0,NULL,0))
            do {
                incpush_use_sep(buf, 0, INCPUSH_ADD_SUB_DIRS);
-           } while (my_trnlnm("PERL5LIB",buf,++idx));
+           } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0));
        else {
-           while (my_trnlnm("PERLLIB",buf,idx++))
+           while (vmstrnenv("PERLLIB",buf,idx++,NULL,0))
                incpush_use_sep(buf, 0, 0);
        }
 #endif /* VMS */
@@ -4475,11 +4502,11 @@ S_init_perllib(pTHX)
         */
        char buf[256];
        int idx = 0;
-       if (my_trnlnm("PERL5LIB",buf,0))
+       if (vmstrnenv("PERL5LIB",buf,0,NULL,0))
            do {
                incpush_use_sep(buf, 0,
                                INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR);
-           } while (my_trnlnm("PERL5LIB",buf,++idx));
+           } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0));
 #endif /* VMS */
     }
 
@@ -5053,7 +5080,10 @@ S_my_exit_jump(pTHX)
     }
 
     POPSTACK_TO(PL_mainstack);
-    dounwind(-1);
+    if (cxstack_ix >= 0) {
+        dounwind(-1);
+        CX_POPBLOCK(cxstack);
+    }
     LEAVE_SCOPE(0);
 
     JMPENV_JUMP(2);