XPUSHs(TARG);
if (PL_op->op_flags & OPf_MOD) {
if (PL_op->op_private & OPpLVAL_INTRO)
- SAVECLEARSV(PL_curpad[PL_op->op_targ]);
+ SAVECLEARSV(PAD_SVl(PL_op->op_targ));
else if (PL_op->op_private & OPpDEREF) {
PUTBACK;
- vivify_ref(PL_curpad[PL_op->op_targ], PL_op->op_private & OPpDEREF);
+ vivify_ref(PAD_SVl(PL_op->op_targ), PL_op->op_private & OPpDEREF);
SPAGAIN;
}
}
}
}
+PP(pp_dor)
+{
+ /* Most of this is lifted straight from pp_defined */
+ dSP;
+ register SV* sv;
+
+ sv = TOPs;
+ if (!sv || !SvANY(sv)) {
+ --SP;
+ RETURNOP(cLOGOP->op_other);
+ }
+
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
+ RETURN;
+ break;
+ case SVt_PVHV:
+ if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
+ RETURN;
+ break;
+ case SVt_PVCV:
+ if (CvROOT(sv) || CvXSUB(sv))
+ RETURN;
+ break;
+ default:
+ if (SvGMAGICAL(sv))
+ mg_get(sv);
+ if (SvOK(sv))
+ RETURN;
+ }
+
+ --SP;
+ RETURNOP(cLOGOP->op_other);
+}
+
PP(pp_add)
{
dSP; dATARGET; bool useleft; tryAMAGICbin(add,opASSIGN);
goto had_magic;
if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
- SETERRNO(EBADF,RMS$_IFI);
+ SETERRNO(EBADF,RMS_IFI);
goto just_say_no;
}
else if (!(fp = IoOFP(io))) {
else if (ckWARN2(WARN_UNOPENED,WARN_CLOSED))
report_evil_fh(gv, io, PL_op->op_type);
}
- SETERRNO(EBADF,IoIFP(io)?RMS$_FAC:RMS$_IFI);
+ SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI);
goto just_say_no;
}
else {
}
SP += maxarg;
}
- else {
+ else if (GIMME_V == G_SCALAR) {
dTARGET;
I32 maxarg = AvFILL(av) + 1;
SETi(maxarg);
tryAMAGICunDEREF(to_hv);
hv = (HV*)SvRV(sv);
- if (SvTYPE(hv) != SVt_PVHV && SvTYPE(hv) != SVt_PVAV)
+ if (SvTYPE(hv) != SVt_PVHV)
DIE(aTHX_ "Not a HASH reference");
if (PL_op->op_flags & OPf_REF) {
SETs((SV*)hv);
}
}
else {
- if (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) {
+ if (SvTYPE(sv) == SVt_PVHV) {
hv = (HV*)sv;
if (PL_op->op_flags & OPf_REF) {
SETs((SV*)hv);
}
else {
dTARGET;
- if (SvTYPE(hv) == SVt_PVAV)
- hv = avhv_keys((AV*)hv);
if (HvFILL(hv))
Perl_sv_setpvf(aTHX_ TARG, "%"IVdf"/%"IVdf,
(IV)HvFILL(hv), (IV)HvMAX(hv) + 1);
}
}
-STATIC int
-S_do_maybe_phash(pTHX_ AV *ary, SV **lelem, SV **firstlelem, SV **relem,
- SV **lastrelem)
-{
- OP *leftop;
- I32 i;
-
- leftop = ((BINOP*)PL_op)->op_last;
- assert(leftop);
- assert(leftop->op_type == OP_NULL && leftop->op_targ == OP_LIST);
- leftop = ((LISTOP*)leftop)->op_first;
- assert(leftop);
- /* Skip PUSHMARK and each element already assigned to. */
- for (i = lelem - firstlelem; i > 0; i--) {
- leftop = leftop->op_sibling;
- assert(leftop);
- }
- if (leftop->op_type != OP_RV2HV)
- return 0;
-
- /* pseudohash */
- if (av_len(ary) > 0)
- av_fill(ary, 0); /* clear all but the fields hash */
- if (lastrelem >= relem) {
- while (relem < lastrelem) { /* gobble up all the rest */
- SV *tmpstr;
- assert(relem[0]);
- assert(relem[1]);
- /* Avoid a memory leak when avhv_store_ent dies. */
- tmpstr = sv_newmortal();
- sv_setsv(tmpstr,relem[1]); /* value */
- relem[1] = tmpstr;
- if (avhv_store_ent(ary,relem[0],tmpstr,0))
- (void)SvREFCNT_inc(tmpstr);
- if (SvMAGICAL(ary) != 0 && SvSMAGICAL(tmpstr))
- mg_set(tmpstr);
- relem += 2;
- TAINT_NOT;
- }
- }
- if (relem == lastrelem)
- return 1;
- return 2;
-}
-
STATIC void
S_do_oddball(pTHX_ HV *hash, SV **relem, SV **firstrelem)
{
if (*relem) {
SV *tmpstr;
- if (ckWARN(WARN_MISC)) {
+ HE *didstore;
+
+ if (ckWARN(WARN_MISC)) {
if (relem == firstrelem &&
SvROK(*relem) &&
(SvTYPE(SvRV(*relem)) == SVt_PVAV ||
Perl_warner(aTHX_ packWARN(WARN_MISC),
"Odd number of elements in hash assignment");
}
- if (SvTYPE(hash) == SVt_PVAV) {
- /* pseudohash */
- tmpstr = sv_newmortal();
- if (avhv_store_ent((AV*)hash,*relem,tmpstr,0))
- (void)SvREFCNT_inc(tmpstr);
- if (SvMAGICAL(hash) && SvSMAGICAL(tmpstr))
- mg_set(tmpstr);
- }
- else {
- HE *didstore;
- tmpstr = NEWSV(29,0);
- didstore = hv_store_ent(hash,*relem,tmpstr,0);
- if (SvMAGICAL(hash)) {
- if (SvSMAGICAL(tmpstr))
- mg_set(tmpstr);
- if (!didstore)
- sv_2mortal(tmpstr);
- }
- }
- TAINT_NOT;
+
+ tmpstr = NEWSV(29,0);
+ didstore = hv_store_ent(hash,*relem,tmpstr,0);
+ if (SvMAGICAL(hash)) {
+ if (SvSMAGICAL(tmpstr))
+ mg_set(tmpstr);
+ if (!didstore)
+ sv_2mortal(tmpstr);
+ }
+ TAINT_NOT;
}
}
case SVt_PVAV:
ary = (AV*)sv;
magic = SvMAGICAL(ary) != 0;
- if (PL_op->op_private & OPpASSIGN_HASH) {
- switch (do_maybe_phash(ary, lelem, firstlelem, relem,
- lastrelem))
- {
- case 0:
- goto normal_array;
- case 1:
- do_oddball((HV*)ary, relem, firstrelem);
- }
- relem = lastrelem + 1;
- break;
- }
- normal_array:
av_clear(ary);
av_extend(ary, lastrelem - relem);
i = 0;
call_method("READLINE", gimme);
LEAVE;
SPAGAIN;
- if (gimme == G_SCALAR)
- SvSetMagicSV_nosteal(TARG, TOPs);
+ if (gimme == G_SCALAR) {
+ SV* result = POPs;
+ SvSetSV_nosteal(TARG, result);
+ PUSHTARG;
+ }
RETURN;
}
fp = Nullfp;
tmplen = SvLEN(sv); /* remember if already alloced */
if (!tmplen)
Sv_Grow(sv, 80); /* try short-buffering it */
- if (type == OP_RCATLINE)
+ offset = 0;
+ if (type == OP_RCATLINE && SvOK(sv)) {
+ if (!SvPOK(sv)) {
+ STRLEN n_a;
+ (void)SvPV_force(sv, n_a);
+ }
offset = SvCUR(sv);
- else
- offset = 0;
+ }
}
else {
sv = sv_2mortal(NEWSV(57, 80));
U32 lval = PL_op->op_flags & OPf_MOD || LVRET;
U32 defer = PL_op->op_private & OPpLVAL_DEFER;
SV *sv;
+#ifdef PERL_COPY_ON_WRITE
+ U32 hash = (SvIsCOW_shared_hash(keysv)) ? SvUVX(keysv) : 0;
+#else
U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0;
+#endif
I32 preeminent = 0;
if (SvTYPE(hv) == SVt_PVHV) {
he = hv_fetch_ent(hv, keysv, lval && !defer, hash);
svp = he ? &HeVAL(he) : 0;
}
- else if (SvTYPE(hv) == SVt_PVAV) {
- if (PL_op->op_private & OPpLVAL_INTRO)
- DIE(aTHX_ "Can't localize pseudo-hash element");
- svp = avhv_fetch_ent((AV*)hv, keysv, lval && !defer, hash);
- }
else {
RETPUSHUNDEF;
}
EXTEND(SP,1);
}
- if (SvFAKE(TARG) && SvREADONLY(TARG))
- sv_force_normal(TARG);
+ if (SvIsCOW(TARG))
+ sv_force_normal_flags(TARG,0);
if (SvREADONLY(TARG)
|| (SvTYPE(TARG) > SVt_PVLV
&& !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))
/* known replacement string? */
if (dstr) {
- c = SvPV(dstr, clen);
- doutf8 = DO_UTF8(dstr);
/* replacement needing upgrading? */
if (DO_UTF8(TARG) && !doutf8) {
- SV *nsv = sv_2mortal(newSVpvn(c, clen));
+ SV *nsv = sv_newmortal();
+ SvSetSV(nsv, dstr);
if (PL_encoding)
sv_recode_to_utf8(nsv, PL_encoding);
else
sv_utf8_upgrade(nsv);
c = SvPV(nsv, clen);
+ doutf8 = TRUE;
+ }
+ else {
+ c = SvPV(dstr, clen);
+ doutf8 = DO_UTF8(dstr);
}
}
else {
if (SP > PL_stack_base + TOPMARK)
sv = *(PL_stack_base + TOPMARK + 1);
else {
- AV *av = (AV*)PL_curpad[0];
+ AV *av = (AV*)PAD_SVl(0);
if (hasargs || !av || AvFILLp(av) < 0
|| !(sv = AvARRAY(av)[0]))
{
AV* av;
I32 items;
#ifdef USE_5005THREADS
- av = (AV*)PL_curpad[0];
+ av = (AV*)PAD_SVl(0);
#else
av = GvAV(PL_defgv);
#endif /* USE_5005THREADS */
dMARK;
register I32 items = SP - MARK;
AV* padlist = CvPADLIST(cv);
- SV** svp = AvARRAY(padlist);
push_return(PL_op->op_next);
PUSHBLOCK(cx, CXt_SUB, MARK);
PUSHSUB(cx);
*/
if (CvDEPTH(cv) < 2)
(void)SvREFCNT_inc(cv);
- else { /* save temporaries on recursion? */
+ else {
PERL_STACK_OVERFLOW_CHECK();
- if (CvDEPTH(cv) > AvFILLp(padlist)) {
- AV *av;
- AV *newpad = newAV();
- SV **oldpad = AvARRAY(svp[CvDEPTH(cv)-1]);
- I32 ix = AvFILLp((AV*)svp[1]);
- I32 names_fill = AvFILLp((AV*)svp[0]);
- svp = AvARRAY(svp[0]);
- for ( ;ix > 0; ix--) {
- if (names_fill >= ix && svp[ix] != &PL_sv_undef) {
- char *name = SvPVX(svp[ix]);
- if ((SvFLAGS(svp[ix]) & SVf_FAKE) /* outer lexical? */
- || *name == '&') /* anonymous code? */
- {
- av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
- }
- else { /* our own lexical */
- if (*name == '@')
- av_store(newpad, ix, sv = (SV*)newAV());
- else if (*name == '%')
- av_store(newpad, ix, sv = (SV*)newHV());
- else
- av_store(newpad, ix, sv = NEWSV(0,0));
- SvPADMY_on(sv);
- }
- }
- else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
- av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
- }
- else {
- av_store(newpad, ix, sv = NEWSV(0,0));
- SvPADTMP_on(sv);
- }
- }
- av = newAV(); /* will be @_ */
- av_extend(av, 0);
- av_store(newpad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
- av_store(padlist, CvDEPTH(cv), (SV*)newpad);
- AvFILLp(padlist) = CvDEPTH(cv);
- svp = AvARRAY(padlist);
- }
+ pad_push(padlist, CvDEPTH(cv), 1);
}
#ifdef USE_5005THREADS
if (!hasargs) {
- AV* av = (AV*)PL_curpad[0];
+ AV* av = (AV*)PAD_SVl(0);
items = AvFILLp(av) + 1;
if (items) {
}
}
#endif /* USE_5005THREADS */
- SAVEVPTR(PL_curpad);
- PL_curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
+ PAD_SET_CUR(padlist, CvDEPTH(cv));
#ifndef USE_5005THREADS
if (hasargs)
#endif /* USE_5005THREADS */
DEBUG_S(PerlIO_printf(Perl_debug_log,
"%p entersub preparing @_\n", thr));
#endif
- av = (AV*)PL_curpad[0];
+ av = (AV*)PAD_SVl(0);
if (AvREAL(av)) {
/* @_ is normally not REAL--this should only ever
* happen when DB::sub() calls things that modify @_ */
cx->blk_sub.savearray = GvAV(PL_defgv);
GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
#endif /* USE_5005THREADS */
- cx->blk_sub.oldcurpad = PL_curpad;
+ CX_CURPAD_SAVE(cx->blk_sub);
cx->blk_sub.argarray = av;
++MARK;
projects / p5sagit/p5-mst-13.2.git / blobdiff