make change#3386 a build-time option (avoids problems due to

perl_run() longjmping out)

p4raw-link: @3386 on //depot/perl: 312caa8e97f1c7ee342a9895c2f0e749625b4929

p4raw-id: //depot/perl@5162

16 files changed, 286 insertions, 86 deletions

diff --git a/Todo-5.6 b/Todo-5.6
index 28b146da4c..8ae31ad497 100644
--- a/Todo-5.6
+++ b/Todo-5.6
@@ -1,5 +1,4 @@
 Bugs
-    perl_run() can longjmp out
     fix small memory leaks on compile-time failures
 
 Unicode support
diff --git a/embed.h b/embed.h
index be6a68527f..ea76f70911 100644
--- a/embed.h
+++ b/embed.h
@@ -774,8 +774,10 @@
 #define do_pmop_dump		Perl_do_pmop_dump
 #define do_sv_dump		Perl_do_sv_dump
 #define magic_dump		Perl_magic_dump
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 #define default_protect		Perl_default_protect
 #define vdefault_protect	Perl_vdefault_protect
+#endif
 #define reginitcolors		Perl_reginitcolors
 #define sv_2pv_nolen		Perl_sv_2pv_nolen
 #define sv_2pvutf8_nolen	Perl_sv_2pvutf8_nolen
@@ -902,8 +904,13 @@
 #define parse_body		S_parse_body
 #define run_body		S_run_body
 #define call_body		S_call_body
-#define call_xbody		S_call_xbody
 #define call_list_body		S_call_list_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vparse_body		S_vparse_body
+#define vrun_body		S_vrun_body
+#define vcall_body		S_vcall_body
+#define vcall_list_body		S_vcall_list_body
+#endif
 #  if defined(USE_THREADS)
 #define init_main_thread	S_init_main_thread
 #  endif
@@ -919,6 +926,9 @@
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 #define docatch			S_docatch
 #define docatch_body		S_docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vdocatch_body		S_vdocatch_body
+#endif
 #define dofindlabel		S_dofindlabel
 #define doparseform		S_doparseform
 #define dopoptoeval		S_dopoptoeval
@@ -2187,7 +2197,9 @@
 #define do_pmop_dump(a,b,c)	Perl_do_pmop_dump(aTHX_ a,b,c)
 #define do_sv_dump(a,b,c,d,e,f,g)	Perl_do_sv_dump(aTHX_ a,b,c,d,e,f,g)
 #define magic_dump(a)		Perl_magic_dump(aTHX_ a)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 #define vdefault_protect(a,b,c,d)	Perl_vdefault_protect(aTHX_ a,b,c,d)
+#endif
 #define reginitcolors()		Perl_reginitcolors(aTHX)
 #define sv_2pv_nolen(a)		Perl_sv_2pv_nolen(aTHX_ a)
 #define sv_2pvutf8_nolen(a)	Perl_sv_2pvutf8_nolen(aTHX_ a)
@@ -2311,11 +2323,16 @@
 #  if defined(IAMSUID)
 #define fd_on_nosuid_fs(a)	S_fd_on_nosuid_fs(aTHX_ a)
 #  endif
-#define parse_body(a)		S_parse_body(aTHX_ a)
+#define parse_body(a,b)		S_parse_body(aTHX_ a,b)
 #define run_body(a)		S_run_body(aTHX_ a)
-#define call_body(a)		S_call_body(aTHX_ a)
-#define call_xbody(a,b)		S_call_xbody(aTHX_ a,b)
+#define call_body(a,b)		S_call_body(aTHX_ a,b)
 #define call_list_body(a)	S_call_list_body(aTHX_ a)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vparse_body(a)		S_vparse_body(aTHX_ a)
+#define vrun_body(a)		S_vrun_body(aTHX_ a)
+#define vcall_body(a)		S_vcall_body(aTHX_ a)
+#define vcall_list_body(a)	S_vcall_list_body(aTHX_ a)
+#endif
 #  if defined(USE_THREADS)
 #define init_main_thread()	S_init_main_thread(aTHX)
 #  endif
@@ -2330,7 +2347,10 @@
 #endif
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 #define docatch(a)		S_docatch(aTHX_ a)
-#define docatch_body(a)		S_docatch_body(aTHX_ a)
+#define docatch_body()		S_docatch_body(aTHX)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define vdocatch_body(a)	S_vdocatch_body(aTHX_ a)
+#endif
 #define dofindlabel(a,b,c,d)	S_dofindlabel(aTHX_ a,b,c,d)
 #define doparseform(a)		S_doparseform(aTHX_ a)
 #define dopoptoeval(a)		S_dopoptoeval(aTHX_ a)
