In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/d12be05dd0210a08e077f0cc9586a5a963122547?hp=be294d8de54348bbae20db1deaab47d34dfba5fd>
- Log ----------------------------------------------------------------- commit d12be05dd0210a08e077f0cc9586a5a963122547 Author: David Mitchell <[email protected]> Date: Mon Sep 26 15:56:08 2016 +0100 make PL_ pad vars be of type PADOFFSET Now that that PADOFFSET is signed, make PL_comppad_name_fill PL_comppad_name_floor PL_padix PL_constpadix PL_padix_floor PL_min_intro_pending PL_max_intro_pending be of type PADOFFSET rather than I32, to match the rest of the pad interface. At the same time, change various I32 local vars in pad.c functions to be PADOFFSET. M intrpvar.h M pad.c commit d081a35540aca5feaa56d2ce8a0b72b909a2d79e Author: David Mitchell <[email protected]> Date: Mon Sep 26 15:22:25 2016 +0100 make PADOFFSET be SSizet_t Currently it's defined as U32 or U64 depending on whether pointers are 32 bit or 64-bit, which is just a long-winded way of doing typedef Size_t PADOFFSET Change it to typedef SSize_t PADOFFSET Making it signed makes it easier to handle comparisons against PADOFFSET values that can be -1, such as PL_comppad_name_floor (which will be fixed in the next commit). M op.c M pad.h M pp_hot.c commit f2949f414d32db2fe5a59d82956b1cc4c693639f Author: David Mitchell <[email protected]> Date: Mon Sep 26 15:04:21 2016 +0100 remove a bunch of XXX's from pad.c When in 2002 I moved a bunch of code from op.c etc into a new file, pad.c, I left this comment at the top: /* XXX DAPM * As of Sept 2002, this file is new and may be in a state of flux for * a while. I've marked things I intent to come back and look at further * with an 'XXX DAPM' comment. */ Well, 12 years have passed since then, and if I was going to do any of this stuff I would probably have done it by now, or someone else would. So this commit removes the XXX's. M pad.c commit 4e785f27a1ab4651f67a4329a8eb1f6e1e8a0f8b Author: David Mitchell <[email protected]> Date: Mon Sep 26 14:59:26 2016 +0100 pad.c comments: clarify PERL_PADSEQ_INTRO M pad.c ----------------------------------------------------------------------- Summary of changes: intrpvar.h | 14 ++++---- op.c | 2 +- pad.c | 118 ++++++++++++++++++++++--------------------------------------- pad.h | 8 +---- pp_hot.c | 3 +- 5 files changed, 53 insertions(+), 92 deletions(-) diff --git a/intrpvar.h b/intrpvar.h index 3f43fd9..63bc4d1 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -490,8 +490,8 @@ PERLVAR(I, compiling, COP) /* compiling/done executing marker */ PERLVAR(I, compcv, CV *) /* currently compiling subroutine */ PERLVAR(I, comppad_name, PADNAMELIST *) /* variable names for "my" variables */ -PERLVAR(I, comppad_name_fill, I32) /* last "introduced" variable offset */ -PERLVAR(I, comppad_name_floor, I32) /* start of vars in innermost block */ +PERLVAR(I, comppad_name_fill, PADOFFSET)/* last "introduced" variable offset */ +PERLVAR(I, comppad_name_floor, PADOFFSET)/* start of vars in innermost block */ #ifdef HAVE_INTERP_INTERN PERLVAR(I, sys_intern, struct interp_intern) @@ -550,14 +550,14 @@ PERLVARI(I, runops, runops_proc_t, RUNOPS_DEFAULT) PERLVAR(I, subname, SV *) /* name of current subroutine */ PERLVAR(I, subline, I32) /* line this subroutine began on */ -PERLVAR(I, min_intro_pending, I32) /* start of vars to introduce */ +PERLVAR(I, min_intro_pending, PADOFFSET)/* start of vars to introduce */ -PERLVAR(I, max_intro_pending, I32) /* end of vars to introduce */ -PERLVAR(I, padix, I32) /* lowest unused index - 1 +PERLVAR(I, max_intro_pending, PADOFFSET)/* end of vars to introduce */ +PERLVAR(I, padix, PADOFFSET) /* lowest unused index - 1 in current "register" pad */ -PERLVAR(I, constpadix, I32) /* lowest unused for constants */ +PERLVAR(I, constpadix, PADOFFSET) /* lowest unused for constants */ -PERLVAR(I, padix_floor, I32) /* how low may inner block reset padix */ +PERLVAR(I, padix_floor, PADOFFSET) /* how low may inner block reset padix */ #ifdef USE_LOCALE_COLLATE PERLVAR(I, collation_name, char *) /* Name of current collation */ diff --git a/op.c b/op.c index 3e44be8..c2f5406 100644 --- a/op.c +++ b/op.c @@ -13907,7 +13907,7 @@ Perl_rpeep(pTHX_ OP *o) if ( intro && (8*sizeof(base) > 8*sizeof(UV)-OPpPADRANGE_COUNTSHIFT-SAVE_TIGHT_SHIFT - ? base + ? (Size_t)base : (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) ) > (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) diff --git a/pad.c b/pad.c index bdaf948..bcbf95b 100644 --- a/pad.c +++ b/pad.c @@ -18,12 +18,6 @@ * [p.23 of _The Lord of the Rings_, I/i: "A Long-Expected Party"] */ -/* XXX DAPM - * As of Sept 2002, this file is new and may be in a state of flux for - * a while. I've marked things I intent to come back and look at further - * with an 'XXX DAPM' comment. - */ - /* =head1 Pad Data Structures @@ -85,9 +79,15 @@ PERL_PADSEQ_INTRO to indicate various stages: PERL_PADSEQ_INTRO 0 variable not yet introduced: { my ($x valid-seq# PERL_PADSEQ_INTRO variable in scope: - { my ($x) + { my ($x); valid-seq# valid-seq# compilation of scope complete: - { my ($x) } + { my ($x); .... } + +When a lexical var hasn't yet been introduced, it already exists from the +perspective of duplicate declarations, but not for variable lookups, e.g. + + my ($x, $x); # '"my" variable $x masks earlier declaration' + my $x = $x; # equal to my $x = $::x; For typed lexicals C<PadnameTYPE> points at the type stash. For C<our> lexicals, C<PadnameOURSTASH> points at the stash of the associated global (so @@ -196,31 +196,23 @@ Perl_pad_new(pTHX_ int flags) ASSERT_CURPAD_LEGAL("pad_new"); - /* XXX DAPM really need a new SAVEt_PAD which restores all or most - * vars (based on flags) rather than storing vals + addresses for - * each individually. Also see pad_block_start. - * XXX DAPM Try to see whether all these conditionals are required - */ - /* save existing state, ... */ if (flags & padnew_SAVE) { SAVECOMPPAD(); if (! (flags & padnew_CLONE)) { SAVESPTR(PL_comppad_name); - SAVEI32(PL_padix); - SAVEI32(PL_constpadix); - SAVEI32(PL_comppad_name_fill); - SAVEI32(PL_min_intro_pending); - SAVEI32(PL_max_intro_pending); + save_strlen((STRLEN *)&PL_padix); + save_strlen((STRLEN *)&PL_constpadix); + save_strlen((STRLEN *)&PL_comppad_name_fill); + save_strlen((STRLEN *)&PL_min_intro_pending); + save_strlen((STRLEN *)&PL_max_intro_pending); SAVEBOOL(PL_cv_has_eval); if (flags & padnew_SAVESUB) { SAVEBOOL(PL_pad_reset_pending); } } } - /* XXX DAPM interestingly, PL_comppad_name_floor never seems to be - * saved - check at some pt that this is okay */ /* ... create new pad ... */ @@ -228,11 +220,6 @@ Perl_pad_new(pTHX_ int flags) pad = newAV(); if (flags & padnew_CLONE) { - /* XXX DAPM I dont know why cv_clone needs it - * doing differently yet - perhaps this separate branch can be - * dispensed with eventually ??? - */ - AV * const a0 = newAV(); /* will be @_ */ av_store(pad, 0, MUTABLE_SV(a0)); AvREIFY_only(a0); @@ -378,7 +365,7 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) pad_peg("pad_undef"); if (!CvISXSUB(&cvbody) && CvPADLIST(&cvbody)) { - I32 ix; + PADOFFSET ix; const PADLIST *padlist = CvPADLIST(&cvbody); /* Free the padlist associated with a CV. @@ -395,8 +382,6 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) /* detach any '&' anon children in the pad; if afterwards they * are still live, fix up their CvOUTSIDEs to point to our outside, * bypassing us. */ - /* XXX DAPM for efficiency, we should only do this if we know we have - * children, or integrate this loop with general cleanup */ if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */ CV * const outercv = CvOUTSIDE(&cvbody); @@ -707,14 +692,11 @@ but is used for debugging. =cut */ -/* XXX DAPM integrate alloc(), add_name() and add_anon(), - * or at least rationalise ??? */ - PADOFFSET Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) { SV *sv; - I32 retval; + PADOFFSET retval; PERL_UNUSED_ARG(optype); ASSERT_CURPAD_ACTIVE("pad_alloc"); @@ -727,7 +709,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) if (tmptype == SVs_PADMY) { /* Not & because this âflagâ is 0. */ /* For a my, simply push a null SV onto the end of PL_comppad. */ sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE); - retval = AvFILLp(PL_comppad); + retval = (PADOFFSET)AvFILLp(PL_comppad); } else { /* For a tmp, scan the pad from PL_padix upwards @@ -781,7 +763,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) sv->sv_debug_optype = optype; sv->sv_debug_inpad = 1; #endif - return (PADOFFSET)retval; + return retval; } /* @@ -818,7 +800,6 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype) assert(COP_SEQ_RANGE_HIGH(name) != PERL_PADSEQ_INTRO); ix = pad_alloc(optype, SVs_PADMY); padnamelist_store(PL_comppad_name, ix, name); - /* XXX DAPM use PL_curpad[] ? */ av_store(PL_comppad, ix, (SV*)func); /* to avoid ref loops, we never have parent + child referencing each @@ -882,9 +863,7 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash) svp = PadnamelistARRAY(PL_comppad_name); top = PadnamelistMAX(PL_comppad_name); /* check the current scope */ - /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same - * type ? */ - for (off = top; (I32)off > PL_comppad_name_floor; off--) { + for (off = top; off > PL_comppad_name_floor; off--) { PADNAME * const sv = svp[off]; if (sv && PadnameLEN(sv) == PadnameLEN(name) @@ -924,7 +903,7 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash) { Perl_warner(aTHX_ packWARN(WARN_MISC), "\"our\" variable %"PNf" redeclared", PNfARG(sv)); - if ((I32)off <= PL_comppad_name_floor) + if (off <= PL_comppad_name_floor) Perl_warner(aTHX_ packWARN(WARN_MISC), "\t(Did you mean \"local\" instead of \"our\"?)\n"); break; @@ -955,7 +934,7 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) { PADNAME *out_pn; int out_flags; - I32 offset; + PADOFFSET offset; const PADNAMELIST *namelist; PADNAME **name_p; @@ -973,7 +952,7 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) offset = pad_findlex(namepv, namelen, flags, PL_compcv, PL_cop_seqmax, 1, NULL, &out_pn, &out_flags); - if ((PADOFFSET)offset != NOT_IN_PAD) + if (offset != NOT_IN_PAD) return offset; /* Skip the âourâ hack for subroutines, as the warning does not apply. @@ -1116,7 +1095,7 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq, int warn, SV** out_capture, PADNAME** out_name, int *out_flags) { - I32 offset, new_offset; + PADOFFSET offset, new_offset; SV *new_capture; SV **new_capturep; const PADLIST * const padlist = CvPADLIST(cv); @@ -1139,7 +1118,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, /* first, search this pad */ if (padlist) { /* not an undef CV */ - I32 fake_offset = 0; + PADOFFSET fake_offset = 0; const PADNAMELIST * const names = PadlistNAMES(padlist); PADNAME * const * const name_p = PadnamelistARRAY(names); @@ -1290,7 +1269,7 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, flags | padadd_STALEOK*(new_capturep == &new_capture), CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1, new_capturep, out_name, out_flags); - if ((PADOFFSET)offset == NOT_IN_PAD) + if (offset == NOT_IN_PAD) return NOT_IN_PAD; /* found in an outer CV. Add appropriate fake entry to this pad */ @@ -1408,27 +1387,21 @@ Update the pad compilation state variables on entry to a new block. =cut */ -/* XXX DAPM perhaps: - * - integrate this in general state-saving routine ??? - * - combine with the state-saving going on in pad_new ??? - * - introduce a new SAVE type that does all this in one go ? - */ - void Perl_pad_block_start(pTHX_ int full) { ASSERT_CURPAD_ACTIVE("pad_block_start"); - SAVEI32(PL_comppad_name_floor); + save_strlen((STRLEN *)&PL_comppad_name_floor); PL_comppad_name_floor = PadnamelistMAX(PL_comppad_name); if (full) PL_comppad_name_fill = PL_comppad_name_floor; if (PL_comppad_name_floor < 0) PL_comppad_name_floor = 0; - SAVEI32(PL_min_intro_pending); - SAVEI32(PL_max_intro_pending); + save_strlen((STRLEN *)&PL_min_intro_pending); + save_strlen((STRLEN *)&PL_max_intro_pending); PL_min_intro_pending = 0; - SAVEI32(PL_comppad_name_fill); - SAVEI32(PL_padix_floor); + save_strlen((STRLEN *)&PL_comppad_name_fill); + save_strlen((STRLEN *)&PL_padix_floor); /* PL_padix_floor is what PL_padix is reset to at the start of each statement, by pad_reset(). We set it when entering a new scope to keep things like this working: @@ -1453,7 +1426,7 @@ U32 Perl_intro_my(pTHX) { PADNAME **svp; - I32 i; + PADOFFSET i; U32 seq; ASSERT_CURPAD_ACTIVE("intro_my"); @@ -1504,7 +1477,7 @@ lexicals in this scope and warn of any lexicals that never got introduced. OP * Perl_pad_leavemy(pTHX) { - I32 off; + PADOFFSET off; OP *o = NULL; PADNAME * const * const svp = PadnamelistARRAY(PL_comppad_name); @@ -1596,7 +1569,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust) /* Use PL_constpadix here, not PL_padix. The latter may have been reset by pad_reset. We donât want pad_alloc to have to scan the whole pad when allocating a constant. */ - if ((I32)po < PL_constpadix) + if (po < PL_constpadix) PL_constpadix = po - 1; } @@ -1650,11 +1623,6 @@ the kind of subroutine: =cut */ -/* XXX DAPM surely most of this stuff should be done properly - * at the right time beforehand, rather than going around afterwards - * cleaning up our mistakes ??? - */ - void Perl_pad_tidy(pTHX_ padtidy_type type) { @@ -1722,7 +1690,6 @@ Perl_pad_tidy(pTHX_ padtidy_type type) } } else if (type == padtidy_SUB) { - /* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */ AV * const av = newAV(); /* Will be @_ */ av_store(PL_comppad, 0, MUTABLE_SV(av)); AvREIFY_only(av); @@ -1767,7 +1734,6 @@ Free the SV at offset po in the current pad. =cut */ -/* XXX DAPM integrate with pad_swipe ???? */ void Perl_pad_free(pTHX_ PADOFFSET po) { @@ -1793,7 +1759,7 @@ Perl_pad_free(pTHX_ PADOFFSET po) if (sv && sv != &PL_sv_undef && !SvPADMY(sv)) SvFLAGS(sv) &= ~SVs_PADTMP; - if ((I32)po < PL_padix) + if (po < PL_padix) PL_padix = po - 1; #endif } @@ -1813,7 +1779,7 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) const AV *pad; PADNAME **pname; SV **ppad; - I32 ix; + PADOFFSET ix; PERL_ARGS_ASSERT_DO_DUMP_PAD; @@ -1927,14 +1893,14 @@ static CV * S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, bool newcv) { - I32 ix; + PADOFFSET ix; PADLIST* const protopadlist = CvPADLIST(proto); PADNAMELIST *const protopad_name = PadlistNAMES(protopadlist); const PAD *const protopad = PadlistARRAY(protopadlist)[1]; PADNAME** const pname = PadnamelistARRAY(protopad_name); SV** const ppad = AvARRAY(protopad); - const I32 fname = PadnamelistMAX(protopad_name); - const I32 fpad = AvFILLp(protopad); + const PADOFFSET fname = PadnamelistMAX(protopad_name); + const PADOFFSET fpad = AvFILLp(protopad); SV** outpad; long depth; U32 subclones = 0; @@ -2356,7 +2322,7 @@ moved to a pre-existing CV struct. void Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) { - I32 ix; + PADOFFSET ix; PADNAMELIST * const comppad_name = PadlistNAMES(padlist); AV * const comppad = PadlistARRAY(padlist)[1]; PADNAME ** const namepad = PadnamelistARRAY(comppad_name); @@ -2434,8 +2400,8 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) PAD** const svp = PadlistARRAY(padlist); AV* const newpad = newAV(); SV** const oldpad = AvARRAY(svp[depth-1]); - I32 ix = AvFILLp((const AV *)svp[1]); - const I32 names_fill = PadnamelistMAX((PADNAMELIST *)svp[0]); + PADOFFSET ix = AvFILLp((const AV *)svp[1]); + const PADOFFSET names_fill = PadnamelistMAX((PADNAMELIST *)svp[0]); PADNAME ** const names = PadnamelistARRAY((PADNAMELIST *)svp[0]); AV *av; @@ -2520,9 +2486,9 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param) } else { /* CvDEPTH() on our subroutine will be set to 0, so there's no need to build anything other than the first level of pads. */ - I32 ix = AvFILLp(PadlistARRAY(srcpad)[1]); + PADOFFSET ix = AvFILLp(PadlistARRAY(srcpad)[1]); AV *pad1; - const I32 names_fill = PadnamelistMAX(PadlistNAMES(srcpad)); + const PADOFFSET names_fill = PadnamelistMAX(PadlistNAMES(srcpad)); const PAD *const srcpad1 = PadlistARRAY(srcpad)[1]; SV **oldpad = AvARRAY(srcpad1); PADNAME ** const names = PadnamelistARRAY(PadlistNAMES(dstpad)); diff --git a/pad.h b/pad.h index 7ed1033..56d88ab 100644 --- a/pad.h +++ b/pad.h @@ -18,13 +18,7 @@ /* offsets within a pad */ -#if PTRSIZE == 4 -typedef U32TYPE PADOFFSET; -#else -# if PTRSIZE == 8 -typedef U64TYPE PADOFFSET; -# endif -#endif +typedef SSize_t PADOFFSET; /* signed so that -1 is a valid value */ #define NOT_IN_PAD ((PADOFFSET) -1) /* B.xs expects the first members of these two structs to line up diff --git a/pp_hot.c b/pp_hot.c index 9da9ab0..35cc4da 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -382,7 +382,8 @@ PP(pp_padrange) | (count << SAVE_TIGHT_SHIFT) | SAVEt_CLEARPADRANGE); STATIC_ASSERT_STMT(OPpPADRANGE_COUNTMASK + 1 == (1 << OPpPADRANGE_COUNTSHIFT)); - assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) == base); + assert((payload >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)) + == (Size_t)base); { dSS_ADD; SS_ADD_UV(payload); -- Perl5 Master Repository
