[PATCH] perlcommunity.pod: add information about OSDC.fr
[p5sagit/p5-mst-13.2.git] / pad.c
diff --git a/pad.c b/pad.c
index a68f4d3..2e0b863 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -5,13 +5,17 @@
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
+ */
+
+/*
+ *  'Anyway: there was this Mr. Frodo left an orphan and stranded, as you
+ *   might say, among those queer Bucklanders, being brought up anyhow in
+ *   Brandy Hall.  A regular warren, by all accounts.  Old Master Gorbadoc
+ *   never had fewer than a couple of hundred relations in the place.
+ *   Mr. Bilbo never did a kinder deed than when he brought the lad back
+ *   to live among decent folk.'                           --the Gaffer
  *
- *  "Anyway: there was this Mr Frodo left an orphan and stranded, as you
- *  might say, among those queer Bucklanders, being brought up anyhow in
- *  Brandy Hall. A regular warren, by all accounts. Old Master Gorbadoc
- *  never had fewer than a couple of hundred relations in the place. Mr
- *  Bilbo never did a kinder deed than when he brought the lad back to
- *  live among decent folk." --the Gaffer
+ *     [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"]
  */
 
 /* XXX DAPM
@@ -176,7 +180,7 @@ Perl_pad_new(pTHX_ int flags)
            SAVEI32(PL_max_intro_pending);
            SAVEBOOL(PL_cv_has_eval);
            if (flags & padnew_SAVESUB) {
-               SAVEI32(PL_pad_reset_pending);
+               SAVEBOOL(PL_pad_reset_pending);
            }
        }
     }
@@ -197,7 +201,7 @@ Perl_pad_new(pTHX_ int flags)
 
         AV * const a0 = newAV();                       /* will be @_ */
        av_extend(a0, 0);
-       av_store(pad, 0, (SV*)a0);
+       av_store(pad, 0, MUTABLE_SV(a0));
        AvREIFY_only(a0);
     }
     else {
@@ -205,8 +209,8 @@ Perl_pad_new(pTHX_ int flags)
     }
 
     AvREAL_off(padlist);
-    av_store(padlist, 0, (SV*)padname);
-    av_store(padlist, 1, (SV*)pad);
+    av_store(padlist, 0, MUTABLE_SV(padname));
+    av_store(padlist, 1, MUTABLE_SV(pad));
 
     /* ... then update state variables */
 
@@ -319,16 +323,16 @@ Perl_pad_undef(pTHX_ CV* cv)
     while (ix >= 0) {
        SV* const sv = AvARRAY(padlist)[ix--];
        if (sv) {
-           if (sv == (SV*)PL_comppad_name)
+           if (sv == (const SV *)PL_comppad_name)
                PL_comppad_name = NULL;
-           else if (sv == (SV*)PL_comppad) {
+           else if (sv == (const SV *)PL_comppad) {
                PL_comppad = NULL;
                PL_curpad = NULL;
            }
        }
        SvREFCNT_dec(sv);
     }
-    SvREFCNT_dec((SV*)CvPADLIST(cv));
+    SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
     CvPADLIST(cv) = NULL;
 }
 
@@ -367,7 +371,7 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
     if (typestash) {
        assert(SvTYPE(namesv) == SVt_PVMG);
        SvPAD_TYPED_on(namesv);
-       SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN((SV*)typestash)));
+       SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
     }
     if (ourstash) {
        SvPAD_OUR_on(namesv);
@@ -396,9 +400,9 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake
        /* XXX DAPM since slot has been allocated, replace
         * av_store with PL_curpad[offset] ? */
        if (*name == '@')
-           av_store(PL_comppad, offset, (SV*)newAV());
+           av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
        else if (*name == '%')
-           av_store(PL_comppad, offset, (SV*)newHV());
+           av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
        SvPADMY_on(PL_curpad[offset]);
        DEBUG_Xv(PerlIO_printf(Perl_debug_log,
            "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
@@ -499,7 +503,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     PERL_ARGS_ASSERT_PAD_ADD_ANON;
 
     pad_peg("add_anon");
-    sv_setpvn(name, "&", 1);
+    sv_setpvs(name, "&");
     /* Are these two actually ever read? */
     COP_SEQ_RANGE_HIGH_set(name, ~0);
     COP_SEQ_RANGE_LOW_set(name, 1);
@@ -777,9 +781,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                        ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
                        : *out_flags & PAD_FAKELEX_ANON)
                {
-                   if (warn && ckWARN(WARN_CLOSURE))
-                       Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" is not available", name);
+                   if (warn)
+                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                      "Variable \"%s\" is not available", name);
                    *out_capture = NULL;
                }
 