@@ -4289,10 +4309,12 @@
 #define do_sv_dump		Perl_do_sv_dump
 #define Perl_magic_dump		CPerlObj::Perl_magic_dump
 #define magic_dump		Perl_magic_dump
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 #define Perl_default_protect	CPerlObj::Perl_default_protect
 #define default_protect		Perl_default_protect
 #define Perl_vdefault_protect	CPerlObj::Perl_vdefault_protect
 #define vdefault_protect	Perl_vdefault_protect
+#endif
 #define Perl_reginitcolors	CPerlObj::Perl_reginitcolors
 #define reginitcolors		Perl_reginitcolors
 #define Perl_sv_2pv_nolen	CPerlObj::Perl_sv_2pv_nolen
@@ -4521,10 +4543,18 @@
 #define run_body		S_run_body
 #define S_call_body		CPerlObj::S_call_body
 #define call_body		S_call_body
-#define S_call_xbody		CPerlObj::S_call_xbody
-#define call_xbody		S_call_xbody
 #define S_call_list_body	CPerlObj::S_call_list_body
 #define call_list_body		S_call_list_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define S_vparse_body		CPerlObj::S_vparse_body
+#define vparse_body		S_vparse_body
+#define S_vrun_body		CPerlObj::S_vrun_body
+#define vrun_body		S_vrun_body
+#define S_vcall_body		CPerlObj::S_vcall_body
+#define vcall_body		S_vcall_body
+#define S_vcall_list_body	CPerlObj::S_vcall_list_body
+#define vcall_list_body		S_vcall_list_body
+#endif
 #  if defined(USE_THREADS)
 #define S_init_main_thread	CPerlObj::S_init_main_thread
 #define init_main_thread	S_init_main_thread
@@ -4549,6 +4579,10 @@
 #define docatch			S_docatch
 #define S_docatch_body		CPerlObj::S_docatch_body
 #define docatch_body		S_docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#define S_vdocatch_body		CPerlObj::S_vdocatch_body
+#define vdocatch_body		S_vdocatch_body
+#endif
 #define S_dofindlabel		CPerlObj::S_dofindlabel
 #define dofindlabel		S_dofindlabel
 #define S_doparseform		CPerlObj::S_doparseform
diff --git a/embed.pl b/embed.pl
index 3366a24b81..c1967d2214 100755
--- a/embed.pl
+++ b/embed.pl
@@ -2097,10 +2097,12 @@ Ap	|void	|do_pmop_dump	|I32 level|PerlIO *file|PMOP *pm
 Ap	|void	|do_sv_dump	|I32 level|PerlIO *file|SV *sv|I32 nest \
 				|I32 maxnest|bool dumpops|STRLEN pvlim
 Ap	|void	|magic_dump	|MAGIC *mg
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 Ap	|void*	|default_protect|volatile JMPENV *je|int *excpt \
 				|protect_body_t body|...
 Ap	|void*	|vdefault_protect|volatile JMPENV *je|int *excpt \
 				|protect_body_t body|va_list *args
+#endif
 Ap	|void	|reginitcolors
 Ap	|char*	|sv_2pv_nolen	|SV* sv
 Ap	|char*	|sv_2pvutf8_nolen|SV* sv
@@ -2237,11 +2239,16 @@ s	|void	|validate_suid	|char *|char*|int
 #  if defined(IAMSUID)
 s	|int	|fd_on_nosuid_fs|int fd
 #  endif
-s	|void*	|parse_body	|va_list args
-s	|void*	|run_body	|va_list args
-s	|void*	|call_body	|va_list args
-s	|void	|call_xbody	|OP *myop|int is_eval
-s	|void*	|call_list_body	|va_list args
+s	|void*	|parse_body	|char **env|XSINIT_t xsinit
+s	|void*	|run_body	|I32 oldscope
+s	|void	|call_body	|OP *myop|int is_eval
+s	|void*	|call_list_body	|CV *cv
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+s	|void*	|vparse_body	|va_list args
+s	|void*	|vrun_body	|va_list args
+s	|void*	|vcall_body	|va_list args
+s	|void*	|vcall_list_body|va_list args
+#endif
 #  if defined(USE_THREADS)
 s	|struct perl_thread *	|init_main_thread
 #  endif
@@ -2258,7 +2265,10 @@ s	|int	|div128		|SV *pnum|bool *done
 
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 s	|OP*	|docatch	|OP *o
-s	|void*	|docatch_body	|va_list args
+s	|void*	|docatch_body
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+s	|void*	|vdocatch_body	|va_list args
+#endif
 s	|OP*	|dofindlabel	|OP *o|char *label|OP **opstack|OP **oplimit
 s	|void	|doparseform	|SV *sv
 s	|I32	|dopoptoeval	|I32 startingblock
