X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl.c;h=d0d4e9ae172a51c997965a46c168b6a37e6caef0;hb=ae178db11db50e8d46c66980e186cfba029f0cb9;hp=87aa87082eaf098cd7e856da86285d8f458c2f9f;hpb=864dbfa3ca8032ef66f7aa86961933b19b962357;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perl.c b/perl.c
index 87aa870..d0d4e9a 100644
--- a/perl.c
+++ b/perl.c
@@ -14,6 +14,7 @@
 #include "EXTERN.h"
 #define PERL_IN_PERL_C
 #include "perl.h"
+#include "patchlevel.h"			/* for local_patches */
 
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
@@ -24,6 +25,8 @@
 char *getenv (char *); /* Usually in <stdlib.h> */
 #endif
 
+static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
+
 #ifdef I_FCNTL
 #include <fcntl.h>
 #endif
@@ -55,18 +58,19 @@ CPerlObj* perl_alloc(IPerlMem* ipM, IPerlEnv* ipE, IPerlStdIO* ipStd,
 }
 #else
 PerlInterpreter *
-perl_alloc(pTHX)
+perl_alloc(void)
 {
-    PerlInterpreter *sv_interp;
+    PerlInterpreter *my_perl;
 
-    PL_curinterp = 0;
-    New(53, sv_interp, 1, PerlInterpreter);
-    return sv_interp;
+    /* New() needs interpreter, so call malloc() instead */
+    my_perl = (PerlInterpreter*)PerlMem_malloc(sizeof(PerlInterpreter));
+    PERL_SET_INTERP(my_perl);
+    return my_perl;
 }
 #endif /* PERL_OBJECT */
 
 void
