X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=8f4525e48c994dcdcf26f1a9cf06ac4f8f406469;hb=565764a853a177193a027e73655fad354d57fc10;hp=3db7f175ff55d85c26345d9c496ce53e71b188f2;hpb=d55594aef6b1fb9e305275c3d19a25e4cdfb2cda;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 3db7f17..8f4525e 100644
--- a/perl.c
+++ b/perl.c
@@ -62,6 +62,7 @@ dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
     mess_sv     = Nullsv;	\
   } STMT_END
 
+#ifndef PERL_OBJECT
 static void find_beginning _((void));
 static void forbid_setid _((char *));
 static void incpush _((char *, int));
@@ -70,7 +71,7 @@ static void init_debugger _((void));
 static void init_lexer _((void));
 static void init_main_stash _((void));
 #ifdef USE_THREADS
-static struct thread * init_main_thread _((void));
+static struct perl_thread * init_main_thread _((void));
 #endif /* USE_THREADS */
 static void init_perllib _((void));
 static void init_postdump_symbols _((int, char **, char **));
@@ -80,15 +81,16 @@ static void nuke_stacks _((void));
 static void open_script _((char *, bool, SV *));
 static void usage _((char *));
 static void validate_suid _((char *, char*));
+#endif
 
 static int fdscript = -1;
 
 #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
 #include <asm/sigcontext.h>
-static void
+STATIC void
 catch_sigsegv(int signo, struct sigcontext_struct sc)
 {
-    signal(SIGSEGV, SIG_DFL);
+    PerlProc_signal(SIGSEGV, SIG_DFL);
     fprintf(stderr, "Segmentation fault dereferencing 0x%lx\n"
 		    "return_address = 0x%lx, eip = 0x%lx\n",
 	    	    sc.cr2, __builtin_return_address(0), sc.eip);
@@ -96,8 +98,19 @@ catch_sigsegv(int signo, struct sigcontext_struct sc)
 }
 #endif
 
+#ifdef PERL_OBJECT
+CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
+					     IPerlLIO* ipLIO, IPerlDir* ipD, IPerlSock* ipS, IPerlProc* ipP)
+{
+	CPerlObj* pPerl = new(ipM) CPerlObj(ipM, ipE, ipStd, ipLIO, ipD, ipS, ipP);
+	if(pPerl != NULL)
+		pPerl->Init();
+
+	return pPerl;
+}
+#else
 PerlInterpreter *
-perl_alloc()
+perl_alloc(void)
 {
     PerlInterpreter *sv_interp;
 
@@ -105,20 +118,26 @@ perl_alloc()
     New(53, sv_interp, 1, PerlInterpreter);
     return sv_interp;
 }
+#endif
 
 void
-perl_construct( sv_interp )
-register PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_construct(void)
+#else
+perl_construct(register PerlInterpreter *sv_interp)
+#endif
 {
 #ifdef USE_THREADS
     int i;
 #ifndef FAKE_THREADS
-    struct thread *thr;
+    struct perl_thread *thr;
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
     
+#ifndef PERL_OBJECT
     if (!(curinterp = sv_interp))
 	return;
+#endif
 
 #ifdef MULTIPLICITY
     Zero(sv_interp, 1, PerlInterpreter);
@@ -135,7 +154,6 @@ register PerlInterpreter *sv_interp;
 	if (pthread_key_create(&thr_key, 0))
 	    croak("panic: pthread_key_create");
 #endif
-	MUTEX_INIT(&malloc_mutex);
 	MUTEX_INIT(&sv_mutex);
 	/*
 	 * Safe to use basic SV functions from now on (though
@@ -145,7 +163,7 @@ register PerlInterpreter *sv_interp;
 	COND_INIT(&eval_cond);
 	MUTEX_INIT(&threads_mutex);
 	COND_INIT(&nthreads_cond);
-	
+
 	thr = init_main_thread();
 #endif /* USE_THREADS */
 
@@ -167,7 +185,12 @@ register PerlInterpreter *sv_interp;
 	nrs = newSVpv("\n", 1);
 	rs = SvREFCNT_inc(nrs);
 
+#ifdef PERL_OBJECT
+	/* TODO: */
+	/* sighandlerp = sighandler; */
+#else
 	sighandlerp = sighandler;
+#endif
 	pidstatus = newHV();
 
 #ifdef MSDOS
@@ -226,8 +249,11 @@ register PerlInterpreter *sv_interp;
 }
 
 void
-perl_destruct(sv_interp)
-register PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_destruct(void)
+#else
+perl_destruct(register PerlInterpreter *sv_interp)
+#endif
 {
     dTHR;
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
@@ -237,8 +263,10 @@ register PerlInterpreter *sv_interp;
     Thread t;
 #endif /* USE_THREADS */
 
+#ifndef PERL_OBJECT
     if (!(curinterp = sv_interp))
 	return;
+#endif
 
 #ifdef USE_THREADS
 #ifndef FAKE_THREADS
@@ -314,7 +342,7 @@ register PerlInterpreter *sv_interp;
 #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;
@@ -420,36 +448,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;
@@ -474,8 +472,7 @@ register PerlInterpreter *sv_interp;
     envgv = Nullgv;
     siggv = Nullgv;
     incgv = Nullgv;
-    errhv = Nullhv;
-    errsv = Nullsv;
+    errgv = Nullgv;
     argvgv = Nullgv;
     argvoutgv = Nullgv;
     stdingv = Nullgv;
@@ -562,7 +559,6 @@ register PerlInterpreter *sv_interp;
     DEBUG_P(debprofdump());
 #ifdef USE_THREADS
     MUTEX_DESTROY(&sv_mutex);
-    MUTEX_DESTROY(&malloc_mutex);
     MUTEX_DESTROY(&eval_mutex);
     COND_DESTROY(&eval_cond);
 
@@ -586,21 +582,27 @@ register PerlInterpreter *sv_interp;
 }
 
 void
-perl_free(sv_interp)
-PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_free(void)
+#else
+perl_free(PerlInterpreter *sv_interp)
+#endif
 {
+#ifdef PERL_OBJECT
+	Safefree(this);
+#else
     if (!(curinterp = sv_interp))
 	return;
     Safefree(sv_interp);
+#endif
 }
 
 int
