Better support for multicharacter foldings.
[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
984                 /* The ibcmp_utf8() uses to_uni_fold() which is more
985                  * correct folding for Unicode than using lowercase.
986                  * However, it doesn't work quite fully since the folding
987                  * is a one-to-many mapping and the regex optimizer is
988                  * unaware of this, so it may throw out good matches.
989                  * Fortunately, not getting this right is allowed
990                  * for Unicode Regular Expression Support level 1,
991                  * only one-to-one matching is required. --jhi */
992
993                 if (c1 == c2) {
994                     while (s <= e) {
995                         c = utf8_to_uvchr((U8*)s, &len);
996                         if ( c == c1
997                              && (ln == len ||
998                                  !ibcmp_utf8(s, do_utf8,
999                                              strend - s > ln ? ln : strend - s,
1000                                              m, UTF, ln))
1001                              && (norun || regtry(prog, s)) )
1002                             goto got_it;
1003                         else {
1004                              uvchr_to_utf8(tmpbuf, c);
1005                              to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1006                              f = utf8_to_uvchr(foldbuf, 0);
1007                              if ( f != c
1008                                   && (f == c1 || f == c2)
1009                                   && (ln == foldlen ||
1010                                       !ibcmp_utf8((char *)foldbuf,
1011                                                   do_utf8,
1012                                                   foldlen > ln ? ln : foldlen,
1013                                                   m, UTF, ln))
1014                                   && (norun || regtry(prog, s)) )
1015                                   goto got_it;
1016                         }
1017                         s += len;
1018                     }
1019                 }
1020                 else {
1021                     while (s <= e) {
1022                         c = utf8_to_uvchr((U8*)s, &len);
1023
1024                         /* Handle some of the three Greek sigmas cases.
1025                           * Note that not all the possible combinations
1026                           * are handled here: some of them are handled
1027                           * handled by the standard folding rules, and
1028                           * some of them (the character class or ANYOF
1029                           * cases) are handled during compiletime in
1030                           * regexec.c:S_regclass(). */
1031                         if (c == (UV)UNICODE_GREEK_CAPITAL_LETTER_SIGMA ||
1032                             c == (UV)UNICODE_GREEK_SMALL_LETTER_FINAL_SIGMA)
1033                             c = (UV)UNICODE_GREEK_SMALL_LETTER_SIGMA;
1034
1035                         if ( (c == c1 || c == c2)
1036                              && (ln == len ||
1037                                  !ibcmp_utf8(s, do_utf8,
1038                                              strend - s > ln ? ln : strend - s,
1039                                              m, UTF, ln))
1040                              && (norun || regtry(prog, s)) )
1041                             goto got_it;
1042                         else {
1043                              uvchr_to_utf8(tmpbuf, c);
1044                              to_utf8_fold(tmpbuf, foldbuf, &foldlen);
1045                              f = utf8_to_uvchr(foldbuf, 0);
1046                              if ( f != c
1047                                   && (f == c1 || f == c2)
1048                                   && (ln == foldlen ||
1049                                       !ibcmp_utf8((char *)foldbuf,
1050                                                   do_utf8,
1051                                                   foldlen > ln ? ln : foldlen,
1052                                                   m, UTF, ln))
1053                                   && (norun || regtry(prog, s)) )
1054                                   goto got_it;
1055                         }
1056                         s += len;
1057                     }
1058                 }
1059             }
1060             else {
1061                 if (c1 == c2)
1062                     while (s <= e) {
1063                         if ( *(U8*)s == c1
1064                              && (ln == 1 || !(OP(c) == EXACTF
1065                                               ? ibcmp(s, m, ln)
1066                                               : ibcmp_locale(s, m, ln)))
1067                              && (norun || regtry(prog, s)) )
1068                             goto got_it;
1069                         s++;
1070                     }
1071                 else
1072                     while (s <= e) {
1073                         if ( (*(U8*)s == c1 || *(U8*)s == c2)
1074                              && (ln == 1 || !(OP(c) == EXACTF
1075                                               ? ibcmp(s, m, ln)
1076                                               : ibcmp_locale(s, m, ln)))
1077                              && (norun || regtry(prog, s)) )
1078                             goto got_it;
1079                         s++;
1080                     }
1081             }
1082             break;
1083         case BOUNDL:
1084             PL_reg_flags |= RF_tainted;
1085             /* FALL THROUGH */
1086         case BOUND:
1087             if (do_utf8) {
1088                 if (s == PL_bostr)
1089                     tmp = '\n';
1090                 else {
1091                     U8 *r = reghop3((U8*)s, -1, (U8*)startpos);
1092                 
1093                     if (s > (char*)r)
1094                         tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0);
1095                 }
1096                 tmp = ((OP(c) == BOUND ?
1097                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1098                 LOAD_UTF8_CHARCLASS(alnum,"a");
1099                 while (s < strend) {
1100                     if (tmp == !(OP(c) == BOUND ?
1101                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1102                                  isALNUM_LC_utf8((U8*)s)))
1103                     {
1104                         tmp = !tmp;
1105                         if ((norun || regtry(prog, s)))
1106                             goto got_it;
1107                     }
1108                     s += UTF8SKIP(s);
1109                 }
1110             }
1111             else {
1112                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1113                 tmp = ((OP(c) == BOUND ? isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1114                 while (s < strend) {
1115                     if (tmp ==
1116                         !(OP(c) == BOUND ? isALNUM(*s) : isALNUM_LC(*s))) {
1117                         tmp = !tmp;
1118                         if ((norun || regtry(prog, s)))
1119                             goto got_it;
1120                     }
1121                     s++;
1122                 }
1123             }
1124             if ((!prog->minlen && tmp) && (norun || regtry(prog, s)))
1125                 goto got_it;
1126             break;
1127         case NBOUNDL:
1128             PL_reg_flags |= RF_tainted;
1129             /* FALL THROUGH */
1130         case NBOUND:
1131             if (do_utf8) {
1132                 if (s == PL_bostr)
1133                     tmp = '\n';
1134                 else {
1135                     U8 *r = reghop3((U8*)s, -1, (U8*)startpos);
1136                 
1137                     if (s > (char*)r)
1138                         tmp = (I32)utf8n_to_uvchr(r, s - (char*)r, 0, 0);
1139                 }
1140                 tmp = ((OP(c) == NBOUND ?
1141                         isALNUM_uni(tmp) : isALNUM_LC_uvchr(UNI_TO_NATIVE(tmp))) != 0);
1142                 LOAD_UTF8_CHARCLASS(alnum,"a");
1143                 while (s < strend) {
1144                     if (tmp == !(OP(c) == NBOUND ?
1145                                  swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8) :
1146                                  isALNUM_LC_utf8((U8*)s)))
1147                         tmp = !tmp;
1148                     else if ((norun || regtry(prog, s)))
1149                         goto got_it;
1150                     s += UTF8SKIP(s);
1151                 }
1152             }
1153             else {
1154                 tmp = (s != PL_bostr) ? UCHARAT(s - 1) : '\n';
1155                 tmp = ((OP(c) == NBOUND ?
1156                         isALNUM(tmp) : isALNUM_LC(tmp)) != 0);
1157                 while (s < strend) {
1158                     if (tmp ==
1159                         !(OP(c) == NBOUND ? isALNUM(*s) : isALNUM_LC(*s)))
1160                         tmp = !tmp;
1161                     else if ((norun || regtry(prog, s)))
1162                         goto got_it;
1163                     s++;
1164                 }
1165             }
1166             if ((!prog->minlen && !tmp) && (norun || regtry(prog, s)))
1167                 goto got_it;
1168             break;
1169         case ALNUM:
1170             if (do_utf8) {
1171                 LOAD_UTF8_CHARCLASS(alnum,"a");
1172                 while (s < strend) {
1173                     if (swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1174                         if (tmp && (norun || regtry(prog, s)))
1175                             goto got_it;
1176                         else
1177                             tmp = doevery;
1178                     }
1179                     else
1180                         tmp = 1;
1181                     s += UTF8SKIP(s);
1182                 }
1183             }
1184             else {
1185                 while (s < strend) {
1186                     if (isALNUM(*s)) {
1187                         if (tmp && (norun || regtry(prog, s)))
1188                             goto got_it;
1189                         else
1190                             tmp = doevery;
1191                     }
1192                     else
1193                         tmp = 1;
1194                     s++;
1195                 }
1196             }
1197             break;
1198         case ALNUML:
1199             PL_reg_flags |= RF_tainted;
1200             if (do_utf8) {
1201                 while (s < strend) {
1202                     if (isALNUM_LC_utf8((U8*)s)) {
1203                         if (tmp && (norun || regtry(prog, s)))
1204                             goto got_it;
1205                         else
1206                             tmp = doevery;
1207                     }
1208                     else
1209                         tmp = 1;
1210                     s += UTF8SKIP(s);
1211                 }
1212             }
1213             else {
1214                 while (s < strend) {
1215                     if (isALNUM_LC(*s)) {
1216                         if (tmp && (norun || regtry(prog, s)))
1217                             goto got_it;
1218                         else
1219                             tmp = doevery;
1220                     }
1221                     else
1222                         tmp = 1;
1223                     s++;
1224                 }
1225             }
1226             break;
1227         case NALNUM:
1228             if (do_utf8) {
1229                 LOAD_UTF8_CHARCLASS(alnum,"a");
1230                 while (s < strend) {
1231                     if (!swash_fetch(PL_utf8_alnum, (U8*)s, do_utf8)) {
1232                         if (tmp && (norun || regtry(prog, s)))
1233                             goto got_it;
1234                         else
1235                             tmp = doevery;
1236                     }
1237                     else
1238                         tmp = 1;
1239                     s += UTF8SKIP(s);
1240                 }
1241             }
1242             else {
1243                 while (s < strend) {
1244                     if (!isALNUM(*s)) {
1245                         if (tmp && (norun || regtry(prog, s)))
1246                             goto got_it;
1247                         else
1248                             tmp = doevery;
1249                     }
1250                     else
1251                         tmp = 1;
1252                     s++;
1253                 }
1254             }
1255             break;
1256         case NALNUML:
1257             PL_reg_flags |= RF_tainted;
1258             if (do_utf8) {
1259                 while (s < strend) {
1260                     if (!isALNUM_LC_utf8((U8*)s)) {
1261                         if (tmp && (norun || regtry(prog, s)))
1262                             goto got_it;
1263                         else
1264                             tmp = doevery;
1265                     }
1266                     else
1267                         tmp = 1;
1268                     s += UTF8SKIP(s);
1269                 }
1270             }
1271             else {
1272                 while (s < strend) {
1273                     if (!isALNUM_LC(*s)) {
1274                         if (tmp && (norun || regtry(prog, s)))
1275                             goto got_it;
1276                         else
1277                             tmp = doevery;
1278                     }
1279                     else
1280                         tmp = 1;
1281                     s++;
1282                 }
1283             }
1284             break;
1285         case SPACE:
1286             if (do_utf8) {
1287                 LOAD_UTF8_CHARCLASS(space," ");
1288                 while (s < strend) {
1289                     if (*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8)) {
1290                         if (tmp && (norun || regtry(prog, s)))
1291                             goto got_it;
1292                         else
1293                             tmp = doevery;
1294                     }
1295                     else
1296                         tmp = 1;
1297                     s += UTF8SKIP(s);
1298                 }
1299             }
1300             else {
1301                 while (s < strend) {
1302                     if (isSPACE(*s)) {
1303                         if (tmp && (norun || regtry(prog, s)))
1304                             goto got_it;
1305                         else
1306                             tmp = doevery;
1307                     }
1308                     else
1309                         tmp = 1;
1310                     s++;
1311                 }
1312             }
1313             break;
1314         case SPACEL:
1315             PL_reg_flags |= RF_tainted;
1316             if (do_utf8) {
1317                 while (s < strend) {
1318                     if (*s == ' ' || isSPACE_LC_utf8((U8*)s)) {
1319                         if (tmp && (norun || regtry(prog, s)))
1320                             goto got_it;
1321                         else
1322                             tmp = doevery;
1323                     }
1324                     else
1325                         tmp = 1;
1326                     s += UTF8SKIP(s);
1327                 }
1328             }
1329             else {
1330                 while (s < strend) {
1331                     if (isSPACE_LC(*s)) {
1332                         if (tmp && (norun || regtry(prog, s)))
1333                             goto got_it;
1334                         else
1335                             tmp = doevery;
1336                     }
1337                     else
1338                         tmp = 1;
1339                     s++;
1340                 }
1341             }
1342             break;
1343         case NSPACE:
1344             if (do_utf8) {
1345                 LOAD_UTF8_CHARCLASS(space," ");
1346                 while (s < strend) {
1347                     if (!(*s == ' ' || swash_fetch(PL_utf8_space,(U8*)s, do_utf8))) {
1348                         if (tmp && (norun || regtry(prog, s)))
1349                             goto got_it;
1350                         else
1351                             tmp = doevery;
1352                     }
1353                     else
1354                         tmp = 1;
1355                     s += UTF8SKIP(s);
1356                 }
1357             }
1358             else {
1359                 while (s < strend) {
1360                     if (!isSPACE(*s)) {
1361                         if (tmp && (norun || regtry(prog, s)))
1362                             goto got_it;
1363                         else
1364                             tmp = doevery;
1365                     }
1366                     else
1367                         tmp = 1;
1368                     s++;
1369                 }
1370             }
1371             break;
1372         case NSPACEL:
1373             PL_reg_flags |= RF_tainted;
1374             if (do_utf8) {
1375                 while (s < strend) {
1376                     if (!(*s == ' ' || isSPACE_LC_utf8((U8*)s))) {
1377                         if (tmp && (norun || regtry(prog, s)))
1378                             goto got_it;
1379                         else
1380                             tmp = doevery;
1381                     }
1382                     else
1383                         tmp = 1;
1384                     s += UTF8SKIP(s);
1385                 }
1386             }
1387             else {
1388                 while (s < strend) {
1389                     if (!isSPACE_LC(*s)) {
1390                         if (tmp && (norun || regtry(prog, s)))
1391                             goto got_it;
1392                         else
1393                             tmp = doevery;
1394                     }
1395                     else
1396                         tmp = 1;
1397                     s++;
1398                 }
1399             }
1400             break;
1401         case DIGIT:
1402             if (do_utf8) {
1403                 LOAD_UTF8_CHARCLASS(digit,"0");
1404                 while (s < strend) {
1405                     if (swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1406                         if (tmp && (norun || regtry(prog, s)))
1407                             goto got_it;
1408                         else
1409                             tmp = doevery;
1410                     }
1411                     else
1412                         tmp = 1;
1413                     s += UTF8SKIP(s);
1414                 }
1415             }
1416             else {
1417                 while (s < strend) {
1418                     if (isDIGIT(*s)) {
1419                         if (tmp && (norun || regtry(prog, s)))
1420                             goto got_it;
1421                         else
1422                             tmp = doevery;
1423                     }
1424                     else
1425                         tmp = 1;
1426                     s++;
1427                 }
1428             }
1429             break;
1430         case DIGITL:
1431             PL_reg_flags |= RF_tainted;
1432             if (do_utf8) {
1433                 while (s < strend) {
1434                     if (isDIGIT_LC_utf8((U8*)s)) {
1435                         if (tmp && (norun || regtry(prog, s)))
1436                             goto got_it;
1437                         else
1438                             tmp = doevery;
1439                     }
1440                     else
1441                         tmp = 1;
1442                     s += UTF8SKIP(s);
1443                 }
1444             }
1445             else {
1446                 while (s < strend) {
1447                     if (isDIGIT_LC(*s)) {
1448                         if (tmp && (norun || regtry(prog, s)))
1449                             goto got_it;
1450                         else
1451                             tmp = doevery;
1452                     }
1453                     else
1454                         tmp = 1;
1455                     s++;
1456                 }
1457             }
1458             break;
1459         case NDIGIT:
1460             if (do_utf8) {
1461                 LOAD_UTF8_CHARCLASS(digit,"0");
1462                 while (s < strend) {
1463                     if (!swash_fetch(PL_utf8_digit,(U8*)s, do_utf8)) {
1464                         if (tmp && (norun || regtry(prog, s)))
1465                             goto got_it;
1466                         else
1467                             tmp = doevery;
1468                     }
1469                     else
1470                         tmp = 1;
1471                     s += UTF8SKIP(s);
1472                 }
1473             }
1474             else {
1475                 while (s < strend) {
1476                     if (!isDIGIT(*s)) {
1477                         if (tmp && (norun || regtry(prog, s)))
1478                             goto got_it;
1479                         else
1480                             tmp = doevery;
1481                     }
1482                     else
1483                         tmp = 1;
1484                     s++;
1485                 }
1486             }
1487             break;
1488         case NDIGITL:
1489             PL_reg_flags |= RF_tainted;
1490             if (do_utf8) {
1491                 while (s < strend) {
1492                     if (!isDIGIT_LC_utf8((U8*)s)) {
1493                         if (tmp && (norun || regtry(prog, s)))
1494                             goto got_it;
1495                         else
1496                             tmp = doevery;
1497                     }
1498                     else
1499                         tmp = 1;
1500                     s += UTF8SKIP(s);
1501                 }
1502             }
1503             else {
1504                 while (s < strend) {
1505                     if (!isDIGIT_LC(*s)) {
1506                         if (tmp && (norun || regtry(prog, s)))
1507                             goto got_it;
1508                         else
1509                             tmp = doevery;
1510                     }
1511                     else
1512                         tmp = 1;
1513                     s++;
1514                 }
1515             }
1516             break;
1517         default:
1518             Perl_croak(aTHX_ "panic: unknown regstclass %d", (int)OP(c));
1519             break;
1520         }
1521         return 0;
1522       got_it:
1523         return s;
1524 }
1525
1526 /*
1527  - regexec_flags - match a regexp against a string
1528  */
1529 I32
1530 Perl_regexec_flags(pTHX_ register regexp *prog, char *stringarg, register char *strend,
1531               char *strbeg, I32 minend, SV *sv, void *data, U32 flags)
1532 /* strend: pointer to null at end of string */
1533 /* strbeg: real beginning of string */
1534 /* minend: end of match must be >=minend after stringarg. */
1535 /* data: May be used for some additional optimizations. */
1536 /* nosave: For optimizations. */
1537 {
1538     register char *s;
1539     register regnode *c;
1540     register char *startpos = stringarg;
1541     I32 minlen;         /* must match at least this many chars */
1542     I32 dontbother = 0; /* how many characters not to try at end */
1543     /* I32 start_shift = 0; */          /* Offset of the start to find
1544                                          constant substr. */            /* CC */
1545     I32 end_shift = 0;                  /* Same for the end. */         /* CC */
1546     I32 scream_pos = -1;                /* Internal iterator of scream. */
1547     char *scream_olds;
1548     SV* oreplsv = GvSV(PL_replgv);
1549     bool do_utf8 = DO_UTF8(sv);
1550 #ifdef DEBUGGING
1551     SV *dsv = PERL_DEBUG_PAD_ZERO(0);
1552 #endif
1553
1554     PL_regcc = 0;
1555
1556     cache_re(prog);
1557 #ifdef DEBUGGING
1558     PL_regnarrate = DEBUG_r_TEST;
1559 #endif
1560
1561     /* Be paranoid... */
1562     if (prog == NULL || startpos == NULL) {
1563         Perl_croak(aTHX_ "NULL regexp parameter");
1564         return 0;
1565     }
1566
1567     minlen = prog->minlen;
1568     if (strend - startpos < minlen) {
1569         DEBUG_r(PerlIO_printf(Perl_debug_log,
1570                               "String too short [regexec_flags]...\n"));
1571         goto phooey;
1572     }
1573
1574     /* Check validity of program. */
1575     if (UCHARAT(prog->program) != REG_MAGIC) {
1576         Perl_croak(aTHX_ "corrupted regexp program");
1577     }
1578
1579     PL_reg_flags = 0;
1580     PL_reg_eval_set = 0;
1581     PL_reg_maxiter = 0;
1582
1583     if (prog->reganch & ROPT_UTF8)
1584         PL_reg_flags |= RF_utf8;
1585
1586     /* Mark beginning of line for ^ and lookbehind. */
1587     PL_regbol = startpos;
1588     PL_bostr  = strbeg;
1589     PL_reg_sv = sv;
1590
1591     /* Mark end of line for $ (and such) */
1592     PL_regeol = strend;
1593
1594     /* see how far we have to get to not match where we matched before */
1595     PL_regtill = startpos+minend;
1596
1597     /* We start without call_cc context.  */
1598     PL_reg_call_cc = 0;
1599
1600     /* If there is a "must appear" string, look for it. */
1601     s = startpos;
1602
1603     if (prog->reganch & ROPT_GPOS_SEEN) { /* Need to have PL_reg_ganch */
1604         MAGIC *mg;
1605
1606         if (flags & REXEC_IGNOREPOS)    /* Means: check only at start */
1607             PL_reg_ganch = startpos;
1608         else if (sv && SvTYPE(sv) >= SVt_PVMG
1609                   && SvMAGIC(sv)
1610                   && (mg = mg_find(sv, PERL_MAGIC_regex_global))
1611                   && mg->mg_len >= 0) {
1612             PL_reg_ganch = strbeg + mg->mg_len; /* Defined pos() */
1613             if (prog->reganch & ROPT_ANCH_GPOS) {
1614                 if (s > PL_reg_ganch)
1615                     goto phooey;
1616                 s = PL_reg_ganch;
1617             }
1618         }
1619         else                            /* pos() not defined */
1620             PL_reg_ganch = strbeg;
1621     }
1622
1623     if (do_utf8 == (UTF!=0) &&
1624         !(flags & REXEC_CHECKED) && prog->check_substr != Nullsv) {
1625         re_scream_pos_data d;
1626
1627         d.scream_olds = &scream_olds;
1628         d.scream_pos = &scream_pos;
1629         s = re_intuit_start(prog, sv, s, strend, flags, &d);
1630         if (!s) {
1631             DEBUG_r(PerlIO_printf(Perl_debug_log, "Not present...\n"));
1632             goto phooey;        /* not present */
1633         }
1634     }
1635
1636     DEBUG_r({
1637          char *s   = do_utf8 ? sv_uni_display(dsv, sv, 60, 0) : startpos;
1638          int   len = do_utf8 ? strlen(s) : strend - startpos;
1639          if (!PL_colorset)
1640              reginitcolors();
1641          PerlIO_printf(Perl_debug_log,
1642                        "%sMatching REx%s `%s%.60s%s%s' against `%s%.*s%s%s'\n",
1643                        PL_colors[4],PL_colors[5],PL_colors[0],
1644                        prog->precomp,
1645                        PL_colors[1],
1646                        (strlen(prog->precomp) > 60 ? "..." : ""),
1647                        PL_colors[0],
1648                        (int)(len > 60 ? 60 : len),
1649                        s, PL_colors[1],
1650                        (len > 60 ? "..." : "")
1651               );
1652     });
1653
1654     /* Simplest case:  anchored match need be tried only once. */
1655     /*  [unless only anchor is BOL and multiline is set] */
1656     if (prog->reganch & (ROPT_ANCH & ~ROPT_ANCH_GPOS)) {
1657         if (s == startpos && regtry(prog, startpos))
1658             goto got_it;
1659         else if (PL_multiline || (prog->reganch & ROPT_IMPLICIT)
1660                  || (prog->reganch & ROPT_ANCH_MBOL)) /* XXXX SBOL? */
1661         {
1662             char *end;
1663
1664             if (minlen)
1665                 dontbother = minlen - 1;
1666             end = HOP3c(strend, -dontbother, strbeg) - 1;
1667             /* for multiline we only have to try after newlines */
1668             if (prog->check_substr) {
1669                 if (s == startpos)
1670                     goto after_try;
1671                 while (1) {
1672                     if (regtry(prog, s))
1673                         goto got_it;
1674                   after_try:
1675                     if (s >= end)
1676                         goto phooey;
1677                     if (prog->reganch & RE_USE_INTUIT) {
1678                         s = re_intuit_start(prog, sv, s + 1, strend, flags, NULL);
1679                         if (!s)
1680                             goto phooey;
1681                     }
1682                     else
1683                         s++;
1684                 }               
1685             } else {
1686                 if (s > startpos)
1687                     s--;
1688                 while (s < end) {
1689                     if (*s++ == '\n') { /* don't need PL_utf8skip here */
1690                         if (regtry(prog, s))
1691                             goto got_it;
1692                     }
1693                 }               
1694             }
1695         }
1696         goto phooey;
1697     } else if (prog->reganch & ROPT_ANCH_GPOS) {
1698         if (regtry(prog, PL_reg_ganch))
1699             goto got_it;
1700         goto phooey;
1701     }
1702
1703     /* Messy cases:  unanchored match. */
1704     if (prog->anchored_substr && prog->reganch & ROPT_SKIP) {
1705         /* we have /x+whatever/ */
1706         /* it must be a one character string (XXXX Except UTF?) */
1707         char ch = SvPVX(prog->anchored_substr)[0];
1708 #ifdef DEBUGGING
1709         int did_match = 0;
1710 #endif
1711
1712         if (do_utf8) {
1713             while (s < strend) {
1714                 if (*s == ch) {
1715                     DEBUG_r( did_match = 1 );
1716                     if (regtry(prog, s)) goto got_it;
1717                     s += UTF8SKIP(s);
1718                     while (s < strend && *s == ch)
1719                         s += UTF8SKIP(s);
1720                 }
1721                 s += UTF8SKIP(s);
1722             }
1723         }
1724         else {
1725             while (s < strend) {
1726                 if (*s == ch) {
1727                     DEBUG_r( did_match = 1 );
1728                     if (regtry(prog, s)) goto got_it;
1729                     s++;
1730                     while (s < strend && *s == ch)
1731                         s++;
1732                 }
1733                 s++;
1734             }
1735         }
1736         DEBUG_r(if (!did_match)
1737                 PerlIO_printf(Perl_debug_log,
1738                                   "Did not find anchored character...\n")
1739                );
1740     }
1741     /*SUPPRESS 560*/
1742     else if (do_utf8 == (UTF!=0) &&
1743              (prog->anchored_substr != Nullsv
1744               || (prog->float_substr != Nullsv
1745                   && prog->float_max_offset < strend - s))) {
1746         SV *must = prog->anchored_substr
1747             ? prog->anchored_substr : prog->float_substr;
1748         I32 back_max =
1749             prog->anchored_substr ? prog->anchored_offset : prog->float_max_offset;
1750         I32 back_min =
1751             prog->anchored_substr ? prog->anchored_offset : prog->float_min_offset;
1752         char *last = HOP3c(strend,      /* Cannot start after this */
1753                           -(I32)(CHR_SVLEN(must)
1754                                  - (SvTAIL(must) != 0) + back_min), strbeg);
1755         char *last1;            /* Last position checked before */
1756 #ifdef DEBUGGING
1757         int did_match = 0;
1758 #endif
1759
1760         if (s > PL_bostr)
1761             last1 = HOPc(s, -1);
1762         else
1763             last1 = s - 1;      /* bogus */
1764
1765         /* XXXX check_substr already used to find `s', can optimize if
1766            check_substr==must. */
1767         scream_pos = -1;
1768         dontbother = end_shift;
1769         strend = HOPc(strend, -dontbother);
1770         while ( (s <= last) &&
1771                 ((flags & REXEC_SCREAM)
1772                  ? (s = screaminstr(sv, must, HOP3c(s, back_min, strend) - strbeg,
1773                                     end_shift, &scream_pos, 0))
1774                  : (s = fbm_instr((unsigned char*)HOP3(s, back_min, strend),
1775                                   (unsigned char*)strend, must,
1776                                   PL_multiline ? FBMrf_MULTILINE : 0))) ) {
1777             DEBUG_r( did_match = 1 );
1778             if (HOPc(s, -back_max) > last1) {
1779                 last1 = HOPc(s, -back_min);
1780                 s = HOPc(s, -back_max);
1781             }
1782             else {
1783                 char *t = (last1 >= PL_bostr) ? HOPc(last1, 1) : last1 + 1;
1784
1785                 last1 = HOPc(s, -back_min);
1786                 s = t;          
1787             }
1788             if (do_utf8) {
1789                 while (s <= last1) {
1790                     if (regtry(prog, s))
1791                         goto got_it;
1792                     s += UTF8SKIP(s);
1793                 }
1794             }
1795             else {
1796                 while (s <= last1) {
1797                     if (regtry(prog, s))
1798                         goto got_it;
1799                     s++;
1800                 }
1801             }
1802         }
1803         DEBUG_r(if (!did_match)
1804                     PerlIO_printf(Perl_debug_log, 
1805                                   "Did not find %s substr `%s%.*s%s'%s...\n",
1806                               ((must == prog->anchored_substr)
1807                                ? "anchored" : "floating"),
1808                               PL_colors[0],
1809                               (int)(SvCUR(must) - (SvTAIL(must)!=0)),
1810                               SvPVX(must),
1811                                   PL_colors[1], (SvTAIL(must) ? "$" : ""))
1812                );
1813         goto phooey;
1814     }
1815     else if ((c = prog->regstclass)) {
1816         if (minlen && PL_regkind[(U8)OP(prog->regstclass)] != EXACT)
1817             /* don't bother with what can't match */
1818             strend = HOPc(strend, -(minlen - 1));
1819         DEBUG_r({
1820             SV *prop = sv_newmortal();
1821             regprop(prop, c);
1822             PerlIO_printf(Perl_debug_log, "Matching stclass `%s' against `%s'\n", SvPVX(prop), UTF ? sv_uni_display(dsv, sv, 60, 0) : s);
1823         });
1824         if (find_byclass(prog, c, s, strend, startpos, 0))
1825             goto got_it;
1826         DEBUG_r(PerlIO_printf(Perl_debug_log, "Contradicts stclass...\n"));
1827     }
1828     else {
1829         dontbother = 0;
1830         if (prog->float_substr != Nullsv) {     /* Trim the end. */
1831             char *last;
1832
1833             if (flags & REXEC_SCREAM) {
1834                 last = screaminstr(sv, prog->float_substr, s - strbeg,
1835                                    end_shift, &scream_pos, 1); /* last one */
1836                 if (!last)
1837                     last = scream_olds; /* Only one occurrence. */
1838             }
1839             else {
1840                 STRLEN len;
1841                 char *little = SvPV(prog->float_substr, len);
1842
1843                 if (SvTAIL(prog->float_substr)) {
1844                     if (memEQ(strend - len + 1, little, len - 1))
1845                         last = strend - len + 1;
1846                     else if (!PL_multiline)
1847                         last = memEQ(strend - len, little, len)
1848                             ? strend - len : Nullch;
1849                     else
1850                         goto find_last;
1851                 } else {
1852                   find_last:
1853                     if (len)
1854                         last = rninstr(s, strend, little, little + len);
1855                     else
1856                         last = strend;  /* matching `$' */
1857                 }
1858             }
1859             if (last == NULL) {
1860                 DEBUG_r(PerlIO_printf(Perl_debug_log,
1861                                       "%sCan't trim the tail, match fails (should not happen)%s\n",
1862                                       PL_colors[4],PL_colors[5]));
1863                 goto phooey; /* Should not happen! */
1864             }
1865             dontbother = strend - last + prog->float_min_offset;
1866         }
1867         if (minlen && (dontbother < minlen))
1868             dontbother = minlen - 1;
1869         strend -= dontbother;              /* this one's always in bytes! */
1870         /* We don't know much -- general case. */
1871         if (do_utf8) {
1872             for (;;) {
1873                 if (regtry(prog, s))
1874                     goto got_it;
1875                 if (s >= strend)
1876                     break;
1877                 s += UTF8SKIP(s);
1878             };
1879         }
1880         else {
1881             do {
1882                 if (regtry(prog, s))
1883                     goto got_it;
1884             } while (s++ < strend);
1885         }
1886     }
1887
1888     /* Failure. */
1889     goto phooey;
1890
1891 got_it:
1892     RX_MATCH_TAINTED_set(prog, PL_reg_flags & RF_tainted);
1893
1894     if (PL_reg_eval_set) {
1895         /* Preserve the current value of $^R */
1896         if (oreplsv != GvSV(PL_replgv))
1897             sv_setsv(oreplsv, GvSV(PL_replgv));/* So that when GvSV(replgv) is
1898                                                   restored, the value remains
1899                                                   the same. */
1900         restore_pos(aTHX_ 0);
1901     }
1902
1903     /* make sure $`, $&, $', and $digit will work later */
1904     if ( !(flags & REXEC_NOT_FIRST) ) {
1905         if (RX_MATCH_COPIED(prog)) {
1906             Safefree(prog->subbeg);
1907             RX_MATCH_COPIED_off(prog);
1908         }
1909         if (flags & REXEC_COPY_STR) {
1910             I32 i = PL_regeol - startpos + (stringarg - strbeg);
1911
1912             s = savepvn(strbeg, i);
1913             prog->subbeg = s;
1914             prog->sublen = i;
1915             RX_MATCH_COPIED_on(prog);
1916         }
1917         else {
1918             prog->subbeg = strbeg;
1919             prog->sublen = PL_regeol - strbeg;  /* strend may have been modified */
1920         }
1921     }
1922
1923     return 1;
1924
1925 phooey:
1926     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch failed%s\n",
1927                           PL_colors[4],PL_colors[5]));
1928     if (PL_reg_eval_set)
1929         restore_pos(aTHX_ 0);
1930     return 0;
1931 }
1932
1933 /*
1934  - regtry - try match at specific point
1935  */
1936 STATIC I32                      /* 0 failure, 1 success */
1937 S_regtry(pTHX_ regexp *prog, char *startpos)
1938 {
1939     register I32 i;
1940     register I32 *sp;
1941     register I32 *ep;
1942     CHECKPOINT lastcp;
1943
1944 #ifdef DEBUGGING
1945     PL_regindent = 0;   /* XXXX Not good when matches are reenterable... */
1946 #endif
1947     if ((prog->reganch & ROPT_EVAL_SEEN) && !PL_reg_eval_set) {
1948         MAGIC *mg;
1949
1950         PL_reg_eval_set = RS_init;
1951         DEBUG_r(DEBUG_s(
1952             PerlIO_printf(Perl_debug_log, "  setting stack tmpbase at %"IVdf"\n",
1953                           (IV)(PL_stack_sp - PL_stack_base));
1954             ));
1955         SAVEI32(cxstack[cxstack_ix].blk_oldsp);
1956         cxstack[cxstack_ix].blk_oldsp = PL_stack_sp - PL_stack_base;
1957         /* Otherwise OP_NEXTSTATE will free whatever on stack now.  */
1958         SAVETMPS;
1959         /* Apparently this is not needed, judging by wantarray. */
1960         /* SAVEI8(cxstack[cxstack_ix].blk_gimme);
1961            cxstack[cxstack_ix].blk_gimme = G_SCALAR; */
1962
1963         if (PL_reg_sv) {
1964             /* Make $_ available to executed code. */
1965             if (PL_reg_sv != DEFSV) {
1966                 /* SAVE_DEFSV does *not* suffice here for USE_5005THREADS */
1967                 SAVESPTR(DEFSV);
1968                 DEFSV = PL_reg_sv;
1969             }
1970         
1971             if (!(SvTYPE(PL_reg_sv) >= SVt_PVMG && SvMAGIC(PL_reg_sv)
1972                   && (mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global)))) {
1973                 /* prepare for quick setting of pos */
1974                 sv_magic(PL_reg_sv, (SV*)0,
1975                         PERL_MAGIC_regex_global, Nullch, 0);
1976                 mg = mg_find(PL_reg_sv, PERL_MAGIC_regex_global);
1977                 mg->mg_len = -1;
1978             }
1979             PL_reg_magic    = mg;
1980             PL_reg_oldpos   = mg->mg_len;
1981             SAVEDESTRUCTOR_X(restore_pos, 0);
1982         }
1983         if (!PL_reg_curpm) {
1984             Newz(22,PL_reg_curpm, 1, PMOP);
1985 #ifdef USE_ITHREADS
1986             {
1987                 SV* repointer = newSViv(0);
1988                 /* so we know which PL_regex_padav element is PL_reg_curpm */
1989                 SvFLAGS(repointer) |= SVf_BREAK;
1990                 av_push(PL_regex_padav,repointer);
1991                 PL_reg_curpm->op_pmoffset = av_len(PL_regex_padav);
1992                 PL_regex_pad = AvARRAY(PL_regex_padav);
1993             }
1994 #endif      
1995         }
1996         PM_SETRE(PL_reg_curpm, prog);
1997         PL_reg_oldcurpm = PL_curpm;
1998         PL_curpm = PL_reg_curpm;
1999         if (RX_MATCH_COPIED(prog)) {
2000             /*  Here is a serious problem: we cannot rewrite subbeg,
2001                 since it may be needed if this match fails.  Thus
2002                 $` inside (?{}) could fail... */
2003             PL_reg_oldsaved = prog->subbeg;
2004             PL_reg_oldsavedlen = prog->sublen;
2005             RX_MATCH_COPIED_off(prog);
2006         }
2007         else
2008             PL_reg_oldsaved = Nullch;
2009         prog->subbeg = PL_bostr;
2010         prog->sublen = PL_regeol - PL_bostr; /* strend may have been modified */
2011     }
2012     prog->startp[0] = startpos - PL_bostr;
2013     PL_reginput = startpos;
2014     PL_regstartp = prog->startp;
2015     PL_regendp = prog->endp;
2016     PL_reglastparen = &prog->lastparen;
2017     PL_reglastcloseparen = &prog->lastcloseparen;
2018     prog->lastparen = 0;
2019     PL_regsize = 0;
2020     DEBUG_r(PL_reg_starttry = startpos);
2021     if (PL_reg_start_tmpl <= prog->nparens) {
2022         PL_reg_start_tmpl = prog->nparens*3/2 + 3;
2023         if(PL_reg_start_tmp)
2024             Renew(PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2025         else
2026             New(22,PL_reg_start_tmp, PL_reg_start_tmpl, char*);
2027     }
2028
2029 #ifdef DEBUGGING
2030     sv_setpvn(PERL_DEBUG_PAD(0), "", 0);
2031     sv_setpvn(PERL_DEBUG_PAD(1), "", 0);
2032     sv_setpvn(PERL_DEBUG_PAD(2), "", 0);
2033 #endif
2034
2035     /* XXXX What this code is doing here?!!!  There should be no need
2036        to do this again and again, PL_reglastparen should take care of
2037        this!  --ilya*/
2038
2039     /* Tests pat.t#187 and split.t#{13,14} seem to depend on this code.
2040      * Actually, the code in regcppop() (which Ilya may be meaning by
2041      * PL_reglastparen), is not needed at all by the test suite
2042      * (op/regexp, op/pat, op/split), but that code is needed, oddly
2043      * enough, for building DynaLoader, or otherwise this
2044      * "Error: '*' not in typemap in DynaLoader.xs, line 164"
2045      * will happen.  Meanwhile, this code *is* needed for the
2046      * above-mentioned test suite tests to succeed.  The common theme
2047      * on those tests seems to be returning null fields from matches.
2048      * --jhi */
2049 #if 1
2050     sp = prog->startp;
2051     ep = prog->endp;
2052     if (prog->nparens) {
2053         for (i = prog->nparens; i > *PL_reglastparen; i--) {
2054             *++sp = -1;
2055             *++ep = -1;
2056         }
2057     }
2058 #endif
2059     REGCP_SET(lastcp);
2060     if (regmatch(prog->program + 1)) {
2061         prog->endp[0] = PL_reginput - PL_bostr;
2062         return 1;
2063     }
2064     REGCP_UNWIND(lastcp);
2065     return 0;
2066 }
2067
2068 #define RE_UNWIND_BRANCH        1
2069 #define RE_UNWIND_BRANCHJ       2
2070
2071 union re_unwind_t;
2072
2073 typedef struct {                /* XX: makes sense to enlarge it... */
2074     I32 type;
2075     I32 prev;
2076     CHECKPOINT lastcp;
2077 } re_unwind_generic_t;
2078
2079 typedef struct {
2080     I32 type;
2081     I32 prev;
2082     CHECKPOINT lastcp;
2083     I32 lastparen;
2084     regnode *next;
2085     char *locinput;
2086     I32 nextchr;
2087 #ifdef DEBUGGING
2088     int regindent;
2089 #endif
2090 } re_unwind_branch_t;
2091
2092 typedef union re_unwind_t {
2093     I32 type;
2094     re_unwind_generic_t generic;
2095     re_unwind_branch_t branch;
2096 } re_unwind_t;
2097
2098 #define sayYES goto yes
2099 #define sayNO goto no
2100 #define sayYES_FINAL goto yes_final
2101 #define sayYES_LOUD  goto yes_loud
2102 #define sayNO_FINAL  goto no_final
2103 #define sayNO_SILENT goto do_no
2104 #define saySAME(x) if (x) goto yes; else goto no
2105
2106 #define REPORT_CODE_OFF 24
2107
2108 /*
2109  - regmatch - main matching routine
2110  *
2111  * Conceptually the strategy is simple:  check to see whether the current
2112  * node matches, call self recursively to see whether the rest matches,
2113  * and then act accordingly.  In practice we make some effort to avoid
2114  * recursion, in particular by going through "ordinary" nodes (that don't
2115  * need to know whether the rest of the match failed) by a loop instead of
2116  * by recursion.
2117  */
2118 /* [lwall] I've hoisted the register declarations to the outer block in order to
2119  * maybe save a little bit of pushing and popping on the stack.  It also takes
2120  * advantage of machines that use a register save mask on subroutine entry.
2121  */
2122 STATIC I32                      /* 0 failure, 1 success */
2123 S_regmatch(pTHX_ regnode *prog)
2124 {
2125     register regnode *scan;     /* Current node. */
2126     regnode *next;              /* Next node. */
2127     regnode *inner;             /* Next node in internal branch. */
2128     register I32 nextchr;       /* renamed nextchr - nextchar colides with
2129                                    function of same name */
2130     register I32 n;             /* no or next */
2131     register I32 ln = 0;        /* len or last */
2132     register char *s = Nullch;  /* operand or save */
2133     register char *locinput = PL_reginput;
2134     register I32 c1 = 0, c2 = 0, paren; /* case fold search, parenth */
2135     int minmod = 0, sw = 0, logical = 0;
2136     I32 unwind = 0;
2137 #if 0
2138     I32 firstcp = PL_savestack_ix;
2139 #endif
2140     register bool do_utf8 = PL_reg_match_utf8;
2141 #ifdef DEBUGGING
2142     SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
2143     SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
2144     SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
2145 #endif
2146
2147 #ifdef DEBUGGING
2148     PL_regindent++;
2149 #endif
2150
2151     /* Note that nextchr is a byte even in UTF */
2152     nextchr = UCHARAT(locinput);
2153     scan = prog;
2154     while (scan != NULL) {
2155
2156         DEBUG_r( {
2157             SV *prop = sv_newmortal();
2158             int docolor = *PL_colors[0];
2159             int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
2160             int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
2161             /* The part of the string before starttry has one color
2162                (pref0_len chars), between starttry and current
2163                position another one (pref_len - pref0_len chars),
2164                after the current position the third one.
2165                We assume that pref0_len <= pref_len, otherwise we
2166                decrease pref0_len.  */
2167             int pref_len = (locinput - PL_bostr) > (5 + taill) - l
2168                 ? (5 + taill) - l : locinput - PL_bostr;
2169             int pref0_len;
2170
2171             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput - pref_len)))
2172                 pref_len++;
2173             pref0_len = pref_len  - (locinput - PL_reg_starttry);
2174             if (l + pref_len < (5 + taill) && l < PL_regeol - locinput)
2175                 l = ( PL_regeol - locinput > (5 + taill) - pref_len
2176                       ? (5 + taill) - pref_len : PL_regeol - locinput);
2177             while (do_utf8 && UTF8_IS_CONTINUATION(*(U8*)(locinput + l)))
2178                 l--;
2179             if (pref0_len < 0)
2180                 pref0_len = 0;
2181             if (pref0_len > pref_len)
2182                 pref0_len = pref_len;
2183             regprop(prop, scan);
2184             {
2185               char *s0 =
2186                 do_utf8 ?
2187                 pv_uni_display(dsv0, (U8*)(locinput - pref_len),
2188                                pref0_len, 60, 0) :
2189                 locinput - pref_len;
2190               int len0 = do_utf8 ? strlen(s0) : pref0_len;
2191               char *s1 = do_utf8 ?
2192                 pv_uni_display(dsv1, (U8*)(locinput - pref_len + pref0_len),
2193                                pref_len - pref0_len, 60, 0) :
2194                 locinput - pref_len + pref0_len;
2195               int len1 = do_utf8 ? strlen(s1) : pref_len - pref0_len;
2196               char *s2 = do_utf8 ?
2197                 pv_uni_display(dsv2, (U8*)locinput,
2198                                PL_regeol - locinput, 60, 0) :
2199                 locinput;
2200               int len2 = do_utf8 ? strlen(s2) : l;
2201               PerlIO_printf(Perl_debug_log,
2202                             "%4"IVdf" <%s%.*s%s%s%.*s%s%s%s%.*s%s>%*s|%3"IVdf":%*s%s\n",
2203                             (IV)(locinput - PL_bostr),
2204                             PL_colors[4],
2205                             len0, s0,
2206                             PL_colors[5],
2207                             PL_colors[2],
2208                             len1, s1,
2209                             PL_colors[3],
2210                             (docolor ? "" : "> <"),
2211                             PL_colors[0],
2212                             len2, s2,
2213                             PL_colors[1],
2214                             15 - l - pref_len + 1,
2215                             "",
2216                             (IV)(scan - PL_regprogram), PL_regindent*2, "",
2217                             SvPVX(prop));
2218             }
2219         });
2220
2221         next = scan + NEXT_OFF(scan);
2222         if (next == scan)
2223             next = NULL;
2224
2225         switch (OP(scan)) {
2226         case BOL:
2227             if (locinput == PL_bostr || (PL_multiline &&
2228                 (nextchr || locinput < PL_regeol) && locinput[-1] == '\n') )
2229             {
2230                 /* regtill = regbol; */
2231                 break;
2232             }
2233             sayNO;
2234         case MBOL:
2235             if (locinput == PL_bostr ||
2236                 ((nextchr || locinput < PL_regeol) && locinput[-1] == '\n'))
2237             {
2238                 break;
2239             }
2240             sayNO;
2241         case SBOL:
2242             if (locinput == PL_bostr)
2243                 break;
2244             sayNO;
2245         case GPOS:
2246             if (locinput == PL_reg_ganch)
2247                 break;
2248             sayNO;
2249         case EOL:
2250             if (PL_multiline)
2251                 goto meol;
2252             else
2253                 goto seol;
2254         case MEOL:
2255           meol:
2256             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2257                 sayNO;
2258             break;
2259         case SEOL:
2260           seol:
2261             if ((nextchr || locinput < PL_regeol) && nextchr != '\n')
2262                 sayNO;
2263             if (PL_regeol - locinput > 1)
2264                 sayNO;
2265             break;
2266         case EOS:
2267             if (PL_regeol != locinput)
2268                 sayNO;
2269             break;
2270         case SANY:
2271             if (!nextchr && locinput >= PL_regeol)
2272                 sayNO;
2273             if (do_utf8) {
2274                 locinput += PL_utf8skip[nextchr];
2275                 if (locinput > PL_regeol)
2276                     sayNO;
2277                 nextchr = UCHARAT(locinput);
2278             }
2279             else
2280                 nextchr = UCHARAT(++locinput);
2281             break;
2282         case CANY:
2283             if (!nextchr && locinput >= PL_regeol)
2284                 sayNO;
2285             nextchr = UCHARAT(++locinput);
2286             break;
2287         case REG_ANY:
2288             if ((!nextchr && locinput >= PL_regeol) || nextchr == '\n')
2289                 sayNO;
2290             if (do_utf8) {
2291                 locinput += PL_utf8skip[nextchr];
2292                 if (locinput > PL_regeol)
2293                     sayNO;
2294                 nextchr = UCHARAT(locinput);
2295             }
2296             else
2297                 nextchr = UCHARAT(++locinput);
2298             break;
2299         case EXACT:
2300             s = STRING(scan);
2301             ln = STR_LEN(scan);
2302             if (do_utf8 != (UTF!=0)) {
2303                 /* The target and the pattern have differing utf8ness. */
2304                 char *l = locinput;
2305                 char *e = s + ln;
2306                 STRLEN ulen;
2307
2308                 if (do_utf8) {
2309                     /* The target is utf8, the pattern is not utf8. */
2310                     while (s < e) {
2311                         if (l >= PL_regeol)
2312                              sayNO;
2313                         if (NATIVE_TO_UNI(*(U8*)s) !=
2314                             utf8_to_uvchr((U8*)l, &ulen))
2315                              sayNO;
2316                         l += ulen;
2317                         s ++;
2318                     }
2319                 }
2320                 else {
2321                     /* The target is not utf8, the pattern is utf8. */
2322                     while (s < e) {
2323                         if (l >= PL_regeol)
2324                             sayNO;
2325                         if (NATIVE_TO_UNI(*((U8*)l)) !=
2326                             utf8_to_uvchr((U8*)s, &ulen))
2327                             sayNO;
2328                         s += ulen;
2329                         l ++;
2330                     }
2331                 }
2332                 locinput = l;
2333                 nextchr = UCHARAT(locinput);
2334                 break;
2335             }
2336             /* The target and the pattern have the same utf8ness. */
2337             /* Inline the first character, for speed. */
2338             if (UCHARAT(s) != nextchr)
2339                 sayNO;
2340             if (PL_regeol - locinput < ln)
2341                 sayNO;
2342             if (ln > 1 && memNE(s, locinput, ln))
2343                 sayNO;
2344             locinput += ln;
2345             nextchr = UCHARAT(locinput);
2346             break;
2347         case EXACTFL:
2348             PL_reg_flags |= RF_tainted;
2349             /* FALL THROUGH */
2350         case EXACTF:
2351             s = STRING(scan);
2352             ln = STR_LEN(scan);
2353
2354             {
2355                 char *l = locinput;
2356                 char *e = s + ln;
2357
2358                 if (do_utf8 != (UTF!=0)) {
2359                      /* The target and the pattern have differing utf8ness. */
2360                      STRLEN ulen1, ulen2;
2361                      UV cs, cl;
2362
2363                      if (do_utf8) {
2364                           /* The target is utf8, the pattern is not utf8. */
2365                           while (s < e) {
2366                                if (l >= PL_regeol)
2367                                     sayNO;
2368
2369                                cs = to_uni_fold(NATIVE_TO_UNI(*(U8*)s),
2370                                                 (U8*)s, &ulen1);
2371                                cl = utf8_to_uvchr((U8*)l, &ulen2);
2372
2373                                if (cs != cl) {
2374                                     cl = to_uni_fold(cl, (U8*)l, &ulen2);
2375                                     if (ulen1 != ulen2 || cs != cl)
2376                                          sayNO;
2377                                }
2378                                l += ulen1;
2379                                s ++;
2380                           }
2381                      }
2382                      else {
2383                           /* The target is not utf8, the pattern is utf8. */
2384                           while (s < e) {
2385                                if (l >= PL_regeol)
2386                                     sayNO;
2387
2388                                cs = utf8_to_uvchr((U8*)s, &ulen1);
2389
2390                                cl = to_uni_fold(NATIVE_TO_UNI(*(U8*)l),
2391                                                 (U8*)l, &ulen2);
2392
2393                                if (cs != cl) {
2394                                     cs = to_uni_fold(cs, (U8*)s, &ulen1);
2395                                     if (ulen1 != ulen2 || cs != cl)
2396                                          sayNO;
2397                                }
2398                                l ++;
2399                                s += ulen1;
2400                           }
2401                      }
2402                      locinput = l;
2403                      nextchr = UCHARAT(locinput);
2404                      break;
2405                 }
2406
2407                 if (do_utf8 && UTF) {
2408                      /* Both the target and the pattern are utf8. */
2409                      U8 lfoldbuf[UTF8_MAXLEN_FOLD+1], *lf;
2410                      U8 sfoldbuf[UTF8_MAXLEN_FOLD+1], *sf;
2411                      STRLEN lfoldlen, sfoldlen;
2412                      STRLEN llen = 0;
2413                      STRLEN slen = 0;
2414
2415                      while (s < e) {
2416                           /* Fold them and walk them characterwise.  */
2417
2418                           if (llen == 0) {
2419                                to_utf8_fold((U8*)l, lfoldbuf, &lfoldlen);
2420                                lf   = lfoldbuf;
2421                                llen = lfoldlen;
2422                           }
2423
2424                           if (slen == 0) {
2425                                to_utf8_fold((U8*)s, sfoldbuf, &sfoldlen);
2426                                sf   = sfoldbuf;
2427                                slen = sfoldlen;
2428                           }
2429
2430                           while (llen && slen) {
2431                                if (UTF8SKIP(lf) != UTF8SKIP(sf) ||
2432                                    memNE((char*)lf, (char*)sf, UTF8SKIP(lf)))
2433                                     sayNO;
2434                                llen -= UTF8SKIP(lf);
2435                                lf   += UTF8SKIP(lf);
2436                                slen -= UTF8SKIP(sf);
2437                                sf   += UTF8SKIP(sf);
2438                           }
2439                           
2440                           l += UTF8SKIP(l);
2441                           s += UTF8SKIP(s);
2442                      }
2443                      locinput = l;
2444                      nextchr = UCHARAT(locinput);
2445                      break;
2446                 }
2447             }
2448
2449             /* Neither the target and the pattern are utf8. */
2450
2451             /* Inline the first character, for speed. */
2452             if (UCHARAT(s) != nextchr &&
2453                 UCHARAT(s) != ((OP(scan) == EXACTF)
2454                                ? PL_fold : PL_fold_locale)[nextchr])
2455                 sayNO;
2456             if (PL_regeol - locinput < ln)
2457                 sayNO;
2458             if (ln > 1 && (OP(scan) == EXACTF
2459                            ? ibcmp(s, locinput, ln)
2460                            : ibcmp_locale(s, locinput, ln)))
2461                 sayNO;
2462             locinput += ln;
2463             nextchr = UCHARAT(locinput);
2464             break;
2465         case ANYOF:
2466             if (do_utf8) {
2467                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2468                     sayNO;
2469                 if (locinput >= PL_regeol)
2470                     sayNO;
2471                 locinput += PL_utf8skip[nextchr];
2472                 nextchr = UCHARAT(locinput);
2473             }
2474             else {
2475                 if (nextchr < 0)
2476                     nextchr = UCHARAT(locinput);
2477                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2478                     sayNO;
2479                 if (!nextchr && locinput >= PL_regeol)
2480                     sayNO;
2481                 nextchr = UCHARAT(++locinput);
2482             }
2483             break;
2484         case ALNUML:
2485             PL_reg_flags |= RF_tainted;
2486             /* FALL THROUGH */
2487         case ALNUM:
2488             if (!nextchr)
2489                 sayNO;
2490             if (do_utf8) {
2491                 LOAD_UTF8_CHARCLASS(alnum,"a");
2492                 if (!(OP(scan) == ALNUM
2493                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2494                       : isALNUM_LC_utf8((U8*)locinput)))
2495                 {
2496                     sayNO;
2497                 }
2498                 locinput += PL_utf8skip[nextchr];
2499                 nextchr = UCHARAT(locinput);
2500                 break;
2501             }
2502             if (!(OP(scan) == ALNUM
2503                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2504                 sayNO;
2505             nextchr = UCHARAT(++locinput);
2506             break;
2507         case NALNUML:
2508             PL_reg_flags |= RF_tainted;
2509             /* FALL THROUGH */
2510         case NALNUM:
2511             if (!nextchr && locinput >= PL_regeol)
2512                 sayNO;
2513             if (do_utf8) {
2514                 LOAD_UTF8_CHARCLASS(alnum,"a");
2515                 if (OP(scan) == NALNUM
2516                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2517                     : isALNUM_LC_utf8((U8*)locinput))
2518                 {
2519                     sayNO;
2520                 }
2521                 locinput += PL_utf8skip[nextchr];
2522                 nextchr = UCHARAT(locinput);
2523                 break;
2524             }
2525             if (OP(scan) == NALNUM
2526                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2527                 sayNO;
2528             nextchr = UCHARAT(++locinput);
2529             break;
2530         case BOUNDL:
2531         case NBOUNDL:
2532             PL_reg_flags |= RF_tainted;
2533             /* FALL THROUGH */
2534         case BOUND:
2535         case NBOUND:
2536             /* was last char in word? */
2537             if (do_utf8) {
2538                 if (locinput == PL_bostr)
2539                     ln = '\n';
2540                 else {
2541                     U8 *r = reghop((U8*)locinput, -1);
2542                 
2543                     ln = utf8n_to_uvchr(r, s - (char*)r, 0, 0);
2544                 }
2545                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2546                     ln = isALNUM_uni(ln);
2547                     LOAD_UTF8_CHARCLASS(alnum,"a");
2548                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2549                 }
2550                 else {
2551                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2552                     n = isALNUM_LC_utf8((U8*)locinput);
2553                 }
2554             }
2555             else {
2556                 ln = (locinput != PL_bostr) ?
2557                     UCHARAT(locinput - 1) : '\n';
2558                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2559                     ln = isALNUM(ln);
2560                     n = isALNUM(nextchr);
2561                 }
2562                 else {
2563                     ln = isALNUM_LC(ln);
2564                     n = isALNUM_LC(nextchr);
2565                 }
2566             }
2567             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2568                                     OP(scan) == BOUNDL))
2569                     sayNO;
2570             break;
2571         case SPACEL:
2572             PL_reg_flags |= RF_tainted;
2573             /* FALL THROUGH */
2574         case SPACE:
2575             if (!nextchr)
2576                 sayNO;
2577             if (do_utf8) {
2578                 if (UTF8_IS_CONTINUED(nextchr)) {
2579                     LOAD_UTF8_CHARCLASS(space," ");
2580                     if (!(OP(scan) == SPACE
2581                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2582                           : isSPACE_LC_utf8((U8*)locinput)))
2583                     {
2584                         sayNO;
2585                     }
2586                     locinput += PL_utf8skip[nextchr];
2587                     nextchr = UCHARAT(locinput);
2588                     break;
2589                 }
2590                 if (!(OP(scan) == SPACE
2591                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2592                     sayNO;
2593                 nextchr = UCHARAT(++locinput);
2594             }
2595             else {
2596                 if (!(OP(scan) == SPACE
2597                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2598                     sayNO;
2599                 nextchr = UCHARAT(++locinput);
2600             }
2601             break;
2602         case NSPACEL:
2603             PL_reg_flags |= RF_tainted;
2604             /* FALL THROUGH */
2605         case NSPACE:
2606             if (!nextchr && locinput >= PL_regeol)
2607                 sayNO;
2608             if (do_utf8) {
2609                 LOAD_UTF8_CHARCLASS(space," ");
2610                 if (OP(scan) == NSPACE
2611                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2612                     : isSPACE_LC_utf8((U8*)locinput))
2613                 {
2614                     sayNO;
2615                 }
2616                 locinput += PL_utf8skip[nextchr];
2617                 nextchr = UCHARAT(locinput);
2618                 break;
2619             }
2620             if (OP(scan) == NSPACE
2621                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2622                 sayNO;
2623             nextchr = UCHARAT(++locinput);
2624             break;
2625         case DIGITL:
2626             PL_reg_flags |= RF_tainted;
2627             /* FALL THROUGH */
2628         case DIGIT:
2629             if (!nextchr)
2630                 sayNO;
2631             if (do_utf8) {
2632                 LOAD_UTF8_CHARCLASS(digit,"0");
2633                 if (!(OP(scan) == DIGIT
2634                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2635                       : isDIGIT_LC_utf8((U8*)locinput)))
2636                 {
2637                     sayNO;
2638                 }
2639                 locinput += PL_utf8skip[nextchr];
2640                 nextchr = UCHARAT(locinput);
2641                 break;
2642             }
2643             if (!(OP(scan) == DIGIT
2644                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2645                 sayNO;
2646             nextchr = UCHARAT(++locinput);
2647             break;
2648         case NDIGITL:
2649             PL_reg_flags |= RF_tainted;
2650             /* FALL THROUGH */
2651         case NDIGIT:
2652             if (!nextchr && locinput >= PL_regeol)
2653                 sayNO;
2654             if (do_utf8) {
2655                 LOAD_UTF8_CHARCLASS(digit,"0");
2656                 if (OP(scan) == NDIGIT
2657                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2658                     : isDIGIT_LC_utf8((U8*)locinput))
2659                 {
2660                     sayNO;
2661                 }
2662                 locinput += PL_utf8skip[nextchr];
2663                 nextchr = UCHARAT(locinput);
2664                 break;
2665             }
2666             if (OP(scan) == NDIGIT
2667                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2668                 sayNO;
2669             nextchr = UCHARAT(++locinput);
2670             break;
2671         case CLUMP:
2672             if (locinput >= PL_regeol)
2673                 sayNO;
2674             if  (do_utf8) {
2675                 LOAD_UTF8_CHARCLASS(mark,"~");
2676                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2677                     sayNO;
2678                 locinput += PL_utf8skip[nextchr];
2679                 while (locinput < PL_regeol &&
2680                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2681                     locinput += UTF8SKIP(locinput);
2682                 if (locinput > PL_regeol)
2683                     sayNO;
2684             } 
2685             else
2686                locinput++;
2687             nextchr = UCHARAT(locinput);
2688             break;
2689         case REFFL:
2690             PL_reg_flags |= RF_tainted;
2691             /* FALL THROUGH */
2692         case REF:
2693         case REFF:
2694             n = ARG(scan);  /* which paren pair */
2695             ln = PL_regstartp[n];
2696             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2697             if (*PL_reglastparen < n || ln == -1)
2698                 sayNO;                  /* Do not match unless seen CLOSEn. */
2699             if (ln == PL_regendp[n])
2700                 break;
2701
2702             s = PL_bostr + ln;
2703             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2704                 char *l = locinput;
2705                 char *e = PL_bostr + PL_regendp[n];
2706                 /*
2707                  * Note that we can't do the "other character" lookup trick as
2708                  * in the 8-bit case (no pun intended) because in Unicode we
2709                  * have to map both upper and title case to lower case.
2710                  */
2711                 if (OP(scan) == REFF) {
2712                     STRLEN ulen1, ulen2;
2713                     U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
2714                     U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
2715                     while (s < e) {
2716                         if (l >= PL_regeol)
2717                             sayNO;
2718                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2719                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2720                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2721                             sayNO;
2722                         s += ulen1;
2723                         l += ulen2;
2724                     }
2725                 }
2726                 locinput = l;
2727                 nextchr = UCHARAT(locinput);
2728                 break;
2729             }
2730
2731             /* Inline the first character, for speed. */
2732             if (UCHARAT(s) != nextchr &&
2733                 (OP(scan) == REF ||
2734                  (UCHARAT(s) != ((OP(scan) == REFF
2735                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2736                 sayNO;
2737             ln = PL_regendp[n] - ln;
2738             if (locinput + ln > PL_regeol)
2739                 sayNO;
2740             if (ln > 1 && (OP(scan) == REF
2741                            ? memNE(s, locinput, ln)
2742                            : (OP(scan) == REFF
2743                               ? ibcmp(s, locinput, ln)
2744                               : ibcmp_locale(s, locinput, ln))))
2745                 sayNO;
2746             locinput += ln;
2747             nextchr = UCHARAT(locinput);
2748             break;
2749
2750         case NOTHING:
2751         case TAIL:
2752             break;
2753         case BACK:
2754             break;
2755         case EVAL:
2756         {
2757             dSP;
2758             OP_4tree *oop = PL_op;
2759             COP *ocurcop = PL_curcop;
2760             SV **ocurpad = PL_curpad;
2761             SV *ret;
2762         
2763             n = ARG(scan);
2764             PL_op = (OP_4tree*)PL_regdata->data[n];
2765             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2766             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2767             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2768
2769             {
2770                 SV **before = SP;
2771                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2772                 SPAGAIN;
2773                 if (SP == before)
2774                     ret = Nullsv;   /* protect against empty (?{}) blocks. */
2775                 else {
2776                     ret = POPs;
2777                     PUTBACK;
2778                 }
2779             }
2780
2781             PL_op = oop;
2782             PL_curpad = ocurpad;
2783             PL_curcop = ocurcop;
2784             if (logical) {
2785                 if (logical == 2) {     /* Postponed subexpression. */
2786                     regexp *re;
2787                     MAGIC *mg = Null(MAGIC*);
2788                     re_cc_state state;
2789                     CHECKPOINT cp, lastcp;
2790
2791                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2792                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2793
2794                         if(SvMAGICAL(sv))
2795                             mg = mg_find(sv, PERL_MAGIC_qr);
2796                     }
2797                     if (mg) {
2798                         re = (regexp *)mg->mg_obj;
2799                         (void)ReREFCNT_inc(re);
2800                     }
2801                     else {
2802                         STRLEN len;
2803                         char *t = SvPV(ret, len);
2804                         PMOP pm;
2805                         char *oprecomp = PL_regprecomp;
2806                         I32 osize = PL_regsize;
2807                         I32 onpar = PL_regnpar;
2808
2809                         Zero(&pm, 1, PMOP);
2810                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2811                         if (!(SvFLAGS(ret)
2812                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2813                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2814                                         PERL_MAGIC_qr,0,0);
2815                         PL_regprecomp = oprecomp;
2816                         PL_regsize = osize;
2817                         PL_regnpar = onpar;
2818                     }
2819                     DEBUG_r(
2820                         PerlIO_printf(Perl_debug_log,
2821                                       "Entering embedded `%s%.60s%s%s'\n",
2822                                       PL_colors[0],
2823                                       re->precomp,
2824                                       PL_colors[1],
2825                                       (strlen(re->precomp) > 60 ? "..." : ""))
2826                         );
2827                     state.node = next;
2828                     state.prev = PL_reg_call_cc;
2829                     state.cc = PL_regcc;
2830                     state.re = PL_reg_re;
2831
2832                     PL_regcc = 0;
2833                 
2834                     cp = regcppush(0);  /* Save *all* the positions. */
2835                     REGCP_SET(lastcp);
2836                     cache_re(re);
2837                     state.ss = PL_savestack_ix;
2838                     *PL_reglastparen = 0;
2839                     *PL_reglastcloseparen = 0;
2840                     PL_reg_call_cc = &state;
2841                     PL_reginput = locinput;
2842
2843                     /* XXXX This is too dramatic a measure... */
2844                     PL_reg_maxiter = 0;
2845
2846                     if (regmatch(re->program + 1)) {
2847                         /* Even though we succeeded, we need to restore
2848                            global variables, since we may be wrapped inside
2849                            SUSPEND, thus the match may be not finished yet. */
2850
2851                         /* XXXX Do this only if SUSPENDed? */
2852                         PL_reg_call_cc = state.prev;
2853                         PL_regcc = state.cc;
2854                         PL_reg_re = state.re;
2855                         cache_re(PL_reg_re);
2856
2857                         /* XXXX This is too dramatic a measure... */
2858                         PL_reg_maxiter = 0;
2859
2860                         /* These are needed even if not SUSPEND. */
2861                         ReREFCNT_dec(re);
2862                         regcpblow(cp);
2863                         sayYES;
2864                     }
2865                     ReREFCNT_dec(re);
2866                     REGCP_UNWIND(lastcp);
2867                     regcppop();
2868                     PL_reg_call_cc = state.prev;
2869                     PL_regcc = state.cc;
2870                     PL_reg_re = state.re;
2871                     cache_re(PL_reg_re);
2872
2873                     /* XXXX This is too dramatic a measure... */
2874                     PL_reg_maxiter = 0;
2875
2876                     logical = 0;
2877                     sayNO;
2878                 }
2879                 sw = SvTRUE(ret);
2880                 logical = 0;
2881             }
2882             else
2883                 sv_setsv(save_scalar(PL_replgv), ret);
2884             break;
2885         }
2886         case OPEN:
2887             n = ARG(scan);  /* which paren pair */
2888             PL_reg_start_tmp[n] = locinput;
2889             if (n > PL_regsize)
2890                 PL_regsize = n;
2891             break;
2892         case CLOSE:
2893             n = ARG(scan);  /* which paren pair */
2894             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2895             PL_regendp[n] = locinput - PL_bostr;
2896             if (n > *PL_reglastparen)
2897                 *PL_reglastparen = n;
2898             *PL_reglastcloseparen = n;
2899             break;
2900         case GROUPP:
2901             n = ARG(scan);  /* which paren pair */
2902             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2903             break;
2904         case IFTHEN:
2905             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2906             if (sw)
2907                 next = NEXTOPER(NEXTOPER(scan));
2908             else {
2909                 next = scan + ARG(scan);
2910                 if (OP(next) == IFTHEN) /* Fake one. */
2911                     next = NEXTOPER(NEXTOPER(next));
2912             }
2913             break;
2914         case LOGICAL:
2915             logical = scan->flags;
2916             break;
2917 /*******************************************************************
2918  PL_regcc contains infoblock about the innermost (...)* loop, and
2919  a pointer to the next outer infoblock.
2920
2921  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2922
2923    1) After matching X, regnode for CURLYX is processed;
2924
2925    2) This regnode creates infoblock on the stack, and calls
2926       regmatch() recursively with the starting point at WHILEM node;
2927
2928    3) Each hit of WHILEM node tries to match A and Z (in the order
2929       depending on the current iteration, min/max of {min,max} and
2930       greediness).  The information about where are nodes for "A"
2931       and "Z" is read from the infoblock, as is info on how many times "A"
2932       was already matched, and greediness.
2933
2934    4) After A matches, the same WHILEM node is hit again.
2935
2936    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2937       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2938       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2939       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2940       of the external loop.
2941
2942  Currently present infoblocks form a tree with a stem formed by PL_curcc
2943  and whatever it mentions via ->next, and additional attached trees
2944  corresponding to temporarily unset infoblocks as in "5" above.
2945
2946  In the following picture infoblocks for outer loop of
2947  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2948  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2949  infoblocks are drawn below the "reset" infoblock.
2950
2951  In fact in the picture below we do not show failed matches for Z and T
2952  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2953  more obvious *why* one needs to *temporary* unset infoblocks.]
2954
2955   Matched       REx position    InfoBlocks      Comment
2956                 (Y(A)*?Z)*?T    x
2957                 Y(A)*?Z)*?T     x <- O
2958   Y             (A)*?Z)*?T      x <- O
2959   Y             A)*?Z)*?T       x <- O <- I
2960   YA            )*?Z)*?T        x <- O <- I
2961   YA            A)*?Z)*?T       x <- O <- I
2962   YAA           )*?Z)*?T        x <- O <- I
2963   YAA           Z)*?T           x <- O          # Temporary unset I
2964                                      I
2965
2966   YAAZ          Y(A)*?Z)*?T     x <- O
2967                                      I
2968
2969   YAAZY         (A)*?Z)*?T      x <- O
2970                                      I
2971
2972   YAAZY         A)*?Z)*?T       x <- O <- I
2973                                      I
2974
2975   YAAZYA        )*?Z)*?T        x <- O <- I     
2976                                      I
2977
2978   YAAZYA        Z)*?T           x <- O          # Temporary unset I
2979                                      I,I
2980
2981   YAAZYAZ       )*?T            x <- O
2982                                      I,I
2983
2984   YAAZYAZ       T               x               # Temporary unset O
2985                                 O
2986                                 I,I
2987
2988   YAAZYAZT                      x
2989                                 O
2990                                 I,I
2991  *******************************************************************/
2992         case CURLYX: {
2993                 CURCUR cc;
2994                 CHECKPOINT cp = PL_savestack_ix;
2995                 /* No need to save/restore up to this paren */
2996                 I32 parenfloor = scan->flags;
2997
2998                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2999                     next += ARG(next);
3000                 cc.oldcc = PL_regcc;
3001                 PL_regcc = &cc;
3002                 /* XXXX Probably it is better to teach regpush to support
3003                    parenfloor > PL_regsize... */
3004                 if (parenfloor > *PL_reglastparen)
3005                     parenfloor = *PL_reglastparen; /* Pessimization... */
3006                 cc.parenfloor = parenfloor;
3007                 cc.cur = -1;
3008                 cc.min = ARG1(scan);
3009                 cc.max  = ARG2(scan);
3010                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3011                 cc.next = next;
3012                 cc.minmod = minmod;
3013                 cc.lastloc = 0;
3014                 PL_reginput = locinput;
3015                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3016                 regcpblow(cp);
3017                 PL_regcc = cc.oldcc;
3018                 saySAME(n);
3019             }
3020             /* NOT REACHED */
3021         case WHILEM: {
3022                 /*
3023                  * This is really hard to understand, because after we match
3024                  * what we're trying to match, we must make sure the rest of
3025                  * the REx is going to match for sure, and to do that we have
3026                  * to go back UP the parse tree by recursing ever deeper.  And
3027                  * if it fails, we have to reset our parent's current state
3028                  * that we can try again after backing off.
3029                  */
3030
3031                 CHECKPOINT cp, lastcp;
3032                 CURCUR* cc = PL_regcc;
3033                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
3034                 
3035                 n = cc->cur + 1;        /* how many we know we matched */
3036                 PL_reginput = locinput;
3037
3038                 DEBUG_r(
3039                     PerlIO_printf(Perl_debug_log,
3040                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
3041                                   REPORT_CODE_OFF+PL_regindent*2, "",
3042                                   (long)n, (long)cc->min,
3043                                   (long)cc->max, (long)cc)
3044                     );
3045
3046                 /* If degenerate scan matches "", assume scan done. */
3047
3048                 if (locinput == cc->lastloc && n >= cc->min) {
3049                     PL_regcc = cc->oldcc;
3050                     if (PL_regcc)
3051                         ln = PL_regcc->cur;
3052                     DEBUG_r(
3053                         PerlIO_printf(Perl_debug_log,
3054                            "%*s  empty match detected, try continuation...\n",
3055                            REPORT_CODE_OFF+PL_regindent*2, "")
3056                         );
3057                     if (regmatch(cc->next))
3058                         sayYES;
3059                     if (PL_regcc)
3060                         PL_regcc->cur = ln;
3061                     PL_regcc = cc;
3062                     sayNO;
3063                 }
3064
3065                 /* First just match a string of min scans. */
3066
3067                 if (n < cc->min) {
3068                     cc->cur = n;
3069                     cc->lastloc = locinput;
3070                     if (regmatch(cc->scan))
3071                         sayYES;
3072                     cc->cur = n - 1;
3073                     cc->lastloc = lastloc;
3074                     sayNO;
3075                 }
3076
3077                 if (scan->flags) {
3078                     /* Check whether we already were at this position.
3079                         Postpone detection until we know the match is not
3080                         *that* much linear. */
3081                 if (!PL_reg_maxiter) {
3082                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3083                     PL_reg_leftiter = PL_reg_maxiter;
3084                 }
3085                 if (PL_reg_leftiter-- == 0) {
3086                     I32 size = (PL_reg_maxiter + 7)/8;
3087                     if (PL_reg_poscache) {
3088                         if (PL_reg_poscache_size < size) {
3089                             Renew(PL_reg_poscache, size, char);
3090                             PL_reg_poscache_size = size;
3091                         }
3092                         Zero(PL_reg_poscache, size, char);
3093                     }
3094                     else {
3095                         PL_reg_poscache_size = size;
3096                         Newz(29, PL_reg_poscache, size, char);
3097                     }
3098                     DEBUG_r(
3099                         PerlIO_printf(Perl_debug_log,
3100               "%sDetected a super-linear match, switching on caching%s...\n",
3101                                       PL_colors[4], PL_colors[5])
3102                         );
3103                 }
3104                 if (PL_reg_leftiter < 0) {
3105                     I32 o = locinput - PL_bostr, b;
3106
3107                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
3108                     b = o % 8;
3109                     o /= 8;
3110                     if (PL_reg_poscache[o] & (1<<b)) {
3111                     DEBUG_r(
3112                         PerlIO_printf(Perl_debug_log,
3113                                       "%*s  already tried at this position...\n",
3114                                       REPORT_CODE_OFF+PL_regindent*2, "")
3115                         );
3116                         sayNO_SILENT;
3117                     }
3118                     PL_reg_poscache[o] |= (1<<b);
3119                 }
3120                 }
3121
3122                 /* Prefer next over scan for minimal matching. */
3123
3124                 if (cc->minmod) {
3125                     PL_regcc = cc->oldcc;
3126                     if (PL_regcc)
3127                         ln = PL_regcc->cur;
3128                     cp = regcppush(cc->parenfloor);
3129                     REGCP_SET(lastcp);
3130                     if (regmatch(cc->next)) {
3131                         regcpblow(cp);
3132                         sayYES; /* All done. */
3133                     }
3134                     REGCP_UNWIND(lastcp);
3135                     regcppop();
3136                     if (PL_regcc)
3137                         PL_regcc->cur = ln;
3138                     PL_regcc = cc;
3139
3140                     if (n >= cc->max) { /* Maximum greed exceeded? */
3141                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3142                             && !(PL_reg_flags & RF_warned)) {
3143                             PL_reg_flags |= RF_warned;
3144                             Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3145                                  "Complex regular subexpression recursion",
3146                                  REG_INFTY - 1);
3147                         }
3148                         sayNO;
3149                     }
3150
3151                     DEBUG_r(
3152                         PerlIO_printf(Perl_debug_log,
3153                                       "%*s  trying longer...\n",
3154                                       REPORT_CODE_OFF+PL_regindent*2, "")
3155                         );
3156                     /* Try scanning more and see if it helps. */
3157                     PL_reginput = locinput;
3158                     cc->cur = n;
3159                     cc->lastloc = locinput;
3160                     cp = regcppush(cc->parenfloor);
3161                     REGCP_SET(lastcp);
3162                     if (regmatch(cc->scan)) {
3163                         regcpblow(cp);
3164                         sayYES;
3165                     }
3166                     REGCP_UNWIND(lastcp);
3167                     regcppop();
3168                     cc->cur = n - 1;
3169                     cc->lastloc = lastloc;
3170                     sayNO;
3171                 }
3172
3173                 /* Prefer scan over next for maximal matching. */
3174
3175                 if (n < cc->max) {      /* More greed allowed? */
3176                     cp = regcppush(cc->parenfloor);
3177                     cc->cur = n;
3178                     cc->lastloc = locinput;
3179                     REGCP_SET(lastcp);
3180                     if (regmatch(cc->scan)) {
3181                         regcpblow(cp);
3182                         sayYES;
3183                     }
3184                     REGCP_UNWIND(lastcp);
3185                     regcppop();         /* Restore some previous $<digit>s? */
3186                     PL_reginput = locinput;
3187                     DEBUG_r(
3188                         PerlIO_printf(Perl_debug_log,
3189                                       "%*s  failed, try continuation...\n",
3190                                       REPORT_CODE_OFF+PL_regindent*2, "")
3191                         );
3192                 }
3193                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3194                         && !(PL_reg_flags & RF_warned)) {
3195                     PL_reg_flags |= RF_warned;
3196                     Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3197                          "Complex regular subexpression recursion",
3198                          REG_INFTY - 1);
3199                 }
3200
3201                 /* Failed deeper matches of scan, so see if this one works. */
3202                 PL_regcc = cc->oldcc;
3203                 if (PL_regcc)
3204                     ln = PL_regcc->cur;
3205                 if (regmatch(cc->next))
3206                     sayYES;
3207                 if (PL_regcc)
3208                     PL_regcc->cur = ln;
3209                 PL_regcc = cc;
3210                 cc->cur = n - 1;
3211                 cc->lastloc = lastloc;
3212                 sayNO;
3213             }
3214             /* NOT REACHED */
3215         case BRANCHJ:
3216             next = scan + ARG(scan);
3217             if (next == scan)
3218                 next = NULL;
3219             inner = NEXTOPER(NEXTOPER(scan));
3220             goto do_branch;
3221         case BRANCH:
3222             inner = NEXTOPER(scan);
3223           do_branch:
3224             {
3225                 c1 = OP(scan);
3226                 if (OP(next) != c1)     /* No choice. */
3227                     next = inner;       /* Avoid recursion. */
3228                 else {
3229                     I32 lastparen = *PL_reglastparen;
3230                     I32 unwind1;
3231                     re_unwind_branch_t *uw;
3232
3233                     /* Put unwinding data on stack */
3234                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3235                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3236                     uw->prev = unwind;
3237                     unwind = unwind1;
3238                     uw->type = ((c1 == BRANCH)
3239                                 ? RE_UNWIND_BRANCH
3240                                 : RE_UNWIND_BRANCHJ);
3241                     uw->lastparen = lastparen;
3242                     uw->next = next;
3243                     uw->locinput = locinput;
3244                     uw->nextchr = nextchr;
3245 #ifdef DEBUGGING
3246                     uw->regindent = ++PL_regindent;
3247 #endif
3248
3249                     REGCP_SET(uw->lastcp);
3250
3251                     /* Now go into the first branch */
3252                     next = inner;
3253                 }
3254             }
3255             break;
3256         case MINMOD:
3257             minmod = 1;
3258             break;
3259         case CURLYM:
3260         {
3261             I32 l = 0;
3262             CHECKPOINT lastcp;
3263         
3264             /* We suppose that the next guy does not need
3265                backtracking: in particular, it is of constant length,
3266                and has no parenths to influence future backrefs. */
3267             ln = ARG1(scan);  /* min to match */
3268             n  = ARG2(scan);  /* max to match */
3269             paren = scan->flags;
3270             if (paren) {
3271                 if (paren > PL_regsize)
3272                     PL_regsize = paren;
3273                 if (paren > *PL_reglastparen)
3274                     *PL_reglastparen = paren;
3275             }
3276             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3277             if (paren)
3278                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3279             PL_reginput = locinput;
3280             if (minmod) {
3281                 minmod = 0;
3282                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3283                     sayNO;
3284                 /* if we matched something zero-length we don't need to
3285                    backtrack - capturing parens are already defined, so
3286                    the caveat in the maximal case doesn't apply
3287
3288                    XXXX if ln == 0, we can redo this check first time
3289                    through the following loop
3290                 */
3291                 if (ln && l == 0)
3292                     n = ln;     /* don't backtrack */
3293                 locinput = PL_reginput;
3294                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3295                     regnode *text_node = next;
3296
3297                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3298
3299                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3300                     else {
3301                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3302                             I32 n, ln;
3303                             n = ARG(text_node);  /* which paren pair */
3304                             ln = PL_regstartp[n];
3305                             /* assume yes if we haven't seen CLOSEn */
3306                             if (
3307                                 *PL_reglastparen < n ||
3308                                 ln == -1 ||
3309                                 ln == PL_regendp[n]
3310                             ) {
3311                                 c1 = c2 = -1000;
3312                                 goto assume_ok_MM;
3313                             }
3314                             c1 = *(PL_bostr + ln);
3315                         }
3316                         else { c1 = (U8)*STRING(text_node); }
3317                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3318                             c2 = PL_fold[c1];
3319                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3320                             c2 = PL_fold_locale[c1];
3321                         else
3322                             c2 = c1;
3323                     }
3324                 }
3325                 else
3326                     c1 = c2 = -1000;
3327             assume_ok_MM:
3328                 REGCP_SET(lastcp);
3329                 /* This may be improved if l == 0.  */
3330                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
3331                     /* If it could work, try it. */
3332                     if (c1 == -1000 ||
3333                         UCHARAT(PL_reginput) == c1 ||
3334                         UCHARAT(PL_reginput) == c2)
3335                     {
3336                         if (paren) {
3337                             if (ln) {
3338                                 PL_regstartp[paren] =
3339                                     HOPc(PL_reginput, -l) - PL_bostr;
3340                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3341                             }
3342                             else
3343                                 PL_regendp[paren] = -1;
3344                         }
3345                         if (regmatch(next))
3346                             sayYES;
3347                         REGCP_UNWIND(lastcp);
3348                     }
3349                     /* Couldn't or didn't -- move forward. */
3350                     PL_reginput = locinput;
3351                     if (regrepeat_hard(scan, 1, &l)) {
3352                         ln++;
3353                         locinput = PL_reginput;
3354                     }
3355                     else
3356                         sayNO;
3357                 }
3358             }
3359             else {
3360                 n = regrepeat_hard(scan, n, &l);
3361                 /* if we matched something zero-length we don't need to
3362                    backtrack, unless the minimum count is zero and we
3363                    are capturing the result - in that case the capture
3364                    being defined or not may affect later execution
3365                 */
3366                 if (n != 0 && l == 0 && !(paren && ln == 0))
3367                     ln = n;     /* don't backtrack */
3368                 locinput = PL_reginput;
3369                 DEBUG_r(
3370                     PerlIO_printf(Perl_debug_log,
3371                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3372                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3373                                   (IV) n, (IV)l)
3374                     );
3375                 if (n >= ln) {
3376                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3377                         regnode *text_node = next;
3378
3379                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3380
3381                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3382                         else {
3383                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3384                                 I32 n, ln;
3385                                 n = ARG(text_node);  /* which paren pair */
3386                                 ln = PL_regstartp[n];
3387                                 /* assume yes if we haven't seen CLOSEn */
3388                                 if (
3389                                     *PL_reglastparen < n ||
3390                                     ln == -1 ||
3391                                     ln == PL_regendp[n]
3392                                 ) {
3393                                     c1 = c2 = -1000;
3394                                     goto assume_ok_REG;
3395                                 }
3396                                 c1 = *(PL_bostr + ln);
3397                             }
3398                             else { c1 = (U8)*STRING(text_node); }
3399
3400                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3401                                 c2 = PL_fold[c1];
3402                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3403                                 c2 = PL_fold_locale[c1];
3404                             else
3405                                 c2 = c1;
3406                         }
3407                     }
3408                     else
3409                         c1 = c2 = -1000;
3410                 }
3411             assume_ok_REG:
3412                 REGCP_SET(lastcp);
3413                 while (n >= ln) {
3414                     /* If it could work, try it. */
3415                     if (c1 == -1000 ||
3416                         UCHARAT(PL_reginput) == c1 ||
3417                         UCHARAT(PL_reginput) == c2)
3418                     {
3419                         DEBUG_r(
3420                                 PerlIO_printf(Perl_debug_log,
3421                                               "%*s  trying tail with n=%"IVdf"...\n",
3422                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3423                             );
3424                         if (paren) {
3425                             if (n) {
3426                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3427                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3428                             }
3429                             else
3430                                 PL_regendp[paren] = -1;
3431                         }
3432                         if (regmatch(next))
3433                             sayYES;
3434                         REGCP_UNWIND(lastcp);
3435                     }
3436                     /* Couldn't or didn't -- back up. */
3437                     n--;
3438                     locinput = HOPc(locinput, -l);
3439                     PL_reginput = locinput;
3440                 }
3441             }
3442             sayNO;
3443             break;
3444         }
3445         case CURLYN:
3446             paren = scan->flags;        /* Which paren to set */
3447             if (paren > PL_regsize)
3448                 PL_regsize = paren;
3449             if (paren > *PL_reglastparen)
3450                 *PL_reglastparen = paren;
3451             ln = ARG1(scan);  /* min to match */
3452             n  = ARG2(scan);  /* max to match */
3453             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3454             goto repeat;
3455         case CURLY:
3456             paren = 0;
3457             ln = ARG1(scan);  /* min to match */
3458             n  = ARG2(scan);  /* max to match */
3459             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3460             goto repeat;
3461         case STAR:
3462             ln = 0;
3463             n = REG_INFTY;
3464             scan = NEXTOPER(scan);
3465             paren = 0;
3466             goto repeat;
3467         case PLUS:
3468             ln = 1;
3469             n = REG_INFTY;
3470             scan = NEXTOPER(scan);
3471             paren = 0;
3472           repeat:
3473             /*
3474             * Lookahead to avoid useless match attempts
3475             * when we know what character comes next.
3476             */
3477
3478             /*
3479             * Used to only do .*x and .*?x, but now it allows
3480             * for )'s, ('s and (?{ ... })'s to be in the way
3481             * of the quantifier and the EXACT-like node.  -- japhy
3482             */
3483
3484             if (HAS_TEXT(next) || JUMPABLE(next)) {
3485                 U8 *s;
3486                 regnode *text_node = next;
3487
3488                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3489
3490                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3491                 else {
3492                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3493                         I32 n, ln;
3494                         n = ARG(text_node);  /* which paren pair */
3495                         ln = PL_regstartp[n];
3496                         /* assume yes if we haven't seen CLOSEn */
3497                         if (
3498                             *PL_reglastparen < n ||
3499                             ln == -1 ||
3500                             ln == PL_regendp[n]
3501                         ) {
3502                             c1 = c2 = -1000;
3503                             goto assume_ok_easy;
3504                         }
3505                         s = (U8*)PL_bostr + ln;
3506                     }
3507                     else { s = (U8*)STRING(text_node); }
3508
3509                     if (!UTF) {
3510                         c2 = c1 = *s;
3511                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3512                             c2 = PL_fold[c1];
3513                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3514                             c2 = PL_fold_locale[c1];
3515                     }
3516                     else { /* UTF */
3517                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3518                              STRLEN ulen1, ulen2;
3519                              U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
3520                              U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
3521
3522                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3523                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3524
3525                              c1 = utf8_to_uvuni(tmpbuf1, 0);
3526                              c2 = utf8_to_uvuni(tmpbuf2, 0);
3527                         }
3528                         else {
3529                             c2 = c1 = utf8_to_uvchr(s, NULL);
3530                         }
3531                     }
3532                 }
3533             }
3534             else
3535                 c1 = c2 = -1000;
3536         assume_ok_easy:
3537             PL_reginput = locinput;
3538             if (minmod) {
3539                 CHECKPOINT lastcp;
3540                 minmod = 0;
3541                 if (ln && regrepeat(scan, ln) < ln)
3542                     sayNO;
3543                 locinput = PL_reginput;
3544                 REGCP_SET(lastcp);
3545                 if (c1 != -1000) {
3546                     char *e; /* Should not check after this */
3547                     char *old = locinput;
3548
3549                     if  (n == REG_INFTY) {
3550                         e = PL_regeol - 1;
3551                         if (do_utf8)
3552                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3553                                 e--;
3554                     }
3555                     else if (do_utf8) {
3556                         int m = n - ln;
3557                         for (e = locinput;
3558                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3559                             e += UTF8SKIP(e);
3560                     }
3561                     else {
3562                         e = locinput + n - ln;
3563                         if (e >= PL_regeol)
3564                             e = PL_regeol - 1;
3565                     }
3566                     while (1) {
3567                         int count;
3568                         /* Find place 'next' could work */
3569                         if (!do_utf8) {
3570                             if (c1 == c2) {
3571                                 while (locinput <= e &&
3572                                        UCHARAT(locinput) != c1)
3573                                     locinput++;
3574                             } else {
3575                                 while (locinput <= e
3576                                        && UCHARAT(locinput) != c1
3577                                        && UCHARAT(locinput) != c2)
3578                                     locinput++;
3579                             }
3580                             count = locinput - old;
3581                         }
3582                         else {
3583                             STRLEN len;
3584                             if (c1 == c2) {
3585                                 for (count = 0;
3586                                      locinput <= e &&
3587                                          utf8_to_uvchr((U8*)locinput, &len) != c1;
3588                                      count++)
3589                                     locinput += len;
3590                                 
3591                             } else {
3592                                 for (count = 0; locinput <= e; count++) {
3593                                     UV c = utf8_to_uvchr((U8*)locinput, &len);
3594                                     if (c == c1 || c == c2)
3595                                         break;
3596                                     locinput += len;                    
3597                                 }
3598                             }
3599                         }
3600                         if (locinput > e)
3601                             sayNO;
3602                         /* PL_reginput == old now */
3603                         if (locinput != old) {
3604                             ln = 1;     /* Did some */
3605                             if (regrepeat(scan, count) < count)
3606                                 sayNO;
3607                         }
3608                         /* PL_reginput == locinput now */
3609                         TRYPAREN(paren, ln, locinput);
3610                         PL_reginput = locinput; /* Could be reset... */
3611                         REGCP_UNWIND(lastcp);
3612                         /* Couldn't or didn't -- move forward. */
3613                         old = locinput;
3614                         if (do_utf8)
3615                             locinput += UTF8SKIP(locinput);
3616                         else
3617                             locinput++;
3618                     }
3619                 }
3620                 else
3621                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3622                     UV c;
3623                     if (c1 != -1000) {
3624                         if (do_utf8)
3625                             c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3626                         else
3627                             c = UCHARAT(PL_reginput);
3628                         /* If it could work, try it. */
3629                         if (c == c1 || c == c2)
3630                         {
3631                             TRYPAREN(paren, n, PL_reginput);
3632                             REGCP_UNWIND(lastcp);
3633                         }
3634                     }
3635                     /* If it could work, try it. */
3636                     else if (c1 == -1000)
3637                     {
3638                         TRYPAREN(paren, n, PL_reginput);
3639                         REGCP_UNWIND(lastcp);
3640                     }
3641                     /* Couldn't or didn't -- move forward. */
3642                     PL_reginput = locinput;
3643                     if (regrepeat(scan, 1)) {
3644                         ln++;
3645                         locinput = PL_reginput;
3646                     }
3647                     else
3648                         sayNO;
3649                 }
3650             }
3651             else {
3652                 CHECKPOINT lastcp;
3653                 n = regrepeat(scan, n);
3654                 locinput = PL_reginput;
3655                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3656                     (!PL_multiline  || OP(next) == SEOL || OP(next) == EOS)) {
3657                     ln = n;                     /* why back off? */
3658                     /* ...because $ and \Z can match before *and* after
3659                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3660                        We should back off by one in this case. */
3661                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3662                         ln--;
3663                 }
3664                 REGCP_SET(lastcp);
3665                 if (paren) {
3666                     UV c = 0;
3667                     while (n >= ln) {
3668                         if (c1 != -1000) {
3669                             if (do_utf8)
3670                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3671                             else
3672                                 c = UCHARAT(PL_reginput);
3673                         }
3674                         /* If it could work, try it. */
3675                         if (c1 == -1000 || c == c1 || c == c2)
3676                             {
3677                                 TRYPAREN(paren, n, PL_reginput);
3678                                 REGCP_UNWIND(lastcp);
3679                             }
3680                         /* Couldn't or didn't -- back up. */
3681                         n--;
3682                         PL_reginput = locinput = HOPc(locinput, -1);
3683                     }
3684                 }
3685                 else {
3686                     UV c = 0;
3687                     while (n >= ln) {
3688                         if (c1 != -1000) {
3689                             if (do_utf8)
3690                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3691                             else
3692                                 c = UCHARAT(PL_reginput);
3693                         }
3694                         /* If it could work, try it. */
3695                         if (c1 == -1000 || c == c1 || c == c2)
3696                             {
3697                                 TRYPAREN(paren, n, PL_reginput);
3698                                 REGCP_UNWIND(lastcp);
3699                             }
3700                         /* Couldn't or didn't -- back up. */
3701                         n--;
3702                         PL_reginput = locinput = HOPc(locinput, -1);
3703                     }
3704                 }
3705             }
3706             sayNO;
3707             break;
3708         case END:
3709             if (PL_reg_call_cc) {
3710                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3711                 CURCUR *cctmp = PL_regcc;
3712                 regexp *re = PL_reg_re;
3713                 CHECKPOINT cp, lastcp;
3714                 
3715                 cp = regcppush(0);      /* Save *all* the positions. */
3716                 REGCP_SET(lastcp);
3717                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3718                                                     the caller. */
3719                 PL_reginput = locinput; /* Make position available to
3720                                            the callcc. */
3721                 cache_re(PL_reg_call_cc->re);
3722                 PL_regcc = PL_reg_call_cc->cc;
3723                 PL_reg_call_cc = PL_reg_call_cc->prev;
3724                 if (regmatch(cur_call_cc->node)) {
3725                     PL_reg_call_cc = cur_call_cc;
3726                     regcpblow(cp);
3727                     sayYES;
3728                 }
3729                 REGCP_UNWIND(lastcp);
3730                 regcppop();
3731                 PL_reg_call_cc = cur_call_cc;
3732                 PL_regcc = cctmp;
3733                 PL_reg_re = re;
3734                 cache_re(re);
3735
3736                 DEBUG_r(
3737                     PerlIO_printf(Perl_debug_log,
3738                                   "%*s  continuation failed...\n",
3739                                   REPORT_CODE_OFF+PL_regindent*2, "")
3740                     );
3741                 sayNO_SILENT;
3742             }
3743             if (locinput < PL_regtill) {
3744                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3745                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3746                                       PL_colors[4],
3747                                       (long)(locinput - PL_reg_starttry),
3748                                       (long)(PL_regtill - PL_reg_starttry),
3749                                       PL_colors[5]));
3750                 sayNO_FINAL;            /* Cannot match: too short. */
3751             }
3752             PL_reginput = locinput;     /* put where regtry can find it */
3753             sayYES_FINAL;               /* Success! */
3754         case SUCCEED:
3755             PL_reginput = locinput;     /* put where regtry can find it */
3756             sayYES_LOUD;                /* Success! */
3757         case SUSPEND:
3758             n = 1;
3759             PL_reginput = locinput;
3760             goto do_ifmatch;    
3761         case UNLESSM:
3762             n = 0;
3763             if (scan->flags) {
3764                 s = HOPBACKc(locinput, scan->flags);
3765                 if (!s)
3766                     goto say_yes;
3767                 PL_reginput = s;
3768             }
3769             else
3770                 PL_reginput = locinput;
3771             goto do_ifmatch;
3772         case IFMATCH:
3773             n = 1;
3774             if (scan->flags) {
3775                 s = HOPBACKc(locinput, scan->flags);
3776                 if (!s)
3777                     goto say_no;
3778                 PL_reginput = s;
3779             }
3780             else
3781                 PL_reginput = locinput;
3782
3783           do_ifmatch:
3784             inner = NEXTOPER(NEXTOPER(scan));
3785             if (regmatch(inner) != n) {
3786               say_no:
3787                 if (logical) {
3788                     logical = 0;
3789                     sw = 0;
3790                     goto do_longjump;
3791                 }
3792                 else
3793                     sayNO;
3794             }
3795           say_yes:
3796             if (logical) {
3797                 logical = 0;
3798                 sw = 1;
3799             }
3800             if (OP(scan) == SUSPEND) {
3801                 locinput = PL_reginput;
3802                 nextchr = UCHARAT(locinput);
3803             }
3804             /* FALL THROUGH. */
3805         case LONGJMP:
3806           do_longjump:
3807             next = scan + ARG(scan);
3808             if (next == scan)
3809                 next = NULL;
3810             break;
3811         default:
3812             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3813                           PTR2UV(scan), OP(scan));
3814             Perl_croak(aTHX_ "regexp memory corruption");
3815         }
3816       reenter:
3817         scan = next;
3818     }
3819
3820     /*
3821     * We get here only if there's trouble -- normally "case END" is
3822     * the terminating point.
3823     */
3824     Perl_croak(aTHX_ "corrupted regexp pointers");
3825     /*NOTREACHED*/
3826     sayNO;
3827
3828 yes_loud:
3829     DEBUG_r(
3830         PerlIO_printf(Perl_debug_log,
3831                       "%*s  %scould match...%s\n",
3832                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3833         );
3834     goto yes;
3835 yes_final:
3836     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3837                           PL_colors[4],PL_colors[5]));
3838 yes:
3839 #ifdef DEBUGGING
3840     PL_regindent--;
3841 #endif
3842
3843 #if 0                                   /* Breaks $^R */
3844     if (unwind)
3845         regcpblow(firstcp);
3846 #endif
3847     return 1;
3848
3849 no:
3850     DEBUG_r(
3851         PerlIO_printf(Perl_debug_log,
3852                       "%*s  %sfailed...%s\n",
3853                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3854         );
3855     goto do_no;
3856 no_final:
3857 do_no:
3858     if (unwind) {
3859         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3860
3861         switch (uw->type) {
3862         case RE_UNWIND_BRANCH:
3863         case RE_UNWIND_BRANCHJ:
3864         {
3865             re_unwind_branch_t *uwb = &(uw->branch);
3866             I32 lastparen = uwb->lastparen;
3867         
3868             REGCP_UNWIND(uwb->lastcp);
3869             for (n = *PL_reglastparen; n > lastparen; n--)
3870                 PL_regendp[n] = -1;
3871             *PL_reglastparen = n;
3872             scan = next = uwb->next;
3873             if ( !scan ||
3874                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3875                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3876                 unwind = uwb->prev;
3877 #ifdef DEBUGGING
3878                 PL_regindent--;
3879 #endif
3880                 goto do_no;
3881             }
3882             /* Have more choice yet.  Reuse the same uwb.  */
3883             /*SUPPRESS 560*/
3884             if ((n = (uwb->type == RE_UNWIND_BRANCH
3885                       ? NEXT_OFF(next) : ARG(next))))
3886                 next += n;
3887             else
3888                 next = NULL;    /* XXXX Needn't unwinding in this case... */
3889             uwb->next = next;
3890             next = NEXTOPER(scan);
3891             if (uwb->type == RE_UNWIND_BRANCHJ)
3892                 next = NEXTOPER(next);
3893             locinput = uwb->locinput;
3894             nextchr = uwb->nextchr;
3895 #ifdef DEBUGGING
3896             PL_regindent = uwb->regindent;
3897 #endif
3898
3899             goto reenter;
3900         }
3901         /* NOT REACHED */
3902         default:
3903             Perl_croak(aTHX_ "regexp unwind memory corruption");
3904         }
3905         /* NOT REACHED */
3906     }
3907 #ifdef DEBUGGING
3908     PL_regindent--;
3909 #endif
3910     return 0;
3911 }
3912
3913 /*
3914  - regrepeat - repeatedly match something simple, report how many
3915  */
3916 /*
3917  * [This routine now assumes that it will only match on things of length 1.
3918  * That was true before, but now we assume scan - reginput is the count,
3919  * rather than incrementing count on every character.  [Er, except utf8.]]
3920  */
3921 STATIC I32
3922 S_regrepeat(pTHX_ regnode *p, I32 max)
3923 {
3924     register char *scan;
3925     register I32 c;
3926     register char *loceol = PL_regeol;
3927     register I32 hardcount = 0;
3928     register bool do_utf8 = PL_reg_match_utf8;
3929
3930     scan = PL_reginput;
3931     if (max != REG_INFTY && max < loceol - scan)
3932       loceol = scan + max;
3933     switch (OP(p)) {
3934     case REG_ANY:
3935         if (do_utf8) {
3936             loceol = PL_regeol;
3937             while (scan < loceol && hardcount < max && *scan != '\n') {
3938                 scan += UTF8SKIP(scan);
3939                 hardcount++;
3940             }
3941         } else {
3942             while (scan < loceol && *scan != '\n')
3943                 scan++;
3944         }
3945         break;
3946     case SANY:
3947         scan = loceol;
3948         break;
3949     case CANY:
3950         scan = loceol;
3951         break;
3952     case EXACT:         /* length of string is 1 */
3953         c = (U8)*STRING(p);
3954         while (scan < loceol && UCHARAT(scan) == c)
3955             scan++;
3956         break;
3957     case EXACTF:        /* length of string is 1 */
3958         c = (U8)*STRING(p);
3959         while (scan < loceol &&
3960                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3961             scan++;
3962         break;
3963     case EXACTFL:       /* length of string is 1 */
3964         PL_reg_flags |= RF_tainted;
3965         c = (U8)*STRING(p);
3966         while (scan < loceol &&
3967                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3968             scan++;
3969         break;
3970     case ANYOF:
3971         if (do_utf8) {
3972             loceol = PL_regeol;
3973             while (hardcount < max && scan < loceol &&
3974                    reginclass(p, (U8*)scan, do_utf8)) {
3975                 scan += UTF8SKIP(scan);
3976                 hardcount++;
3977             }
3978         } else {
3979             while (scan < loceol && reginclass(p, (U8*)scan, do_utf8))
3980                 scan++;
3981         }
3982         break;
3983     case ALNUM:
3984         if (do_utf8) {
3985             loceol = PL_regeol;
3986             LOAD_UTF8_CHARCLASS(alnum,"a");
3987             while (hardcount < max && scan < loceol &&
3988                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3989                 scan += UTF8SKIP(scan);
3990                 hardcount++;
3991             }
3992         } else {
3993             while (scan < loceol && isALNUM(*scan))
3994                 scan++;
3995         }
3996         break;
3997     case ALNUML:
3998         PL_reg_flags |= RF_tainted;
3999         if (do_utf8) {
4000             loceol = PL_regeol;
4001             while (hardcount < max && scan < loceol &&
4002                    isALNUM_LC_utf8((U8*)scan)) {
4003                 scan += UTF8SKIP(scan);
4004                 hardcount++;
4005             }
4006         } else {
4007             while (scan < loceol && isALNUM_LC(*scan))
4008                 scan++;
4009         }
4010         break;
4011     case NALNUM:
4012         if (do_utf8) {
4013             loceol = PL_regeol;
4014             LOAD_UTF8_CHARCLASS(alnum,"a");
4015             while (hardcount < max && scan < loceol &&
4016                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4017                 scan += UTF8SKIP(scan);
4018                 hardcount++;
4019             }
4020         } else {
4021             while (scan < loceol && !isALNUM(*scan))
4022                 scan++;
4023         }
4024         break;
4025     case NALNUML:
4026         PL_reg_flags |= RF_tainted;
4027         if (do_utf8) {
4028             loceol = PL_regeol;
4029             while (hardcount < max && scan < loceol &&
4030                    !isALNUM_LC_utf8((U8*)scan)) {
4031                 scan += UTF8SKIP(scan);
4032                 hardcount++;
4033             }
4034         } else {
4035             while (scan < loceol && !isALNUM_LC(*scan))
4036                 scan++;
4037         }
4038         break;
4039     case SPACE:
4040         if (do_utf8) {
4041             loceol = PL_regeol;
4042             LOAD_UTF8_CHARCLASS(space," ");
4043             while (hardcount < max && scan < loceol &&
4044                    (*scan == ' ' ||
4045                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4046                 scan += UTF8SKIP(scan);
4047                 hardcount++;
4048             }
4049         } else {
4050             while (scan < loceol && isSPACE(*scan))
4051                 scan++;
4052         }
4053         break;
4054     case SPACEL:
4055         PL_reg_flags |= RF_tainted;
4056         if (do_utf8) {
4057             loceol = PL_regeol;
4058             while (hardcount < max && scan < loceol &&
4059                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4060                 scan += UTF8SKIP(scan);
4061                 hardcount++;
4062             }
4063         } else {
4064             while (scan < loceol && isSPACE_LC(*scan))
4065                 scan++;
4066         }
4067         break;
4068     case NSPACE:
4069         if (do_utf8) {
4070             loceol = PL_regeol;
4071             LOAD_UTF8_CHARCLASS(space," ");
4072             while (hardcount < max && scan < loceol &&
4073                    !(*scan == ' ' ||
4074                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4075                 scan += UTF8SKIP(scan);
4076                 hardcount++;
4077             }
4078         } else {
4079             while (scan < loceol && !isSPACE(*scan))
4080                 scan++;
4081             break;
4082         }
4083     case NSPACEL:
4084         PL_reg_flags |= RF_tainted;
4085         if (do_utf8) {
4086             loceol = PL_regeol;
4087             while (hardcount < max && scan < loceol &&
4088                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4089                 scan += UTF8SKIP(scan);
4090                 hardcount++;
4091             }
4092         } else {
4093             while (scan < loceol && !isSPACE_LC(*scan))
4094                 scan++;
4095         }
4096         break;
4097     case DIGIT:
4098         if (do_utf8) {
4099             loceol = PL_regeol;
4100             LOAD_UTF8_CHARCLASS(digit,"0");
4101             while (hardcount < max && scan < loceol &&
4102                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4103                 scan += UTF8SKIP(scan);
4104                 hardcount++;
4105             }
4106         } else {
4107             while (scan < loceol && isDIGIT(*scan))
4108                 scan++;
4109         }
4110         break;
4111     case NDIGIT:
4112         if (do_utf8) {
4113             loceol = PL_regeol;
4114             LOAD_UTF8_CHARCLASS(digit,"0");
4115             while (hardcount < max && scan < loceol &&
4116                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4117                 scan += UTF8SKIP(scan);
4118                 hardcount++;
4119             }
4120         } else {
4121             while (scan < loceol && !isDIGIT(*scan))
4122                 scan++;
4123         }
4124         break;
4125     default:            /* Called on something of 0 width. */
4126         break;          /* So match right here or not at all. */
4127     }
4128
4129     if (hardcount)
4130         c = hardcount;
4131     else
4132         c = scan - PL_reginput;
4133     PL_reginput = scan;
4134
4135     DEBUG_r(
4136         {
4137                 SV *prop = sv_newmortal();
4138
4139                 regprop(prop, p);
4140                 PerlIO_printf(Perl_debug_log,
4141                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4142                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
4143         });
4144
4145     return(c);
4146 }
4147
4148 /*
4149  - regrepeat_hard - repeatedly match something, report total lenth and length
4150  *
4151  * The repeater is supposed to have constant length.
4152  */
4153
4154 STATIC I32
4155 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4156 {
4157     register char *scan = Nullch;
4158     register char *start;
4159     register char *loceol = PL_regeol;
4160     I32 l = 0;
4161     I32 count = 0, res = 1;
4162
4163     if (!max)
4164         return 0;
4165
4166     start = PL_reginput;
4167     if (PL_reg_match_utf8) {
4168         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4169             if (!count++) {
4170                 l = 0;
4171                 while (start < PL_reginput) {
4172                     l++;
4173                     start += UTF8SKIP(start);
4174                 }
4175                 *lp = l;
4176                 if (l == 0)
4177                     return max;
4178             }
4179             if (count == max)
4180                 return count;
4181         }
4182     }
4183     else {
4184         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4185             if (!count++) {
4186                 *lp = l = PL_reginput - start;
4187                 if (max != REG_INFTY && l*max < loceol - scan)
4188                     loceol = scan + l*max;
4189                 if (l == 0)
4190                     return max;
4191             }
4192         }
4193     }
4194     if (!res)
4195         PL_reginput = scan;
4196
4197     return count;
4198 }
4199
4200 /*
4201 - regclass_swash - prepare the utf8 swash
4202 */
4203
4204 SV *
4205 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
4206 {
4207     SV *sw = NULL;
4208     SV *si = NULL;
4209
4210     if (PL_regdata && PL_regdata->count) {
4211         U32 n = ARG(node);
4212
4213         if (PL_regdata->what[n] == 's') {
4214             SV *rv = (SV*)PL_regdata->data[n];
4215             AV *av = (AV*)SvRV((SV*)rv);
4216             SV **a;
4217         
4218             si = *av_fetch(av, 0, FALSE);
4219             a  =  av_fetch(av, 1, FALSE);
4220         
4221             if (a)
4222                 sw = *a;
4223             else if (si && doinit) {
4224                 sw = swash_init("utf8", "", si, 1, 0);
4225                 (void)av_store(av, 1, sw);
4226             }
4227         }
4228     }
4229         
4230     if (initsvp)
4231         *initsvp = si;
4232
4233     return sw;
4234 }
4235
4236 /*
4237  - reginclass - determine if a character falls into a character class
4238  */
4239
4240 STATIC bool
4241 S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
4242 {
4243     char flags = ANYOF_FLAGS(n);
4244     bool match = FALSE;
4245     UV c;
4246     STRLEN len = 0;
4247
4248     c = do_utf8 ? utf8_to_uvchr(p, &len) : *p;
4249
4250     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4251         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4252             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4253                 match = TRUE;
4254         }
4255         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4256             match = TRUE;
4257         if (!match) {
4258             SV *sw = regclass_swash(n, TRUE, 0);
4259         
4260             if (sw) {
4261                 if (swash_fetch(sw, p, do_utf8))
4262                     match = TRUE;
4263                 else if (flags & ANYOF_FOLD) {
4264                     STRLEN ulen;
4265                     U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
4266
4267                     to_utf8_fold(p, tmpbuf, &ulen);
4268                     if (swash_fetch(sw, tmpbuf, do_utf8))
4269                         match = TRUE;
4270                     to_utf8_upper(p, tmpbuf, &ulen);
4271                     if (swash_fetch(sw, tmpbuf, do_utf8))
4272                         match = TRUE;
4273                 }
4274             }
4275         }
4276     }
4277     if (!match && c < 256) {
4278         if (ANYOF_BITMAP_TEST(n, c))
4279             match = TRUE;
4280         else if (flags & ANYOF_FOLD) {
4281           I32 f;
4282
4283             if (flags & ANYOF_LOCALE) {
4284                 PL_reg_flags |= RF_tainted;
4285                 f = PL_fold_locale[c];
4286             }
4287             else
4288                 f = PL_fold[c];
4289             if (f != c && ANYOF_BITMAP_TEST(n, f))
4290                 match = TRUE;
4291         }
4292         
4293         if (!match && (flags & ANYOF_CLASS)) {
4294             PL_reg_flags |= RF_tainted;
4295             if (
4296                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4297                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4298                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4299                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4300                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4301                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4302                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4303                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4304                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4305                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4306                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4307                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4308                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4309                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4310                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4311                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4312                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4313                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4314                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4315                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4316                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4317                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4318                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4319                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4320                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4321                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4322                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4323                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4324                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4325                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4326                 ) /* How's that for a conditional? */
4327             {
4328                 match = TRUE;
4329             }
4330         }
4331     }
4332
4333     return (flags & ANYOF_INVERT) ? !match : match;
4334 }
4335
4336 STATIC U8 *
4337 S_reghop(pTHX_ U8 *s, I32 off)
4338 {
4339     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4340 }
4341
4342 STATIC U8 *
4343 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4344 {
4345     if (off >= 0) {
4346         while (off-- && s < lim) {
4347             /* XXX could check well-formedness here */
4348             s += UTF8SKIP(s);
4349         }
4350     }
4351     else {
4352         while (off++) {
4353             if (s > lim) {
4354                 s--;
4355                 if (UTF8_IS_CONTINUED(*s)) {
4356                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4357                         s--;
4358                 }
4359                 /* XXX could check well-formedness here */
4360             }
4361         }
4362     }
4363     return s;
4364 }
4365
4366 STATIC U8 *
4367 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4368 {
4369     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4370 }
4371
4372 STATIC U8 *
4373 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4374 {
4375     if (off >= 0) {
4376         while (off-- && s < lim) {
4377             /* XXX could check well-formedness here */
4378             s += UTF8SKIP(s);
4379         }
4380         if (off >= 0)
4381             return 0;
4382     }
4383     else {
4384         while (off++) {
4385             if (s > lim) {
4386                 s--;
4387                 if (UTF8_IS_CONTINUED(*s)) {
4388                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4389                         s--;
4390                 }
4391                 /* XXX could check well-formedness here */
4392             }
4393             else
4394                 break;
4395         }
4396         if (off <= 0)
4397             return 0;
4398     }
4399     return s;
4400 }
4401
4402 static void
4403 restore_pos(pTHX_ void *arg)
4404 {
4405     if (PL_reg_eval_set) {
4406         if (PL_reg_oldsaved) {
4407             PL_reg_re->subbeg = PL_reg_oldsaved;
4408             PL_reg_re->sublen = PL_reg_oldsavedlen;
4409             RX_MATCH_COPIED_on(PL_reg_re);
4410         }
4411         PL_reg_magic->mg_len = PL_reg_oldpos;
4412         PL_reg_eval_set = 0;
4413         PL_curpm = PL_reg_oldcurpm;
4414     }   
4415 }