-perl_construct(register PerlInterpreter *sv_interp)
+perl_construct(pTHXx)
 {
 #ifdef USE_THREADS
     int i;
@@ -75,14 +79,16 @@ perl_construct(register PerlInterpreter *sv_interp)
 #endif /* FAKE_THREADS */
 #endif /* USE_THREADS */
     
-#ifndef PERL_OBJECT
-    if (!(PL_curinterp = sv_interp))
-	return;
+#ifdef MULTIPLICITY
+    Zero(my_perl, 1, PerlInterpreter);
 #endif
 
 #ifdef MULTIPLICITY
-    ++PL_ninterps;
-    Zero(sv_interp, 1, PerlInterpreter);
+    init_interp();
+    PL_perl_destruct_level = 1; 
+#else
+   if (PL_perl_destruct_level > 0)
+       init_interp();
 #endif
 
    /* Init the real globals (and main thread)? */
@@ -94,7 +100,7 @@ perl_construct(register PerlInterpreter *sv_interp)
         ALLOC_THREAD_KEY;
 #else
 	if (pthread_key_create(&PL_thr_key, 0))
-	    croak("panic: pthread_key_create");
+	    Perl_croak(aTHX_ "panic: pthread_key_create");
 #endif
 	MUTEX_INIT(&PL_sv_mutex);
 	/*
@@ -114,7 +120,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 	thr = init_main_thread();
 #endif /* USE_THREADS */
 
-	PL_protect = FUNC_NAME_TO_PTR(default_protect); /* for exceptions */
+	PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
 
 	PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
@@ -143,7 +149,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 	/* TODO: */
 	/* PL_sighandlerp = sighandler; */
 #else
-	PL_sighandlerp = sighandler;
+	PL_sighandlerp = Perl_sighandler;
 #endif
 	PL_pidstatus = newHV();
 
@@ -161,14 +167,7 @@ perl_construct(register PerlInterpreter *sv_interp)
     PL_nrs = newSVpvn("\n", 1);
     PL_rs = SvREFCNT_inc(PL_nrs);
 
-    init_stacks(ARGS);
-#ifdef MULTIPLICITY
-    init_interp();
-    PL_perl_destruct_level = 1; 
-#else
-   if (PL_perl_destruct_level > 0)
-       init_interp();
-#endif
+    init_stacks();
 
     init_ids();
     PL_lex_state = LEX_NOTPARSING;
@@ -176,6 +175,7 @@ perl_construct(register PerlInterpreter *sv_interp)
     JMPENV_BOOTSTRAP;
     STATUS_ALL_SUCCESS;
 
+    init_i18nl10n(1);
     SET_NUMERIC_STANDARD();
 #if defined(PERL_SUBVERSION) && PERL_SUBVERSION > 0
     sprintf(PL_patchlevel, "%7.5f",   (double) PERL_REVISION
@@ -204,7 +204,7 @@ perl_construct(register PerlInterpreter *sv_interp)
 }
 
 void
-perl_destruct(register PerlInterpreter *sv_interp)
+perl_destruct(pTHXx)
 {
     dTHR;
     int destruct_level;  /* 0=none, 1=full, 2=full with checks */
@@ -212,13 +212,9 @@ perl_destruct(register PerlInterpreter *sv_interp)
     HV *hv;
 #ifdef USE_THREADS
     Thread t;
+    dTHX;
 #endif /* USE_THREADS */
 
-#ifndef PERL_OBJECT
-    if (!(PL_curinterp = sv_interp))
-	return;
-#endif
-
 #ifdef USE_THREADS
 #ifndef FAKE_THREADS
     /* Pass 1 on any remaining threads: detach joinables, join zombies */
@@ -304,10 +300,6 @@ perl_destruct(register PerlInterpreter *sv_interp)
     LEAVE;
     FREETMPS;
 
-#ifdef MULTIPLICITY
-    --PL_ninterps;
-#endif
-
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
@@ -336,12 +328,10 @@ perl_destruct(register PerlInterpreter *sv_interp)
     PL_warnhook = Nullsv;
     SvREFCNT_dec(PL_diehook);
     PL_diehook = Nullsv;
-    SvREFCNT_dec(PL_parsehook);
-    PL_parsehook = Nullsv;
 
     /* call exit list functions */
     while (PL_exitlistlen-- > 0)
-	PL_exitlist[PL_exitlistlen].fn(PERL_OBJECT_THIS_ PL_exitlist[PL_exitlistlen].ptr);
+	PL_exitlist[PL_exitlistlen].fn(aTHXo_ PL_exitlist[PL_exitlistlen].ptr);
 
     Safefree(PL_exitlist);
 
@@ -417,6 +407,11 @@ perl_destruct(register PerlInterpreter *sv_interp)
     Safefree(PL_screamnext);
     PL_screamnext  = 0;
 
+    /* float buffer */
+    Safefree(PL_efloatbuf);
+    PL_efloatbuf = Nullch;
+    PL_efloatsize = 0;
+
     /* startup and shutdown function lists */
     SvREFCNT_dec(PL_beginav);
     SvREFCNT_dec(PL_endav);
@@ -446,19 +441,25 @@ perl_destruct(register PerlInterpreter *sv_interp)
     PL_defstash = 0;
     SvREFCNT_dec(hv);
 
+    /* clear queued errors */
+    SvREFCNT_dec(PL_errors);
+    PL_errors = Nullsv;
+
     FREETMPS;
-    if (destruct_level >= 2) {
+    if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
 	if (PL_scopestack_ix != 0)
-	    warn("Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
+	    Perl_warner(aTHX_ WARN_INTERNAL,
+	         "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
 		 (long)PL_scopestack_ix);
 	if (PL_savestack_ix != 0)
-	    warn("Unbalanced saves: %ld more saves than restores\n",
+	    Perl_warner(aTHX_ WARN_INTERNAL,
+		 "Unbalanced saves: %ld more saves than restores\n",
 		 (long)PL_savestack_ix);
 	if (PL_tmps_floor != -1)
-	    warn("Unbalanced tmps: %ld more allocs than frees\n",
+	    Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",
 		 (long)PL_tmps_floor + 1);
 	if (cxstack_ix != -1)
-	    warn("Unbalanced context: %ld more PUSHes than POPs\n",
+	    Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced context: %ld more PUSHes than POPs\n",
 		 (long)cxstack_ix + 1);
     }
 
@@ -487,8 +488,9 @@ perl_destruct(register PerlInterpreter *sv_interp)
 	array = HvARRAY(PL_strtab);
 	hent = array[0];
 	for (;;) {
-	    if (hent) {
-		warn("Unbalanced string table refcount: (%d) for \"%s\"",
+	    if (hent && ckWARN_d(WARN_INTERNAL)) {
+		Perl_warner(aTHX_ WARN_INTERNAL,
+		     "Unbalanced string table refcount: (%d) for \"%s\"",
 		     HeVAL(hent) - Nullsv, HeKEY(hent));
 		HeVAL(hent) = Nullsv;
 		hent = HeNEXT(hent);
@@ -502,8 +504,8 @@ perl_destruct(register PerlInterpreter *sv_interp)
     }
     SvREFCNT_dec(PL_strtab);
 
-    if (PL_sv_count != 0)
-	warn("Scalars leaked: %ld\n", (long)PL_sv_count);
+    if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
+	Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
     sv_free_arenas();
 
@@ -515,6 +517,7 @@ perl_destruct(register PerlInterpreter *sv_interp)
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
 	Safefree(PL_reg_curpm);
+    Safefree(PL_reg_poscache);
     Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
     Safefree(PL_op_mask);
     nuke_stacks();
@@ -562,14 +565,12 @@ perl_destruct(register PerlInterpreter *sv_interp)
 }
 
 void
-perl_free(PerlInterpreter *sv_interp)
+perl_free(pTHXx)
 {
-#ifdef PERL_OBJECT
-	Safefree(this);
+#if defined(PERL_OBJECT)
+    PerlMem_free(this);
 #else
-    if (!(PL_curinterp = sv_interp))
-	return;
-    Safefree(sv_interp);
+    PerlMem_free(aTHXx);
 #endif
 }
 
@@ -583,25 +584,23 @@ Perl_call_atexit(pTHX_ ATEXIT_t fn, void *ptr)
 }
 
 int
-perl_parse(PerlInterpreter *sv_interp, XSINIT_t xsinit, int argc, char **argv, char **env)
+perl_parse(pTHXx_ XSINIT_t xsinit, int argc, char **argv, char **env)
 {
     dTHR;
     I32 oldscope;
     int ret;
+#ifdef USE_THREADS
+    dTHX;
+#endif
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
 #undef IAMSUID
-    croak("suidperl is no longer needed since the kernel can now execute\n\
+    Perl_croak(aTHX_ "suidperl is no longer needed since the kernel can now execute\n\
 setuid perl scripts securely.\n");
 #endif
 #endif
 
-#ifndef PERL_OBJECT
-    if (!(PL_curinterp = sv_interp))
-	return 255;
-#endif
-
 #if defined(__DYNAMIC__) && (defined(NeXT) || defined(__NeXT__))
     _dyld_lookup_and_bind
 	("__environ", (unsigned long *) &environ_pointer, NULL);
@@ -638,7 +637,7 @@ setuid perl scripts securely.\n");
     oldscope = PL_scopestack_ix;
     PL_dowarn = G_WARN_OFF;
 
-    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(parse_body), env, xsinit);
+    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_parse_body), env, xsinit);
     switch (ret) {
     case 0:
 	return 0;
@@ -662,7 +661,7 @@ setuid perl scripts securely.\n");
 }
 
 STATIC void *
-parse_body(pTHX_ va_list args)
+S_parse_body(pTHX_ va_list args)
 {
     dTHR;
     int argc = PL_origargc;
@@ -730,7 +729,7 @@ parse_body(pTHX_ va_list args)
 
 	case 'e':
 	    if (PL_euid != PL_uid || PL_egid != PL_gid)
-		croak("No -e allowed in setuid scripts");
+		Perl_croak(aTHX_ "No -e allowed in setuid scripts");
 	    if (!PL_e_script) {
 		PL_e_script = newSVpvn("",0);
 		filter_add(read_e_script, NULL);
@@ -742,7 +741,7 @@ parse_body(pTHX_ va_list args)
 		argc--,argv++;
 	    }
 	    else
-		croak("No code specified for -e");
+		Perl_croak(aTHX_ "No code specified for -e");
 	    sv_catpv(PL_e_script, "\n");
 	    break;
 
@@ -801,16 +800,16 @@ parse_body(pTHX_ va_list args)
 		    sv_catpv(PL_Sv,"\"  Locally applied patches:\\n\",");
 		    for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
 			if (PL_localpatches[i])
-			    sv_catpvf(PL_Sv,"q\"  \t%s\n\",",PL_localpatches[i]);
+			    Perl_sv_catpvf(aTHX_ PL_Sv,"q\"  \t%s\n\",",PL_localpatches[i]);
 		    }
 		}
 #endif
-		sv_catpvf(PL_Sv,"\"  Built under %s\\n\"",OSNAME);
+		Perl_sv_catpvf(aTHX_ PL_Sv,"\"  Built under %s\\n\"",OSNAME);
 #ifdef __DATE__
 #  ifdef __TIME__
-		sv_catpvf(PL_Sv,",\"  Compiled at %s %s\\n\"",__DATE__,__TIME__);
+		Perl_sv_catpvf(aTHX_ PL_Sv,",\"  Compiled at %s %s\\n\"",__DATE__,__TIME__);
 #  else
-		sv_catpvf(PL_Sv,",\"  Compiled on %s\\n\"",__DATE__);
+		Perl_sv_catpvf(aTHX_ PL_Sv,",\"  Compiled on %s\\n\"",__DATE__);
 #  endif
 #endif
 		sv_catpv(PL_Sv, "; \
@@ -853,7 +852,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 	    s--;
 	    /* FALL THROUGH */
 	default:
-	    croak("Unrecognized switch: -%s  (-h will show valid options)",s);
+	    Perl_croak(aTHX_ "Unrecognized switch: -%s  (-h will show valid options)",s);
 	}
     }
   switch_end:
@@ -879,7 +878,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
 		if (!*s)
 		    break;
 		if (!strchr("DIMUdmw", *s))
-		    croak("Illegal switch in PERL5OPT: -%c", *s);
+		    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
 		s = moreswitches(s);
 	    }
 	}
