X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=24904f59cdece93f1fb0cd7846f983567587cf4f;hb=ea726b52599b52cf534201a46ec3455418c9eb8e;hp=f04f4cc99adc08a951ce0915af2b398a80cb12ec;hpb=5e661f6a5e9caa656f01592947f38c9e56ec3d8a;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index f04f4cc..24904f5 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, 2006, 2007 by Larry Wall and others
+ *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -125,16 +125,22 @@ char *getenv (char *); /* Usually in <stdlib.h> */
 
 static I32 read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen);
 
-#ifdef IAMSUID
-#ifndef DOSUID
-#define DOSUID
-#endif
-#endif /* IAMSUID */
-
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef DOSUID
-#undef DOSUID
-#endif
+#  ifdef IAMSUID
+/* Drop scriptname */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ validarg, fdscript, suidscript, linestr_sv, rsfp)
+#  else
+/* Drop suidscript */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ validarg, scriptname, fdscript, linestr_sv, rsfp)
+#  endif
+#else
+#  ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+/* Drop everything. Heck, don't even try to call it */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) NOOP
+#  else
+/* Drop almost everything */
+#    define validate_suid(validarg, scriptname, fdscript, suidscript, linestr_sv, rsfp) S_validate_suid(aTHX_ rsfp)
+#  endif
 #endif
 
 #define CALL_BODY_EVAL(myop) \
@@ -181,6 +187,44 @@ S_init_tls_and_interp(PerlInterpreter *my_perl)
     }
 }
 
+
+/* these implement the PERL_SYS_INIT, PERL_SYS_INIT3, PERL_SYS_TERM macros */
+
+void
+Perl_sys_init(int* argc, char*** argv)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_SYS_INIT;
+
+    PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
+    PERL_UNUSED_ARG(argv);
+    PERL_SYS_INIT_BODY(argc, argv);
+}
+
+void
+Perl_sys_init3(int* argc, char*** argv, char*** env)
+{
+    dVAR;
+
+    PERL_ARGS_ASSERT_SYS_INIT3;
+
+    PERL_UNUSED_ARG(argc); /* may not be used depending on _BODY macro */
+    PERL_UNUSED_ARG(argv);
+    PERL_UNUSED_ARG(env);
+    PERL_SYS_INIT3_BODY(argc, argv, env);
+}
+
+void
+Perl_sys_term()
+{
+    dVAR;
+    if (!PL_veto_cleanup) {
+	PERL_SYS_TERM_BODY();
+    }
+}
+
+
 #ifdef PERL_IMPLICIT_SYS
 PerlInterpreter *
 perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
@@ -190,6 +234,9 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
 		 struct IPerlProc* ipP)
 {
     PerlInterpreter *my_perl;
+
+    PERL_ARGS_ASSERT_PERL_ALLOC_USING;
+
     /* Newx() needs interpreter, so call malloc() instead */
     my_perl = (PerlInterpreter*)(*ipM->pMalloc)(ipM, sizeof(PerlInterpreter));
     S_init_tls_and_interp(my_perl);
@@ -250,58 +297,56 @@ void
 perl_construct(pTHXx)
 {
     dVAR;
-    PERL_UNUSED_ARG(my_perl);
+
+    PERL_ARGS_ASSERT_PERL_CONSTRUCT;
+
 #ifdef MULTIPLICITY
     init_interp();
     PL_perl_destruct_level = 1;
 #else
+    PERL_UNUSED_ARG(my_perl);
    if (PL_perl_destruct_level > 0)
        init_interp();
 #endif
-   /* Init the real globals (and main thread)? */
-    if (!PL_linestr) {
-	PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
+    PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
-	PL_linestr = newSV_type(SVt_PVIV);
-	SvGROW(PL_linestr, 80);
+    /* set read-only and try to insure than we wont see REFCNT==0
+       very often */
 
-	if (!SvREADONLY(&PL_sv_undef)) {
-	    /* set read-only and try to insure than we wont see REFCNT==0
-	       very often */
+    SvREADONLY_on(&PL_sv_undef);
+    SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
 
-	    SvREADONLY_on(&PL_sv_undef);
-	    SvREFCNT(&PL_sv_undef) = (~(U32)0)/2;
+    sv_setpv(&PL_sv_no,PL_No);
+    /* value lookup in void context - happens to have the side effect
+       of caching the numeric forms. However, as &PL_sv_no doesn't contain
+       a string that is a valid numer, we have to turn the public flags by
+       hand:  */
+    SvNV(&PL_sv_no);
+    SvIV(&PL_sv_no);
+    SvIOK_on(&PL_sv_no);
+    SvNOK_on(&PL_sv_no);
+    SvREADONLY_on(&PL_sv_no);
+    SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
 
-	    sv_setpv(&PL_sv_no,PL_No);
-	    /* value lookup in void context - happens to have the side effect
-	       of caching the numeric forms.  */
-	    SvIV(&PL_sv_no);
-	    SvNV(&PL_sv_no);
-	    SvREADONLY_on(&PL_sv_no);
-	    SvREFCNT(&PL_sv_no) = (~(U32)0)/2;
+    sv_setpv(&PL_sv_yes,PL_Yes);
+    SvNV(&PL_sv_yes);
+    SvIV(&PL_sv_yes);
+    SvREADONLY_on(&PL_sv_yes);
+    SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
 
-	    sv_setpv(&PL_sv_yes,PL_Yes);
-	    SvIV(&PL_sv_yes);
-	    SvNV(&PL_sv_yes);
-	    SvREADONLY_on(&PL_sv_yes);
-	    SvREFCNT(&PL_sv_yes) = (~(U32)0)/2;
+    SvREADONLY_on(&PL_sv_placeholder);
+    SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
 
-	    SvREADONLY_on(&PL_sv_placeholder);
-	    SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2;
-	}
-
-	PL_sighandlerp = (Sighandler_t) Perl_sighandler;
+    PL_sighandlerp = (Sighandler_t) Perl_sighandler;
 #ifdef PERL_USES_PL_PIDSTATUS
-	PL_pidstatus = newHV();
+    PL_pidstatus = newHV();
 #endif
-    }
 
     PL_rs = newSVpvs("\n");
 
     init_stacks();
 
     init_ids();
-    PL_lex_state = LEX_NOTPARSING;
 
     JMPENV_BOOTSTRAP;
     STATUS_ALL_SUCCESS;
@@ -326,8 +371,9 @@ perl_construct(pTHXx)
     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);	/* ext/re needs these */
     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);	/* even without DEBUGGING. */
 #ifdef USE_ITHREADS
-    /* First entry is an array of empty elements */
-    Perl_av_create_and_push(aTHX_ &PL_regex_padav,(SV*)newAV());
+    /* First entry is a list of empty elements. It needs to be initialised
+       else all hell breaks loose in S_find_uninit_var().  */
+    Perl_av_create_and_push(aTHX_ &PL_regex_padav, newSVpvs(""));
     PL_regex_pad = AvARRAY(PL_regex_padav);
 #endif
 #ifdef USE_REENTRANT_API
@@ -366,7 +412,7 @@ perl_construct(pTHXx)
 
     PL_stashcache = newHV();
 
-    PL_patchlevel = Perl_newSVpvf(aTHX_ "%d.%d.%d", (int)PERL_REVISION,
+    PL_patchlevel = Perl_newSVpvf(aTHX_ "v%d.%d.%d", (int)PERL_REVISION,
 				  (int)PERL_VERSION, (int)PERL_SUBVERSION);
 
 #ifdef HAS_MMAP
@@ -444,6 +490,8 @@ Perl_dump_sv_child(pTHX_ SV *sv)
     int returned_errno;
     unsigned char buffer[256];
 
+    PERL_ARGS_ASSERT_DUMP_SV_CHILD;
+
     if(sock == -1 || debug_fd == -1)
 	return;
 
@@ -540,13 +588,16 @@ int
 perl_destruct(pTHXx)
 {
     dVAR;
-    VOL int destruct_level;  /* 0=none, 1=full, 2=full with checks */
+    VOL signed char destruct_level;  /* see possible values in intrpvar.h */
     HV *hv;
 #ifdef DEBUG_LEAKING_SCALARS_FORK_DUMP
     pid_t child;
 #endif
 
+    PERL_ARGS_ASSERT_PERL_DESTRUCT;
+#ifndef MULTIPLICITY
     PERL_UNUSED_ARG(my_perl);
+#endif
 
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
@@ -611,7 +662,7 @@ perl_destruct(pTHXx)
 	    int f;
 	    const char *where;
 	    /* Our success message is an integer 0, and a char 0  */
-	    static const char success[sizeof(int) + 1];
+	    static const char success[sizeof(int) + 1] = {0};
 
 	    close(fd[0]);
 
@@ -845,28 +896,6 @@ perl_destruct(pTHXx)
      * REGEXPs in the parent interpreter
      * we need to manually ReREFCNT_dec for the clones
      */
-    {
-        I32 i = AvFILLp(PL_regex_padav) + 1;
-        SV * const * const ary = AvARRAY(PL_regex_padav);
-
-        while (i) {
-            SV * const resv = ary[--i];
-
-            if (SvFLAGS(resv) & SVf_BREAK) {
-                /* this is PL_reg_curpm, already freed
-                 * flag is set in regexec.c:S_regtry
-                 */
-                SvFLAGS(resv) &= ~SVf_BREAK;
-            }
-	    else if(SvREPADTMP(resv)) {
-	      SvREPADTMP_off(resv);
-	    }
-            else if(SvIOKp(resv)) {
-		REGEXP *re = INT2PTR(REGEXP *,SvIVX(resv));
-                ReREFCNT_dec(re);
-            }
-        }
-    }
     SvREFCNT_dec(PL_regex_padav);
     PL_regex_padav = NULL;
     PL_regex_pad = NULL;
@@ -877,22 +906,18 @@ perl_destruct(pTHXx)
 
     /* loosen bonds of global variables */
 
-    if(PL_rsfp) {
-	(void)PerlIO_close(PL_rsfp);
-	PL_rsfp = NULL;
+    /* XXX can PL_parser still be non-null here? */
+    if(PL_parser && PL_parser->rsfp) {
+	(void)PerlIO_close(PL_parser->rsfp);
+	PL_parser->rsfp = NULL;
     }
 
-    /* Filters for program text */
-    SvREFCNT_dec(PL_rsfp_filters);
-    PL_rsfp_filters = NULL;
-
     if (PL_minus_F) {
 	Safefree(PL_splitstr);
 	PL_splitstr = NULL;
     }
 
     /* switches */
-    PL_preprocess   = FALSE;
     PL_minus_n      = FALSE;
     PL_minus_p      = FALSE;
     PL_minus_l      = FALSE;
@@ -983,7 +1008,6 @@ perl_destruct(pTHXx)
     PL_DBsingle = NULL;
     PL_DBtrace = NULL;
     PL_DBsignal = NULL;
-    PL_DBassertion = NULL;
     PL_DBcv = NULL;
     PL_dbargs = NULL;
     PL_debstash = NULL;
@@ -997,8 +1021,6 @@ perl_destruct(pTHXx)
     PL_preambleav = NULL;
     SvREFCNT_dec(PL_subname);
     PL_subname = NULL;
-    SvREFCNT_dec(PL_linestr);
-    PL_linestr = NULL;
 #ifdef PERL_USES_PL_PIDSTATUS
     SvREFCNT_dec(PL_pidstatus);
     PL_pidstatus = NULL;
@@ -1084,6 +1106,8 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_errors);
     PL_errors = NULL;
 
+    SvREFCNT_dec(PL_isarev);
+
     FREETMPS;
     if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
 	if (PL_scopestack_ix != 0)
@@ -1103,18 +1127,11 @@ perl_destruct(pTHXx)
     }
 
     /* Now absolutely destruct everything, somehow or other, loops or no. */
-    SvFLAGS(PL_fdpid) |= SVTYPEMASK;		/* don't clean out pid table now */
-    SvFLAGS(PL_strtab) |= SVTYPEMASK;		/* don't clean out strtab now */
 
     /* the 2 is for PL_fdpid and PL_strtab */
-    while (PL_sv_count > 2 && sv_clean_all())
+    while (sv_clean_all() > 2)
 	;
 
-    SvFLAGS(PL_fdpid) &= ~SVTYPEMASK;
-    SvFLAGS(PL_fdpid) |= SVt_PVAV;
-    SvFLAGS(PL_strtab) &= ~SVTYPEMASK;
-    SvFLAGS(PL_strtab) |= SVt_PVHV;
-
     AvREAL_off(PL_fdpid);		/* no surviving entries */
     SvREFCNT_dec(PL_fdpid);		/* needed in io_close() */
     PL_fdpid = NULL;
@@ -1204,7 +1221,8 @@ perl_destruct(pTHXx)
 			" flags=0x%"UVxf
 			" refcnt=%"UVuf pTHX__FORMAT "\n"
 			"\tallocated at %s:%d %s %s%s\n",
-			(void*)sv, sv->sv_flags, sv->sv_refcnt pTHX__VALUE,
+			(void*)sv, (UV)sv->sv_flags, (UV)sv->sv_refcnt
+			pTHX__VALUE,
 			sv->sv_debug_file ? sv->sv_debug_file : "(unknown)",
 			sv->sv_debug_line,
 			sv->sv_debug_inpad ? "for" : "by",
@@ -1238,6 +1256,10 @@ perl_destruct(pTHXx)
     }
 #endif
 #endif
+#ifdef DEBUG_LEAKING_SCALARS_ABORT
+    if (PL_sv_count)
+	abort();
+#endif
     PL_sv_count = 0;
 
 #ifdef PERL_DEBUG_READONLY_OPS
@@ -1334,6 +1356,8 @@ perl_free(pTHXx)
 {
     dVAR;
 
+    PERL_ARGS_ASSERT_PERL_FREE;
+
     if (PL_veto_cleanup)
 	return;
 
@@ -1345,10 +1369,17 @@ perl_free(pTHXx)
 	 */
 	const char * const s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL");
 	if (!s || atoi(s) == 0) {
+	    const U32 old_debug = PL_debug;
 	    /* Emulate the PerlHost behaviour of free()ing all memory allocated in this
 	       thread at thread exit.  */
+	    if (DEBUG_m_TEST) {
+		PerlIO_puts(Perl_debug_log, "Disabling memory debugging as we "
+			    "free this thread's memory\n");
+		PL_debug &= ~ DEBUG_m_FLAG;
+	    }
 	    while(aTHXx->Imemory_debug_header.next != &(aTHXx->Imemory_debug_header))
 		safesysfree(sTHX + (char *)(aTHXx->Imemory_debug_header.next));
+	    PL_debug = old_debug;
 	}
     }
 #endif
@@ -1478,14 +1509,14 @@ perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
     int ret;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_PERL_PARSE;
+#ifndef MULTIPLICITY
     PERL_UNUSED_ARG(my_perl);
+#endif
 
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-#ifdef IAMSUID
-#undef IAMSUID
-    Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now execute\n\
-setuid perl scripts securely.\n");
-#endif /* IAMSUID */
+#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW_AND_IAMSUID
+    Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now "
+	       "execute\nsetuid perl scripts securely.\n");
 #endif
 
 #if defined(USE_HASH_SEED) || defined(USE_HASH_SEED_EXPLICIT)
@@ -1663,23 +1694,32 @@ STATIC void *
 S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 {
     dVAR;
+    PerlIO *rsfp;
     int argc = PL_origargc;
     char **argv = PL_origargv;
     const char *scriptname = NULL;
     VOL bool dosearch = FALSE;
+#ifdef DOSUID
     const char *validarg = "";
+#endif
     register SV *sv;
-    register char *s, c;
+    register char c;
     const char *cddir = NULL;
 #ifdef USE_SITECUSTOMIZE
     bool minus_f = FALSE;
 #endif
+    SV *linestr_sv = newSV_type(SVt_PVIV);
+    bool add_read_e_script = FALSE;
+
+    SvGROW(linestr_sv, 80);
+    sv_setpvn(linestr_sv,"",0);
 
-    sv_setpvn(PL_linestr,"",0);
     sv = newSVpvs("");		/* first used for -I flags */
     SAVEFREESV(sv);
     init_main_stash();
 
+    {
+	const char *s;
     for (argc--,argv++; argc > 0; argc--,argv++) {
 	if (argv[0][0] != '-' || !argv[0][1])
 	    break;
@@ -1723,7 +1763,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	case 'W':
 	case 'X':
 	case 'w':
-	case 'A':
 	    if ((s = moreswitches(s)))
 		goto reswitch;
 	    break;
@@ -1752,10 +1791,10 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
 		break;
 #endif
-	    forbid_setid('e', -1);
+	    forbid_setid('e', FALSE);
 	    if (!PL_e_script) {
 		PL_e_script = newSVpvs("");
-		filter_add(read_e_script, NULL);
+		add_read_e_script = TRUE;
 	    }
 	    if (*++s)
 		sv_catpv(PL_e_script, s);
@@ -1776,7 +1815,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    goto reswitch;
 
 	case 'I':	/* -I handled both here and in moreswitches() */
-	    forbid_setid('I', -1);
+	    forbid_setid('I', FALSE);
 	    if (!*++s && (s=argv[1]) != NULL) {
 		argc--,argv++;
 	    }
@@ -1792,13 +1831,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    else
 		Perl_croak(aTHX_ "No directory specified for -I");
 	    break;
-	case 'P':
-	    forbid_setid('P', -1);
-	    PL_preprocess = TRUE;
-	    s++;
-	    goto reswitch;
 	case 'S':
-	    forbid_setid('S', -1);
+	    forbid_setid('S', FALSE);
 	    dosearch = TRUE;
 	    s++;
 	    goto reswitch;
@@ -1808,56 +1842,18 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 
 		Perl_av_create_and_push(aTHX_ &PL_preambleav, newSVpvs("use Config;"));
 		if (*++s != ':')  {
-		    STRLEN opts;
-		
-		    opts_prog = newSVpvs("print Config::myconfig(),");
-#ifdef VMS
-		    sv_catpvs(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n\",");
-#else
-		    sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n\",");
-#endif
-		    opts = SvCUR(opts_prog);
-
-		    Perl_sv_catpv(aTHX_ opts_prog,"\"  Compile-time options:"
+		    /* Can't do newSVpvs() as that would involve pre-processor
+		       condititionals inside a macro expansion.  */
+		    opts_prog = Perl_newSVpv(aTHX_ "$_ = join ' ', sort qw("
 #  ifdef 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
-			     " MULTIPLICITY"
-#  endif
-#  ifdef MYMALLOC
-			     " MYMALLOC"
-#  endif
 #  ifdef NO_MATHOMS
                             " NO_MATHOMS"
 #  endif
-#  ifdef PERL_DEBUG_READONLY_OPS
-			     " PERL_DEBUG_READONLY_OPS"
-#  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_MAD
-			     " PERL_MAD"
-#  endif
 #  ifdef PERL_MALLOC_WRAP
 			     " PERL_MALLOC_WRAP"
 #  endif
@@ -1876,85 +1872,27 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  ifdef PERL_MEM_LOG_TIMESTAMP
 			     " PERL_MEM_LOG_TIMESTAMP"
 #  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_POISON
-			     " PERL_POISON"
-#  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_64_BIT_ALL
-			     " USE_64_BIT_ALL"
-#  endif
-#  ifdef USE_64_BIT_INT
-			     " USE_64_BIT_INT"
-#  endif
-#  ifdef USE_ITHREADS
-			     " USE_ITHREADS"
-#  endif
-#  ifdef USE_LARGE_FILES
-			     " USE_LARGE_FILES"
-#  endif
-#  ifdef USE_LONG_DOUBLE
-			     " USE_LONG_DOUBLE"
-#  endif
-#  ifdef USE_PERLIO
-			     " USE_PERLIO"
-#  endif
-#  ifdef USE_REENTRANT_API
-			     " USE_REENTRANT_API"
-#  endif
-#  ifdef USE_SFIO
-			     " USE_SFIO"
-#  endif
 #  ifdef USE_SITECUSTOMIZE
 			     " USE_SITECUSTOMIZE"
 #  endif	       
-#  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 * const 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 */
+#  ifdef USE_FAST_STDIO
+			     " USE_FAST_STDIO"
+#  endif	       
+					     , 0);
 
-			opts = space - pv;
-			Perl_sv_insert(aTHX_ opts_prog, opts, 0,
-				  STR_WITH_LEN("\\n                       "));
-		    }
+		    sv_catpv(opts_prog, PL_bincompat_options);
+		    /* Terminate the qw(, and then wrap at 76 columns.  */
+		    sv_catpvs(opts_prog, "); s/(?=.{53})(.{1,53}) /$1\\n                        /mg;print Config::myconfig(),");
+#ifdef VMS
+		    sv_catpvs(opts_prog,"\"\\nCharacteristics of this PERLSHR image: \\n");
+#else
+		    sv_catpvs(opts_prog,"\"\\nCharacteristics of this binary (from libperl): \\n");
+#endif
 
-		    sv_catpvs(opts_prog,"\\n\",");
+		    sv_catpvs(opts_prog,"  Compile-time options: $_\\n\",");
 
 #if defined(LOCAL_PATCH_COUNT)
 		    if (LOCAL_PATCH_COUNT > 0) {
@@ -1969,15 +1907,13 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		    }
 #endif
 		    Perl_sv_catpvf(aTHX_ opts_prog,
-				   "\"  Built under %s\\n\"",OSNAME);
+				   "\"  Built under %s\\n",OSNAME);
 #ifdef __DATE__
 #  ifdef __TIME__
-		    Perl_sv_catpvf(aTHX_ opts_prog,
-				   ",\"  Compiled at %s %s\\n\"",__DATE__,
-				   __TIME__);
+		    sv_catpvs(opts_prog,
+			      "  Compiled at " __DATE__ " " __TIME__ "\\n\"");
 #  else
-		    Perl_sv_catpvf(aTHX_ opts_prog,",\"  Compiled on %s\\n\"",
-				   __DATE__);
+		    sv_catpvs(opts_prog, "  Compiled on " __DATE__ "\\n\"");
 #  endif
 #endif
 		    sv_catpvs(opts_prog, "; $\"=\"\\n    \"; "
@@ -2031,15 +1967,19 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    Perl_croak(aTHX_ "Unrecognized switch: -%s  (-h will show valid options)",s);
 	}
     }
+    }
+
   switch_end:
 
+    {
+	char *s;
+
     if (
 #ifndef SECURE_INTERNAL_GETENV
         !PL_tainting &&
 #endif
 	(s = PerlEnv_getenv("PERL5OPT")))
     {
-    	const char *popt = s;
 	while (isSPACE(*s))
 	    s++;
 	if (*s == '-' && *(s+1) == 'T') {
@@ -2050,7 +1990,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	else {
 	    char *popt_copy = NULL;
 	    while (s && *s) {
-	        char *d;
+	        const char *d;
 		while (isSPACE(*s))
 		    s++;
 		if (*s == '-') {
@@ -2061,14 +2001,14 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 		d = s;
 		if (!*s)
 		    break;
-		if (!strchr("CDIMUdmtwA", *s))
+		if (!strchr("CDIMUdmtw", *s))
 		    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
 		while (++s && *s) {
 		    if (isSPACE(*s)) {
 			if (!popt_copy) {
-			    popt_copy = SvPVX(sv_2mortal(newSVpv(popt,0)));
-			    s = popt_copy + (s - popt);
-			    d = popt_copy + (d - popt);
+			    popt_copy = SvPVX(sv_2mortal(newSVpv(d,0)));
+			    s = popt_copy + (s - d);
+			    d = popt_copy;
 			}
 		        *s++ = '\0';
 			break;
@@ -2085,6 +2025,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    }
 	}
     }
+    }
 
 #ifdef USE_SITECUSTOMIZE
     if (!minus_f) {
@@ -2115,11 +2056,15 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     init_perllib();
 
     {
-	int suidscript;
-	const int fdscript
-	    = open_script(scriptname, dosearch, sv, &suidscript);
+	bool suidscript = FALSE;
 
-	validate_suid(validarg, scriptname, fdscript, suidscript);
+#ifdef DOSUID
+	const int fdscript =
+#endif
+	    open_script(scriptname, dosearch, &suidscript, &rsfp);
+
+	validate_suid(validarg, scriptname, fdscript, suidscript,
+		linestr_sv, rsfp);
 
 #ifndef PERL_MICRO
 #  if defined(SIGCHLD) || defined(SIGCLD)
@@ -2144,25 +2089,28 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
 	    ) {
 
-	    /* This will croak if suidscript is >= 0, as -x cannot be used with
+	    /* This will croak if suidscript is true, as -x cannot be used with
 	       setuid scripts.  */
 	    forbid_setid('x', suidscript);
-	    /* Hence you can't get here if suidscript >= 0  */
+	    /* Hence you can't get here if suidscript is true */
 
-	    find_beginning();
+	    find_beginning(linestr_sv, rsfp);
 	    if (cddir && PerlDir_chdir( (char *)cddir ) < 0)
 		Perl_croak(aTHX_ "Can't chdir to %s",cddir);
 	}
     }
 
-    PL_main_cv = PL_compcv = (CV*)newSV_type(SVt_PVCV);
+    PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
     CvUNIQUE_on(PL_compcv);
 
     CvPADLIST(PL_compcv) = pad_new(0);
 
+    PL_isarev = newHV();
+
     boot_core_PerlIO();
     boot_core_UNIVERSAL();
     boot_core_xsutils();
+    boot_core_mro();
 
     if (xsinit)
 	(*xsinit)(aTHX);	/* in case linked C routines want magical variables */
@@ -2233,6 +2181,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	 }
     }
 
+    {
+	const char *s;
     if ((s = PerlEnv_getenv("PERL_SIGNALS"))) {
 	 if (strEQ(s, "unsafe"))
 	      PL_signals |=  PERL_SIGNALS_UNSAFE_FLAG;
@@ -2241,8 +2191,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	 else
 	      Perl_croak(aTHX_ "PERL_SIGNALS illegal: \"%s\"", s);
     }
+    }
 
 #ifdef PERL_MAD
+    {
+	const char *s;
     if ((s = PerlEnv_getenv("PERL_XMLDUMP"))) {
 	PL_madskills = 1;
 	PL_minus_c = 1;
@@ -2253,22 +2206,30 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	    if (!PL_xmlfp)
 		Perl_croak(aTHX_ "Can't open %s", s);
 	}
-	my_setenv("PERL_XMLDUMP", Nullch);	/* hide from subprocs */
+	my_setenv("PERL_XMLDUMP", NULL);	/* hide from subprocs */
+    }
     }
+
+    {
+	const char *s;
     if ((s = PerlEnv_getenv("PERL_MADSKILLS"))) {
 	PL_madskills = atoi(s);
-	my_setenv("PERL_MADSKILLS", Nullch);	/* hide from subprocs */
+	my_setenv("PERL_MADSKILLS", NULL);	/* hide from subprocs */
+    }
     }
 #endif
 
-    init_lexer();
+    lex_start(linestr_sv, rsfp, TRUE);
+    PL_subname = newSVpvs("main");
+
+    if (add_read_e_script)
+	filter_add(read_e_script, NULL);
 
     /* now parse the script */
 
     SETERRNO(0,SS_NORMAL);
-    PL_error_count = 0;
 #ifdef MACOS_TRADITIONAL
-    if (gMacPerl_SyntaxError = (yyparse() || PL_error_count)) {
+    if (gMacPerl_SyntaxError = (yyparse() || PL_parser->error_count)) {
 	if (PL_minus_c)
 	    Perl_croak(aTHX_ "%s had compilation errors.\n", MacPerl_MPWFileName(PL_origfilename));
 	else {
@@ -2277,7 +2238,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 	}
     }
 #else
-    if (yyparse() || PL_error_count) {
+    if (yyparse() || PL_parser->error_count) {
 	if (PL_minus_c)
 	    Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
 	else {
@@ -2288,7 +2249,6 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #endif
     CopLINE_set(PL_curcop, 0);
     PL_curstash = PL_defstash;
-    PL_preprocess = FALSE;
     if (PL_e_script) {
 	SvREFCNT_dec(PL_e_script);
 	PL_e_script = NULL;
@@ -2307,8 +2267,11 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
     FREETMPS;
 
 #ifdef MYMALLOC
+    {
+	const char *s;
     if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
 	dump_mstats("after compilation:");
+    }
 #endif
 
     ENTER;
@@ -2332,7 +2295,10 @@ perl_run(pTHXx)
     int ret = 0;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_PERL_RUN;
+#ifndef MULTIPLICITY
     PERL_UNUSED_ARG(my_perl);
+#endif
 
     oldscope = PL_scopestack_ix;
 #ifdef VMS
@@ -2396,8 +2362,6 @@ S_run_body(pTHX_ I32 oldscope)
 	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)));
 
 	if (PL_minus_c) {
 #ifdef MACOS_TRADITIONAL
@@ -2450,6 +2414,9 @@ SV*
 Perl_get_sv(pTHX_ const char *name, I32 create)
 {
     GV *gv;
+
+    PERL_ARGS_ASSERT_GET_SV;
+
     gv = gv_fetchpv(name, create, SVt_PV);
     if (gv)
 	return GvSV(gv);
@@ -2472,6 +2439,9 @@ AV*
 Perl_get_av(pTHX_ const char *name, I32 create)
 {
     GV* const gv = gv_fetchpv(name, create, SVt_PVAV);
+
+    PERL_ARGS_ASSERT_GET_AV;
+
     if (create)
     	return GvAVn(gv);
     if (gv)
@@ -2495,6 +2465,9 @@ HV*
 Perl_get_hv(pTHX_ const char *name, I32 create)
 {
     GV* const gv = gv_fetchpv(name, create, SVt_PVHV);
+
+    PERL_ARGS_ASSERT_GET_HV;
+
     if (create)
     	return GvHVn(gv);
     if (gv)
@@ -2527,9 +2500,11 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
     /* XXX this is probably not what they think they're getting.
      * It has the same effect as "sub name;", i.e. just a forward
      * declaration! */
+
+    PERL_ARGS_ASSERT_GET_CVN_FLAGS;
+
     if ((flags & ~GV_NOADD_MASK) && !GvCVu(gv)) {
-	SV *const sv = newSVpvn(name,len);
-	SvFLAGS(sv) |= flags & SVf_UTF8;
+	SV *const sv = newSVpvn_flags(name, len, flags & SVf_UTF8);
     	return newSUB(start_subparse(FALSE, 0),
 		      newSVOP(OP_CONST, 0, sv),
 		      NULL, NULL);
@@ -2542,6 +2517,8 @@ Perl_get_cvn_flags(pTHX_ const char *name, STRLEN len, I32 flags)
 CV*
 Perl_get_cv(pTHX_ const char *name, I32 flags)
 {
+    PERL_ARGS_ASSERT_GET_CV;
+
     return get_cvn_flags(name, strlen(name), flags);
 }
 
@@ -2567,10 +2544,12 @@ Perl_call_argv(pTHX_ const char *sub_name, I32 flags, register char **argv)
     dVAR;
     dSP;
 
+    PERL_ARGS_ASSERT_CALL_ARGV;
+
     PUSHMARK(SP);
     if (argv) {
 	while (*argv) {
-	    XPUSHs(sv_2mortal(newSVpv(*argv,0)));
+	    mXPUSHs(newSVpv(*argv,0));
 	    argv++;
 	}
 	PUTBACK;
@@ -2591,6 +2570,8 @@ Perl_call_pv(pTHX_ const char *sub_name, I32 flags)
               		/* name of the subroutine */
           		/* See G_* flags in cop.h */
 {
+    PERL_ARGS_ASSERT_CALL_PV;
+
     return call_sv((SV*)get_cv(sub_name, TRUE), flags);
 }
 
@@ -2608,6 +2589,8 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
                		/* name of the subroutine */
           		/* See G_* flags in cop.h */
 {
+    PERL_ARGS_ASSERT_CALL_METHOD;
+
     return call_sv(sv_2mortal(newSVpv(methname,0)), flags | G_METHOD);
 }
 
@@ -2622,7 +2605,7 @@ L<perlcall>.
 */
 
 I32
-Perl_call_sv(pTHX_ SV *sv, I32 flags)
+Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
           		/* See G_* flags in cop.h */
 {
     dVAR; dSP;
@@ -2636,18 +2619,23 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     OP* const oldop = PL_op;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_CALL_SV;
+
     if (flags & G_DISCARD) {
 	ENTER;
 	SAVETMPS;
     }
+    if (!(flags & G_WANT)) {
+	/* Backwards compatibility - as G_SCALAR was 0, it could be omitted.
+	 */
+	flags |= G_SCALAR;
+    }
 
     Zero(&myop, 1, LOGOP);
     myop.op_next = NULL;
     if (!(flags & G_NOARGS))
 	myop.op_flags |= OPf_STACKED;
-    myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
-		      (flags & G_ARRAY) ? OPf_WANT_LIST :
-		      OPf_WANT_SCALAR);
+    myop.op_flags |= OP_GIMME_REVERSE(flags);
     SAVEOP();
     PL_op = (OP*)&myop;
 
@@ -2661,7 +2649,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	  && (PL_DBcv || (PL_DBcv = GvCV(PL_DBsub)))
 	   /* Try harder, since this may have been a sighandler, thus
 	    * curstash may be meaningless. */
-	  && (SvTYPE(sv) != SVt_PVCV || CvSTASH((CV*)sv) != PL_debstash)
+	  && (SvTYPE(sv) != SVt_PVCV || CvSTASH((const CV *)sv) != PL_debstash)
 	  && !(flags & G_NODEBUG))
 	PL_op->op_private |= OPpENTERSUB_DB;
 
@@ -2669,7 +2657,9 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	Zero(&method_op, 1, UNOP);
 	method_op.op_next = PL_op;
 	method_op.op_ppaddr = PL_ppaddr[OP_METHOD];
+	method_op.op_type = OP_METHOD;
 	myop.op_ppaddr = PL_ppaddr[OP_ENTERSUB];
+	myop.op_type = OP_ENTERSUB;
 	PL_op = (OP*)&method_op;
     }
 
@@ -2692,8 +2682,9 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
  redo_body:
 	    CALL_BODY_SUB((OP*)&myop);
 	    retval = PL_stack_sp - (PL_stack_base + oldmark);
-	    if (!(flags & G_KEEPERR))
-		sv_setpvn(ERRSV,"",0);
+	    if (!(flags & G_KEEPERR)) {
+		CLEAR_ERRSV();
+	    }
 	    break;
 	case 1:
 	    STATUS_ALL_FAILURE;
@@ -2714,7 +2705,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 		goto redo_body;
 	    }
 	    PL_stack_sp = PL_stack_base + oldmark;
-	    if (flags & G_ARRAY)
+	    if ((flags & G_WANT) == G_ARRAY)
 		retval = 0;
 	    else {
 		retval = 1;
@@ -2762,6 +2753,8 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     OP* const oldop = PL_op;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_EVAL_SV;
+
     if (flags & G_DISCARD) {
 	ENTER;
 	SAVETMPS;
@@ -2777,9 +2770,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	myop.op_flags = OPf_STACKED;
     myop.op_next = NULL;
     myop.op_type = OP_ENTEREVAL;
-    myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
-		      (flags & G_ARRAY) ? OPf_WANT_LIST :
-		      OPf_WANT_SCALAR);
+    myop.op_flags |= OP_GIMME_REVERSE(flags);
     if (flags & G_KEEPERR)
 	myop.op_flags |= OPf_SPECIAL;
 
@@ -2793,8 +2784,9 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
  redo_body:
 	CALL_BODY_EVAL((OP*)&myop);
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
-	if (!(flags & G_KEEPERR))
-	    sv_setpvn(ERRSV,"",0);
+	if (!(flags & G_KEEPERR)) {
+	    CLEAR_ERRSV();
+	}
 	break;
     case 1:
 	STATUS_ALL_FAILURE;
@@ -2815,7 +2807,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	    goto redo_body;
 	}
 	PL_stack_sp = PL_stack_base + oldmark;
-	if (flags & G_ARRAY)
+	if ((flags & G_WANT) == G_ARRAY)
 	    retval = 0;
 	else {
 	    retval = 1;
@@ -2850,6 +2842,8 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
     dSP;
     SV* sv = newSVpv(p, 0);
 
+    PERL_ARGS_ASSERT_EVAL_PV;
+
     eval_sv(sv, G_SCALAR);
     SvREFCNT_dec(sv);
 
@@ -2883,6 +2877,9 @@ Perl_require_pv(pTHX_ const char *pv)
     dVAR;
     dSP;
     SV* sv;
+
+    PERL_ARGS_ASSERT_REQUIRE_PV;
+
     PUSHSTACKi(PERLSI_REQUIRE);
     PUTBACK;
     sv = Perl_newSVpvf(aTHX_ "require q%c%s%c", 0, pv, 0);
@@ -2896,6 +2893,8 @@ Perl_magicname(pTHX_ const char *sym, const char *name, I32 namlen)
 {
     register GV * const gv = gv_fetchpv(sym, GV_ADD, SVt_PV);
 
+    PERL_ARGS_ASSERT_MAGICNAME;
+
     if (gv)
 	sv_magic(GvSV(gv), (SV*)gv, PERL_MAGIC_sv, name, namlen);
 }
@@ -2908,7 +2907,6 @@ S_usage(pTHX_ const char *name)		/* XXX move this out into a module ? */
 
     static const char * const usage_msg[] = {
 "-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)",
@@ -2924,7 +2922,6 @@ S_usage(pTHX_ const char *name)		/* XXX move this out into a module ? */
 "-[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",
@@ -2942,6 +2939,8 @@ NULL
 };
     const char * const *p = usage_msg;
 
+    PERL_ARGS_ASSERT_USAGE;
+
     PerlIO_printf(PerlIO_stdout(),
 		  "\nUsage: %s [switches] [--] [programfile] [arguments]",
 		  name);
@@ -2964,8 +2963,8 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       "  t  Trace execution",
       "  o  Method and overloading resolution",
       "  c  String/numeric conversions",
-      "  P  Print profiling info, preprocessor command for -P, source file input state",
-      "  m  Memory allocation",
+      "  P  Print profiling info, source file input state",
+      "  m  Memory and SV allocation",
       "  f  Format processing",
       "  r  Regular expression parsing and execution",
       "  x  Syntax tree dump",
@@ -2973,7 +2972,6 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       "  H  Hash dump -- usurps values()",
       "  X  Scratchpad allocation",
       "  D  Cleaning up",
-      "  S  Thread synchronization",
       "  T  Tokenising",
       "  R  Include reference counts of dumped variables (eg when using -Ds)",
       "  J  Do not s,t,P-debug (Jump over) opcodes within package DB",
@@ -2984,6 +2982,9 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
       NULL
     };
     int i = 0;
+
+    PERL_ARGS_ASSERT_GET_DEBUG_OPTS;
+
     if (isALPHA(**s)) {
 	/* if adding extra options, remember to update DEBUG_MASK */
 	static const char debopts[] = "psltocPmfrxuUHXDSTRJvCAq";
@@ -3016,11 +3017,14 @@ Perl_get_debug_opts(pTHX_ const char **s, bool givehelp)
 
 /* This routine handles any switches that can be given during run */
 
-char *
-Perl_moreswitches(pTHX_ char *s)
+const char *
+Perl_moreswitches(pTHX_ const char *s)
 {
     dVAR;
     UV rschar;
+    const char option = *s; /* used to remember option in -m/-M code */
+
+    PERL_ARGS_ASSERT_MORESWITCHES;
 
     switch (*s) {
     case '0':
@@ -3086,7 +3090,7 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 'd':
-	forbid_setid('d', -1);
+	forbid_setid('d', FALSE);
 	s++;
 
         /* -dt indicates to the debugger that threads will be used */
@@ -3098,21 +3102,23 @@ Perl_moreswitches(pTHX_ char *s)
 	/* The following permits -d:Mod to accepts arguments following an =
 	   in the fashion that -MSome::Mod does. */
 	if (*s == ':' || *s == '=') {
-            const char *start;
+	    const char *start = ++s;
+	    const char *const end = s + strlen(s);
 	    SV * const sv = newSVpvs("use Devel::");
-	    start = ++s;
+
 	    /* We now allow -d:Module=Foo,Bar */
 	    while(isALNUM(*s) || *s==':') ++s;
 	    if (*s != '=')
-		sv_catpv(sv, start);
+		sv_catpvn(sv, start, end - start);
 	    else {
 		sv_catpvn(sv, start, s-start);
 		/* Don't use NUL as q// delimiter here, this string goes in the
 		 * environment. */
 		Perl_sv_catpvf(aTHX_ sv, " split(/,/,q{%s});", ++s);
 	    }
-	    s += strlen(s);
+	    s = end;
 	    my_setenv("PERL5DB", SvPV_nolen_const(sv));
+	    SvREFCNT_dec(sv);
 	}
 	if (!PL_perldb) {
 	    PL_perldb = PERLDB_ALL;
@@ -3122,7 +3128,7 @@ Perl_moreswitches(pTHX_ char *s)
     case 'D':
     {	
 #ifdef DEBUGGING
-	forbid_setid('D', -1);
+	forbid_setid('D', FALSE);
 	s++;
 	PL_debug = get_debug_opts( (const char **)&s, 1) | DEBUG_TOP_FLAG;
 #else /* !DEBUGGING */
@@ -3158,12 +3164,12 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 	return s;
     case 'I':	/* -I handled both here and in parse_body() */
-	forbid_setid('I', -1);
+	forbid_setid('I', FALSE);
 	++s;
 	while (*s && isSPACE(*s))
 	    ++s;
 	if (*s) {
-	    char *e, *p;
+	    const char *e, *p;
 	    p = s;
 	    /* ignore trailing spaces (possibly followed by other switches) */
 	    do {
@@ -3206,36 +3212,17 @@ Perl_moreswitches(pTHX_ char *s)
 	    }
 	}
 	return s;
-    case 'A':
-	forbid_setid('A', -1);
-	s++;
-	{
-	    char * const start = s;
-	    SV * const sv = newSVpvs("use assertions::activate");
-	    while(isALNUM(*s) || *s == ':') ++s;
-	    if (s != start) {
-		sv_catpvs(sv, "::");
-		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, (int)(s-start), start);
-	    }
-	    Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
-	    return s;
-	}
     case 'M':
-	forbid_setid('M', -1);	/* XXX ? */
+	forbid_setid('M', FALSE);	/* XXX ? */
 	/* FALL THROUGH */
     case 'm':
-	forbid_setid('m', -1);	/* XXX ? */
+	forbid_setid('m', FALSE);	/* XXX ? */
 	if (*++s) {
-	    char *start;
+	    const char *start;
+	    const char *end;
 	    SV *sv;
 	    const char *use = "use ";
+	    bool colon = FALSE;
 	    /* -M-foo == 'no foo'	*/
 	    /* Leading space on " no " is deliberate, to make both
 	       possibilities the same length.  */
@@ -3243,29 +3230,42 @@ Perl_moreswitches(pTHX_ char *s)
 	    sv = newSVpvn(use,4);
 	    start = s;
 	    /* We allow -M'Module qw(Foo Bar)'	*/
-	    while(isALNUM(*s) || *s==':') ++s;
+	    while(isALNUM(*s) || *s==':') {
+		if( *s++ == ':' ) {
+		    if( *s == ':' ) 
+			s++;
+		    else
+			colon = TRUE;
+		}
+	    }
+	    if (s == start)
+		Perl_croak(aTHX_ "Module name required with -%c option",
+				    option);
+	    if (colon) 
+		Perl_croak(aTHX_ "Invalid module name %.*s with -%c option: "
+				    "contains single ':'",
+				    (int)(s - start), start, option);
+	    end = s + strlen(s);
 	    if (*s != '=') {
-		sv_catpv(sv, start);
-		if (*(start-1) == 'm') {
+		sv_catpvn(sv, start, end - start);
+		if (option == 'm') {
 		    if (*s != '\0')
 			Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
 		    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_catpvs(sv, " split(/,/,q");
-		sv_catpvs(sv, "\0");        /* Use NUL as q//-delimiter. */
-		sv_catpv(sv, ++s);
+		/* Use NUL as q''-delimiter.  */
+		sv_catpvs(sv, " split(/,/,q\0");
+		++s;
+		sv_catpvn(sv, s, end - s);
 		sv_catpvs(sv,  "\0)");
 	    }
-	    s += strlen(s);
+	    s = end;
 	    Perl_av_create_and_push(aTHX_ &PL_preambleav, sv);
 	}
 	else
-	    Perl_croak(aTHX_ "Missing argument to -%c", *(s-1));
+	    Perl_croak(aTHX_ "Missing argument to -%c", option);
 	return s;
     case 'n':
 	PL_minus_n = TRUE;
@@ -3276,7 +3276,7 @@ Perl_moreswitches(pTHX_ char *s)
 	s++;
 	return s;
     case 's':
-	forbid_setid('s', -1);
+	forbid_setid('s', FALSE);
 	PL_doswitches = TRUE;
 	s++;
 	return s;
@@ -3336,7 +3336,7 @@ Perl_moreswitches(pTHX_ char *s)
 #endif
 
 	PerlIO_printf(PerlIO_stdout(),
-		      "\n\nCopyright 1987-2007, Larry Wall\n");
+		      "\n\nCopyright 1987-2008, Larry Wall\n");
 #ifdef MACOS_TRADITIONAL
 	PerlIO_printf(PerlIO_stdout(),
 		      "\nMac OS port Copyright 1991-2002, Matthias Neeracher;\n"
@@ -3434,8 +3434,10 @@ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
 	return s;
     case '*':
     case ' ':
-	if (s[1] == '-')	/* Additional switches on #! line. */
-	    return s+2;
+        while( *s == ' ' )
+          ++s;
+	if (s[0] == '-')	/* Additional switches on #! line. */
+	    return s+1;
 	break;
     case '-':
     case 0:
@@ -3449,10 +3451,6 @@ Internet, point your browser at http://www.perl.org/, the Perl Home Page.\n\n");
     case 'S':			/* OS/2 needs -S on "extproc" line. */
 	break;
 #endif
-    case 'P':
-	if (PL_preprocess)
-	    return s+1;
-	/* FALL THROUGH */
     default:
 	Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
     }
@@ -3508,7 +3506,6 @@ S_init_interp(pTHX)
 #    define PERLVARIC(var,type,init)	PERL_GET_INTERP->var = init;
 #  endif
 #  include "intrpvar.h"
-#  include "thrdvar.h"
 #  undef PERLVAR
 #  undef PERLVARA
 #  undef PERLVARI
@@ -3519,7 +3516,6 @@ S_init_interp(pTHX)
 #  define PERLVARI(var,type,init)	PL_##var = init;
 #  define PERLVARIC(var,type,init)	PL_##var = init;
 #  include "intrpvar.h"
-#  include "thrdvar.h"
 #  undef PERLVAR
 #  undef PERLVARA
 #  undef PERLVARI
@@ -3550,18 +3546,18 @@ S_init_main_stash(pTHX)
        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_simple(PL_defstash);
+    GvHV(gv) = MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash));
     SvREADONLY_on(gv);
     PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL,
 					     SVt_PVAV)));
-    SvREFCNT_inc_simple(PL_incgv); /* Don't allow it to be freed */
+    SvREFCNT_inc_simple_void(PL_incgv); /* Don't allow it to be freed */
     GvMULTI_on(PL_incgv);
     PL_hintgv = gv_fetchpvs("\010", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^H */
     GvMULTI_on(PL_hintgv);
     PL_defgv = gv_fetchpvs("_", GV_ADD|GV_NOTQUAL, SVt_PVAV);
-    SvREFCNT_inc_simple(PL_defgv);
+    SvREFCNT_inc_simple_void(PL_defgv);
     PL_errgv = gv_HVadd(gv_fetchpvs("@", GV_ADD|GV_NOTQUAL, SVt_PV));
-    SvREFCNT_inc_simple(PL_errgv);
+    SvREFCNT_inc_simple_void(PL_errgv);
     GvMULTI_on(PL_errgv);
     PL_replgv = gv_fetchpvs("\022", GV_ADD|GV_NOTQUAL, SVt_PV); /* ^R */
     GvMULTI_on(PL_replgv);
@@ -3570,7 +3566,7 @@ S_init_main_stash(pTHX)
     gv_SVadd(PL_errgv);
 #endif
     sv_grow(ERRSV, 240);	/* Preallocate - for immediate signals. */
-    sv_setpvn(ERRSV, "", 0);
+    CLEAR_ERRSV();
     PL_curstash = PL_defstash;
     CopSTASH_set(&PL_compiling, PL_defstash);
     PL_debstash = GvHV(gv_fetchpvs("DB::", GV_ADDMULTI, SVt_PVHV));
@@ -3581,19 +3577,13 @@ S_init_main_stash(pTHX)
 }
 
 STATIC int
-S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
-	      int *suidscript)
+S_open_script(pTHX_ const char *scriptname, bool dosearch,
+	      bool *suidscript, PerlIO **rsfpp)
 {
-#ifndef IAMSUID
-    const char *quote;
-    const char *code;
-    const char *cpp_discard_flag;
-    const char *perl;
-#endif
     int fdscript = -1;
     dVAR;
 
-    *suidscript = -1;
+    PERL_ARGS_ASSERT_OPEN_SCRIPT;
 
     if (PL_e_script) {
 	PL_origfilename = savepvs("-e");
@@ -3617,7 +3607,7 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
 		 * Is it a mistake to use a similar /dev/fd/ construct for
 		 * suidperl?
 		 */
-		*suidscript = 1;
+		*suidscript = TRUE;
 		/* PSz 20 Feb 04  
 		 * Be supersafe and do some sanity-checks.
 		 * Still, can we be sure we got the right thing?
@@ -3640,11 +3630,11 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
     if (*PL_origfilename == '-' && PL_origfilename[1] == '\0')
 	scriptname = (char *)"";
     if (fdscript >= 0) {
-	PL_rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
+	*rsfpp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
 #       if defined(HAS_FCNTL) && defined(F_SETFD)
-	    if (PL_rsfp)
+	    if (*rsfpp)
                 /* ensure close-on-exec */
-	        fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
+	        fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
 #       endif
     }
 #ifdef IAMSUID
@@ -3660,90 +3650,64 @@ S_open_script(pTHX_ const char *scriptname, bool dosearch, SV *sv,
  * perl with that fd as it has always done.
  */
     }
-    if (*suidscript != 1) {
+    if (*suidscript) {
 	Perl_croak(aTHX_ "suidperl needs (suid) fd script\n");
     }
 #else /* IAMSUID */
-    else if (PL_preprocess) {
-	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");
-	if (strEQ(cpp_cfg, "cppstdin"))
-	    Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
-	sv_catpv(cpp, cpp_cfg);
-
-#       ifndef VMS
-	    sv_catpvs(sv, "-I");
-	    sv_catpv(sv,PRIVLIB_EXP);
-#       endif
-
-	DEBUG_P(PerlIO_printf(Perl_debug_log,
-			      "PL_preprocess: scriptname=\"%s\", cpp=\"%s\", sv=\"%s\", CPPMINUS=\"%s\"\n",
-			      scriptname, SvPVX_const (cpp), SvPVX_const (sv),
-			      CPPMINUS));
-
-#       if defined(MSDOS) || defined(WIN32) || defined(VMS)
-            quote = "\"";
-#       else
-            quote = "'";
-#       endif
-
-#       ifdef VMS
-            cpp_discard_flag = "";
-#       else
-            cpp_discard_flag = "-C";
-#       endif
-
-#       ifdef OS2
-            perl = os2_execname(aTHX);
-#       else
-            perl = PL_origargv[0];
-#       endif
-
-
-        /* This strips off Perl comments which might interfere with
-           the C pre-processor, including #!.  #line directives are
-           deliberately stripped to avoid confusion with Perl's version
-           of #line.  FWP played some golf with it so it will fit
-           into VMS's 255 character buffer.
-        */
-        if( PL_doextract )
-            code = "(1../^#!.*perl/i)|/^\\s*#(?!\\s*((ifn?|un)def|(el|end)?if|define|include|else|error|pragma)\\b)/||!($|=1)||print";
-        else
-            code = "/^\\s*#(?!\\s*((ifn?|un)def|(el|end)?if|define|include|else|error|pragma)\\b)/||!($|=1)||print";
-
-        Perl_sv_setpvf(aTHX_ cmd, "\
-%s -ne%s%s%s %s | %"SVf" %s %"SVf" %s",
-                       perl, quote, code, quote, scriptname, SVfARG(cpp),
-                       cpp_discard_flag, SVfARG(sv), CPPMINUS);
-
-	PL_doextract = FALSE;
-
-        DEBUG_P(PerlIO_printf(Perl_debug_log,
-                              "PL_preprocess: cmd=\"%s\"\n",
-                              SvPVX_const(cmd)));
-
-	PL_rsfp = PerlProc_popen((char *)SvPVX_const(cmd), (char *)"r");
-	SvREFCNT_dec(cmd);
-	SvREFCNT_dec(cpp);
-    }
     else if (!*scriptname) {
 	forbid_setid(0, *suidscript);
-	PL_rsfp = PerlIO_stdin();
+	*rsfpp = PerlIO_stdin();
     }
     else {
-	PL_rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
+#ifdef FAKE_BIT_BUCKET
+	/* This hack allows one not to have /dev/null (or BIT_BUCKET as it
+	 * is called) and still have the "-e" work.  (Believe it or not,
+	 * a /dev/null is required for the "-e" to work because source
+	 * filter magic is used to implement it. ) This is *not* a general
+	 * replacement for a /dev/null.  What we do here is create a temp
+	 * file (an empty file), open up that as the script, and then
+	 * immediately close and unlink it.  Close enough for jazz. */ 
+#define FAKE_BIT_BUCKET_PREFIX "/tmp/perlnull-"
+#define FAKE_BIT_BUCKET_SUFFIX "XXXXXXXX"
+#define FAKE_BIT_BUCKET_TEMPLATE FAKE_BIT_BUCKET_PREFIX FAKE_BIT_BUCKET_SUFFIX
+	char tmpname[sizeof(FAKE_BIT_BUCKET_TEMPLATE)] = {
+	    FAKE_BIT_BUCKET_TEMPLATE
+	};
+	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 tmpfd = mkstemp(tmpname);
+	    if (tmpfd > -1) {
+		scriptname = tmpname;
+		close(tmpfd);
+	    } else
+		Perl_croak(aTHX_ err);
+#else
+#  ifdef HAS_MKTEMP
+	    scriptname = mktemp(tmpname);
+	    if (!scriptname)
+		Perl_croak(aTHX_ err);
+#  endif
+#endif
+	}
+#endif
+	*rsfpp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
+#ifdef FAKE_BIT_BUCKET
+	if (memEQ(scriptname, FAKE_BIT_BUCKET_PREFIX,
+		  sizeof(FAKE_BIT_BUCKET_PREFIX) - 1)
+	    && strlen(scriptname) == sizeof(tmpname) - 1) {
+	    unlink(scriptname);
+	}
+	scriptname = BIT_BUCKET;
+#endif
 #       if defined(HAS_FCNTL) && defined(F_SETFD)
-	    if (PL_rsfp)
+	    if (*rsfpp)
                 /* ensure close-on-exec */
-	        fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,1);
+	        fcntl(PerlIO_fileno(*rsfpp),F_SETFD,1);
 #       endif
     }
 #endif /* IAMSUID */
-    if (!PL_rsfp) {
+    if (!*rsfpp) {
 	/* PSz 16 Sep 03  Keep neat error message */
 	if (PL_e_script)
 	    Perl_croak(aTHX_ "Can't open "BIT_BUCKET": %s\n", Strerror(errno));
@@ -3888,14 +3852,22 @@ S_fd_on_nosuid_fs(pTHX_ int fd)
 }
 #endif /* IAMSUID */
 
+#ifdef DOSUID
 STATIC void
-S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
-		int fdscript, int suidscript)
+S_validate_suid(pTHX_ const char *validarg,
+#  ifndef IAMSUID
+		const char *scriptname,
+#  endif
+		int fdscript,
+#  ifdef IAMSUID
+		bool suidscript,
+#  endif
+		SV *linestr_sv, PerlIO *rsfp)
 {
     dVAR;
-#ifdef IAMSUID
-    /* int which; */
-#endif /* IAMSUID */
+    const char *s, *s2;
+
+    PERL_ARGS_ASSERT_VALIDATE_SUID;
 
     /* do we need to emulate setuid on scripts? */
 
@@ -3924,18 +3896,15 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
      * Configure script will set this up for you if you want it.
      */
 
-#ifdef DOSUID
-    const char *s, *s2;
-
-    if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
+    if (PerlLIO_fstat(PerlIO_fileno(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;
 	const char *linestr;
 	const char *s_end;
 
-#ifdef IAMSUID
-	if (fdscript < 0 || suidscript != 1)
+#  ifdef IAMSUID
+	if (fdscript < 0 || !suidscript)
 	    Perl_croak(aTHX_ "Need (suid) fdscript in suidperl\n");	/* We already checked this */
 	/* PSz 11 Nov 03
 	 * Since the script is opened by perl, not suidperl, some of these
@@ -3945,16 +3914,16 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 	/* PSz 27 Feb 04
 	 * Do checks even for systems with no HAS_SETREUID.
 	 * We used to swap, then re-swap UIDs with
-#ifdef HAS_SETREUID
+#    ifdef HAS_SETREUID
 	    if (setreuid(PL_euid,PL_uid) < 0
 		|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
 		Perl_croak(aTHX_ "Can't swap uid and euid");
-#endif
-#ifdef HAS_SETREUID
+#    endif
+#    ifdef HAS_SETREUID
 	    if (setreuid(PL_uid,PL_euid) < 0
 		|| PerlProc_getuid() != PL_uid || PerlProc_geteuid() != PL_euid)
 		Perl_croak(aTHX_ "Can't reswap uid and euid");
-#endif
+#    endif
 	 */
 
 	/* On this access check to make sure the directories are readable,
@@ -4015,12 +3984,12 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 	 * operating systems do not have such mount options anyway...)
 	 * Seems safe enough to do as root.
 	 */
-#if !defined(NO_NOSUID_CHECK)
-	if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp))) {
+#    if !defined(NO_NOSUID_CHECK)
+	if (fd_on_nosuid_fs(PerlIO_fileno(rsfp))) {
 	    Perl_croak(aTHX_ "Setuid script on nosuid or noexec filesystem\n");
 	}
-#endif
-#endif /* IAMSUID */
+#    endif
+#  endif /* IAMSUID */
 
 	if (!S_ISREG(PL_statbuf.st_mode)) {
 	    Perl_croak(aTHX_ "Setuid script not plain file\n");
@@ -4030,9 +3999,9 @@ 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) == NULL)
+	if (sv_gets(linestr_sv, rsfp, 0) == NULL)
 	    Perl_croak(aTHX_ "No #! line");
-	linestr = SvPV_nolen_const(PL_linestr);
+	linestr = SvPV_nolen_const(linestr_sv);
 	/* required even on Sys V */
 	if (!*linestr || !linestr[1] || strnNE(linestr,"#!",2))
 	    Perl_croak(aTHX_ "No #! line");
@@ -4084,14 +4053,14 @@ S_validate_suid(pTHX_ const char *validarg, const char *scriptname,
 	      || ((s_end - s) == len+2 && isSPACE(s[len+1]))))
 	    Perl_croak(aTHX_ "Args must match #! line");
 
-#ifndef IAMSUID
+#  ifndef IAMSUID
 	if (fdscript < 0 &&
 	    PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) &&
 	    PL_euid == PL_statbuf.st_uid)
 	    if (!PL_do_undump)
 		Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
-#endif /* IAMSUID */
+#  endif /* IAMSUID */
 
 	if (fdscript < 0 &&
 	    PL_euid) {	/* oops, we're not the setuid root perl */
@@ -4109,7 +4078,7 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 	     * fdscript to avoid loops), and do the execs
 	     * even for root.
 	     */
-#ifndef IAMSUID
+#  ifndef IAMSUID
 	    int which;
 	    /* PSz 11 Nov 03
 	     * Pass fd script to suidperl.
@@ -4118,8 +4087,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 	     * in fact will use that to distinguish this from "normal"
 	     * usage, see comments above.
 	     */
-	    PerlIO_rewind(PL_rsfp);
-	    PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+	    PerlIO_rewind(rsfp);
+	    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
 	    /* PSz 27 Feb 04  Sanity checks on scriptname */
 	    if ((!scriptname) || (!*scriptname) ) {
 		Perl_croak(aTHX_ "No setuid script name\n");
@@ -4136,16 +4105,16 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 		Perl_croak(aTHX_ "Can't change argv to have fd script\n");
 	    }
 	    PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",
-					  PerlIO_fileno(PL_rsfp), PL_origargv[which]));
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-	    fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
-#endif
+					  PerlIO_fileno(rsfp), PL_origargv[which]));
+#    if defined(HAS_FCNTL) && defined(F_SETFD)
+	    fcntl(PerlIO_fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
+#    endif
 	    PERL_FPU_PRE_EXEC
 	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl"PERL_FS_VER_FMT, BIN_EXP,
 				     (int)PERL_REVISION, (int)PERL_VERSION,
 				     (int)PERL_SUBVERSION), PL_origargv);
 	    PERL_FPU_POST_EXEC
-#endif /* IAMSUID */
+#  endif /* IAMSUID */
 	    Perl_croak(aTHX_ "Can't do setuid (cannot exec sperl)\n");
 	}
 
@@ -4156,54 +4125,54 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
  * in the sense that we only want to set EGID; but are there any machines
  * with either of the latter, but not the former? Same with UID, later.
  */
-#ifdef HAS_SETEGID
+#  ifdef HAS_SETEGID
 	    (void)setegid(PL_statbuf.st_gid);
-#else
-#ifdef HAS_SETREGID
+#  else
+#    ifdef HAS_SETREGID
            (void)setregid((Gid_t)-1,PL_statbuf.st_gid);
-#else
-#ifdef HAS_SETRESGID
+#    else
+#      ifdef HAS_SETRESGID
            (void)setresgid((Gid_t)-1,PL_statbuf.st_gid,(Gid_t)-1);
-#else
+#      else
 	    PerlProc_setgid(PL_statbuf.st_gid);
-#endif
-#endif
-#endif
+#      endif
+#    endif
+#  endif
 	    if (PerlProc_getegid() != PL_statbuf.st_gid)
 		Perl_croak(aTHX_ "Can't do setegid!\n");
 	}
 	if (PL_statbuf.st_mode & S_ISUID) {
 	    if (PL_statbuf.st_uid != PL_euid)
-#ifdef HAS_SETEUID
+#  ifdef HAS_SETEUID
 		(void)seteuid(PL_statbuf.st_uid);	/* all that for this */
-#else
-#ifdef HAS_SETREUID
+#  else
+#    ifdef HAS_SETREUID
                 (void)setreuid((Uid_t)-1,PL_statbuf.st_uid);
-#else
-#ifdef HAS_SETRESUID
+#    else
+#      ifdef HAS_SETRESUID
                 (void)setresuid((Uid_t)-1,PL_statbuf.st_uid,(Uid_t)-1);
-#else
+#      else
 		PerlProc_setuid(PL_statbuf.st_uid);
-#endif
-#endif
-#endif
+#      endif
+#    endif
+#  endif
 	    if (PerlProc_geteuid() != PL_statbuf.st_uid)
 		Perl_croak(aTHX_ "Can't do seteuid!\n");
 	}
 	else if (PL_uid) {			/* oops, mustn't run as root */
-#ifdef HAS_SETEUID
+#  ifdef HAS_SETEUID
           (void)seteuid((Uid_t)PL_uid);
-#else
-#ifdef HAS_SETREUID
+#  else
+#    ifdef HAS_SETREUID
           (void)setreuid((Uid_t)-1,(Uid_t)PL_uid);
-#else
-#ifdef HAS_SETRESUID
+#    else
+#      ifdef HAS_SETRESUID
           (void)setresuid((Uid_t)-1,(Uid_t)PL_uid,(Uid_t)-1);
-#else
+#      else
           PerlProc_setuid((Uid_t)PL_uid);
-#endif
-#endif
-#endif
+#      endif
+#    endif
+#  endif
 	    if (PerlProc_geteuid() != PL_uid)
 		Perl_croak(aTHX_ "Can't do seteuid!\n");
 	}
@@ -4211,10 +4180,8 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 	if (!cando(S_IXUSR,TRUE,&PL_statbuf))
 	    Perl_croak(aTHX_ "Effective UID cannot exec script\n");	/* they can't do this */
     }
-#ifdef IAMSUID
-    else if (PL_preprocess)	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
-	Perl_croak(aTHX_ "-P not allowed for setuid/setgid script\n");
-    else if (fdscript < 0 || suidscript != 1)
+#  ifdef IAMSUID
+    else if (fdscript < 0 || !suidscript)
 	/* PSz 13 Nov 03  Caught elsewhere, useless(?!) here */
 	Perl_croak(aTHX_ "(suid) fdscript needed in suidperl\n");
     else {
@@ -4255,34 +4222,38 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
      * #endif
      * into the perly bits.
      */
-    PerlIO_rewind(PL_rsfp);
-    PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+    PerlIO_rewind(rsfp);
+    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
     /* PSz 11 Nov 03
      * Keep original arguments: suidperl already has fd script.
      */
-/*  for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;	*/
-/*  if (!PL_origargv[which]) {						*/
-/*	errno = EPERM;							*/
-/*	Perl_croak(aTHX_ "Permission denied\n");			*/
-/*  }									*/
-/*  PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",	*/
-/*				  PerlIO_fileno(PL_rsfp), PL_origargv[which]));	*/
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
-#endif
+#  if defined(HAS_FCNTL) && defined(F_SETFD)
+    fcntl(PerlIO_fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
+#  endif
     PERL_FPU_PRE_EXEC
     PerlProc_execv(Perl_form(aTHX_ "%s/perl"PERL_FS_VER_FMT, BIN_EXP,
 			     (int)PERL_REVISION, (int)PERL_VERSION,
 			     (int)PERL_SUBVERSION), PL_origargv);/* try again */
     PERL_FPU_POST_EXEC
     Perl_croak(aTHX_ "Can't do setuid (suidperl cannot exec perl)\n");
-#endif /* IAMSUID */
+#  endif /* IAMSUID */
+}
+
 #else /* !DOSUID */
-    PERL_UNUSED_ARG(fdscript);
-    PERL_UNUSED_ARG(suidscript);
+
+#  ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
+/* Don't even need this function.  */
+#  else
+STATIC void
+S_validate_suid(pTHX_ PerlIO *rsfp)
+{
+    PERL_ARGS_ASSERT_VALIDATE_SUID;
+
     if (PL_euid != PL_uid || PL_egid != PL_gid) {	/* (suidperl doesn't exist, in fact) */
-#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
-	PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf);	/* may be either wrapped or real suid */
+#  ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
+	dVAR;
+
+	PerlLIO_fstat(PerlIO_fileno(rsfp),&PL_statbuf);	/* may be either wrapped or real suid */
 	if ((PL_euid != PL_uid && PL_euid == PL_statbuf.st_uid && PL_statbuf.st_mode & S_ISUID)
 	    ||
 	    (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
@@ -4290,31 +4261,32 @@ FIX YOUR KERNEL, OR PUT A C WRAPPER AROUND THIS SCRIPT!\n");
 	    if (!PL_do_undump)
 		Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
-#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
+#  endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
 	/* not set-id, must be wrapped */
     }
-#endif /* DOSUID */
-    PERL_UNUSED_ARG(validarg);
-    PERL_UNUSED_ARG(scriptname);
 }
+#  endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
+#endif /* DOSUID */
 
 STATIC void
-S_find_beginning(pTHX)
+S_find_beginning(pTHX_ SV* linestr_sv, PerlIO *rsfp)
 {
     dVAR;
-    register char *s;
+    const char *s;
     register const char *s2;
 #ifdef MACOS_TRADITIONAL
     int maclines = 0;
 #endif
 
+    PERL_ARGS_ASSERT_FIND_BEGINNING;
+
     /* skip forward in input to the real script? */
 
 #ifdef MACOS_TRADITIONAL
     /* Since the Mac OS does not honor #! arguments for us, we do it ourselves */
 
     while (PL_doextract || gMacPerl_AlwaysExtract) {
-	if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == NULL) {
+	if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL) {
 	    if (!gMacPerl_AlwaysExtract)
 		Perl_croak(aTHX_ "No Perl script found in input\n");
 
@@ -4325,18 +4297,18 @@ S_find_beginning(pTHX)
 		    PL_doextract = FALSE;
 
 	    /* Pater peccavi, file does not have #! */
-	    PerlIO_rewind(PL_rsfp);
+	    PerlIO_rewind(rsfp);
 
 	    break;
 	}
 #else
     while (PL_doextract) {
-	if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == NULL)
+	if ((s = sv_gets(linestr_sv, rsfp, 0)) == NULL)
 	    Perl_croak(aTHX_ "No Perl script found in input\n");
 #endif
 	s2 = s;
 	if (*s == '#' && s[1] == '!' && ((s = instr(s,"perl")) || (s = instr(s2,"PERL")))) {
-	    PerlIO_ungetc(PL_rsfp, '\n');		/* to keep line count right */
+	    PerlIO_ungetc(rsfp, '\n');		/* to keep line count right */
 	    PL_doextract = FALSE;
 	    while (*s && !(isSPACE (*s) || *s == '#')) s++;
 	    s2 = s;
@@ -4354,7 +4326,7 @@ S_find_beginning(pTHX)
 	     * by counting lines we already skipped over
 	     */
 	    for (; maclines > 0 ; maclines--)
-		PerlIO_ungetc(PL_rsfp, '\n');
+		PerlIO_ungetc(rsfp, '\n');
 
 	    break;
 
@@ -4435,7 +4407,7 @@ Perl_doing_taint(int argc, char *argv[], char *envp[])
    "program input from stdin", which is substituted in place of '\0', which
    could never be a command line flag.  */
 STATIC void
-S_forbid_setid(pTHX_ const char flag, const int suidscript)
+S_forbid_setid(pTHX_ const char flag, const bool suidscript) /* g */
 {
     dVAR;
     char string[3] = "-x";
@@ -4474,7 +4446,7 @@ S_forbid_setid(pTHX_ const char flag, const int suidscript)
      * 
      * Also see comments about root running a setuid script, elsewhere.
      */
-    if (suidscript >= 0)
+    if (suidscript)
         Perl_croak(aTHX_ "No %s allowed with (suid) fdscript", message);
 #ifdef IAMSUID
     /* PSz 11 Nov 03  Catch it in suidperl, always! */
@@ -4501,8 +4473,6 @@ Perl_init_debugger(pTHX)
     sv_setiv(PL_DBtrace, 0);
     PL_DBsignal = GvSV((gv_fetchpvs("DB::signal", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsignal, 0);
-    PL_DBassertion = GvSV((gv_fetchpvs("DB::assertion", GV_ADDMULTI, SVt_PV)));
-    sv_setiv(PL_DBassertion, 0);
     PL_curstash = ostash;
 }
 
@@ -4568,17 +4538,6 @@ S_nuke_stacks(pTHX)
     Safefree(PL_savestack);
 }
 
-STATIC void
-S_init_lexer(pTHX)
-{
-    dVAR;
-    PerlIO *tmpfp;
-    tmpfp = PL_rsfp;
-    PL_rsfp = NULL;
-    lex_start(PL_linestr);
-    PL_rsfp = tmpfp;
-    PL_subname = newSVpvs("main");
-}
 
 STATIC void
 S_init_predump_symbols(pTHX)
@@ -4626,6 +4585,9 @@ void
 Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 {
     dVAR;
+
+    PERL_ARGS_ASSERT_INIT_ARGV_SYMBOLS;
+
     argc--,argv++;	/* skip name of script */
     if (PL_doswitches) {
 	for (; argc > 0 && **argv == '-'; argc--,argv++) {
@@ -4668,6 +4630,8 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     dVAR;
     GV* tmpgv;
 
+    PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS;
+
     PL_toptarget = newSV_type(SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
     PL_bodytarget = newSV_type(SVt_PVFM);
@@ -4712,18 +4676,21 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 	    environ[0] = NULL;
 	}
 	if (env) {
-	  char *s;
+	  char *s, *old_var;
 	  SV *sv;
 	  for (; *env; env++) {
-	    if (!(s = strchr(*env,'=')) || s == *env)
+	    old_var = *env;
+
+	    if (!(s = strchr(old_var,'=')) || s == old_var)
 		continue;
+
 #if defined(MSDOS) && !defined(DJGPP)
 	    *s = '\0';
-	    (void)strupr(*env);
+	    (void)strupr(old_var);
 	    *s = '=';
 #endif
 	    sv = newSVpv(s+1, 0);
-	    (void)hv_store(hv, *env, s - *env, sv, 0);
+	    (void)hv_store(hv, old_var, s - old_var, sv, 0);
 	    if (env_is_not_environ)
 	        mg_set(sv);
 	  }
@@ -4898,6 +4865,9 @@ S_incpush_if_exists(pTHX_ SV *dir)
 {
     dVAR;
     Stat_t tmpstatbuf;
+
+    PERL_ARGS_ASSERT_INCPUSH_IF_EXISTS;
+
     if (PerlLIO_stat(SvPVX_const(dir), &tmpstatbuf) >= 0 &&
 	S_ISDIR(tmpstatbuf.st_mode)) {
 	av_push(GvAVn(PL_incgv), dir);
@@ -4989,7 +4959,8 @@ S_incpush(pTHX_ const char *dir, bool addsubdirs, bool addoldvers, bool usesep,
 		   SvPOK() won't be true.  */
 		assert(caret_X);
 		assert(SvPOKp(caret_X));
-		prefix_sv = newSVpvn(SvPVX(caret_X), SvCUR(caret_X));
+		prefix_sv = newSVpvn_flags(SvPVX(caret_X), SvCUR(caret_X),
+					   SvUTF8(caret_X));
 		/* Firstly take off the leading .../
 		   If all else fail we'll do the paths relative to the current
 		   directory.  */
@@ -5140,8 +5111,10 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     int ret;
     dJMPENV;
 
+    PERL_ARGS_ASSERT_CALL_LIST;
+
     while (av_len(paramList) >= 0) {
-	cv = (CV*)av_shift(paramList);
+	cv = MUTABLE_CV(av_shift(paramList));
 	if (PL_savebegin) {
 	    if (paramList == PL_beginav) {
 		/* save PL_beginav for compiler */
@@ -5173,8 +5146,6 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 #endif
 	    atsv = ERRSV;
 	    (void)SvPV_const(atsv, len);
-	    if (PL_madskills && PL_minus_c && paramList == PL_beginav)
-		break;	/* not really trying to run, so just wing it */
 	    if (len) {
 		PL_curcop = &PL_compiling;
 		CopLINE_set(PL_curcop, oldline);
@@ -5205,8 +5176,6 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 	    PL_curcop = &PL_compiling;
 	    CopLINE_set(PL_curcop, oldline);
 	    JMPENV_POP;
-	    if (PL_madskills && PL_minus_c && paramList == PL_beginav)
-		return;	/* not really trying to run, so just wing it */
 	    if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
 		if (paramList == PL_beginav)
 		    Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
@@ -5237,8 +5206,6 @@ void
 Perl_my_exit(pTHX_ U32 status)
 {
     dVAR;
-    DEBUG_S(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
-			  (void*)thr, (unsigned long) status));
     switch (status) {
     case 0:
 	STATUS_ALL_SUCCESS;