make calling of /(?{}) code blocks correct

Formerly, it just updated PL_comppad, set PL_op to the first op of the
code block, and did CALLRUNOPS().

This had a lot of problems, e.g. depth of recursion, and not having
anything on the context stack for die/caller/next/goto etc to see, usually
leading to segfaults.

Make it so that it uses the MULTICALL API instead. This makes it push a
new stack and a CxSUB context stack frame; it also makes us share code
rather than rolling our own.

MULTICALL had to be extended in two ways to make this work; but these have
not yet been made part of the public API. First, it had to allow changing
of the current CV while leaving the current CxSUB frame in place, and
secondly it had to allow pushing a CV with a zero increment of CvDEPTH.
This latter is to handle direct literal blocks:

    /(?{...})/

which are compiled into the same CV as the surrounding scope; therefore we
need to push the same sub twice at the same depth (usually 1), i.e.

    $ ./perl -Dstv -e'sub f { /(?{$x})/ } f'
    ...
    (29912:-e:1)	gvsv(main::x)

    STACK 0: MAIN
      CX 0: BLOCK  =>
      CX 1: SUB    =>           <=== the same sub ...
      retop=leave
    STACK 1: SORT
      CX 0: SUB    => UNDEF     <==== ... as this
      retop=(null)

(note that stack 1 is misidentified as SORT; this is a bug in MULTICALl
to be fixed later).

One has to be very careful with the save stack; /(?{})/ is designed
not to introduce a new scope, so that the effects of 'local' etc
accumulate across multiple block invocations (but get popped on
backtracking). This is why we couldn't just do a POP_MULTICALL/PUSH_MULTICALL
pair to change the current CV; the former would pop the save stack too.

Note that in the current implementation, after calling out to the first
code block, we leave the CxSUB and PL_comppad value in place, on the
assumption that it may be soon re-used, and only pop the CxSUB at the end
of S_regmatch(). However, when popping the savestack on backtracking, this
will restore PL_comppad to its original value; so when calling a new code
block with the same CV, we can't rely on PL_comppad still being correct.

Also, this means that outside of a code block call, the context stack and
PL_comppad are wrong; I can't think of anything within the regex code
that could be using these; but it if it turns out not to be the case,
then we'd have to change it so that after each code block call, we pop the
CxSUB off the stack and restore PL_comppad, but without popping the save
stack.

1 files changed, 36 insertions, 3 deletions

diff --git a/cop.h b/cop.h
index af989656c8..041420c211 100644
--- a/cop.h
+++ b/cop.h
@@ -1180,6 +1180,12 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     U8 hasargs = 0		/* used by PUSHSUB */
 
 #define PUSH_MULTICALL(the_cv) \
+    PUSH_MULTICALL_WITHDEPTH(the_cv, 1);
+
+/* Like PUSH_MULTICALL, but allows you to specify the CvDEPTH increment,
+ * rather than the default of 1 (this isn't part of the public API) */
+
+#define PUSH_MULTICALL_WITHDEPTH(the_cv, depth) \
     STMT_START {							\
 	CV * const _nOnclAshIngNamE_ = the_cv;				\
 	CV * const cv = _nOnclAshIngNamE_;				\
@@ -1191,7 +1197,8 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 	PUSHSTACKi(PERLSI_SORT);					\
 	PUSHBLOCK(cx, CXt_SUB|CXp_MULTICALL, PL_stack_sp);		\
 	PUSHSUB(cx);							\
-	if (++CvDEPTH(cv) >= 2) {					\
+	CvDEPTH(cv) += depth;						\
+	if (CvDEPTH(cv) >= 2) {						\
 	    PERL_STACK_OVERFLOW_CHECK();				\
 	    Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));			\
 	}								\
@@ -1209,8 +1216,9 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 
 #define POP_MULTICALL \
     STMT_START {							\
-	if (! --CvDEPTH(multicall_cv))					\
-	    LEAVESUB(multicall_cv);					\
+	if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {	\
+		LEAVESUB(multicall_cv);					\
+	}								\
 	POPBLOCK(cx,PL_curpm);						\
 	POPSTACK;							\
 	CATCH_SET(multicall_oldcatch);					\
@@ -1218,6 +1226,31 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
 	SPAGAIN;							\
     } STMT_END
 
+/* Change the CV of an already-pushed MULTICALL CxSUB block.
+ * (this isn't part of the public API) */
+
+#define CHANGE_MULTICALL_WITHDEPTH(the_cv, depth) \
+    STMT_START {							\
+	CV * const _nOnclAshIngNamE_ = the_cv;				\
+	CV * const cv = _nOnclAshIngNamE_;				\
+	AV * const padlist = CvPADLIST(cv);				\
+	cx = &cxstack[cxstack_ix];					\
+	assert(cx->cx_type & CXp_MULTICALL);				\
+	if (! ((CvDEPTH(multicall_cv) = cx->blk_sub.olddepth)) ) {	\
+		LEAVESUB(multicall_cv);					\
+	}								\
+	cx->cx_type &= ~CXp_HASARGS;					\
+	PUSHSUB(cx);							\
+	CvDEPTH(cv) += depth;						\
+	if (CvDEPTH(cv) >= 2) {						\
+	    PERL_STACK_OVERFLOW_CHECK();				\
+	    Perl_pad_push(aTHX_ padlist, CvDEPTH(cv));			\
+	}								\
+	SAVECOMPPAD();							\
+	PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));			\
+	multicall_cv = cv;						\
+	multicall_cop = CvSTART(cv);					\
+    } STMT_END
 /*
  * Local variables:
  * c-indentation-style: bsd