diff --git a/intrpvar.h b/intrpvar.h
index e578b1ab19..14037873b9 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -8,10 +8,7 @@
  * generated when built with or without MULTIPLICITY.  It is also used
  * to generate the appropriate export list for win32.
  *
- * When building without MULTIPLICITY, these variables will be truly global.
- *
- * Avoid build-specific #ifdefs here, like DEBUGGING.  That way,
- * we can keep binary compatibility of the curinterp structure */
+ * When building without MULTIPLICITY, these variables will be truly global. */
 
 /* pseudo environmental stuff */
 PERLVAR(Iorigargc,	int)
diff --git a/objXSUB.h b/objXSUB.h
index 2897a6ae5e..c2385f8b62 100644
--- a/objXSUB.h
+++ b/objXSUB.h
@@ -1987,6 +1987,7 @@
 #define Perl_magic_dump		pPerl->Perl_magic_dump
 #undef  magic_dump
 #define magic_dump		Perl_magic_dump
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 #undef  Perl_default_protect
 #define Perl_default_protect	pPerl->Perl_default_protect
 #undef  default_protect
@@ -1995,6 +1996,7 @@
 #define Perl_vdefault_protect	pPerl->Perl_vdefault_protect
 #undef  vdefault_protect
 #define vdefault_protect	Perl_vdefault_protect
+#endif
 #undef  Perl_reginitcolors
 #define Perl_reginitcolors	pPerl->Perl_reginitcolors
 #undef  reginitcolors
@@ -2151,12 +2153,16 @@
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 #  if defined(IAMSUID)
 #  endif
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
 #  if defined(USE_THREADS)
 #  endif
 #endif
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 #endif
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 #endif
diff --git a/perl.c b/perl.c
index 6776ac9497..eba7e5cd65 100644
--- a/perl.c
+++ b/perl.c
@@ -155,7 +155,9 @@ perl_construct(pTHXx)
 	thr = init_main_thread();
 #endif /* USE_THREADS */
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 	PL_protect = MEMBER_TO_FPTR(Perl_default_protect); /* for exceptions */
+#endif
 
 	PL_curcop = &PL_compiling;	/* needed by ckWARN, right away */
 
@@ -800,13 +802,20 @@ setuid perl scripts securely.\n");
     oldscope = PL_scopestack_ix;
     PL_dowarn = G_WARN_OFF;
 
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_parse_body),
-		env, xsinit);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vparse_body), env, xsinit);
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+	parse_body(env,xsinit);
+#endif
 	if (PL_checkav)
 	    call_list(oldscope, PL_checkav);
-	return 0;
+	ret = 0;
+	break;
     case 1:
 	STATUS_ALL_FAILURE;
 	/* FALL THROUGH */
@@ -818,21 +827,34 @@ setuid perl scripts securely.\n");
 	PL_curstash = PL_defstash;
 	if (PL_checkav)
 	    call_list(oldscope, PL_checkav);
-	return STATUS_NATIVE_EXPORT;
+	ret = STATUS_NATIVE_EXPORT;
+	break;
     case 3:
 	PerlIO_printf(Perl_error_log, "panic: top_env\n");
-	return 1;
+	ret = 1;
+	break;
     }
-    return 0;
+    JMPENV_POP;
+    return ret;
+}
+
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+STATIC void *
+S_vparse_body(pTHX_ va_list args)
+{
+    char **env = va_arg(args, char**);
+    XSINIT_t xsinit = va_arg(args, XSINIT_t);
+
+    return parse_body(env, xsinit);
 }
+#endif
 
 STATIC void *
-S_parse_body(pTHX_ va_list args)
+S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 {
     dTHR;
     int argc = PL_origargc;
     char **argv = PL_origargv;
-    char **env = va_arg(args, char**);
     char *scriptname = NULL;
     int fdscript = -1;
     VOL bool dosearch = FALSE;
@@ -842,8 +864,6 @@ S_parse_body(pTHX_ va_list args)
     register char *s;
     char *cddir = Nullch;
 
-    XSINIT_t xsinit = va_arg(args, XSINIT_t);
-
     sv_setpvn(PL_linestr,"",0);
     sv = newSVpvn("",0);		/* first used for -I flags */
     SAVEFREESV(sv);
@@ -1230,7 +1250,7 @@ perl_run(pTHXx)
 {
     dTHR;
     I32 oldscope;
-    int ret;
+    int ret = 0;
     dJMPENV;
 #ifdef USE_THREADS
     dTHX;
@@ -1238,14 +1258,23 @@ perl_run(pTHXx)
 
     oldscope = PL_scopestack_ix;
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_run_body), oldscope);
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vrun_body), oldscope);
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 1:
 	cxstack_ix = -1;		/* start context stack again */
 	goto redo_body;
