X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c82ecf346a8512f22f25188e450d92938c245421..45cc06e3de6c5eed0544072a9b48f21ae63b577b:/inline.h diff --git a/inline.h b/inline.h index 6b24ae5..35983d8 100644 --- a/inline.h +++ b/inline.h @@ -14,7 +14,7 @@ /* ------------------------------- av.h ------------------------------- */ -PERL_STATIC_INLINE I32 +PERL_STATIC_INLINE SSize_t S_av_top_index(pTHX_ AV *av) { PERL_ARGS_ASSERT_AV_TOP_INDEX; @@ -23,21 +23,15 @@ S_av_top_index(pTHX_ AV *av) return AvFILL(av); } -/* ------------------------------- cop.h ------------------------------ */ +/* ------------------------------- cv.h ------------------------------- */ -#ifdef USE_ITHREADS -PERL_STATIC_INLINE void -S_CopFILE_free(pTHX_ COP * const c) +PERL_STATIC_INLINE GV * +S_CvGV(pTHX_ CV *sv) { - GV * const gv = CopFILEGV(c); - if (!gv) return; - if (SvREFCNT(gv) == 1) PL_filegvpad[c->cop_filegvoff] = NULL; - SvREFCNT_dec_NN(gv); - c->cop_filegvoff = 0; + return CvNAMED(sv) + ? Perl_cvgv_from_hek(aTHX_ sv) + : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv; } -#endif - -/* ------------------------------- cv.h ------------------------------- */ PERL_STATIC_INLINE I32 * S_CvDEPTHp(const CV * const sv) @@ -76,6 +70,61 @@ S_strip_spaces(pTHX_ const char * orig, STRLEN * const len) } #endif +/* ------------------------------- mg.h ------------------------------- */ + +#if defined(PERL_CORE) || defined(PERL_EXT) +/* assumes get-magic and stringification have already occurred */ +PERL_STATIC_INLINE STRLEN +S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len) +{ + assert(mg->mg_type == PERL_MAGIC_regex_global); + assert(mg->mg_len != -1); + if (mg->mg_flags & MGf_BYTES || !DO_UTF8(sv)) + return (STRLEN)mg->mg_len; + else { + const STRLEN pos = (STRLEN)mg->mg_len; + /* Without this check, we may read past the end of the buffer: */ + if (pos > sv_or_pv_len_utf8(sv, s, len)) return len+1; + return sv_or_pv_pos_u2b(sv, s, pos, NULL); + } +} +#endif + +/* ------------------------------- pad.h ------------------------------ */ + +#if defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C) +PERL_STATIC_INLINE bool +PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq) +{ + /* is seq within the range _LOW to _HIGH ? + * This is complicated by the fact that PL_cop_seqmax + * may have wrapped around at some point */ + if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO) + return FALSE; /* not yet introduced */ + + if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) { + /* in compiling scope */ + if ( + (seq > COP_SEQ_RANGE_LOW(pn)) + ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1)) + : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1)) + ) + return TRUE; + } + else if ( + (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn)) + ? + ( seq > COP_SEQ_RANGE_LOW(pn) + || seq <= COP_SEQ_RANGE_HIGH(pn)) + + : ( seq > COP_SEQ_RANGE_LOW(pn) + && seq <= COP_SEQ_RANGE_HIGH(pn)) + ) + return TRUE; + return FALSE; +} +#endif + /* ----------------------------- regexp.h ----------------------------- */ PERL_STATIC_INLINE struct regexp * @@ -122,7 +171,6 @@ PERL_STATIC_INLINE void S_SvREFCNT_dec_NN(pTHX_ SV *sv) { U32 rc = SvREFCNT(sv); - PERL_ARGS_ASSERT_SVREFCNT_DEC_NN; if (LIKELY(rc > 1)) SvREFCNT(sv) = rc - 1; else @@ -143,33 +191,22 @@ SvAMAGIC_off(SV *sv) } PERL_STATIC_INLINE U32 -S_SvPADTMP_on(SV *sv) -{ - assert(!(SvFLAGS(sv) & SVs_PADMY)); - return SvFLAGS(sv) |= SVs_PADTMP; -} -PERL_STATIC_INLINE U32 -S_SvPADTMP_off(SV *sv) -{ - assert(!(SvFLAGS(sv) & SVs_PADMY)); - return SvFLAGS(sv) &= ~SVs_PADTMP; -} -PERL_STATIC_INLINE U32 S_SvPADSTALE_on(SV *sv) { - assert(SvFLAGS(sv) & SVs_PADMY); + assert(!(SvFLAGS(sv) & SVs_PADTMP)); return SvFLAGS(sv) |= SVs_PADSTALE; } PERL_STATIC_INLINE U32 S_SvPADSTALE_off(SV *sv) { - assert(SvFLAGS(sv) & SVs_PADMY); + assert(!(SvFLAGS(sv) & SVs_PADTMP)); return SvFLAGS(sv) &= ~SVs_PADSTALE; } -#ifdef PERL_CORE +#if defined(PERL_CORE) || defined (PERL_EXT) PERL_STATIC_INLINE STRLEN S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp) { + PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B; if (SvGAMAGIC(sv)) { U8 *hopped = utf8_hop((U8 *)pv, pos); if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped); @@ -182,36 +219,533 @@ S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp) /* ------------------------------- handy.h ------------------------------- */ /* saves machine code for a common noreturn idiom typically used in Newx*() */ -#ifdef __clang__ -#pragma clang diagnostic push -#pragma clang diagnostic ignored "-Wunused-function" +#ifdef GCC_DIAG_PRAGMA +GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */ #endif static void S_croak_memory_wrap(void) { Perl_croak_nocontext("%s",PL_memory_wrap); } -#ifdef __clang__ -#pragma clang diagnostic pop +#ifdef GCC_DIAG_PRAGMA +GCC_DIAG_RESTORE /* Intentionally left semicolonless. */ #endif /* ------------------------------- utf8.h ------------------------------- */ -/* These exist only to replace the macros they formerly were so that their use - * can be deprecated */ +PERL_STATIC_INLINE void +S_append_utf8_from_native_byte(const U8 byte, U8** dest) +{ + /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8 + * encoded string at '*dest', updating '*dest' to include it */ + + PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE; + + if (NATIVE_BYTE_IS_INVARIANT(byte)) + *(*dest)++ = byte; + else { + *(*dest)++ = UTF8_EIGHT_BIT_HI(byte); + *(*dest)++ = UTF8_EIGHT_BIT_LO(byte); + } +} + +/* + +A helper function for the macro isUTF8_CHAR(), which should be used instead of +this function. The macro will handle smaller code points directly saving time, +using this function as a fall-back for higher code points. + +Tests if the first bytes of string C form a valid UTF-8 character. 0 is +returned if the bytes starting at C up to but not including C do not form a +complete well-formed UTF-8 character; otherwise the number of bytes in the +character is returned. + +Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8 +character. + +=cut */ +PERL_STATIC_INLINE STRLEN +S__is_utf8_char_slow(const U8 *s, const U8 *e) +{ + dTHX; /* The function called below requires thread context */ + + STRLEN actual_len; + + PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW; + + assert(e >= s); + utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY); + + return (actual_len == (STRLEN) -1) ? 0 : actual_len; +} + +/* ------------------------------- perl.h ----------------------------- */ + +/* +=head1 Miscellaneous Functions + +=for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name + +Test that the given C doesn't contain any internal C characters. +If it does, set C to C, optionally warn, and return FALSE. + +Return TRUE if the name is safe. + +Used by the C macro. + +=cut +*/ PERL_STATIC_INLINE bool -S_isIDFIRST_lazy(pTHX_ const char* p) +S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) { + /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs + * perl itself uses xce*() functions which accept 8-bit strings. + */ + + PERL_ARGS_ASSERT_IS_SAFE_SYSCALL; + + if (len > 1) { + char *null_at; + if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) { + SETERRNO(ENOENT, LIB_INVARG); + Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS), + "Invalid \\0 character in %s for %s: %s\\0%s", + what, op_name, pv, null_at+1); + return FALSE; + } + } + + return TRUE; +} + +/* + +Return true if the supplied filename has a newline character +immediately before the first (hopefully only) NUL. + +My original look at this incorrectly used the len from SvPV(), but +that's incorrect, since we allow for a NUL in pv[len-1]. + +So instead, strlen() and work from there. + +This allow for the user reading a filename, forgetting to chomp it, +then calling: + + open my $foo, "$file\0"; + +*/ + +#ifdef PERL_CORE + +PERL_STATIC_INLINE bool +S_should_warn_nl(const char *pv) { + STRLEN len; + + PERL_ARGS_ASSERT_SHOULD_WARN_NL; + + len = strlen(pv); + + return len > 0 && pv[len-1] == '\n'; +} + +#endif + +/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */ + +#define MAX_CHARSET_NAME_LENGTH 2 + +PERL_STATIC_INLINE const char * +get_regex_charset_name(const U32 flags, STRLEN* const lenp) { - PERL_ARGS_ASSERT_ISIDFIRST_LAZY; + /* Returns a string that corresponds to the name of the regex character set + * given by 'flags', and *lenp is set the length of that string, which + * cannot exceed MAX_CHARSET_NAME_LENGTH characters */ - return isIDFIRST_lazy_if(p,1); + *lenp = 1; + switch (get_regex_charset(flags)) { + case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS; + case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS; + case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS; + case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS; + case REGEX_ASCII_MORE_RESTRICTED_CHARSET: + *lenp = 2; + return ASCII_MORE_RESTRICT_PAT_MODS; + } + /* The NOT_REACHED; hides an assert() which has a rather complex + * definition in perl.h. */ + NOT_REACHED; /* NOTREACHED */ + return "?"; /* Unknown */ } +/* + +Return false if any get magic is on the SV other than taint magic. + +*/ + PERL_STATIC_INLINE bool -S_isALNUM_lazy(pTHX_ const char* p) +S_sv_only_taint_gmagic(SV *sv) { + MAGIC *mg = SvMAGIC(sv); + + PERL_ARGS_ASSERT_SV_ONLY_TAINT_GMAGIC; + + while (mg) { + if (mg->mg_type != PERL_MAGIC_taint + && !(mg->mg_flags & MGf_GSKIP) + && mg->mg_virtual->svt_get) { + return FALSE; + } + mg = mg->mg_moremagic; + } + + return TRUE; +} + +/* ------------------ cop.h ------------------------------------------- */ + + +/* Enter a block. Push a new base context and return its address. */ + +PERL_STATIC_INLINE PERL_CONTEXT * +S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix) { - PERL_ARGS_ASSERT_ISALNUM_LAZY; + PERL_CONTEXT * cx; - return isALNUM_lazy_if(p,1); + PERL_ARGS_ASSERT_CX_PUSHBLOCK; + + CXINC; + cx = CX_CUR(); + cx->cx_type = type; + cx->blk_gimme = gimme; + cx->blk_oldsaveix = saveix; + cx->blk_oldsp = (I32)(sp - PL_stack_base); + cx->blk_oldcop = PL_curcop; + cx->blk_oldmarksp = (I32)(PL_markstack_ptr - PL_markstack); + cx->blk_oldscopesp = PL_scopestack_ix; + cx->blk_oldpm = PL_curpm; + cx->blk_old_tmpsfloor = PL_tmps_floor; + + PL_tmps_floor = PL_tmps_ix; + CX_DEBUG(cx, "PUSH"); + return cx; } + + +/* Exit a block (RETURN and LAST). */ + +PERL_STATIC_INLINE void +S_cx_popblock(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_POPBLOCK; + + CX_DEBUG(cx, "POP"); + /* these 3 are common to cx_popblock and cx_topblock */ + PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp; + PL_scopestack_ix = cx->blk_oldscopesp; + PL_curpm = cx->blk_oldpm; + + /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats + * and leaves a CX entry lying around for repeated use, so + * skip for multicall */ \ + assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx)) + || PL_savestack_ix == cx->blk_oldsaveix); + PL_curcop = cx->blk_oldcop; + PL_tmps_floor = cx->blk_old_tmpsfloor; +} + +/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO). + * Whereas cx_popblock() restores the state to the point just before + * cx_pushblock() was called, cx_topblock() restores it to the point just + * *after* cx_pushblock() was called. */ + +PERL_STATIC_INLINE void +S_cx_topblock(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_TOPBLOCK; + + CX_DEBUG(cx, "TOP"); + /* these 3 are common to cx_popblock and cx_topblock */ + PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp; + PL_scopestack_ix = cx->blk_oldscopesp; + PL_curpm = cx->blk_oldpm; + + PL_stack_sp = PL_stack_base + cx->blk_oldsp; +} + + +PERL_STATIC_INLINE void +S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs) +{ + U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub); + + PERL_ARGS_ASSERT_CX_PUSHSUB; + + PERL_DTRACE_PROBE_ENTRY(cv); + cx->blk_sub.cv = cv; + cx->blk_sub.olddepth = CvDEPTH(cv); + cx->blk_sub.prevcomppad = PL_comppad; + cx->cx_type |= (hasargs) ? CXp_HASARGS : 0; + cx->blk_sub.retop = retop; + SvREFCNT_inc_simple_void_NN(cv); + cx->blk_u16 = PL_op->op_private & (phlags|OPpDEREF); +} + + +/* subsets of cx_popsub() */ + +PERL_STATIC_INLINE void +S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx) +{ + CV *cv; + + PERL_ARGS_ASSERT_CX_POPSUB_COMMON; + assert(CxTYPE(cx) == CXt_SUB); + + PL_comppad = cx->blk_sub.prevcomppad; + PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; + cv = cx->blk_sub.cv; + CvDEPTH(cv) = cx->blk_sub.olddepth; + cx->blk_sub.cv = NULL; + SvREFCNT_dec(cv); +} + + +/* handle the @_ part of leaving a sub */ + +PERL_STATIC_INLINE void +S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx) +{ + AV *av; + + PERL_ARGS_ASSERT_CX_POPSUB_ARGS; + assert(CxTYPE(cx) == CXt_SUB); + assert(AvARRAY(MUTABLE_AV( + PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ + CvDEPTH(cx->blk_sub.cv)])) == PL_curpad); + + CX_POP_SAVEARRAY(cx); + av = MUTABLE_AV(PAD_SVl(0)); + if (UNLIKELY(AvREAL(av))) + /* abandon @_ if it got reified */ + clear_defarray(av, 0); + else { + CLEAR_ARGARRAY(av); + } +} + + +PERL_STATIC_INLINE void +S_cx_popsub(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_POPSUB; + assert(CxTYPE(cx) == CXt_SUB); + + PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv); + + if (CxHASARGS(cx)) + cx_popsub_args(cx); + cx_popsub_common(cx); +} + + +PERL_STATIC_INLINE void +S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv) +{ + PERL_ARGS_ASSERT_CX_PUSHFORMAT; + + cx->blk_format.cv = cv; + cx->blk_format.retop = retop; + cx->blk_format.gv = gv; + cx->blk_format.dfoutgv = PL_defoutgv; + cx->blk_format.prevcomppad = PL_comppad; + cx->blk_u16 = 0; + + SvREFCNT_inc_simple_void_NN(cv); + CvDEPTH(cv)++; + SvREFCNT_inc_void(cx->blk_format.dfoutgv); +} + + +PERL_STATIC_INLINE void +S_cx_popformat(pTHX_ PERL_CONTEXT *cx) +{ + CV *cv; + GV *dfout; + + PERL_ARGS_ASSERT_CX_POPFORMAT; + assert(CxTYPE(cx) == CXt_FORMAT); + + dfout = cx->blk_format.dfoutgv; + setdefout(dfout); + cx->blk_format.dfoutgv = NULL; + SvREFCNT_dec_NN(dfout); + + PL_comppad = cx->blk_format.prevcomppad; + PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; + cv = cx->blk_format.cv; + cx->blk_format.cv = NULL; + --CvDEPTH(cv); + SvREFCNT_dec_NN(cv); +} + + +PERL_STATIC_INLINE void +S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv) +{ + PERL_ARGS_ASSERT_CX_PUSHEVAL; + + cx->blk_eval.retop = retop; + cx->blk_eval.old_namesv = namesv; + cx->blk_eval.old_eval_root = PL_eval_root; + cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL; + cx->blk_eval.cv = NULL; /* later set by doeval_compile() */ + cx->blk_eval.cur_top_env = PL_top_env; + + assert(!(PL_in_eval & ~ 0x7F)); + assert(!(PL_op->op_type & ~0x1FF)); + cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7); +} + + +PERL_STATIC_INLINE void +S_cx_popeval(pTHX_ PERL_CONTEXT *cx) +{ + SV *sv; + + PERL_ARGS_ASSERT_CX_POPEVAL; + assert(CxTYPE(cx) == CXt_EVAL); + + PL_in_eval = CxOLD_IN_EVAL(cx); + PL_eval_root = cx->blk_eval.old_eval_root; + sv = cx->blk_eval.cur_text; + if (sv && SvSCREAM(sv)) { + cx->blk_eval.cur_text = NULL; + SvREFCNT_dec_NN(sv); + } + + sv = cx->blk_eval.old_namesv; + if (sv && !SvTEMP(sv))/* TEMP implies cx_popeval() re-entrantly called */ + sv_2mortal(sv); +} + + +/* push a plain loop, i.e. + * { block } + * while (cond) { block } + * for (init;cond;continue) { block } + * This loop can be last/redo'ed etc. + */ + +PERL_STATIC_INLINE void +S_cx_pushloop_plain(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_PUSHLOOP_PLAIN; + cx->blk_loop.my_op = cLOOP; +} + + +/* push a true for loop, i.e. + * for var (list) { block } + */ + +PERL_STATIC_INLINE void +S_cx_pushloop_for(pTHX_ PERL_CONTEXT *cx, void *itervarp, SV* itersave) +{ + PERL_ARGS_ASSERT_CX_PUSHLOOP_FOR; + + /* this one line is common with cx_pushloop_plain */ + cx->blk_loop.my_op = cLOOP; + + cx->blk_loop.itervar_u.svp = (SV**)itervarp; + cx->blk_loop.itersave = itersave; +#ifdef USE_ITHREADS + cx->blk_loop.oldcomppad = PL_comppad; +#endif +} + + +/* pop all loop types, including plain */ + +PERL_STATIC_INLINE void +S_cx_poploop(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_POPLOOP; + + assert(CxTYPE_is_LOOP(cx)); + if ( CxTYPE(cx) == CXt_LOOP_ARY + || CxTYPE(cx) == CXt_LOOP_LAZYSV) + { + /* Free ary or cur. This assumes that state_u.ary.ary + * aligns with state_u.lazysv.cur. See cx_dup() */ + SV *sv = cx->blk_loop.state_u.lazysv.cur; + cx->blk_loop.state_u.lazysv.cur = NULL; + SvREFCNT_dec_NN(sv); + if (CxTYPE(cx) == CXt_LOOP_LAZYSV) { + sv = cx->blk_loop.state_u.lazysv.end; + cx->blk_loop.state_u.lazysv.end = NULL; + SvREFCNT_dec_NN(sv); + } + } + if (cx->cx_type & (CXp_FOR_PAD|CXp_FOR_GV)) { + SV *cursv; + SV **svp = (cx)->blk_loop.itervar_u.svp; + if ((cx->cx_type & CXp_FOR_GV)) + svp = &GvSV((GV*)svp); + cursv = *svp; + *svp = cx->blk_loop.itersave; + cx->blk_loop.itersave = NULL; + SvREFCNT_dec(cursv); + } +} + + +PERL_STATIC_INLINE void +S_cx_pushwhen(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_PUSHWHEN; + + cx->blk_givwhen.leave_op = cLOGOP->op_other; +} + + +PERL_STATIC_INLINE void +S_cx_popwhen(pTHX_ PERL_CONTEXT *cx) +{ + PERL_ARGS_ASSERT_CX_POPWHEN; + assert(CxTYPE(cx) == CXt_WHEN); + + PERL_UNUSED_ARG(cx); + /* currently NOOP */ +} + + +PERL_STATIC_INLINE void +S_cx_pushgiven(pTHX_ PERL_CONTEXT *cx, SV *orig_defsv) +{ + PERL_ARGS_ASSERT_CX_PUSHGIVEN; + + cx->blk_givwhen.leave_op = cLOGOP->op_other; + cx->blk_givwhen.defsv_save = orig_defsv; +} + + +PERL_STATIC_INLINE void +S_cx_popgiven(pTHX_ PERL_CONTEXT *cx) +{ + SV *sv; + + PERL_ARGS_ASSERT_CX_POPGIVEN; + assert(CxTYPE(cx) == CXt_GIVEN); + + sv = GvSV(PL_defgv); + GvSV(PL_defgv) = cx->blk_givwhen.defsv_save; + cx->blk_givwhen.defsv_save = NULL; + SvREFCNT_dec(sv); +} + + + + +/* + * ex: set ts=8 sts=4 sw=4 et: + */