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=%04"UVXf" | ",
- SvPV_nolen( *tmp ),
+ SvPV_nolen_const( *tmp ),
TRIE_LIST_ITEM(state,charid).forid,
(UV)TRIE_LIST_ITEM(state,charid).newstate
);
for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) {
SV **tmp = av_fetch( trie->revcharmap, charid, 0);
if ( tmp ) {
- PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) );
+ PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
}
}
for( state = 0 ; state < trie->uniquecharcount ; state++ ) {
SV **tmp = av_fetch( trie->revcharmap, state, 0);
if ( tmp ) {
- PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen( *tmp ) );
+ PerlIO_printf( Perl_debug_log, "%4.4s ", SvPV_nolen_const( *tmp ) );
}
}
PerlIO_printf( Perl_debug_log, "\n-----:-----------------------");
SV *mysv=sv_newmortal();
regprop( mysv, scan);
PerlIO_printf(Perl_debug_log, "%*speep: %s (0x%08"UVXf")\n",
- (int)depth*2, "", SvPV_nolen(mysv), PTR2UV(scan));
+ (int)depth*2, "", SvPV_nolen_const(mysv), PTR2UV(scan));
});
if (PL_regkind[(U8)OP(scan)] == EXACT) {
DEBUG_OPTIMISE_r({
regprop( mysv, tail );
PerlIO_printf( Perl_debug_log, "%*s%s%s%s\n",
- (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen( mysv ),
+ (int)depth * 2 + 2, "", "Tail node is:", SvPV_nolen_const( mysv ),
(RExC_seen_evals) ? "[EVAL]" : ""
);
});
DEBUG_OPTIMISE_r({
regprop( mysv, cur);
PerlIO_printf( Perl_debug_log, "%*s%s",
- (int)depth * 2 + 2," ", SvPV_nolen( mysv ) );
+ (int)depth * 2 + 2," ", SvPV_nolen_const( mysv ) );
regprop( mysv, noper);
PerlIO_printf( Perl_debug_log, " -> %s",
- SvPV_nolen(mysv));
+ SvPV_nolen_const(mysv));
if ( noper_next ) {
regprop( mysv, noper_next );
PerlIO_printf( Perl_debug_log,"\t=> %s\t",
- SvPV_nolen(mysv));
+ SvPV_nolen_const(mysv));
}
PerlIO_printf( Perl_debug_log, "0x%p,0x%p,0x%p)\n",
first, last, cur );
if (!last ) {
regprop( mysv, first);
PerlIO_printf( Perl_debug_log, "%*s%s",
- (int)depth * 2 + 2, "F:", SvPV_nolen( mysv ) );
+ (int)depth * 2 + 2, "F:", SvPV_nolen_const( mysv ) );
regprop( mysv, NEXTOPER(first) );
PerlIO_printf( Perl_debug_log, " -> %s\n",
- SvPV_nolen( mysv ) );
+ SvPV_nolen_const( mysv ) );
}
);
last = cur;
DEBUG_OPTIMISE_r({
regprop( mysv, cur);
PerlIO_printf( Perl_debug_log, "%*s%s",
- (int)depth * 2 + 2, "N:", SvPV_nolen( mysv ) );
+ (int)depth * 2 + 2, "N:", SvPV_nolen_const( mysv ) );
regprop( mysv, noper );
PerlIO_printf( Perl_debug_log, " -> %s\n",
- SvPV_nolen( mysv ) );
+ SvPV_nolen_const( mysv ) );
});
}
} else {
regprop( mysv, cur);
PerlIO_printf( Perl_debug_log,
"%*s%s\t(0x%p,0x%p,0x%p)\n", (int)depth * 2 + 2,
- " ", SvPV_nolen( mysv ), first, last, cur);
+ " ", SvPV_nolen_const( mysv ), first, last, cur);
});
if ( last ) {
#if defined(SPARC64_GCC_WORKAROUND)
I32 b = 0;
STRLEN l = 0;
- char *s = NULL;
+ const char *s = NULL;
I32 old = 0;
if (pos_before >= data->last_start_min)
b = data->last_start_min;
l = 0;
- s = SvPV(data->last_found, l);
+ s = SvPV_const(data->last_found, l);
old = b - data->last_start_min;
#else
I32 b = pos_before >= data->last_start_min
? pos_before : data->last_start_min;
STRLEN l;
- char *s = SvPV(data->last_found, l);
+ const char *s = SvPV_const(data->last_found, l);
I32 old = b - data->last_start_min;
#endif
{ /* Assume that RE_INTUIT is set */
GET_RE_DEBUG_FLAGS_DECL;
DEBUG_COMPILE_r(
- { STRLEN n_a;
- const char *s = SvPV(prog->check_substr
- ? prog->check_substr : prog->check_utf8, n_a);
+ {
+ const char *s = SvPV_nolen_const(prog->check_substr
+ ? prog->check_substr : prog->check_utf8);
if (!PL_colorset) reginitcolors();
PerlIO_printf(Perl_debug_log,
#endif
msv = vmess(buf, &args);
va_end(args);
- message = SvPV(msv,l1);
+ message = SvPV_const(msv,l1);
if (l1 > 512)
l1 = 512;
Copy(message, buf, l1 , char);
PerlIO_printf(Perl_debug_log, "%*s<%s%s%s>\n",
(int)(2*(l+4)), "",
PL_colors[0],
- SvPV_nolen(*elem_ptr),
+ SvPV_nolen_const(*elem_ptr),
PL_colors[1]
);
/*
}
DEBUG_EXECUTE_r({
SV *prop = sv_newmortal();
- char *s0;
- char *s1;
+ const char *s0;
+ const char *s1;
int len0;
int len1;
s0 = UTF ?
pv_uni_display(dsv0, (U8*)SvPVX_const(prop), SvCUR(prop), 60,
UNI_DISPLAY_REGEX) :
- SvPVX(prop);
+ SvPVX_const(prop);
len0 = UTF ? SvCUR(dsv0) : SvCUR(prop);
s1 = UTF ?
sv_uni_display(dsv1, sv, 60, UNI_DISPLAY_REGEX) : s;
}
else {
STRLEN len;
- const char * const little = SvPV(float_real, len);
+ const char * const little = SvPV_const(float_real, len);
if (SvTAIL(float_real)) {
if (memEQ(strend - len + 1, little, len - 1))
"%*s %sonly one match : #%d <%s>%s\n",
REPORT_CODE_OFF+PL_regindent*2, "", PL_colors[4],
accept_buff[ 0 ].wordnum,
- tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr",
+ tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",
PL_colors[5] );
});
PL_reginput = (char *)accept_buff[ 0 ].endpos;
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,
- tmp ? SvPV_nolen( *tmp ) : "not compiled under -Dr",scan,
+ tmp ? SvPV_nolen_const( *tmp ) : "not compiled under -Dr",scan,
PL_colors[5] );
});
if ( best<accepted ) {
for (i = 0; i <= av_len(av); i++) {
SV* sv = *av_fetch(av, i, FALSE);
STRLEN len;
- const char *s = SvPV(sv, len);
+ const char *s = SvPV_const(sv, len);
if (len <= plen && memEQ(s, (char*)p, len)) {
*lenp = len;
if (svp && *svp && SvTAINTED(*svp)) {
STRLEN len;
const bool was_tainted = PL_tainted;
- const char *t = SvPV(*svp, len);
+ const char *t = SvPV_const(*svp, len);
const char *e = t + len;
PL_tainted = was_tainted;
if (t < e && isALNUM(*t))
if (PL_oldbufptr && *PL_oldbufptr)
sv_catpv(report, PL_tokenbuf);
}
- PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen(report));
+ PerlIO_printf(Perl_debug_log, "### %s]\n", SvPV_nolen_const(report));
};
return (int)rv;
}
void
Perl_lex_start(pTHX_ SV *line)
{
- char *s;
+ const char *s;
STRLEN len;
SAVEI32(PL_lex_dojoin);
PL_linestr = line;
if (SvREADONLY(PL_linestr))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
- s = SvPV(PL_linestr, len);
+ s = SvPV_const(PL_linestr, len);
if (!len || s[len-1] != ';') {
if (!(SvFLAGS(PL_linestr) & SVs_TEMP))
PL_linestr = sv_2mortal(newSVsv(PL_linestr));
NV retval = 0.0;
NV nshift = 1.0;
STRLEN len;
- const char *start = SvPVx_const(sv,len);
+ const char *start = SvPV_const(sv,len);
const char *end = start + len;
const bool utf = SvUTF8(sv) ? TRUE : FALSE;
while (start < end) {
if (SvTYPE(sv) == SVt_PVIV) {
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
STRLEN len;
- const char *p = SvPV(sv, len);
+ const char *p = SvPV_const(sv, len);
SV * const nsv = newSVpvn(p, len);
if (SvUTF8(sv))
SvUTF8_on(nsv);
src = (U8 *)d - 1;
dst = src+hicount;
d += hicount;
- while (src >= (U8 *)SvPVX(sv)) {
+ while (src >= (const U8 *)SvPVX_const(sv)) {
if (!NATIVE_IS_INVARIANT(*src)) {
U8 ch = NATIVE_TO_ASCII(*src);
*dst-- = (U8)UTF8_EIGHT_BIT_LO(ch);
char* e = strchr(s, '}');
SV *res;
STRLEN len;
- char *str;
+ const char *str;
if (!e) {
yyerror("Missing right brace on \\N{}");
res, Nullsv, "\\N{...}" );
if (has_utf8)
sv_utf8_upgrade(res);
- str = SvPV(res,len);
+ str = SvPV_const(res,len);
#ifdef EBCDIC_NEVER_MIND
/* charnames uses pack U and that has been
* recently changed to do the below uni->native
* gets revoked, but the semantics is still
* desireable for charnames. --jhi */
{
- UV uv = utf8_to_uvchr((U8*)str, 0);
+ UV uv = utf8_to_uvchr((const U8*)str, 0);
if (uv < 0x100) {
U8 tmpbuf[UTF8_MAXBYTES+1], *d;
d = uvchr_to_utf8(tmpbuf, UNI_TO_NATIVE(uv));
sv_setpvn(res, (char *)tmpbuf, d - tmpbuf);
- str = SvPV(res, len);
+ str = SvPV_const(res, len);
}
}
#endif
funcp = DPTR2FPTR(filter_t, IoANY(datasv));
DEBUG_P(PerlIO_printf(Perl_debug_log,
"filter_read %d: via function %p (%s)\n",
- idx, datasv, SvPV_nolen(datasv)));
+ idx, datasv, SvPV_nolen_const(datasv)));
/* Call function. The function is expected to */
/* call "FILTER_READ(idx+1, buf_sv)" first. */
/* Return: <0:error, =0:eof, >0:not eof */
else {
STRLEN blen;
STRLEN llen;
- const char *bstart = SvPV(CopFILESV(PL_curcop),blen);
- const char *lstart = SvPV(x,llen);
+ const char *bstart = SvPV_const(CopFILESV(PL_curcop),blen);
+ const char *lstart = SvPV_const(x,llen);
if (llen < blen) {
bstart += blen - llen;
if (strnEQ(bstart, lstart, llen) && bstart[-1] == '/') {
if (!s)
missingterm((char*)0);
yylval.ival = OP_CONST;
+ /* FIXME. I think that this can be const if char *d is replaced by
+ more localised variables. */
for (d = SvPV(PL_lex_stuff, len); len; len--, d++) {
if (*d == '$' || *d == '@' || *d == '\\' || !UTF8_IS_INVARIANT((U8)*d)) {
yylval.ival = OP_STRINGIFY;
/* Is there a prototype? */
if (SvPOK(cv)) {
STRLEN len;
- char *proto = SvPV((SV*)cv, len);
+ const char *proto = SvPV_const((SV*)cv, len);
if (!len)
TERM(FUNC0SUB);
if (*proto == '$' && proto[1] == '\0')
{
register char *s = start; /* current position in buffer */
register char *d;
- register char *e;
+ const char *e;
char *end;
I32 len;
Perl_croak(aTHX_ "Usage: version::new(class, version)");
SP -= items;
{
- const char *classname = SvPV_nolen(ST(0));
+ const char *classname = SvPV_nolen_const(ST(0));
SV *vs = ST(1);
SV *rv;
if (items == 3 )
{
vs = sv_newmortal();
- Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen(ST(2)));
+ Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
}
rv = new_version(vs);
if ((hv = get_hv(special, FALSE)) &&
(svp = hv_fetch(hv, (const char*)tmpbuf, UNISKIP(uv1), FALSE)) &&
(*svp)) {
- char *s;
+ const char *s;
- s = SvPV(*svp, len);
+ s = SvPV_const(*svp, len);
if (len == 1)
len = uvuni_to_utf8(ustrp, NATIVE_TO_UNI(*(U8*)s)) - ustrp;
else {
POPSTACK;
if (IN_PERL_COMPILETIME) {
STRLEN len;
- const char* pv = SvPV(tokenbufsv, len);
+ const char* pv = SvPV_const(tokenbufsv, len);
Copy(pv, PL_tokenbuf, len+1, char);
PL_curcop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
U32 off;
STRLEN slen;
STRLEN needents;
- U8 *tmps = NULL;
+ const U8 *tmps = NULL;
U32 bit;
SV *retval;
U8 tmputf8[2];
SV** svp = hv_fetch(hv, (const char*)ptr, klen, FALSE);
/* If not cached, generate it via utf8::SWASHGET */
- if (!svp || !SvPOK(*svp) || !(tmps = (U8*)SvPV(*svp, slen))) {
+ if (!svp || !SvPOK(*svp) || !(tmps = (const U8*)SvPV_const(*svp, slen))) {
dSP;
/* We use utf8n_to_uvuni() as we want an index into
Unicode tables, not a native character number.
PL_last_swash_hv = hv;
PL_last_swash_klen = klen;
- PL_last_swash_tmps = tmps;
+ /* FIXME change interpvar.h? */
+ PL_last_swash_tmps = (U8 *) tmps;
PL_last_swash_slen = slen;
if (klen)
Copy(ptr, PL_last_swash_key, klen, U8);
char *
Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags)
{
- return Perl_pv_uni_display(aTHX_ dsv, (U8*)SvPVX(ssv), SvCUR(ssv),
- pvlim, flags);
+ return Perl_pv_uni_display(aTHX_ dsv, (const U8*)SvPVX_const(ssv),
+ SvCUR(ssv), pvlim, flags);
}
/*
char *
Perl_screaminstr(pTHX_ SV *bigstr, SV *littlestr, I32 start_shift, I32 end_shift, I32 *old_posp, I32 last)
{
- register unsigned char *big;
+ const register unsigned char *big;
register I32 pos;
register I32 previous;
register I32 first;
- register unsigned char *little;
+ const register unsigned char *little;
register I32 stop_pos;
- register unsigned char *littleend;
+ const register unsigned char *littleend;
I32 found = 0;
if (*old_posp == -1
cant_find:
if ( BmRARE(littlestr) == '\n'
&& BmPREVIOUS(littlestr) == SvCUR(littlestr) - 1) {
- little = (unsigned char *)(SvPVX(littlestr));
+ little = (const unsigned char *)(SvPVX_const(littlestr));
littleend = little + SvCUR(littlestr);
first = *little++;
goto check_tail;
return Nullch;
}
- little = (unsigned char *)(SvPVX(littlestr));
+ little = (const unsigned char *)(SvPVX_const(littlestr));
littleend = little + SvCUR(littlestr);
first = *little++;
/* The value of pos we can start at: */
previous = BmPREVIOUS(littlestr);
- big = (unsigned char *)(SvPVX(bigstr));
+ big = (const unsigned char *)(SvPVX_const(bigstr));
/* The value of pos we can stop at: */
stop_pos = SvCUR(bigstr) - end_shift - (SvCUR(littlestr) - 1 - previous);
if (previous + start_shift > stop_pos) {
}
big -= previous;
do {
- register unsigned char *s, *x;
+ const register unsigned char *s, *x;
if (pos >= stop_pos) break;
if (big[pos] != first)
continue;
if (!SvTAIL(littlestr) || (end_shift > 0))
return Nullch;
/* Ignore the trailing "\n". This code is not microoptimized */
- big = (unsigned char *)(SvPVX(bigstr) + SvCUR(bigstr));
+ big = (const unsigned char *)(SvPVX_const(bigstr) + SvCUR(bigstr));
stop_pos = littleend - little; /* Actual littlestr len */
if (stop_pos == 0)
return (char*)big;
}
}
-STATIC char *
+STATIC const char *
S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
I32* utf8)
{
dVAR;
- char *message;
+ const char *message;
if (pat) {
SV *msv = vmess(pat, args);
if (PL_errors && SvCUR(PL_errors)) {
sv_catsv(PL_errors, msv);
- message = SvPV(PL_errors, *msglen);
+ message = SvPV_const(PL_errors, *msglen);
SvCUR_set(PL_errors, 0);
}
else
- message = SvPV(msv,*msglen);
+ message = SvPV_const(msv,*msglen);
*utf8 = SvUTF8(msv);
}
else {
JMPENV_JUMP(3);
}
else if (!message)
- message = SvPVx(ERRSV, msglen);
+ message = SvPVx_const(ERRSV, msglen);
write_to_stderr(message, msglen);
my_failure_exit();
Perl_vwarn(pTHX_ const char* pat, va_list *args)
{
dVAR;
- char *message;
+ const char *message;
HV *stash;
GV *gv;
CV *cv;
msv = vmess(pat, args);
utf8 = SvUTF8(msv);
- message = SvPV(msv, msglen);
+ message = SvPV_const(msv, msglen);
if (PL_warnhook) {
/* sv_2cv might call Perl_warn() */
if (ckDEAD(err)) {
SV * const msv = vmess(pat, args);
STRLEN msglen;
- const char *message = SvPV(msv, msglen);
+ const char *message = SvPV_const(msv, msglen);
const I32 utf8 = SvUTF8(msv);
if (PL_diehook) {
for (nret = 0 ; numattrs && (attr = *attrlist++); numattrs--) {
STRLEN len;
- const char *name = SvPV(attr, len);
+ const char *name = SvPV_const(attr, len);
const bool negated = (*name == '-');
if (negated) {
projects / p5sagit/p5-mst-13.2.git / commitdiff