X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=bc53f5ec52b81a4d08a4878d7e93101c4ac1212b;hb=b7b1864f76048b3925a3516e05f0ced40aaebf56;hp=f757d11bedd982d1e639068ef8525e12af327c0b;hpb=e92c4225b24535b7128dd90f6a3e01d0abc79a1d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index f757d11..bc53f5e 100644
--- a/perl.c
+++ b/perl.c
@@ -1,6 +1,6 @@
 /*    perl.c
  *
- *    Copyright (c) 1987-1997 Larry Wall
+ *    Copyright (c) 1987-1998 Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -24,6 +24,13 @@
 char *getenv _((char *)); /* Usually in <stdlib.h> */
 #endif
 
+#ifdef I_FCNTL
+#include <fcntl.h>
+#endif
+#ifdef I_SYS_FILE
+#include <sys/file.h>
+#endif
+
 dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
 
 #ifdef IAMSUID
@@ -69,10 +76,12 @@ static void init_ids _((void));
 static void init_debugger _((void));
 static void init_lexer _((void));
 static void init_main_stash _((void));
+#ifdef USE_THREADS
+static struct perl_thread * init_main_thread _((void));
+#endif /* USE_THREADS */
 static void init_perllib _((void));
 static void init_postdump_symbols _((int, char **, char **));
 static void init_predump_symbols _((void));
-static void init_stacks _((void));
 static void my_exit_jump _((void)) __attribute__((noreturn));
 static void nuke_stacks _((void));
 static void open_script _((char *, bool, SV *));
@@ -82,7 +91,7 @@ static void validate_suid _((char *, char*));
 static int fdscript = -1;
 
 PerlInterpreter *
-perl_alloc()
+perl_alloc(void)
 {
     PerlInterpreter *sv_interp;
 
@@ -92,9 +101,15 @@ perl_alloc()
 }
 
 void
-perl_construct( sv_interp )
-register PerlInterpreter *sv_interp;
+perl_construct(register PerlInterpreter *sv_interp)
 {
+#ifdef USE_THREADS
+    int i;
+#ifndef FAKE_THREADS
+    struct perl_thread *thr;
+#endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
+    
     if (!(curinterp = sv_interp))
 	return;
 
@@ -102,8 +117,33 @@ register PerlInterpreter *sv_interp;
     Zero(sv_interp, 1, PerlInterpreter);
 #endif
 
-    /* Init the real globals? */
+   /* Init the real globals (and main thread)? */
     if (!linestr) {
+#ifdef USE_THREADS
+
+    	INIT_THREADS;
+#ifdef ALLOC_THREAD_KEY
+        ALLOC_THREAD_KEY;
+#else
+	if (pthread_key_create(&thr_key, 0))
+	    croak("panic: pthread_key_create");
+#endif
+	MUTEX_INIT(&sv_mutex);
+	/*
+	 * Safe to use basic SV functions from now on (though
+	 * not things like mortals or tainting yet).
+	 */
+	MUTEX_INIT(&eval_mutex);
+	COND_INIT(&eval_cond);
+	MUTEX_INIT(&threads_mutex);
+	COND_INIT(&nthreads_cond);
+#ifdef EMULATE_ATOMIC_REFCOUNTS
+	MUTEX_INIT(&svref_mutex);
+#endif /* EMULATE_ATOMIC_REFCOUNTS */
+	
+	thr = init_main_thread();
+#endif /* USE_THREADS */
+
 	linestr = NEWSV(65,80);
 	sv_upgrade(linestr,SVt_PVIV);
 
@@ -122,6 +162,7 @@ register PerlInterpreter *sv_interp;
 	nrs = newSVpv("\n", 1);
 	rs = SvREFCNT_inc(nrs);
 
+	sighandlerp = sighandler;
 	pidstatus = newHV();
 
 #ifdef MSDOS
@@ -135,6 +176,7 @@ register PerlInterpreter *sv_interp;
 #endif
     }
 
+    init_stacks(ARGS);
 #ifdef MULTIPLICITY
     I_REINIT;
     perl_destruct_level = 1; 
@@ -144,6 +186,7 @@ register PerlInterpreter *sv_interp;
 #endif
 
     init_ids();
+    lex_state = LEX_NOTPARSING;
 
     start_env.je_prev = NULL;
     start_env.je_ret = -1;
@@ -169,26 +212,103 @@ register PerlInterpreter *sv_interp;
 
     fdpid = newAV();	/* for remembering popen pids by fd */
 
-    init_stacks();
+    DEBUG( {
+	New(51,debname,128,char);
+	New(52,debdelim,128,char);
+    } )
+
     ENTER;
 }
 
 void