@@ -935,13 +934,18 @@ print \"  \\@INC:\\n    @INC\\n\";");
     CvPADLIST(PL_compcv) = comppadlist;
 
     boot_core_UNIVERSAL();
+    boot_core_xsutils();
 
     if (xsinit)
-	(*xsinit)(PERL_OBJECT_THIS);	/* in case linked C routines want magical variables */
+	(*xsinit)(aTHXo);	/* in case linked C routines want magical variables */
 #if defined(VMS) || defined(WIN32) || defined(DJGPP)
     init_os_extras();
 #endif
 
+#ifdef USE_SOCKS
+    SOCKSinit(argv[0]);
+#endif    
+
     init_predump_symbols();
     /* init_postdump_symbols not currently designed to be called */
     /* more than once (ENV isn't cleared first, for example)	 */
@@ -957,10 +961,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
     PL_error_count = 0;
     if (yyparse() || PL_error_count) {
 	if (PL_minus_c)
-	    croak("%s had compilation errors.\n", PL_origfilename);
+	    Perl_croak(aTHX_ "%s had compilation errors.\n", PL_origfilename);
 	else {
-	    croak("Execution of %s aborted due to compilation errors.\n",
-		PL_origfilename);
+	    Perl_croak(aTHX_ "Execution of %s aborted due to compilation errors.\n",
+		       PL_origfilename);
 	}
     }
     PL_curcop->cop_line = 0;
@@ -978,7 +982,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     if (PL_do_undump)
 	my_unexec();
 
-    if (ckWARN(WARN_ONCE))
+    if (isWARN_ONCE)
 	gv_check(PL_defstash);
 
     LEAVE;
@@ -995,21 +999,19 @@ print \"  \\@INC:\\n    @INC\\n\";");
 }
 
 int
-perl_run(PerlInterpreter *sv_interp)
+perl_run(pTHXx)
 {
     dTHR;
     I32 oldscope;
     int ret;
-
-#ifndef PERL_OBJECT
-    if (!(PL_curinterp = sv_interp))
-	return 255;
+#ifdef USE_THREADS
+    dTHX;
 #endif
 
     oldscope = PL_scopestack_ix;
 
  redo_body:
-    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(run_body), oldscope);
+    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
     switch (ret) {
     case 1:
 	cxstack_ix = -1;		/* start context stack again */
@@ -1042,7 +1044,7 @@ perl_run(PerlInterpreter *sv_interp)
 }
 
 STATIC void *
-run_body(pTHX_ va_list args)
+S_run_body(pTHX_ va_list args)
 {
     dTHR;
     I32 oldscope = va_arg(args, I32);
@@ -1071,14 +1073,16 @@ run_body(pTHX_ va_list args)
     if (PL_restartop) {
 	PL_op = PL_restartop;
 	PL_restartop = 0;
-	CALLRUNOPS();
+	CALLRUNOPS(aTHX);
     }
     else if (PL_main_start) {
 	CvDEPTH(PL_main_cv) = 1;
 	PL_op = PL_main_start;
-	CALLRUNOPS();
+	CALLRUNOPS(aTHX);
     }
 
+    my_exit(0);
+    /* NOTREACHED */
     return NULL;
 }
 
@@ -1181,7 +1185,7 @@ Perl_call_method(pTHX_ const char *methname, I32 flags)
 	PL_op = &myop;
     XPUSHs(sv_2mortal(newSVpv(methname,0)));
     PUTBACK;
-    pp_method(ARGS);
+    pp_method();
 	if(PL_op == &myop)
 		PL_op = Nullop;
     return call_sv(*PL_stack_sp--, flags);
@@ -1232,10 +1236,16 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	PL_op->op_private |= OPpENTERSUB_DB;
 
     if (!(flags & G_EVAL)) {
-	CATCH_SET(TRUE);
+        /* G_NOCATCH is a hack for perl_vdie using this path to call
+	   a __DIE__ handler */
+        if (!(flags & G_NOCATCH)) {
+	    CATCH_SET(TRUE);
+	}
 	call_xbody((OP*)&myop, FALSE);
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
-	CATCH_SET(FALSE);
+        if (!(flags & G_NOCATCH)) {
+	    CATCH_SET(FALSE);
+	}
     }
     else {
 	cLOGOP->op_other = PL_op;
@@ -1262,7 +1272,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	PL_markstack_ptr++;
 
   redo_body:
-	CALLPROTECT(&ret, FUNC_NAME_TO_PTR(call_body), (OP*)&myop, FALSE);
+	CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, FALSE);
 	switch (ret) {
 	case 0:
 	    retval = PL_stack_sp - (PL_stack_base + oldmark);
@@ -1277,7 +1287,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    PL_curstash = PL_defstash;
 	    FREETMPS;
 	    if (PL_statusvalue)
-		croak("Callback called exit");
+		Perl_croak(aTHX_ "Callback called exit");
 	    my_exit_jump();
 	    /* NOTREACHED */
 	case 3:
@@ -1322,7 +1332,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 }
 
 STATIC void *
-call_body(pTHX_ va_list args)
+S_call_body(pTHX_ va_list args)
 {
     OP *myop = va_arg(args, OP*);
     int is_eval = va_arg(args, int);
@@ -1332,18 +1342,18 @@ call_body(pTHX_ va_list args)
 }
 
 STATIC void
