This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
todo: expand the list of OS access builtins to update
[perl5.git] / pad.c
diff --git a/pad.c b/pad.c
index e6e8024..00ba632 100644 (file)
--- a/pad.c
+++ b/pad.c
@@ -56,7 +56,8 @@ at that depth of recursion into the CV.  The 0th slot of a frame AV is an
 AV which is @_.  Other entries are storage for variables and op targets.
 
 Iterating over the PADNAMELIST iterates over all possible pad
-items.  Pad slots for targets (SVs_PADTMP) and GVs end up having &PL_sv_no
+items.  Pad slots for targets (SVs_PADTMP)
+and GVs end up having &PL_sv_undef
 "names", while slots for constants have &PL_sv_no "names" (see
 pad_alloc()).  That &PL_sv_no is used is an implementation detail subject
 to change.  To test for it, use C<PadnamePV(name) && !PadnameLEN(name)>.
@@ -153,28 +154,6 @@ Points directly to the body of the L</PL_comppad> array.
   STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
 
 /*
-=for apidoc mx|void|pad_peg|const char *s
-
-When PERL_MAD is enabled, this is a small no-op function that gets called
-at the start of each pad-related function.  It can be breakpointed to
-track all pad operations.  The parameter is a string indicating the type
-of pad operation being performed.
-
-=cut
-*/
-
-#ifdef PERL_MAD
-void pad_peg(const char* s) {
-    static int pegcnt; /* XXX not threadsafe */
-    PERL_UNUSED_ARG(s);
-
-    PERL_ARGS_ASSERT_PAD_PEG;
-
-    pegcnt++;
-}
-#endif
-
-/*
 This is basically sv_eq_flags() in sv.c, but we avoid the magic
 and bytes checking.
 */
@@ -232,7 +211,6 @@ flags can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
-    dVAR;
     PADLIST *padlist;
     PAD *padname, *pad;
     PAD **ary;
@@ -339,7 +317,6 @@ children can still follow the full lexical scope chain.
 void
 Perl_cv_undef(pTHX_ CV *cv)
 {
-    dVAR;
     const PADLIST *padlist = CvPADLIST(cv);
     bool const slabbed = !!CvSLABBED(cv);
 
@@ -382,7 +359,7 @@ Perl_cv_undef(pTHX_ CV *cv)
        LEAVE;
     }
 #ifdef DEBUGGING
-    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+    else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
 #endif
     SvPOK_off(MUTABLE_SV(cv));         /* forget prototype */
     sv_unmagic((SV *)cv, PERL_MAGIC_checkcall);
@@ -522,7 +499,7 @@ Perl_cv_forget_slab(pTHX_ CV *cv)
     if      (CvROOT(cv))  slab = OpSLAB(CvROOT(cv));
     else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv);
 #ifdef DEBUGGING
-    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", cv);
+    else if (slabbed)     Perl_warn(aTHX_ "Slab leaked from cv %p", (void*)cv);
 #endif
 
     if (slab) {
@@ -554,7 +531,6 @@ is done.  Returns the offset of the allocated pad slot.
 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);
 
     PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