@@ -819,17 +823,16 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
                    if (SvPADSTALE(*out_capture)
                        && !SvPAD_STATE(name_svp[offset]))
                    {
-                       if (ckWARN(WARN_CLOSURE))
-                           Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                               "Variable \"%s\" is not available", name);
+                       Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                      "Variable \"%s\" is not available", name);
                        *out_capture = NULL;
                    }
                }
                if (!*out_capture) {
                    if (*name == '@')
-                       *out_capture = sv_2mortal((SV*)newAV());
+                       *out_capture = sv_2mortal(MUTABLE_SV(newAV()));
                    else if (*name == '%')
-                       *out_capture = sv_2mortal((SV*)newHV());
+                       *out_capture = sv_2mortal(MUTABLE_SV(newHV()));
                    else
                        *out_capture = sv_newmortal();
                }
@@ -1062,11 +1065,10 @@ Perl_pad_leavemy(pTHX)
     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
        for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
            const SV * const sv = svp[off];
-           if (sv && sv != &PL_sv_undef
-                   && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
-               Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                           "%"SVf" never introduced",
-                           SVfARG(sv));
+           if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
+               Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+                                "%"SVf" never introduced",
+                                SVfARG(sv));
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -1146,8 +1148,8 @@ Mark all the current temporaries for reuse
  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
  * We avoid doing this until we can think of a Better Way.
  * GSAR 97-10-29 */
-void
-Perl_pad_reset(pTHX)
+static void
+S_pad_reset(pTHX)
 {
     dVAR;
 #ifdef USE_BROKEN_PAD_RESET
@@ -1250,7 +1252,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
        /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
        AV * const av = newAV();                        /* Will be @_ */
        av_extend(av, 0);
-       av_store(PL_comppad, 0, (SV*)av);
+       av_store(PL_comppad, 0, MUTABLE_SV(av));
        AvREIFY_only(av);
     }
 
@@ -1306,13 +1308,7 @@ Perl_pad_free(pTHX_ PADOFFSET po)
        SvPADTMP_off(PL_curpad[po]);
 #ifdef USE_ITHREADS
        /* SV could be a shared hash key (eg bugid #19022) */
-       if (
-#ifdef PERL_OLD_COPY_ON_WRITE
-           !SvIsCOW(PL_curpad[po])
-#else
-           !SvFAKE(PL_curpad[po])
-#endif
-           )
+       if (!SvIsCOW(PL_curpad[po]))
            SvREADONLY_off(PL_curpad[po]);      /* could be a freed constant */
 #endif
     }
@@ -1506,7 +1502,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))
-       sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
+       sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
 
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
@@ -1529,9 +1525,8 @@ Perl_cv_clone(pTHX_ CV *proto)
                   while my $x if $false can leave an active var marked as
                   stale. And state vars are always available */
                if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
-                   if (ckWARN(WARN_CLOSURE))
-                       Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-                           "Variable \"%s\" is not available", SvPVX_const(namesv));
+                   Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
+                                  "Variable \"%s\" is not available", SvPVX_const(namesv));
                    sv = NULL;
                }
                else 
@@ -1542,9 +1537,9 @@ Perl_cv_clone(pTHX_ CV *proto)
                 if (sigil == '&')
                    sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
-                   sv = (SV*)newAV();
+                   sv = MUTABLE_SV(newAV());
                 else if (sigil == '%')
-                   sv = (SV*)newHV();
+                   sv = MUTABLE_SV(newHV());
                else
                    sv = newSV(0);
                SvPADMY_on(sv);
@@ -1668,9 +1663,9 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
                else {          /* our own lexical */
                    SV *sv; 
                    if (sigil == '@')
-                       sv = (SV*)newAV();
+                       sv = MUTABLE_SV(newAV());
                    else if (sigil == '%')
-                       sv = (SV*)newHV();
+                       sv = MUTABLE_SV(newHV());
                    else
                        sv = newSV(0);
                    av_store(newpad, ix, sv);
@@ -1689,10 +1684,10 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
        }
        av = newAV();
        av_extend(av, 0);
-       av_store(newpad, 0, (SV*)av);
+       av_store(newpad, 0, MUTABLE_SV(av));
        AvREIFY_only(av);
 
-       av_store(padlist, depth, (SV*)newpad);
+       av_store(padlist, depth, MUTABLE_SV(newpad));
        AvFILLp(padlist) = depth;
     }
 }