* and no knowing what you'll find around a corner. And Elves, sir!" --Samwise
*/
+/* This file contains general pp ("push/pop") functions that execute the
+ * opcodes that make up a perl program. A typical pp function expects to
+ * find its arguments on the stack, and usually pushes its results onto
+ * the stack, hence the 'pp' terminology. Each OP structure contains
+ * a pointer to the relevant pp_foo() function.
+ */
+
#include "EXTERN.h"
#define PERL_IN_PP_C
#include "perl.h"
/* If this is a 'my' scalar and flag is set then vivify
* NI-S 1999/05/07
*/
+ if (SvREADONLY(sv))
+ Perl_croak(aTHX_ PL_no_modify);
if (PL_op->op_private & OPpDEREF) {
char *name;
GV *gv;
if (SvTYPE(sv) < SVt_RV)
sv_upgrade(sv, SVt_RV);
if (SvPVX(sv)) {
- (void)SvOOK_off(sv); /* backoff */
+ SvOOK_off(sv); /* backoff */
if (SvLEN(sv))
Safefree(SvPVX(sv));
SvLEN(sv)=SvCUR(sv)=0;
break;
default:
if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
- (void)SvOOK_off(sv);
+ SvOOK_off(sv);
Safefree(SvPVX(sv));
SvPV_set(sv, Nullch);
SvLEN_set(sv, 0);
}
- (void)SvOK_off(sv);
+ SvOK_off(sv);
SvSETMAGIC(sv);
}
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
- SP--;
- SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s)));
- RETURN;
- }
+ if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
+ SP--;
+ SETs(boolSV(SvRV(TOPs) < SvRV(TOPp1s)));
+ RETURN;
+ }
#endif
{
dPOPnv;
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) > SvRV(TOPp1s)));
RETURN;
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) <= SvRV(TOPp1s)));
RETURN;
#ifdef PERL_PRESERVE_IVUV
else
#endif
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) >= SvRV(TOPp1s)));
RETURN;
{
dSP; tryAMAGICbinSET(ne,0);
#ifndef NV_PRESERVES_UV
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
SP--;
SETs(boolSV(SvRV(TOPs) != SvRV(TOPp1s)));
RETURN;
{
dSP; dTARGET; tryAMAGICbin(ncmp,0);
#ifndef NV_PRESERVES_UV
- if (SvROK(TOPs) && SvROK(TOPm1s)) {
+ if (SvROK(TOPs) && !SvAMAGIC(TOPs) && SvROK(TOPm1s) && !SvAMAGIC(TOPm1s)) {
UV right = PTR2UV(SvRV(POPs));
UV left = PTR2UV(SvRV(TOPs));
SETi((left > right) - (left < right));
sv_magic(TARG, Nullsv, PERL_MAGIC_substr, Nullch, 0);
}
else
- (void)SvOK_off(TARG);
+ SvOK_off(TARG);
LvTYPE(TARG) = 'x';
if (LvTARG(TARG) != sv) {
}
if (GIMME != G_ARRAY) {
MARK = ORIGMARK;
- *++MARK = *SP;
+ *++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef;
SP = MARK;
}
RETURN;
}
if (GIMME != G_ARRAY) {
MARK = ORIGMARK;
- *++MARK = *SP;
+ *++MARK = SP > ORIGMARK ? *SP : &PL_sv_undef;
SP = MARK;
}
RETURN;
if (newlen && !AvREAL(ary) && AvREIFY(ary))
av_reify(ary);
+ /* make new elements SVs now: avoid problems if they're from the array */
+ for (dst = MARK, i = newlen; i; i--) {
+ SV *h = *dst;
+ *dst = NEWSV(46, 0);
+ sv_setsv(*dst++, h);
+ }
+
if (diff < 0) { /* shrinking the area */
if (newlen) {
New(451, tmparyval, newlen, SV*); /* so remember insertion */
dst[--i] = &PL_sv_undef;
if (newlen) {
- for (src = tmparyval, dst = AvARRAY(ary) + offset;
- newlen; newlen--) {
- *dst = NEWSV(46, 0);
- sv_setsv(*dst++, *src++);
- }
+ Copy( tmparyval, AvARRAY(ary) + offset, newlen, SV* );
Safefree(tmparyval);
}
}
}
}
- for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
- *dst = NEWSV(46, 0);
- sv_setsv(*dst++, *src++);
+ if (newlen) {
+ Copy( MARK, AvARRAY(ary) + offset, newlen, SV* );
}
+
MARK = ORIGMARK + 1;
if (GIMME == G_ARRAY) { /* copy return vals to stack */
if (length) {
I32 origlimit = limit;
I32 realarray = 0;
I32 base;
- AV *oldstack = PL_curstack;
I32 gimme = GIMME_V;
I32 oldsave = PL_savestack_ix;
I32 make_mortal = 1;
+ bool multiline = 0;
MAGIC *mg = (MAGIC *) NULL;
#ifdef DEBUGGING
AvARRAY(ary)[i] = &PL_sv_undef; /* don't free mere refs */
}
/* temporarily switch stacks */
- SWITCHSTACK(PL_curstack, ary);
- PL_curstackinfo->si_stack = ary;
+ SAVESWITCHSTACK(PL_curstack, ary);
make_mortal = 0;
}
}
s++;
}
}
- if ((int)(pm->op_pmflags & PMf_MULTILINE) != PL_multiline) {
- SAVEINT(PL_multiline);
- PL_multiline = pm->op_pmflags & PMf_MULTILINE;
+ if (pm->op_pmflags & PMf_MULTILINE) {
+ multiline = 1;
}
if (!limit)
#ifndef lint
while (s < strend && --limit &&
(m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
- csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
+ csv, multiline ? FBMrf_MULTILINE : 0)) )
#endif
{
dstr = NEWSV(31, m-s);
}
}
- LEAVE_SCOPE(oldsave);
iters = (SP - PL_stack_base) - base;
if (iters > maxiters)
DIE(aTHX_ "Split loop");
}
}
+ PUTBACK;
+ LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */
+ SPAGAIN;
if (realarray) {
if (!mg) {
- SWITCHSTACK(ary, oldstack);
- PL_curstackinfo->si_stack = oldstack;
if (SvSMAGICAL(ary)) {
PUTBACK;
mg_set((SV*)ary);