X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=0b21655c46075bf0564f17b9e70a8660057b5b2d;hb=ffd4ff43bd2a65a31e5f3808320b98b9851ba91e;hp=2b09a4af26b4549e7c68af0fb0d4192bb06e2fdd;hpb=0510663fa1f5ec2b546d095c2c040e4f25909e8a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 2b09a4a..0b21655 100644
--- a/perl.c
+++ b/perl.c
@@ -92,6 +92,21 @@ char *nw_get_sitelib(const char *pl);
 #include <unistd.h>
 #endif
 
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+#  ifdef I_SYS_WAIT
+#   include <sys/wait.h>
+#  endif
+#  ifdef I_SYSUIO
+#    include <sys/uio.h>
+#  endif
+
+union control_un {
+  struct cmsghdr cm;
+  char control[CMSG_SPACE(sizeof(int))];
+};
+
+#endif
+
 #ifdef __BEOS__
 #  define HZ 1000000
 #endif
@@ -150,7 +165,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);
@@ -183,7 +198,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);
@@ -203,6 +218,7 @@ void
 perl_construct(pTHXx)
 {
     dVAR;
+    PERL_UNUSED_ARG(my_perl);
 #ifdef MULTIPLICITY
     init_interp();
     PL_perl_destruct_level = 1;
@@ -242,7 +258,7 @@ perl_construct(pTHXx)
 	    SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
 	}
 
-	PL_sighandlerp = Perl_sighandler;
+	PL_sighandlerp = (Sighandler_t) Perl_sighandler;
 	PL_pidstatus = newHV();
     }
 
@@ -316,12 +332,8 @@ perl_construct(pTHXx)
 
     PL_stashcache = newHV();
 