-perl_parse(sv_interp, xsinit, argc, argv, env)
-PerlInterpreter *sv_interp;
-void (*xsinit)_((void));
-int argc;
-char **argv;
-char **env;
+#ifdef PERL_OBJECT
+CPerlObj::perl_parse(void (*xsinit) (CPerlObj*), int argc, char **argv, char **env)
+#else
+perl_parse(PerlInterpreter *sv_interp, void (*xsinit) (void), int argc, char **argv, char **env)
+#endif
 {
     dTHR;
     register SV *sv;
@@ -621,8 +623,10 @@ setuid perl scripts securely.\n");
 #endif
 #endif
 
+#ifndef PERL_OBJECT
     if (!(curinterp = sv_interp))
 	return 255;
+#endif
 
 #if defined(NeXT) && defined(__DYNAMIC__)
     _dyld_lookup_and_bind
@@ -730,7 +734,7 @@ setuid perl scripts securely.\n");
 		croak("No -e allowed in setuid scripts");
 	    if (!e_fp) {
 	        e_tmpname = savepv(TMPPATH);
-		(void)mktemp(e_tmpname);
+		(void)PerlLIO_mktemp(e_tmpname);
 		if (!*e_tmpname)
 		    croak("Can't mktemp()");
 		e_fp = PerlIO_open(e_tmpname,"w");
@@ -862,7 +866,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     }
   switch_end:
 
-    if (!tainting && (s = getenv("PERL5OPT"))) {
+    if (!tainting && (s = PerlEnv_getenv("PERL5OPT"))) {
 	while (s && *s) {
 	    while (isSPACE(*s))
 		s++;
@@ -894,7 +898,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 = "-";
@@ -936,14 +940,17 @@ print \"  \\@INC:\\n    @INC\\n\";");
     CvPADLIST(compcv) = comppadlist;
 
     boot_core_UNIVERSAL();
+#if defined(WIN32) && defined(PERL_OBJECT)
+	BootDynaLoader();
+#endif
     if (xsinit)
-	(*xsinit)();	/* in case linked C routines want magical variables */
-#if defined(VMS) || defined(WIN32)
+	(*xsinit)(THIS);	/* in case linked C routines want magical variables */
+#if defined(VMS) || defined(WIN32) || defined(DJGPP)
     init_os_extras();
 #endif
 
 #if defined(DEBUGGING) && defined(USE_THREADS) && defined(__linux__)
-    DEBUG_L(signal(SIGSEGV, (void(*)(int))catch_sigsegv););
+    DEBUG_L(PerlProc_signal(SIGSEGV, (void(*)(int))catch_sigsegv););
 #endif
 
     init_predump_symbols();
@@ -954,6 +961,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 
     /* now parse the script */
 
+    SETERRNO(0,SS$_NORMAL);
     error_count = 0;
     if (yyparse() || error_count) {
 	if (minus_c)
@@ -976,7 +984,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     SvREFCNT_dec(rs);
     rs = SvREFCNT_inc(nrs);
 #ifdef USE_THREADS
-    sv_setsv(*av_fetch(thr->magicals, find_thread_magical("/"), FALSE), rs); 
+    sv_setsv(*av_fetch(thr->threadsv, find_threadsv("/"), FALSE), rs); 
 #else
     sv_setsv(GvSV(gv_fetchpv("/", TRUE, SVt_PV)), rs);
 #endif /* USE_THREADS */
@@ -990,7 +998,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     FREETMPS;
 
 #ifdef MYMALLOC
-    if ((s=getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
+    if ((s=PerlEnv_getenv("PERL_DEBUG_MSTATS")) && atoi(s) >= 2)
 	dump_mstats("after compilation:");
 #endif
 
@@ -1001,16 +1009,21 @@ print \"  \\@INC:\\n    @INC\\n\";");
 }
 
 int
-perl_run(sv_interp)
-PerlInterpreter *sv_interp;
+#ifdef PERL_OBJECT
+CPerlObj::perl_run(void)
+#else
+perl_run(PerlInterpreter *sv_interp)
+#endif
 {
     dTHR;
     I32 oldscope;
     dJMPENV;
     int ret;
 
+#ifndef PERL_OBJECT
     if (!(curinterp = sv_interp))
 	return 255;
+#endif
 
     oldscope = scopestack_ix;
 
@@ -1028,7 +1041,7 @@ PerlInterpreter *sv_interp;
 	if (endav)
 	    call_list(oldscope, endav);
 #ifdef MYMALLOC
-	if (getenv("PERL_DEBUG_MSTATS"))
+	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
 	JMPENV_POP;
@@ -1073,12 +1086,12 @@ PerlInterpreter *sv_interp;
     if (restartop) {
 	op = restartop;
 	restartop = 0;
-	runops();
+	CALLRUNOPS();
     }
     else if (main_start) {
 	CvDEPTH(main_cv) = 1;
 	op = main_start;
-	runops();
+	CALLRUNOPS();
     }
 
     my_exit(0);
@@ -1087,20 +1100,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 *av_fetch(thr->threadsv, tmp, FALSE);
+	}
+    }
+#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)
@@ -1111,9 +1130,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)
@@ -1124,9 +1141,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))
@@ -1142,12 +1157,11 @@ 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 */
 {
-    dTHR;
     dSP;
 
     PUSHMARK(sp);
@@ -1158,23 +1172,22 @@ 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 */
 {
-    dTHR;
     dSP;
     OP myop;
     if (!op)
@@ -1187,9 +1200,9 @@ I32 flags;		/* See G_* flags in cop.h */
 
 /* 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 */
 {
     dTHR;
     LOGOP myop;		/* fake syntax tree node */
@@ -1236,7 +1249,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;
@@ -1251,7 +1264,7 @@ I32 flags;		/* See G_* flags in cop.h */
 	    if (flags & G_KEEPERR)
 		in_eval |= 4;
 	    else
-		sv_setpv(errsv,"");
+		sv_setpv(ERRSV,"");
 	}
 	markstack_ptr++;
 
@@ -1293,10 +1306,10 @@ I32 flags;		/* See G_* flags in cop.h */
     if (op == (OP*)&myop)
 	op = pp_entersub(ARGS);
     if (op)
-	runops();
+	CALLRUNOPS();
     retval = stack_sp - (stack_base + oldmark);
     if ((flags & G_EVAL) && !(flags & G_KEEPERR))
-	sv_setpv(errsv,"");
+	sv_setpv(ERRSV,"");
 
   cleanup:
     if (flags & G_EVAL) {
@@ -1304,7 +1317,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);
@@ -1331,9 +1344,9 @@ 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 */
 {
     dTHR;
     UNOP myop;		/* fake syntax tree node */
@@ -1402,10 +1415,10 @@ I32 flags;		/* See G_* flags in cop.h */
     if (op == (OP*)&myop)
 	op = pp_entereval(ARGS);
     if (op)
-	runops();
+	CALLRUNOPS();
     retval = stack_sp - (stack_base + oldmark);
     if (!(flags & G_KEEPERR))
-	sv_setpv(errsv,"");
+	sv_setpv(ERRSV,"");
 
   cleanup:
     JMPENV_POP;
@@ -1420,11 +1433,8 @@ I32 flags;		/* See G_* flags in cop.h */
 }
 
 SV*
-perl_eval_pv(p, croak_on_error)
-char* p;
-I32 croak_on_error;
+perl_eval_pv(char *p, I32 croak_on_error)
 {
-    dTHR;
     dSP;
     SV* sv = newSVpv(p, 0);
 
@@ -1436,8 +1446,8 @@ I32 croak_on_error;
     sv = POPs;
     PUTBACK;
 
-    if (croak_on_error && SvTRUE(errsv))
-	croak(SvPV(errsv, na));
+    if (croak_on_error && SvTRUE(ERRSV))
+	croak(SvPVx(ERRSV, na));
 
     return sv;
 }
@@ -1445,8 +1455,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 '");
@@ -1456,10 +1465,7 @@ char* pv;
 }
 
 void
-magicname(sym,name,namlen)
-char *sym;
-char *name;
-I32 namlen;
+magicname(char *sym, char *name, I32 namlen)
 {
     register GV *gv;
 
@@ -1467,14 +1473,14 @@ I32 namlen;
 	sv_magic(GvSV(gv), (SV*)gv, 0, name, namlen);
 }
 
-static void
-usage(name)		/* XXX move this out into a module ? */
-char *name;
+STATIC void
+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[] = {
+    static char *usage_msg[] = {
 "-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)",
@@ -1501,7 +1507,7 @@ char *name;
 "\n",
 NULL
 };
-    char **p = usage;
+    char **p = usage_msg;
 
     printf("\nUsage: %s [switches] [--] [programfile] [arguments]", name);
     while (*p)
@@ -1511,8 +1517,7 @@ NULL
 /* This routine handles any switches that can be given during run */
 
 char *
-moreswitches(s)
-char *s;
+moreswitches(char *s)
 {
     I32 numlen;
     U32 rschar;
@@ -1581,7 +1586,7 @@ char *s;
 	return s;
     case 'h':
 	usage(origargv[0]);    
-	exit(0);
+	PerlProc_exit(0);
     case 'i':
 	if (inplace)
 	    Safefree(inplace);
@@ -1711,6 +1716,7 @@ char *s;
 #endif
 #ifdef DJGPP
 	printf("djgpp v2 port (jpl5003c) by Hirofumi Watanabe, 1996\n");
+	printf("djgpp v2 port (perl5004) by Laszlo Molnar, 1997\n");
 #endif
 #ifdef OS2
 	printf("\n\nOS/2 port Copyright (c) 1990, 1991, Raymond Chen, Kai Uwe Rommel\n"
@@ -1722,7 +1728,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++;
@@ -1734,6 +1740,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;
@@ -1756,7 +1765,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;
@@ -1773,7 +1782,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>
@@ -1784,8 +1793,8 @@ my_unexec()
 #endif
 }
 
-static void
-init_main_stash()
+STATIC void
+init_main_stash(void)
 {
     dTHR;
     GV *gv;
@@ -1808,23 +1817,24 @@ init_main_stash()
     incgv = gv_HVadd(gv_AVadd(gv_fetchpv("INC",TRUE, SVt_PVAV)));
     GvMULTI_on(incgv);
     defgv = gv_fetchpv("_",TRUE, SVt_PVAV);
-    errsv = newSVpv("", 0);
-    errhv = newHV();
+    errgv = gv_HVadd(gv_fetchpv("@", TRUE, SVt_PV));
+    GvMULTI_on(errgv);
     (void)form("%240s","");	/* Preallocate temp - for immediate signals. */
-    sv_grow(errsv, 240);	/* Preallocate - for immediate signals. */
-    sv_setpvn(errsv, "", 0);
+    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
+STATIC void
 open_script(char *scriptname, bool dosearch, SV *sv)
 #else
-static void
+STATIC void
 open_script(scriptname,dosearch,sv)
 char *scriptname;
 bool dosearch;
@@ -1868,7 +1878,7 @@ SV *sv;
      *
      * Assuming SEARCH_EXTS is C<".foo",".bar",NULL>, PATH search
      * proceeds as follows:
-     *   If DOSISH:
+     *   If DOSISH or VMSISH:
      *     + look for ./scriptname{,.foo,.bar}
      *     + search the PATH for scriptname{,.foo,.bar}
      *
@@ -1878,11 +1888,20 @@ SV *sv;
      */
 
 #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 ||
@@ -1914,7 +1933,7 @@ SV *sv;
 #endif
 	    DEBUG_p(PerlIO_printf(Perl_debug_log,
 				  "Looking for %s\n",cur));
-	    if (Stat(cur,&statbuf) >= 0) {
+	    if (PerlLIO_stat(cur,&statbuf) >= 0) {
 		dosearch = 0;
 		scriptname = cur;
 #ifdef SEARCH_EXTS
@@ -1938,7 +1957,7 @@ SV *sv;
 #ifdef DOSISH
 		 && !strchr(scriptname, '\\')
 #endif
-		 && (s = getenv("PATH"))) {
+		 && (s = PerlEnv_getenv("PATH"))) {
 	bool seen_dot = 0;
 	
 	bufend = s + strlen(s);
@@ -1982,7 +2001,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? */
@@ -2005,7 +2024,7 @@ SV *sv;
 		xfailed = savepv(tokenbuf);
 	}
 #ifndef DOSISH
-	if (!xfound && !seen_dot && !xfailed && (Stat(scriptname,&statbuf) < 0))
+	if (!xfound && !seen_dot && !xfailed && (PerlLIO_stat(scriptname,&statbuf) < 0))
 #endif
 	    seen_dot = 1;			/* Disable message. */
 	if (!xfound)
@@ -2034,7 +2053,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 */
@@ -2101,15 +2120,15 @@ sed %s -e \"/^[^#]/b\" \
 #ifdef HAS_SETRESUID
 	    (void)setresuid((Uid_t)-1, uid, (Uid_t)-1);
 #else
-	    setuid(uid);
+	    PerlProc_setuid(uid);
 #endif
 #endif
 #endif
-	    if (geteuid() != uid)
+	    if (PerlProc_geteuid() != uid)
 		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);
     }
@@ -2118,7 +2137,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 */
@@ -2130,10 +2149,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
@@ -2143,10 +2162,8 @@ sed %s -e \"/^[^#]/b\" \
     }
 }
 
-static void
-validate_suid(validarg, scriptname)
-char *validarg;
-char *scriptname;
+STATIC void
+validate_suid(char *validarg, char *scriptname)
 {
     int which;
 
@@ -2174,7 +2191,7 @@ char *scriptname;
     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;
@@ -2189,7 +2206,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
@@ -2208,14 +2225,14 @@ char *scriptname;
 		setresuid(euid,uid,(Uid_t)-1) < 0
 # endif
 #endif
-		|| getuid() != euid || geteuid() != uid)
+		|| PerlProc_getuid() != euid || PerlProc_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",
@@ -2223,7 +2240,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");
 	    }
@@ -2235,7 +2252,7 @@ char *scriptname;
               setresuid(uid,euid,(Uid_t)-1) < 0
 # endif
 #endif
-              || getuid() != uid || geteuid() != euid)
+              || PerlProc_getuid() != uid || PerlProc_geteuid() != euid)
 		croak("Can't reswap uid and euid");
 	    if (!cando(S_IXUSR,FALSE,&statbuf))		/* can real uid exec? */
 		croak("Permission denied\n");
