Re: Factor out some common code of jmpenv blocks

[email protected] (Gerard Goossen)
Newsgroups perl.perl5.porters
Message-ID <[email protected]> 
On Sun, May 30, 2010 at 03:11:06PM +0100, Dave Mitchell wrote:
> On Sat, May 29, 2010 at 08:40:07PM +0200, Gerard Goossen wrote:
> > My fault, after rebasing I forgot to commit the latest changes 
> > (they were already added, so git diff didn't show anything :( )
> > Attached are the correct patches.
> 
> Having had a look at these changes, I'm concerned that although they are
> advertised as just factoring out some common code, they actually change
> execution behaviour. 

Advertising it at factoring out some common code, was wrong. It started
out that way, but soon it also contained some minor (irrelevant) changes.
The new attached patches, fixes the problem of calling it "factoring out"
and also add some documentation to the new funtion. Below is also an
explanation of why the changes.

> For example the code path in case 2 of call_sv() has
> changed from:
> 
>     PL_curstash = PL_defstash;
>     FREETMPS;
>     JMPENV_POP;
>     if (PL_e_script) {
> 	SvREFCNT_dec(PL_e_script);
> 	PL_e_script = NULL;
>     }
>     POPSTACK_TO(PL_mainstack);
>     dounwind(-1);
>     LEAVE_SCOPE(0);
>     JMPENV_JUMP(2);
> 
> to
> 
>     PL_top_env = PL_top_env->je_prev;
>     JMPENV_JUMP(2);
> 
> Now it may be that these excised steps are not needed, in which case I
> would much prefer to see a separate commit which explicitly removes them
> along with an explanation of why they aren't necessary.

Having an extra jmpenv level is something internal and shouldn't have any
effect (it shouldn't matter whether code is executed usin eval_sv/call_sv or pp_entersub).
Thus handling case 2 should just jump to the next level. That is the reason why
the code is removed, the reason why the original code didn't do anything is
because all that (poping the stack, unwinding, etc) is already done by the
initial my_exit call.

Gerard Goossen
0001-New-function-for-handling-ret-values-from-jmpenv-blo.patch (text/x-diff, 4.7 KB) 
From aa00110a07cfff08698cc37769a1f3647ac09c0b Mon Sep 17 00:00:00 2001
From: Gerard Goossen <[email protected]>
Date: Mon, 2 Nov 2009 14:22:26 +0100
Subject: [PATCH 1/4] New function for handling ret values from jmpenv blocks, plus use of this function in call_sv.

---
 embed.fnc |    1 +
 embed.h   |    6 ++++++
 perl.c    |   36 ++++++++++++++----------------------
 proto.h   |    1 +
 run.c     |   42 ++++++++++++++++++++++++++++++++++++++++++
 5 files changed, 64 insertions(+), 22 deletions(-)

diff --git a/embed.fnc b/embed.fnc
index 36d8c1a..102ce0f 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1337,6 +1337,7 @@ Ap	|struct perl_vars*|init_global_struct
 Ap	|void	|free_global_struct|NN struct perl_vars *plvarsp
 #endif
 Ap	|int	|runops_standard
+p	|int	|runops_continue_from_jmpenv|int ret
 Ap	|int	|runops_debug
 Afpd	|void	|sv_catpvf_mg	|NN SV *const sv|NN const char *const pat|...
 Apd	|void	|sv_vcatpvf_mg	|NN SV *const sv|NN const char *const pat \
diff --git a/embed.h b/embed.h
index 80457a2..46aeb8b 100644
--- a/embed.h
+++ b/embed.h
@@ -1117,6 +1117,9 @@
 #define free_global_struct	Perl_free_global_struct
 #endif
 #define runops_standard		Perl_runops_standard
+#ifdef PERL_CORE
+#define runops_continue_from_jmpenv	Perl_runops_continue_from_jmpenv
+#endif
 #define runops_debug		Perl_runops_debug
 #define sv_catpvf_mg		Perl_sv_catpvf_mg
 #define sv_vcatpvf_mg		Perl_sv_vcatpvf_mg
@@ -3548,6 +3551,9 @@
 #define free_global_struct(a)	Perl_free_global_struct(aTHX_ a)
 #endif
 #define runops_standard()	Perl_runops_standard(aTHX)
+#ifdef PERL_CORE
+#define runops_continue_from_jmpenv(a)	Perl_runops_continue_from_jmpenv(aTHX_ a)
+#endif
 #define runops_debug()		Perl_runops_debug(aTHX)
 #define sv_vcatpvf_mg(a,b,c)	Perl_sv_vcatpvf_mg(aTHX_ a,b,c)
 #define sv_catpv_mg(a,b)	Perl_sv_catpv_mg(aTHX_ a,b)
diff --git a/perl.c b/perl.c
index 0edad78..15713ae 100644
--- a/perl.c
+++ b/perl.c
@@ -2600,32 +2600,26 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
 
 	JMPENV_PUSH(ret);
 
-	switch (ret) {
+	switch(ret) {
 	case 0:
- redo_body:
 	    CALL_BODY_SUB((OP*)&myop);
+	    break;
+	default:
+	    ret = runops_continue_from_jmpenv(ret);
+	    break;
+	}
+
+	JMPENV_POP;
+
+	switch(ret) {
+	case 0:
 	    retval = PL_stack_sp - (PL_stack_base + oldmark);
 	    if (!(flags & G_KEEPERR)) {
 		CLEAR_ERRSV();
 	    }
+	    delete_eval_scope();
 	    break;
-	case 1:
-	    STATUS_ALL_FAILURE;
-	    /* FALL THROUGH */
-	case 2:
-	    /* my_exit() was called */
-	    PL_curstash = PL_defstash;
-	    FREETMPS;
-	    JMPENV_POP;
-	    my_exit_jump();
-	    /* NOTREACHED */
 	case 3:
-	    if (PL_restartop) {
-		PL_restartjmpenv = NULL;
-		PL_op = PL_restartop;
-		PL_restartop = 0;
-		goto redo_body;
-	    }
 	    PL_stack_sp = PL_stack_base + oldmark;
 	    if ((flags & G_WANT) == G_ARRAY)
 		retval = 0;
@@ -2634,11 +2628,9 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
 		*++PL_stack_sp = &PL_sv_undef;
 	    }
 	    break;
+	default:
+	    assert(0);
 	}
-
-	if (PL_scopestack_ix > oldscope)
-	    delete_eval_scope();
-	JMPENV_POP;
     }
 
     if (flags & G_DISCARD) {
diff --git a/proto.h b/proto.h
index 271107f..66c8999 100644
--- a/proto.h
+++ b/proto.h
@@ -3973,6 +3973,7 @@ PERL_CALLCONV void	Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
 
 #endif
 PERL_CALLCONV int	Perl_runops_standard(pTHX);
+PERL_CALLCONV int	Perl_runops_continue_from_jmpenv(pTHX_ int ret);
 PERL_CALLCONV int	Perl_runops_debug(pTHX);
 PERL_CALLCONV void	Perl_sv_catpvf_mg(pTHX_ SV *const sv, const char *const pat, ...)
 			__attribute__format__(__printf__,pTHX_2,pTHX_3)
diff --git a/run.c b/run.c
index eb465da..06d72aa 100644
--- a/run.c
+++ b/run.c
@@ -46,6 +46,48 @@ Perl_runops_standard(pTHX)
 }
 
 /*
+=for apidoc runops_continue_from_jmpenv
+
+Handles a the ret code of a JMPENV_JUMP: Continues running the
+C<restartop>, jump to the next jmpenv or returns the final ret value.
+The return value indicates the result of the: 0 for normal completion,
+2 for exit or uncaught die (can only happen if there are no outer
+jmpenvs or 3 for a caught die.
+
+=cut
+*/
+
+int
+Perl_runops_continue_from_jmpenv(pTHX_ int ret)
+{
+    switch (ret) {
+    case 1:
+	STATUS_ALL_FAILURE;
+	/* FALL THROUGH */
+    case 2:
+	/* my_exit() was called */
+	DEBUG_l(Perl_deb(aTHX_ "popping jumplevel was %p, now %p\n",
+			 (void*)PL_top_env, (void*)PL_top_env->je_prev));
+	PL_top_env = PL_top_env->je_prev;
+	JMPENV_JUMP(ret);
+	/* NOTREACHED */
+	break;
+    case 3:
+	if (PL_restartop) {
+	    PL_restartjmpenv = NULL;
+	    PL_op = PL_restartop;
+	    PL_restartop = 0;
+	    CALLRUNOPS(aTHX);
+	    return 0;
+	}
+	break;
+    default:
+	assert(0);
+    }
+    return ret;
+}
+
+/*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
-- 
1.7.1
0002-use-runops_continue-in-main-run-loop.patch (text/x-diff, 1.1 KB) 
From cdaa81294763694913e4fa339ea82b9565831b0d Mon Sep 17 00:00:00 2001
From: Gerard Goossen <[email protected]>
Date: Fri, 30 Oct 2009 17:39:29 +0100
Subject: [PATCH 2/4] use runops_continue in main run loop

---
 perl.c |   21 +++++++--------------
 1 files changed, 7 insertions(+), 14 deletions(-)

diff --git a/perl.c b/perl.c
index 15713ae..c7d336d 100644
--- a/perl.c
+++ b/perl.c
@@ -2224,14 +2224,11 @@ perl_run(pTHXx)
 #endif
 
     JMPENV_PUSH(ret);
+
     switch (ret) {
-    case 1:
-	cxstack_ix = -1;		/* start context stack again */
-	goto redo_body;
     case 0:				/* normal completion */
- redo_body:
 	run_body(oldscope);
-	/* FALL THROUGH */
+	/* NOT REACHED */
     case 2:				/* my_exit() */
 	while (PL_scopestack_ix > oldscope)
 	    LEAVE;
@@ -2246,18 +2243,14 @@ perl_run(pTHXx)
 #endif
 	ret = STATUS_EXIT;
 	break;
-    case 3:
-	if (PL_restartop) {
-	    POPSTACK_TO(PL_mainstack);
-	    goto redo_body;
-	}
-	PerlIO_printf(Perl_error_log, "panic: restartop\n");
-	FREETMPS;
-	ret = 1;
-	break;
+    default:
+	ret = runops_continue_from_jmpenv(ret);
+	my_exit(0);
+	/* NOT REACHED */
     }
 
     JMPENV_POP;
+
     return ret;
 }
 
-- 
1.7.1
0003-use-of-runops_continue_from_jmpenv-in-eval_sv.patch (text/x-diff, 1.5 KB) 
From c3897f4d5b0b750141eea0fcf5204aacc0a1ebfd Mon Sep 17 00:00:00 2001
From: Gerard Goossen <[email protected]>
Date: Mon, 2 Nov 2009 14:30:03 +0100
Subject: [PATCH 3/4] use of runops_continue_from_jmpenv in eval_sv

---
 perl.c |   27 +++++++++------------------
 1 files changed, 9 insertions(+), 18 deletions(-)

diff --git a/perl.c b/perl.c
index c7d336d..44ca986 100644
--- a/perl.c
+++ b/perl.c
@@ -2686,32 +2686,23 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
     TAINT_PROPER("eval_sv()");
 
     JMPENV_PUSH(ret);
+
     switch (ret) {
     case 0:
- redo_body:
 	CALL_BODY_EVAL((OP*)&myop);
+	break;
+    default:
+	ret = runops_continue_from_jmpenv(ret);
+    }
+
+    switch(ret) {
+    case 0:
 	retval = PL_stack_sp - (PL_stack_base + oldmark);
 	if (!(flags & G_KEEPERR)) {
 	    CLEAR_ERRSV();
 	}
 	break;
-    case 1:
-	STATUS_ALL_FAILURE;
-	/* FALL THROUGH */
-    case 2:
-	/* my_exit() was called */
-	PL_curstash = PL_defstash;
-	FREETMPS;
-	JMPENV_POP;
-	my_exit_jump();
-	/* NOTREACHED */
     case 3:
-	if (PL_restartop) {
-	    PL_restartjmpenv = NULL;
-	    PL_op = PL_restartop;
-	    PL_restartop = 0;
-	    goto redo_body;
-	}
 	PL_stack_sp = PL_stack_base + oldmark;
 	if ((flags & G_WANT) == G_ARRAY)
 	    retval = 0;
@@ -2719,10 +2710,10 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
 	    retval = 1;
 	    *++PL_stack_sp = &PL_sv_undef;
 	}
-	break;
     }
 
     JMPENV_POP;
+
     if (flags & G_DISCARD) {
 	PL_stack_sp = PL_stack_base + oldmark;
 	retval = 0;
-- 
1.7.1
0004-use-of-runops_continue_from_jmpenv-in-call_list.patch (text/x-diff, 1.4 KB) 
From c58b5b258b03263cae0c4812a5996653e043fbb5 Mon Sep 17 00:00:00 2001
From: Gerard Goossen <[email protected]>
Date: Mon, 2 Nov 2009 14:34:45 +0100
Subject: [PATCH 4/4] use of runops_continue_from_jmpenv in call_list

---
 perl.c |   29 ++++++-----------------------
 1 files changed, 6 insertions(+), 23 deletions(-)

diff --git a/perl.c b/perl.c
index 44ca986..7257513 100644
--- a/perl.c
+++ b/perl.c
@@ -564,6 +564,8 @@ perl_destruct(pTHXx)
 	PERL_UNUSED_VAR(x);
         if (PL_endav && !PL_minus_c)
             call_list(PL_scopestack_ix, PL_endav);
+	while (PL_scopestack_ix > 1)
+	    LEAVE;
         JMPENV_POP;
     }
     LEAVE;
@@ -4593,30 +4595,11 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 		Perl_croak(aTHX_ "%"SVf"", SVfARG(atsv));
 	    }
 	    break;
-	case 1:
-	    STATUS_ALL_FAILURE;
-	    /* FALL THROUGH */
-	case 2:
-	    /* my_exit() was called */
-	    while (PL_scopestack_ix > oldscope)
-		LEAVE;
-	    FREETMPS;
-	    PL_curstash = PL_defstash;
-	    PL_curcop = &PL_compiling;
-	    CopLINE_set(PL_curcop, oldline);
-	    JMPENV_POP;
-	    my_exit_jump();
-	    /* NOTREACHED */
-	case 3:
-	    if (PL_restartop) {
-		PL_curcop = &PL_compiling;
-		CopLINE_set(PL_curcop, oldline);
-		JMPENV_JUMP(3);
-	    }
-	    PerlIO_printf(Perl_error_log, "panic: restartop\n");
-	    FREETMPS;
-	    break;
+	default:
+	    ret = runops_continue_from_jmpenv(ret);
 	}
+	assert(ret == 0);
+
 	JMPENV_POP;
     }
 }
-- 
1.7.1
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.