-    PL_patchlevel = newSVpv(
-	    Perl_form(aTHX_ "%d.%d.%d",
-	    (int)PERL_REVISION,
-	    (int)PERL_VERSION,
-	    (int)PERL_SUBVERSION ), 0
-    );
+    PL_patchlevel = Perl_newSVpvf(aTHX_ "%d.%d.%d", (int)PERL_REVISION,
+				  (int)PERL_VERSION, (int)PERL_SUBVERSION);
 
 #ifdef HAS_MMAP
     if (!PL_mmap_page_size) {
@@ -383,6 +395,104 @@ Perl_nothreadhook(pTHX)
     return 0;
 }
 
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+void
+Perl_dump_sv_child(pTHX_ SV *sv)
+{
+    ssize_t got;
+    const int sock = PL_dumper_fd;
+    const int debug_fd = PerlIO_fileno(Perl_debug_log);
+    union control_un control;
+    struct msghdr msg;
+    struct iovec vec[2];
+    struct cmsghdr *cmptr;
+    int returned_errno;
+    unsigned char buffer[256];
+
+    if(sock == -1 || debug_fd == -1)
+	return;
+
+    PerlIO_flush(Perl_debug_log);
+
+    /* All these shenanigans are to pass a file descriptor over to our child for
+       it to dump out to.  We can't let it hold open the file descriptor when it
+       forks, as the file descriptor it will dump to can turn out to be one end
+       of pipe that some other process will wait on for EOF. (So as it would
+       be open, the wait would be forever.  */
+
+    msg.msg_control = control.control;
+    msg.msg_controllen = sizeof(control.control);
+    /* We're a connected socket so we don't need a destination  */
+    msg.msg_name = NULL;
+    msg.msg_namelen = 0;
+    msg.msg_iov = vec;
+    msg.msg_iovlen = 1;
+
+    cmptr = CMSG_FIRSTHDR(&msg);
+    cmptr->cmsg_len = CMSG_LEN(sizeof(int));
+    cmptr->cmsg_level = SOL_SOCKET;
+    cmptr->cmsg_type = SCM_RIGHTS;
+    *((int *)CMSG_DATA(cmptr)) = 1;
+
+    vec[0].iov_base = (void*)&sv;
+    vec[0].iov_len = sizeof(sv);
+    got = sendmsg(sock, &msg, 0);
+
+    if(got < 0) {
+	perror("Debug leaking scalars parent sendmsg failed");
+	abort();
+    }
+    if(got < sizeof(sv)) {
+	perror("Debug leaking scalars parent short sendmsg");
+	abort();
+    }
+
+    /* Return protocol is
+       int:		errno value
+       unsigned char:	length of location string (0 for empty)
+       unsigned char*:	string (not terminated)
+    */
+    vec[0].iov_base = (void*)&returned_errno;
+    vec[0].iov_len = sizeof(returned_errno);
+    vec[1].iov_base = buffer;
+    vec[1].iov_len = 1;
+
+    got = readv(sock, vec, 2);
+
+    if(got < 0) {
+	perror("Debug leaking scalars parent read failed");
+	PerlIO_flush(PerlIO_stderr());
+	abort();
+    }
+    if(got < sizeof(returned_errno) + 1) {
+	perror("Debug leaking scalars parent short read");
+	PerlIO_flush(PerlIO_stderr());
+	abort();
+    }
+
+    if (*buffer) {
+	got = read(sock, buffer + 1, *buffer);
+	if(got < 0) {
+	    perror("Debug leaking scalars parent read 2 failed");
+	    PerlIO_flush(PerlIO_stderr());
+	    abort();
+	}
+
+	if(got < *buffer) {
+	    perror("Debug leaking scalars parent short read 2");
+	    PerlIO_flush(PerlIO_stderr());
+	    abort();
+	}
+    }
+
+    if (returned_errno || *buffer) {
+	Perl_warn(aTHX_ "Debug leaking scalars child failed%s%.*s with errno"
+		  " %d: %s", (*buffer ? " at " : ""), (int) *buffer, buffer + 1,
+		  returned_errno, strerror(returned_errno));
+    }
+}
+#endif
+
 /*
 =for apidoc perl_destruct
 
@@ -397,6 +507,11 @@ perl_destruct(pTHXx)
     dVAR;
     volatile int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     HV *hv;
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+    pid_t child;
+#endif
+
+    PERL_UNUSED_ARG(my_perl);
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
@@ -404,8 +519,8 @@ perl_destruct(pTHXx)
     destruct_level = PL_perl_destruct_level;
 #ifdef DEBUGGING
     {
-	const char *s;
-	if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
+	const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
+	if (s) {
             const int i = atoi(s);
 	    if (destruct_level < i)
 		destruct_level = i;
@@ -418,6 +533,7 @@ perl_destruct(pTHXx)
         int x = 0;
 
         JMPENV_PUSH(x);
+	PERL_UNUSED_VAR(x);
         if (PL_endav && !PL_minus_c)
             call_list(PL_scopestack_ix, PL_endav);
         JMPENV_POP;
@@ -433,9 +549,168 @@ perl_destruct(pTHXx)
         return STATUS_NATIVE_EXPORT;
     }
 
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+    if (destruct_level != 0) {
+	/* Fork here to create a child. Our child's job is to preserve the
+	   state of scalars prior to destruction, so that we can instruct it
+	   to dump any scalars that we later find have leaked.
+	   There's no subtlety in this code - it assumes POSIX, and it doesn't
+	   fail gracefully  */
+	int fd[2];
+
+	if(socketpair(AF_UNIX, SOCK_STREAM, 0, fd)) {
+	    perror("Debug leaking scalars socketpair failed");
+	    abort();
+	}
+
+	child = fork();
+	if(child == -1) {
+	    perror("Debug leaking scalars fork failed");
+	    abort();
+	}
+	if (!child) {
+	    /* We are the child */
+	    const int sock = fd[1];
+	    const int debug_fd = PerlIO_fileno(Perl_debug_log);
+	    int f;
+	    const char *where;
+	    /* Our success message is an integer 0, and a char 0  */
+	    static const char success[sizeof(int) + 1];
+
+	    close(fd[0]);
+
+	    /* We need to close all other file descriptors otherwise we end up
+	       with interesting hangs, where the parent closes its end of a
+	       pipe, and sits waiting for (another) child to terminate. Only
+	       that child never terminates, because it never gets EOF, because
+	       we also have the far end of the pipe open.  We even need to
+	       close the debugging fd, because sometimes it happens to be one
+	       end of a pipe, and a process is waiting on the other end for
+	       EOF. Normally it would be closed at some point earlier in
+	       destruction, but if we happen to cause the pipe to remain open,
+	       EOF never occurs, and we get an infinite hang. Hence all the
+	       games to pass in a file descriptor if it's actually needed.  */
+
+	    f = sysconf(_SC_OPEN_MAX);
+	    if(f < 0) {
+		where = "sysconf failed";
+		goto abort;
+	    }
+	    while (f--) {
+		if (f == sock)
+		    continue;
+		close(f);
+	    }
+
+	    while (1) {
+		SV *target;
+		union control_un control;
+		struct msghdr msg;
+		struct iovec vec[1];
+		struct cmsghdr *cmptr;
+		ssize_t got;
+		int got_fd;
+
+		msg.msg_control = control.control;
+		msg.msg_controllen = sizeof(control.control);
+		/* We're a connected socket so we don't need a source  */
+		msg.msg_name = NULL;
+		msg.msg_namelen = 0;
+		msg.msg_iov = vec;
+		msg.msg_iovlen = sizeof(vec)/sizeof(vec[0]);
+
+		vec[0].iov_base = (void*)&target;
+		vec[0].iov_len = sizeof(target);
+      
+		got = recvmsg(sock, &msg, 0);
+
+		if(got == 0)
+		    break;
+		if(got < 0) {
+		    where = "recv failed";
+		    goto abort;
+		}
+		if(got < sizeof(target)) {
+		    where = "short recv";
+		    goto abort;
+		}
+
+		if(!(cmptr = CMSG_FIRSTHDR(&msg))) {
+		    where = "no cmsg";
+		    goto abort;
+		}
+		if(cmptr->cmsg_len != CMSG_LEN(sizeof(int))) {
+		    where = "wrong cmsg_len";
+		    goto abort;
+		}
+		if(cmptr->cmsg_level != SOL_SOCKET) {
+		    where = "wrong cmsg_level";
+		    goto abort;
+		}
+		if(cmptr->cmsg_type != SCM_RIGHTS) {
+		    where = "wrong cmsg_type";
+		    goto abort;
+		}
+
+		got_fd = *(int*)CMSG_DATA(cmptr);
+		/* For our last little bit of trickery, put the file descriptor
+		   back into Perl_debug_log, as if we never actually closed it
+		*/
+		if(got_fd != debug_fd) {
+		    if (dup2(got_fd, debug_fd) == -1) {
+			where = "dup2";
+			goto abort;
+		    }
+		}
+		sv_dump(target);
+
+		PerlIO_flush(Perl_debug_log);
+
+		got = write(sock, &success, sizeof(success));
+
+		if(got < 0) {
+		    where = "write failed";
+		    goto abort;
+		}
+		if(got < sizeof(success)) {
+		    where = "short write";
+		    goto abort;
+		}
+	    }
+	    _exit(0);
+	abort:
+	    {
+		int send_errno = errno;
+		unsigned char length = (unsigned char) strlen(where);
+		struct iovec failure[3] = {
+		    {(void*)&send_errno, sizeof(send_errno)},
+		    {&length, 1},
+		    {(void*)where, length}
+		};
+		int got = writev(sock, failure, 3);
+		/* Bad news travels fast. Faster than data. We'll get a SIGPIPE
+		   in the parent if we try to read from the socketpair after the
+		   child has exited, even if there was data to read.
+		   So sleep a bit to give the parent a fighting chance of
+		   reading the data.  */
+		sleep(2);
+		_exit((got == -1) ? errno : 0);
+	    }
+	    /* End of child.  */
+	}
+	PL_dumper_fd = fd[0];
+	close(fd[1]);
+    }
+#endif
+    
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
+    /* Do this now, because destroying ops can cause new SVs to be generated
+       in Perl_pad_swipe, and when running with -DDEBUG_LEAKING_SCALARS they
+       PL_curcop to point to a valid op from which the filename structure
+       member is copied.  */
+    PL_curcop = &PL_compiling;
     if (PL_main_root) {
 	/* ensure comppad/curpad to refer to main's pad */
 	if (CvPADLIST(PL_main_cv)) {
@@ -444,7 +719,6 @@ perl_destruct(pTHXx)
 	op_free(PL_main_root);
 	PL_main_root = Nullop;
     }
-    PL_curcop = &PL_compiling;
     PL_main_start = Nullop;
     SvREFCNT_dec(PL_main_cv);
     PL_main_cv = Nullcv;
@@ -803,23 +1077,23 @@ perl_destruct(pTHXx)
     {
 	/* Yell and reset the HeVAL() slots that are still holding refcounts,
 	 * so that sv_free() won't fail on them.
+	 * Now that the global string table is using a single hunk of memory
+	 * for both HE and HEK, we either need to explicitly unshare it the
+	 * correct way, or actually free things here.
 	 */
-	I32 riter;
-	I32 max;
-	HE *hent;
-	HE **array;
-
-	riter = 0;
-	max = HvMAX(PL_strtab);
-	array = HvARRAY(PL_strtab);
-	hent = array[0];
+	I32 riter = 0;
+	const I32 max = HvMAX(PL_strtab);
+	HE **array = HvARRAY(PL_strtab);
+	HE *hent = array[0];
+
 	for (;;) {
 	    if (hent && ckWARN_d(WARN_INTERNAL)) {
+		HE *next = HeNEXT(hent);
 		Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
 		     "Unbalanced string table refcount: (%d) for \"%s\"",
 		     HeVAL(hent) - Nullsv, HeKEY(hent));
-		HeVAL(hent) = Nullsv;
-		hent = HeNEXT(hent);
+		Safefree(hent);
+		hent = next;
 	    }
 	    if (!hent) {
 		if (++riter > max)
@@ -827,6 +1101,11 @@ perl_destruct(pTHXx)
 		hent = array[riter];
 	    }
 	}
+
+	Safefree(array);
+	HvARRAY(PL_strtab) = 0;
+	HvTOTALKEYS(PL_strtab) = 0;
+	HvFILL(PL_strtab) = 0;
     }
     SvREFCNT_dec(PL_strtab);
 
