Add a way to have functions with a trailing depth argument under debugging

In the regex engine it can be useful in debugging mode to
maintain a depth counter, but in normal mode this argument
would be unused. This allows us to define functions in embed.fnc
with a "W" flag which use _pDEPTH and _aDEPTH defines which
effectively define/pass through a U32 depth parameter to the
macro wrappers. These defines are similar to the existing
aTHX and pTHX parameters.

6 files changed, 73 insertions, 53 deletions

diff --git a/embed.fnc b/embed.fnc
index c58f49a8b3..94cb9845a9 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -144,6 +144,13 @@
 :
 :         (currently no effect)
 :
+:   W  Add a _pDEPTH argument to function prototypes, and an _aDEPTH
+:      argument to the function calls. This means that under DEBUGGING
+:      a depth argument is added to the functions, which is used for
+:      example by the regex engine for debugging and trace output.
+:      A non DEBUGGING build will not pass the unused argument.
+:      Currently restricted to functions with at least one argument.
+:
 :   X  Explicitly exported:
 :
 :         add entry to the list of exported symbols, unless x or m
@@ -2402,21 +2409,20 @@ Es	|U8	|regtail_study	|NN RExC_state_t *pRExC_state \
 ERs	|bool	|isFOO_lc	|const U8 classnum|const U8 character
 ERs	|bool	|isFOO_utf8_lc	|const U8 classnum|NN const U8* character
 ERs	|SSize_t|regmatch	|NN regmatch_info *reginfo|NN char *startpos|NN regnode *prog
-ERs	|I32	|regrepeat	|NN regexp *prog|NN char **startposp \
+WERs	|I32	|regrepeat	|NN regexp *prog|NN char **startposp \
 				|NN const regnode *p \
 				|NN regmatch_info *const reginfo \
-				|I32 max \
-				|int depth
+				|I32 max
 ERs	|bool	|regtry		|NN regmatch_info *reginfo|NN char **startposp
 ERs	|bool	|reginclass	|NULLOK regexp * const prog  \
 				|NN const regnode * const n  \
 				|NN const U8 * const p       \
 				|NN const U8 * const p_end   \
 				|bool const utf8_target
-Es	|CHECKPOINT|regcppush	|NN const regexp *rex|I32 parenfloor\
-				|U32 maxopenparen|int depth
-Es	|void	|regcppop	|NN regexp *rex\
-				|NN U32 *maxopenparen_p|int depth
+WEs	|CHECKPOINT|regcppush	|NN const regexp *rex|I32 parenfloor\
+				|U32 maxopenparen
+WEs	|void	|regcppop	|NN regexp *rex|NN U32 *maxopenparen_p
+WEs	|void	|regcp_restore	|NN regexp *rex|I32 ix|NN U32 *maxopenparen_p
 ERsn	|U8*	|reghop3	|NN U8 *s|SSize_t off|NN const U8 *lim
 ERsn	|U8*	|reghop4	|NN U8 *s|SSize_t off|NN const U8 *llim \
 				|NN const U8 *rlim
diff --git a/embed.h b/embed.h
index 2c25e9eeca..0f1ae02fd2 100644
--- a/embed.h
+++ b/embed.h
@@ -1136,14 +1136,15 @@
 #define isSB(a,b,c,d,e,f)	S_isSB(aTHX_ a,b,c,d,e,f)
 #define isWB(a,b,c,d,e,f,g)	S_isWB(aTHX_ a,b,c,d,e,f,g)
 #define reg_check_named_buff_matched	S_reg_check_named_buff_matched
-#define regcppop(a,b,c)		S_regcppop(aTHX_ a,b,c)
-#define regcppush(a,b,c,d)	S_regcppush(aTHX_ a,b,c,d)
+#define regcp_restore(a,b,c)        S_regcp_restore(aTHX_ a,b,c _aDEPTH)
+#define regcppop(a,b)                S_regcppop(aTHX_ a,b _aDEPTH)
+#define regcppush(a,b,c)        S_regcppush(aTHX_ a,b,c _aDEPTH)
 #define reghop3			S_reghop3
 #define reghop4			S_reghop4
 #define reghopmaybe3		S_reghopmaybe3
 #define reginclass(a,b,c,d,e)	S_reginclass(aTHX_ a,b,c,d,e)
 #define regmatch(a,b,c)		S_regmatch(aTHX_ a,b,c)
