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