@@ -834,8 +1113,6 @@ perl_destruct(pTHXx)
     /* free the pointer tables used for cloning */
     ptr_table_free(PL_ptr_table);
     PL_ptr_table = (PTR_TBL_t*)NULL;
-    ptr_table_free(PL_shared_hek_table);
-    PL_shared_hek_table = (PTR_TBL_t*)NULL;
 #endif
 
     /* free special SVs */
@@ -885,10 +1162,31 @@ perl_destruct(pTHXx)
 			    PL_op_name[sv->sv_debug_optype]: "(none)",
 			sv->sv_debug_cloned ? " (cloned)" : ""
 		    );
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+		    Perl_dump_sv_child(aTHX_ sv);
+#endif
 		}
 	    }
 	}
     }
+#ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+    {
+	int status;
+	fd_set rset;
+	/* Wait for up to 4 seconds for child to terminate.
+	   This seems to be the least effort way of timing out on reaping
+	   its exit status.  */
+	struct timeval waitfor = {4, 0};
+	int sock = PL_dumper_fd;
+
+	shutdown(sock, 1);
+	FD_ZERO(&rset);
+	FD_SET(sock, &rset);
+	select(sock + 1, &rset, NULL, NULL, &waitfor);
+	waitpid(child, &status, WNOHANG);
+	close(sock);
+    }
+#endif
 #endif
     PL_sv_count = 0;
 
@@ -910,8 +1208,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);
@@ -924,8 +1221,6 @@ perl_destruct(pTHXx)
     Safefree(PL_psig_pend);
     PL_psig_pend = (int*)NULL;
     PL_formfeed = Nullsv;
-    Safefree(PL_ofmt);
-    PL_ofmt = Nullch;
     nuke_stacks();
     PL_tainting = FALSE;
     PL_taint_warn = FALSE;
@@ -1071,9 +1366,9 @@ S_set_caret_X(pTHX) {
 	S_procself_val(aTHX_ GvSV(tmpgv), PL_origargv[0]);
 #else
 #ifdef OS2
-	sv_setpv(GvSV(tmpgv), os2_execname(aTHX));
+	sv_setpv(GvSVn(tmpgv), os2_execname(aTHX));
 #else
-	sv_setpv(GvSV(tmpgv),PL_origargv[0]);
+	sv_setpv(GvSVn(tmpgv),PL_origargv[0]);
 #endif
 #endif
     }
