**** Alterations to Henry's code are...
****
**** Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- **** 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ **** 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
****
**** You may distribute under the terms of either the GNU General Public
**** License or the Artistic License, as specified in the README file.
STATIC CHECKPOINT
S_regcppush(pTHX_ I32 parenfloor)
{
+ dVAR;
const int retval = PL_savestack_ix;
#define REGCP_PAREN_ELEMS 4
const int paren_elems_to_push = (PL_regsize - parenfloor) * REGCP_PAREN_ELEMS;
STATIC char *
S_regcppop(pTHX)
{
+ dVAR;
I32 i;
U32 paren = 0;
char *input;
return input;
}
-STATIC char *
-S_regcp_set_to(pTHX_ I32 ss)
-{
- const I32 tmp = PL_savestack_ix;
-
- PL_savestack_ix = ss;
- regcppop();
- PL_savestack_ix = tmp;
- return Nullch;
-}
-
typedef struct re_cc_state
{
I32 ss;
STATIC void
S_cache_re(pTHX_ regexp *prog)
{
+ dVAR;
PL_regprecomp = prog->precomp; /* Needed for FAIL. */
#ifdef DEBUGGING
PL_regprogram = prog->program;
Perl_re_intuit_start(pTHX_ regexp *prog, SV *sv, char *strpos,
char *strend, U32 flags, re_scream_pos_data *data)
{
+ dVAR;
register I32 start_shift = 0;
/* Should be nonnegative! */
register I32 end_shift = 0;
s = find_byclass(prog, prog->regstclass, s, endpos, 1);
if (!s) {
#ifdef DEBUGGING
- const char *what = 0;
+ const char *what = NULL;
#endif
if (endpos == strend) {
DEBUG_EXECUTE_r( PerlIO_printf(Perl_debug_log,
if (s == PL_bostr)
tmp = '\n';
else {
- U8 *r = reghop3((U8*)s, -1, (U8*)PL_bostr);
-
+ U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
}
tmp = ((OP(c) == BOUND ?
if (s == PL_bostr)
tmp = '\n';
else {
- U8 *r = reghop3((U8*)s, -1, (U8*)PL_bostr);
-
+ U8 * const r = reghop3((U8*)s, -1, (U8*)PL_bostr);
tmp = utf8n_to_uvchr(r, UTF8SKIP(r), 0, 0);
}
tmp = ((OP(c) == NBOUND ?
/* data: May be used for some additional optimizations. */
/* nosave: For optimizations. */
{
+ dVAR;
register char *s;
register regnode *c;
register char *startpos = stringarg;
const bool do_utf8 = DO_UTF8(sv);
const I32 multiline = prog->reganch & PMf_MULTILINE;
#ifdef DEBUGGING
- SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
- SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
+ SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
+ SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
#endif
GET_RE_DEBUG_FLAGS_DECL;
STATIC I32 /* 0 failure, 1 success */
S_regtry(pTHX_ regexp *prog, char *startpos)
{
+ dVAR;
register I32 i;
register I32 *sp;
register I32 *ep;
ENTER; \
SAVETMPS; \
bufflen = TRIE_INITAL_ACCEPT_BUFFLEN ; \
- sv_accept_buff=NEWSV( 1234, \
- bufflen * sizeof(reg_trie_accepted) - 1 ); \
+ sv_accept_buff=newSV(bufflen * sizeof(reg_trie_accepted) - 1 );\
SvCUR_set( sv_accept_buff, sizeof(reg_trie_accepted) ); \
SvPOK_on( sv_accept_buff ); \
sv_2mortal( sv_accept_buff ); \
I32 unwind = 0;
/* used by the trie code */
- SV *sv_accept_buff = 0; /* accepting states we have traversed */
- reg_trie_accepted *accept_buff = 0; /* "" */
+ SV *sv_accept_buff = NULL; /* accepting states we have traversed */
+ reg_trie_accepted *accept_buff = NULL; /* "" */
reg_trie_data *trie; /* what trie are we using right now */
U32 accepted = 0; /* how many accepting states we have seen*/
#endif
register const bool do_utf8 = PL_reg_match_utf8;
#ifdef DEBUGGING
- SV *dsv0 = PERL_DEBUG_PAD_ZERO(0);
- SV *dsv1 = PERL_DEBUG_PAD_ZERO(1);
- SV *dsv2 = PERL_DEBUG_PAD_ZERO(2);
+ SV * const dsv0 = PERL_DEBUG_PAD_ZERO(0);
+ SV * const dsv1 = PERL_DEBUG_PAD_ZERO(1);
+ SV * const dsv2 = PERL_DEBUG_PAD_ZERO(2);
SV *re_debug_flags = NULL;
#endif
while (scan != NULL) {
DEBUG_EXECUTE_r( {
- SV *prop = sv_newmortal();
+ SV * const prop = sv_newmortal();
const int docolor = *PL_colors[0];
const int taill = (docolor ? 10 : 7); /* 3 chars for "> <" */
int l = (PL_regeol - locinput) > taill ? taill : (PL_regeol - locinput);
best = cur;
}
DEBUG_EXECUTE_r({
- SV **tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 );
+ SV ** const tmp = av_fetch( trie->words, accept_buff[ best ].wordnum - 1, 0 );
PerlIO_printf( Perl_debug_log, "%*s %strying alternation #%d <%s> at 0x%p%s\n",
REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
accept_buff[best].wordnum,
case EVAL:
{
dSP;
- OP_4tree *oop = PL_op;
- COP *ocurcop = PL_curcop;
+ OP_4tree * const oop = PL_op;
+ COP * const ocurcop = PL_curcop;
PAD *old_comppad;
SV *ret;
- struct regexp *oreg = PL_reg_re;
+ struct regexp * const oreg = PL_reg_re;
n = ARG(scan);
PL_op = (OP_4tree*)PL_regdata->data[n];
PL_regendp[0] = PL_reg_magic->mg_len = locinput - PL_bostr;
{
- SV **before = SP;
+ SV ** const before = SP;
CALLRUNOPS(aTHX); /* Scalar context. */
SPAGAIN;
if (SP == before)
if (logical) {
if (logical == 2) { /* Postponed subexpression. */
regexp *re;
- MAGIC *mg = Null(MAGIC*);
+ MAGIC *mg = NULL;
re_cc_state state;
CHECKPOINT cp, lastcp;
int toggleutf;
}
else {
STRLEN len;
- const char *t = SvPV_const(ret, len);
+ const char * const t = SvPV_const(ret, len);
PMOP pm;
char * const oprecomp = PL_regprecomp;
const I32 osize = PL_regsize;
CHECKPOINT cp, lastcp;
CURCUR* cc = PL_regcc;
- char *lastloc = cc->lastloc; /* Detection of 0-len. */
+ char * const lastloc = cc->lastloc; /* Detection of 0-len. */
I32 cache_offset = 0, cache_bit = 0;
n = cc->cur + 1; /* how many we know we matched */
next = inner; /* Avoid recursion. */
else {
const I32 lastparen = *PL_reglastparen;
- I32 unwind1;
- re_unwind_branch_t *uw;
-
/* Put unwinding data on stack */
- unwind1 = SSNEWt(1,re_unwind_branch_t);
- uw = SSPTRt(unwind1,re_unwind_branch_t);
+ const I32 unwind1 = SSNEWt(1,re_unwind_branch_t);
+ re_unwind_branch_t * const uw = SSPTRt(unwind1,re_unwind_branch_t);
+
uw->prev = unwind;
unwind = unwind1;
uw->type = ((c1 == BRANCH)
re_cc_state *cur_call_cc = PL_reg_call_cc;
CURCUR *cctmp = PL_regcc;
regexp *re = PL_reg_re;
- CHECKPOINT cp, lastcp;
-
- cp = regcppush(0); /* Save *all* the positions. */
+ CHECKPOINT lastcp;
+ I32 tmp;
+
+ /* Save *all* the positions. */
+ const CHECKPOINT cp = regcppush(0);
REGCP_SET(lastcp);
- regcp_set_to(PL_reg_call_cc->ss); /* Restore parens of
- the caller. */
- PL_reginput = locinput; /* Make position available to
- the callcc. */
+
+ /* Restore parens of the caller. */
+ tmp = PL_savestack_ix;
+ PL_savestack_ix = PL_reg_call_cc->ss;
+ regcppop();
+ PL_savestack_ix = tmp;
+
+ /* Make position available to the callcc. */
+ PL_reginput = locinput;
+
cache_re(PL_reg_call_cc->re);
PL_regcc = PL_reg_call_cc->cc;
PL_reg_call_cc = PL_reg_call_cc->prev;
no_final:
do_no:
if (unwind) {
- re_unwind_t *uw = SSPTRt(unwind,re_unwind_t);
+ re_unwind_t * const uw = SSPTRt(unwind,re_unwind_t);
switch (uw->type) {
case RE_UNWIND_BRANCH:
case RE_UNWIND_BRANCHJ:
{
- re_unwind_branch_t *uwb = &(uw->branch);
+ re_unwind_branch_t * const uwb = &(uw->branch);
const I32 lastparen = uwb->lastparen;
REGCP_UNWIND(uwb->lastcp);
DEBUG_r({
SV *re_debug_flags = NULL;
- SV *prop = sv_newmortal();
+ SV * const prop = sv_newmortal();
GET_RE_DEBUG_FLAGS;
DEBUG_EXECUTE_r({
regprop(prop, p);
STATIC I32
S_regrepeat_hard(pTHX_ regnode *p, I32 max, I32 *lp)
{
+ dVAR;
register char *scan = Nullch;
register char *start;
register char *loceol = PL_regeol;
SV *
Perl_regclass_swash(pTHX_ register const regnode* node, bool doinit, SV** listsvp, SV **altsvp)
{
+ dVAR;
SV *sw = NULL;
SV *si = NULL;
SV *alt = NULL;
SV **const ary = AvARRAY(av);
SV **a, **b;
- /* See the end of regcomp.c:S_reglass() for
+ /* See the end of regcomp.c:S_regclass() for
* documentation of these array elements. */
si = *ary;
- a = SvTYPE(ary[1]) == SVt_RV ? &ary[1] : 0;
+ a = SvROK(ary[1]) ? &ary[1] : 0;
b = SvTYPE(ary[2]) == SVt_PVAV ? &ary[2] : 0;
if (a)
STRLEN len = 0;
STRLEN plen;
- if (do_utf8 && !UTF8_IS_INVARIANT(c))
- c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
- ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
+ if (do_utf8 && !UTF8_IS_INVARIANT(c)) {
+ c = utf8n_to_uvchr(p, UTF8_MAXBYTES, &len,
+ ckWARN(WARN_UTF8) ? UTF8_CHECK_ONLY :
+ UTF8_ALLOW_ANYUV|UTF8_CHECK_ONLY);
+ if (len == (STRLEN)-1)
+ Perl_croak(aTHX_ "Malformed UTF-8 character (fatal)");
+ }
plen = lenp ? *lenp : UNISKIP(NATIVE_TO_UNI(c));
if (do_utf8 || (flags & ANYOF_UNICODE)) {
STATIC U8 *
S_reghop(pTHX_ U8 *s, I32 off)
{
+ dVAR;
return S_reghop3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
}
STATIC U8 *
S_reghop3(pTHX_ U8 *s, I32 off, U8* lim)
{
+ dVAR;
if (off >= 0) {
while (off-- && s < lim) {
/* XXX could check well-formedness here */
STATIC U8 *
S_reghopmaybe(pTHX_ U8 *s, I32 off)
{
+ dVAR;
return S_reghopmaybe3(aTHX_ s, off, (U8*)(off >= 0 ? PL_regeol : PL_bostr));
}
STATIC U8 *
S_reghopmaybe3(pTHX_ U8* s, I32 off, U8* lim)
{
+ dVAR;
if (off >= 0) {
while (off-- && s < lim) {
/* XXX could check well-formedness here */
static void
restore_pos(pTHX_ void *arg)
{
+ dVAR;
PERL_UNUSED_ARG(arg);
if (PL_reg_eval_set) {
if (PL_reg_oldsaved) {
STATIC void
S_to_byte_substr(pTHX_ register regexp *prog)
{
+ dVAR;
if (prog->float_utf8 && !prog->float_substr) {
SV* sv;
prog->float_substr = sv = newSVsv(prog->float_utf8);