Add a way to have functions with a trailing depth argument under debugging
authorYves Orton <demerphq@gmail.com>
Wed, 19 Oct 2016 20:44:45 +0000 (22:44 +0200)
committerYves Orton <demerphq@gmail.com>
Wed, 19 Oct 2016 20:44:45 +0000 (22:44 +0200)
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.

embed.fnc
embed.h
perl.h
proto.h
regen/embed.pl
regexec.c

index c58f49a..94cb984 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
 :
 :         (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 2c25e9e..0f1ae02 100644 (file)
--- a/embed.h
+++ b/embed.h
 #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 a843a60..d27a131 100644 (file)
--- a/perl.h
+++ b/perl.h
 #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 0ea0243..139e802 100644 (file)
--- 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)
index 0b1ed0d..50ca2eb 100755 (executable)
@@ -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/;
        }
index 47f630e..0cbe889 100644 (file)
--- 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;