/* doop.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 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 I32
S_do_trans_simple(pTHX_ SV *sv)
{
+ dVAR;
U8 *s;
U8 *d;
const U8 *send;
STATIC I32
S_do_trans_count(pTHX_ SV *sv)
{
+ dVAR;
const U8 *s;
const U8 *send;
I32 matches = 0;
STRLEN len;
- const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
const short * const tbl = (short*)cPVOP->op_pv;
if (!tbl)
if (tbl[*s++] >= 0)
matches++;
}
- else
+ else {
+ const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
while (s < send) {
STRLEN ulen;
const UV c = utf8n_to_uvchr(s, send - s, &ulen, 0);
matches++;
s += ulen;
}
+ }
return matches;
}
STATIC I32
S_do_trans_complex(pTHX_ SV *sv)
{
+ dVAR;
U8 *s;
U8 *send;
U8 *d;
U8 *dstart;
I32 isutf8;
I32 matches = 0;
- const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
- const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
- const I32 del = PL_op->op_private & OPpTRANS_DELETE;
STRLEN len, rlen = 0;
const short * const tbl = (short*)cPVOP->op_pv;
SvCUR_set(sv, d - dstart);
}
else { /* isutf8 */
+ const I32 complement = PL_op->op_private & OPpTRANS_COMPLEMENT;
+ const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
+ const I32 del = PL_op->op_private & OPpTRANS_DELETE;
+
if (grows)
Newx(d, len*2+1, U8);
else
STATIC I32
S_do_trans_simple_utf8(pTHX_ SV *sv)
{
+ dVAR;
U8 *s;
U8 *send;
U8 *d;
SV* const rv = (SV*)cSVOP->op_sv;
HV* const hv = (HV*)SvRV(rv);
- SV* const * svp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV* const * svp = hv_fetchs(hv, "NONE", FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
UV final = 0;
const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
- if ((hibit = !NATIVE_IS_INVARIANT(ch)))
+ hibit = !NATIVE_IS_INVARIANT(ch);
+ if (hibit) {
+ s = bytes_to_utf8(s, &len);
break;
+ }
}
- if (hibit)
- s = bytes_to_utf8(s, &len);
}
send = s + len;
start = s;
- svp = hv_fetch(hv, "FINAL", 5, FALSE);
+ svp = hv_fetchs(hv, "FINAL", FALSE);
if (svp)
final = SvUV(*svp);
STATIC I32
S_do_trans_count_utf8(pTHX_ SV *sv)
{
+ dVAR;
const U8 *s;
- const U8 *start = 0, *send;
+ const U8 *start = NULL;
+ const U8 *send;
I32 matches = 0;
STRLEN len;
SV* const rv = (SV*)cSVOP->op_sv;
HV* const hv = (HV*)SvRV(rv);
- SV* const * const svp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV* const * const svp = hv_fetchs(hv, "NONE", FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
U8 hibit = 0;
const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
- if ((hibit = !NATIVE_IS_INVARIANT(ch)))
+ hibit = !NATIVE_IS_INVARIANT(ch);
+ if (hibit) {
+ start = s = bytes_to_utf8(s, &len);
break;
+ }
}
- if (hibit)
- start = s = bytes_to_utf8(s, &len);
}
send = s + len;
STATIC I32
S_do_trans_complex_utf8(pTHX_ SV *sv)
{
+ dVAR;
U8 *start, *send;
U8 *d;
I32 matches = 0;
const I32 grows = PL_op->op_private & OPpTRANS_GROWS;
SV * const rv = (SV*)cSVOP->op_sv;
HV * const hv = (HV*)SvRV(rv);
- SV * const *svp = hv_fetch(hv, "NONE", 4, FALSE);
+ SV * const *svp = hv_fetchs(hv, "NONE", FALSE);
const UV none = svp ? SvUV(*svp) : 0x7fffffff;
const UV extra = none + 1;
UV final = 0;
const U8 * const e = s + len;
while (t < e) {
const U8 ch = *t++;
- if ((hibit = !NATIVE_IS_INVARIANT(ch)))
+ hibit = !NATIVE_IS_INVARIANT(ch);
+ if (hibit) {
+ s = bytes_to_utf8(s, &len);
break;
+ }
}
- if (hibit)
- s = bytes_to_utf8(s, &len);
}
send = s + len;
start = s;
- svp = hv_fetch(hv, "FINAL", 5, FALSE);
+ svp = hv_fetchs(hv, "FINAL", FALSE);
if (svp) {
final = SvUV(*svp);
havefinal = TRUE;
I32
Perl_do_trans(pTHX_ SV *sv)
{
+ dVAR;
STRLEN len;
const I32 hasutf = (PL_op->op_private &
(OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF));
void
Perl_do_join(pTHX_ register SV *sv, SV *del, register SV **mark, register SV **sp)
{
+ dVAR;
SV ** const oldmark = mark;
register I32 items = sp - mark;
register STRLEN len;
void
Perl_do_sprintf(pTHX_ SV *sv, I32 len, SV **sarg)
{
+ dVAR;
STRLEN patlen;
const char * const pat = SvPV_const(*sarg, patlen);
bool do_taint = FALSE;
UV
Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
{
+ dVAR;
STRLEN srclen, len;
const unsigned char *s = (const unsigned char *) SvPV_const(sv, srclen);
UV retnum = 0;
void
Perl_do_vecset(pTHX_ SV *sv)
{
+ dVAR;
register I32 offset;
register I32 size;
register unsigned char *s;
void
Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
{
+ dVAR;
STRLEN len;
char *s;
if (SvREADONLY(sv))
Perl_croak(aTHX_ PL_no_modify);
}
+
+ if (PL_encoding && !SvUTF8(sv)) {
+ /* like in do_chomp(), utf8-ize the sv as a side-effect
+ * if we're using encoding. */
+ sv_recode_to_utf8(sv, PL_encoding);
+ }
+
s = SvPV(sv, len);
if (len && !SvPOK(sv))
s = SvPV_force(sv, len);
I32
Perl_do_chomp(pTHX_ register SV *sv)
{
+ dVAR;
register I32 count;
STRLEN len;
char *s;
void
Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right)
{
+ dVAR;
#ifdef LIBERAL
register long *dl;
register long *ll;
OP *
Perl_do_kv(pTHX)
{
+ dVAR;
dSP;
HV * const hv = (HV*)POPs;
HV *keys;