* Forward declarations for pregcomp()'s friends.
*/
-static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
- 0, 0, 0, 0, 0, 0};
+static const scan_data_t zero_scan_data =
+ { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0};
#define SF_BEFORE_EOL (SF_BEFORE_SEOL|SF_BEFORE_MEOL)
#define SF_BEFORE_SEOL 0x1
STATIC void
S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
{
- STRLEN l = CHR_SVLEN(data->last_found);
- STRLEN old_l = CHR_SVLEN(*data->longest);
+ const STRLEN l = CHR_SVLEN(data->last_found);
+ const STRLEN old_l = CHR_SVLEN(*data->longest);
if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) {
SvSetMagicSV(*data->longest, data->last_found);
tmp = newSVpv( "", 0 ); \
pv_uni_display( tmp, uc, len, 60, UNI_DISPLAY_REGEX ); \
} else { \
- tmp = Perl_newSVpvf_nocontext( "%c", uvc ); \
+ tmp = Perl_newSVpvf_nocontext( "%c", (int)uvc ); \
} \
av_push( trie->revcharmap, tmp ); \
})
scan += len; \
len = 0; \
} else { \
- uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags); \
+ uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
uvc = to_uni_fold( uvc, foldbuf, &foldlen ); \
foldlen -= UNISKIP( uvc ); \
scan = foldbuf + UNISKIP( uvc ); \
} \
} else { \
- uvc = utf8n_to_uvuni( (U8*)uc, UTF8_MAXLEN, &len, uniflags); \
+ uvc = utf8n_to_uvuni( (const U8*)uc, UTF8_MAXLEN, &len, uniflags);\
} \
} else { \
uvc = (U32)*uc; \
STATIC I32
S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 flags)
{
+ dVAR;
/* first pass, loop through and scan words */
reg_trie_data *trie;
regnode *cur;
- U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+ const U32 uniflags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
STRLEN len = 0;
UV uvc = 0;
U16 curword = 0;
U32 next_alloc = 0;
/* we just use folder as a flag in utf8 */
- const U8 *folder=( flags == EXACTF
+ const U8 * const folder = ( flags == EXACTF
? PL_fold
: ( flags == EXACTFL
? PL_fold_locale
)
);
- U32 data_slot = add_data( pRExC_state, 1, "t" );
+ const U32 data_slot = add_data( pRExC_state, 1, "t" );
SV *re_trie_maxbuff;
GET_RE_DEBUG_FLAGS_DECL;
for ( cur = first ; cur < last ; cur = regnext( cur ) ) {
regnode *noper = NEXTOPER( cur );
- U8 *uc = (U8*)STRING( noper );
- U8 *e = uc + STR_LEN( noper );
+ const U8 *uc = (U8*)STRING( noper );
+ const U8 *e = uc + STR_LEN( noper );
STRLEN foldlen = 0;
U8 foldbuf[ UTF8_MAXBYTES_CASE + 1 ];
- U8 *scan;
+ const U8 *scan = (U8*)NULL;
for ( ; uc < e ; uc += len ) {
trie->charcount++;
svpp = hv_fetch( trie->widecharmap, (char*)&uvc, sizeof( UV ), 1 );
if ( !svpp )
- Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%X", uvc );
+ Perl_croak( aTHX_ "error creating/fetching widecharmap entry for 0x%"UVXf, uvc );
if ( !SvTRUE( *svpp ) ) {
sv_setiv( *svpp, ++trie->uniquecharcount );
state = newstate;
} else {
- Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %d", uvc );
+ Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
}
/* charid is now 0 if we dont know the char read, or nonzero if we do */
}
for( state=1 ; state < next_alloc ; state ++ ) {
- PerlIO_printf( Perl_debug_log, "\n %04X :", state );
+ PerlIO_printf( Perl_debug_log, "\n %04"UVXf" :", (UV)state );
if ( ! trie->states[ state ].wordnum ) {
PerlIO_printf( Perl_debug_log, "%5s| ","");
} else {
- PerlIO_printf( Perl_debug_log, "W%04X| ",
+ PerlIO_printf( Perl_debug_log, "W%04x| ",
trie->states[ state ].wordnum
);
}
for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) {
SV **tmp = av_fetch( trie->revcharmap, TRIE_LIST_ITEM(state,charid).forid, 0);
- PerlIO_printf( Perl_debug_log, "%s:%3X=%04X | ",
+ PerlIO_printf( Perl_debug_log, "%s:%3X=%04"UVXf" | ",
SvPV_nolen( *tmp ),
TRIE_LIST_ITEM(state,charid).forid,
- TRIE_LIST_ITEM(state,charid).newstate
+ (UV)TRIE_LIST_ITEM(state,charid).newstate
);
}
}
state = trie->trans[ state + charid ].next;
} else {
- Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %d", uvc );
+ Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %"IVdf, uvc );
}
/* charid is now 0 if we dont know the char read, or nonzero if we do */
}
for( state=1 ; state < next_alloc ; state += trie->uniquecharcount ) {
- PerlIO_printf( Perl_debug_log, "%04X : ", TRIE_NODENUM( state ) );
+ PerlIO_printf( Perl_debug_log, "%04"UVXf" : ", (UV)TRIE_NODENUM( state ) );
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
- PerlIO_printf( Perl_debug_log, "%04X ",
- SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
+ PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
+ (UV)SAFE_TRIE_NODENUM( trie->trans[ state + charid ].next ) );
}
if ( ! trie->states[ TRIE_NODENUM( state ) ].wordnum ) {
- PerlIO_printf( Perl_debug_log, " (%04X)\n", trie->trans[ state ].check );
+ PerlIO_printf( Perl_debug_log, " (%04"UVXf")\n", (UV)trie->trans[ state ].check );
} else {
- PerlIO_printf( Perl_debug_log, " (%04X) W%04X\n", trie->trans[ state ].check,
+ PerlIO_printf( Perl_debug_log, " (%04"UVXf") W%04X\n", (UV)trie->trans[ state ].check,
trie->states[ TRIE_NODENUM( state ) ].wordnum );
}
}
demq
*/
- U32 laststate = TRIE_NODENUM( next_alloc );
+ const U32 laststate = TRIE_NODENUM( next_alloc );
U32 used , state, charid;
U32 pos = 0, zp=0;
trie->laststate = laststate;
trie->lasttrans = pos + 1;
Renew( trie->states, laststate + 1, reg_trie_state);
DEBUG_TRIE_COMPILE_MORE_r(
- PerlIO_printf( Perl_debug_log, " Alloc: %d Orig: %d elements, Final:%d. Savings of %%%5.2f\n",
- ( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ), next_alloc, pos,
+ PerlIO_printf( Perl_debug_log,
+ " Alloc: %d Orig: %"IVdf" elements, Final:%"IVdf". Savings of %%%5.2f\n",
+ ( ( trie->charcount + 1 ) * trie->uniquecharcount + 1 ), (IV)next_alloc, (IV)pos,
( ( next_alloc - pos ) * 100 ) / (double)next_alloc );
);
for( state = 1 ; state < trie->laststate ; state++ ) {
U32 base = trie->states[ state ].trans.base;
- PerlIO_printf( Perl_debug_log, "#%04X ", state);
+ PerlIO_printf( Perl_debug_log, "#%04"UVXf" ", (UV)state);
if ( trie->states[ state ].wordnum ) {
PerlIO_printf( Perl_debug_log, " W%04X", trie->states[ state ].wordnum );
PerlIO_printf( Perl_debug_log, "%6s", "" );
}
- PerlIO_printf( Perl_debug_log, " @%04X ", base );
+ PerlIO_printf( Perl_debug_log, " @%04"UVXf" ", (UV)base );
if ( base ) {
U32 ofs = 0;
&& trie->trans[ base + ofs - trie->uniquecharcount ].check != state))
ofs++;
- PerlIO_printf( Perl_debug_log, "+%02X[ ", ofs);
+ PerlIO_printf( Perl_debug_log, "+%02"UVXf"[ ", (UV)ofs);
for ( ofs = 0 ; ofs < trie->uniquecharcount ; ofs++ ) {
if ( ( base + ofs >= trie->uniquecharcount ) &&
( base + ofs - trie->uniquecharcount < trie->lasttrans ) &&
trie->trans[ base + ofs - trie->uniquecharcount ].check == state )
{
- PerlIO_printf( Perl_debug_log, "%04X ",
- trie->trans[ base + ofs - trie->uniquecharcount ].next );
+ PerlIO_printf( Perl_debug_log, "%04"UVXf" ",
+ (UV)trie->trans[ base + ofs - trie->uniquecharcount ].next );
} else {
PerlIO_printf( Perl_debug_log, "%4s "," 0" );
}
}
- PerlIO_printf( Perl_debug_log, "]", ofs);
+ PerlIO_printf( Perl_debug_log, "]");
}
PerlIO_printf( Perl_debug_log, "\n" );
DEBUG_OPTIMISE_r({
SV *mysv=sv_newmortal();
regprop( mysv, scan);
- PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08X)\n",depth*2,"",SvPV_nolen(mysv),scan);
+ PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n",
+ (int)depth*2, "", SvPV_nolen(mysv), PTR2UV(scan));
});
if (PL_regkind[(U8)OP(scan)] == EXACT) {
n = regnext(n);
}
else if (stringok) {
- int oldl = STR_LEN(scan);
+ const int oldl = STR_LEN(scan);
regnode *nnext = regnext(n);
if (oldl + STR_LEN(n) > U8_MAX)
char *s1 = s0 + STR_LEN(scan) - 1, *s2 = s1 - 4;
const char *t0 = "\xcc\x88\xcc\x81";
const char *t1 = t0 + 3;
-
+
for (s = s0 + 2;
s < s2 && (t = ninstr(s, s1, t0, t1));
s = t + 4) {
/* Follow the next-chain of the current node and optimize
away all the NOTHINGs from it. */
if (OP(scan) != CURLYX) {
- int max = (reg_off_by_arg[OP(scan)]
+ const int max = (reg_off_by_arg[OP(scan)]
? I32_MAX
/* I32 may be smaller than U16 on CRAYs! */
: (I32_MAX < U16_MAX ? I32_MAX : U16_MAX));
DEBUG_OPTIMISE_r({
regprop( mysv, tail );
PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
- depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ),
+ (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ),
(RExC_seen_evals) ? "[EVAL]" : ""
);
});
DEBUG_OPTIMISE_r({
regprop( mysv, cur);
PerlIO_printf( Perl_debug_log, "%*s%s",
- depth * 2 + 2," ", SvPV_nolen( mysv ) );
+ (int)depth * 2 + 2," ", SvPV_nolen( mysv ) );
regprop( mysv, noper);
PerlIO_printf( Perl_debug_log, " -> %s",
if (!last ) {
regprop( mysv, first);
PerlIO_printf( Perl_debug_log, "%*s%s",
- depth * 2 + 2, "F:", SvPV_nolen( mysv ) );
+ (int)depth * 2 + 2, "F:", SvPV_nolen( mysv ) );
regprop( mysv, NEXTOPER(first) );
PerlIO_printf( Perl_debug_log, " -> %s\n",
SvPV_nolen( mysv ) );
DEBUG_OPTIMISE_r({
regprop( mysv, cur);
PerlIO_printf( Perl_debug_log, "%*s%s",
- depth * 2 + 2, "N:", SvPV_nolen( mysv ) );
+ (int)depth * 2 + 2, "N:", SvPV_nolen( mysv ) );
regprop( mysv, noper );
PerlIO_printf( Perl_debug_log, " -> %s\n",
SvPV_nolen( mysv ) );
if ( last ) {
DEBUG_OPTIMISE_r(
PerlIO_printf( Perl_debug_log, "%*s%s\n",
- depth * 2 + 2, "E:", "**END**" );
+ (int)depth * 2 + 2, "E:", "**END**" );
);
make_trie( pRExC_state, startbranch, first, cur, tail, optype );
}
DEBUG_OPTIMISE_r({
regprop( mysv, cur);
PerlIO_printf( Perl_debug_log,
- "%*s%s\t(0x%p,0x%p,0x%p)\n", depth * 2 + 2,
+ "%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
" ", SvPV_nolen( mysv ), first, last, cur);
});
if ( last ) {
DEBUG_OPTIMISE_r(
PerlIO_printf( Perl_debug_log, "%*s%s\n",
- depth * 2 + 2, "E:", "==END==" );
+ (int)depth * 2 + 2, "E:", "==END==" );
);
make_trie( pRExC_state, startbranch, first, scan, tail, optype );
}
I32 l = STR_LEN(scan);
UV uc = *((U8*)STRING(scan));
if (UTF) {
- U8 *s = (U8*)STRING(scan);
+ const U8 * const s = (U8*)STRING(scan);
l = utf8_length(s, s + l);
uc = utf8_to_uvchr(s, NULL);
}
SvGROW(last_str, (mincount * l) + 1);
repeatcpy(SvPVX(last_str) + l,
SvPVX(last_str), l, mincount - 1);
- SvCUR(last_str) *= mincount;
+ SvCUR_set(last_str, SvCUR(last_str) * mincount);
/* Add additional parts. */
SvCUR_set(data->last_found,
SvCUR(data->last_found) - l);
PL_colors[i] = ++s;
}
else
- PL_colors[i] = s = "";
+ PL_colors[i] = s = (char *)"";
}
} else {
while (i < 6)
- PL_colors[i++] = "";
+ PL_colors[i++] = (char *)"";
}
PL_colorset = 1;
}
Newz(1304, r->offsets, 2*RExC_size+1, U32); /* MJD 20001228 */
if (r->offsets) {
- r->offsets[0] = RExC_size;
+ r->offsets[0] = RExC_size;
}
DEBUG_OFFSETS_r(PerlIO_printf(Perl_debug_log,
- "%s %"UVuf" bytes for offset annotations.\n",
- r->offsets ? "Got" : "Couldn't get",
+ "%s %"UVuf" bytes for offset annotations.\n",
+ r->offsets ? "Got" : "Couldn't get",
(UV)((2*RExC_size+1) * sizeof(U32))));
RExC_rx = r;
S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp)
/* paren: Parenthesized? 0=top, 1=(, inside: changed to letter. */
{
+ dVAR;
register regnode *ret; /* Will be the head of the group. */
register regnode *br;
register regnode *lastbr;
while (isDIGIT(*RExC_parse))
RExC_parse++;
ret = reganode(pRExC_state, GROUPP, parno);
-
+
if ((c = *nextchar(pRExC_state)) != ')')
vFAIL("Switch condition not recognized");
insert_if:
parse_start = RExC_parse; /* MJD */
br = regbranch(pRExC_state, &flags, 1);
/* branch_len = (paren != 0); */
-
+
if (br == NULL)
return(NULL);
if (*RExC_parse == '|') {
RExC_extralen += 2; /* Account for LONGJMP. */
nextchar(pRExC_state);
br = regbranch(pRExC_state, &flags, 0);
-
+
if (br == NULL)
return(NULL);
regtail(pRExC_state, lastbr, br); /* BRANCH -> BRANCH. */
}
{
- const char *p;
- static const char parens[] = "=!<,>";
+ const char *p;
+ static const char parens[] = "=!<,>";
if (paren && (p = strchr(parens, paren))) {
U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH;
reginsert(pRExC_state, CURLYX,ret);
/* MJD hk */
Set_Node_Offset(ret, parse_start+1);
- Set_Node_Length(ret,
+ Set_Node_Length(ret,
op == '{' ? (RExC_parse - parse_start) : 1);
-
+
if (!SIZE_ONLY && RExC_extralen)
NEXT_OFF(ret) = 3; /* Go over NOTHING to LONGJMP. */
regtail(pRExC_state, ret, reg_node(pRExC_state, NOTHING));
(U8)(FOLD ? (LOC ? REFFL : REFF) : REF),
num);
*flagp |= HASWIDTH;
-
+
/* override incorrect value set in reganode MJD */
- Set_Node_Offset(ret, parse_start+1);
+ Set_Node_Offset(ret, parse_start+1);
Set_Node_Cur_Length(ret); /* MJD */
RExC_parse--;
nextchar(pRExC_state);
- regcurly - a little FSA that accepts {\d+,?\d*}
*/
STATIC I32
-S_regcurly(pTHX_ register char *s)
+S_regcurly(pTHX_ register const char *s)
{
if (*s++ != '{')
return FALSE;
node = dumpuntil(start, NEXTOPER(node), next, sv, l + 1);
}
else if ( PL_regkind[(U8)op] == TRIE ) {
- I32 n = ARG(node);
- reg_trie_data *trie=(reg_trie_data*)PL_regdata->data[n];
+ const I32 n = ARG(node);
+ const reg_trie_data *trie = (reg_trie_data*)PL_regdata->data[n];
+ const I32 arry_len = av_len(trie->words)+1;
I32 word_idx;
- I32 arry_len=av_len(trie->words)+1;
PerlIO_printf(Perl_debug_log,
- "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%d%s]\n",
+ "%*s[Words:%d Chars Stored:%d Unique Chars:%d States:%"IVdf"%s]\n",
(int)(2*(l+3)), "",
trie->wordcount,
trie->charcount,
trie->uniquecharcount,
- trie->laststate-1,
+ (IV)trie->laststate-1,
node->flags ? " EVAL mode" : "");
for (word_idx=0; word_idx < arry_len; word_idx++) {
PerlIO_printf(Perl_debug_log, "with eval ");
PerlIO_printf(Perl_debug_log, "\n");
if (r->offsets) {
- U32 i;
- U32 len = r->offsets[0];
+ U32 i;
+ const U32 len = r->offsets[0];
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_OFFSETS_r({
- PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
- for (i = 1; i <= len; i++)
- PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ",
- (UV)r->offsets[i*2-1],
- (UV)r->offsets[i*2]);
- PerlIO_printf(Perl_debug_log, "\n");
+ PerlIO_printf(Perl_debug_log, "Offsets: [%"UVuf"]\n\t", (UV)r->offsets[0]);
+ for (i = 1; i <= len; i++)
+ PerlIO_printf(Perl_debug_log, "%"UVuf"[%"UVuf"] ",
+ (UV)r->offsets[i*2-1], (UV)r->offsets[i*2]);
+ PerlIO_printf(Perl_debug_log, "\n");
});
}
#endif /* DEBUGGING */
- regprop - printable representation of opcode
*/
void
-Perl_regprop(pTHX_ SV *sv, regnode *o)
+Perl_regprop(pTHX_ SV *sv, const regnode *o)
{
#ifdef DEBUGGING
register int k;
pv_uni_display(dsv, (U8*)STRING(o), STR_LEN(o), 60,
UNI_DISPLAY_REGEX) :
STRING(o);
- int len = do_utf8 ?
+ const int len = do_utf8 ?
strlen(s) :
STR_LEN(o);
Perl_sv_catpvf(aTHX_ sv, " <%s%.*s%s>",
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_COMPILE_r(
{ STRLEN n_a;
- char *s = SvPV(prog->check_substr
+ const char *s = SvPV(prog->check_substr
? prog->check_substr : prog->check_utf8, n_a);
if (!PL_colorset) reginitcolors();
void
Perl_pregfree(pTHX_ struct regexp *r)
{
+ dVAR;
#ifdef DEBUGGING
SV *dsv = PERL_DEBUG_PAD_ZERO(0);
SV *re_debug_flags=get_sv(RE_DEBUG_FLAGS,0);
if (!r || (--r->refcnt > 0))
return;
DEBUG_r(if (re_debug_flags && (SvIV(re_debug_flags) & RE_DEBUG_COMPILE)) {
- int len;
- char *s;
-
- s = (r->reganch & ROPT_UTF8) ? pv_uni_display(dsv, (U8*)r->precomp,
- r->prelen, 60, UNI_DISPLAY_REGEX)
+ const char *s = (r->reganch & ROPT_UTF8)
+ ? pv_uni_display(dsv, (U8*)r->precomp, r->prelen, 60, UNI_DISPLAY_REGEX)
: pv_display(dsv, r->precomp, r->prelen, 0, 60);
- len = SvCUR(dsv);
+ const int len = SvCUR(dsv);
if (!PL_colorset)
reginitcolors();
PerlIO_printf(Perl_debug_log,
STRLEN l2 = strlen(pat2);
char buf[512];
SV *msv;
- char *message;
+ const char *message;
if (l1 > 510)
l1 = 510;
* indent-tabs-mode: t
* End:
*
- * vim: shiftwidth=4:
-*/
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */