PP(pp_stub)
{
- djSP;
+ dSP;
if (GIMME_V == G_SCALAR)
XPUSHs(&PL_sv_undef);
RETURN;
PP(pp_padav)
{
- djSP; dTARGET;
+ dSP; dTARGET;
if (PL_op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(PL_curpad[PL_op->op_targ]);
EXTEND(SP, 1);
PP(pp_padhv)
{
- djSP; dTARGET;
+ dSP; dTARGET;
I32 gimme;
XPUSHs(TARG);
PP(pp_rv2gv)
{
- djSP; dTOPss;
+ dSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_rv2sv)
{
- djSP; dTOPss;
+ dSP; dTOPss;
if (SvROK(sv)) {
wasref:
PP(pp_av2arylen)
{
- djSP;
+ dSP;
AV *av = (AV*)TOPs;
SV *sv = AvARYLEN(av);
if (!sv) {
AvARYLEN(av) = sv = NEWSV(0,0);
sv_upgrade(sv, SVt_IV);
- sv_magic(sv, (SV*)av, '#', Nullch, 0);
+ sv_magic(sv, (SV*)av, PERL_MAGIC_arylen, Nullch, 0);
}
SETs(sv);
RETURN;
PP(pp_pos)
{
- djSP; dTARGET; dPOPss;
+ dSP; dTARGET; dPOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, '.', Nullch, 0);
+ sv_magic(TARG, Nullsv, PERL_MAGIC_pos, Nullch, 0);
}
LvTYPE(TARG) = '.';
MAGIC* mg;
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
- mg = mg_find(sv, 'g');
+ mg = mg_find(sv, PERL_MAGIC_regex_global);
if (mg && mg->mg_len >= 0) {
I32 i = mg->mg_len;
if (DO_UTF8(sv))
PP(pp_rv2cv)
{
- djSP;
+ dSP;
GV *gv;
HV *stash;
PP(pp_prototype)
{
- djSP;
+ dSP;
CV *cv;
HV *stash;
GV *gv;
else if (n && str[0] == ';' && seen_question)
goto set; /* XXXX system, exec */
if ((oa & (OA_OPTIONAL - 1)) >= OA_AVREF
- && (oa & (OA_OPTIONAL - 1)) <= OA_HVREF) {
+ && (oa & (OA_OPTIONAL - 1)) <= OA_SCALARREF
+ /* But globs are already references (kinda) */
+ && (oa & (OA_OPTIONAL - 1)) != OA_FILEREF
+ ) {
str[n++] = '\\';
}
- /* What to do with R ((un)tie, tied, (sys)read, recv)? */
str[n++] = ("?$@@%&*$")[oa & (OA_OPTIONAL - 1)];
oa = oa >> 4;
}
PP(pp_anoncode)
{
- djSP;
+ dSP;
CV* cv = (CV*)PL_curpad[PL_op->op_targ];
if (CvCLONE(cv))
cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
PP(pp_srefgen)
{
- djSP;
+ dSP;
*SP = refto(*SP);
RETURN;
}
PP(pp_refgen)
{
- djSP; dMARK;
+ dSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP;
PP(pp_ref)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *sv;
char *pv;
PP(pp_bless)
{
- djSP;
+ dSP;
HV *stash;
if (MAXARG == 1)
SV *sv;
SV *tmpRef;
char *elem;
- djSP;
+ dSP;
STRLEN n_a;
sv = POPs;
PP(pp_study)
{
- djSP; dPOPss;
+ dSP; dPOPss;
register unsigned char *s;
register I32 pos;
register I32 ch;
}
SvSCREAM_on(sv);
- sv_magic(sv, Nullsv, 'g', Nullch, 0); /* piggyback on m//g magic */
+ /* piggyback on m//g magic */
+ sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
RETPUSHYES;
}
PP(pp_trans)
{
- djSP; dTARG;
+ dSP; dTARG;
SV *sv;
if (PL_op->op_flags & OPf_STACKED)
PP(pp_schop)
{
- djSP; dTARGET;
+ dSP; dTARGET;
do_chop(TARG, TOPs);
SETTARG;
RETURN;
PP(pp_chop)
{
- djSP; dMARK; dTARGET;
- while (SP > MARK)
- do_chop(TARG, POPs);
+ dSP; dMARK; dTARGET; dORIGMARK;
+ while (MARK < SP)
+ do_chop(TARG, *++MARK);
+ SP = ORIGMARK;
PUSHTARG;
RETURN;
}
PP(pp_schomp)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SETi(do_chomp(TOPs));
RETURN;
}
PP(pp_chomp)
{
- djSP; dMARK; dTARGET;
+ dSP; dMARK; dTARGET;
register I32 count = 0;
while (SP > MARK)
PP(pp_defined)
{
- djSP;
+ dSP;
register SV* sv;
sv = POPs;
RETPUSHNO;
switch (SvTYPE(sv)) {
case SVt_PVAV:
- if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
+ || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
RETPUSHYES;
break;
case SVt_PVHV:
- if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv,'P')))
+ if (HvARRAY(sv) || SvGMAGICAL(sv)
+ || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
RETPUSHYES;
break;
case SVt_PVCV:
PP(pp_undef)
{
- djSP;
+ dSP;
SV *sv;
if (!PL_op->op_private) {
case SVt_PVFM:
{
/* let user-undef'd sub keep its identity */
- GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
+ GV* gv = CvGV((CV*)sv);
cv_undef((CV*)sv);
CvGV((CV*)sv) = gv;
}
PP(pp_predec)
{
- djSP;
+ dSP;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
PP(pp_postinc)
{
- djSP; dTARGET;
+ dSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
PP(pp_postdec)
{
- djSP; dTARGET;
+ dSP; dTARGET;
if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
DIE(aTHX_ PL_no_modify);
sv_setsv(TARG, TOPs);
PP(pp_pow)
{
- djSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
{
dPOPTOPnnrl;
SETn( Perl_pow( left, right) );
PP(pp_multiply)
{
- djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_divide)
{
- djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPPOPnnrl;
NV value;
PP(pp_modulo)
{
- djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
- UV left;
- UV right;
+ UV left = 0;
+ UV right = 0;
bool left_neg;
bool right_neg;
bool use_double = 0;
- NV dright;
- NV dleft;
+ NV dright = 0.0;
+ NV dleft = 0.0;
if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
IV i = SvIVX(POPs);
PP(pp_repeat)
{
- djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
{
register IV count = POPi;
if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) {
(void)SvPOK_only_UTF8(TARG);
else
(void)SvPOK_only(TARG);
+
+ if (PL_op->op_private & OPpREPEAT_DOLIST) {
+ /* The parser saw this as a list repeat, and there
+ are probably several items on the stack. But we're
+ in scalar context, and there's no pp_list to save us
+ now. So drop the rest of the items -- robin@kitsite.com
+ */
+ dMARK;
+ SP = MARK;
+ }
PUSHTARG;
}
RETURN;
PP(pp_subtract)
{
- djSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
+ dSP; dATARGET; bool useleft; tryAMAGICbin(subtr,opASSIGN);
useleft = USE_LEFT(TOPm1s);
#ifdef PERL_PRESERVE_IVUV
/* See comments in pp_add (in pp_hot.c) about Overflow, and how
/* Unless the left argument is integer in range we are going to have to
use NV maths. Hence only attempt to coerce the right argument if
we know the left is integer. */
- register UV auv;
- bool auvok;
+ register UV auv = 0;
+ bool auvok = FALSE;
bool a_valid = 0;
if (!useleft) {
UV result;
register UV buv;
bool buvok = SvUOK(TOPs);
-
+
if (buvok)
buv = SvUVX(TOPs);
else {
PP(pp_left_shift)
{
- djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
{
IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
PP(pp_right_shift)
{
- djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
{
IV shift = POPi;
if (PL_op->op_private & HINT_INTEGER) {
PP(pp_lt)
{
- djSP; tryAMAGICbinSET(lt,0);
+ dSP; tryAMAGICbinSET(lt,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_gt)
{
- djSP; tryAMAGICbinSET(gt,0);
+ dSP; tryAMAGICbinSET(gt,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_le)
{
- djSP; tryAMAGICbinSET(le,0);
+ dSP; tryAMAGICbinSET(le,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_ge)
{
- djSP; tryAMAGICbinSET(ge,0);
+ dSP; tryAMAGICbinSET(ge,0);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_ne)
{
- djSP; tryAMAGICbinSET(ne,0);
+ dSP; tryAMAGICbinSET(ne,0);
+#ifndef NV_PRESERVES_UV
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ SETs(boolSV(SvRV(TOPs) != SvRV(TOPm1s)));
+ RETURN;
+ }
+#endif
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_ncmp)
{
- djSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dSP; dTARGET; tryAMAGICbin(ncmp,0);
+#ifndef NV_PRESERVES_UV
+ if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ SETi(PTR2UV(SvRV(TOPs)) - PTR2UV(SvRV(TOPm1s)));
+ RETURN;
+ }
+#endif
#ifdef PERL_PRESERVE_IVUV
/* Fortunately it seems NaN isn't IOK */
SvIV_please(TOPs);
PP(pp_slt)
{
- djSP; tryAMAGICbinSET(slt,0);
+ dSP; tryAMAGICbinSET(slt,0);
{
dPOPTOPssrl;
- int cmp = ((PL_op->op_private & OPpLOCALE)
+ int cmp = (IN_LOCALE_RUNTIME
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp < 0));
PP(pp_sgt)
{
- djSP; tryAMAGICbinSET(sgt,0);
+ dSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
- int cmp = ((PL_op->op_private & OPpLOCALE)
+ int cmp = (IN_LOCALE_RUNTIME
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp > 0));
PP(pp_sle)
{
- djSP; tryAMAGICbinSET(sle,0);
+ dSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
- int cmp = ((PL_op->op_private & OPpLOCALE)
+ int cmp = (IN_LOCALE_RUNTIME
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp <= 0));
PP(pp_sge)
{
- djSP; tryAMAGICbinSET(sge,0);
+ dSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
- int cmp = ((PL_op->op_private & OPpLOCALE)
+ int cmp = (IN_LOCALE_RUNTIME
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETs(boolSV(cmp >= 0));
PP(pp_seq)
{
- djSP; tryAMAGICbinSET(seq,0);
+ dSP; tryAMAGICbinSET(seq,0);
{
dPOPTOPssrl;
SETs(boolSV(sv_eq(left, right)));
PP(pp_sne)
{
- djSP; tryAMAGICbinSET(sne,0);
+ dSP; tryAMAGICbinSET(sne,0);
{
dPOPTOPssrl;
SETs(boolSV(!sv_eq(left, right)));
PP(pp_scmp)
{
- djSP; dTARGET; tryAMAGICbin(scmp,0);
+ dSP; dTARGET; tryAMAGICbin(scmp,0);
{
dPOPTOPssrl;
- int cmp = ((PL_op->op_private & OPpLOCALE)
+ int cmp = (IN_LOCALE_RUNTIME
? sv_cmp_locale(left, right)
: sv_cmp(left, right));
SETi( cmp );
PP(pp_bit_and)
{
- djSP; dATARGET; tryAMAGICbin(band,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
PP(pp_bit_xor)
{
- djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
PP(pp_bit_or)
{
- djSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
{
dPOPTOPssrl;
if (SvNIOKp(left) || SvNIOKp(right)) {
PP(pp_negate)
{
- djSP; dTARGET; tryAMAGICun(neg);
+ dSP; dTARGET; tryAMAGICun(neg);
{
dTOPss;
int flags = SvFLAGS(sv);
PP(pp_not)
{
- djSP; tryAMAGICunSET(not);
+ dSP; tryAMAGICunSET(not);
*PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp));
return NORMAL;
}
PP(pp_complement)
{
- djSP; dTARGET; tryAMAGICun(compl);
+ dSP; dTARGET; tryAMAGICun(compl);
{
dTOPss;
if (SvNIOKp(sv)) {
send = tmps + len;
while (tmps < send) {
- UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
+ UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
tmps += UTF8SKIP(tmps);
targlen += UNISKIP(~c);
nchar++;
if (nwide) {
Newz(0, result, targlen + 1, U8);
while (tmps < send) {
- UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
+ UV c = utf8n_to_uvchr(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV);
tmps += UTF8SKIP(tmps);
- result = uv_to_utf8(result, ~c);
+ result = uvchr_to_utf8(result, ~c);
}
*result = '\0';
result -= targlen;
else {
Newz(0, result, nchar + 1, U8);
while (tmps < send) {
- U8 c = (U8)utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY);
+ U8 c = (U8)utf8n_to_uvchr(tmps, 0, &l, UTF8_ALLOW_ANY);
tmps += UTF8SKIP(tmps);
*result++ = ~c;
}
PP(pp_i_multiply)
{
- djSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
{
dPOPTOPiirl;
SETi( left * right );
PP(pp_i_divide)
{
- djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
{
dPOPiv;
if (value == 0)
PP(pp_i_modulo)
{
- djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN);
{
dPOPTOPiirl;
if (!right)
PP(pp_i_add)
{
- djSP; dATARGET; tryAMAGICbin(add,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
{
dPOPTOPiirl_ul;
SETi( left + right );
PP(pp_i_subtract)
{
- djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
+ dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
{
dPOPTOPiirl_ul;
SETi( left - right );
PP(pp_i_lt)
{
- djSP; tryAMAGICbinSET(lt,0);
+ dSP; tryAMAGICbinSET(lt,0);
{
dPOPTOPiirl;
SETs(boolSV(left < right));
PP(pp_i_gt)
{
- djSP; tryAMAGICbinSET(gt,0);
+ dSP; tryAMAGICbinSET(gt,0);
{
dPOPTOPiirl;
SETs(boolSV(left > right));
PP(pp_i_le)
{
- djSP; tryAMAGICbinSET(le,0);
+ dSP; tryAMAGICbinSET(le,0);
{
dPOPTOPiirl;
SETs(boolSV(left <= right));
PP(pp_i_ge)
{
- djSP; tryAMAGICbinSET(ge,0);
+ dSP; tryAMAGICbinSET(ge,0);
{
dPOPTOPiirl;
SETs(boolSV(left >= right));
PP(pp_i_eq)
{
- djSP; tryAMAGICbinSET(eq,0);
+ dSP; tryAMAGICbinSET(eq,0);
{
dPOPTOPiirl;
SETs(boolSV(left == right));
PP(pp_i_ne)
{
- djSP; tryAMAGICbinSET(ne,0);
+ dSP; tryAMAGICbinSET(ne,0);
{
dPOPTOPiirl;
SETs(boolSV(left != right));
PP(pp_i_ncmp)
{
- djSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dSP; dTARGET; tryAMAGICbin(ncmp,0);
{
dPOPTOPiirl;
I32 value;
PP(pp_i_negate)
{
- djSP; dTARGET; tryAMAGICun(neg);
+ dSP; dTARGET; tryAMAGICun(neg);
SETi(-TOPi);
RETURN;
}
PP(pp_atan2)
{
- djSP; dTARGET; tryAMAGICbin(atan2,0);
+ dSP; dTARGET; tryAMAGICbin(atan2,0);
{
dPOPTOPnnrl;
SETn(Perl_atan2(left, right));
PP(pp_sin)
{
- djSP; dTARGET; tryAMAGICun(sin);
+ dSP; dTARGET; tryAMAGICun(sin);
{
NV value;
value = POPn;
PP(pp_cos)
{
- djSP; dTARGET; tryAMAGICun(cos);
+ dSP; dTARGET; tryAMAGICun(cos);
{
NV value;
value = POPn;
PP(pp_rand)
{
- djSP; dTARGET;
+ dSP; dTARGET;
NV value;
if (MAXARG < 1)
value = 1.0;
PP(pp_srand)
{
- djSP;
+ dSP;
UV anum;
if (MAXARG < 1)
anum = seed();
PP(pp_exp)
{
- djSP; dTARGET; tryAMAGICun(exp);
+ dSP; dTARGET; tryAMAGICun(exp);
{
NV value;
value = POPn;
PP(pp_log)
{
- djSP; dTARGET; tryAMAGICun(log);
+ dSP; dTARGET; tryAMAGICun(log);
{
NV value;
value = POPn;
PP(pp_sqrt)
{
- djSP; dTARGET; tryAMAGICun(sqrt);
+ dSP; dTARGET; tryAMAGICun(sqrt);
{
NV value;
value = POPn;
PP(pp_int)
{
- djSP; dTARGET; tryAMAGICun(int);
+ dSP; dTARGET; tryAMAGICun(int);
{
NV value;
IV iv = TOPi; /* attempt to convert to IV if possible. */
SETu(U_V(value));
} else {
#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+# ifdef HAS_MODFL_POW32_BUG
+/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
+ {
+ NV offset = Perl_modf(value, &value);
+ (void)Perl_modf(offset, &offset);
+ value += offset;
+ }
+# else
(void)Perl_modf(value, &value);
+# endif
#else
double tmp = (double)value;
(void)Perl_modf(tmp, &tmp);
SETi(I_V(value));
} else {
#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE)
+# ifdef HAS_MODFL_POW32_BUG
+/* some versions of glibc split (i + d) into (i-1, d+1) for 2^32 <= i < 2^64 */
+ {
+ NV offset = Perl_modf(-value, &value);
+ (void)Perl_modf(offset, &offset);
+ value += offset;
+ }
+# else
(void)Perl_modf(-value, &value);
+# endif
value = -value;
#else
double tmp = (double)value;
PP(pp_abs)
{
- djSP; dTARGET; tryAMAGICun(abs);
+ dSP; dTARGET; tryAMAGICun(abs);
{
/* This will cache the NV value if string isn't actually integer */
IV iv = TOPi;
PP(pp_hex)
{
- djSP; dTARGET;
+ dSP; dTARGET;
char *tmps;
STRLEN argtype;
- STRLEN n_a;
+ STRLEN len;
- tmps = POPpx;
+ tmps = (SvPVx(POPs, len));
argtype = 1; /* allow underscores */
- XPUSHn(scan_hex(tmps, 99, &argtype));
+ XPUSHn(scan_hex(tmps, len, &argtype));
RETURN;
}
PP(pp_oct)
{
- djSP; dTARGET;
+ dSP; dTARGET;
NV value;
STRLEN argtype;
char *tmps;
- STRLEN n_a;
+ STRLEN len;
- tmps = POPpx;
- while (*tmps && isSPACE(*tmps))
- tmps++;
+ tmps = (SvPVx(POPs, len));
+ while (*tmps && len && isSPACE(*tmps))
+ tmps++, len--;
if (*tmps == '0')
- tmps++;
+ tmps++, len--;
argtype = 1; /* allow underscores */
if (*tmps == 'x')
- value = scan_hex(++tmps, 99, &argtype);
+ value = scan_hex(++tmps, --len, &argtype);
else if (*tmps == 'b')
- value = scan_bin(++tmps, 99, &argtype);
+ value = scan_bin(++tmps, --len, &argtype);
else
- value = scan_oct(tmps, 99, &argtype);
+ value = scan_oct(tmps, len, &argtype);
XPUSHn(value);
RETURN;
}
PP(pp_length)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *sv = TOPs;
if (DO_UTF8(sv))
PP(pp_substr)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *sv;
- I32 len;
+ I32 len = 0;
STRLEN curlen;
- STRLEN utfcurlen;
+ STRLEN utf8_curlen;
I32 pos;
I32 rem;
I32 fail;
I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
char *tmps;
I32 arybase = PL_curcop->cop_arybase;
+ SV *repl_sv = NULL;
char *repl = 0;
STRLEN repl_len;
int num_args = PL_op->op_private & 7;
+ bool repl_need_utf8_upgrade = FALSE;
+ bool repl_is_utf8 = FALSE;
SvTAINTED_off(TARG); /* decontaminate */
SvUTF8_off(TARG); /* decontaminate */
if (num_args > 2) {
if (num_args > 3) {
- sv = POPs;
- repl = SvPV(sv, repl_len);
+ repl_sv = POPs;
+ repl = SvPV(repl_sv, repl_len);
+ repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv);
}
len = POPi;
}
pos = POPi;
sv = POPs;
PUTBACK;
+ if (repl_sv) {
+ if (repl_is_utf8) {
+ if (!DO_UTF8(sv))
+ sv_utf8_upgrade(sv);
+ }
+ else if (DO_UTF8(sv))
+ repl_need_utf8_upgrade = TRUE;
+ }
tmps = SvPV(sv, curlen);
if (DO_UTF8(sv)) {
- utfcurlen = sv_len_utf8(sv);
- if (utfcurlen == curlen)
- utfcurlen = 0;
+ utf8_curlen = sv_len_utf8(sv);
+ if (utf8_curlen == curlen)
+ utf8_curlen = 0;
else
- curlen = utfcurlen;
+ curlen = utf8_curlen;
}
else
- utfcurlen = 0;
+ utf8_curlen = 0;
if (pos >= arybase) {
pos -= arybase;
else {
I32 upos = pos;
I32 urem = rem;
- if (utfcurlen)
+ if (utf8_curlen)
sv_pos_u2b(sv, &pos, &rem);
tmps += pos;
sv_setpvn(TARG, tmps, rem);
- if (utfcurlen)
+#ifdef USE_LOCALE_COLLATE
+ sv_unmagic(TARG, PERL_MAGIC_collxfrm);
+#endif
+ if (utf8_curlen)
SvUTF8_on(TARG);
- if (repl)
+ if (repl) {
+ SV* repl_sv_copy = NULL;
+
+ if (repl_need_utf8_upgrade) {
+ repl_sv_copy = newSVsv(repl_sv);
+ sv_utf8_upgrade(repl_sv_copy);
+ repl = SvPV(repl_sv_copy, repl_len);
+ repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv);
+ }
sv_insert(sv, pos, rem, repl, repl_len);
+ if (repl_is_utf8)
+ SvUTF8_on(sv);
+ if (repl_sv_copy)
+ SvREFCNT_dec(repl_sv_copy);
+ }
else if (lvalue) { /* it's an lvalue! */
if (!SvGMAGICAL(sv)) {
if (SvROK(sv)) {
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, 'x', Nullch, 0);
+ sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
}
LvTYPE(TARG) = 'x';
PP(pp_vec)
{
- djSP; dTARGET;
+ dSP; dTARGET;
register IV size = POPi;
register IV offset = POPi;
register SV *src = POPs;
if (lvalue) { /* it's an lvalue! */
if (SvTYPE(TARG) < SVt_PVLV) {
sv_upgrade(TARG, SVt_PVLV);
- sv_magic(TARG, Nullsv, 'v', Nullch, 0);
+ sv_magic(TARG, Nullsv, PERL_MAGIC_vec, Nullch, 0);
}
LvTYPE(TARG) = 'v';
if (LvTARG(TARG) != src) {
PP(pp_index)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *big;
SV *little;
I32 offset;
PP(pp_rindex)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *big;
SV *little;
STRLEN blen;
PP(pp_sprintf)
{
- djSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
do_sprintf(TARG, SP-MARK, MARK+1);
TAINT_IF(SvTAINTED(TARG));
SP = ORIGMARK;
PP(pp_ord)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *argsv = POPs;
STRLEN len;
U8 *s = (U8*)SvPVx(argsv, len);
- XPUSHu(DO_UTF8(argsv) ? utf8_to_uv_simple(s, 0) : (*s & 0xff));
+ XPUSHu(DO_UTF8(argsv) ? utf8_to_uvchr(s, 0) : (*s & 0xff));
RETURN;
}
PP(pp_chr)
{
- djSP; dTARGET;
+ dSP; dTARGET;
char *tmps;
UV value = POPu;
(void)SvUPGRADE(TARG,SVt_PV);
- if (value > 255 && !IN_BYTE) {
+ if (value > 255 && !IN_BYTES) {
SvGROW(TARG, UNISKIP(value)+1);
- tmps = (char*)uv_to_utf8((U8*)SvPVX(TARG), value);
+ tmps = (char*)uvchr_to_utf8((U8*)SvPVX(TARG), value);
SvCUR_set(TARG, tmps - SvPVX(TARG));
*tmps = '\0';
(void)SvPOK_only(TARG);
PP(pp_crypt)
{
- djSP; dTARGET; dPOPTOPssrl;
+ dSP; dTARGET; dPOPTOPssrl;
STRLEN n_a;
#ifdef HAS_CRYPT
char *tmps = SvPV(left, n_a);
PP(pp_ucfirst)
{
- djSP;
+ dSP;
SV *sv = TOPs;
register U8 *s;
STRLEN slen;
STRLEN ulen;
U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tend;
- UV uv = utf8_to_uv(s, slen, &ulen, 0);
+ UV uv;
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
- uv = toTITLE_LC_uni(uv);
+ uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
}
else
uv = toTITLE_utf8(s);
- tend = uv_to_utf8(tmpbuf, uv);
+ tend = uvchr_to_utf8(tmpbuf, uv);
if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
}
s = (U8*)SvPV_force(sv, slen);
if (*s) {
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
*s = toUPPER_LC(*s);
PP(pp_lcfirst)
{
- djSP;
+ dSP;
SV *sv = TOPs;
register U8 *s;
STRLEN slen;
STRLEN ulen;
U8 tmpbuf[UTF8_MAXLEN+1];
U8 *tend;
- UV uv = utf8_to_uv(s, slen, &ulen, 0);
+ UV uv;
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
- uv = toLOWER_LC_uni(uv);
+ uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
}
else
uv = toLOWER_utf8(s);
- tend = uv_to_utf8(tmpbuf, uv);
+ tend = uvchr_to_utf8(tmpbuf, uv);
if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
dTARGET;
}
s = (U8*)SvPV_force(sv, slen);
if (*s) {
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
*s = toLOWER_LC(*s);
PP(pp_uc)
{
- djSP;
+ dSP;
SV *sv = TOPs;
register U8 *s;
STRLEN len;
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
+ d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
s += ulen;
}
}
else {
while (s < send) {
- d = uv_to_utf8(d, toUPPER_utf8( s ));
+ d = uvchr_to_utf8(d, toUPPER_utf8( s ));
s += UTF8SKIP(s);
}
}
if (len) {
register U8 *send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
for (; s < send; s++)
PP(pp_lc)
{
- djSP;
+ dSP;
SV *sv = TOPs;
register U8 *s;
STRLEN len;
(void)SvPOK_only(TARG);
d = (U8*)SvPVX(TARG);
send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(TARG);
while (s < send) {
- d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, len, &ulen, 0)));
+ d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
s += ulen;
}
}
else {
while (s < send) {
- d = uv_to_utf8(d, toLOWER_utf8(s));
+ d = uvchr_to_utf8(d, toLOWER_utf8(s));
s += UTF8SKIP(s);
}
}
if (len) {
register U8 *send = s + len;
- if (PL_op->op_private & OPpLOCALE) {
+ if (IN_LOCALE_RUNTIME) {
TAINT;
SvTAINTED_on(sv);
for (; s < send; s++)
PP(pp_quotemeta)
{
- djSP; dTARGET;
+ dSP; dTARGET;
SV *sv = TOPs;
STRLEN len;
register char *s = SvPV(sv,len);
PP(pp_aslice)
{
- djSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
register SV** svp;
register AV* av = (AV*)POPs;
register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
PP(pp_each)
{
- djSP;
+ dSP;
HV *hash = (HV*)POPs;
HE *entry;
I32 gimme = GIMME_V;
PP(pp_delete)
{
- djSP;
+ dSP;
I32 gimme = GIMME_V;
I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
SV *sv;
PP(pp_exists)
{
- djSP;
+ dSP;
SV *tmpsv;
HV *hv;
PP(pp_hslice)
{
- djSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
register HV *hv = (HV*)POPs;
register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
I32 realhv = (SvTYPE(hv) == SVt_PVHV);
while (++MARK <= SP) {
SV *keysv = *MARK;
SV **svp;
- I32 preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0);
+ I32 preeminent = SvRMAGICAL(hv) ? 1 :
+ realhv ? hv_exists_ent(hv, keysv, 0)
+ : avhv_exists_ent((AV*)hv, keysv, 0);
if (realhv) {
HE *he = hv_fetch_ent(hv, keysv, lval, 0);
svp = he ? &HeVAL(he) : 0;
PP(pp_list)
{
- djSP; dMARK;
+ dSP; dMARK;
if (GIMME != G_ARRAY) {
if (++MARK <= SP)
*MARK = *SP; /* unwanted list, return last item */
PP(pp_lslice)
{
- djSP;
+ dSP;
SV **lastrelem = PL_stack_sp;
SV **lastlelem = PL_stack_base + POPMARK;
SV **firstlelem = PL_stack_base + POPMARK + 1;
PP(pp_anonlist)
{
- djSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
I32 items = SP - MARK;
SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
SP = ORIGMARK; /* av_make() might realloc stack_sp */
PP(pp_anonhash)
{
- djSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
HV* hv = (HV*)sv_2mortal((SV*)newHV());
while (MARK < SP) {
PP(pp_splice)
{
- djSP; dMARK; dORIGMARK;
+ dSP; dMARK; dORIGMARK;
register AV *ary = (AV*)*++MARK;
register SV **src;
register SV **dst;
SV **tmparyval = 0;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
PP(pp_push)
{
- djSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
PP(pp_pop)
{
- djSP;
+ dSP;
AV *av = (AV*)POPs;
SV *sv = av_pop(av);
if (AvREAL(av))
PP(pp_shift)
{
- djSP;
+ dSP;
AV *av = (AV*)POPs;
SV *sv = av_shift(av);
EXTEND(SP, 1);
PP(pp_unshift)
{
- djSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv;
register I32 i = 0;
MAGIC *mg;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
*MARK-- = SvTIED_obj((SV*)ary, mg);
PUSHMARK(MARK);
PUTBACK;
PP(pp_reverse)
{
- djSP; dMARK;
+ dSP; dMARK;
register SV *tmp;
SV **oldsp = SP;
U8* s = (U8*)SvPVX(TARG);
U8* send = (U8*)(s + len);
while (s < send) {
- if (UTF8_IS_ASCII(*s)) {
+ if (UTF8_IS_INVARIANT(*s)) {
s++;
continue;
}
else {
- if (!utf8_to_uv_simple(s, 0))
+ if (!utf8_to_uvchr(s, 0))
break;
up = (char*)s;
s += UTF8SKIP(s);
#define ISUUCHAR(ch) (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ')
#endif
+
PP(pp_unpack)
{
- djSP;
+ dSP;
dPOPPOPssrl;
I32 start_sp_offset = SP - PL_stack_base;
I32 gimme = GIMME_V;
STRLEN llen;
STRLEN rlen;
register char *pat = SvPV(left, llen);
+#ifdef PACKED_IS_OCTETS
+ /* Packed side is assumed to be octets - so force downgrade if it
+ has been UTF-8 encoded by accident
+ */
+ register char *s = SvPVbyte(right, rlen);
+#else
register char *s = SvPV(right, rlen);
+#endif
char *strend = s + rlen;
char *strbeg = s;
register char *patend = pat + llen;
I32 datumtype;
register I32 len;
- register I32 bits;
+ register I32 bits = 0;
register char *str;
/* These must not be in registers: */
float afloat;
double adouble;
I32 checksum = 0;
- register U32 culong;
- NV cdouble;
+ register U32 culong = 0;
+ NV cdouble = 0.0;
int commas = 0;
int star;
#ifdef PERL_NATINT_PACK
if (checksum) {
while (len-- > 0 && s < strend) {
STRLEN alen;
- auint = utf8_to_uv((U8*)s, strend - s, &alen, 0);
+ auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0);
along = alen;
s += along;
if (checksum > 32)
EXTEND_MORTAL(len);
while (len-- > 0 && s < strend) {
STRLEN alen;
- auint = utf8_to_uv((U8*)s, strend - s, &alen, 0);
+ auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0);
along = alen;
s += along;
sv = NEWSV(37, 0);
while ((len > 0) && (s < strend)) {
auv = (auv << 7) | (*s & 0x7f);
- if (UTF8_IS_ASCII(*s++)) {
+ /* UTF8_IS_XXXXX not right here - using constant 0x80 */
+ if ((U8)(*s++) < 0x80) {
bytes = 0;
sv = NEWSV(40, 0);
sv_setuv(sv, auv);
PP(pp_pack)
{
- djSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
register I32 items;
STRLEN fromlen;
patcopy++;
continue;
}
+#ifndef PACKED_IS_OCTETS
if (datumtype == 'U' && pat == patcopy+1)
SvUTF8_on(cat);
+#endif
if (datumtype == '#') {
while (pat < patend && *pat != '\n')
pat++;
case 'c':
while (len-- > 0) {
fromstr = NEXTFROM;
- aint = SvIV(fromstr);
- achar = aint;
- sv_catpvn(cat, &achar, sizeof(char));
+ switch (datumtype) {
+ case 'C':
+ aint = SvIV(fromstr);
+ if ((aint < 0 || aint > 255) &&
+ ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
+ "Character in \"C\" format wrapped");
+ achar = aint & 255;
+ sv_catpvn(cat, &achar, sizeof(char));
+ break;
+ case 'c':
+ aint = SvIV(fromstr);
+ if ((aint < -128 || aint > 127) &&
+ ckWARN(WARN_PACK))
+ Perl_warner(aTHX_ WARN_PACK,
+ "Character in \"c\" format wrapped");
+ achar = aint & 255;
+ sv_catpvn(cat, &achar, sizeof(char));
+ break;
+ }
}
break;
case 'U':
fromstr = NEXTFROM;
auint = SvUV(fromstr);
SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1);
- SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint)
+ SvCUR_set(cat, (char*)uvchr_to_utf8((U8*)SvEND(cat),auint)
- SvPVX(cat));
}
*SvEND(cat) = '\0';
PP(pp_split)
{
- djSP; dTARG;
+ dSP; dTARG;
AV *ary;
register IV limit = POPi; /* note, negative is forever */
SV *sv = POPs;
av_extend(ary,0);
av_clear(ary);
SPAGAIN;
- if ((mg = SvTIED_mg((SV*)ary, 'P'))) {
+ if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj((SV*)ary, mg));
}
void
Perl_unlock_condpair(pTHX_ void *svv)
{
- MAGIC *mg = mg_find((SV*)svv, 'm');
+ MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
if (!mg)
Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
PP(pp_lock)
{
- djSP;
+ dSP;
dTOPss;
SV *retsv = sv;
#ifdef USE_THREADS
PP(pp_threadsv)
{
#ifdef USE_THREADS
- djSP;
+ dSP;
EXTEND(SP, 1);
if (PL_op->op_private & OPpLVAL_INTRO)
PUSHs(*save_threadsv(PL_op->op_targ));