/* vi: set ft=c inde=: */
#define COP_SEQ_RANGE_LOW_set(SV, VAL) \
- do { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xlow = (VAL); } while (0)
+ STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xlow = (VAL); } STMT_END
#define COP_SEQ_RANGE_HIGH_set(SV, VAL) \
- do { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xhigh = (VAL); } while (0)
+ STMT_START { ((XPVNV*)SvANY(SV))->xnv_u.xpad_cop_seq.xhigh = (VAL); } STMT_END
static void S_pad_block_start(pTHX_ int full) {
dVAR;
dVAR;
const int retval = PL_savestack_ix;
- S_pad_block_start(full);
+ S_pad_block_start(aTHX_ full);
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
SAVECOMPILEWARNINGS();
switch (o->op_type) {
case OP_REPEAT:
- S_scalar(cBINOPo->op_first);
+ S_scalar(aTHX_ cBINOPo->op_first);
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
- S_scalar(kid);
+ S_scalar(aTHX_ kid);
break;
/* FALL THROUGH */
case OP_SPLIT:
default:
if (o->op_flags & OPf_KIDS) {
for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
- S_scalar(kid);
+ S_scalar(aTHX_ kid);
}
break;
case OP_LEAVE:
case OP_LEAVETRY:
kid = cLISTOPo->op_first;
- S_scalar(kid);
+ S_scalar(aTHX_ kid);
kid = kid->op_sibling;
do_kids:
while (kid) {
OP *sib = kid->op_sibling;
if (sib && kid->op_type != OP_LEAVEWHEN)
- S_scalarvoid(kid);
+ S_scalarvoid(aTHX_ kid);
else
- S_scalar(kid);
+ S_scalar(aTHX_ kid);
kid = sib;
}
PL_curcop = &PL_compiling;
if (o && o->op_flags & OPf_KIDS) {
OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
- S_scalar(kid);
+ S_scalar(aTHX_ kid);
}
return o;
}
(PL_opargs[o->op_type] & OA_TARGLEX)
/* OPp share the meaning */
) {
- return S_scalar(o); /* As if inside SASSIGN */
+ return S_scalar(aTHX_ o); /* As if inside SASSIGN */
}
o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
case OP_SPRINTF:
case OP_AELEM:
case OP_AELEMFAST:
- case OP_AELEMFAST_LEX:
+ IF_HAVE_PERL_5_16(case OP_AELEMFAST_LEX:, )
case OP_ASLICE:
case OP_HELEM:
case OP_HSLICE:
case OP_GGRGID:
case OP_GETLOGIN:
case OP_PROTOTYPE:
- case OP_RUNCV:
+ IF_HAVE_PERL_5_16(case OP_RUNCV:, )
func_ops:
if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)))
/* Otherwise it's "Useless use of grep iterator" */
}
case OP_AASSIGN: {
- S_inplace_aassign(o);
+ S_inplace_aassign(aTHX_ o);
break;
}
case OP_ENTERGIVEN:
case OP_ENTERWHEN:
for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
- S_scalarvoid(kid);
+ S_scalarvoid(aTHX_ kid);
break;
case OP_NULL:
case OP_LEAVEGIVEN:
case OP_LEAVEWHEN:
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
- S_scalarvoid(kid);
+ S_scalarvoid(aTHX_ kid);
break;
case OP_ENTEREVAL:
- S_scalarkids(o);
+ S_scalarkids(aTHX_ o);
break;
case OP_SCALAR:
- return S_scalar(o);
+ return S_scalar(aTHX_ o);
}
if (useless)
Perl_ck_warner(aTHX_ packWARN(WARN_VOID), "Useless use of %"SVf" in void context",
OP *kid;
for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
if (kid->op_sibling) {
- S_scalarvoid(kid);
+ S_scalarvoid(aTHX_ kid);
}
}
PL_curcop = &PL_compiling;
static OP *S_block_end(pTHX_ I32 floor, OP *seq) {
dVAR;
const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
- OP *retval = S_scalarseq(seq);
+ OP *retval = S_scalarseq(aTHX_ seq);
CALL_BLOCK_HOOKS(bhk_pre_end, &retval);
CopHINTS_set(&PL_compiling, PL_hints);
if (needblockscope)
PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
- S_pad_leavemy();
+ S_pad_leavemy(aTHX);
CALL_BLOCK_HOOKS(bhk_post_end, &retval);
return retval;
}
+
+
+#ifndef pad_alloc
+
+#define pad_alloc(OPTYPE, TMPTYPE) \
+ S_pad_alloc(aTHX_ OPTYPE, TMPTYPE)
+
+static PADOFFSET S_pad_alloc(pTHX_ I32 optype, U32 tmptype) {
+ dVAR;
+ SV *sv;
+ I32 retval;
+
+ PERL_UNUSED_ARG(optype);
+ ASSERT_CURPAD_ACTIVE("pad_alloc");
+
+ if (AvARRAY(PL_comppad) != PL_curpad)
+ Perl_croak(aTHX_ "panic: pad_alloc");
+ PL_pad_reset_pending = FALSE;
+ if (tmptype & SVs_PADMY) {
+ sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
+ retval = AvFILLp(PL_comppad);
+ }
+ else {
+ SV * const * const names = AvARRAY(PL_comppad_name);
+ const SSize_t names_fill = AvFILLp(PL_comppad_name);
+ for (;;) {
+ /*
+ * "foreach" index vars temporarily become aliases to non-"my"
+ * values. Thus we must skip, not just pad values that are
+ * marked as current pad values, but also those with names.
+ */
+ /* HVDS why copy to sv here? we don't seem to use it */
+ if (++PL_padix <= names_fill &&
+ (sv = names[PL_padix]) && sv != &PL_sv_undef)
+ continue;
+ sv = *av_fetch(PL_comppad, PL_padix, TRUE);
+ if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
+ !IS_PADGV(sv) && !IS_PADCONST(sv))
+ break;
+ }
+ retval = PL_padix;
+ }
+ SvFLAGS(sv) |= tmptype;
+ PL_curpad = AvARRAY(PL_comppad);
+
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
+ PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
+ PL_op_name[optype]));
+#ifdef DEBUG_LEAKING_SCALARS
+ sv->sv_debug_optype = optype;
+ sv->sv_debug_inpad = 1;
+#endif
+ return (PADOFFSET)retval;
+}
+
+#endif
+
+
+#ifndef pad_add_name_sv
+
+#define pad_add_name_sv(NAMESV, FLAGS, TYPESTASH, OURSTASH) \
+ S_pad_add_name_sv(aTHX_ NAMESV, FLAGS, TYPESTASH, OURSTASH)
+
+static PADOFFSET S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash) {
+ dVAR;
+ const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+
+ assert(flags == 0);
+
+ ASSERT_CURPAD_ACTIVE("pad_alloc_name");
+
+ if (typestash) {
+ assert(SvTYPE(namesv) == SVt_PVMG);
+ SvPAD_TYPED_on(namesv);
+ SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+ }
+ if (ourstash) {
+ SvPAD_OUR_on(namesv);
+ SvOURSTASH_set(namesv, ourstash);
+ SvREFCNT_inc_simple_void_NN(ourstash);
+ }
+
+ av_store(PL_comppad_name, offset, namesv);
+ return offset;
+}
+
+PADOFFSET static S_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags, HV *typestash, HV *ourstash) {
+ dVAR;
+ PADOFFSET offset;
+ SV *namesv;
+
+ assert(flags == 0);
+
+ namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
+
+ sv_setpvn(namesv, namepv, namelen);
+
+ offset = S_pad_alloc_name(aTHX_ namesv, flags, typestash, ourstash);
+
+ /* not yet introduced */
+ COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
+ COP_SEQ_RANGE_HIGH_set(namesv, 0);
+
+ if (!PL_min_intro_pending)
+ PL_min_intro_pending = offset;
+ PL_max_intro_pending = offset;
+ /* if it's not a simple scalar, replace with an AV or HV */
+ assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
+ assert(SvREFCNT(PL_curpad[offset]) == 1);
+ if (namelen != 0 && *namepv == '@')
+ sv_upgrade(PL_curpad[offset], SVt_PVAV);
+ else if (namelen != 0 && *namepv == '%')
+ sv_upgrade(PL_curpad[offset], SVt_PVHV);
+ assert(SvPADMY(PL_curpad[offset]));
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+ (long)offset, SvPVX(namesv),
+ PTR2UV(PL_curpad[offset])));
+
+ return offset;
+}
+
+static PADOFFSET S_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash) {
+ char *namepv;
+ STRLEN namelen;
+ assert(flags == 0);
+ namepv = SvPV(name, namelen);
+ return S_pad_add_name_pvn(aTHX_ namepv, namelen, flags, typestash, ourstash);
+}
+
+#endif
projects / p5sagit/Function-Parameters.git / blobdiff