-#define regrepeat(a,b,c,d,e,f)	S_regrepeat(aTHX_ a,b,c,d,e,f)
+#define regrepeat(a,b,c,d,e)        S_regrepeat(aTHX_ a,b,c,d,e _aDEPTH)
 #define regtry(a,b)		S_regtry(aTHX_ a,b)
 #define to_byte_substr(a)	S_to_byte_substr(aTHX_ a)
 #define to_utf8_substr(a)	S_to_utf8_substr(aTHX_ a)
diff --git a/perl.h b/perl.h
index a843a60b72..d27a131e30 100644
--- a/perl.h
+++ b/perl.h
@@ -11,6 +11,16 @@
 #ifndef H_PERL
 #define H_PERL 1
 
+/* this is used for functions which take a depth trailing
+ * argument under debugging */
+#ifdef DEBUGGING
+#define _pDEPTH ,U32 depth
+#define _aDEPTH ,depth
+#else
+#define _pDEPTH
+#define _aDEPTH
+#endif
+
 #ifdef PERL_FOR_X2P
 /*
  * This file is being used for x2p stuff.
@@ -7328,6 +7338,7 @@ INFNAN_NV_U8_DECL PL_nan;
 
 #endif /* DOUBLE_HAS_NAN */
 
+
 /*
 
    (KEEP THIS LAST IN perl.h!)
diff --git a/proto.h b/proto.h
index 0ea024397a..139e80220a 100644
--- a/proto.h
+++ b/proto.h
@@ -5284,10 +5284,13 @@ STATIC I32	S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan
 #define PERL_ARGS_ASSERT_REG_CHECK_NAMED_BUFF_MATCHED	\
 	assert(rex); assert(scan)
 
-STATIC void	S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p, int depth);
+STATIC void        S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p _pDEPTH);
+#define PERL_ARGS_ASSERT_REGCP_RESTORE        \
+        assert(rex); assert(maxopenparen_p)
+STATIC void        S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p _pDEPTH);
 #define PERL_ARGS_ASSERT_REGCPPOP	\
 	assert(rex); assert(maxopenparen_p)
-STATIC CHECKPOINT	S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen, int depth);
+STATIC CHECKPOINT        S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen _pDEPTH);
 #define PERL_ARGS_ASSERT_REGCPPUSH	\
 	assert(rex)
 STATIC U8*	S_reghop3(U8 *s, SSize_t off, const U8 *lim)
@@ -5315,7 +5318,7 @@ STATIC SSize_t	S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode
 #define PERL_ARGS_ASSERT_REGMATCH	\
 	assert(reginfo); assert(startpos); assert(prog)
 
-STATIC I32	S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, regmatch_info *const reginfo, I32 max, int depth)
+STATIC I32        S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, regmatch_info *const reginfo, I32 max _pDEPTH)
 			__attribute__warn_unused_result__;
 #define PERL_ARGS_ASSERT_REGREPEAT	\
 	assert(prog); assert(startposp); assert(p); assert(reginfo)
diff --git a/regen/embed.pl b/regen/embed.pl
index 0b1ed0d943..50ca2eb712 100755
--- a/regen/embed.pl
+++ b/regen/embed.pl
@@ -75,10 +75,11 @@ my ($embed, $core, $ext, $api) = setup_embed();
 	}
 
 	my ($flags,$retval,$plain_func,@args) = @$_;
-	if ($flags =~ / ( [^AabDdEfiMmnOoPpRrsUXx] ) /x) {
+        if ($flags =~ / ( [^AabDdEfiMmnOoPpRrsUWXx] ) /x) {
 	    warn "flag $1 is not legal (for function $plain_func)";
 	}
 	my @nonnull;
+        my $has_depth = ( $flags =~ /W/ );
 	my $has_context = ( $flags !~ /n/ );
 	my $never_returns = ( $flags =~ /r/ );
 	my $binarycompat = ( $flags =~ /b/ );
@@ -161,6 +162,7 @@ my ($embed, $core, $ext, $api) = setup_embed();
 	else {
 	    $ret .= "void" if !$has_context;
 	}
+        $ret .= " _pDEPTH" if $has_depth;
 	$ret .= ")";
 	my @attrs;
 	if ( $flags =~ /r/ ) {
@@ -321,7 +323,15 @@ sub embed_h {
 		$ret .=  "\t" x ($t < 4 ? 4 - $t : 1);
 		$ret .= full_name($func, $flags) . "(aTHX";
 		$ret .= "_ " if $alist;
-		$ret .= $alist . ")\n";
+                $ret .= $alist;
+                if ($flags =~ /W/) {
+                    if ($alist) {
+                        $ret .= " _aDEPTH";
+                    } else {
+                        die "Can't use W without other args (currently)";
+                    }
+                }
+                $ret .= ")\n";
 	    }
 	    $ret = "#ifndef NO_MATHOMS\n$ret#endif\n" if $flags =~ /b/;
 	}
diff --git a/regexec.c b/regexec.c
index 47f630e3f2..0cbe8899a5 100644
--- a/regexec.c
+++ b/regexec.c
@@ -272,7 +272,7 @@ static regmatch_state * S_push_slab(pTHX);
  * are needed for the regexp context stack bookkeeping. */
 
 STATIC CHECKPOINT
-S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen, int depth)
+S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen _pDEPTH)
 {
     const int retval = PL_savestack_ix;
     const int paren_elems_to_push =
@@ -283,9 +283,6 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen, int depth
     GET_RE_DEBUG_FLAGS_DECL;
 
     PERL_ARGS_ASSERT_REGCPPUSH;
-#ifndef DEBUGGING
-    PERL_UNUSED_ARG(depth);
-#endif
 
     if (paren_elems_to_push < 0)
         Perl_croak(aTHX_ "panic: paren_elems_to_push, %i < 0, maxopenparen: %i parenfloor: %i REGCP_PAREN_ELEMS: %u",
@@ -361,16 +358,13 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen, int depth
 
 
 STATIC void
-S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p, int depth)
+S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p _pDEPTH)
 {
     UV i;
     U32 paren;
     GET_RE_DEBUG_FLAGS_DECL;
 
     PERL_ARGS_ASSERT_REGCPPOP;
-#ifndef DEBUGGING
-    PERL_UNUSED_ARG(depth);
-#endif
 
     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
     i = SSPOPUV;
@@ -438,11 +432,11 @@ S_regcppop(pTHX_ regexp *rex, U32 *maxopenparen_p, int depth)
  * but without popping the stack */
 
 STATIC void
-S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p, int depth)
+S_regcp_restore(pTHX_ regexp *rex, I32 ix, U32 *maxopenparen_p _pDEPTH)
 {
     I32 tmpix = PL_savestack_ix;
     PL_savestack_ix = ix;
-    S_regcppop(aTHX_ rex, maxopenparen_p, depth);
+    regcppop(rex, maxopenparen_p);
     PL_savestack_ix = tmpix;
 }
 
@@ -5353,7 +5347,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
     I32 nextchr;   /* is always set to UCHARAT(locinput), or -1 at EOS */
 
     bool result = 0;	    /* return value of S_regmatch */
-    int depth = 0;	    /* depth of backtrack stack */
+    U32 depth = 0;            /* depth of backtrack stack */
     U32 nochange_depth = 0; /* depth of GOSUB recursion with nochange */
     const U32 max_nochange_depth =
         (3 * rex->nparens > MAX_RECURSE_EVAL_NOCHANGE_DEPTH) ?
@@ -6774,7 +6768,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
             }
 
             /* Save all the positions seen so far. */
-            ST.cp = S_regcppush(aTHX_ rex, 0, maxopenparen, depth);
+            ST.cp = regcppush(rex, 0, maxopenparen);
             REGCP_SET(ST.lastcp);
 
             /* and then jump to the code we share with EVAL */
@@ -6799,7 +6793,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
 		CV *newcv;
 
 		/* save *all* paren positions */
-		S_regcppush(aTHX_ rex, 0, maxopenparen, depth);
+                regcppush(rex, 0, maxopenparen);
 		REGCP_SET(runops_cp);
 
 		if (!caller_cv)
@@ -6965,7 +6959,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
 		 * in the regexp code uses the pad ! */
 		PL_op = oop;
 		PL_curcop = ocurcop;