@@ -2282,7 +2299,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");
 	}
@@ -2297,11 +2314,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #ifdef HAS_SETRESGID
            (void)setresgid((Gid_t)-1,statbuf.st_gid,(Gid_t)-1);
 #else
-	    setgid(statbuf.st_gid);
+	    PerlProc_setgid(statbuf.st_gid);
 #endif
 #endif
 #endif
-	    if (getegid() != statbuf.st_gid)
+	    if (PerlProc_getegid() != statbuf.st_gid)
 		croak("Can't do setegid!\n");
 	}
 	if (statbuf.st_mode & S_ISUID) {
@@ -2315,11 +2332,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #ifdef HAS_SETRESUID
                 (void)setresuid((Uid_t)-1,statbuf.st_uid,(Uid_t)-1);
 #else
-		setuid(statbuf.st_uid);
+		PerlProc_setuid(statbuf.st_uid);
 #endif
 #endif
 #endif
-	    if (geteuid() != statbuf.st_uid)
+	    if (PerlProc_geteuid() != statbuf.st_uid)
 		croak("Can't do seteuid!\n");
 	}
 	else if (uid) {			/* oops, mustn't run as root */
@@ -2332,11 +2349,11 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #ifdef HAS_SETRESUID
           (void)setresuid((Uid_t)-1,(Uid_t)uid,(Uid_t)-1);
 #else
-          setuid((Uid_t)uid);
+          PerlProc_setuid((Uid_t)uid);
 #endif
 #endif
 #endif
-	    if (geteuid() != uid)
+	    if (PerlProc_geteuid() != uid)
 		croak("Can't do seteuid!\n");
 	}
 	init_ids();