@@ -1095,6 +1390,8 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     int ret;
     dJMPENV;
 
+    PERL_UNUSED_VAR(my_perl);
+
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
 #undef IAMSUID
@@ -1112,15 +1409,10 @@ setuid perl scripts securely.\n");
     if (!PL_rehash_seed_set)
 	 PL_rehash_seed = get_hash_seed();
     {
-	 char *s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
-
-	 if (s) {
-	      int i = atoi(s);
+	const char * const s = PerlEnv_getenv("PERL_HASH_SEED_DEBUG");
 
-	      if (i == 1)
-		   PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n",
-				 PL_rehash_seed);
-	 }
+	if (s && (atoi(s) == 1))
+	    PerlIO_printf(Perl_debug_log, "HASH_SEED = %"UVuf"\n", PL_rehash_seed);
     }
 #endif /* #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT) */
 
@@ -1137,10 +1429,10 @@ setuid perl scripts securely.\n");
 	 * --jhi */
 	 const char *s = NULL;
 	 int i;
-	 UV mask =
+	 const UV mask =
 	   ~(UV)(PTRSIZE == 4 ? 3 : PTRSIZE == 8 ? 7 : PTRSIZE == 16 ? 15 : 0);
          /* Do the mask check only if the args seem like aligned. */
-	 UV aligned =
+	 const UV aligned =
 	   (mask < ~(UV)0) && ((PTR2UV(argv[0]) & mask) == PTR2UV(argv[0]));
 
 	 /* See if all the arguments are contiguous in memory.  Note
@@ -1284,7 +1576,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     register SV *sv;
     register char *s;
     const char *cddir = Nullch;
+#ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
+#endif
 
     PL_fdscript = -1;
     PL_suidscript = -1;
@@ -1379,7 +1673,9 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    break;
 
 	case 'f':
+#ifdef USE_SITECUSTOMIZE
 	    minus_f = TRUE;
+#endif
 	    s++;
 	    goto reswitch;
 
@@ -1389,9 +1685,8 @@ 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_catpvn(sv, p, len);
@@ -1412,117 +1707,172 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    s++;
 	    goto reswitch;
 	case 'V':
-	    if (!PL_preambleav)
-		PL_preambleav = newAV();
-	    av_push(PL_preambleav, newSVpv("use Config qw(myconfig config_vars)",0));
-	    if (*++s != ':')  {
-                STRLEN opts;
-
-		PL_Sv = newSVpv("print myconfig();",0);
+	    {
+		SV *opts_prog;
+
+		if (!PL_preambleav)
+		    PL_preambleav = newAV();
+		av_push(PL_preambleav,
+			newSVpv("use Config;",0));
+		if (*++s != ':')  {
+		    STRLEN opts;
+		
+		    opts_prog = newSVpv("print Config::myconfig(),",0);
 #ifdef VMS
-		sv_catpv(PL_Sv,"print \"\\nCharacteristics of this PERLSHR image: \\n\",");
+		    sv_catpv(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
 #else
-		sv_catpv(PL_Sv,"print \"\\nCharacteristics of this binary (from libperl): \\n\",");
+		    sv_catpv(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
 #endif
-                opts = SvCUR(PL_Sv);
+		    opts = SvCUR(opts_prog);
 
-		sv_catpv(PL_Sv,"\"  Compile-time options:");
+		    sv_catpv(opts_prog,"\"  Compile-time options:");
 #  ifdef DEBUGGING
-		sv_catpv(PL_Sv," DEBUGGING");
+		    sv_catpv(opts_prog," DEBUGGING");
+#  endif
+#  ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
+		    sv_catpv(opts_prog," DEBUG_LEAKING_SCALARS_FORK_DUMP");
+#  endif
+#  ifdef FAKE_THREADS
+		    sv_catpv(opts_prog," FAKE_THREADS");
 #  endif
 #  ifdef MULTIPLICITY
-		sv_catpv(PL_Sv," MULTIPLICITY");
+		    sv_catpv(opts_prog," MULTIPLICITY");
+#  endif
+#  ifdef MYMALLOC
+		    sv_catpv(opts_prog," MYMALLOC");
+#  endif
+#  ifdef PERL_DONT_CREATE_GVSV
+		    sv_catpv(opts_prog," PERL_DONT_CREATE_GVSV");
+#  endif
+#  ifdef PERL_GLOBAL_STRUCT
+		    sv_catpv(opts_prog," PERL_GLOBAL_STRUCT");
+#  endif
+#  ifdef PERL_IMPLICIT_CONTEXT
+		    sv_catpv(opts_prog," PERL_IMPLICIT_CONTEXT");
+#  endif
+#  ifdef PERL_IMPLICIT_SYS
+		    sv_catpv(opts_prog," PERL_IMPLICIT_SYS");
+#  endif
+#  ifdef PERL_MALLOC_WRAP
+		    sv_catpv(opts_prog," PERL_MALLOC_WRAP");
+#  endif
+#  ifdef PERL_NEED_APPCTX
+		    sv_catpv(opts_prog," PERL_NEED_APPCTX");
+#  endif
+#  ifdef PERL_NEED_TIMESBASE
+		    sv_catpv(opts_prog," PERL_NEED_TIMESBASE");
+#  endif
+#  ifdef PERL_OLD_COPY_ON_WRITE
+		    sv_catpv(opts_prog," PERL_OLD_COPY_ON_WRITE");
+#  endif
+#  ifdef PL_OP_SLAB_ALLOC
+		    sv_catpv(opts_prog," PL_OP_SLAB_ALLOC");
+#  endif
+#  ifdef THREADS_HAVE_PIDS
+		    sv_catpv(opts_prog," THREADS_HAVE_PIDS");
 #  endif
 #  ifdef USE_5005THREADS
-		sv_catpv(PL_Sv," USE_5005THREADS");
+		    sv_catpv(opts_prog," USE_5005THREADS");
 #  endif
-#  ifdef USE_ITHREADS
-		sv_catpv(PL_Sv," USE_ITHREADS");
+#  ifdef USE_64_BIT_ALL
+		    sv_catpv(opts_prog," USE_64_BIT_ALL");
 #  endif
 #  ifdef USE_64_BIT_INT
-		sv_catpv(PL_Sv," USE_64_BIT_INT");
+		    sv_catpv(opts_prog," USE_64_BIT_INT");
 #  endif
-#  ifdef USE_64_BIT_ALL
-		sv_catpv(PL_Sv," USE_64_BIT_ALL");
+#  ifdef USE_ITHREADS
+		    sv_catpv(opts_prog," USE_ITHREADS");
+#  endif
+#  ifdef USE_LARGE_FILES
+		    sv_catpv(opts_prog," USE_LARGE_FILES");
 #  endif
 #  ifdef USE_LONG_DOUBLE
-		sv_catpv(PL_Sv," USE_LONG_DOUBLE");
+		    sv_catpv(opts_prog," USE_LONG_DOUBLE");
 #  endif
-#  ifdef USE_LARGE_FILES
-		sv_catpv(PL_Sv," USE_LARGE_FILES");
+#  ifdef USE_PERLIO
+		    sv_catpv(opts_prog," USE_PERLIO");
 #  endif
-#  ifdef USE_SOCKS
-		sv_catpv(PL_Sv," USE_SOCKS");
+#  ifdef USE_REENTRANT_API
+		    sv_catpv(opts_prog," USE_REENTRANT_API");
+#  endif
+#  ifdef USE_SFIO
+		    sv_catpv(opts_prog," USE_SFIO");
 #  endif
 #  ifdef USE_SITECUSTOMIZE
-		sv_catpv(PL_Sv," USE_SITECUSTOMIZE");
+		    sv_catpv(opts_prog," USE_SITECUSTOMIZE");
 #  endif	       
-#  ifdef PERL_IMPLICIT_CONTEXT
-		sv_catpv(PL_Sv," PERL_IMPLICIT_CONTEXT");
-#  endif
-#  ifdef PERL_IMPLICIT_SYS
-		sv_catpv(PL_Sv," PERL_IMPLICIT_SYS");
+#  ifdef USE_SOCKS
+		    sv_catpv(opts_prog," USE_SOCKS");
 #  endif
 
-                while (SvCUR(PL_Sv) > opts+76) {
-                    /* find last space after "options: " and before col 76 */
+		    while (SvCUR(opts_prog) > opts+76) {
+			/* find last space after "options: " and before col 76
+			 */
 
-                    const char *space;
-                    char *pv = SvPV_nolen(PL_Sv);
-                    const char c = pv[opts+76];
-                    pv[opts+76] = '\0';
-                    space = strrchr(pv+opts+26, ' ');
-                    pv[opts+76] = c;
-                    if (!space) break; /* "Can't happen" */
+			const char *space;
+			char *pv = SvPV_nolen(opts_prog);
+			const char c = pv[opts+76];
+			pv[opts+76] = '\0';
+			space = strrchr(pv+opts+26, ' ');
+			pv[opts+76] = c;
+			if (!space) break; /* "Can't happen" */
 
-                    /* break the line before that space */
+			/* break the line before that space */
 
-                    opts = space - pv;
-                    sv_insert(PL_Sv, opts, 0,
-                              "\\n                       ", 25);
-                }
+			opts = space - pv;
+			sv_insert(opts_prog, opts, 0,
+				  "\\n                       ", 25);
+		    }
 
