This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Stop substr re optimisation from rejecting long strs
[perl5.git] / regexp.h
index 9cdc009..8542cb1 100644 (file)
--- a/regexp.h
+++ b/regexp.h
@@ -36,8 +36,8 @@ struct regexp_engine;
 struct regexp;
 
 struct reg_substr_datum {
-    I32 min_offset;
-    I32 max_offset;
+    SSize_t min_offset;
+    SSize_t max_offset;
     SV *substr;                /* non-utf8 variant */
     SV *utf8_substr;   /* utf8 variant */
     I32 end_shift;
@@ -55,8 +55,8 @@ struct reg_substr_data {
 /* offsets within a string of a particular /(.)/ capture */
 
 typedef struct regexp_paren_pair {
-    I32 start;
-    I32 end;
+    SSize_t start;
+    SSize_t end;
     /* 'start_tmp' records a new opening position before the matching end
      * has been found, so that the old start and end values are still
      * valid, e.g.
@@ -119,18 +119,20 @@ struct reg_code_block {
        /* during matching */                                           \
        U32 lastparen;                  /* last open paren matched */   \
        U32 lastcloseparen;             /* last close paren matched */  \
-       regexp_paren_pair *swap;        /* Unused: 5.10.1 and later */  \
        /* Array of offsets for (@-) and (@+) */                        \
        regexp_paren_pair *offs;                                        \
        /* saved or original string so \digit works forever. */         \
        char *subbeg;                                                   \
        SV_SAVED_COPY   /* If non-NULL, SV which is COW from original */\
-       I32 sublen;     /* Length of string pointed by subbeg */        \
+       SSize_t sublen; /* Length of string pointed by subbeg */        \
        I32 suboffset;  /* byte offset of subbeg from logical start of str */ \
        I32 subcoffset; /* suboffset equiv, but in chars (for @-/@+) */ \
        /* Information about the match that isn't often used */         \
        /* offset from wrapped to the start of precomp */               \
        PERL_BITFIELD32 pre_prefix:4;                                   \
+        /* original flags used to compile the pattern, may differ */    \
+        /* from extflags in various ways */                             \
+        PERL_BITFIELD32 compflags:9;                                    \
        CV *qr_anoncv   /* the anon sub wrapped round qr/(?{..})/ */
 
 typedef struct regexp {
@@ -153,10 +155,15 @@ typedef struct re_scream_pos_data_s
 typedef struct regexp_engine {
     REGEXP* (*comp) (pTHX_ SV * const pattern, U32 flags);
     I32     (*exec) (pTHX_ REGEXP * const rx, char* stringarg, char* strend,
-                     char* strbeg, I32 minend, SV* screamer,
+                     char* strbeg, I32 minend, SV* sv,
                      void* data, U32 flags);
-    char*   (*intuit) (pTHX_ REGEXP * const rx, SV *sv, char *strpos,
-                       char *strend, const U32 flags,
+    char*   (*intuit) (pTHX_
+                        REGEXP * const rx,
+                        SV *sv,
+                        const char * const strbeg,
+                        char *strpos,
+                        char *strend,
+                        const U32 flags,
                        re_scream_pos_data *data);
     SV*     (*checkstr) (pTHX_ REGEXP * const rx);
     void    (*free) (pTHX_ REGEXP * const rx);
@@ -334,7 +341,17 @@ and check for NULL.
 
 /* Leave some space, so future bit allocations can go either in the shared or
  * unshared area without affecting binary compatibility */
-#define RXf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT+1)
+#define RXf_BASE_SHIFT (_RXf_PMf_SHIFT_NEXT)
+
+/*
+  Set in Perl_pmruntime if op_flags & OPf_SPECIAL, i.e. split. Will
+  be used by regex engines to check whether they should set
+  RXf_SKIPWHITE
+*/
+#define RXf_SPLIT                (1<<(RXf_BASE_SHIFT-1))
+#if RXf_SPLIT != RXf_PMf_SPLIT
+#   error "RXf_SPLIT does not match RXf_PMf_SPLIT"
+#endif
 
 /* Manually decorate this function with gcc-style attributes just to
  * avoid having to restructure the header files and their called order,
@@ -367,19 +384,6 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
     }
 }
 
-/*
-  Two flags no longer used.
-  RXf_SPLIT used to be set in Perl_pmruntime if op_flags & OPf_SPECIAL,
-  i.e., split.  It was used by the regex engine to check whether it should
-  set RXf_SKIPWHITE.  Regexp plugins on CPAN also have done the same thing
-  historically, so we leave these flags defined.
-*/
-#ifndef PERL_CORE
-# define RXf_SPLIT             0
-# define RXf_SKIPWHITE         0
-#endif
-
-
 /* Anchor and GPOS related stuff */
 #define RXf_ANCH_BOL           (1<<(RXf_BASE_SHIFT+0))
 #define RXf_ANCH_MBOL          (1<<(RXf_BASE_SHIFT+1))
@@ -393,7 +397,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RXf_ANCH_SINGLE         (RXf_ANCH_SBOL|RXf_ANCH_GPOS)
 
 /* What we have seen */
-#define RXf_LOOKBEHIND_SEEN    (1<<(RXf_BASE_SHIFT+6))
+#define RXf_NO_INPLACE_SUBST    (1<<(RXf_BASE_SHIFT+6))
 #define RXf_EVAL_SEEN          (1<<(RXf_BASE_SHIFT+7))
 #define RXf_CANY_SEEN          (1<<(RXf_BASE_SHIFT+8))
 
@@ -402,7 +406,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RXf_CHECK_ALL          (1<<(RXf_BASE_SHIFT+10))
 
 /* UTF8 related */
-#define RXf_MATCH_UTF8         (1<<(RXf_BASE_SHIFT+11))
+#define RXf_MATCH_UTF8         (1<<(RXf_BASE_SHIFT+11)) /* $1 etc are utf8 */
 
 /* Intuit related */
 #define RXf_USE_INTUIT_NOML    (1<<(RXf_BASE_SHIFT+12))
@@ -410,8 +414,6 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RXf_INTUIT_TAIL        (1<<(RXf_BASE_SHIFT+14))
 #define RXf_USE_INTUIT         (RXf_USE_INTUIT_NOML|RXf_USE_INTUIT_ML)
 
-#define RXf_MODIFIES_VARS      (1<<(RXf_BASE_SHIFT+15))
-
 /* Copy and tainted info */
 #define RXf_COPY_DONE          (1<<(RXf_BASE_SHIFT+16))
 
@@ -423,6 +425,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 
 /* Flags indicating special patterns */
 #define RXf_START_ONLY         (1<<(RXf_BASE_SHIFT+19)) /* Pattern is /^/ */
+#define RXf_SKIPWHITE                (1<<(RXf_BASE_SHIFT+20)) /* Pattern is for a split " " */
 #define RXf_WHITE              (1<<(RXf_BASE_SHIFT+21)) /* Pattern is /\s+/ */
 #define RXf_NULL               (1U<<(RXf_BASE_SHIFT+22)) /* Pattern is // */
 #if RXf_BASE_SHIFT+22 > 31
@@ -469,6 +472,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
                                         : RX_MATCH_COPIED_off(prog))
 
 #define RXp_EXTFLAGS(rx)       ((rx)->extflags)
+#define RXp_COMPFLAGS(rx)        ((rx)->compflags)
 
 /* For source compatibility. We used to store these explicitly.  */
 #define RX_PRECOMP(prog)       (RX_WRAPPED(prog) + ReANY(prog)->pre_prefix)
@@ -483,6 +487,7 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RX_CHECK_SUBSTR(prog)  (ReANY(prog)->check_substr)
 #define RX_REFCNT(prog)                SvREFCNT(prog)
 #define RX_EXTFLAGS(prog)      RXp_EXTFLAGS(ReANY(prog))
+#define RX_COMPFLAGS(prog)        RXp_COMPFLAGS(ReANY(prog))
 #define RX_ENGINE(prog)                (ReANY(prog)->engine)
 #define RX_SUBBEG(prog)                (ReANY(prog)->subbeg)
 #define RX_SUBOFFSET(prog)     (ReANY(prog)->suboffset)
@@ -496,6 +501,10 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RX_LASTPAREN(prog)     (ReANY(prog)->lastparen)
 #define RX_LASTCLOSEPAREN(prog)        (ReANY(prog)->lastcloseparen)
 #define RX_SAVED_COPY(prog)    (ReANY(prog)->saved_copy)
+/* last match was zero-length */
+#define RX_ZERO_LEN(prog) \
+        (RX_OFFS(prog)[0].start + (SSize_t)RX_GOFS(prog) \
+          == RX_OFFS(prog)[0].end)
 
 #endif /* PLUGGABLE_RE_EXTENSION */
 
@@ -523,22 +532,30 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 #define RX_MATCH_UTF8_on(prog)         (RX_EXTFLAGS(prog) |= RXf_MATCH_UTF8)
 #define RX_MATCH_UTF8_off(prog)                (RX_EXTFLAGS(prog) &= ~RXf_MATCH_UTF8)
 #define RX_MATCH_UTF8_set(prog, t)     ((t) \
-                       ? (RX_MATCH_UTF8_on(prog), (PL_reg_match_utf8 = 1)) \
-                       : (RX_MATCH_UTF8_off(prog), (PL_reg_match_utf8 = 0)))
+                       ? RX_MATCH_UTF8_on(prog) \
+                       : RX_MATCH_UTF8_off(prog))
 
 /* Whether the pattern stored at RX_WRAPPED is in UTF-8  */
 #define RX_UTF8(prog)                  SvUTF8(prog)
 
-#define REXEC_COPY_STR 0x01            /* Need to copy the string. */
-#define REXEC_CHECKED  0x02            /* check_substr already checked. */
-#define REXEC_SCREAM   0x04            /* use scream table. */
-#define REXEC_IGNOREPOS        0x08            /* \G matches at start. */
-#define REXEC_NOT_FIRST        0x10            /* This is another iteration of //g. */
-                                    /* under REXEC_COPY_STR, it's ok for the
-                                     * engine (modulo PL_sawamperand etc)
-                                     * to skip copying ... */
-#define REXEC_COPY_SKIP_PRE  0x20   /* ...the $` part of the string, or */
-#define REXEC_COPY_SKIP_POST 0x40   /* ...the $' part of the string */
+
+/* bits in flags arg of Perl_regexec_flags() */
+
+#define REXEC_COPY_STR  0x01    /* Need to copy the string for captures. */
+#define REXEC_CHECKED   0x02    /* re_intuit_start() already called. */
+#define REXEC_SCREAM    0x04    /* currently unused. */
+#define REXEC_IGNOREPOS 0x08    /* use stringarg, not pos(), for \G match */
+#define REXEC_NOT_FIRST 0x10    /* This is another iteration of //g:
+                                   no need to copy string again */
+
+                                     /* under REXEC_COPY_STR, it's ok for the
+                                        engine (modulo PL_sawamperand etc)
+                                        to skip copying: ... */
+#define REXEC_COPY_SKIP_PRE  0x20    /* ...the $` part of the string, or */
+#define REXEC_COPY_SKIP_POST 0x40    /* ...the $' part of the string */
+#define REXEC_FAIL_ON_UNDERFLOW 0x80 /* fail the match if $& would start before
+                                        the start pos (so s/.\G// would fail
+                                        on second iteration */
 
 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 #  define ReREFCNT_inc(re)                                             \
@@ -571,17 +588,64 @@ get_regex_charset_name(const U32 flags, STRLEN* const lenp)
 
 #define FBMrf_MULTILINE        1
 
+struct regmatch_state;
+struct regmatch_slab;
+
+/* like regmatch_info_aux, but contains extra fields only needed if the
+ * pattern contains (?{}). If used, is snuck into the second slot in the
+ * regmatch_state stack at the start of execution */
+
+typedef struct {
+    regexp *rex;
+    PMOP    *curpm;     /* saved PL_curpm */
+#ifdef PERL_ANY_COW
+    SV      *saved_copy; /* saved saved_copy field from rex */
+#endif
+    char    *subbeg;    /* saved subbeg     field from rex */
+    STRLEN  sublen;     /* saved sublen     field from rex */
+    STRLEN  suboffset;  /* saved suboffset  field from rex */
+    STRLEN  subcoffset; /* saved subcoffset field from rex */
+    MAGIC   *pos_magic; /* pos() magic attached to $_ */
+    I32     pos;        /* the original value of pos() in pos_magic */
+    U8      pos_flags;  /* flags to be restored; currently only MGf_BYTES*/
+} regmatch_info_aux_eval;
+
+
+/* fields that logically  live in regmatch_info, but which need cleaning
+ * up on croak(), and so are instead are snuck into the first slot in
+ * the regmatch_state stack at the start of execution */
+
+typedef struct {
+    regmatch_info_aux_eval *info_aux_eval;
+    struct regmatch_state *old_regmatch_state; /* saved PL_regmatch_state */
+    struct regmatch_slab  *old_regmatch_slab;  /* saved PL_regmatch_slab */
+    char *poscache;    /* S-L cache of fail positions of WHILEMs */
+} regmatch_info_aux;
+
+
 /* some basic information about the current match that is created by
- * Perl_regexec_flags and then passed to regtry(), regmatch() etc */
+ * Perl_regexec_flags and then passed to regtry(), regmatch() etc.
+ * It is allocated as a local var on the stack, so nothing should be
+ * stored in it that needs preserving or clearing up on croak().
+ * For that, see the aux_info and aux_info_eval members of the
+ * regmatch_state union. */
 
 typedef struct {
-    REGEXP *prog;
-    char *bol;
-    char *till;
-    SV *sv;
-    char *ganch;
-    char *cutpoint;
-    bool is_utf8_pat;
+    REGEXP *prog;        /* the regex being executed */
+    const char * strbeg; /* real start of string */
+    char *strend;        /* one byte beyond last char of match string */
+    char *till;          /* matches shorter than this fail (see minlen arg) */
+    SV *sv;              /* the SV string currently being matched */
+    char *ganch;         /* position of \G anchor */
+    char *cutpoint;      /* (*COMMIT) position (if any) */
+    regmatch_info_aux      *info_aux; /* extra fields that need cleanup */
+    regmatch_info_aux_eval *info_aux_eval; /* extra saved state for (?{}) */
+    I32  poscache_maxiter; /* how many whilems todo before S-L cache kicks in */
+    I32  poscache_iter;    /* current countdown from _maxiter to zero */
+    STRLEN poscache_size;  /* size of regmatch_info_aux.poscache */
+    bool intuit;    /* re_intuit_start() is the top-level caller */
+    bool is_utf8_pat;    /* regex is utf8 */
+    bool is_utf8_target; /* string being matched is utf8 */
     bool warned; /* we have issued a recursion warning; no need for more */
 } regmatch_info;
  
@@ -600,6 +664,29 @@ typedef struct regmatch_state {
 
     union {
 
+        /* the 'info_aux' and 'info_aux_eval' union members are cuckoos in
+         * the nest. They aren't saved backtrack state; rather they
+         * represent one or two extra chunks of data that need allocating
+         * at the start of a match. These fields would logically live in
+         * the regmatch_info struct, except that is allocated on the
+         * C stack, and these fields are all things that require cleanup
+         * after a croak(), when the stack is lost.
+         * As a convenience, we just use the first 1 or 2 regmatch_state
+         * slots to store this info, as we will be allocating a slab of
+         * these anyway. Otherwise we'd have to malloc and then free them,
+         * or allocate them on the save stack (where they will get
+         * realloced if the save stack grows).
+         * info_aux contains the extra fields that are always needed;
+         * info_aux_eval contains extra fields that only needed if
+         * the pattern contains code blocks
+         * We split them into two separate structs to avoid increasing
+         * the size of the union.
+         */
+
+        regmatch_info_aux info_aux;
+
+        regmatch_info_aux_eval info_aux_eval;
+
        /* this is a fake union member that matches the first element
         * of each member that needs to store positive backtrack
         * information */
@@ -654,7 +741,6 @@ typedef struct regmatch_state {
            struct regmatch_state *prev_eval;
            struct regmatch_state *prev_curlyx;
            REGEXP      *prev_rex;
-           bool        saved_utf8_pat; /* saved copy of is_utf8_pat */
            CHECKPOINT  cp;     /* remember current savestack indexes */
            CHECKPOINT  lastcp;
            U32        close_paren; /* which close bracket is our end */
@@ -755,50 +841,7 @@ typedef struct regmatch_slab {
     struct regmatch_slab *prev, *next;
 } regmatch_slab;
 
-#define PL_bostr               PL_reg_state.re_state_bostr
-#define PL_regeol              PL_reg_state.re_state_regeol
-#define PL_reg_match_utf8      PL_reg_state.re_state_reg_match_utf8
-#define PL_reg_magic           PL_reg_state.re_state_reg_magic
-#define PL_reg_oldpos          PL_reg_state.re_state_reg_oldpos
-#define PL_reg_oldcurpm                PL_reg_state.re_state_reg_oldcurpm
-#define PL_reg_curpm           PL_reg_state.re_state_reg_curpm
-#define PL_reg_oldsaved                PL_reg_state.re_state_reg_oldsaved
-#define PL_reg_oldsavedlen     PL_reg_state.re_state_reg_oldsavedlen
-#define PL_reg_oldsavedoffset  PL_reg_state.re_state_reg_oldsavedoffset
-#define PL_reg_oldsavedcoffset PL_reg_state.re_state_reg_oldsavedcoffset
-#define PL_reg_maxiter         PL_reg_state.re_state_reg_maxiter
-#define PL_reg_leftiter                PL_reg_state.re_state_reg_leftiter
-#define PL_reg_poscache                PL_reg_state.re_state_reg_poscache
-#define PL_reg_poscache_size   PL_reg_state.re_state_reg_poscache_size
-#define PL_reg_starttry                PL_reg_state.re_state_reg_starttry
-#define PL_nrs                 PL_reg_state.re_state_nrs
-
-struct re_save_state {
-    bool re_state_eval_setup_done;     /* from regexec.c */
-    bool re_state_reg_match_utf8;      /* from regexec.c */
-    bool re_reparsing;                 /* runtime (?{}) fed back into parser */
-    char *re_state_bostr;
-    char *re_state_regeol;             /* End of input, for $ check. */
-    MAGIC *re_state_reg_magic;         /* from regexec.c */
-    PMOP *re_state_reg_oldcurpm;       /* from regexec.c */
-    PMOP *re_state_reg_curpm;          /* from regexec.c */
-    char *re_state_reg_oldsaved;       /* old saved substr during match */
-    STRLEN re_state_reg_oldsavedlen;   /* old length of saved substr during match */
-    STRLEN re_state_reg_oldsavedoffset;        /* old offset of saved substr during match */
-    STRLEN re_state_reg_oldsavedcoffset;/* old coffset of saved substr during match */
-    STRLEN re_state_reg_poscache_size; /* size of pos cache of WHILEM */
-    I32 re_state_reg_oldpos;           /* from regexec.c */
-    I32 re_state_reg_maxiter;          /* max wait until caching pos */
-    I32 re_state_reg_leftiter;         /* wait until caching pos */
-    char *re_state_reg_poscache;       /* cache of pos of WHILEM */
-    char *re_state_reg_starttry;       /* from regexec.c */
-#ifdef PERL_ANY_COW
-    SV *re_state_nrs;                  /* was placeholder: unused since 5.8.0 (5.7.2 patch #12027 for bug ID 20010815.012). Used to save rx->saved_copy */
-#endif
-};
 
-#define SAVESTACK_ALLOC_FOR_RE_SAVE_STATE \
-       (1 + ((sizeof(struct re_save_state) - 1) / sizeof(*PL_savestack)))
 
 /*
  * Local variables: