0f738d1b27fdee4cc6e535c8afd25ff98d9afff3
[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 = 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                      while (s < e) {
2410                           if (l >= PL_regeol)
2411                                sayNO;
2412                           if (UTF8SKIP(s) != UTF8SKIP(l) ||
2413                               memNE(s, (char*)l, UTF8SKIP(s))) {
2414                                U8 lfoldbuf[UTF8_MAXLEN_FOLD+1];
2415                                STRLEN lfoldlen;
2416
2417                                /* Try one of them folded. */
2418
2419                                to_utf8_fold((U8*)l, lfoldbuf, &lfoldlen);
2420                                if (UTF8SKIP(s) != lfoldlen ||
2421                                    memNE(s, (char*)lfoldbuf, lfoldlen)) {
2422                                     U8 sfoldbuf[UTF8_MAXLEN_FOLD+1];
2423                                     STRLEN sfoldlen;
2424
2425                                     /* Try both of them folded. */
2426
2427                                     to_utf8_fold((U8*)s, sfoldbuf, &sfoldlen);
2428                                     if (sfoldlen != lfoldlen ||
2429                                         memNE((char*)sfoldbuf,
2430                                               (char*)lfoldbuf, lfoldlen))
2431                                       sayNO;
2432                                }
2433                           }
2434                           l += UTF8SKIP(l);
2435                           s += UTF8SKIP(s);
2436                      }
2437                      locinput = l;
2438                      nextchr = UCHARAT(locinput);
2439                      break;
2440                 }
2441             }
2442
2443             /* Neither the target and the pattern are utf8. */
2444
2445             /* Inline the first character, for speed. */
2446             if (UCHARAT(s) != nextchr &&
2447                 UCHARAT(s) != ((OP(scan) == EXACTF)
2448                                ? PL_fold : PL_fold_locale)[nextchr])
2449                 sayNO;
2450             if (PL_regeol - locinput < ln)
2451                 sayNO;
2452             if (ln > 1 && (OP(scan) == EXACTF
2453                            ? ibcmp(s, locinput, ln)
2454                            : ibcmp_locale(s, locinput, ln)))
2455                 sayNO;
2456             locinput += ln;
2457             nextchr = UCHARAT(locinput);
2458             break;
2459         case ANYOF:
2460             if (do_utf8) {
2461                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2462                     sayNO;
2463                 if (locinput >= PL_regeol)
2464                     sayNO;
2465                 locinput += PL_utf8skip[nextchr];
2466                 nextchr = UCHARAT(locinput);
2467             }
2468             else {
2469                 if (nextchr < 0)
2470                     nextchr = UCHARAT(locinput);
2471                 if (!reginclass(scan, (U8*)locinput, do_utf8))
2472                     sayNO;
2473                 if (!nextchr && locinput >= PL_regeol)
2474                     sayNO;
2475                 nextchr = UCHARAT(++locinput);
2476             }
2477             break;
2478         case ALNUML:
2479             PL_reg_flags |= RF_tainted;
2480             /* FALL THROUGH */
2481         case ALNUM:
2482             if (!nextchr)
2483                 sayNO;
2484             if (do_utf8) {
2485                 LOAD_UTF8_CHARCLASS(alnum,"a");
2486                 if (!(OP(scan) == ALNUM
2487                       ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2488                       : isALNUM_LC_utf8((U8*)locinput)))
2489                 {
2490                     sayNO;
2491                 }
2492                 locinput += PL_utf8skip[nextchr];
2493                 nextchr = UCHARAT(locinput);
2494                 break;
2495             }
2496             if (!(OP(scan) == ALNUM
2497                   ? isALNUM(nextchr) : isALNUM_LC(nextchr)))
2498                 sayNO;
2499             nextchr = UCHARAT(++locinput);
2500             break;
2501         case NALNUML:
2502             PL_reg_flags |= RF_tainted;
2503             /* FALL THROUGH */
2504         case NALNUM:
2505             if (!nextchr && locinput >= PL_regeol)
2506                 sayNO;
2507             if (do_utf8) {
2508                 LOAD_UTF8_CHARCLASS(alnum,"a");
2509                 if (OP(scan) == NALNUM
2510                     ? swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8)
2511                     : isALNUM_LC_utf8((U8*)locinput))
2512                 {
2513                     sayNO;
2514                 }
2515                 locinput += PL_utf8skip[nextchr];
2516                 nextchr = UCHARAT(locinput);
2517                 break;
2518             }
2519             if (OP(scan) == NALNUM
2520                 ? isALNUM(nextchr) : isALNUM_LC(nextchr))
2521                 sayNO;
2522             nextchr = UCHARAT(++locinput);
2523             break;
2524         case BOUNDL:
2525         case NBOUNDL:
2526             PL_reg_flags |= RF_tainted;
2527             /* FALL THROUGH */
2528         case BOUND:
2529         case NBOUND:
2530             /* was last char in word? */
2531             if (do_utf8) {
2532                 if (locinput == PL_bostr)
2533                     ln = '\n';
2534                 else {
2535                     U8 *r = reghop((U8*)locinput, -1);
2536                 
2537                     ln = utf8n_to_uvchr(r, s - (char*)r, 0, 0);
2538                 }
2539                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2540                     ln = isALNUM_uni(ln);
2541                     LOAD_UTF8_CHARCLASS(alnum,"a");
2542                     n = swash_fetch(PL_utf8_alnum, (U8*)locinput, do_utf8);
2543                 }
2544                 else {
2545                     ln = isALNUM_LC_uvchr(UNI_TO_NATIVE(ln));
2546                     n = isALNUM_LC_utf8((U8*)locinput);
2547                 }
2548             }
2549             else {
2550                 ln = (locinput != PL_bostr) ?
2551                     UCHARAT(locinput - 1) : '\n';
2552                 if (OP(scan) == BOUND || OP(scan) == NBOUND) {
2553                     ln = isALNUM(ln);
2554                     n = isALNUM(nextchr);
2555                 }
2556                 else {
2557                     ln = isALNUM_LC(ln);
2558                     n = isALNUM_LC(nextchr);
2559                 }
2560             }
2561             if (((!ln) == (!n)) == (OP(scan) == BOUND ||
2562                                     OP(scan) == BOUNDL))
2563                     sayNO;
2564             break;
2565         case SPACEL:
2566             PL_reg_flags |= RF_tainted;
2567             /* FALL THROUGH */
2568         case SPACE:
2569             if (!nextchr)
2570                 sayNO;
2571             if (do_utf8) {
2572                 if (UTF8_IS_CONTINUED(nextchr)) {
2573                     LOAD_UTF8_CHARCLASS(space," ");
2574                     if (!(OP(scan) == SPACE
2575                           ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2576                           : isSPACE_LC_utf8((U8*)locinput)))
2577                     {
2578                         sayNO;
2579                     }
2580                     locinput += PL_utf8skip[nextchr];
2581                     nextchr = UCHARAT(locinput);
2582                     break;
2583                 }
2584                 if (!(OP(scan) == SPACE
2585                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2586                     sayNO;
2587                 nextchr = UCHARAT(++locinput);
2588             }
2589             else {
2590                 if (!(OP(scan) == SPACE
2591                       ? isSPACE(nextchr) : isSPACE_LC(nextchr)))
2592                     sayNO;
2593                 nextchr = UCHARAT(++locinput);
2594             }
2595             break;
2596         case NSPACEL:
2597             PL_reg_flags |= RF_tainted;
2598             /* FALL THROUGH */
2599         case NSPACE:
2600             if (!nextchr && locinput >= PL_regeol)
2601                 sayNO;
2602             if (do_utf8) {
2603                 LOAD_UTF8_CHARCLASS(space," ");
2604                 if (OP(scan) == NSPACE
2605                     ? swash_fetch(PL_utf8_space, (U8*)locinput, do_utf8)
2606                     : isSPACE_LC_utf8((U8*)locinput))
2607                 {
2608                     sayNO;
2609                 }
2610                 locinput += PL_utf8skip[nextchr];
2611                 nextchr = UCHARAT(locinput);
2612                 break;
2613             }
2614             if (OP(scan) == NSPACE
2615                 ? isSPACE(nextchr) : isSPACE_LC(nextchr))
2616                 sayNO;
2617             nextchr = UCHARAT(++locinput);
2618             break;
2619         case DIGITL:
2620             PL_reg_flags |= RF_tainted;
2621             /* FALL THROUGH */
2622         case DIGIT:
2623             if (!nextchr)
2624                 sayNO;
2625             if (do_utf8) {
2626                 LOAD_UTF8_CHARCLASS(digit,"0");
2627                 if (!(OP(scan) == DIGIT
2628                       ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2629                       : isDIGIT_LC_utf8((U8*)locinput)))
2630                 {
2631                     sayNO;
2632                 }
2633                 locinput += PL_utf8skip[nextchr];
2634                 nextchr = UCHARAT(locinput);
2635                 break;
2636             }
2637             if (!(OP(scan) == DIGIT
2638                   ? isDIGIT(nextchr) : isDIGIT_LC(nextchr)))
2639                 sayNO;
2640             nextchr = UCHARAT(++locinput);
2641             break;
2642         case NDIGITL:
2643             PL_reg_flags |= RF_tainted;
2644             /* FALL THROUGH */
2645         case NDIGIT:
2646             if (!nextchr && locinput >= PL_regeol)
2647                 sayNO;
2648             if (do_utf8) {
2649                 LOAD_UTF8_CHARCLASS(digit,"0");
2650                 if (OP(scan) == NDIGIT
2651                     ? swash_fetch(PL_utf8_digit, (U8*)locinput, do_utf8)
2652                     : isDIGIT_LC_utf8((U8*)locinput))
2653                 {
2654                     sayNO;
2655                 }
2656                 locinput += PL_utf8skip[nextchr];
2657                 nextchr = UCHARAT(locinput);
2658                 break;
2659             }
2660             if (OP(scan) == NDIGIT
2661                 ? isDIGIT(nextchr) : isDIGIT_LC(nextchr))
2662                 sayNO;
2663             nextchr = UCHARAT(++locinput);
2664             break;
2665         case CLUMP:
2666             if (locinput >= PL_regeol)
2667                 sayNO;
2668             if  (do_utf8) {
2669                 LOAD_UTF8_CHARCLASS(mark,"~");
2670                 if (swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2671                     sayNO;
2672                 locinput += PL_utf8skip[nextchr];
2673                 while (locinput < PL_regeol &&
2674                        swash_fetch(PL_utf8_mark,(U8*)locinput, do_utf8))
2675                     locinput += UTF8SKIP(locinput);
2676                 if (locinput > PL_regeol)
2677                     sayNO;
2678             } 
2679             else
2680                locinput++;
2681             nextchr = UCHARAT(locinput);
2682             break;
2683         case REFFL:
2684             PL_reg_flags |= RF_tainted;
2685             /* FALL THROUGH */
2686         case REF:
2687         case REFF:
2688             n = ARG(scan);  /* which paren pair */
2689             ln = PL_regstartp[n];
2690             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2691             if (*PL_reglastparen < n || ln == -1)
2692                 sayNO;                  /* Do not match unless seen CLOSEn. */
2693             if (ln == PL_regendp[n])
2694                 break;
2695
2696             s = PL_bostr + ln;
2697             if (do_utf8 && OP(scan) != REF) {   /* REF can do byte comparison */
2698                 char *l = locinput;
2699                 char *e = PL_bostr + PL_regendp[n];
2700                 /*
2701                  * Note that we can't do the "other character" lookup trick as
2702                  * in the 8-bit case (no pun intended) because in Unicode we
2703                  * have to map both upper and title case to lower case.
2704                  */
2705                 if (OP(scan) == REFF) {
2706                     STRLEN ulen1, ulen2;
2707                     U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
2708                     U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
2709                     while (s < e) {
2710                         if (l >= PL_regeol)
2711                             sayNO;
2712                         toLOWER_utf8((U8*)s, tmpbuf1, &ulen1);
2713                         toLOWER_utf8((U8*)l, tmpbuf2, &ulen2);
2714                         if (ulen1 != ulen2 || memNE((char *)tmpbuf1, (char *)tmpbuf2, ulen1))
2715                             sayNO;
2716                         s += ulen1;
2717                         l += ulen2;
2718                     }
2719                 }
2720                 locinput = l;
2721                 nextchr = UCHARAT(locinput);
2722                 break;
2723             }
2724
2725             /* Inline the first character, for speed. */
2726             if (UCHARAT(s) != nextchr &&
2727                 (OP(scan) == REF ||
2728                  (UCHARAT(s) != ((OP(scan) == REFF
2729                                   ? PL_fold : PL_fold_locale)[nextchr]))))
2730                 sayNO;
2731             ln = PL_regendp[n] - ln;
2732             if (locinput + ln > PL_regeol)
2733                 sayNO;
2734             if (ln > 1 && (OP(scan) == REF
2735                            ? memNE(s, locinput, ln)
2736                            : (OP(scan) == REFF
2737                               ? ibcmp(s, locinput, ln)
2738                               : ibcmp_locale(s, locinput, ln))))
2739                 sayNO;
2740             locinput += ln;
2741             nextchr = UCHARAT(locinput);
2742             break;
2743
2744         case NOTHING:
2745         case TAIL:
2746             break;
2747         case BACK:
2748             break;
2749         case EVAL:
2750         {
2751             dSP;
2752             OP_4tree *oop = PL_op;
2753             COP *ocurcop = PL_curcop;
2754             SV **ocurpad = PL_curpad;
2755             SV *ret;
2756         
2757             n = ARG(scan);
2758             PL_op = (OP_4tree*)PL_regdata->data[n];
2759             DEBUG_r( PerlIO_printf(Perl_debug_log, "  re_eval 0x%"UVxf"\n", PTR2UV(PL_op)) );
2760             PL_curpad = AvARRAY((AV*)PL_regdata->data[n + 2]);
2761             PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
2762
2763             {
2764                 SV **before = SP;
2765                 CALLRUNOPS(aTHX);                       /* Scalar context. */
2766                 SPAGAIN;
2767                 if (SP == before)
2768                     ret = Nullsv;   /* protect against empty (?{}) blocks. */
2769                 else {
2770                     ret = POPs;
2771                     PUTBACK;
2772                 }
2773             }
2774
2775             PL_op = oop;
2776             PL_curpad = ocurpad;
2777             PL_curcop = ocurcop;
2778             if (logical) {
2779                 if (logical == 2) {     /* Postponed subexpression. */
2780                     regexp *re;
2781                     MAGIC *mg = Null(MAGIC*);
2782                     re_cc_state state;
2783                     CHECKPOINT cp, lastcp;
2784
2785                     if(SvROK(ret) || SvRMAGICAL(ret)) {
2786                         SV *sv = SvROK(ret) ? SvRV(ret) : ret;
2787
2788                         if(SvMAGICAL(sv))
2789                             mg = mg_find(sv, PERL_MAGIC_qr);
2790                     }
2791                     if (mg) {
2792                         re = (regexp *)mg->mg_obj;
2793                         (void)ReREFCNT_inc(re);
2794                     }
2795                     else {
2796                         STRLEN len;
2797                         char *t = SvPV(ret, len);
2798                         PMOP pm;
2799                         char *oprecomp = PL_regprecomp;
2800                         I32 osize = PL_regsize;
2801                         I32 onpar = PL_regnpar;
2802
2803                         Zero(&pm, 1, PMOP);
2804                         re = CALLREGCOMP(aTHX_ t, t + len, &pm);
2805                         if (!(SvFLAGS(ret)
2806                               & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)))
2807                             sv_magic(ret,(SV*)ReREFCNT_inc(re),
2808                                         PERL_MAGIC_qr,0,0);
2809                         PL_regprecomp = oprecomp;
2810                         PL_regsize = osize;
2811                         PL_regnpar = onpar;
2812                     }
2813                     DEBUG_r(
2814                         PerlIO_printf(Perl_debug_log,
2815                                       "Entering embedded `%s%.60s%s%s'\n",
2816                                       PL_colors[0],
2817                                       re->precomp,
2818                                       PL_colors[1],
2819                                       (strlen(re->precomp) > 60 ? "..." : ""))
2820                         );
2821                     state.node = next;
2822                     state.prev = PL_reg_call_cc;
2823                     state.cc = PL_regcc;
2824                     state.re = PL_reg_re;
2825
2826                     PL_regcc = 0;
2827                 
2828                     cp = regcppush(0);  /* Save *all* the positions. */
2829                     REGCP_SET(lastcp);
2830                     cache_re(re);
2831                     state.ss = PL_savestack_ix;
2832                     *PL_reglastparen = 0;
2833                     *PL_reglastcloseparen = 0;
2834                     PL_reg_call_cc = &state;
2835                     PL_reginput = locinput;
2836
2837                     /* XXXX This is too dramatic a measure... */
2838                     PL_reg_maxiter = 0;
2839
2840                     if (regmatch(re->program + 1)) {
2841                         /* Even though we succeeded, we need to restore
2842                            global variables, since we may be wrapped inside
2843                            SUSPEND, thus the match may be not finished yet. */
2844
2845                         /* XXXX Do this only if SUSPENDed? */
2846                         PL_reg_call_cc = state.prev;
2847                         PL_regcc = state.cc;
2848                         PL_reg_re = state.re;
2849                         cache_re(PL_reg_re);
2850
2851                         /* XXXX This is too dramatic a measure... */
2852                         PL_reg_maxiter = 0;
2853
2854                         /* These are needed even if not SUSPEND. */
2855                         ReREFCNT_dec(re);
2856                         regcpblow(cp);
2857                         sayYES;
2858                     }
2859                     ReREFCNT_dec(re);
2860                     REGCP_UNWIND(lastcp);
2861                     regcppop();
2862                     PL_reg_call_cc = state.prev;
2863                     PL_regcc = state.cc;
2864                     PL_reg_re = state.re;
2865                     cache_re(PL_reg_re);
2866
2867                     /* XXXX This is too dramatic a measure... */
2868                     PL_reg_maxiter = 0;
2869
2870                     logical = 0;
2871                     sayNO;
2872                 }
2873                 sw = SvTRUE(ret);
2874                 logical = 0;
2875             }
2876             else
2877                 sv_setsv(save_scalar(PL_replgv), ret);
2878             break;
2879         }
2880         case OPEN:
2881             n = ARG(scan);  /* which paren pair */
2882             PL_reg_start_tmp[n] = locinput;
2883             if (n > PL_regsize)
2884                 PL_regsize = n;
2885             break;
2886         case CLOSE:
2887             n = ARG(scan);  /* which paren pair */
2888             PL_regstartp[n] = PL_reg_start_tmp[n] - PL_bostr;
2889             PL_regendp[n] = locinput - PL_bostr;
2890             if (n > *PL_reglastparen)
2891                 *PL_reglastparen = n;
2892             *PL_reglastcloseparen = n;
2893             break;
2894         case GROUPP:
2895             n = ARG(scan);  /* which paren pair */
2896             sw = (*PL_reglastparen >= n && PL_regendp[n] != -1);
2897             break;
2898         case IFTHEN:
2899             PL_reg_leftiter = PL_reg_maxiter;           /* Void cache */
2900             if (sw)
2901                 next = NEXTOPER(NEXTOPER(scan));
2902             else {
2903                 next = scan + ARG(scan);
2904                 if (OP(next) == IFTHEN) /* Fake one. */
2905                     next = NEXTOPER(NEXTOPER(next));
2906             }
2907             break;
2908         case LOGICAL:
2909             logical = scan->flags;
2910             break;
2911 /*******************************************************************
2912  PL_regcc contains infoblock about the innermost (...)* loop, and
2913  a pointer to the next outer infoblock.
2914
2915  Here is how Y(A)*Z is processed (if it is compiled into CURLYX/WHILEM):
2916
2917    1) After matching X, regnode for CURLYX is processed;
2918
2919    2) This regnode creates infoblock on the stack, and calls
2920       regmatch() recursively with the starting point at WHILEM node;
2921
2922    3) Each hit of WHILEM node tries to match A and Z (in the order
2923       depending on the current iteration, min/max of {min,max} and
2924       greediness).  The information about where are nodes for "A"
2925       and "Z" is read from the infoblock, as is info on how many times "A"
2926       was already matched, and greediness.
2927
2928    4) After A matches, the same WHILEM node is hit again.
2929
2930    5) Each time WHILEM is hit, PL_regcc is the infoblock created by CURLYX
2931       of the same pair.  Thus when WHILEM tries to match Z, it temporarily
2932       resets PL_regcc, since this Y(A)*Z can be a part of some other loop:
2933       as in (Y(A)*Z)*.  If Z matches, the automaton will hit the WHILEM node
2934       of the external loop.
2935
2936  Currently present infoblocks form a tree with a stem formed by PL_curcc
2937  and whatever it mentions via ->next, and additional attached trees
2938  corresponding to temporarily unset infoblocks as in "5" above.
2939
2940  In the following picture infoblocks for outer loop of
2941  (Y(A)*?Z)*?T are denoted O, for inner I.  NULL starting block
2942  is denoted by x.  The matched string is YAAZYAZT.  Temporarily postponed
2943  infoblocks are drawn below the "reset" infoblock.
2944
2945  In fact in the picture below we do not show failed matches for Z and T
2946  by WHILEM blocks.  [We illustrate minimal matches, since for them it is
2947  more obvious *why* one needs to *temporary* unset infoblocks.]
2948
2949   Matched       REx position    InfoBlocks      Comment
2950                 (Y(A)*?Z)*?T    x
2951                 Y(A)*?Z)*?T     x <- O
2952   Y             (A)*?Z)*?T      x <- O
2953   Y             A)*?Z)*?T       x <- O <- I
2954   YA            )*?Z)*?T        x <- O <- I
2955   YA            A)*?Z)*?T       x <- O <- I
2956   YAA           )*?Z)*?T        x <- O <- I
2957   YAA           Z)*?T           x <- O          # Temporary unset I
2958                                      I
2959
2960   YAAZ          Y(A)*?Z)*?T     x <- O
2961                                      I
2962
2963   YAAZY         (A)*?Z)*?T      x <- O
2964                                      I
2965
2966   YAAZY         A)*?Z)*?T       x <- O <- I
2967                                      I
2968
2969   YAAZYA        )*?Z)*?T        x <- O <- I     
2970                                      I
2971
2972   YAAZYA        Z)*?T           x <- O          # Temporary unset I
2973                                      I,I
2974
2975   YAAZYAZ       )*?T            x <- O
2976                                      I,I
2977
2978   YAAZYAZ       T               x               # Temporary unset O
2979                                 O
2980                                 I,I
2981
2982   YAAZYAZT                      x
2983                                 O
2984                                 I,I
2985  *******************************************************************/
2986         case CURLYX: {
2987                 CURCUR cc;
2988                 CHECKPOINT cp = PL_savestack_ix;
2989                 /* No need to save/restore up to this paren */
2990                 I32 parenfloor = scan->flags;
2991
2992                 if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */
2993                     next += ARG(next);
2994                 cc.oldcc = PL_regcc;
2995                 PL_regcc = &cc;
2996                 /* XXXX Probably it is better to teach regpush to support
2997                    parenfloor > PL_regsize... */
2998                 if (parenfloor > *PL_reglastparen)
2999                     parenfloor = *PL_reglastparen; /* Pessimization... */
3000                 cc.parenfloor = parenfloor;
3001                 cc.cur = -1;
3002                 cc.min = ARG1(scan);
3003                 cc.max  = ARG2(scan);
3004                 cc.scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS;
3005                 cc.next = next;
3006                 cc.minmod = minmod;
3007                 cc.lastloc = 0;
3008                 PL_reginput = locinput;
3009                 n = regmatch(PREVOPER(next));   /* start on the WHILEM */
3010                 regcpblow(cp);
3011                 PL_regcc = cc.oldcc;
3012                 saySAME(n);
3013             }
3014             /* NOT REACHED */
3015         case WHILEM: {
3016                 /*
3017                  * This is really hard to understand, because after we match
3018                  * what we're trying to match, we must make sure the rest of
3019                  * the REx is going to match for sure, and to do that we have
3020                  * to go back UP the parse tree by recursing ever deeper.  And
3021                  * if it fails, we have to reset our parent's current state
3022                  * that we can try again after backing off.
3023                  */
3024
3025                 CHECKPOINT cp, lastcp;
3026                 CURCUR* cc = PL_regcc;
3027                 char *lastloc = cc->lastloc; /* Detection of 0-len. */
3028                 
3029                 n = cc->cur + 1;        /* how many we know we matched */
3030                 PL_reginput = locinput;
3031
3032                 DEBUG_r(
3033                     PerlIO_printf(Perl_debug_log,
3034                                   "%*s  %ld out of %ld..%ld  cc=%lx\n",
3035                                   REPORT_CODE_OFF+PL_regindent*2, "",
3036                                   (long)n, (long)cc->min,
3037                                   (long)cc->max, (long)cc)
3038                     );
3039
3040                 /* If degenerate scan matches "", assume scan done. */
3041
3042                 if (locinput == cc->lastloc && n >= cc->min) {
3043                     PL_regcc = cc->oldcc;
3044                     if (PL_regcc)
3045                         ln = PL_regcc->cur;
3046                     DEBUG_r(
3047                         PerlIO_printf(Perl_debug_log,
3048                            "%*s  empty match detected, try continuation...\n",
3049                            REPORT_CODE_OFF+PL_regindent*2, "")
3050                         );
3051                     if (regmatch(cc->next))
3052                         sayYES;
3053                     if (PL_regcc)
3054                         PL_regcc->cur = ln;
3055                     PL_regcc = cc;
3056                     sayNO;
3057                 }
3058
3059                 /* First just match a string of min scans. */
3060
3061                 if (n < cc->min) {
3062                     cc->cur = n;
3063                     cc->lastloc = locinput;
3064                     if (regmatch(cc->scan))
3065                         sayYES;
3066                     cc->cur = n - 1;
3067                     cc->lastloc = lastloc;
3068                     sayNO;
3069                 }
3070
3071                 if (scan->flags) {
3072                     /* Check whether we already were at this position.
3073                         Postpone detection until we know the match is not
3074                         *that* much linear. */
3075                 if (!PL_reg_maxiter) {
3076                     PL_reg_maxiter = (PL_regeol - PL_bostr + 1) * (scan->flags>>4);
3077                     PL_reg_leftiter = PL_reg_maxiter;
3078                 }
3079                 if (PL_reg_leftiter-- == 0) {
3080                     I32 size = (PL_reg_maxiter + 7)/8;
3081                     if (PL_reg_poscache) {
3082                         if (PL_reg_poscache_size < size) {
3083                             Renew(PL_reg_poscache, size, char);
3084                             PL_reg_poscache_size = size;
3085                         }
3086                         Zero(PL_reg_poscache, size, char);
3087                     }
3088                     else {
3089                         PL_reg_poscache_size = size;
3090                         Newz(29, PL_reg_poscache, size, char);
3091                     }
3092                     DEBUG_r(
3093                         PerlIO_printf(Perl_debug_log,
3094               "%sDetected a super-linear match, switching on caching%s...\n",
3095                                       PL_colors[4], PL_colors[5])
3096                         );
3097                 }
3098                 if (PL_reg_leftiter < 0) {
3099                     I32 o = locinput - PL_bostr, b;
3100
3101                     o = (scan->flags & 0xf) - 1 + o * (scan->flags>>4);
3102                     b = o % 8;
3103                     o /= 8;
3104                     if (PL_reg_poscache[o] & (1<<b)) {
3105                     DEBUG_r(
3106                         PerlIO_printf(Perl_debug_log,
3107                                       "%*s  already tried at this position...\n",
3108                                       REPORT_CODE_OFF+PL_regindent*2, "")
3109                         );
3110                         sayNO_SILENT;
3111                     }
3112                     PL_reg_poscache[o] |= (1<<b);
3113                 }
3114                 }
3115
3116                 /* Prefer next over scan for minimal matching. */
3117
3118                 if (cc->minmod) {
3119                     PL_regcc = cc->oldcc;
3120                     if (PL_regcc)
3121                         ln = PL_regcc->cur;
3122                     cp = regcppush(cc->parenfloor);
3123                     REGCP_SET(lastcp);
3124                     if (regmatch(cc->next)) {
3125                         regcpblow(cp);
3126                         sayYES; /* All done. */
3127                     }
3128                     REGCP_UNWIND(lastcp);
3129                     regcppop();
3130                     if (PL_regcc)
3131                         PL_regcc->cur = ln;
3132                     PL_regcc = cc;
3133
3134                     if (n >= cc->max) { /* Maximum greed exceeded? */
3135                         if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3136                             && !(PL_reg_flags & RF_warned)) {
3137                             PL_reg_flags |= RF_warned;
3138                             Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3139                                  "Complex regular subexpression recursion",
3140                                  REG_INFTY - 1);
3141                         }
3142                         sayNO;
3143                     }
3144
3145                     DEBUG_r(
3146                         PerlIO_printf(Perl_debug_log,
3147                                       "%*s  trying longer...\n",
3148                                       REPORT_CODE_OFF+PL_regindent*2, "")
3149                         );
3150                     /* Try scanning more and see if it helps. */
3151                     PL_reginput = locinput;
3152                     cc->cur = n;
3153                     cc->lastloc = locinput;
3154                     cp = regcppush(cc->parenfloor);
3155                     REGCP_SET(lastcp);
3156                     if (regmatch(cc->scan)) {
3157                         regcpblow(cp);
3158                         sayYES;
3159                     }
3160                     REGCP_UNWIND(lastcp);
3161                     regcppop();
3162                     cc->cur = n - 1;
3163                     cc->lastloc = lastloc;
3164                     sayNO;
3165                 }
3166
3167                 /* Prefer scan over next for maximal matching. */
3168
3169                 if (n < cc->max) {      /* More greed allowed? */
3170                     cp = regcppush(cc->parenfloor);
3171                     cc->cur = n;
3172                     cc->lastloc = locinput;
3173                     REGCP_SET(lastcp);
3174                     if (regmatch(cc->scan)) {
3175                         regcpblow(cp);
3176                         sayYES;
3177                     }
3178                     REGCP_UNWIND(lastcp);
3179                     regcppop();         /* Restore some previous $<digit>s? */
3180                     PL_reginput = locinput;
3181                     DEBUG_r(
3182                         PerlIO_printf(Perl_debug_log,
3183                                       "%*s  failed, try continuation...\n",
3184                                       REPORT_CODE_OFF+PL_regindent*2, "")
3185                         );
3186                 }
3187                 if (ckWARN(WARN_REGEXP) && n >= REG_INFTY
3188                         && !(PL_reg_flags & RF_warned)) {
3189                     PL_reg_flags |= RF_warned;
3190                     Perl_warner(aTHX_ WARN_REGEXP, "%s limit (%d) exceeded",
3191                          "Complex regular subexpression recursion",
3192                          REG_INFTY - 1);
3193                 }
3194
3195                 /* Failed deeper matches of scan, so see if this one works. */
3196                 PL_regcc = cc->oldcc;
3197                 if (PL_regcc)
3198                     ln = PL_regcc->cur;
3199                 if (regmatch(cc->next))
3200                     sayYES;
3201                 if (PL_regcc)
3202                     PL_regcc->cur = ln;
3203                 PL_regcc = cc;
3204                 cc->cur = n - 1;
3205                 cc->lastloc = lastloc;
3206                 sayNO;
3207             }
3208             /* NOT REACHED */
3209         case BRANCHJ:
3210             next = scan + ARG(scan);
3211             if (next == scan)
3212                 next = NULL;
3213             inner = NEXTOPER(NEXTOPER(scan));
3214             goto do_branch;
3215         case BRANCH:
3216             inner = NEXTOPER(scan);
3217           do_branch:
3218             {
3219                 c1 = OP(scan);
3220                 if (OP(next) != c1)     /* No choice. */
3221                     next = inner;       /* Avoid recursion. */
3222                 else {
3223                     I32 lastparen = *PL_reglastparen;
3224                     I32 unwind1;
3225                     re_unwind_branch_t *uw;
3226
3227                     /* Put unwinding data on stack */
3228                     unwind1 = SSNEWt(1,re_unwind_branch_t);
3229                     uw = SSPTRt(unwind1,re_unwind_branch_t);
3230                     uw->prev = unwind;
3231                     unwind = unwind1;
3232                     uw->type = ((c1 == BRANCH)
3233                                 ? RE_UNWIND_BRANCH
3234                                 : RE_UNWIND_BRANCHJ);
3235                     uw->lastparen = lastparen;
3236                     uw->next = next;
3237                     uw->locinput = locinput;
3238                     uw->nextchr = nextchr;
3239 #ifdef DEBUGGING
3240                     uw->regindent = ++PL_regindent;
3241 #endif
3242
3243                     REGCP_SET(uw->lastcp);
3244
3245                     /* Now go into the first branch */
3246                     next = inner;
3247                 }
3248             }
3249             break;
3250         case MINMOD:
3251             minmod = 1;
3252             break;
3253         case CURLYM:
3254         {
3255             I32 l = 0;
3256             CHECKPOINT lastcp;
3257         
3258             /* We suppose that the next guy does not need
3259                backtracking: in particular, it is of constant length,
3260                and has no parenths to influence future backrefs. */
3261             ln = ARG1(scan);  /* min to match */
3262             n  = ARG2(scan);  /* max to match */
3263             paren = scan->flags;
3264             if (paren) {
3265                 if (paren > PL_regsize)
3266                     PL_regsize = paren;
3267                 if (paren > *PL_reglastparen)
3268                     *PL_reglastparen = paren;
3269             }
3270             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3271             if (paren)
3272                 scan += NEXT_OFF(scan); /* Skip former OPEN. */
3273             PL_reginput = locinput;
3274             if (minmod) {
3275                 minmod = 0;
3276                 if (ln && regrepeat_hard(scan, ln, &l) < ln)
3277                     sayNO;
3278                 /* if we matched something zero-length we don't need to
3279                    backtrack - capturing parens are already defined, so
3280                    the caveat in the maximal case doesn't apply
3281
3282                    XXXX if ln == 0, we can redo this check first time
3283                    through the following loop
3284                 */
3285                 if (ln && l == 0)
3286                     n = ln;     /* don't backtrack */
3287                 locinput = PL_reginput;
3288                 if (HAS_TEXT(next) || JUMPABLE(next)) {
3289                     regnode *text_node = next;
3290
3291                     if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3292
3293                     if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3294                     else {
3295                         if (PL_regkind[(U8)OP(text_node)] == REF) {
3296                             I32 n, ln;
3297                             n = ARG(text_node);  /* which paren pair */
3298                             ln = PL_regstartp[n];
3299                             /* assume yes if we haven't seen CLOSEn */
3300                             if (
3301                                 *PL_reglastparen < n ||
3302                                 ln == -1 ||
3303                                 ln == PL_regendp[n]
3304                             ) {
3305                                 c1 = c2 = -1000;
3306                                 goto assume_ok_MM;
3307                             }
3308                             c1 = *(PL_bostr + ln);
3309                         }
3310                         else { c1 = (U8)*STRING(text_node); }
3311                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3312                             c2 = PL_fold[c1];
3313                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3314                             c2 = PL_fold_locale[c1];
3315                         else
3316                             c2 = c1;
3317                     }
3318                 }
3319                 else
3320                     c1 = c2 = -1000;
3321             assume_ok_MM:
3322                 REGCP_SET(lastcp);
3323                 /* This may be improved if l == 0.  */
3324                 while (n >= ln || (n == REG_INFTY && ln > 0 && l)) { /* ln overflow ? */
3325                     /* If it could work, try it. */
3326                     if (c1 == -1000 ||
3327                         UCHARAT(PL_reginput) == c1 ||
3328                         UCHARAT(PL_reginput) == c2)
3329                     {
3330                         if (paren) {
3331                             if (ln) {
3332                                 PL_regstartp[paren] =
3333                                     HOPc(PL_reginput, -l) - PL_bostr;
3334                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3335                             }
3336                             else
3337                                 PL_regendp[paren] = -1;
3338                         }
3339                         if (regmatch(next))
3340                             sayYES;
3341                         REGCP_UNWIND(lastcp);
3342                     }
3343                     /* Couldn't or didn't -- move forward. */
3344                     PL_reginput = locinput;
3345                     if (regrepeat_hard(scan, 1, &l)) {
3346                         ln++;
3347                         locinput = PL_reginput;
3348                     }
3349                     else
3350                         sayNO;
3351                 }
3352             }
3353             else {
3354                 n = regrepeat_hard(scan, n, &l);
3355                 /* if we matched something zero-length we don't need to
3356                    backtrack, unless the minimum count is zero and we
3357                    are capturing the result - in that case the capture
3358                    being defined or not may affect later execution
3359                 */
3360                 if (n != 0 && l == 0 && !(paren && ln == 0))
3361                     ln = n;     /* don't backtrack */
3362                 locinput = PL_reginput;
3363                 DEBUG_r(
3364                     PerlIO_printf(Perl_debug_log,
3365                                   "%*s  matched %"IVdf" times, len=%"IVdf"...\n",
3366                                   (int)(REPORT_CODE_OFF+PL_regindent*2), "",
3367                                   (IV) n, (IV)l)
3368                     );
3369                 if (n >= ln) {
3370                     if (HAS_TEXT(next) || JUMPABLE(next)) {
3371                         regnode *text_node = next;
3372
3373                         if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3374
3375                         if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3376                         else {
3377                             if (PL_regkind[(U8)OP(text_node)] == REF) {
3378                                 I32 n, ln;
3379                                 n = ARG(text_node);  /* which paren pair */
3380                                 ln = PL_regstartp[n];
3381                                 /* assume yes if we haven't seen CLOSEn */
3382                                 if (
3383                                     *PL_reglastparen < n ||
3384                                     ln == -1 ||
3385                                     ln == PL_regendp[n]
3386                                 ) {
3387                                     c1 = c2 = -1000;
3388                                     goto assume_ok_REG;
3389                                 }
3390                                 c1 = *(PL_bostr + ln);
3391                             }
3392                             else { c1 = (U8)*STRING(text_node); }
3393
3394                             if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3395                                 c2 = PL_fold[c1];
3396                             else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3397                                 c2 = PL_fold_locale[c1];
3398                             else
3399                                 c2 = c1;
3400                         }
3401                     }
3402                     else
3403                         c1 = c2 = -1000;
3404                 }
3405             assume_ok_REG:
3406                 REGCP_SET(lastcp);
3407                 while (n >= ln) {
3408                     /* If it could work, try it. */
3409                     if (c1 == -1000 ||
3410                         UCHARAT(PL_reginput) == c1 ||
3411                         UCHARAT(PL_reginput) == c2)
3412                     {
3413                         DEBUG_r(
3414                                 PerlIO_printf(Perl_debug_log,
3415                                               "%*s  trying tail with n=%"IVdf"...\n",
3416                                               (int)(REPORT_CODE_OFF+PL_regindent*2), "", (IV)n)
3417                             );
3418                         if (paren) {
3419                             if (n) {
3420                                 PL_regstartp[paren] = HOPc(PL_reginput, -l) - PL_bostr;
3421                                 PL_regendp[paren] = PL_reginput - PL_bostr;
3422                             }
3423                             else
3424                                 PL_regendp[paren] = -1;
3425                         }
3426                         if (regmatch(next))
3427                             sayYES;
3428                         REGCP_UNWIND(lastcp);
3429                     }
3430                     /* Couldn't or didn't -- back up. */
3431                     n--;
3432                     locinput = HOPc(locinput, -l);
3433                     PL_reginput = locinput;
3434                 }
3435             }
3436             sayNO;
3437             break;
3438         }
3439         case CURLYN:
3440             paren = scan->flags;        /* Which paren to set */
3441             if (paren > PL_regsize)
3442                 PL_regsize = paren;
3443             if (paren > *PL_reglastparen)
3444                 *PL_reglastparen = paren;
3445             ln = ARG1(scan);  /* min to match */
3446             n  = ARG2(scan);  /* max to match */
3447             scan = regnext(NEXTOPER(scan) + NODE_STEP_REGNODE);
3448             goto repeat;
3449         case CURLY:
3450             paren = 0;
3451             ln = ARG1(scan);  /* min to match */
3452             n  = ARG2(scan);  /* max to match */
3453             scan = NEXTOPER(scan) + NODE_STEP_REGNODE;
3454             goto repeat;
3455         case STAR:
3456             ln = 0;
3457             n = REG_INFTY;
3458             scan = NEXTOPER(scan);
3459             paren = 0;
3460             goto repeat;
3461         case PLUS:
3462             ln = 1;
3463             n = REG_INFTY;
3464             scan = NEXTOPER(scan);
3465             paren = 0;
3466           repeat:
3467             /*
3468             * Lookahead to avoid useless match attempts
3469             * when we know what character comes next.
3470             */
3471
3472             /*
3473             * Used to only do .*x and .*?x, but now it allows
3474             * for )'s, ('s and (?{ ... })'s to be in the way
3475             * of the quantifier and the EXACT-like node.  -- japhy
3476             */
3477
3478             if (HAS_TEXT(next) || JUMPABLE(next)) {
3479                 U8 *s;
3480                 regnode *text_node = next;
3481
3482                 if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node);
3483
3484                 if (! HAS_TEXT(text_node)) c1 = c2 = -1000;
3485                 else {
3486                     if (PL_regkind[(U8)OP(text_node)] == REF) {
3487                         I32 n, ln;
3488                         n = ARG(text_node);  /* which paren pair */
3489                         ln = PL_regstartp[n];
3490                         /* assume yes if we haven't seen CLOSEn */
3491                         if (
3492                             *PL_reglastparen < n ||
3493                             ln == -1 ||
3494                             ln == PL_regendp[n]
3495                         ) {
3496                             c1 = c2 = -1000;
3497                             goto assume_ok_easy;
3498                         }
3499                         s = (U8*)PL_bostr + ln;
3500                     }
3501                     else { s = (U8*)STRING(text_node); }
3502
3503                     if (!UTF) {
3504                         c2 = c1 = *s;
3505                         if (OP(text_node) == EXACTF || OP(text_node) == REFF)
3506                             c2 = PL_fold[c1];
3507                         else if (OP(text_node) == EXACTFL || OP(text_node) == REFFL)
3508                             c2 = PL_fold_locale[c1];
3509                     }
3510                     else { /* UTF */
3511                         if (OP(text_node) == EXACTF || OP(text_node) == REFF) {
3512                              STRLEN ulen1, ulen2;
3513                              U8 tmpbuf1[UTF8_MAXLEN_UCLC+1];
3514                              U8 tmpbuf2[UTF8_MAXLEN_UCLC+1];
3515
3516                              to_utf8_lower((U8*)s, tmpbuf1, &ulen1);
3517                              to_utf8_upper((U8*)s, tmpbuf2, &ulen2);
3518
3519                              c1 = utf8_to_uvuni(tmpbuf1, 0);
3520                              c2 = utf8_to_uvuni(tmpbuf2, 0);
3521                         }
3522                         else {
3523                             c2 = c1 = utf8_to_uvchr(s, NULL);
3524                         }
3525                     }
3526                 }
3527             }
3528             else
3529                 c1 = c2 = -1000;
3530         assume_ok_easy:
3531             PL_reginput = locinput;
3532             if (minmod) {
3533                 CHECKPOINT lastcp;
3534                 minmod = 0;
3535                 if (ln && regrepeat(scan, ln) < ln)
3536                     sayNO;
3537                 locinput = PL_reginput;
3538                 REGCP_SET(lastcp);
3539                 if (c1 != -1000) {
3540                     char *e; /* Should not check after this */
3541                     char *old = locinput;
3542
3543                     if  (n == REG_INFTY) {
3544                         e = PL_regeol - 1;
3545                         if (do_utf8)
3546                             while (UTF8_IS_CONTINUATION(*(U8*)e))
3547                                 e--;
3548                     }
3549                     else if (do_utf8) {
3550                         int m = n - ln;
3551                         for (e = locinput;
3552                              m >0 && e + UTF8SKIP(e) <= PL_regeol; m--)
3553                             e += UTF8SKIP(e);
3554                     }
3555                     else {
3556                         e = locinput + n - ln;
3557                         if (e >= PL_regeol)
3558                             e = PL_regeol - 1;
3559                     }
3560                     while (1) {
3561                         int count;
3562                         /* Find place 'next' could work */
3563                         if (!do_utf8) {
3564                             if (c1 == c2) {
3565                                 while (locinput <= e &&
3566                                        UCHARAT(locinput) != c1)
3567                                     locinput++;
3568                             } else {
3569                                 while (locinput <= e
3570                                        && UCHARAT(locinput) != c1
3571                                        && UCHARAT(locinput) != c2)
3572                                     locinput++;
3573                             }
3574                             count = locinput - old;
3575                         }
3576                         else {
3577                             STRLEN len;
3578                             if (c1 == c2) {
3579                                 for (count = 0;
3580                                      locinput <= e &&
3581                                          utf8_to_uvchr((U8*)locinput, &len) != c1;
3582                                      count++)
3583                                     locinput += len;
3584                                 
3585                             } else {
3586                                 for (count = 0; locinput <= e; count++) {
3587                                     UV c = utf8_to_uvchr((U8*)locinput, &len);
3588                                     if (c == c1 || c == c2)
3589                                         break;
3590                                     locinput += len;                    
3591                                 }
3592                             }
3593                         }
3594                         if (locinput > e)
3595                             sayNO;
3596                         /* PL_reginput == old now */
3597                         if (locinput != old) {
3598                             ln = 1;     /* Did some */
3599                             if (regrepeat(scan, count) < count)
3600                                 sayNO;
3601                         }
3602                         /* PL_reginput == locinput now */
3603                         TRYPAREN(paren, ln, locinput);
3604                         PL_reginput = locinput; /* Could be reset... */
3605                         REGCP_UNWIND(lastcp);
3606                         /* Couldn't or didn't -- move forward. */
3607                         old = locinput;
3608                         if (do_utf8)
3609                             locinput += UTF8SKIP(locinput);
3610                         else
3611                             locinput++;
3612                     }
3613                 }
3614                 else
3615                 while (n >= ln || (n == REG_INFTY && ln > 0)) { /* ln overflow ? */
3616                     UV c;
3617                     if (c1 != -1000) {
3618                         if (do_utf8)
3619                             c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3620                         else
3621                             c = UCHARAT(PL_reginput);
3622                         /* If it could work, try it. */
3623                         if (c == c1 || c == c2)
3624                         {
3625                             TRYPAREN(paren, n, PL_reginput);
3626                             REGCP_UNWIND(lastcp);
3627                         }
3628                     }
3629                     /* If it could work, try it. */
3630                     else if (c1 == -1000)
3631                     {
3632                         TRYPAREN(paren, n, PL_reginput);
3633                         REGCP_UNWIND(lastcp);
3634                     }
3635                     /* Couldn't or didn't -- move forward. */
3636                     PL_reginput = locinput;
3637                     if (regrepeat(scan, 1)) {
3638                         ln++;
3639                         locinput = PL_reginput;
3640                     }
3641                     else
3642                         sayNO;
3643                 }
3644             }
3645             else {
3646                 CHECKPOINT lastcp;
3647                 n = regrepeat(scan, n);
3648                 locinput = PL_reginput;
3649                 if (ln < n && PL_regkind[(U8)OP(next)] == EOL &&
3650                     (!PL_multiline  || OP(next) == SEOL || OP(next) == EOS)) {
3651                     ln = n;                     /* why back off? */
3652                     /* ...because $ and \Z can match before *and* after
3653                        newline at the end.  Consider "\n\n" =~ /\n+\Z\n/.
3654                        We should back off by one in this case. */
3655                     if (UCHARAT(PL_reginput - 1) == '\n' && OP(next) != EOS)
3656                         ln--;
3657                 }
3658                 REGCP_SET(lastcp);
3659                 if (paren) {
3660                     UV c = 0;
3661                     while (n >= ln) {
3662                         if (c1 != -1000) {
3663                             if (do_utf8)
3664                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3665                             else
3666                                 c = UCHARAT(PL_reginput);
3667                         }
3668                         /* If it could work, try it. */
3669                         if (c1 == -1000 || c == c1 || c == c2)
3670                             {
3671                                 TRYPAREN(paren, n, PL_reginput);
3672                                 REGCP_UNWIND(lastcp);
3673                             }
3674                         /* Couldn't or didn't -- back up. */
3675                         n--;
3676                         PL_reginput = locinput = HOPc(locinput, -1);
3677                     }
3678                 }
3679                 else {
3680                     UV c = 0;
3681                     while (n >= ln) {
3682                         if (c1 != -1000) {
3683                             if (do_utf8)
3684                                 c = utf8_to_uvchr((U8*)PL_reginput, NULL);
3685                             else
3686                                 c = UCHARAT(PL_reginput);
3687                         }
3688                         /* If it could work, try it. */
3689                         if (c1 == -1000 || c == c1 || c == c2)
3690                             {
3691                                 TRYPAREN(paren, n, PL_reginput);
3692                                 REGCP_UNWIND(lastcp);
3693                             }
3694                         /* Couldn't or didn't -- back up. */
3695                         n--;
3696                         PL_reginput = locinput = HOPc(locinput, -1);
3697                     }
3698                 }
3699             }
3700             sayNO;
3701             break;
3702         case END:
3703             if (PL_reg_call_cc) {
3704                 re_cc_state *cur_call_cc = PL_reg_call_cc;
3705                 CURCUR *cctmp = PL_regcc;
3706                 regexp *re = PL_reg_re;
3707                 CHECKPOINT cp, lastcp;
3708                 
3709                 cp = regcppush(0);      /* Save *all* the positions. */
3710                 REGCP_SET(lastcp);
3711                 regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
3712                                                     the caller. */
3713                 PL_reginput = locinput; /* Make position available to
3714                                            the callcc. */
3715                 cache_re(PL_reg_call_cc->re);
3716                 PL_regcc = PL_reg_call_cc->cc;
3717                 PL_reg_call_cc = PL_reg_call_cc->prev;
3718                 if (regmatch(cur_call_cc->node)) {
3719                     PL_reg_call_cc = cur_call_cc;
3720                     regcpblow(cp);
3721                     sayYES;
3722                 }
3723                 REGCP_UNWIND(lastcp);
3724                 regcppop();
3725                 PL_reg_call_cc = cur_call_cc;
3726                 PL_regcc = cctmp;
3727                 PL_reg_re = re;
3728                 cache_re(re);
3729
3730                 DEBUG_r(
3731                     PerlIO_printf(Perl_debug_log,
3732                                   "%*s  continuation failed...\n",
3733                                   REPORT_CODE_OFF+PL_regindent*2, "")
3734                     );
3735                 sayNO_SILENT;
3736             }
3737             if (locinput < PL_regtill) {
3738                 DEBUG_r(PerlIO_printf(Perl_debug_log,
3739                                       "%sMatch possible, but length=%ld is smaller than requested=%ld, failing!%s\n",
3740                                       PL_colors[4],
3741                                       (long)(locinput - PL_reg_starttry),
3742                                       (long)(PL_regtill - PL_reg_starttry),
3743                                       PL_colors[5]));
3744                 sayNO_FINAL;            /* Cannot match: too short. */
3745             }
3746             PL_reginput = locinput;     /* put where regtry can find it */
3747             sayYES_FINAL;               /* Success! */
3748         case SUCCEED:
3749             PL_reginput = locinput;     /* put where regtry can find it */
3750             sayYES_LOUD;                /* Success! */
3751         case SUSPEND:
3752             n = 1;
3753             PL_reginput = locinput;
3754             goto do_ifmatch;    
3755         case UNLESSM:
3756             n = 0;
3757             if (scan->flags) {
3758                 s = HOPBACKc(locinput, scan->flags);
3759                 if (!s)
3760                     goto say_yes;
3761                 PL_reginput = s;
3762             }
3763             else
3764                 PL_reginput = locinput;
3765             goto do_ifmatch;
3766         case IFMATCH:
3767             n = 1;
3768             if (scan->flags) {
3769                 s = HOPBACKc(locinput, scan->flags);
3770                 if (!s)
3771                     goto say_no;
3772                 PL_reginput = s;
3773             }
3774             else
3775                 PL_reginput = locinput;
3776
3777           do_ifmatch:
3778             inner = NEXTOPER(NEXTOPER(scan));
3779             if (regmatch(inner) != n) {
3780               say_no:
3781                 if (logical) {
3782                     logical = 0;
3783                     sw = 0;
3784                     goto do_longjump;
3785                 }
3786                 else
3787                     sayNO;
3788             }
3789           say_yes:
3790             if (logical) {
3791                 logical = 0;
3792                 sw = 1;
3793             }
3794             if (OP(scan) == SUSPEND) {
3795                 locinput = PL_reginput;
3796                 nextchr = UCHARAT(locinput);
3797             }
3798             /* FALL THROUGH. */
3799         case LONGJMP:
3800           do_longjump:
3801             next = scan + ARG(scan);
3802             if (next == scan)
3803                 next = NULL;
3804             break;
3805         default:
3806             PerlIO_printf(Perl_error_log, "%"UVxf" %d\n",
3807                           PTR2UV(scan), OP(scan));
3808             Perl_croak(aTHX_ "regexp memory corruption");
3809         }
3810       reenter:
3811         scan = next;
3812     }
3813
3814     /*
3815     * We get here only if there's trouble -- normally "case END" is
3816     * the terminating point.
3817     */
3818     Perl_croak(aTHX_ "corrupted regexp pointers");
3819     /*NOTREACHED*/
3820     sayNO;
3821
3822 yes_loud:
3823     DEBUG_r(
3824         PerlIO_printf(Perl_debug_log,
3825                       "%*s  %scould match...%s\n",
3826                       REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],PL_colors[5])
3827         );
3828     goto yes;
3829 yes_final:
3830     DEBUG_r(PerlIO_printf(Perl_debug_log, "%sMatch successful!%s\n",
3831                           PL_colors[4],PL_colors[5]));
3832 yes:
3833 #ifdef DEBUGGING
3834     PL_regindent--;
3835 #endif
3836
3837 #if 0                                   /* Breaks $^R */
3838     if (unwind)
3839         regcpblow(firstcp);
3840 #endif
3841     return 1;
3842
3843 no:
3844     DEBUG_r(
3845         PerlIO_printf(Perl_debug_log,
3846                       "%*s  %sfailed...%s\n",
3847                       REPORT_CODE_OFF+PL_regindent*2, "",PL_colors[4],PL_colors[5])
3848         );
3849     goto do_no;
3850 no_final:
3851 do_no:
3852     if (unwind) {
3853         re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
3854
3855         switch (uw->type) {
3856         case RE_UNWIND_BRANCH:
3857         case RE_UNWIND_BRANCHJ:
3858         {
3859             re_unwind_branch_t *uwb = &(uw->branch);
3860             I32 lastparen = uwb->lastparen;
3861         
3862             REGCP_UNWIND(uwb->lastcp);
3863             for (n = *PL_reglastparen; n > lastparen; n--)
3864                 PL_regendp[n] = -1;
3865             *PL_reglastparen = n;
3866             scan = next = uwb->next;
3867             if ( !scan ||
3868                  OP(scan) != (uwb->type == RE_UNWIND_BRANCH
3869                               ? BRANCH : BRANCHJ) ) {           /* Failure */
3870                 unwind = uwb->prev;
3871 #ifdef DEBUGGING
3872                 PL_regindent--;
3873 #endif
3874                 goto do_no;
3875             }
3876             /* Have more choice yet.  Reuse the same uwb.  */
3877             /*SUPPRESS 560*/
3878             if ((n = (uwb->type == RE_UNWIND_BRANCH
3879                       ? NEXT_OFF(next) : ARG(next))))
3880                 next += n;
3881             else
3882                 next = NULL;    /* XXXX Needn't unwinding in this case... */
3883             uwb->next = next;
3884             next = NEXTOPER(scan);
3885             if (uwb->type == RE_UNWIND_BRANCHJ)
3886                 next = NEXTOPER(next);
3887             locinput = uwb->locinput;
3888             nextchr = uwb->nextchr;
3889 #ifdef DEBUGGING
3890             PL_regindent = uwb->regindent;
3891 #endif
3892
3893             goto reenter;
3894         }
3895         /* NOT REACHED */
3896         default:
3897             Perl_croak(aTHX_ "regexp unwind memory corruption");
3898         }
3899         /* NOT REACHED */
3900     }
3901 #ifdef DEBUGGING
3902     PL_regindent--;
3903 #endif
3904     return 0;
3905 }
3906
3907 /*
3908  - regrepeat - repeatedly match something simple, report how many
3909  */
3910 /*
3911  * [This routine now assumes that it will only match on things of length 1.
3912  * That was true before, but now we assume scan - reginput is the count,
3913  * rather than incrementing count on every character.  [Er, except utf8.]]
3914  */
3915 STATIC I32
3916 S_regrepeat(pTHX_ regnode *p, I32 max)
3917 {
3918     register char *scan;
3919     register I32 c;
3920     register char *loceol = PL_regeol;
3921     register I32 hardcount = 0;
3922     register bool do_utf8 = PL_reg_match_utf8;
3923
3924     scan = PL_reginput;
3925     if (max != REG_INFTY && max < loceol - scan)
3926       loceol = scan + max;
3927     switch (OP(p)) {
3928     case REG_ANY:
3929         if (do_utf8) {
3930             loceol = PL_regeol;
3931             while (scan < loceol && hardcount < max && *scan != '\n') {
3932                 scan += UTF8SKIP(scan);
3933                 hardcount++;
3934             }
3935         } else {
3936             while (scan < loceol && *scan != '\n')
3937                 scan++;
3938         }
3939         break;
3940     case SANY:
3941         scan = loceol;
3942         break;
3943     case CANY:
3944         scan = loceol;
3945         break;
3946     case EXACT:         /* length of string is 1 */
3947         c = (U8)*STRING(p);
3948         while (scan < loceol && UCHARAT(scan) == c)
3949             scan++;
3950         break;
3951     case EXACTF:        /* length of string is 1 */
3952         c = (U8)*STRING(p);
3953         while (scan < loceol &&
3954                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold[c]))
3955             scan++;
3956         break;
3957     case EXACTFL:       /* length of string is 1 */
3958         PL_reg_flags |= RF_tainted;
3959         c = (U8)*STRING(p);
3960         while (scan < loceol &&
3961                (UCHARAT(scan) == c || UCHARAT(scan) == PL_fold_locale[c]))
3962             scan++;
3963         break;
3964     case ANYOF:
3965         if (do_utf8) {
3966             loceol = PL_regeol;
3967             while (hardcount < max && scan < loceol &&
3968                    reginclass(p, (U8*)scan, do_utf8)) {
3969                 scan += UTF8SKIP(scan);
3970                 hardcount++;
3971             }
3972         } else {
3973             while (scan < loceol && reginclass(p, (U8*)scan, do_utf8))
3974                 scan++;
3975         }
3976         break;
3977     case ALNUM:
3978         if (do_utf8) {
3979             loceol = PL_regeol;
3980             LOAD_UTF8_CHARCLASS(alnum,"a");
3981             while (hardcount < max && scan < loceol &&
3982                    swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
3983                 scan += UTF8SKIP(scan);
3984                 hardcount++;
3985             }
3986         } else {
3987             while (scan < loceol && isALNUM(*scan))
3988                 scan++;
3989         }
3990         break;
3991     case ALNUML:
3992         PL_reg_flags |= RF_tainted;
3993         if (do_utf8) {
3994             loceol = PL_regeol;
3995             while (hardcount < max && scan < loceol &&
3996                    isALNUM_LC_utf8((U8*)scan)) {
3997                 scan += UTF8SKIP(scan);
3998                 hardcount++;
3999             }
4000         } else {
4001             while (scan < loceol && isALNUM_LC(*scan))
4002                 scan++;
4003         }
4004         break;
4005     case NALNUM:
4006         if (do_utf8) {
4007             loceol = PL_regeol;
4008             LOAD_UTF8_CHARCLASS(alnum,"a");
4009             while (hardcount < max && scan < loceol &&
4010                    !swash_fetch(PL_utf8_alnum, (U8*)scan, do_utf8)) {
4011                 scan += UTF8SKIP(scan);
4012                 hardcount++;
4013             }
4014         } else {
4015             while (scan < loceol && !isALNUM(*scan))
4016                 scan++;
4017         }
4018         break;
4019     case NALNUML:
4020         PL_reg_flags |= RF_tainted;
4021         if (do_utf8) {
4022             loceol = PL_regeol;
4023             while (hardcount < max && scan < loceol &&
4024                    !isALNUM_LC_utf8((U8*)scan)) {
4025                 scan += UTF8SKIP(scan);
4026                 hardcount++;
4027             }
4028         } else {
4029             while (scan < loceol && !isALNUM_LC(*scan))
4030                 scan++;
4031         }
4032         break;
4033     case SPACE:
4034         if (do_utf8) {
4035             loceol = PL_regeol;
4036             LOAD_UTF8_CHARCLASS(space," ");
4037             while (hardcount < max && scan < loceol &&
4038                    (*scan == ' ' ||
4039                     swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4040                 scan += UTF8SKIP(scan);
4041                 hardcount++;
4042             }
4043         } else {
4044             while (scan < loceol && isSPACE(*scan))
4045                 scan++;
4046         }
4047         break;
4048     case SPACEL:
4049         PL_reg_flags |= RF_tainted;
4050         if (do_utf8) {
4051             loceol = PL_regeol;
4052             while (hardcount < max && scan < loceol &&
4053                    (*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4054                 scan += UTF8SKIP(scan);
4055                 hardcount++;
4056             }
4057         } else {
4058             while (scan < loceol && isSPACE_LC(*scan))
4059                 scan++;
4060         }
4061         break;
4062     case NSPACE:
4063         if (do_utf8) {
4064             loceol = PL_regeol;
4065             LOAD_UTF8_CHARCLASS(space," ");
4066             while (hardcount < max && scan < loceol &&
4067                    !(*scan == ' ' ||
4068                      swash_fetch(PL_utf8_space,(U8*)scan, do_utf8))) {
4069                 scan += UTF8SKIP(scan);
4070                 hardcount++;
4071             }
4072         } else {
4073             while (scan < loceol && !isSPACE(*scan))
4074                 scan++;
4075             break;
4076         }
4077     case NSPACEL:
4078         PL_reg_flags |= RF_tainted;
4079         if (do_utf8) {
4080             loceol = PL_regeol;
4081             while (hardcount < max && scan < loceol &&
4082                    !(*scan == ' ' || isSPACE_LC_utf8((U8*)scan))) {
4083                 scan += UTF8SKIP(scan);
4084                 hardcount++;
4085             }
4086         } else {
4087             while (scan < loceol && !isSPACE_LC(*scan))
4088                 scan++;
4089         }
4090         break;
4091     case DIGIT:
4092         if (do_utf8) {
4093             loceol = PL_regeol;
4094             LOAD_UTF8_CHARCLASS(digit,"0");
4095             while (hardcount < max && scan < loceol &&
4096                    swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4097                 scan += UTF8SKIP(scan);
4098                 hardcount++;
4099             }
4100         } else {
4101             while (scan < loceol && isDIGIT(*scan))
4102                 scan++;
4103         }
4104         break;
4105     case NDIGIT:
4106         if (do_utf8) {
4107             loceol = PL_regeol;
4108             LOAD_UTF8_CHARCLASS(digit,"0");
4109             while (hardcount < max && scan < loceol &&
4110                    !swash_fetch(PL_utf8_digit, (U8*)scan, do_utf8)) {
4111                 scan += UTF8SKIP(scan);
4112                 hardcount++;
4113             }
4114         } else {
4115             while (scan < loceol && !isDIGIT(*scan))
4116                 scan++;
4117         }
4118         break;
4119     default:            /* Called on something of 0 width. */
4120         break;          /* So match right here or not at all. */
4121     }
4122
4123     if (hardcount)
4124         c = hardcount;
4125     else
4126         c = scan - PL_reginput;
4127     PL_reginput = scan;
4128
4129     DEBUG_r(
4130         {
4131                 SV *prop = sv_newmortal();
4132
4133                 regprop(prop, p);
4134                 PerlIO_printf(Perl_debug_log,
4135                               "%*s  %s can match %"IVdf" times out of %"IVdf"...\n",
4136                               REPORT_CODE_OFF+1, "", SvPVX(prop),(IV)c,(IV)max);
4137         });
4138
4139     return(c);
4140 }
4141
4142 /*
4143  - regrepeat_hard - repeatedly match something, report total lenth and length
4144  *
4145  * The repeater is supposed to have constant length.
4146  */
4147
4148 STATIC I32
4149 S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
4150 {
4151     register char *scan = Nullch;
4152     register char *start;
4153     register char *loceol = PL_regeol;
4154     I32 l = 0;
4155     I32 count = 0, res = 1;
4156
4157     if (!max)
4158         return 0;
4159
4160     start = PL_reginput;
4161     if (PL_reg_match_utf8) {
4162         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4163             if (!count++) {
4164                 l = 0;
4165                 while (start < PL_reginput) {
4166                     l++;
4167                     start += UTF8SKIP(start);
4168                 }
4169                 *lp = l;
4170                 if (l == 0)
4171                     return max;
4172             }
4173             if (count == max)
4174                 return count;
4175         }
4176     }
4177     else {
4178         while (PL_reginput < loceol && (scan = PL_reginput, res = regmatch(p))) {
4179             if (!count++) {
4180                 *lp = l = PL_reginput - start;
4181                 if (max != REG_INFTY && l*max < loceol - scan)
4182                     loceol = scan + l*max;
4183                 if (l == 0)
4184                     return max;
4185             }
4186         }
4187     }
4188     if (!res)
4189         PL_reginput = scan;
4190
4191     return count;
4192 }
4193
4194 /*
4195 - regclass_swash - prepare the utf8 swash
4196 */
4197
4198 SV *
4199 Perl_regclass_swash(pTHX_ register regnode* node, bool doinit, SV** initsvp)
4200 {
4201     SV *sw = NULL;
4202     SV *si = NULL;
4203
4204     if (PL_regdata && PL_regdata->count) {
4205         U32 n = ARG(node);
4206
4207         if (PL_regdata->what[n] == 's') {
4208             SV *rv = (SV*)PL_regdata->data[n];
4209             AV *av = (AV*)SvRV((SV*)rv);
4210             SV **a;
4211         
4212             si = *av_fetch(av, 0, FALSE);
4213             a  =  av_fetch(av, 1, FALSE);
4214         
4215             if (a)
4216                 sw = *a;
4217             else if (si && doinit) {
4218                 sw = swash_init("utf8", "", si, 1, 0);
4219                 (void)av_store(av, 1, sw);
4220             }
4221         }
4222     }
4223         
4224     if (initsvp)
4225         *initsvp = si;
4226
4227     return sw;
4228 }
4229
4230 /*
4231  - reginclass - determine if a character falls into a character class
4232  */
4233
4234 STATIC bool
4235 S_reginclass(pTHX_ register regnode *n, register U8* p, register bool do_utf8)
4236 {
4237     char flags = ANYOF_FLAGS(n);
4238     bool match = FALSE;
4239     UV c;
4240     STRLEN len = 0;
4241
4242     c = do_utf8 ? utf8_to_uvchr(p, &len) : *p;
4243
4244     if (do_utf8 || (flags & ANYOF_UNICODE)) {
4245         if (do_utf8 && !ANYOF_RUNTIME(n)) {
4246             if (len != (STRLEN)-1 && c < 256 && ANYOF_BITMAP_TEST(n, c))
4247                 match = TRUE;
4248         }
4249         if (!match && do_utf8 && (flags & ANYOF_UNICODE_ALL) && c >= 256)
4250             match = TRUE;
4251         if (!match) {
4252             SV *sw = regclass_swash(n, TRUE, 0);
4253         
4254             if (sw) {
4255                 if (swash_fetch(sw, p, do_utf8))
4256                     match = TRUE;
4257                 else if (flags & ANYOF_FOLD) {
4258                     STRLEN ulen;
4259                     U8 tmpbuf[UTF8_MAXLEN_FOLD+1];
4260
4261                     to_utf8_fold(p, tmpbuf, &ulen);
4262                     if (swash_fetch(sw, tmpbuf, do_utf8))
4263                         match = TRUE;
4264                     to_utf8_upper(p, tmpbuf, &ulen);
4265                     if (swash_fetch(sw, tmpbuf, do_utf8))
4266                         match = TRUE;
4267                 }
4268             }
4269         }
4270     }
4271     if (!match && c < 256) {
4272         if (ANYOF_BITMAP_TEST(n, c))
4273             match = TRUE;
4274         else if (flags & ANYOF_FOLD) {
4275           I32 f;
4276
4277             if (flags & ANYOF_LOCALE) {
4278                 PL_reg_flags |= RF_tainted;
4279                 f = PL_fold_locale[c];
4280             }
4281             else
4282                 f = PL_fold[c];
4283             if (f != c && ANYOF_BITMAP_TEST(n, f))
4284                 match = TRUE;
4285         }
4286         
4287         if (!match && (flags & ANYOF_CLASS)) {
4288             PL_reg_flags |= RF_tainted;
4289             if (
4290                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUM)   &&  isALNUM_LC(c))  ||
4291                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUM)  && !isALNUM_LC(c))  ||
4292                 (ANYOF_CLASS_TEST(n, ANYOF_SPACE)   &&  isSPACE_LC(c))  ||
4293                 (ANYOF_CLASS_TEST(n, ANYOF_NSPACE)  && !isSPACE_LC(c))  ||
4294                 (ANYOF_CLASS_TEST(n, ANYOF_DIGIT)   &&  isDIGIT_LC(c))  ||
4295                 (ANYOF_CLASS_TEST(n, ANYOF_NDIGIT)  && !isDIGIT_LC(c))  ||
4296                 (ANYOF_CLASS_TEST(n, ANYOF_ALNUMC)  &&  isALNUMC_LC(c)) ||
4297                 (ANYOF_CLASS_TEST(n, ANYOF_NALNUMC) && !isALNUMC_LC(c)) ||
4298                 (ANYOF_CLASS_TEST(n, ANYOF_ALPHA)   &&  isALPHA_LC(c))  ||
4299                 (ANYOF_CLASS_TEST(n, ANYOF_NALPHA)  && !isALPHA_LC(c))  ||
4300                 (ANYOF_CLASS_TEST(n, ANYOF_ASCII)   &&  isASCII(c))     ||
4301                 (ANYOF_CLASS_TEST(n, ANYOF_NASCII)  && !isASCII(c))     ||
4302                 (ANYOF_CLASS_TEST(n, ANYOF_CNTRL)   &&  isCNTRL_LC(c))  ||
4303                 (ANYOF_CLASS_TEST(n, ANYOF_NCNTRL)  && !isCNTRL_LC(c))  ||
4304                 (ANYOF_CLASS_TEST(n, ANYOF_GRAPH)   &&  isGRAPH_LC(c))  ||
4305                 (ANYOF_CLASS_TEST(n, ANYOF_NGRAPH)  && !isGRAPH_LC(c))  ||
4306                 (ANYOF_CLASS_TEST(n, ANYOF_LOWER)   &&  isLOWER_LC(c))  ||
4307                 (ANYOF_CLASS_TEST(n, ANYOF_NLOWER)  && !isLOWER_LC(c))  ||
4308                 (ANYOF_CLASS_TEST(n, ANYOF_PRINT)   &&  isPRINT_LC(c))  ||
4309                 (ANYOF_CLASS_TEST(n, ANYOF_NPRINT)  && !isPRINT_LC(c))  ||
4310                 (ANYOF_CLASS_TEST(n, ANYOF_PUNCT)   &&  isPUNCT_LC(c))  ||
4311                 (ANYOF_CLASS_TEST(n, ANYOF_NPUNCT)  && !isPUNCT_LC(c))  ||
4312                 (ANYOF_CLASS_TEST(n, ANYOF_UPPER)   &&  isUPPER_LC(c))  ||
4313                 (ANYOF_CLASS_TEST(n, ANYOF_NUPPER)  && !isUPPER_LC(c))  ||
4314                 (ANYOF_CLASS_TEST(n, ANYOF_XDIGIT)  &&  isXDIGIT(c))    ||
4315                 (ANYOF_CLASS_TEST(n, ANYOF_NXDIGIT) && !isXDIGIT(c))    ||
4316                 (ANYOF_CLASS_TEST(n, ANYOF_PSXSPC)  &&  isPSXSPC(c))    ||
4317                 (ANYOF_CLASS_TEST(n, ANYOF_NPSXSPC) && !isPSXSPC(c))    ||
4318                 (ANYOF_CLASS_TEST(n, ANYOF_BLANK)   &&  isBLANK(c))     ||
4319                 (ANYOF_CLASS_TEST(n, ANYOF_NBLANK)  && !isBLANK(c))
4320                 ) /* How's that for a conditional? */
4321             {
4322                 match = TRUE;
4323             }
4324         }
4325     }
4326
4327     return (flags & ANYOF_INVERT) ? !match : match;
4328 }
4329
4330 STATIC U8 *
4331 S_reghop(pTHX_ U8 *s, I32 off)
4332 {
4333     return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4334 }
4335
4336 STATIC U8 *
4337 S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
4338 {
4339     if (off >= 0) {
4340         while (off-- && s < lim) {
4341             /* XXX could check well-formedness here */
4342             s += UTF8SKIP(s);
4343         }
4344     }
4345     else {
4346         while (off++) {
4347             if (s > lim) {
4348                 s--;
4349                 if (UTF8_IS_CONTINUED(*s)) {
4350                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4351                         s--;
4352                 }
4353                 /* XXX could check well-formedness here */
4354             }
4355         }
4356     }
4357     return s;
4358 }
4359
4360 STATIC U8 *
4361 S_reghopmaybe(pTHX_ U8 *s, I32 off)
4362 {
4363     return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
4364 }
4365
4366 STATIC U8 *
4367 S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
4368 {
4369     if (off >= 0) {
4370         while (off-- && s < lim) {
4371             /* XXX could check well-formedness here */
4372             s += UTF8SKIP(s);
4373         }
4374         if (off >= 0)
4375             return 0;
4376     }
4377     else {
4378         while (off++) {
4379             if (s > lim) {
4380                 s--;
4381                 if (UTF8_IS_CONTINUED(*s)) {
4382                     while (s > (U8*)lim && UTF8_IS_CONTINUATION(*s))
4383                         s--;
4384                 }
4385                 /* XXX could check well-formedness here */
4386             }
4387             else
4388                 break;
4389         }
4390         if (off <= 0)
4391             return 0;
4392     }
4393     return s;
4394 }
4395
4396 static void
4397 restore_pos(pTHX_ void *arg)
4398 {
4399     if (PL_reg_eval_set) {
4400         if (PL_reg_oldsaved) {
4401             PL_reg_re->subbeg = PL_reg_oldsaved;
4402             PL_reg_re->sublen = PL_reg_oldsavedlen;
4403             RX_MATCH_COPIED_on(PL_reg_re);
4404         }
4405         PL_reg_magic->mg_len = PL_reg_oldpos;
4406         PL_reg_eval_set = 0;
4407         PL_curpm = PL_reg_oldcurpm;
4408     }   
4409 }