contrib/capture_hook.patch

   1 Index: D:/dev/perl/ver/zoro/embed.h
   2 ===================================================================
   3 --- D:/dev/perl/ver/zoro/embed.h        (revision 972)
   4 +++ D:/dev/perl/ver/zoro/embed.h        (revision 973)
   5 @@ -698,6 +698,8 @@
   6  #if defined(PERL_CORE) || defined(PERL_EXT)
   7  #define reg_named_buff_get     Perl_reg_named_buff_get
   8  #define reg_numbered_buff_get  Perl_reg_numbered_buff_get
   9 +#endif
  10 +#if defined(PERL_CORE) || defined(PERL_EXT)
  11  #define regprop                        Perl_regprop
  12  #endif
  13  #define repeatcpy              Perl_repeatcpy
  14 @@ -2915,7 +2917,9 @@
  15  #define regnext(a)             Perl_regnext(aTHX_ a)
  16  #if defined(PERL_CORE) || defined(PERL_EXT)
  17  #define reg_named_buff_get(a,b,c)      Perl_reg_named_buff_get(aTHX_ a,b,c)
  18 -#define reg_numbered_buff_get(a,b,c,d) Perl_reg_numbered_buff_get(aTHX_ a,b,c,d)
  19 +#define reg_numbered_buff_get(a,b,c)   Perl_reg_numbered_buff_get(aTHX_ a,b,c)
  20 +#endif
  21 +#if defined(PERL_CORE) || defined(PERL_EXT)
  22  #define regprop(a,b,c)         Perl_regprop(aTHX_ a,b,c)
  23  #endif
  24  #define repeatcpy(a,b,c,d)     Perl_repeatcpy(aTHX_ a,b,c,d)
  25 Index: D:/dev/perl/ver/zoro/regcomp.c
  26 ===================================================================
  27 --- D:/dev/perl/ver/zoro/regcomp.c      (revision 972)
  28 +++ D:/dev/perl/ver/zoro/regcomp.c      (revision 973)
  29 @@ -4692,58 +4692,53 @@
  30      return(r);
  31  }
  32
  33 -#undef CORE_ONLY_BLOCK
  34  #undef RE_ENGINE_PTR
  35
  36 -#ifndef PERL_IN_XSUB_RE
  37 +
  38  SV*
  39 -Perl_reg_named_buff_get(pTHX_ SV* namesv, const REGEXP * const from_re, U32 flags)
  40 +Perl_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags)
  41  {
  42      AV *retarray = NULL;
  43      SV *ret;
  44      if (flags & 1)
  45          retarray=newAV();
  46 -
  47 -    if (from_re || PL_curpm) {
  48 -        const REGEXP * const rx = from_re ? from_re : PM_GETRE(PL_curpm);
  49 -        if (rx && rx->paren_names) {
  50 -            HE *he_str = hv_fetch_ent( rx->paren_names, namesv, 0, 0 );
  51 -            if (he_str) {
  52 -                IV i;
  53 -                SV* sv_dat=HeVAL(he_str);
  54 -                I32 *nums=(I32*)SvPVX(sv_dat);
  55 -                for ( i=0; i<SvIVX(sv_dat); i++ ) {
  56 -                    if ((I32)(rx->nparens) >= nums[i]
  57 -                        && rx->startp[nums[i]] != -1
  58 -                        && rx->endp[nums[i]] != -1)
  59 -                    {
  60 -                        ret = reg_numbered_buff_get(nums[i],rx,NULL,0);
  61 -                        if (!retarray)
  62 -                            return ret;
  63 -                    } else {
  64 -                        ret = newSVsv(&PL_sv_undef);
  65 -                    }
  66 -                    if (retarray) {
  67 -                        SvREFCNT_inc(ret);
  68 -                        av_push(retarray, ret);
  69 -                    }
  70 +
  71 +    if (rx && rx->paren_names) {
  72 +        HE *he_str = hv_fetch_ent( rx->paren_names, namesv, 0, 0 );
  73 +        if (he_str) {
  74 +            IV i;
  75 +            SV* sv_dat=HeVAL(he_str);
  76 +            I32 *nums=(I32*)SvPVX(sv_dat);
  77 +            for ( i=0; i<SvIVX(sv_dat); i++ ) {
  78 +                if ((I32)(rx->nparens) >= nums[i]
  79 +                    && rx->startp[nums[i]] != -1
  80 +                    && rx->endp[nums[i]] != -1)
  81 +                {
  82 +                    ret = CALLREG_NUMBUF(rx,nums[i],NULL);
  83 +                    if (!retarray)
  84 +                        return ret;
  85 +                } else {
  86 +                    ret = newSVsv(&PL_sv_undef);
  87                  }
  88 -                if (retarray)
  89 -                    return (SV*)retarray;
  90 +                if (retarray) {
  91 +                    SvREFCNT_inc(ret);
  92 +                    av_push(retarray, ret);
  93 +                }
  94              }
  95 +            if (retarray)
  96 +                return (SV*)retarray;
  97          }
  98      }
  99      return NULL;
 100  }
 101
 102  SV*
 103 -Perl_reg_numbered_buff_get(pTHX_ I32 paren, const REGEXP * const rx, SV* usesv, U32 flags)
 104 +Perl_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv)
 105  {
 106      char *s = NULL;
 107      I32 i = 0;
 108      I32 s1, t1;
 109      SV *sv = usesv ? usesv : newSVpvs("");
 110 -    PERL_UNUSED_ARG(flags);
 111
 112      if (!rx->subbeg) {
 113          sv_setsv(sv,&PL_sv_undef);
 114 @@ -4812,8 +4807,8 @@
 115      }
 116      return sv;
 117  }
 118 -#endif
 119
 120 +
 121  /* Scans the name of a named buffer from the pattern.
 122   * If flags is REG_RSN_RETURN_NULL returns null.
 123   * If flags is REG_RSN_RETURN_NAME returns an SV* containing the name
 124 Index: D:/dev/perl/ver/zoro/regcomp.h
 125 ===================================================================
 126 --- D:/dev/perl/ver/zoro/regcomp.h      (revision 972)
 127 +++ D:/dev/perl/ver/zoro/regcomp.h      (revision 973)
 128 @@ -463,6 +463,8 @@
 129          Perl_re_intuit_start,
 130          Perl_re_intuit_string,
 131          Perl_regfree_internal,
 132 +        Perl_reg_numbered_buff_get,
 133 +        Perl_reg_named_buff_get,
 134  #if defined(USE_ITHREADS)
 135          Perl_regdupe_internal
 136  #endif
 137 Index: D:/dev/perl/ver/zoro/regexp.h
 138 ===================================================================
 139 --- D:/dev/perl/ver/zoro/regexp.h       (revision 972)
 140 +++ D:/dev/perl/ver/zoro/regexp.h       (revision 973)
 141 @@ -111,6 +111,8 @@
 142                             struct re_scream_pos_data_s *data);
 143      SV*            (*checkstr) (pTHX_ regexp *prog);
 144      void    (*free) (pTHX_ struct regexp* r);
 145 +    SV*     (*numbered_buff_get) (pTHX_ const REGEXP * const rx, I32 paren, SV* usesv);
 146 +    SV*     (*named_buff_get)(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags);
 147  #ifdef USE_ITHREADS
 148      void* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
 149  #endif
 150 Index: D:/dev/perl/ver/zoro/perl.h
 151 ===================================================================
 152 --- D:/dev/perl/ver/zoro/perl.h (revision 972)
 153 +++ D:/dev/perl/ver/zoro/perl.h (revision 973)
 154 @@ -219,6 +219,13 @@
 155  #define CALLREGFREE_PVT(prog) \
 156      if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
 157
 158 +#define CALLREG_NUMBUF(rx,paren,usesv) \
 159 +    CALL_FPTR((rx)->engine->numbered_buff_get)(aTHX_ (rx),(paren),(usesv))
 160 +
 161 +#define CALLREG_NAMEDBUF(rx,name,flags) \
 162 +    CALL_FPTR((rx)->engine->named_buff_get)(aTHX_ (rx),(name),(flags))
 163 +
 164 +
 165  #if defined(USE_ITHREADS)
 166  #define CALLREGDUPE(prog,param) \
 167      Perl_re_dup(aTHX_ (prog),(param))
 168 Index: D:/dev/perl/ver/zoro/proto.h
 169 ===================================================================
 170 --- D:/dev/perl/ver/zoro/proto.h        (revision 972)
 171 +++ D:/dev/perl/ver/zoro/proto.h        (revision 973)
 172 @@ -1888,12 +1888,15 @@
 173                         __attribute__warn_unused_result__
 174                         __attribute__nonnull__(pTHX_1);
 175
 176 -PERL_CALLCONV SV*      Perl_reg_named_buff_get(pTHX_ SV* namesv, const REGEXP * const from_re, U32 flags)
 177 -                       __attribute__nonnull__(pTHX_1);
 178
 179 -PERL_CALLCONV SV*      Perl_reg_numbered_buff_get(pTHX_ I32 paren, const REGEXP * const rx, SV* usesv, U32 flags)
 180 +PERL_CALLCONV SV*      Perl_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags)
 181 +                       __attribute__nonnull__(pTHX_1)
 182                         __attribute__nonnull__(pTHX_2);
 183
 184 +PERL_CALLCONV SV*      Perl_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv)
 185 +                       __attribute__nonnull__(pTHX_1);
 186 +
 187 +
 188  PERL_CALLCONV void     Perl_regprop(pTHX_ const regexp *prog, SV* sv, const regnode* o)
 189                         __attribute__nonnull__(pTHX_2)
 190                         __attribute__nonnull__(pTHX_3);
 191 Index: D:/dev/perl/ver/zoro/ext/re/re.xs
 192 ===================================================================
 193 --- D:/dev/perl/ver/zoro/ext/re/re.xs   (revision 972)
 194 +++ D:/dev/perl/ver/zoro/ext/re/re.xs   (revision 973)
 195 @@ -22,6 +22,8 @@
 196  extern SV*     my_re_intuit_string (pTHX_ regexp *prog);
 197
 198  extern void    my_regfree (pTHX_ struct regexp* r);
 199 +extern SV*      my_reg_numbered_buff_get(pTHX_ const REGEXP * const rx, I32 paren, SV* usesv);
 200 +extern SV*      my_reg_named_buff_get(pTHX_ const REGEXP * const rx, SV* namesv, U32 flags);
 201  #if defined(USE_ITHREADS)
 202  extern void*   my_regdupe (pTHX_ const regexp *r, CLONE_PARAMS *param);
 203  #endif
 204 @@ -36,6 +38,8 @@
 205          my_re_intuit_start,
 206          my_re_intuit_string,
 207          my_regfree,
 208 +        my_reg_numbered_buff_get,
 209 +        my_reg_named_buff_get,
 210  #if defined(USE_ITHREADS)
 211          my_regdupe
 212  #endif
 213 @@ -213,7 +217,7 @@
 214  {
 215      re = get_re_arg( aTHX_ qr, 1, NULL);
 216      if (SvPOK(sv) && re && re->paren_names) {
 217 -        bufs = Perl_reg_named_buff_get(aTHX_ sv, re ,all && SvTRUE(all));
 218 +        bufs = CALLREG_NAMEDBUF(re,sv,all && SvTRUE(all));
 219          if (bufs) {
 220              if (all && SvTRUE(all))
 221                  XPUSHs(newRV(bufs));
 222 Index: D:/dev/perl/ver/zoro/ext/re/re_top.h
 223 ===================================================================
 224 --- D:/dev/perl/ver/zoro/ext/re/re_top.h        (revision 972)
 225 +++ D:/dev/perl/ver/zoro/ext/re/re_top.h        (revision 973)
 226 @@ -16,6 +16,8 @@
 227  #define Perl_regfree_internal   my_regfree
 228  #define Perl_re_intuit_string   my_re_intuit_string
 229  #define Perl_regdupe_internal   my_regdupe
 230 +#define Perl_reg_numbered_buff_get  my_reg_numbered_buff_get
 231 +#define Perl_reg_named_buff_get  my_reg_named_buff_get
 232
 233  #define PERL_NO_GET_CONTEXT
 234
 235 Index: D:/dev/perl/ver/zoro/mg.c
 236 ===================================================================
 237 --- D:/dev/perl/ver/zoro/mg.c   (revision 972)
 238 +++ D:/dev/perl/ver/zoro/mg.c   (revision 973)
 239 @@ -863,7 +863,7 @@
 240                  * XXX Does the new way break anything?
 241                  */
 242                 paren = atoi(mg->mg_ptr); /* $& is in [0] */
 243 -               reg_numbered_buff_get( paren, rx, sv, 0);
 244 +               CALLREG_NUMBUF(rx,paren,sv);
 245                 break;
 246             }
 247             sv_setsv(sv,&PL_sv_undef);
 248 @@ -872,7 +872,7 @@
 249      case '+':
 250         if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 251             if (rx->lastparen) {
 252 -               reg_numbered_buff_get( rx->lastparen, rx, sv, 0);
 253 +               CALLREG_NUMBUF(rx,rx->lastparen,sv);
 254                 break;
 255             }
 256         }
 257 @@ -881,7 +881,7 @@
 258      case '\016':               /* ^N */
 259         if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 260             if (rx->lastcloseparen) {
 261 -               reg_numbered_buff_get( rx->lastcloseparen, rx, sv, 0);
 262 +               CALLREG_NUMBUF(rx,rx->lastcloseparen,sv);
 263                 break;
 264             }
 265
 266 @@ -891,16 +891,16 @@
 267      case '`':
 268        do_prematch_fetch:
 269         if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 270 -         reg_numbered_buff_get( -2, rx, sv, 0);
 271 -         break;
 272 +           CALLREG_NUMBUF(rx,-2,sv);
 273 +           break;
 274         }
 275         sv_setsv(sv,&PL_sv_undef);
 276         break;
 277      case '\'':
 278        do_postmatch_fetch:
 279         if (PL_curpm && (rx = PM_GETRE(PL_curpm))) {
 280 -         reg_numbered_buff_get( -1, rx, sv, 0);
 281 -         break;
 282 +           CALLREG_NUMBUF(rx,-1,sv);
 283 +           break;
 284         }
 285         sv_setsv(sv,&PL_sv_undef);
 286         break;
 287 Index: D:/dev/perl/ver/zoro/embed.fnc
 288 ===================================================================
 289 --- D:/dev/perl/ver/zoro/embed.fnc      (revision 972)
 290 +++ D:/dev/perl/ver/zoro/embed.fnc      (revision 973)
 291 @@ -691,8 +691,10 @@
 292                                 |NN char* strend|NN char* strbeg|I32 minend \
 293                                 |NN SV* screamer|NULLOK void* data|U32 flags
 294  ApR    |regnode*|regnext       |NN regnode* p
 295 -EXp    |SV*|reg_named_buff_get |NN SV* namesv|NULLOK const REGEXP * const from_re|U32 flags
 296 -EXp    |SV*|reg_numbered_buff_get|I32 paren|NN const REGEXP * const rx|NULLOK SV* usesv|U32 flags
 297 +
 298 +EXp    |SV*|reg_named_buff_get |NN const REGEXP * const rx|NN SV* namesv|U32 flags
 299 +EXp    |SV*|reg_numbered_buff_get|NN const REGEXP * const rx|I32 paren|NULLOK SV* usesv
 300 +
 301  Ep     |void   |regprop        |NULLOK const regexp *prog|NN SV* sv|NN const regnode* o
 302  Ap     |void   |repeatcpy      |NN char* to|NN const char* from|I32 len|I32 count
 303  ApP    |char*  |rninstr        |NN const char* big|NN const char* bigend \