X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f3548bdc4d2efd11e139d110e60764b9dae81319..8b2d66400d0e016ebfcc9a22cd041309afd77ee0:/pad.h diff --git a/pad.h b/pad.h index f8a777e..cc96ddc 100644 --- a/pad.h +++ b/pad.h @@ -1,6 +1,6 @@ /* pad.h * - * Copyright (c) 2002, Larry Wall + * Copyright (C) 2002, 2003, 2005, 2006, 2007 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. @@ -30,15 +30,75 @@ typedef U64TYPE PADOFFSET; # endif #endif #define NOT_IN_PAD ((PADOFFSET) -1) - + +/* B.xs needs these for the benefit of B::Deparse */ +/* Low range end is exclusive (valid from the cop seq after this one) */ +/* High range end is inclusive (valid up to this cop seq) */ + +#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# define COP_SEQ_RANGE_LOW(sv) \ + (({ SV *const _svi = (SV *) (sv); \ + assert(SvTYPE(_svi) == SVt_NV || SvTYPE(_svi) >= SVt_PVNV); \ + assert(SvTYPE(_svi) != SVt_PVAV); \ + assert(SvTYPE(_svi) != SVt_PVHV); \ + assert(SvTYPE(_svi) != SVt_PVCV); \ + assert(SvTYPE(_svi) != SVt_PVFM); \ + assert(!isGV_with_GP(_svi)); \ + ((XPVNV*) SvANY(_svi))->xnv_u.xpad_cop_seq.xlow; \ + })) +# define COP_SEQ_RANGE_HIGH(sv) \ + (({ SV *const _svi = (SV *) (sv); \ + assert(SvTYPE(_svi) == SVt_NV || SvTYPE(_svi) >= SVt_PVNV); \ + assert(SvTYPE(_svi) != SVt_PVAV); \ + assert(SvTYPE(_svi) != SVt_PVHV); \ + assert(SvTYPE(_svi) != SVt_PVCV); \ + assert(SvTYPE(_svi) != SVt_PVFM); \ + assert(!isGV_with_GP(_svi)); \ + ((XPVNV*) SvANY(_svi))->xnv_u.xpad_cop_seq.xhigh; \ + })) +# define PARENT_PAD_INDEX(sv) \ + (({ SV *const _svi = (SV *) (sv); \ + assert(SvTYPE(_svi) == SVt_NV || SvTYPE(_svi) >= SVt_PVNV); \ + assert(SvTYPE(_svi) != SVt_PVAV); \ + assert(SvTYPE(_svi) != SVt_PVHV); \ + assert(SvTYPE(_svi) != SVt_PVCV); \ + assert(SvTYPE(_svi) != SVt_PVFM); \ + assert(!isGV_with_GP(_svi)); \ + ((XPVNV*) SvANY(_svi))->xnv_u.xpad_cop_seq.xlow; \ + })) +# define PARENT_FAKELEX_FLAGS(sv) \ + (({ SV *const _svi = (SV *) (sv); \ + assert(SvTYPE(_svi) == SVt_NV || SvTYPE(_svi) >= SVt_PVNV); \ + assert(SvTYPE(_svi) != SVt_PVAV); \ + assert(SvTYPE(_svi) != SVt_PVHV); \ + assert(SvTYPE(_svi) != SVt_PVCV); \ + assert(SvTYPE(_svi) != SVt_PVFM); \ + assert(!isGV_with_GP(_svi)); \ + ((XPVNV*) SvANY(_svi))->xnv_u.xpad_cop_seq.xhigh; \ + })) +#else +# define COP_SEQ_RANGE_LOW(sv) \ + (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow)) +# define COP_SEQ_RANGE_HIGH(sv) \ + (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh)) + + +# define PARENT_PAD_INDEX(sv) \ + (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xlow)) +# define PARENT_FAKELEX_FLAGS(sv) \ + (0 + (((XPVNV*) SvANY(sv))->xnv_u.xpad_cop_seq.xhigh)) +#endif + +/* Flags set in the SvIVX field of FAKE namesvs */ + +#define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */ +#define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */ /* flags for the pad_new() function */ -typedef enum { - padnew_CLONE = 1, /* this pad is for a cloned CV */ - padnew_SAVE = 2, /* save old globals */ - padnew_SAVESUB = 4 /* also save extra stuff for start of sub */ -} padnew_flags; +#define padnew_CLONE 1 /* this pad is for a cloned CV */ +#define padnew_SAVE 2 /* save old globals */ +#define padnew_SAVESUB 4 /* also save extra stuff for start of sub */ /* values for the pad_tidy() function */ @@ -52,14 +112,20 @@ typedef enum { * whether PL_comppad and PL_curpad are consistent and whether they have * active values */ +#ifndef PERL_MAD +# define pad_peg(label) +#endif + #ifdef DEBUGGING # define ASSERT_CURPAD_LEGAL(label) \ + pad_peg(label); \ if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \ Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%"UVxf"[0x%"UVxf"]",\ label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); # define ASSERT_CURPAD_ACTIVE(label) \ + pad_peg(label); \ if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \ Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%"UVxf"[0x%"UVxf"]",\ label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); @@ -79,7 +145,7 @@ Save a pad slot (used to restore after an iteration) XXX DAPM it would make more sense to make the arg a PADOFFSET =for apidoc m|void|SAVECLEARSV |SV **svp -Clear the pointed to pad value on scope exit. (ie the runtime action of 'my') +Clear the pointed to pad value on scope exit. (i.e. the runtime action of 'my') =for apidoc m|void|SAVECOMPPAD save PL_comppad and PL_curpad @@ -105,7 +171,15 @@ Get the value from slot C in the base (DEPTH=1) pad of a padlist =for apidoc m|void|PAD_SET_CUR |PADLIST padlist|I32 n Set the current pad to be pad C in the padlist, saving -the previous current pad. +the previous current pad. NB currently this macro expands to a string too +long for some compilers, so it's best to replace it with + + SAVECOMPPAD(); + PAD_SET_CUR_NOSAVE(padlist,n); + + +=for apidoc m|void|PAD_SET_CUR_NOSAVE |PADLIST padlist|I32 n +like PAD_SET_CUR, but without the save =for apidoc m|void|PAD_SAVE_SETNULLPAD Save the current pad then set it to null. @@ -132,33 +206,37 @@ Restore the old pad saved into the local variable opad by PAD_SAVE_LOCAL() #define PAD_BASE_SV(padlist, po) \ (AvARRAY(padlist)[1]) \ - ? AvARRAY((AV*)(AvARRAY(padlist)[1]))[po] : Nullsv; + ? AvARRAY((AV*)(AvARRAY(padlist)[1]))[po] : NULL; -#define PAD_SET_CUR(padlist,n) \ - SAVECOMPPAD(); \ - PL_comppad = (PAD*) (AvARRAY(padlist)[n]); \ +#define PAD_SET_CUR_NOSAVE(padlist,nth) \ + PL_comppad = (PAD*) (AvARRAY(padlist)[nth]); \ PL_curpad = AvARRAY(PL_comppad); \ DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ "Pad 0x%"UVxf"[0x%"UVxf"] set_cur depth=%d\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(n))); + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(nth))); + + +#define PAD_SET_CUR(padlist,nth) \ + SAVECOMPPAD(); \ + PAD_SET_CUR_NOSAVE(padlist,nth); #define PAD_SAVE_SETNULLPAD() SAVECOMPPAD(); \ - PL_comppad = Null(PAD*); PL_curpad = Null(SV**); \ + PL_comppad = NULL; PL_curpad = NULL; \ DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n")); #define PAD_SAVE_LOCAL(opad,npad) \ opad = PL_comppad; \ PL_comppad = (npad); \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ "Pad 0x%"UVxf"[0x%"UVxf"] save_local\n", \ PTR2UV(PL_comppad), PTR2UV(PL_curpad))); #define PAD_RESTORE_LOCAL(opad) \ PL_comppad = opad; \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : Null(SV**); \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ "Pad 0x%"UVxf"[0x%"UVxf"] restore_local\n", \ PTR2UV(PL_comppad), PTR2UV(PL_curpad))); @@ -198,25 +276,30 @@ Assumes the slot entry is a valid C lexical. =for apidoc m|STRLEN|PAD_COMPNAME_GEN|PADOFFSET po The generation number of the name at offset C in the current -compiling pad (lvalue). Note that C is hijacked for this purpose. +compiling pad (lvalue). Note that C is hijacked for this purpose. + +=for apidoc m|STRLEN|PAD_COMPNAME_GEN_set|PADOFFSET po|int gen +Sets the generation number of the name at offset C in the current +ling pad (lvalue) to C. Note that C is hijacked for this purpose. =cut + */ -#define PAD_COMPNAME_FLAGS(po) SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE)) -#define PAD_COMPNAME_PV(po) SvPV_nolen(*av_fetch(PL_comppad_name, (po), FALSE)) +#define PAD_COMPNAME_SV(po) (*av_fetch(PL_comppad_name, (po), FALSE)) +#define PAD_COMPNAME_FLAGS(po) SvFLAGS(PAD_COMPNAME_SV(po)) +#define PAD_COMPNAME_FLAGS_isOUR(po) \ + ((PAD_COMPNAME_FLAGS(po) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR)) +#define PAD_COMPNAME_PV(po) SvPV_nolen(PAD_COMPNAME_SV(po)) -/* XXX DAPM yuk - using av_fetch twice. Is there a better way? */ -#define PAD_COMPNAME_TYPE(po) \ - ((SvFLAGS(*av_fetch(PL_comppad_name, (po), FALSE)) & SVpad_TYPED) \ - ? (SvSTASH(*av_fetch(PL_comppad_name, (po), FALSE))) : Nullhv) +#define PAD_COMPNAME_TYPE(po) pad_compname_type(po) #define PAD_COMPNAME_OURSTASH(po) \ - (GvSTASH(*av_fetch(PL_comppad_name, (po), FALSE))) - -#define PAD_COMPNAME_GEN(po) SvCUR(AvARRAY(PL_comppad_name)[po]) + (SvOURSTASH(PAD_COMPNAME_SV(po))) +#define PAD_COMPNAME_GEN(po) ((STRLEN)SvUVX(AvARRAY(PL_comppad_name)[po])) +#define PAD_COMPNAME_GEN_set(po, gen) SvUV_set(AvARRAY(PL_comppad_name)[po], (UV)(gen)) /* @@ -242,15 +325,17 @@ Clone the state variables associated with running and compiling pads. else \ (dstpad) = av_dup_inc((srcpad), param); -/* note - we set comp/curpad to null rather than duping - otherwise - * we may dup a pad but not the whole padlist, and be left with - * leaked pad. We assume that a sub will get called very soon hereafter - * and comp/curpad will get set to something sensible. DAPM 16-Oct02 */ -/* XXX DAPM -does the same logic appply to comppad_name ? */ +/* NB - we set PL_comppad to null unless it points at a value that + * has already been dup'ed, ie it points to part of an active padlist. + * Otherwise PL_comppad ends up being a leaked scalar in code like + * the following: + * threads->create(sub { threads->create(sub {...} ) } ); + * where the second thread dups the outer sub's comppad but not the + * sub's CV or padlist. */ #define PAD_CLONE_VARS(proto_perl, param) \ - PL_comppad = Null(PAD*); \ - PL_curpad = Null(SV **); \ + PL_comppad = (AV *) ptr_table_fetch(PL_ptr_table, proto_perl->Icomppad); \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ PL_comppad_name = av_dup(proto_perl->Icomppad_name, param); \ PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \ PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \