/* pad.c
*
- * Copyright (C) 2002, 2003, 2004, by Larry Wall and others
+ * Copyright (C) 2002, 2003, 2004, 2005 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
AV * const a0 = newAV(); /* will be @_ */
av_extend(a0, 0);
av_store(pad, 0, (SV*)a0);
- AvFLAGS(a0) = AVf_REIFY;
+ AvREIFY_only(a0);
}
else {
av_store(pad, 0, Nullsv);
AV *comppad = (AV*)AvARRAY(padlist)[1];
SV **curpad = AvARRAY(comppad);
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
- SV *namesv = namepad[ix];
+ SV * const namesv = namepad[ix];
if (namesv && namesv != &PL_sv_undef
- && *SvPVX(namesv) == '&')
+ && *SvPVX_const(namesv) == '&')
{
CV * const innercv = (CV*)curpad[ix];
+ U32 inner_rc = SvREFCNT(innercv);
+ assert(inner_rc);
namepad[ix] = Nullsv;
SvREFCNT_dec(namesv);
if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
curpad[ix] = Nullsv;
SvREFCNT_dec(innercv);
+ inner_rc--;
}
- if (SvREFCNT(innercv) /* in use, not just a prototype */
+ if (inner_rc /* in use, not just a prototype */
&& CvOUTSIDE(innercv) == cv)
{
assert(CvWEAKOUTSIDE(innercv));
PADOFFSET
Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake)
{
- PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+ const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
SV* namesv = NEWSV(1102, 0);
ASSERT_CURPAD_ACTIVE("pad_add_name");
if (typestash) {
SvFLAGS(namesv) |= SVpad_TYPED;
- SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
+ SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
}
if (ourstash) {
SvFLAGS(namesv) |= SVpad_OUR;
}
else {
/* not yet introduced */
- SvNVX(namesv) = (NV)PAD_MAX; /* min */
- SvIVX(namesv) = 0; /* max */
+ SvNV_set(namesv, (NV)PAD_MAX); /* min */
+ SvIV_set(namesv, 0); /* max */
if (!PL_min_intro_pending)
PL_min_intro_pending = offset;
"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;
}
name = NEWSV(1106, 0);
sv_upgrade(name, SVt_PVNV);
sv_setpvn(name, "&", 1);
- SvIVX(name) = -1;
- SvNVX(name) = 1;
+ SvIV_set(name, -1);
+ SvNV_set(name, 1);
ix = pad_alloc(op_type, SVs_PADMY);
av_store(PL_comppad_name, ix, name);
/* XXX DAPM use PL_curpad[] ? */
&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& (!is_our
|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
- && strEQ(name, SvPVX(sv)))
+ && strEQ(name, SvPVX_const(sv)))
{
Perl_warner(aTHX_ packWARN(WARN_MISC),
"\"%s\" variable %s masks earlier declaration in same %s",
&& !SvFAKE(sv)
&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
- && strEQ(name, SvPVX(sv)))
+ && strEQ(name, SvPVX_const(sv)))
{
Perl_warner(aTHX_ packWARN(WARN_MISC),
"\"our\" variable %s redeclared", name);
if (namesv && namesv != &PL_sv_undef
&& !SvFAKE(namesv)
&& (SvFLAGS(namesv) & SVpad_OUR)
- && strEQ(SvPVX(namesv), name)
+ && strEQ(SvPVX_const(namesv), name)
&& U_32(SvNVX(namesv)) == PAD_MAX /* min */
)
return offset;
for (offset = AvFILLp(nameav); offset > 0; offset--) {
const SV *namesv = name_svp[offset];
if (namesv && namesv != &PL_sv_undef
- && strEQ(SvPVX(namesv), name))
+ && strEQ(SvPVX_const(namesv), name))
{
if (SvFAKE(namesv))
fake_offset = offset; /* in case we don't find a real one */
PL_curpad = AvARRAY(PL_comppad);
new_offset = pad_add_name(
- SvPVX(*out_name_sv),
+ SvPVX_const(*out_name_sv),
(SvFLAGS(*out_name_sv) & SVpad_TYPED)
? SvSTASH(*out_name_sv) : Nullhv,
(SvFLAGS(*out_name_sv) & SVpad_OUR)
);
new_namesv = AvARRAY(PL_comppad_name)[new_offset];
- SvIVX(new_namesv) = *out_flags;
+ SvIV_set(new_namesv, *out_flags);
- SvNVX(new_namesv) = (NV)0;
+ SvNV_set(new_namesv, (NV)0);
if (SvFLAGS(new_namesv) & SVpad_OUR) {
/* do nothing */
}
else if (CvLATE(cv)) {
/* delayed creation - just note the offset within parent pad */
- SvNVX(new_namesv) = (NV)offset;
+ SvNV_set(new_namesv, (NV)offset);
CvCLONE_on(cv);
}
else {
if ((sv = svp[i]) && sv != &PL_sv_undef
&& !SvFAKE(sv) && !SvIVX(sv))
{
- SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
- SvNVX(sv) = (NV)PL_cop_seqmax;
+ SvIV_set(sv, PAD_MAX); /* Don't know scope end yet. */
+ SvNV_set(sv, (NV)PL_cop_seqmax);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad intromy: %ld \"%s\", (%ld,%ld)\n",
- (long)i, SvPVX(sv),
+ (long)i, SvPVX_const(sv),
(long)U_32(SvNVX(sv)), (long)SvIVX(sv))
);
}
if ((sv = svp[off]) && sv != &PL_sv_undef
&& !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
{
- SvIVX(sv) = PL_cop_seqmax;
+ SvIV_set(sv, PL_cop_seqmax);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
- (long)off, SvPVX(sv),
+ (long)off, SvPVX_const(sv),
(long)U_32(SvNVX(sv)), (long)SvIVX(sv))
);
}
void
Perl_pad_tidy(pTHX_ padtidy_type type)
{
- PADOFFSET ix;
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_tidy");
if (type == padtidy_SUBCLONE) {
SV **namep = AvARRAY(PL_comppad_name);
+ PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
*/
if (!((namesv = namep[ix]) != Nullsv &&
namesv != &PL_sv_undef &&
- *SvPVX(namesv) == '&'))
+ *SvPVX_const(namesv) == '&'))
{
SvREFCNT_dec(PL_curpad[ix]);
PL_curpad[ix] = Nullsv;
AV *av = newAV(); /* Will be @_ */
av_extend(av, 0);
av_store(PL_comppad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
+ AvREIFY_only(av);
}
/* XXX DAPM rationalise these two similar branches */
if (type == padtidy_SUB) {
+ PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
continue;
}
}
else if (type == padtidy_FORMAT) {
+ PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
SvPADTMP_on(PL_curpad[ix]);
(int) ix,
PTR2UV(ppad[ix]),
(unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
- SvPVX(namesv),
+ SvPVX_const(namesv),
(unsigned long)SvIVX(namesv),
(unsigned long)SvNVX(namesv)
(unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
(long)U_32(SvNVX(namesv)),
(long)SvIVX(namesv),
- SvPVX(namesv)
+ SvPVX_const(namesv)
);
}
else if (full) {
CV *
Perl_cv_clone(pTHX_ CV *proto)
{
+ dVAR;
I32 ix;
AV* protopadlist = CvPADLIST(proto);
const AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
SV** ppad = AvARRAY(protopad);
const I32 fname = AvFILLp(protopad_name);
const I32 fpad = AvFILLp(protopad);
- AV* comppadlist;
CV* cv;
SV** outpad;
CV* outside;
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
if (SvPOK(proto))
- sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
+ sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
- CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
+ CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
av_fill(PL_comppad, fpad);
for (ix = fname; ix >= 0; ix--)
if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
if (ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", SvPVX(namesv));
+ "Variable \"%s\" is not available", SvPVX_const(namesv));
sv = Nullsv;
}
else {
}
}
if (!sv) {
- const char sigil = SvPVX(namesv)[0];
+ const char sigil = SvPVX_const(namesv)[0];
if (sigil == '&')
sv = SvREFCNT_inc(ppad[ix]);
else if (sigil == '@')
Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
{
I32 ix;
- AV *comppad_name = (AV*)AvARRAY(padlist)[0];
- AV *comppad = (AV*)AvARRAY(padlist)[1];
+ AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
+ AV * const comppad = (AV*)AvARRAY(padlist)[1];
SV **namepad = AvARRAY(comppad_name);
SV **curpad = AvARRAY(comppad);
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
const SV *namesv = namepad[ix];
if (namesv && namesv != &PL_sv_undef
- && *SvPVX(namesv) == '&')
+ && *SvPVX_const(namesv) == '&')
{
CV *innercv = (CV*)curpad[ix];
assert(CvWEAKOUTSIDE(innercv));
for ( ;ix > 0; ix--) {
if (names_fill >= ix && names[ix] != &PL_sv_undef) {
- const char sigil = SvPVX(names[ix])[0];
+ const char sigil = SvPVX_const(names[ix])[0];
if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
/* outer lexical or anon code */
av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
av = newAV();
av_extend(av, 0);
av_store(newpad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
+ AvREIFY_only(av);
av_store(padlist, depth, (SV*)newpad);
AvFILLp(padlist) = depth;
}
}
+
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+ SV** const av = av_fetch(PL_comppad_name, po, FALSE);
+ if ( SvFLAGS(*av) & SVpad_TYPED ) {
+ return SvSTASH(*av);
+ }
+ return Nullhv;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff