#include "EXTERN.h"
#define PERL_IN_PP_C
#include "perl.h"
#include "keywords.h"
#include "invlist_inline.h"
#include "reentr.h"
#include "regcharclass.h"
PP(pp_stub)
{
if
(GIMME_V == G_SCALAR)
rpp_xpush_IMM(&PL_sv_undef);
return
NORMAL;
}
PP(pp_padcv)
{
dTARGET;
assert
(SvTYPE(TARG) == SVt_PVCV);
rpp_xpush_1(TARG);
return
NORMAL;
}
PP(pp_introcv)
{
dTARGET;
SvPADSTALE_off(TARG);
return
NORMAL;
}
PP(pp_clonecv)
{
dTARGET;
CV *
const
protocv = PadnamePROTOCV(
PadlistNAMESARRAY(CvPADLIST(find_runcv(NULL)))[ARGTARG]
);
assert
(SvTYPE(TARG) == SVt_PVCV);
assert
(protocv);
if
(CvISXSUB(protocv)) {
SAVEPADSVANDMORTALIZE(ARGTARG);
PAD_SVl(ARGTARG) = SvREFCNT_inc_simple_NN(protocv);
}
else
{
if
(CvROOT(protocv)) {
assert
(CvCLONE(protocv));
assert
(!CvCLONED(protocv));
}
cv_clone_into(protocv,(CV *)TARG);
SAVECLEARSV(PAD_SVl(ARGTARG));
}
return
NORMAL;
}
static
SV *
S_rv2gv(pTHX_ SV *sv,
const
bool
vivify_sv,
const
bool
strict,
const
bool
noinit)
{
if
(!isGV(sv) || SvFAKE(sv)) SvGETMAGIC(sv);
if
(SvROK(sv)) {
if
(SvAMAGIC(sv)) {
sv = amagic_deref_call(sv, to_gv_amg);
}
wasref:
sv = SvRV(sv);
if
(SvTYPE(sv) == SVt_PVIO) {
GV *
const
gv = MUTABLE_GV(sv_newmortal());
gv_init(gv, 0,
"__ANONIO__"
, 10, 0);
GvIOp(gv) = MUTABLE_IO(sv);
SvREFCNT_inc_void_NN(sv);
sv = MUTABLE_SV(gv);
}
else
if
(!isGV_with_GP(sv)) {
Perl_die(aTHX_
"Not a GLOB reference"
);
}
}
else
{
if
(!isGV_with_GP(sv)) {
if
(!SvOK(sv)) {
if
(vivify_sv && sv != &PL_sv_undef) {
GV *gv;
HV *stash;
if
(SvREADONLY(sv))
Perl_croak_no_modify();
gv = MUTABLE_GV(newSV_type(SVt_NULL));
stash = CopSTASH(PL_curcop);
if
(SvTYPE(stash) != SVt_PVHV) stash = NULL;
if
(cUNOP->op_targ) {
SV *
const
namesv = PAD_SV(cUNOP->op_targ);
gv_init_sv(gv, stash, namesv, 0);
}
else
{
gv_init_pv(gv, stash,
"__ANONIO__"
, 0);
}
sv_setrv_noinc_mg(sv, MUTABLE_SV(gv));
goto
wasref;
}
if
(PL_op->op_flags & OPf_REF || strict) {
Perl_die(aTHX_ PL_no_usym,
"a symbol"
);
}
if
(ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
return
&PL_sv_undef;
}
if
(noinit)
{
if
(!(sv = MUTABLE_SV(gv_fetchsv_nomg(
sv, GV_ADDMG, SVt_PVGV
))))
return
&PL_sv_undef;
}
else
{
if
(strict) {
Perl_die(aTHX_
PL_no_symref_sv,
sv,
(SvPOKp(sv) && SvCUR(sv)>32 ?
"..."
:
""
),
"a symbol"
);
}
if
((PL_op->op_private & (OPpLVAL_INTRO|OPpDONT_INIT_GV))
== OPpDONT_INIT_GV) {
return
sv;
}
sv = MUTABLE_SV(gv_fetchsv_nomg(sv, GV_ADD, SVt_PVGV));
}
SvFAKE_off(sv);
}
}
if
(SvFAKE(sv) && !(PL_op->op_private & OPpALLOW_FAKE)) {
SV *newsv = sv_mortalcopy_flags(sv, 0);
SvFAKE_off(newsv);
sv = newsv;
}
return
sv;
}
PP(pp_rv2gv)
{
SV *sv = *PL_stack_sp;
sv = S_rv2gv(aTHX_
sv, PL_op->op_private & OPpDEREF,
PL_op->op_private & HINT_STRICT_REFS,
((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD))
|| PL_op->op_type == OP_READLINE
);
if
(PL_op->op_private & OPpLVAL_INTRO)
save_gp(MUTABLE_GV(sv), !(PL_op->op_flags & OPf_SPECIAL));
rpp_replace_1_1_NN(sv);
return
NORMAL;
}
GV *
Perl_softref2xv(pTHX_ SV *
const
sv,
const
char
*
const
what,
const
svtype type)
{
GV *gv;
PERL_ARGS_ASSERT_SOFTREF2XV;
if
(PL_op->op_private & HINT_STRICT_REFS) {
if
(SvOK(sv))
Perl_die(aTHX_ PL_no_symref_sv, sv,
(SvPOKp(sv) && SvCUR(sv)>32 ?
"..."
:
""
), what);
else
Perl_die(aTHX_ PL_no_usym, what);
}
if
(!SvOK(sv)) {
if
(
PL_op->op_flags & OPf_REF
)
Perl_die(aTHX_ PL_no_usym, what);
if
(ckWARN(WARN_UNINITIALIZED))
report_uninit(sv);
if
(type != SVt_PV && GIMME_V == G_LIST) {
rpp_popfree_1_NN();
return
NULL;
}
rpp_replace_1_IMM_NN(&PL_sv_undef);
return
NULL;
}
if
((PL_op->op_flags & OPf_SPECIAL) &&
!(PL_op->op_flags & OPf_MOD))
{
if
(!(gv = gv_fetchsv_nomg(sv, GV_ADDMG, type)))
{
rpp_replace_1_IMM_NN(&PL_sv_undef);
return
NULL;
}
}
else
{
gv = gv_fetchsv_nomg(sv, GV_ADD, type);
}
return
gv;
}
PP(pp_rv2sv)
{
SV *sv = *PL_stack_sp;
GV *gv = NULL;
SvGETMAGIC(sv);
if
(SvROK(sv)) {
if
(SvAMAGIC(sv)) {
sv = amagic_deref_call(sv, to_sv_amg);
}
sv = SvRV(sv);
if
(SvTYPE(sv) >= SVt_PVAV)
DIE(aTHX_
"Not a SCALAR reference"
);
}
else
{
gv = MUTABLE_GV(sv);
if
(!isGV_with_GP(gv)) {
gv = Perl_softref2xv(aTHX_ sv,
"a SCALAR"
, SVt_PV);
if
(!gv)
return
NORMAL;
}
sv = GvSVn(gv);
}
if
(PL_op->op_flags & OPf_MOD) {
if
(PL_op->op_private & OPpLVAL_INTRO) {
if
(cUNOP->op_first->op_type == OP_NULL)
sv = save_scalar(MUTABLE_GV(*PL_stack_sp));
else
if
(gv)
sv = save_scalar(gv);
else
Perl_croak(aTHX_
"%s"
, PL_no_localize_ref);
}
else
if
(PL_op->op_private & OPpDEREF)
sv = vivify_ref(sv, PL_op->op_private & OPpDEREF);
}
rpp_replace_1_1_NN(sv);
return
NORMAL;
}
PP(pp_av2arylen)
{
AV *
const
av = MUTABLE_AV(*PL_stack_sp);
const
I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
if
(lvalue) {
SV **
const
svp = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
if
(!*svp) {
*svp = newSV_type(SVt_PVMG);
sv_magic(*svp, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
}
SV *sv_al = *svp;
#ifdef PERL_RC_STACK
if
(SvREFCNT(av) == 1) {
MAGIC *mg_av = mg_find((
const
SV *)av, PERL_MAGIC_arylen_p);
MAGIC *mg_al = mg_find(sv_al, PERL_MAGIC_arylen);
assert
(mg_av);
assert
(mg_al);
assert
( mg_av->mg_flags & MGf_REFCOUNTED);
assert
(!(mg_al->mg_flags & MGf_REFCOUNTED));
mg_av->mg_flags &= ~MGf_REFCOUNTED;
mg_al->mg_flags |= MGf_REFCOUNTED;
*PL_stack_sp = sv_al;
}
else
#endif
rpp_replace_1_1_NN(sv_al);
}
else
{
SV *sv = newSViv(AvFILL(MUTABLE_AV(av)));
rpp_popfree_1();
rpp_push_1_norc(sv);
}
return
NORMAL;
}
PP(pp_pos)
{
SV *sv = *PL_stack_sp;
if
(PL_op->op_flags & OPf_MOD || LVRET) {
SV *
const
ret = newSV_type_mortal(SVt_PVLV);
sv_magic(ret, NULL, PERL_MAGIC_pos, NULL, 0);
LvTYPE(ret) =
'.'
;
LvTARG(ret) = SvREFCNT_inc_simple(sv);
rpp_replace_1_1_NN(ret);
}
else
{
const
MAGIC *
const
mg = mg_find_mglob(sv);
if
(mg && mg->mg_len != -1) {
STRLEN i = mg->mg_len;
if
(PL_op->op_private & OPpTRUEBOOL)
rpp_replace_1_IMM_NN(i ? &PL_sv_yes : &PL_sv_zero);
else
{
dTARGET;
if
(mg->mg_flags & MGf_BYTES && DO_UTF8(sv))
i = sv_pos_b2u_flags(sv, i, SV_GMAGIC|SV_CONST_RETURN);
TARGu(i,1);
rpp_replace_1_1_NN(targ);
}
return
NORMAL;
}
rpp_replace_1_IMM_NN(&PL_sv_undef);
}
return
NORMAL;
}
PP(pp_rv2cv)
{
GV *gv;
HV *stash_unused;
const
I32 flags = (PL_op->op_flags & OPf_SPECIAL)
? GV_ADDMG
: ((PL_op->op_private & (OPpLVAL_INTRO|OPpMAY_RETURN_CONSTANT))
== OPpMAY_RETURN_CONSTANT)
? GV_ADD|GV_NOEXPAND
: GV_ADD;
CV *cv = sv_2cv(*PL_stack_sp, &stash_unused, &gv, flags);
if
(cv) NOOP;
else
if
((flags == (GV_ADD|GV_NOEXPAND)) && gv && SvROK(gv)) {
cv = SvTYPE(SvRV(gv)) == SVt_PVCV
? MUTABLE_CV(SvRV(gv))
: MUTABLE_CV(gv);
}
else
cv = MUTABLE_CV(&PL_sv_undef);
rpp_replace_1_1_NN(MUTABLE_SV(cv));
return
NORMAL;
}
PP(pp_prototype)
{
CV *cv;
HV *stash;
GV *gv;
SV *ret = &PL_sv_undef;
SV *fn = *PL_stack_sp;
if
(SvGMAGICAL(fn))
fn = sv_mortalcopy(fn);
if
(SvPOK(fn) && SvCUR(fn) >= 7) {
const
char
* s = SvPVX_const(fn);
if
(memBEGINs(s, SvCUR(fn),
"CORE::"
)) {
const
int
code = keyword(s + 6, SvCUR(fn) - 6, 1);
if
(!code)
DIE(aTHX_
"Can't find an opnumber for \"%"
UTF8f
"\""
,
UTF8fARG(SvFLAGS(fn) & SVf_UTF8, SvCUR(fn)-6, s+6));
{
SV *
const
sv = core_prototype(NULL, s + 6, code, NULL);
if
(sv) ret = sv;
}
goto
set;
}
}
cv = sv_2cv(fn, &stash, &gv, 0);
if
(cv && SvPOK(cv))
ret = newSVpvn_flags(
CvPROTO(cv), CvPROTOLEN(cv), SVs_TEMP | SvUTF8(cv)
);
set:
rpp_replace_1_1_NN(ret);
return
NORMAL;
}
PP(pp_anoncode)
{
CV *cv = MUTABLE_CV(PAD_SV(PL_op->op_targ));
if
(CvCLONE(cv))
cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
SV* sv = MUTABLE_SV(cv);
if
(LIKELY(PL_op->op_flags & OPf_REF)) {
sv = refto(sv);
}
rpp_xpush_1(sv);
return
NORMAL;
}
PP(pp_srefgen)
{
rpp_replace_1_1_NN(refto(*PL_stack_sp));
return
NORMAL;
}
PP(pp_refgen)
{
const
U8 gimme = GIMME_V;
dMARK;
if
(gimme == G_VOID)
rpp_popfree_to_NN(mark);
else
if
(gimme == G_SCALAR) {
if
(++mark < PL_stack_sp) {
SV *topsv = *PL_stack_sp;
*PL_stack_sp = *mark;
*mark = topsv;
rpp_popfree_to_NN(mark);
}
else
if
(mark > PL_stack_sp) {
rpp_xpush_IMM(&PL_sv_undef);
}
rpp_replace_1_1_NN(refto(*PL_stack_sp));
}
else
{
EXTEND_MORTAL(PL_stack_sp - MARK);
while
(++MARK <= PL_stack_sp) {
SV *sv = *MARK;
SV *rv = refto(sv);
#ifdef PERL_RC_STACK
SvREFCNT_dec(sv);
SvREFCNT_inc(rv);
#endif
*MARK = rv;
}
}
return
NORMAL;
}
STATIC SV*
S_refto(pTHX_ SV *sv)
{
SV* rv;
PERL_ARGS_ASSERT_REFTO;
if
(SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) ==
'y'
) {
if
(LvTARGLEN(sv))
vivify_defelem(sv);
if
(!(sv = LvTARG(sv)))
sv = &PL_sv_undef;
else
SvREFCNT_inc_void_NN(sv);
}
else
if
(SvTYPE(sv) == SVt_PVAV) {
if
(!AvREAL((
const
AV *)sv) && AvREIFY((
const
AV *)sv))
av_reify(MUTABLE_AV(sv));
SvTEMP_off(sv);
SvREFCNT_inc_void_NN(sv);
}
else
if
(SvPADTMP(sv)) {
sv = newSVsv(sv);
}
else
if
(UNLIKELY(SvSMAGICAL(sv) && mg_find(sv, PERL_MAGIC_nonelem)))
sv_unmagic(SvREFCNT_inc_simple_NN(sv), PERL_MAGIC_nonelem);
else
{
SvTEMP_off(sv);
SvREFCNT_inc_void_NN(sv);
}
rv = newSV_type_mortal(SVt_IV);
sv_setrv_noinc(rv, sv);
return
rv;
}
PP(pp_ref)
{
SV *
const
sv = *PL_stack_sp;
SvGETMAGIC(sv);
if
(!SvROK(sv)) {
rpp_replace_1_IMM_NN(&PL_sv_no);
return
NORMAL;
}
if
( (PL_op->op_private & OPpTRUEBOOL)
|| ( (PL_op->op_private & OPpMAYBE_TRUEBOOL)
&& block_gimme() == G_VOID))
{
SV *
const
rv = SvRV(sv);
if
(SvOBJECT(rv)) {
HV *stash = SvSTASH(rv);
HEK *hek = HvNAME_HEK(stash);
if
(hek) {
I32 len = HEK_LEN(hek);
if
(UNLIKELY(
len == HEf_SVKEY
|| (len == 1 && HEK_KEY(hek)[0] ==
'0'
)
))
goto
do_sv_ref;
}
}
rpp_replace_1_IMM_NN(&PL_sv_yes);
return
NORMAL;
}
do_sv_ref:
{
dTARGET;
sv_ref(TARG, SvRV(sv), TRUE);
rpp_replace_1_1_NN(TARG);
SvSETMAGIC(TARG);
return
NORMAL;
}
}
PP(pp_bless)
{
HV *stash;
SV **sp = PL_stack_sp;
if
(MAXARG == 1)
{
curstash:
stash = CopSTASH(PL_curcop);
if
(SvTYPE(stash) != SVt_PVHV)
Perl_croak(aTHX_
"Attempt to bless into a freed package"
);
}
else
{
SV *
const
ssv = *sp--;
STRLEN len;
const
char
*ptr;
if
(!ssv)
goto
curstash;
SvGETMAGIC(ssv);
if
(SvROK(ssv)) {
if
(!SvAMAGIC(ssv)) {
frog:
Perl_croak(aTHX_
"Attempt to bless into a reference"
);
}
ptr = SvPV_nomg_const(ssv,len);
if
(!SvAMAGIC(ssv))
goto
frog;
}
else
ptr = SvPV_nomg_const(ssv,len);
if
(len == 0)
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Explicit blessing to '' (assuming package main)"
);
stash = gv_stashpvn(ptr, len, GV_ADD|SvUTF8(ssv));
}
(
void
)sv_bless(*sp, stash);
if
(PL_stack_sp > sp)
rpp_popfree_1();
return
NORMAL;
}
PP(pp_gelem)
{
SV *sv = PL_stack_sp[0];
STRLEN len;
const
char
*
const
elem = SvPV_const(sv, len);
GV *
const
gv = MUTABLE_GV(PL_stack_sp[-1]);
SV * tmpRef = NULL;
sv = NULL;
if
(elem) {
switch
(*elem) {
case
'A'
:
if
(memEQs(elem, len,
"ARRAY"
))
{
tmpRef = MUTABLE_SV(GvAV(gv));
if
(tmpRef && !AvREAL((
const
AV *)tmpRef)
&& AvREIFY((
const
AV *)tmpRef))
av_reify(MUTABLE_AV(tmpRef));
}
break
;
case
'C'
:
if
(memEQs(elem, len,
"CODE"
))
tmpRef = MUTABLE_SV(GvCVu(gv));
break
;
case
'F'
:
if
(memEQs(elem, len,
"FILEHANDLE"
)) {
tmpRef = MUTABLE_SV(GvIOp(gv));
}
else
if
(memEQs(elem, len,
"FORMAT"
))
tmpRef = MUTABLE_SV(GvFORM(gv));
break
;
case
'G'
:
if
(memEQs(elem, len,
"GLOB"
))
tmpRef = MUTABLE_SV(gv);
break
;
case
'H'
:
if
(memEQs(elem, len,
"HASH"
))
tmpRef = MUTABLE_SV(GvHV(gv));
break
;
case
'I'
:
if
(memEQs(elem, len,
"IO"
))
tmpRef = MUTABLE_SV(GvIOp(gv));
break
;
case
'N'
:
if
(memEQs(elem, len,
"NAME"
))
sv = newSVhek(GvNAME_HEK(gv));
break
;
case
'P'
:
if
(memEQs(elem, len,
"PACKAGE"
)) {
const
HV *
const
stash = GvSTASH(gv);
const
HEK *
const
hek = stash ? HvNAME_HEK(stash) : NULL;
sv = hek ? newSVhek(hek) : newSVpvs(
"__ANON__"
);
}
break
;
case
'S'
:
if
(memEQs(elem, len,
"SCALAR"
))
tmpRef = GvSVn(gv);
break
;
}
}
if
(tmpRef)
sv = newRV(tmpRef);
if
(sv)
sv_2mortal(sv);
else
sv = &PL_sv_undef;
rpp_replace_2_1_NN(sv);
return
NORMAL;
}
PP(pp_study)
{
SV *sv = *PL_stack_sp;
STRLEN len;
(
void
)SvPV(sv, len);
if
(len == 0 || len > I32_MAX || !SvPOK(sv) || SvUTF8(sv) || SvVALID(sv)) {
rpp_replace_1_IMM_NN(&PL_sv_no);
return
NORMAL;
}
rpp_replace_1_IMM_NN(&PL_sv_yes);
return
NORMAL;
}
PP_wrapped(pp_trans, ((PL_op->op_flags & OPf_STACKED) ? 1 : 0), 0)
{
dSP;
SV *sv;
if
(PL_op->op_flags & OPf_STACKED)
sv = POPs;
else
{
EXTEND(SP,1);
if
(ARGTARG)
sv = PAD_SV(ARGTARG);
else
{
sv = DEFSV;
}
}
if
(PL_op->op_type == OP_TRANSR) {
STRLEN len;
const
char
*
const
pv = SvPV(sv,len);
SV *
const
newsv = newSVpvn_flags(pv, len, SVs_TEMP|SvUTF8(sv));
do_trans(newsv);
PUSHs(newsv);
}
else
{
Size_t i = do_trans(sv);
mPUSHi((UV)i);
}
RETURN;
}
static
size_t
S_do_chomp(pTHX_ SV *retval, SV *sv,
bool
chomping)
{
STRLEN len;
char
*s;
size_t
count = 0;
PERL_ARGS_ASSERT_DO_CHOMP;
if
(chomping && (RsSNARF(PL_rs) || RsRECORD(PL_rs)))
return
0;
if
(SvTYPE(sv) == SVt_PVAV) {
SSize_t i;
AV *
const
av = MUTABLE_AV(sv);
const
SSize_t max = AvFILL(av);
for
(i = 0; i <= max; i++) {
sv = MUTABLE_SV(av_fetch(av, i, FALSE));
if
(sv && ((sv = *(SV**)sv), sv != &PL_sv_undef))
count += do_chomp(retval, sv, chomping);
}
return
count;
}
else
if
(SvTYPE(sv) == SVt_PVHV) {
HV*
const
hv = MUTABLE_HV(sv);
HE* entry;
(
void
)hv_iterinit(hv);
while
((entry = hv_iternext(hv)))
count += do_chomp(retval, hv_iterval(hv,entry), chomping);
return
count;
}
else
if
(SvREADONLY(sv)) {
Perl_croak_no_modify();
}
s = SvPV(sv, len);
if
(chomping) {
if
(s && len) {
char
*temp_buffer = NULL;
s += --len;
if
(RsPARA(PL_rs)) {
if
(*s !=
'\n'
)
goto
nope_free_nothing;
++count;
while
(len && s[-1] ==
'\n'
) {
--len;
--s;
++count;
}
}
else
{
STRLEN rslen, rs_charlen;
const
char
*rsptr = SvPV_const(PL_rs, rslen);
rs_charlen = SvUTF8(PL_rs)
? sv_len_utf8(PL_rs)
: rslen;
if
(SvUTF8(PL_rs) != SvUTF8(sv)) {
if
(SvUTF8(PL_rs)) {
bool
is_utf8 = TRUE;
temp_buffer = (
char
*)bytes_from_utf8((U8*)rsptr,
&rslen, &is_utf8);
if
(is_utf8) {
assert
(temp_buffer == rsptr);
goto
nope_free_nothing;
}
rsptr = temp_buffer;
}
else
{
temp_buffer = (
char
*)bytes_to_utf8((U8*)rsptr, &rslen);
rsptr = temp_buffer;
}
}
if
(rslen == 1) {
if
(*s != *rsptr)
goto
nope_free_all;
++count;
}
else
{
if
(len < rslen - 1)
goto
nope_free_all;
len -= rslen - 1;
s -= rslen - 1;
if
(memNE(s, rsptr, rslen))
goto
nope_free_all;
count += rs_charlen;
}
}
SvPV_force_nomg_nolen(sv);
SvCUR_set(sv, len);
*SvEND(sv) =
'\0'
;
SvNIOK_off(sv);
SvSETMAGIC(sv);
nope_free_all:
Safefree(temp_buffer);
nope_free_nothing: ;
}
}
else
{
if
(len && (!SvPOK(sv) || SvIsCOW(sv)))
s = SvPV_force_nomg(sv, len);
if
(DO_UTF8(sv)) {
if
(s && len) {
char
*
const
send = s + len;
char
*
const
start = s;
s = (
char
*) utf8_hop_back((U8 *) send, -1, (U8 *) start);
if
(is_utf8_string((U8*)s, send - s)) {
sv_setpvn(retval, s, send - s);
*s =
'\0'
;
SvCUR_set(sv, s - start);
SvNIOK_off(sv);
SvUTF8_on(retval);
}
}
else
SvPVCLEAR(retval);
}
else
if
(s && len) {
s += --len;
sv_setpvn(retval, s, 1);
*s =
'\0'
;
SvCUR_set(sv, len);
SvUTF8_off(sv);
SvNIOK_off(sv);
}
else
SvPVCLEAR(retval);
SvSETMAGIC(sv);
}
return
count;
}
PP(pp_schop)
{
dTARGET;
const
bool
chomping = PL_op->op_type == OP_SCHOMP;
const
size_t
count = do_chomp(TARG, *PL_stack_sp, chomping);
if
(chomping)
sv_setiv(TARG, count);
SvSETMAGIC(TARG);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP_wrapped(pp_chop, 0, 1)
{
dSP; dMARK; dTARGET; dORIGMARK;
const
bool
chomping = PL_op->op_type == OP_CHOMP;
size_t
count = 0;
while
(MARK < SP)
count += do_chomp(TARG, *++MARK, chomping);
if
(chomping)
sv_setiv(TARG, count);
SP = ORIGMARK;
XPUSHTARG;
RETURN;
}
PP(pp_undef)
{
SV *sv;
if
(!PL_op->op_private) {
rpp_xpush_IMM(&PL_sv_undef);
return
NORMAL;
}
if
(PL_op->op_private & OPpTARGET_MY) {
SV**
const
padentry = &PAD_SVl(PL_op->op_targ);
sv = *padentry;
if
(UNLIKELY((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID))
rpp_xpush_1(sv);
if
((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
== OPpLVAL_INTRO)
{
save_clearsv(padentry);
}
}
else
{
sv = *PL_stack_sp;
if
(!sv) {
*PL_stack_sp = &PL_sv_undef;
return
NORMAL;
}
}
if
(SvTHINKFIRST(sv))
sv_force_normal_flags(sv, SV_COW_DROP_PV|SV_IMMEDIATE_UNREF);
switch
(SvTYPE(sv)) {
case
SVt_NULL:
break
;
case
SVt_PVAV:
av_undef(MUTABLE_AV(sv));
break
;
case
SVt_PVHV:
hv_undef(MUTABLE_HV(sv));
break
;
case
SVt_PVCV:
if
(cv_const_sv((
const
CV *)sv))
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Constant subroutine %"
SVf
" undefined"
,
SVfARG(CvANON((
const
CV *)sv)
? newSVpvs_flags(
"(anonymous)"
, SVs_TEMP)
: newSVhek_mortal(
CvNAMED(sv)
? CvNAME_HEK((CV *)sv)
: GvENAME_HEK(CvGV((
const
CV *)sv))
)
));
case
SVt_PVFM:
cv_undef_flags(MUTABLE_CV(sv), CV_UNDEF_KEEP_NAME);
break
;
case
SVt_PVGV:
assert
(isGV_with_GP(sv));
assert
(!SvFAKE(sv));
{
GP *gp;
HV *stash;
bool
method_changed
= GvCVu((
const
GV *)sv) && (stash = GvSTASH((
const
GV *)sv))
&& HvHasENAME(stash);
if
((stash = GvHV((
const
GV *)sv))) {
if
(HvENAME_get(stash))
SvREFCNT_inc_simple_void_NN(sv_2mortal((SV *)stash));
else
stash = NULL;
}
SvREFCNT_inc_simple_void_NN(sv_2mortal(sv));
gp_free(MUTABLE_GV(sv));
Newxz(gp, 1, GP);
GvGP_set(sv, gp_ref(gp));
#ifndef PERL_DONT_CREATE_GVSV
GvSV(sv) = newSV_type(SVt_NULL);
#endif
GvLINE(sv) = CopLINE(PL_curcop);
GvEGV(sv) = MUTABLE_GV(sv);
GvMULTI_on(sv);
if
(stash)
mro_package_moved(NULL, stash, (
const
GV *)sv, 0);
stash = NULL;
if
( strEQ(GvNAME((
const
GV *)sv),
"ISA"
)
&& (stash = GvSTASH((
const
GV *)sv))
&& (method_changed || HvHasENAME(stash)) )
mro_isa_changed_in(stash);
else
if
(method_changed)
mro_method_changed_in(
GvSTASH((
const
GV *)sv)
);
break
;
}
default
:
if
(SvTYPE(sv) >= SVt_PV && SvPVX_const(sv) && SvLEN(sv)
&& !(PL_op->op_private & OPpUNDEF_KEEP_PV)
) {
SvPV_free(sv);
SvPV_set(sv, NULL);
SvLEN_set(sv, 0);
}
SvOK_off(sv);
SvSETMAGIC(sv);
}
if
(!(PL_op->op_private & OPpTARGET_MY)) {
if
(LIKELY((PL_op->op_flags & OPf_WANT) == OPf_WANT_VOID))
rpp_popfree_1_NN();
else
rpp_replace_1_1_NN(&PL_sv_undef);
}
return
NORMAL;
}
static
OP *
S_postincdec_common(pTHX_ SV *sv, SV *targ)
{
const
bool
inc =
PL_op->op_type == OP_POSTINC || PL_op->op_type == OP_I_POSTINC;
if
(SvROK(sv))
TARG = sv_newmortal();
sv_setsv(TARG, sv);
if
(inc)
sv_inc_nomg(sv);
else
sv_dec_nomg(sv);
SvSETMAGIC(sv);
if
(inc && !SvOK(TARG))
sv_setiv(TARG, 0);
SvSETMAGIC(TARG);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_postinc)
{
dTARGET;
SV *sv = *PL_stack_sp;
if
(LIKELY(((sv->sv_flags &
(SVf_THINKFIRST|SVs_GMG|SVf_IVisUV|
SVf_IOK|SVf_NOK|SVf_POK|SVp_NOK|SVp_POK|SVf_ROK))
== SVf_IOK))
&& SvIVX(sv) != IV_MAX)
{
IV iv = SvIVX(sv);
SvIV_set(sv, iv + 1);
TARGi(iv, 0);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
return
S_postincdec_common(aTHX_ sv, TARG);
}
PP(pp_postdec)
{
dTARGET;
SV *sv = *PL_stack_sp;
if
(LIKELY(((sv->sv_flags &
(SVf_THINKFIRST|SVs_GMG|SVf_IVisUV|
SVf_IOK|SVf_NOK|SVf_POK|SVp_NOK|SVp_POK|SVf_ROK))
== SVf_IOK))
&& SvIVX(sv) != IV_MIN)
{
IV iv = SvIVX(sv);
SvIV_set(sv, iv - 1);
TARGi(iv, 0);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
return
S_postincdec_common(aTHX_ sv, TARG);
}
PP(pp_pow)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(pow_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
SV *svr = PL_stack_sp[0];
SV *svl = PL_stack_sp[-1];
#ifdef PERL_PRESERVE_IVUV
bool
is_int = 0;
if
(SvIV_please_nomg(svr) && SvIV_please_nomg(svl)) {
UV power;
bool
baseuok;
UV baseuv;
if
(SvUOK(svr)) {
power = SvUVX(svr);
}
else
{
const
IV iv = SvIVX(svr);
if
(iv >= 0) {
power = iv;
}
else
{
goto
float_it;
}
}
baseuok = SvUOK(svl);
if
(baseuok) {
baseuv = SvUVX(svl);
}
else
{
const
IV iv = SvIVX(svl);
if
(iv >= 0) {
baseuv = iv;
baseuok = TRUE;
}
else
{
baseuv = -iv;
}
}
is_int = 1;
if
(!(baseuv & (baseuv - 1))) {
NV result = 1.0;
NV base = baseuok ? baseuv : -(NV)baseuv;
if
(power & 1) {
result *= base;
}
while
(power >>= 1) {
base *= base;
if
(power & 1) {
result *= base;
}
}
TARGn(result, 1);
SvIV_please_nomg(svr);
goto
ret;
}
else
{
unsigned
int
highbit = 8 *
sizeof
(UV);
unsigned
int
diff = 8 *
sizeof
(UV);
while
(diff >>= 1) {
highbit -= diff;
if
(baseuv >> highbit) {
highbit += diff;
}
}
if
(power * highbit <= 8 *
sizeof
(UV)) {
UV result = 1;
UV base = baseuv;
const
bool
odd_power = cBOOL(power & 1);
if
(odd_power) {
result *= base;
}
while
(power >>= 1) {
base *= base;
if
(power & 1) {
result *= base;
}
}
if
(baseuok || !odd_power)
TARGu(result, 1);
else
if
(result <= (UV)IV_MAX)
TARGi(-(IV)result, 1);
else
if
(result == (UV)IV_MIN)
TARGi(IV_MIN, 1);
else
TARGn(-(NV)result, 1);
goto
ret;
}
}
}
float_it:
#endif
{
NV right = SvNV_nomg(svr);
NV left = SvNV_nomg(svl);
#if defined(USE_LONG_DOUBLE) && defined(HAS_AIX_POWL_NEG_BASE_BUG)
if
(left < 0.0) {
NV mod2 = Perl_fmod( right, 2.0 );
if
(mod2 == 1.0 || mod2 == -1.0) {
TARGn(-Perl_pow(-left, right), 1);
}
else
if
(mod2 == 0.0) {
TARGn(Perl_pow(-left, right), 1);
}
else
{
TARGn(NV_NAN, 1);
}
}
else
{
TARGn(Perl_pow(left, right), 1);
}
#elif IVSIZE == 4 && defined(LONGDOUBLE_DOUBLEDOUBLE) && defined(USE_LONG_DOUBLE)
if
(is_int) {
TARGn(roundl(Perl_pow(left, right)), 1);
}
else
TARGn(Perl_pow(left, right), 1 );
#else
TARGn(Perl_pow(left, right), 1);
#endif /* HAS_AIX_POWL_NEG_BASE_BUG */
#ifdef PERL_PRESERVE_IVUV
if
(is_int)
SvIV_please_nomg(svr);
#endif
}
ret:
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_multiply)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(mult_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
SV *svr = PL_stack_sp[0];
SV *svl = PL_stack_sp[-1];
#ifdef PERL_PRESERVE_IVUV
if
(!((svl->sv_flags|svr->sv_flags) & (SVf_IVisUV|SVs_GMG))) {
IV il, ir;
U32 flags = (svl->sv_flags & svr->sv_flags);
if
(flags & SVf_IOK) {
UV topl, topr;
il = SvIVX(svl);
ir = SvIVX(svr);
do_iv:
topl = ((UV)il) >> (UVSIZE * 4 - 1);
topr = ((UV)ir) >> (UVSIZE * 4 - 1);
if
(!(
((topl+1) | (topr+1))
& ( (((UV)1) << (UVSIZE * 4 + 1)) - 2)
)) {
TARGi(il * ir, 0);
goto
ret;
}
goto
generic;
}
else
if
(flags & SVf_NOK) {
NV nl = SvNVX(svl);
NV nr = SvNVX(svr);
NV result;
if
(lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
goto
do_iv;
}
result = nl * nr;
# if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE && NVSIZE == 16
if
(Perl_isinf(result)) {
Zero((U8*)&result + 8, 8, U8);
}
# endif
TARGn(result, 0);
goto
ret;
}
}
generic:
if
(SvIV_please_nomg(svr)) {
if
(SvIV_please_nomg(svl)) {
bool
auvok = SvUOK(svl);
bool
buvok = SvUOK(svr);
const
UV topmask = (~ (UV)0) << (4 *
sizeof
(UV));
const
UV botmask = ~((~ (UV)0) << (4 *
sizeof
(UV)));
UV alow;
UV ahigh;
UV blow;
UV bhigh;
if
(auvok) {
alow = SvUVX(svl);
}
else
{
const
IV aiv = SvIVX(svl);
if
(aiv >= 0) {
alow = aiv;
auvok = TRUE;
}
else
{
alow = (UV) (0 - (UV) aiv);
}
}
if
(buvok) {
blow = SvUVX(svr);
}
else
{
const
IV biv = SvIVX(svr);
if
(biv >= 0) {
blow = biv;
buvok = TRUE;
}
else
{
blow = (UV) (0 - (UV) biv);
}
}
ahigh = alow >> (4 *
sizeof
(UV));
alow &= botmask;
bhigh = blow >> (4 *
sizeof
(UV));
blow &= botmask;
if
(ahigh && bhigh) {
NOOP;
}
else
if
(!ahigh && !bhigh) {
const
UV product = alow * blow;
if
(auvok == buvok) {
TARGu(product, 1);
goto
ret;
}
else
if
(product <= (UV)IV_MIN) {
assert
(product != (UV)IV_MIN);
TARGi(-(IV)product, 1);
goto
ret;
}
}
else
{
UV product_middle;
if
(bhigh) {
ahigh = bhigh;
bhigh = blow;
blow = alow;
alow = bhigh;
}
product_middle = ahigh * blow;
if
(!(product_middle & topmask)) {
UV product_low;
product_middle <<= (4 *
sizeof
(UV));
product_low = alow * blow;
product_low += product_middle;
if
(product_low >= product_middle) {
if
(auvok == buvok) {
TARGu(product_low, 1);
goto
ret;
}
else
if
(product_low <= (UV)IV_MIN) {
TARGi(product_low == (UV)IV_MIN
? IV_MIN : -(IV)product_low,
1);
goto
ret;
}
}
}
}
}
}
#endif
{
NV right = SvNV_nomg(svr);
NV left = SvNV_nomg(svl);
NV result = left * right;
#if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE && NVSIZE == 16
if
(Perl_isinf(result)) {
Zero((U8*)&result + 8, 8, U8);
}
#endif
TARGn(result, 1);
goto
ret;
}
ret:
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_divide)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(div_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
SV *svr = PL_stack_sp[0];
SV *svl = PL_stack_sp[-1];
#if defined(SLOPPYDIVIDE) || (defined(PERL_PRESERVE_IVUV) && !defined(NV_PRESERVES_UV))
# define PERL_TRY_UV_DIVIDE
#endif
#ifdef PERL_TRY_UV_DIVIDE
if
(SvIV_please_nomg(svr) && SvIV_please_nomg(svl)) {
bool
left_non_neg = SvUOK(svl);
bool
right_non_neg = SvUOK(svr);
UV left;
UV right;
if
(right_non_neg) {
right = SvUVX(svr);
}
else
{
const
IV biv = SvIVX(svr);
if
(biv >= 0) {
right = biv;
right_non_neg = TRUE;
}
else
{
right = -(UV)biv;
}
}
if
(right == 0)
DIE(aTHX_
"Illegal division by zero"
);
if
(left_non_neg) {
left = SvUVX(svl);
}
else
{
const
IV aiv = SvIVX(svl);
if
(aiv >= 0) {
left = aiv;
left_non_neg = TRUE;
}
else
{
left = -(UV)aiv;
}
}
if
(left >= right
#ifdef SLOPPYDIVIDE
#else
&& (left > ((UV)1 << NV_PRESERVES_UV_BITS))
#endif
) {
const
UV result = left / right;
if
(left % right == 0) {
if
(left_non_neg == right_non_neg) {
TARGu(result, 1);
goto
ret;
}
if
(result <= (UV)IV_MIN)
TARGi(result == (UV)IV_MIN ? IV_MIN : -(IV)result,
1);
else
{
TARGn(-(NV)result, 1);
}
goto
ret;
}
}
}
#endif /* PERL_TRY_UV_DIVIDE */
{
NV right = SvNV_nomg(svr);
NV left = SvNV_nomg(svl);
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
if
(! Perl_isnan(right) && right == 0.0)
#else
if
(right == 0.0)
#endif
DIE(aTHX_
"Illegal division by zero"
);
TARGn(left / right, 1);
goto
ret;
}
ret:
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_modulo)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(modulo_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
{
UV left = 0;
UV right = 0;
bool
left_neg = FALSE;
bool
right_neg = FALSE;
bool
use_double = FALSE;
bool
dright_valid = FALSE;
NV dright = 0.0;
NV dleft = 0.0;
SV *
const
svr = PL_stack_sp[0];
SV *
const
svl = PL_stack_sp[-1];
if
(SvIV_please_nomg(svr)) {
right_neg = !SvUOK(svr);
if
(!right_neg) {
right = SvUVX(svr);
}
else
{
const
IV biv = SvIVX(svr);
if
(biv >= 0) {
right = biv;
right_neg = FALSE;
}
else
{
right = NEGATE_2UV(biv);
}
}
}
else
{
dright = SvNV_nomg(svr);
right_neg = dright < 0;
if
(right_neg)
dright = -dright;
if
(dright < UV_MAX_P1) {
right = U_V(dright);
dright_valid = TRUE;
}
else
{
use_double = TRUE;
}
}
if
(!use_double && SvIV_please_nomg(svl)) {
left_neg = !SvUOK(svl);
if
(!left_neg) {
left = SvUVX(svl);
}
else
{
const
IV aiv = SvIVX(svl);
if
(aiv >= 0) {
left = aiv;
left_neg = FALSE;
}
else
{
left = NEGATE_2UV(aiv);
}
}
}
else
{
dleft = SvNV_nomg(svl);
left_neg = dleft < 0;
if
(left_neg)
dleft = -dleft;
if
(!use_double) {
if
(dleft < UV_MAX_P1) {
left = U_V(dleft);
}
else
{
dleft = Perl_floor(dleft + 0.5);
use_double = TRUE;
if
(dright_valid)
dright = Perl_floor(dright + 0.5);
else
dright = right;
}
}
}
if
(use_double) {
NV dans;
if
(!dright)
DIE(aTHX_
"Illegal modulus zero"
);
dans = Perl_fmod(dleft, dright);
if
((left_neg != right_neg) && dans)
dans = dright - dans;
if
(right_neg)
dans = -dans;
sv_setnv(TARG, dans);
}
else
{
UV ans;
if
(!right)
DIE(aTHX_
"Illegal modulus zero"
);
ans = left % right;
if
((left_neg != right_neg) && ans)
ans = right - ans;
if
(right_neg) {
if
(ans <= ABS_IV_MIN)
sv_setiv(TARG, NEGATE_2IV(ans));
else
sv_setnv(TARG, -(NV)ans);
}
else
sv_setuv(TARG, ans);
}
SvSETMAGIC(TARG);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
}
PP_wrapped(pp_repeat,
((PL_op->op_private & OPpREPEAT_DOLIST) ? 0 : 2),
((PL_op->op_private & OPpREPEAT_DOLIST) ? 1 : 0))
{
dSP; dATARGET;
IV count;
SV *sv;
bool
infnan = FALSE;
const
U8 gimme = GIMME_V;
if
(gimme == G_LIST && PL_op->op_private & OPpREPEAT_DOLIST) {
sv = POPs;
SvGETMAGIC(sv);
}
else
{
if
(UNLIKELY(PL_op->op_private & OPpREPEAT_DOLIST)) {
dMARK;
if
(MARK + 1 < SP) {
MARK[1] = TOPm1s;
MARK[2] = TOPs;
}
else
{
dTOPss;
ASSUME(MARK + 1 == SP);
MEXTEND(SP, 1);
PUSHs(sv);
MARK[1] = &PL_sv_undef;
}
SP = MARK + 2;
}
tryAMAGICbin_MG(repeat_amg, AMGf_assign);
sv = POPs;
}
if
(SvIOKp(sv)) {
if
(SvUOK(sv)) {
const
UV uv = SvUV_nomg(sv);
if
(uv > IV_MAX)
count = IV_MAX;
else
count = uv;
}
else
{
count = SvIV_nomg(sv);
}
}
else
if
(SvNOKp(sv)) {
const
NV nv = SvNV_nomg(sv);
infnan = Perl_isinfnan(nv);
if
(UNLIKELY(infnan)) {
count = 0;
}
else
{
if
(nv < 0.0)
count = -1;
else
count = (IV)nv;
}
}
else
count = SvIV_nomg(sv);
if
(infnan) {
Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
"Non-finite repeat count does nothing"
);
}
else
if
(count < 0) {
count = 0;
Perl_ck_warner(aTHX_ packWARN(WARN_NUMERIC),
"Negative repeat count does nothing"
);
}
if
(gimme == G_LIST && PL_op->op_private & OPpREPEAT_DOLIST) {
dMARK;
const
SSize_t items = SP - MARK;
const
U8 mod = PL_op->op_flags & OPf_MOD;
if
(count > 1) {
SSize_t max;
if
( items > SSize_t_MAX / (SSize_t)
sizeof
(SV *) / count )
Perl_croak(aTHX_
"%s"
,
"Out of memory during list extend"
);
max = items * count;
MEXTEND(MARK, max);
while
(SP > MARK) {
if
(*SP) {
if
(mod && SvPADTMP(*SP)) {
*SP = sv_mortalcopy(*SP);
}
SvTEMP_off((*SP));
}
SP--;
}
MARK++;
repeatcpy((
char
*)(MARK + items), (
char
*)MARK,
items *
sizeof
(
const
SV *), count - 1);
SP += max;
}
else
if
(count <= 0)
SP = MARK;
}
else
{
SV *
const
tmpstr = POPs;
STRLEN len;
bool
isutf;
if
(TARG != tmpstr)
sv_setsv_nomg(TARG, tmpstr);
SvPV_force_nomg(TARG, len);
isutf = DO_UTF8(TARG);
if
(count != 1) {
if
(count < 1)
SvCUR_set(TARG, 0);
else
{
STRLEN max;
if
( len > (MEM_SIZE_MAX-1) / (UV)count
)
Perl_croak(aTHX_
"%s"
,
"Out of memory during string extend"
);
max = (UV)count * len + 1;
SvGROW(TARG, max);
repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
SvCUR_set(TARG, SvCUR(TARG) * count);
}
*SvEND(TARG) =
'\0'
;
}
if
(isutf)
(
void
)SvPOK_only_UTF8(TARG);
else
(
void
)SvPOK_only(TARG);
PUSHTARG;
}
RETURN;
}
PP(pp_subtract)
{
bool
useleft;
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(subtr_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
SV *svr = PL_stack_sp[0];
SV *svl = PL_stack_sp[-1];
#ifdef PERL_PRESERVE_IVUV
if
(!((svl->sv_flags|svr->sv_flags) & (SVf_IVisUV|SVs_GMG))) {
IV il, ir;
U32 flags = (svl->sv_flags & svr->sv_flags);
if
(flags & SVf_IOK) {
UV topl, topr;
il = SvIVX(svl);
ir = SvIVX(svr);
do_iv:
topl = ((UV)il) >> (UVSIZE * 8 - 2);
topr = ((UV)ir) >> (UVSIZE * 8 - 2);
if
(!( ((topl+1) | (topr+1)) & 2)) {
TARGi(il - ir, 0);
goto
ret;
}
goto
generic;
}
else
if
(flags & SVf_NOK) {
NV nl = SvNVX(svl);
NV nr = SvNVX(svr);
if
(lossless_NV_to_IV(nl, &il) && lossless_NV_to_IV(nr, &ir)) {
goto
do_iv;
}
TARGn(nl - nr, 0);
goto
ret;
}
}
generic:
useleft = USE_LEFT(svl);
if
(SvIV_please_nomg(svr)) {
UV auv = 0;
bool
auvok = FALSE;
bool
a_valid = 0;
if
(!useleft) {
auv = 0;
a_valid = auvok = 1;
}
else
{
if
(SvIV_please_nomg(svl)) {
if
((auvok = SvUOK(svl)))
auv = SvUVX(svl);
else
{
const
IV aiv = SvIVX(svl);
if
(aiv >= 0) {
auv = aiv;
auvok = 1;
}
else
{
auv = (UV) (0 - (UV) aiv);
}
}
a_valid = 1;
}
}
if
(a_valid) {
bool
result_good = 0;
UV result;
UV buv;
bool
buvok = SvUOK(svr);
if
(buvok)
buv = SvUVX(svr);
else
{
const
IV biv = SvIVX(svr);
if
(biv >= 0) {
buv = biv;
buvok = 1;
}
else
buv = (UV) (0 - (UV) biv);
}
if
(auvok ^ buvok) {
result = auv + buv;
if
(result >= auv)
result_good = 1;
}
else
{
if
(auv >= buv) {
result = auv - buv;
if
(result <= auv)
result_good = 1;
}
else
{
result = buv - auv;
if
(result <= buv) {
auvok = !auvok;
result_good = 1;
}
}
}
if
(result_good) {
if
(auvok)
TARGu(result, 1);
else
{
if
(result <= (UV)IV_MIN)
TARGi(result == (UV)IV_MIN
? IV_MIN : -(IV)result,
1);
else
{
TARGn(-(NV)result, 1);
}
}
goto
ret;
}
}
}
#else
useleft = USE_LEFT(svl);
#endif
{
NV value = SvNV_nomg(svr);
if
(!useleft) {
TARGn(-value, 1);
goto
ret;
}
TARGn(SvNV_nomg(svl) - value, 1);
goto
ret;
}
ret:
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
#define IV_BITS (IVSIZE * 8)
static
int
S_shift_amount(pTHX_ SV *
const
svr)
{
const
IV iv = SvIV_nomg(svr);
if
(SvIsUV(svr))
return
SvUVX(svr) > IV_BITS ? IV_BITS : (
int
)SvUVX(svr);
return
iv < -IV_BITS ? -IV_BITS : iv > IV_BITS ? IV_BITS : (
int
)iv;
}
static
UV S_uv_shift(UV uv,
int
shift,
bool
left)
{
if
(shift < 0) {
shift = -shift;
left = !left;
}
if
(UNLIKELY(shift >= IV_BITS)) {
return
0;
}
return
left ? uv << shift : uv >> shift;
}
static
IV S_iv_shift(IV iv,
int
shift,
bool
left)
{
if
(shift < 0) {
shift = -shift;
left = !left;
}
if
(UNLIKELY(shift >= IV_BITS)) {
return
iv < 0 && !left ? -1 : 0;
}
if
(left) {
return
(IV) (((UV) iv) << shift);
}
return
iv >> shift;
}
#define UV_LEFT_SHIFT(uv, shift) S_uv_shift(uv, shift, TRUE)
#define UV_RIGHT_SHIFT(uv, shift) S_uv_shift(uv, shift, FALSE)
#define IV_LEFT_SHIFT(iv, shift) S_iv_shift(iv, shift, TRUE)
#define IV_RIGHT_SHIFT(iv, shift) S_iv_shift(iv, shift, FALSE)
PP(pp_left_shift)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(lshift_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
SV *svr = PL_stack_sp[0];
SV *svl = PL_stack_sp[-1];
{
const
int
shift = S_shift_amount(aTHX_ svr);
if
(PL_op->op_private & OPpUSEINT) {
TARGi(IV_LEFT_SHIFT(SvIV_nomg(svl), shift), 1);
}
else
{
TARGu(UV_LEFT_SHIFT(SvUV_nomg(svl), shift), 1);
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
}
PP(pp_right_shift)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(rshift_amg, AMGf_assign|AMGf_numeric))
return
NORMAL;
SV *svr = PL_stack_sp[0];
SV *svl = PL_stack_sp[-1];
{
const
int
shift = S_shift_amount(aTHX_ svr);
if
(PL_op->op_private & OPpUSEINT) {
TARGi(IV_RIGHT_SHIFT(SvIV_nomg(svl), shift), 1);
}
else
{
TARGu(UV_RIGHT_SHIFT(SvUV_nomg(svl), shift), 1);
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
}
PP(pp_lt)
{
if
(rpp_try_AMAGIC_2(lt_amg, AMGf_numeric))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
U32 flags_and = SvFLAGS(left) & SvFLAGS(right);
U32 flags_or = SvFLAGS(left) | SvFLAGS(right);
rpp_replace_2_IMM_NN(boolSV(
( (flags_and & SVf_IOK) && ((flags_or & SVf_IVisUV) ==0 ) )
? (SvIVX(left) < SvIVX(right))
: (flags_and & SVf_NOK)
? (SvNVX(left) < SvNVX(right))
: (do_ncmp(left, right) == -1)
));
return
NORMAL;
}
PP(pp_gt)
{
if
(rpp_try_AMAGIC_2(gt_amg, AMGf_numeric))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
U32 flags_and = SvFLAGS(left) & SvFLAGS(right);
U32 flags_or = SvFLAGS(left) | SvFLAGS(right);
rpp_replace_2_IMM_NN(boolSV(
( (flags_and & SVf_IOK) && ((flags_or & SVf_IVisUV) ==0 ) )
? (SvIVX(left) > SvIVX(right))
: (flags_and & SVf_NOK)
? (SvNVX(left) > SvNVX(right))
: (do_ncmp(left, right) == 1)
));
return
NORMAL;
}
PP(pp_le)
{
if
(rpp_try_AMAGIC_2(le_amg, AMGf_numeric))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
U32 flags_and = SvFLAGS(left) & SvFLAGS(right);
U32 flags_or = SvFLAGS(left) | SvFLAGS(right);
rpp_replace_2_IMM_NN(boolSV(
( (flags_and & SVf_IOK) && ((flags_or & SVf_IVisUV) ==0 ) )
? (SvIVX(left) <= SvIVX(right))
: (flags_and & SVf_NOK)
? (SvNVX(left) <= SvNVX(right))
: (do_ncmp(left, right) <= 0)
));
return
NORMAL;
}
PP(pp_ge)
{
if
(rpp_try_AMAGIC_2(ge_amg, AMGf_numeric))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
U32 flags_and = SvFLAGS(left) & SvFLAGS(right);
U32 flags_or = SvFLAGS(left) | SvFLAGS(right);
rpp_replace_2_IMM_NN(boolSV(
( (flags_and & SVf_IOK) && ((flags_or & SVf_IVisUV) ==0 ) )
? (SvIVX(left) >= SvIVX(right))
: (flags_and & SVf_NOK)
? (SvNVX(left) >= SvNVX(right))
: ( (do_ncmp(left, right) & 2) == 0)
));
return
NORMAL;
}
PP(pp_ne)
{
if
(rpp_try_AMAGIC_2(ne_amg, AMGf_numeric))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
U32 flags_and = SvFLAGS(left) & SvFLAGS(right);
U32 flags_or = SvFLAGS(left) | SvFLAGS(right);
rpp_replace_2_IMM_NN(boolSV(
( (flags_and & SVf_IOK) && ((flags_or & SVf_IVisUV) ==0 ) )
? (SvIVX(left) != SvIVX(right))
: (flags_and & SVf_NOK)
? (SvNVX(left) != SvNVX(right))
: (do_ncmp(left, right) != 0)
));
return
NORMAL;
}
I32
Perl_do_ncmp(pTHX_ SV*
const
left, SV *
const
right)
{
PERL_ARGS_ASSERT_DO_NCMP;
#ifdef PERL_PRESERVE_IVUV
if
(SvIV_please_nomg(right) && SvIV_please_nomg(left)) {
if
(!SvUOK(left)) {
const
IV leftiv = SvIVX(left);
if
(!SvUOK(right)) {
const
IV rightiv = SvIVX(right);
return
(leftiv > rightiv) - (leftiv < rightiv);
}
if
(leftiv < 0)
return
-1;
{
const
UV rightuv = SvUVX(right);
return
((UV)leftiv > rightuv) - ((UV)leftiv < rightuv);
}
}
if
(SvUOK(right)) {
const
UV leftuv = SvUVX(left);
const
UV rightuv = SvUVX(right);
return
(leftuv > rightuv) - (leftuv < rightuv);
}
{
const
IV rightiv = SvIVX(right);
if
(rightiv < 0)
return
1;
{
const
UV leftuv = SvUVX(left);
return
(leftuv > (UV)rightiv) - (leftuv < (UV)rightiv);
}
}
NOT_REACHED;
}
#endif
{
NV
const
rnv = SvNV_nomg(right);
NV
const
lnv = SvNV_nomg(left);
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
if
(Perl_isnan(lnv) || Perl_isnan(rnv)) {
return
2;
}
return
(lnv > rnv) - (lnv < rnv);
#else
if
(lnv < rnv)
return
-1;
if
(lnv > rnv)
return
1;
if
(lnv == rnv)
return
0;
return
2;
#endif
}
}
PP(pp_ncmp)
{
if
(rpp_try_AMAGIC_2(ncmp_amg, AMGf_numeric))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
SV *targ;
I32 value = do_ncmp(left, right);
if
(value == 2) {
targ = &PL_sv_undef;
}
else
{
GETTARGET;
TARGi(value, 1);
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_sle)
{
int
amg_type = sle_amg;
int
multiplier = 1;
int
rhs = 1;
switch
(PL_op->op_type) {
case
OP_SLT:
amg_type = slt_amg;
rhs = 0;
break
;
case
OP_SGT:
amg_type = sgt_amg;
multiplier = -1;
rhs = 0;
break
;
case
OP_SGE:
amg_type = sge_amg;
multiplier = -1;
break
;
}
if
(rpp_try_AMAGIC_2(amg_type, 0))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
const
int
cmp =
#ifdef USE_LOCALE_COLLATE
(IN_LC_RUNTIME(LC_COLLATE))
? sv_cmp_locale_flags(left, right, 0)
:
#endif
sv_cmp_flags(left, right, 0);
rpp_replace_2_IMM_NN(boolSV(cmp * multiplier < rhs));
return
NORMAL;
}
PP(pp_seq)
{
if
(rpp_try_AMAGIC_2(seq_amg, 0))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
rpp_replace_2_IMM_NN(boolSV(sv_eq_flags(left, right, 0)));;
return
NORMAL;
}
PP(pp_sne)
{
if
(rpp_try_AMAGIC_2(sne_amg, 0))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
rpp_replace_2_IMM_NN(boolSV(!sv_eq_flags(left, right, 0)));
return
NORMAL;
}
PP(pp_scmp)
{
dTARGET;
if
(rpp_try_AMAGIC_2(scmp_amg, 0))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
const
int
cmp =
#ifdef USE_LOCALE_COLLATE
(IN_LC_RUNTIME(LC_COLLATE))
? sv_cmp_locale_flags(left, right, 0)
:
#endif
sv_cmp_flags(left, right, 0);
TARGi(cmp, 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_bit_and)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(band_amg, AMGf_assign))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
{
if
(SvNIOKp(left) || SvNIOKp(right)) {
const
bool
left_ro_nonnum = !SvNIOKp(left) && SvREADONLY(left);
const
bool
right_ro_nonnum = !SvNIOKp(right) && SvREADONLY(right);
if
(PL_op->op_private & OPpUSEINT) {
const
IV i = SvIV_nomg(left) & SvIV_nomg(right);
TARGi(i, 1);
}
else
{
const
UV u = SvUV_nomg(left) & SvUV_nomg(right);
TARGu(u, 1);
}
if
(left_ro_nonnum && left != TARG) SvNIOK_off(left);
if
(right_ro_nonnum) SvNIOK_off(right);
}
else
{
do_vop(PL_op->op_type, TARG, left, right);
SvSETMAGIC(targ);
}
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_nbit_and)
{
if
(rpp_try_AMAGIC_2(band_amg, AMGf_assign|AMGf_numarg))
return
NORMAL;
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
{
if
(PL_op->op_private & OPpUSEINT) {
const
IV i = SvIV_nomg(left) & SvIV_nomg(right);
TARGi(i, 1);
}
else
{
const
UV u = SvUV_nomg(left) & SvUV_nomg(right);
TARGu(u, 1);
}
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_sbit_and)
{
if
(rpp_try_AMAGIC_2(sband_amg, AMGf_assign))
return
NORMAL;
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
do_vop(OP_BIT_AND, targ, left, right);
SvSETMAGIC(targ);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_bit_or)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
const
int
op_type = PL_op->op_type;
if
(rpp_try_AMAGIC_2((op_type == OP_BIT_OR ? bor_amg : bxor_amg),
AMGf_assign))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
{
if
(SvNIOKp(left) || SvNIOKp(right)) {
const
bool
left_ro_nonnum = !SvNIOKp(left) && SvREADONLY(left);
const
bool
right_ro_nonnum = !SvNIOKp(right) && SvREADONLY(right);
if
(PL_op->op_private & OPpUSEINT) {
const
IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
const
IV r = SvIV_nomg(right);
const
IV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
TARGi(result, 1);
}
else
{
const
UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0);
const
UV r = SvUV_nomg(right);
const
UV result = op_type == OP_BIT_OR ? (l | r) : (l ^ r);
TARGu(result, 1);
}
if
(left_ro_nonnum && left != TARG) SvNIOK_off(left);
if
(right_ro_nonnum) SvNIOK_off(right);
}
else
{
do_vop(op_type, TARG, left, right);
SvSETMAGIC(targ);
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
}
PP(pp_nbit_or)
{
const
int
op_type = PL_op->op_type;
if
(rpp_try_AMAGIC_2((op_type == OP_NBIT_OR ? bor_amg : bxor_amg),
AMGf_assign|AMGf_numarg))
return
NORMAL;
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
{
if
(PL_op->op_private & OPpUSEINT) {
const
IV l = (USE_LEFT(left) ? SvIV_nomg(left) : 0);
const
IV r = SvIV_nomg(right);
const
IV result = op_type == OP_NBIT_OR ? (l | r) : (l ^ r);
TARGi(result, 1);
}
else
{
const
UV l = (USE_LEFT(left) ? SvUV_nomg(left) : 0);
const
UV r = SvUV_nomg(right);
const
UV result = op_type == OP_NBIT_OR ? (l | r) : (l ^ r);
TARGu(result, 1);
}
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_sbit_or)
{
const
int
op_type = PL_op->op_type;
if
(rpp_try_AMAGIC_2((op_type == OP_SBIT_OR ? sbor_amg : sbxor_amg),
AMGf_assign))
return
NORMAL;
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
do_vop(op_type == OP_SBIT_OR ? OP_BIT_OR : OP_BIT_XOR, targ,
left, right);
SvSETMAGIC(TARG);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PERL_STATIC_INLINE
bool
S_negate_string(pTHX)
{
dTARGET;
STRLEN len;
const
char
*s;
SV *
const
sv = *PL_stack_sp;
assert
(SvPOKp(sv));
if
(SvNIOK(sv) || (!SvPOK(sv) && SvNIOKp(sv)))
return
FALSE;
s = SvPV_nomg_const(sv, len);
if
(isIDFIRST(*s)) {
if
(LIKELY(TARG!=sv)) {
sv_setpvs(TARG,
"-"
);
sv_catsv(TARG, sv);
}
else
{
sv_insert_flags(TARG, 0, 0,
"-"
, 1, 0);
}
}
else
if
(*s ==
'+'
|| (*s ==
'-'
&& !looks_like_number(sv))) {
sv_setsv_nomg(TARG, sv);
*SvPV_force_nomg(TARG, len) = *s ==
'-'
?
'+'
:
'-'
;
}
else
return
FALSE;
SvSETMAGIC(TARG);
if
(LIKELY(targ != sv))
rpp_replace_1_1_NN(TARG);
return
TRUE;
}
PP(pp_negate)
{
dTARGET;
if
(rpp_try_AMAGIC_1(neg_amg, AMGf_numeric))
return
NORMAL;
SV *
const
sv = *PL_stack_sp;
if
(SvPOKp(sv) && S_negate_string(aTHX))
return
NORMAL;
{
if
(SvIOK(sv)) {
oops_its_an_int:
if
(SvIsUV(sv)) {
if
(SvIVX(sv) == IV_MIN) {
TARGi(SvIVX(sv), 1);
goto
ret;
}
else
if
(SvUVX(sv) <= IV_MAX) {
TARGi(-SvIVX(sv), 1);
goto
ret;
}
}
else
if
(SvIVX(sv) != IV_MIN) {
TARGi(-SvIVX(sv), 1);
goto
ret;
}
#ifdef PERL_PRESERVE_IVUV
else
{
TARGu((UV)IV_MIN, 1);
goto
ret;
}
#endif
}
if
(SvNIOKp(sv) && (SvNIOK(sv) || !SvPOK(sv)))
TARGn(-SvNV_nomg(sv), 1);
else
if
(SvPOKp(sv) && SvIV_please_nomg(sv))
goto
oops_its_an_int;
else
TARGn(-SvNV_nomg(sv), 1);
}
ret:
if
(LIKELY(targ != sv))
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_not)
{
if
(rpp_try_AMAGIC_1(not_amg, 0))
return
NORMAL;
rpp_replace_1_IMM_NN(boolSV(!SvTRUE_nomg_NN(*PL_stack_sp)));
return
NORMAL;
}
static
void
S_scomplement(pTHX_ SV *targ, SV *sv)
{
U8 *tmps;
SSize_t anum;
STRLEN len;
sv_copypv_nomg(TARG, sv);
tmps = (U8*)SvPV_nomg(TARG, len);
if
(SvUTF8(TARG)) {
if
(len && ! utf8_to_bytes(tmps, &len)) {
Perl_croak(aTHX_ FATAL_ABOVE_FF_MSG, PL_op_desc[PL_op->op_type]);
}
SvCUR_set(TARG, len);
SvUTF8_off(TARG);
}
anum = len;
{
long
*tmpl;
for
( ; anum && PTR2nat(tmps) %
sizeof
(
long
); anum--, tmps++)
*tmps = ~*tmps;
tmpl = (
long
*)tmps;
for
( ; anum >= (SSize_t)
sizeof
(
long
); anum -= (SSize_t)
sizeof
(
long
), tmpl++)
*tmpl = ~*tmpl;
tmps = (U8*)tmpl;
}
for
( ; anum > 0; anum--, tmps++)
*tmps = ~*tmps;
}
PP(pp_complement)
{
dTARGET;
if
(rpp_try_AMAGIC_1(compl_amg, AMGf_numeric))
return
NORMAL;
{
SV *sv = *PL_stack_sp;
if
(SvNIOKp(sv)) {
if
(PL_op->op_private & OPpUSEINT) {
const
IV i = ~SvIV_nomg(sv);
TARGi(i, 1);
}
else
{
const
UV u = ~SvUV_nomg(sv);
TARGu(u, 1);
}
}
else
{
S_scomplement(aTHX_ TARG, sv);
SvSETMAGIC(TARG);
}
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
}
PP(pp_ncomplement)
{
if
(rpp_try_AMAGIC_1(compl_amg, AMGf_numeric|AMGf_numarg))
return
NORMAL;
dTARGET;
{
SV *sv = *PL_stack_sp;
if
(PL_op->op_private & OPpUSEINT) {
const
IV i = ~SvIV_nomg(sv);
TARGi(i, 1);
}
else
{
const
UV u = ~SvUV_nomg(sv);
TARGu(u, 1);
}
}
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_scomplement)
{
if
(rpp_try_AMAGIC_1(scompl_amg, AMGf_numeric))
return
NORMAL;
dTARGET;
SV *sv = *PL_stack_sp;
S_scomplement(aTHX_ TARG, sv);
SvSETMAGIC(TARG);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_i_multiply)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(mult_amg, AMGf_assign))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
TARGi((IV)((UV)left * (UV)right), 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_i_divide)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(div_amg, AMGf_assign))
return
NORMAL;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
{
IV value = SvIV_nomg(right);
if
(value == 0)
DIE(aTHX_
"Illegal division by zero"
);
IV num = SvIV_nomg(left);
if
(value == -1)
value = (IV)-(UV)num;
else
value = num / value;
TARGi(value, 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
}
PP(pp_i_modulo)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(modulo_amg, AMGf_assign))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
{
if
(!right)
DIE(aTHX_
"Illegal modulus zero"
);
if
(right == -1)
TARGi(0, 1);
else
TARGi(left % right, 1);
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_i_add)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(add_amg, AMGf_assign))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
SV *leftsv = PL_stack_sp[-1];
IV left = USE_LEFT(leftsv) ? SvIV_nomg(leftsv) : 0;
TARGi((IV)((UV)left + (UV)right), 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_i_subtract)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
if
(rpp_try_AMAGIC_2(subtr_amg, AMGf_assign))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
SV *leftsv = PL_stack_sp[-1];
IV left = USE_LEFT(leftsv) ? SvIV_nomg(leftsv) : 0;
TARGi((IV)((UV)left - (UV)right), 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_i_lt)
{
if
(rpp_try_AMAGIC_2(lt_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
rpp_replace_2_IMM_NN(boolSV(left < right));
return
NORMAL;
}
PP(pp_i_gt)
{
if
(rpp_try_AMAGIC_2(gt_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
rpp_replace_2_IMM_NN(boolSV(left > right));
return
NORMAL;
}
PP(pp_i_le)
{
if
(rpp_try_AMAGIC_2(le_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
rpp_replace_2_IMM_NN(boolSV(left <= right));
return
NORMAL;
}
PP(pp_i_ge)
{
if
(rpp_try_AMAGIC_2(ge_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
rpp_replace_2_IMM_NN(boolSV(left >= right));
return
NORMAL;
}
PP(pp_i_eq)
{
if
(rpp_try_AMAGIC_2(eq_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
rpp_replace_2_IMM_NN(boolSV(left == right));
return
NORMAL;
}
PP(pp_i_ne)
{
if
(rpp_try_AMAGIC_2(ne_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
rpp_replace_2_IMM_NN(boolSV(left != right));
return
NORMAL;
}
PP(pp_i_ncmp)
{
dTARGET;
if
(rpp_try_AMAGIC_2(ncmp_amg, 0))
return
NORMAL;
IV right = SvIV_nomg(PL_stack_sp[0]);
IV left = SvIV_nomg(PL_stack_sp[-1]);
{
I32 value;
if
(left > right)
value = 1;
else
if
(left < right)
value = -1;
else
value = 0;
TARGi(value, 1);
}
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_i_negate)
{
dTARGET;
if
(rpp_try_AMAGIC_1(neg_amg, 0))
return
NORMAL;
SV *
const
sv = *PL_stack_sp;
if
(SvPOKp(sv) && S_negate_string(aTHX))
return
NORMAL;
{
IV
const
i = SvIV_nomg(sv);
TARGi((IV)-(UV)i, 1);
if
(LIKELY(targ != sv))
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
}
PP(pp_atan2)
{
dTARGET;
if
(rpp_try_AMAGIC_2(atan2_amg, 0))
return
NORMAL;
NV right = SvNV_nomg(PL_stack_sp[0]);
NV left = SvNV_nomg(PL_stack_sp[-1]);
TARGn(Perl_atan2(left, right), 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_sin)
{
dTARGET;
int
amg_type = fallback_amg;
const
char
*neg_report = NULL;
const
int
op_type = PL_op->op_type;
switch
(op_type) {
case
OP_SIN: amg_type = sin_amg;
break
;
case
OP_COS: amg_type = cos_amg;
break
;
case
OP_EXP: amg_type = exp_amg;
break
;
case
OP_LOG: amg_type = log_amg; neg_report =
"log"
;
break
;
case
OP_SQRT: amg_type = sqrt_amg; neg_report =
"sqrt"
;
break
;
}
assert
(amg_type != fallback_amg);
if
(rpp_try_AMAGIC_1(amg_type, 0))
return
NORMAL;
{
SV *
const
arg = *PL_stack_sp;
const
NV value = SvNV_nomg(arg);
#ifdef NV_NAN
NV result = NV_NAN;
#else
NV result = 0.0;
#endif
if
(neg_report) {
if
(
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
! Perl_isnan(value) &&
#endif
(op_type == OP_LOG ? (value <= 0.0) : (value < 0.0)))
{
char
* mesg;
LC_NUMERIC_LOCK(0);
SET_NUMERIC_STANDARD();
mesg = Perl_form(aTHX_
"Can't take %s of %"
NVgf, neg_report, value);
LC_NUMERIC_UNLOCK;
DIE(aTHX_
"%s"
, mesg);
}
}
switch
(op_type) {
default
:
case
OP_SIN: result = Perl_sin(value);
break
;
case
OP_COS: result = Perl_cos(value);
break
;
case
OP_EXP: result = Perl_exp(value);
break
;
case
OP_LOG: result = Perl_log(value);
break
;
case
OP_SQRT: result = Perl_sqrt(value);
break
;
}
TARGn(result, 1);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
}
PP_wrapped(pp_rand, MAXARG, 0)
{
if
(!PL_srand_called) {
Rand_seed_t s;
if
(PL_srand_override) {
PERL_SRAND_OVERRIDE_GET(s);
}
else
{
s= (Rand_seed_t)seed();
}
(
void
)seedDrand01(s);
PL_srand_called = TRUE;
}
{
dSP;
NV value;
if
(MAXARG < 1)
{
EXTEND(SP, 1);
value = 1.0;
}
else
{
SV *
const
sv = POPs;
if
(!sv)
value = 1.0;
else
value = SvNV(sv);
}
#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
if
(! Perl_isnan(value) && value == 0.0)
#else
if
(value == 0.0)
#endif
value = 1.0;
{
dTARGET;
PUSHs(TARG);
PUTBACK;
value *= Drand01();
sv_setnv_mg(TARG, value);
}
}
return
NORMAL;
}
PP_wrapped(pp_srand, MAXARG, 0)
{
dSP; dTARGET;
UV anum;
if
(MAXARG >= 1 && (TOPs || POPs)) {
SV *top;
char
*pv;
STRLEN len;
int
flags;
top = POPs;
pv = SvPV(top, len);
flags = grok_number(pv, len, &anum);
if
(!(flags & IS_NUMBER_IN_UV)) {
Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
"Integer overflow in srand"
);
anum = UV_MAX;
}
}
else
{
if
(PL_srand_override) {
PERL_SRAND_OVERRIDE_GET(anum);
}
else
{
anum = seed();
}
}
(
void
)seedDrand01((Rand_seed_t)anum);
PL_srand_called = TRUE;
if
(anum)
XPUSHu(anum);
else
{
sv_setpvs(TARG,
"0 but true"
);
XPUSHTARG;
}
RETURN;
}
PP(pp_int)
{
dTARGET;
if
(rpp_try_AMAGIC_1(int_amg, AMGf_numeric))
return
NORMAL;
{
SV *
const
sv = *PL_stack_sp;
const
IV iv = SvIV_nomg(sv);
if
(!SvOK(sv)) {
TARGu(0, 1);
}
else
if
(SvIOK(sv)) {
if
(SvIsUV(sv))
TARGu(SvUV_nomg(sv), 1);
else
TARGi(iv, 1);
}
else
{
const
NV value = SvNV_nomg(sv);
if
(UNLIKELY(Perl_isinfnan(value)))
TARGn(value, 1);
else
if
(value >= 0.0) {
if
(value < (NV)UV_MAX + 0.5) {
TARGu(U_V(value), 1);
}
else
{
TARGn(Perl_floor(value), 1);
}
}
else
{
if
(value > (NV)IV_MIN - 0.5) {
TARGi(I_V(value), 1);
}
else
{
TARGn(Perl_ceil(value), 1);
}
}
}
}
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_abs)
{
dTARGET;
if
(rpp_try_AMAGIC_1(abs_amg, AMGf_numeric))
return
NORMAL;
{
SV *
const
sv = *PL_stack_sp;
const
IV iv = SvIV_nomg(sv);
UV uv;
if
(!SvOK(sv)) {
uv = 0;
goto
set_uv;
}
else
if
(SvIOK(sv)) {
if
(SvIsUV(sv)) {
uv = SvUVX(sv);
}
else
{
if
(iv >= 0) {
uv = (UV)iv;
}
else
{
uv = (UV)-(iv + 1) + 1;
}
}
set_uv:
TARGu(uv, 1);
}
else
{
const
NV value = SvNV_nomg(sv);
TARGn(Perl_fabs(value), 1);
}
}
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_oct)
{
dTARGET;
const
char
*tmps;
I32 flags = PERL_SCAN_ALLOW_UNDERSCORES;
STRLEN len;
NV result_nv;
UV result_uv;
SV*
const
sv = *PL_stack_sp;
tmps = (SvPV_const(sv, len));
if
(DO_UTF8(sv)) {
SV*
const
tsv = sv_2mortal(newSVsv(sv));
SvUTF8_on(tsv);
(
void
)sv_utf8_downgrade(tsv, FALSE);
tmps = SvPV_const(tsv, len);
}
if
(PL_op->op_type == OP_HEX)
goto
hex;
while
(*tmps && len && isSPACE(*tmps))
tmps++, len--;
if
(*tmps ==
'0'
)
tmps++, len--;
if
(isALPHA_FOLD_EQ(*tmps,
'x'
)) {
tmps++, len--;
flags |= PERL_SCAN_DISALLOW_PREFIX;
hex:
result_uv = grok_hex (tmps, &len, &flags, &result_nv);
}
else
if
(isALPHA_FOLD_EQ(*tmps,
'b'
)) {
tmps++, len--;
flags |= PERL_SCAN_DISALLOW_PREFIX;
result_uv = grok_bin (tmps, &len, &flags, &result_nv);
}
else
{
if
(isALPHA_FOLD_EQ(*tmps,
'o'
)) {
tmps++, len--;
}
result_uv = grok_oct (tmps, &len, &flags, &result_nv);
}
if
(flags & PERL_SCAN_GREATER_THAN_UV_MAX) {
TARGn(result_nv, 1);
}
else
{
TARGu(result_uv, 1);
}
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_length)
{
dTARGET;
SV *
const
sv = *PL_stack_sp;
U32 in_bytes = IN_BYTES;
U32 svflags = (SvFLAGS(sv) ^ (in_bytes << 26)) & (SVf_POK|SVs_GMG|SVf_UTF8);
STATIC_ASSERT_STMT(SVf_UTF8 == (HINT_BYTES << 26));
if
(LIKELY(svflags == SVf_POK))
goto
simple_pv;
if
(svflags & SVs_GMG)
mg_get(sv);
if
(SvOK(sv)) {
STRLEN len;
if
(!IN_BYTES) {
if
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == SVf_POK)
goto
simple_pv;
if
( SvPOK(sv) && (PL_op->op_private & OPpTRUEBOOL)) {
len = SvCUR(sv);
goto
return_bool;
}
len = sv_len_utf8_nomg(sv);
}
else
{
if
(SvPOK_nog(sv)) {
simple_pv:
len = SvCUR(sv);
if
(PL_op->op_private & OPpTRUEBOOL) {
return_bool:
rpp_replace_1_IMM_NN(len ? &PL_sv_yes : &PL_sv_zero);
return
NORMAL;
}
}
else
{
(
void
)sv_2pv_flags(sv, &len, 0|SV_CONST_RETURN);
}
}
TARGi((IV)(len), 1);
}
else
{
if
(!SvPADTMP(TARG)) {
sv_set_undef(TARG);
SvSETMAGIC(TARG);
}
else
targ = &PL_sv_undef;
}
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
bool
Perl_translate_substr_offsets( STRLEN curlen, IV pos1_iv,
bool
pos1_is_uv, IV len_iv,
bool
len_is_uv, STRLEN *posp,
STRLEN *lenp)
{
IV pos2_iv;
int
pos2_is_uv;
PERL_ARGS_ASSERT_TRANSLATE_SUBSTR_OFFSETS;
if
(!pos1_is_uv && pos1_iv < 0 && curlen) {
pos1_is_uv = curlen-1 > ~(UV)pos1_iv;
pos1_iv += curlen;
}
if
((pos1_is_uv || pos1_iv > 0) && (UV)pos1_iv > curlen)
return
FALSE;
if
(len_iv || len_is_uv) {
if
(!len_is_uv && len_iv < 0) {
pos2_iv = curlen + len_iv;
if
(curlen)
pos2_is_uv = curlen-1 > ~(UV)len_iv;
else
pos2_is_uv = 0;
}
else
{
if
(!pos1_is_uv && pos1_iv < 0) {
pos2_iv = pos1_iv + len_iv;
pos2_is_uv = (UV)len_iv > (UV)IV_MAX;
}
else
{
if
((UV)len_iv > curlen-(UV)pos1_iv)
pos2_iv = curlen;
else
pos2_iv = pos1_iv+len_iv;
pos2_is_uv = 1;
}
}
}
else
{
pos2_iv = curlen;
pos2_is_uv = 1;
}
if
(!pos2_is_uv && pos2_iv < 0) {
if
(!pos1_is_uv && pos1_iv < 0)
return
FALSE;
pos2_iv = 0;
}
else
if
(!pos1_is_uv && pos1_iv < 0)
pos1_iv = 0;
if
((UV)pos2_iv < (UV)pos1_iv)
pos2_iv = pos1_iv;
if
((UV)pos2_iv > curlen)
pos2_iv = curlen;
*posp = (STRLEN)( (UV)pos1_iv );
*lenp = (STRLEN)( (UV)pos2_iv - (UV)pos1_iv );
return
TRUE;
}
PP_wrapped(pp_substr,
(PL_op->op_private & 7)
+ ((PL_op->op_private & OPpSUBSTR_REPL_FIRST) ? 1 : 0),
0)
{
dSP; dTARGET;
SV *sv;
STRLEN curlen;
STRLEN utf8_curlen;
SV * pos_sv;
IV pos1_iv;
int
pos1_is_uv;
SV * len_sv;
IV len_iv = 0;
int
len_is_uv = 0;
I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
const
bool
rvalue = (GIMME_V != G_VOID);
const
char
*tmps;
SV *repl_sv = NULL;
const
char
*repl = NULL;
STRLEN repl_len;
int
num_args = PL_op->op_private & 7;
bool
repl_need_utf8_upgrade = FALSE;
if
(num_args > 2) {
if
(num_args > 3) {
if
(!(repl_sv = POPs)) num_args--;
}
if
((len_sv = POPs)) {
len_iv = SvIV(len_sv);
len_is_uv = len_iv ? SvIOK_UV(len_sv) : 1;
}
else
num_args--;
}
pos_sv = POPs;
pos1_iv = SvIV(pos_sv);
pos1_is_uv = SvIOK_UV(pos_sv);
sv = POPs;
if
(PL_op->op_private & OPpSUBSTR_REPL_FIRST) {
assert
(!repl_sv);
repl_sv = POPs;
}
if
(lvalue && !repl_sv) {
SV * ret;
ret = newSV_type_mortal(SVt_PVLV);
sv_magic(ret, NULL, PERL_MAGIC_substr, NULL, 0);
LvTYPE(ret) =
'x'
;
LvTARG(ret) = SvREFCNT_inc_simple(sv);
LvTARGOFF(ret) =
pos1_is_uv || pos1_iv >= 0
? (STRLEN)(UV)pos1_iv
: (LvFLAGS(ret) |= LVf_NEG_OFF, (STRLEN)(UV)-pos1_iv);
LvTARGLEN(ret) =
len_is_uv || len_iv > 0
? (STRLEN)(UV)len_iv
: (LvFLAGS(ret) |= LVf_NEG_LEN, (STRLEN)(UV)-len_iv);
PUSHs(ret);
RETURN;
}
if
(repl_sv) {
repl = SvPV_const(repl_sv, repl_len);
SvGETMAGIC(sv);
if
(SvROK(sv))
Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
"Attempt to use reference as lvalue in substr"
);
tmps = SvPV_force_nomg(sv, curlen);
if
(DO_UTF8(repl_sv) && repl_len) {
if
(!DO_UTF8(sv)) {
sv_utf8_upgrade_nomg(sv);
tmps = SvPV_nomg(sv, curlen);
}
}
else
if
(DO_UTF8(sv))
repl_need_utf8_upgrade = TRUE;
}
else
tmps = SvPV_const(sv, curlen);
if
(DO_UTF8(sv)) {
utf8_curlen = sv_or_pv_len_utf8(sv, tmps, curlen);
if
(utf8_curlen == curlen)
utf8_curlen = 0;
else
curlen = utf8_curlen;
}
else
utf8_curlen = 0;
{
STRLEN pos, len, byte_len, byte_pos;
if
(!translate_substr_offsets(
curlen, pos1_iv, pos1_is_uv, len_iv, len_is_uv, &pos, &len
))
goto
bound_fail;
byte_len = len;
byte_pos = utf8_curlen
? sv_or_pv_pos_u2b(sv, tmps, pos, &byte_len) : pos;
tmps += byte_pos;
if
(rvalue) {
SvTAINTED_off(TARG);
SvUTF8_off(TARG);
sv_setpvn(TARG, tmps, byte_len);
#ifdef USE_LOCALE_COLLATE
sv_unmagic(TARG, PERL_MAGIC_collxfrm);
#endif
if
(utf8_curlen)
SvUTF8_on(TARG);
}
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_const(repl_sv_copy, repl_len);
}
if
(!SvOK(sv))
SvPVCLEAR(sv);
sv_insert_flags(sv, byte_pos, byte_len, repl, repl_len, 0);
SvREFCNT_dec(repl_sv_copy);
}
}
if
(PL_op->op_private & OPpSUBSTR_REPL_FIRST)
SP++;
else
if
(rvalue) {
SvSETMAGIC(TARG);
PUSHs(TARG);
}
RETURN;
bound_fail:
if
(repl)
Perl_croak(aTHX_
"substr outside of string"
);
Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR),
"substr outside of string"
);
RETPUSHUNDEF;
}
PP_wrapped(pp_vec, 3, 0)
{
dSP;
const
IV size = POPi;
SV* offsetsv = POPs;
SV *
const
src = POPs;
const
I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
SV * ret;
UV retuv;
STRLEN offset = 0;
char
errflags = 0;
{
IV iv = SvIV(offsetsv);
if
(SvIOK_UV(offsetsv) && SvUVX(offsetsv) > (UV)IV_MAX)
errflags = LVf_OUT_OF_RANGE;
else
if
(iv < 0)
errflags = (LVf_NEG_OFF|LVf_OUT_OF_RANGE);
#if PTRSIZE < IVSIZE
else
if
(iv > Size_t_MAX)
errflags = LVf_OUT_OF_RANGE;
#endif
else
offset = (STRLEN)iv;
}
retuv = errflags ? 0 : do_vecget(src, offset, size);
if
(lvalue) {
ret = newSV_type_mortal(SVt_PVLV);
sv_magic(ret, NULL, PERL_MAGIC_vec, NULL, 0);
LvTYPE(ret) =
'v'
;
LvTARG(ret) = SvREFCNT_inc_simple(src);
LvTARGOFF(ret) = offset;
LvTARGLEN(ret) = size;
LvFLAGS(ret) = errflags;
}
else
{
dTARGET;
SvTAINTED_off(TARG);
ret = TARG;
}
sv_setuv(ret, retuv);
if
(!lvalue)
SvSETMAGIC(ret);
PUSHs(ret);
RETURN;
}
PP(pp_index)
{
SV *targ = (PL_op->op_flags & OPf_STACKED)
? PL_stack_sp[-1]
: PAD_SV(PL_op->op_targ);
SV *big;
SV *little;
SV *temp = NULL;
STRLEN biglen;
STRLEN llen = 0;
SSize_t offset = 0;
SSize_t retval;
const
char
*big_p;
const
char
*little_p;
bool
big_utf8;
bool
little_utf8;
const
bool
is_index = PL_op->op_type == OP_INDEX;
assert
(MAXARG == 2 || MAXARG == 3);
bool
threeargs = (MAXARG == 3);
if
(MAXARG == 3 && !PL_stack_sp[0]) {
PL_stack_sp--;
threeargs = FALSE;
}
if
(threeargs) {
offset = SvIV(*PL_stack_sp);
rpp_popfree_1_NN();
}
little = PL_stack_sp[0];
big = PL_stack_sp[-1];
big_p = SvPV_const(big, biglen);
little_p = SvPV_const(little, llen);
big_utf8 = DO_UTF8(big);
little_utf8 = DO_UTF8(little);
if
(big_utf8 ^ little_utf8) {
if
(little_utf8) {
char
*
const
pv = (
char
*)bytes_from_utf8((U8 *)little_p, &llen,
&little_utf8);
if
(little_utf8) {
retval = -1;
goto
push_result;
}
little = temp = newSV_type(SVt_NULL);
sv_usepvn(temp, pv, llen);
little_p = SvPVX(little);
}
else
{
temp = newSVpvn(little_p, llen);
sv_utf8_upgrade(temp);
little = temp;
little_p = SvPV_const(little, llen);
}
}
if
(SvGAMAGIC(big)) {
big = newSVpvn_flags(big_p, biglen,
SVs_TEMP | (big_utf8 ? SVf_UTF8 : 0));
big_p = SvPVX(big);
}
if
(SvGAMAGIC(little) || (is_index && !SvOK(little))) {
little = newSVpvn_flags(little_p, llen,
SVs_TEMP | (little_utf8 ? SVf_UTF8 : 0));
little_p = SvPVX(little);
}
if
(!threeargs)
offset = is_index ? 0 : biglen;
else
{
if
(big_utf8 && offset > 0)
offset = sv_pos_u2b_flags(big, offset, 0, SV_CONST_RETURN);
if
(!is_index)
offset += llen;
}
if
(offset < 0)
offset = 0;
else
if
(offset > (SSize_t)biglen)
offset = biglen;
if
(!(little_p = is_index
? fbm_instr((unsigned
char
*)big_p + offset,
(unsigned
char
*)big_p + biglen, little, 0)
: rninstr(big_p, big_p + offset,
little_p, little_p + llen)))
retval = -1;
else
{
retval = little_p - big_p;
if
(retval > 1 && big_utf8)
retval = sv_pos_b2u_flags(big, retval, SV_CONST_RETURN);
}
SvREFCNT_dec(temp);
push_result:
if
(PL_op->op_private & OPpTRUEBOOL) {
SV *result = ((retval != -1) ^ cBOOL(PL_op->op_private & OPpINDEX_BOOLNEG))
? &PL_sv_yes : &PL_sv_no;
if
(PL_op->op_private & OPpTARGET_MY)
sv_setsv_mg(targ, result);
else
targ = result;
}
else
TARGi(retval, 1);
rpp_replace_2_1_NN(targ);
return
NORMAL;
}
PP(pp_sprintf)
{
dMARK; dORIGMARK; dTARGET;
SvTAINTED_off(TARG);
do_sprintf(TARG, PL_stack_sp - MARK, MARK + 1);
TAINT_IF(SvTAINTED(TARG));
rpp_popfree_to_NN(ORIGMARK);
SvSETMAGIC(TARG);
rpp_push_1(TARG);
return
NORMAL;
}
PP(pp_ord)
{
dTARGET;
SV *argsv = *PL_stack_sp;
STRLEN len;
const
U8 *s = (U8*)SvPV_const(argsv, len);
TARGu(DO_UTF8(argsv)
? (len ? utf8n_to_uvchr(s, len, 0, UTF8_ALLOW_ANYUV) : 0)
: (UV)(*s),
1);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_chr)
{
dTARGET;
char
*tmps;
UV value;
SV *top = *PL_stack_sp;
SvGETMAGIC(top);
if
(UNLIKELY(SvAMAGIC(top)))
top = sv_2num(top);
if
(UNLIKELY(isinfnansv(top)))
Perl_croak(aTHX_
"Cannot chr %"
NVgf, SvNV(top));
else
{
if
(!IN_BYTES
&& ((SvIOKp(top) && !SvIsUV(top) && SvIV_nomg(top) < 0)
||
((SvNOKp(top) || (SvOK(top) && !SvIsUV(top)))
&& SvNV_nomg(top) < 0.0)))
{
if
(ckWARN(WARN_UTF8)) {
if
(SvGMAGICAL(top)) {
SV *top2 = sv_newmortal();
sv_setsv_nomg(top2, top);
top = top2;
}
Perl_warner(aTHX_ packWARN(WARN_UTF8),
"Invalid negative number (%"
SVf
") in chr"
, SVfARG(top));
}
value = UNICODE_REPLACEMENT;
}
else
{
value = SvUV_nomg(top);
}
}
SvUPGRADE(TARG,SVt_PV);
if
(value > 255 && !IN_BYTES) {
SvGROW(TARG, (STRLEN)UVCHR_SKIP(value)+1);
tmps = (
char
*)uvchr_to_utf8_flags((U8*)SvPVX(TARG), value, 0);
SvCUR_set(TARG, tmps - SvPVX_const(TARG));
*tmps =
'\0'
;
(
void
)SvPOK_only(TARG);
SvUTF8_on(TARG);
goto
ret;
}
SvGROW(TARG,2);
SvCUR_set(TARG, 1);
tmps = SvPVX(TARG);
*tmps++ = (
char
)value;
*tmps =
'\0'
;
(
void
)SvPOK_only(TARG);
ret:
SvSETMAGIC(TARG);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP(pp_crypt)
{
#ifdef HAS_CRYPT
dTARGET;
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
STRLEN len;
const
char
*tmps = SvPV_const(left, len);
if
(DO_UTF8(left)) {
SV*
const
tsv = newSVpvn_flags(tmps, len, SVf_UTF8|SVs_TEMP);
(
void
)sv_utf8_downgrade(tsv, FALSE);
tmps = SvPV_const(tsv, len);
}
# ifdef USE_ITHREADS
# ifdef HAS_CRYPT_R
if
(!PL_reentrant_buffer->_crypt_struct_buffer) {
PL_reentrant_buffer->_crypt_struct_buffer =
(
struct
crypt_data *)safemalloc(
sizeof
(
struct
crypt_data));
# if defined(__GLIBC__) || defined(__EMX__)
if
(PL_reentrant_buffer->_crypt_struct_buffer) {
PL_reentrant_buffer->_crypt_struct_buffer->initialized = 0;
}
# endif
}
# endif /* HAS_CRYPT_R */
# endif /* USE_ITHREADS */
sv_setpv(TARG, PerlProc_crypt(tmps, SvPV_nolen_const(right)));
SvUTF8_off(TARG);
SvSETMAGIC(TARG);
rpp_replace_2_1_NN(targ);
return
NORMAL;
#else
DIE(aTHX_
"The crypt() function is unimplemented due to excessive paranoia."
);
#endif
}
PP_wrapped(pp_ucfirst, 1, 0)
{
dSP;
SV *source = TOPs;
STRLEN slen;
STRLEN need;
SV *dest;
bool
inplace;
bool
doing_utf8 = FALSE;
bool
convert_source_to_utf8 = FALSE;
const
int
op_type = PL_op->op_type;
const
U8 *s;
U8 *d;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
STRLEN ulen;
STRLEN tculen;
bool
remove_dot_above = FALSE;
s = (
const
U8*)SvPV_const(source, slen);
inplace = !SvREADONLY(source) && SvPADTMP(source);
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
CHECK_AND_WARN_PROBLEMATIC_LOCALE_;
}
#endif
if
(! slen) {
need = 1;
ulen = 0;
*tmpbuf =
'\0'
;
}
else
if
(DO_UTF8(source)) {
doing_utf8 = TRUE;
ulen = UTF8SKIP(s);
if
(op_type == OP_UCFIRST) {
#ifdef USE_LOCALE_CTYPE
_toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
#else
_toTITLE_utf8_flags(s, s +slen, tmpbuf, &tculen, 0);
#endif
}
else
{
#ifdef USE_LOCALE_CTYPE
_toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, IN_LC_RUNTIME(LC_CTYPE));
if
( UNLIKELY(IN_UTF8_TURKIC_LOCALE)
&& IN_LC_RUNTIME(LC_CTYPE)
&& (UNLIKELY(*s ==
'I'
&& tmpbuf[0] ==
'i'
)))
{
inplace = FALSE;
if
(LIKELY(memBEGINs(s + 1, s + slen, COMBINING_DOT_ABOVE_UTF8))) {
ulen += 2;
}
else
{
remove_dot_above = TRUE;
}
}
#else
PERL_UNUSED_VAR(remove_dot_above);
_toLOWER_utf8_flags(s, s + slen, tmpbuf, &tculen, 0);
#endif
}
if
(ulen != tculen) inplace = FALSE;
need = slen + 1 - ulen + tculen;
}
else
{
ulen = 1;
tculen = 1;
need = slen + 1;
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
if
( UNLIKELY(IN_UTF8_TURKIC_LOCALE)
&& ( (op_type == OP_LCFIRST && UNLIKELY(*s ==
'I'
))
|| (op_type == OP_UCFIRST && UNLIKELY(*s ==
'i'
))))
{
if
(*s ==
'I'
) {
tmpbuf[0] = UTF8_TWO_BYTE_HI(LATIN_SMALL_LETTER_DOTLESS_I);
tmpbuf[1] = UTF8_TWO_BYTE_LO(LATIN_SMALL_LETTER_DOTLESS_I);
}
else
{
tmpbuf[0] = UTF8_TWO_BYTE_HI(LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE);
tmpbuf[1] = UTF8_TWO_BYTE_LO(LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE);
}
tculen = 2;
inplace = FALSE;
doing_utf8 = TRUE;
convert_source_to_utf8 = TRUE;
need += variant_under_utf8_count(s, s + slen);
}
else
if
(op_type == OP_LCFIRST) {
*tmpbuf = toLOWER_LC(*s);
}
else
{
if
(IN_UTF8_CTYPE_LOCALE) {
goto
do_uni_rules;
}
*tmpbuf = (U8) toUPPER_LC(*s);
}
}
else
#endif
if
(! IN_UNI_8_BIT) {
*tmpbuf = (op_type == OP_LCFIRST)
? toLOWER(*s)
: toUPPER(*s);
}
else
if
(op_type == OP_LCFIRST) {
*tmpbuf = toLOWER_LATIN1(*s);
}
else
{
UV title_ord;
#ifdef USE_LOCALE_CTYPE
do_uni_rules:
#endif
title_ord = _to_upper_title_latin1(*s, tmpbuf, &tculen,
's'
);
if
(tculen > 1) {
assert
(tculen == 2);
if
(UTF8_IS_DOWNGRADEABLE_START(*tmpbuf)) {
*tmpbuf = (U8) title_ord;
tculen = 1;
}
else
{
inplace = FALSE;
if
(title_ord > 255) {
doing_utf8 = TRUE;
convert_source_to_utf8 = TRUE;
need = slen
+ variant_under_utf8_count(s, s + slen)
+ 1;
ulen = 2;
}
else
{
need = slen + 1 + 1;
}
}
}
}
}
if
(inplace) {
dest = source;
s = d = (U8*)SvPV_force_nomg(source, slen);
}
else
{
dTARGET;
dest = TARG;
SvUPGRADE(dest, SVt_PV);
d = (U8*)SvGROW(dest, need);
(
void
)SvPOK_only(dest);
SETs(dest);
}
if
(doing_utf8) {
if
(! inplace) {
if
(! convert_source_to_utf8) {
sv_setpvn(dest, (
char
*)tmpbuf, tculen);
if
(slen > ulen) {
if
(UNLIKELY(remove_dot_above)) {
do
{
Size_t this_len = UTF8SKIP(s + ulen);
sv_catpvn(dest, (
char
*)(s + ulen), this_len);
ulen += this_len;
if
(memBEGINs(s + ulen, s + slen, COMBINING_DOT_ABOVE_UTF8)) {
ulen += 2;
break
;
}
}
while
(s + ulen < s + slen);
}
sv_catpvn(dest, (
char
*)(s + ulen), slen - ulen);
}
}
else
{
const
U8 *
const
send = s + slen;
assert
(tculen == 2);
*d++ = *tmpbuf;
*d++ = *(tmpbuf + 1);
s++;
while
(s < send) {
append_utf8_from_native_byte(*s, &d);
s++;
}
*d =
'\0'
;
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
}
SvUTF8_on(dest);
}
else
{
Copy(tmpbuf, d, tculen, U8);
SvCUR_set(dest, need - 1);
}
}
else
{
if
(slen) {
if
(inplace) {
*d = *tmpbuf;
}
else
{
Copy(tmpbuf, d, tculen, U8);
d += tculen - 1;
}
}
else
{
*d = *s;
}
if
(DO_UTF8(source))
SvUTF8_on(dest);
if
(!inplace) {
Copy(s + 1, d + 1, slen, U8);
SvCUR_set(dest, need - 1);
}
}
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
TAINT;
SvTAINTED_on(dest);
}
#endif
if
(dest != source && SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
return
NORMAL;
}
PP_wrapped(pp_uc, 1, 0)
{
dSP;
SV *source = TOPs;
STRLEN len;
STRLEN min;
SV *dest;
const
U8 *s;
U8 *d;
SvGETMAGIC(source);
if
( SvPADTMP(source)
&& !SvREADONLY(source) && SvPOK(source)
&& !DO_UTF8(source)
&& (
#ifdef USE_LOCALE_CTYPE
(IN_LC_RUNTIME(LC_CTYPE))
? ! IN_UTF8_CTYPE_LOCALE
:
#endif
! IN_UNI_8_BIT))
{
dest = source;
s = d = (U8*)SvPV_force_nomg(source, len);
min = len + 1;
}
else
{
dTARGET;
dest = TARG;
s = (
const
U8*)SvPV_nomg_const(source, len);
min = len + 1;
SvUPGRADE(dest, SVt_PV);
d = (U8*)SvGROW(dest, min);
(
void
)SvPOK_only(dest);
SETs(dest);
}
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
CHECK_AND_WARN_PROBLEMATIC_LOCALE_;
}
#endif
if
(DO_UTF8(source)) {
const
U8 *
const
send = s + len;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
#define GREEK_CAPITAL_LETTER_IOTA 0x0399
#define COMBINING_GREEK_YPOGEGRAMMENI 0x0345
bool
in_iota_subscript = FALSE;
while
(s < send) {
STRLEN u;
STRLEN ulen;
UV uv;
if
(UNLIKELY(in_iota_subscript)) {
UV cp = utf8_to_uvchr_buf(s, send, NULL);
if
(! _invlist_contains_cp(PL_utf8_mark, cp)) {
*d++ = UTF8_TWO_BYTE_HI(GREEK_CAPITAL_LETTER_IOTA);
*d++ = UTF8_TWO_BYTE_LO(GREEK_CAPITAL_LETTER_IOTA);
in_iota_subscript = FALSE;
}
}
u = UTF8SKIP(s);
#ifdef USE_LOCALE_CTYPE
uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
#else
uv = _toUPPER_utf8_flags(s, send, tmpbuf, &ulen, 0);
#endif
if
(uv == GREEK_CAPITAL_LETTER_IOTA
&& utf8_to_uvchr_buf(s, send, 0) == COMBINING_GREEK_YPOGEGRAMMENI)
{
in_iota_subscript = TRUE;
}
else
{
if
(ulen > u && (SvLEN(dest) < (min += ulen - u))) {
const
UV o = d - (U8*)SvPVX_const(dest);
d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
d += ulen;
}
s += u;
}
if
(in_iota_subscript) {
*d++ = UTF8_TWO_BYTE_HI(GREEK_CAPITAL_LETTER_IOTA);
*d++ = UTF8_TWO_BYTE_LO(GREEK_CAPITAL_LETTER_IOTA);
}
SvUTF8_on(dest);
*d =
'\0'
;
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
}
else
{
if
(len) {
const
U8 *
const
send = s + len;
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
if
(IN_UTF8_CTYPE_LOCALE) {
goto
do_uni_rules;
}
for
(; s < send; d++, s++)
*d = (U8) toUPPER_LC(*s);
}
else
#endif
if
(! IN_UNI_8_BIT) {
for
(; s < send; d++, s++) {
*d = toUPPER(*s);
}
}
else
{
#ifdef USE_LOCALE_CTYPE
do_uni_rules:
#endif
for
(; s < send; d++, s++) {
Size_t extra;
*d = toUPPER_LATIN1_MOD(*s);
if
( LIKELY(*d != LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)
#ifdef USE_LOCALE_CTYPE
&& (LIKELY( ! IN_UTF8_TURKIC_LOCALE
|| ! IN_LC_RUNTIME(LC_CTYPE))
|| *s !=
'i'
)
#endif
) {
continue
;
}
#if UNICODE_MAJOR_VERSION > 2 \
|| (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \
&& UNICODE_DOT_DOT_VERSION >= 8)
if
(*s == LATIN_SMALL_LETTER_SHARP_S) {
if
(SvLEN(dest) < ++min) {
const
UV o = d - (U8*)SvPVX_const(dest);
d = o + (U8*) SvGROW(dest, min);
}
*d++ =
'S'
; *d =
'S'
;
continue
;
}
#endif
extra = send - s + variant_under_utf8_count(s, send);
#ifdef USE_LOCALE_CTYPE
if
(UNLIKELY(*s ==
'i'
)) {
const
U8 * s_peek = s;
do
{
extra++;
s_peek = (U8 *)
memchr
(s_peek + 1,
'i'
,
send - (s_peek + 1));
}
while
(s_peek != NULL);
}
#endif
len = d - (U8*)SvPVX_const(dest);
SvCUR_set(dest, len);
len = sv_utf8_upgrade_flags_grow(dest,
SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
extra
+ 1
);
d = (U8*)SvPVX(dest) + len;
#ifdef USE_LOCALE_CTYPE
if
( UNLIKELY(IN_UTF8_TURKIC_LOCALE)
&& UNLIKELY(IN_LC_RUNTIME(LC_CTYPE)))
{
for
(; s < send; s++) {
if
(*s ==
'i'
) {
*d++ = UTF8_TWO_BYTE_HI(LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE);
*d++ = UTF8_TWO_BYTE_LO(LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE);
}
else
{
(
void
) _to_upper_title_latin1(*s, d, &len,
'S'
);
d += len;
}
}
}
else
#endif
for
(; s < send; s++) {
(
void
) _to_upper_title_latin1(*s, d, &len,
'S'
);
d += len;
}
break
;
}
}
}
if
(source != dest) {
*d =
'\0'
;
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
}
}
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
TAINT;
SvTAINTED_on(dest);
}
#endif
if
(dest != source && SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
return
NORMAL;
}
PP_wrapped(pp_lc, 1, 0)
{
dSP;
SV *source = TOPs;
STRLEN len;
STRLEN min;
SV *dest;
const
U8 *s;
U8 *d;
bool
has_turkic_I = FALSE;
SvGETMAGIC(source);
if
( SvPADTMP(source)
&& !SvREADONLY(source) && SvPOK(source)
&& !DO_UTF8(source)
#ifdef USE_LOCALE_CTYPE
&& ( LIKELY(! IN_LC_RUNTIME(LC_CTYPE))
|| LIKELY(! IN_UTF8_TURKIC_LOCALE))
#endif
) {
dest = source;
s = d = (U8*)SvPV_force_nomg(source, len);
min = len + 1;
}
else
{
dTARGET;
dest = TARG;
s = (
const
U8*)SvPV_nomg_const(source, len);
min = len + 1;
SvUPGRADE(dest, SVt_PV);
d = (U8*)SvGROW(dest, min);
(
void
)SvPOK_only(dest);
SETs(dest);
}
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
const
U8 * next_I;
CHECK_AND_WARN_PROBLEMATIC_LOCALE_;
if
( UNLIKELY(IN_UTF8_TURKIC_LOCALE)
&& ! DO_UTF8(source)
&& (next_I = (U8 *)
memchr
(s,
'I'
, len)))
{
Size_t I_count = 0;
const
U8 *
const
send = s + len;
do
{
I_count++;
next_I = (U8 *)
memchr
(next_I + 1,
'I'
,
send - (next_I + 1));
}
while
(next_I != NULL);
sv_utf8_upgrade_flags_grow(dest, 0, len
+ I_count
+ variant_under_utf8_count(s, send)
+ 1
);
d = (U8*)SvPVX(dest);
has_turkic_I = TRUE;
}
}
#else
PERL_UNUSED_VAR(has_turkic_I);
#endif
if
(DO_UTF8(source)) {
const
U8 *
const
send = s + len;
U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
bool
remove_dot_above = FALSE;
while
(s < send) {
const
STRLEN u = UTF8SKIP(s);
STRLEN ulen;
#ifdef USE_LOCALE_CTYPE
_toLOWER_utf8_flags(s, send, tmpbuf, &ulen, IN_LC_RUNTIME(LC_CTYPE));
if
( UNLIKELY(IN_UTF8_TURKIC_LOCALE)
&& IN_LC_RUNTIME(LC_CTYPE))
{
if
( UNLIKELY(remove_dot_above)
&& memBEGINs(tmpbuf,
sizeof
(tmpbuf), COMBINING_DOT_ABOVE_UTF8))
{
s += u;
remove_dot_above = FALSE;
continue
;
}
else
if
(UNLIKELY(*s ==
'I'
&& tmpbuf[0] ==
'i'
)) {
remove_dot_above = TRUE;
}
}
#else
PERL_UNUSED_VAR(remove_dot_above);
_toLOWER_utf8_flags(s, send, tmpbuf, &ulen, 0);
#endif
if
(ulen > u && (SvLEN(dest) < (min += ulen - u))) {
const
UV o = d - (U8*)SvPVX_const(dest);
d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
d += ulen;
s += u;
}
SvUTF8_on(dest);
*d =
'\0'
;
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
}
else
{
if
(len) {
const
U8 *
const
send = s + len;
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
if
(LIKELY( ! has_turkic_I)) {
for
(; s < send; d++, s++)
*d = toLOWER_LC(*s);
}
else
{
for
(; s < send; s++) {
if
(*s ==
'I'
) {
*d++ = UTF8_TWO_BYTE_HI(LATIN_SMALL_LETTER_DOTLESS_I);
*d++ = UTF8_TWO_BYTE_LO(LATIN_SMALL_LETTER_DOTLESS_I);
}
else
{
append_utf8_from_native_byte(toLOWER_LATIN1(*s), &d);
}
}
}
}
else
#endif
if
(! IN_UNI_8_BIT) {
for
(; s < send; d++, s++) {
*d = toLOWER(*s);
}
}
else
{
for
(; s < send; d++, s++) {
*d = toLOWER_LATIN1(*s);
}
}
}
if
(source != dest) {
*d =
'\0'
;
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
}
}
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
TAINT;
SvTAINTED_on(dest);
}
#endif
if
(dest != source && SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
return
NORMAL;
}
PP(pp_quotemeta)
{
dTARGET;
SV *
const
sv = *PL_stack_sp;
STRLEN len;
const
char
*s = SvPV_const(sv,len);
SvUTF8_off(TARG);
if
(len) {
char
*d;
SvUPGRADE(TARG, SVt_PV);
SvGROW(TARG, (len * 2) + 1);
d = SvPVX(TARG);
if
(DO_UTF8(sv)) {
while
(len) {
STRLEN ulen = UTF8SKIP(s);
bool
to_quote = FALSE;
if
(UTF8_IS_INVARIANT(*s)) {
if
(_isQUOTEMETA(*s)) {
to_quote = TRUE;
}
}
else
if
(UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(s, s + len)) {
if
(
#ifdef USE_LOCALE_CTYPE
IN_LC_RUNTIME(LC_CTYPE)
||
#endif
_isQUOTEMETA(EIGHT_BIT_UTF8_TO_NATIVE(*s, *(s + 1))))
{
to_quote = TRUE;
}
}
else
if
(is_QUOTEMETA_high(s)) {
to_quote = TRUE;
}
if
(to_quote) {
*d++ =
'\\'
;
}
if
(ulen > len)
ulen = len;
len -= ulen;
while
(ulen--)
*d++ = *s++;
}
SvUTF8_on(TARG);
}
else
if
(IN_UNI_8_BIT) {
while
(len--) {
if
(_isQUOTEMETA(*s))
*d++ =
'\\'
;
*d++ = *s++;
}
}
else
{
while
(len--) {
if
(!isWORDCHAR_A(*s))
*d++ =
'\\'
;
*d++ = *s++;
}
}
*d =
'\0'
;
SvCUR_set(TARG, d - SvPVX_const(TARG));
(
void
)SvPOK_only_UTF8(TARG);
}
else
sv_setpvn(TARG, s, len);
SvSETMAGIC(TARG);
rpp_replace_1_1_NN(TARG);
return
NORMAL;
}
PP_wrapped(pp_fc, 1, 0)
{
dTARGET;
dSP;
SV *source = TOPs;
STRLEN len;
STRLEN min;
SV *dest;
const
U8 *s;
const
U8 *send;
U8 *d;
U8 tmpbuf[UTF8_MAXBYTES_CASE + 1];
#if UNICODE_MAJOR_VERSION > 3 /* no multifolds in early Unicode */ \
|| (UNICODE_MAJOR_VERSION == 3 && ( UNICODE_DOT_VERSION > 0) \
|| UNICODE_DOT_DOT_VERSION > 0)
const
bool
full_folding = TRUE;
#else
const
bool
full_folding = FALSE;
#endif
const
U8 flags = ( full_folding ? FOLD_FLAGS_FULL : 0 )
#ifdef USE_LOCALE_CTYPE
| ( IN_LC_RUNTIME(LC_CTYPE) ? FOLD_FLAGS_LOCALE : 0 )
#endif
;
SvGETMAGIC(source);
dest = TARG;
if
(SvOK(source)) {
s = (
const
U8*)SvPV_nomg_const(source, len);
}
else
{
if
(ckWARN(WARN_UNINITIALIZED))
report_uninit(source);
s = (
const
U8*)
""
;
len = 0;
}
min = len + 1;
SvUPGRADE(dest, SVt_PV);
d = (U8*)SvGROW(dest, min);
(
void
)SvPOK_only(dest);
SETs(dest);
send = s + len;
#ifdef USE_LOCALE_CTYPE
if
( IN_LC_RUNTIME(LC_CTYPE) ) {
CHECK_AND_WARN_PROBLEMATIC_LOCALE_;
}
#endif
if
(DO_UTF8(source)) {
while
(s < send) {
const
STRLEN u = UTF8SKIP(s);
STRLEN ulen;
_toFOLD_utf8_flags(s, send, tmpbuf, &ulen, flags);
if
(ulen > u && (SvLEN(dest) < (min += ulen - u))) {
const
UV o = d - (U8*)SvPVX_const(dest);
d = o + (U8*) SvGROW(dest, min);
}
Copy(tmpbuf, d, ulen, U8);
d += ulen;
s += u;
}
SvUTF8_on(dest);
}
else
if
(len) {
#ifdef USE_LOCALE_CTYPE
if
( IN_LC_RUNTIME(LC_CTYPE) ) {
if
(IN_UTF8_CTYPE_LOCALE) {
goto
do_uni_folding;
}
for
(; s < send; d++, s++)
*d = (U8) toFOLD_LC(*s);
}
else
#endif
if
( !IN_UNI_8_BIT ) {
for
(; s < send; d++, s++)
*d = toFOLD(*s);
}
else
{
#ifdef USE_LOCALE_CTYPE
do_uni_folding:
#endif
for
(; s < send; d++, s++) {
if
( UNLIKELY(*s == MICRO_SIGN)
#ifdef USE_LOCALE_CTYPE
|| ( UNLIKELY(IN_UTF8_TURKIC_LOCALE)
&& UNLIKELY(IN_LC_RUNTIME(LC_CTYPE))
&& UNLIKELY(*s ==
'I'
))
#endif
) {
Size_t extra = send - s
+ variant_under_utf8_count(s, send);
if
(UNLIKELY(*s ==
'I'
)) {
const
U8 * s_peek = s;
do
{
extra++;
s_peek = (U8 *)
memchr
(s_peek + 1,
'I'
,
send - (s_peek + 1));
}
while
(s_peek != NULL);
}
len = d - (U8*)SvPVX_const(dest);
SvCUR_set(dest, len);
len = sv_utf8_upgrade_flags_grow(dest,
SV_GMAGIC|SV_FORCE_UTF8_UPGRADE,
extra
+ 1
);
d = (U8*)SvPVX(dest) + len;
if
(*s ==
'I'
) {
*d++ = UTF8_TWO_BYTE_HI(LATIN_SMALL_LETTER_DOTLESS_I);
*d++ = UTF8_TWO_BYTE_LO(LATIN_SMALL_LETTER_DOTLESS_I);
}
else
{
*d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU);
*d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU);
}
s++;
for
(; s < send; s++) {
STRLEN ulen;
_to_uni_fold_flags(*s, d, &ulen, flags);
d += ulen;
}
break
;
}
else
if
( UNLIKELY(*s == LATIN_SMALL_LETTER_SHARP_S)
&& full_folding)
{
if
(SvLEN(dest) < ++min) {
const
UV o = d - (U8*)SvPVX_const(dest);
d = o + (U8*) SvGROW(dest, min);
}
*(d)++ =
's'
;
*d =
's'
;
}
else
{
*d = toLOWER_LATIN1(*s);
}
}
}
}
*d =
'\0'
;
SvCUR_set(dest, d - (U8*)SvPVX_const(dest));
#ifdef USE_LOCALE_CTYPE
if
(IN_LC_RUNTIME(LC_CTYPE)) {
TAINT;
SvTAINTED_on(dest);
}
#endif
if
(SvTAINTED(source))
SvTAINT(dest);
SvSETMAGIC(dest);
RETURN;
}
PP(pp_aslice)
{
dMARK; dORIGMARK;
AV *
const
av = MUTABLE_AV(*PL_stack_sp);
const
I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
if
(SvTYPE(av) == SVt_PVAV) {
const
bool
localizing = PL_op->op_private & OPpLVAL_INTRO;
bool
can_preserve = FALSE;
if
(localizing) {
MAGIC *mg;
HV *stash;
can_preserve = SvCANEXISTDELETE(av);
}
if
(lval && localizing) {
SV **svp;
SSize_t max = -1;
for
(svp = MARK + 1; svp < PL_stack_sp; svp++) {
const
SSize_t elem = SvIV(*svp);
if
(elem > max)
max = elem;
}
if
(max > AvMAX(av))
av_extend(av, max);
}
while
(++MARK < PL_stack_sp) {
SV **svp;
SSize_t elem = SvIV(*MARK);
bool
preeminent = TRUE;
if
(localizing && can_preserve) {
preeminent = av_exists(av, elem);
}
svp = av_fetch(av, elem, lval);
if
(lval) {
if
(!svp || !*svp)
DIE(aTHX_ PL_no_aelem, elem);
if
(localizing) {
if
(preeminent)
save_aelem(av, elem, svp);
else
SAVEADELETE(av, elem);
}
}
rpp_replace_at_NN(MARK, svp ? *svp : &PL_sv_undef);
}
}
rpp_context(ORIGMARK, GIMME_V, 1);
return
NORMAL;
}
PP(pp_kvaslice)
{
dMARK; dORIGMARK;
AV *
const
av = MUTABLE_AV(*PL_stack_sp);
I32 lval = (PL_op->op_flags & OPf_MOD);
SSize_t items = PL_stack_sp - MARK - 1;
if
(PL_op->op_private & OPpMAYBE_LVSUB) {
const
I32 flags = is_lvalue_sub();
if
(flags) {
if
(!(flags & OPpENTERSUB_INARGS))
Perl_croak(aTHX_
"Can't modify index/value array slice in list assignment"
);
lval = flags;
}
}
rpp_extend(items);
MARK = ORIGMARK;
PL_stack_sp[items] = PL_stack_sp[0];
PL_stack_sp[0] = NULL;
SSize_t i = items;
while
(i > 1) {
*(MARK+i*2-1) = *(MARK+i);
*(MARK+i*2) = NULL;
*(MARK+i) = NULL;
i--;
}
PL_stack_sp += items;
while
(++MARK < PL_stack_sp) {
SV **svp;
svp = av_fetch(av, SvIV(*MARK), lval);
if
(lval) {
if
(!svp || !*svp || *svp == &PL_sv_undef) {
DIE(aTHX_ PL_no_aelem, SvIV(*MARK));
}
SV *oldsv = *MARK;
SV *newsv = newSVsv(oldsv);
#ifdef PERL_RC_STACK
*MARK = newsv;
SvREFCNT_dec(oldsv);
#else
*MARK = sv_2mortal(newsv);
#endif
}
MARK++;
rpp_replace_at(MARK, svp ? *svp : &PL_sv_undef);
}
rpp_context(ORIGMARK, GIMME_V, 1);
return
NORMAL;
}
PP_wrapped(pp_aeach, 1, 0)
{
dSP;
AV *array = MUTABLE_AV(POPs);
const
U8 gimme = GIMME_V;
IV *iterp = Perl_av_iter_p(aTHX_ array);
const
IV current = (*iterp)++;
if
(current > av_top_index(array)) {
*iterp = 0;
if
(gimme == G_SCALAR)
RETPUSHUNDEF;
else
RETURN;
}
EXTEND(SP, 2);
mPUSHi(current);
if
(gimme == G_LIST) {
SV **
const
element = av_fetch(array, current, 0);
PUSHs(element ? *element : &PL_sv_undef);
}
RETURN;
}
PP_wrapped(pp_akeys, 1, 0)
{
dSP;
AV *array = MUTABLE_AV(POPs);
const
U8 gimme = GIMME_V;
*Perl_av_iter_p(aTHX_ array) = 0;
if
(gimme == G_SCALAR) {
dTARGET;
PUSHi(av_count(array));
}
else
if
(gimme == G_LIST) {
if
(UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) {
const
I32 flags = is_lvalue_sub();
if
(flags && !(flags & OPpENTERSUB_INARGS))
Perl_croak(aTHX_
"Can't modify keys on array in list assignment"
);
}
{
IV n = av_top_index(array);
IV i;
EXTEND(SP, n + 1);
if
( PL_op->op_type == OP_AKEYS
|| ( PL_op->op_type == OP_AVHVSWITCH
&& (PL_op->op_private & 3) + OP_AEACH == OP_AKEYS ))
{
for
(i = 0; i <= n; i++) {
mPUSHi(i);
}
}
else
{
for
(i = 0; i <= n; i++) {
SV *
const
*
const
elem = Perl_av_fetch(aTHX_ array, i, 0);
PUSHs(elem ? *elem : &PL_sv_undef);
}
}
}
}
RETURN;
}
PP_wrapped(pp_each, 1, 0)
{
dSP;
HV * hash = MUTABLE_HV(POPs);
HE *entry;
const
U8 gimme = GIMME_V;
entry = hv_iternext(hash);
EXTEND(SP, 2);
if
(entry) {
SV*
const
sv = hv_iterkeysv(entry);
PUSHs(sv);
if
(gimme == G_LIST) {
SV *val;
val = hv_iterval(hash, entry);
PUSHs(val);
}
}
else
if
(gimme == G_SCALAR)
RETPUSHUNDEF;
RETURN;
}
STATIC OP *
S_do_delete_local(pTHX)
{
dSP;
const
U8 gimme = GIMME_V;
const
MAGIC *mg;
HV *stash;
const
bool
sliced = cBOOL(PL_op->op_private & OPpSLICE);
SV **unsliced_keysv = sliced ? NULL : sp--;
SV *
const
osv = POPs;
SV **mark = sliced ? PL_stack_base + POPMARK : unsliced_keysv-1;
dORIGMARK;
const
bool
tied = SvRMAGICAL(osv)
&& mg_find((
const
SV *)osv, PERL_MAGIC_tied);
const
bool
can_preserve = SvCANEXISTDELETE(osv);
const
U32 type = SvTYPE(osv);
SV **
const
end = sliced ? SP : unsliced_keysv;
if
(type == SVt_PVHV) {
HV *
const
hv = MUTABLE_HV(osv);
while
(++MARK <= end) {
SV *
const
keysv = *MARK;
SV *sv = NULL;
bool
preeminent = TRUE;
if
(can_preserve)
preeminent = hv_exists_ent(hv, keysv, 0);
if
(tied) {
HE *he = hv_fetch_ent(hv, keysv, 1, 0);
if
(he)
sv = HeVAL(he);
else
preeminent = FALSE;
}
else
{
sv = hv_delete_ent(hv, keysv, 0, 0);
if
(preeminent)
SvREFCNT_inc_simple_void(sv);
}
if
(preeminent) {
if
(!sv) DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
save_helem_flags(hv, keysv, &sv, SAVEf_KEEPOLDELEM);
if
(tied) {
*MARK = sv_mortalcopy(sv);
mg_clear(sv);
}
else
*MARK = sv;
}
else
{
SAVEHDELETE(hv, keysv);
*MARK = &PL_sv_undef;
}
}
}
else
if
(type == SVt_PVAV) {
if
(PL_op->op_flags & OPf_SPECIAL) {
AV *
const
av = MUTABLE_AV(osv);
while
(++MARK <= end) {
SSize_t idx = SvIV(*MARK);
SV *sv = NULL;
bool
preeminent = TRUE;
if
(can_preserve)
preeminent = av_exists(av, idx);
if
(tied) {
SV **svp = av_fetch(av, idx, 1);
if
(svp)
sv = *svp;
else
preeminent = FALSE;
}
else
{
sv = av_delete(av, idx, 0);
if
(preeminent)
SvREFCNT_inc_simple_void(sv);
}
if
(preeminent) {
save_aelem_flags(av, idx, &sv, SAVEf_KEEPOLDELEM);
if
(tied) {
*MARK = sv_mortalcopy(sv);
mg_clear(sv);
}
else
*MARK = sv;
}
else
{
SAVEADELETE(av, idx);
*MARK = &PL_sv_undef;
}
}
}
else
DIE(aTHX_
"panic: avhv_delete no longer supported"
);
}
else
DIE(aTHX_
"Not a HASH reference"
);
if
(sliced) {
if
(gimme == G_VOID)
SP = ORIGMARK;
else
if
(gimme == G_SCALAR) {
MARK = ORIGMARK;
if
(SP > MARK)
*++MARK = *SP;
else
*++MARK = &PL_sv_undef;
SP = MARK;
}
}
else
if
(gimme != G_VOID)
PUSHs(*unsliced_keysv);
RETURN;
}
PP_wrapped(pp_delete,
((PL_op->op_private & (OPpSLICE|OPpKVSLICE)) ? 0 : 2),
((PL_op->op_private & (OPpSLICE|OPpKVSLICE)) ? 1 : 0))
{
dSP;
U8 gimme;
I32 discard;
if
(PL_op->op_private & OPpLVAL_INTRO)
return
do_delete_local();
gimme = GIMME_V;
discard = (gimme == G_VOID) ? G_DISCARD : 0;
if
(PL_op->op_private & (OPpSLICE|OPpKVSLICE)) {
dMARK; dORIGMARK;
HV *
const
hv = MUTABLE_HV(POPs);
const
U32 hvtype = SvTYPE(hv);
int
skip = 0;
if
(PL_op->op_private & OPpKVSLICE) {
SSize_t items = SP - MARK;
MEXTEND(SP,items);
while
(items > 1) {
*(MARK+items*2-1) = *(MARK+items);
items--;
}
items = SP - MARK;
SP += items;
skip = 1;
}
if
(hvtype == SVt_PVHV) {
while
((MARK += (1+skip)) <= SP) {
SV *
const
sv = hv_delete_ent(hv, *(MARK-skip), discard, 0);
*MARK = sv ? sv : &PL_sv_undef;
}
}
else
if
(hvtype == SVt_PVAV) {
if
(PL_op->op_flags & OPf_SPECIAL) {
while
((MARK += (1+skip)) <= SP) {
SV *
const
sv = av_delete(MUTABLE_AV(hv), SvIV(*(MARK-skip)), discard);
*MARK = sv ? sv : &PL_sv_undef;
}
}
}
else
DIE(aTHX_
"Not a HASH reference"
);
if
(discard)
SP = ORIGMARK;
else
if
(gimme == G_SCALAR) {
MARK = ORIGMARK;
if
(SP > MARK)
*++MARK = *SP;
else
*++MARK = &PL_sv_undef;
SP = MARK;
}
}
else
{
SV *keysv = POPs;
HV *
const
hv = MUTABLE_HV(POPs);
SV *sv = NULL;
if
(SvTYPE(hv) == SVt_PVHV)
sv = hv_delete_ent(hv, keysv, discard, 0);
else
if
(SvTYPE(hv) == SVt_PVAV) {
if
(PL_op->op_flags & OPf_SPECIAL)
sv = av_delete(MUTABLE_AV(hv), SvIV(keysv), discard);
else
DIE(aTHX_
"panic: avhv_delete no longer supported"
);
}
else
DIE(aTHX_
"Not a HASH reference"
);
if
(!sv)
sv = &PL_sv_undef;
if
(!discard)
PUSHs(sv);
}
RETURN;
}
PP_wrapped(pp_exists, ((PL_op->op_private & OPpEXISTS_SUB) ? 1 : 2), 0)
{
dSP;
SV *tmpsv;
HV *hv;
if
(UNLIKELY( PL_op->op_private & OPpEXISTS_SUB )) {
GV *gv;
SV *
const
sv = POPs;
CV *
const
cv = sv_2cv(sv, &hv, &gv, 0);
if
(cv)
RETPUSHYES;
if
(gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
RETPUSHYES;
RETPUSHNO;
}
tmpsv = POPs;
hv = MUTABLE_HV(POPs);
if
(LIKELY( SvTYPE(hv) == SVt_PVHV )) {
if
(hv_exists_ent(hv, tmpsv, 0))
RETPUSHYES;
}
else
if
(SvTYPE(hv) == SVt_PVAV) {
if
(PL_op->op_flags & OPf_SPECIAL) {
if
(av_exists(MUTABLE_AV(hv), SvIV(tmpsv)))
RETPUSHYES;
}
}
else
{
DIE(aTHX_
"Not a HASH reference"
);
}
RETPUSHNO;
}
PP(pp_helemexistsor)
{
SV *keysv = PL_stack_sp[0];
HV *hv = MUTABLE_HV(PL_stack_sp[-1]);
bool
is_delete = PL_op->op_private & OPpHELEMEXISTSOR_DELETE;
assert
(SvTYPE(hv) == SVt_PVHV);
bool
hv_is_magical = UNLIKELY(SvMAGICAL(hv));
SV *val = NULL;
if
(hv_is_magical && !hv_exists_ent(hv, keysv, 0))
goto
other;
if
(is_delete) {
val = hv_delete_ent(hv, keysv, 0, 0);
}
else
{
HE *he = hv_fetch_ent(hv, keysv, 0, 0);
val = he ? HeVAL(he) : NULL;
if
(hv_is_magical && val)
SvGETMAGIC(val);
}
if
(!val) {
other:
rpp_popfree_2_NN();
return
cLOGOP->op_other;
}
rpp_replace_2_1_NN(val);
return
NORMAL;
}
PP(pp_hslice)
{
dMARK; dORIGMARK;
HV *
const
hv = MUTABLE_HV(*PL_stack_sp);
const
I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
const
bool
localizing = PL_op->op_private & OPpLVAL_INTRO;
bool
can_preserve = FALSE;
if
(localizing) {
MAGIC *mg;
HV *stash;
if
(SvCANEXISTDELETE(hv))
can_preserve = TRUE;
}
while
(++MARK < PL_stack_sp) {
SV *
const
keysv = *MARK;
SV **svp;
HE *he;
bool
preeminent = TRUE;
if
(localizing && can_preserve) {
preeminent = hv_exists_ent(hv, keysv, 0);
}
he = hv_fetch_ent(hv, keysv, lval, 0);
svp = he ? &HeVAL(he) : NULL;
if
(lval) {
if
(!svp || !*svp || *svp == &PL_sv_undef) {
DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
}
if
(localizing) {
if
(HvNAME_get(hv) && isGV_or_RVCV(*svp))
save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL));
else
if
(preeminent)
save_helem_flags(hv, keysv, svp,
(PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC);
else
SAVEHDELETE(hv, keysv);
}
}
rpp_replace_at_NN(MARK, svp && *svp ? *svp : &PL_sv_undef);
}
rpp_context(ORIGMARK, GIMME_V, 1);
return
NORMAL;
}
PP(pp_kvhslice)
{
dMARK; dORIGMARK;
HV *
const
hv = MUTABLE_HV(*PL_stack_sp);
I32 lval = (PL_op->op_flags & OPf_MOD);
SSize_t items = PL_stack_sp - MARK - 1;
if
(PL_op->op_private & OPpMAYBE_LVSUB) {
const
I32 flags = is_lvalue_sub();
if
(flags) {
if
(!(flags & OPpENTERSUB_INARGS))
Perl_croak(aTHX_
"Can't modify key/value hash slice in %s assignment"
,
GIMME_V == G_LIST ?
"list"
:
"scalar"
);
lval = flags;
}
}
rpp_extend(items);
MARK = ORIGMARK;
PL_stack_sp[items] = PL_stack_sp[0];
PL_stack_sp[0] = NULL;
SSize_t i = items;
while
(i > 1) {
*(MARK+i*2-1) = *(MARK+i);
*(MARK+i*2) = NULL;
*(MARK+i) = NULL;
i--;
}
PL_stack_sp += items;
while
(++MARK < PL_stack_sp) {
SV *
const
keysv = *MARK;
SV **svp;
HE *he;
he = hv_fetch_ent(hv, keysv, lval, 0);
svp = he ? &HeVAL(he) : NULL;
if
(lval) {
if
(!svp || !*svp || *svp == &PL_sv_undef) {
DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv));
}
SV *oldsv = *MARK;
SV *newsv = newSVsv(oldsv);
#ifdef PERL_RC_STACK
*MARK = newsv;
SvREFCNT_dec(oldsv);
#else
*MARK = sv_2mortal(newsv);
#endif
}
MARK++;
rpp_replace_at(MARK, (svp && *svp) ? *svp : &PL_sv_undef);
}
rpp_context(ORIGMARK, GIMME_V, 1);
return
NORMAL;
}
PP(pp_list)
{
dMARK;
rpp_context(mark, GIMME_V, 0);
return
NORMAL;
}
PP_wrapped(pp_lslice, 0, 2)
{
dSP;
SV **
const
lastrelem = PL_stack_sp;
SV **
const
lastlelem = PL_stack_base + POPMARK;
SV **
const
firstlelem = PL_stack_base + POPMARK + 1;
SV **
const
firstrelem = lastlelem + 1;
const
U8 mod = PL_op->op_flags & OPf_MOD;
const
SSize_t max = lastrelem - lastlelem;
SV **lelem;
if
(GIMME_V != G_LIST) {
if
(lastlelem < firstlelem) {
EXTEND(SP, 1);
*firstlelem = &PL_sv_undef;
}
else
{
SSize_t ix = SvIV(*lastlelem);
if
(ix < 0)
ix += max;
if
(ix < 0 || ix >= max)
*firstlelem = &PL_sv_undef;
else
*firstlelem = firstrelem[ix];
}
SP = firstlelem;
RETURN;
}
if
(max == 0) {
SP = firstlelem - 1;
RETURN;
}
for
(lelem = firstlelem; lelem <= lastlelem; lelem++) {
SSize_t ix = SvIV(*lelem);
if
(ix < 0)
ix += max;
if
(ix < 0 || ix >= max)
*lelem = &PL_sv_undef;
else
{
if
(!(*lelem = firstrelem[ix]))
*lelem = &PL_sv_undef;
else
if
(mod && SvPADTMP(*lelem)) {
*lelem = firstrelem[ix] = sv_mortalcopy(*lelem);
}
}
}
SP = lastlelem;
RETURN;
}
PP(pp_anonlist)
{
dMARK;
const
SSize_t items = PL_stack_sp - MARK;
SV *
const
av = MUTABLE_SV(av_make(items, MARK+1));
rpp_extend(1);
SV *sv = (PL_op->op_flags & OPf_SPECIAL) ? newRV_noinc(av) : (SV*)av;
rpp_push_1_norc(sv);
PL_stack_sp[0] = PL_stack_sp[-items];
PL_stack_sp[-items] = sv;
rpp_popfree_to_NN(PL_stack_sp - items);
return
NORMAL;
}
PP(pp_emptyavhv)
{
OP *
const
op = PL_op;
SV * rv;
SV *
const
sv = MUTABLE_SV( newSV_type(
(op->op_private & OPpEMPTYAVHV_IS_HV) ?
SVt_PVHV :
SVt_PVAV ) );
if
(op->op_private & OPpTARGET_MY) {
SV**
const
padentry = &PAD_SVl(op->op_targ);
rv = *padentry;
if
(SvTYPE(rv) == SVt_IV && !SvOK(rv)) {
SvFLAGS(rv) = (SVt_IV | SVf_ROK);
SvRV_set(rv, sv);
}
else
{
sv_setrv_noinc_mg(rv, sv);
}
if
((op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO) {
save_clearsv(padentry);
}
if
(GIMME_V == G_VOID) {
return
NORMAL;
}
rpp_xpush_1(rv);
}
else
{
SV * refsv = newSV_type(SVt_IV);
SvRV_set(refsv, sv);
SvROK_on(refsv);
rpp_extend(1);
rpp_push_1_norc(refsv);
}
return
NORMAL;
}
PP(pp_anonhash)
{
dMARK; dORIGMARK;
HV*
const
hv = newHV();
SV*
const
retval = (PL_op->op_flags & OPf_SPECIAL)
? newRV_noinc(MUTABLE_SV(hv))
: MUTABLE_SV(hv);
const
SSize_t pairs = (PL_stack_sp - MARK + 1) >> 1;
rpp_extend(1);
rpp_push_1_norc(retval);
MARK = ORIGMARK;
if
(pairs == 0)
return
NORMAL;
if
(pairs > PERL_HASH_DEFAULT_HvMAX) {
hv_ksplit(hv, pairs);
}
while
(++MARK < PL_stack_sp) {
SV *key = *MARK;
if
(SvGMAGICAL(key))
key = sv_mortalcopy(key);
SV *val;
if
(++MARK < PL_stack_sp)
{
SvGETMAGIC(*MARK);
val = newSV_type(SVt_NULL);
sv_setsv_nomg(val, *MARK);
}
else
{
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"Odd number of elements in anonymous hash"
);
val = newSV_type(SVt_NULL);
}
(
void
)hv_store_ent(hv,key,val,0);
}
*PL_stack_sp = ORIGMARK[1];
ORIGMARK[1] = retval;
rpp_popfree_to_NN(ORIGMARK+1);
return
NORMAL;
}
PP_wrapped(pp_splice, 0, 1)
{
dSP; dMARK; dORIGMARK;
int
num_args = (SP - MARK);
AV *ary = MUTABLE_AV(*++MARK);
SV **src;
SV **dst;
SSize_t i;
SSize_t offset;
SSize_t length;
SSize_t newlen;
SSize_t after;
SSize_t diff;
const
MAGIC *
const
mg = SvTIED_mg((
const
SV *)ary, PERL_MAGIC_tied);
if
(mg) {
return
Perl_tied_method(aTHX_ SV_CONST(SPLICE), mark - 1, MUTABLE_SV(ary), mg,
GIMME_V | TIED_METHOD_ARGUMENTS_ON_STACK,
sp - mark);
}
if
(SvREADONLY(ary))
Perl_croak_no_modify();
SP++;
if
(++MARK < SP) {
offset = i = SvIV(*MARK);
if
(offset < 0)
offset += AvFILLp(ary) + 1;
if
(offset < 0)
DIE(aTHX_ PL_no_aelem, i);
if
(++MARK < SP) {
length = SvIVx(*MARK++);
if
(length < 0) {
length += AvFILLp(ary) - offset + 1;
if
(length < 0)
length = 0;
}
}
else
length = AvMAX(ary) + 1;
}
else
{
offset = 0;
length = AvMAX(ary) + 1;
}
if
(offset > AvFILLp(ary) + 1) {
if
(num_args > 2)
Perl_ck_warner(aTHX_ packWARN(WARN_MISC),
"splice() offset past end of array"
);
offset = AvFILLp(ary) + 1;
}
after = AvFILLp(ary) + 1 - (offset + length);
if
(after < 0) {
length += after;
after = 0;
if
(!AvALLOC(ary))
av_extend(ary, 0);
}
newlen = SP - MARK;
diff = newlen - length;
if
(newlen && !AvREAL(ary) && AvREIFY(ary))
av_reify(ary);
for
(dst = MARK, i = newlen; i; i--) {
SV *
const
h = *dst;
*dst++ = newSVsv(h);
}
if
(diff < 0) {
SV **tmparyval = NULL;
if
(newlen) {
Newx(tmparyval, newlen, SV*);
Copy(MARK, tmparyval, newlen, SV*);
}
MARK = ORIGMARK + 1;
if
(GIMME_V == G_LIST) {
const
bool
real = cBOOL(AvREAL(ary));
MEXTEND(MARK, length);
if
(real)
EXTEND_MORTAL(length);
for
(i = 0, dst = MARK; i < length; i++) {
if
((*dst = AvARRAY(ary)[i+offset])) {
if
(real)
sv_2mortal(*dst);
}
else
*dst = &PL_sv_undef;
dst++;
}
MARK += length - 1;
}
else
{
*MARK = AvARRAY(ary)[offset+length-1];
if
(AvREAL(ary)) {
sv_2mortal(*MARK);
for
(i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
SvREFCNT_dec(*dst++);
}
if
(!*MARK)
*MARK = &PL_sv_undef;
}
AvFILLp(ary) += diff;
if
(offset < after) {
if
(offset) {
src = &AvARRAY(ary)[offset-1];
dst = src - diff;
for
(i = offset; i > 0; i--)
*dst-- = *src--;
}
dst = AvARRAY(ary);
AvARRAY(ary) = AvARRAY(ary) - diff;
AvMAX(ary) += diff;
}
else
{
if
(after) {
src = AvARRAY(ary) + offset + length;
dst = src + diff;
Move(src, dst, after, SV*);
}
dst = &AvARRAY(ary)[AvFILLp(ary)+1];
}
i = -diff;
while
(i)
dst[--i] = NULL;
if
(newlen) {
Copy( tmparyval, AvARRAY(ary) + offset, newlen, SV* );
Safefree(tmparyval);
}
}
else
{
SV** tmparyval = NULL;
if
(length) {
Newx(tmparyval, length, SV*);
Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
}
if
(diff > 0) {
if
(offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
if
(offset) {
src = AvARRAY(ary);
dst = src - diff;
Move(src, dst, offset, SV*);
}
AvARRAY(ary) = AvARRAY(ary) - diff;
AvMAX(ary) += diff;
AvFILLp(ary) += diff;
}
else
{
if
(AvFILLp(ary) + diff >= AvMAX(ary))
av_extend(ary, AvFILLp(ary) + diff);
AvFILLp(ary) += diff;
if
(after) {
dst = AvARRAY(ary) + AvFILLp(ary);
src = dst - diff;
for
(i = after; i; i--) {
*dst-- = *src--;
}
}
}
}
if
(newlen) {
Copy( MARK, AvARRAY(ary) + offset, newlen, SV* );
}
MARK = ORIGMARK + 1;
if
(GIMME_V == G_LIST) {
if
(length) {
const
bool
real = cBOOL(AvREAL(ary));
if
(real)
EXTEND_MORTAL(length);
for
(i = 0, dst = MARK; i < length; i++) {
if
((*dst = tmparyval[i])) {
if
(real)
sv_2mortal(*dst);
}
else
*dst = &PL_sv_undef;
dst++;
}
}
MARK += length - 1;
}
else
if
(length--) {
*MARK = tmparyval[length];
if
(AvREAL(ary)) {
sv_2mortal(*MARK);
while
(length-- > 0)
SvREFCNT_dec(tmparyval[length]);
}
if
(!*MARK)
*MARK = &PL_sv_undef;
}
else
*MARK = &PL_sv_undef;
Safefree(tmparyval);
}
if
(SvMAGICAL(ary))
mg_set(MUTABLE_SV(ary));
SP = MARK;
RETURN;
}
PP(pp_push)
{
dMARK; dORIGMARK; dTARGET;
AV *
const
ary = MUTABLE_AV(*++MARK);
const
MAGIC *
const
mg = SvTIED_mg((
const
SV *)ary, PERL_MAGIC_tied);
if
(mg) {
ENTER_with_name(
"call_PUSH"
);
SV *obj = SvTIED_obj(MUTABLE_SV(ary), mg);
#ifdef PERL_RC_STACK
SAVEFREESV(MUTABLE_SV(ary));
SvREFCNT_inc_simple_void(obj);
#endif
*MARK-- = obj;
PUSHMARK(MARK);
call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
LEAVE_with_name(
"call_PUSH"
);
}
else
{
U16 old_delaymagic = PL_delaymagic;
if
(SvREADONLY(ary) && MARK < PL_stack_sp)
Perl_croak_no_modify();
PL_delaymagic = DM_DELAY;
for
(++MARK; MARK <= PL_stack_sp; MARK++) {
SV *sv;
if
(*MARK) SvGETMAGIC(*MARK);
sv = newSV_type(SVt_NULL);
if
(*MARK)
sv_setsv_nomg(sv, *MARK);
av_store(ary, AvFILLp(ary)+1, sv);
}
if
(PL_delaymagic & DM_ARRAY_ISA)
mg_set(MUTABLE_SV(ary));
PL_delaymagic = old_delaymagic;
}
rpp_popfree_to_NN(ORIGMARK);
if
( (PL_op->op_flags & OPf_WANT) != G_VOID
|| (PL_op->op_private & OPpTARGET_MY))
{
TARGi(AvFILL(ary) + 1, 1);
if
((PL_op->op_flags & OPf_WANT) != G_VOID)
rpp_push_1(targ);
}
return
NORMAL;
}
PP_wrapped(pp_shift, (PL_op->op_flags & OPf_SPECIAL ? 0 : 1), 0)
{
dSP;
AV *
const
av = PL_op->op_flags & OPf_SPECIAL
? MUTABLE_AV(GvAVn(PL_defgv)) : MUTABLE_AV(POPs);
SV *
const
sv = PL_op->op_type == OP_SHIFT ? av_shift(av) : av_pop(av);
EXTEND(SP, 1);
assert
(sv);
if
(AvREAL(av))
(
void
)sv_2mortal(sv);
PUSHs(sv);
RETURN;
}
PP(pp_unshift)
{
dMARK; dORIGMARK; dTARGET;
AV *ary = MUTABLE_AV(*++MARK);
const
MAGIC *
const
mg = SvTIED_mg((
const
SV *)ary, PERL_MAGIC_tied);
if
(mg) {
ENTER_with_name(
"call_UNSHIFT"
);
SV *obj = SvTIED_obj(MUTABLE_SV(ary), mg);
#ifdef PERL_RC_STACK
SAVEFREESV(MUTABLE_SV(ary));
SvREFCNT_inc_simple_void(obj);
#endif
*MARK-- = obj;
PUSHMARK(MARK);
call_sv(SV_CONST(UNSHIFT),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
LEAVE_with_name(
"call_UNSHIFT"
);
}
else
{
U16 old_delaymagic = PL_delaymagic;
SSize_t i = 0;
av_unshift(ary, PL_stack_sp - MARK);
PL_delaymagic = DM_DELAY;
if
(!SvMAGICAL(ary)) {
while
(MARK < PL_stack_sp) {
SV *
const
sv = newSVsv(*++MARK);
assert
( !SvTIED_mg((
const
SV *)ary, PERL_MAGIC_tied) );
assert
( i >= 0 );
assert
( !SvREADONLY(ary) );
assert
( AvREAL(ary) || !AvREIFY(ary) );
assert
( i <= AvMAX(ary) );
assert
( i <= AvFILLp(ary) );
if
(AvREAL(ary))
SvREFCNT_dec(AvARRAY(ary)[i]);
AvARRAY(ary)[i] = sv;
i++;
}
}
else
{
while
(MARK < PL_stack_sp) {
SV *
const
sv = newSVsv(*++MARK);
(
void
)av_store(ary, i++, sv);
}
}
if
(PL_delaymagic & DM_ARRAY_ISA)
mg_set(MUTABLE_SV(ary));
PL_delaymagic = old_delaymagic;
}
rpp_popfree_to_NN(ORIGMARK);
if
( (PL_op->op_flags & OPf_WANT) != G_VOID
|| (PL_op->op_private & OPpTARGET_MY))
{
TARGi(AvFILL(ary) + 1, 1);
if
((PL_op->op_flags & OPf_WANT) != G_VOID)
rpp_push_1(targ);
}
return
NORMAL;
}
PP_wrapped(pp_reverse, 0, 1)
{
dSP; dMARK;
if
(GIMME_V == G_LIST) {
if
(PL_op->op_private & OPpREVERSE_INPLACE) {
AV *av;
assert
( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
(
void
)POPMARK;
av = MUTABLE_AV((*SP));
SP = MARK;
if
(SvMAGICAL(av)) {
SSize_t i, j;
SV *tmp = sv_newmortal();
HV *stash;
const
MAGIC *mg;
bool
can_preserve = SvCANEXISTDELETE(av);
for
(i = 0, j = av_top_index(av); i < j; ++i, --j) {
SV *begin, *end;
if
(can_preserve) {
if
(!av_exists(av, i)) {
if
(av_exists(av, j)) {
SV *sv = av_delete(av, j, 0);
begin = *av_fetch(av, i, TRUE);
sv_setsv_mg(begin, sv);
}
continue
;
}
else
if
(!av_exists(av, j)) {
SV *sv = av_delete(av, i, 0);
end = *av_fetch(av, j, TRUE);
sv_setsv_mg(end, sv);
continue
;
}
}
begin = *av_fetch(av, i, TRUE);
end = *av_fetch(av, j, TRUE);
sv_setsv(tmp, begin);
sv_setsv_mg(begin, end);
sv_setsv_mg(end, tmp);
}
}
else
{
SV **begin = AvARRAY(av);
if
(begin) {
SV **end = begin + AvFILLp(av);
while
(begin < end) {
SV *
const
tmp = *begin;
*begin++ = *end;
*end-- = tmp;
}
}
}
}
else
{
SV **oldsp = SP;
MARK++;
while
(MARK < SP) {
SV *
const
tmp = *MARK;
*MARK++ = *SP;
*SP-- = tmp;
}
SP = oldsp;
}
}
else
{
char
*up;
dTARGET;
STRLEN len;
SvUTF8_off(TARG);
if
(SP - MARK > 1) {
do_join(TARG, &PL_sv_no, MARK, SP);
SP = MARK + 1;
SETs(TARG);
}
else
if
(SP > MARK) {
sv_setsv(TARG, *SP);
SETs(TARG);
}
else
{
sv_setsv(TARG, DEFSV);
XPUSHs(TARG);
}
SvSETMAGIC(TARG);
up = SvPV_force(TARG, len);
if
(len > 1) {
char
*down;
if
(DO_UTF8(TARG)) {
U8* s = (U8*)SvPVX(TARG);
const
U8* send = (U8*)(s + len);
while
(s < send) {
if
(UTF8_IS_INVARIANT(*s)) {
s++;
continue
;
}
else
{
if
(!utf8_to_uvchr_buf(s, send, 0))
break
;
up = (
char
*)s;
s += UTF8SKIP(s);
down = (
char
*)(s - 1);
while
(down > up) {
const
char
tmp = *up;
*up++ = *down;
*down-- = tmp;
}
}
}
up = SvPVX(TARG);
}
down = SvPVX(TARG) + len - 1;
while
(down > up) {
const
char
tmp = *up;
*up++ = *down;
*down-- = tmp;
}
(
void
)SvPOK_only_UTF8(TARG);
}
}
RETURN;
}
PP_wrapped(pp_split,
( (PL_op->op_private & OPpSPLIT_ASSIGN)
&& (PL_op->op_flags & OPf_STACKED))
? 3 : 2,
0)
{
dSP; dTARG;
AV *ary = ( (PL_op->op_private & OPpSPLIT_ASSIGN)
&& (PL_op->op_flags & OPf_STACKED))
? (AV *)POPs : NULL;
IV limit = POPi;
SV *
const
sv = POPs;
STRLEN len;
const
char
*s = SvPV_const(sv, len);
const
bool
do_utf8 = DO_UTF8(sv);
const
bool
in_uni_8_bit = IN_UNI_8_BIT;
const
char
*strend = s + len;
PMOP *pm = cPMOP;
REGEXP *rx;
SV *dstr;
const
char
*m;
SSize_t iters = 0;
const
STRLEN slen = do_utf8
? utf8_length((U8*)s, (U8*)strend)
: (STRLEN)(strend - s);
SSize_t maxiters = slen + 10;
I32 trailing_empty = 0;
const
char
*orig;
const
IV origlimit = limit;
bool
realarray = 0;
SSize_t base;
const
U8 gimme = GIMME_V;
bool
gimme_scalar;
I32 oldsave = PL_savestack_ix;
U32 flags = (do_utf8 ? SVf_UTF8 : 0) |
SVs_TEMP;
MAGIC *mg = NULL;
rx = PM_GETRE(pm);
TAINT_IF(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET &&
(RX_EXTFLAGS(rx) & (RXf_WHITE | RXf_SKIPWHITE)));
if
(PL_op->op_private & OPpSPLIT_ASSIGN) {
realarray = 1;
if
(!(PL_op->op_flags & OPf_STACKED)) {
if
(PL_op->op_private & OPpSPLIT_LEX) {
if
(PL_op->op_private & OPpLVAL_INTRO)
SAVECLEARSV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
ary = (AV *)PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff);
}
else
{
GV *gv =
#ifdef USE_ITHREADS
MUTABLE_GV(PAD_SVl(pm->op_pmreplrootu.op_pmtargetoff));
#else
pm->op_pmreplrootu.op_pmtargetgv;
#endif
if
(PL_op->op_private & OPpLVAL_INTRO)
ary = save_ary(gv);
else
ary = GvAVn(gv);
}
oldsave = PL_savestack_ix;
}
(
void
)sv_2mortal(SvREFCNT_inc_simple_NN(ary));
if
((mg = SvTIED_mg((
const
SV *)ary, PERL_MAGIC_tied))) {
PUSHMARK(SP);
XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg));
}
else
{
flags &= ~SVs_TEMP;
}
}
base = SP - PL_stack_base;
orig = s;
if
(RX_EXTFLAGS(rx) & RXf_SKIPWHITE) {
if
(do_utf8) {
while
(s < strend && isSPACE_utf8_safe(s, strend))
s += UTF8SKIP(s);
}
else
if
(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET) {
while
(s < strend && isSPACE_LC(*s))
s++;
}
else
if
(in_uni_8_bit) {
while
(s < strend && isSPACE_L1(*s))
s++;
}
else
{
while
(s < strend && isSPACE(*s))
s++;
}
}
gimme_scalar = gimme == G_SCALAR && !ary;
if
(!limit)
limit = maxiters + 2;
if
(RX_EXTFLAGS(rx) & RXf_WHITE) {
while
(--limit) {
m = s;
if
(do_utf8) {
while
(m < strend && ! isSPACE_utf8_safe(m, strend) ) {
const
int
t = UTF8SKIP(m);
if
(strend - m < t)
m = strend;
else
m += t;
}
}
else
if
(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
{
while
(m < strend && !isSPACE_LC(*m))
++m;
}
else
if
(in_uni_8_bit) {
while
(m < strend && !isSPACE_L1(*m))
++m;
}
else
{
while
(m < strend && !isSPACE(*m))
++m;
}
if
(m >= strend)
break
;
if
(gimme_scalar) {
iters++;
if
(m-s == 0)
trailing_empty++;
else
trailing_empty = 0;
}
else
{
dstr = newSVpvn_flags(s, m-s, flags);
XPUSHs(dstr);
}
if
(do_utf8)
s = m + UTF8SKIP(m);
else
s = m + 1;
if
(do_utf8) {
while
(s < strend && isSPACE_utf8_safe(s, strend) )
s += UTF8SKIP(s);
}
else
if
(get_regex_charset(RX_EXTFLAGS(rx)) == REGEX_LOCALE_CHARSET)
{
while
(s < strend && isSPACE_LC(*s))
++s;
}
else
if
(in_uni_8_bit) {
while
(s < strend && isSPACE_L1(*s))
++s;
}
else
{
while
(s < strend && isSPACE(*s))
++s;
}
}
}
else
if
(RX_EXTFLAGS(rx) & RXf_START_ONLY) {
while
(--limit) {
for
(m = s; m < strend && *m !=
'\n'
; m++)
;
m++;
if
(m >= strend)
break
;
if
(gimme_scalar) {
iters++;
if
(m-s == 0)
trailing_empty++;
else
trailing_empty = 0;
}
else
{
dstr = newSVpvn_flags(s, m-s, flags);
XPUSHs(dstr);
}
s = m;
}
}
else
if
(RX_EXTFLAGS(rx) & RXf_NULL && !(s >= strend)) {
const
SSize_t sslen = slen > SSize_t_MAX ? -1 : (SSize_t)slen;
const
IV items = limit - 1;
if
(sslen < items || items < 0) {
iters = slen -1;
limit = slen + 1;
if
(gimme_scalar) {
s = strend;
iters++;
}
}
else
{
iters = items;
}
if
(!gimme_scalar) {
EXTEND(SP, limit);
if
(do_utf8) {
while
(--limit) {
m = s;
s += UTF8SKIP(s);
dstr = newSVpvn_flags(m, s-m, flags);
PUSHs(dstr);
}
}
else
{
while
(--limit) {
dstr = newSVpvn_flags(s, 1, flags);
PUSHs(dstr);
s++;
}
}
}
}
else
if
(do_utf8 == (RX_UTF8(rx) != 0) &&
(RX_EXTFLAGS(rx) & RXf_USE_INTUIT) && !RX_NPARENS(rx)
&& (RX_EXTFLAGS(rx) & RXf_CHECK_ALL)
&& !(RX_EXTFLAGS(rx) & RXf_IS_ANCHORED)) {
const
int
tail = (RX_EXTFLAGS(rx) & RXf_INTUIT_TAIL);
SV *
const
csv = CALLREG_INTUIT_STRING(rx);
len = RX_MINLENRET(rx);
if
(len == 1 && !RX_UTF8(rx) && !tail) {
const
char
c = *SvPV_nolen_const(csv);
while
(--limit) {
for
(m = s; m < strend && *m != c; m++)
;
if
(m >= strend)
break
;
if
(gimme_scalar) {
iters++;
if
(m-s == 0)
trailing_empty++;
else
trailing_empty = 0;
}
else
{
dstr = newSVpvn_flags(s, m-s, flags);
XPUSHs(dstr);
}
if
(do_utf8)
s = (
char
*)utf8_hop_forward((U8*) m, len, (U8*) strend);
else
s = m + len;
}
}
else
{
const
bool
multiline = (RX_EXTFLAGS(rx) & RXf_PMf_MULTILINE) ? 1 : 0;
while
(s < strend && --limit &&
(m = fbm_instr((unsigned
char
*)s, (unsigned
char
*)strend,
csv, multiline ? FBMrf_MULTILINE : 0)) )
{
if
(gimme_scalar) {
iters++;
if
(m-s == 0)
trailing_empty++;
else
trailing_empty = 0;
}
else
{
dstr = newSVpvn_flags(s, m-s, flags);
XPUSHs(dstr);
}
if
(do_utf8)
s = (
char
*)utf8_hop_forward((U8*)m, len, (U8 *) strend);
else
s = m + len;
}
}
}
else
{
maxiters += slen * RX_NPARENS(rx);
while
(s < strend && --limit)
{
I32 rex_return;
PUTBACK;
rex_return = CALLREGEXEC(rx, (
char
*)s, (
char
*)strend, (
char
*)orig, 1,
sv, NULL, 0);
SPAGAIN;
if
(rex_return == 0)
break
;
TAINT_IF(RX_MATCH_TAINTED(rx));
assert
(!RX_MATCH_COPIED(rx));
m = RX_OFFS_START(rx,0) + orig;
if
(gimme_scalar) {
iters++;
if
(m-s == 0)
trailing_empty++;
else
trailing_empty = 0;
}
else
{
dstr = newSVpvn_flags(s, m-s, flags);
XPUSHs(dstr);
}
if
(RX_NPARENS(rx)) {
I32 i;
for
(i = 1; i <= (I32)RX_NPARENS(rx); i++) {
s = orig + RX_OFFS_START(rx,i);
m = orig + RX_OFFS_END(rx,i);
if
(gimme_scalar) {
iters++;
if
(m-s == 0)
trailing_empty++;
else
trailing_empty = 0;
}
else
{
if
(m >= orig && s >= orig) {
dstr = newSVpvn_flags(s, m-s, flags);
}
else
dstr = &PL_sv_undef;
XPUSHs(dstr);
}
}
}
s = RX_OFFS_END(rx,0) + orig;
}
}
if
(!gimme_scalar) {
iters = (SP - PL_stack_base) - base;
}
if
(iters > maxiters)
DIE(aTHX_
"Split loop"
);
if
(s < strend || (iters && origlimit)) {
if
(!gimme_scalar) {
const
STRLEN l = strend - s;
dstr = newSVpvn_flags(s, l, flags);
XPUSHs(dstr);
}
iters++;
}
else
if
(!origlimit) {
if
(gimme_scalar) {
iters -= trailing_empty;
}
else
{
while
(iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0)) {
if
(TOPs && !(flags & SVs_TEMP))
sv_2mortal(TOPs);
*SP-- = NULL;
iters--;
}
}
}
PUTBACK;
LEAVE_SCOPE(oldsave);
SPAGAIN;
if
(realarray) {
if
(!mg) {
PUTBACK;
if
(AvREAL(ary)) {
if
(av_count(ary) > 0)
av_clear(ary);
}
else
{
AvREAL_on(ary);
AvREIFY_off(ary);
if
(AvMAX(ary) > -1) {
Zero(AvARRAY(ary), AvMAX(ary), SV*);
}
}
if
(AvMAX(ary) < iters)
av_extend(ary,iters);
SPAGAIN;
Copy(SP + 1 - iters, AvARRAY(ary), iters, SV*);
AvFILLp(ary) = iters - 1;
if
(SvSMAGICAL(ary)) {
PUTBACK;
mg_set(MUTABLE_SV(ary));
SPAGAIN;
}
if
(gimme != G_LIST) {
SP -= iters;
PUTBACK;
}
}
else
{
PUTBACK;
av_extend(ary,iters);
av_clear(ary);
ENTER_with_name(
"call_PUSH"
);
call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED);
LEAVE_with_name(
"call_PUSH"
);
SPAGAIN;
if
(gimme == G_LIST) {
SSize_t i;
EXTEND_SKIP(SP, iters);
for
(i=0; i < iters; i++) {
SV **svp = av_fetch(ary, i, FALSE);
PUSHs((svp) ? *svp : &PL_sv_undef);
}
RETURN;
}
}
}
if
(gimme != G_LIST) {
GETTARGET;
XPUSHi(iters);
}
RETURN;
}
PP(pp_once)
{
SV *
const
sv = PAD_SVl(PL_op->op_targ);
if
(SvPADSTALE(sv)) {
SvPADSTALE_off(sv);
return
cLOGOP->op_other;
}
return
cLOGOP->op_next;
}
PP(pp_lock)
{
SV *sv = *PL_stack_sp;
SV *retsv = sv;
SvLOCK(sv);
if
(SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
|| SvTYPE(retsv) == SVt_PVCV) {
retsv = refto(retsv);
}
rpp_replace_1_1_NN(retsv);
return
NORMAL;
}
PP(unimplemented_op)
{
const
Optype op_type = PL_op->op_type;
const
char
*
const
name = op_type >= OP_max
?
"[out of range]"
: PL_op_name[op_type];
if
(OP_IS_SOCKET(op_type))
DIE(aTHX_ PL_no_sock_func, name);
DIE(aTHX_
"panic: unimplemented op %s (#%d) called"
, name, op_type);
}
static
void
S_maybe_unwind_defav(pTHX)
{
if
(CX_CUR()->cx_type & CXp_HASARGS) {
PERL_CONTEXT *cx = CX_CUR();
assert
(CxHASARGS(cx));
cx_popsub_args(cx);
cx->cx_type &= ~CXp_HASARGS;
}
}
PP_wrapped(pp_coreargs, 0, 0)
{
dSP;
int
opnum = SvIOK(cSVOP_sv) ? (
int
)SvUV(cSVOP_sv) : 0;
int
defgv = PL_opargs[opnum] & OA_DEFGV ||opnum==OP_GLOB, whicharg = 0;
AV *
const
at_ = GvAV(PL_defgv);
SV **svp = at_ ? AvARRAY(at_) : NULL;
I32 minargs = 0, maxargs = 0, numargs = at_ ? AvFILLp(at_)+1 : 0;
I32 oa = opnum ? PL_opargs[opnum] >> OASHIFT : 0;
bool
seen_question = 0;
const
char
*err = NULL;
const
bool
pushmark = PL_op->op_private & OPpCOREARGS_PUSHMARK;
while
(oa) {
if
((oa & 7) == OA_LIST) { maxargs = I32_MAX;
break
; }
maxargs++;
if
(oa & OA_OPTIONAL) seen_question = 1;
if
(!seen_question) minargs++;
oa >>= 4;
}
if
(numargs < minargs) err =
"Not enough"
;
else
if
(numargs > maxargs) err =
"Too many"
;
if
(err)
Perl_croak(aTHX_
"%s arguments for %s"
, err,
opnum ? PL_op_desc[opnum] : SvPV_nolen_const(cSVOP_sv)
);
SP = PL_stack_base + CX_CUR()->blk_oldsp;
if
(!maxargs) RETURN;
if
(pushmark) {
PUSHMARK(SP);
}
EXTEND(SP, maxargs == I32_MAX ? numargs : maxargs);
PUTBACK;
oa = PL_opargs[opnum] >> OASHIFT;
for
(; oa&&(numargs||!pushmark); (
void
)(numargs&&(++svp,--numargs))) {
whicharg++;
switch
(oa & 7) {
case
OA_SCALAR:
try_defsv:
if
(!numargs && defgv && whicharg == minargs + 1) {
PUSHs(DEFSV);
}
else
PUSHs(numargs ? svp && *svp ? *svp : &PL_sv_undef : NULL);
break
;
case
OA_LIST:
while
(numargs--) {
PUSHs(svp && *svp ? *svp : &PL_sv_undef);
svp++;
}
RETURN;
case
OA_AVREF:
if
(!numargs) {
GV *gv;
if
(CvUNIQUE(find_runcv_where(FIND_RUNCV_level_eq,1,NULL)))
gv = PL_argvgv;
else
{
S_maybe_unwind_defav(aTHX);
gv = PL_defgv;
}
PUSHs((SV *)GvAVn(gv));
break
;
}
if
(!svp || !*svp || !SvROK(*svp)
|| SvTYPE(SvRV(*svp)) != SVt_PVAV)
DIE(aTHX_
"Type of arg %d to &CORE::%s must be array reference"
,
whicharg, PL_op_desc[opnum]
);
PUSHs(SvRV(*svp));
break
;
case
OA_HVREF:
if
(!svp || !*svp || !SvROK(*svp)
|| ( SvTYPE(SvRV(*svp)) != SVt_PVHV
&& ( opnum == OP_DBMCLOSE || opnum == OP_DBMOPEN
|| SvTYPE(SvRV(*svp)) != SVt_PVAV )))
DIE(aTHX_
"Type of arg %d to &CORE::%s must be hash%s reference"
,
whicharg, PL_op_desc[opnum],
opnum == OP_DBMCLOSE || opnum == OP_DBMOPEN
?
""
:
" or array"
);
PUSHs(SvRV(*svp));
break
;
case
OA_FILEREF:
if
(!numargs) PUSHs(NULL);
else
if
(svp && *svp && SvROK(*svp) && isGV_with_GP(SvRV(*svp)))
PUSHs(SvRV(*svp));
else
{
const
bool
constr = PL_op->op_private & whicharg;
PUSHs(S_rv2gv(aTHX_
svp && *svp ? *svp : &PL_sv_undef,
constr, cBOOL(CopHINTS_get(PL_curcop) & HINT_STRICT_REFS),
!constr
));
}
break
;
case
OA_SCALARREF:
if
(!numargs)
goto
try_defsv;
else
{
const
bool
wantscalar =
PL_op->op_private & OPpCOREARGS_SCALARMOD;
if
(!svp || !*svp || !SvROK(*svp)
|| SvTYPE(SvRV(*svp)) > (
wantscalar ? SVt_PVLV
: opnum == OP_LOCK || opnum == OP_UNDEF
? SVt_PVCV
: SVt_PVHV
)
)
DIE(aTHX_
"Type of arg %d to &CORE::%s must be %s"
,
whicharg, PL_op_name[opnum],
wantscalar
?
"scalar reference"
: opnum == OP_LOCK || opnum == OP_UNDEF
?
"reference to one of [$@%&*]"
:
"reference to one of [$@%*]"
);
PUSHs(SvRV(*svp));
if
(opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv) {
S_maybe_unwind_defav(aTHX);
}
}
break
;
default
:
DIE(aTHX_
"panic: unknown OA_*: %x"
, (unsigned)(oa&7));
}
oa = oa >> 4;
}
RETURN;
}
PP(pp_avhvswitch)
{
return
PL_ppaddr[
(SvTYPE(*PL_stack_sp) == SVt_PVAV ? OP_AEACH : OP_EACH)
+ (PL_op->op_private & OPpAVHVSWITCH_MASK)
](aTHX);
}
PP(pp_runcv)
{
CV *cv;
if
(PL_op->op_private & OPpOFFBYONE) {
cv = find_runcv_where(FIND_RUNCV_level_eq, 1, NULL);
}
else
cv = find_runcv(NULL);
rpp_extend(1);
if
(CvEVAL(cv))
rpp_push_IMM(&PL_sv_undef);
else
rpp_push_1_norc(newRV((SV *)cv));
return
NORMAL;
}
static
void
S_localise_aelem_lval(pTHX_ AV *
const
av, SV *
const
keysv,
const
bool
can_preserve)
{
const
SSize_t ix = SvIV(keysv);
if
(can_preserve ? av_exists(av, ix) : TRUE) {
SV **
const
svp = av_fetch(av, ix, 1);
if
(!svp || !*svp)
Perl_croak(aTHX_ PL_no_aelem, ix);
save_aelem(av, ix, svp);
}
else
SAVEADELETE(av, ix);
}
static
void
S_localise_helem_lval(pTHX_ HV *
const
hv, SV *
const
keysv,
const
bool
can_preserve)
{
if
(can_preserve ? hv_exists_ent(hv, keysv, 0) : TRUE) {
HE *
const
he = hv_fetch_ent(hv, keysv, 1, 0);
SV **
const
svp = he ? &HeVAL(he) : NULL;
if
(!svp || !*svp)
Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(keysv));
save_helem_flags(hv, keysv, svp, 0);
}
else
SAVEHDELETE(hv, keysv);
}
static
void
S_localise_gv_slot(pTHX_ GV *gv, U8 type)
{
if
(type == OPpLVREF_SV) {
save_pushptrptr(gv, SvREFCNT_inc_simple(GvSV(gv)), SAVEt_GVSV);
GvSV(gv) = 0;
}
else
if
(type == OPpLVREF_AV)
save_ary(gv);
else
{
assert
(type == OPpLVREF_HV);
save_hash(gv);
}
}
PP(pp_refassign)
{
SV *key = NULL;
SV *left = NULL;
SSize_t extra = 0;
if
(PL_op->op_private & OPpLVREF_ELEM) {
key = PL_stack_sp[0];
extra++;
}
if
(PL_op->op_flags & OPf_STACKED) {
left = PL_stack_sp[-extra];
extra++;
}
SV *sv = PL_stack_sp[-extra];
const
char
*bad = NULL;
const
U8 type = PL_op->op_private & OPpLVREF_TYPE;
if
(!SvROK(sv)) DIE(aTHX_
"Assigned value is not a reference"
);
switch
(type) {
case
OPpLVREF_SV:
if
(SvTYPE(SvRV(sv)) > SVt_PVLV)
bad =
" SCALAR"
;
break
;
case
OPpLVREF_AV:
if
(SvTYPE(SvRV(sv)) != SVt_PVAV)
bad =
"n ARRAY"
;
break
;
case
OPpLVREF_HV:
if
(SvTYPE(SvRV(sv)) != SVt_PVHV)
bad =
" HASH"
;
break
;
case
OPpLVREF_CV:
if
(SvTYPE(SvRV(sv)) != SVt_PVCV)
bad =
" CODE"
;
}
if
(bad)
DIE(aTHX_
"Assigned value is not a%s reference"
, bad);
switch
(left ? SvTYPE(left) : 0) {
case
0:
{
SV *
const
old = PAD_SV(ARGTARG);
PAD_SETSV(ARGTARG, SvREFCNT_inc_NN(SvRV(sv)));
SvREFCNT_dec(old);
if
((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE))
== OPpLVAL_INTRO)
SAVECLEARSV(PAD_SVl(ARGTARG));
break
;
}
case
SVt_PVGV:
if
(PL_op->op_private & OPpLVAL_INTRO) {
S_localise_gv_slot(aTHX_ (GV *)left, type);
}
gv_setref(left, sv);
SvSETMAGIC(left);
break
;
case
SVt_PVAV:
assert
(key);
if
(UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
MAGIC *mg;
HV *stash;
S_localise_aelem_lval(aTHX_ (AV *)left, key,
SvCANEXISTDELETE(left));
}
av_store((AV *)left, SvIV(key), SvREFCNT_inc_simple_NN(SvRV(sv)));
break
;
case
SVt_PVHV:
if
(UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
assert
(key);
MAGIC *mg;
HV *stash;
S_localise_helem_lval(aTHX_ (HV *)left, key,
SvCANEXISTDELETE(left));
}
(
void
)hv_store_ent((HV *)left, key, SvREFCNT_inc_simple_NN(SvRV(sv)), 0);
}
if
(UNLIKELY(PL_op->op_flags & OPf_MOD)) {
rpp_popfree_to_NN(PL_stack_sp - extra);
rpp_replace_at_norc(PL_stack_sp, newSVsv(sv));
}
else
rpp_popfree_to_NN(PL_stack_sp - (extra + 1));
return
NORMAL;
}
PP_wrapped(pp_lvref,
!!(PL_op->op_private & OPpLVREF_ELEM) + !!(PL_op->op_flags & OPf_STACKED),
0)
{
dSP;
SV *
const
ret = newSV_type_mortal(SVt_PVMG);
SV *
const
elem = PL_op->op_private & OPpLVREF_ELEM ? POPs : NULL;
SV *
const
arg = PL_op->op_flags & OPf_STACKED ? POPs : NULL;
MAGIC *
const
mg = sv_magicext(ret, arg, PERL_MAGIC_lvref,
&PL_vtbl_lvref, (
char
*)elem,
elem ? HEf_SVKEY : (I32)ARGTARG);
mg->mg_private = PL_op->op_private;
if
(PL_op->op_private & OPpLVREF_ITER)
mg->mg_flags |= MGf_PERSIST;
if
(UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) {
if
(elem) {
MAGIC *mg;
HV *stash;
assert
(arg);
{
const
bool
can_preserve = SvCANEXISTDELETE(arg);
if
(SvTYPE(arg) == SVt_PVAV)
S_localise_aelem_lval(aTHX_ (AV *)arg, elem, can_preserve);
else
S_localise_helem_lval(aTHX_ (HV *)arg, elem, can_preserve);
}
}
else
if
(arg) {
S_localise_gv_slot(aTHX_ (GV *)arg,
PL_op->op_private & OPpLVREF_TYPE);
}
else
if
(!(PL_op->op_private & OPpPAD_STATE))
SAVECLEARSV(PAD_SVl(ARGTARG));
}
XPUSHs(ret);
RETURN;
}
PP_wrapped(pp_lvrefslice, 0, 1)
{
dSP; dMARK;
AV *
const
av = (AV *)POPs;
const
bool
localizing = PL_op->op_private & OPpLVAL_INTRO;
bool
can_preserve = FALSE;
if
(UNLIKELY(localizing)) {
MAGIC *mg;
HV *stash;
SV **svp;
can_preserve = SvCANEXISTDELETE(av);
if
(SvTYPE(av) == SVt_PVAV) {
SSize_t max = -1;
for
(svp = MARK + 1; svp <= SP; svp++) {
const
SSize_t elem = SvIV(*svp);
if
(elem > max)
max = elem;
}
if
(max > AvMAX(av))
av_extend(av, max);
}
}
while
(++MARK <= SP) {
SV *
const
elemsv = *MARK;
if
(UNLIKELY(localizing)) {
if
(SvTYPE(av) == SVt_PVAV)
S_localise_aelem_lval(aTHX_ av, elemsv, can_preserve);
else
S_localise_helem_lval(aTHX_ (HV *)av, elemsv, can_preserve);
}
*MARK = newSV_type_mortal(SVt_PVMG);
sv_magic(*MARK,(SV *)av,PERL_MAGIC_lvref,(
char
*)elemsv,HEf_SVKEY);
}
RETURN;
}
PP(pp_lvavref)
{
if
(PL_op->op_flags & OPf_STACKED)
Perl_pp_rv2av(aTHX);
else
Perl_pp_padav(aTHX);
{
rpp_extend(1);
PL_stack_sp[1] = PL_stack_sp[0];
PL_stack_sp[0] = NULL;
PL_stack_sp++;
return
NORMAL;
}
}
PP(pp_anonconst)
{
SV *sv = *PL_stack_sp;
CV* constsub = newCONSTSUB(
SvTYPE(CopSTASH(PL_curcop))==SVt_PVHV ? CopSTASH(PL_curcop) : NULL,
NULL,
SvREFCNT_inc_simple_NN(sv)
);
SV* ret_sv = sv_2mortal((SV *)constsub);
if
(LIKELY(PL_op->op_flags & OPf_REF)) {
ret_sv = refto(ret_sv);
}
rpp_replace_1_1_NN(ret_sv);
return
NORMAL;
}
PP_wrapped(pp_argelem,
!!( (PL_op->op_private & OPpARGELEM_MASK) == OPpARGELEM_SV
&& (PL_op->op_flags & OPf_STACKED)),
0)
{
dTARG;
SV *val;
SV ** padentry;
OP *o = PL_op;
AV *defav = GvAV(PL_defgv);
IV ix = PTR2IV(cUNOP_AUXo->op_aux);
IV argc;
padentry = &(PAD_SVl(o->op_targ));
save_clearsv(padentry);
targ = *padentry;
if
((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_SV) {
if
(o->op_flags & OPf_STACKED) {
dSP;
val = POPs;
PUTBACK;
}
else
{
SV **svp;
assert
(ix >= 0);
#if IVSIZE > PTRSIZE
assert
(ix <= SSize_t_MAX);
#endif
svp = av_fetch(defav, ix, FALSE);
val = svp ? *svp : &PL_sv_undef;
}
assert
(TAINTING_get || !TAINT_get);
if
(UNLIKELY(TAINT_get) && !SvTAINTED(val))
TAINT_NOT;
SvSetMagicSV(targ, val);
return
o->op_next;
}
assert
(!(o->op_flags & OPf_STACKED));
argc = ((IV)AvFILL(defav) + 1) - ix;
if
((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_AV) {
IV i;
if
(AvFILL((AV*)targ) > -1) {
for
(i = 0; i < argc; i++) {
SV **svp = av_fetch(defav, ix + i, FALSE);
SV *newsv = newSVsv_flags(svp ? *svp : &PL_sv_undef,
(SV_DO_COW_SVSETSV|SV_NOSTEAL));
if
(!av_store(defav, ix + i, newsv))
SvREFCNT_dec_NN(newsv);
}
av_clear((AV*)targ);
}
if
(argc <= 0)
return
o->op_next;
av_extend((AV*)targ, argc);
i = 0;
while
(argc--) {
SV *tmpsv;
SV **svp = av_fetch(defav, ix + i, FALSE);
SV *val = svp ? *svp : &PL_sv_undef;
tmpsv = newSV_type(SVt_NULL);
sv_setsv(tmpsv, val);
av_store((AV*)targ, i++, tmpsv);
TAINT_NOT;
}
}
else
{
IV i;
assert
((o->op_private & OPpARGELEM_MASK) == OPpARGELEM_HV);
if
(SvRMAGICAL(targ) || HvUSEDKEYS((HV*)targ)) {
for
(i = 0; i < argc; i++) {
SV **svp = av_fetch(defav, ix + i, FALSE);
SV *newsv = newSV_type(SVt_NULL);
sv_setsv_flags(newsv,
svp ? *svp : &PL_sv_undef,
(SV_DO_COW_SVSETSV|SV_NOSTEAL));
if
(!av_store(defav, ix + i, newsv))
SvREFCNT_dec_NN(newsv);
}
hv_clear((HV*)targ);
}
if
(argc <= 0)
return
o->op_next;
assert
(argc % 2 == 0);
i = 0;
while
(argc) {
SV *tmpsv;
SV **svp;
SV *key;
SV *val;
svp = av_fetch(defav, ix + i++, FALSE);
key = svp ? *svp : &PL_sv_undef;
svp = av_fetch(defav, ix + i++, FALSE);
val = svp ? *svp : &PL_sv_undef;
argc -= 2;
if
(UNLIKELY(SvGMAGICAL(key)))
key = sv_mortalcopy(key);
tmpsv = newSV_type(SVt_NULL);
sv_setsv(tmpsv, val);
hv_store_ent((HV*)targ, key, tmpsv, 0);
TAINT_NOT;
}
}
return
o->op_next;
}
PP(pp_argdefelem)
{
OP *
const
o = PL_op;
AV *defav = GvAV(PL_defgv);
IV ix = (IV)o->op_targ;
assert
(ix >= 0);
#if IVSIZE > PTRSIZE
assert
(ix <= SSize_t_MAX);
#endif
if
(AvFILL(defav) < ix)
return
cLOGOPo->op_other;
SV **svp = av_fetch(defav, ix, FALSE);
SV *val = svp ? *svp : &PL_sv_undef;
if
((PL_op->op_private & OPpARG_IF_UNDEF) && !SvOK(val))
return
cLOGOPo->op_other;
if
((PL_op->op_private & OPpARG_IF_FALSE) && !SvTRUE(val))
return
cLOGOPo->op_other;
rpp_xpush_1(val);
return
NORMAL;
}
static
SV *
S_find_runcv_name(
void
)
{
dTHX;
CV *cv;
GV *gv;
SV *sv;
cv = find_runcv(0);
if
(!cv)
return
&PL_sv_no;
gv = CvGV(cv);
if
(!gv)
return
&PL_sv_no;
sv = sv_newmortal();
gv_fullname4(sv, gv, NULL, TRUE);
return
sv;
}
PP(pp_argcheck)
{
OP *
const
o = PL_op;
struct
op_argcheck_aux *aux = (
struct
op_argcheck_aux *)cUNOP_AUXo->op_aux;
UV params = aux->params;
UV opt_params = aux->opt_params;
char
slurpy = aux->slurpy;
AV *defav = GvAV(PL_defgv);
UV argc;
bool
too_few;
assert
(!SvMAGICAL(defav));
argc = (UV)(AvFILLp(defav) + 1);
too_few = (argc < (params - opt_params));
if
(UNLIKELY(too_few || (!slurpy && argc > params)))
Perl_croak_caller(
"Too %s arguments for subroutine '%"
SVf
"' (got %"
UVuf
"; expected %s%"
UVuf
")"
,
too_few ?
"few"
:
"many"
,
S_find_runcv_name(),
argc,
too_few ? (slurpy || opt_params ?
"at least "
:
""
) : (opt_params ?
"at most "
:
""
),
too_few ? (params - opt_params) : params);
if
(UNLIKELY(slurpy ==
'%'
&& argc > params && (argc - params) % 2))
Perl_croak_caller(
"Odd name/value argument for subroutine '%"
SVf
"'"
,
S_find_runcv_name());
return
NORMAL;
}
PP_wrapped(pp_isa, 2, 0)
{
dSP;
SV *left, *right;
right = POPs;
left = TOPs;
SETs(boolSV(sv_isa_sv(left, right)));
RETURN;
}
PP(pp_cmpchain_and)
{
SV *result = PL_stack_sp[0];
if
(SvTRUE_NN(result)) {
rpp_popfree_1_NN();
return
cLOGOP->op_other;
}
else
{
rpp_replace_2_1_NN(result);
return
NORMAL;
}
}
PP(pp_cmpchain_dup)
{
SV *right = PL_stack_sp[0];
SV *left = PL_stack_sp[-1];
PL_stack_sp[-1] = right;
PL_stack_sp[0] = left;
rpp_xpush_1(right);
return
NORMAL;
}
PP(pp_is_bool)
{
SV *arg = *PL_stack_sp;
SvGETMAGIC(arg);
rpp_replace_1_IMM_NN(boolSV(SvIsBOOL(arg)));
return
NORMAL;
}
PP(pp_is_weak)
{
SV *arg = *PL_stack_sp;
SvGETMAGIC(arg);
rpp_replace_1_IMM_NN(boolSV(SvWEAKREF(arg)));
return
NORMAL;
}
PP(pp_weaken)
{
sv_rvweaken(*PL_stack_sp);
rpp_popfree_1_NN();
return
NORMAL;
}
PP(pp_unweaken)
{
sv_rvunweaken(*PL_stack_sp);
rpp_popfree_1_NN();
return
NORMAL;
}
PP(pp_blessed)
{
SV *arg = *PL_stack_sp;
SV *rv, *ret;
SvGETMAGIC(arg);
if
(!SvROK(arg) || !SvOBJECT((rv = SvRV(arg)))) {
ret = &PL_sv_undef;
goto
ret;
}
if
((PL_op->op_private & OPpTRUEBOOL) ||
((PL_op->op_private & OPpMAYBE_TRUEBOOL) && (block_gimme() == G_VOID))) {
HV *stash = SvSTASH(rv);
HEK *hek = HvNAME_HEK(stash);
if
(!hek)
goto
fallback;
I32 len = HEK_LEN(hek);
if
(UNLIKELY(len == HEf_SVKEY || (len == 1 && HEK_KEY(hek)[0] ==
'0'
)))
goto
fallback;
ret = &PL_sv_yes;
goto
ret;
}
else
{
fallback:
ret = (sv_ref(NULL, rv, TRUE));
}
ret:
rpp_replace_1_1_NN(ret);
return
NORMAL;
}
PP(pp_is_tainted)
{
SV *arg = *PL_stack_sp;
SvGETMAGIC(arg);
rpp_replace_1_IMM_NN(boolSV(SvTAINTED(arg)));
return
NORMAL;
}