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