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