-call_xbody(pTHX_ OP *myop, int is_eval)
+S_call_xbody(pTHX_ OP *myop, int is_eval)
 {
     dTHR;
 
     if (PL_op == myop) {
 	if (is_eval)
-	    PL_op = pp_entereval(ARGS);
+	    PL_op = Perl_pp_entereval(aTHX);
 	else
-	    PL_op = pp_entersub(ARGS);
+	    PL_op = Perl_pp_entersub(aTHX);
     }
     if (PL_op)
-	CALLRUNOPS();
+	CALLRUNOPS(aTHX);
 }
 
 /* Eval a string. The G_EVAL flag is always assumed. */
@@ -1384,7 +1394,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	myop.op_flags |= OPf_SPECIAL;
 
  redo_body:
-    CALLPROTECT(&ret, FUNC_NAME_TO_PTR(call_body), (OP*)&myop, TRUE);
+    CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_body), (OP*)&myop, TRUE);
     switch (ret) {
     case 0:
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
@@ -1399,7 +1409,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	PL_curstash = PL_defstash;
 	FREETMPS;
 	if (PL_statusvalue)
-	    croak("Callback called exit");
+	    Perl_croak(aTHX_ "Callback called exit");
 	my_exit_jump();
 	/* NOTREACHED */
     case 3:
@@ -1444,7 +1454,7 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 
     if (croak_on_error && SvTRUE(ERRSV)) {
 	STRLEN n_a;
-	croak(SvPVx(ERRSV, n_a));
+	Perl_croak(aTHX_ SvPVx(ERRSV, n_a));
     }
 
     return sv;
@@ -1478,7 +1488,7 @@ Perl_magicname(pTHX_ char *sym, char *name, I32 namlen)
 }
 
 STATIC void
-usage(pTHX_ char *name)		/* XXX move this out into a module ? */
+S_usage(pTHX_ 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? */
@@ -1558,7 +1568,7 @@ Perl_moreswitches(pTHX_ char *s)
 	forbid_setid("-d");
 	s++;
 	if (*s == ':' || *s == '=')  {
-	    my_setenv("PERL5DB", form("use Devel::%s;", ++s));
+	    my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
 	    s += strlen(s);
 	}
 	if (!PL_perldb) {
@@ -1567,6 +1577,7 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 	return s;
     case 'D':
+    {	
 #ifdef DEBUGGING
 	forbid_setid("-D");
 	if (isALPHA(s[1])) {
@@ -1582,11 +1593,15 @@ Perl_moreswitches(pTHX_ char *s)
 	}
 	PL_debug |= 0x80000000;
 #else
-	warn("Recompile perl with -DDEBUGGING to use -D switch\n");
+	dTHR;
+	if (ckWARN_d(WARN_DEBUGGING))
+	    Perl_warner(aTHX_ WARN_DEBUGGING,
+	           "Recompile perl with -DDEBUGGING to use -D switch\n");
 	for (s++; isALNUM(*s); s++) ;
 #endif
 	/*SUPPRESS 530*/
 	return s;
+    }	
     case 'h':
 	usage(PL_origargv[0]);    
 	PerlProc_exit(0);
@@ -1616,7 +1631,7 @@ Perl_moreswitches(pTHX_ char *s)
 	    s = e;
 	}
 	else
-	    croak("No space allowed after -I");
+	    Perl_croak(aTHX_ "No space allowed after -I");
 	return s;
     case 'l':
 	PL_minus_l = TRUE;
@@ -1659,7 +1674,7 @@ Perl_moreswitches(pTHX_ char *s)
 		sv_catpv(sv, start);
 		if (*(start-1) == 'm') {
 		    if (*s != '\0')
-			croak("Can't use '%c' after -mname", *s);
+			Perl_croak(aTHX_ "Can't use '%c' after -mname", *s);
 		    sv_catpv( sv, " ()");
 		}
 	    } else {
@@ -1674,7 +1689,7 @@ Perl_moreswitches(pTHX_ char *s)
 	    av_push(PL_preambleav, sv);
 	}
 	else
-	    croak("No space allowed after -%c", *(s-1));
+	    Perl_croak(aTHX_ "No space allowed after -%c", *(s-1));
 	return s;
     case 'n':
 	PL_minus_n = TRUE;
@@ -1691,7 +1706,7 @@ Perl_moreswitches(pTHX_ char *s)
 	return s;
     case 'T':
 	if (!PL_tainting)
-	    croak("Too late for \"-T\" option");
+	    Perl_croak(aTHX_ "Too late for \"-T\" option");
 	s++;
 	return s;
     case 'u':
@@ -1799,7 +1814,7 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
 	    return s+1;
 	/* FALL THROUGH */
     default:
-	croak("Can't emulate -%.1s on #! line",s);
+	Perl_croak(aTHX_ "Can't emulate -%.1s on #! line",s);
     }
     return Nullch;
 }
@@ -1838,7 +1853,7 @@ Perl_my_unexec(pTHX)
 
 /* initialize curinterp */
 STATIC void
-init_interp(pTHX)
+S_init_interp(pTHX)
 {
 
 #ifdef PERL_OBJECT		/* XXX kludge */
@@ -1879,17 +1894,30 @@ init_interp(pTHX)
 #else
 #  ifdef MULTIPLICITY
 #    define PERLVAR(var,type)
-#    define PERLVARI(var,type,init)	PL_curinterp->var = init;
-#    define PERLVARIC(var,type,init)	PL_curinterp->var = init;
+#    define PERLVARA(var,n,type)
+#    if defined(PERL_IMPLICIT_CONTEXT)
+#      if defined(USE_THREADS)
+#        define PERLVARI(var,type,init)		PERL_GET_INTERP->var = init;
+#        define PERLVARIC(var,type,init)	PERL_GET_INTERP->var = init;
+#      else /* !USE_THREADS */
+#        define PERLVARI(var,type,init)		aTHX->var = init;
+#        define PERLVARIC(var,type,init)	aTHX->var = init;
+#      endif /* USE_THREADS */
+#    else
+#      define PERLVARI(var,type,init)	PERL_GET_INTERP->var = init;
+#      define PERLVARIC(var,type,init)	PERL_GET_INTERP->var = init;
+#    endif
 #    include "intrpvar.h"
 #    ifndef USE_THREADS
 #      include "thrdvar.h"
 #    endif
 #    undef PERLVAR
+#    undef PERLVARA
 #    undef PERLVARI
 #    undef PERLVARIC
 #  else
 #    define PERLVAR(var,type)
+#    define PERLVARA(var,n,type)
 #    define PERLVARI(var,type,init)	PL_##var = init;
 #    define PERLVARIC(var,type,init)	PL_##var = init;
 #    include "intrpvar.h"
@@ -1897,6 +1925,7 @@ init_interp(pTHX)
 #      include "thrdvar.h"
 #    endif
 #    undef PERLVAR
+#    undef PERLVARA
 #    undef PERLVARI
 #    undef PERLVARIC
 #  endif
@@ -1905,7 +1934,7 @@ init_interp(pTHX)
 }
 
 STATIC void
-init_main_stash(pTHX)
+S_init_main_stash(pTHX)
 {
     dTHR;
     GV *gv;
@@ -1936,7 +1965,7 @@ init_main_stash(pTHX)
     GvMULTI_on(PL_errgv);
     PL_replgv = gv_fetchpv("\022", TRUE, SVt_PV); /* ^R */
     GvMULTI_on(PL_replgv);
-    (void)form("%240s","");	/* Preallocate temp - for immediate signals. */
+    (void)Perl_form(aTHX_ "%240s","");	/* Preallocate temp - for immediate signals. */
     sv_grow(ERRSV, 240);	/* Preallocate - for immediate signals. */
     sv_setpvn(ERRSV, "", 0);
     PL_curstash = PL_defstash;
@@ -1948,7 +1977,7 @@ init_main_stash(pTHX)
 }
 
 STATIC void
-open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
+S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 {
     dTHR;
     register char *s;
@@ -1991,14 +2020,14 @@ open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
 	SV *cmd = NEWSV(0,0);
 
 	if (strEQ(cpp_cfg, "cppstdin"))
-	    sv_catpvf(cpp, "%s/", BIN_EXP);
+	    Perl_sv_catpvf(aTHX_ cpp, "%s/", BIN_EXP);
 	sv_catpv(cpp, cpp_cfg);
 
 	sv_catpv(sv,"-I");
 	sv_catpv(sv,PRIVLIB_EXP);
 
 #ifdef MSDOS
-	sv_setpvf(cmd, "\
+	Perl_sv_setpvf(aTHX_ cmd, "\
 sed %s -e \"/^[^#]/b\" \
  -e \"/^#[ 	]*include[ 	]/b\" \
  -e \"/^#[ 	]*define[ 	]/b\" \
@@ -2014,7 +2043,7 @@ sed %s -e \"/^[^#]/b\" \
 	  (PL_doextract ? "-e \"1,/^#/d\n\"" : ""),
 #else
 #  ifdef __OPEN_VM
-	sv_setpvf(cmd, "\
+	Perl_sv_setpvf(aTHX_ cmd, "\
 %s %s -e '/^[^#]/b' \
  -e '/^#[ 	]*include[ 	]/b' \
  -e '/^#[ 	]*define[ 	]/b' \
@@ -2028,7 +2057,7 @@ sed %s -e \"/^[^#]/b\" \
  -e 's/^[ 	]*#.*//' \
  %s | %_ %_ %s",
 #  else
-	sv_setpvf(cmd, "\
+	Perl_sv_setpvf(aTHX_ cmd, "\
 %s %s -e '/^[^#]/b' \
  -e '/^#[ 	]*include[ 	]/b' \
  -e '/^#[ 	]*define[ 	]/b' \
@@ -2067,7 +2096,7 @@ sed %s -e \"/^[^#]/b\" \
 #endif
 #endif
 	    if (PerlProc_geteuid() != PL_uid)
-		croak("Can't do seteuid!\n");
+		Perl_croak(aTHX_ "Can't do seteuid!\n");
 	}
 #endif /* IAMSUID */
 	PL_rsfp = PerlProc_popen(SvPVX(cmd), "r");
@@ -2093,12 +2122,12 @@ sed %s -e \"/^[^#]/b\" \
 	    PL_statbuf.st_mode & (S_ISUID|S_ISGID))
 	{
 	    /* try again */
-	    PerlProc_execv(form("%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
-	    croak("Can't do setuid\n");
+	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+	    Perl_croak(aTHX_ "Can't do setuid\n");
 	}
 #endif
 #endif
-	croak("Can't open perl script \"%s\": %s\n",
+	Perl_croak(aTHX_ "Can't open perl script \"%s\": %s\n",
 	  SvPVX(GvSV(PL_curcop->cop_filegv)), Strerror(errno));
     }
 }
@@ -2112,7 +2141,7 @@ sed %s -e \"/^[^#]/b\" \
 
 #ifdef IAMSUID
 STATIC int
-fd_on_nosuid_fs(pTHX_ int fd)
+S_fd_on_nosuid_fs(pTHX_ int fd)
 {
     int on_nosuid  = 0;
     int check_okay = 0;
@@ -2169,13 +2198,13 @@ fd_on_nosuid_fs(pTHX_ int fd)
 #       endif /* statfs */
 #   endif /* statvfs */
     if (!check_okay) 
-	croak("Can't check filesystem of script \"%s\"", PL_origfilename);
+	Perl_croak(aTHX_ "Can't check filesystem of script \"%s\"", PL_origfilename);
     return on_nosuid;
 }
 #endif /* IAMSUID */
 
 STATIC void
-validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
+S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 {
     int which;
 
@@ -2204,7 +2233,7 @@ validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
     char *s, *s2;
 
     if (PerlLIO_fstat(PerlIO_fileno(PL_rsfp),&PL_statbuf) < 0)	/* normal stat is insecure */
-	croak("Can't stat script \"%s\"",PL_origfilename);
+	Perl_croak(aTHX_ "Can't stat script \"%s\"",PL_origfilename);
     if (fdscript < 0 && PL_statbuf.st_mode & (S_ISUID|S_ISGID)) {
 	I32 len;
 	STRLEN n_a;
@@ -2220,7 +2249,7 @@ validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 	 * it says access() is useful in setuid programs.
 	 */
 	if (PerlLIO_access(SvPVX(GvSV(PL_curcop->cop_filegv)),1)) /*double check*/
-	    croak("Permission denied");
+	    Perl_croak(aTHX_ "Permission denied");
 #else
 	/* If we can swap euid and uid, then we can determine access rights
 	 * with a simple stat of the file, and then compare device and
@@ -2239,12 +2268,12 @@ validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 # endif
 #endif
 		|| PerlProc_getuid() != PL_euid || PerlProc_geteuid() != PL_uid)
-		croak("Can't swap uid and euid");	/* really paranoid */
+		Perl_croak(aTHX_ "Can't swap uid and euid");	/* really paranoid */
 	    if (PerlLIO_stat(SvPVX(GvSV(PL_curcop->cop_filegv)),&tmpstatbuf) < 0)
-		croak("Permission denied");	/* testing full pathname here */
+		Perl_croak(aTHX_ "Permission denied");	/* testing full pathname here */
 #if defined(IAMSUID) && !defined(NO_NOSUID_CHECK)
 	    if (fd_on_nosuid_fs(PerlIO_fileno(PL_rsfp)))
-		croak("Permission denied");
+		Perl_croak(aTHX_ "Permission denied");
 #endif
 	    if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
 		tmpstatbuf.st_ino != PL_statbuf.st_ino) {
@@ -2259,7 +2288,7 @@ validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 			(long)PL_statbuf.st_uid, (long)PL_statbuf.st_gid);
 		    (void)PerlProc_pclose(PL_rsfp);
 		}
-		croak("Permission denied\n");
+		Perl_croak(aTHX_ "Permission denied\n");
 	    }
 	    if (
 #ifdef HAS_SETREUID
@@ -2270,29 +2299,29 @@ validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 # endif
 #endif
               || PerlProc_getuid() != PL_uid || PerlProc_geteuid() != PL_euid)
-		croak("Can't reswap uid and euid");
+		Perl_croak(aTHX_ "Can't reswap uid and euid");
 	    if (!cando(S_IXUSR,FALSE,&PL_statbuf))		/* can real uid exec? */
-		croak("Permission denied\n");
+		Perl_croak(aTHX_ "Permission denied\n");
 	}
 #endif /* HAS_SETREUID */
 #endif /* IAMSUID */
 
 	if (!S_ISREG(PL_statbuf.st_mode))
-	    croak("Permission denied");
+	    Perl_croak(aTHX_ "Permission denied");
 	if (PL_statbuf.st_mode & S_IWOTH)
-	    croak("Setuid/gid script is writable by world");
+	    Perl_croak(aTHX_ "Setuid/gid script is writable by world");
 	PL_doswitches = FALSE;		/* -s is insecure in suid */
 	PL_curcop->cop_line++;
 	if (sv_gets(PL_linestr, PL_rsfp, 0) == Nullch ||
 	  strnNE(SvPV(PL_linestr,n_a),"#!",2) )	/* required even on Sys V */
-	    croak("No #! line");
+	    Perl_croak(aTHX_ "No #! line");
 	s = SvPV(PL_linestr,n_a)+2;
 	if (*s == ' ') s++;
 	while (!isSPACE(*s)) s++;
 	for (s2 = s;  (s2 > SvPV(PL_linestr,n_a)+2 &&
 		       (isDIGIT(s2[-1]) || strchr("._-", s2[-1])));  s2--) ;
 	if (strnNE(s2-4,"perl",4) && strnNE(s-9,"perl",4))  /* sanity check */
-	    croak("Not a perl script");
+	    Perl_croak(aTHX_ "Not a perl script");
 	while (*s == ' ' || *s == '\t') s++;
 	/*
 	 * #! arg must be what we saw above.  They can invoke it by
@@ -2302,13 +2331,13 @@ validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
 	len = strlen(validarg);
 	if (strEQ(validarg," PHOOEY ") ||
 	    strnNE(s,validarg,len) || !isSPACE(s[len]))
-	    croak("Args must match #! line");
+	    Perl_croak(aTHX_ "Args must match #! line");
 
 #ifndef IAMSUID
 	if (PL_euid != PL_uid && (PL_statbuf.st_mode & S_ISUID) &&
 	    PL_euid == PL_statbuf.st_uid)
 	    if (!PL_do_undump)
-		croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
+		Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif /* IAMSUID */
 
@@ -2316,9 +2345,9 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	    (void)PerlIO_close(PL_rsfp);
 #ifndef IAMSUID
 	    /* try again */
-	    PerlProc_execv(form("%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
+	    PerlProc_execv(Perl_form(aTHX_ "%s/sperl%s", BIN_EXP, PL_patchlevel), PL_origargv);
 #endif
-	    croak("Can't do setuid\n");
+	    Perl_croak(aTHX_ "Can't do setuid\n");
 	}
 
 	if (PL_statbuf.st_mode & S_ISGID && PL_statbuf.st_gid != PL_egid) {
@@ -2336,7 +2365,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif
 #endif
 	    if (PerlProc_getegid() != PL_statbuf.st_gid)
-		croak("Can't do setegid!\n");
+		Perl_croak(aTHX_ "Can't do setegid!\n");
 	}
 	if (PL_statbuf.st_mode & S_ISUID) {
 	    if (PL_statbuf.st_uid != PL_euid)
@@ -2354,7 +2383,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif
 #endif
 	    if (PerlProc_geteuid() != PL_statbuf.st_uid)
-		croak("Can't do seteuid!\n");
+		Perl_croak(aTHX_ "Can't do seteuid!\n");
 	}
 	else if (PL_uid) {			/* oops, mustn't run as root */
 #ifdef HAS_SETEUID
@@ -2371,19 +2400,19 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif
 #endif
 	    if (PerlProc_geteuid() != PL_uid)
-		croak("Can't do seteuid!\n");
+		Perl_croak(aTHX_ "Can't do seteuid!\n");
 	}
 	init_ids();
 	if (!cando(S_IXUSR,TRUE,&PL_statbuf))
-	    croak("Permission denied\n");	/* they can't do this */
+	    Perl_croak(aTHX_ "Permission denied\n");	/* they can't do this */
     }
 #ifdef IAMSUID
     else if (PL_preprocess)
-	croak("-P not allowed for setuid/setgid script\n");
+	Perl_croak(aTHX_ "-P not allowed for setuid/setgid script\n");
     else if (fdscript >= 0)
-	croak("fd script not allowed in suidperl\n");
+	Perl_croak(aTHX_ "fd script not allowed in suidperl\n");
     else
-	croak("Script is not setuid/setgid in suidperl\n");
+	Perl_croak(aTHX_ "Script is not setuid/setgid in suidperl\n");
 
     /* We absolutely must clear out any saved ids here, so we */
     /* exec the real perl, substituting fd script for scriptname. */
@@ -2392,14 +2421,14 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
     PerlLIO_lseek(PerlIO_fileno(PL_rsfp),(Off_t)0,0);  /* just in case rewind didn't */
     for (which = 1; PL_origargv[which] && PL_origargv[which] != scriptname; which++) ;
     if (!PL_origargv[which])
-	croak("Permission denied");
-    PL_origargv[which] = savepv(form("/dev/fd/%d/%s",
+	Perl_croak(aTHX_ "Permission denied");
+    PL_origargv[which] = savepv(Perl_form(aTHX_ "/dev/fd/%d/%s",
 				  PerlIO_fileno(PL_rsfp), PL_origargv[which]));
 #if defined(HAS_FCNTL) && defined(F_SETFD)
     fcntl(PerlIO_fileno(PL_rsfp),F_SETFD,0);	/* ensure no close-on-exec */
 #endif
-    PerlProc_execv(form("%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
-    croak("Can't do setuid\n");
+    PerlProc_execv(Perl_form(aTHX_ "%s/perl%s", BIN_EXP, PL_patchlevel), PL_origargv);/* try again */
+    Perl_croak(aTHX_ "Can't do setuid\n");
 #endif /* IAMSUID */
 #else /* !DOSUID */
     if (PL_euid != PL_uid || PL_egid != PL_gid) {	/* (suidperl doesn't exist, in fact) */
@@ -2411,7 +2440,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 	    (PL_egid != PL_gid && PL_egid == PL_statbuf.st_gid && PL_statbuf.st_mode & S_ISGID)
 	   )
 	    if (!PL_do_undump)
-		croak("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
+		Perl_croak(aTHX_ "YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
 FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 #endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
 	/* not set-id, must be wrapped */
@@ -2420,7 +2449,7 @@ FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
 }
 
 STATIC void
-find_beginning(pTHX)
+S_find_beginning(pTHX)
 {
     register char *s, *s2;
 
@@ -2429,7 +2458,7 @@ find_beginning(pTHX)
     forbid_setid("-x");
     while (PL_doextract) {
 	if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch)
-	    croak("No Perl script found in input\n");
+	    Perl_croak(aTHX_ "No Perl script found in input\n");
 	if (*s == '#' && s[1] == '!' && (s = instr(s,"perl"))) {
 	    PerlIO_ungetc(PL_rsfp, '\n');		/* to keep line count right */
 	    PL_doextract = FALSE;
@@ -2443,19 +2472,19 @@ find_beginning(pTHX)
 		    while (s = moreswitches(s)) ;
 	    }
 	    if (PL_cddir && PerlDir_chdir(PL_cddir) < 0)
-		croak("Can't chdir to %s",PL_cddir);
+		Perl_croak(aTHX_ "Can't chdir to %s",PL_cddir);
 	}
     }
 }
 
 
 STATIC void
-init_ids(pTHX)
+S_init_ids(pTHX)
 {
-    PL_uid = (int)PerlProc_getuid();
-    PL_euid = (int)PerlProc_geteuid();
-    PL_gid = (int)PerlProc_getgid();
-    PL_egid = (int)PerlProc_getegid();
+    PL_uid = PerlProc_getuid();
+    PL_euid = PerlProc_geteuid();
+    PL_gid = PerlProc_getgid();
+    PL_egid = PerlProc_getegid();
 #ifdef VMS
     PL_uid |= PL_gid << 16;
     PL_euid |= PL_egid << 16;
@@ -2464,31 +2493,34 @@ init_ids(pTHX)
 }
 
 STATIC void
-forbid_setid(pTHX_ char *s)
+S_forbid_setid(pTHX_ char *s)
 {
     if (PL_euid != PL_uid)
-        croak("No %s allowed while running setuid", s);
+        Perl_croak(aTHX_ "No %s allowed while running setuid", s);
     if (PL_egid != PL_gid)
-        croak("No %s allowed while running setgid", s);
+        Perl_croak(aTHX_ "No %s allowed while running setgid", s);
 }
 
-STATIC void
-init_debugger(pTHX)
+void
+Perl_init_debugger(pTHX)
 {
     dTHR;
+    HV *ostash = PL_curstash;
+
     PL_curstash = PL_debstash;
     PL_dbargs = GvAV(gv_AVadd((gv_fetchpv("args", GV_ADDMULTI, SVt_PVAV))));
     AvREAL_off(PL_dbargs);
     PL_DBgv = gv_fetchpv("DB", GV_ADDMULTI, SVt_PVGV);
     PL_DBline = gv_fetchpv("dbline", GV_ADDMULTI, SVt_PVAV);
     PL_DBsub = gv_HVadd(gv_fetchpv("sub", GV_ADDMULTI, SVt_PVHV));
+    sv_upgrade(GvSV(PL_DBsub), SVt_IV);	/* IVX accessed if PERLDB_SUB_NN */
     PL_DBsingle = GvSV((gv_fetchpv("single", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsingle, 0); 
     PL_DBtrace = GvSV((gv_fetchpv("trace", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBtrace, 0); 
     PL_DBsignal = GvSV((gv_fetchpv("signal", GV_ADDMULTI, SVt_PV)));
     sv_setiv(PL_DBsignal, 0); 
-    PL_curstash = PL_defstash;
+    PL_curstash = ostash;
 }
 
 #ifndef STRESS_REALLOC
@@ -2498,7 +2530,7 @@ init_debugger(pTHX)
 #endif
 
 void
-Perl_init_stacks(pTHX_ ARGSproto)
+Perl_init_stacks(pTHX)
 {
     /* start with 128-item stack and 8K cxstack */
     PL_curstackinfo = new_stackinfo(REASONABLE(128),
@@ -2538,7 +2570,7 @@ Perl_init_stacks(pTHX_ ARGSproto)
 #undef REASONABLE
 
 STATIC void
-nuke_stacks(pTHX)
+S_nuke_stacks(pTHX)
 {
     dTHR;
     while (PL_curstackinfo->si_next)
@@ -2566,7 +2598,7 @@ static PerlIO *tmpfp;  /* moved outside init_lexer() because of UNICOS bug */
 #endif
 
 STATIC void
-init_lexer(pTHX)
+S_init_lexer(pTHX)
 {
 #ifdef PERL_OBJECT
 	PerlIO *tmpfp;
@@ -2579,34 +2611,38 @@ init_lexer(pTHX)
 }
 
 STATIC void
-init_predump_symbols(pTHX)
+S_init_predump_symbols(pTHX)
 {
     dTHR;
     GV *tmpgv;
     GV *othergv;
+    IO *io;
 
     sv_setpvn(get_sv("\"", TRUE), " ", 1);
     PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
-    IoIFP(GvIOp(PL_stdingv)) = PerlIO_stdin();
+    io = GvIOp(PL_stdingv);
+    IoIFP(io) = PerlIO_stdin();
     tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_stdingv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
     GvMULTI_on(tmpgv);
-    IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = PerlIO_stdout();
+    io = GvIOp(tmpgv);
+    IoOFP(io) = IoIFP(io) = PerlIO_stdout();
     setdefout(tmpgv);
     tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_defoutgv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
     GvMULTI_on(othergv);
-    IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = PerlIO_stderr();
+    io = GvIOp(othergv);
+    IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     PL_statname = NEWSV(66,0);		/* last filename we did stat on */
 
@@ -2615,7 +2651,7 @@ init_predump_symbols(pTHX)
 }
 
 STATIC void
-init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
+S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
 {
     dTHR;
     char *s;
@@ -2667,7 +2703,7 @@ init_postdump_symbols(pTHX_ register int argc, register char **argv, register ch
 	GvMULTI_on(PL_envgv);
 	hv = GvHVn(PL_envgv);
 	hv_magic(hv, PL_envgv, 'E');
-#ifndef VMS  /* VMS doesn't have environ array */
+#if !defined( VMS) && !defined(EPOC)  /* VMS doesn't have environ array */
 	/* Note that if the supplied env parameter is actually a copy
 	   of the global environ then it may now point to free'd memory
 	   if the environment has been modified since. To avoid this
@@ -2703,7 +2739,7 @@ init_postdump_symbols(pTHX_ register int argc, register char **argv, register ch
 }
 
 STATIC void
-init_perllib(pTHX)
+S_init_perllib(pTHX)
 {
     char *s;
     if (!PL_tainting) {
@@ -2756,6 +2792,13 @@ init_perllib(pTHX)
     incpush(SITELIB_EXP, FALSE);
 #endif
 #endif
+#if defined(PERL_VENDORLIB_EXP)
+#if defined(WIN32) 
+    incpush(PERL_VENDORLIB_EXP, TRUE);
+#else
+    incpush(PERL_VENDORLIB_EXP, FALSE);
+#endif
+#endif
     if (!PL_tainting)
 	incpush(".", FALSE);
 }
@@ -2774,7 +2817,7 @@ init_perllib(pTHX)
 #endif 
 
 STATIC void
-incpush(pTHX_ char *p, int addsubdirs)
+S_incpush(pTHX_ char *p, int addsubdirs)
 {
     SV *subdir = Nullsv;
 
@@ -2862,13 +2905,16 @@ incpush(pTHX_ char *p, int addsubdirs)
 
 #ifdef USE_THREADS
 STATIC struct perl_thread *
-init_main_thread(pTHX)
+S_init_main_thread(pTHX)
 {
+#if !defined(PERL_IMPLICIT_CONTEXT)
     struct perl_thread *thr;
+#endif
     XPV *xpv;
 
     Newz(53, thr, 1, struct perl_thread);
     PL_curcop = &PL_compiling;
+    thr->interp = PERL_GET_INTERP;
     thr->cvcache = newHV();
     thr->threadsv = newAV();
     /* thr->threadsvp is set when find_threadsv is called */
@@ -2898,7 +2944,7 @@ init_main_thread(pTHX)
     MUTEX_UNLOCK(&PL_threads_mutex);
 
 #ifdef HAVE_THREAD_INTERN
-    init_thread_intern(thr);
+    Perl_init_thread_intern(thr);
 #endif
 
 #ifdef SET_THREAD_SELF
@@ -2923,8 +2969,11 @@ init_main_thread(pTHX)
     (void) find_threadsv("@");	/* Ensure $@ is initialised early */
 
     PL_maxscream = -1;
-    PL_regcompp = FUNC_NAME_TO_PTR(pregcomp);
-    PL_regexecp = FUNC_NAME_TO_PTR(regexec_flags);
+    PL_regcompp = MEMBER_TO_FPTR(Perl_pregcomp);
+    PL_regexecp = MEMBER_TO_FPTR(Perl_regexec_flags);
+    PL_regint_start = MEMBER_TO_FPTR(Perl_re_intuit_start);
+    PL_regint_string = MEMBER_TO_FPTR(Perl_re_intuit_string);
+    PL_regfree = MEMBER_TO_FPTR(Perl_pregfree);
     PL_regindent = 0;
     PL_reginterp_cnt = 0;
 
@@ -2945,7 +2994,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     while (AvFILL(paramList) >= 0) {
 	cv = (CV*)av_shift(paramList);
 	SAVEFREESV(cv);
-	CALLPROTECT(&ret, FUNC_NAME_TO_PTR(call_list_body), cv);
+	CALLPROTECT(aTHX_ &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
 	switch (ret) {
 	case 0:
 	    (void)SvPV(atsv, len);
@@ -2958,7 +3007,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 		    sv_catpv(atsv, "END failed--cleanup aborted");
 		while (PL_scopestack_ix > oldscope)
 		    LEAVE;
-		croak("%s", SvPVX(atsv));
+		Perl_croak(aTHX_ "%s", SvPVX(atsv));
 	    }
 	    break;
 	case 1:
@@ -2976,9 +3025,9 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 	    PL_curcop->cop_line = oldline;
 	    if (PL_statusvalue) {
 		if (paramList == PL_beginav)
-		    croak("BEGIN failed--compilation aborted");
+		    Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
 		else
-		    croak("END failed--cleanup aborted");
+		    Perl_croak(aTHX_ "END failed--cleanup aborted");
 	    }
 	    my_exit_jump();
 	    /* NOTREACHED */
@@ -2996,7 +3045,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 }
 
 STATIC void *
-call_list_body(pTHX_ va_list args)
+S_call_list_body(pTHX_ va_list args)
 {
     dTHR;
     CV *cv = va_arg(args, CV*);
@@ -3057,7 +3106,7 @@ Perl_my_failure_exit(pTHX)
 }
 
 STATIC void
-my_exit_jump(pTHX)
+S_my_exit_jump(pTHX)
 {
     dTHR;
     register PERL_CONTEXT *cx;
@@ -3082,12 +3131,11 @@ my_exit_jump(pTHX)
 
 #ifdef PERL_OBJECT
 #define NO_XSLOCKS
-#endif  /* PERL_OBJECT */
-
 #include "XSUB.h"
+#endif
 
-STATIC I32
-read_e_script(pTHX_ int idx, SV *buf_sv, int maxlen)
+static I32
+read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)
 {
     char *p, *nl;
     p  = SvPVX(PL_e_script);