-    case 0:  /* normal completion */
-    case 2:  /* my_exit() */
+    case 0:				/* normal completion */
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	run_body(oldscope);
+#endif
+	/* FALL THROUGH */
+    case 2:				/* my_exit() */
 	while (PL_scopestack_ix > oldscope)
 	    LEAVE;
 	FREETMPS;
@@ -1256,7 +1285,8 @@ perl_run(pTHXx)
 	if (PerlEnv_getenv("PERL_DEBUG_MSTATS"))
 	    dump_mstats("after execution:  ");
 #endif
-	return STATUS_NATIVE_EXPORT;
+	ret = STATUS_NATIVE_EXPORT;
+	break;
     case 3:
 	if (PL_restartop) {
 	    POPSTACK_TO(PL_mainstack);
@@ -1264,19 +1294,30 @@ perl_run(pTHXx)
 	}
 	PerlIO_printf(Perl_error_log, "panic: restartop\n");
 	FREETMPS;
-	return 1;
+	ret = 1;
+	break;
     }
 
-    /* NOTREACHED */
-    return 0;
+    JMPENV_POP;
+    return ret;
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
-S_run_body(pTHX_ va_list args)
+S_vrun_body(pTHX_ va_list args)
 {
-    dTHR;
     I32 oldscope = va_arg(args, I32);
 
+    return run_body(oldscope);
+}
+#endif
+
+
+STATIC void *
+S_run_body(pTHX_ I32 oldscope)
+{
+    dTHR;
+
     DEBUG_r(PerlIO_printf(Perl_debug_log, "%s $` $& $' support.\n",
                     PL_sawampersand ? "Enabling" : "Omitting"));
 
@@ -1543,7 +1584,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 
     if (!(flags & G_EVAL)) {
 	CATCH_SET(TRUE);
-	call_xbody((OP*)&myop, FALSE);
+	call_body((OP*)&myop, FALSE);
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
 	CATCH_SET(oldcatch);
     }
@@ -1571,11 +1612,19 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	}
 	PL_markstack_ptr++;
 
-  redo_body:
-	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
 		    (OP*)&myop, FALSE);
+#else
+	JMPENV_PUSH(ret);
+#endif
 	switch (ret) {
 	case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	    call_body((OP*)&myop, FALSE);
+#endif
 	    retval = PL_stack_sp - (PL_stack_base + oldmark);
 	    if (!(flags & G_KEEPERR))
 		sv_setpv(ERRSV,"");
@@ -1587,6 +1636,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    /* my_exit() was called */
 	    PL_curstash = PL_defstash;
 	    FREETMPS;
+	    JMPENV_POP;
 	    if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
 		Perl_croak(aTHX_ "Callback called exit");
 	    my_exit_jump();
@@ -1620,6 +1670,7 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
 	    PL_curpm = newpm;
 	    LEAVE;
 	}
+	JMPENV_POP;
     }
 
     if (flags & G_DISCARD) {
@@ -1632,18 +1683,20 @@ Perl_call_sv(pTHX_ SV *sv, I32 flags)
     return retval;
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
-S_call_body(pTHX_ va_list args)
+S_vcall_body(pTHX_ va_list args)
 {
     OP *myop = va_arg(args, OP*);
     int is_eval = va_arg(args, int);
 
-    call_xbody(myop, is_eval);
+    call_body(myop, is_eval);
     return NULL;
 }
+#endif
 
 STATIC void
-S_call_xbody(pTHX_ OP *myop, int is_eval)
+S_call_body(pTHX_ OP *myop, int is_eval)
 {
     dTHR;
 
@@ -1703,11 +1756,19 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     if (flags & G_KEEPERR)
 	myop.op_flags |= OPf_SPECIAL;
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
-    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_body),
+    CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_body),
 		(OP*)&myop, TRUE);
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	call_body((OP*)&myop,TRUE);
+#endif
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
 	if (!(flags & G_KEEPERR))
 	    sv_setpv(ERRSV,"");
@@ -1719,6 +1780,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	/* my_exit() was called */
 	PL_curstash = PL_defstash;
 	FREETMPS;
+	JMPENV_POP;
 	if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
 	    Perl_croak(aTHX_ "Callback called exit");
 	my_exit_jump();
@@ -1739,6 +1801,7 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	break;
     }
 
+    JMPENV_POP;
     if (flags & G_DISCARD) {
 	PL_stack_sp = PL_stack_base + oldmark;
 	retval = 0;
@@ -3373,9 +3436,16 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
     while (AvFILL(paramList) >= 0) {
 	cv = (CV*)av_shift(paramList);
 	SAVEFREESV(cv);
-	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_call_list_body), cv);
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+	CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
+#else
+	JMPENV_PUSH(ret);
+#endif
 	switch (ret) {
 	case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+	    call_list_body(cv);
+#endif
 	    atsv = ERRSV;
 	    (void)SvPV(atsv, len);
 	    if (len) {
@@ -3392,6 +3462,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 				   : "END");
 		while (PL_scopestack_ix > oldscope)
 		    LEAVE;
+		JMPENV_POP;
 		Perl_croak(aTHX_ "%s", SvPVx(atsv, n_a));
 	    }
 	    break;
@@ -3406,6 +3477,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 	    PL_curstash = PL_defstash;
 	    PL_curcop = &PL_compiling;
 	    CopLINE_set(PL_curcop, oldline);
+	    JMPENV_POP;
 	    if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
 		if (paramList == PL_beginav)
 		    Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
@@ -3427,15 +3499,22 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 	    FREETMPS;
 	    break;
 	}
+	JMPENV_POP;
     }
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
-S_call_list_body(pTHX_ va_list args)
+S_vcall_list_body(pTHX_ va_list args)
 {
-    dTHR;
     CV *cv = va_arg(args, CV*);
+    return call_list_body(cv);
+}
+#endif
 
+STATIC void *
+S_call_list_body(pTHX_ CV *cv)
+{
     PUSHMARK(PL_stack_sp);
     call_sv((SV*)cv, G_EVAL|G_DISCARD);
     return NULL;
diff --git a/perl.h b/perl.h
index 66162e6ec9..cdf1ecd3fb 100644
--- a/perl.h
+++ b/perl.h
@@ -215,7 +215,10 @@ struct perl_thread;
 #define CALLREG_INTUIT_START CALL_FPTR(PL_regint_start)
 #define CALLREG_INTUIT_STRING CALL_FPTR(PL_regint_string)
 #define CALLREGFREE CALL_FPTR(PL_regfree)
-#define CALLPROTECT CALL_FPTR(PL_protect)
+
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
+#  define CALLPROTECT CALL_FPTR(PL_protect)
+#endif
 
 #define NOOP (void)0
 #define dNOOP extern int Perl___notused
diff --git a/perlapi.c b/perlapi.c
index f0824984b3..c4653ccc14 100644
--- a/perlapi.c
+++ b/perlapi.c
@@ -3589,6 +3589,7 @@ Perl_magic_dump(pTHXo_ MAGIC *mg)
 {
     ((CPerlObj*)pPerl)->Perl_magic_dump(mg);
 }
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 
 #undef  Perl_default_protect
 void*
@@ -3609,6 +3610,7 @@ Perl_vdefault_protect(pTHXo_ volatile JMPENV *je, int *excpt, protect_body_t bod
 {
     return ((CPerlObj*)pPerl)->Perl_vdefault_protect(je, excpt, body, args);
 }
+#endif
 
 #undef  Perl_reginitcolors
 void
@@ -3864,12 +3866,16 @@ Perl_ptr_table_split(pTHXo_ PTR_TBL_t *tbl)
 #if defined(PERL_IN_PERL_C) || defined(PERL_DECL_PROT)
 #  if defined(IAMSUID)
 #  endif
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
 #  if defined(USE_THREADS)
 #  endif
 #endif
 #if defined(PERL_IN_PP_C) || defined(PERL_DECL_PROT)
 #endif
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+#endif
 #endif
 #if defined(PERL_IN_PP_HOT_C) || defined(PERL_DECL_PROT)
 #endif
diff --git a/perlvars.h b/perlvars.h
index 55769d55ca..220574a2be 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -11,11 +11,7 @@
  *
  * The 'G' prefix is only needed for vars that need appropriate #defines
  * generated in embed*.h.  Such symbols are also used to generate
- * the appropriate export list for win32.
- *
- * Avoid build-specific #ifdefs here, like DEBUGGING.  That way,
- * we can keep binary compatibility of the curinterp structure */
-
+ * the appropriate export list for win32. */
 
 /* global state */
 PERLVAR(Gcurinterp,	PerlInterpreter *)
diff --git a/pp_ctl.c b/pp_ctl.c
index 030bcbd166..24fad37430 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2521,9 +2521,17 @@ S_save_lines(pTHX_ AV *array, SV *sv)
     }
 }
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 STATIC void *
 S_docatch_body(pTHX_ va_list args)
 {
+    return docatch_body();
+}
+#endif
+
+STATIC void *
+S_docatch_body(pTHX)
+{
     CALLRUNOPS(aTHX);
     return NULL;
 }
