This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
eliminate PL_regprecomp, PL_regprogram, PL_regnpar and PL_regdata
[perl5.git] / regexec.c
1 /*    regexec.c
2  */
3
4 /*
5  * "One Ring to rule them all, One Ring to find them..."
6  */
7
8 /* This file contains functions for executing a regular expression.  See
9  * also regcomp.c which funnily enough, contains functions for compiling
10  * a regular expression.
11  *
12  * This file is also copied at build time to ext/re/re_exec.c, where
13  * it's built with -DPERL_EXT_RE_BUILD -DPERL_EXT_RE_DEBUG -DPERL_EXT.
14  * This causes the main functions to be compiled under new names and with
15  * debugging support added, which makes "use re 'debug'" work.
16  
17  */
18
19 /* NOTE: this is derived from Henry Spencer's regexp code, and should not
20  * confused with the original package (see point 3 below).  Thanks, Henry!
21  */
22
23 /* Additional note: this code is very heavily munged from Henry's version
24  * in places.  In some spots I've traded clarity for efficiency, so don't
25  * blame Henry for some of the lack of readability.
26  */
27
28 /* The names of the functions have been changed from regcomp and
29  * regexec to  pregcomp and pregexec in order to avoid conflicts
30  * with the POSIX routines of the same names.
31 */
32
33 #ifdef PERL_EXT_RE_BUILD
34 /* need to replace pregcomp et al, so enable that */
35 #  ifndef PERL_IN_XSUB_RE
36 #    define PERL_IN_XSUB_RE
37 #  endif
38 /* need access to debugger hooks */
39 #  if defined(PERL_EXT_RE_DEBUG) && !defined(DEBUGGING)
40 #    define DEBUGGING
41 #  endif
42 #endif
43
44 #ifdef PERL_IN_XSUB_RE
45 /* We *really* need to overwrite these symbols: */
46 #  define Perl_regexec_flags my_regexec
47 #  define Perl_regdump my_regdump
48 #  define Perl_regprop my_regprop
49 #  define Perl_re_intuit_start my_re_intuit_start
50 /* *These* symbols are masked to allow static link. */
51 #  define Perl_pregexec my_pregexec
52 #  define Perl_reginitcolors my_reginitcolors
53 #  define Perl_regclass_swash my_regclass_swash
54
55 #  define PERL_NO_GET_CONTEXT
56 #endif
57
58 /*
59  * pregcomp and pregexec -- regsub and regerror are not used in perl
60  *
61  *      Copyright (c) 1986 by University of Toronto.
62  *      Written by Henry Spencer.  Not derived from licensed software.
63  *
64  *      Permission is granted to anyone to use this software for any
65  *      purpose on any computer system, and to redistribute it freely,
66  *      subject to the following restrictions:
67  *
68  *      1. The author is not responsible for the consequences of use of
69  *              this software, no matter how awful, even if they arise
70  *              from defects in it.
71  *
72  *      2. The origin of this software must not be misrepresented, either
73  *              by explicit claim or by omission.
74  *
75  *      3. Altered versions must be plainly marked as such, and must not
76  *              be misrepresented as being the original software.
77  *
78  ****    Alterations to Henry's code are...
79  ****
80  ****    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
81  ****    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
82  ****
83  ****    You may distribute under the terms of either the GNU General Public
84  ****    License or the Artistic License, as specified in the README file.
85  *
86  * Beware that some of this code is subtly aware of the way operator
87  * precedence is structured in regular expressions.  Serious changes in
88  * regular-expression syntax might require a total rethink.
89  */
90 #include "EXTERN.h"
91 #define PERL_IN_REGEXEC_C
92 #include "perl.h"
93
94 #include "regcomp.h"
95
96 #define RF_tainted      1               /* tainted information used? */
97 #define RF_warned       2               /* warned about big count? */
98 #define RF_evaled       4               /* Did an EVAL with setting? */
99 #define RF_utf8         8               /* String contains multibyte chars? */
100
101 #define UTF ((PL_reg_flags & RF_utf8) != 0)
102
103 #define RS_init         1               /* eval environment created */
104 #define RS_set          2               /* replsv value is set */
105
106 #ifndef STATIC
107 #define STATIC  static
108 #endif
109
110 #define REGINCLASS(p,c)  (ANYOF_FLAGS(p) ? reginclass(p,c,0,0) : ANYOF_BITMAP_TEST(p,*(c)))
111
112 /*
113  * Forwards.
114  */
115
116 #define CHR_SVLEN(sv) (do_utf8 ? sv_len_utf8(sv) : SvCUR(sv))
117 #define CHR_DIST(a,b) (PL_reg_match_utf8 ? utf8_distance(a,b) : a - b)
118
119 #define HOPc(pos,off) ((char *)(PL_reg_match_utf8 \
120             ? reghop3((U8*)pos, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr)) \
121             : (U8*)(pos + off)))
122 #define HOPBACKc(pos, off) ((char*)     \
123     ((PL_reg_match_utf8)                \
124         ? reghopmaybe3((U8*)pos, -off, ((U8*)(off < 0 ? PL_regeol : PL_bostr))) \
125     : (pos - off >= PL_bostr)           \
126         ? (U8*)(pos - off)              \
127     : (U8*)NULL)                        \
128 )
129
130 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
131 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
132 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
133
134 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
135     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
136 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
137 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
138 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
139 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
140
141 /* for use after a quantifier and before an EXACT-like node -- japhy */
142 #define JUMPABLE(rn) ( \
143     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
144     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
145     OP(rn) == PLUS || OP(rn) == MINMOD || \
146     (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
147 )
148
149 #define HAS_TEXT(rn) ( \
150     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
151 )
152
153 /*
154   Search for mandatory following text node; for lookahead, the text must
155   follow but for lookbehind (rn->flags != 0) we skip to the next step.
156 */
157 #define FIND_NEXT_IMPT(rn) STMT_START { \
158     while (JUMPABLE(rn)) \
159         if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
160             rn = NEXTOPER(NEXTOPER(rn)); \
161         else if (OP(rn) == PLUS) \
162             rn = NEXTOPER(rn); \
163         else if (OP(rn) == IFMATCH) \
164             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
165         else rn += NEXT_OFF(rn); \
166 } STMT_END 
167
168 static void restore_pos(pTHX_ void *arg);
169
170 STATIC CHECKPOINT
171 S_regcppush(pTHX_ I32 parenfloor)
172 {
173     dVAR;
174     const int retval = PL_savestack_ix;
175 #define REGCP_PAREN_ELEMS 4
176     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
177     int p;
178
179     if (paren_elems_to_push < 0)
180         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
181
182 #define REGCP_OTHER_ELEMS 6
183     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
184     for (p = PL_regsize; p > parenfloor; p--) {
185 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
186         SSPUSHINT(PL_regendp[p]);
187         SSPUSHINT(PL_regstartp[p]);
188         SSPUSHPTR(PL_reg_start_tmp[p]);
189         SSPUSHINT(p);
190     }
191 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
192     SSPUSHINT(PL_regsize);
193     SSPUSHINT(*PL_reglastparen);
194     SSPUSHINT(*PL_reglastcloseparen);
195     SSPUSHPTR(PL_reginput);
196 #define REGCP_FRAME_ELEMS 2
197 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
198  * are needed for the regexp context stack bookkeeping. */
199     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
200     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
201
202     return retval;
203 }
204
205 /* These are needed since we do not localize EVAL nodes: */
206 #  define REGCP_SET(cp)  DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,          \
207                              "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
208                              (IV)PL_savestack_ix)); cp = PL_savestack_ix
209
210 #  define REGCP_UNWIND(cp)  DEBUG_EXECUTE_r(cp != PL_savestack_ix ?             \
211                                 PerlIO_printf(Perl_debug_log,           \
212                                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
213                                 (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
214
215 STATIC char *
216 S_regcppop(pTHX_ regexp *rex)
217 {
218     dVAR;
219     I32 i;
220     U32 paren = 0;
221     char *input;
222
223     GET_RE_DEBUG_FLAGS_DECL;
224
225     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
226     i = SSPOPINT;
227     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
228     i = SSPOPINT; /* Parentheses elements to pop. */
229     input = (char *) SSPOPPTR;
230     *PL_reglastcloseparen = SSPOPINT;
231     *PL_reglastparen = SSPOPINT;
232     PL_regsize = SSPOPINT;
233
234     /* Now restore the parentheses context. */
235     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
236          i > 0; i -= REGCP_PAREN_ELEMS) {
237         I32 tmps;
238         paren = (U32)SSPOPINT;
239         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
240         PL_regstartp[paren] = SSPOPINT;
241         tmps = SSPOPINT;
242         if (paren <= *PL_reglastparen)
243             PL_regendp[paren] = tmps;
244         DEBUG_EXECUTE_r(
245             PerlIO_printf(Perl_debug_log,
246                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
247                           (UV)paren, (IV)PL_regstartp[paren],
248                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
249                           (IV)PL_regendp[paren],
250                           (paren > *PL_reglastparen ? "(no)" : ""));
251         );
252     }
253     DEBUG_EXECUTE_r(
254         if ((I32)(*PL_reglastparen + 1) <= rex->nparens) {
255             PerlIO_printf(Perl_debug_log,
256                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
257                           (IV)(*PL_reglastparen + 1), (IV)rex->nparens);
258         }
259     );
260 #if 1
261     /* It would seem that the similar code in regtry()
262      * already takes care of this, and in fact it is in
263      * a better location to since this code can #if 0-ed out
264      * but the code in regtry() is needed or otherwise tests
265      * requiring null fields (pat.t#187 and split.t#{13,14}
266      * (as of patchlevel 7877)  will fail.  Then again,
267      * this code seems to be necessary or otherwise
268      * building DynaLoader will fail:
269      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
270      * --jhi */
271     for (paren = *PL_reglastparen + 1; (I32)paren <= rex->nparens; paren++) {
272         if ((I32)paren > PL_regsize)
273             PL_regstartp[paren] = -1;
274         PL_regendp[paren] = -1;
275     }
276 #endif
277     return input;
278 }
279
280 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
281
282 #define TRYPAREN(paren, n, input, where) {                      \
283     if (paren) {                                                \
284         if (n) {                                                \
285             PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
286             PL_regendp[paren] = input - PL_bostr;               \
287         }                                                       \
288         else                                                    \
289             PL_regendp[paren] = -1;                             \
290     }                                                           \
291     REGMATCH(next, where);                                      \
292     if (result)                                                 \
293         sayYES;                                                 \
294     if (paren && n)                                             \
295         PL_regendp[paren] = -1;                                 \
296 }
297
298
299 /*
300  * pregexec and friends
301  */
302
303 /*
304  - pregexec - match a regexp against a string
305  */
306 I32
307 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
308          char *strbeg, I32 minend, SV *screamer, U32 nosave)
309 /* strend: pointer to null at end of string */
310 /* strbeg: real beginning of string */
311 /* minend: end of match must be >=minend after stringarg. */
312 /* nosave: For optimizations. */
313 {
314     return
315         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
316                       nosave ? 0 : REXEC_COPY_STR);
317 }
318
319
320 /*
321  * Need to implement the following flags for reg_anch:
322  *
323  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
324  * USE_INTUIT_ML
325  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
326  * INTUIT_AUTORITATIVE_ML
327  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
328  * INTUIT_ONCE_ML
329  *
330  * Another flag for this function: SECOND_TIME (so that float substrs
331  * with giant delta may be not rechecked).
332  */
333
334 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
335
336 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
337    Otherwise, only SvCUR(sv) is used to get strbeg. */
338
339 /* XXXX We assume that strpos is strbeg unless sv. */
340
341 /* XXXX Some places assume that there is a fixed substring.
342         An update may be needed if optimizer marks as "INTUITable"
343         RExen without fixed substrings.  Similarly, it is assumed that
344         lengths of all the strings are no more than minlen, thus they
345         cannot come from lookahead.
346         (Or minlen should take into account lookahead.) */
347
348 /* A failure to find a constant substring means that there is no need to make
349    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
350    finding a substring too deep into the string means that less calls to
351    regtry() should be needed.
352
353    REx compiler's optimizer found 4 possible hints:
354         a) Anchored substring;
355         b) Fixed substring;
356         c) Whether we are anchored (beginning-of-line or \G);
357         d) First node (of those at offset 0) which may distingush positions;
358    We use a)b)d) and multiline-part of c), and try to find a position in the
359    string which does not contradict any of them.
360  */
361
362 /* Most of decisions we do here should have been done at compile time.
363    The nodes of the REx which we used for the search should have been
364    deleted from the finite automaton. */
365
366 char *
367 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
368                      char *strend, U32 flags, re_scream_pos_data *data)
369 {
370     dVAR;
371     register I32 start_shift = 0;
372     /* Should be nonnegative! */
373     register I32 end_shift   = 0;
374     register char *s;
375     register SV *check;
376     char *strbeg;
377     char *t;
378     const int do_utf8 = sv ? SvUTF8(sv) : 0;    /* if no sv we have to assume bytes */
379     I32 ml_anch;
380     register char *other_last = NULL;   /* other substr checked before this */
381     char *check_at = NULL;              /* check substr found at this pos */
382     const I32 multiline = prog->reganch & PMf_MULTILINE;
383 #ifdef DEBUGGING
384     const char * const i_strpos = strpos;
385     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
386 #endif
387
388     GET_RE_DEBUG_FLAGS_DECL;
389
390     RX_MATCH_UTF8_set(prog,do_utf8);
391
392     if (prog->reganch & ROPT_UTF8) {
393         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
394                               "UTF-8 regex...\n"));
395         PL_reg_flags |= RF_utf8;
396     }
397
398     DEBUG_EXECUTE_r({
399          const char *s   = PL_reg_match_utf8 ?
400                          sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
401                          strpos;
402          const int   len = PL_reg_match_utf8 ?
403                          strlen(s) : strend - strpos;
404          if (!PL_colorset)
405               reginitcolors();
406          if (PL_reg_match_utf8)
407              DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
408                                    "UTF-8 target...\n"));
409          PerlIO_printf(Perl_debug_log,
410                        "%sGuessing start of match, REx%s \"%s%.60s%s%s\" against \"%s%.*s%s%s\"...\n",
411                        PL_colors[4], PL_colors[5], PL_colors[0],
412                        prog->precomp,
413                        PL_colors[1],
414                        (strlen(prog->precomp) > 60 ? "..." : ""),
415                        PL_colors[0],
416                        (int)(len > 60 ? 60 : len),
417                        s, PL_colors[1],
418                        (len > 60 ? "..." : "")
419               );
420     });
421
422     /* CHR_DIST() would be more correct here but it makes things slow. */
423     if (prog->minlen > strend - strpos) {
424         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
425                               "String too short... [re_intuit_start]\n"));
426         goto fail;
427     }
428     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
429     PL_regeol = strend;
430     if (do_utf8) {
431         if (!prog->check_utf8 && prog->check_substr)
432             to_utf8_substr(prog);
433         check = prog->check_utf8;
434     } else {
435         if (!prog->check_substr && prog->check_utf8)
436             to_byte_substr(prog);
437         check = prog->check_substr;
438     }
439    if (check == &PL_sv_undef) {
440         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
441                 "Non-utf string cannot match utf check string\n"));
442         goto fail;
443     }
444     if (prog->reganch & ROPT_ANCH) {    /* Match at beg-of-str or after \n */
445         ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
446                      || ( (prog->reganch & ROPT_ANCH_BOL)
447                           && !multiline ) );    /* Check after \n? */
448
449         if (!ml_anch) {
450           if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
451                                   | ROPT_IMPLICIT)) /* not a real BOL */
452                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
453                && sv && !SvROK(sv)
454                && (strpos != strbeg)) {
455               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
456               goto fail;
457           }
458           if (prog->check_offset_min == prog->check_offset_max &&
459               !(prog->reganch & ROPT_CANY_SEEN)) {
460             /* Substring at constant offset from beg-of-str... */
461             I32 slen;
462
463             s = HOP3c(strpos, prog->check_offset_min, strend);
464             if (SvTAIL(check)) {
465                 slen = SvCUR(check);    /* >= 1 */
466
467                 if ( strend - s > slen || strend - s < slen - 1
468                      || (strend - s == slen && strend[-1] != '\n')) {
469                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
470                     goto fail_finish;
471                 }
472                 /* Now should match s[0..slen-2] */
473                 slen--;
474                 if (slen && (*SvPVX_const(check) != *s
475                              || (slen > 1
476                                  && memNE(SvPVX_const(check), s, slen)))) {
477                   report_neq:
478                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
479                     goto fail_finish;
480                 }
481             }
482             else if (*SvPVX_const(check) != *s
483                      || ((slen = SvCUR(check)) > 1
484                          && memNE(SvPVX_const(check), s, slen)))
485                 goto report_neq;
486             check_at = s;
487             goto success_at_start;
488           }
489         }
490         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
491         s = strpos;
492         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
493         end_shift = prog->minlen - start_shift -
494             CHR_SVLEN(check) + (SvTAIL(check) != 0);
495         if (!ml_anch) {
496             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
497                                          - (SvTAIL(check) != 0);
498             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
499
500             if (end_shift < eshift)
501                 end_shift = eshift;
502         }
503     }
504     else {                              /* Can match at random position */
505         ml_anch = 0;
506         s = strpos;
507         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
508         /* Should be nonnegative! */
509         end_shift = prog->minlen - start_shift -
510             CHR_SVLEN(check) + (SvTAIL(check) != 0);
511     }
512
513 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
514     if (end_shift < 0)
515         Perl_croak(aTHX_ "panic: end_shift");
516 #endif
517
518   restart:
519     /* Find a possible match in the region s..strend by looking for
520        the "check" substring in the region corrected by start/end_shift. */
521     if (flags & REXEC_SCREAM) {
522         I32 p = -1;                     /* Internal iterator of scream. */
523         I32 * const pp = data ? data->scream_pos : &p;
524
525         if (PL_screamfirst[BmRARE(check)] >= 0
526             || ( BmRARE(check) == '\n'
527                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
528                  && SvTAIL(check) ))
529             s = screaminstr(sv, check,
530                             start_shift + (s - strbeg), end_shift, pp, 0);
531         else
532             goto fail_finish;
533         /* we may be pointing at the wrong string */
534         if (s && RX_MATCH_COPIED(prog))
535             s = strbeg + (s - SvPVX_const(sv));
536         if (data)
537             *data->scream_olds = s;
538     }
539     else if (prog->reganch & ROPT_CANY_SEEN)
540         s = fbm_instr((U8*)(s + start_shift),
541                       (U8*)(strend - end_shift),
542                       check, multiline ? FBMrf_MULTILINE : 0);
543     else
544         s = fbm_instr(HOP3(s, start_shift, strend),
545                       HOP3(strend, -end_shift, strbeg),
546                       check, multiline ? FBMrf_MULTILINE : 0);
547
548     /* Update the count-of-usability, remove useless subpatterns,
549         unshift s.  */
550
551     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s %s substr \"%s%.*s%s\"%s%s",
552                           (s ? "Found" : "Did not find"),
553                           (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"),
554                           PL_colors[0],
555                           (int)(SvCUR(check) - (SvTAIL(check)!=0)),
556                           SvPVX_const(check),
557                           PL_colors[1], (SvTAIL(check) ? "$" : ""),
558                           (s ? " at offset " : "...\n") ) );
559
560     if (!s)
561         goto fail_finish;
562
563     check_at = s;
564
565     /* Finish the diagnostic message */
566     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
567
568     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
569        Start with the other substr.
570        XXXX no SCREAM optimization yet - and a very coarse implementation
571        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
572                 *always* match.  Probably should be marked during compile...
573        Probably it is right to do no SCREAM here...
574      */
575
576     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8) : (prog->float_substr && prog->anchored_substr)) {
577         /* Take into account the "other" substring. */
578         /* XXXX May be hopelessly wrong for UTF... */
579         if (!other_last)
580             other_last = strpos;
581         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
582           do_other_anchored:
583             {
584                 char * const last = HOP3c(s, -start_shift, strbeg);
585                 char *last1, *last2;
586                 char *s1 = s;
587                 SV* must;
588
589                 t = s - prog->check_offset_max;
590                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
591                     && (!do_utf8
592                         || ((t = reghopmaybe3_c(s, -(prog->check_offset_max), strpos))
593                             && t > strpos)))
594                     /* EMPTY */;
595                 else
596                     t = strpos;
597                 t = HOP3c(t, prog->anchored_offset, strend);
598                 if (t < other_last)     /* These positions already checked */
599                     t = other_last;
600                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
601                 if (last < last1)
602                     last1 = last;
603  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
604                 /* On end-of-str: see comment below. */
605                 must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
606                 if (must == &PL_sv_undef) {
607                     s = (char*)NULL;
608                     DEBUG_EXECUTE_r(must = prog->anchored_utf8);        /* for debug */
609                 }
610                 else
611                     s = fbm_instr(
612                         (unsigned char*)t,
613                         HOP3(HOP3(last1, prog->anchored_offset, strend)
614                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
615                         must,
616                         multiline ? FBMrf_MULTILINE : 0
617                     );
618                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
619                         "%s anchored substr \"%s%.*s%s\"%s",
620                         (s ? "Found" : "Contradicts"),
621                         PL_colors[0],
622                           (int)(SvCUR(must)
623                           - (SvTAIL(must)!=0)),
624                           SvPVX_const(must),
625                           PL_colors[1], (SvTAIL(must) ? "$" : "")));
626                 if (!s) {
627                     if (last1 >= last2) {
628                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
629                                                 ", giving up...\n"));
630                         goto fail_finish;
631                     }
632                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
633                         ", trying floating at offset %ld...\n",
634                         (long)(HOP3c(s1, 1, strend) - i_strpos)));
635                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
636                     s = HOP3c(last, 1, strend);
637                     goto restart;
638                 }
639                 else {
640                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
641                           (long)(s - i_strpos)));
642                     t = HOP3c(s, -prog->anchored_offset, strbeg);
643                     other_last = HOP3c(s, 1, strend);
644                     s = s1;
645                     if (t == strpos)
646                         goto try_at_start;
647                     goto try_at_offset;
648                 }
649             }
650         }
651         else {          /* Take into account the floating substring. */
652             char *last, *last1;
653             char *s1 = s;
654             SV* must;
655
656             t = HOP3c(s, -start_shift, strbeg);
657             last1 = last =
658                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
659             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
660                 last = HOP3c(t, prog->float_max_offset, strend);
661             s = HOP3c(t, prog->float_min_offset, strend);
662             if (s < other_last)
663                 s = other_last;
664  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
665             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
666             /* fbm_instr() takes into account exact value of end-of-str
667                if the check is SvTAIL(ed).  Since false positives are OK,
668                and end-of-str is not later than strend we are OK. */
669             if (must == &PL_sv_undef) {
670                 s = (char*)NULL;
671                 DEBUG_EXECUTE_r(must = prog->float_utf8);       /* for debug message */
672             }
673             else
674                 s = fbm_instr((unsigned char*)s,
675                               (unsigned char*)last + SvCUR(must)
676                                   - (SvTAIL(must)!=0),
677                               must, multiline ? FBMrf_MULTILINE : 0);
678             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
679                     (s ? "Found" : "Contradicts"),
680                     PL_colors[0],
681                       (int)(SvCUR(must) - (SvTAIL(must)!=0)),
682                       SvPVX_const(must),
683                       PL_colors[1], (SvTAIL(must) ? "$" : "")));
684             if (!s) {
685                 if (last1 == last) {
686                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
687                                             ", giving up...\n"));
688                     goto fail_finish;
689                 }
690                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
691                     ", trying anchored starting at offset %ld...\n",
692                     (long)(s1 + 1 - i_strpos)));
693                 other_last = last;
694                 s = HOP3c(t, 1, strend);
695                 goto restart;
696             }
697             else {
698                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
699                       (long)(s - i_strpos)));
700                 other_last = s; /* Fix this later. --Hugo */
701                 s = s1;
702                 if (t == strpos)
703                     goto try_at_start;
704                 goto try_at_offset;
705             }
706         }
707     }
708
709     t = s - prog->check_offset_max;
710     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
711         && (!do_utf8
712             || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
713                  && t > strpos))) {
714         /* Fixed substring is found far enough so that the match
715            cannot start at strpos. */
716       try_at_offset:
717         if (ml_anch && t[-1] != '\n') {
718             /* Eventually fbm_*() should handle this, but often
719                anchored_offset is not 0, so this check will not be wasted. */
720             /* XXXX In the code below we prefer to look for "^" even in
721                presence of anchored substrings.  And we search even
722                beyond the found float position.  These pessimizations
723                are historical artefacts only.  */
724           find_anchor:
725             while (t < strend - prog->minlen) {
726                 if (*t == '\n') {
727                     if (t < check_at - prog->check_offset_min) {
728                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
729                             /* Since we moved from the found position,
730                                we definitely contradict the found anchored
731                                substr.  Due to the above check we do not
732                                contradict "check" substr.
733                                Thus we can arrive here only if check substr
734                                is float.  Redo checking for "other"=="fixed".
735                              */
736                             strpos = t + 1;                     
737                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
738                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
739                             goto do_other_anchored;
740                         }
741                         /* We don't contradict the found floating substring. */
742                         /* XXXX Why not check for STCLASS? */
743                         s = t + 1;
744                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
745                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
746                         goto set_useful;
747                     }
748                     /* Position contradicts check-string */
749                     /* XXXX probably better to look for check-string
750                        than for "\n", so one should lower the limit for t? */
751                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
752                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
753                     other_last = strpos = s = t + 1;
754                     goto restart;
755                 }
756                 t++;
757             }
758             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
759                         PL_colors[0], PL_colors[1]));
760             goto fail_finish;
761         }
762         else {
763             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
764                         PL_colors[0], PL_colors[1]));
765         }
766         s = t;
767       set_useful:
768         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
769     }
770     else {
771         /* The found string does not prohibit matching at strpos,
772            - no optimization of calling REx engine can be performed,
773            unless it was an MBOL and we are not after MBOL,
774            or a future STCLASS check will fail this. */
775       try_at_start:
776         /* Even in this situation we may use MBOL flag if strpos is offset
777            wrt the start of the string. */
778         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
779             && (strpos != strbeg) && strpos[-1] != '\n'
780             /* May be due to an implicit anchor of m{.*foo}  */
781             && !(prog->reganch & ROPT_IMPLICIT))
782         {
783             t = strpos;
784             goto find_anchor;
785         }
786         DEBUG_EXECUTE_r( if (ml_anch)
787             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
788                         (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
789         );
790       success_at_start:
791         if (!(prog->reganch & ROPT_NAUGHTY)     /* XXXX If strpos moved? */
792             && (do_utf8 ? (
793                 prog->check_utf8                /* Could be deleted already */
794                 && --BmUSEFUL(prog->check_utf8) < 0
795                 && (prog->check_utf8 == prog->float_utf8)
796             ) : (
797                 prog->check_substr              /* Could be deleted already */
798                 && --BmUSEFUL(prog->check_substr) < 0
799                 && (prog->check_substr == prog->float_substr)
800             )))
801         {
802             /* If flags & SOMETHING - do not do it many times on the same match */
803             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
804             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
805             if (do_utf8 ? prog->check_substr : prog->check_utf8)
806                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
807             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
808             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
809             check = NULL;                       /* abort */
810             s = strpos;
811             /* XXXX This is a remnant of the old implementation.  It
812                     looks wasteful, since now INTUIT can use many
813                     other heuristics. */
814             prog->reganch &= ~RE_USE_INTUIT;
815         }
816         else
817             s = strpos;
818     }
819
820     /* Last resort... */
821     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
822     if (prog->regstclass) {
823         /* minlen == 0 is possible if regstclass is \b or \B,
824            and the fixed substr is ''$.
825            Since minlen is already taken into account, s+1 is before strend;
826            accidentally, minlen >= 1 guaranties no false positives at s + 1
827            even for \b or \B.  But (minlen? 1 : 0) below assumes that
828            regstclass does not come from lookahead...  */
829         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
830            This leaves EXACTF only, which is dealt with in find_byclass().  */
831         const U8* const str = (U8*)STRING(prog->regstclass);
832         const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
833                     ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
834                     : 1);
835         const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
836                 ? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
837                 : (prog->float_substr || prog->float_utf8
838                    ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
839                            cl_l, strend)
840                    : strend);
841
842         t = s;
843         PL_reg_re = prog;
844         s = find_byclass(prog, prog->regstclass, s, endpos, 1);
845         if (!s) {
846 #ifdef DEBUGGING
847             const char *what = NULL;
848 #endif
849             if (endpos == strend) {
850                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
851                                 "Could not match STCLASS...\n") );
852                 goto fail;
853             }
854             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
855                                    "This position contradicts STCLASS...\n") );
856             if ((prog->reganch & ROPT_ANCH) && !ml_anch)
857                 goto fail;
858             /* Contradict one of substrings */
859             if (prog->anchored_substr || prog->anchored_utf8) {
860                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
861                     DEBUG_EXECUTE_r( what = "anchored" );
862                   hop_and_restart:
863                     s = HOP3c(t, 1, strend);
864                     if (s + start_shift + end_shift > strend) {
865                         /* XXXX Should be taken into account earlier? */
866                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
867                                                "Could not match STCLASS...\n") );
868                         goto fail;
869                     }
870                     if (!check)
871                         goto giveup;
872                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
873                                 "Looking for %s substr starting at offset %ld...\n",
874                                  what, (long)(s + start_shift - i_strpos)) );
875                     goto restart;
876                 }
877                 /* Have both, check_string is floating */
878                 if (t + start_shift >= check_at) /* Contradicts floating=check */
879                     goto retry_floating_check;
880                 /* Recheck anchored substring, but not floating... */
881                 s = check_at;
882                 if (!check)
883                     goto giveup;
884                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
885                           "Looking for anchored substr starting at offset %ld...\n",
886                           (long)(other_last - i_strpos)) );
887                 goto do_other_anchored;
888             }
889             /* Another way we could have checked stclass at the
890                current position only: */
891             if (ml_anch) {
892                 s = t = t + 1;
893                 if (!check)
894                     goto giveup;
895                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
896                           "Looking for /%s^%s/m starting at offset %ld...\n",
897                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
898                 goto try_at_offset;
899             }
900             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
901                 goto fail;
902             /* Check is floating subtring. */
903           retry_floating_check:
904             t = check_at - start_shift;
905             DEBUG_EXECUTE_r( what = "floating" );
906             goto hop_and_restart;
907         }
908         if (t != s) {
909             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
910                         "By STCLASS: moving %ld --> %ld\n",
911                                   (long)(t - i_strpos), (long)(s - i_strpos))
912                    );
913         }
914         else {
915             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
916                                   "Does not contradict STCLASS...\n"); 
917                    );
918         }
919     }
920   giveup:
921     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
922                           PL_colors[4], (check ? "Guessed" : "Giving up"),
923                           PL_colors[5], (long)(s - i_strpos)) );
924     return s;
925
926   fail_finish:                          /* Substring not found */
927     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
928         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
929   fail:
930     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
931                           PL_colors[4], PL_colors[5]));
932     return NULL;
933 }
934
935 /* We know what class REx starts with.  Try to find this position... */
936 STATIC char *
937 S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun)
938 {
939         dVAR;
940         const I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
941         char *m;
942         STRLEN ln;
943         STRLEN lnc;
944         register STRLEN uskip;
945         unsigned int c1;
946         unsigned int c2;
947         char *e;
948         register I32 tmp = 1;   /* Scratch variable? */
949         register const bool do_utf8 = PL_reg_match_utf8;
950
951         /* We know what class it must start with. */
952         switch (OP(c)) {
953         case ANYOF:
954             if (do_utf8) {
955                  while (s + (uskip = UTF8SKIP(s)) <= strend) {
956                       if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
957                           !UTF8_IS_INVARIANT((U8)s[0]) ?
958                           reginclass(c, (U8*)s, 0, do_utf8) :
959                           REGINCLASS(c, (U8*)s)) {
960                            if (tmp && (norun || regtry(prog, s)))
961                                 goto got_it;
962                            else
963                                 tmp = doevery;
964                       }
965                       else 
966                            tmp = 1;
967                       s += uskip;
968                  }
969             }
970             else {
971                  while (s < strend) {
972                       STRLEN skip = 1;
973
974                       if (REGINCLASS(c, (U8*)s) ||
975                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
976                            /* The assignment of 2 is intentional:
977                             * for the folded sharp s, the skip is 2. */
978                            (skip = SHARP_S_SKIP))) {
979                            if (tmp && (norun || regtry(prog, s)))
980                                 goto got_it;
981                            else
982                                 tmp = doevery;
983                       }
984                       else 
985                            tmp = 1;
986                       s += skip;
987                  }
988             }
989             break;
990         case CANY:
991             while (s < strend) {
992                 if (tmp && (norun || regtry(prog, s)))
993                     goto got_it;
994                 else
995                     tmp = doevery;
996                 s++;
997             }
998             break;
999         case EXACTF:
1000             m   = STRING(c);
1001             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1002             lnc = (I32) ln;     /* length to match in characters */
1003             if (UTF) {
1004                 STRLEN ulen1, ulen2;
1005                 U8 *sm = (U8 *) m;
1006                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1007                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1008                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1009
1010                 to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1011                 to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1012
1013                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, 
1014                                     0, uniflags);
1015                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1016                                     0, uniflags);
1017                 lnc = 0;
1018                 while (sm < ((U8 *) m + ln)) {
1019                     lnc++;
1020                     sm += UTF8SKIP(sm);
1021                 }
1022             }
1023             else {
1024                 c1 = *(U8*)m;
1025                 c2 = PL_fold[c1];
1026             }
1027             goto do_exactf;
1028         case EXACTFL:
1029             m   = STRING(c);
1030             ln  = STR_LEN(c);
1031             lnc = (I32) ln;
1032             c1 = *(U8*)m;
1033             c2 = PL_fold_locale[c1];
1034           do_exactf:
1035             e = HOP3c(strend, -((I32)lnc), s);
1036
1037             if (norun && e < s)
1038                 e = s;                  /* Due to minlen logic of intuit() */
1039
1040             /* The idea in the EXACTF* cases is to first find the
1041              * first character of the EXACTF* node and then, if
1042              * necessary, case-insensitively compare the full
1043              * text of the node.  The c1 and c2 are the first
1044              * characters (though in Unicode it gets a bit
1045              * more complicated because there are more cases
1046              * than just upper and lower: one needs to use
1047              * the so-called folding case for case-insensitive
1048              * matching (called "loose matching" in Unicode).
1049              * ibcmp_utf8() will do just that. */
1050
1051             if (do_utf8) {
1052                 UV c, f;
1053                 U8 tmpbuf [UTF8_MAXBYTES+1];
1054                 STRLEN len, foldlen;
1055                 const U32 uniflags = UTF8_ALLOW_DEFAULT;
1056                 if (c1 == c2) {
1057                     /* Upper and lower of 1st char are equal -
1058                      * probably not a "letter". */
1059                     while (s <= e) {
1060                         c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1061                                            uniflags);
1062                         if ( c == c1
1063                              && (ln == len ||
1064                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1065                                             m, (char **)0, ln, (bool)UTF))
1066                              && (norun || regtry(prog, s)) )
1067                             goto got_it;
1068                         else {
1069                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1070                              uvchr_to_utf8(tmpbuf, c);
1071                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1072                              if ( f != c
1073                                   && (f == c1 || f == c2)
1074                                   && (ln == foldlen ||
1075                                       !ibcmp_utf8((char *) foldbuf,
1076                                                   (char **)0, foldlen, do_utf8,
1077                                                   m,
1078                                                   (char **)0, ln, (bool)UTF))
1079                                   && (norun || regtry(prog, s)) )
1080                                   goto got_it;
1081                         }
1082                         s += len;
1083                     }
1084                 }
1085                 else {
1086                     while (s <= e) {
1087                       c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1088                                            uniflags);
1089
1090                         /* Handle some of the three Greek sigmas cases.
1091                          * Note that not all the possible combinations
1092                          * are handled here: some of them are handled
1093                          * by the standard folding rules, and some of
1094                          * them (the character class or ANYOF cases)
1095                          * are handled during compiletime in
1096                          * regexec.c:S_regclass(). */
1097                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1098                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1099                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1100
1101                         if ( (c == c1 || c == c2)
1102                              && (ln == len ||
1103                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1104                                             m, (char **)0, ln, (bool)UTF))
1105                              && (norun || regtry(prog, s)) )
1106                             goto got_it;
1107                         else {
1108                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1109                              uvchr_to_utf8(tmpbuf, c);
1110                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1111                              if ( f != c
1112                                   && (f == c1 || f == c2)
1113                                   && (ln == foldlen ||
1114                                       !ibcmp_utf8((char *) foldbuf,
1115                                                   (char **)0, foldlen, do_utf8,
1116                                                   m,
1117                                                   (char **)0, ln, (bool)UTF))
1118                                   && (norun || regtry(prog, s)) )
1119                                   goto got_it;
1120                         }
1121                         s += len;
1122                     }
1123                 }
1124             }
1125             else {
1126                 if (c1 == c2)
1127                     while (s <= e) {
1128                         if ( *(U8*)s == c1
1129                              && (ln == 1 || !(OP(c) == EXACTF
1130                                               ? ibcmp(s, m, ln)
1131                                               : ibcmp_locale(s, m, ln)))
1132                              && (norun || regtry(prog, s)) )
1133                             goto got_it;
1134                         s++;
1135                     }
1136                 else
1137                     while (s <= e) {
1138                         if ( (*(U8*)s == c1 || *(U8*)s == c2)
1139                              && (ln == 1 || !(OP(c) == EXACTF
1140                                               ? ibcmp(s, m, ln)
1141                                               : ibcmp_locale(s, m, ln)))
1142                              && (norun || regtry(prog, s)) )
1143                             goto got_it;
1144                         s++;
1145                     }
1146             }
1147             break;
1148         case BOUNDL:
1149             PL_reg_flags |= RF_tainted;
1150             /* FALL THROUGH */
1151         case BOUND:
1152             if (do_utf8) {
1153                 if (s == PL_bostr)
1154                     tmp = '\n';
1155                 else {
1156                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1157                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1158                 }
1159                 tmp = ((OP(c) == BOUND ?
1160                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1161                 LOAD_UTF8_CHARCLASS_ALNUM();
1162                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1163                     if (tmp == !(OP(c) == BOUND ?
1164                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1165                                  isALNUM_LC_utf8((U8*)s)))
1166                     {
1167                         tmp = !tmp;
1168                         if ((norun || regtry(prog, s)))
1169                             goto got_it;
1170                     }
1171                     s += uskip;
1172                 }
1173             }
1174             else {
1175                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1176                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1177                 while (s < strend) {
1178                     if (tmp ==
1179                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1180                         tmp = !tmp;
1181                         if ((norun || regtry(prog, s)))
1182                             goto got_it;
1183                     }
1184                     s++;
1185                 }
1186             }
1187             if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
1188                 goto got_it;
1189             break;
1190         case NBOUNDL:
1191             PL_reg_flags |= RF_tainted;
1192             /* FALL THROUGH */
1193         case NBOUND:
1194             if (do_utf8) {
1195                 if (s == PL_bostr)
1196                     tmp = '\n';
1197                 else {
1198                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1199                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, UTF8_ALLOW_DEFAULT);
1200                 }
1201                 tmp = ((OP(c) == NBOUND ?
1202                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1203                 LOAD_UTF8_CHARCLASS_ALNUM();
1204                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1205                     if (tmp == !(OP(c) == NBOUND ?
1206                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1207                                  isALNUM_LC_utf8((U8*)s)))
1208                         tmp = !tmp;
1209                     else if ((norun || regtry(prog, s)))
1210                         goto got_it;
1211                     s += uskip;
1212                 }
1213             }
1214             else {
1215                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1216                 tmp = ((OP(c) == NBOUND ?
1217                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1218                 while (s < strend) {
1219                     if (tmp ==
1220                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1221                         tmp = !tmp;
1222                     else if ((norun || regtry(prog, s)))
1223                         goto got_it;
1224                     s++;
1225                 }
1226             }
1227             if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
1228                 goto got_it;
1229             break;
1230         case ALNUM:
1231             if (do_utf8) {
1232                 LOAD_UTF8_CHARCLASS_ALNUM();
1233                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1234                     if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1235                         if (tmp && (norun || regtry(prog, s)))
1236                             goto got_it;
1237                         else
1238                             tmp = doevery;
1239                     }
1240                     else
1241                         tmp = 1;
1242                     s += uskip;
1243                 }
1244             }
1245             else {
1246                 while (s < strend) {
1247                     if (isALNUM(*s)) {
1248                         if (tmp && (norun || regtry(prog, s)))
1249                             goto got_it;
1250                         else
1251                             tmp = doevery;
1252                     }
1253                     else
1254                         tmp = 1;
1255                     s++;
1256                 }
1257             }
1258             break;
1259         case ALNUML:
1260             PL_reg_flags |= RF_tainted;
1261             if (do_utf8) {
1262                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1263                     if (isALNUM_LC_utf8((U8*)s)) {
1264                         if (tmp && (norun || regtry(prog, s)))
1265                             goto got_it;
1266                         else
1267                             tmp = doevery;
1268                     }
1269                     else
1270                         tmp = 1;
1271                     s += uskip;
1272                 }
1273             }
1274             else {
1275                 while (s < strend) {
1276                     if (isALNUM_LC(*s)) {
1277                         if (tmp && (norun || regtry(prog, s)))
1278                             goto got_it;
1279                         else
1280                             tmp = doevery;
1281                     }
1282                     else
1283                         tmp = 1;
1284                     s++;
1285                 }
1286             }
1287             break;
1288         case NALNUM:
1289             if (do_utf8) {
1290                 LOAD_UTF8_CHARCLASS_ALNUM();
1291                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1292                     if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1293                         if (tmp && (norun || regtry(prog, s)))
1294                             goto got_it;
1295                         else
1296                             tmp = doevery;
1297                     }
1298                     else
1299                         tmp = 1;
1300                     s += uskip;
1301                 }
1302             }
1303             else {
1304                 while (s < strend) {
1305                     if (!isALNUM(*s)) {
1306                         if (tmp && (norun || regtry(prog, s)))
1307                             goto got_it;
1308                         else
1309                             tmp = doevery;
1310                     }
1311                     else
1312                         tmp = 1;
1313                     s++;
1314                 }
1315             }
1316             break;
1317         case NALNUML:
1318             PL_reg_flags |= RF_tainted;
1319             if (do_utf8) {
1320                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1321                     if (!isALNUM_LC_utf8((U8*)s)) {
1322                         if (tmp && (norun || regtry(prog, s)))
1323                             goto got_it;
1324                         else
1325                             tmp = doevery;
1326                     }
1327                     else
1328                         tmp = 1;
1329                     s += uskip;
1330                 }
1331             }
1332             else {
1333                 while (s < strend) {
1334                     if (!isALNUM_LC(*s)) {
1335                         if (tmp && (norun || regtry(prog, s)))
1336                             goto got_it;
1337                         else
1338                             tmp = doevery;
1339                     }
1340                     else
1341                         tmp = 1;
1342                     s++;
1343                 }
1344             }
1345             break;
1346         case SPACE:
1347             if (do_utf8) {
1348                 LOAD_UTF8_CHARCLASS_SPACE();
1349                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1350                     if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
1351                         if (tmp && (norun || regtry(prog, s)))
1352                             goto got_it;
1353                         else
1354                             tmp = doevery;
1355                     }
1356                     else
1357                         tmp = 1;
1358                     s += uskip;
1359                 }
1360             }
1361             else {
1362                 while (s < strend) {
1363                     if (isSPACE(*s)) {
1364                         if (tmp && (norun || regtry(prog, s)))
1365                             goto got_it;
1366                         else
1367                             tmp = doevery;
1368                     }
1369                     else
1370                         tmp = 1;
1371                     s++;
1372                 }
1373             }
1374             break;
1375         case SPACEL:
1376             PL_reg_flags |= RF_tainted;
1377             if (do_utf8) {
1378                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1379                     if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1380                         if (tmp && (norun || regtry(prog, s)))
1381                             goto got_it;
1382                         else
1383                             tmp = doevery;
1384                     }
1385                     else
1386                         tmp = 1;
1387                     s += uskip;
1388                 }
1389             }
1390             else {
1391                 while (s < strend) {
1392                     if (isSPACE_LC(*s)) {
1393                         if (tmp && (norun || regtry(prog, s)))
1394                             goto got_it;
1395                         else
1396                             tmp = doevery;
1397                     }
1398                     else
1399                         tmp = 1;
1400                     s++;
1401                 }
1402             }
1403             break;
1404         case NSPACE:
1405             if (do_utf8) {
1406                 LOAD_UTF8_CHARCLASS_SPACE();
1407                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1408                     if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
1409                         if (tmp && (norun || regtry(prog, s)))
1410                             goto got_it;
1411                         else
1412                             tmp = doevery;
1413                     }
1414                     else
1415                         tmp = 1;
1416                     s += uskip;
1417                 }
1418             }
1419             else {
1420                 while (s < strend) {
1421                     if (!isSPACE(*s)) {
1422                         if (tmp && (norun || regtry(prog, s)))
1423                             goto got_it;
1424                         else
1425                             tmp = doevery;
1426                     }
1427                     else
1428                         tmp = 1;
1429                     s++;
1430                 }
1431             }
1432             break;
1433         case NSPACEL:
1434             PL_reg_flags |= RF_tainted;
1435             if (do_utf8) {
1436                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1437                     if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1438                         if (tmp && (norun || regtry(prog, s)))
1439                             goto got_it;
1440                         else
1441                             tmp = doevery;
1442                     }
1443                     else
1444                         tmp = 1;
1445                     s += uskip;
1446                 }
1447             }
1448             else {
1449                 while (s < strend) {
1450                     if (!isSPACE_LC(*s)) {
1451                         if (tmp && (norun || regtry(prog, s)))
1452                             goto got_it;
1453                         else
1454                             tmp = doevery;
1455                     }
1456                     else
1457                         tmp = 1;
1458                     s++;
1459                 }
1460             }
1461             break;
1462         case DIGIT:
1463             if (do_utf8) {
1464                 LOAD_UTF8_CHARCLASS_DIGIT();
1465                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1466                     if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1467                         if (tmp && (norun || regtry(prog, s)))
1468                             goto got_it;
1469                         else
1470                             tmp = doevery;
1471                     }
1472                     else
1473                         tmp = 1;
1474                     s += uskip;
1475                 }
1476             }
1477             else {
1478                 while (s < strend) {
1479                     if (isDIGIT(*s)) {
1480                         if (tmp && (norun || regtry(prog, s)))
1481                             goto got_it;
1482                         else
1483                             tmp = doevery;
1484                     }
1485                     else
1486                         tmp = 1;
1487                     s++;
1488                 }
1489             }
1490             break;
1491         case DIGITL:
1492             PL_reg_flags |= RF_tainted;
1493             if (do_utf8) {
1494                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1495                     if (isDIGIT_LC_utf8((U8*)s)) {
1496                         if (tmp && (norun || regtry(prog, s)))
1497                             goto got_it;
1498                         else
1499                             tmp = doevery;
1500                     }
1501                     else
1502                         tmp = 1;
1503                     s += uskip;
1504                 }
1505             }
1506             else {
1507                 while (s < strend) {
1508                     if (isDIGIT_LC(*s)) {
1509                         if (tmp && (norun || regtry(prog, s)))
1510                             goto got_it;
1511                         else
1512                             tmp = doevery;
1513                     }
1514                     else
1515                         tmp = 1;
1516                     s++;
1517                 }
1518             }
1519             break;
1520         case NDIGIT:
1521             if (do_utf8) {
1522                 LOAD_UTF8_CHARCLASS_DIGIT();
1523                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1524                     if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1525                         if (tmp && (norun || regtry(prog, s)))
1526                             goto got_it;
1527                         else
1528                             tmp = doevery;
1529                     }
1530                     else
1531                         tmp = 1;
1532                     s += uskip;
1533                 }
1534             }
1535             else {
1536                 while (s < strend) {
1537                     if (!isDIGIT(*s)) {
1538                         if (tmp && (norun || regtry(prog, s)))
1539                             goto got_it;
1540                         else
1541                             tmp = doevery;
1542                     }
1543                     else
1544                         tmp = 1;
1545                     s++;
1546                 }
1547             }
1548             break;
1549         case NDIGITL:
1550             PL_reg_flags |= RF_tainted;
1551             if (do_utf8) {
1552                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1553                     if (!isDIGIT_LC_utf8((U8*)s)) {
1554                         if (tmp && (norun || regtry(prog, s)))
1555                             goto got_it;
1556                         else
1557                             tmp = doevery;
1558                     }
1559                     else
1560                         tmp = 1;
1561                     s += uskip;
1562                 }
1563             }
1564             else {
1565                 while (s < strend) {
1566                     if (!isDIGIT_LC(*s)) {
1567                         if (tmp && (norun || regtry(prog, s)))
1568                             goto got_it;
1569                         else
1570                             tmp = doevery;
1571                     }
1572                     else
1573                         tmp = 1;
1574                     s++;
1575                 }
1576             }
1577             break;
1578         default:
1579             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1580             break;
1581         }
1582         return 0;
1583       got_it:
1584         return s;
1585 }
1586
1587 /*
1588  - regexec_flags - match a regexp against a string
1589  */
1590 I32
1591 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1592               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1593 /* strend: pointer to null at end of string */
1594 /* strbeg: real beginning of string */
1595 /* minend: end of match must be >=minend after stringarg. */
1596 /* data: May be used for some additional optimizations. */
1597 /* nosave: For optimizations. */
1598 {
1599     dVAR;
1600     register char *s;
1601     register regnode *c;
1602     register char *startpos = stringarg;
1603     I32 minlen;         /* must match at least this many chars */
1604     I32 dontbother = 0; /* how many characters not to try at end */
1605     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1606     I32 scream_pos = -1;                /* Internal iterator of scream. */
1607     char *scream_olds = NULL;
1608     SV* oreplsv = GvSV(PL_replgv);
1609     const bool do_utf8 = DO_UTF8(sv);
1610     const I32 multiline = prog->reganch & PMf_MULTILINE;
1611 #ifdef DEBUGGING
1612     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
1613     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
1614 #endif
1615
1616     GET_RE_DEBUG_FLAGS_DECL;
1617
1618     PERL_UNUSED_ARG(data);
1619     RX_MATCH_UTF8_set(prog,do_utf8);
1620
1621     PL_reg_re = prog;
1622 #ifdef DEBUGGING
1623     PL_regnarrate = DEBUG_r_TEST;
1624 #endif
1625
1626     /* Be paranoid... */
1627     if (prog == NULL || startpos == NULL) {
1628         Perl_croak(aTHX_ "NULL regexp parameter");
1629         return 0;
1630     }
1631
1632     minlen = prog->minlen;
1633     if (strend - startpos < minlen) {
1634         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1635                               "String too short [regexec_flags]...\n"));
1636         goto phooey;
1637     }
1638
1639     /* Check validity of program. */
1640     if (UCHARAT(prog->program) != REG_MAGIC) {
1641         Perl_croak(aTHX_ "corrupted regexp program");
1642     }
1643
1644     PL_reg_flags = 0;
1645     PL_reg_eval_set = 0;
1646     PL_reg_maxiter = 0;
1647
1648     if (prog->reganch & ROPT_UTF8)
1649         PL_reg_flags |= RF_utf8;
1650
1651     /* Mark beginning of line for ^ and lookbehind. */
1652     PL_regbol = startpos;
1653     PL_bostr  = strbeg;
1654     PL_reg_sv = sv;
1655
1656     /* Mark end of line for $ (and such) */
1657     PL_regeol = strend;
1658
1659     /* see how far we have to get to not match where we matched before */
1660     PL_regtill = startpos+minend;
1661
1662     /* We start without call_cc context.  */
1663     PL_reg_call_cc = 0;
1664
1665     /* If there is a "must appear" string, look for it. */
1666     s = startpos;
1667
1668     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1669         MAGIC *mg;
1670
1671         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1672             PL_reg_ganch = startpos;
1673         else if (sv && SvTYPE(sv) >= SVt_PVMG
1674                   && SvMAGIC(sv)
1675                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1676                   && mg->mg_len >= 0) {
1677             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1678             if (prog->reganch & ROPT_ANCH_GPOS) {
1679                 if (s > PL_reg_ganch)
1680                     goto phooey;
1681                 s = PL_reg_ganch;
1682             }
1683         }
1684         else                            /* pos() not defined */
1685             PL_reg_ganch = strbeg;
1686     }
1687
1688     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1689         re_scream_pos_data d;
1690
1691         d.scream_olds = &scream_olds;
1692         d.scream_pos = &scream_pos;
1693         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1694         if (!s) {
1695             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1696             goto phooey;        /* not present */
1697         }
1698     }
1699
1700     DEBUG_EXECUTE_r({
1701         const char * const s0   = UTF
1702             ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
1703                           UNI_DISPLAY_REGEX)
1704             : prog->precomp;
1705         const int len0 = UTF ? SvCUR(dsv0) : prog->prelen;
1706         const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
1707                                                UNI_DISPLAY_REGEX) : startpos;
1708         const int len1 = do_utf8 ? SvCUR(dsv1) : strend - startpos;
1709          if (!PL_colorset)
1710              reginitcolors();
1711          PerlIO_printf(Perl_debug_log,
1712                        "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n",
1713                        PL_colors[4], PL_colors[5], PL_colors[0],
1714                        len0, len0, s0,
1715                        PL_colors[1],
1716                        len0 > 60 ? "..." : "",
1717                        PL_colors[0],
1718                        (int)(len1 > 60 ? 60 : len1),
1719                        s1, PL_colors[1],
1720                        (len1 > 60 ? "..." : "")
1721               );
1722     });
1723
1724     /* Simplest case:  anchored match need be tried only once. */
1725     /*  [unless only anchor is BOL and multiline is set] */
1726     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1727         if (s == startpos && regtry(prog, startpos))
1728             goto got_it;
1729         else if (multiline || (prog->reganch & ROPT_IMPLICIT)
1730                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1731         {
1732             char *end;
1733
1734             if (minlen)
1735                 dontbother = minlen - 1;
1736             end = HOP3c(strend, -dontbother, strbeg) - 1;
1737             /* for multiline we only have to try after newlines */
1738             if (prog->check_substr || prog->check_utf8) {
1739                 if (s == startpos)
1740                     goto after_try;
1741                 while (1) {
1742                     if (regtry(prog, s))
1743                         goto got_it;
1744                   after_try:
1745                     if (s >= end)
1746                         goto phooey;
1747                     if (prog->reganch & RE_USE_INTUIT) {
1748                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1749                         if (!s)
1750                             goto phooey;
1751                     }
1752                     else
1753                         s++;
1754                 }               
1755             } else {
1756                 if (s > startpos)
1757                     s--;
1758                 while (s < end) {
1759                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1760                         if (regtry(prog, s))
1761                             goto got_it;
1762                     }
1763                 }               
1764             }
1765         }
1766         goto phooey;
1767     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1768         if (regtry(prog, PL_reg_ganch))
1769             goto got_it;
1770         goto phooey;
1771     }
1772
1773     /* Messy cases:  unanchored match. */
1774     if ((prog->anchored_substr || prog->anchored_utf8) && prog->reganch & ROPT_SKIP) {
1775         /* we have /x+whatever/ */
1776         /* it must be a one character string (XXXX Except UTF?) */
1777         char ch;
1778 #ifdef DEBUGGING
1779         int did_match = 0;
1780 #endif
1781         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1782             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1783         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1784
1785         if (do_utf8) {
1786             while (s < strend) {
1787                 if (*s == ch) {
1788                     DEBUG_EXECUTE_r( did_match = 1 );
1789                     if (regtry(prog, s)) goto got_it;
1790                     s += UTF8SKIP(s);
1791                     while (s < strend && *s == ch)
1792                         s += UTF8SKIP(s);
1793                 }
1794                 s += UTF8SKIP(s);
1795             }
1796         }
1797         else {
1798             while (s < strend) {
1799                 if (*s == ch) {
1800                     DEBUG_EXECUTE_r( did_match = 1 );
1801                     if (regtry(prog, s)) goto got_it;
1802                     s++;
1803                     while (s < strend && *s == ch)
1804                         s++;
1805                 }
1806                 s++;
1807             }
1808         }
1809         DEBUG_EXECUTE_r(if (!did_match)
1810                 PerlIO_printf(Perl_debug_log,
1811                                   "Did not find anchored character...\n")
1812                );
1813     }
1814     else if (prog->anchored_substr != NULL
1815               || prog->anchored_utf8 != NULL
1816               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1817                   && prog->float_max_offset < strend - s)) {
1818         SV *must;
1819         I32 back_max;
1820         I32 back_min;
1821         char *last;
1822         char *last1;            /* Last position checked before */
1823 #ifdef DEBUGGING
1824         int did_match = 0;
1825 #endif
1826         if (prog->anchored_substr || prog->anchored_utf8) {
1827             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1828                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1829             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1830             back_max = back_min = prog->anchored_offset;
1831         } else {
1832             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1833                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1834             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1835             back_max = prog->float_max_offset;
1836             back_min = prog->float_min_offset;
1837         }
1838         if (must == &PL_sv_undef)
1839             /* could not downgrade utf8 check substring, so must fail */
1840             goto phooey;
1841
1842         last = HOP3c(strend,    /* Cannot start after this */
1843                           -(I32)(CHR_SVLEN(must)
1844                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1845
1846         if (s > PL_bostr)
1847             last1 = HOPc(s, -1);
1848         else
1849             last1 = s - 1;      /* bogus */
1850
1851         /* XXXX check_substr already used to find "s", can optimize if
1852            check_substr==must. */
1853         scream_pos = -1;
1854         dontbother = end_shift;
1855         strend = HOPc(strend, -dontbother);
1856         while ( (s <= last) &&
1857                 ((flags & REXEC_SCREAM)
1858                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1859                                     end_shift, &scream_pos, 0))
1860                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1861                                   (unsigned char*)strend, must,
1862                                   multiline ? FBMrf_MULTILINE : 0))) ) {
1863             /* we may be pointing at the wrong string */
1864             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1865                 s = strbeg + (s - SvPVX_const(sv));
1866             DEBUG_EXECUTE_r( did_match = 1 );
1867             if (HOPc(s, -back_max) > last1) {
1868                 last1 = HOPc(s, -back_min);
1869                 s = HOPc(s, -back_max);
1870             }
1871             else {
1872                 char * const t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1873
1874                 last1 = HOPc(s, -back_min);
1875                 s = t;
1876             }
1877             if (do_utf8) {
1878                 while (s <= last1) {
1879                     if (regtry(prog, s))
1880                         goto got_it;
1881                     s += UTF8SKIP(s);
1882                 }
1883             }
1884             else {
1885                 while (s <= last1) {
1886                     if (regtry(prog, s))
1887                         goto got_it;
1888                     s++;
1889                 }
1890             }
1891         }
1892         DEBUG_EXECUTE_r(if (!did_match)
1893                     PerlIO_printf(Perl_debug_log, 
1894                                   "Did not find %s substr \"%s%.*s%s\"%s...\n",
1895                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1896                                ? "anchored" : "floating"),
1897                               PL_colors[0],
1898                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1899                               SvPVX_const(must),
1900                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1901                );
1902         goto phooey;
1903     }
1904     else if ((c = prog->regstclass)) {
1905         if (minlen) {
1906             I32 op = (U8)OP(prog->regstclass);
1907             /* don't bother with what can't match */
1908             if (PL_regkind[op] != EXACT && op != CANY)
1909                 strend = HOPc(strend, -(minlen - 1));
1910         }
1911         DEBUG_EXECUTE_r({
1912             SV *prop = sv_newmortal();
1913             const char *s0;
1914             const char *s1;
1915             int len0;
1916             int len1;
1917
1918             regprop(prop, c);
1919             s0 = UTF ?
1920               pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
1921                              UNI_DISPLAY_REGEX) :
1922               SvPVX_const(prop);
1923             len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
1924             s1 = UTF ?
1925               sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
1926             len1 = UTF ? SvCUR(dsv1) : strend - s;
1927             PerlIO_printf(Perl_debug_log,
1928                           "Matching stclass \"%*.*s\" against \"%*.*s\"\n",
1929                           len0, len0, s0,
1930                           len1, len1, s1);
1931         });
1932         if (find_byclass(prog, c, s, strend, 0))
1933             goto got_it;
1934         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1935     }
1936     else {
1937         dontbother = 0;
1938         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
1939             /* Trim the end. */
1940             char *last;
1941             SV* float_real;
1942
1943             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1944                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1945             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
1946
1947             if (flags & REXEC_SCREAM) {
1948                 last = screaminstr(sv, float_real, s - strbeg,
1949                                    end_shift, &scream_pos, 1); /* last one */
1950                 if (!last)
1951                     last = scream_olds; /* Only one occurrence. */
1952                 /* we may be pointing at the wrong string */
1953                 else if (RX_MATCH_COPIED(prog))
1954                     s = strbeg + (s - SvPVX_const(sv));
1955             }
1956             else {
1957                 STRLEN len;
1958                 const char * const little = SvPV_const(float_real, len);
1959
1960                 if (SvTAIL(float_real)) {
1961                     if (memEQ(strend - len + 1, little, len - 1))
1962                         last = strend - len + 1;
1963                     else if (!multiline)
1964                         last = memEQ(strend - len, little, len)
1965                             ? strend - len : NULL;
1966                     else
1967                         goto find_last;
1968                 } else {
1969                   find_last:
1970                     if (len)
1971                         last = rninstr(s, strend, little, little + len);
1972                     else
1973                         last = strend;  /* matching "$" */
1974                 }
1975             }
1976             if (last == NULL) {
1977                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1978                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
1979                                       PL_colors[4], PL_colors[5]));
1980                 goto phooey; /* Should not happen! */
1981             }
1982             dontbother = strend - last + prog->float_min_offset;
1983         }
1984         if (minlen && (dontbother < minlen))
1985             dontbother = minlen - 1;
1986         strend -= dontbother;              /* this one's always in bytes! */
1987         /* We don't know much -- general case. */
1988         if (do_utf8) {
1989             for (;;) {
1990                 if (regtry(prog, s))
1991                     goto got_it;
1992                 if (s >= strend)
1993                     break;
1994                 s += UTF8SKIP(s);
1995             };
1996         }
1997         else {
1998             do {
1999                 if (regtry(prog, s))
2000                     goto got_it;
2001             } while (s++ < strend);
2002         }
2003     }
2004
2005     /* Failure. */
2006     goto phooey;
2007
2008 got_it:
2009     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2010
2011     if (PL_reg_eval_set) {
2012         /* Preserve the current value of $^R */
2013         if (oreplsv != GvSV(PL_replgv))
2014             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2015                                                   restored, the value remains
2016                                                   the same. */
2017         restore_pos(aTHX_ prog);
2018     }
2019
2020     /* make sure $`, $&, $', and $digit will work later */
2021     if ( !(flags & REXEC_NOT_FIRST) ) {
2022         RX_MATCH_COPY_FREE(prog);
2023         if (flags & REXEC_COPY_STR) {
2024             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2025 #ifdef PERL_OLD_COPY_ON_WRITE
2026             if ((SvIsCOW(sv)
2027                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2028                 if (DEBUG_C_TEST) {
2029                     PerlIO_printf(Perl_debug_log,
2030                                   "Copy on write: regexp capture, type %d\n",
2031                                   (int) SvTYPE(sv));
2032                 }
2033                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2034                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2035                 assert (SvPOKp(prog->saved_copy));
2036             } else
2037 #endif
2038             {
2039                 RX_MATCH_COPIED_on(prog);
2040                 s = savepvn(strbeg, i);
2041                 prog->subbeg = s;
2042             }
2043             prog->sublen = i;
2044         }
2045         else {
2046             prog->subbeg = strbeg;
2047             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2048         }
2049     }
2050
2051     return 1;
2052
2053 phooey:
2054     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2055                           PL_colors[4], PL_colors[5]));
2056     if (PL_reg_eval_set)
2057         restore_pos(aTHX_ prog);
2058     return 0;
2059 }
2060
2061 /*
2062  - regtry - try match at specific point
2063  */
2064 STATIC I32                      /* 0 failure, 1 success */
2065 S_regtry(pTHX_ regexp *prog, char *startpos)
2066 {
2067     dVAR;
2068     register I32 i;
2069     register I32 *sp;
2070     register I32 *ep;
2071     CHECKPOINT lastcp;
2072     GET_RE_DEBUG_FLAGS_DECL;
2073
2074 #ifdef DEBUGGING
2075     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2076 #endif
2077     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2078         MAGIC *mg;
2079
2080         PL_reg_eval_set = RS_init;
2081         DEBUG_EXECUTE_r(DEBUG_s(
2082             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2083                           (IV)(PL_stack_sp - PL_stack_base));
2084             ));
2085         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2086         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2087         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2088         SAVETMPS;
2089         /* Apparently this is not needed, judging by wantarray. */
2090         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2091            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2092
2093         if (PL_reg_sv) {
2094             /* Make $_ available to executed code. */
2095             if (PL_reg_sv != DEFSV) {
2096                 SAVE_DEFSV;
2097                 DEFSV = PL_reg_sv;
2098             }
2099         
2100             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2101                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2102                 /* prepare for quick setting of pos */
2103 #ifdef PERL_OLD_COPY_ON_WRITE
2104                 if (SvIsCOW(sv))
2105                     sv_force_normal_flags(sv, 0);
2106 #endif
2107                 mg = sv_magicext(PL_reg_sv, (SV*)0, PERL_MAGIC_regex_global,
2108                                  &PL_vtbl_mglob, NULL, 0);
2109                 mg->mg_len = -1;
2110             }
2111             PL_reg_magic    = mg;
2112             PL_reg_oldpos   = mg->mg_len;
2113             SAVEDESTRUCTOR_X(restore_pos, prog);
2114         }
2115         if (!PL_reg_curpm) {
2116             Newxz(PL_reg_curpm, 1, PMOP);
2117 #ifdef USE_ITHREADS
2118             {
2119                 SV* repointer = newSViv(0);
2120                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2121                 SvFLAGS(repointer) |= SVf_BREAK;
2122                 av_push(PL_regex_padav,repointer);
2123                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2124                 PL_regex_pad = AvARRAY(PL_regex_padav);
2125             }
2126 #endif      
2127         }
2128         PM_SETRE(PL_reg_curpm, prog);
2129         PL_reg_oldcurpm = PL_curpm;
2130         PL_curpm = PL_reg_curpm;
2131         if (RX_MATCH_COPIED(prog)) {
2132             /*  Here is a serious problem: we cannot rewrite subbeg,
2133                 since it may be needed if this match fails.  Thus
2134                 $` inside (?{}) could fail... */
2135             PL_reg_oldsaved = prog->subbeg;
2136             PL_reg_oldsavedlen = prog->sublen;
2137 #ifdef PERL_OLD_COPY_ON_WRITE
2138             PL_nrs = prog->saved_copy;
2139 #endif
2140             RX_MATCH_COPIED_off(prog);
2141         }
2142         else
2143             PL_reg_oldsaved = NULL;
2144         prog->subbeg = PL_bostr;
2145         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2146     }
2147     prog->startp[0] = startpos - PL_bostr;
2148     PL_reginput = startpos;
2149     PL_regstartp = prog->startp;
2150     PL_regendp = prog->endp;
2151     PL_reglastparen = &prog->lastparen;
2152     PL_reglastcloseparen = &prog->lastcloseparen;
2153     prog->lastparen = 0;
2154     prog->lastcloseparen = 0;
2155     PL_regsize = 0;
2156     DEBUG_EXECUTE_r(PL_reg_starttry = startpos);
2157     if (PL_reg_start_tmpl <= prog->nparens) {
2158         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2159         if(PL_reg_start_tmp)
2160             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2161         else
2162             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2163     }
2164
2165     /* XXXX What this code is doing here?!!!  There should be no need
2166        to do this again and again, PL_reglastparen should take care of
2167        this!  --ilya*/
2168
2169     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2170      * Actually, the code in regcppop() (which Ilya may be meaning by
2171      * PL_reglastparen), is not needed at all by the test suite
2172      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2173      * enough, for building DynaLoader, or otherwise this
2174      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2175      * will happen.  Meanwhile, this code *is* needed for the
2176      * above-mentioned test suite tests to succeed.  The common theme
2177      * on those tests seems to be returning null fields from matches.
2178      * --jhi */
2179 #if 1
2180     sp = prog->startp;
2181     ep = prog->endp;
2182     if (prog->nparens) {
2183         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2184             *++sp = -1;
2185             *++ep = -1;
2186         }
2187     }
2188 #endif
2189     REGCP_SET(lastcp);
2190     if (regmatch(prog, prog->program + 1)) {
2191         prog->endp[0] = PL_reginput - PL_bostr;
2192         return 1;
2193     }
2194     REGCP_UNWIND(lastcp);
2195     return 0;
2196 }
2197
2198 #define RE_UNWIND_BRANCH        1
2199 #define RE_UNWIND_BRANCHJ       2
2200
2201 union re_unwind_t;
2202
2203 typedef struct {                /* XX: makes sense to enlarge it... */
2204     I32 type;
2205     I32 prev;
2206     CHECKPOINT lastcp;
2207 } re_unwind_generic_t;
2208
2209 typedef struct {
2210     I32 type;
2211     I32 prev;
2212     CHECKPOINT lastcp;
2213     I32 lastparen;
2214     regnode *next;
2215     char *locinput;
2216     I32 nextchr;
2217 #ifdef DEBUGGING
2218     int regindent;
2219 #endif
2220 } re_unwind_branch_t;
2221
2222 typedef union re_unwind_t {
2223     I32 type;
2224     re_unwind_generic_t generic;
2225     re_unwind_branch_t branch;
2226 } re_unwind_t;
2227
2228 #define sayYES goto yes
2229 #define sayNO goto no
2230 #define sayNO_ANYOF goto no_anyof
2231 #define sayYES_FINAL goto yes_final
2232 #define sayYES_LOUD  goto yes_loud
2233 #define sayNO_FINAL  goto no_final
2234 #define sayNO_SILENT goto do_no
2235 #define saySAME(x) if (x) goto yes; else goto no
2236
2237 #define POSCACHE_SUCCESS 0      /* caching success rather than failure */
2238 #define POSCACHE_SEEN 1         /* we know what we're caching */
2239 #define POSCACHE_START 2        /* the real cache: this bit maps to pos 0 */
2240 #define CACHEsayYES STMT_START { \
2241     if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) { \
2242         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2243             PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) || (1<<POSCACHE_SEEN); \
2244         else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2245             /* cache records failure, but this is success */ \
2246             DEBUG_r( \
2247                 PerlIO_printf(Perl_debug_log, \
2248                     "%*s  (remove success from failure cache)\n", \
2249                     REPORT_CODE_OFF+PL_regindent*2, "") \
2250             ); \
2251             PL_reg_poscache[st->u.whilem.cache_offset] &= ~(1<<st->u.whilem.cache_bit); \
2252         } \
2253     } \
2254     sayYES; \
2255 } STMT_END
2256 #define CACHEsayNO STMT_START { \
2257     if (st->u.whilem.cache_offset | st->u.whilem.cache_bit) { \
2258         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2259             PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
2260         else if ((PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2261             /* cache records success, but this is failure */ \
2262             DEBUG_r( \
2263                 PerlIO_printf(Perl_debug_log, \
2264                     "%*s  (remove failure from success cache)\n", \
2265                     REPORT_CODE_OFF+PL_regindent*2, "") \
2266             ); \
2267             PL_reg_poscache[st->u.whilem.cache_offset] &= ~(1<<st->u.whilem.cache_bit); \
2268         } \
2269     } \
2270     sayNO; \
2271 } STMT_END
2272
2273 /* this is used to determine how far from the left messages like
2274    'failed...' are printed. Currently 29 makes these messages line
2275    up with the opcode they refer to. Earlier perls used 25 which
2276    left these messages outdented making reviewing a debug output
2277    quite difficult.
2278 */
2279 #define REPORT_CODE_OFF 29
2280
2281
2282 /* Make sure there is a test for this +1 options in re_tests */
2283 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2284
2285 /* grab a new slab and return the first slot in it */
2286
2287 STATIC regmatch_state *
2288 S_push_slab(pTHX)
2289 {
2290     regmatch_slab *s = PL_regmatch_slab->next;
2291     if (!s) {
2292         Newx(s, 1, regmatch_slab);
2293         s->prev = PL_regmatch_slab;
2294         s->next = NULL;
2295         PL_regmatch_slab->next = s;
2296     }
2297     PL_regmatch_slab = s;
2298     return &s->states[0];
2299 }
2300
2301 /* simulate a recursive call to regmatch */
2302
2303 #define REGMATCH(ns, where) \
2304     st->scan = scan; \
2305     scan = (ns); \
2306     st->resume_state = resume_##where; \
2307     goto start_recurse; \
2308     resume_point_##where:
2309
2310 /*
2311  - regmatch - main matching routine
2312  *
2313  * Conceptually the strategy is simple:  check to see whether the current
2314  * node matches, call self recursively to see whether the rest matches,
2315  * and then act accordingly.  In practice we make some effort to avoid
2316  * recursion, in particular by going through "ordinary" nodes (that don't
2317  * need to know whether the rest of the match failed) by a loop instead of
2318  * by recursion.
2319  */
2320 /* [lwall] I've hoisted the register declarations to the outer block in order to
2321  * maybe save a little bit of pushing and popping on the stack.  It also takes
2322  * advantage of machines that use a register save mask on subroutine entry.
2323  *
2324  * This function used to be heavily recursive, but since this had the
2325  * effect of blowing the CPU stack on complex regexes, it has been
2326  * restructured to be iterative, and to save state onto the heap rather
2327  * than the stack. Essentially whereever regmatch() used to be called, it
2328  * pushes the current state, notes where to return, then jumps back into
2329  * the main loop.
2330  *
2331  * Originally the structure of this function used to look something like
2332
2333     S_regmatch() {
2334         int a = 1, b = 2;
2335         ...
2336         while (scan != NULL) {
2337             a++; // do stuff with a and b
2338             ...
2339             switch (OP(scan)) {
2340                 case FOO: {
2341                     int local = 3;
2342                     ...
2343                     if (regmatch(...))  // recurse
2344                         goto yes;
2345                 }
2346                 ...
2347             }
2348         }
2349         yes:
2350         return 1;
2351     }
2352
2353  * Now it looks something like this:
2354
2355     typedef struct {
2356         int a, b, local;
2357         int resume_state;
2358     } regmatch_state;
2359
2360     S_regmatch() {
2361         regmatch_state *st = new();
2362         int depth=0;
2363         st->a++; // do stuff with a and b
2364         ...
2365         while (scan != NULL) {
2366             ...
2367             switch (OP(scan)) {
2368                 case FOO: {
2369                     st->local = 3;
2370                     ...
2371                     st->scan = scan;
2372                     scan = ...;
2373                     st->resume_state = resume_FOO;
2374                     goto start_recurse; // recurse
2375
2376                     resume_point_FOO:
2377                     if (result)
2378                         goto yes;
2379                 }
2380                 ...
2381             }
2382           start_recurse:
2383             st = new(); push a new state
2384             st->a = 1; st->b = 2;
2385             depth++;
2386         }
2387       yes:
2388         result = 1;
2389         if (depth--) {
2390             st = pop();
2391             switch (resume_state) {
2392             case resume_FOO:
2393                 goto resume_point_FOO;
2394             ...
2395             }
2396         }
2397         return result
2398     }
2399             
2400  * WARNING: this means that any line in this function that contains a
2401  * REGMATCH() or TRYPAREN() is actually simulating a recursive call to
2402  * regmatch() using gotos instead. Thus the values of any local variables
2403  * not saved in the regmatch_state structure will have been lost when
2404  * execution resumes on the next line .
2405  *
2406  * States (ie the st pointer) are allocated in slabs of about 4K in size.
2407  * PL_regmatch_state always points to the currently active state, and
2408  * PL_regmatch_slab points to the slab currently containing PL_regmatch_state.
2409  * The first time regmatch is called, the first slab is allocated, and is
2410  * never freed until interpreter desctruction. When the slab is full,
2411  * a new one is allocated chained to the end. At exit from regmatch, slabs
2412  * allocated since entry are freed.
2413  */
2414  
2415
2416 STATIC I32                      /* 0 failure, 1 success */
2417 S_regmatch(pTHX_ regexp *rex, regnode *prog)
2418 {
2419     dVAR;
2420     register const bool do_utf8 = PL_reg_match_utf8;
2421     const U32 uniflags = UTF8_ALLOW_DEFAULT;
2422
2423     regmatch_slab  *orig_slab;
2424     regmatch_state *orig_state;
2425
2426     /* the current state. This is a cached copy of PL_regmatch_state */
2427     register regmatch_state *st;
2428
2429     /* cache heavy used fields of st in registers */
2430     register regnode *scan;
2431     register regnode *next;
2432     register I32 n = 0; /* initialize to shut up compiler warning */
2433     register char *locinput = PL_reginput;
2434
2435     /* these variables are NOT saved during a recusive RFEGMATCH: */
2436     register I32 nextchr;   /* is always set to UCHARAT(locinput) */
2437     bool result;            /* return value of S_regmatch */
2438     regnode *inner;         /* Next node in internal branch. */
2439     int depth = 0;          /* depth of recursion */
2440     
2441 #ifdef DEBUGGING
2442     SV *re_debug_flags = NULL;
2443     GET_RE_DEBUG_FLAGS;
2444     PL_regindent++;
2445 #endif
2446
2447     /* on first ever call to regmatch, allocate first slab */
2448     if (!PL_regmatch_slab) {
2449         Newx(PL_regmatch_slab, 1, regmatch_slab);
2450         PL_regmatch_slab->prev = NULL;
2451         PL_regmatch_slab->next = NULL;
2452         PL_regmatch_state = &PL_regmatch_slab->states[0] - 1;
2453     }
2454
2455     /* remember current high-water mark for exit */
2456     /* XXX this should be done with SAVE* instead */
2457     orig_slab  = PL_regmatch_slab;
2458     orig_state = PL_regmatch_state;
2459
2460     /* grab next free state slot */
2461     st = ++PL_regmatch_state;
2462     if (st >  &(PL_regmatch_slab->states[PERL_REGMATCH_SLAB_SLOTS-1]))
2463         st = PL_regmatch_state = S_push_slab(aTHX);
2464
2465     st->minmod = 0;
2466     st->sw = 0;
2467     st->logical = 0;
2468     st->unwind = 0;
2469     st->cc = NULL;
2470     /* Note that nextchr is a byte even in UTF */
2471     nextchr = UCHARAT(locinput);
2472     scan = prog;
2473     while (scan != NULL) {
2474
2475         DEBUG_EXECUTE_r( {
2476             SV * const prop = sv_newmortal();
2477             const int docolor = *PL_colors[0];
2478             const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2479             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2480             /* The part of the string before starttry has one color
2481                (pref0_len chars), between starttry and current
2482                position another one (pref_len - pref0_len chars),
2483                after the current position the third one.
2484                We assume that pref0_len <= pref_len, otherwise we
2485                decrease pref0_len.  */
2486             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2487                 ? (5 + taill) - l : locinput - PL_bostr;
2488             int pref0_len;
2489
2490             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2491                 pref_len++;
2492             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2493             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2494                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2495                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2496             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2497                 l--;
2498             if (pref0_len < 0)
2499                 pref0_len = 0;
2500             if (pref0_len > pref_len)
2501                 pref0_len = pref_len;
2502             regprop(prop, scan);
2503             {
2504               const char * const s0 =
2505                 do_utf8 && OP(scan) != CANY ?
2506                 pv_uni_display(PERL_DEBUG_PAD(0), (U8*)(locinput - pref_len),
2507                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2508                 locinput - pref_len;
2509               const int len0 = do_utf8 ? strlen(s0) : pref0_len;
2510               const char * const s1 = do_utf8 && OP(scan) != CANY ?
2511                 pv_uni_display(PERL_DEBUG_PAD(1),
2512                                (U8*)(locinput - pref_len + pref0_len),
2513                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2514                 locinput - pref_len + pref0_len;
2515               const int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2516               const char * const s2 = do_utf8 && OP(scan) != CANY ?
2517                 pv_uni_display(PERL_DEBUG_PAD(2), (U8*)locinput,
2518                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2519                 locinput;
2520               const int len2 = do_utf8 ? strlen(s2) : l;
2521               PerlIO_printf(Perl_debug_log,
2522                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2523                             (IV)(locinput - PL_bostr),
2524                             PL_colors[4],
2525                             len0, s0,
2526                             PL_colors[5],
2527                             PL_colors[2],
2528                             len1, s1,
2529                             PL_colors[3],
2530                             (docolor ? "" : "> <"),
2531                             PL_colors[0],
2532                             len2, s2,
2533                             PL_colors[1],
2534                             15 - l - pref_len + 1,
2535                             "",
2536                             (IV)(scan - rex->program), PL_regindent*2, "",
2537                             SvPVX_const(prop));
2538             }
2539         });
2540
2541         next = scan + NEXT_OFF(scan);
2542         if (next == scan)
2543             next = NULL;
2544
2545         switch (OP(scan)) {
2546         case BOL:
2547             if (locinput == PL_bostr)
2548             {
2549                 /* regtill = regbol; */
2550                 break;
2551             }
2552             sayNO;
2553         case MBOL:
2554             if (locinput == PL_bostr ||
2555                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2556             {
2557                 break;
2558             }
2559             sayNO;
2560         case SBOL:
2561             if (locinput == PL_bostr)
2562                 break;
2563             sayNO;
2564         case GPOS:
2565             if (locinput == PL_reg_ganch)
2566                 break;
2567             sayNO;
2568         case EOL:
2569                 goto seol;
2570         case MEOL:
2571             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2572                 sayNO;
2573             break;
2574         case SEOL:
2575           seol:
2576             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2577                 sayNO;
2578             if (PL_regeol - locinput > 1)
2579                 sayNO;
2580             break;
2581         case EOS:
2582             if (PL_regeol != locinput)
2583                 sayNO;
2584             break;
2585         case SANY:
2586             if (!nextchr && locinput >= PL_regeol)
2587                 sayNO;
2588             if (do_utf8) {
2589                 locinput += PL_utf8skip[nextchr];
2590                 if (locinput > PL_regeol)
2591                     sayNO;
2592                 nextchr = UCHARAT(locinput);
2593             }
2594             else
2595                 nextchr = UCHARAT(++locinput);
2596             break;
2597         case CANY:
2598             if (!nextchr && locinput >= PL_regeol)
2599                 sayNO;
2600             nextchr = UCHARAT(++locinput);
2601             break;
2602         case REG_ANY:
2603             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2604                 sayNO;
2605             if (do_utf8) {
2606                 locinput += PL_utf8skip[nextchr];
2607                 if (locinput > PL_regeol)
2608                     sayNO;
2609                 nextchr = UCHARAT(locinput);
2610             }
2611             else
2612                 nextchr = UCHARAT(++locinput);
2613             break;
2614
2615
2616
2617         /*
2618            traverse the TRIE keeping track of all accepting states
2619            we transition through until we get to a failing node.
2620
2621
2622         */
2623         case TRIE:
2624         case TRIEF:
2625         case TRIEFL:
2626             {
2627                 U8 *uc = ( U8* )locinput;
2628                 U32 state = 1;
2629                 U16 charid = 0;
2630                 U32 base = 0;
2631                 UV uvc = 0;
2632                 STRLEN len = 0;
2633                 STRLEN foldlen = 0;
2634                 U8 *uscan = (U8*)NULL;
2635                 STRLEN bufflen=0;
2636                 SV *sv_accept_buff = NULL;
2637                 const enum { trie_plain, trie_utf8, trie_uft8_fold }
2638                     trie_type = do_utf8 ?
2639                           (OP(scan) == TRIE ? trie_utf8 : trie_uft8_fold)
2640                         : trie_plain;
2641
2642                 /* what trie are we using right now */
2643                 reg_trie_data *trie
2644                     = (reg_trie_data*)PL_reg_re->data->data[ ARG( scan ) ];
2645                 st->u.trie.accepted = 0; /* how many accepting states we have seen */
2646                 result = 0;
2647
2648                 while ( state && uc <= (U8*)PL_regeol ) {
2649
2650                     if (trie->states[ state ].wordnum) {
2651                         if (!st->u.trie.accepted ) {
2652                             ENTER;
2653                             SAVETMPS;
2654                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
2655                             sv_accept_buff=newSV(bufflen *
2656                                             sizeof(reg_trie_accepted) - 1);
2657                             SvCUR_set(sv_accept_buff,
2658                                                 sizeof(reg_trie_accepted));
2659                             SvPOK_on(sv_accept_buff);
2660                             sv_2mortal(sv_accept_buff);
2661                             st->u.trie.accept_buff =
2662                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
2663                         }
2664                         else {
2665                             if (st->u.trie.accepted >= bufflen) {
2666                                 bufflen *= 2;
2667                                 st->u.trie.accept_buff =(reg_trie_accepted*)
2668                                     SvGROW(sv_accept_buff,
2669                                         bufflen * sizeof(reg_trie_accepted));
2670                             }
2671                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
2672                                 + sizeof(reg_trie_accepted));
2673                         }
2674                         st->u.trie.accept_buff[st->u.trie.accepted].wordnum = trie->states[state].wordnum;
2675                         st->u.trie.accept_buff[st->u.trie.accepted].endpos = uc;
2676                         ++st->u.trie.accepted;
2677                     }
2678
2679                     base = trie->states[ state ].trans.base;
2680
2681                     DEBUG_TRIE_EXECUTE_r(
2682                                 PerlIO_printf( Perl_debug_log,
2683                                     "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2684                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2685                                     (UV)state, (UV)base, (UV)st->u.trie.accepted );
2686                     );
2687
2688                     if ( base ) {
2689                         switch (trie_type) {
2690                         case trie_uft8_fold:
2691                             if ( foldlen>0 ) {
2692                                 uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
2693                                 foldlen -= len;
2694                                 uscan += len;
2695                                 len=0;
2696                             } else {
2697                                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2698                                 uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2699                                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );
2700                                 foldlen -= UNISKIP( uvc );
2701                                 uscan = foldbuf + UNISKIP( uvc );
2702                             }
2703                             break;
2704                         case trie_utf8:
2705                             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN,
2706                                                             &len, uniflags );
2707                             break;
2708                         case trie_plain:
2709                             uvc = (UV)*uc;
2710                             len = 1;
2711                         }
2712
2713                         if (uvc < 256) {
2714                             charid = trie->charmap[ uvc ];
2715                         }
2716                         else {
2717                             charid = 0;
2718                             if (trie->widecharmap) {
2719                                 SV** svpp = (SV**)NULL;
2720                                 svpp = hv_fetch(trie->widecharmap,
2721                                             (char*)&uvc, sizeof(UV), 0);
2722                                 if (svpp)
2723                                     charid = (U16)SvIV(*svpp);
2724                             }
2725                         }
2726
2727                         if (charid &&
2728                              (base + charid > trie->uniquecharcount )
2729                              && (base + charid - 1 - trie->uniquecharcount
2730                                     < trie->lasttrans)
2731                              && trie->trans[base + charid - 1 -
2732                                     trie->uniquecharcount].check == state)
2733                         {
2734                             state = trie->trans[base + charid - 1 -
2735                                 trie->uniquecharcount ].next;
2736                         }
2737                         else {
2738                             state = 0;
2739                         }
2740                         uc += len;
2741
2742                     }
2743                     else {
2744                         state = 0;
2745                     }
2746                     DEBUG_TRIE_EXECUTE_r(
2747                         PerlIO_printf( Perl_debug_log,
2748                             "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2749                             charid, uvc, (UV)state, PL_colors[5] );
2750                     );
2751                 }
2752                 if (!st->u.trie.accepted )
2753                    sayNO;
2754
2755             /*
2756                There was at least one accepting state that we
2757                transitioned through. Presumably the number of accepting
2758                states is going to be low, typically one or two. So we
2759                simply scan through to find the one with lowest wordnum.
2760                Once we find it, we swap the last state into its place
2761                and decrement the size. We then try to match the rest of
2762                the pattern at the point where the word ends, if we
2763                succeed then we end the loop, otherwise the loop
2764                eventually terminates once all of the accepting states
2765                have been tried.
2766             */
2767
2768                 if ( st->u.trie.accepted == 1 ) {
2769                     DEBUG_EXECUTE_r({
2770                         SV **tmp = av_fetch( trie->words, st->u.trie.accept_buff[ 0 ].wordnum-1, 0 );
2771                         PerlIO_printf( Perl_debug_log,
2772                             "%*s  %sonly one match : #%d <%s>%s\n",
2773                             REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2774                             st->u.trie.accept_buff[ 0 ].wordnum,
2775                             tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
2776                             PL_colors[5] );
2777                     });
2778                     PL_reginput = (char *)st->u.trie.accept_buff[ 0 ].endpos;
2779                     /* in this case we free tmps/leave before we call regmatch
2780                        as we wont be using accept_buff again. */
2781                     FREETMPS;
2782                     LEAVE;
2783                     REGMATCH(scan + NEXT_OFF(scan), TRIE1);
2784                     /*** all unsaved local vars undefined at this point */
2785                 } else {
2786                     DEBUG_EXECUTE_r(
2787                         PerlIO_printf( Perl_debug_log,"%*s  %sgot %"IVdf" possible matches%s\n",
2788                             REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4], (IV)st->u.trie.accepted,
2789                             PL_colors[5] );
2790                     );
2791                     while ( !result && st->u.trie.accepted-- ) {
2792                         U32 best = 0;
2793                         U32 cur;
2794                         for( cur = 1 ; cur <= st->u.trie.accepted ; cur++ ) {
2795                             DEBUG_TRIE_EXECUTE_r(
2796                                 PerlIO_printf( Perl_debug_log,
2797                                     "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
2798                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2799                                     (IV)best, st->u.trie.accept_buff[ best ].wordnum, (IV)cur,
2800                                     st->u.trie.accept_buff[ cur ].wordnum, PL_colors[5] );
2801                             );
2802
2803                             if (st->u.trie.accept_buff[cur].wordnum <
2804                                     st->u.trie.accept_buff[best].wordnum)
2805                                 best = cur;
2806                         }
2807                         DEBUG_EXECUTE_r({
2808                             SV ** const tmp = av_fetch( trie->words, st->u.trie.accept_buff[ best ].wordnum - 1, 0 );
2809                             PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
2810                                 REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2811                                 st->u.trie.accept_buff[best].wordnum,
2812                                 tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
2813                                 PL_colors[5] );
2814                         });
2815                         if ( best<st->u.trie.accepted ) {
2816                             reg_trie_accepted tmp = st->u.trie.accept_buff[ best ];
2817                             st->u.trie.accept_buff[ best ] = st->u.trie.accept_buff[ st->u.trie.accepted ];
2818                             st->u.trie.accept_buff[ st->u.trie.accepted ] = tmp;
2819                             best = st->u.trie.accepted;
2820                         }
2821                         PL_reginput = (char *)st->u.trie.accept_buff[ best ].endpos;
2822
2823                         /* 
2824                            as far as I can tell we only need the SAVETMPS/FREETMPS 
2825                            for re's with EVAL in them but I'm leaving them in for 
2826                            all until I can be sure.
2827                          */
2828                         SAVETMPS;
2829                         REGMATCH(scan + NEXT_OFF(scan), TRIE2);
2830                         /*** all unsaved local vars undefined at this point */
2831                         FREETMPS;
2832                     }
2833                     FREETMPS;
2834                     LEAVE;
2835                 }
2836                 
2837                 if (result) {
2838                     sayYES;
2839                 } else {
2840                     sayNO;
2841                 }
2842             }
2843             /* unreached codepoint */
2844         case EXACT: {
2845             char *s = STRING(scan);
2846             st->ln = STR_LEN(scan);
2847             if (do_utf8 != UTF) {
2848                 /* The target and the pattern have differing utf8ness. */
2849                 char *l = locinput;
2850                 const char *e = s + st->ln;
2851
2852                 if (do_utf8) {
2853                     /* The target is utf8, the pattern is not utf8. */
2854                     while (s < e) {
2855                         STRLEN ulen;
2856                         if (l >= PL_regeol)
2857                              sayNO;
2858                         if (NATIVE_TO_UNI(*(U8*)s) !=
2859                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2860                                             uniflags))
2861                              sayNO;
2862                         l += ulen;
2863                         s ++;
2864                     }
2865                 }
2866                 else {
2867                     /* The target is not utf8, the pattern is utf8. */
2868                     while (s < e) {
2869                         STRLEN ulen;
2870                         if (l >= PL_regeol)
2871                             sayNO;
2872                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2873                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2874                                            uniflags))
2875                             sayNO;
2876                         s += ulen;
2877                         l ++;
2878                     }
2879                 }
2880                 locinput = l;
2881                 nextchr = UCHARAT(locinput);
2882                 break;
2883             }
2884             /* The target and the pattern have the same utf8ness. */
2885             /* Inline the first character, for speed. */
2886             if (UCHARAT(s) != nextchr)
2887                 sayNO;
2888             if (PL_regeol - locinput < st->ln)
2889                 sayNO;
2890             if (st->ln > 1 && memNE(s, locinput, st->ln))
2891                 sayNO;
2892             locinput += st->ln;
2893             nextchr = UCHARAT(locinput);
2894             break;
2895             }
2896         case EXACTFL:
2897             PL_reg_flags |= RF_tainted;
2898             /* FALL THROUGH */
2899         case EXACTF: {
2900             char *s = STRING(scan);
2901             st->ln = STR_LEN(scan);
2902
2903             if (do_utf8 || UTF) {
2904               /* Either target or the pattern are utf8. */
2905                 char *l = locinput;
2906                 char *e = PL_regeol;
2907
2908                 if (ibcmp_utf8(s, 0,  st->ln, (bool)UTF,
2909                                l, &e, 0,  do_utf8)) {
2910                      /* One more case for the sharp s:
2911                       * pack("U0U*", 0xDF) =~ /ss/i,
2912                       * the 0xC3 0x9F are the UTF-8
2913                       * byte sequence for the U+00DF. */
2914                      if (!(do_utf8 &&
2915                            toLOWER(s[0]) == 's' &&
2916                            st->ln >= 2 &&
2917                            toLOWER(s[1]) == 's' &&
2918                            (U8)l[0] == 0xC3 &&
2919                            e - l >= 2 &&
2920                            (U8)l[1] == 0x9F))
2921                           sayNO;
2922                 }
2923                 locinput = e;
2924                 nextchr = UCHARAT(locinput);
2925                 break;
2926             }
2927
2928             /* Neither the target and the pattern are utf8. */
2929
2930             /* Inline the first character, for speed. */
2931             if (UCHARAT(s) != nextchr &&
2932                 UCHARAT(s) != ((OP(scan) == EXACTF)
2933                                ? PL_fold : PL_fold_locale)[nextchr])
2934                 sayNO;
2935             if (PL_regeol - locinput < st->ln)
2936                 sayNO;
2937             if (st->ln > 1 && (OP(scan) == EXACTF
2938                            ? ibcmp(s, locinput, st->ln)
2939                            : ibcmp_locale(s, locinput, st->ln)))
2940                 sayNO;
2941             locinput += st->ln;
2942             nextchr = UCHARAT(locinput);
2943             break;
2944             }
2945         case ANYOF:
2946             if (do_utf8) {
2947                 STRLEN inclasslen = PL_regeol - locinput;
2948
2949                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2950                     sayNO_ANYOF;
2951                 if (locinput >= PL_regeol)
2952                     sayNO;
2953                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2954                 nextchr = UCHARAT(locinput);
2955                 break;
2956             }
2957             else {
2958                 if (nextchr < 0)
2959                     nextchr = UCHARAT(locinput);
2960                 if (!REGINCLASS(scan, (U8*)locinput))
2961                     sayNO_ANYOF;
2962                 if (!nextchr && locinput >= PL_regeol)
2963                     sayNO;
2964                 nextchr = UCHARAT(++locinput);
2965                 break;
2966             }
2967         no_anyof:
2968             /* If we might have the case of the German sharp s
2969              * in a casefolding Unicode character class. */
2970
2971             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2972                  locinput += SHARP_S_SKIP;
2973                  nextchr = UCHARAT(locinput);
2974             }
2975             else
2976                  sayNO;
2977             break;
2978         case ALNUML:
2979             PL_reg_flags |= RF_tainted;
2980             /* FALL THROUGH */
2981         case ALNUM:
2982             if (!nextchr)
2983                 sayNO;
2984             if (do_utf8) {
2985                 LOAD_UTF8_CHARCLASS_ALNUM();
2986                 if (!(OP(scan) == ALNUM
2987                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2988                       : isALNUM_LC_utf8((U8*)locinput)))
2989                 {
2990                     sayNO;
2991                 }
2992                 locinput += PL_utf8skip[nextchr];
2993                 nextchr = UCHARAT(locinput);
2994                 break;
2995             }
2996             if (!(OP(scan) == ALNUM
2997                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2998                 sayNO;
2999             nextchr = UCHARAT(++locinput);
3000             break;
3001         case NALNUML:
3002             PL_reg_flags |= RF_tainted;
3003             /* FALL THROUGH */
3004         case NALNUM:
3005             if (!nextchr && locinput >= PL_regeol)
3006                 sayNO;
3007             if (do_utf8) {
3008                 LOAD_UTF8_CHARCLASS_ALNUM();
3009                 if (OP(scan) == NALNUM
3010                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
3011                     : isALNUM_LC_utf8((U8*)locinput))
3012                 {
3013                     sayNO;
3014                 }
3015                 locinput += PL_utf8skip[nextchr];
3016                 nextchr = UCHARAT(locinput);
3017                 break;
3018             }
3019             if (OP(scan) == NALNUM
3020                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
3021                 sayNO;
3022             nextchr = UCHARAT(++locinput);
3023             break;
3024         case BOUNDL:
3025         case NBOUNDL:
3026             PL_reg_flags |= RF_tainted;
3027             /* FALL THROUGH */
3028         case BOUND:
3029         case NBOUND:
3030             /* was last char in word? */
3031             if (do_utf8) {
3032                 if (locinput == PL_bostr)
3033                     st->ln = '\n';
3034                 else {
3035                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
3036                 
3037                     st->ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, uniflags);
3038                 }
3039                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3040                     st->ln = isALNUM_uni(st->ln);
3041                     LOAD_UTF8_CHARCLASS_ALNUM();
3042                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
3043                 }
3044                 else {
3045                     st->ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(st->ln));
3046                     n = isALNUM_LC_utf8((U8*)locinput);
3047                 }
3048             }
3049             else {
3050                 st->ln = (locinput != PL_bostr) ?
3051                     UCHARAT(locinput - 1) : '\n';
3052                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
3053                     st->ln = isALNUM(st->ln);
3054                     n = isALNUM(nextchr);
3055                 }
3056                 else {
3057                     st->ln = isALNUM_LC(st->ln);
3058                     n = isALNUM_LC(nextchr);
3059                 }
3060             }
3061             if (((!st->ln) == (!n)) == (OP(scan) == BOUND ||
3062                                     OP(scan) == BOUNDL))
3063                     sayNO;
3064             break;
3065         case SPACEL:
3066             PL_reg_flags |= RF_tainted;
3067             /* FALL THROUGH */
3068         case SPACE:
3069             if (!nextchr)
3070                 sayNO;
3071             if (do_utf8) {
3072                 if (UTF8_IS_CONTINUED(nextchr)) {
3073                     LOAD_UTF8_CHARCLASS_SPACE();
3074                     if (!(OP(scan) == SPACE
3075                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3076                           : isSPACE_LC_utf8((U8*)locinput)))
3077                     {
3078                         sayNO;
3079                     }
3080                     locinput += PL_utf8skip[nextchr];
3081                     nextchr = UCHARAT(locinput);
3082                     break;
3083                 }
3084                 if (!(OP(scan) == SPACE
3085                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3086                     sayNO;
3087                 nextchr = UCHARAT(++locinput);
3088             }
3089             else {
3090                 if (!(OP(scan) == SPACE
3091                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
3092                     sayNO;
3093                 nextchr = UCHARAT(++locinput);
3094             }
3095             break;
3096         case NSPACEL:
3097             PL_reg_flags |= RF_tainted;
3098             /* FALL THROUGH */
3099         case NSPACE:
3100             if (!nextchr && locinput >= PL_regeol)
3101                 sayNO;
3102             if (do_utf8) {
3103                 LOAD_UTF8_CHARCLASS_SPACE();
3104                 if (OP(scan) == NSPACE
3105                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3106                     : isSPACE_LC_utf8((U8*)locinput))
3107                 {
3108                     sayNO;
3109                 }
3110                 locinput += PL_utf8skip[nextchr];
3111                 nextchr = UCHARAT(locinput);
3112                 break;
3113             }
3114             if (OP(scan) == NSPACE
3115                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3116                 sayNO;
3117             nextchr = UCHARAT(++locinput);
3118             break;
3119         case DIGITL:
3120             PL_reg_flags |= RF_tainted;
3121             /* FALL THROUGH */
3122         case DIGIT:
3123             if (!nextchr)
3124                 sayNO;
3125             if (do_utf8) {
3126                 LOAD_UTF8_CHARCLASS_DIGIT();
3127                 if (!(OP(scan) == DIGIT
3128                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3129                       : isDIGIT_LC_utf8((U8*)locinput)))
3130                 {
3131                     sayNO;
3132                 }
3133                 locinput += PL_utf8skip[nextchr];
3134                 nextchr = UCHARAT(locinput);
3135                 break;
3136             }
3137             if (!(OP(scan) == DIGIT
3138                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3139                 sayNO;
3140             nextchr = UCHARAT(++locinput);
3141             break;
3142         case NDIGITL:
3143             PL_reg_flags |= RF_tainted;
3144             /* FALL THROUGH */
3145         case NDIGIT:
3146             if (!nextchr && locinput >= PL_regeol)
3147                 sayNO;
3148             if (do_utf8) {
3149                 LOAD_UTF8_CHARCLASS_DIGIT();
3150                 if (OP(scan) == NDIGIT
3151                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3152                     : isDIGIT_LC_utf8((U8*)locinput))
3153                 {
3154                     sayNO;
3155                 }
3156                 locinput += PL_utf8skip[nextchr];
3157                 nextchr = UCHARAT(locinput);
3158                 break;
3159             }
3160             if (OP(scan) == NDIGIT
3161                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3162                 sayNO;
3163             nextchr = UCHARAT(++locinput);
3164             break;
3165         case CLUMP:
3166             if (locinput >= PL_regeol)
3167                 sayNO;
3168             if  (do_utf8) {
3169                 LOAD_UTF8_CHARCLASS_MARK();
3170                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3171                     sayNO;
3172                 locinput += PL_utf8skip[nextchr];
3173                 while (locinput < PL_regeol &&
3174                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3175                     locinput += UTF8SKIP(locinput);
3176                 if (locinput > PL_regeol)
3177                     sayNO;
3178             } 
3179             else
3180                locinput++;
3181             nextchr = UCHARAT(locinput);
3182             break;
3183         case REFFL:
3184             PL_reg_flags |= RF_tainted;
3185             /* FALL THROUGH */
3186         case REF:
3187         case REFF: {
3188             char *s;
3189             n = ARG(scan);  /* which paren pair */
3190             st->ln = PL_regstartp[n];
3191             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3192             if ((I32)*PL_reglastparen < n || st->ln == -1)
3193                 sayNO;                  /* Do not match unless seen CLOSEn. */
3194             if (st->ln == PL_regendp[n])
3195                 break;
3196
3197             s = PL_bostr + st->ln;
3198             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
3199                 char *l = locinput;
3200                 const char *e = PL_bostr + PL_regendp[n];
3201                 /*
3202                  * Note that we can't do the "other character" lookup trick as
3203                  * in the 8-bit case (no pun intended) because in Unicode we
3204                  * have to map both upper and title case to lower case.
3205                  */
3206                 if (OP(scan) == REFF) {
3207                     while (s < e) {
3208                         STRLEN ulen1, ulen2;
3209                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3210                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3211
3212                         if (l >= PL_regeol)
3213                             sayNO;
3214                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3215                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3216                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3217                             sayNO;
3218                         s += ulen1;
3219                         l += ulen2;
3220                     }
3221                 }
3222                 locinput = l;
3223                 nextchr = UCHARAT(locinput);
3224                 break;
3225             }
3226
3227             /* Inline the first character, for speed. */
3228             if (UCHARAT(s) != nextchr &&
3229                 (OP(scan) == REF ||
3230                  (UCHARAT(s) != ((OP(scan) == REFF
3231                                   ? PL_fold : PL_fold_locale)[nextchr]))))
3232                 sayNO;
3233             st->ln = PL_regendp[n] - st->ln;
3234             if (locinput + st->ln > PL_regeol)
3235                 sayNO;
3236             if (st->ln > 1 && (OP(scan) == REF
3237                            ? memNE(s, locinput, st->ln)
3238                            : (OP(scan) == REFF
3239                               ? ibcmp(s, locinput, st->ln)
3240                               : ibcmp_locale(s, locinput, st->ln))))
3241                 sayNO;
3242             locinput += st->ln;
3243             nextchr = UCHARAT(locinput);
3244             break;
3245             }
3246
3247         case NOTHING:
3248         case TAIL:
3249             break;
3250         case BACK:
3251             break;
3252         case EVAL:
3253         {
3254             SV *ret;
3255             {
3256                 /* execute the code in the {...} */
3257                 dSP;
3258                 SV ** const before = SP;
3259                 OP_4tree * const oop = PL_op;
3260                 COP * const ocurcop = PL_curcop;
3261                 PAD *old_comppad;
3262                 struct regexp * const oreg = PL_reg_re;
3263             
3264                 n = ARG(scan);
3265                 PL_op = (OP_4tree*)PL_reg_re->data->data[n];
3266                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3267                 PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_reg_re->data->data[n + 2]);
3268                 PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3269
3270                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3271                 SPAGAIN;
3272                 if (SP == before)
3273                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3274                 else {
3275                     ret = POPs;
3276                     PUTBACK;
3277                 }
3278
3279                 PL_op = oop;
3280                 PAD_RESTORE_LOCAL(old_comppad);
3281                 PL_curcop = ocurcop;
3282                 if (!st->logical) {
3283                     /* /(?{...})/ */
3284                     sv_setsv(save_scalar(PL_replgv), ret);
3285                     PL_reg_re = oreg;
3286                     break;
3287                 }
3288             }
3289             if (st->logical == 2) { /* Postponed subexpression: /(??{...})/ */
3290                 regexp *re;
3291                 re_cc_state state;
3292                 int toggleutf;
3293
3294                 {
3295                     /* extract RE object from returned value; compiling if
3296                      * necessary */
3297
3298                     MAGIC *mg = NULL;
3299                     SV *sv;
3300                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3301                         mg = mg_find(sv, PERL_MAGIC_qr);
3302                     else if (SvSMAGICAL(ret)) {
3303                         if (SvGMAGICAL(ret))
3304                             sv_unmagic(ret, PERL_MAGIC_qr);
3305                         else
3306                             mg = mg_find(ret, PERL_MAGIC_qr);
3307                     }
3308
3309                     if (mg) {
3310                         re = (regexp *)mg->mg_obj;
3311                         (void)ReREFCNT_inc(re);
3312                     }
3313                     else {
3314                         STRLEN len;
3315                         const char * const t = SvPV_const(ret, len);
3316                         PMOP pm;
3317                         const I32 osize = PL_regsize;
3318
3319                         Zero(&pm, 1, PMOP);
3320                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3321                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
3322                         if (!(SvFLAGS(ret)
3323                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3324                                 | SVs_GMG)))
3325                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3326                                         PERL_MAGIC_qr,0,0);
3327                         PL_regsize = osize;
3328                     }
3329                 }
3330                 DEBUG_EXECUTE_r(
3331                     PerlIO_printf(Perl_debug_log,
3332                                   "Entering embedded \"%s%.60s%s%s\"\n",
3333                                   PL_colors[0],
3334                                   re->precomp,
3335                                   PL_colors[1],
3336                                   (strlen(re->precomp) > 60 ? "..." : ""))
3337                     );
3338                 state.node = next;
3339                 state.prev = PL_reg_call_cc;
3340                 state.cc = st->cc;
3341                 state.re = PL_reg_re;
3342
3343                 st->cc = 0;
3344             
3345                 st->u.eval.cp = regcppush(0);   /* Save *all* the positions. */
3346                 REGCP_SET(st->u.eval.lastcp);
3347                 PL_reg_re = re;
3348                 state.ss = PL_savestack_ix;
3349                 *PL_reglastparen = 0;
3350                 *PL_reglastcloseparen = 0;
3351                 PL_reg_call_cc = &state;
3352                 PL_reginput = locinput;
3353                 toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
3354                             ((re->reganch & ROPT_UTF8) != 0);
3355                 if (toggleutf) PL_reg_flags ^= RF_utf8;
3356
3357                 /* XXXX This is too dramatic a measure... */
3358                 PL_reg_maxiter = 0;
3359
3360                 /* XXX the only recursion left in regmatch() */
3361                 if (regmatch(re, re->program + 1)) {
3362                     /* Even though we succeeded, we need to restore
3363                        global variables, since we may be wrapped inside
3364                        SUSPEND, thus the match may be not finished yet. */
3365
3366                     /* XXXX Do this only if SUSPENDed? */
3367                     PL_reg_call_cc = state.prev;
3368                     st->cc = state.cc;
3369                     PL_reg_re = state.re;
3370
3371                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3372
3373                     /* XXXX This is too dramatic a measure... */
3374                     PL_reg_maxiter = 0;
3375
3376                     /* These are needed even if not SUSPEND. */
3377                     ReREFCNT_dec(re);
3378                     regcpblow(st->u.eval.cp);
3379                     sayYES;
3380                 }
3381                 ReREFCNT_dec(re);
3382                 REGCP_UNWIND(st->u.eval.lastcp);
3383                 regcppop(rex);
3384                 PL_reg_call_cc = state.prev;
3385                 st->cc = state.cc;
3386                 PL_reg_re = state.re;
3387                 if (toggleutf) PL_reg_flags ^= RF_utf8;
3388
3389                 /* XXXX This is too dramatic a measure... */
3390                 PL_reg_maxiter = 0;
3391
3392                 st->logical = 0;
3393                 sayNO;
3394                 /* NOTREACHED */
3395             }
3396             /* /(?(?{...})X|Y)/ */
3397             st->sw = SvTRUE(ret);
3398             st->logical = 0;
3399             break;
3400         }
3401         case OPEN:
3402             n = ARG(scan);  /* which paren pair */
3403             PL_reg_start_tmp[n] = locinput;
3404             if (n > PL_regsize)
3405                 PL_regsize = n;
3406             break;
3407         case CLOSE:
3408             n = ARG(scan);  /* which paren pair */
3409             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3410             PL_regendp[n] = locinput - PL_bostr;
3411             if (n > (I32)*PL_reglastparen)
3412                 *PL_reglastparen = n;
3413             *PL_reglastcloseparen = n;
3414             break;
3415         case GROUPP:
3416             n = ARG(scan);  /* which paren pair */
3417             st->sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3418             break;
3419         case IFTHEN:
3420             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3421             if (st->sw)
3422                 next = NEXTOPER(NEXTOPER(scan));
3423             else {
3424                 next = scan + ARG(scan);
3425                 if (OP(next) == IFTHEN) /* Fake one. */
3426                     next = NEXTOPER(NEXTOPER(next));
3427             }
3428             break;
3429         case LOGICAL:
3430             st->logical = scan->flags;
3431             break;
3432 /*******************************************************************
3433  cc points to the regmatch_state associated with the most recent CURLYX.
3434  This struct contains info about the innermost (...)* loop (an
3435  "infoblock"), and a pointer to the next outer cc.
3436
3437  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3438
3439    1) After matching Y, regnode for CURLYX is processed;
3440
3441    2) This regnode populates cc, and calls regmatch() recursively
3442       with the starting point at WHILEM node;
3443
3444    3) Each hit of WHILEM node tries to match A and Z (in the order
3445       depending on the current iteration, min/max of {min,max} and
3446       greediness).  The information about where are nodes for "A"
3447       and "Z" is read from cc, as is info on how many times "A"
3448       was already matched, and greediness.
3449
3450    4) After A matches, the same WHILEM node is hit again.
3451
3452    5) Each time WHILEM is hit, cc is the infoblock created by CURLYX
3453       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3454       resets cc, since this Y(A)*Z can be a part of some other loop:
3455       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3456       of the external loop.
3457
3458  Currently present infoblocks form a tree with a stem formed by st->cc
3459  and whatever it mentions via ->next, and additional attached trees
3460  corresponding to temporarily unset infoblocks as in "5" above.
3461
3462  In the following picture, infoblocks for outer loop of
3463  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3464  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3465  infoblocks are drawn below the "reset" infoblock.
3466
3467  In fact in the picture below we do not show failed matches for Z and T
3468  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3469  more obvious *why* one needs to *temporary* unset infoblocks.]
3470
3471   Matched       REx position    InfoBlocks      Comment
3472                 (Y(A)*?Z)*?T    x
3473                 Y(A)*?Z)*?T     x <- O
3474   Y             (A)*?Z)*?T      x <- O
3475   Y             A)*?Z)*?T       x <- O <- I
3476   YA            )*?Z)*?T        x <- O <- I
3477   YA            A)*?Z)*?T       x <- O <- I
3478   YAA           )*?Z)*?T        x <- O <- I
3479   YAA           Z)*?T           x <- O          # Temporary unset I
3480                                      I
3481
3482   YAAZ          Y(A)*?Z)*?T     x <- O
3483                                      I
3484
3485   YAAZY         (A)*?Z)*?T      x <- O
3486                                      I
3487
3488   YAAZY         A)*?Z)*?T       x <- O <- I
3489                                      I
3490
3491   YAAZYA        )*?Z)*?T        x <- O <- I     
3492                                      I
3493
3494   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3495                                      I,I
3496
3497   YAAZYAZ       )*?T            x <- O
3498                                      I,I
3499
3500   YAAZYAZ       T               x               # Temporary unset O
3501                                 O
3502                                 I,I
3503
3504   YAAZYAZT                      x
3505                                 O
3506                                 I,I
3507  *******************************************************************/
3508
3509         case CURLYX: {
3510                 /* No need to save/restore up to this paren */
3511                 I32 parenfloor = scan->flags;
3512
3513                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3514                     next += ARG(next);
3515                 /* XXXX Probably it is better to teach regpush to support
3516                    parenfloor > PL_regsize... */
3517                 if (parenfloor > (I32)*PL_reglastparen)
3518                     parenfloor = *PL_reglastparen; /* Pessimization... */
3519
3520                 st->u.curlyx.cp = PL_savestack_ix;
3521                 st->u.curlyx.outercc = st->cc;
3522                 st->cc = st;
3523                 /* these fields contain the state of the current curly.
3524                  * they are accessed by subsequent WHILEMs;
3525                  * cur and lastloc are also updated by WHILEM */
3526                 st->u.curlyx.parenfloor = parenfloor;
3527                 st->u.curlyx.cur = -1; /* this will be updated by WHILEM */
3528                 st->u.curlyx.min = ARG1(scan);
3529                 st->u.curlyx.max  = ARG2(scan);
3530                 st->u.curlyx.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3531                 st->u.curlyx.lastloc = 0;
3532                 /* st->next and st->minmod are also read by WHILEM */
3533
3534                 PL_reginput = locinput;
3535                 REGMATCH(PREVOPER(next), CURLYX); /* start on the WHILEM */
3536                 /*** all unsaved local vars undefined at this point */
3537                 regcpblow(st->u.curlyx.cp);
3538                 st->cc = st->u.curlyx.outercc;
3539                 saySAME(result);
3540             }
3541             /* NOTREACHED */
3542         case WHILEM: {
3543                 /*
3544                  * This is really hard to understand, because after we match
3545                  * what we're trying to match, we must make sure the rest of
3546                  * the REx is going to match for sure, and to do that we have
3547                  * to go back UP the parse tree by recursing ever deeper.  And
3548                  * if it fails, we have to reset our parent's current state
3549                  * that we can try again after backing off.
3550                  */
3551
3552                 st->u.whilem.lastloc = st->cc->u.curlyx.lastloc; /* Detection of 0-len. */
3553                 st->u.whilem.cache_offset = 0;
3554                 st->u.whilem.cache_bit = 0;
3555                 
3556                 n = st->cc->u.curlyx.cur + 1; /* how many we know we matched */
3557                 PL_reginput = locinput;
3558
3559                 DEBUG_EXECUTE_r(
3560                     PerlIO_printf(Perl_debug_log,
3561                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3562                                   REPORT_CODE_OFF+PL_regindent*2, "",
3563                                   (long)n, (long)st->cc->u.curlyx.min,
3564                                   (long)st->cc->u.curlyx.max, PTR2UV(st->cc))
3565                     );
3566
3567                 /* If degenerate scan matches "", assume scan done. */
3568
3569                 if (locinput == st->cc->u.curlyx.lastloc && n >= st->cc->u.curlyx.min) {
3570                     st->u.whilem.savecc = st->cc;
3571                     st->cc = st->cc->u.curlyx.outercc;
3572                     if (st->cc)
3573                         st->ln = st->cc->u.curlyx.cur;
3574                     DEBUG_EXECUTE_r(
3575                         PerlIO_printf(Perl_debug_log,
3576                            "%*s  empty match detected, try continuation...\n",
3577                            REPORT_CODE_OFF+PL_regindent*2, "")
3578                         );
3579                     REGMATCH(st->u.whilem.savecc->next, WHILEM1);
3580                     /*** all unsaved local vars undefined at this point */
3581                     st->cc = st->u.whilem.savecc;
3582                     if (result)
3583                         sayYES;
3584                     if (st->cc->u.curlyx.outercc)
3585                         st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3586                     sayNO;
3587                 }
3588
3589                 /* First just match a string of min scans. */
3590
3591                 if (n < st->cc->u.curlyx.min) {
3592                     st->cc->u.curlyx.cur = n;
3593                     st->cc->u.curlyx.lastloc = locinput;
3594                     REGMATCH(st->cc->u.curlyx.scan, WHILEM2);
3595                     /*** all unsaved local vars undefined at this point */
3596                     if (result)
3597                         sayYES;
3598                     st->cc->u.curlyx.cur = n - 1;
3599                     st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3600                     sayNO;
3601                 }
3602
3603                 if (scan->flags) {
3604                     /* Check whether we already were at this position.
3605                         Postpone detection until we know the match is not
3606                         *that* much linear. */
3607                 if (!PL_reg_maxiter) {
3608                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3609                     PL_reg_leftiter = PL_reg_maxiter;
3610                 }
3611                 if (PL_reg_leftiter-- == 0) {
3612                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3613                     if (PL_reg_poscache) {
3614                         if ((I32)PL_reg_poscache_size < size) {
3615                             Renew(PL_reg_poscache, size, char);
3616                             PL_reg_poscache_size = size;
3617                         }
3618                         Zero(PL_reg_poscache, size, char);
3619                     }
3620                     else {
3621                         PL_reg_poscache_size = size;
3622                         Newxz(PL_reg_poscache, size, char);
3623                     }
3624                     DEBUG_EXECUTE_r(
3625                         PerlIO_printf(Perl_debug_log,
3626               "%sDetected a super-linear match, switching on caching%s...\n",
3627                                       PL_colors[4], PL_colors[5])
3628                         );
3629                 }
3630                 if (PL_reg_leftiter < 0) {
3631                     st->u.whilem.cache_offset = locinput - PL_bostr;
3632
3633                     st->u.whilem.cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3634                             + st->u.whilem.cache_offset * (scan->flags>>4);
3635                     st->u.whilem.cache_bit = st->u.whilem.cache_offset % 8;
3636                     st->u.whilem.cache_offset /= 8;
3637                     if (PL_reg_poscache[st->u.whilem.cache_offset] & (1<<st->u.whilem.cache_bit)) {
3638                     DEBUG_EXECUTE_r(
3639                         PerlIO_printf(Perl_debug_log,
3640                                       "%*s  already tried at this position...\n",
3641                                       REPORT_CODE_OFF+PL_regindent*2, "")
3642                         );
3643                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3644                             /* cache records success */
3645                             sayYES;
3646                         else
3647                             /* cache records failure */
3648                             sayNO_SILENT;
3649                     }
3650                     PL_reg_poscache[st->u.whilem.cache_offset] |= (1<<st->u.whilem.cache_bit);
3651                 }
3652                 }
3653
3654                 /* Prefer next over scan for minimal matching. */
3655
3656                 if (st->cc->minmod) {
3657                     st->u.whilem.savecc = st->cc;
3658                     st->cc = st->cc->u.curlyx.outercc;
3659                     if (st->cc)
3660                         st->ln = st->cc->u.curlyx.cur;
3661                     st->u.whilem.cp = regcppush(st->u.whilem.savecc->u.curlyx.parenfloor);
3662                     REGCP_SET(st->u.whilem.lastcp);
3663                     REGMATCH(st->u.whilem.savecc->next, WHILEM3);
3664                     /*** all unsaved local vars undefined at this point */
3665                     st->cc = st->u.whilem.savecc;
3666                     if (result) {
3667                         regcpblow(st->u.whilem.cp);
3668                         CACHEsayYES;    /* All done. */
3669                     }
3670                     REGCP_UNWIND(st->u.whilem.lastcp);
3671                     regcppop(rex);
3672                     if (st->cc->u.curlyx.outercc)
3673                         st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3674
3675                     if (n >= st->cc->u.curlyx.max) { /* Maximum greed exceeded? */
3676                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3677                             && !(PL_reg_flags & RF_warned)) {
3678                             PL_reg_flags |= RF_warned;
3679                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3680                                  "Complex regular subexpression recursion",
3681                                  REG_INFTY - 1);
3682                         }
3683                         CACHEsayNO;
3684                     }
3685
3686                     DEBUG_EXECUTE_r(
3687                         PerlIO_printf(Perl_debug_log,
3688                                       "%*s  trying longer...\n",
3689                                       REPORT_CODE_OFF+PL_regindent*2, "")
3690                         );
3691                     /* Try scanning more and see if it helps. */
3692                     PL_reginput = locinput;
3693                     st->cc->u.curlyx.cur = n;
3694                     st->cc->u.curlyx.lastloc = locinput;
3695                     st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
3696                     REGCP_SET(st->u.whilem.lastcp);
3697                     REGMATCH(st->cc->u.curlyx.scan, WHILEM4);
3698                     /*** all unsaved local vars undefined at this point */
3699                     if (result) {
3700                         regcpblow(st->u.whilem.cp);
3701                         CACHEsayYES;
3702                     }
3703                     REGCP_UNWIND(st->u.whilem.lastcp);
3704                     regcppop(rex);
3705                     st->cc->u.curlyx.cur = n - 1;
3706                     st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3707                     CACHEsayNO;
3708                 }
3709
3710                 /* Prefer scan over next for maximal matching. */
3711
3712                 if (n < st->cc->u.curlyx.max) { /* More greed allowed? */
3713                     st->u.whilem.cp = regcppush(st->cc->u.curlyx.parenfloor);
3714                     st->cc->u.curlyx.cur = n;
3715                     st->cc->u.curlyx.lastloc = locinput;
3716                     REGCP_SET(st->u.whilem.lastcp);
3717                     REGMATCH(st->cc->u.curlyx.scan, WHILEM5);
3718                     /*** all unsaved local vars undefined at this point */
3719                     if (result) {
3720                         regcpblow(st->u.whilem.cp);
3721                         CACHEsayYES;
3722                     }
3723                     REGCP_UNWIND(st->u.whilem.lastcp);
3724                     regcppop(rex);      /* Restore some previous $<digit>s? */
3725                     PL_reginput = locinput;
3726                     DEBUG_EXECUTE_r(
3727                         PerlIO_printf(Perl_debug_log,
3728                                       "%*s  failed, try continuation...\n",
3729                                       REPORT_CODE_OFF+PL_regindent*2, "")
3730                         );
3731                 }
3732                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3733                         && !(PL_reg_flags & RF_warned)) {
3734                     PL_reg_flags |= RF_warned;
3735                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3736                          "Complex regular subexpression recursion",
3737                          REG_INFTY - 1);
3738                 }
3739
3740                 /* Failed deeper matches of scan, so see if this one works. */
3741                 st->u.whilem.savecc = st->cc;
3742                 st->cc = st->cc->u.curlyx.outercc;
3743                 if (st->cc)
3744                     st->ln = st->cc->u.curlyx.cur;
3745                 REGMATCH(st->u.whilem.savecc->next, WHILEM6);
3746                 /*** all unsaved local vars undefined at this point */
3747                 st->cc = st->u.whilem.savecc;
3748                 if (result)
3749                     CACHEsayYES;
3750                 if (st->cc->u.curlyx.outercc)
3751                     st->cc->u.curlyx.outercc->u.curlyx.cur = st->ln;
3752                 st->cc->u.curlyx.cur = n - 1;
3753                 st->cc->u.curlyx.lastloc = st->u.whilem.lastloc;
3754                 CACHEsayNO;
3755             }
3756             /* NOTREACHED */
3757         case BRANCHJ:
3758             next = scan + ARG(scan);
3759             if (next == scan)
3760                 next = NULL;
3761             inner = NEXTOPER(NEXTOPER(scan));
3762             goto do_branch;
3763         case BRANCH:
3764             inner = NEXTOPER(scan);
3765           do_branch:
3766             {
3767                 I32 type;
3768                 type = OP(scan);
3769                 if (OP(next) != type)   /* No choice. */
3770                     next = inner;       /* Avoid recursion. */
3771                 else {
3772                     const I32 lastparen = *PL_reglastparen;
3773                     /* Put unwinding data on stack */
3774                     const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
3775                     re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
3776
3777                     uw->prev = st->unwind;
3778                     st->unwind = unwind1;
3779                     uw->type = ((type == BRANCH)
3780                                 ? RE_UNWIND_BRANCH
3781                                 : RE_UNWIND_BRANCHJ);
3782                     uw->lastparen = lastparen;
3783                     uw->next = next;
3784                     uw->locinput = locinput;
3785                     uw->nextchr = nextchr;
3786 #ifdef DEBUGGING
3787                     uw->regindent = ++PL_regindent;
3788 #endif
3789
3790                     REGCP_SET(uw->lastcp);
3791
3792                     /* Now go into the first branch */
3793                     next = inner;
3794                 }
3795             }
3796             break;
3797         case MINMOD:
3798             st->minmod = 1;
3799             break;
3800         case CURLYM:
3801         {
3802             st->u.curlym.l = st->u.curlym.matches = 0;
3803         
3804             /* We suppose that the next guy does not need
3805                backtracking: in particular, it is of constant non-zero length,
3806                and has no parenths to influence future backrefs. */
3807             st->ln = ARG1(scan);  /* min to match */
3808             n  = ARG2(scan);  /* max to match */
3809             st->u.curlym.paren = scan->flags;
3810             if (st->u.curlym.paren) {
3811                 if (st->u.curlym.paren > PL_regsize)
3812                     PL_regsize = st->u.curlym.paren;
3813                 if (st->u.curlym.paren > (I32)*PL_reglastparen)
3814                     *PL_reglastparen = st->u.curlym.paren;
3815             }
3816             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3817             if (st->u.curlym.paren)
3818                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3819             PL_reginput = locinput;
3820             st->u.curlym.maxwanted = st->minmod ? st->ln : n;
3821             if (st->u.curlym.maxwanted) {
3822                 while (PL_reginput < PL_regeol && st->u.curlym.matches < st->u.curlym.maxwanted) {
3823                     REGMATCH(scan, CURLYM1);
3824                     /*** all unsaved local vars undefined at this point */
3825                     if (!result)
3826                         break;
3827                     /* on first match, determine length, u.curlym.l */
3828                     if (!st->u.curlym.matches++) {
3829                         if (PL_reg_match_utf8) {
3830                             char *s = locinput;
3831                             while (s < PL_reginput) {
3832                                 st->u.curlym.l++;
3833                                 s += UTF8SKIP(s);
3834                             }
3835                         }
3836                         else {
3837                             st->u.curlym.l = PL_reginput - locinput;
3838                         }
3839                         if (st->u.curlym.l == 0) {
3840                             st->u.curlym.matches = st->u.curlym.maxwanted;
3841                             break;
3842                         }
3843                     }
3844                     locinput = PL_reginput;
3845                 }
3846             }
3847
3848             PL_reginput = locinput;
3849
3850             if (st->minmod) {
3851                 st->minmod = 0;
3852                 if (st->ln && st->u.curlym.matches < st->ln)
3853                     sayNO;
3854                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3855                     regnode *text_node = next;
3856
3857                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3858
3859                     if (! HAS_TEXT(text_node)) st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3860                     else {
3861                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3862                             st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3863                             goto assume_ok_MM;
3864                         }
3865                         else { st->u.curlym.c1 = (U8)*STRING(text_node); }
3866                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3867                             st->u.curlym.c2 = PL_fold[st->u.curlym.c1];
3868                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3869                             st->u.curlym.c2 = PL_fold_locale[st->u.curlym.c1];
3870                         else
3871                             st->u.curlym.c2 = st->u.curlym.c1;
3872                     }
3873                 }
3874                 else
3875                     st->u.curlym.c1 = st->u.curlym.c2 = -1000;
3876             assume_ok_MM:
3877                 REGCP_SET(st->u.curlym.lastcp);
3878                 while (n >= st->ln || (n == REG_INFTY && st->ln > 0)) { /* ln overflow ? */
3879                     /* If it could work, try it. */
3880                     if (st->u.curlym.c1 == -1000 ||
3881                         UCHARAT(PL_reginput) == st->u.curlym.c1 ||
3882                         UCHARAT(PL_reginput) == st->u.curlym.c2)
3883                     {
3884                         if (st->u.curlym.paren) {
3885                             if (st->ln) {
3886                                 PL_regstartp[st->u.curlym.paren] =
3887                                     HOPc(PL_reginput, -st->u.curlym.l) - PL_bostr;
3888                                 PL_regendp[st->u.curlym.paren] = PL_reginput - PL_bostr;
3889                             }