PP(pp_padav)
{
dSP; dTARGET;
- I32 gimme;
+ U8 gimme;
assert(SvTYPE(TARG) == SVt_PVAV);
if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO ))
if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) ))
SAVECLEARSV(PAD_SVl(PL_op->op_targ));
EXTEND(SP, 1);
+
if (PL_op->op_flags & OPf_REF) {
PUSHs(TARG);
RETURN;
- } else if (PL_op->op_private & OPpMAYBE_LVSUB) {
- const I32 flags = is_lvalue_sub();
- if (flags && !(flags & OPpENTERSUB_INARGS)) {
- if (GIMME_V == G_SCALAR)
- /* diag_listed_as: Can't return %s to lvalue scalar context */
- Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
- PUSHs(TARG);
- RETURN;
+ }
+ else if (PL_op->op_private & OPpMAYBE_LVSUB) {
+ const I32 flags = is_lvalue_sub();
+ if (flags && !(flags & OPpENTERSUB_INARGS)) {
+ if (GIMME_V == G_SCALAR)
+ /* diag_listed_as: Can't return %s to lvalue scalar context */
+ Perl_croak(aTHX_ "Can't return array to lvalue scalar context");
+ PUSHs(TARG);
+ RETURN;
}
}
+
gimme = GIMME_V;
if (gimme == G_ARRAY) {
/* XXX see also S_pushav in pp_hot.c */
PP(pp_padhv)
{
dSP; dTARGET;
- I32 gimme;
+ U8 gimme;
assert(SvTYPE(TARG) == SVt_PVHV);
XPUSHs(TARG);
if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO ))
if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) ))
SAVECLEARSV(PAD_SVl(PL_op->op_targ));
+
if (PL_op->op_flags & OPf_REF)
RETURN;
else if (PL_op->op_private & OPpMAYBE_LVSUB) {
- const I32 flags = is_lvalue_sub();
- if (flags && !(flags & OPpENTERSUB_INARGS)) {
- if (GIMME_V == G_SCALAR)
- /* diag_listed_as: Can't return %s to lvalue scalar context */
- Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
- RETURN;
- }
+ const I32 flags = is_lvalue_sub();
+ if (flags && !(flags & OPpENTERSUB_INARGS)) {
+ if (GIMME_V == G_SCALAR)
+ /* diag_listed_as: Can't return %s to lvalue scalar context */
+ Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
+ RETURN;
+ }
}
+
gimme = GIMME_V;
if (gimme == G_ARRAY) {
RETURNOP(Perl_do_kv(aTHX));
else if ((PL_op->op_private & OPpTRUEBOOL
|| ( PL_op->op_private & OPpMAYBE_TRUEBOOL
&& block_gimme() == G_VOID ))
- && (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied)))
+ && (!SvRMAGICAL(TARG) || !mg_find(TARG, PERL_MAGIC_tied))
+ )
SETs(HvUSEDKEYS(TARG) ? &PL_sv_yes : sv_2mortal(newSViv(0)));
else if (gimme == G_SCALAR) {
SV* const sv = Perl_hv_scalar(aTHX_ MUTABLE_HV(TARG));
break;
case 'F':
if (len == 10 && strEQ(second_letter, "ILEHANDLE")) {
- /* finally deprecated in 5.8.0 */
- deprecate("*glob{FILEHANDLE}");
tmpRef = MUTABLE_SV(GvIOp(gv));
}
else
NV nr = SvNVX(svr);
NV result;
- il = (IV)nl;
- ir = (IV)nr;
- if (nl == (NV)il && nr == (NV)ir)
+ if (
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
+ && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
+#else
+ nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
+#endif
+ )
/* nothing was lost by converting to IVs */
goto do_iv;
SP--;
result = nl * nr;
-# if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN && NVSIZE == 16
+# 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);
}
NV result = left * right;
(void)POPs;
-#if defined(__sgi) && defined(USE_LONG_DOUBLE) && LONG_DOUBLEKIND == LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN && NVSIZE == 16
+#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);
}
NV nl = SvNVX(svl);
NV nr = SvNVX(svr);
- il = (IV)nl;
- ir = (IV)nr;
- if (nl == (NV)il && nr == (NV)ir)
+ if (
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+ !Perl_isnan(nl) && nl == (NV)(il = (IV)nl)
+ && !Perl_isnan(nr) && nr == (NV)(ir = (IV)nr)
+#else
+ nl == (NV)(il = (IV)nl) && nr == (NV)(ir = (IV)nr)
+#endif
+ )
/* nothing was lost by converting to IVs */
goto do_iv;
SP--;
U8 *result;
U8 *p;
+ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+ deprecated_above_ff_msg, PL_op_desc[PL_op->op_type]);
Newx(result, targlen + 1, U8);
p = result;
while (tmps < send) {
}
}
-#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) \
- && ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
-STATIC
-PP(pp_i_modulo_0)
-#else
PP(pp_i_modulo)
-#endif
{
/* This is the vanilla old i_modulo. */
dSP; dATARGET;
}
}
-#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) \
+#if defined(__GLIBC__) && IVSIZE == 8 \
&& ( __GLIBC__ < 2 || (__GLIBC__ == 2 && __GLIBC_MINOR__ < 8))
-STATIC
-PP(pp_i_modulo_1)
+PP(pp_i_modulo_glibc_bugfix)
{
/* This is the i_modulo with the workaround for the _moddi3 bug
* in (at least) glibc 2.2.5 (the PERL_ABS() the workaround).
RETURN;
}
}
-
-PP(pp_i_modulo)
-{
- dVAR; dSP; dATARGET;
- tryAMAGICbin_MG(modulo_amg, AMGf_assign);
- {
- dPOPTOPiirl_nomg;
- if (!right)
- DIE(aTHX_ "Illegal modulus zero");
- /* The assumption is to use hereafter the old vanilla version... */
- PL_op->op_ppaddr =
- PL_ppaddr[OP_I_MODULO] =
- Perl_pp_i_modulo_0;
- /* .. but if we have glibc, we might have a buggy _moddi3
- * (at least glibc 2.2.5 is known to have this bug), in other
- * words our integer modulus with negative quad as the second
- * argument might be broken. Test for this and re-patch the
- * opcode dispatch table if that is the case, remembering to
- * also apply the workaround so that this first round works
- * right, too. See [perl #9402] for more information. */
- {
- IV l = 3;
- IV r = -10;
- /* Cannot do this check with inlined IV constants since
- * that seems to work correctly even with the buggy glibc. */
- if (l % r == -3) {
- /* Yikes, we have the bug.
- * Patch in the workaround version. */
- PL_op->op_ppaddr =
- PL_ppaddr[OP_I_MODULO] =
- &Perl_pp_i_modulo_1;
- /* Make certain we work right this time, too. */
- right = PERL_ABS(right);
- }
- }
- /* avoid FPE_INTOVF on some platforms when left is IV_MIN */
- if (right == -1)
- SETi( 0 );
- else
- SETi( left % right );
- RETURN;
- }
-}
#endif
PP(pp_i_add)
} else {
/* 2s complement assumption. Also, not really needed as
IV_MIN and -IV_MIN should both be %100...00 and NV-able */
- SETu(IV_MIN);
+ SETu((UV)IV_MIN);
}
}
}
/* We may be able to get away with changing only the first character, in
* place, but not if read-only, etc. Later we may discover more reasons to
* not convert in-place. */
- inplace = !SvREADONLY(source)
- && ( SvPADTMP(source)
- || ( SvTEMP(source) && !SvSMAGICAL(source)
- && SvREFCNT(source) == 1));
+ inplace = !SvREADONLY(source) && SvPADTMP(source);
/* First calculate what the changed first character should be. This affects
* whether we can just swap it out, leaving the rest of the string unchanged,
SvGETMAGIC(source);
- if ((SvPADTMP(source)
- ||
- (SvTEMP(source) && !SvSMAGICAL(source) && SvREFCNT(source) == 1))
+ if ( SvPADTMP(source)
&& !SvREADONLY(source) && SvPOK(source)
&& !DO_UTF8(source)
&& (
SvGETMAGIC(source);
- if ( ( SvPADTMP(source)
- || ( SvTEMP(source) && !SvSMAGICAL(source)
- && SvREFCNT(source) == 1 )
- )
+ if ( SvPADTMP(source)
&& !SvREADONLY(source) && SvPOK(source)
&& !DO_UTF8(source)) {
{
dSP;
AV *array = MUTABLE_AV(POPs);
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
IV *iterp = Perl_av_iter_p(aTHX_ array);
const IV current = (*iterp)++;
{
dSP;
AV *array = MUTABLE_AV(POPs);
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
*Perl_av_iter_p(aTHX_ array) = 0;
dSP;
HV * hash = MUTABLE_HV(POPs);
HE *entry;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
entry = hv_iternext(hash);
S_do_delete_local(pTHX)
{
dSP;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
const MAGIC *mg;
HV *stash;
const bool sliced = !!(PL_op->op_private & OPpSLICE);
PP(pp_delete)
{
dSP;
- I32 gimme;
+ U8 gimme;
I32 discard;
if (PL_op->op_private & OPpLVAL_INTRO)
RETURN;
}
-static AV *
-S_deref_plain_array(pTHX_ AV *ary)
-{
- if (SvTYPE(ary) == SVt_PVAV) return ary;
- SvGETMAGIC((SV *)ary);
- if (!SvROK(ary) || SvTYPE(SvRV(ary)) != SVt_PVAV)
- Perl_die(aTHX_ "Not an ARRAY reference");
- else if (SvOBJECT(SvRV(ary)))
- Perl_die(aTHX_ "Not an unblessed ARRAY reference");
- return (AV *)SvRV(ary);
-}
-
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define DEREF_PLAIN_ARRAY(ary) \
- ({ \
- AV *aRrRay = ary; \
- SvTYPE(aRrRay) == SVt_PVAV \
- ? aRrRay \
- : S_deref_plain_array(aTHX_ aRrRay); \
- })
-#else
-# define DEREF_PLAIN_ARRAY(ary) \
- ( \
- PL_Sv = (SV *)(ary), \
- SvTYPE(PL_Sv) == SVt_PVAV \
- ? (AV *)PL_Sv \
- : S_deref_plain_array(aTHX_ (AV *)PL_Sv) \
- )
-#endif
-
PP(pp_splice)
{
dSP; dMARK; dORIGMARK;
int num_args = (SP - MARK);
- AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+ AV *ary = MUTABLE_AV(*++MARK);
SV **src;
SV **dst;
SSize_t i;
PP(pp_push)
{
dSP; dMARK; dORIGMARK; dTARGET;
- AV * const ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+ AV * const ary = MUTABLE_AV(*++MARK);
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
{
dSP;
AV * const av = PL_op->op_flags & OPf_SPECIAL
- ? MUTABLE_AV(GvAV(PL_defgv)) : DEREF_PLAIN_ARRAY(MUTABLE_AV(POPs));
+ ? MUTABLE_AV(GvAV(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);
PP(pp_unshift)
{
dSP; dMARK; dORIGMARK; dTARGET;
- AV *ary = DEREF_PLAIN_ARRAY(MUTABLE_AV(*++MARK));
+ AV *ary = MUTABLE_AV(*++MARK);
const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied);
if (mg) {
const IV origlimit = limit;
I32 realarray = 0;
I32 base;
- const I32 gimme = GIMME_V;
+ const U8 gimme = GIMME_V;
bool gimme_scalar;
const I32 oldsave = PL_savestack_ix;
U32 make_mortal = SVs_TEMP;
to return. nextstate usually does this on sub entry, but we need
to run the next op with the caller's hints, so we cannot have a
nextstate. */
- SP = PL_stack_base + cxstack[cxstack_ix].blk_oldsp;
+ SP = PL_stack_base + CX_CUR()->blk_oldsp;
if(!maxargs) RETURN;
);
PUSHs(SvRV(*svp));
if (opnum == OP_UNDEF && SvRV(*svp) == (SV *)PL_defgv
- && cxstack[cxstack_ix].cx_type & CXp_HASARGS) {
+ && CX_CUR()->cx_type & CXp_HASARGS) {
/* Undo @_ localisation, so that sub exit does not undo
part of our undeffing. */
- PERL_CONTEXT *cx = &cxstack[cxstack_ix];
- POP_SAVEARRAY();
- cx->cx_type &= ~ CXp_HASARGS;
- assert(!AvREAL(cx->blk_sub.argarray));
+ PERL_CONTEXT *cx = CX_CUR();
+
+ assert(CxHASARGS(cx));
+ cx_popsub_args(cx);;
+ cx->cx_type &= ~CXp_HASARGS;
}
}
break;