@@ -2541,10 +2549,18 @@ S_docatch(pTHX_ OP *o)
     assert(CATCH_GET == TRUE);
 #endif
     PL_op = o;
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
     CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
+#else
+    JMPENV_PUSH(ret);
+#endif
     switch (ret) {
     case 0:
+#ifndef PERL_FLEXIBLE_EXCEPTIONS
+ redo_body:
+	docatch_body();
+#endif
 	break;
     case 3:
 	if (PL_restartop && cursi == PL_curstackinfo) {
@@ -2554,10 +2570,12 @@ S_docatch(pTHX_ OP *o)
 	}
 	/* FALL THROUGH */
     default:
+	JMPENV_POP;
 	PL_op = oldop;
 	JMPENV_JUMP(ret);
 	/* NOTREACHED */
     }
+    JMPENV_POP;
     PL_op = oldop;
     return Nullop;
 }
diff --git a/proto.h b/proto.h
index 31b8f45649..d4e218f8da 100644
--- a/proto.h
+++ b/proto.h
@@ -876,8 +876,10 @@ PERL_CALLCONV void	Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o);
 PERL_CALLCONV void	Perl_do_pmop_dump(pTHX_ I32 level, PerlIO *file, PMOP *pm);
 PERL_CALLCONV void	Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bool dumpops, STRLEN pvlim);
 PERL_CALLCONV void	Perl_magic_dump(pTHX_ MAGIC *mg);
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 PERL_CALLCONV void*	Perl_default_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, ...);
 PERL_CALLCONV void*	Perl_vdefault_protect(pTHX_ volatile JMPENV *je, int *excpt, protect_body_t body, va_list *args);
+#endif
 PERL_CALLCONV void	Perl_reginitcolors(pTHX);
 PERL_CALLCONV char*	Perl_sv_2pv_nolen(pTHX_ SV* sv);
 PERL_CALLCONV char*	Perl_sv_2pvutf8_nolen(pTHX_ SV* sv);
@@ -1011,11 +1013,16 @@ STATIC void	S_validate_suid(pTHX_ char *, char*, int);
 #  if defined(IAMSUID)
 STATIC int	S_fd_on_nosuid_fs(pTHX_ int fd);
 #  endif
-STATIC void*	S_parse_body(pTHX_ va_list args);
-STATIC void*	S_run_body(pTHX_ va_list args);
-STATIC void*	S_call_body(pTHX_ va_list args);
-STATIC void	S_call_xbody(pTHX_ OP *myop, int is_eval);
-STATIC void*	S_call_list_body(pTHX_ va_list args);
+STATIC void*	S_parse_body(pTHX_ char **env, XSINIT_t xsinit);
+STATIC void*	S_run_body(pTHX_ I32 oldscope);
+STATIC void	S_call_body(pTHX_ OP *myop, int is_eval);
+STATIC void*	S_call_list_body(pTHX_ CV *cv);
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+STATIC void*	S_vparse_body(pTHX_ va_list args);
+STATIC void*	S_vrun_body(pTHX_ va_list args);
+STATIC void*	S_vcall_body(pTHX_ va_list args);
+STATIC void*	S_vcall_list_body(pTHX_ va_list args);
+#endif
 #  if defined(USE_THREADS)
 STATIC struct perl_thread *	S_init_main_thread(pTHX);
 #  endif
@@ -1032,7 +1039,10 @@ STATIC int	S_div128(pTHX_ SV *pnum, bool *done);
 
 #if defined(PERL_IN_PP_CTL_C) || defined(PERL_DECL_PROT)
 STATIC OP*	S_docatch(pTHX_ OP *o);
-STATIC void*	S_docatch_body(pTHX_ va_list args);
+STATIC void*	S_docatch_body(pTHX);
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
+STATIC void*	S_vdocatch_body(pTHX_ va_list args);
+#endif
 STATIC OP*	S_dofindlabel(pTHX_ OP *o, char *label, OP **opstack, OP **oplimit);
 STATIC void	S_doparseform(pTHX_ SV *sv);
 STATIC I32	S_dopoptoeval(pTHX_ I32 startingblock);
diff --git a/scope.c b/scope.c
index e6c31259ec..740000a44d 100644
--- a/scope.c
+++ b/scope.c
@@ -16,6 +16,7 @@
 #define PERL_IN_SCOPE_C
 #include "perl.h"
 