-		S_regcp_restore(aTHX_ rex, runops_cp, &maxopenparen, depth);
+                regcp_restore(rex, runops_cp, &maxopenparen);
 		PL_curpm = PL_reg_curpm;
 
 		if (logical != 2)
@@ -7033,7 +7027,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
                                              * close_paren only for GOSUB */
                 ST.prev_recurse_locinput= NULL; /* only used for GOSUB */
                 /* Save all the seen positions so far. */
-                ST.cp = S_regcppush(aTHX_ rex, 0, maxopenparen, depth);
+                ST.cp = regcppush(rex, 0, maxopenparen);
                 REGCP_SET(ST.lastcp);
                 /* and set maxopenparen to 0, since we are starting a "fresh" match */
                 maxopenparen = 0;
@@ -7133,7 +7127,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog)
 	    rexi = RXi_GET(rex); 
 
 	    REGCP_UNWIND(ST.lastcp);
-	    S_regcppop(aTHX_ rex, &maxopenparen, depth);
+            regcppop(rex, &maxopenparen);
 	    cur_eval = ST.prev_eval;
 	    cur_curlyx = ST.prev_curlyx;
 
@@ -7406,8 +7400,7 @@ NULL
 	    /* First just match a string of min A's. */
 
 	    if (n < min) {
-		ST.cp = S_regcppush(aTHX_ rex, cur_curlyx->u.curlyx.parenfloor,
-                                    maxopenparen, depth);
+                ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor, maxopenparen);
 		cur_curlyx->u.curlyx.lastloc = locinput;
 		REGCP_SET(ST.lastcp);
 