@@ -605,7 +581,6 @@ PADOFFSET
 Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
                U32 flags, HV *typestash, HV *ourstash)
 {
-    dVAR;
     PADOFFSET offset;
     SV *namesv;
     bool is_utf8;
@@ -737,7 +712,6 @@ but is used for debugging.
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
-    dVAR;
     SV *sv;
     I32 retval;
 
@@ -817,7 +791,6 @@ but is used for debugging.
 PADOFFSET
 Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
 {
-    dVAR;
     PADOFFSET ix;
     SV* const name = newSV_type(SVt_PVNV);
 
@@ -869,7 +842,6 @@ C<is_our> indicates that the name to check is an 'our' declaration.
 STATIC void
 S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
 {
-    dVAR;
     SV         **svp;
     PADOFFSET  top, off;
     const U32  is_our = flags & padadd_OUR;
@@ -954,7 +926,6 @@ or C<NOT_IN_PAD> if no such lexical is in scope.
 PADOFFSET
 Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
 {
-    dVAR;
     SV *out_sv;
     int out_flags;
     I32 offset;
@@ -1056,7 +1027,6 @@ L</find_rundefsv> is likely to be more convenient.
 PADOFFSET
 Perl_find_rundefsvoffset(pTHX)
 {
-    dVAR;
     SV *out_sv;
     int out_flags;
     return pad_findlex("$_", 2, 0, find_runcv(NULL), PL_curcop->cop_seq, 1,
@@ -1154,7 +1124,6 @@ STATIC PADOFFSET
 S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq,
        int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
 {
-    dVAR;
     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
@@ -1434,7 +1403,6 @@ Use macro PAD_SV instead of calling this function directly.
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_sv");
 
     if (!po)
@@ -1458,8 +1426,6 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_PAD_SETSV;
 
     ASSERT_CURPAD_ACTIVE("pad_setsv");
@@ -1490,7 +1456,6 @@ Update the pad compilation state variables on entry to a new block.
 void
 Perl_pad_block_start(pTHX_ int full)
 {
-    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
@@ -1520,7 +1485,6 @@ subsequent statements.
 U32
 Perl_intro_my(pTHX)
 {
-    dVAR;
     SV **svp;
     I32 i;
     U32 seq;
@@ -1570,7 +1534,6 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 OP *
 Perl_pad_leavemy(pTHX)
 {
-    dVAR;
     I32 off;
     OP *o = NULL;
     SV * const * const svp = AvARRAY(PL_comppad_name);
@@ -1628,7 +1591,6 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
-    dVAR;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
        return;
@@ -1683,7 +1645,6 @@ Mark all the current temporaries for reuse
 static void
 S_pad_reset(pTHX)
 {
-    dVAR;
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
        Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p",
@@ -1848,7 +1809,6 @@ Free the SV at offset po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
-    dVAR;
     SV *sv;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
@@ -1884,7 +1844,6 @@ Dump the contents of a padlist
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
-    dVAR;
     const AV *pad_name;
     const AV *pad;
     SV **pname;
@@ -1957,7 +1916,6 @@ dump the contents of a CV
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
-    dVAR;
     const CV * const outside = CvOUTSIDE(cv);
     PADLIST* const padlist = CvPADLIST(cv);
 
@@ -2003,7 +1961,6 @@ static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside);
 static void
 S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 {
-    dVAR;
     I32 ix;
     PADLIST* const protopadlist = CvPADLIST(proto);
     PAD *const protopad_name = *PadlistARRAY(protopadlist);
@@ -2158,7 +2115,9 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
 static CV *
 S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
 {
+#ifdef USE_ITHREADS
     dVAR;
+#endif
     const bool newcv = !cv;
 
     assert(!CvUNIQUE(proto));
@@ -2250,7 +2209,6 @@ moved to a pre-existing CV struct.
 void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
-    dVAR;
     I32 ix;
     AV * const comppad_name = PadlistARRAY(padlist)[0];
     AV * const comppad = PadlistARRAY(padlist)[1];
@@ -2307,8 +2265,6 @@ the new pad an @_ in slot zero.
 void
 Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
-    dVAR;
-
     PERL_ARGS_ASSERT_PAD_PUSH;
 
     if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) {
@@ -2373,10 +2329,9 @@ class to which it is typed is returned.  If not, C<NULL> is returned.
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
-    dVAR;
-    SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
-    if ( SvPAD_TYPED(*av) ) {
-        return SvSTASH(*av);
+    SV* const av = PAD_COMPNAME_SV(po);
+    if ( SvPAD_TYPED(av) ) {
+        return SvSTASH(av);
     }
     return NULL;
 }
@@ -2515,7 +2470,6 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
 PAD **
 Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
 {
-    dVAR;
     PAD **ary;
     SSize_t const oldmax = PadlistMAX(padlist);