@@ -2355,7 +2372,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");
@@ -2364,14 +2381,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
 	dTHR;
-	Fstat(PerlIO_fileno(rsfp),&statbuf);	/* may be either wrapped or real suid */
+	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)
@@ -2385,8 +2402,8 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif /* DOSUID */
 }
 
-static void
-find_beginning()
+STATIC void
+find_beginning(void)
 {
     register char *s, *s2;
 
@@ -2408,19 +2425,19 @@ 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()
+STATIC void
+init_ids(void)
 {
-    uid = (int)getuid();
-    euid = (int)geteuid();
-    gid = (int)getgid();
-    egid = (int)getegid();
+    uid = (int)PerlProc_getuid();
+    euid = (int)PerlProc_geteuid();
+    gid = (int)PerlProc_getgid();
+    egid = (int)PerlProc_getegid();
 #ifdef VMS
     uid |= gid << 16;
     euid |= egid << 16;
@@ -2428,9 +2445,8 @@ init_ids()
     tainting |= (uid && (euid != uid || egid != gid));
 }
 
-static void
-forbid_setid(s)
-char *s;
+STATIC void
+forbid_setid(char *s)
 {
     if (euid != uid)
         croak("No %s allowed while running setuid", s);
@@ -2438,8 +2454,8 @@ char *s;
         croak("No %s allowed while running setgid", s);
 }
 
-static void
-init_debugger()
+STATIC void
+init_debugger(void)
 {
     dTHR;
     curstash = debstash;
@@ -2458,8 +2474,7 @@ init_debugger()
 }
 
 void
-init_stacks(ARGS)
-dARGS
+init_stacks(ARGSproto)
 {
     curstack = newAV();
     mainstack = curstack;		/* remember in case we switch stacks */
@@ -2470,8 +2485,8 @@ dARGS
     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_max = 8192 / sizeof(PERL_CONTEXT) - 2;	/* Use most of 8K. */
+    New(50,cxstack,cxstack_max + 1,PERL_CONTEXT);
     cxstack_ix	= -1;
 
     New(50,tmps_stack,128,SV*);
@@ -2517,8 +2532,8 @@ dARGS
     }
 }
 