-		sv_catpv(PL_Sv,"\\n\",");
+		    sv_catpv(opts_prog,"\\n\",");
 
 #if defined(LOCAL_PATCH_COUNT)
-		if (LOCAL_PATCH_COUNT > 0) {
-		    int i;
-		    sv_catpv(PL_Sv,"\"  Locally applied patches:\\n\",");
-		    for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
-			if (PL_localpatches[i])
-			    Perl_sv_catpvf(aTHX_ PL_Sv,"q%c\t%s\n%c,",
-				    0, PL_localpatches[i], 0);
+		    if (LOCAL_PATCH_COUNT > 0) {
+			int i;
+			sv_catpv(opts_prog,
+				 "\"  Locally applied patches:\\n\",");
+			for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
+			    if (PL_localpatches[i])
+				Perl_sv_catpvf(aTHX_ opts_prog,"q%c\t%s\n%c,",
+					       0, PL_localpatches[i], 0);
+			}
 		    }
-		}
 #endif
-		Perl_sv_catpvf(aTHX_ PL_Sv,"\"  Built under %s\\n\"",OSNAME);
+		    Perl_sv_catpvf(aTHX_ opts_prog,
+				   "\"  Built under %s\\n\"",OSNAME);
 #ifdef __DATE__
 #  ifdef __TIME__
-		Perl_sv_catpvf(aTHX_ PL_Sv,",\"  Compiled at %s %s\\n\"",__DATE__,__TIME__);
+		    Perl_sv_catpvf(aTHX_ opts_prog,
+				   ",\"  Compiled at %s %s\\n\"",__DATE__,
+				   __TIME__);
 #  else
-		Perl_sv_catpvf(aTHX_ PL_Sv,",\"  Compiled on %s\\n\"",__DATE__);
+		    Perl_sv_catpvf(aTHX_ opts_prog,",\"  Compiled on %s\\n\"",
+				   __DATE__);
 #  endif
 #endif