+#if defined(PERL_FLEXIBLE_EXCEPTIONS)
 void *
 Perl_default_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
 		     protect_body_t body, ...)
@@ -36,8 +37,6 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
     int ex;
     void *ret;
 
-    DEBUG_l(Perl_deb(aTHX_ "Setting up local jumplevel %p, was %p\n",
-		pcur_env, PL_top_env));
     JMPENV_PUSH(ex);
     if (ex)
 	ret = NULL;
@@ -47,6 +46,7 @@ Perl_vdefault_protect(pTHX_ volatile JMPENV *pcur_env, int *excpt,
     JMPENV_POP;
     return ret;
 }
+#endif
 
 SV**
 Perl_stack_grow(pTHX_ SV **sp, SV **p, int n)
diff --git a/scope.h b/scope.h
index fa211996e6..f33154abed 100644
--- a/scope.h
+++ b/scope.h
@@ -193,19 +193,21 @@ struct jmpenv {
     Sigjmp_buf		je_buf;		/* only for use if !je_throw */
     int			je_ret;		/* last exception thrown */
     bool		je_mustcatch;	/* need to call longjmp()? */
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
     void		(*je_throw)(int v); /* last for bincompat */
     bool		je_noset;	/* no need for setjmp() */
+#endif
 };
 
 typedef struct jmpenv JMPENV;
 
-/*
- * Function that catches/throws, and its callback for the
- *  body of protected processing.
- */
-typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
-typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
-					     int *, protect_body_t, ...);
+#ifdef OP_IN_REGISTER
+#define OP_REG_TO_MEM	PL_opsave = op
+#define OP_MEM_TO_REG	op = PL_opsave
+#else
+#define OP_REG_TO_MEM	NOOP
+#define OP_MEM_TO_REG	NOOP
+#endif
 
 /*
  * How to build the first jmpenv.
@@ -219,21 +221,13 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
 
 #define JMPENV_BOOTSTRAP \
     STMT_START {				\
-	PL_start_env.je_prev = NULL;		\
-	PL_start_env.je_throw = NULL;		\
+	Zero(&PL_start_env, 1, JMPENV);		\
 	PL_start_env.je_ret = -1;		\
 	PL_start_env.je_mustcatch = TRUE;	\
-	PL_start_env.je_noset = 0;		\
 	PL_top_env = &PL_start_env;		\
     } STMT_END
 
-#ifdef OP_IN_REGISTER
-#define OP_REG_TO_MEM	PL_opsave = op
-#define OP_MEM_TO_REG	op = PL_opsave
-#else
-#define OP_REG_TO_MEM	NOOP
-#define OP_MEM_TO_REG	NOOP
-#endif
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 
 /*
  * These exception-handling macros are split up to
@@ -265,6 +259,14 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
  *    JMPENV_POP;  // don't forget this!
  */
 
+/*
+ * Function that catches/throws, and its callback for the
+ *  body of protected processing.
+ */
+typedef void *(CPERLscope(*protect_body_t)) (pTHX_ va_list);
+typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
+					     int *, protect_body_t, ...);
+
 #define dJMPENV	JMPENV cur_env;	\
 		volatile JMPENV *pcur_env = ((cur_env.je_noset = 0),&cur_env)
 
@@ -288,10 +290,11 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
 
 #define JMPENV_POST_CATCH JMPENV_POST_CATCH_ENV(*(JMPENV*)pcur_env)
 