-static void
-nuke_stacks()
+STATIC void
+nuke_stacks(void)
 {
     dTHR;
     Safefree(cxstack);
@@ -2529,11 +2544,16 @@ nuke_stacks()
     } )
 }
 
+#ifndef PERL_OBJECT
 static PerlIO *tmpfp;  /* moved outside init_lexer() because of UNICOS bug */
+#endif
 
-static void
-init_lexer()
+STATIC void
+init_lexer(void)
 {
+#ifdef PERL_OBJECT
+	PerlIO *tmpfp;
+#endif
     tmpfp = rsfp;
     rsfp = Nullfp;
     lex_start(linestr);
@@ -2541,15 +2561,15 @@ init_lexer()
     subname = newSVpv("main",4);
 }
 
-static void
-init_predump_symbols()
+STATIC void
+init_predump_symbols(void)
 {
     dTHR;
     GV *tmpgv;
     GV *othergv;
 
 #ifdef USE_THREADS
-    sv_setpvn(*av_fetch(thr->magicals,find_thread_magical("\""),FALSE)," ", 1);
+    sv_setpvn(*av_fetch(thr->threadsv,find_threadsv("\""),FALSE)," ", 1);
 #else
     sv_setpvn(GvSV(gv_fetchpv("\"", TRUE, SVt_PV)), " ", 1);
 #endif /* USE_THREADS */
@@ -2582,11 +2602,8 @@ init_predump_symbols()
 	osname = savepv(OSNAME);
 }
 
