X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/7edfd0ef07bb2042adfd7871ecb385475da3f544..3f5a5a292521388b979675247c6a3bfc1477f474:/perl.c

diff --git a/perl.c b/perl.c
index 57a9471..7c881c4 100644
--- a/perl.c
+++ b/perl.c
@@ -1,7 +1,7 @@
 /*    perl.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 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.
@@ -137,6 +137,15 @@ static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 #endif
 #endif
 
+#ifndef NO_MATHOMS
+/* This reference ensures that the mathoms are linked with perl */
+extern void Perl_mathoms(void);
+void Perl_mathoms_ref(void);
+void Perl_mathoms_ref(void) {
+    Perl_mathoms();
+}
+#endif
+
 static void
 S_init_tls_and_interp(PerlInterpreter *my_perl)
 {
@@ -150,6 +159,9 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
 	OP_REFCNT_INIT;
 	MUTEX_INIT(&PL_dollarzero_mutex);
 #  endif
+#ifdef PERL_IMPLICIT_CONTEXT
+	MUTEX_INIT(&PL_my_ctx_mutex);
+#  endif
     }
     else {
 	PERL_SET_THX(my_perl);
@@ -165,7 +177,7 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
 		 struct IPerlProc* ipP)
 {
     PerlInterpreter *my_perl;
-    /* New() needs interpreter, so call malloc() instead */
+    /* Newx() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     S_init_tls_and_interp(my_perl);
     Zero(my_perl, 1, PerlInterpreter);
@@ -198,7 +210,7 @@ perl_alloc(void)
 {
     PerlInterpreter *my_perl;
 
-    /* New() needs interpreter, so call malloc() instead */
+    /* Newx() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
 
     S_init_tls_and_interp(my_perl);
@@ -230,7 +242,7 @@ perl_construct(pTHXx)
     if (!PL_linestr) {
 	PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
-	PL_linestr = NEWSV(65,79);
+	PL_linestr = newSV(79);
 	sv_upgrade(PL_linestr,SVt_PVIV);
 
 	if (!SvREADONLY(&PL_sv_undef)) {
@@ -258,11 +270,13 @@ perl_construct(pTHXx)
 	    SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
 	}
 
-	PL_sighandlerp = Perl_sighandler;
+	PL_sighandlerp = (Sighandler_t) Perl_sighandler;
+#ifdef PERL_USES_PL_PIDSTATUS
 	PL_pidstatus = newHV();
+#endif
     }
 
-    PL_rs = newSVpvn("\n", 1);
+    PL_rs = newSVpvs("\n");
 
     init_stacks();
 
@@ -287,7 +301,7 @@ perl_construct(pTHXx)
 
     PL_fdpid = newAV();			/* for remembering popen pids by fd */
     PL_modglobal = newHV();		/* pointers to per-interpreter module globals */
-    PL_errors = newSVpvn("",0);
+    PL_errors = newSVpvs("");
     sv_setpvn(PERL_DEBUG_PAD(0), "", 0);	/* For regex debugging. */
     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);	/* ext/re needs these */
     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);	/* even without DEBUGGING. */
@@ -347,7 +361,7 @@ perl_construct(pTHXx)
 #   endif
 	if ((long) PL_mmap_page_size < 0) {
 	  if (errno) {
-	    SV *error = ERRSV;
+	    SV * const error = ERRSV;
 	    (void) SvUPGRADE(error, SVt_PV);
 	    Perl_croak(aTHX_ "panic: sysconf: %s", SvPV_nolen_const(error));
 	  }
@@ -546,7 +560,7 @@ perl_destruct(pTHXx)
 
     if (CALL_FPTR(PL_threadhook)(aTHX)) {
         /* Threads hook has vetoed further cleanup */
-        return STATUS_NATIVE_EXPORT;
+        return STATUS_EXIT;
     }
 
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
@@ -739,6 +753,8 @@ perl_destruct(pTHXx)
 	 */
 	sv_clean_objs();
 	PL_sv_objcount = 0;
+	if (PL_defoutgv && !SvREFCNT(PL_defoutgv))
+	    PL_defoutgv = Nullgv; /* may have been freed */
     }
 
     /* unhook hooks which will soon be, or use, destroyed data */
@@ -766,7 +782,7 @@ perl_destruct(pTHXx)
 #endif
 
 	/* The exit() function will do everything that needs doing. */
-        return STATUS_NATIVE_EXPORT;
+        return STATUS_EXIT;
     }
 
     /* jettison our possibly duplicated environment */
@@ -806,10 +822,10 @@ perl_destruct(pTHXx)
      */
     {
         I32 i = AvFILLp(PL_regex_padav) + 1;
-        SV **ary = AvARRAY(PL_regex_padav);
+        SV * const * const ary = AvARRAY(PL_regex_padav);
 
         while (i) {
-            SV *resv = ary[--i];
+            SV * const resv = ary[--i];
 
             if (SvFLAGS(resv) & SVf_BREAK) {
                 /* this is PL_reg_curpm, already freed
@@ -827,7 +843,7 @@ perl_destruct(pTHXx)
         }
     }
     SvREFCNT_dec(PL_regex_padav);
-    PL_regex_padav = Nullav;
+    PL_regex_padav = NULL;
     PL_regex_pad = NULL;
 #endif
 
@@ -843,7 +859,7 @@ perl_destruct(pTHXx)
 
     /* Filters for program text */
     SvREFCNT_dec(PL_rsfp_filters);
-    PL_rsfp_filters = Nullav;
+    PL_rsfp_filters = NULL;
 
     /* switches */
     PL_preprocess   = FALSE;
@@ -910,12 +926,12 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_checkav);
     SvREFCNT_dec(PL_checkav_save);
     SvREFCNT_dec(PL_initav);
-    PL_beginav = Nullav;
-    PL_beginav_save = Nullav;
-    PL_endav = Nullav;
-    PL_checkav = Nullav;
-    PL_checkav_save = Nullav;
-    PL_initav = Nullav;
+    PL_beginav = NULL;
+    PL_beginav_save = NULL;
+    PL_endav = NULL;
+    PL_checkav = NULL;
+    PL_checkav_save = NULL;
+    PL_initav = NULL;
 
     /* shortcuts just get cleared */
     PL_envgv = Nullgv;
@@ -936,22 +952,24 @@ perl_destruct(pTHXx)
     PL_DBsignal = Nullsv;
     PL_DBassertion = Nullsv;
     PL_DBcv = Nullcv;
-    PL_dbargs = Nullav;
-    PL_debstash = Nullhv;
+    PL_dbargs = NULL;
+    PL_debstash = NULL;
 
     SvREFCNT_dec(PL_argvout_stack);
-    PL_argvout_stack = Nullav;
+    PL_argvout_stack = NULL;
 
     SvREFCNT_dec(PL_modglobal);
-    PL_modglobal = Nullhv;
+    PL_modglobal = NULL;
     SvREFCNT_dec(PL_preambleav);
-    PL_preambleav = Nullav;
+    PL_preambleav = NULL;
     SvREFCNT_dec(PL_subname);
     PL_subname = Nullsv;
     SvREFCNT_dec(PL_linestr);
     PL_linestr = Nullsv;
+#ifdef PERL_USES_PL_PIDSTATUS
     SvREFCNT_dec(PL_pidstatus);
-    PL_pidstatus = Nullhv;
+    PL_pidstatus = NULL;
+#endif
     SvREFCNT_dec(PL_toptarget);
     PL_toptarget = Nullsv;
     SvREFCNT_dec(PL_bodytarget);
@@ -1067,7 +1085,7 @@ perl_destruct(pTHXx)
 
     AvREAL_off(PL_fdpid);		/* no surviving entries */
     SvREFCNT_dec(PL_fdpid);		/* needed in io_close() */
-    PL_fdpid = Nullav;
+    PL_fdpid = NULL;
 
 #ifdef HAVE_INTERP_INTERN
     sys_intern_clear();
@@ -1083,15 +1101,15 @@ perl_destruct(pTHXx)
 	 */
 	I32 riter = 0;
 	const I32 max = HvMAX(PL_strtab);
-	HE **array = HvARRAY(PL_strtab);
+	HE * const * const array = HvARRAY(PL_strtab);
 	HE *hent = array[0];
 
 	for (;;) {
 	    if (hent && ckWARN_d(WARN_INTERNAL)) {
-		HE *next = HeNEXT(hent);
+		HE * const next = HeNEXT(hent);
 		Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-		     "Unbalanced string table refcount: (%d) for \"%s\"",
-		     HeVAL(hent) - Nullsv, HeKEY(hent));
+		     "Unbalanced string table refcount: (%ld) for \"%s\"",
+		     (long)(HeVAL(hent) - Nullsv), HeKEY(hent));
 		Safefree(hent);
 		hent = next;
 	    }
@@ -1208,8 +1226,7 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_start_tmp);
     PL_reg_start_tmp = (char**)NULL;
     PL_reg_start_tmpl = 0;
-    if (PL_reg_curpm)
-	Safefree(PL_reg_curpm);
+    Safefree(PL_reg_curpm);
     Safefree(PL_reg_poscache);
     free_tied_hv_pool();
     Safefree(PL_op_mask);
@@ -1258,7 +1275,7 @@ perl_destruct(pTHXx)
 	Safefree(PL_mess_sv);
 	PL_mess_sv = Nullsv;
     }
-    return STATUS_NATIVE_EXPORT;
+    return STATUS_EXIT;
 }
 
 /*
@@ -1318,6 +1335,7 @@ perl_fini(void)
 void
 Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
 {
+    dVAR;
     Renew(PL_exitlist, PL_exitlistlen+1, PerlExitListEntry);
     PL_exitlist[PL_exitlistlen].fn = fn;
     PL_exitlist[PL_exitlistlen].ptr = ptr;
@@ -1361,6 +1379,7 @@ S_procself_val(pTHX_ SV *sv, const char *arg0)
 
 STATIC void
 S_set_caret_X(pTHX) {
+    dVAR;
     GV* tmpgv = gv_fetchpv("\030",TRUE, SVt_PV); /* $^X */
     if (tmpgv) {
 #ifdef HAS_PROCSELFEXE
@@ -1420,7 +1439,10 @@ setuid perl scripts securely.\n");
     PL_origargc = argc;
     PL_origargv = argv;
 
-    {
+    if (PL_origalen != 0) {
+	PL_origalen = 1; /* don't use old PL_origalen if perl_parse() is called again */
+    }
+    else {
 	/* Set PL_origalen be the sum of the contiguous argv[]
 	 * elements plus the size of the env in case that it is
 	 * contiguous with the argv[].  This is used in mg.c:Perl_magic_set()
@@ -1468,7 +1490,7 @@ setuid perl scripts securely.\n");
 	      }
 	 }
 	 /* Can we grab env area too to be used as the area for $0? */
-	 if (PL_origenviron) {
+	 if (s && PL_origenviron) {
 	      if ((PL_origenviron[0] == s + 1
 #ifdef OS2
 		   || (PL_origenviron[0] == s + 9 && (s += 8))
@@ -1504,7 +1526,7 @@ setuid perl scripts securely.\n");
 		   }
 	      }
 	 }
-	 PL_origalen = s - PL_origargv[0] + 1;
+	 PL_origalen = s ? s - PL_origargv[0] + 1 : 0;
     }
 
     if (PL_do_undump) {
@@ -1554,7 +1576,7 @@ setuid perl scripts securely.\n");
 	PL_curstash = PL_defstash;
 	if (PL_checkav)
 	    call_list(oldscope, PL_checkav);
-	ret = STATUS_NATIVE_EXPORT;
+	ret = STATUS_EXIT;
 	break;
     case 3:
 	PerlIO_printf(Perl_error_log, "panic: top_env\n");
@@ -1584,7 +1606,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     PL_fdscript = -1;
     PL_suidscript = -1;
     sv_setpvn(PL_linestr,"",0);
-    sv = newSVpvn("",0);		/* first used for -I flags */
+    sv = newSVpvs("");		/* first used for -I flags */
     SAVEFREESV(sv);
     init_main_stash();
 
@@ -1651,6 +1673,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    s++;
 	    goto reswitch;
 
+	case 'E':
+	    PL_minus_E = TRUE;
+	    /* FALL THROUGH */
 	case 'e':
 #ifdef MACOS_TRADITIONAL
 	    /* ignore -e for Dev:Pseudo argument */
@@ -1659,7 +1684,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
 	    forbid_setid("-e");
 	    if (!PL_e_script) {
-		PL_e_script = newSVpvn("",0);
+		PL_e_script = newSVpvs("");
 		filter_add(read_e_script, NULL);
 	    }
 	    if (*++s)
@@ -1669,8 +1694,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		argc--,argv++;
 	    }
 	    else
-		Perl_croak(aTHX_ "No code specified for -e");
-	    sv_catpv(PL_e_script, "\n");
+		Perl_croak(aTHX_ "No code specified for -%c", *s);
+	    sv_catpvs(PL_e_script, "\n");
 	    break;
 
 	case 'f':
@@ -1686,13 +1711,12 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		argc--,argv++;
 	    }
 	    if (s && *s) {
-		char *p;
 		STRLEN len = strlen(s);
-		p = savepvn(s, len);
+		const char * const p = savepvn(s, len);
 		incpush(p, TRUE, TRUE, FALSE, FALSE);
-		sv_catpvn(sv, "-I", 2);
+		sv_catpvs(sv, "-I");
 		sv_catpvn(sv, p, len);
-		sv_catpvn(sv, " ", 1);
+		sv_catpvs(sv, " ");
 		Safefree(p);
 	    }
 	    else
@@ -1715,62 +1739,120 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		if (!PL_preambleav)
 		    PL_preambleav = newAV();
 		av_push(PL_preambleav,
-			newSVpv("use Config;",0));
+			newSVpvs("use Config;"));
 		if (*++s != ':')  {
 		    STRLEN opts;
 		
-		    opts_prog = newSVpv("print Config::myconfig(),",0);
+		    opts_prog = newSVpvs("print Config::myconfig(),");
 #ifdef VMS
-		    sv_catpv(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
+		    sv_catpvs(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
 #else
-		    sv_catpv(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
+		    sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
 #endif
 		    opts = SvCUR(opts_prog);
 
-		    sv_catpv(opts_prog,"\"  Compile-time options:");
+		    Perl_sv_catpv(aTHX_ opts_prog,"\"  Compile-time options:"
 #  ifdef DEBUGGING
-		    sv_catpv(opts_prog," DEBUGGING");
+			     " DEBUGGING"
+#  endif
+#  ifdef DEBUG_LEAKING_SCALARS
+			     " DEBUG_LEAKING_SCALARS"
+#  endif
+#  ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+			     " DEBUG_LEAKING_SCALARS_FORK_DUMP"
+#  endif
+#  ifdef FAKE_THREADS
+			     " FAKE_THREADS"
 #  endif
 #  ifdef MULTIPLICITY
-		    sv_catpv(opts_prog," MULTIPLICITY");
+			     " MULTIPLICITY"
+#  endif
+#  ifdef MYMALLOC
+			     " MYMALLOC"
+#  endif
+#  ifdef NO_MATHOMS
+                            " NO_MATHOMS"
+#  endif
+#  ifdef PERL_DONT_CREATE_GVSV
+			     " PERL_DONT_CREATE_GVSV"
+#  endif
+#  ifdef PERL_GLOBAL_STRUCT
+			     " PERL_GLOBAL_STRUCT"
+#  endif
+#  ifdef PERL_IMPLICIT_CONTEXT
+			     " PERL_IMPLICIT_CONTEXT"
+#  endif
+#  ifdef PERL_IMPLICIT_SYS
+			     " PERL_IMPLICIT_SYS"
+#  endif
+#  ifdef PERL_MALLOC_WRAP
+			     " PERL_MALLOC_WRAP"
+#  endif
+#  ifdef PERL_NEED_APPCTX
+			     " PERL_NEED_APPCTX"
+#  endif
+#  ifdef PERL_NEED_TIMESBASE
+			     " PERL_NEED_TIMESBASE"
+#  endif
+#  ifdef PERL_OLD_COPY_ON_WRITE
+			     " PERL_OLD_COPY_ON_WRITE"
+#  endif
+#  ifdef PERL_TRACK_MEMPOOL
+			     " PERL_TRACK_MEMPOOL"
+#  endif
+#  ifdef PERL_USE_SAFE_PUTENV
+			     " PERL_USE_SAFE_PUTENV"
+#  endif
+#ifdef PERL_USES_PL_PIDSTATUS
+			     " PERL_USES_PL_PIDSTATUS"
+#endif
+#  ifdef PL_OP_SLAB_ALLOC
+			     " PL_OP_SLAB_ALLOC"
+#  endif
+#  ifdef THREADS_HAVE_PIDS
+			     " THREADS_HAVE_PIDS"
 #  endif
 #  ifdef USE_5005THREADS
-		    sv_catpv(opts_prog," USE_5005THREADS");
+			     " USE_5005THREADS"
 #  endif
-#  ifdef USE_ITHREADS
-		    sv_catpv(opts_prog," USE_ITHREADS");
+#  ifdef USE_64_BIT_ALL
+			     " USE_64_BIT_ALL"
 #  endif
 #  ifdef USE_64_BIT_INT
-		    sv_catpv(opts_prog," USE_64_BIT_INT");
+			     " USE_64_BIT_INT"
 #  endif
-#  ifdef USE_64_BIT_ALL
-		    sv_catpv(opts_prog," USE_64_BIT_ALL");
+#  ifdef USE_ITHREADS
+			     " USE_ITHREADS"
+#  endif
+#  ifdef USE_LARGE_FILES
+			     " USE_LARGE_FILES"
 #  endif
 #  ifdef USE_LONG_DOUBLE
-		    sv_catpv(opts_prog," USE_LONG_DOUBLE");
+			     " USE_LONG_DOUBLE"
 #  endif
-#  ifdef USE_LARGE_FILES
-		    sv_catpv(opts_prog," USE_LARGE_FILES");
+#  ifdef USE_PERLIO
+			     " USE_PERLIO"
 #  endif
-#  ifdef USE_SOCKS
-		    sv_catpv(opts_prog," USE_SOCKS");
+#  ifdef USE_REENTRANT_API
+			     " USE_REENTRANT_API"
+#  endif
+#  ifdef USE_SFIO
+			     " USE_SFIO"
 #  endif
 #  ifdef USE_SITECUSTOMIZE
-		    sv_catpv(opts_prog," USE_SITECUSTOMIZE");
+			     " USE_SITECUSTOMIZE"
 #  endif	       
-#  ifdef PERL_IMPLICIT_CONTEXT
-		    sv_catpv(opts_prog," PERL_IMPLICIT_CONTEXT");
-#  endif
-#  ifdef PERL_IMPLICIT_SYS
-		    sv_catpv(opts_prog," PERL_IMPLICIT_SYS");
+#  ifdef USE_SOCKS
+			     " USE_SOCKS"
 #  endif
+			     );
 
 		    while (SvCUR(opts_prog) > opts+76) {
 			/* find last space after "options: " and before col 76
 			 */
 
 			const char *space;
-			char *pv = SvPV_nolen(opts_prog);
+			char * const pv = SvPV_nolen(opts_prog);
 			const char c = pv[opts+76];
 			pv[opts+76] = '\0';
 			space = strrchr(pv+opts+26, ' ');
@@ -1780,16 +1862,16 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 			/* break the line before that space */
 
 			opts = space - pv;
-			sv_insert(opts_prog, opts, 0,
-				  "\\n                       ", 25);
+			Perl_sv_insert(aTHX_ opts_prog, opts, 0,
+				  STR_WITH_LEN("\\n                       "));
 		    }
 
-		    sv_catpv(opts_prog,"\\n\",");
+		    sv_catpvs(opts_prog,"\\n\",");
 
 #if defined(LOCAL_PATCH_COUNT)
 		    if (LOCAL_PATCH_COUNT > 0) {
 			int i;
-			sv_catpv(opts_prog,
+			sv_catpvs(opts_prog,
 				 "\"  Locally applied patches:\\n\",");
 			for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
 			    if (PL_localpatches[i])
@@ -1810,14 +1892,14 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 				   __DATE__);
 #  endif
 #endif
-		    sv_catpv(opts_prog, "; $\"=\"\\n    \"; "
+		    sv_catpvs(opts_prog, "; $\"=\"\\n    \"; "
 			     "@env = map { \"$_=\\\"$ENV{$_}\\\"\" } "
 			     "sort grep {/^PERL/} keys %ENV; ");
 #ifdef __CYGWIN__
-		    sv_catpv(opts_prog,
+		    sv_catpvs(opts_prog,
 			     "push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
 #endif
-		    sv_catpv(opts_prog, 
+		    sv_catpvs(opts_prog, 
 			     "print \"  \\%ENV:\\n    @env\\n\" if @env;"
 			     "print \"  \\@INC:\\n    @INC\\n\";");
 		}
@@ -1891,7 +1973,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		d = s;
 		if (!*s)
 		    break;
-		if (!strchr("DIMUdmtwA", *s))
+		if (!strchr("CDIMUdmtwA", *s))
 		    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
 		while (++s && *s) {
 		    if (isSPACE(*s)) {
@@ -1961,7 +2043,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  define SIGCHLD SIGCLD
 #endif
 	Sighandler_t sigstate = rsignal_state(SIGCHLD);
-	if (sigstate == SIG_IGN) {
+	if (sigstate == (Sighandler_t) SIG_IGN) {
 	    if (ckWARN(WARN_SIGNAL))
 		Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
 			    "Can't ignore signal CHLD, forcing to default");
@@ -1982,14 +2064,14 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
     }
 
-    PL_main_cv = PL_compcv = (CV*)NEWSV(1104,0);
+    PL_main_cv = PL_compcv = (CV*)newSV(0);
     sv_upgrade((SV *)PL_compcv, SVt_PVCV);
     CvUNIQUE_on(PL_compcv);
 
     CvPADLIST(PL_compcv) = pad_new(0);
 #ifdef USE_5005THREADS
     CvOWNER(PL_compcv) = 0;
-    New(666, CvMUTEXP(PL_compcv), 1, perl_mutex);
+    Newx(CvMUTEXP(PL_compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(PL_compcv));
 #endif /* USE_5005THREADS */
 
@@ -2000,7 +2082,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     if (xsinit)
 	(*xsinit)(aTHX);	/* in case linked C routines want magical variables */
 #ifndef PERL_MICRO
-#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC)
+#if defined(VMS) || defined(WIN32) || defined(DJGPP) || defined(__CYGWIN__) || defined(EPOC) || defined(SYMBIAN)
     init_os_extras();
 #endif
 #endif
@@ -2024,7 +2106,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
      * or explicitly in some platforms.
      * locale.c:Perl_init_i18nl10n() if the environment
      * look like the user wants to use UTF-8. */
-#if defined(SYMBIAN)
+#if defined(__SYMBIAN32__)
     PL_unicode = PERL_UNICODE_STD_FLAG; /* See PERL_SYMBIAN_CONSOLE_UTF8. */
 #endif
     if (PL_unicode) {
@@ -2140,6 +2222,7 @@ Tells a Perl interpreter to run.  See L<perlembed>.
 int
 perl_run(pTHXx)
 {
+    dVAR;
     I32 oldscope;
     int ret = 0;
     dJMPENV;
@@ -2172,7 +2255,7 @@ perl_run(pTHXx)
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
-	ret = STATUS_NATIVE_EXPORT;
+	ret = STATUS_EXIT;
 	break;
     case 3:
 	if (PL_restartop) {
@@ -2193,13 +2276,16 @@ perl_run(pTHXx)
 STATIC void
 S_run_body(pTHX_ I32 oldscope)
 {
+    dVAR;
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
                     PL_sawampersand ? "Enabling" : "Omitting"));
 
     if (!PL_restartop) {
 	DEBUG_x(dump_all());
+#ifdef DEBUGGING
 	if (!DEBUG_q_TEST)
 	  PERL_DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+#endif
 	DEBUG_S(PerlIO_printf(Perl_debug_log, "main thread is 0x%"UVxf"\n",
 			      PTR2UV(thr)));
 
@@ -2279,12 +2365,12 @@ set and the variable does not exist then NULL is returned.
 AV*
 Perl_get_av(pTHX_ const char *name, I32 create)
 {
-    GV* gv = gv_fetchpv(name, create, SVt_PVAV);
+    GV* const gv = gv_fetchpv(name, create, SVt_PVAV);
     if (create)
     	return GvAVn(gv);
     if (gv)
 	return GvAV(gv);
-    return Nullav;
+    return NULL;
 }
 
 /*
@@ -2302,12 +2388,12 @@ set and the variable does not exist then NULL is returned.
 HV*
 Perl_get_hv(pTHX_ const char *name, I32 create)
 {
-    GV* gv = gv_fetchpv(name, create, SVt_PVHV);
+    GV* const gv = gv_fetchpv(name, create, SVt_PVHV);
     if (create)
     	return GvHVn(gv);
     if (gv)
 	return GvHV(gv);
-    return Nullhv;
+    return NULL;
 }
 
 /*
@@ -2326,7 +2412,7 @@ subroutine does not exist then NULL is returned.
 CV*
 Perl_get_cv(pTHX_ const char *name, I32 create)
 {
-    GV* gv = gv_fetchpv(name, create, SVt_PVCV);
+    GV* const gv = gv_fetchpv(name, create, SVt_PVCV);
     /* XXX unsafe for threads if eval_owner isn't held */
     /* XXX this is probably not what they think they're getting.
      * It has the same effect as "sub name;", i.e. just a forward
@@ -2360,6 +2446,7 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
           		/* See G_* flags in cop.h */
                      	/* null terminated arg list */
 {
+    dVAR;
     dSP;
 
     PUSHMARK(SP);
@@ -2428,7 +2515,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     I32 oldscope;
     bool oldcatch = CATCH_GET;
     int ret;
-    OP* oldop = PL_op;
+    OP* const oldop = PL_op;
     dJMPENV;
 
     if (flags & G_DISCARD) {
@@ -2565,6 +2652,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 STATIC void
 S_call_body(pTHX_ const OP *myop, bool is_eval)
 {
+    dVAR;
     if (PL_op == myop) {
 	if (is_eval)
 	    PL_op = Perl_pp_entereval(aTHX);	/* this doesn't do a POPMARK */
@@ -2590,12 +2678,13 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 
           		/* See G_* flags in cop.h */
 {
+    dVAR;
     dSP;
     UNOP myop;		/* fake syntax tree node */
     volatile I32 oldmark = SP - PL_stack_base;
     volatile I32 retval = 0;
     int ret;
-    OP* oldop = PL_op;
+    OP* const oldop = PL_op;
     dJMPENV;
 
     if (flags & G_DISCARD) {
@@ -2682,6 +2771,7 @@ Tells Perl to C<eval> the given string and return an SV* result.
 SV*
 Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 {
+    dVAR;
     dSP;
     SV* sv = newSVpv(p, 0);
 
@@ -2715,15 +2805,13 @@ implemented that way; consider using load_module instead.
 void
 Perl_require_pv(pTHX_ const char *pv)
 {
-    SV* sv;
+    dVAR;
     dSP;
+    SV* sv;
     PUSHSTACKi(PERLSI_REQUIRE);
     PUTBACK;
-    sv = sv_newmortal();
-    sv_setpv(sv, "require '");
-    sv_catpv(sv, pv);
-    sv_catpv(sv, "'");
-    eval_sv(sv, G_DISCARD);
+    sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
+    eval_sv(sv_2mortal(sv), G_DISCARD);
     SPAGAIN;
     POPSTACK;
 }
@@ -2731,9 +2819,9 @@ Perl_require_pv(pTHX_ const char *pv)
 void
 Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
 {
-    register GV *gv;
+    register GV * const gv = gv_fetchpv(sym,TRUE, SVt_PV);
 
-    if ((gv = gv_fetchpv(sym,TRUE, SVt_PV)))
+    if (gv)
 	sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
 }
 
@@ -2752,6 +2840,7 @@ S_usage(pTHX_ const char *name)		/* XXX move this out into a module ? */
 "-d[:debugger]     run program under debugger",
 "-D[number/list]   set debugging flags (argument is a bit mask or alphabets)",
 "-e program        one line of program (several -e's allowed, omit programfile)",
+"-E program        like -e, but enables all optional features",
 "-f                don't do $sitelib/sitecustomize.pl at startup",
 "-F/pattern/       split() pattern for -a switch (//'s are optional)",
 "-i[extension]     edit <> files in place (makes backup if extension supplied)",
@@ -2825,7 +2914,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 	static const char debopts[] = "psltocPmfrxu HXDSTRJvCAq";
 
 	for (; isALNUM(**s); (*s)++) {
-	    const char *d = strchr(debopts,**s);
+	    const char * const d = strchr(debopts,**s);
 	    if (d)
 		i |= 1 << (d - debopts);
 	    else if (ckWARN_d(WARN_DEBUGGING))
@@ -2838,7 +2927,7 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 	for (; isALNUM(**s); (*s)++) ;
     }
     else if (givehelp) {
-      char **p = (char **)usage_msgd;
+      const char *const *p = usage_msgd;
       while (*p) PerlIO_printf(PerlIO_stdout(), "%s\n", *p++);
     }
 #  ifdef EBCDIC
@@ -2879,7 +2968,7 @@ Perl_moreswitches(pTHX_ char *s)
 		   numlen = 0;
 		   s--;
 	      }
-	      PL_rs = newSVpvn("", 0);
+	      PL_rs = newSVpvs("");
 	      SvGROW(PL_rs, (STRLEN)(UNISKIP(rschar) + 1));
 	      tmps = (U8*)SvPVX(PL_rs);
 	      uvchr_to_utf8(tmps, rschar);
@@ -2892,7 +2981,7 @@ Perl_moreswitches(pTHX_ char *s)
 	      if (rschar & ~((U8)~0))
 		   PL_rs = &PL_sv_undef;
 	      else if (!rschar && numlen >= 2)
-		   PL_rs = newSVpvn("", 0);
+		   PL_rs = newSVpvs("");
 	      else {
 		   char ch = (char)rschar;
 		   PL_rs = newSVpvn(&ch, 1);
@@ -2934,8 +3023,7 @@ Perl_moreswitches(pTHX_ char *s)
 	   in the fashion that -MSome::Mod does. */
 	if (*s == ':' || *s == '=') {
             const char *start;
-	    SV *sv;
-	    sv = newSVpv("use Devel::", 0);
+	    SV * const sv = newSVpvs("use Devel::");
 	    start = ++s;
 	    /* We now allow -d:Module=Foo,Bar */
 	    while(isALNUM(*s) || *s==':') ++s;
@@ -2971,11 +3059,10 @@ Perl_moreswitches(pTHX_ char *s)
 	usage(PL_origargv[0]);
 	my_exit(0);
     case 'i':
-	if (PL_inplace)
-	    Safefree(PL_inplace);
+	Safefree(PL_inplace);
 #if defined(__CYGWIN__) /* do backup extension automagically */
 	if (*(s+1) == '\0') {
-	PL_inplace = savepv(".bak");
+	PL_inplace = savepvs(".bak");
 	return s+1;
 	}
 #endif /* __CYGWIN__ */
@@ -3023,14 +3110,14 @@ Perl_moreswitches(pTHX_ char *s)
 	if (isDIGIT(*s)) {
             I32 flags = 0;
 	    STRLEN numlen;
-	    PL_ors_sv = newSVpvn("\n",1);
+	    PL_ors_sv = newSVpvs("\n");
 	    numlen = 3 + (*s == '0');
 	    *SvPVX(PL_ors_sv) = (char)grok_oct(s, &numlen, &flags, NULL);
 	    s += numlen;
 	}
 	else {
 	    if (RsPARA(PL_rs)) {
-		PL_ors_sv = newSVpvn("\n\n",2);
+		PL_ors_sv = newSVpvs("\n\n");
 	    }
 	    else {
 		PL_ors_sv = newSVsv(PL_rs);
@@ -3043,11 +3130,11 @@ Perl_moreswitches(pTHX_ char *s)
 	    PL_preambleav = newAV();
 	s++;
 	{
-	    char *start = s;
-	    SV *sv = newSVpv("use assertions::activate", 24);
+	    char * const start = s;
+	    SV * const sv = newSVpvs("use assertions::activate");
 	    while(isALNUM(*s) || *s == ':') ++s;
 	    if (s != start) {
-		sv_catpvn(sv, "::", 2);
+		sv_catpvs(sv, "::");
 		sv_catpvn(sv, start, s-start);
 	    }
 	    if (*s == '=') {
@@ -3055,7 +3142,7 @@ Perl_moreswitches(pTHX_ char *s)
 		s+=strlen(s);
 	    }
 	    else if (*s != '\0') {
-		Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, s-start, start);
+		Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, (int)(s-start), start);
 	    }
 	    av_push(PL_preambleav, sv);
 	    return s;
@@ -3082,17 +3169,17 @@ Perl_moreswitches(pTHX_ char *s)
 		if (*(start-1) == 'm') {
 		    if (*s != '\0')
 			Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
-		    sv_catpv( sv, " ()");
+		    sv_catpvs( sv, " ()");
 		}
 	    } else {
                 if (s == start)
                     Perl_croak(aTHX_ "Module name required with -%c option",
 			       s[-1]);
 		sv_catpvn(sv, start, s-start);
-		sv_catpv(sv, " split(/,/,q");
-		sv_catpvn(sv, "\0)", 1);        /* Use NUL as q//-delimiter. */
+		sv_catpvs(sv, " split(/,/,q");
+		sv_catpvs(sv, "\0");        /* Use NUL as q//-delimiter. */
 		sv_catpv(sv, ++s);
-		sv_catpvn(sv,  "\0)", 2);
+		sv_catpvs(sv,  "\0)");
 	    }
 	    s += strlen(s);
 	    if (!PL_preambleav)
@@ -3138,10 +3225,14 @@ Perl_moreswitches(pTHX_ char *s)
 	return s;
     case 'v':
 	if (!sv_derived_from(PL_patchlevel, "version"))
-		(void *)upg_version(PL_patchlevel);
+	    upg_version(PL_patchlevel);
 #if !defined(DGUX)
 	PerlIO_printf(PerlIO_stdout(),
-		Perl_form(aTHX_ "\nThis is perl, %"SVf" built for %s",
+		Perl_form(aTHX_ "\nThis is perl, %"SVf
+#ifdef PERL_PATCHNUM
+			  " DEVEL" STRINGIFY(PERL_PATCHNUM)
+#endif
+			  " built for %s",
 		    vstringify(PL_patchlevel),
 		    ARCHNAME));
 #else /* DGUX */
@@ -3167,7 +3258,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 
 	PerlIO_printf(PerlIO_stdout(),
-		      "\n\nCopyright 1987-2005, Larry Wall\n");
+		      "\n\nCopyright 1987-2006, Larry Wall\n");
 #ifdef MACOS_TRADITIONAL
 	PerlIO_printf(PerlIO_stdout(),
 		      "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
@@ -3228,7 +3319,7 @@ Perl_moreswitches(pTHX_ char *s)
 	PerlIO_printf(PerlIO_stdout(),"Built on " __DATE__ " " __TIME__ "\n\n");
 	wce_hitreturn();
 #endif
-#ifdef SYMBIAN
+#ifdef __SYMBIAN32__
 	PerlIO_printf(PerlIO_stdout(),
 		      "Symbian port by Nokia, 2004-2005\n");
 #endif
@@ -3304,9 +3395,9 @@ Perl_my_unexec(pTHX)
     extern int etext;
 
     prog = newSVpv(BIN_EXP, 0);
-    sv_catpv(prog, "/perl");
+    sv_catpvs(prog, "/perl");
     file = newSVpv(PL_origfilename, 0);
-    sv_catpv(file, ".perldump");
+    sv_catpvs(file, ".perldump");
 
     unexec(SvPVX(file), SvPVX(prog), &etext, sbrk(0), 0);
     /* unexec prints msg to stderr in case of failure */
@@ -3315,6 +3406,8 @@ Perl_my_unexec(pTHX)
 #  ifdef VMS
 #    include <lib$routines.h>
      lib$signal(SS$_DEBUG);  /* ssdef.h #included from vmsish.h */
+#  elif defined(WIN32) || defined(__CYGWIN__)
+    Perl_croak(aTHX_ "dump is not supported");
 #  else
     ABORT();		/* for use with undump */
 #  endif
@@ -3325,7 +3418,7 @@ Perl_my_unexec(pTHX)
 STATIC void
 S_init_interp(pTHX)
 {
-
+    dVAR;
 #ifdef MULTIPLICITY
 #  define PERLVAR(var,type)
 #  define PERLVARA(var,n,type)
@@ -3369,21 +3462,32 @@ S_init_interp(pTHX)
 STATIC void
 S_init_main_stash(pTHX)
 {
+    dVAR;
     GV *gv;
 
     PL_curstash = PL_defstash = newHV();
-    PL_curstname = newSVpvn("main",4);
+    /* We know that the string "main" will be in the global shared string
+       table, so it's a small saving to use it rather than allocate another
+       8 bytes.  */
+    PL_curstname = newSVpvs_share("main");
     gv = gv_fetchpv("main::",TRUE, SVt_PVHV);
+    /* If we hadn't caused another reference to "main" to be in the shared
+       string table above, then it would be worth reordering these two,
+       because otherwise all we do is delete "main" from it as a consequence
+       of the SvREFCNT_dec, only to add it again with hv_name_set */
     SvREFCNT_dec(GvHV(gv));
+    hv_name_set(PL_defstash, "main", 4, 0);
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
-    Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
+    SvREFCNT_inc(PL_incgv); /* Don't allow it to be freed */
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
     GvMULTI_on(PL_hintgv);
     PL_defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
+    SvREFCNT_inc(PL_defgv);
     PL_errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    SvREFCNT_inc(PL_errgv);
     GvMULTI_on(PL_errgv);
     PL_replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */
     GvMULTI_on(PL_replgv);
@@ -3417,7 +3521,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
     PL_suidscript = -1;
 
     if (PL_e_script) {
-	PL_origfilename = savepvn("-e", 2);
+	PL_origfilename = savepvs("-e");
     }
     else {
 	/* if find_script() returns, it returns a malloc()-ed value */
@@ -3486,9 +3590,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
     }
 #else /* IAMSUID */
     else if (PL_preprocess) {
-	const char *cpp_cfg = CPPSTDIN;
-	SV *cpp = newSVpvn("",0);
-	SV *cmd = NEWSV(0,0);
+	const char * const cpp_cfg = CPPSTDIN;
+	SV * const cpp = newSVpvs("");
+	SV * const cmd = newSV(0);
 
 	if (cpp_cfg[0] == 0) /* PERL_MICRO? */
 	     Perl_croak(aTHX_ "Can't run with cpp -P with CPPSTDIN undefined");
@@ -3497,7 +3601,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 	sv_catpv(cpp, cpp_cfg);
 
 #       ifndef VMS
-	    sv_catpvn(sv, "-I", 2);
+	    sv_catpvs(sv, "-I");
 	    sv_catpv(sv,PRIVLIB_EXP);
 #       endif
 
@@ -3566,8 +3670,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 #endif /* IAMSUID */
     if (!PL_rsfp) {
 	/* PSz 16 Sep 03  Keep neat error message */
-	Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
-		CopFILE(PL_curcop), Strerror(errno));
+	if (PL_e_script)
+	    Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
+	else
+	    Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
+		    CopFILE(PL_curcop), Strerror(errno));
     }
 }
 
@@ -3657,10 +3764,9 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
                     cmplen = sizeof(fsd.fd_req.path);
                 if (strnEQ(fsd.fd_req.path, us.f_fname, cmplen) &&
                     fdst.st_dev == fsd.fd_req.dev) {
-                        check_okay = 1;
-                        on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
-                        on_noexec = fsd.fd_req.flags & PERL_MOUNT_NOEXEC;
-                    }
+                    check_okay = 1;
+                    on_nosuid = fsd.fd_req.flags & PERL_MOUNT_NOSUID;
+                    on_noexec = fsd.fd_req.flags & PERL_MOUNT_NOEXEC;
                 }
             }
         }
@@ -3749,6 +3855,7 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
     if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	I32 len;
 	const char *linestr;
+	const char *s_end;
 
 #ifdef IAMSUID
 	if (PL_fdscript < 0 || PL_suidscript != 1)
@@ -3846,15 +3953,18 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
 	PL_doswitches = FALSE;		/* -s is insecure in suid */
 	/* PSz 13 Nov 03  But -s was caught elsewhere ... so unsetting it here is useless(?!) */
 	CopLINE_inc(PL_curcop);
+	if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch)
+	    Perl_croak(aTHX_ "No #! line");
 	linestr = SvPV_nolen_const(PL_linestr);
-	if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
-	  strnNE(linestr,"#!",2) )	/* required even on Sys V */
+	/* required even on Sys V */
+	if (!*linestr || !linestr[1] || strnNE(linestr,"#!",2))
 	    Perl_croak(aTHX_ "No #! line");
-	linestr+=2;
+	linestr += 2;
 	s = linestr;
 	/* PSz 27 Feb 04 */
 	/* Sanity check on line length */
-	if (strlen(s) < 1 || strlen(s) > 4000)
+	s_end = s + strlen(s);
+	if (s_end == s || (s_end - s) > 4000)
 	    Perl_croak(aTHX_ "Very long #! line");
 	/* Allow more than a single space after #! */
 	while (isSPACE(*s)) s++;
@@ -3893,7 +4003,8 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
 	len = strlen(validarg);
 	if (strEQ(validarg," PHOOEY ") ||
 	    strnNE(s,validarg,len) || !isSPACE(s[len]) ||
-	    !(strlen(s) == len+1 || (strlen(s) == len+2 && isSPACE(s[len+1]))))
+	    !((s_end - s) == len+1
+	      || ((s_end - s) == len+2 && isSPACE(s[len+1]))))
 	    Perl_croak(aTHX_ "Args must match #! line");
 
 #ifndef IAMSUID
@@ -4111,6 +4222,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 STATIC void
 S_find_beginning(pTHX)
 {
+    dVAR;
     register char *s;
     register const char *s2;
 #ifdef MACOS_TRADITIONAL
@@ -4180,6 +4292,7 @@ S_find_beginning(pTHX)
 STATIC void
 S_init_ids(pTHX)
 {
+    dVAR;
     PL_uid = PerlProc_getuid();
     PL_euid = PerlProc_geteuid();
     PL_gid = PerlProc_getgid();
@@ -4242,6 +4355,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
 STATIC void
 S_forbid_setid(pTHX_ const char *s)
 {
+    dVAR;
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
     if (PL_euid != PL_uid)
         Perl_croak(aTHX_ "No %s allowed while running setuid", s);
@@ -4281,7 +4395,8 @@ S_forbid_setid(pTHX_ const char *s)
 void
 Perl_init_debugger(pTHX)
 {
-    HV *ostash = PL_curstash;
+    dVAR;
+    HV * const ostash = PL_curstash;
 
     PL_curstash = PL_debstash;
     PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("DB::args", GV_ADDMULTI, SVt_PVAV))));
@@ -4309,6 +4424,7 @@ Perl_init_debugger(pTHX)
 void
 Perl_init_stacks(pTHX)
 {
+    dVAR;
     /* start with 128-item stack and 8K cxstack */
     PL_curstackinfo = new_stackinfo(REASONABLE(128),
 				 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
@@ -4320,22 +4436,22 @@ Perl_init_stacks(pTHX)
     PL_stack_sp = PL_stack_base;
     PL_stack_max = PL_stack_base + AvMAX(PL_curstack);
 
-    New(50,PL_tmps_stack,REASONABLE(128),SV*);
+    Newx(PL_tmps_stack,REASONABLE(128),SV*);
     PL_tmps_floor = -1;
     PL_tmps_ix = -1;
     PL_tmps_max = REASONABLE(128);
 
-    New(54,PL_markstack,REASONABLE(32),I32);
+    Newx(PL_markstack,REASONABLE(32),I32);
     PL_markstack_ptr = PL_markstack;
     PL_markstack_max = PL_markstack + REASONABLE(32);
 
     SET_MARK_OFFSET;
 
-    New(54,PL_scopestack,REASONABLE(32),I32);
+    Newx(PL_scopestack,REASONABLE(32),I32);
     PL_scopestack_ix = 0;
     PL_scopestack_max = REASONABLE(32);
 
-    New(54,PL_savestack,REASONABLE(128),ANY);
+    Newx(PL_savestack,REASONABLE(128),ANY);
     PL_savestack_ix = 0;
     PL_savestack_max = REASONABLE(128);
 }
@@ -4345,6 +4461,7 @@ Perl_init_stacks(pTHX)
 STATIC void
 S_nuke_stacks(pTHX)
 {
+    dVAR;
     while (PL_curstackinfo->si_next)
 	PL_curstackinfo = PL_curstackinfo->si_next;
     while (PL_curstackinfo) {
@@ -4363,17 +4480,19 @@ S_nuke_stacks(pTHX)
 STATIC void
 S_init_lexer(pTHX)
 {
+    dVAR;
     PerlIO *tmpfp;
     tmpfp = PL_rsfp;
     PL_rsfp = Nullfp;
     lex_start(PL_linestr);
     PL_rsfp = tmpfp;
-    PL_subname = newSVpvn("main",4);
+    PL_subname = newSVpvs("main");
 }
 
 STATIC void
 S_init_predump_symbols(pTHX)
 {
+    dVAR;
     GV *tmpgv;
     IO *io;
 
@@ -4406,20 +4525,20 @@ S_init_predump_symbols(pTHX)
     GvMULTI_on(tmpgv);
     GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
-    PL_statname = NEWSV(66,0);		/* last filename we did stat on */
+    PL_statname = newSV(0);		/* last filename we did stat on */
 
-    if (PL_osname)
-    	Safefree(PL_osname);
+    Safefree(PL_osname);
     PL_osname = savepv(OSNAME);
 }
 
 void
 Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 {
-    char *s;
+    dVAR;
     argc--,argv++;	/* skip name of script */
     if (PL_doswitches) {
 	for (; argc > 0 && **argv == '-'; argc--,argv++) {
+	    char *s;
 	    if (!argv[0][1])
 		break;
 	    if (argv[0][1] == '-' && !argv[0][2]) {
@@ -4427,8 +4546,9 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 		break;
 	    }
 	    if ((s = strchr(argv[0], '='))) {
-		*s++ = '\0';
-		sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
+		*s = '\0';
+		sv_setpv(GvSV(gv_fetchpv(argv[0] + 1, TRUE, SVt_PV)), s + 1);
+		*s = '=';
 	    }
 	    else
 		sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
@@ -4439,7 +4559,7 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 	(void)gv_AVadd(PL_argvgv);
 	av_clear(GvAVn(PL_argvgv));
 	for (; argc > 0; argc--,argv++) {
-	    SV *sv = newSVpv(argv[0],0);
+	    SV * const sv = newSVpv(argv[0],0);
 	    av_push(GvAVn(PL_argvgv),sv);
 	    if (!(PL_unicode & PERL_UNICODE_LOCALE_FLAG) || PL_utf8locale) {
 		 if (PL_unicode & PERL_UNICODE_ARGV_FLAG)
@@ -4457,10 +4577,10 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     dVAR;
     GV* tmpgv;
 
-    PL_toptarget = NEWSV(0,0);
+    PL_toptarget = newSV(0);
     sv_upgrade(PL_toptarget, SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
-    PL_bodytarget = NEWSV(0,0);
+    PL_bodytarget = newSV(0);
     sv_upgrade(PL_bodytarget, SVt_PVFM);
     sv_setpvn(PL_bodytarget, "", 0);
     PL_formtarget = PL_bodytarget;
@@ -4548,11 +4668,21 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 STATIC void
 S_init_perllib(pTHX)
 {
+    dVAR;
     char *s;
     if (!PL_tainting) {
 #ifndef VMS
 	s = PerlEnv_getenv("PERL5LIB");
+/*
+ * It isn't possible to delete an environment variable with
+ * PERL_USE_SAFE_PUTENV set unless unsetenv() is also available, so in that
+ * case we treat PERL5LIB as undefined if it has a zero-length value.
+ */
+#if defined(PERL_USE_SAFE_PUTENV) && ! defined(HAS_UNSETENV)
+	if (s && *s != '\0')
+#else
 	if (s)
+#endif
 	    incpush(s, TRUE, TRUE, TRUE, FALSE);
 	else
 	    incpush(PerlEnv_getenv("PERLLIB"), FALSE, FALSE, TRUE, FALSE);
@@ -4583,7 +4713,7 @@ S_init_perllib(pTHX)
 #ifdef MACOS_TRADITIONAL
     {
 	Stat_t tmpstatbuf;
-    	SV * privdir = NEWSV(55, 0);
+    	SV * privdir = newSV(0);
 	char * macperl = PerlEnv_getenv("MACPERL");
 	
 	if (!macperl)
@@ -4660,7 +4790,7 @@ S_init_perllib(pTHX)
 #endif /* MACOS_TRADITIONAL */
 }
 
-#if defined(DOSISH) || defined(EPOC) || defined(SYMBIAN)
+#if defined(DOSISH) || defined(EPOC) || defined(__SYMBIAN32__)
 #    define PERLLIB_SEP ';'
 #else
 #  if defined(VMS)
@@ -4683,11 +4813,12 @@ S_init_perllib(pTHX)
 STATIC SV *
 S_incpush_if_exists(pTHX_ SV *dir)
 {
+    dVAR;
     Stat_t tmpstatbuf;
     if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
 	S_ISDIR(tmpstatbuf.st_mode)) {
 	av_push(GvAVn(PL_incgv), dir);
-	dir = NEWSV(0,0);
+	dir = newSV(0);
     }
     return dir;
 }
@@ -4696,6 +4827,7 @@ STATIC void
 S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 	  bool canrelocate)
 {
+    dVAR;
     SV *subdir = Nullsv;
     const char *p = dir;
 
@@ -4703,19 +4835,19 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 	return;
 
     if (addsubdirs || addoldvers) {
-	subdir = NEWSV(0,0);
+	subdir = newSV(0);
     }
 
     /* Break at all separators */
     while (p && *p) {
-	SV *libdir = NEWSV(55,0);
+	SV *libdir = newSV(0);
         const char *s;
 
 	/* skip any consecutive separators */
 	if (usesep) {
 	    while ( *p == PERLLIB_SEP ) {
 		/* Uncomment the next line for PATH semantics */
-		/* av_push(GvAVn(PL_incgv), newSVpvn(".", 1)); */
+		/* av_push(GvAVn(PL_incgv), newSVpvs(".")); */
 		p++;
 	    }
 	}
@@ -4736,7 +4868,7 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 	    sv_setpv(libdir, MacPerl_CanonDir(SvPVX(libdir), buf, 0));
 	}
 	if (SvPVX(libdir)[SvCUR(libdir)-1] != ':')
-	    sv_catpv(libdir, ":");
+	    sv_catpvs(libdir, ":");
 #endif
 
 	/* Do the if() outside the #ifdef to avoid warnings about an unused
@@ -4759,11 +4891,11 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 	 * The intent is that /usr/local/bin/perl and .../../lib/perl5
 	 * generates /usr/local/lib/perl5
 	 */
-	    char *libpath = SvPVX(libdir);
+	    const char *libpath = SvPVX(libdir);
 	    STRLEN libpath_len = SvCUR(libdir);
 	    if (libpath_len >= 4 && memEQ (libpath, ".../", 4)) {
 		/* Game on!  */
-		SV *caret_X = get_sv("\030", 0);
+		SV * const caret_X = get_sv("\030", 0);
 		/* Going to use the SV just as a scratch buffer holding a C
 		   string:  */
 		SV *prefix_sv;
@@ -4844,8 +4976,8 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 	if (addsubdirs || addoldvers) {
 #ifdef PERL_INC_VERSION_LIST
 	    /* Configure terminates PERL_INC_VERSION_LIST with a NULL */
-	    const char *incverlist[] = { PERL_INC_VERSION_LIST };
-	    const char **incver;
+	    const char * const incverlist[] = { PERL_INC_VERSION_LIST };
+	    const char * const *incver;
 #endif
 #ifdef VMS
 	    char *unix;
@@ -4919,7 +5051,7 @@ S_init_main_thread(pTHX)
 #endif
     XPV *xpv;
 
-    Newz(53, thr, 1, struct perl_thread);
+    Newxz(thr, 1, struct perl_thread);
     PL_curcop = &PL_compiling;
     thr->interp = PERL_GET_INTERP;
     thr->cvcache = newHV();
@@ -4929,8 +5061,8 @@ S_init_main_thread(pTHX)
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
     /* Handcraft thrsv similarly to mess_sv */
-    New(53, PL_thrsv, 1, SV);
-    Newz(53, xpv, 1, XPV);
+    Newx(PL_thrsv, 1, SV);
+    Newxz(xpv, 1, XPV);
     SvFLAGS(PL_thrsv) = SVt_PV;
     SvANY(PL_thrsv) = (void*)xpv;
     SvREFCNT(PL_thrsv) = 1 << 30;	/* practically infinite */
@@ -4966,14 +5098,14 @@ S_init_main_thread(pTHX)
      * because sv_setpvn does SvTAINT and the taint
      * fields thread selfness being set.
      */
-    PL_toptarget = NEWSV(0,0);
+    PL_toptarget = newSV(0);
     sv_upgrade(PL_toptarget, SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
-    PL_bodytarget = NEWSV(0,0);
+    PL_bodytarget = newSV(0);
     sv_upgrade(PL_bodytarget, SVt_PVFM);
     sv_setpvn(PL_bodytarget, "", 0);
     PL_formtarget = PL_bodytarget;
-    thr->errsv = newSVpvn("", 0);
+    thr->errsv = newSVpvs("");
     (void) find_threadsv("@");	/* Ensure $@ is initialised early */
 
     PL_maxscream = -1;
@@ -5029,7 +5161,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 		PL_curcop = &PL_compiling;
 		CopLINE_set(PL_curcop, oldline);
 		if (paramList == PL_beginav)
-		    sv_catpv(atsv, "BEGIN failed--compilation aborted");
+		    sv_catpvs(atsv, "BEGIN failed--compilation aborted");
 		else
 		    Perl_sv_catpvf(aTHX_ atsv,
 				   "%s failed--call queue aborted",
@@ -5082,6 +5214,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 STATIC void *
 S_call_list_body(pTHX_ CV *cv)
 {
+    dVAR;
     PUSHMARK(PL_stack_sp);
     call_sv((SV*)cv, G_EVAL|G_DISCARD);
     return NULL;
@@ -5090,6 +5223,7 @@ S_call_list_body(pTHX_ CV *cv)
 void
 Perl_my_exit(pTHX_ U32 status)
 {
+    dVAR;
     DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
 			  thr, (unsigned long) status));
     switch (status) {
@@ -5100,7 +5234,7 @@ Perl_my_exit(pTHX_ U32 status)
 	STATUS_ALL_FAILURE;
 	break;
     default:
-	STATUS_NATIVE_SET(status);
+	STATUS_EXIT_SET(status);
 	break;
     }
     my_exit_jump();
@@ -5109,17 +5243,62 @@ Perl_my_exit(pTHX_ U32 status)
 void
 Perl_my_failure_exit(pTHX)
 {
+    dVAR;
 #ifdef VMS
-    if (vaxc$errno & 1) {
-	if (STATUS_NATIVE & 1)		/* fortuitiously includes "-1" */
-	    STATUS_NATIVE_SET(44);
+     /* We have been called to fall on our sword.  The desired exit code
+      * should be already set in STATUS_UNIX, but could be shifted over
+      * by 8 bits.  STATUS_UNIX_EXIT_SET will handle the cases where a
+      * that code is set.
+      *
+      * If an error code has not been set, then force the issue.
+      */
+    if (MY_POSIX_EXIT) {
+
+	/* In POSIX_EXIT mode follow Perl documentations and use 255 for
+	 * the exit code when there isn't an error.
+	 */
+
+	if (STATUS_UNIX == 0)
+	    STATUS_UNIX_EXIT_SET(255);
+	else {
+	    STATUS_UNIX_EXIT_SET(STATUS_UNIX);
+
+	    /* The exit code could have been set by $? or vmsish which
+	     * means that it may not be fatal.  So convert
+	     * success/warning codes to fatal.
+	     */
+	    if ((STATUS_NATIVE & (STS$K_SEVERE|STS$K_ERROR)) == 0)
+		STATUS_UNIX_EXIT_SET(255);
+	}
     }
     else {
-	if (!vaxc$errno)		/* unlikely */
-	    STATUS_NATIVE_SET(44);
-	else
-	    STATUS_NATIVE_SET(vaxc$errno);
+	/* Traditionally Perl on VMS always expects a Fatal Error. */
+	if (vaxc$errno & 1) {
+
+	    /* So force success status to failure */
+	    if (STATUS_NATIVE & 1)
+		STATUS_ALL_FAILURE;
+	}
+	else {
+	    if (!vaxc$errno) {
+		STATUS_UNIX = EINTR; /* In case something cares */
+		STATUS_ALL_FAILURE;
+	    }
+	    else {
+		int severity;
+		STATUS_NATIVE = vaxc$errno; /* Should already be this */
+
+		/* Encode the severity code */
+		severity = STATUS_NATIVE & STS$M_SEVERITY;
+		STATUS_UNIX = (severity ? severity : 1) << 8;
+
+		/* Perl expects this to be a fatal error */
+		if (severity != STS$K_SEVERE)
+		    STATUS_ALL_FAILURE;
+	    }
+	}
     }
+
 #else
     int exitstatus;
     if (errno & 255)
@@ -5164,6 +5343,7 @@ S_my_exit_jump(pTHX)
 static I32
 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
+    dVAR;
     const char * const p  = SvPVX_const(PL_e_script);
     const char *nl = strchr(p, '\n');