@@ -7517,8 +7510,8 @@ NULL
 	    if (cur_curlyx->u.curlyx.minmod) {
 		ST.save_curlyx = cur_curlyx;
 		cur_curlyx = cur_curlyx->u.curlyx.prev_curlyx;
-		ST.cp = S_regcppush(aTHX_ rex, ST.save_curlyx->u.curlyx.parenfloor,
-                            maxopenparen, depth);
+                ST.cp = regcppush(rex, ST.save_curlyx->u.curlyx.parenfloor,
+                            maxopenparen);
 		REGCP_SET(ST.lastcp);
 		PUSH_YES_STATE_GOTO(WHILEM_B_min, ST.save_curlyx->u.curlyx.B,
                                     locinput);
@@ -7528,8 +7521,8 @@ NULL
 	    /* Prefer A over B for maximal matching. */
 
 	    if (n < max) { /* More greed allowed? */
-		ST.cp = S_regcppush(aTHX_ rex, cur_curlyx->u.curlyx.parenfloor,
-                            maxopenparen, depth);
+                ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
+                            maxopenparen);
 		cur_curlyx->u.curlyx.lastloc = locinput;
 		REGCP_SET(ST.lastcp);
 		PUSH_STATE_GOTO(WHILEM_A_max, A, locinput);
@@ -7556,7 +7549,7 @@ NULL
 	    /* FALLTHROUGH */
 	case WHILEM_A_pre_fail: /* just failed to match even minimal A */
 	    REGCP_UNWIND(ST.lastcp);
-	    S_regcppop(aTHX_ rex, &maxopenparen, depth);
+            regcppop(rex, &maxopenparen);
 	    cur_curlyx->u.curlyx.lastloc = ST.save_lastloc;
 	    cur_curlyx->u.curlyx.count--;
 	    CACHEsayNO;
@@ -7564,7 +7557,7 @@ NULL
 
 	case WHILEM_A_max_fail: /* just failed to match A in a maximal match */
 	    REGCP_UNWIND(ST.lastcp);
-	    S_regcppop(aTHX_ rex, &maxopenparen, depth); /* Restore some previous $<digit>s? */
+            regcppop(rex, &maxopenparen); /* Restore some previous $<digit>s? */
             DEBUG_EXECUTE_r(Perl_re_exec_indentf( aTHX_  "whilem: failed, trying continuation...\n",
                 depth)
 	    );
@@ -7590,7 +7583,7 @@ NULL
 	case WHILEM_B_min_fail: /* just failed to match B in a minimal match */
 	    cur_curlyx = ST.save_curlyx;
 	    REGCP_UNWIND(ST.lastcp);
-	    S_regcppop(aTHX_ rex, &maxopenparen, depth);
+            regcppop(rex, &maxopenparen);
 
 	    if (cur_curlyx->u.curlyx.count >= /*max*/ARG2(cur_curlyx->u.curlyx.me)) {
 		/* Maximum greed exceeded */
@@ -7612,8 +7605,8 @@ NULL
 	    );
 	    /* Try grabbing another A and see if it helps. */
 	    cur_curlyx->u.curlyx.lastloc = locinput;
-	    ST.cp = S_regcppush(aTHX_ rex, cur_curlyx->u.curlyx.parenfloor,
-                            maxopenparen, depth);
+            ST.cp = regcppush(rex, cur_curlyx->u.curlyx.parenfloor,
+                            maxopenparen);
 	    REGCP_SET(ST.lastcp);
 	    PUSH_STATE_GOTO(WHILEM_A_min,
 		/*A*/ NEXTOPER(ST.save_curlyx->u.curlyx.me) + EXTRA_STEP_2ARGS,
@@ -7978,7 +7971,7 @@ NULL
                 char *li = locinput;
 		minmod = 0;
 		if (ST.min &&
-                        regrepeat(rex, &li, ST.A, reginfo, ST.min, depth)
+                        regrepeat(rex, &li, ST.A, reginfo, ST.min)
                             < ST.min)
 		    sayNO;
                 SET_locinput(li);
@@ -8015,7 +8008,7 @@ NULL
                 /* avoid taking address of locinput, so it can remain
                  * a register var */
                 char *li = locinput;
-		ST.count = regrepeat(rex, &li, ST.A, reginfo, ST.max, depth);
+                ST.count = regrepeat(rex, &li, ST.A, reginfo, ST.max);
 		if (ST.count < ST.min)
 		    sayNO;
                 SET_locinput(li);
@@ -8098,7 +8091,7 @@ NULL
                      * locinput matches */
                     char *li = ST.oldloc;
 		    ST.count += n;
-		    if (regrepeat(rex, &li, ST.A, reginfo, n, depth) < n)
+                    if (regrepeat(rex, &li, ST.A, reginfo, n) < n)
 			sayNO;
                     assert(n == REG_INFTY || locinput == li);
 		}
@@ -8119,7 +8112,7 @@ NULL
 	    /* failed -- move forward one */
             {
                 char *li = locinput;
-                if (!regrepeat(rex, &li, ST.A, reginfo, 1, depth)) {
+                if (!regrepeat(rex, &li, ST.A, reginfo, 1)) {
                     sayNO;
                 }
                 locinput = li;
@@ -8193,7 +8186,7 @@ NULL
 		st->u.eval.prev_rex = rex_sv;		/* inner */
 
                 /* Save *all* the positions. */
-		st->u.eval.cp = S_regcppush(aTHX_ rex, 0, maxopenparen, depth);
+                st->u.eval.cp = regcppush(rex, 0, maxopenparen);
                 rex_sv = CUR_EVAL.prev_rex;
 		is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv));
 		SET_reg_curpm(rex_sv);
@@ -8207,8 +8200,7 @@ NULL
 
 		/* Restore parens of the outer rex without popping the
 		 * savestack */
-                S_regcp_restore(aTHX_ rex, CUR_EVAL.lastcp,
-                                        &maxopenparen, depth);
+                regcp_restore(rex, CUR_EVAL.lastcp, &maxopenparen);
 
 		st->u.eval.prev_eval = cur_eval;
                 cur_eval = CUR_EVAL.prev_eval;
@@ -8661,7 +8653,7 @@ NULL
  */
 STATIC I32
 S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
-            regmatch_info *const reginfo, I32 max, int depth)
+            regmatch_info *const reginfo, I32 max _pDEPTH)
 {
     char *scan;     /* Pointer to current position in target string */
     I32 c;
@@ -8671,9 +8663,6 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p,
     unsigned int to_complement = 0;  /* Invert the result? */
     UV utf8_flags;
     _char_class_number classnum;
-#ifndef DEBUGGING
-    PERL_UNUSED_ARG(depth);
-#endif
 
     PERL_ARGS_ASSERT_REGREPEAT;