-static void
-init_postdump_symbols(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
+STATIC void
+init_postdump_symbols(register int argc, register char **argv, register char **env)
 {
     dTHR;
     char *s;
@@ -2652,7 +2669,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);
@@ -2660,7 +2677,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
@@ -2673,17 +2690,17 @@ register char **env;
 	sv_setiv(GvSV(tmpgv), (IV)getpid());
 }
 
-static void
-init_perllib()
+STATIC void
+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
@@ -2740,10 +2757,8 @@ init_perllib()
 #  define PERLLIB_MANGLE(s,n) (s)
 #endif 
 
-static void
-incpush(p, addsubdirs)
-char *p;
-int addsubdirs;
+STATIC void
+incpush(char *p, int addsubdirs)
 {
     SV *subdir = Nullsv;
     static char *archpat_auto;
@@ -2811,7 +2826,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"));
@@ -2819,7 +2834,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"));
@@ -2833,17 +2848,18 @@ int addsubdirs;
 }
 
 #ifdef USE_THREADS
-static struct thread *
+STATIC struct perl_thread *
 init_main_thread()
 {
-    struct thread *thr;
+    struct perl_thread *thr;
     XPV *xpv;
 
-    Newz(53, thr, 1, struct thread);
+    Newz(53, thr, 1, struct perl_thread);
     curcop = &compiling;
     thr->cvcache = newHV();
-    thr->magicals = newAV();
+    thr->threadsv = newAV();
     thr->specific = newAV();
+    thr->errhv = newHV();
     thr->flags = THRf_R_JOINABLE;
     MUTEX_INIT(&thr->mutex);
     /* Handcraft thrsv similarly to mess_sv */
@@ -2869,9 +2885,13 @@ init_main_thread()
 
 #ifdef HAVE_THREAD_INTERN
     init_thread_intern(thr);
+#endif
+
+#ifdef SET_THREAD_SELF
+    SET_THREAD_SELF(thr);
 #else
     thr->self = pthread_self();
-#endif /* HAVE_THREAD_INTERN */
+#endif /* SET_THREAD_SELF */
     SET_THR(thr);
 
     /*
@@ -2885,14 +2905,13 @@ init_main_thread()
     sv_upgrade(bodytarget, SVt_PVFM);
     sv_setpvn(bodytarget, "", 0);
     formtarget = bodytarget;
+    thr->errsv = newSVpv("", 0);
     return thr;
 }
 #endif /* USE_THREADS */
 
 void
-call_list(oldscope, list)
-I32 oldscope;
-AV* list;
+call_list(I32 oldscope, AV *paramList)
 {
     dTHR;
     line_t oldline = curcop->cop_line;
@@ -2900,28 +2919,29 @@ AV* list;
     dJMPENV;
     int ret;
 
-    while (AvFILL(list) >= 0) {
-	CV *cv = (CV*)av_shift(list);
+    while (AvFILL(paramList) >= 0) {
+	CV *cv = (CV*)av_shift(paramList);
 
 	SAVEFREESV(cv);
 
 	JMPENV_PUSH(ret);
 	switch (ret) {
 	case 0: {
+		SV* atsv = ERRSV;
 		PUSHMARK(stack_sp);
 		perl_call_sv((SV*)cv, G_EVAL|G_DISCARD);
-		(void)SvPV(errsv, len);
+		(void)SvPV(atsv, len);
 		if (len) {
 		    JMPENV_POP;
 		    curcop = &compiling;
 		    curcop->cop_line = oldline;
-		    if (list == beginav)
-			sv_catpv(errsv, "BEGIN failed--compilation aborted");
+		    if (paramList == beginav)
+			sv_catpv(atsv, "BEGIN failed--compilation aborted");
 		    else
-			sv_catpv(errsv, "END failed--cleanup aborted");
+			sv_catpv(atsv, "END failed--cleanup aborted");
 		    while (scopestack_ix > oldscope)
 			LEAVE;
-		    croak("%s", SvPVX(errsv));
+		    croak("%s", SvPVX(atsv));
 		}
 	    }
 	    break;
@@ -2940,7 +2960,7 @@ AV* list;
 	    curcop = &compiling;
 	    curcop->cop_line = oldline;
 	    if (statusvalue) {
-		if (list == beginav)
+		if (paramList == beginav)
 		    croak("BEGIN failed--compilation aborted");
 		else
 		    croak("END failed--cleanup aborted");
@@ -2963,8 +2983,7 @@ AV* list;
 }
 
 void
-my_exit(status)
-U32 status;
+my_exit(U32 status)
 {
     dTHR;
 
@@ -2987,7 +3006,7 @@ U32 status;
 }
 
 void
-my_failure_exit()
+my_failure_exit(void)
 {
 #ifdef VMS
     if (vaxc$errno & 1) {
@@ -3009,11 +3028,11 @@ my_failure_exit()
     my_exit_jump();
 }
 
-static void
-my_exit_jump()
+STATIC void
+my_exit_jump(void)
 {
     dTHR;
-    register CONTEXT *cx;
+    register PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
 
@@ -3036,3 +3055,6 @@ my_exit_jump()
 
     JMPENV_JUMP(2);
 }
+
+
+