-perl_destruct(sv_interp)
-register PerlInterpreter *sv_interp;
+perl_destruct(register PerlInterpreter *sv_interp)
 {
+    dTHR;
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
     I32 last_sv_count;
     HV *hv;
+#ifdef USE_THREADS
+    Thread t;
+#endif /* USE_THREADS */
 
     if (!(curinterp = sv_interp))
 	return;
 
+#ifdef USE_THREADS
+#ifndef FAKE_THREADS
+    /* Pass 1 on any remaining threads: detach joinables, join zombies */
+  retry_cleanup:
+    MUTEX_LOCK(&threads_mutex);
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			  "perl_destruct: waiting for %d threads...\n",
+			  nthreads - 1));
+    for (t = thr->next; t != thr; t = t->next) {
+	MUTEX_LOCK(&t->mutex);
+	switch (ThrSTATE(t)) {
+	    AV *av;
+	case THRf_ZOMBIE:
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+				  "perl_destruct: joining zombie %p\n", t));
+	    ThrSETSTATE(t, THRf_DEAD);
+	    MUTEX_UNLOCK(&t->mutex);
+	    nthreads--;
+	    /*
+	     * The SvREFCNT_dec below may take a long time (e.g. av
+	     * may contain an object scalar whose destructor gets
+	     * called) so we have to unlock threads_mutex and start
+	     * all over again.
+	     */
+	    MUTEX_UNLOCK(&threads_mutex);
+	    JOIN(t, &av);
+	    SvREFCNT_dec((SV*)av);
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+				  "perl_destruct: joined zombie %p OK\n", t));
+	    goto retry_cleanup;
+	case THRf_R_JOINABLE:
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+				  "perl_destruct: detaching thread %p\n", t));
+	    ThrSETSTATE(t, THRf_R_DETACHED);
+	    /* 
+	     * We unlock threads_mutex and t->mutex in the opposite order
+	     * from which we locked them just so that DETACH won't
+	     * deadlock if it panics. It's only a breach of good style
+	     * not a bug since they are unlocks not locks.
+	     */
+	    MUTEX_UNLOCK(&threads_mutex);
+	    DETACH(t);
+	    MUTEX_UNLOCK(&t->mutex);
+	    goto retry_cleanup;
+	default:
+	    DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+				  "perl_destruct: ignoring %p (state %u)\n",
+				  t, ThrSTATE(t)));
+	    MUTEX_UNLOCK(&t->mutex);
+	    /* fall through and out */
+	}
+    }
+    /* We leave the above "Pass 1" loop with threads_mutex still locked */
+
+    /* Pass 2 on remaining threads: wait for the thread count to drop to one */
+    while (nthreads > 1)
+    {
+	DEBUG_L(PerlIO_printf(PerlIO_stderr(),
+			      "perl_destruct: final wait for %d threads\n",
+			      nthreads - 1));
+	COND_WAIT(&nthreads_cond, &threads_mutex);
+    }
+    /* At this point, we're the last thread */
+    MUTEX_UNLOCK(&threads_mutex);
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "perl_destruct: armageddon has arrived\n"));
+    MUTEX_DESTROY(&threads_mutex);
+    COND_DESTROY(&nthreads_cond);
+#endif /* !defined(FAKE_THREADS) */
+#endif /* USE_THREADS */
+
     destruct_level = perl_destruct_level;
 #ifdef DEBUGGING
     {
 	char *s;
-	if (s = getenv("PERL_DESTRUCT_LEVEL")) {
+	if (s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL")) {
 	    int i = atoi(s);
 	    if (destruct_level < i)
 		destruct_level = i;
@@ -294,36 +414,6 @@ register PerlInterpreter *sv_interp;
 
     /* defgv, aka *_ should be taken care of elsewhere */
 
-#if 0  /* just about all regexp stuff, seems to be ok */
-
-    /* shortcuts to regexp stuff */
-    leftgv = Nullgv;
-    ampergv = Nullgv;
-
-    SAVEFREEOP(curpm);
-    SAVEFREEOP(oldlastpm); /* for saving regexp context during debugger */
-
-    regprecomp = NULL;	/* uncompiled string. */
-    regparse = NULL;	/* Input-scan pointer. */
-    regxend = NULL;	/* End of input for compile */
-    regnpar = 0;	/* () count. */
-    regcode = NULL;	/* Code-emit pointer; &regdummy = don't. */
-    regsize = 0;	/* Code size. */
-    regnaughty = 0;	/* How bad is this pattern? */
-    regsawback = 0;	/* Did we see \1, ...? */
-
-    reginput = NULL;		/* String-input pointer. */
-    regbol = NULL;		/* Beginning of input, for ^ check. */
-    regeol = NULL;		/* End of input, for $ check. */
-    regstartp = (char **)NULL;	/* Pointer to startp array. */
-    regendp = (char **)NULL;	/* Ditto for endp. */
-    reglastparen = 0;		/* Similarly for lastparen. */
-    regtill = NULL;		/* How far we are required to go. */
-    regflags = 0;		/* are we folding, multilining? */
-    regprev = (char)NULL;	/* char before regbol, \n if none */
-
-#endif /* if 0 */
-
     /* clean up after study() */
     SvREFCNT_dec(lastscream);
     lastscream = Nullsv;
@@ -335,12 +425,10 @@ register PerlInterpreter *sv_interp;
     /* startup and shutdown function lists */
     SvREFCNT_dec(beginav);
     SvREFCNT_dec(endav);
+    SvREFCNT_dec(initav);
     beginav = Nullav;
     endav = Nullav;
-
-    /* temp stack during pp_sort() */
-    SvREFCNT_dec(sortstack);
-    sortstack = Nullav;
+    initav = Nullav;
 
     /* shortcuts just get cleared */
     envgv = Nullgv;
@@ -405,7 +493,7 @@ register PerlInterpreter *sv_interp;
 	    if (hent) {
 		warn("Unbalanced string table refcount: (%d) for \"%s\"",
 		     HeVAL(hent) - Nullsv, HeKEY(hent));
-		HeVAL(hent) = Nullsv;
+		HeVAL(hent) = &sv_undef;
 		hent = HeNEXT(hent);
 	    }
 	    if (!hent) {
@@ -431,7 +519,18 @@ register PerlInterpreter *sv_interp;
     hints = 0;		/* Reset hints. Should hints be per-interpreter ? */
     
     DEBUG_P(debprofdump());
-
+#ifdef USE_THREADS
+    MUTEX_DESTROY(&sv_mutex);
+    MUTEX_DESTROY(&eval_mutex);
+    COND_DESTROY(&eval_cond);
+
+    /* As the penultimate thing, free the non-arena SV for thrsv */
+    Safefree(SvPVX(thrsv));
+    Safefree(SvANY(thrsv));
+    Safefree(thrsv);
+    thrsv = Nullsv;
+#endif /* USE_THREADS */
+    
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (mess_sv) {
@@ -445,8 +544,7 @@ register PerlInterpreter *sv_interp;
 }
 
 void
-perl_free(sv_interp)
-PerlInterpreter *sv_interp;
+perl_free(PerlInterpreter *sv_interp)
 {
     if (!(curinterp = sv_interp))
 	return;
@@ -454,13 +552,9 @@ PerlInterpreter *sv_interp;
 }
 
 int
-perl_parse(sv_interp, xsinit, argc, argv, env)
-PerlInterpreter *sv_interp;
-void (*xsinit)_((void));
-int argc;
-char **argv;
-char **env;
+perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
 {
+    dTHR;
     register SV *sv;
     register char *s;
     char *scriptname = NULL;
@@ -468,6 +562,7 @@ char **env;
     char *validarg = "";
     I32 oldscope;
     AV* comppadlist;
+    int e_tmpfd = -1;
     dJMPENV;
     int ret;
 
@@ -527,6 +622,7 @@ setuid perl scripts securely.\n");
 	/* my_exit() was called */
 	while (scopestack_ix > oldscope)
 	    LEAVE;
+	FREETMPS;
 	curstash = defstash;
 	if (endav)
 	    call_list(oldscope, endav);
@@ -586,13 +682,36 @@ setuid perl scripts securely.\n");
 	    if (euid != uid || egid != gid)
 		croak("No -e allowed in setuid scripts");
 	    if (!e_fp) {
+#if defined(HAS_UMASK) && !defined(VMS)
+		int oldumask = PerlLIO_umask(0177);
+#endif
 	        e_tmpname = savepv(TMPPATH);
-		(void)mktemp(e_tmpname);
+#ifdef HAS_MKSTEMP
+		e_tmpfd = PerlLIO_mkstemp(e_tmpname);
+#else /* use mktemp() */
+		(void)PerlLIO_mktemp(e_tmpname);
 		if (!*e_tmpname)
-		    croak("Can't mktemp()");
+		    croak("Cannot generate temporary filename");
+# if defined(HAS_OPEN3) && defined(O_EXCL)
+		e_tmpfd = open(e_tmpname,
+			       O_WRONLY | O_CREAT | O_EXCL,
+			       0600);
+# else
+		(void)UNLINK(e_tmpname);
+		/* Yes, potential race.  But at least we can say we tried. */
 		e_fp = PerlIO_open(e_tmpname,"w");
-		if (!e_fp)
-		    croak("Cannot open temporary file");
+# endif
+#endif /* ifdef HAS_MKSTEMP */
+#if defined(HAS_MKSTEMP) || (defined(HAS_OPEN3) && defined(O_EXCL))
+		if (e_tmpfd < 0)
+		    croak("Cannot create temporary file \"%s\"", e_tmpname);
+		e_fp = PerlIO_fdopen(e_tmpfd,"w");
+#endif
+  		if (!e_fp)
+ 		    croak("Cannot create temporary file \"%s\"", e_tmpname);
+#if defined(HAS_UMASK) && !defined(VMS)
+		(void)PerlLIO_umask(oldumask);
+#endif
 	    }
 	    if (*++s)
 		PerlIO_puts(e_fp,s);
@@ -604,20 +723,23 @@ setuid perl scripts securely.\n");
 		croak("No code specified for -e");
 	    (void)PerlIO_putc(e_fp,'\n');
 	    break;
-	case 'I':
+	case 'I':	/* -I handled both here and in moreswitches() */
 	    forbid_setid("-I");
-	    sv_catpv(sv,"-");
-	    sv_catpv(sv,s);
-	    sv_catpv(sv," ");
-	    if (*++s) {
-		incpush(s, TRUE);
-	    }
-	    else if (argv[1]) {
-		incpush(argv[1], TRUE);
-		sv_catpv(sv,argv[1]);
+	    if (!*++s && (s=argv[1]) != Nullch) {
 		argc--,argv++;
-		sv_catpv(sv," ");
 	    }
+	    while (s && isSPACE(*s))
+		++s;
+	    if (s && *s) {
+		char *e, *p;
+		for (e = s; *e && !isSPACE(*e); e++) ;
+		p = savepvn(s, e-s);
+		incpush(p, TRUE);
+		sv_catpv(sv,"-I");
+		sv_catpv(sv,p);
+		sv_catpv(sv," ");
+		Safefree(p);
+	    }	/* XXX else croak? */
 	    break;
 	case 'P':
 	    forbid_setid("-P");
@@ -692,19 +814,32 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	    if (*s)
 		cddir = savepv(s);
 	    break;
-	case '-':
-	    argc--,argv++;
-	    goto switch_end;
 	case 0:
 	    break;
+	case '-':
+	    if (!*++s || isSPACE(*s)) {
+		argc--,argv++;
+		goto switch_end;
+	    }
+	    /* catch use of gnu style long options */
+	    if (strEQ(s, "version")) {
+		s = "v";
+		goto reswitch;
+	    }
+	    if (strEQ(s, "help")) {
+		s = "h";
+		goto reswitch;
+	    }
+	    s--;
+	    /* FALL THROUGH */
 	default:
-	    croak("Unrecognized switch: -%s",s);
+	    croak("Unrecognized switch: -%s  (-h will show valid options)",s);
 	}
     }
   switch_end:
 
-    if (!tainting && (s = getenv("PERL5OPT"))) {
-	for (;;) {
+    if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
+	while (s && *s) {
 	    while (isSPACE(*s))
 		s++;
 	    if (*s == '-') {
@@ -735,7 +870,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     }
     else if (scriptname == Nullch) {
 #ifdef MSDOS
-	if ( isatty(PerlIO_fileno(PerlIO_stdin())) )
+	if ( PerlLIO_isatty(PerlIO_fileno(PerlIO_stdin())) )
 	    moreswitches("h");
 #endif
 	scriptname = "-";
@@ -761,6 +896,14 @@ print \"  \\@INC:\\n    @INC\\n\";");
     comppad_name_fill = 0;
     min_intro_pending = 0;
     padix = 0;
+#ifdef USE_THREADS
+    av_store(comppad_name, 0, newSVpv("@_", 2));
+    curpad[0] = (SV*)newAV();
+    SvPADMY_on(curpad[0]);	/* XXX Needed? */
+    CvOWNER(compcv) = 0;
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
+    MUTEX_INIT(CvMUTEXP(compcv));
+#endif /* USE_THREADS */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -771,7 +914,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     boot_core_UNIVERSAL();
     if (xsinit)
 	(*xsinit)();	/* in case linked C routines want magical variables */
-#ifdef VMS
+#if defined(VMS) || defined(WIN32) || defined(DJGPP)
     init_os_extras();
 #endif
 
@@ -783,6 +926,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     /* now parse the script */
 
+    SETERRNO(0,SS$_NORMAL);
     error_count = 0;
     if (yyparse() || error_count) {
 	if (minus_c)
@@ -799,13 +943,13 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	(void)UNLINK(e_tmpname);
 	Safefree(e_tmpname);
 	e_tmpname = Nullch;
+	e_tmpfd = -1;
     }
 
     /* now that script is parsed, we can modify record separator */
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
-    sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
-
+    sv_setsv(perl_get_sv("/", TRUE), rs);
     if (do_undump)
 	my_unexec();
 
@@ -815,8 +959,8 @@ print \"  \\@INC:\\n    @INC\\n\";");
     LEAVE;
     FREETMPS;
 
-#ifdef DEBUGGING_MSTATS
-    if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+#ifdef MYMALLOC
+    if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
 	dump_mstats("after compilation:");
 #endif
 
@@ -827,9 +971,9 @@ print \"  \\@INC:\\n    @INC\\n\";");
 }
 
 int
-perl_run(sv_interp)
-PerlInterpreter *sv_interp;
+perl_run(PerlInterpreter *sv_interp)
 {
+    dSP;
     I32 oldscope;
     dJMPENV;
     int ret;
@@ -848,12 +992,12 @@ PerlInterpreter *sv_interp;
 	/* my_exit() was called */
 	while (scopestack_ix > oldscope)
 	    LEAVE;
+	FREETMPS;
 	curstash = defstash;
 	if (endav)
 	    call_list(oldscope, endav);
-	FREETMPS;
-#ifdef DEBUGGING_MSTATS
-	if (getenv("PERL_DEBUG_MSTATS"))
+#ifdef MYMALLOC
+	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
 	JMPENV_POP;
@@ -865,26 +1009,29 @@ PerlInterpreter *sv_interp;
 	    JMPENV_POP;
 	    return 1;
 	}
-	if (curstack != mainstack) {
-	    dSP;
-	    SWITCHSTACK(curstack, mainstack);
-	}
+	POPSTACK_TO(mainstack);
 	break;
     }
 
-    DEBUG_r(PerlIO_printf(PerlIO_stderr(), "%s $` $& $' support.\n",
+    DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
                     sawampersand ? "Enabling" : "Omitting"));
 
     if (!restartop) {
 	DEBUG_x(dump_all());
 	DEBUG(PerlIO_printf(Perl_debug_log, "\nEXECUTING...\n\n"));
+#ifdef USE_THREADS
+	DEBUG_L(PerlIO_printf(Perl_debug_log, "main thread is 0x%lx\n",
+			      (unsigned long) thr));
+#endif /* USE_THREADS */	
 
 	if (minus_c) {
 	    PerlIO_printf(PerlIO_stderr(), "%s syntax OK\n", origfilename);
 	    my_exit(0);
 	}
-	if (perldb && DBsingle)
+	if (PERLDB_SINGLE && DBsingle)
 	   sv_setiv(DBsingle, 1); 
+	if (initav)
+	    call_list(oldscope, initav);
     }
 
     /* do it */
@@ -906,20 +1053,26 @@ PerlInterpreter *sv_interp;
 }
 
 SV*
-perl_get_sv(name, create)
-char* name;
-I32 create;
+perl_get_sv(char *name, I32 create)
 {
-    GV* gv = gv_fetchpv(name, create, SVt_PV);
+    GV *gv;
+#ifdef USE_THREADS
+    if (name[1] == '\0' && !isALPHA(name[0])) {
+	PADOFFSET tmp = find_threadsv(name);
+    	if (tmp != NOT_IN_PAD) {
+	    dTHR;
+	    return THREADSV(tmp);
+	}
+    }
+#endif /* USE_THREADS */
+    gv = gv_fetchpv(name, create, SVt_PV);
     if (gv)
 	return GvSV(gv);
     return Nullsv;
 }
 
 AV*
-perl_get_av(name, create)
-char* name;
-I32 create;
+perl_get_av(char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVAV);
     if (create)
@@ -930,9 +1083,7 @@ I32 create;
 }
 
 HV*
-perl_get_hv(name, create)
-char* name;
-I32 create;
+perl_get_hv(char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVHV);
     if (create)
@@ -943,9 +1094,7 @@ I32 create;
 }
 
 CV*
-perl_get_cv(name, create)
-char* name;
-I32 create;
+perl_get_cv(char *name, I32 create)
 {
     GV* gv = gv_fetchpv(name, create, SVt_PVCV);
     if (create && !GvCVu(gv))
@@ -961,14 +1110,14 @@ I32 create;
 /* Be sure to refetch the stack pointer after calling these routines. */
 
 I32
-perl_call_argv(subname, flags, argv)
-char *subname;
-I32 flags;		/* See G_* flags in cop.h */
-register char **argv;	/* null terminated arg list */
+perl_call_argv(char *sub_name, I32 flags, register char **argv)
+              
+          		/* See G_* flags in cop.h */
+                     	/* null terminated arg list */
 {
     dSP;
 
-    PUSHMARK(sp);
+    PUSHMARK(SP);
     if (argv) {
 	while (*argv) {
 	    XPUSHs(sv_2mortal(newSVpv(*argv,0)));
@@ -976,21 +1125,21 @@ register char **argv;	/* null terminated arg list */
 	}
 	PUTBACK;
     }
-    return perl_call_pv(subname, flags);
+    return perl_call_pv(sub_name, flags);
 }
 
 I32
-perl_call_pv(subname, flags)
-char *subname;		/* name of the subroutine */
-I32 flags;		/* See G_* flags in cop.h */
+perl_call_pv(char *sub_name, I32 flags)
+              		/* name of the subroutine */
+          		/* See G_* flags in cop.h */
 {
-    return perl_call_sv((SV*)perl_get_cv(subname, TRUE), flags);
+    return perl_call_sv((SV*)perl_get_cv(sub_name, TRUE), flags);
 }
 
 I32
-perl_call_method(methname, flags)
-char *methname;		/* name of the subroutine */
-I32 flags;		/* See G_* flags in cop.h */
+perl_call_method(char *methname, I32 flags)
+               		/* name of the subroutine */
+          		/* See G_* flags in cop.h */
 {
     dSP;
     OP myop;
@@ -998,18 +1147,18 @@ I32 flags;		/* See G_* flags in cop.h */
 	op = &myop;
     XPUSHs(sv_2mortal(newSVpv(methname,0)));
     PUTBACK;
-    pp_method();
+    pp_method(ARGS);
     return perl_call_sv(*stack_sp--, flags);
 }
 
 /* May be called with any of a CV, a GV, or an SV containing the name. */
 I32
-perl_call_sv(sv, flags)
-SV* sv;
-I32 flags;		/* See G_* flags in cop.h */
+perl_call_sv(SV *sv, I32 flags)
+       
+          		/* See G_* flags in cop.h */
 {
+    dSP;
     LOGOP myop;		/* fake syntax tree node */
-    SV** sp = stack_sp;
     I32 oldmark;
     I32 retval;
     I32 oldscope;
@@ -1031,7 +1180,7 @@ I32 flags;		/* See G_* flags in cop.h */
     myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
 		      (flags & G_ARRAY) ? OPf_WANT_LIST :
 		      OPf_WANT_SCALAR);
-    SAVESPTR(op);
+    SAVEOP();
     op = (OP*)&myop;
 
     EXTEND(stack_sp, 1);
@@ -1039,7 +1188,7 @@ I32 flags;		/* See G_* flags in cop.h */
     oldmark = TOPMARK;
     oldscope = scopestack_ix;
 
-    if (perldb && curstash != debstash
+    if (PERLDB_SUB && curstash != debstash
 	   /* Handle first BEGIN of -d. */
 	  && (DBcv || (DBcv = GvCV(DBsub)))
 	   /* Try harder, since this may have been a sighandler, thus
@@ -1052,7 +1201,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	markstack_ptr--;
 	/* we're trying to emulate pp_entertry() here */
 	{
-	    register CONTEXT *cx;
+	    register PERL_CONTEXT *cx;
 	    I32 gimme = GIMME_V;
 	    
 	    ENTER;
@@ -1067,7 +1216,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	    if (flags & G_KEEPERR)
 		in_eval |= 4;
 	    else
-		sv_setpv(GvSV(errgv),"");
+		sv_setpv(ERRSV,"");
 	}
 	markstack_ptr++;
 
@@ -1107,12 +1256,12 @@ I32 flags;		/* See G_* flags in cop.h */
 	CATCH_SET(TRUE);
 
     if (op == (OP*)&myop)
-	op = pp_entersub();
+	op = pp_entersub(ARGS);
     if (op)
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if ((flags & G_EVAL) && !(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(ERRSV,"");
 
   cleanup:
     if (flags & G_EVAL) {
@@ -1120,7 +1269,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	    SV **newsp;
 	    PMOP *newpm;
 	    I32 gimme;
-	    register CONTEXT *cx;
+	    register PERL_CONTEXT *cx;
 	    I32 optype;
 
 	    POPBLOCK(cx,newpm);
@@ -1147,24 +1296,25 @@ I32 flags;		/* See G_* flags in cop.h */
 /* Eval a string. The G_EVAL flag is always assumed. */
 
 I32
-perl_eval_sv(sv, flags)
-SV* sv;
-I32 flags;		/* See G_* flags in cop.h */
+perl_eval_sv(SV *sv, I32 flags)
+       
+          		/* See G_* flags in cop.h */
 {
+    dSP;
     UNOP myop;		/* fake syntax tree node */
-    SV** sp = stack_sp;
-    I32 oldmark = sp - stack_base;
+    I32 oldmark = SP - stack_base;
     I32 retval;
     I32 oldscope;
     dJMPENV;
     int ret;
-    
+    OP* oldop = op;
+
     if (flags & G_DISCARD) {
 	ENTER;
 	SAVETMPS;
     }
 
-    SAVESPTR(op);
+    SAVEOP();
     op = (OP*)&myop;
     Zero(op, 1, UNOP);
     EXTEND(stack_sp, 1);
@@ -1214,12 +1364,12 @@ I32 flags;		/* See G_* flags in cop.h */
     }
 
     if (op == (OP*)&myop)
-	op = pp_entereval();
+	op = pp_entereval(ARGS);
     if (op)
 	runops();
     retval = stack_sp - (stack_base + oldmark);
     if (!(flags & G_KEEPERR))
-	sv_setpv(GvSV(errgv),"");
+	sv_setpv(ERRSV,"");
 
   cleanup:
     JMPENV_POP;
@@ -1229,18 +1379,17 @@ I32 flags;		/* See G_* flags in cop.h */
 	FREETMPS;
 	LEAVE;
     }
+    op = oldop;
     return retval;
 }
 
 SV*
-perl_eval_pv(p, croak_on_error)
-char* p;
-I32 croak_on_error;
+perl_eval_pv(char *p, I32 croak_on_error)
 {
     dSP;
     SV* sv = newSVpv(p, 0);
 
-    PUSHMARK(sp);
+    PUSHMARK(SP);
     perl_eval_sv(sv, G_SCALAR);
     SvREFCNT_dec(sv);
 
@@ -1248,8 +1397,8 @@ I32 croak_on_error;
     sv = POPs;
     PUTBACK;
 
-    if (croak_on_error && SvTRUE(GvSV(errgv)))
-	croak(SvPVx(GvSV(errgv), na));
+    if (croak_on_error && SvTRUE(ERRSV))
+	croak(SvPVx(ERRSV, na));
 
     return sv;
 }
@@ -1257,8 +1406,7 @@ I32 croak_on_error;
 /* Require a module. */
 
 void
-perl_require_pv(pv)
-char* pv;
+perl_require_pv(char *pv)
 {
     SV* sv = sv_newmortal();
     sv_setpv(sv, "require '");
@@ -1268,10 +1416,7 @@ char* pv;
 }
 
 void
-magicname(sym,name,namlen)
-char *sym;
-char *name;
-I32 namlen;
+magicname(char *sym, char *name, I32 namlen)
 {
     register GV *gv;
 
@@ -1280,48 +1425,58 @@ I32 namlen;
 }
 
 static void
-usage(name)		/* XXX move this out into a module ? */
-char *name;
+usage(char *name)		/* XXX move this out into a module ? */
+           
 {
     /* This message really ought to be max 23 lines.
      * Removed -h because the user already knows that opton. Others? */
+
+    static char *usage[] = {
+"-0[octal]       specify record separator (\\0, if no argument)",
+"-a              autosplit mode with -n or -p (splits $_ into @F)",
+"-c              check syntax only (runs BEGIN and END blocks)",
+"-d[:debugger]   run scripts under debugger",
+"-D[number/list] set debugging flags (argument is a bit mask or flags)",
+"-e 'command'    one line of script. Several -e's allowed. Omit [programfile].",
+"-F/pattern/     split() pattern for autosplit (-a). The //'s are optional.",
+"-i[extension]   edit <> files in place (make backup if extension supplied)",
+"-Idirectory     specify @INC/#include directory (may be used more than once)",
+"-l[octal]       enable line ending processing, specifies line terminator",
+"-[mM][-]module.. executes `use/no module...' before executing your script.",
+"-n              assume 'while (<>) { ... }' loop around your script",
+"-p              assume loop like -n but print line also like sed",
+"-P              run script through C preprocessor before compilation",
+"-s              enable some switch parsing for switches after script name",
+"-S              look for the script using PATH environment variable",
+"-T              turn on tainting checks",
+"-u              dump core after parsing script",
+"-U              allow unsafe operations",
+"-v              print version number and patchlevel of perl",
+"-V[:variable]   print perl configuration information",
+"-w              TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT. Recommended.",
+"-x[directory]   strip off text before #!perl line and perhaps cd to directory",
+"\n",
+NULL
+};
+    char **p = usage;
+
     printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
-    printf("\n  -0[octal]       specify record separator (\\0, if no argument)");
-    printf("\n  -a              autosplit mode with -n or -p (splits $_ into @F)");
-    printf("\n  -c              check syntax only (runs BEGIN and END blocks)");
-    printf("\n  -d[:debugger]   run scripts under debugger");
-    printf("\n  -D[number/list] set debugging flags (argument is a bit mask or flags)");
-    printf("\n  -e 'command'    one line of script. Several -e's allowed. Omit [programfile].");
-    printf("\n  -F/pattern/     split() pattern for autosplit (-a). The //'s are optional.");
-    printf("\n  -i[extension]   edit <> files in place (make backup if extension supplied)");
-    printf("\n  -Idirectory     specify @INC/#include directory (may be used more then once)");
-    printf("\n  -l[octal]       enable line ending processing, specifies line teminator");
-    printf("\n  -[mM][-]module.. executes `use/no module...' before executing your script.");
-    printf("\n  -n              assume 'while (<>) { ... }' loop arround your script");
-    printf("\n  -p              assume loop like -n but print line also like sed");
-    printf("\n  -P              run script through C preprocessor before compilation");
-    printf("\n  -s              enable some switch parsing for switches after script name");
-    printf("\n  -S              look for the script using PATH environment variable");
-    printf("\n  -T              turn on tainting checks");
-    printf("\n  -u              dump core after parsing script");
-    printf("\n  -U              allow unsafe operations");
-    printf("\n  -v              print version number and patchlevel of perl");
-    printf("\n  -V[:variable]   print perl configuration information");
-    printf("\n  -w              TURN WARNINGS ON FOR COMPILATION OF YOUR SCRIPT.");
-    printf("\n  -x[directory]   strip off text before #!perl line and perhaps cd to directory\n");
+    while (*p)
+	printf("\n  %s", *p++);
 }
 
 /* This routine handles any switches that can be given during run */
 
 char *
-moreswitches(s)
-char *s;
+moreswitches(char *s)
 {
     I32 numlen;
     U32 rschar;
 
     switch (*s) {
     case '0':
+    {
+	dTHR;
 	rschar = scan_oct(s, 4, &numlen);
 	SvREFCNT_dec(nrs);
 	if (rschar & ~((U8)~0))
@@ -1333,6 +1488,7 @@ char *s;
 	    nrs = newSVpv(&ch, 1);
 	}
 	return s + numlen;
+    }
     case 'F':
 	minus_F = TRUE;
 	splitstr = savepv(s + 1);
@@ -1354,7 +1510,7 @@ char *s;
 	    s += strlen(s);
 	}
 	if (!perldb) {
-	    perldb = TRUE;
+	    perldb = PERLDB_ALL;
 	    init_debugger();
 	}
 	return s;
@@ -1381,29 +1537,32 @@ char *s;
 	return s;
     case 'h':
 	usage(origargv[0]);    
-	exit(0);
+	PerlProc_exit(0);
     case 'i':
 	if (inplace)
 	    Safefree(inplace);
 	inplace = savepv(s+1);
 	/*SUPPRESS 530*/
 	for (s = inplace; *s && !isSPACE(*s); s++) ;
-	*s = '\0';
-	break;
-    case 'I':
+	if (*s)
+	    *s++ = '\0';
+	return s;
+    case 'I':	/* -I handled both here and in parse_perl() */
 	forbid_setid("-I");
-	if (*++s) {
+	++s;
+	while (*s && isSPACE(*s))
+	    ++s;
+	if (*s) {
 	    char *e, *p;
 	    for (e = s; *e && !isSPACE(*e); e++) ;
 	    p = savepvn(s, e-s);
 	    incpush(p, TRUE);
 	    Safefree(p);
-	    if (*e)
-		return e;
+	    s = e;
 	}
 	else
 	    croak("No space allowed after -I");
-	break;
+	return s;
     case 'l':
 	minus_l = TRUE;
 	s++;
@@ -1416,6 +1575,7 @@ char *s;
 	    s += numlen;
 	}
 	else {
+	    dTHR;
 	    if (RsPARA(nrs)) {
 		ors = "\n\n";
 		orslen = 2;
@@ -1432,30 +1592,31 @@ char *s;
 	forbid_setid("-m");	/* XXX ? */
 	if (*++s) {
 	    char *start;
+	    SV *sv;
 	    char *use = "use ";
 	    /* -M-foo == 'no foo'	*/
 	    if (*s == '-') { use = "no "; ++s; }
-	    Sv = newSVpv(use,0);
+	    sv = newSVpv(use,0);
 	    start = s;
 	    /* We allow -M'Module qw(Foo Bar)'	*/
 	    while(isALNUM(*s) || *s==':') ++s;
 	    if (*s != '=') {
-		sv_catpv(Sv, start);
+		sv_catpv(sv, start);
 		if (*(start-1) == 'm') {
 		    if (*s != '\0')
 			croak("Can't use '%c' after -mname", *s);
-		    sv_catpv( Sv, " ()");
+		    sv_catpv( sv, " ()");
 		}
 	    } else {
-		sv_catpvn(Sv, start, s-start);
-		sv_catpv(Sv, " split(/,/,q{");
-		sv_catpv(Sv, ++s);
-		sv_catpv(Sv,    "})");
+		sv_catpvn(sv, start, s-start);
+		sv_catpv(sv, " split(/,/,q{");
+		sv_catpv(sv, ++s);
+		sv_catpv(sv,    "})");
 	    }
 	    s += strlen(s);
 	    if (preambleav == NULL)
 		preambleav = newAV();
-	    av_push(preambleav, Sv);
+	    av_push(preambleav, sv);
 	}
 	else
 	    croak("No space allowed after -%c", *(s-1));
@@ -1488,21 +1649,29 @@ char *s;
 	return s;
     case 'v':
 #if defined(SUBVERSION) && SUBVERSION > 0
-	printf("\nThis is perl, version 5.%03d_%02d", PATCHLEVEL, SUBVERSION);
+	printf("\nThis is perl, version 5.%03d_%02d built for %s",
+	    PATCHLEVEL, SUBVERSION, ARCHNAME);
 #else
-	printf("\nThis is perl, version %s",patchlevel);
+	printf("\nThis is perl, version %s built for %s",
+		patchlevel, ARCHNAME);
+#endif
+#if defined(LOCAL_PATCH_COUNT)
+	if (LOCAL_PATCH_COUNT > 0)
+	    printf("\n(with %d registered patch%s, see perl -V for more detail)",
+		LOCAL_PATCH_COUNT, (LOCAL_PATCH_COUNT!=1) ? "es" : "");
 #endif
 
-	printf("\n\nCopyright 1987-1997, Larry Wall\n");
+	printf("\n\nCopyright 1987-1998, Larry Wall\n");
 #ifdef MSDOS
-	printf("\n\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
+	printf("\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
 #endif
 #ifdef DJGPP
 	printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
+	printf("djgpp v2 port (perl5004+) by Laszlo Molnar, 1997-1998\n");
 #endif
 #ifdef OS2
 	printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
-	    "Version 5 port Copyright (c) 1994-1997, Andreas Kaiser, Ilya Zakharevich\n");
+	    "Version 5 port Copyright (c) 1994-1998, Andreas Kaiser, Ilya Zakharevich\n");
 #endif
 #ifdef atarist
 	printf("atariST series port, ++jrb  bammi@cadence.com\n");
@@ -1510,7 +1679,7 @@ char *s;
 	printf("\n\
 Perl may be copied only under the terms of either the Artistic License or the\n\
 GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n");
-	exit(0);
+	PerlProc_exit(0);
     case 'w':
 	dowarn = TRUE;
 	s++;
@@ -1522,6 +1691,9 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n")
 	break;
     case '-':
     case 0:
+#ifdef WIN32
+    case '\r':
+#endif
     case '\n':
     case '\t':
 	break;
@@ -1544,7 +1716,7 @@ GNU General Public License, which may be found in the Perl 5.0 source kit.\n\n")
 /* unexec() can be found in the Gnu emacs distribution */
 
 void
-my_unexec()
+my_unexec(void)
 {
 #ifdef UNEXEC
     SV*    prog;
@@ -1561,7 +1733,7 @@ my_unexec()
     if (status)
 	PerlIO_printf(PerlIO_stderr(), "unexec of %s into %s failed!\n",
 		      SvPVX(prog), SvPVX(file));
-    exit(status);
+    PerlProc_exit(status);
 #else
 #  ifdef VMS
 #    include <lib$routines.h>
@@ -1573,8 +1745,9 @@ my_unexec()
 }
 
 static void
-init_main_stash()
+init_main_stash(void)
 {
+    dTHR;
     GV *gv;
 
     /* Note that strtab is a rather special HV.  Assumptions are made
@@ -1597,25 +1770,21 @@ init_main_stash()
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
     errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
     GvMULTI_on(errgv);
-    sv_setpvn(GvSV(errgv), "", 0);
+    (void)form("%240s","");	/* Preallocate temp - for immediate signals. */
+    sv_grow(ERRSV, 240);	/* Preallocate - for immediate signals. */
+    sv_setpvn(ERRSV, "", 0);
     curstash = defstash;
     compiling.cop_stash = defstash;
     debstash = GvHV(gv_fetchpv("DB::", GV_ADDMULTI, SVt_PVHV));
+    globalstash = GvHV(gv_fetchpv("CORE::GLOBAL::", GV_ADDMULTI, SVt_PVHV));
     /* We must init $/ before switches are processed. */
     sv_setpvn(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), "\n", 1);
 }
 
-#ifdef CAN_PROTOTYPE
 static void
 open_script(char *scriptname, bool dosearch, SV *sv)
-#else
-static void
-open_script(scriptname,dosearch,sv)
-char *scriptname;
-bool dosearch;
-SV *sv;
-#endif
 {
+    dTHR;
     char *xfound = Nullch;
     char *xfailed = Nullch;
     register char *s;
@@ -1625,6 +1794,10 @@ SV *sv;
 #  define SEARCH_EXTS ".bat", ".cmd", NULL
 #  define MAX_EXT_LEN 4
 #endif
+#ifdef OS2
+#  define SEARCH_EXTS ".cmd", ".btm", ".bat", ".pl", NULL
+#  define MAX_EXT_LEN 4
+#endif
 #ifdef VMS
 #  define SEARCH_EXTS ".pl", ".com", NULL
 #  define MAX_EXT_LEN 4
@@ -1632,16 +1805,46 @@ SV *sv;
     /* additional extensions to try in each dir if scriptname not found */
 #ifdef SEARCH_EXTS
     char *ext[] = { SEARCH_EXTS };
-    int extidx = (strchr(scriptname,'.')) ? -1 : 0; /* has ext already */
+    int extidx = 0, i = 0;
+    char *curext = Nullch;
 #else
 #  define MAX_EXT_LEN 0
 #endif
 
+    /*
+     * If dosearch is true and if scriptname does not contain path
+     * delimiters, search the PATH for scriptname.
+     *
+     * If SEARCH_EXTS is also defined, will look for each
+     * scriptname{SEARCH_EXTS} whenever scriptname is not found
+     * while searching the PATH.
+     *
+     * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
+     * proceeds as follows:
+     *   If DOSISH or VMSISH:
+     *     + look for ./scriptname{,.foo,.bar}
+     *     + search the PATH for scriptname{,.foo,.bar}
+     *
+     *   If !DOSISH:
+     *     + look *only* in the PATH for scriptname{,.foo,.bar} (note
+     *       this will not look in '.' if it's not in the PATH)
+     */
+
 #ifdef VMS
+#  ifdef ALWAYS_DEFTYPES
+    len = strlen(scriptname);
+    if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') {
+	int hasdir, idx = 0, deftypes = 1;
+	bool seen_dot = 1;
+
+	hasdir = !dosearch || (strpbrk(scriptname,":[</") != Nullch) ;
+#  else
     if (dosearch) {
 	int hasdir, idx = 0, deftypes = 1;
+	bool seen_dot = 1;
 
 	hasdir = (strpbrk(scriptname,":[</") != Nullch) ;
+#  endif
 	/* The first time through, just add SEARCH_EXTS to whatever we
 	 * already have, so we can check for default file types. */
 	while (deftypes ||
@@ -1656,42 +1859,81 @@ SV *sv;
 		continue;	/* don't search dir with too-long name */
 	    strcat(tokenbuf, scriptname);
 #else  /* !VMS */
+
+#ifdef DOSISH
+    if (strEQ(scriptname, "-"))
+ 	dosearch = 0;
+    if (dosearch) {		/* Look in '.' first. */
+	char *cur = scriptname;
+#ifdef SEARCH_EXTS
+	if ((curext = strrchr(scriptname,'.')))	/* possible current ext */
+	    while (ext[i])
+		if (strEQ(ext[i++],curext)) {
+		    extidx = -1;		/* already has an ext */
+		    break;
+		}
+	do {
+#endif
+	    DEBUG_p(PerlIO_printf(Perl_debug_log,
+				  "Looking for %s\n",cur));
+	    if (PerlLIO_stat(cur,&statbuf) >= 0) {
+		dosearch = 0;
+		scriptname = cur;
+#ifdef SEARCH_EXTS
+		break;
+#endif
+	    }
+#ifdef SEARCH_EXTS
+	    if (cur == scriptname) {
+		len = strlen(scriptname);
+		if (len+MAX_EXT_LEN+1 >= sizeof(tokenbuf))
+		    break;
+		cur = strcpy(tokenbuf, scriptname);
+	    }
+	} while (extidx >= 0 && ext[extidx]	/* try an extension? */
+		 && strcpy(tokenbuf+len, ext[extidx++]));
+#endif
+    }
+#endif
+
     if (dosearch && !strchr(scriptname, '/')
 #ifdef DOSISH
 		 && !strchr(scriptname, '\\')
 #endif
-		 && (s = getenv("PATH"))) {
+		 && (s = PerlEnv_getenv("PATH"))) {
+	bool seen_dot = 0;
+	
 	bufend = s + strlen(s);
 	while (s < bufend) {
-#ifndef atarist
-	    s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
-#ifdef DOSISH
-			 ';',
-#else
-			 ':',
-#endif
-			 &len);
-#else  /* atarist */
-	    for (len = 0; *s && *s != ',' && *s != ';'; len++, s++) {
+#if defined(atarist) || defined(DOSISH)
+	    for (len = 0; *s
+#  ifdef atarist
+		    && *s != ','
+#  endif
+		    && *s != ';'; len++, s++) {
 		if (len < sizeof tokenbuf)
 		    tokenbuf[len] = *s;
 	    }
 	    if (len < sizeof tokenbuf)
 		tokenbuf[len] = '\0';
-#endif /* atarist */
+#else  /* ! (atarist || DOSISH) */
+	    s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf, s, bufend,
+			':',
+			&len);
+#endif /* ! (atarist || DOSISH) */
 	    if (s < bufend)
 		s++;
 	    if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tokenbuf)
 		continue;	/* don't search dir with too-long name */
 	    if (len
-#if defined(atarist) && !defined(DOSISH)
-		&& tokenbuf[len - 1] != '/'
-#endif
 #if defined(atarist) || defined(DOSISH)
+		&& tokenbuf[len - 1] != '/'
 		&& tokenbuf[len - 1] != '\\'
 #endif
 	       )
 		tokenbuf[len++] = '/';
+	    if (len == 2 && tokenbuf[0] == '.')
+		seen_dot = 1;
 	    (void)strcpy(tokenbuf + len, scriptname);
 #endif  /* !VMS */
 
@@ -1702,7 +1944,7 @@ SV *sv;
 	    do {
 #endif
 	    	DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tokenbuf));
-		retval = Stat(tokenbuf,&statbuf);
+		retval = PerlLIO_stat(tokenbuf,&statbuf);
 #ifdef SEARCH_EXTS
 	    } while (  retval < 0		/* not there */
 		    && extidx>=0 && ext[extidx]	/* try an extension? */
@@ -1724,8 +1966,16 @@ SV *sv;
 	    if (!xfailed)
 		xfailed = savepv(tokenbuf);
 	}
+#ifndef DOSISH
+	if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
+#endif
+	    seen_dot = 1;			/* Disable message. */
 	if (!xfound)
-	    croak("Can't execute %s", xfailed ? xfailed : scriptname );
+	    croak("Can't %s %s%s%s",
+		  (xfailed ? "execute" : "find"),
+		  (xfailed ? xfailed : scriptname),
+		  (xfailed ? "" : " on PATH"),
+		  (xfailed || seen_dot) ? "" : ", '.' not in PATH");
 	if (xfailed)
 	    Safefree(xfailed);
 	scriptname = xfound;
@@ -1746,7 +1996,7 @@ SV *sv;
     if (strEQ(origfilename,"-"))
 	scriptname = "";
     if (fdscript >= 0) {
-	rsfp = PerlIO_fdopen(fdscript,"r");
+	rsfp = PerlIO_fdopen(fdscript,PERL_SCRIPT_MODE);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
 	if (rsfp)
 	    fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
@@ -1821,7 +2071,7 @@ sed %s -e \"/^[^#]/b\" \
 		croak("Can't do seteuid!\n");
 	}
 #endif /* IAMSUID */
-	rsfp = my_popen(SvPVX(cmd), "r");
+	rsfp = PerlProc_popen(SvPVX(cmd), "r");
 	SvREFCNT_dec(cmd);
 	SvREFCNT_dec(cpp);
     }
@@ -1830,7 +2080,7 @@ sed %s -e \"/^[^#]/b\" \
 	rsfp = PerlIO_stdin();
     }
     else {
-	rsfp = PerlIO_open(scriptname,"r");
+	rsfp = PerlIO_open(scriptname,PERL_SCRIPT_MODE);
 #if defined(HAS_FCNTL) && defined(F_SETFD)
 	if (rsfp)
 	    fcntl(PerlIO_fileno(rsfp),F_SETFD,1);  /* ensure close-on-exec */
@@ -1842,10 +2092,10 @@ sed %s -e \"/^[^#]/b\" \
     if (!rsfp) {
 #ifdef DOSUID
 #ifndef IAMSUID		/* in case script is not readable before setuid */
-	if (euid && Stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
+	if (euid && PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&statbuf) >= 0 &&
 	  statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	    /* try again */
-	    execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+	    PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
 	    croak("Can't do setuid\n");
 	}
 #endif
@@ -1856,9 +2106,7 @@ sed %s -e \"/^[^#]/b\" \
 }
 
 static void
-validate_suid(validarg, scriptname)
-char *validarg;
-char *scriptname;
+validate_suid(char *validarg, char *scriptname)
 {
     int which;
 
@@ -1883,9 +2131,10 @@ char *scriptname;
      */
 
 #ifdef DOSUID
+    dTHR;
     char *s, *s2;
 
-    if (Fstat(PerlIO_fileno(rsfp),&statbuf) < 0)	/* normal stat is insecure */
+    if (PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf) < 0)	/* normal stat is insecure */
 	croak("Can't stat script \"%s\"",origfilename);
     if (fdscript < 0 && statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	I32 len;
@@ -1900,7 +2149,7 @@ char *scriptname;
 	 * But I don't think it's too important.  The manual lies when
 	 * it says access() is useful in setuid programs.
 	 */
-	if (access(SvPVX(GvSV(curcop->cop_filegv)),1))	/*double check*/
+	if (PerlLIO_access(SvPVX(GvSV(curcop->cop_filegv)),1))	/*double check*/
 	    croak("Permission denied");
 #else
 	/* If we can swap euid and uid, then we can determine access rights
@@ -1921,12 +2170,12 @@ char *scriptname;
 #endif
 		|| getuid() != euid || geteuid() != uid)
 		croak("Can't swap uid and euid");	/* really paranoid */
-	    if (Stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
+	    if (PerlLIO_stat(SvPVX(GvSV(curcop->cop_filegv)),&tmpstatbuf) < 0)
 		croak("Permission denied");	/* testing full pathname here */
 	    if (tmpstatbuf.st_dev != statbuf.st_dev ||
 		tmpstatbuf.st_ino != statbuf.st_ino) {
 		(void)PerlIO_close(rsfp);
-		if (rsfp = my_popen("/bin/mail root","w")) {	/* heh, heh */
+		if (rsfp = PerlProc_popen("/bin/mail root","w")) {	/* heh, heh */
 		    PerlIO_printf(rsfp,
 "User %ld tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
 (Filename of set-id script was %s, uid %ld gid %ld.)\n\nSincerely,\nperl\n",
@@ -1934,7 +2183,7 @@ char *scriptname;
 			(long)statbuf.st_dev, (long)statbuf.st_ino,
 			SvPVX(GvSV(curcop->cop_filegv)),
 			(long)statbuf.st_uid, (long)statbuf.st_gid);
-		    (void)my_pclose(rsfp);
+		    (void)PerlProc_pclose(rsfp);
 		}
 		croak("Permission denied\n");
 	    }
@@ -1993,7 +2242,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	    (void)PerlIO_close(rsfp);
 #ifndef IAMSUID
 	    /* try again */
-	    execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
+	    PerlProc_execv(form("%s/sperl%s", BIN_EXP, patchlevel), origargv);
 #endif
 	    croak("Can't do setuid\n");
 	}
@@ -2066,7 +2315,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     /* exec the real perl, substituting fd script for scriptname. */
     /* (We pass script name as "subdir" of fd, which perl will grok.) */
     PerlIO_rewind(rsfp);
-    lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
+    PerlLIO_lseek(PerlIO_fileno(rsfp),(Off_t)0,0);  /* just in case rewind didn't */
     for (which = 1; origargv[which] && origargv[which] != scriptname; which++) ;
     if (!origargv[which])
 	croak("Permission denied");
@@ -2075,13 +2324,14 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(rsfp),F_SETFD,0);	/* ensure no close-on-exec */
 #endif
-    execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv);	/* try again */
+    PerlProc_execv(form("%s/perl%s", BIN_EXP, patchlevel), origargv);	/* try again */
     croak("Can't do setuid\n");
 #endif /* IAMSUID */
 #else /* !DOSUID */
     if (euid != uid || egid != gid) {	/* (suidperl doesn't exist, in fact) */
 #ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
-	Fstat(PerlIO_fileno(rsfp),&statbuf);	/* may be either wrapped or real suid */
+	dTHR;
+	PerlLIO_fstat(PerlIO_fileno(rsfp),&statbuf);	/* may be either wrapped or real suid */
 	if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
 	    ||
 	    (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
@@ -2096,7 +2346,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 }
 
 static void
-find_beginning()
+find_beginning(void)
 {
     register char *s, *s2;
 
@@ -2118,14 +2368,14 @@ find_beginning()
 		    /*SUPPRESS 530*/
 		    while (s = moreswitches(s)) ;
 	    }
-	    if (cddir && chdir(cddir) < 0)
+	    if (cddir && PerlDir_chdir(cddir) < 0)
 		croak("Can't chdir to %s",cddir);
 	}
     }
 }
 
 static void
-init_ids()
+init_ids(void)
 {
     uid = (int)getuid();
     euid = (int)geteuid();
@@ -2139,8 +2389,7 @@ init_ids()
 }
 
 static void
-forbid_setid(s)
-char *s;
+forbid_setid(char *s)
 {
     if (euid != uid)
         croak("No %s allowed while running setuid", s);
@@ -2149,8 +2398,9 @@ char *s;
 }
 
 static void
-init_debugger()
+init_debugger(void)
 {
+    dTHR;
     curstash = debstash;
     dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(dbargs);
@@ -2166,30 +2416,30 @@ init_debugger()
     curstash = defstash;
 }
 
-static void
-init_stacks()
+#ifndef STRESS_REALLOC
+#define REASONABLE(size) (size)
+#else
+#define REASONABLE(size) (1) /* unreasonable */
+#endif
+
+void
+init_stacks(ARGSproto)
 {
-    curstack = newAV();
+    /* start with 128-item stack and 8K cxstack */
+    curstackinfo = new_stackinfo(REASONABLE(128),
+				 REASONABLE(8192/sizeof(PERL_CONTEXT) - 1));
+    curstackinfo->si_type = SI_MAIN;
+    curstack = curstackinfo->si_stack;
     mainstack = curstack;		/* remember in case we switch stacks */
-    AvREAL_off(curstack);		/* not a real array */
-    av_extend(curstack,127);
 
     stack_base = AvARRAY(curstack);
     stack_sp = stack_base;
-    stack_max = stack_base + 127;
-
-    cxstack_max = 8192 / sizeof(CONTEXT) - 2;	/* Use most of 8K. */
-    New(50,cxstack,cxstack_max + 1,CONTEXT);
-    cxstack_ix	= -1;
+    stack_max = stack_base + AvMAX(curstack);
 
-    New(50,tmps_stack,128,SV*);
+    New(50,tmps_stack,REASONABLE(128),SV*);
+    tmps_floor = -1;
     tmps_ix = -1;
-    tmps_max = 128;
-
-    DEBUG( {
-	New(51,debname,128,char);
-	New(52,debdelim,128,char);
-    } )
+    tmps_max = REASONABLE(128);
 
     /*
      * The following stacks almost certainly should be per-interpreter,
@@ -2199,40 +2449,53 @@ init_stacks()
     if (markstack) {
 	markstack_ptr = markstack;
     } else {
-	New(54,markstack,64,I32);
+	New(54,markstack,REASONABLE(32),I32);
 	markstack_ptr = markstack;
-	markstack_max = markstack + 64;
+	markstack_max = markstack + REASONABLE(32);
     }
 
+    SET_MARKBASE;
+
     if (scopestack) {
 	scopestack_ix = 0;
     } else {
-	New(54,scopestack,32,I32);
+	New(54,scopestack,REASONABLE(32),I32);
 	scopestack_ix = 0;
-	scopestack_max = 32;
+	scopestack_max = REASONABLE(32);
     }
 
     if (savestack) {
 	savestack_ix = 0;
     } else {
-	New(54,savestack,128,ANY);
+	New(54,savestack,REASONABLE(128),ANY);
 	savestack_ix = 0;
-	savestack_max = 128;
+	savestack_max = REASONABLE(128);
     }
 
     if (retstack) {
 	retstack_ix = 0;
     } else {
-	New(54,retstack,16,OP*);
+	New(54,retstack,REASONABLE(16),OP*);
 	retstack_ix = 0;
-	retstack_max = 16;
+	retstack_max = REASONABLE(16);
     }
 }
 
+#undef REASONABLE
+
 static void
-nuke_stacks()
+nuke_stacks(void)
 {
-    Safefree(cxstack);
+    dTHR;
+    while (curstackinfo->si_next)
+	curstackinfo = curstackinfo->si_next;
+    while (curstackinfo) {
+	PERL_SI *p = curstackinfo->si_prev;
+	SvREFCNT_dec(curstackinfo->si_stack);
+	Safefree(curstackinfo->si_cxstack);
+	Safefree(curstackinfo);
+	curstackinfo = p;
+    }
     Safefree(tmps_stack);
     DEBUG( {
 	Safefree(debname);
@@ -2243,22 +2506,23 @@ nuke_stacks()
 static PerlIO *tmpfp;  /* moved outside init_lexer() because of UNICOS bug */
 
 static void
-init_lexer()
+init_lexer(void)
 {
     tmpfp = rsfp;
+    rsfp = Nullfp;
     lex_start(linestr);
     rsfp = tmpfp;
     subname = newSVpv("main",4);
 }
 
 static void
-init_predump_symbols()
+init_predump_symbols(void)
 {
+    dTHR;
     GV *tmpgv;
     GV *othergv;
 
-    sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
-
+    sv_setpvn(perl_get_sv("\"", TRUE), " ", 1);
     stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(stdingv);
     IoIFP(GvIOp(stdingv)) = PerlIO_stdin();
@@ -2288,11 +2552,9 @@ init_predump_symbols()
 }
 
 static void
-init_postdump_symbols(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
+init_postdump_symbols(register int argc, register char **argv, register char **env)
 {
+    dTHR;
     char *s;
     SV *sv;
     GV* tmpgv;
@@ -2356,7 +2618,7 @@ register char **env;
 	    if (!(s = strchr(*env,'=')))
 		continue;
 	    *s++ = '\0';
-#ifdef WIN32
+#if defined(WIN32) || defined(MSDOS)
 	    (void)strupr(*env);
 #endif
 	    sv = newSVpv(s--,0);
@@ -2364,7 +2626,7 @@ register char **env;
 	    *s = '=';
 #if defined(__BORLANDC__) && defined(USE_WIN32_RTL_ENV)
 	    /* Sins of the RTL. See note in my_setenv(). */
-	    (void)putenv(savepv(*env));
+	    (void)PerlEnv_putenv(savepv(*env));
 #endif
 	}
 #endif
@@ -2378,16 +2640,16 @@ register char **env;
 }
 
 static void
-init_perllib()
+init_perllib(void)
 {
     char *s;
     if (!tainting) {
 #ifndef VMS
-	s = getenv("PERL5LIB");
+	s = PerlEnv_getenv("PERL5LIB");
 	if (s)
 	    incpush(s, TRUE);
 	else
-	    incpush(getenv("PERLLIB"), FALSE);
+	    incpush(PerlEnv_getenv("PERLLIB"), FALSE);
 #else /* VMS */
 	/* Treat PERL5?LIB as a possible search list logical name -- the
 	 * "natural" VMS idiom for a Unix path string.  We allow each
@@ -2403,7 +2665,7 @@ init_perllib()
     }
 
 /* Use the ~-expanded versions of APPLLIB (undocumented),
-    ARCHLIB PRIVLIB SITEARCH SITELIB and OLDARCHLIB
+    ARCHLIB PRIVLIB SITEARCH and SITELIB 
 */
 #ifdef APPLLIB_EXP
     incpush(APPLLIB_EXP, FALSE);
@@ -2423,10 +2685,6 @@ init_perllib()
 #ifdef SITELIB_EXP
     incpush(SITELIB_EXP, FALSE);
 #endif
-#ifdef OLDARCHLIB_EXP  /* 5.00[01] compatibility */
-    incpush(OLDARCHLIB_EXP, FALSE);
-#endif
-    
     if (!tainting)
 	incpush(".", FALSE);
 }
@@ -2445,9 +2703,7 @@ init_perllib()
 #endif 
 
 static void
-incpush(p, addsubdirs)
-char *p;
-int addsubdirs;
+incpush(char *p, int addsubdirs)
 {
     SV *subdir = Nullsv;
     static char *archpat_auto;
@@ -2456,7 +2712,7 @@ int addsubdirs;
 	return;
 
     if (addsubdirs) {
-	subdir = newSV(0);
+	subdir = NEWSV(55,0);
 	if (!archpat_auto) {
 	    STRLEN len = (sizeof(ARCHNAME) + strlen(patchlevel)
 			  + sizeof("//auto"));
@@ -2472,7 +2728,7 @@ int addsubdirs;
 
     /* Break at all separators */
     while (p && *p) {
-	SV *libdir = newSV(0);
+	SV *libdir = NEWSV(55,0);
 	char *s;
 
 	/* skip any consecutive separators */
@@ -2515,7 +2771,7 @@ int addsubdirs;
 	    /* .../archname/version if -d .../archname/version/auto */
 	    sv_setsv(subdir, libdir);
 	    sv_catpv(subdir, archpat_auto);
-	    if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
 		  S_ISDIR(tmpstatbuf.st_mode))
 		av_push(GvAVn(incgv),
 			newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
@@ -2523,7 +2779,7 @@ int addsubdirs;
 	    /* .../archname if -d .../archname/auto */
 	    sv_insert(subdir, SvCUR(libdir) + sizeof(ARCHNAME),
 		      strlen(patchlevel) + 1, "", 0);
-	    if (Stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
+	    if (PerlLIO_stat(SvPVX(subdir), &tmpstatbuf) >= 0 &&
 		  S_ISDIR(tmpstatbuf.st_mode))
 		av_push(GvAVn(incgv),
 			newSVpv(SvPVX(subdir), SvCUR(subdir) - sizeof "auto"));
@@ -2536,17 +2792,81 @@ int addsubdirs;
     SvREFCNT_dec(subdir);
 }
 
+#ifdef USE_THREADS
+static struct perl_thread *
+init_main_thread()
+{
+    struct perl_thread *thr;
+    XPV *xpv;
+
+    Newz(53, thr, 1, struct perl_thread);
+    curcop = &compiling;
+    thr->cvcache = newHV();
+    thr->threadsv = newAV();
+    /* thr->threadsvp is set when find_threadsv is called */
+    thr->specific = newAV();
+    thr->errhv = newHV();
+    thr->flags = THRf_R_JOINABLE;
+    MUTEX_INIT(&thr->mutex);
+    /* Handcraft thrsv similarly to mess_sv */
+    New(53, thrsv, 1, SV);
+    Newz(53, xpv, 1, XPV);
+    SvFLAGS(thrsv) = SVt_PV;
+    SvANY(thrsv) = (void*)xpv;
+    SvREFCNT(thrsv) = 1 << 30;	/* practically infinite */
+    SvPVX(thrsv) = (char*)thr;
+    SvCUR_set(thrsv, sizeof(thr));
+    SvLEN_set(thrsv, sizeof(thr));
+    *SvEND(thrsv) = '\0';	/* in the trailing_nul field */
+    thr->oursv = thrsv;
+    curcop = &compiling;
+    chopset = " \n-";
+
+    MUTEX_LOCK(&threads_mutex);
+    nthreads++;
+    thr->tid = 0;
+    thr->next = thr;
+    thr->prev = thr;
+    MUTEX_UNLOCK(&threads_mutex);
+
+#ifdef HAVE_THREAD_INTERN
+    init_thread_intern(thr);
+#endif
+
+#ifdef SET_THREAD_SELF
+    SET_THREAD_SELF(thr);
+#else
+    thr->self = pthread_self();
+#endif /* SET_THREAD_SELF */
+    SET_THR(thr);
+
+    /*
+     * These must come after the SET_THR because sv_setpvn does
+     * SvTAINT and the taint fields require dTHR.
+     */
+    toptarget = NEWSV(0,0);
+    sv_upgrade(toptarget, SVt_PVFM);
+    sv_setpvn(toptarget, "", 0);
+    bodytarget = NEWSV(0,0);
+    sv_upgrade(bodytarget, SVt_PVFM);
+    sv_setpvn(bodytarget, "", 0);
+    formtarget = bodytarget;
+    thr->errsv = newSVpv("", 0);
+    (void) find_threadsv("@");	/* Ensure $@ is initialised early */
+    return thr;
+}
+#endif /* USE_THREADS */
+
 void
-call_list(oldscope, list)
-I32 oldscope;
-AV* list;
+call_list(I32 oldscope, AV *list)
 {
+    dTHR;
     line_t oldline = curcop->cop_line;
     STRLEN len;
     dJMPENV;
     int ret;
 
-    while (AvFILL(list) >= 0) {
+    while (AvFILL(list) >= 0) { 
 	CV *cv = (CV*)av_shift(list);
 
 	SAVEFREESV(cv);
@@ -2554,7 +2874,7 @@ AV* list;
 	JMPENV_PUSH(ret);
 	switch (ret) {
 	case 0: {
-		SV* atsv = GvSV(errgv);
+		SV* atsv = ERRSV;
 		PUSHMARK(stack_sp);
 		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
 		(void)SvPV(atsv, len);
@@ -2579,10 +2899,10 @@ AV* list;
 	    /* my_exit() was called */
 	    while (scopestack_ix > oldscope)
 		LEAVE;
+	    FREETMPS;
 	    curstash = defstash;
 	    if (endav)
 		call_list(oldscope, endav);
-	    FREETMPS;
 	    JMPENV_POP;
 	    curcop = &compiling;
 	    curcop->cop_line = oldline;
@@ -2610,9 +2930,14 @@ AV* list;
 }
 
 void
-my_exit(status)
-U32 status;
+my_exit(U32 status)
 {
+    dTHR;
+
+#ifdef USE_THREADS
+    DEBUG_L(PerlIO_printf(Perl_debug_log, "my_exit: thread %p, status %lu\n",
+			  thr, (unsigned long) status));
+#endif /* USE_THREADS */
     switch (status) {
     case 0:
 	STATUS_ALL_SUCCESS;
@@ -2628,7 +2953,7 @@ U32 status;
 }
 
 void
-my_failure_exit()
+my_failure_exit(void)
 {
 #ifdef VMS
     if (vaxc$errno & 1) {
@@ -2651,9 +2976,10 @@ my_failure_exit()
 }
 
 static void
-my_exit_jump()
+my_exit_jump(void)
 {
-    register CONTEXT *cx;
+    dTHR;
+    register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
 
@@ -2676,3 +3002,6 @@ my_exit_jump()
 
     JMPENV_JUMP(2);
 }
+
+
+