|NN char* strend|NN char* strbeg|I32 minend \
|NN SV* screamer|U32 nosave
Ap |void |pregfree |NULLOK struct regexp* r
-p |char * |reg_stringify |NN MAGIC *mg|NULLOK STRLEN *lp|NULLOK U32 *flags|NULLOK I32 *haseval
+Ap |void |regfree_internal|NULLOK struct regexp* r
+Ap |char * |reg_stringify |NN MAGIC *mg|NULLOK STRLEN *lp|NULLOK U32 *flags|NULLOK I32 *haseval
#if defined(USE_ITHREADS)
-Ap |regexp*|regdupe |NN const regexp* r|NN CLONE_PARAMS* param
+Ap |void* |regdupe_internal|NN const regexp* r|NN CLONE_PARAMS* param
#endif
Ap |regexp*|pregcomp |NN char* exp|NN char* xend|NN PMOP* pm
Ap |char* |re_intuit_start|NN regexp* prog|NULLOK SV* sv|NN char* strpos \
#define regclass_swash Perl_regclass_swash
#define pregexec Perl_pregexec
#define pregfree Perl_pregfree
-#ifdef PERL_CORE
+#define regfree_internal Perl_regfree_internal
#define reg_stringify Perl_reg_stringify
-#endif
#if defined(USE_ITHREADS)
-#define regdupe Perl_regdupe
+#define regdupe_internal Perl_regdupe_internal
#endif
#define pregcomp Perl_pregcomp
#define re_intuit_start Perl_re_intuit_start
#define regclass_swash(a,b,c,d,e) Perl_regclass_swash(aTHX_ a,b,c,d,e)
#define pregexec(a,b,c,d,e,f,g) Perl_pregexec(aTHX_ a,b,c,d,e,f,g)
#define pregfree(a) Perl_pregfree(aTHX_ a)
-#ifdef PERL_CORE
+#define regfree_internal(a) Perl_regfree_internal(aTHX_ a)
#define reg_stringify(a,b,c,d) Perl_reg_stringify(aTHX_ a,b,c,d)
-#endif
#if defined(USE_ITHREADS)
-#define regdupe(a,b) Perl_regdupe(aTHX_ a,b)
+#define regdupe_internal(a,b) Perl_regdupe_internal(aTHX_ a,b)
#endif
#define pregcomp(a,b,c) Perl_pregcomp(aTHX_ a,b,c)
#define re_intuit_start(a,b,c,d,e,f) Perl_re_intuit_start(aTHX_ a,b,c,d,e,f)
extern I32 my_regexec (pTHX_ regexp* prog, char* stringarg, char* strend,
char* strbeg, I32 minend, SV* screamer,
void* data, U32 flags);
-extern void my_regfree (pTHX_ struct regexp* r);
+
extern char* my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos,
char *strend, U32 flags,
struct re_scream_pos_data_s *data);
extern SV* my_re_intuit_string (pTHX_ regexp *prog);
-extern char* my_reg_stringify (pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval);
+extern void my_regfree (pTHX_ struct regexp* r);
#if defined(USE_ITHREADS)
extern regexp* my_regdupe (pTHX_ const regexp *r, CLONE_PARAMS *param);
#endif
my_re_intuit_start,
my_re_intuit_string,
my_regfree,
- my_reg_stringify,
#if defined(USE_ITHREADS)
my_regdupe
#endif
#define Perl_regprop my_regprop
#define Perl_re_intuit_start my_re_intuit_start
#define Perl_pregcomp my_regcomp
-#define Perl_pregfree my_regfree
+#define Perl_regfree_internal my_regfree
#define Perl_re_intuit_string my_re_intuit_string
-#define Perl_regdupe my_regdupe
-#define Perl_reg_stringify my_reg_stringify
+#define Perl_regdupe_internal my_regdupe
#define PERL_NO_GET_CONTEXT
Perl_regclass_swash
Perl_pregexec
Perl_pregfree
-Perl_regdupe
+Perl_regfree_internal
+Perl_reg_stringify
+Perl_regdupe_internal
Perl_pregcomp
Perl_re_intuit_start
Perl_re_intuit_string
#define CALLRUNOPS CALL_FPTR(PL_runops)
-#define CALLREGCOMP(exp, xend, pm) Perl_pregcomp(aTHX_ exp,xend,pm)
+#define CALLREGCOMP(exp, xend, pm) Perl_pregcomp(aTHX_ (exp),(xend),(pm))
#define CALLREGCOMP_ENG(prog, exp, xend, pm) \
CALL_FPTR(((prog)->comp))(aTHX_ exp, xend, pm)
(strend),(flags),(data))
#define CALLREG_INTUIT_STRING(prog) \
CALL_FPTR((prog)->engine->checkstr)(aTHX_ (prog))
-#define CALLREGFREE(prog) \
- if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
+
#define CALLREG_AS_STR(mg,lp,flags,haseval) \
- CALL_FPTR(((regexp *)((mg)->mg_obj))->engine->as_str)(aTHX_ (mg), (lp), (flags), (haseval))
+ Perl_reg_stringify(aTHX_ (mg), (lp), (flags), (haseval))
#define CALLREG_STRINGIFY(mg,lp,flags) CALLREG_AS_STR(mg,lp,flags,0)
+
+#define CALLREGFREE(prog) \
+ Perl_pregfree(aTHX_ (prog))
+
+#define CALLREGFREE_PVT(prog) \
+ if(prog) CALL_FPTR((prog)->engine->free)(aTHX_ (prog))
+
#if defined(USE_ITHREADS)
#define CALLREGDUPE(prog,param) \
+ Perl_re_dup(aTHX_ (prog),(param))
+
+#define CALLREGDUPE_PVT(prog,param) \
(prog ? CALL_FPTR((prog)->engine->dupe)(aTHX_ (prog),(param)) \
: (REGEXP *)NULL)
#endif
regex engine, feedback on the perl5-porters mail list, and no doubt other
places as well.
-B<WARNING!> It should be clearly understood that this document
-represents the state of the regex engine as the author understands it at
-the time of writing. It is B<NOT> an API definition; it is purely an
-internals guide for those who want to hack the regex engine, or
+B<WARNING!> It should be clearly understood that this document represents
+the state of the regex engine as the author understands it at the time of
+writing. Unless stated otherwise it is B<NOT> an API definition; it is
+purely an internals guide for those who want to hack the regex engine, or
understand how the regex engine works. Readers of this document are
-expected to understand perl's regex syntax and its usage in detail. If
-you want to learn about the basics of Perl's regular expressions, see
+expected to understand perl's regex syntax and its usage in detail. If you
+want to learn about the basics of Perl's regular expressions, see
L<perlre>.
=head1 OVERVIEW
A sequence of valid UTF-8 bytes cannot be a subsequence of
another valid sequence of UTF-8 bytes.
-=head2 Base Struct
-F<regexp.h> contains the base structure definition:
+=head2 Base Structures
- typedef struct regexp {
- I32 *startp;
- I32 *endp;
- regexp_paren_ofs *swap;
- regnode *regstclass;
- struct reg_substr_data *substrs;
- char *precomp; /* pre-compilation regular expression */
- struct reg_data *data; /* Additional data. */
- char *subbeg; /* saved or original string
- so \digit works forever. */
- #ifdef PERL_OLD_COPY_ON_WRITE
- SV *saved_copy; /* If non-NULL, SV which is COW from original */
- #endif
- U32 *offsets; /* offset annotations 20001228 MJD */
- I32 sublen; /* Length of string pointed by subbeg */
- I32 refcnt;
- I32 minlen; /* mininum length of string to match */
- I32 minlenret; /* mininum possible length of $& */
- I32 prelen; /* length of precomp */
- U32 nparens; /* number of parentheses */
- U32 lastparen; /* last paren matched */
- U32 lastcloseparen; /* last paren matched */
- U32 reganch; /* Internal use only +
- Tainted information used by regexec? */
- HV *paren_names; /* Paren names */
- const struct regexp_engine* engine;
- regnode program[1]; /* Unwarranted chumminess with compiler. */
- } regexp;
+There are two structures used to store a compiled regular expression.
+One, the regexp structure is considered to be perl's property, and the
+other is considered to be the property of the regex engine which
+compiled the regular expression; in the case of the stock engine this
+structure is called regexp_internal.
-=over 5
-
-=item C<program>
+The regexp structure contains all the data that perl needs to be aware of
+to properly work with the regular expression. It includes data about
+optimisations that perl can use to determine if the regex engine should
+really be used, and various other control info that is needed to properly
+execute patterns in various contexts such as is the pattern anchored in
+some way, or what flags were used during the compile, or whether the
+program contains special constructs that perl needs to be aware of.
-Compiled program. Inlined into the structure so the entire struct can be
-treated as a single blob.
+In addition it contains two fields that are intended for the private use
+of the regex engine that compiled the pattern. These are the C<intflags>
+and pprivate members. The C<pprivate> is a void pointer to an arbitrary
+structure whose use and management is the responsibility of the compiling
+engine. perl will never modify either of these values.
-=item C<data>
+As mentioned earlier, in the case of the default engines, the C<pprivate>
+will be a pointer to a regexp_internal structure which holds the compiled
+program and any additional data that is private to the regex engine
+implementation.
-This field points at a reg_data structure, which is defined as follows
+=head3 Perl Inspectable Data About Pattern
- struct reg_data {
- U32 count;
- U8 *what;
- void* data[1];
- };
+F<regexp.h> contains the "public" structure definition. All regex engines
+must be able to correctly build a regexp structure.
-This structure is used for handling data structures that the regex engine
-needs to handle specially during a clone or free operation on the compiled
-product. Each element in the data array has a corresponding element in the
-what array. During compilation regops that need special structures stored
-will add an element to each array using the add_data() routine and then store
-the index in the regop.
-
-=item C<nparens>, C<lasparen>, and C<lastcloseparen>
+ typedef struct regexp {
+ /* what engine created this regexp? */
+ const struct regexp_engine* engine;
+
+ /* Information about the match that the perl core uses to manage things */
+ U32 extflags; /* Flags used both externally and internally */
+ I32 minlen; /* mininum possible length of string to match */
+ I32 minlenret; /* mininum possible length of $& */
+ U32 gofs; /* chars left of pos that we search from */
+ struct reg_substr_data *substrs; /* substring data about strings that must appear
+ in the final match, used for optimisations */
+ U32 nparens; /* number of capture buffers */
+
+ /* private engine specific data */
+ U32 intflags; /* Engine Specific Internal flags */
+ void *pprivate; /* Data private to the regex engine which
+ created this object. */
+
+ /* Data about the last/current match. These are modified during matching*/
+ U32 lastparen; /* last open paren matched */
+ U32 lastcloseparen; /* last close paren matched */
+ I32 *startp; /* Array of offsets from start of string (@-) */
+ I32 *endp; /* Array of offsets from start of string (@+) */
+ char *subbeg; /* saved or original string
+ so \digit works forever. */
+ I32 sublen; /* Length of string pointed by subbeg */
+ SV_SAVED_COPY /* If non-NULL, SV which is COW from original */
+
+
+ /* Information about the match that isn't often used */
+ char *precomp; /* pre-compilation regular expression */
+ I32 prelen; /* length of precomp */
+ I32 seen_evals; /* number of eval groups in the pattern - for security checks */
+ HV *paren_names; /* Optional hash of paren names */
+
+ /* Refcount of this regexp */
+ I32 refcnt; /* Refcount of this regexp */
+ } regexp;
-These fields are used to keep track of how many paren groups could be matched
-in the pattern, which was the last open paren to be entered, and which was
-the last close paren to be entered.
+The fields are discussed in more detail below:
-=item C<startp>, C<endp>, C<swap>
+=over 5
-These fields store arrays that are used to hold the offsets of the begining
-and end of each capture group that has matched. -1 is used to indicate no match.
-C<swap> is an extra set of startp/endp stored in a C<regexp_paren_ofs>
-struct. This is used when the last successful match was from same pattern
-as the current pattern, so that a partial match doesn't overwrite the
-previous match's results. When this field is data filled the matching
-engine will swap buffers before every match attempt. If the match fails,
-then it swaps them back. If it's successful it leaves them. This field
-is populated on demand and is by default null.
+=item C<refcnt>
-These are the source for @- and @+.
+The number of times the structure is referenced. When this falls to 0
+the regexp is automatically freed by a call to pregfree.
-=item C<subbeg> C<sublen> C<saved_copy>
+=item C<engine>
-These are used during execution phase for managing search and replace
-patterns.
+This field points at a regexp_engine structure which contains pointers
+to the subroutine that are to be used for performing a match. It
+is the compiling routines responsibility to populate this field before
+returning the regexp object.
-=item C<precomp> C<prelen> C<offsets>
+=item C<precomp> C<prelen>
Used for debugging purposes. C<precomp> holds a copy of the pattern
-that was compiled, offsets holds a mapping of offset in the C<program>
-to offset in the C<precomp> string. This is only used by ActiveStates
-visual regex debugger.
+that was compiled.
-=item C<reg_substr_data>
-
-Holds information on the longest string that must occur at a fixed
-offset from the start of the pattern, and the longest string that must
-occur at a floating offset from the start of the pattern. Used to do
-Fast-Boyer-Moore searches on the string to find out if its worth using
-the regex engine at all, and if so where in the string to search.
+=item C<extflags>
-=item C<regstclass>
-
-Special regop that is used by C<re_intuit_start()> to check if a pattern
-can match at a certain position. For instance if the regex engine knows
-that the pattern must start with a 'Z' then it can scan the string until
-it finds one and then launch the regex engine from there. The routine
-that handles this is called C<find_by_class()>. Sometimes this field
-points at a regop embedded in the program, and sometimes it points at
-an independent synthetic regop that has been constructed by the optimiser.
+This is used to store various flags about the pattern, such as whether it
+contains a \G or a ^ or $ symbol.
=item C<minlen> C<minlenret>
logic uses the C<minlenret> to tell whether it can do in-place substition
which can result in considerable speedup.
-=item C<reganch>
+=item C<gofs>
-This is used to store various flags about the pattern, such as whether it
-contains a \G or a ^ or $ symbol.
+Left offset from pos() to start match at.
+
+=item C<nparens>, C<lasparen>, and C<lastcloseparen>
+
+These fields are used to keep track of how many paren groups could be matched
+in the pattern, which was the last open paren to be entered, and which was
+the last close paren to be entered.
=item C<paren_names>
independently in the data array in cases where named backreferences are
used.
-=item C<refcnt>
+=item C<reg_substr_data>
-The number of times the structure is referenced. When this falls to 0
-the regexp is automatically freed by a call to pregfree.
+Holds information on the longest string that must occur at a fixed
+offset from the start of the pattern, and the longest string that must
+occur at a floating offset from the start of the pattern. Used to do
+Fast-Boyer-Moore searches on the string to find out if its worth using
+the regex engine at all, and if so where in the string to search.
-=item C<engine>
+=item C<startp>, C<endp>,
-This field points at a regexp_engine structure which contains pointers
-to the subroutine that are to be used for performing a match. It
-is the compiling routines responsibility to populate this field before
-returning the regexp object.
+These fields store arrays that are used to hold the offsets of the begining
+and end of each capture group that has matched. -1 is used to indicate no match.
+
+These are the source for @- and @+.
+
+=item C<subbeg> C<sublen> C<saved_copy>
+
+These are used during execution phase for managing search and replace
+patterns.
+
+=item C<seen_evals>
+
+This stores the number of eval groups in the pattern. This is used
+for security purposes when embedding compiled regexes into larger
+patterns.
+
+=back
+
+=head3 Engine Private Data About Pattern
+
+Additionally regexp.h contains the following "private" definition which is perl
+specific and is only of curiosity value to other engine implementations.
+
+ typedef struct regexp_internal {
+ regexp_paren_ofs *swap; /* Swap copy of *startp / *endp */
+ U32 *offsets; /* offset annotations 20001228 MJD
+ data about mapping the program to the
+ string*/
+ regnode *regstclass; /* Optional startclass as identified or constructed
+ by the optimiser */
+ struct reg_data *data; /* Additional miscellaneous data used by the program.
+ Used to make it easier to clone and free arbitrary
+ data that the regops need. Often the ARG field of
+ a regop is an index into this structure */
+ regnode program[1]; /* Unwarranted chumminess with compiler. */
+ } regexp_internal;
+
+=over 5
+
+=item C<swap>
+
+C<swap> is an extra set of startp/endp stored in a C<regexp_paren_ofs>
+struct. This is used when the last successful match was from same pattern
+as the current pattern, so that a partial match doesn't overwrite the
+previous match's results. When this field is data filled the matching
+engine will swap buffers before every match attempt. If the match fails,
+then it swaps them back. If it's successful it leaves them. This field
+is populated on demand and is by default null.
+
+=item C<offsets>
+
+Offsets holds a mapping of offset in the C<program>
+to offset in the C<precomp> string. This is only used by ActiveStates
+visual regex debugger.
+
+=item C<regstclass>
+
+Special regop that is used by C<re_intuit_start()> to check if a pattern
+can match at a certain position. For instance if the regex engine knows
+that the pattern must start with a 'Z' then it can scan the string until
+it finds one and then launch the regex engine from there. The routine
+that handles this is called C<find_by_class()>. Sometimes this field
+points at a regop embedded in the program, and sometimes it points at
+an independent synthetic regop that has been constructed by the optimiser.
+
+=item C<data>
+
+This field points at a reg_data structure, which is defined as follows
+
+ struct reg_data {
+ U32 count;
+ U8 *what;
+ void* data[1];
+ };
+
+This structure is used for handling data structures that the regex engine
+needs to handle specially during a clone or free operation on the compiled
+product. Each element in the data array has a corresponding element in the
+what array. During compilation regops that need special structures stored
+will add an element to each array using the add_data() routine and then store
+the index in the regop.
+
+=item C<program>
+
+Compiled program. Inlined into the structure so the entire struct can be
+treated as a single blob.
=back
typedef struct regexp_engine {
regexp* (*comp) (pTHX_ char* exp, char* xend, PMOP* pm);
- I32 (*exec) (pTHX_ regexp* prog, char* stringarg, char* strend,
- char* strbeg, I32 minend, SV* screamer,
- void* data, U32 flags);
+ I32 (*exec) (pTHX_ regexp* prog, char* stringarg, char* strend,
+ char* strbeg, I32 minend, SV* screamer,
+ void* data, U32 flags);
char* (*intuit) (pTHX_ regexp *prog, SV *sv, char *strpos,
- char *strend, U32 flags,
- struct re_scream_pos_data_s *data);
- SV* (*checkstr) (pTHX_ regexp *prog);
+ char *strend, U32 flags,
+ struct re_scream_pos_data_s *data);
+ SV* (*checkstr) (pTHX_ regexp *prog);
void (*free) (pTHX_ struct regexp* r);
#ifdef USE_ITHREADS
- regexp* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
- #endif
+ void* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
+ #endif
} regexp_engine;
When a regexp is compiled its C<engine> field is then set to point at
-the appropriate structure so that when it needs to be used it can find
+the appropriate structure so that when it needs to be used Perl can find
the right routines to do so.
In order to install a new regexp handler, C<$^H{regcomp}> is set
Find the start position where a regex match should be attempted,
or possibly whether the regex engine should not be run because the
-pattern can't match.
+pattern can't match. This is called as appropriate by the core
+depending on the values of the extflags member of the regexp
+structure.
=item checkstr
void free(regexp *prog);
-Release any resources allocated to store this pattern. After this
-call prog is an invalid pointer.
+Called by perl when it is freeing a regexp pattern so that the engine
+can release any resources pointed to by the C<pprivate> member of the
+regexp structure. This is only responsible for freeing private data,
+perl will handle releasing anything else contained in the regexp structure.
=item dupe
- regexp* dupe(const regexp *r, CLONE_PARAMS *param);
+ void* dupe(const regexp *r, CLONE_PARAMS *param);
On threaded builds a regexp may need to be duplicated so that the pattern
can be used by mutiple threads. This routine is expected to handle the
-duplication. On unthreaded builds this field doesnt exist.
+duplication of any private data pointed to by the C<pprivate> member of
+the regexp structure. It will be called with the preconstructed new
+regexp structure as an argument, the C<pprivate> member will point at
+the B<old> private structue, and it is this routines responsibility to
+construct a copy and return a pointer to it (which perl will then use to
+overwrite the field as passed to this routine.)
+
+This allows the engine to dupe its private data but also if necessary
+modify the final structure if it really must.
+
+On unthreaded builds this field doesn't exist.
=back
__attribute__nonnull__(pTHX_6);
PERL_CALLCONV void Perl_pregfree(pTHX_ struct regexp* r);
+PERL_CALLCONV void Perl_regfree_internal(pTHX_ struct regexp* r);
PERL_CALLCONV char * Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval)
__attribute__nonnull__(pTHX_1);
#if defined(USE_ITHREADS)
-PERL_CALLCONV regexp* Perl_regdupe(pTHX_ const regexp* r, CLONE_PARAMS* param)
+PERL_CALLCONV void* Perl_regdupe_internal(pTHX_ const regexp* r, CLONE_PARAMS* param)
__attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
return count;
}
+/*XXX: todo make this not included in a non debugging perl */
#ifndef PERL_IN_XSUB_RE
void
Perl_reginitcolors(pTHX)
ri->program[RExC_size].type = 255;
#endif
/* Store the count of eval-groups for security checks: */
- RExC_emit->next_off = (RExC_seen_evals > (I32)U16_MAX) ? U16_MAX : (U16)RExC_seen_evals;
+ RExC_rx->seen_evals = RExC_seen_evals;
REGC((U8)REG_MAGIC, (char*) RExC_emit++);
if (reg(pRExC_state, 0, &flags,1) == NULL)
return(NULL);
}
/*
- pregfree - free a regexp
+ pregfree()
- See regdupe below if you change anything here.
+ handles refcounting and freeing the perl core regexp structure. When
+ it is necessary to actually free the structure the first thing it
+ does is call the 'free' method of the regexp_engine associated to to
+ the regexp, allowing the handling of the void *pprivate; member
+ first. (This routine is not overridable by extensions, which is why
+ the extensions free is called first.)
+
+ See regdupe and regdupe_internal if you change anything here.
*/
-
+#ifndef PERL_IN_XSUB_RE
void
Perl_pregfree(pTHX_ struct regexp *r)
{
dVAR;
- RXi_GET_DECL(r,ri);
GET_RE_DEBUG_FLAGS_DECL;
if (!r || (--r->refcnt > 0))
return;
- DEBUG_COMPILE_r({
- if (!PL_colorset)
- reginitcolors();
- {
- SV *dsv= sv_newmortal();
- RE_PV_QUOTED_DECL(s, (r->extflags & RXf_UTF8),
- dsv, r->precomp, r->prelen, 60);
- PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n",
- PL_colors[4],PL_colors[5],s);
- }
- });
-
+
+ CALLREGFREE_PVT(r); /* free the private data */
+
/* gcov results gave these as non-null 100% of the time, so there's no
optimisation in checking them before calling Safefree */
Safefree(r->precomp);
- Safefree(ri->offsets); /* 20010421 MJD */
RX_MATCH_COPY_FREE(r);
#ifdef PERL_OLD_COPY_ON_WRITE
if (r->saved_copy)
}
if (r->paren_names)
SvREFCNT_dec(r->paren_names);
+
+ Safefree(r->startp);
+ Safefree(r->endp);
+ Safefree(r);
+}
+#endif
+
+/* regfree_internal()
+
+ Free the private data in a regexp. This is overloadable by
+ extensions. Perl takes care of the regexp structure in pregfree(),
+ this covers the *pprivate pointer which technically perldoesnt
+ know about, however of course we have to handle the
+ regexp_internal structure when no extension is in use.
+
+ Note this is called before freeing anything in the regexp
+ structure.
+ */
+
+void
+Perl_regfree_internal(pTHX_ struct regexp *r)
+{
+ dVAR;
+ RXi_GET_DECL(r,ri);
+ GET_RE_DEBUG_FLAGS_DECL;
+
+ DEBUG_COMPILE_r({
+ if (!PL_colorset)
+ reginitcolors();
+ {
+ SV *dsv= sv_newmortal();
+ RE_PV_QUOTED_DECL(s, (r->extflags & RXf_UTF8),
+ dsv, r->precomp, r->prelen, 60);
+ PerlIO_printf(Perl_debug_log,"%sFreeing REx:%s %s\n",
+ PL_colors[4],PL_colors[5],s);
+ }
+ });
+
+ Safefree(ri->offsets); /* 20010421 MJD */
if (ri->data) {
int n = ri->data->count;
PAD* new_comppad = NULL;
Safefree(ri->data->what);
Safefree(ri->data);
}
- Safefree(r->startp);
- Safefree(r->endp);
if (ri->swap) {
Safefree(ri->swap->startp);
Safefree(ri->swap->endp);
Safefree(ri->swap);
}
Safefree(ri);
- Safefree(r);
}
#define sv_dup_inc(s,t) SvREFCNT_inc(sv_dup(s,t))
given regexp structure. It is a no-op when not under USE_ITHREADS.
(Originally this *was* re_dup() for change history see sv.c)
- See pregfree() above if you change anything here.
+ After all of the core data stored in struct regexp is duplicated
+ the regexp_engine.dupe method is used to copy any private data
+ stored in the *pprivate pointer. This allows extensions to handle
+ any duplication it needs to do.
+
+ See pregfree() and regfree_internal() if you change anything here.
*/
#if defined(USE_ITHREADS)
+#ifndef PERL_IN_XSUB_RE
regexp *
-Perl_regdupe(pTHX_ const regexp *r, CLONE_PARAMS *param)
+Perl_re_dup(pTHX_ const regexp *r, CLONE_PARAMS *param)
{
dVAR;
regexp *ret;
- regexp_internal *reti;
- int i, len, npar;
+ int i, npar;
struct reg_substr_datum *s;
RXi_GET_DECL(r,ri);
if ((ret = (REGEXP *)ptr_table_fetch(PL_ptr_table, r)))
return ret;
- len = ri->offsets[0];
+
npar = r->nparens+1;
-
Newxz(ret, 1, regexp);
- Newxc(reti, sizeof(regexp_internal) + (len+1)*sizeof(regnode), char, regexp_internal);
- RXi_SET(ret,reti);
- Copy(ri->program, reti->program, len+1, regnode);
-
Newx(ret->startp, npar, I32);
Copy(r->startp, ret->startp, npar, I32);
Newx(ret->endp, npar, I32);
- Copy(r->startp, ret->startp, npar, I32);
- if(ri->swap) {
- Newx(reti->swap, 1, regexp_paren_ofs);
- /* no need to copy these */
- Newx(reti->swap->startp, npar, I32);
- Newx(reti->swap->endp, npar, I32);
- } else {
- reti->swap = NULL;
- }
+ Copy(r->endp, ret->endp, npar, I32);
Newx(ret->substrs, 1, struct reg_substr_data);
for (s = ret->substrs->data, i = 0; i < 3; i++, s++) {
s->substr = sv_dup_inc(r->substrs->data[i].substr, param);
s->utf8_substr = sv_dup_inc(r->substrs->data[i].utf8_substr, param);
}
+
+
+ ret->precomp = SAVEPVN(r->precomp, r->prelen);
+ ret->refcnt = r->refcnt;
+ ret->minlen = r->minlen;
+ ret->minlenret = r->minlenret;
+ ret->prelen = r->prelen;
+ ret->nparens = r->nparens;
+ ret->lastparen = r->lastparen;
+ ret->lastcloseparen = r->lastcloseparen;
+ ret->intflags = r->intflags;
+ ret->extflags = r->extflags;
+
+ ret->sublen = r->sublen;
+
+ ret->engine = r->engine;
+
+ ret->paren_names = hv_dup_inc(r->paren_names, param);
+
+ if (RX_MATCH_COPIED(ret))
+ ret->subbeg = SAVEPVN(r->subbeg, r->sublen);
+ else
+ ret->subbeg = NULL;
+#ifdef PERL_OLD_COPY_ON_WRITE
+ ret->saved_copy = NULL;
+#endif
+
+ ret->pprivate = r->pprivate;
+ RXi_SET(ret,CALLREGDUPE_PVT(ret,param));
+
+ ptr_table_store(PL_ptr_table, r, ret);
+ return ret;
+}
+#endif /* PERL_IN_XSUB_RE */
+
+/*
+ regdupe_internal()
+
+ This is the internal complement to regdupe() which is used to copy
+ the structure pointed to by the *pprivate pointer in the regexp.
+ This is the core version of the extension overridable cloning hook.
+ The regexp structure being duplicated will be copied by perl prior
+ to this and will be provided as the regexp *r argument, however
+ with the /old/ structures pprivate pointer value. Thus this routine
+ may override any copying normally done by perl.
+
+ It returns a pointer to the new regexp_internal structure.
+*/
+
+void *
+Perl_regdupe_internal(pTHX_ const regexp *r, CLONE_PARAMS *param)
+{
+ dVAR;
+ regexp_internal *reti;
+ int len, npar;
+ RXi_GET_DECL(r,ri);
+
+ npar = r->nparens+1;
+ len = ri->offsets[0];
+
+ Newxc(reti, sizeof(regexp_internal) + (len+1)*sizeof(regnode), char, regexp_internal);
+ Copy(ri->program, reti->program, len+1, regnode);
+
+ if(ri->swap) {
+ Newx(reti->swap, 1, regexp_paren_ofs);
+ /* no need to copy these */
+ Newx(reti->swap->startp, npar, I32);
+ Newx(reti->swap->endp, npar, I32);
+ } else {
+ reti->swap = NULL;
+ }
+
reti->regstclass = NULL;
if (ri->data) {
Newx(reti->offsets, 2*len+1, U32);
Copy(ri->offsets, reti->offsets, 2*len+1, U32);
-
- ret->precomp = SAVEPVN(r->precomp, r->prelen);
- ret->refcnt = r->refcnt;
- ret->minlen = r->minlen;
- ret->minlenret = r->minlenret;
- ret->prelen = r->prelen;
- ret->nparens = r->nparens;
- ret->lastparen = r->lastparen;
- ret->lastcloseparen = r->lastcloseparen;
- ret->intflags = r->intflags;
- ret->extflags = r->extflags;
-
- ret->sublen = r->sublen;
-
- ret->engine = r->engine;
- ret->paren_names = hv_dup_inc(r->paren_names, param);
-
- if (RX_MATCH_COPIED(ret))
- ret->subbeg = SAVEPVN(r->subbeg, r->sublen);
- else
- ret->subbeg = NULL;
-#ifdef PERL_OLD_COPY_ON_WRITE
- ret->saved_copy = NULL;
-#endif
-
- ptr_table_store(PL_ptr_table, r, ret);
- return ret;
+ return (void*)reti;
}
-#endif
+
+#endif /* USE_ITHREADS */
/*
reg_stringify()
resulting string
If flags is nonnull and the returned string contains UTF8 then
- (flags & 1) will be true.
+ (*flags & 1) will be true.
If haseval is nonnull then it is used to return whether the pattern
contains evals.
Normally called via macro:
- CALLREG_STRINGIFY(mg,0,0);
+ CALLREG_STRINGIFY(mg,&len,&utf8);
And internally with
- CALLREG_AS_STR(mg,lp,flags,haseval)
+ CALLREG_AS_STR(mg,&lp,&flags,&haseval)
See sv_2pv_flags() in sv.c for an example of internal usage.
*/
-
+#ifndef PERL_IN_XSUB_RE
char *
Perl_reg_stringify(pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval ) {
dVAR;
const regexp * const re = (regexp *)mg->mg_obj;
- RXi_GET_DECL(re,ri);
-
+
if (!mg->mg_ptr) {
const char *fptr = "msix";
char reflags[6];
mg->mg_ptr[mg->mg_len] = 0;
}
if (haseval)
- *haseval = ri->program[0].next_off;
+ *haseval = re->seen_evals;
if (flags)
*flags = ((re->extflags & RXf_UTF8) ? 1 : 0);
return mg->mg_ptr;
}
-
-#ifndef PERL_IN_XSUB_RE
/*
- regnext - dig the "next" pointer out of a node
*/
Perl_regexec_flags,
Perl_re_intuit_start,
Perl_re_intuit_string,
- Perl_pregfree,
- Perl_reg_stringify,
+ Perl_regfree_internal,
#if defined(USE_ITHREADS)
- Perl_regdupe
+ Perl_regdupe_internal
#endif
};
#endif /* DOINIT */
#else
#define SV_SAVED_COPY
#endif
-
+/* this is ordered such that the most commonly used
+ fields are at the start of the struct */
typedef struct regexp {
- /* Generic details */
- const struct regexp_engine* engine; /* what created this regexp? */
- I32 refcnt; /* Refcount of this regexp */
-
- /* The original string as passed to the compilation routine */
- char *precomp; /* pre-compilation regular expression */
- I32 prelen; /* length of precomp */
-
- /* Used for generic optimisations by the perl core.
- All engines are expected to provide this information. */
+ /* what engine created this regexp? */
+ const struct regexp_engine* engine;
+
+ /* Information about the match that the perl core uses to manage things */
U32 extflags; /* Flags used both externally and internally */
I32 minlen; /* mininum possible length of string to match */
I32 minlenret; /* mininum possible length of $& */
U32 gofs; /* chars left of pos that we search from */
- U32 nparens; /* number of capture buffers */
- HV *paren_names; /* Optional hash of paren names */
- struct reg_substr_data *substrs; /* substring data about strings that must appear
+ struct reg_substr_data *substrs; /* substring data about strings that must appear
in the final match, used for optimisations */
+ U32 nparens; /* number of capture buffers */
- /* Data about the last/current match. Used by the core and therefore
- must be populated by all engines. */
+ /* private engine specific data */
+ U32 intflags; /* Engine Specific Internal flags */
+ void *pprivate; /* Data private to the regex engine which
+ created this object. */
+
+ /* Data about the last/current match. These are modified during matching*/
+ U32 lastparen; /* last open paren matched */
+ U32 lastcloseparen; /* last close paren matched */
+ I32 *startp; /* Array of offsets from start of string (@-) */
+ I32 *endp; /* Array of offsets from start of string (@+) */
char *subbeg; /* saved or original string
so \digit works forever. */
I32 sublen; /* Length of string pointed by subbeg */
- I32 *startp; /* Array of offsets from start of string (@-) */
- I32 *endp; /* Array of offsets from start of string (@+) */
-
SV_SAVED_COPY /* If non-NULL, SV which is COW from original */
- U32 lastparen; /* last open paren matched */
- U32 lastcloseparen; /* last close paren matched */
-
- /* Perl Regex Engine specific data. Other engines shouldn't need
- to touch this. Should be refactored out into a different structure
- and accessed via the *pprivate field. (except intflags) */
- U32 intflags; /* Internal flags */
- void *pprivate; /* Data private to the regex engine which
- created this object. Perl will never mess with
- this member at all. */
+
+
+ /* Information about the match that isn't often used */
+ char *precomp; /* pre-compilation regular expression */
+ I32 prelen; /* length of precomp */
+ I32 seen_evals; /* number of eval groups in the pattern - for security checks */
+ HV *paren_names; /* Optional hash of paren names */
+
+ /* Refcount of this regexp */
+ I32 refcnt; /* Refcount of this regexp */
} regexp;
struct re_scream_pos_data_s *data);
SV* (*checkstr) (pTHX_ regexp *prog);
void (*free) (pTHX_ struct regexp* r);
- char* (*as_str) (pTHX_ MAGIC *mg, STRLEN *lp, U32 *flags, I32 *haseval);
#ifdef USE_ITHREADS
- regexp* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
+ void* (*dupe) (pTHX_ const regexp *r, CLONE_PARAMS *param);
#endif
} regexp_engine;
#define SAVEPVN(p,n) ((p) ? savepvn(p,n) : NULL)
-/* Duplicate a regexp. Required reading: pregcomp() and pregfree() in
- regcomp.c. AMS 20010712 */
-
-REGEXP *
-Perl_re_dup(pTHX_ const REGEXP *r, CLONE_PARAMS *param)
-{
- return CALLREGDUPE(r,param);
-}
-
/* duplicate a file handle */
PerlIO *
nmg->mg_type = mg->mg_type;
nmg->mg_flags = mg->mg_flags;
if (mg->mg_type == PERL_MAGIC_qr) {
- nmg->mg_obj = (SV*)re_dup((REGEXP*)mg->mg_obj, param);
+ nmg->mg_obj = (SV*)CALLREGDUPE((REGEXP*)mg->mg_obj, param);
}
else if(mg->mg_type == PERL_MAGIC_backref) {
/* The backref AV has its reference count deliberately bumped by
SvREPADTMP(regex)
? sv_dup_inc(regex, param)
: SvREFCNT_inc(
- newSViv(PTR2IV(re_dup(
+ newSViv(PTR2IV(CALLREGDUPE(
INT2PTR(REGEXP *, SvIVX(regex)), param))))
;
av_push(PL_regex_padav, sv);
projects / p5sagit/p5-mst-13.2.git / commitdiff