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) {
PP(pp_pos)
{
- djSP; dTARGET; dPOPss;
+ dSP; dTARGET; dPOPss;
if (PL_op->op_flags & OPf_MOD || LVRET) {
if (SvTYPE(TARG) < SVt_PVLV) {
PP(pp_rv2cv)
{
- djSP;
+ dSP;
GV *gv;
HV *stash;
PP(pp_prototype)
{
- djSP;
+ dSP;
CV *cv;
HV *stash;
GV *gv;
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;
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;
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;
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) {
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
- /* We must see if we can perform the addition with integers if possible,
- as the integer code detects overflow while the NV code doesn't.
- If either argument hasn't had a numeric conversion yet attempt to get
- the IV. It's important to do this now, rather than just assuming that
- it's not IOK as a PV of "9223372036854775806" may not take well to NV
- addition, and an SV which is NOK, NV=6.0 ought to be coerced to
- integer in case the second argument is IV=9223372036854775806
- We can (now) rely on sv_2iv to do the right thing, only setting the
- public IOK flag if the value in the NV (or PV) slot is truly integer.
-
- A side effect is that this also aggressively prefers integer maths over
- fp maths for integer values. */
+ /* See comments in pp_add (in pp_hot.c) about Overflow, and how
+ "bad things" happen if you rely on signed integers wrapping. */
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
/* 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;
+ bool a_valid = 0;
+
if (!useleft) {
- /* left operand is undef, treat as zero. + 0 is identity. */
- if (SvUOK(TOPs)) {
- dPOPuv; /* Scary macros. Lets put a sequence point (;) here */
- if (value <= (UV)IV_MIN) {
- /* 2s complement assumption. */
- SETi(-(IV)value);
- RETURN;
- } /* else drop through into NVs below */
- } else {
- dPOPiv;
- SETu((UV)-value);
- RETURN;
- }
+ auv = 0;
+ a_valid = auvok = 1;
+ /* left operand is undef, treat as zero. */
} else {
/* Left operand is defined, so is it IV? */
SvIV_please(TOPm1s);
if (SvIOK(TOPm1s)) {
- bool auvok = SvUOK(TOPm1s);
- bool buvok = SvUOK(TOPs);
-
- if (!auvok && !buvok) { /* ## IV - IV ## */
- IV aiv = SvIVX(TOPm1s);
- IV biv = SvIVX(TOPs);
- IV result = aiv - biv;
-
- if (biv >= 0 ? (result < aiv) : (result >= aiv)) {
- SP--;
- SETi( result );
- RETURN;
- }
- /* +ve - +ve can't overflow. (worst case 0 - IV_MAX) */
- /* -ve - -ve can't overflow. (worst case -1 - IV_MIN) */
- /* -ve - +ve can only overflow too negative. */
- /* leaving +ve - -ve, which will go UV */
- if (aiv >= 0 && biv < 0) { /* assert don't need biv <0 */
- /* 2s complement assumption for IV_MIN */
- UV result = (UV)aiv + (UV)-biv;
- /* UV + UV must get bigger. +ve IV + +ve IV +1 can't
- overflow UV (2s complement assumption */
- assert (result >= (UV) aiv);
- SP--;
- SETu( result );
- RETURN;
- }
- /* Overflow, drop through to NVs */
- } else if (auvok && buvok) { /* ## UV - UV ## */
- UV auv = SvUVX(TOPm1s);
- UV buv = SvUVX(TOPs);
- IV result;
-
- if (auv >= buv) {
- SP--;
- SETu( auv - buv );
- RETURN;
- }
- /* Blatant 2s complement assumption. */
- result = (IV)(auv - buv);
- if (result < 0) {
- SP--;
- SETi( result );
- RETURN;
+ if ((auvok = SvUOK(TOPm1s)))
+ auv = SvUVX(TOPm1s);
+ else {
+ register IV aiv = SvIVX(TOPm1s);
+ if (aiv >= 0) {
+ auv = aiv;
+ auvok = 1; /* Now acting as a sign flag. */
+ } else { /* 2s complement assumption for IV_MIN */
+ auv = (UV)-aiv;
}
- /* Overflow on IV - IV, drop through to NVs */
- } else if (auvok) { /* ## Mixed UV - IV ## */
- UV auv = SvUVX(TOPm1s);
- IV biv = SvIVX(TOPs);
-
- if (biv < 0) {
- /* 2s complement assumptions for IV_MIN */
- UV result = auv + ((UV)-biv);
- /* UV + UV can only get bigger... */
- if (result >= auv) {
- SP--;
- SETu( result );
- RETURN;
- }
- /* and if it gets too big for UV then it's NV time. */
- } else if (auv > (UV)IV_MAX) {
- /* I think I'm making an implicit 2s complement
- assumption that IV_MIN == -IV_MAX - 1 */
- /* biv is >= 0 */
- UV result = auv - (UV)biv;
- assert (result <= auv);
- SP--;
- SETu( result );
- RETURN;
- } else {
- /* biv is >= 0 */
- IV result = (IV)auv - biv;
- assert (result <= (IV)auv);
- SP--;
- SETi( result );
- RETURN;
+ }
+ a_valid = 1;
+ }
+ }
+ if (a_valid) {
+ bool result_good = 0;
+ UV result;
+ register UV buv;
+ bool buvok = SvUOK(TOPs);
+
+ if (buvok)
+ buv = SvUVX(TOPs);
+ else {
+ register IV biv = SvIVX(TOPs);
+ if (biv >= 0) {
+ buv = biv;
+ buvok = 1;
+ } else
+ buv = (UV)-biv;
+ }
+ /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve,
+ else "IV" now, independant of how it came in.
+ if a, b represents positive, A, B negative, a maps to -A etc
+ a - b => (a - b)
+ A - b => -(a + b)
+ a - B => (a + b)
+ A - B => -(a - b)
+ all UV maths. negate result if A negative.
+ subtract if signs same, add if signs differ. */
+
+ if (auvok ^ buvok) {
+ /* Signs differ. */
+ result = auv + buv;
+ if (result >= auv)
+ result_good = 1;
+ } else {
+ /* Signs same */
+ if (auv >= buv) {
+ result = auv - buv;
+ /* Must get smaller */
+ if (result <= auv)
+ result_good = 1;
+ } else {
+ result = buv - auv;
+ if (result <= buv) {
+ /* result really should be -(auv-buv). as its negation
+ of true value, need to swap our result flag */
+ auvok = !auvok;
+ result_good = 1;
}
- } else { /* ## Mixed IV - UV ## */
- IV aiv = SvIVX(TOPm1s);
- UV buv = SvUVX(TOPs);
- IV result = aiv - (IV)buv; /* 2s complement assumption. */
-
- /* result must not get larger. */
- if (result <= aiv) {
- SP--;
- SETi( result );
- RETURN;
- } /* end of IV-IV / UV-UV / UV-IV / IV-UV */
}
}
+ if (result_good) {
+ SP--;
+ if (auvok)
+ SETu( result );
+ else {
+ /* Negate result */
+ if (result <= (UV)IV_MIN)
+ SETi( -(IV)result );
+ else {
+ /* result valid, but out of range for IV. */
+ SETn( -(NV)result );
+ }
+ }
+ RETURN;
+ } /* Overflow, drop through to NVs. */
}
}
#endif
+ useleft = USE_LEFT(TOPm1s);
{
dPOPnv;
if (!useleft) {
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);
#ifdef PERL_PRESERVE_IVUV
SvIV_please(TOPs);
if (SvIOK(TOPs)) {
PP(pp_ncmp)
{
- djSP; dTARGET; tryAMAGICbin(ncmp,0);
+ dSP; dTARGET; tryAMAGICbin(ncmp,0);
#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)
PP(pp_sgt)
{
- djSP; tryAMAGICbinSET(sgt,0);
+ dSP; tryAMAGICbinSET(sgt,0);
{
dPOPTOPssrl;
int cmp = ((PL_op->op_private & OPpLOCALE)
PP(pp_sle)
{
- djSP; tryAMAGICbinSET(sle,0);
+ dSP; tryAMAGICbinSET(sle,0);
{
dPOPTOPssrl;
int cmp = ((PL_op->op_private & OPpLOCALE)
PP(pp_sge)
{
- djSP; tryAMAGICbinSET(sge,0);
+ dSP; tryAMAGICbinSET(sge,0);
{
dPOPTOPssrl;
int cmp = ((PL_op->op_private & OPpLOCALE)
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)
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;
+ dSP; dTARGET; tryAMAGICun(int);
{
NV value;
IV iv = TOPi; /* attempt to convert to IV if possible. */
(void)Perl_modf(tmp, &tmp);
value = (NV)tmp;
#endif
+ SETn(value);
}
}
else {
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;
PP(pp_oct)
{
- djSP; dTARGET;
+ dSP; dTARGET;
NV value;
STRLEN argtype;
char *tmps;
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;
STRLEN curlen;
PP(pp_vec)
{
- djSP; dTARGET;
+ dSP; dTARGET;
register IV size = POPi;
register IV offset = POPi;
register SV *src = POPs;
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;
if (value > 255 && !IN_BYTE) {
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) {
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;
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) {
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;
PP(pp_uc)
{
- djSP;
+ dSP;
SV *sv = TOPs;
register U8 *s;
STRLEN len;
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);
}
}
PP(pp_lc)
{
- djSP;
+ dSP;
SV *sv = TOPs;
register U8 *s;
STRLEN len;
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);
}
}
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);
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;
PP(pp_push)
{
- djSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
register AV *ary = (AV*)*++MARK;
register SV *sv = &PL_sv_undef;
MAGIC *mg;
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;
PP(pp_reverse)
{
- djSP; dMARK;
+ dSP; dMARK;
register SV *tmp;
SV **oldsp = SP;
continue;
}
else {
- if (!utf8_to_uv_simple(s, 0))
+ if (!utf8_to_uvchr(s, 0))
break;
up = (char*)s;
s += UTF8SKIP(s);
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);
+#if 0
+ /* 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;
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);
PP(pp_pack)
{
- djSP; dMARK; dORIGMARK; dTARGET;
+ dSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
register I32 items;
STRLEN fromlen;
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;
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));