This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Further adjustement to change #27576 by Jan Dubois
[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 reghop_c(pos,off) ((char*)reghop((U8*)pos, off))
120 #define reghopmaybe_c(pos,off) ((char*)reghopmaybe((U8*)pos, off))
121 #define HOP(pos,off) (PL_reg_match_utf8 ? reghop((U8*)pos, off) : (U8*)(pos + off))
122 #define HOPMAYBE(pos,off) (PL_reg_match_utf8 ? reghopmaybe((U8*)pos, off) : (U8*)(pos + off))
123 #define HOPc(pos,off) ((char*)HOP(pos,off))
124 #define HOPMAYBEc(pos,off) ((char*)HOPMAYBE(pos,off))
125
126 #define HOPBACK(pos, off) (             \
127     (PL_reg_match_utf8)                 \
128         ? reghopmaybe((U8*)pos, -off)   \
129     : (pos - off >= PL_bostr)           \
130         ? (U8*)(pos - off)              \
131     : (U8*)NULL                         \
132 )
133 #define HOPBACKc(pos, off) (char*)HOPBACK(pos, off)
134
135 #define reghop3_c(pos,off,lim) ((char*)reghop3((U8*)pos, off, (U8*)lim))
136 #define reghopmaybe3_c(pos,off,lim) ((char*)reghopmaybe3((U8*)pos, off, (U8*)lim))
137 #define HOP3(pos,off,lim) (PL_reg_match_utf8 ? reghop3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
138 #define HOPMAYBE3(pos,off,lim) (PL_reg_match_utf8 ? reghopmaybe3((U8*)pos, off, (U8*)lim) : (U8*)(pos + off))
139 #define HOP3c(pos,off,lim) ((char*)HOP3(pos,off,lim))
140 #define HOPMAYBE3c(pos,off,lim) ((char*)HOPMAYBE3(pos,off,lim))
141
142 #define LOAD_UTF8_CHARCLASS(class,str) STMT_START { \
143     if (!CAT2(PL_utf8_,class)) { bool ok; ENTER; save_re_context(); ok=CAT2(is_utf8_,class)((const U8*)str); assert(ok); LEAVE; } } STMT_END
144 #define LOAD_UTF8_CHARCLASS_ALNUM() LOAD_UTF8_CHARCLASS(alnum,"a")
145 #define LOAD_UTF8_CHARCLASS_DIGIT() LOAD_UTF8_CHARCLASS(digit,"0")
146 #define LOAD_UTF8_CHARCLASS_SPACE() LOAD_UTF8_CHARCLASS(space," ")
147 #define LOAD_UTF8_CHARCLASS_MARK()  LOAD_UTF8_CHARCLASS(mark, "\xcd\x86")
148
149 /* for use after a quantifier and before an EXACT-like node -- japhy */
150 #define JUMPABLE(rn) ( \
151     OP(rn) == OPEN || OP(rn) == CLOSE || OP(rn) == EVAL || \
152     OP(rn) == SUSPEND || OP(rn) == IFMATCH || \
153     OP(rn) == PLUS || OP(rn) == MINMOD || \
154     (PL_regkind[(U8)OP(rn)] == CURLY && ARG1(rn) > 0) \
155 )
156
157 #define HAS_TEXT(rn) ( \
158     PL_regkind[(U8)OP(rn)] == EXACT || PL_regkind[(U8)OP(rn)] == REF \
159 )
160
161 /*
162   Search for mandatory following text node; for lookahead, the text must
163   follow but for lookbehind (rn->flags != 0) we skip to the next step.
164 */
165 #define FIND_NEXT_IMPT(rn) STMT_START { \
166     while (JUMPABLE(rn)) \
167         if (OP(rn) == SUSPEND || PL_regkind[(U8)OP(rn)] == CURLY) \
168             rn = NEXTOPER(NEXTOPER(rn)); \
169         else if (OP(rn) == PLUS) \
170             rn = NEXTOPER(rn); \
171         else if (OP(rn) == IFMATCH) \
172             rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \
173         else rn += NEXT_OFF(rn); \
174 } STMT_END 
175
176 static void restore_pos(pTHX_ void *arg);
177
178 STATIC CHECKPOINT
179 S_regcppush(pTHX_ I32 parenfloor)
180 {
181     dVAR;
182     const int retval = PL_savestack_ix;
183 #define REGCP_PAREN_ELEMS 4
184     const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
185     int p;
186
187     if (paren_elems_to_push < 0)
188         Perl_croak(aTHX_ "panic: paren_elems_to_push < 0");
189
190 #define REGCP_OTHER_ELEMS 6
191     SSGROW(paren_elems_to_push + REGCP_OTHER_ELEMS);
192     for (p = PL_regsize; p > parenfloor; p--) {
193 /* REGCP_PARENS_ELEMS are pushed per pairs of parentheses. */
194         SSPUSHINT(PL_regendp[p]);
195         SSPUSHINT(PL_regstartp[p]);
196         SSPUSHPTR(PL_reg_start_tmp[p]);
197         SSPUSHINT(p);
198     }
199 /* REGCP_OTHER_ELEMS are pushed in any case, parentheses or no. */
200     SSPUSHINT(PL_regsize);
201     SSPUSHINT(*PL_reglastparen);
202     SSPUSHINT(*PL_reglastcloseparen);
203     SSPUSHPTR(PL_reginput);
204 #define REGCP_FRAME_ELEMS 2
205 /* REGCP_FRAME_ELEMS are part of the REGCP_OTHER_ELEMS and
206  * are needed for the regexp context stack bookkeeping. */
207     SSPUSHINT(paren_elems_to_push + REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
208     SSPUSHINT(SAVEt_REGCONTEXT); /* Magic cookie. */
209
210     return retval;
211 }
212
213 /* These are needed since we do not localize EVAL nodes: */
214 #  define REGCP_SET(cp)  DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,          \
215                              "  Setting an EVAL scope, savestack=%"IVdf"\n",    \
216                              (IV)PL_savestack_ix)); cp = PL_savestack_ix
217
218 #  define REGCP_UNWIND(cp)  DEBUG_EXECUTE_r(cp != PL_savestack_ix ?             \
219                                 PerlIO_printf(Perl_debug_log,           \
220                                 "  Clearing an EVAL scope, savestack=%"IVdf"..%"IVdf"\n", \
221                                 (IV)(cp), (IV)PL_savestack_ix) : 0); regcpblow(cp)
222
223 STATIC char *
224 S_regcppop(pTHX)
225 {
226     dVAR;
227     I32 i;
228     U32 paren = 0;
229     char *input;
230
231     GET_RE_DEBUG_FLAGS_DECL;
232
233     /* Pop REGCP_OTHER_ELEMS before the parentheses loop starts. */
234     i = SSPOPINT;
235     assert(i == SAVEt_REGCONTEXT); /* Check that the magic cookie is there. */
236     i = SSPOPINT; /* Parentheses elements to pop. */
237     input = (char *) SSPOPPTR;
238     *PL_reglastcloseparen = SSPOPINT;
239     *PL_reglastparen = SSPOPINT;
240     PL_regsize = SSPOPINT;
241
242     /* Now restore the parentheses context. */
243     for (i -= (REGCP_OTHER_ELEMS - REGCP_FRAME_ELEMS);
244          i > 0; i -= REGCP_PAREN_ELEMS) {
245         I32 tmps;
246         paren = (U32)SSPOPINT;
247         PL_reg_start_tmp[paren] = (char *) SSPOPPTR;
248         PL_regstartp[paren] = SSPOPINT;
249         tmps = SSPOPINT;
250         if (paren <= *PL_reglastparen)
251             PL_regendp[paren] = tmps;
252         DEBUG_EXECUTE_r(
253             PerlIO_printf(Perl_debug_log,
254                           "     restoring \\%"UVuf" to %"IVdf"(%"IVdf")..%"IVdf"%s\n",
255                           (UV)paren, (IV)PL_regstartp[paren],
256                           (IV)(PL_reg_start_tmp[paren] - PL_bostr),
257                           (IV)PL_regendp[paren],
258                           (paren > *PL_reglastparen ? "(no)" : ""));
259         );
260     }
261     DEBUG_EXECUTE_r(
262         if ((I32)(*PL_reglastparen + 1) <= PL_regnpar) {
263             PerlIO_printf(Perl_debug_log,
264                           "     restoring \\%"IVdf"..\\%"IVdf" to undef\n",
265                           (IV)(*PL_reglastparen + 1), (IV)PL_regnpar);
266         }
267     );
268 #if 1
269     /* It would seem that the similar code in regtry()
270      * already takes care of this, and in fact it is in
271      * a better location to since this code can #if 0-ed out
272      * but the code in regtry() is needed or otherwise tests
273      * requiring null fields (pat.t#187 and split.t#{13,14}
274      * (as of patchlevel 7877)  will fail.  Then again,
275      * this code seems to be necessary or otherwise
276      * building DynaLoader will fail:
277      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
278      * --jhi */
279     for (paren = *PL_reglastparen + 1; (I32)paren <= PL_regnpar; paren++) {
280         if ((I32)paren > PL_regsize)
281             PL_regstartp[paren] = -1;
282         PL_regendp[paren] = -1;
283     }
284 #endif
285     return input;
286 }
287
288 typedef struct re_cc_state
289 {
290     I32 ss;
291     regnode *node;
292     struct re_cc_state *prev;
293     CURCUR *cc;
294     regexp *re;
295 } re_cc_state;
296
297 #define regcpblow(cp) LEAVE_SCOPE(cp)   /* Ignores regcppush()ed data. */
298
299 #define TRYPAREN(paren, n, input) {                             \
300     if (paren) {                                                \
301         if (n) {                                                \
302             PL_regstartp[paren] = HOPc(input, -1) - PL_bostr;   \
303             PL_regendp[paren] = input - PL_bostr;               \
304         }                                                       \
305         else                                                    \
306             PL_regendp[paren] = -1;                             \
307     }                                                           \
308     if (regmatch(next))                                         \
309         sayYES;                                                 \
310     if (paren && n)                                             \
311         PL_regendp[paren] = -1;                                 \
312 }
313
314
315 /*
316  * pregexec and friends
317  */
318
319 /*
320  - pregexec - match a regexp against a string
321  */
322 I32
323 Perl_pregexec(pTHX_ register regexp *prog, char *stringarg, register char *strend,
324          char *strbeg, I32 minend, SV *screamer, U32 nosave)
325 /* strend: pointer to null at end of string */
326 /* strbeg: real beginning of string */
327 /* minend: end of match must be >=minend after stringarg. */
328 /* nosave: For optimizations. */
329 {
330     return
331         regexec_flags(prog, stringarg, strend, strbeg, minend, screamer, NULL,
332                       nosave ? 0 : REXEC_COPY_STR);
333 }
334
335 STATIC void
336 S_cache_re(pTHX_ regexp *prog)
337 {
338     dVAR;
339     PL_regprecomp = prog->precomp;              /* Needed for FAIL. */
340 #ifdef DEBUGGING
341     PL_regprogram = prog->program;
342 #endif
343     PL_regnpar = prog->nparens;
344     PL_regdata = prog->data;
345     PL_reg_re = prog;
346 }
347
348 /*
349  * Need to implement the following flags for reg_anch:
350  *
351  * USE_INTUIT_NOML              - Useful to call re_intuit_start() first
352  * USE_INTUIT_ML
353  * INTUIT_AUTORITATIVE_NOML     - Can trust a positive answer
354  * INTUIT_AUTORITATIVE_ML
355  * INTUIT_ONCE_NOML             - Intuit can match in one location only.
356  * INTUIT_ONCE_ML
357  *
358  * Another flag for this function: SECOND_TIME (so that float substrs
359  * with giant delta may be not rechecked).
360  */
361
362 /* Assumptions: if ANCH_GPOS, then strpos is anchored. XXXX Check GPOS logic */
363
364 /* If SCREAM, then SvPVX_const(sv) should be compatible with strpos and strend.
365    Otherwise, only SvCUR(sv) is used to get strbeg. */
366
367 /* XXXX We assume that strpos is strbeg unless sv. */
368
369 /* XXXX Some places assume that there is a fixed substring.
370         An update may be needed if optimizer marks as "INTUITable"
371         RExen without fixed substrings.  Similarly, it is assumed that
372         lengths of all the strings are no more than minlen, thus they
373         cannot come from lookahead.
374         (Or minlen should take into account lookahead.) */
375
376 /* A failure to find a constant substring means that there is no need to make
377    an expensive call to REx engine, thus we celebrate a failure.  Similarly,
378    finding a substring too deep into the string means that less calls to
379    regtry() should be needed.
380
381    REx compiler's optimizer found 4 possible hints:
382         a) Anchored substring;
383         b) Fixed substring;
384         c) Whether we are anchored (beginning-of-line or \G);
385         d) First node (of those at offset 0) which may distingush positions;
386    We use a)b)d) and multiline-part of c), and try to find a position in the
387    string which does not contradict any of them.
388  */
389
390 /* Most of decisions we do here should have been done at compile time.
391    The nodes of the REx which we used for the search should have been
392    deleted from the finite automaton. */
393
394 char *
395 Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
396                      char *strend, U32 flags, re_scream_pos_data *data)
397 {
398     dVAR;
399     register I32 start_shift = 0;
400     /* Should be nonnegative! */
401     register I32 end_shift   = 0;
402     register char *s;
403     register SV *check;
404     char *strbeg;
405     char *t;
406     const int do_utf8 = sv ? SvUTF8(sv) : 0;    /* if no sv we have to assume bytes */
407     I32 ml_anch;
408     register char *other_last = NULL;   /* other substr checked before this */
409     char *check_at = NULL;              /* check substr found at this pos */
410     const I32 multiline = prog->reganch & PMf_MULTILINE;
411 #ifdef DEBUGGING
412     const char * const i_strpos = strpos;
413     SV * const dsv = PERL_DEBUG_PAD_ZERO(0);
414 #endif
415
416     GET_RE_DEBUG_FLAGS_DECL;
417
418     RX_MATCH_UTF8_set(prog,do_utf8);
419
420     if (prog->reganch & ROPT_UTF8) {
421         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
422                               "UTF-8 regex...\n"));
423         PL_reg_flags |= RF_utf8;
424     }
425
426     DEBUG_EXECUTE_r({
427          const char *s   = PL_reg_match_utf8 ?
428                          sv_uni_display(dsv, sv, 60, UNI_DISPLAY_REGEX) :
429                          strpos;
430          const int   len = PL_reg_match_utf8 ?
431                          strlen(s) : strend - strpos;
432          if (!PL_colorset)
433               reginitcolors();
434          if (PL_reg_match_utf8)
435              DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
436                                    "UTF-8 target...\n"));
437          PerlIO_printf(Perl_debug_log,
438                        "%sGuessing start of match, REx%s \"%s%.60s%s%s\" against \"%s%.*s%s%s\"...\n",
439                        PL_colors[4], PL_colors[5], PL_colors[0],
440                        prog->precomp,
441                        PL_colors[1],
442                        (strlen(prog->precomp) > 60 ? "..." : ""),
443                        PL_colors[0],
444                        (int)(len > 60 ? 60 : len),
445                        s, PL_colors[1],
446                        (len > 60 ? "..." : "")
447               );
448     });
449
450     /* CHR_DIST() would be more correct here but it makes things slow. */
451     if (prog->minlen > strend - strpos) {
452         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
453                               "String too short... [re_intuit_start]\n"));
454         goto fail;
455     }
456     strbeg = (sv && SvPOK(sv)) ? strend - SvCUR(sv) : strpos;
457     PL_regeol = strend;
458     if (do_utf8) {
459         if (!prog->check_utf8 && prog->check_substr)
460             to_utf8_substr(prog);
461         check = prog->check_utf8;
462     } else {
463         if (!prog->check_substr && prog->check_utf8)
464             to_byte_substr(prog);
465         check = prog->check_substr;
466     }
467    if (check == &PL_sv_undef) {
468         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
469                 "Non-utf string cannot match utf check string\n"));
470         goto fail;
471     }
472     if (prog->reganch & ROPT_ANCH) {    /* Match at beg-of-str or after \n */
473         ml_anch = !( (prog->reganch & ROPT_ANCH_SINGLE)
474                      || ( (prog->reganch & ROPT_ANCH_BOL)
475                           && !multiline ) );    /* Check after \n? */
476
477         if (!ml_anch) {
478           if ( !(prog->reganch & (ROPT_ANCH_GPOS /* Checked by the caller */
479                                   | ROPT_IMPLICIT)) /* not a real BOL */
480                /* SvCUR is not set on references: SvRV and SvPVX_const overlap */
481                && sv && !SvROK(sv)
482                && (strpos != strbeg)) {
483               DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not at start...\n"));
484               goto fail;
485           }
486           if (prog->check_offset_min == prog->check_offset_max &&
487               !(prog->reganch & ROPT_CANY_SEEN)) {
488             /* Substring at constant offset from beg-of-str... */
489             I32 slen;
490
491             s = HOP3c(strpos, prog->check_offset_min, strend);
492             if (SvTAIL(check)) {
493                 slen = SvCUR(check);    /* >= 1 */
494
495                 if ( strend - s > slen || strend - s < slen - 1
496                      || (strend - s == slen && strend[-1] != '\n')) {
497                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String too long...\n"));
498                     goto fail_finish;
499                 }
500                 /* Now should match s[0..slen-2] */
501                 slen--;
502                 if (slen && (*SvPVX_const(check) != *s
503                              || (slen > 1
504                                  && memNE(SvPVX_const(check), s, slen)))) {
505                   report_neq:
506                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "String not equal...\n"));
507                     goto fail_finish;
508                 }
509             }
510             else if (*SvPVX_const(check) != *s
511                      || ((slen = SvCUR(check)) > 1
512                          && memNE(SvPVX_const(check), s, slen)))
513                 goto report_neq;
514             check_at = s;
515             goto success_at_start;
516           }
517         }
518         /* Match is anchored, but substr is not anchored wrt beg-of-str. */
519         s = strpos;
520         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
521         end_shift = prog->minlen - start_shift -
522             CHR_SVLEN(check) + (SvTAIL(check) != 0);
523         if (!ml_anch) {
524             const I32 end = prog->check_offset_max + CHR_SVLEN(check)
525                                          - (SvTAIL(check) != 0);
526             const I32 eshift = CHR_DIST((U8*)strend, (U8*)s) - end;
527
528             if (end_shift < eshift)
529                 end_shift = eshift;
530         }
531     }
532     else {                              /* Can match at random position */
533         ml_anch = 0;
534         s = strpos;
535         start_shift = prog->check_offset_min; /* okay to underestimate on CC */
536         /* Should be nonnegative! */
537         end_shift = prog->minlen - start_shift -
538             CHR_SVLEN(check) + (SvTAIL(check) != 0);
539     }
540
541 #ifdef DEBUGGING        /* 7/99: reports of failure (with the older version) */
542     if (end_shift < 0)
543         Perl_croak(aTHX_ "panic: end_shift");
544 #endif
545
546   restart:
547     /* Find a possible match in the region s..strend by looking for
548        the "check" substring in the region corrected by start/end_shift. */
549     if (flags & REXEC_SCREAM) {
550         I32 p = -1;                     /* Internal iterator of scream. */
551         I32 * const pp = data ? data->scream_pos : &p;
552
553         if (PL_screamfirst[BmRARE(check)] >= 0
554             || ( BmRARE(check) == '\n'
555                  && (BmPREVIOUS(check) == SvCUR(check) - 1)
556                  && SvTAIL(check) ))
557             s = screaminstr(sv, check,
558                             start_shift + (s - strbeg), end_shift, pp, 0);
559         else
560             goto fail_finish;
561         /* we may be pointing at the wrong string */
562         if (s && RX_MATCH_COPIED(prog))
563             s = strbeg + (s - SvPVX_const(sv));
564         if (data)
565             *data->scream_olds = s;
566     }
567     else if (prog->reganch & ROPT_CANY_SEEN)
568         s = fbm_instr((U8*)(s + start_shift),
569                       (U8*)(strend - end_shift),
570                       check, multiline ? FBMrf_MULTILINE : 0);
571     else
572         s = fbm_instr(HOP3(s, start_shift, strend),
573                       HOP3(strend, -end_shift, strbeg),
574                       check, multiline ? FBMrf_MULTILINE : 0);
575
576     /* Update the count-of-usability, remove useless subpatterns,
577         unshift s.  */
578
579     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s %s substr \"%s%.*s%s\"%s%s",
580                           (s ? "Found" : "Did not find"),
581                           (check == (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) ? "anchored" : "floating"),
582                           PL_colors[0],
583                           (int)(SvCUR(check) - (SvTAIL(check)!=0)),
584                           SvPVX_const(check),
585                           PL_colors[1], (SvTAIL(check) ? "$" : ""),
586                           (s ? " at offset " : "...\n") ) );
587
588     if (!s)
589         goto fail_finish;
590
591     check_at = s;
592
593     /* Finish the diagnostic message */
594     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%ld...\n", (long)(s - i_strpos)) );
595
596     /* Got a candidate.  Check MBOL anchoring, and the *other* substr.
597        Start with the other substr.
598        XXXX no SCREAM optimization yet - and a very coarse implementation
599        XXXX /ttx+/ results in anchored="ttx", floating="x".  floating will
600                 *always* match.  Probably should be marked during compile...
601        Probably it is right to do no SCREAM here...
602      */
603
604     if (do_utf8 ? (prog->float_utf8 && prog->anchored_utf8) : (prog->float_substr && prog->anchored_substr)) {
605         /* Take into account the "other" substring. */
606         /* XXXX May be hopelessly wrong for UTF... */
607         if (!other_last)
608             other_last = strpos;
609         if (check == (do_utf8 ? prog->float_utf8 : prog->float_substr)) {
610           do_other_anchored:
611             {
612                 char * const last = HOP3c(s, -start_shift, strbeg);
613                 char *last1, *last2;
614                 char *s1 = s;
615                 SV* must;
616
617                 t = s - prog->check_offset_max;
618                 if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
619                     && (!do_utf8
620                         || ((t = reghopmaybe3_c(s, -(prog->check_offset_max), strpos))
621                             && t > strpos)))
622                     /* EMPTY */;
623                 else
624                     t = strpos;
625                 t = HOP3c(t, prog->anchored_offset, strend);
626                 if (t < other_last)     /* These positions already checked */
627                     t = other_last;
628                 last2 = last1 = HOP3c(strend, -prog->minlen, strbeg);
629                 if (last < last1)
630                     last1 = last;
631  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
632                 /* On end-of-str: see comment below. */
633                 must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
634                 if (must == &PL_sv_undef) {
635                     s = (char*)NULL;
636                     DEBUG_EXECUTE_r(must = prog->anchored_utf8);        /* for debug */
637                 }
638                 else
639                     s = fbm_instr(
640                         (unsigned char*)t,
641                         HOP3(HOP3(last1, prog->anchored_offset, strend)
642                                 + SvCUR(must), -(SvTAIL(must)!=0), strbeg),
643                         must,
644                         multiline ? FBMrf_MULTILINE : 0
645                     );
646                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
647                         "%s anchored substr \"%s%.*s%s\"%s",
648                         (s ? "Found" : "Contradicts"),
649                         PL_colors[0],
650                           (int)(SvCUR(must)
651                           - (SvTAIL(must)!=0)),
652                           SvPVX_const(must),
653                           PL_colors[1], (SvTAIL(must) ? "$" : "")));
654                 if (!s) {
655                     if (last1 >= last2) {
656                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
657                                                 ", giving up...\n"));
658                         goto fail_finish;
659                     }
660                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
661                         ", trying floating at offset %ld...\n",
662                         (long)(HOP3c(s1, 1, strend) - i_strpos)));
663                     other_last = HOP3c(last1, prog->anchored_offset+1, strend);
664                     s = HOP3c(last, 1, strend);
665                     goto restart;
666                 }
667                 else {
668                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
669                           (long)(s - i_strpos)));
670                     t = HOP3c(s, -prog->anchored_offset, strbeg);
671                     other_last = HOP3c(s, 1, strend);
672                     s = s1;
673                     if (t == strpos)
674                         goto try_at_start;
675                     goto try_at_offset;
676                 }
677             }
678         }
679         else {          /* Take into account the floating substring. */
680             char *last, *last1;
681             char *s1 = s;
682             SV* must;
683
684             t = HOP3c(s, -start_shift, strbeg);
685             last1 = last =
686                 HOP3c(strend, -prog->minlen + prog->float_min_offset, strbeg);
687             if (CHR_DIST((U8*)last, (U8*)t) > prog->float_max_offset)
688                 last = HOP3c(t, prog->float_max_offset, strend);
689             s = HOP3c(t, prog->float_min_offset, strend);
690             if (s < other_last)
691                 s = other_last;
692  /* XXXX It is not documented what units *_offsets are in.  Assume bytes.  */
693             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
694             /* fbm_instr() takes into account exact value of end-of-str
695                if the check is SvTAIL(ed).  Since false positives are OK,
696                and end-of-str is not later than strend we are OK. */
697             if (must == &PL_sv_undef) {
698                 s = (char*)NULL;
699                 DEBUG_EXECUTE_r(must = prog->float_utf8);       /* for debug message */
700             }
701             else
702                 s = fbm_instr((unsigned char*)s,
703                               (unsigned char*)last + SvCUR(must)
704                                   - (SvTAIL(must)!=0),
705                               must, multiline ? FBMrf_MULTILINE : 0);
706             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s floating substr \"%s%.*s%s\"%s",
707                     (s ? "Found" : "Contradicts"),
708                     PL_colors[0],
709                       (int)(SvCUR(must) - (SvTAIL(must)!=0)),
710                       SvPVX_const(must),
711                       PL_colors[1], (SvTAIL(must) ? "$" : "")));
712             if (!s) {
713                 if (last1 == last) {
714                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
715                                             ", giving up...\n"));
716                     goto fail_finish;
717                 }
718                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
719                     ", trying anchored starting at offset %ld...\n",
720                     (long)(s1 + 1 - i_strpos)));
721                 other_last = last;
722                 s = HOP3c(t, 1, strend);
723                 goto restart;
724             }
725             else {
726                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, " at offset %ld...\n",
727                       (long)(s - i_strpos)));
728                 other_last = s; /* Fix this later. --Hugo */
729                 s = s1;
730                 if (t == strpos)
731                     goto try_at_start;
732                 goto try_at_offset;
733             }
734         }
735     }
736
737     t = s - prog->check_offset_max;
738     if (s - strpos > prog->check_offset_max  /* signed-corrected t > strpos */
739         && (!do_utf8
740             || ((t = reghopmaybe3_c(s, -prog->check_offset_max, strpos))
741                  && t > strpos))) {
742         /* Fixed substring is found far enough so that the match
743            cannot start at strpos. */
744       try_at_offset:
745         if (ml_anch && t[-1] != '\n') {
746             /* Eventually fbm_*() should handle this, but often
747                anchored_offset is not 0, so this check will not be wasted. */
748             /* XXXX In the code below we prefer to look for "^" even in
749                presence of anchored substrings.  And we search even
750                beyond the found float position.  These pessimizations
751                are historical artefacts only.  */
752           find_anchor:
753             while (t < strend - prog->minlen) {
754                 if (*t == '\n') {
755                     if (t < check_at - prog->check_offset_min) {
756                         if (do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) {
757                             /* Since we moved from the found position,
758                                we definitely contradict the found anchored
759                                substr.  Due to the above check we do not
760                                contradict "check" substr.
761                                Thus we can arrive here only if check substr
762                                is float.  Redo checking for "other"=="fixed".
763                              */
764                             strpos = t + 1;                     
765                             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld, rescanning for anchored from offset %ld...\n",
766                                 PL_colors[0], PL_colors[1], (long)(strpos - i_strpos), (long)(strpos - i_strpos + prog->anchored_offset)));
767                             goto do_other_anchored;
768                         }
769                         /* We don't contradict the found floating substring. */
770                         /* XXXX Why not check for STCLASS? */
771                         s = t + 1;
772                         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m at offset %ld...\n",
773                             PL_colors[0], PL_colors[1], (long)(s - i_strpos)));
774                         goto set_useful;
775                     }
776                     /* Position contradicts check-string */
777                     /* XXXX probably better to look for check-string
778                        than for "\n", so one should lower the limit for t? */
779                     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Found /%s^%s/m, restarting lookup for check-string at offset %ld...\n",
780                         PL_colors[0], PL_colors[1], (long)(t + 1 - i_strpos)));
781                     other_last = strpos = s = t + 1;
782                     goto restart;
783                 }
784                 t++;
785             }
786             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Did not find /%s^%s/m...\n",
787                         PL_colors[0], PL_colors[1]));
788             goto fail_finish;
789         }
790         else {
791             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Starting position does not contradict /%s^%s/m...\n",
792                         PL_colors[0], PL_colors[1]));
793         }
794         s = t;
795       set_useful:
796         ++BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr);    /* hooray/5 */
797     }
798     else {
799         /* The found string does not prohibit matching at strpos,
800            - no optimization of calling REx engine can be performed,
801            unless it was an MBOL and we are not after MBOL,
802            or a future STCLASS check will fail this. */
803       try_at_start:
804         /* Even in this situation we may use MBOL flag if strpos is offset
805            wrt the start of the string. */
806         if (ml_anch && sv && !SvROK(sv) /* See prev comment on SvROK */
807             && (strpos != strbeg) && strpos[-1] != '\n'
808             /* May be due to an implicit anchor of m{.*foo}  */
809             && !(prog->reganch & ROPT_IMPLICIT))
810         {
811             t = strpos;
812             goto find_anchor;
813         }
814         DEBUG_EXECUTE_r( if (ml_anch)
815             PerlIO_printf(Perl_debug_log, "Position at offset %ld does not contradict /%s^%s/m...\n",
816                         (long)(strpos - i_strpos), PL_colors[0], PL_colors[1]);
817         );
818       success_at_start:
819         if (!(prog->reganch & ROPT_NAUGHTY)     /* XXXX If strpos moved? */
820             && (do_utf8 ? (
821                 prog->check_utf8                /* Could be deleted already */
822                 && --BmUSEFUL(prog->check_utf8) < 0
823                 && (prog->check_utf8 == prog->float_utf8)
824             ) : (
825                 prog->check_substr              /* Could be deleted already */
826                 && --BmUSEFUL(prog->check_substr) < 0
827                 && (prog->check_substr == prog->float_substr)
828             )))
829         {
830             /* If flags & SOMETHING - do not do it many times on the same match */
831             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "... Disabling check substring...\n"));
832             SvREFCNT_dec(do_utf8 ? prog->check_utf8 : prog->check_substr);
833             if (do_utf8 ? prog->check_substr : prog->check_utf8)
834                 SvREFCNT_dec(do_utf8 ? prog->check_substr : prog->check_utf8);
835             prog->check_substr = prog->check_utf8 = NULL;       /* disable */
836             prog->float_substr = prog->float_utf8 = NULL;       /* clear */
837             check = NULL;                       /* abort */
838             s = strpos;
839             /* XXXX This is a remnant of the old implementation.  It
840                     looks wasteful, since now INTUIT can use many
841                     other heuristics. */
842             prog->reganch &= ~RE_USE_INTUIT;
843         }
844         else
845             s = strpos;
846     }
847
848     /* Last resort... */
849     /* XXXX BmUSEFUL already changed, maybe multiple change is meaningful... */
850     if (prog->regstclass) {
851         /* minlen == 0 is possible if regstclass is \b or \B,
852            and the fixed substr is ''$.
853            Since minlen is already taken into account, s+1 is before strend;
854            accidentally, minlen >= 1 guaranties no false positives at s + 1
855            even for \b or \B.  But (minlen? 1 : 0) below assumes that
856            regstclass does not come from lookahead...  */
857         /* If regstclass takes bytelength more than 1: If charlength==1, OK.
858            This leaves EXACTF only, which is dealt with in find_byclass().  */
859         const U8* const str = (U8*)STRING(prog->regstclass);
860         const int cl_l = (PL_regkind[(U8)OP(prog->regstclass)] == EXACT
861                     ? CHR_DIST(str+STR_LEN(prog->regstclass), str)
862                     : 1);
863         const char * const endpos = (prog->anchored_substr || prog->anchored_utf8 || ml_anch)
864                 ? HOP3c(s, (prog->minlen ? cl_l : 0), strend)
865                 : (prog->float_substr || prog->float_utf8
866                    ? HOP3c(HOP3c(check_at, -start_shift, strbeg),
867                            cl_l, strend)
868                    : strend);
869
870         t = s;
871         cache_re(prog);
872         s = find_byclass(prog, prog->regstclass, s, endpos, 1);
873         if (!s) {
874 #ifdef DEBUGGING
875             const char *what = NULL;
876 #endif
877             if (endpos == strend) {
878                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
879                                 "Could not match STCLASS...\n") );
880                 goto fail;
881             }
882             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
883                                    "This position contradicts STCLASS...\n") );
884             if ((prog->reganch & ROPT_ANCH) && !ml_anch)
885                 goto fail;
886             /* Contradict one of substrings */
887             if (prog->anchored_substr || prog->anchored_utf8) {
888                 if ((do_utf8 ? prog->anchored_utf8 : prog->anchored_substr) == check) {
889                     DEBUG_EXECUTE_r( what = "anchored" );
890                   hop_and_restart:
891                     s = HOP3c(t, 1, strend);
892                     if (s + start_shift + end_shift > strend) {
893                         /* XXXX Should be taken into account earlier? */
894                         DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
895                                                "Could not match STCLASS...\n") );
896                         goto fail;
897                     }
898                     if (!check)
899                         goto giveup;
900                     DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
901                                 "Looking for %s substr starting at offset %ld...\n",
902                                  what, (long)(s + start_shift - i_strpos)) );
903                     goto restart;
904                 }
905                 /* Have both, check_string is floating */
906                 if (t + start_shift >= check_at) /* Contradicts floating=check */
907                     goto retry_floating_check;
908                 /* Recheck anchored substring, but not floating... */
909                 s = check_at;
910                 if (!check)
911                     goto giveup;
912                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
913                           "Looking for anchored substr starting at offset %ld...\n",
914                           (long)(other_last - i_strpos)) );
915                 goto do_other_anchored;
916             }
917             /* Another way we could have checked stclass at the
918                current position only: */
919             if (ml_anch) {
920                 s = t = t + 1;
921                 if (!check)
922                     goto giveup;
923                 DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
924                           "Looking for /%s^%s/m starting at offset %ld...\n",
925                           PL_colors[0], PL_colors[1], (long)(t - i_strpos)) );
926                 goto try_at_offset;
927             }
928             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))     /* Could have been deleted */
929                 goto fail;
930             /* Check is floating subtring. */
931           retry_floating_check:
932             t = check_at - start_shift;
933             DEBUG_EXECUTE_r( what = "floating" );
934             goto hop_and_restart;
935         }
936         if (t != s) {
937             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
938                         "By STCLASS: moving %ld --> %ld\n",
939                                   (long)(t - i_strpos), (long)(s - i_strpos))
940                    );
941         }
942         else {
943             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
944                                   "Does not contradict STCLASS...\n"); 
945                    );
946         }
947     }
948   giveup:
949     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%s%s:%s match at offset %ld\n",
950                           PL_colors[4], (check ? "Guessed" : "Giving up"),
951                           PL_colors[5], (long)(s - i_strpos)) );
952     return s;
953
954   fail_finish:                          /* Substring not found */
955     if (prog->check_substr || prog->check_utf8)         /* could be removed already */
956         BmUSEFUL(do_utf8 ? prog->check_utf8 : prog->check_substr) += 5; /* hooray */
957   fail:
958     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch rejected by optimizer%s\n",
959                           PL_colors[4], PL_colors[5]));
960     return NULL;
961 }
962
963 /* We know what class REx starts with.  Try to find this position... */
964 STATIC char *
965 S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, const char *strend, I32 norun)
966 {
967         dVAR;
968         const I32 doevery = (prog->reganch & ROPT_SKIP) == 0;
969         char *m;
970         STRLEN ln;
971         STRLEN lnc;
972         register STRLEN uskip;
973         unsigned int c1;
974         unsigned int c2;
975         char *e;
976         register I32 tmp = 1;   /* Scratch variable? */
977         register const bool do_utf8 = PL_reg_match_utf8;
978
979         /* We know what class it must start with. */
980         switch (OP(c)) {
981         case ANYOF:
982             if (do_utf8) {
983                  while (s + (uskip = UTF8SKIP(s)) <= strend) {
984                       if ((ANYOF_FLAGS(c) & ANYOF_UNICODE) ||
985                           !UTF8_IS_INVARIANT((U8)s[0]) ?
986                           reginclass(c, (U8*)s, 0, do_utf8) :
987                           REGINCLASS(c, (U8*)s)) {
988                            if (tmp && (norun || regtry(prog, s)))
989                                 goto got_it;
990                            else
991                                 tmp = doevery;
992                       }
993                       else 
994                            tmp = 1;
995                       s += uskip;
996                  }
997             }
998             else {
999                  while (s < strend) {
1000                       STRLEN skip = 1;
1001
1002                       if (REGINCLASS(c, (U8*)s) ||
1003                           (ANYOF_FOLD_SHARP_S(c, s, strend) &&
1004                            /* The assignment of 2 is intentional:
1005                             * for the folded sharp s, the skip is 2. */
1006                            (skip = SHARP_S_SKIP))) {
1007                            if (tmp && (norun || regtry(prog, s)))
1008                                 goto got_it;
1009                            else
1010                                 tmp = doevery;
1011                       }
1012                       else 
1013                            tmp = 1;
1014                       s += skip;
1015                  }
1016             }
1017             break;
1018         case CANY:
1019             while (s < strend) {
1020                 if (tmp && (norun || regtry(prog, s)))
1021                     goto got_it;
1022                 else
1023                     tmp = doevery;
1024                 s++;
1025             }
1026             break;
1027         case EXACTF:
1028             m   = STRING(c);
1029             ln  = STR_LEN(c);   /* length to match in octets/bytes */
1030             lnc = (I32) ln;     /* length to match in characters */
1031             if (UTF) {
1032                 STRLEN ulen1, ulen2;
1033                 U8 *sm = (U8 *) m;
1034                 U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
1035                 U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
1036                 const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
1037
1038                 to_utf8_lower((U8*)m, tmpbuf1, &ulen1);
1039                 to_utf8_upper((U8*)m, tmpbuf2, &ulen2);
1040
1041                 c1 = utf8n_to_uvchr(tmpbuf1, UTF8_MAXBYTES_CASE, 
1042                                     0, uniflags);
1043                 c2 = utf8n_to_uvchr(tmpbuf2, UTF8_MAXBYTES_CASE,
1044                                     0, uniflags);
1045                 lnc = 0;
1046                 while (sm < ((U8 *) m + ln)) {
1047                     lnc++;
1048                     sm += UTF8SKIP(sm);
1049                 }
1050             }
1051             else {
1052                 c1 = *(U8*)m;
1053                 c2 = PL_fold[c1];
1054             }
1055             goto do_exactf;
1056         case EXACTFL:
1057             m   = STRING(c);
1058             ln  = STR_LEN(c);
1059             lnc = (I32) ln;
1060             c1 = *(U8*)m;
1061             c2 = PL_fold_locale[c1];
1062           do_exactf:
1063             e = HOP3c(strend, -((I32)lnc), s);
1064
1065             if (norun && e < s)
1066                 e = s;                  /* Due to minlen logic of intuit() */
1067
1068             /* The idea in the EXACTF* cases is to first find the
1069              * first character of the EXACTF* node and then, if
1070              * necessary, case-insensitively compare the full
1071              * text of the node.  The c1 and c2 are the first
1072              * characters (though in Unicode it gets a bit
1073              * more complicated because there are more cases
1074              * than just upper and lower: one needs to use
1075              * the so-called folding case for case-insensitive
1076              * matching (called "loose matching" in Unicode).
1077              * ibcmp_utf8() will do just that. */
1078
1079             if (do_utf8) {
1080                 UV c, f;
1081                 U8 tmpbuf [UTF8_MAXBYTES+1];
1082                 STRLEN len, foldlen;
1083                 const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
1084                 if (c1 == c2) {
1085                     /* Upper and lower of 1st char are equal -
1086                      * probably not a "letter". */
1087                     while (s <= e) {
1088                         c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1089                                            uniflags);
1090                         if ( c == c1
1091                              && (ln == len ||
1092                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1093                                             m, (char **)0, ln, (bool)UTF))
1094                              && (norun || regtry(prog, s)) )
1095                             goto got_it;
1096                         else {
1097                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1098                              uvchr_to_utf8(tmpbuf, c);
1099                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1100                              if ( f != c
1101                                   && (f == c1 || f == c2)
1102                                   && (ln == foldlen ||
1103                                       !ibcmp_utf8((char *) foldbuf,
1104                                                   (char **)0, foldlen, do_utf8,
1105                                                   m,
1106                                                   (char **)0, ln, (bool)UTF))
1107                                   && (norun || regtry(prog, s)) )
1108                                   goto got_it;
1109                         }
1110                         s += len;
1111                     }
1112                 }
1113                 else {
1114                     while (s <= e) {
1115                       c = utf8n_to_uvchr((U8*)s, UTF8_MAXBYTES, &len,
1116                                            uniflags);
1117
1118                         /* Handle some of the three Greek sigmas cases.
1119                          * Note that not all the possible combinations
1120                          * are handled here: some of them are handled
1121                          * by the standard folding rules, and some of
1122                          * them (the character class or ANYOF cases)
1123                          * are handled during compiletime in
1124                          * regexec.c:S_regclass(). */
1125                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1126                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1127                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1128
1129                         if ( (c == c1 || c == c2)
1130                              && (ln == len ||
1131                                  ibcmp_utf8(s, (char **)0, 0,  do_utf8,
1132                                             m, (char **)0, ln, (bool)UTF))
1133                              && (norun || regtry(prog, s)) )
1134                             goto got_it;
1135                         else {
1136                              U8 foldbuf[UTF8_MAXBYTES_CASE+1];
1137                              uvchr_to_utf8(tmpbuf, c);
1138                              f = to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1139                              if ( f != c
1140                                   && (f == c1 || f == c2)
1141                                   && (ln == foldlen ||
1142                                       !ibcmp_utf8((char *) foldbuf,
1143                                                   (char **)0, foldlen, do_utf8,
1144                                                   m,
1145                                                   (char **)0, ln, (bool)UTF))
1146                                   && (norun || regtry(prog, s)) )
1147                                   goto got_it;
1148                         }
1149                         s += len;
1150                     }
1151                 }
1152             }
1153             else {
1154                 if (c1 == c2)
1155                     while (s <= e) {
1156                         if ( *(U8*)s == c1
1157                              && (ln == 1 || !(OP(c) == EXACTF
1158                                               ? ibcmp(s, m, ln)
1159                                               : ibcmp_locale(s, m, ln)))
1160                              && (norun || regtry(prog, s)) )
1161                             goto got_it;
1162                         s++;
1163                     }
1164                 else
1165                     while (s <= e) {
1166                         if ( (*(U8*)s == c1 || *(U8*)s == c2)
1167                              && (ln == 1 || !(OP(c) == EXACTF
1168                                               ? ibcmp(s, m, ln)
1169                                               : ibcmp_locale(s, m, ln)))
1170                              && (norun || regtry(prog, s)) )
1171                             goto got_it;
1172                         s++;
1173                     }
1174             }
1175             break;
1176         case BOUNDL:
1177             PL_reg_flags |= RF_tainted;
1178             /* FALL THROUGH */
1179         case BOUND:
1180             if (do_utf8) {
1181                 if (s == PL_bostr)
1182                     tmp = '\n';
1183                 else {
1184                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1185                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
1186                 }
1187                 tmp = ((OP(c) == BOUND ?
1188                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1189                 LOAD_UTF8_CHARCLASS_ALNUM();
1190                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1191                     if (tmp == !(OP(c) == BOUND ?
1192                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1193                                  isALNUM_LC_utf8((U8*)s)))
1194                     {
1195                         tmp = !tmp;
1196                         if ((norun || regtry(prog, s)))
1197                             goto got_it;
1198                     }
1199                     s += uskip;
1200                 }
1201             }
1202             else {
1203                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1204                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1205                 while (s < strend) {
1206                     if (tmp ==
1207                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1208                         tmp = !tmp;
1209                         if ((norun || regtry(prog, s)))
1210                             goto got_it;
1211                     }
1212                     s++;
1213                 }
1214             }
1215             if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
1216                 goto got_it;
1217             break;
1218         case NBOUNDL:
1219             PL_reg_flags |= RF_tainted;
1220             /* FALL THROUGH */
1221         case NBOUND:
1222             if (do_utf8) {
1223                 if (s == PL_bostr)
1224                     tmp = '\n';
1225                 else {
1226                     U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
1227                     tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
1228                 }
1229                 tmp = ((OP(c) == NBOUND ?
1230                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1231                 LOAD_UTF8_CHARCLASS_ALNUM();
1232                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1233                     if (tmp == !(OP(c) == NBOUND ?
1234                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1235                                  isALNUM_LC_utf8((U8*)s)))
1236                         tmp = !tmp;
1237                     else if ((norun || regtry(prog, s)))
1238                         goto got_it;
1239                     s += uskip;
1240                 }
1241             }
1242             else {
1243                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1244                 tmp = ((OP(c) == NBOUND ?
1245                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1246                 while (s < strend) {
1247                     if (tmp ==
1248                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1249                         tmp = !tmp;
1250                     else if ((norun || regtry(prog, s)))
1251                         goto got_it;
1252                     s++;
1253                 }
1254             }
1255             if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
1256                 goto got_it;
1257             break;
1258         case ALNUM:
1259             if (do_utf8) {
1260                 LOAD_UTF8_CHARCLASS_ALNUM();
1261                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1262                     if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1263                         if (tmp && (norun || regtry(prog, s)))
1264                             goto got_it;
1265                         else
1266                             tmp = doevery;
1267                     }
1268                     else
1269                         tmp = 1;
1270                     s += uskip;
1271                 }
1272             }
1273             else {
1274                 while (s < strend) {
1275                     if (isALNUM(*s)) {
1276                         if (tmp && (norun || regtry(prog, s)))
1277                             goto got_it;
1278                         else
1279                             tmp = doevery;
1280                     }
1281                     else
1282                         tmp = 1;
1283                     s++;
1284                 }
1285             }
1286             break;
1287         case ALNUML:
1288             PL_reg_flags |= RF_tainted;
1289             if (do_utf8) {
1290                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1291                     if (isALNUM_LC_utf8((U8*)s)) {
1292                         if (tmp && (norun || regtry(prog, s)))
1293                             goto got_it;
1294                         else
1295                             tmp = doevery;
1296                     }
1297                     else
1298                         tmp = 1;
1299                     s += uskip;
1300                 }
1301             }
1302             else {
1303                 while (s < strend) {
1304                     if (isALNUM_LC(*s)) {
1305                         if (tmp && (norun || regtry(prog, s)))
1306                             goto got_it;
1307                         else
1308                             tmp = doevery;
1309                     }
1310                     else
1311                         tmp = 1;
1312                     s++;
1313                 }
1314             }
1315             break;
1316         case NALNUM:
1317             if (do_utf8) {
1318                 LOAD_UTF8_CHARCLASS_ALNUM();
1319                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1320                     if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1321                         if (tmp && (norun || regtry(prog, s)))
1322                             goto got_it;
1323                         else
1324                             tmp = doevery;
1325                     }
1326                     else
1327                         tmp = 1;
1328                     s += uskip;
1329                 }
1330             }
1331             else {
1332                 while (s < strend) {
1333                     if (!isALNUM(*s)) {
1334                         if (tmp && (norun || regtry(prog, s)))
1335                             goto got_it;
1336                         else
1337                             tmp = doevery;
1338                     }
1339                     else
1340                         tmp = 1;
1341                     s++;
1342                 }
1343             }
1344             break;
1345         case NALNUML:
1346             PL_reg_flags |= RF_tainted;
1347             if (do_utf8) {
1348                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1349                     if (!isALNUM_LC_utf8((U8*)s)) {
1350                         if (tmp && (norun || regtry(prog, s)))
1351                             goto got_it;
1352                         else
1353                             tmp = doevery;
1354                     }
1355                     else
1356                         tmp = 1;
1357                     s += uskip;
1358                 }
1359             }
1360             else {
1361                 while (s < strend) {
1362                     if (!isALNUM_LC(*s)) {
1363                         if (tmp && (norun || regtry(prog, s)))
1364                             goto got_it;
1365                         else
1366                             tmp = doevery;
1367                     }
1368                     else
1369                         tmp = 1;
1370                     s++;
1371                 }
1372             }
1373             break;
1374         case SPACE:
1375             if (do_utf8) {
1376                 LOAD_UTF8_CHARCLASS_SPACE();
1377                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1378                     if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
1379                         if (tmp && (norun || regtry(prog, s)))
1380                             goto got_it;
1381                         else
1382                             tmp = doevery;
1383                     }
1384                     else
1385                         tmp = 1;
1386                     s += uskip;
1387                 }
1388             }
1389             else {
1390                 while (s < strend) {
1391                     if (isSPACE(*s)) {
1392                         if (tmp && (norun || regtry(prog, s)))
1393                             goto got_it;
1394                         else
1395                             tmp = doevery;
1396                     }
1397                     else
1398                         tmp = 1;
1399                     s++;
1400                 }
1401             }
1402             break;
1403         case SPACEL:
1404             PL_reg_flags |= RF_tainted;
1405             if (do_utf8) {
1406                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1407                     if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1408                         if (tmp && (norun || regtry(prog, s)))
1409                             goto got_it;
1410                         else
1411                             tmp = doevery;
1412                     }
1413                     else
1414                         tmp = 1;
1415                     s += uskip;
1416                 }
1417             }
1418             else {
1419                 while (s < strend) {
1420                     if (isSPACE_LC(*s)) {
1421                         if (tmp && (norun || regtry(prog, s)))
1422                             goto got_it;
1423                         else
1424                             tmp = doevery;
1425                     }
1426                     else
1427                         tmp = 1;
1428                     s++;
1429                 }
1430             }
1431             break;
1432         case NSPACE:
1433             if (do_utf8) {
1434                 LOAD_UTF8_CHARCLASS_SPACE();
1435                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1436                     if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
1437                         if (tmp && (norun || regtry(prog, s)))
1438                             goto got_it;
1439                         else
1440                             tmp = doevery;
1441                     }
1442                     else
1443                         tmp = 1;
1444                     s += uskip;
1445                 }
1446             }
1447             else {
1448                 while (s < strend) {
1449                     if (!isSPACE(*s)) {
1450                         if (tmp && (norun || regtry(prog, s)))
1451                             goto got_it;
1452                         else
1453                             tmp = doevery;
1454                     }
1455                     else
1456                         tmp = 1;
1457                     s++;
1458                 }
1459             }
1460             break;
1461         case NSPACEL:
1462             PL_reg_flags |= RF_tainted;
1463             if (do_utf8) {
1464                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1465                     if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1466                         if (tmp && (norun || regtry(prog, s)))
1467                             goto got_it;
1468                         else
1469                             tmp = doevery;
1470                     }
1471                     else
1472                         tmp = 1;
1473                     s += uskip;
1474                 }
1475             }
1476             else {
1477                 while (s < strend) {
1478                     if (!isSPACE_LC(*s)) {
1479                         if (tmp && (norun || regtry(prog, s)))
1480                             goto got_it;
1481                         else
1482                             tmp = doevery;
1483                     }
1484                     else
1485                         tmp = 1;
1486                     s++;
1487                 }
1488             }
1489             break;
1490         case DIGIT:
1491             if (do_utf8) {
1492                 LOAD_UTF8_CHARCLASS_DIGIT();
1493                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1494                     if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1495                         if (tmp && (norun || regtry(prog, s)))
1496                             goto got_it;
1497                         else
1498                             tmp = doevery;
1499                     }
1500                     else
1501                         tmp = 1;
1502                     s += uskip;
1503                 }
1504             }
1505             else {
1506                 while (s < strend) {
1507                     if (isDIGIT(*s)) {
1508                         if (tmp && (norun || regtry(prog, s)))
1509                             goto got_it;
1510                         else
1511                             tmp = doevery;
1512                     }
1513                     else
1514                         tmp = 1;
1515                     s++;
1516                 }
1517             }
1518             break;
1519         case DIGITL:
1520             PL_reg_flags |= RF_tainted;
1521             if (do_utf8) {
1522                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1523                     if (isDIGIT_LC_utf8((U8*)s)) {
1524                         if (tmp && (norun || regtry(prog, s)))
1525                             goto got_it;
1526                         else
1527                             tmp = doevery;
1528                     }
1529                     else
1530                         tmp = 1;
1531                     s += uskip;
1532                 }
1533             }
1534             else {
1535                 while (s < strend) {
1536                     if (isDIGIT_LC(*s)) {
1537                         if (tmp && (norun || regtry(prog, s)))
1538                             goto got_it;
1539                         else
1540                             tmp = doevery;
1541                     }
1542                     else
1543                         tmp = 1;
1544                     s++;
1545                 }
1546             }
1547             break;
1548         case NDIGIT:
1549             if (do_utf8) {
1550                 LOAD_UTF8_CHARCLASS_DIGIT();
1551                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1552                     if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1553                         if (tmp && (norun || regtry(prog, s)))
1554                             goto got_it;
1555                         else
1556                             tmp = doevery;
1557                     }
1558                     else
1559                         tmp = 1;
1560                     s += uskip;
1561                 }
1562             }
1563             else {
1564                 while (s < strend) {
1565                     if (!isDIGIT(*s)) {
1566                         if (tmp && (norun || regtry(prog, s)))
1567                             goto got_it;
1568                         else
1569                             tmp = doevery;
1570                     }
1571                     else
1572                         tmp = 1;
1573                     s++;
1574                 }
1575             }
1576             break;
1577         case NDIGITL:
1578             PL_reg_flags |= RF_tainted;
1579             if (do_utf8) {
1580                 while (s + (uskip = UTF8SKIP(s)) <= strend) {
1581                     if (!isDIGIT_LC_utf8((U8*)s)) {
1582                         if (tmp && (norun || regtry(prog, s)))
1583                             goto got_it;
1584                         else
1585                             tmp = doevery;
1586                     }
1587                     else
1588                         tmp = 1;
1589                     s += uskip;
1590                 }
1591             }
1592             else {
1593                 while (s < strend) {
1594                     if (!isDIGIT_LC(*s)) {
1595                         if (tmp && (norun || regtry(prog, s)))
1596                             goto got_it;
1597                         else
1598                             tmp = doevery;
1599                     }
1600                     else
1601                         tmp = 1;
1602                     s++;
1603                 }
1604             }
1605             break;
1606         default:
1607             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1608             break;
1609         }
1610         return 0;
1611       got_it:
1612         return s;
1613 }
1614
1615 /*
1616  - regexec_flags - match a regexp against a string
1617  */
1618 I32
1619 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1620               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1621 /* strend: pointer to null at end of string */
1622 /* strbeg: real beginning of string */
1623 /* minend: end of match must be >=minend after stringarg. */
1624 /* data: May be used for some additional optimizations. */
1625 /* nosave: For optimizations. */
1626 {
1627     dVAR;
1628     register char *s;
1629     register regnode *c;
1630     register char *startpos = stringarg;
1631     I32 minlen;         /* must match at least this many chars */
1632     I32 dontbother = 0; /* how many characters not to try at end */
1633     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1634     I32 scream_pos = -1;                /* Internal iterator of scream. */
1635     char *scream_olds = NULL;
1636     SV* oreplsv = GvSV(PL_replgv);
1637     const bool do_utf8 = DO_UTF8(sv);
1638     const I32 multiline = prog->reganch & PMf_MULTILINE;
1639 #ifdef DEBUGGING
1640     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
1641     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
1642 #endif
1643
1644     GET_RE_DEBUG_FLAGS_DECL;
1645
1646     PERL_UNUSED_ARG(data);
1647     RX_MATCH_UTF8_set(prog,do_utf8);
1648
1649     PL_regcc = 0;
1650
1651     cache_re(prog);
1652 #ifdef DEBUGGING
1653     PL_regnarrate = DEBUG_r_TEST;
1654 #endif
1655
1656     /* Be paranoid... */
1657     if (prog == NULL || startpos == NULL) {
1658         Perl_croak(aTHX_ "NULL regexp parameter");
1659         return 0;
1660     }
1661
1662     minlen = prog->minlen;
1663     if (strend - startpos < minlen) {
1664         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
1665                               "String too short [regexec_flags]...\n"));
1666         goto phooey;
1667     }
1668
1669     /* Check validity of program. */
1670     if (UCHARAT(prog->program) != REG_MAGIC) {
1671         Perl_croak(aTHX_ "corrupted regexp program");
1672     }
1673
1674     PL_reg_flags = 0;
1675     PL_reg_eval_set = 0;
1676     PL_reg_maxiter = 0;
1677
1678     if (prog->reganch & ROPT_UTF8)
1679         PL_reg_flags |= RF_utf8;
1680
1681     /* Mark beginning of line for ^ and lookbehind. */
1682     PL_regbol = startpos;
1683     PL_bostr  = strbeg;
1684     PL_reg_sv = sv;
1685
1686     /* Mark end of line for $ (and such) */
1687     PL_regeol = strend;
1688
1689     /* see how far we have to get to not match where we matched before */
1690     PL_regtill = startpos+minend;
1691
1692     /* We start without call_cc context.  */
1693     PL_reg_call_cc = 0;
1694
1695     /* If there is a "must appear" string, look for it. */
1696     s = startpos;
1697
1698     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1699         MAGIC *mg;
1700
1701         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1702             PL_reg_ganch = startpos;
1703         else if (sv && SvTYPE(sv) >= SVt_PVMG
1704                   && SvMAGIC(sv)
1705                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1706                   && mg->mg_len >= 0) {
1707             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1708             if (prog->reganch & ROPT_ANCH_GPOS) {
1709                 if (s > PL_reg_ganch)
1710                     goto phooey;
1711                 s = PL_reg_ganch;
1712             }
1713         }
1714         else                            /* pos() not defined */
1715             PL_reg_ganch = strbeg;
1716     }
1717
1718     if (!(flags & REXEC_CHECKED) && (prog->check_substr != NULL || prog->check_utf8 != NULL)) {
1719         re_scream_pos_data d;
1720
1721         d.scream_olds = &scream_olds;
1722         d.scream_pos = &scream_pos;
1723         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1724         if (!s) {
1725             DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1726             goto phooey;        /* not present */
1727         }
1728     }
1729
1730     DEBUG_EXECUTE_r({
1731         const char * const s0   = UTF
1732             ? pv_uni_display(dsv0, (U8*)prog->precomp, prog->prelen, 60,
1733                           UNI_DISPLAY_REGEX)
1734             : prog->precomp;
1735         const int len0 = UTF ? SvCUR(dsv0) : prog->prelen;
1736         const char * const s1 = do_utf8 ? sv_uni_display(dsv1, sv, 60,
1737                                                UNI_DISPLAY_REGEX) : startpos;
1738         const int len1 = do_utf8 ? SvCUR(dsv1) : strend - startpos;
1739          if (!PL_colorset)
1740              reginitcolors();
1741          PerlIO_printf(Perl_debug_log,
1742                        "%sMatching REx%s \"%s%*.*s%s%s\" against \"%s%.*s%s%s\"\n",
1743                        PL_colors[4], PL_colors[5], PL_colors[0],
1744                        len0, len0, s0,
1745                        PL_colors[1],
1746                        len0 > 60 ? "..." : "",
1747                        PL_colors[0],
1748                        (int)(len1 > 60 ? 60 : len1),
1749                        s1, PL_colors[1],
1750                        (len1 > 60 ? "..." : "")
1751               );
1752     });
1753
1754     /* Simplest case:  anchored match need be tried only once. */
1755     /*  [unless only anchor is BOL and multiline is set] */
1756     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1757         if (s == startpos && regtry(prog, startpos))
1758             goto got_it;
1759         else if (multiline || (prog->reganch & ROPT_IMPLICIT)
1760                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1761         {
1762             char *end;
1763
1764             if (minlen)
1765                 dontbother = minlen - 1;
1766             end = HOP3c(strend, -dontbother, strbeg) - 1;
1767             /* for multiline we only have to try after newlines */
1768             if (prog->check_substr || prog->check_utf8) {
1769                 if (s == startpos)
1770                     goto after_try;
1771                 while (1) {
1772                     if (regtry(prog, s))
1773                         goto got_it;
1774                   after_try:
1775                     if (s >= end)
1776                         goto phooey;
1777                     if (prog->reganch & RE_USE_INTUIT) {
1778                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1779                         if (!s)
1780                             goto phooey;
1781                     }
1782                     else
1783                         s++;
1784                 }               
1785             } else {
1786                 if (s > startpos)
1787                     s--;
1788                 while (s < end) {
1789                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1790                         if (regtry(prog, s))
1791                             goto got_it;
1792                     }
1793                 }               
1794             }
1795         }
1796         goto phooey;
1797     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1798         if (regtry(prog, PL_reg_ganch))
1799             goto got_it;
1800         goto phooey;
1801     }
1802
1803     /* Messy cases:  unanchored match. */
1804     if ((prog->anchored_substr || prog->anchored_utf8) && prog->reganch & ROPT_SKIP) {
1805         /* we have /x+whatever/ */
1806         /* it must be a one character string (XXXX Except UTF?) */
1807         char ch;
1808 #ifdef DEBUGGING
1809         int did_match = 0;
1810 #endif
1811         if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1812             do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1813         ch = SvPVX_const(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr)[0];
1814
1815         if (do_utf8) {
1816             while (s < strend) {
1817                 if (*s == ch) {
1818                     DEBUG_EXECUTE_r( did_match = 1 );
1819                     if (regtry(prog, s)) goto got_it;
1820                     s += UTF8SKIP(s);
1821                     while (s < strend && *s == ch)
1822                         s += UTF8SKIP(s);
1823                 }
1824                 s += UTF8SKIP(s);
1825             }
1826         }
1827         else {
1828             while (s < strend) {
1829                 if (*s == ch) {
1830                     DEBUG_EXECUTE_r( did_match = 1 );
1831                     if (regtry(prog, s)) goto got_it;
1832                     s++;
1833                     while (s < strend && *s == ch)
1834                         s++;
1835                 }
1836                 s++;
1837             }
1838         }
1839         DEBUG_EXECUTE_r(if (!did_match)
1840                 PerlIO_printf(Perl_debug_log,
1841                                   "Did not find anchored character...\n")
1842                );
1843     }
1844     else if (prog->anchored_substr != NULL
1845               || prog->anchored_utf8 != NULL
1846               || ((prog->float_substr != NULL || prog->float_utf8 != NULL)
1847                   && prog->float_max_offset < strend - s)) {
1848         SV *must;
1849         I32 back_max;
1850         I32 back_min;
1851         char *last;
1852         char *last1;            /* Last position checked before */
1853 #ifdef DEBUGGING
1854         int did_match = 0;
1855 #endif
1856         if (prog->anchored_substr || prog->anchored_utf8) {
1857             if (!(do_utf8 ? prog->anchored_utf8 : prog->anchored_substr))
1858                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1859             must = do_utf8 ? prog->anchored_utf8 : prog->anchored_substr;
1860             back_max = back_min = prog->anchored_offset;
1861         } else {
1862             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1863                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1864             must = do_utf8 ? prog->float_utf8 : prog->float_substr;
1865             back_max = prog->float_max_offset;
1866             back_min = prog->float_min_offset;
1867         }
1868         if (must == &PL_sv_undef)
1869             /* could not downgrade utf8 check substring, so must fail */
1870             goto phooey;
1871
1872         last = HOP3c(strend,    /* Cannot start after this */
1873                           -(I32)(CHR_SVLEN(must)
1874                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1875
1876         if (s > PL_bostr)
1877             last1 = HOPc(s, -1);
1878         else
1879             last1 = s - 1;      /* bogus */
1880
1881         /* XXXX check_substr already used to find "s", can optimize if
1882            check_substr==must. */
1883         scream_pos = -1;
1884         dontbother = end_shift;
1885         strend = HOPc(strend, -dontbother);
1886         while ( (s <= last) &&
1887                 ((flags & REXEC_SCREAM)
1888                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1889                                     end_shift, &scream_pos, 0))
1890                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1891                                   (unsigned char*)strend, must,
1892                                   multiline ? FBMrf_MULTILINE : 0))) ) {
1893             /* we may be pointing at the wrong string */
1894             if ((flags & REXEC_SCREAM) && RX_MATCH_COPIED(prog))
1895                 s = strbeg + (s - SvPVX_const(sv));
1896             DEBUG_EXECUTE_r( did_match = 1 );
1897             if (HOPc(s, -back_max) > last1) {
1898                 last1 = HOPc(s, -back_min);
1899                 s = HOPc(s, -back_max);
1900             }
1901             else {
1902                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1903
1904                 last1 = HOPc(s, -back_min);
1905                 s = t;          
1906             }
1907             if (do_utf8) {
1908                 while (s <= last1) {
1909                     if (regtry(prog, s))
1910                         goto got_it;
1911                     s += UTF8SKIP(s);
1912                 }
1913             }
1914             else {
1915                 while (s <= last1) {
1916                     if (regtry(prog, s))
1917                         goto got_it;
1918                     s++;
1919                 }
1920             }
1921         }
1922         DEBUG_EXECUTE_r(if (!did_match)
1923                     PerlIO_printf(Perl_debug_log, 
1924                                   "Did not find %s substr \"%s%.*s%s\"%s...\n",
1925                               ((must == prog->anchored_substr || must == prog->anchored_utf8)
1926                                ? "anchored" : "floating"),
1927                               PL_colors[0],
1928                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1929                               SvPVX_const(must),
1930                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1931                );
1932         goto phooey;
1933     }
1934     else if ((c = prog->regstclass)) {
1935         if (minlen) {
1936             I32 op = (U8)OP(prog->regstclass);
1937             /* don't bother with what can't match */
1938             if (PL_regkind[op] != EXACT && op != CANY)
1939                 strend = HOPc(strend, -(minlen - 1));
1940         }
1941         DEBUG_EXECUTE_r({
1942             SV *prop = sv_newmortal();
1943             const char *s0;
1944             const char *s1;
1945             int len0;
1946             int len1;
1947
1948             regprop(prop, c);
1949             s0 = UTF ?
1950               pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
1951                              UNI_DISPLAY_REGEX) :
1952               SvPVX_const(prop);
1953             len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
1954             s1 = UTF ?
1955               sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
1956             len1 = UTF ? SvCUR(dsv1) : strend - s;
1957             PerlIO_printf(Perl_debug_log,
1958                           "Matching stclass \"%*.*s\" against \"%*.*s\"\n",
1959                           len0, len0, s0,
1960                           len1, len1, s1);
1961         });
1962         if (find_byclass(prog, c, s, strend, 0))
1963             goto got_it;
1964         DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1965     }
1966     else {
1967         dontbother = 0;
1968         if (prog->float_substr != NULL || prog->float_utf8 != NULL) {
1969             /* Trim the end. */
1970             char *last;
1971             SV* float_real;
1972
1973             if (!(do_utf8 ? prog->float_utf8 : prog->float_substr))
1974                 do_utf8 ? to_utf8_substr(prog) : to_byte_substr(prog);
1975             float_real = do_utf8 ? prog->float_utf8 : prog->float_substr;
1976
1977             if (flags & REXEC_SCREAM) {
1978                 last = screaminstr(sv, float_real, s - strbeg,
1979                                    end_shift, &scream_pos, 1); /* last one */
1980                 if (!last)
1981                     last = scream_olds; /* Only one occurrence. */
1982                 /* we may be pointing at the wrong string */
1983                 else if (RX_MATCH_COPIED(prog))
1984                     s = strbeg + (s - SvPVX_const(sv));
1985             }
1986             else {
1987                 STRLEN len;
1988                 const char * const little = SvPV_const(float_real, len);
1989
1990                 if (SvTAIL(float_real)) {
1991                     if (memEQ(strend - len + 1, little, len - 1))
1992                         last = strend - len + 1;
1993                     else if (!multiline)
1994                         last = memEQ(strend - len, little, len)
1995                             ? strend - len : NULL;
1996                     else
1997                         goto find_last;
1998                 } else {
1999                   find_last:
2000                     if (len)
2001                         last = rninstr(s, strend, little, little + len);
2002                     else
2003                         last = strend;  /* matching "$" */
2004                 }
2005             }
2006             if (last == NULL) {
2007                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
2008                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
2009                                       PL_colors[4], PL_colors[5]));
2010                 goto phooey; /* Should not happen! */
2011             }
2012             dontbother = strend - last + prog->float_min_offset;
2013         }
2014         if (minlen && (dontbother < minlen))
2015             dontbother = minlen - 1;
2016         strend -= dontbother;              /* this one's always in bytes! */
2017         /* We don't know much -- general case. */
2018         if (do_utf8) {
2019             for (;;) {
2020                 if (regtry(prog, s))
2021                     goto got_it;
2022                 if (s >= strend)
2023                     break;
2024                 s += UTF8SKIP(s);
2025             };
2026         }
2027         else {
2028             do {
2029                 if (regtry(prog, s))
2030                     goto got_it;
2031             } while (s++ < strend);
2032         }
2033     }
2034
2035     /* Failure. */
2036     goto phooey;
2037
2038 got_it:
2039     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
2040
2041     if (PL_reg_eval_set) {
2042         /* Preserve the current value of $^R */
2043         if (oreplsv != GvSV(PL_replgv))
2044             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
2045                                                   restored, the value remains
2046                                                   the same. */
2047         restore_pos(aTHX_ 0);
2048     }
2049
2050     /* make sure $`, $&, $', and $digit will work later */
2051     if ( !(flags & REXEC_NOT_FIRST) ) {
2052         RX_MATCH_COPY_FREE(prog);
2053         if (flags & REXEC_COPY_STR) {
2054             I32 i = PL_regeol - startpos + (stringarg - strbeg);
2055 #ifdef PERL_OLD_COPY_ON_WRITE
2056             if ((SvIsCOW(sv)
2057                  || (SvFLAGS(sv) & CAN_COW_MASK) == CAN_COW_FLAGS)) {
2058                 if (DEBUG_C_TEST) {
2059                     PerlIO_printf(Perl_debug_log,
2060                                   "Copy on write: regexp capture, type %d\n",
2061                                   (int) SvTYPE(sv));
2062                 }
2063                 prog->saved_copy = sv_setsv_cow(prog->saved_copy, sv);
2064                 prog->subbeg = (char *)SvPVX_const(prog->saved_copy);
2065                 assert (SvPOKp(prog->saved_copy));
2066             } else
2067 #endif
2068             {
2069                 RX_MATCH_COPIED_on(prog);
2070                 s = savepvn(strbeg, i);
2071                 prog->subbeg = s;
2072             }
2073             prog->sublen = i;
2074         }
2075         else {
2076             prog->subbeg = strbeg;
2077             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
2078         }
2079     }
2080
2081     return 1;
2082
2083 phooey:
2084     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
2085                           PL_colors[4], PL_colors[5]));
2086     if (PL_reg_eval_set)
2087         restore_pos(aTHX_ 0);
2088     return 0;
2089 }
2090
2091 /*
2092  - regtry - try match at specific point
2093  */
2094 STATIC I32                      /* 0 failure, 1 success */
2095 S_regtry(pTHX_ regexp *prog, char *startpos)
2096 {
2097     dVAR;
2098     register I32 i;
2099     register I32 *sp;
2100     register I32 *ep;
2101     CHECKPOINT lastcp;
2102     GET_RE_DEBUG_FLAGS_DECL;
2103
2104 #ifdef DEBUGGING
2105     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
2106 #endif
2107     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
2108         MAGIC *mg;
2109
2110         PL_reg_eval_set = RS_init;
2111         DEBUG_EXECUTE_r(DEBUG_s(
2112             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
2113                           (IV)(PL_stack_sp - PL_stack_base));
2114             ));
2115         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
2116         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
2117         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
2118         SAVETMPS;
2119         /* Apparently this is not needed, judging by wantarray. */
2120         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
2121            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
2122
2123         if (PL_reg_sv) {
2124             /* Make $_ available to executed code. */
2125             if (PL_reg_sv != DEFSV) {
2126                 SAVE_DEFSV;
2127                 DEFSV = PL_reg_sv;
2128             }
2129         
2130             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
2131                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
2132                 /* prepare for quick setting of pos */
2133 #ifdef PERL_OLD_COPY_ON_WRITE
2134                 if (SvIsCOW(sv))
2135                     sv_force_normal_flags(sv, 0);
2136 #endif
2137                 mg = sv_magicext(PL_reg_sv, (SV*)0, PERL_MAGIC_regex_global,
2138                                  &PL_vtbl_mglob, NULL, 0);
2139                 mg->mg_len = -1;
2140             }
2141             PL_reg_magic    = mg;
2142             PL_reg_oldpos   = mg->mg_len;
2143             SAVEDESTRUCTOR_X(restore_pos, 0);
2144         }
2145         if (!PL_reg_curpm) {
2146             Newxz(PL_reg_curpm, 1, PMOP);
2147 #ifdef USE_ITHREADS
2148             {
2149                 SV* repointer = newSViv(0);
2150                 /* so we know which PL_regex_padav element is PL_reg_curpm */
2151                 SvFLAGS(repointer) |= SVf_BREAK;
2152                 av_push(PL_regex_padav,repointer);
2153                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
2154                 PL_regex_pad = AvARRAY(PL_regex_padav);
2155             }
2156 #endif      
2157         }
2158         PM_SETRE(PL_reg_curpm, prog);
2159         PL_reg_oldcurpm = PL_curpm;
2160         PL_curpm = PL_reg_curpm;
2161         if (RX_MATCH_COPIED(prog)) {
2162             /*  Here is a serious problem: we cannot rewrite subbeg,
2163                 since it may be needed if this match fails.  Thus
2164                 $` inside (?{}) could fail... */
2165             PL_reg_oldsaved = prog->subbeg;
2166             PL_reg_oldsavedlen = prog->sublen;
2167 #ifdef PERL_OLD_COPY_ON_WRITE
2168             PL_nrs = prog->saved_copy;
2169 #endif
2170             RX_MATCH_COPIED_off(prog);
2171         }
2172         else
2173             PL_reg_oldsaved = NULL;
2174         prog->subbeg = PL_bostr;
2175         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2176     }
2177     prog->startp[0] = startpos - PL_bostr;
2178     PL_reginput = startpos;
2179     PL_regstartp = prog->startp;
2180     PL_regendp = prog->endp;
2181     PL_reglastparen = &prog->lastparen;
2182     PL_reglastcloseparen = &prog->lastcloseparen;
2183     prog->lastparen = 0;
2184     prog->lastcloseparen = 0;
2185     PL_regsize = 0;
2186     DEBUG_EXECUTE_r(PL_reg_starttry = startpos);
2187     if (PL_reg_start_tmpl <= prog->nparens) {
2188         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2189         if(PL_reg_start_tmp)
2190             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2191         else
2192             Newx(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2193     }
2194
2195     /* XXXX What this code is doing here?!!!  There should be no need
2196        to do this again and again, PL_reglastparen should take care of
2197        this!  --ilya*/
2198
2199     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2200      * Actually, the code in regcppop() (which Ilya may be meaning by
2201      * PL_reglastparen), is not needed at all by the test suite
2202      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2203      * enough, for building DynaLoader, or otherwise this
2204      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2205      * will happen.  Meanwhile, this code *is* needed for the
2206      * above-mentioned test suite tests to succeed.  The common theme
2207      * on those tests seems to be returning null fields from matches.
2208      * --jhi */
2209 #if 1
2210     sp = prog->startp;
2211     ep = prog->endp;
2212     if (prog->nparens) {
2213         for (i = prog->nparens; i > (I32)*PL_reglastparen; i--) {
2214             *++sp = -1;
2215             *++ep = -1;
2216         }
2217     }
2218 #endif
2219     REGCP_SET(lastcp);
2220     if (regmatch(prog->program + 1)) {
2221         prog->endp[0] = PL_reginput - PL_bostr;
2222         return 1;
2223     }
2224     REGCP_UNWIND(lastcp);
2225     return 0;
2226 }
2227
2228 #define RE_UNWIND_BRANCH        1
2229 #define RE_UNWIND_BRANCHJ       2
2230
2231 union re_unwind_t;
2232
2233 typedef struct {                /* XX: makes sense to enlarge it... */
2234     I32 type;
2235     I32 prev;
2236     CHECKPOINT lastcp;
2237 } re_unwind_generic_t;
2238
2239 typedef struct {
2240     I32 type;
2241     I32 prev;
2242     CHECKPOINT lastcp;
2243     I32 lastparen;
2244     regnode *next;
2245     char *locinput;
2246     I32 nextchr;
2247 #ifdef DEBUGGING
2248     int regindent;
2249 #endif
2250 } re_unwind_branch_t;
2251
2252 typedef union re_unwind_t {
2253     I32 type;
2254     re_unwind_generic_t generic;
2255     re_unwind_branch_t branch;
2256 } re_unwind_t;
2257
2258 #define sayYES goto yes
2259 #define sayNO goto no
2260 #define sayNO_ANYOF goto no_anyof
2261 #define sayYES_FINAL goto yes_final
2262 #define sayYES_LOUD  goto yes_loud
2263 #define sayNO_FINAL  goto no_final
2264 #define sayNO_SILENT goto do_no
2265 #define saySAME(x) if (x) goto yes; else goto no
2266
2267 #define POSCACHE_SUCCESS 0      /* caching success rather than failure */
2268 #define POSCACHE_SEEN 1         /* we know what we're caching */
2269 #define POSCACHE_START 2        /* the real cache: this bit maps to pos 0 */
2270 #define CACHEsayYES STMT_START { \
2271     if (cache_offset | cache_bit) { \
2272         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2273             PL_reg_poscache[0] |= (1<<POSCACHE_SUCCESS) || (1<<POSCACHE_SEEN); \
2274         else if (!(PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2275             /* cache records failure, but this is success */ \
2276             DEBUG_r( \
2277                 PerlIO_printf(Perl_debug_log, \
2278                     "%*s  (remove success from failure cache)\n", \
2279                     REPORT_CODE_OFF+PL_regindent*2, "") \
2280             ); \
2281             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2282         } \
2283     } \
2284     sayYES; \
2285 } STMT_END
2286 #define CACHEsayNO STMT_START { \
2287     if (cache_offset | cache_bit) { \
2288         if (!(PL_reg_poscache[0] & (1<<POSCACHE_SEEN))) \
2289             PL_reg_poscache[0] |= (1<<POSCACHE_SEEN); \
2290         else if ((PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))) { \
2291             /* cache records success, but this is failure */ \
2292             DEBUG_r( \
2293                 PerlIO_printf(Perl_debug_log, \
2294                     "%*s  (remove failure from success cache)\n", \
2295                     REPORT_CODE_OFF+PL_regindent*2, "") \
2296             ); \
2297             PL_reg_poscache[cache_offset] &= ~(1<<cache_bit); \
2298         } \
2299     } \
2300     sayNO; \
2301 } STMT_END
2302
2303 /* this is used to determine how far from the left messages like
2304    'failed...' are printed. Currently 29 makes these messages line
2305    up with the opcode they refer to. Earlier perls used 25 which
2306    left these messages outdented making reviewing a debug output
2307    quite difficult.
2308 */
2309 #define REPORT_CODE_OFF 29
2310
2311
2312 /* Make sure there is a test for this +1 options in re_tests */
2313 #define TRIE_INITAL_ACCEPT_BUFFLEN 4;
2314
2315
2316
2317 /*
2318  - regmatch - main matching routine
2319  *
2320  * Conceptually the strategy is simple:  check to see whether the current
2321  * node matches, call self recursively to see whether the rest matches,
2322  * and then act accordingly.  In practice we make some effort to avoid
2323  * recursion, in particular by going through "ordinary" nodes (that don't
2324  * need to know whether the rest of the match failed) by a loop instead of
2325  * by recursion.
2326  */
2327 /* [lwall] I've hoisted the register declarations to the outer block in order to
2328  * maybe save a little bit of pushing and popping on the stack.  It also takes
2329  * advantage of machines that use a register save mask on subroutine entry.
2330  */
2331 STATIC I32                      /* 0 failure, 1 success */
2332 S_regmatch(pTHX_ regnode *prog)
2333 {
2334     dVAR;
2335     register regnode *scan;     /* Current node. */
2336     regnode *next;              /* Next node. */
2337     regnode *inner;             /* Next node in internal branch. */
2338     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2339                                    function of same name */
2340     register I32 n;             /* no or next */
2341     register I32 ln = 0;        /* len or last */
2342     register char *s = NULL;    /* operand or save */
2343     register char *locinput = PL_reginput;
2344     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2345     int minmod = 0, sw = 0, logical = 0;
2346     I32 unwind = 0;
2347
2348 #if 0
2349     I32 firstcp = PL_savestack_ix;
2350 #endif
2351     register const bool do_utf8 = PL_reg_match_utf8;
2352 #ifdef DEBUGGING
2353     SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
2354     SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
2355     SV * const dsv2 = PERL_DEBUG_PAD_ZERO(2);
2356
2357     SV *re_debug_flags = NULL;
2358 #endif
2359     U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
2360
2361     GET_RE_DEBUG_FLAGS;
2362
2363 #ifdef DEBUGGING
2364     PL_regindent++;
2365 #endif
2366
2367
2368     /* Note that nextchr is a byte even in UTF */
2369     nextchr = UCHARAT(locinput);
2370     scan = prog;
2371     while (scan != NULL) {
2372
2373         DEBUG_EXECUTE_r( {
2374             SV * const prop = sv_newmortal();
2375             const int docolor = *PL_colors[0];
2376             const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2377             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2378             /* The part of the string before starttry has one color
2379                (pref0_len chars), between starttry and current
2380                position another one (pref_len - pref0_len chars),
2381                after the current position the third one.
2382                We assume that pref0_len <= pref_len, otherwise we
2383                decrease pref0_len.  */
2384             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2385                 ? (5 + taill) - l : locinput - PL_bostr;
2386             int pref0_len;
2387
2388             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2389                 pref_len++;
2390             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2391             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2392                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2393                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2394             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2395                 l--;
2396             if (pref0_len < 0)
2397                 pref0_len = 0;
2398             if (pref0_len > pref_len)
2399                 pref0_len = pref_len;
2400             regprop(prop, scan);
2401             {
2402               const char * const s0 =
2403                 do_utf8 && OP(scan) != CANY ?
2404                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2405                                pref0_len, 60, UNI_DISPLAY_REGEX) :
2406                 locinput - pref_len;
2407               const int len0 = do_utf8 ? strlen(s0) : pref0_len;
2408               const char * const s1 = do_utf8 && OP(scan) != CANY ?
2409                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2410                                pref_len - pref0_len, 60, UNI_DISPLAY_REGEX) :
2411                 locinput - pref_len + pref0_len;
2412               const int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2413               const char * const s2 = do_utf8 && OP(scan) != CANY ?
2414                 pv_uni_display(dsv2, (U8*)locinput,
2415                                PL_regeol - locinput, 60, UNI_DISPLAY_REGEX) :
2416                 locinput;
2417               const int len2 = do_utf8 ? strlen(s2) : l;
2418               PerlIO_printf(Perl_debug_log,
2419                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2420                             (IV)(locinput - PL_bostr),
2421                             PL_colors[4],
2422                             len0, s0,
2423                             PL_colors[5],
2424                             PL_colors[2],
2425                             len1, s1,
2426                             PL_colors[3],
2427                             (docolor ? "" : "> <"),
2428                             PL_colors[0],
2429                             len2, s2,
2430                             PL_colors[1],
2431                             15 - l - pref_len + 1,
2432                             "",
2433                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2434                             SvPVX_const(prop));
2435             }
2436         });
2437
2438         next = scan + NEXT_OFF(scan);
2439         if (next == scan)
2440             next = NULL;
2441
2442         switch (OP(scan)) {
2443         case BOL:
2444             if (locinput == PL_bostr)
2445             {
2446                 /* regtill = regbol; */
2447                 break;
2448             }
2449             sayNO;
2450         case MBOL:
2451             if (locinput == PL_bostr ||
2452                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2453             {
2454                 break;
2455             }
2456             sayNO;
2457         case SBOL:
2458             if (locinput == PL_bostr)
2459                 break;
2460             sayNO;
2461         case GPOS:
2462             if (locinput == PL_reg_ganch)
2463                 break;
2464             sayNO;
2465         case EOL:
2466                 goto seol;
2467         case MEOL:
2468             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2469                 sayNO;
2470             break;
2471         case SEOL:
2472           seol:
2473             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2474                 sayNO;
2475             if (PL_regeol - locinput > 1)
2476                 sayNO;
2477             break;
2478         case EOS:
2479             if (PL_regeol != locinput)
2480                 sayNO;
2481             break;
2482         case SANY:
2483             if (!nextchr && locinput >= PL_regeol)
2484                 sayNO;
2485             if (do_utf8) {
2486                 locinput += PL_utf8skip[nextchr];
2487                 if (locinput > PL_regeol)
2488                     sayNO;
2489                 nextchr = UCHARAT(locinput);
2490             }
2491             else
2492                 nextchr = UCHARAT(++locinput);
2493             break;
2494         case CANY:
2495             if (!nextchr && locinput >= PL_regeol)
2496                 sayNO;
2497             nextchr = UCHARAT(++locinput);
2498             break;
2499         case REG_ANY:
2500             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2501                 sayNO;
2502             if (do_utf8) {
2503                 locinput += PL_utf8skip[nextchr];
2504                 if (locinput > PL_regeol)
2505                     sayNO;
2506                 nextchr = UCHARAT(locinput);
2507             }
2508             else
2509                 nextchr = UCHARAT(++locinput);
2510             break;
2511
2512
2513
2514         /*
2515            traverse the TRIE keeping track of all accepting states
2516            we transition through until we get to a failing node.
2517
2518
2519         */
2520         case TRIE:
2521         case TRIEF:
2522         case TRIEFL:
2523             {
2524                 U8 *uc = ( U8* )locinput;
2525                 U32 state = 1;
2526                 U16 charid = 0;
2527                 U32 base = 0;
2528                 UV uvc = 0;
2529                 STRLEN len = 0;
2530                 STRLEN foldlen = 0;
2531                 U8 *uscan = (U8*)NULL;
2532                 STRLEN bufflen=0;
2533                 const enum { trie_plain, trie_utf8, trie_uft8_fold }
2534                     trie_type = do_utf8 ?
2535                           (OP(scan) == TRIE ? trie_utf8 : trie_uft8_fold)
2536                         : trie_plain;
2537
2538                 int gotit = 0;
2539                 /* accepting states we have traversed */
2540                 SV *sv_accept_buff = NULL;
2541                 reg_trie_accepted  *accept_buff = NULL;
2542                 reg_trie_data *trie; /* what trie are we using right now */
2543                 U32 accepted = 0; /* how many accepting states we have seen */
2544
2545                 trie = (reg_trie_data*)PL_regdata->data[ ARG( scan ) ];
2546
2547                 while ( state && uc <= (U8*)PL_regeol ) {
2548
2549                     if (trie->states[ state ].wordnum) {
2550                         if (!accepted ) {
2551                             ENTER;
2552                             SAVETMPS;
2553                             bufflen = TRIE_INITAL_ACCEPT_BUFFLEN;
2554                             sv_accept_buff=newSV(bufflen *
2555                                             sizeof(reg_trie_accepted) - 1);
2556                             SvCUR_set(sv_accept_buff,
2557                                                 sizeof(reg_trie_accepted));
2558                             SvPOK_on(sv_accept_buff);
2559                             sv_2mortal(sv_accept_buff);
2560                             accept_buff =
2561                                 (reg_trie_accepted*)SvPV_nolen(sv_accept_buff );
2562                         }
2563                         else {
2564                             if (accepted >= bufflen) {
2565                                 bufflen *= 2;
2566                                 accept_buff =(reg_trie_accepted*)
2567                                     SvGROW(sv_accept_buff,
2568                                         bufflen * sizeof(reg_trie_accepted));
2569                             }
2570                             SvCUR_set(sv_accept_buff,SvCUR(sv_accept_buff)
2571                                 + sizeof(reg_trie_accepted));
2572                         }
2573                         accept_buff[accepted].wordnum = trie->states[state].wordnum;
2574                         accept_buff[accepted].endpos = uc;
2575                         ++accepted;
2576                     }
2577
2578                     base = trie->states[ state ].trans.base;
2579
2580                     DEBUG_TRIE_EXECUTE_r(
2581                                 PerlIO_printf( Perl_debug_log,
2582                                     "%*s  %sState: %4"UVxf", Base: %4"UVxf", Accepted: %4"UVxf" ",
2583                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2584                                     (UV)state, (UV)base, (UV)accepted );
2585                     );
2586
2587                     if ( base ) {
2588                         switch (trie_type) {
2589                         case trie_uft8_fold:
2590                             if ( foldlen>0 ) {
2591                                 uvc = utf8n_to_uvuni( uscan, UTF8_MAXLEN, &len, uniflags );
2592                                 foldlen -= len;
2593                                 uscan += len;
2594                                 len=0;
2595                             } else {
2596                                 U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
2597                                 uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags );
2598                                 uvc = to_uni_fold( uvc, foldbuf, &foldlen );
2599                                 foldlen -= UNISKIP( uvc );
2600                                 uscan = foldbuf + UNISKIP( uvc );
2601                             }
2602                             break;
2603                         case trie_utf8:
2604                             uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN,
2605                                                             &len, uniflags );
2606                             break;
2607                         case trie_plain:
2608                             uvc = (UV)*uc;
2609                             len = 1;
2610                         }
2611
2612                         if (uvc < 256) {
2613                             charid = trie->charmap[ uvc ];
2614                         }
2615                         else {
2616                             charid = 0;
2617                             if (trie->widecharmap) {
2618                                 SV** svpp = (SV**)NULL;
2619                                 svpp = hv_fetch(trie->widecharmap,
2620                                             (char*)&uvc, sizeof(UV), 0);
2621                                 if (svpp)
2622                                     charid = (U16)SvIV(*svpp);
2623                             }
2624                         }
2625
2626                         if (charid &&
2627                              (base + charid > trie->uniquecharcount )
2628                              && (base + charid - 1 - trie->uniquecharcount
2629                                     < trie->lasttrans)
2630                              && trie->trans[base + charid - 1 -
2631                                     trie->uniquecharcount].check == state)
2632                         {
2633                             state = trie->trans[base + charid - 1 -
2634                                 trie->uniquecharcount ].next;
2635                         }
2636                         else {
2637                             state = 0;
2638                         }
2639                         uc += len;
2640
2641                     }
2642                     else {
2643                         state = 0;
2644                     }
2645                     DEBUG_TRIE_EXECUTE_r(
2646                         PerlIO_printf( Perl_debug_log,
2647                             "Charid:%3x CV:%4"UVxf" After State: %4"UVxf"%s\n",
2648                             charid, uvc, (UV)state, PL_colors[5] );
2649                     );
2650                 }
2651                 if (!accepted )
2652                    sayNO;
2653
2654             /*
2655                There was at least one accepting state that we
2656                transitioned through. Presumably the number of accepting
2657                states is going to be low, typically one or two. So we
2658                simply scan through to find the one with lowest wordnum.
2659                Once we find it, we swap the last state into its place
2660                and decrement the size. We then try to match the rest of
2661                the pattern at the point where the word ends, if we
2662                succeed then we end the loop, otherwise the loop
2663                eventually terminates once all of the accepting states
2664                have been tried.
2665             */
2666
2667                 if ( accepted == 1 ) {
2668                     DEBUG_EXECUTE_r({
2669                         SV **tmp = av_fetch( trie->words, accept_buff[ 0 ].wordnum-1, 0 );
2670                         PerlIO_printf( Perl_debug_log,
2671                             "%*s  %sonly one match : #%d <%s>%s\n",
2672                             REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2673                             accept_buff[ 0 ].wordnum,
2674                             tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
2675                             PL_colors[5] );
2676                     });
2677                     PL_reginput = (char *)accept_buff[ 0 ].endpos;
2678                     /* in this case we free tmps/leave before we call regmatch
2679                        as we wont be using accept_buff again. */
2680                     FREETMPS;
2681                     LEAVE;
2682                     gotit = regmatch( scan + NEXT_OFF( scan ) );
2683                 } else {
2684                     DEBUG_EXECUTE_r(
2685                         PerlIO_printf( Perl_debug_log,"%*s  %sgot %"IVdf" possible matches%s\n",
2686                             REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4], (IV)accepted,
2687                             PL_colors[5] );
2688                     );
2689                     while ( !gotit && accepted-- ) {
2690                         U32 best = 0;
2691                         U32 cur;
2692                         for( cur = 1 ; cur <= accepted ; cur++ ) {
2693                             DEBUG_TRIE_EXECUTE_r(
2694                                 PerlIO_printf( Perl_debug_log,
2695                                     "%*s  %sgot %"IVdf" (%d) as best, looking at %"IVdf" (%d)%s\n",
2696                                     REPORT_CODE_OFF + PL_regindent * 2, "", PL_colors[4],
2697                                     (IV)best, accept_buff[ best ].wordnum, (IV)cur,
2698                                     accept_buff[ cur ].wordnum, PL_colors[5] );
2699                             );
2700
2701                             if ( accept_buff[ cur ].wordnum < accept_buff[ best ].wordnum )
2702                                     best = cur;
2703                         }
2704                         DEBUG_EXECUTE_r({
2705                             SV ** const tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 );
2706                             PerlIO_printf( Perl_debug_log, "%*s  %strying alternation #%d <%s> at 0x%p%s\n",
2707                                 REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
2708                                 accept_buff[best].wordnum,
2709                                 tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
2710                                 PL_colors[5] );
2711                         });
2712                         if ( best<accepted ) {
2713                             reg_trie_accepted tmp = accept_buff[ best ];
2714                             accept_buff[ best ] = accept_buff[ accepted ];
2715                             accept_buff[ accepted ] = tmp;
2716                             best = accepted;
2717                         }
2718                         PL_reginput = (char *)accept_buff[ best ].endpos;
2719
2720                         /* 
2721                            as far as I can tell we only need the SAVETMPS/FREETMPS 
2722                            for re's with EVAL in them but I'm leaving them in for 
2723                            all until I can be sure.
2724                          */
2725                         SAVETMPS;
2726                         gotit = regmatch( scan + NEXT_OFF( scan ) ) ;
2727                         FREETMPS;
2728                     }
2729                     FREETMPS;
2730                     LEAVE;
2731                 }
2732                 
2733                 if ( gotit ) {
2734                     sayYES;
2735                 } else {
2736                     sayNO;
2737                 }
2738             }
2739             /* unreached codepoint */
2740         case EXACT:
2741             s = STRING(scan);
2742             ln = STR_LEN(scan);
2743             if (do_utf8 != UTF) {
2744                 /* The target and the pattern have differing utf8ness. */
2745                 char *l = locinput;
2746                 const char *e = s + ln;
2747
2748                 if (do_utf8) {
2749                     /* The target is utf8, the pattern is not utf8. */
2750                     while (s < e) {
2751                         STRLEN ulen;
2752                         if (l >= PL_regeol)
2753                              sayNO;
2754                         if (NATIVE_TO_UNI(*(U8*)s) !=
2755                             utf8n_to_uvuni((U8*)l, UTF8_MAXBYTES, &ulen,
2756                                             uniflags))
2757                              sayNO;
2758                         l += ulen;
2759                         s ++;
2760                     }
2761                 }
2762                 else {
2763                     /* The target is not utf8, the pattern is utf8. */
2764                     while (s < e) {
2765                         STRLEN ulen;
2766                         if (l >= PL_regeol)
2767                             sayNO;
2768                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2769                             utf8n_to_uvuni((U8*)s, UTF8_MAXBYTES, &ulen,
2770                                            uniflags))
2771                             sayNO;
2772                         s += ulen;
2773                         l ++;
2774                     }
2775                 }
2776                 locinput = l;
2777                 nextchr = UCHARAT(locinput);
2778                 break;
2779             }
2780             /* The target and the pattern have the same utf8ness. */
2781             /* Inline the first character, for speed. */
2782             if (UCHARAT(s) != nextchr)
2783                 sayNO;
2784             if (PL_regeol - locinput < ln)
2785                 sayNO;
2786             if (ln > 1 && memNE(s, locinput, ln))
2787                 sayNO;
2788             locinput += ln;
2789             nextchr = UCHARAT(locinput);
2790             break;
2791         case EXACTFL:
2792             PL_reg_flags |= RF_tainted;
2793             /* FALL THROUGH */
2794         case EXACTF:
2795             s = STRING(scan);
2796             ln = STR_LEN(scan);
2797
2798             if (do_utf8 || UTF) {
2799               /* Either target or the pattern are utf8. */
2800                 char *l = locinput;
2801                 char *e = PL_regeol;
2802
2803                 if (ibcmp_utf8(s, 0,  ln, (bool)UTF,
2804                                l, &e, 0,  do_utf8)) {
2805                      /* One more case for the sharp s:
2806                       * pack("U0U*", 0xDF) =~ /ss/i,
2807                       * the 0xC3 0x9F are the UTF-8
2808                       * byte sequence for the U+00DF. */
2809                      if (!(do_utf8 &&
2810                            toLOWER(s[0]) == 's' &&
2811                            ln >= 2 &&
2812                            toLOWER(s[1]) == 's' &&
2813                            (U8)l[0] == 0xC3 &&
2814                            e - l >= 2 &&
2815                            (U8)l[1] == 0x9F))
2816                           sayNO;
2817                 }
2818                 locinput = e;
2819                 nextchr = UCHARAT(locinput);
2820                 break;
2821             }
2822
2823             /* Neither the target and the pattern are utf8. */
2824
2825             /* Inline the first character, for speed. */
2826             if (UCHARAT(s) != nextchr &&
2827                 UCHARAT(s) != ((OP(scan) == EXACTF)
2828                                ? PL_fold : PL_fold_locale)[nextchr])
2829                 sayNO;
2830             if (PL_regeol - locinput < ln)
2831                 sayNO;
2832             if (ln > 1 && (OP(scan) == EXACTF
2833                            ? ibcmp(s, locinput, ln)
2834                            : ibcmp_locale(s, locinput, ln)))
2835                 sayNO;
2836             locinput += ln;
2837             nextchr = UCHARAT(locinput);
2838             break;
2839         case ANYOF:
2840             if (do_utf8) {
2841                 STRLEN inclasslen = PL_regeol - locinput;
2842
2843                 if (!reginclass(scan, (U8*)locinput, &inclasslen, do_utf8))
2844                     sayNO_ANYOF;
2845                 if (locinput >= PL_regeol)
2846                     sayNO;
2847                 locinput += inclasslen ? inclasslen : UTF8SKIP(locinput);
2848                 nextchr = UCHARAT(locinput);
2849                 break;
2850             }
2851             else {
2852                 if (nextchr < 0)
2853                     nextchr = UCHARAT(locinput);
2854                 if (!REGINCLASS(scan, (U8*)locinput))
2855                     sayNO_ANYOF;
2856                 if (!nextchr && locinput >= PL_regeol)
2857                     sayNO;
2858                 nextchr = UCHARAT(++locinput);
2859                 break;
2860             }
2861         no_anyof:
2862             /* If we might have the case of the German sharp s
2863              * in a casefolding Unicode character class. */
2864
2865             if (ANYOF_FOLD_SHARP_S(scan, locinput, PL_regeol)) {
2866                  locinput += SHARP_S_SKIP;
2867                  nextchr = UCHARAT(locinput);
2868             }
2869             else
2870                  sayNO;
2871             break;
2872         case ALNUML:
2873             PL_reg_flags |= RF_tainted;
2874             /* FALL THROUGH */
2875         case ALNUM:
2876             if (!nextchr)
2877                 sayNO;
2878             if (do_utf8) {
2879                 LOAD_UTF8_CHARCLASS_ALNUM();
2880                 if (!(OP(scan) == ALNUM
2881                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2882                       : isALNUM_LC_utf8((U8*)locinput)))
2883                 {
2884                     sayNO;
2885                 }
2886                 locinput += PL_utf8skip[nextchr];
2887                 nextchr = UCHARAT(locinput);
2888                 break;
2889             }
2890             if (!(OP(scan) == ALNUM
2891                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2892                 sayNO;
2893             nextchr = UCHARAT(++locinput);
2894             break;
2895         case NALNUML:
2896             PL_reg_flags |= RF_tainted;
2897             /* FALL THROUGH */
2898         case NALNUM:
2899             if (!nextchr && locinput >= PL_regeol)
2900                 sayNO;
2901             if (do_utf8) {
2902                 LOAD_UTF8_CHARCLASS_ALNUM();
2903                 if (OP(scan) == NALNUM
2904                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2905                     : isALNUM_LC_utf8((U8*)locinput))
2906                 {
2907                     sayNO;
2908                 }
2909                 locinput += PL_utf8skip[nextchr];
2910                 nextchr = UCHARAT(locinput);
2911                 break;
2912             }
2913             if (OP(scan) == NALNUM
2914                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2915                 sayNO;
2916             nextchr = UCHARAT(++locinput);
2917             break;
2918         case BOUNDL:
2919         case NBOUNDL:
2920             PL_reg_flags |= RF_tainted;
2921             /* FALL THROUGH */
2922         case BOUND:
2923         case NBOUND:
2924             /* was last char in word? */
2925             if (do_utf8) {
2926                 if (locinput == PL_bostr)
2927                     ln = '\n';
2928                 else {
2929                     const U8 * const r = reghop3((U8*)locinput, -1, (U8*)PL_bostr);
2930                 
2931                     ln = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
2932                 }
2933                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2934                     ln = isALNUM_uni(ln);
2935                     LOAD_UTF8_CHARCLASS_ALNUM();
2936                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2937                 }
2938                 else {
2939                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2940                     n = isALNUM_LC_utf8((U8*)locinput);
2941                 }
2942             }
2943             else {
2944                 ln = (locinput != PL_bostr) ?
2945                     UCHARAT(locinput - 1) : '\n';
2946                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2947                     ln = isALNUM(ln);
2948                     n = isALNUM(nextchr);
2949                 }
2950                 else {
2951                     ln = isALNUM_LC(ln);
2952                     n = isALNUM_LC(nextchr);
2953                 }
2954             }
2955             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2956                                     OP(scan) == BOUNDL))
2957                     sayNO;
2958             break;
2959         case SPACEL:
2960             PL_reg_flags |= RF_tainted;
2961             /* FALL THROUGH */
2962         case SPACE:
2963             if (!nextchr)
2964                 sayNO;
2965             if (do_utf8) {
2966                 if (UTF8_IS_CONTINUED(nextchr)) {
2967                     LOAD_UTF8_CHARCLASS_SPACE();
2968                     if (!(OP(scan) == SPACE
2969                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2970                           : isSPACE_LC_utf8((U8*)locinput)))
2971                     {
2972                         sayNO;
2973                     }
2974                     locinput += PL_utf8skip[nextchr];
2975                     nextchr = UCHARAT(locinput);
2976                     break;
2977                 }
2978                 if (!(OP(scan) == SPACE
2979                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2980                     sayNO;
2981                 nextchr = UCHARAT(++locinput);
2982             }
2983             else {
2984                 if (!(OP(scan) == SPACE
2985                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2986                     sayNO;
2987                 nextchr = UCHARAT(++locinput);
2988             }
2989             break;
2990         case NSPACEL:
2991             PL_reg_flags |= RF_tainted;
2992             /* FALL THROUGH */
2993         case NSPACE:
2994             if (!nextchr && locinput >= PL_regeol)
2995                 sayNO;
2996             if (do_utf8) {
2997                 LOAD_UTF8_CHARCLASS_SPACE();
2998                 if (OP(scan) == NSPACE
2999                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
3000                     : isSPACE_LC_utf8((U8*)locinput))
3001                 {
3002                     sayNO;
3003                 }
3004                 locinput += PL_utf8skip[nextchr];
3005                 nextchr = UCHARAT(locinput);
3006                 break;
3007             }
3008             if (OP(scan) == NSPACE
3009                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
3010                 sayNO;
3011             nextchr = UCHARAT(++locinput);
3012             break;
3013         case DIGITL:
3014             PL_reg_flags |= RF_tainted;
3015             /* FALL THROUGH */
3016         case DIGIT:
3017             if (!nextchr)
3018                 sayNO;
3019             if (do_utf8) {
3020                 LOAD_UTF8_CHARCLASS_DIGIT();
3021                 if (!(OP(scan) == DIGIT
3022                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3023                       : isDIGIT_LC_utf8((U8*)locinput)))
3024                 {
3025                     sayNO;
3026                 }
3027                 locinput += PL_utf8skip[nextchr];
3028                 nextchr = UCHARAT(locinput);
3029                 break;
3030             }
3031             if (!(OP(scan) == DIGIT
3032                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
3033                 sayNO;
3034             nextchr = UCHARAT(++locinput);
3035             break;
3036         case NDIGITL:
3037             PL_reg_flags |= RF_tainted;
3038             /* FALL THROUGH */
3039         case NDIGIT:
3040             if (!nextchr && locinput >= PL_regeol)
3041                 sayNO;
3042             if (do_utf8) {
3043                 LOAD_UTF8_CHARCLASS_DIGIT();
3044                 if (OP(scan) == NDIGIT
3045                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
3046                     : isDIGIT_LC_utf8((U8*)locinput))
3047                 {
3048                     sayNO;
3049                 }
3050                 locinput += PL_utf8skip[nextchr];
3051                 nextchr = UCHARAT(locinput);
3052                 break;
3053             }
3054             if (OP(scan) == NDIGIT
3055                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
3056                 sayNO;
3057             nextchr = UCHARAT(++locinput);
3058             break;
3059         case CLUMP:
3060             if (locinput >= PL_regeol)
3061                 sayNO;
3062             if  (do_utf8) {
3063                 LOAD_UTF8_CHARCLASS_MARK();
3064                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3065                     sayNO;
3066                 locinput += PL_utf8skip[nextchr];
3067                 while (locinput < PL_regeol &&
3068                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
3069                     locinput += UTF8SKIP(locinput);
3070                 if (locinput > PL_regeol)
3071                     sayNO;
3072             } 
3073             else
3074                locinput++;
3075             nextchr = UCHARAT(locinput);
3076             break;
3077         case REFFL:
3078             PL_reg_flags |= RF_tainted;
3079             /* FALL THROUGH */
3080         case REF:
3081         case REFF:
3082             n = ARG(scan);  /* which paren pair */
3083             ln = PL_regstartp[n];
3084             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3085             if ((I32)*PL_reglastparen < n || ln == -1)
3086                 sayNO;                  /* Do not match unless seen CLOSEn. */
3087             if (ln == PL_regendp[n])
3088                 break;
3089
3090             s = PL_bostr + ln;
3091             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
3092                 char *l = locinput;
3093                 const char *e = PL_bostr + PL_regendp[n];
3094                 /*
3095                  * Note that we can't do the "other character" lookup trick as
3096                  * in the 8-bit case (no pun intended) because in Unicode we
3097                  * have to map both upper and title case to lower case.
3098                  */
3099                 if (OP(scan) == REFF) {
3100                     while (s < e) {
3101                         STRLEN ulen1, ulen2;
3102                         U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3103                         U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3104
3105                         if (l >= PL_regeol)
3106                             sayNO;
3107                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
3108                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
3109                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
3110                             sayNO;
3111                         s += ulen1;
3112                         l += ulen2;
3113                     }
3114                 }
3115                 locinput = l;
3116                 nextchr = UCHARAT(locinput);
3117                 break;
3118             }
3119
3120             /* Inline the first character, for speed. */
3121             if (UCHARAT(s) != nextchr &&
3122                 (OP(scan) == REF ||
3123                  (UCHARAT(s) != ((OP(scan) == REFF
3124                                   ? PL_fold : PL_fold_locale)[nextchr]))))
3125                 sayNO;
3126             ln = PL_regendp[n] - ln;
3127             if (locinput + ln > PL_regeol)
3128                 sayNO;
3129             if (ln > 1 && (OP(scan) == REF
3130                            ? memNE(s, locinput, ln)
3131                            : (OP(scan) == REFF
3132                               ? ibcmp(s, locinput, ln)
3133                               : ibcmp_locale(s, locinput, ln))))
3134                 sayNO;
3135             locinput += ln;
3136             nextchr = UCHARAT(locinput);
3137             break;
3138
3139         case NOTHING:
3140         case TAIL:
3141             break;
3142         case BACK:
3143             break;
3144         case EVAL:
3145         {
3146             dSP;
3147             OP_4tree * const oop = PL_op;
3148             COP * const ocurcop = PL_curcop;
3149             PAD *old_comppad;
3150             SV *ret;
3151             struct regexp * const oreg = PL_reg_re;
3152         
3153             n = ARG(scan);
3154             PL_op = (OP_4tree*)PL_regdata->data[n];
3155             DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
3156             PAD_SAVE_LOCAL(old_comppad, (PAD*)PL_regdata->data[n + 2]);
3157             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
3158
3159             {
3160                 SV ** const before = SP;
3161                 CALLRUNOPS(aTHX);                       /* Scalar context. */
3162                 SPAGAIN;
3163                 if (SP == before)
3164                     ret = &PL_sv_undef;   /* protect against empty (?{}) blocks. */
3165                 else {
3166                     ret = POPs;
3167                     PUTBACK;
3168                 }
3169             }
3170
3171             PL_op = oop;
3172             PAD_RESTORE_LOCAL(old_comppad);
3173             PL_curcop = ocurcop;
3174             if (logical) {
3175                 if (logical == 2) {     /* Postponed subexpression. */
3176                     regexp *re;
3177                     MAGIC *mg = NULL;
3178                     re_cc_state state;
3179                     CHECKPOINT cp, lastcp;
3180                     int toggleutf;
3181                     register SV *sv;
3182
3183                     if(SvROK(ret) && SvSMAGICAL(sv = SvRV(ret)))
3184                         mg = mg_find(sv, PERL_MAGIC_qr);
3185                     else if (SvSMAGICAL(ret)) {
3186                         if (SvGMAGICAL(ret))
3187                             sv_unmagic(ret, PERL_MAGIC_qr);
3188                         else
3189                             mg = mg_find(ret, PERL_MAGIC_qr);
3190                     }
3191
3192                     if (mg) {
3193                         re = (regexp *)mg->mg_obj;
3194                         (void)ReREFCNT_inc(re);
3195                     }
3196                     else {
3197                         STRLEN len;
3198                         const char * const t = SvPV_const(ret, len);
3199                         PMOP pm;
3200                         char * const oprecomp = PL_regprecomp;
3201                         const I32 osize = PL_regsize;
3202                         const I32 onpar = PL_regnpar;
3203
3204                         Zero(&pm, 1, PMOP);
3205                         if (DO_UTF8(ret)) pm.op_pmdynflags |= PMdf_DYN_UTF8;
3206                         re = CALLREGCOMP(aTHX_ (char*)t, (char*)t + len, &pm);
3207                         if (!(SvFLAGS(ret)
3208                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY
3209                                 | SVs_GMG)))
3210                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
3211                                         PERL_MAGIC_qr,0,0);
3212                         PL_regprecomp = oprecomp;
3213                         PL_regsize = osize;
3214                         PL_regnpar = onpar;
3215                     }
3216                     DEBUG_EXECUTE_r(
3217                         PerlIO_printf(Perl_debug_log,
3218                                       "Entering embedded \"%s%.60s%s%s\"\n",
3219                                       PL_colors[0],
3220                                       re->precomp,
3221                                       PL_colors[1],
3222                                       (strlen(re->precomp) > 60 ? "..." : ""))
3223                         );
3224                     state.node = next;
3225                     state.prev = PL_reg_call_cc;
3226                     state.cc = PL_regcc;
3227                     state.re = PL_reg_re;
3228
3229                     PL_regcc = 0;
3230                 
3231                     cp = regcppush(0);  /* Save *all* the positions. */
3232                     REGCP_SET(lastcp);
3233                     cache_re(re);
3234                     state.ss = PL_savestack_ix;
3235                     *PL_reglastparen = 0;
3236                     *PL_reglastcloseparen = 0;
3237                     PL_reg_call_cc = &state;
3238                     PL_reginput = locinput;
3239                     toggleutf = ((PL_reg_flags & RF_utf8) != 0) ^
3240                                 ((re->reganch & ROPT_UTF8) != 0);
3241                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3242
3243                     /* XXXX This is too dramatic a measure... */
3244                     PL_reg_maxiter = 0;
3245
3246                     if (regmatch(re->program + 1)) {
3247                         /* Even though we succeeded, we need to restore
3248                            global variables, since we may be wrapped inside
3249                            SUSPEND, thus the match may be not finished yet. */
3250
3251                         /* XXXX Do this only if SUSPENDed? */
3252                         PL_reg_call_cc = state.prev;
3253                         PL_regcc = state.cc;
3254                         PL_reg_re = state.re;
3255                         cache_re(PL_reg_re);
3256                         if (toggleutf) PL_reg_flags ^= RF_utf8;
3257
3258                         /* XXXX This is too dramatic a measure... */
3259                         PL_reg_maxiter = 0;
3260
3261                         /* These are needed even if not SUSPEND. */
3262                         ReREFCNT_dec(re);
3263                         regcpblow(cp);
3264                         sayYES;
3265                     }
3266                     ReREFCNT_dec(re);
3267                     REGCP_UNWIND(lastcp);
3268                     regcppop();
3269                     PL_reg_call_cc = state.prev;
3270                     PL_regcc = state.cc;
3271                     PL_reg_re = state.re;
3272                     cache_re(PL_reg_re);
3273                     if (toggleutf) PL_reg_flags ^= RF_utf8;
3274
3275                     /* XXXX This is too dramatic a measure... */
3276                     PL_reg_maxiter = 0;
3277
3278                     logical = 0;
3279                     sayNO;
3280                 }
3281                 sw = SvTRUE(ret);
3282                 logical = 0;
3283             }
3284             else {
3285                 sv_setsv(save_scalar(PL_replgv), ret);
3286                 cache_re(oreg);
3287             }
3288             break;
3289         }
3290         case OPEN:
3291             n = ARG(scan);  /* which paren pair */
3292             PL_reg_start_tmp[n] = locinput;
3293             if (n > PL_regsize)
3294                 PL_regsize = n;
3295             break;
3296         case CLOSE:
3297             n = ARG(scan);  /* which paren pair */
3298             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
3299             PL_regendp[n] = locinput - PL_bostr;
3300             if (n > (I32)*PL_reglastparen)
3301                 *PL_reglastparen = n;
3302             *PL_reglastcloseparen = n;
3303             break;
3304         case GROUPP:
3305             n = ARG(scan);  /* which paren pair */
3306             sw = ((I32)*PL_reglastparen >= n && PL_regendp[n] != -1);
3307             break;
3308         case IFTHEN:
3309             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
3310             if (sw)
3311                 next = NEXTOPER(NEXTOPER(scan));
3312             else {
3313                 next = scan + ARG(scan);
3314                 if (OP(next) == IFTHEN) /* Fake one. */
3315                     next = NEXTOPER(NEXTOPER(next));
3316             }
3317             break;
3318         case LOGICAL:
3319             logical = scan->flags;
3320             break;
3321 /*******************************************************************
3322  PL_regcc contains infoblock about the innermost (...)* loop, and
3323  a pointer to the next outer infoblock.
3324
3325  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
3326
3327    1) After matching X, regnode for CURLYX is processed;
3328
3329    2) This regnode creates infoblock on the stack, and calls
3330       regmatch() recursively with the starting point at WHILEM node;
3331
3332    3) Each hit of WHILEM node tries to match A and Z (in the order
3333       depending on the current iteration, min/max of {min,max} and
3334       greediness).  The information about where are nodes for "A"
3335       and "Z" is read from the infoblock, as is info on how many times "A"
3336       was already matched, and greediness.
3337
3338    4) After A matches, the same WHILEM node is hit again.
3339
3340    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
3341       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
3342       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
3343       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
3344       of the external loop.
3345
3346  Currently present infoblocks form a tree with a stem formed by PL_curcc
3347  and whatever it mentions via ->next, and additional attached trees
3348  corresponding to temporarily unset infoblocks as in "5" above.
3349
3350  In the following picture infoblocks for outer loop of
3351  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
3352  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
3353  infoblocks are drawn below the "reset" infoblock.
3354
3355  In fact in the picture below we do not show failed matches for Z and T
3356  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
3357  more obvious *why* one needs to *temporary* unset infoblocks.]
3358
3359   Matched       REx position    InfoBlocks      Comment
3360                 (Y(A)*?Z)*?T    x
3361                 Y(A)*?Z)*?T     x <- O
3362   Y             (A)*?Z)*?T      x <- O
3363   Y             A)*?Z)*?T       x <- O <- I
3364   YA            )*?Z)*?T        x <- O <- I
3365   YA            A)*?Z)*?T       x <- O <- I
3366   YAA           )*?Z)*?T        x <- O <- I
3367   YAA           Z)*?T           x <- O          # Temporary unset I
3368                                      I
3369
3370   YAAZ          Y(A)*?Z)*?T     x <- O
3371                                      I
3372
3373   YAAZY         (A)*?Z)*?T      x <- O
3374                                      I
3375
3376   YAAZY         A)*?Z)*?T       x <- O <- I
3377                                      I
3378
3379   YAAZYA        )*?Z)*?T        x <- O <- I     
3380                                      I
3381
3382   YAAZYA        Z)*?T           x <- O          # Temporary unset I
3383                                      I,I
3384
3385   YAAZYAZ       )*?T            x <- O
3386                                      I,I
3387
3388   YAAZYAZ       T               x               # Temporary unset O
3389                                 O
3390                                 I,I
3391
3392   YAAZYAZT                      x
3393                                 O
3394                                 I,I
3395  *******************************************************************/
3396         case CURLYX: {
3397                 CURCUR cc;
3398                 CHECKPOINT cp = PL_savestack_ix;
3399                 /* No need to save/restore up to this paren */
3400                 I32 parenfloor = scan->flags;
3401
3402                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
3403                     next += ARG(next);
3404                 cc.oldcc = PL_regcc;
3405                 PL_regcc = &cc;
3406                 /* XXXX Probably it is better to teach regpush to support
3407                    parenfloor > PL_regsize... */
3408                 if (parenfloor > (I32)*PL_reglastparen)
3409                     parenfloor = *PL_reglastparen; /* Pessimization... */
3410                 cc.parenfloor = parenfloor;
3411                 cc.cur = -1;
3412                 cc.min = ARG1(scan);
3413                 cc.max  = ARG2(scan);
3414                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3415                 cc.next = next;
3416                 cc.minmod = minmod;
3417                 cc.lastloc = 0;
3418                 PL_reginput = locinput;
3419                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3420                 regcpblow(cp);
3421                 PL_regcc = cc.oldcc;
3422                 saySAME(n);
3423             }
3424             /* NOTREACHED */
3425         case WHILEM: {
3426                 /*
3427                  * This is really hard to understand, because after we match
3428                  * what we're trying to match, we must make sure the rest of
3429                  * the REx is going to match for sure, and to do that we have
3430                  * to go back UP the parse tree by recursing ever deeper.  And
3431                  * if it fails, we have to reset our parent's current state
3432                  * that we can try again after backing off.
3433                  */
3434
3435                 CHECKPOINT cp, lastcp;
3436                 CURCUR* cc = PL_regcc;
3437                 char * const lastloc = cc->lastloc; /* Detection of 0-len. */
3438                 I32 cache_offset = 0, cache_bit = 0;
3439                 
3440                 n = cc->cur + 1;        /* how many we know we matched */
3441                 PL_reginput = locinput;
3442
3443                 DEBUG_EXECUTE_r(
3444                     PerlIO_printf(Perl_debug_log,
3445                                   "%*s  %ld out of %ld..%ld  cc=%"UVxf"\n",
3446                                   REPORT_CODE_OFF+PL_regindent*2, "",
3447                                   (long)n, (long)cc->min,
3448                                   (long)cc->max, PTR2UV(cc))
3449                     );
3450
3451                 /* If degenerate scan matches "", assume scan done. */
3452
3453                 if (locinput == cc->lastloc && n >= cc->min) {
3454                     PL_regcc = cc->oldcc;
3455                     if (PL_regcc)
3456                         ln = PL_regcc->cur;
3457                     DEBUG_EXECUTE_r(
3458                         PerlIO_printf(Perl_debug_log,
3459                            "%*s  empty match detected, try continuation...\n",
3460                            REPORT_CODE_OFF+PL_regindent*2, "")
3461                         );
3462                     if (regmatch(cc->next))
3463                         sayYES;
3464                     if (PL_regcc)
3465                         PL_regcc->cur = ln;
3466                     PL_regcc = cc;
3467                     sayNO;
3468                 }
3469
3470                 /* First just match a string of min scans. */
3471
3472                 if (n < cc->min) {
3473                     cc->cur = n;
3474                     cc->lastloc = locinput;
3475                     if (regmatch(cc->scan))
3476                         sayYES;
3477                     cc->cur = n - 1;
3478                     cc->lastloc = lastloc;
3479                     sayNO;
3480                 }
3481
3482                 if (scan->flags) {
3483                     /* Check whether we already were at this position.
3484                         Postpone detection until we know the match is not
3485                         *that* much linear. */
3486                 if (!PL_reg_maxiter) {
3487                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3488                     PL_reg_leftiter = PL_reg_maxiter;
3489                 }
3490                 if (PL_reg_leftiter-- == 0) {
3491                     const I32 size = (PL_reg_maxiter + 7 + POSCACHE_START)/8;
3492                     if (PL_reg_poscache) {
3493                         if ((I32)PL_reg_poscache_size < size) {
3494                             Renew(PL_reg_poscache, size, char);
3495                             PL_reg_poscache_size = size;
3496                         }
3497                         Zero(PL_reg_poscache, size, char);
3498                     }
3499                     else {
3500                         PL_reg_poscache_size = size;
3501                         Newxz(PL_reg_poscache, size, char);
3502                     }
3503                     DEBUG_EXECUTE_r(
3504                         PerlIO_printf(Perl_debug_log,
3505               "%sDetected a super-linear match, switching on caching%s...\n",
3506                                       PL_colors[4], PL_colors[5])
3507                         );
3508                 }
3509                 if (PL_reg_leftiter < 0) {
3510                     cache_offset = locinput - PL_bostr;
3511
3512                     cache_offset = (scan->flags & 0xf) - 1 + POSCACHE_START
3513                             + cache_offset * (scan->flags>>4);
3514                     cache_bit = cache_offset % 8;
3515                     cache_offset /= 8;
3516                     if (PL_reg_poscache[cache_offset] & (1<<cache_bit)) {
3517                     DEBUG_EXECUTE_r(
3518                         PerlIO_printf(Perl_debug_log,
3519                                       "%*s  already tried at this position...\n",
3520                                       REPORT_CODE_OFF+PL_regindent*2, "")
3521                         );
3522                         if (PL_reg_poscache[0] & (1<<POSCACHE_SUCCESS))
3523                             /* cache records success */
3524                             sayYES;
3525                         else
3526                             /* cache records failure */
3527                             sayNO_SILENT;
3528                     }
3529                     PL_reg_poscache[cache_offset] |= (1<<cache_bit);
3530                 }
3531                 }
3532
3533                 /* Prefer next over scan for minimal matching. */
3534
3535                 if (cc->minmod) {
3536                     PL_regcc = cc->oldcc;
3537                     if (PL_regcc)
3538                         ln = PL_regcc->cur;
3539                     cp = regcppush(cc->parenfloor);
3540                     REGCP_SET(lastcp);
3541                     if (regmatch(cc->next)) {
3542                         regcpblow(cp);
3543                         CACHEsayYES;    /* All done. */
3544                     }
3545                     REGCP_UNWIND(lastcp);
3546                     regcppop();
3547                     if (PL_regcc)
3548                         PL_regcc->cur = ln;
3549                     PL_regcc = cc;
3550
3551                     if (n >= cc->max) { /* Maximum greed exceeded? */
3552                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3553                             && !(PL_reg_flags & RF_warned)) {
3554                             PL_reg_flags |= RF_warned;
3555                             Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3556                                  "Complex regular subexpression recursion",
3557                                  REG_INFTY - 1);
3558                         }
3559                         CACHEsayNO;
3560                     }
3561
3562                     DEBUG_EXECUTE_r(
3563                         PerlIO_printf(Perl_debug_log,
3564                                       "%*s  trying longer...\n",
3565                                       REPORT_CODE_OFF+PL_regindent*2, "")
3566                         );
3567                     /* Try scanning more and see if it helps. */
3568                     PL_reginput = locinput;
3569                     cc->cur = n;
3570                     cc->lastloc = locinput;
3571                     cp = regcppush(cc->parenfloor);
3572                     REGCP_SET(lastcp);
3573                     if (regmatch(cc->scan)) {
3574                         regcpblow(cp);
3575                         CACHEsayYES;
3576                     }
3577                     REGCP_UNWIND(lastcp);
3578                     regcppop();
3579                     cc->cur = n - 1;
3580                     cc->lastloc = lastloc;
3581                     CACHEsayNO;
3582                 }
3583
3584                 /* Prefer scan over next for maximal matching. */
3585
3586                 if (n < cc->max) {      /* More greed allowed? */
3587                     cp = regcppush(cc->parenfloor);
3588                     cc->cur = n;
3589                     cc->lastloc = locinput;
3590                     REGCP_SET(lastcp);
3591                     if (regmatch(cc->scan)) {
3592                         regcpblow(cp);
3593                         CACHEsayYES;
3594                     }
3595                     REGCP_UNWIND(lastcp);
3596                     regcppop();         /* Restore some previous $<digit>s? */
3597                     PL_reginput = locinput;
3598                     DEBUG_EXECUTE_r(
3599                         PerlIO_printf(Perl_debug_log,
3600                                       "%*s  failed, try continuation...\n",
3601                                       REPORT_CODE_OFF+PL_regindent*2, "")
3602                         );
3603                 }
3604                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3605                         && !(PL_reg_flags & RF_warned)) {
3606                     PL_reg_flags |= RF_warned;
3607                     Perl_warner(aTHX_ packWARN(WARN_REGEXP), "%s limit (%d) exceeded",
3608                          "Complex regular subexpression recursion",
3609                          REG_INFTY - 1);
3610                 }
3611
3612                 /* Failed deeper matches of scan, so see if this one works. */
3613                 PL_regcc = cc->oldcc;
3614                 if (PL_regcc)
3615                     ln = PL_regcc->cur;
3616                 if (regmatch(cc->next))
3617                     CACHEsayYES;
3618                 if (PL_regcc)
3619                     PL_regcc->cur = ln;
3620                 PL_regcc = cc;
3621                 cc->cur = n - 1;
3622                 cc->lastloc = lastloc;
3623                 CACHEsayNO;
3624             }
3625             /* NOTREACHED */
3626         case BRANCHJ:
3627             next = scan + ARG(scan);
3628             if (next == scan)
3629                 next = NULL;
3630             inner = NEXTOPER(NEXTOPER(scan));
3631             goto do_branch;
3632         case BRANCH:
3633             inner = NEXTOPER(scan);
3634           do_branch:
3635             {
3636                 c1 = OP(scan);
3637                 if (OP(next) != c1)     /* No choice. */
3638                     next = inner;       /* Avoid recursion. */
3639                 else {
3640                     const I32 lastparen = *PL_reglastparen;
3641                     /* Put unwinding data on stack */
3642                     const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
3643                     re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
3644
3645                     uw->prev = unwind;
3646                     unwind = unwind1;
3647                     uw->type = ((c1 == BRANCH)
3648                                 ? RE_UNWIND_BRANCH
3649                                 : RE_UNWIND_BRANCHJ);
3650                     uw->lastparen = lastparen;
3651                     uw->next = next;
3652                     uw->locinput = locinput;
3653                     uw->nextchr = nextchr;
3654 #ifdef DEBUGGING
3655                     uw->regindent = ++PL_regindent;
3656 #endif
3657
3658                     REGCP_SET(uw->lastcp);
3659
3660                     /* Now go into the first branch */
3661                     next = inner;
3662                 }
3663             }
3664             break;
3665         case MINMOD:
3666             minmod = 1;
3667             break;
3668         case CURLYM:
3669         {
3670             I32 l = 0;
3671             I32 matches = 0;
3672             CHECKPOINT lastcp;
3673             I32 maxwanted;
3674         
3675             /* We suppose that the next guy does not need
3676                backtracking: in particular, it is of constant non-zero length,
3677                and has no parenths to influence future backrefs. */
3678             ln = ARG1(scan);  /* min to match */
3679             n  = ARG2(scan);  /* max to match */
3680             paren = scan->flags;
3681             if (paren) {
3682                 if (paren > PL_regsize)
3683                     PL_regsize = paren;
3684                 if (paren > (I32)*PL_reglastparen)
3685                     *PL_reglastparen = paren;
3686             }
3687             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3688             if (paren)
3689                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3690             PL_reginput = locinput;
3691             maxwanted = minmod ? ln : n;
3692             if (maxwanted) {
3693                 while (PL_reginput < PL_regeol && matches < maxwanted) {
3694                     if (!regmatch(scan))
3695                         break;
3696                     /* on first match, determine length, l */
3697                     if (!matches++) {
3698                         if (PL_reg_match_utf8) {
3699                             char *s = locinput;
3700                             while (s < PL_reginput) {
3701                                 l++;
3702                                 s += UTF8SKIP(s);
3703                             }
3704                         }
3705                         else {
3706                             l = PL_reginput - locinput;
3707                         }
3708                         if (l == 0) {
3709                             matches = maxwanted;
3710                             break;
3711                         }
3712                     }
3713                     locinput = PL_reginput;
3714                 }
3715             }
3716
3717             PL_reginput = locinput;
3718
3719             if (minmod) {
3720                 minmod = 0;
3721                 if (ln && matches < ln)
3722                     sayNO;
3723                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3724                     regnode *text_node = next;
3725
3726                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3727
3728                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3729                     else {
3730                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3731                             c1 = c2 = -1000;
3732                             goto assume_ok_MM;
3733                         }
3734                         else { c1 = (U8)*STRING(text_node); }
3735                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3736                             c2 = PL_fold[c1];
3737                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3738                             c2 = PL_fold_locale[c1];
3739                         else
3740                             c2 = c1;
3741                     }
3742                 }
3743                 else
3744                     c1 = c2 = -1000;
3745             assume_ok_MM:
3746                 REGCP_SET(lastcp);
3747                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3748                     /* If it could work, try it. */
3749                     if (c1 == -1000 ||
3750                         UCHARAT(PL_reginput) == c1 ||
3751                         UCHARAT(PL_reginput) == c2)
3752                     {
3753                         if (paren) {
3754                             if (ln) {
3755                                 PL_regstartp[paren] =
3756                                     HOPc(PL_reginput, -l) - PL_bostr;
3757                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3758                             }
3759                             else
3760                                 PL_regendp[paren] = -1;
3761                         }
3762                         if (regmatch(next))
3763                             sayYES;
3764                         REGCP_UNWIND(lastcp);
3765                     }
3766                     /* Couldn't or didn't -- move forward. */
3767                     PL_reginput = locinput;
3768                     if (regmatch(scan)) {
3769                         ln++;
3770                         locinput = PL_reginput;
3771                     }
3772                     else
3773                         sayNO;
3774                 }
3775             }
3776             else {
3777                 DEBUG_EXECUTE_r(
3778                     PerlIO_printf(Perl_debug_log,
3779                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3780                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3781                                   (IV) matches, (IV)l)
3782                     );
3783                 if (matches >= ln) {
3784                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3785                         regnode *text_node = next;
3786
3787                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3788
3789                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3790                         else {
3791                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3792                                 c1 = c2 = -1000;
3793                                 goto assume_ok_REG;
3794                             }
3795                             else { c1 = (U8)*STRING(text_node); }
3796
3797                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3798                                 c2 = PL_fold[c1];
3799                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3800                                 c2 = PL_fold_locale[c1];
3801                             else
3802                                 c2 = c1;
3803                         }
3804                     }
3805                     else
3806                         c1 = c2 = -1000;
3807                 }
3808             assume_ok_REG:
3809                 REGCP_SET(lastcp);
3810                 while (matches >= ln) {
3811                     /* If it could work, try it. */
3812                     if (c1 == -1000 ||
3813                         UCHARAT(PL_reginput) == c1 ||
3814                         UCHARAT(PL_reginput) == c2)
3815                     {
3816                         DEBUG_EXECUTE_r(
3817                             PerlIO_printf(Perl_debug_log,
3818                                 "%*s  trying tail with matches=%"IVdf"...\n",
3819                                 (int)(REPORT_CODE_OFF+PL_regindent*2),
3820                                 "", (IV)matches)
3821                             );
3822                         if (paren) {
3823                             if (matches) {
3824                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3825                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3826                             }
3827                             else
3828                                 PL_regendp[paren] = -1;
3829                         }
3830                         if (regmatch(next))
3831                             sayYES;
3832                         REGCP_UNWIND(lastcp);
3833                     }
3834                     /* Couldn't or didn't -- back up. */
3835                     matches--;
3836                     locinput = HOPc(locinput, -l);
3837                     PL_reginput = locinput;
3838                 }
3839             }
3840             sayNO;
3841             /* NOTREACHED */
3842             break;
3843         }
3844         case CURLYN:
3845             paren = scan->flags;        /* Which paren to set */
3846             if (paren > PL_regsize)
3847                 PL_regsize = paren;
3848             if (paren > (I32)*PL_reglastparen)
3849                 *PL_reglastparen = paren;
3850             ln = ARG1(scan);  /* min to match */
3851             n  = ARG2(scan);  /* max to match */
3852             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3853             goto repeat;
3854         case CURLY:
3855             paren = 0;
3856             ln = ARG1(scan);  /* min to match */
3857             n  = ARG2(scan);  /* max to match */
3858             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3859             goto repeat;
3860         case STAR:
3861             ln = 0;
3862             n = REG_INFTY;
3863             scan = NEXTOPER(scan);
3864             paren = 0;
3865             goto repeat;
3866         case PLUS:
3867             ln = 1;
3868             n = REG_INFTY;
3869             scan = NEXTOPER(scan);
3870             paren = 0;
3871           repeat:
3872             /*
3873             * Lookahead to avoid useless match attempts
3874             * when we know what character comes next.
3875             */
3876
3877             /*
3878             * Used to only do .*x and .*?x, but now it allows
3879             * for )'s, ('s and (?{ ... })'s to be in the way
3880             * of the quantifier and the EXACT-like node.  -- japhy
3881             */
3882
3883             if (HAS_TEXT(next) || JUMPABLE(next)) {
3884                 U8 *s;
3885                 regnode *text_node = next;
3886
3887                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3888
3889                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3890                 else {
3891                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3892                         c1 = c2 = -1000;
3893                         goto assume_ok_easy;
3894                     }
3895                     else { s = (U8*)STRING(text_node); }
3896
3897                     if (!UTF) {
3898                         c2 = c1 = *s;
3899                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3900                             c2 = PL_fold[c1];
3901                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3902                             c2 = PL_fold_locale[c1];
3903                     }
3904                     else { /* UTF */
3905                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3906                              STRLEN ulen1, ulen2;
3907                              U8 tmpbuf1[UTF8_MAXBYTES_CASE+1];
3908                              U8 tmpbuf2[UTF8_MAXBYTES_CASE+1];
3909
3910                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3911                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3912
3913                              c1 = utf8n_to_uvuni(tmpbuf1, UTF8_MAXBYTES, 0,
3914                                                  uniflags);
3915                              c2 = utf8n_to_uvuni(tmpbuf2, UTF8_MAXBYTES, 0,
3916                                                  uniflags);
3917                         }
3918                         else {
3919                             c2 = c1 = utf8n_to_uvchr(s, UTF8_MAXBYTES, 0,
3920                                                      uniflags);
3921                         }
3922                     }
3923                 }
3924             }
3925             else
3926                 c1 = c2 = -1000;
3927         assume_ok_easy:
3928             PL_reginput = locinput;
3929             if (minmod) {
3930                 CHECKPOINT lastcp;
3931                 minmod = 0;
3932                 if (ln && regrepeat(scan, ln) < ln)
3933                     sayNO;
3934                 locinput = PL_reginput;
3935                 REGCP_SET(lastcp);
3936                 if (c1 != -1000) {
3937                     char *e; /* Should not check after this */
3938                     char *old = locinput;
3939                     int count = 0;
3940
3941                     if  (n == REG_INFTY) {
3942                         e = PL_regeol - 1;
3943                         if (do_utf8)
3944                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3945                                 e--;
3946                     }
3947                     else if (do_utf8) {
3948                         int m = n - ln;
3949                         for (e = locinput;
3950                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3951                             e += UTF8SKIP(e);
3952                     }
3953                     else {
3954                         e = locinput + n - ln;
3955                         if (e >= PL_regeol)
3956                             e = PL_regeol - 1;
3957                     }
3958                     while (1) {
3959                         /* Find place 'next' could work */
3960                         if (!do_utf8) {
3961                             if (c1 == c2) {
3962                                 while (locinput <= e &&
3963                                        UCHARAT(locinput) != c1)
3964                                     locinput++;
3965                             } else {
3966                                 while (locinput <= e
3967                                        && UCHARAT(locinput) != c1
3968                                        && UCHARAT(locinput) != c2)
3969                                     locinput++;
3970                             }
3971                             count = locinput - old;
3972                         }
3973                         else {
3974                             if (c1 == c2) {
3975                                 STRLEN len;
3976                                 /* count initialised to
3977                                  * utf8_distance(old, locinput) */
3978                                 while (locinput <= e &&
3979                                        utf8n_to_uvchr((U8*)locinput,
3980                                                       UTF8_MAXBYTES, &len,
3981                                                       uniflags) != (UV)c1) {
3982                                     locinput += len;
3983                                     count++;
3984                                 }
3985                             } else {
3986                                 STRLEN len;
3987                                 /* count initialised to
3988                                  * utf8_distance(old, locinput) */
3989                                 while (locinput <= e) {
3990                                     UV c = utf8n_to_uvchr((U8*)locinput,
3991                                                           UTF8_MAXBYTES, &len,
3992                                                           uniflags);
3993                                     if (c == (UV)c1 || c == (UV)c2)
3994                                         break;
3995                                     locinput += len;
3996                                     count++;
3997                                 }
3998                             }
3999                         }
4000                         if (locinput > e)
4001                             sayNO;
4002                         /* PL_reginput == old now */
4003                         if (locinput != old) {
4004                             ln = 1;     /* Did some */
4005                             if (regrepeat(scan, count) < count)
4006                                 sayNO;
4007                         }
4008                         /* PL_reginput == locinput now */
4009                         TRYPAREN(paren, ln, locinput);
4010                         PL_reginput = locinput; /* Could be reset... */
4011                         REGCP_UNWIND(lastcp);
4012                         /* Couldn't or didn't -- move forward. */
4013                         old = locinput;
4014                         if (do_utf8)
4015                             locinput += UTF8SKIP(locinput);
4016                         else
4017                             locinput++;
4018                         count = 1;
4019                     }
4020                 }
4021                 else
4022                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
4023                     UV c;
4024                     if (c1 != -1000) {
4025                         if (do_utf8)
4026                             c = utf8n_to_uvchr((U8*)PL_reginput,
4027                                                UTF8_MAXBYTES, 0,
4028                                                uniflags);
4029                         else
4030                             c = UCHARAT(PL_reginput);
4031                         /* If it could work, try it. */
4032                         if (c == (UV)c1 || c == (UV)c2)
4033                         {
4034                             TRYPAREN(paren, ln, PL_reginput);
4035                             REGCP_UNWIND(lastcp);
4036                         }
4037                     }
4038                     /* If it could work, try it. */
4039                     else if (c1 == -1000)
4040                     {
4041                         TRYPAREN(paren, ln, PL_reginput);
4042                         REGCP_UNWIND(lastcp);
4043                     }
4044                     /* Couldn't or didn't -- move forward. */
4045                     PL_reginput = locinput;
4046                     if (regrepeat(scan, 1)) {
4047                         ln++;
4048                         locinput = PL_reginput;
4049                     }
4050                     else
4051                         sayNO;
4052                 }
4053             }
4054             else {
4055                 CHECKPOINT lastcp;
4056                 n = regrepeat(scan, n);
4057                 locinput = PL_reginput;
4058                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
4059                     (OP(next) != MEOL ||
4060                         OP(next) == SEOL || OP(next) == EOS))
4061                 {
4062                     ln = n;                     /* why back off? */
4063                     /* ...because $ and \Z can match before *and* after
4064                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
4065                        We should back off by one in this case. */
4066                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
4067                         ln--;
4068                 }
4069                 REGCP_SET(lastcp);
4070                 {
4071                     UV c = 0;
4072                     while (n >= ln) {
4073                         if (c1 != -1000) {
4074                             if (do_utf8)
4075                                 c = utf8n_to_uvchr((U8*)PL_reginput,
4076                                                    UTF8_MAXBYTES, 0,
4077                                                    uniflags);
4078                             else
4079                                 c = UCHARAT(PL_reginput);
4080                         }
4081                         /* If it could work, try it. */
4082                         if (c1 == -1000 || c == (UV)c1 || c == (UV)c2)
4083                             {
4084                                 TRYPAREN(paren, n, PL_reginput);
4085                                 REGCP_UNWIND(lastcp);
4086                             }
4087                         /* Couldn't or didn't -- back up. */
4088                         n--;
4089                         PL_reginput = locinput = HOPc(locinput, -1);
4090                     }
4091                 }
4092             }
4093             sayNO;
4094             break;
4095         case END:
4096             if (PL_reg_call_cc) {
4097                 re_cc_state *cur_call_cc = PL_reg_call_cc;
4098                 CURCUR *cctmp = PL_regcc;
4099                 regexp *re = PL_reg_re;
4100                 CHECKPOINT lastcp;
4101                 I32 tmp;
4102
4103                 /* Save *all* the positions. */
4104                 const CHECKPOINT cp = regcppush(0);
4105                 REGCP_SET(lastcp);
4106
4107                 /* Restore parens of the caller. */
4108                 tmp = PL_savestack_ix;
4109                 PL_savestack_ix = PL_reg_call_cc->ss;
4110                 regcppop();
4111                 PL_savestack_ix = tmp;
4112
4113                 /* Make position available to the callcc. */
4114                 PL_reginput = locinput;
4115
4116                 cache_re(PL_reg_call_cc->re);
4117                 PL_regcc = PL_reg_call_cc->cc;
4118                 PL_reg_call_cc = PL_reg_call_cc->prev;
4119                 if (regmatch(cur_call_cc->node)) {
4120                     PL_reg_call_cc = cur_call_cc;
4121                     regcpblow(cp);
4122                     sayYES;
4123                 }
4124                 REGCP_UNWIND(lastcp);
4125                 regcppop();
4126                 PL_reg_call_cc = cur_call_cc;
4127                 PL_regcc = cctmp;
4128                 PL_reg_re = re;
4129                 cache_re(re);
4130
4131                 DEBUG_EXECUTE_r(
4132                     PerlIO_printf(Perl_debug_log,
4133                                   "%*s  continuation failed...\n",
4134                                   REPORT_CODE_OFF+PL_regindent*2, "")
4135                     );
4136                 sayNO_SILENT;
4137             }
4138             if (locinput < PL_regtill) {
4139                 DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log,
4140                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
4141                                       PL_colors[4],
4142                                       (long)(locinput - PL_reg_starttry),
4143                                       (long)(PL_regtill - PL_reg_starttry),
4144                                       PL_colors[5]));
4145                 sayNO_FINAL;            /* Cannot match: too short. */
4146             }
4147             PL_reginput = locinput;     /* put where regtry can find it */
4148             sayYES_FINAL;               /* Success! */
4149         case SUCCEED:
4150             PL_reginput = locinput;     /* put where regtry can find it */
4151             sayYES_LOUD;                /* Success! */
4152         case SUSPEND:
4153             n = 1;
4154             PL_reginput = locinput;
4155             goto do_ifmatch;    
4156         case UNLESSM:
4157             n = 0;
4158             if (scan->flags) {
4159                 s = HOPBACKc(locinput, scan->flags);
4160                 if (!s)
4161                     goto say_yes;
4162                 PL_reginput = s;
4163             }
4164             else
4165                 PL_reginput = locinput;
4166             goto do_ifmatch;
4167         case IFMATCH:
4168             n = 1;
4169             if (scan->flags) {
4170                 s = HOPBACKc(locinput, scan->flags);
4171                 if (!s)
4172                     goto say_no;
4173                 PL_reginput = s;
4174             }
4175             else
4176                 PL_reginput = locinput;
4177
4178           do_ifmatch:
4179             inner = NEXTOPER(NEXTOPER(scan));
4180             if (regmatch(inner) != n) {
4181               say_no:
4182                 if (logical) {
4183                     logical = 0;
4184                     sw = 0;
4185                     goto do_longjump;
4186                 }
4187                 else
4188                     sayNO;
4189             }
4190           say_yes:
4191             if (logical) {
4192                 logical = 0;
4193                 sw = 1;
4194             }
4195             if (OP(scan) == SUSPEND) {
4196                 locinput = PL_reginput;
4197                 nextchr = UCHARAT(locinput);
4198             }
4199             /* FALL THROUGH. */
4200         case LONGJMP:
4201           do_longjump:
4202             next = scan + ARG(scan);
4203             if (next == scan)
4204                 next = NULL;
4205             break;
4206         default:
4207             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
4208                           PTR2UV(scan), OP(scan));
4209             Perl_croak(aTHX_ "regexp memory corruption");
4210         }
4211       reenter:
4212         scan = next;
4213     }
4214
4215     /*
4216     * We get here only if there's trouble -- normally "case END" is
4217     * the terminating point.
4218     */
4219     Perl_croak(aTHX_ "corrupted regexp pointers");
4220     /*NOTREACHED*/
4221     sayNO;
4222
4223 yes_loud:
4224     DEBUG_EXECUTE_r(
4225         PerlIO_printf(Perl_debug_log,
4226                       "%*s  %scould match...%s\n",
4227                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4228         );
4229     goto yes;
4230 yes_final:
4231     DEBUG_EXECUTE_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
4232                           PL_colors[4], PL_colors[5]));
4233 yes:
4234 #ifdef DEBUGGING
4235     PL_regindent--;
4236 #endif
4237
4238 #if 0                                   /* Breaks $^R */
4239     if (unwind)
4240         regcpblow(firstcp);
4241 #endif
4242     return 1;
4243
4244 no:
4245     DEBUG_EXECUTE_r(
4246         PerlIO_printf(Perl_debug_log,
4247                       "%*s  %sfailed...%s\n",
4248                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4], PL_colors[5])
4249         );
4250     goto do_no;
4251 no_final:
4252 do_no:
4253     if (unwind) {
4254         re_unwind_t * const uw = SSPTRt(unwind,re_unwind_t);
4255
4256         switch (uw->type) {
4257         case RE_UNWIND_BRANCH:
4258         case RE_UNWIND_BRANCHJ:
4259         {
4260             re_unwind_branch_t * const uwb = &(uw->branch);
4261             const I32 lastparen = uwb->lastparen;
4262         
4263             REGCP_UNWIND(uwb->lastcp);
4264             for (n = *PL_reglastparen; n > lastparen; n--)
4265                 PL_regendp[n] = -1;
4266             *PL_reglastparen = n;
4267             scan = next = uwb->next;
4268             if ( !scan ||
4269                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
4270                               ? BRANCH : BRANCHJ) ) {           /* Failure */
4271                 unwind = uwb->prev;
4272 #ifdef DEBUGGING
4273                 PL_regindent--;
4274 #endif
4275                 goto do_no;
4276             }
4277             /* Have more choice yet.  Reuse the same uwb.  */
4278             if ((n = (uwb->type == RE_UNWIND_BRANCH
4279                       ? NEXT_OFF(next) : ARG(next))))
4280                 next += n;
4281             else
4282                 next = NULL;    /* XXXX Needn't unwinding in this case... */
4283             uwb->next = next;
4284             next = NEXTOPER(scan);
4285             if (uwb->type == RE_UNWIND_BRANCHJ)
4286                 next = NEXTOPER(next);
4287             locinput = uwb->locinput;
4288             nextchr = uwb->nextchr;
4289 #ifdef DEBUGGING
4290             PL_regindent = uwb->regindent;
4291 #endif
4292
4293             goto reenter;
4294         }
4295         /* NOTREACHED */
4296         default:
4297             Perl_croak(aTHX_ "regexp unwind memory corruption");
4298         }
4299         /* NOTREACHED */
4300     }
4301 #ifdef DEBUGGING
4302     PL_regindent--;
4303 #endif
4304     return 0;
4305 }
4306
4307 /*
4308  - regrepeat - repeatedly match something simple, report how many
4309  */
4310 /*
4311  * [This routine now assumes that it will only match on things of length 1.
4312  * That was true before, but now we assume scan - reginput is the count,
4313  * rather than incrementing count on every character.  [Er, except utf8.]]
4314  */
4315 STATIC I32
4316 S_regrepeat(pTHX_ const regnode *p, I32 max)
4317 {
4318     dVAR;
4319     register char *scan;
4320     register I32 c;
4321     register char *loceol = PL_regeol;
4322     register I32 hardcount = 0;
4323     register bool do_utf8 = PL_reg_match_utf8;
4324
4325     scan = PL_reginput;
4326     if (max == REG_INFTY)
4327         max = I32_MAX;
4328     else if (max < loceol - scan)
4329       loceol = scan + max;
4330     switch (OP(p)) {
4331     case REG_ANY:
4332         if (do_utf8) {
4333             loceol = PL_regeol;
4334             while (scan < loceol && hardcount < max && *scan != '\n') {
4335                 scan += UTF8SKIP(scan);
4336                 hardcount++;
4337             }
4338         } else {
4339             while (scan < loceol && *scan != '\n')
4340                 scan++;
4341         }
4342         break;
4343     case SANY:
4344         if (do_utf8) {
4345             loceol = PL_regeol;
4346             while (scan < loceol && hardcount < max) {
4347                 scan += UTF8SKIP(scan);
4348                 hardcount++;
4349             }
4350         }
4351         else
4352             scan = loceol;
4353         break;
4354     case CANY:
4355         scan = loceol;
4356         break;
4357     case EXACT:         /* length of string is 1 */
4358         c = (U8)*STRING(p);
4359         while (scan < loceol && UCHARAT(scan) == c)
4360             scan++;
4361         break;
4362     case EXACTF:        /* length of string is 1 */
4363         c = (U8)*STRING(p);
4364         while (scan < loceol &&
4365                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
4366             scan++;
4367         break;
4368     case EXACTFL:       /* length of string is 1 */
4369         PL_reg_flags |= RF_tainted;
4370         c = (U8)*STRING(p);
4371         while (scan < loceol &&
4372                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
4373             scan++;
4374         break;
4375     case ANYOF:
4376         if (do_utf8) {
4377             loceol = PL_regeol;
4378             while (hardcount < max && scan < loceol &&
4379                    reginclass(p, (U8*)scan, 0, do_utf8)) {
4380                 scan += UTF8SKIP(scan);
4381                 hardcount++;
4382             }
4383         } else {
4384             while (scan < loceol && REGINCLASS(p, (U8*)scan))
4385                 scan++;
4386         }
4387         break;
4388     case ALNUM:
4389         if (do_utf8) {
4390             loceol = PL_regeol;
4391             LOAD_UTF8_CHARCLASS_ALNUM();
4392             while (hardcount < max && scan < loceol &&
4393                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4394                 scan += UTF8SKIP(scan);
4395                 hardcount++;
4396             }
4397         } else {
4398             while (scan < loceol && isALNUM(*scan))
4399                 scan++;
4400         }
4401         break;
4402     case ALNUML:
4403         PL_reg_flags |= RF_tainted;
4404         if (do_utf8) {
4405             loceol = PL_regeol;
4406             while (hardcount < max && scan < loceol &&
4407                    isALNUM_LC_utf8((U8*)scan)) {
4408                 scan += UTF8SKIP(scan);
4409                 hardcount++;
4410             }
4411         } else {
4412             while (scan < loceol && isALNUM_LC(*scan))
4413                 scan++;
4414         }
4415         break;
4416     case NALNUM:
4417         if (do_utf8) {
4418             loceol = PL_regeol;
4419             LOAD_UTF8_CHARCLASS_ALNUM();
4420             while (hardcount < max && scan < loceol &&
4421                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4422                 scan += UTF8SKIP(scan);
4423                 hardcount++;
4424             }
4425         } else {
4426             while (scan < loceol && !isALNUM(*scan))
4427                 scan++;
4428         }
4429         break;
4430     case NALNUML:
4431         PL_reg_flags |= RF_tainted;
4432         if (do_utf8) {
4433             loceol = PL_regeol;
4434             while (hardcount < max && scan < loceol &&
4435                    !isALNUM_LC_utf8((U8*)scan)) {
4436                 scan += UTF8SKIP(scan);
4437                 hardcount++;
4438             }
4439         } else {
4440             while (scan < loceol && !isALNUM_LC(*scan))
4441                 scan++;
4442         }
4443         break;
4444     case SPACE:
4445         if (do_utf8) {
4446             loceol = PL_regeol;
4447             LOAD_UTF8_CHARCLASS_SPACE();
4448             while (hardcount < max && scan < loceol &&
4449                    (*scan == ' ' ||
4450                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4451                 scan += UTF8SKIP(scan);
4452                 hardcount++;
4453             }
4454         } else {
4455             while (scan < loceol && isSPACE(*scan))
4456                 scan++;
4457         }
4458         break;
4459     case SPACEL:
4460         PL_reg_flags |= RF_tainted;
4461         if (do_utf8) {
4462             loceol = PL_regeol;
4463             while (hardcount < max && scan < loceol &&
4464                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4465                 scan += UTF8SKIP(scan);
4466                 hardcount++;
4467             }
4468         } else {
4469             while (scan < loceol && isSPACE_LC(*scan))
4470                 scan++;
4471         }
4472         break;
4473     case NSPACE:
4474         if (do_utf8) {
4475             loceol = PL_regeol;
4476             LOAD_UTF8_CHARCLASS_SPACE();
4477             while (hardcount < max && scan < loceol &&
4478                    !(*scan == ' ' ||
4479                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4480                 scan += UTF8SKIP(scan);
4481                 hardcount++;
4482             }
4483         } else {
4484             while (scan < loceol && !isSPACE(*scan))
4485                 scan++;
4486             break;
4487         }
4488     case NSPACEL:
4489         PL_reg_flags |= RF_tainted;
4490         if (do_utf8) {
4491             loceol = PL_regeol;
4492             while (hardcount < max && scan < loceol &&
4493                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4494                 scan += UTF8SKIP(scan);
4495                 hardcount++;
4496             }
4497         } else {
4498             while (scan < loceol && !isSPACE_LC(*scan))
4499                 scan++;
4500         }
4501         break;
4502     case DIGIT:
4503         if (do_utf8) {
4504             loceol = PL_regeol;
4505             LOAD_UTF8_CHARCLASS_DIGIT();
4506             while (hardcount < max && scan < loceol &&
4507                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4508                 scan += UTF8SKIP(scan);
4509                 hardcount++;
4510             }
4511         } else {
4512             while (scan < loceol && isDIGIT(*scan))
4513                 scan++;
4514         }
4515         break;
4516     case NDIGIT:
4517         if (do_utf8) {
4518             loceol = PL_regeol;
4519             LOAD_UTF8_CHARCLASS_DIGIT();
4520             while (hardcount < max && scan < loceol &&
4521                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4522                 scan += UTF8SKIP(scan);
4523                 hardcount++;
4524             }
4525         } else {
4526             while (scan < loceol && !isDIGIT(*scan))
4527                 scan++;
4528         }
4529         break;
4530     default:            /* Called on something of 0 width. */
4531         break;          /* So match right here or not at all. */
4532     }
4533
4534     if (hardcount)
4535         c = hardcount;
4536     else
4537         c = scan - PL_reginput;
4538     PL_reginput = scan;
4539
4540     DEBUG_r({
4541                 SV *re_debug_flags = NULL;
4542                 SV * const prop = sv_newmortal();
4543                 GET_RE_DEBUG_FLAGS;
4544                 DEBUG_EXECUTE_r({
4545                 regprop(prop, p);
4546                 PerlIO_printf(Perl_debug_log,
4547                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4548                               REPORT_CODE_OFF+1, "", SvPVX_const(prop),(IV)c,(IV)max);
4549         });
4550         });
4551
4552     return(c);
4553 }
4554
4555
4556 /*
4557 - regclass_swash - prepare the utf8 swash
4558 */
4559
4560 SV *
4561 Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
4562 {
4563     dVAR;
4564     SV *sw  = NULL;
4565     SV *si  = NULL;
4566     SV *alt = NULL;
4567
4568     if (PL_regdata && PL_regdata->count) {
4569         const U32 n = ARG(node);
4570
4571         if (PL_regdata->what[n] == 's') {
4572             SV * const rv = (SV*)PL_regdata->data[n];
4573             AV * const av = (AV*)SvRV((SV*)rv);
4574             SV **const ary = AvARRAY(av);
4575             SV **a, **b;
4576         
4577             /* See the end of regcomp.c:S_regclass() for
4578              * documentation of these array elements. */
4579
4580             si = *ary;
4581             a  = SvROK(ary[1]) ? &ary[1] : 0;
4582             b  = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
4583
4584             if (a)
4585                 sw = *a;
4586             else if (si && doinit) {
4587                 sw = swash_init("utf8", "", si, 1, 0);
4588                 (void)av_store(av, 1, sw);
4589             }
4590             if (b)
4591                 alt = *b;
4592         }
4593     }
4594         
4595     if (listsvp)
4596         *listsvp = si;
4597     if (altsvp)
4598         *altsvp  = alt;
4599
4600     return sw;
4601 }
4602
4603 /*
4604  - reginclass - determine if a character falls into a character class
4605  
4606   The n is the ANYOF regnode, the p is the target string, lenp
4607   is pointer to the maximum length of how far to go in the p
4608   (if the lenp is zero, UTF8SKIP(p) is used),
4609   do_utf8 tells whether the target string is in UTF-8.
4610
4611  */
4612
4613 STATIC bool
4614 S_reginclass(pTHX_ register const regnode *n, register const U8* p, STRLEN* lenp, register bool do_utf8)
4615 {
4616     dVAR;
4617     const char flags = ANYOF_FLAGS(n);
4618     bool match = FALSE;
4619     UV c = *p;
4620     STRLEN len = 0;
4621     STRLEN plen;
4622
4623     if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
4624         c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
4625                             ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY :
4626                                         UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY);
4627         if (len == (STRLEN)-1)
4628             Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
4629     }
4630
4631     plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
4632     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4633         if (lenp)
4634             *lenp = 0;
4635         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4636             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4637                 match = TRUE;
4638         }
4639         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4640             match = TRUE;
4641         if (!match) {
4642             AV *av;
4643             SV * const sw = regclass_swash(n, TRUE, 0, (SV**)&av);
4644         
4645             if (sw) {
4646                 if (swash_fetch(sw, p, do_utf8))
4647                     match = TRUE;
4648                 else if (flags & ANYOF_FOLD) {
4649                     if (!match && lenp && av) {
4650                         I32 i;
4651                         for (i = 0; i <= av_len(av); i++) {
4652                             SV* const sv = *av_fetch(av, i, FALSE);
4653                             STRLEN len;
4654                             const char * const s = SvPV_const(sv, len);
4655                         
4656                             if (len <= plen && memEQ(s, (char*)p, len)) {
4657                                 *lenp = len;
4658                                 match = TRUE;
4659                                 break;
4660                             }
4661                         }
4662                     }
4663                     if (!match) {
4664                         U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
4665                         STRLEN tmplen;
4666
4667                         to_utf8_fold(p, tmpbuf, &tmplen);
4668                         if (swash_fetch(sw, tmpbuf, do_utf8))
4669                             match = TRUE;
4670                     }
4671                 }
4672             }
4673         }
4674         if (match && lenp && *lenp == 0)
4675             *lenp = UNISKIP(NATIVE_TO_UNI(c));
4676     }
4677     if (!match && c < 256) {
4678         if (ANYOF_BITMAP_TEST(n, c))
4679             match = TRUE;
4680         else if (flags & ANYOF_FOLD) {
4681             U8 f;
4682
4683             if (flags & ANYOF_LOCALE) {
4684                 PL_reg_flags |= RF_tainted;
4685                 f = PL_fold_locale[c];
4686             }
4687             else
4688                 f = PL_fold[c];
4689             if (f != c && ANYOF_BITMAP_TEST(n, f))
4690                 match = TRUE;
4691         }
4692         
4693         if (!match && (flags & ANYOF_CLASS)) {
4694             PL_reg_flags |= RF_tainted;
4695             if (
4696                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4697                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4698                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4699                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4700                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4701                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4702                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4703                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4704                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4705                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4706                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4707                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4708                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4709                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4710                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4711                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4712                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4713                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4714                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4715                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4716                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4717                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4718                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4719                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4720                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4721                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4722                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4723                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4724                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4725                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4726                 ) /* How's that for a conditional? */
4727             {
4728                 match = TRUE;
4729             }
4730         }
4731     }
4732
4733     return (flags & ANYOF_INVERT) ? !match : match;
4734 }
4735
4736 STATIC U8 *
4737 S_reghop(pTHX_ U8 *s, I32 off)
4738 {
4739     dVAR;
4740     return S_reghop3(s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4741 }
4742
4743 STATIC U8 *
4744 S_reghop3(U8 *s, I32 off, U8* lim)
4745 {
4746     dVAR;
4747     if (off >= 0) {
4748         while (off-- && s < lim) {
4749             /* XXX could check well-formedness here */
4750             s += UTF8SKIP(s);
4751         }
4752     }
4753     else {
4754         while (off++) {
4755             if (s > lim) {
4756                 s--;
4757                 if (UTF8_IS_CONTINUED(*s)) {
4758                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4759                         s--;
4760                 }
4761                 /* XXX could check well-formedness here */
4762             }
4763         }
4764     }
4765     return s;
4766 }
4767
4768 STATIC U8 *
4769 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4770 {
4771     dVAR;
4772     return S_reghopmaybe3(s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4773 }
4774
4775 STATIC U8 *
4776 S_reghopmaybe3(U8* s, I32 off, U8* lim)
4777 {
4778     dVAR;
4779     if (off >= 0) {
4780         while (off-- && s < lim) {
4781             /* XXX could check well-formedness here */
4782             s += UTF8SKIP(s);
4783         }
4784         if (off >= 0)
4785             return 0;
4786     }
4787     else {
4788         while (off++) {
4789             if (s > lim) {
4790                 s--;
4791                 if (UTF8_IS_CONTINUED(*s)) {
4792                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4793                         s--;
4794                 }
4795                 /* XXX could check well-formedness here */
4796             }
4797             else
4798                 break;
4799         }
4800         if (off <= 0)
4801             return 0;
4802     }
4803     return s;
4804 }
4805
4806 static void
4807 restore_pos(pTHX_ void *arg)
4808 {
4809     dVAR;
4810     PERL_UNUSED_ARG(arg);
4811     if (PL_reg_eval_set) {
4812         if (PL_reg_oldsaved) {
4813             PL_reg_re->subbeg = PL_reg_oldsaved;
4814             PL_reg_re->sublen = PL_reg_oldsavedlen;
4815 #ifdef PERL_OLD_COPY_ON_WRITE
4816             PL_reg_re->saved_copy = PL_nrs;
4817 #endif
4818             RX_MATCH_COPIED_on(PL_reg_re);
4819         }
4820         PL_reg_magic->mg_len = PL_reg_oldpos;
4821         PL_reg_eval_set = 0;
4822         PL_curpm = PL_reg_oldcurpm;
4823     }   
4824 }
4825
4826 STATIC void
4827 S_to_utf8_substr(pTHX_ register regexp *prog)
4828 {
4829     if (prog->float_substr && !prog->float_utf8) {
4830         SV* sv;
4831         prog->float_utf8 = sv = newSVsv(prog->float_substr);
4832         sv_utf8_upgrade(sv);
4833         if (SvTAIL(prog->float_substr))
4834             SvTAIL_on(sv);
4835         if (prog->float_substr == prog->check_substr)
4836             prog->check_utf8 = sv;
4837     }
4838     if (prog->anchored_substr && !prog->anchored_utf8) {
4839         SV* sv;
4840         prog->anchored_utf8 = sv = newSVsv(prog->anchored_substr);
4841         sv_utf8_upgrade(sv);
4842         if (SvTAIL(prog->anchored_substr))
4843             SvTAIL_on(sv);
4844         if (prog->anchored_substr == prog->check_substr)
4845             prog->check_utf8 = sv;
4846     }
4847 }
4848
4849 STATIC void
4850 S_to_byte_substr(pTHX_ register regexp *prog)
4851 {
4852     dVAR;
4853     if (prog->float_utf8 && !prog->float_substr) {
4854         SV* sv;
4855         prog->float_substr = sv = newSVsv(prog->float_utf8);
4856         if (sv_utf8_downgrade(sv, TRUE)) {
4857             if (SvTAIL(prog->float_utf8))
4858                 SvTAIL_on(sv);
4859         } else {
4860             SvREFCNT_dec(sv);
4861             prog->float_substr = sv = &PL_sv_undef;
4862         }
4863         if (prog->float_utf8 == prog->check_utf8)
4864             prog->check_substr = sv;
4865     }
4866     if (prog->anchored_utf8 && !prog->anchored_substr) {
4867         SV* sv;
4868         prog->anchored_substr = sv = newSVsv(prog->anchored_utf8);
4869         if (sv_utf8_downgrade(sv, TRUE)) {
4870             if (SvTAIL(prog->anchored_utf8))
4871                 SvTAIL_on(sv);
4872         } else {
4873             SvREFCNT_dec(sv);
4874             prog->anchored_substr = sv = &PL_sv_undef;
4875         }
4876         if (prog->anchored_utf8 == prog->check_utf8)
4877             prog->check_substr = sv;
4878     }
4879 }
4880
4881 /*
4882  * Local variables:
4883  * c-indentation-style: bsd
4884  * c-basic-offset: 4
4885  * indent-tabs-mode: t
4886  * End:
4887  *
4888  * ex: set ts=8 sts=4 sw=4 noet:
4889  */