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