-		sv_catpv(PL_Sv, "; \
-$\"=\"\\n    \"; \
-@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; ");
+		    sv_catpv(opts_prog, "; $\"=\"\\n    \"; "
+			     "@env = map { \"$_=\\\"$ENV{$_}\\\"\" } "
+			     "sort grep {/^PERL/} keys %ENV; ");
 #ifdef __CYGWIN__
-		sv_catpv(PL_Sv,"\
-push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
+		    sv_catpv(opts_prog,
+			     "push @env, \"CYGWIN=\\\"$ENV{CYGWIN}\\\"\";");
 #endif
-		sv_catpv(PL_Sv, "\
-print \"  \\%ENV:\\n    @env\\n\" if @env; \
-print \"  \\@INC:\\n    @INC\\n\";");
-	    }
-	    else {
-		PL_Sv = newSVpv("config_vars(qw(",0);
-		sv_catpv(PL_Sv, ++s);
-		sv_catpv(PL_Sv, "))");
-		s += strlen(s);
+		    sv_catpv(opts_prog, 
+			     "print \"  \\%ENV:\\n    @env\\n\" if @env;"
+			     "print \"  \\@INC:\\n    @INC\\n\";");
+		}
+		else {
+		    ++s;
+		    opts_prog = Perl_newSVpvf(aTHX_
+					      "Config::config_vars(qw%c%s%c)",
+					      0, s, 0);
+		    s += strlen(s);
+		}
+		av_push(PL_preambleav, opts_prog);
+		/* don't look for script or read stdin */
+		scriptname = BIT_BUCKET;
+		goto reswitch;
 	    }
-	    av_push(PL_preambleav, PL_Sv);
-	    scriptname = BIT_BUCKET;	/* don't look for script or read stdin */
-	    goto reswitch;
 	case 'x':
 	    PL_doextract = TRUE;
 	    s++;
@@ -1651,7 +2001,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 #  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");
@@ -1679,7 +2029,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     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 */
 
@@ -1834,6 +2184,8 @@ perl_run(pTHXx)
     int ret = 0;
     dJMPENV;
 
+    PERL_UNUSED_ARG(my_perl);
+
     oldscope = PL_scopestack_ix;
 #ifdef VMS
     VMSISH_HUSHED = 0;
@@ -1886,8 +2238,10 @@ S_run_body(pTHX_ I32 oldscope)
 
     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)));
 
@@ -1990,7 +2344,7 @@ 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)
@@ -2233,6 +2587,9 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    POPEVAL(cx);
 	    PL_curpm = newpm;
 	    LEAVE;
+	    PERL_UNUSED_VAR(newsp);
+	    PERL_UNUSED_VAR(gimme);
+	    PERL_UNUSED_VAR(optype);
 	}
 	JMPENV_POP;
     }
@@ -2404,11 +2761,8 @@ Perl_require_pv(pTHX_ const char *pv)
     dSP;
     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;
 }
@@ -2429,37 +2783,35 @@ S_usage(pTHX_ const char *name)		/* XXX move this out into a module ? */
      * Removed -h because the user already knows that option. Others? */
 
     static const char * const usage_msg[] = {
-"-0[octal]       specify record separator (\\0, if no argument)",
-"-A[name]        activate all/given assertions",
-"-a              autosplit mode with -n or -p (splits $_ into @F)",
-"-C[number/list] enables the listed Unicode features",
-"-c              check syntax only (runs BEGIN and CHECK blocks)",
-"-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)",
-#ifdef USE_SITECUSTOMIZE
-"-f              don't do $sitelib/sitecustomize.pl at startup",
-#endif
-"-F/pattern/     split() pattern for -a switch (//'s are optional)",
-"-i[extension]   edit <> files in place (makes backup if extension supplied)",
-"-Idirectory     specify @INC/#include directory (several -I's allowed)",
-"-l[octal]       enable line ending processing, specifies line terminator",
-"-[mM][-]module  execute \"use/no module...\" before executing program",
-"-n              assume \"while (<>) { ... }\" loop around program",
-"-p              assume loop like -n but print line also, like sed",
-"-P              run program through C preprocessor before compilation",
-"-s              enable rudimentary parsing for switches after programfile",
-"-S              look for programfile using PATH environment variable",
-"-t              enable tainting warnings",
-"-T              enable tainting checks",
-"-u              dump core after parsing program",
-"-U              allow unsafe operations",
-"-v              print version, subversion (includes VERY IMPORTANT perl info)",
-"-V[:variable]   print configuration summary (or a single Config.pm variable)",
-"-w              enable many useful warnings (RECOMMENDED)",
-"-W              enable all warnings",
-"-x[directory]   strip off text before #!perl line and perhaps cd to directory",
-"-X              disable all warnings",
+"-0[octal]         specify record separator (\\0, if no argument)",
+"-A[mod][=pattern] activate all/given assertions",
+"-a                autosplit mode with -n or -p (splits $_ into @F)",
+"-C[number/list]   enables the listed Unicode features",
+"-c                check syntax only (runs BEGIN and CHECK blocks)",
+"-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)",
+"-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)",
+"-Idirectory       specify @INC/#include directory (several -I's allowed)",
+"-l[octal]         enable line ending processing, specifies line terminator",
+"-[mM][-]module    execute \"use/no module...\" before executing program",
+"-n                assume \"while (<>) { ... }\" loop around program",
+"-p                assume loop like -n but print line also, like sed",
+"-P                run program through C preprocessor before compilation",
+"-s                enable rudimentary parsing for switches after programfile",
+"-S                look for programfile using PATH environment variable",
+"-t                enable tainting warnings",
+"-T                enable tainting checks",
+"-u                dump core after parsing program",
+"-U                allow unsafe operations",
+"-v                print version, subversion (includes VERY IMPORTANT perl info)",
+"-V[:variable]     print configuration summary (or a single Config.pm variable)",
+"-w                enable many useful warnings (RECOMMENDED)",
+"-W                enable all warnings",
+"-x[directory]     strip off text before #!perl line and perhaps cd to directory",
+"-X                disable all warnings",
 "\n",
 NULL
 };