-
 #define JMPENV_PUSH_ENV(ce,v) \
     STMT_START {						\
 	if (!(ce).je_noset) {					\
+	    DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",	\
+			     ce, PL_top_env));			\
 	    JMPENV_PUSH_INIT_ENV(ce,NULL);			\
 	    EXCEPT_SET_ENV(ce,PerlProc_setjmp((ce).je_buf, 1));\
 	    (ce).je_noset = 1;					\
@@ -305,7 +308,10 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
 #define JMPENV_PUSH(v) JMPENV_PUSH_ENV(*(JMPENV*)pcur_env,v) 
 
 #define JMPENV_POP_ENV(ce) \
-    STMT_START { PL_top_env = (ce).je_prev; } STMT_END
+    STMT_START {						\
+	if (PL_top_env == &(ce))				\
+	    PL_top_env = (ce).je_prev;				\
+    } STMT_END
 
 #define JMPENV_POP  JMPENV_POP_ENV(*(JMPENV*)pcur_env) 
 
@@ -329,5 +335,38 @@ typedef void *(CPERLscope(*protect_proc_t)) (pTHX_ volatile JMPENV *pcur_env,
 #define EXCEPT_SET_ENV(ce,v)	((ce).je_ret = (v))
 #define EXCEPT_SET(v)		EXCEPT_SET_ENV(*(JMPENV*)pcur_env,v)
 
+#else /* !PERL_FLEXIBLE_EXCEPTIONS */
+
+#define dJMPENV		JMPENV cur_env
+
+#define JMPENV_PUSH(v) \
+    STMT_START {							\
+	DEBUG_l(Perl_deb(aTHX_ "Setting up jumplevel %p, was %p\n",	\
+			 &cur_env, PL_top_env));			\
+	cur_env.je_prev = PL_top_env;					\
+	OP_REG_TO_MEM;							\
+	cur_env.je_ret = PerlProc_setjmp(cur_env.je_buf, 1);		\
+	OP_MEM_TO_REG;							\
+	PL_top_env = &cur_env;						\
+	cur_env.je_mustcatch = FALSE;					\
+	(v) = cur_env.je_ret;						\
+    } STMT_END
+
+#define JMPENV_POP \
+    STMT_START { PL_top_env = cur_env.je_prev; } STMT_END
+
+#define JMPENV_JUMP(v) \
+    STMT_START {						\
+	OP_REG_TO_MEM;						\
+	if (PL_top_env->je_prev)				\
+	    PerlProc_longjmp(PL_top_env->je_buf, (v));		\
+	if ((v) == 2)						\
+	    PerlProc_exit(STATUS_NATIVE_EXPORT);		\
+	PerlIO_printf(PerlIO_stderr(), "panic: top_env\n");	\
+	PerlProc_exit(1);					\
+    } STMT_END
+
+#endif /* PERL_FLEXIBLE_EXCEPTIONS */
+
 #define CATCH_GET		(PL_top_env->je_mustcatch)
 #define CATCH_SET(v)		(PL_top_env->je_mustcatch = (v))
diff --git a/sv.c b/sv.c
index 7b52000982..43ed4e4d55 100644
--- a/sv.c
+++ b/sv.c
@@ -107,7 +107,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
     SV* sva = (SV*)ptr;
     register SV* sv;
     register SV* svend;
-    Zero(sva, size, char);
+    Zero(ptr, size, char);
 
     /* The first SV in an arena isn't an SV. */
     SvANY(sva) = (void *) PL_sv_arenaroot;		/* ptr to next arena */
@@ -7853,7 +7853,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_dirty		= proto_perl->Tdirty;
     PL_localizing	= proto_perl->Tlocalizing;
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
     PL_protect		= proto_perl->Tprotect;
+#endif
     PL_errors		= sv_dup_inc(proto_perl->Terrors);
     PL_av_fetch_sv	= Nullsv;
     PL_hv_fetch_sv	= Nullsv;
diff --git a/thrdvar.h b/thrdvar.h
index 814842c5da..e4cfacc06c 100644
--- a/thrdvar.h
+++ b/thrdvar.h
@@ -10,10 +10,7 @@
  *
  * When building without USE_THREADS, these variables will be truly global.
  * When building without USE_THREADS but with MULTIPLICITY, these variables
- * will be global per-interpreter.
- *
- * Avoid build-specific #ifdefs here, like DEBUGGING.  That way,
- * we can keep binary compatibility of the curinterp structure */
+ * will be global per-interpreter. */
 
 /* Important ones in the first cache line (if alignment is done right) */
 
@@ -112,7 +109,9 @@ PERLVAR(Tmainstack,	AV *)		/* the stack when nothing funny is happening */
 
 PERLVAR(Ttop_env,	JMPENV *)	/* ptr. to current sigjmp() environment */
 PERLVAR(Tstart_env,	JMPENV)		/* empty startup sigjmp() environment */
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
 PERLVARI(Tprotect,	protect_proc_t,	MEMBER_TO_FPTR(Perl_default_protect))
+#endif
 PERLVARI(Terrors,	SV *, Nullsv)	/* outstanding queued errors */
 
 /* statics "owned" by various functions */
diff --git a/util.c b/util.c
index 6359125ef8..1525d53af1 100644
--- a/util.c
+++ b/util.c
@@ -3488,7 +3488,9 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t)
     /* parent thread's data needs to be locked while we make copy */
     MUTEX_LOCK(&t->mutex);
 
+#ifdef PERL_FLEXIBLE_EXCEPTIONS
     PL_protect = t->Tprotect;
+#endif
 
     PL_curcop = t->Tcurcop;       /* XXX As good a guess as any? */
     PL_defstash = t->Tdefstash;   /* XXX maybe these should */