@@ -2630,12 +2982,10 @@ Perl_moreswitches(pTHX_ char *s)
 		sv_catpv(sv, start);
 	    else {
 		sv_catpvn(sv, start, s-start);
-		sv_catpv(sv, " split(/,/,q{");
-		sv_catpv(sv, ++s);
-		sv_catpv(sv, "})");
+		Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
 	    }
 	    s += strlen(s);
-	    my_setenv("PERL5DB", SvPV(sv, PL_na));
+	    my_setenv("PERL5DB", SvPV_nolen_const(sv));
 	}
 	if (!PL_perldb) {
 	    PL_perldb = PERLDB_ALL;
@@ -2654,15 +3004,13 @@ Perl_moreswitches(pTHX_ char *s)
 	           "Recompile perl with -DDEBUGGING to use -D switch (did you mean -d ?)\n");
 	for (s++; isALNUM(*s); s++) ;
 #endif
-	/*SUPPRESS 530*/
 	return s;
     }	
     case 'h':
 	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");
@@ -2670,8 +3018,8 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 #endif /* __CYGWIN__ */
 	PL_inplace = savepv(s+1);
-	/*SUPPRESS 530*/
-	for (s = PL_inplace; *s && !isSPACE(*s); s++) ;
+	for (s = PL_inplace; *s && !isSPACE(*s); s++)
+	    ;
 	if (*s) {
 	    *s++ = '\0';
 	    if (*s == '-')	/* Additional switches on #! line. */
@@ -2731,17 +3079,25 @@ Perl_moreswitches(pTHX_ char *s)
 	forbid_setid("-A");
 	if (!PL_preambleav)
 	    PL_preambleav = newAV();
-	if (*++s) {
-	    SV *sv = newSVpv("use assertions::activate split(/,/,q", 0);
-	    sv_catpvn(sv, "\0", 1);     /* Use NUL as q//-delimiter. */
-	    sv_catpv(sv,s);
-	    sv_catpvn(sv, "\0)", 2);
-	    s+=strlen(s);
+	s++;
+	{
+	    char *start = s;
+	    SV *sv = newSVpv("use assertions::activate", 24);
+	    while(isALNUM(*s) || *s == ':') ++s;
+	    if (s != start) {
+		sv_catpvn(sv, "::", 2);
+		sv_catpvn(sv, start, s-start);
+	    }
+	    if (*s == '=') {
+		Perl_sv_catpvf(aTHX_ sv, " split(/,/,q%c%s%c)", 0, ++s, 0);
+		s+=strlen(s);
+	    }
+	    else if (*s != '\0') {
+		Perl_croak(aTHX_ "Can't use '%c' after -A%.*s", *s, s-start, start);
+	    }
 	    av_push(PL_preambleav, sv);
+	    return s;
 	}
-	else
-	    av_push(PL_preambleav, newSVpvn("use assertions::activate",24));
-	return s;
     case 'M':
 	forbid_setid("-M");	/* XXX ? */
 	/* FALL THROUGH */
@@ -2752,8 +3108,10 @@ Perl_moreswitches(pTHX_ char *s)
 	    SV *sv;
 	    const char *use = "use ";
 	    /* -M-foo == 'no foo'	*/
-	    if (*s == '-') { use = "no "; ++s; }
-	    sv = newSVpv(use,0);
+	    /* Leading space on " no " is deliberate, to make both
+	       possibilities the same length.  */
+	    if (*s == '-') { use = " no "; ++s; }
+	    sv = newSVpvn(use,4);
 	    start = s;
 	    /* We allow -M'Module qw(Foo Bar)'	*/
 	    while(isALNUM(*s) || *s==':') ++s;
@@ -2821,13 +3179,13 @@ Perl_moreswitches(pTHX_ char *s)
 		(void *)upg_version(PL_patchlevel);
 #if !defined(DGUX)
 	PerlIO_printf(PerlIO_stdout(),
-		Perl_form(aTHX_ "\nThis is perl, v%"SVf" built for %s",
+		Perl_form(aTHX_ "\nThis is perl, %"SVf" built for %s",
 		    vstringify(PL_patchlevel),
 		    ARCHNAME));
 #else /* DGUX */
 /* Adjust verbose output as in the perl that ships with the DG/UX OS from EMC */
 	PerlIO_printf(PerlIO_stdout(),
-		Perl_form(aTHX_ "\nThis is perl, v%"SVf"\n",
+		Perl_form(aTHX_ "\nThis is perl, %"SVf"\n",
 		    vstringify(PL_patchlevel)));
 	PerlIO_printf(PerlIO_stdout(),
 			Perl_form(aTHX_ "        built under %s at %s %s\n",
@@ -3057,7 +3415,7 @@ S_init_main_stash(pTHX)
     SvREFCNT_dec(GvHV(gv));
     GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash);
     SvREADONLY_on(gv);
-    Perl_hv_name_set(aTHX_ PL_defstash, "main", 4, 0);
+    hv_name_set(PL_defstash, "main", 4, 0);
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpv("\010",TRUE, SVt_PV); /* ^H */
@@ -3068,6 +3426,9 @@ S_init_main_stash(pTHX)
     PL_replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */
     GvMULTI_on(PL_replgv);
     (void)Perl_form(aTHX_ "%240s","");	/* Preallocate temp - for immediate signals. */
+#ifdef PERL_DONT_CREATE_GVSV
+    gv_SVadd(PL_errgv);
+#endif
     sv_grow(ERRSV, 240);	/* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
     PL_curstash = PL_defstash;
@@ -3180,7 +3541,8 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
 	DEBUG_P(PerlIO_printf(Perl_debug_log,
 			      "PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
-			      scriptname, SvPVX (cpp), SvPVX (sv), CPPMINUS));
+			      scriptname, SvPVX_const (cpp), SvPVX_const (sv),
+			      CPPMINUS));
 
 #       if defined(MSDOS) || defined(WIN32) || defined(VMS)
             quote = "\"";
@@ -3221,9 +3583,9 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv)
 
         DEBUG_P(PerlIO_printf(Perl_debug_log,
                               "PL_preprocess: cmd=\"%s\"\n",
-                              SvPVX(cmd)));
+                              SvPVX_const(cmd)));
 
-	PL_rsfp = PerlProc_popen(SvPVX(cmd), (char *)"r");
+	PL_rsfp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
 	SvREFCNT_dec(cmd);
 	SvREFCNT_dec(cpp);
     }
@@ -3418,13 +3780,13 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
      */
 
 #ifdef DOSUID
-    char *s, *s2;
+    const char *s, *s2;
 
     if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
 	Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
     if (PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	I32 len;
-	STRLEN n_a;
+	const char *linestr;
 
 #ifdef IAMSUID
 	if (PL_fdscript < 0 || PL_suidscript != 1)
@@ -3522,10 +3884,12 @@ 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);
+	linestr = SvPV_nolen_const(PL_linestr);
 	if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
-	  strnNE(SvPV(PL_linestr,n_a),"#!",2) )	/* required even on Sys V */
+	  strnNE(linestr,"#!",2) )	/* required even on Sys V */
 	    Perl_croak(aTHX_ "No #! line");
-	s = SvPV(PL_linestr,n_a)+2;
+	linestr+=2;
+	s = linestr;
 	/* PSz 27 Feb 04 */
 	/* Sanity check on line length */
 	if (strlen(s) < 1 || strlen(s) > 4000)
@@ -3534,12 +3898,12 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname)
 	while (isSPACE(*s)) s++;
 	/* Sanity check on buffer end */
 	while ((*s) && !isSPACE(*s)) s++;
-	for (s2 = s;  (s2 > SvPV(PL_linestr,n_a)+2 &&
+	for (s2 = s;  (s2 > linestr &&
 		       (isDIGIT(s2[-1]) || s2[-1] == '.' || s2[-1] == '_'
 			|| s2[-1] == '-'));  s2--) ;
 	/* Sanity check on buffer start */
-	if ( (s2-4 < SvPV(PL_linestr,n_a)+2 || strnNE(s2-4,"perl",4)) &&
-	      (s-9 < SvPV(PL_linestr,n_a)+2 || strnNE(s-9,"perl",4)) )
+	if ( (s2-4 < linestr || strnNE(s2-4,"perl",4)) &&
+	      (s-9 < linestr || strnNE(s-9,"perl",4)) )
 	    Perl_croak(aTHX_ "Not a perl script");
 	while (*s == ' ' || *s == '\t') s++;
 	/*
@@ -3829,7 +4193,6 @@ S_find_beginning(pTHX)
 		while (isDIGIT(s2[-1]) || s2[-1] == '-' || s2[-1] == '.'
 		       || s2[-1] == '_') s2--;
 		if (strnEQ(s2-4,"perl",4))
-		    /*SUPPRESS 530*/
 		    while ((s = moreswitches(s)))
 			;
 	    }
@@ -3995,22 +4358,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);
 }
@@ -4083,18 +4446,17 @@ S_init_predump_symbols(pTHX)
 
     PL_statname = NEWSV(66,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;
     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]) {
@@ -4114,7 +4476,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)
@@ -4359,7 +4721,7 @@ STATIC SV *
 S_incpush_if_exists(pTHX_ SV *dir)
 {
     Stat_t tmpstatbuf;
-    if (PerlLIO_stat(SvPVX(dir), &tmpstatbuf) >= 0 &&
+    if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
 	S_ISDIR(tmpstatbuf.st_mode)) {
 	av_push(GvAVn(PL_incgv), dir);
 	dir = NEWSV(0,0);
@@ -4434,11 +4796,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;
@@ -4594,7 +4956,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();
@@ -4604,8 +4966,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 */
@@ -4832,17 +5194,19 @@ S_my_exit_jump(pTHX)
     }
 
     JMPENV_JUMP(2);
+    PERL_UNUSED_VAR(gimme);
+    PERL_UNUSED_VAR(newsp);
 }
 
 static I32
 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
-    char *p, *nl;
-    (void)idx;
-    (void)maxlen;
+    const char * const p  = SvPVX_const(PL_e_script);
+    const char *nl = strchr(p, '\n');
+
+    PERL_UNUSED_ARG(idx);
+    PERL_UNUSED_ARG(maxlen);
 
-    p  = SvPVX(PL_e_script);
-    nl = strchr(p, '\n');
     nl = (nl) ? nl+1 : SvEND(PL_e_script);
     if (nl-p == 0) {
 	filter_del(read_e_script);