This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
convert CX_PUSHEVAL/POPEVAL to inline fns
[perl5.git] / inline.h
CommitLineData
25468daa
FC
1/* inline.h
2 *
3 * Copyright (C) 2012 by Larry Wall and others
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
8 * This file is a home for static inline functions that cannot go in other
9 * headers files, because they depend on proto.h (included after most other
10 * headers) or struct definitions.
11 *
12 * Each section names the header file that the functions "belong" to.
13 */
27669aa4 14
be3a7a5d
KW
15/* ------------------------------- av.h ------------------------------- */
16
c70927a6 17PERL_STATIC_INLINE SSize_t
be3a7a5d
KW
18S_av_top_index(pTHX_ AV *av)
19{
20 PERL_ARGS_ASSERT_AV_TOP_INDEX;
21 assert(SvTYPE(av) == SVt_PVAV);
22
23 return AvFILL(av);
24}
25
1afe1db1
FC
26/* ------------------------------- cv.h ------------------------------- */
27
ae77754a
FC
28PERL_STATIC_INLINE GV *
29S_CvGV(pTHX_ CV *sv)
30{
31 return CvNAMED(sv)
32 ? Perl_cvgv_from_hek(aTHX_ sv)
33 : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv;
34}
35
1afe1db1
FC
36PERL_STATIC_INLINE I32 *
37S_CvDEPTHp(const CV * const sv)
38{
39 assert(SvTYPE(sv) == SVt_PVCV || SvTYPE(sv) == SVt_PVFM);
8de47657 40 return &((XPVCV*)SvANY(sv))->xcv_depth;
1afe1db1
FC
41}
42
d16269d8
PM
43/*
44 CvPROTO returns the prototype as stored, which is not necessarily what
45 the interpreter should be using. Specifically, the interpreter assumes
46 that spaces have been stripped, which has been the case if the prototype
47 was added by toke.c, but is generally not the case if it was added elsewhere.
48 Since we can't enforce the spacelessness at assignment time, this routine
49 provides a temporary copy at parse time with spaces removed.
50 I<orig> is the start of the original buffer, I<len> is the length of the
51 prototype and will be updated when this returns.
52 */
53
5b67adb8 54#ifdef PERL_CORE
d16269d8
PM
55PERL_STATIC_INLINE char *
56S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
57{
58 SV * tmpsv;
59 char * tmps;
60 tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP);
61 tmps = SvPVX(tmpsv);
62 while ((*len)--) {
63 if (!isSPACE(*orig))
64 *tmps++ = *orig;
65 orig++;
66 }
67 *tmps = '\0';
68 *len = tmps - SvPVX(tmpsv);
69 return SvPVX(tmpsv);
70}
5b67adb8 71#endif
d16269d8 72
25fdce4a
FC
73/* ------------------------------- mg.h ------------------------------- */
74
75#if defined(PERL_CORE) || defined(PERL_EXT)
76/* assumes get-magic and stringification have already occurred */
77PERL_STATIC_INLINE STRLEN
78S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len)
79{
80 assert(mg->mg_type == PERL_MAGIC_regex_global);
81 assert(mg->mg_len != -1);
82 if (mg->mg_flags & MGf_BYTES || !DO_UTF8(sv))
83 return (STRLEN)mg->mg_len;
84 else {
85 const STRLEN pos = (STRLEN)mg->mg_len;
86 /* Without this check, we may read past the end of the buffer: */
87 if (pos > sv_or_pv_len_utf8(sv, s, len)) return len+1;
88 return sv_or_pv_pos_u2b(sv, s, pos, NULL);
89 }
90}
91#endif
92
03414f05
FC
93/* ------------------------------- pad.h ------------------------------ */
94
95#if defined(PERL_IN_PAD_C) || defined(PERL_IN_OP_C)
96PERL_STATIC_INLINE bool
97PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq)
98{
99 /* is seq within the range _LOW to _HIGH ?
100 * This is complicated by the fact that PL_cop_seqmax
101 * may have wrapped around at some point */
102 if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO)
103 return FALSE; /* not yet introduced */
104
105 if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) {
106 /* in compiling scope */
107 if (
108 (seq > COP_SEQ_RANGE_LOW(pn))
109 ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1))
110 : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1))
111 )
112 return TRUE;
113 }
114 else if (
115 (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn))
116 ?
117 ( seq > COP_SEQ_RANGE_LOW(pn)
118 || seq <= COP_SEQ_RANGE_HIGH(pn))
119
120 : ( seq > COP_SEQ_RANGE_LOW(pn)
121 && seq <= COP_SEQ_RANGE_HIGH(pn))
122 )
123 return TRUE;
124 return FALSE;
125}
126#endif
127
8d919b0a
FC
128/* ----------------------------- regexp.h ----------------------------- */
129
130PERL_STATIC_INLINE struct regexp *
131S_ReANY(const REGEXP * const re)
132{
133 assert(isREGEXP(re));
134 return re->sv_u.svu_rx;
135}
136
27669aa4
FC
137/* ------------------------------- sv.h ------------------------------- */
138
139PERL_STATIC_INLINE SV *
140S_SvREFCNT_inc(SV *sv)
141{
2439e033 142 if (LIKELY(sv != NULL))
27669aa4
FC
143 SvREFCNT(sv)++;
144 return sv;
145}
146PERL_STATIC_INLINE SV *
147S_SvREFCNT_inc_NN(SV *sv)
148{
149 SvREFCNT(sv)++;
150 return sv;
151}
152PERL_STATIC_INLINE void
153S_SvREFCNT_inc_void(SV *sv)
154{
2439e033 155 if (LIKELY(sv != NULL))
27669aa4
FC
156 SvREFCNT(sv)++;
157}
75e16a44
FC
158PERL_STATIC_INLINE void
159S_SvREFCNT_dec(pTHX_ SV *sv)
160{
2439e033 161 if (LIKELY(sv != NULL)) {
75a9bf96 162 U32 rc = SvREFCNT(sv);
79e2a32a 163 if (LIKELY(rc > 1))
75a9bf96
DM
164 SvREFCNT(sv) = rc - 1;
165 else
166 Perl_sv_free2(aTHX_ sv, rc);
75e16a44
FC
167 }
168}
541377b1
FC
169
170PERL_STATIC_INLINE void
4a9a56a7
DM
171S_SvREFCNT_dec_NN(pTHX_ SV *sv)
172{
173 U32 rc = SvREFCNT(sv);
79e2a32a 174 if (LIKELY(rc > 1))
4a9a56a7
DM
175 SvREFCNT(sv) = rc - 1;
176 else
177 Perl_sv_free2(aTHX_ sv, rc);
178}
179
180PERL_STATIC_INLINE void
541377b1
FC
181SvAMAGIC_on(SV *sv)
182{
183 assert(SvROK(sv));
184 if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
185}
186PERL_STATIC_INLINE void
187SvAMAGIC_off(SV *sv)
188{
189 if (SvROK(sv) && SvOBJECT(SvRV(sv)))
190 HvAMAGIC_off(SvSTASH(SvRV(sv)));
191}
192
193PERL_STATIC_INLINE U32
541377b1
FC
194S_SvPADSTALE_on(SV *sv)
195{
c0683843 196 assert(!(SvFLAGS(sv) & SVs_PADTMP));
541377b1
FC
197 return SvFLAGS(sv) |= SVs_PADSTALE;
198}
199PERL_STATIC_INLINE U32
200S_SvPADSTALE_off(SV *sv)
201{
c0683843 202 assert(!(SvFLAGS(sv) & SVs_PADTMP));
541377b1
FC
203 return SvFLAGS(sv) &= ~SVs_PADSTALE;
204}
25fdce4a 205#if defined(PERL_CORE) || defined (PERL_EXT)
4ddea69a 206PERL_STATIC_INLINE STRLEN
6964422a 207S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
4ddea69a 208{
25fdce4a 209 PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
4ddea69a
FC
210 if (SvGAMAGIC(sv)) {
211 U8 *hopped = utf8_hop((U8 *)pv, pos);
212 if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
213 return (STRLEN)(hopped - (U8 *)pv);
214 }
215 return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
216}
217#endif
f019c49e 218
d1decf2b
TC
219/* ------------------------------- handy.h ------------------------------- */
220
221/* saves machine code for a common noreturn idiom typically used in Newx*() */
c1d6452f 222#ifdef GCC_DIAG_PRAGMA
6ab56f1e 223GCC_DIAG_IGNORE(-Wunused-function) /* Intentionally left semicolonless. */
c1d6452f 224#endif
d1decf2b
TC
225static void
226S_croak_memory_wrap(void)
227{
228 Perl_croak_nocontext("%s",PL_memory_wrap);
229}
c1d6452f 230#ifdef GCC_DIAG_PRAGMA
6ab56f1e 231GCC_DIAG_RESTORE /* Intentionally left semicolonless. */
c1d6452f 232#endif
d1decf2b 233
a8a2ceaa
KW
234/* ------------------------------- utf8.h ------------------------------- */
235
55d09dc8
KW
236PERL_STATIC_INLINE void
237S_append_utf8_from_native_byte(const U8 byte, U8** dest)
238{
239 /* Takes an input 'byte' (Latin1 or EBCDIC) and appends it to the UTF-8
240 * encoded string at '*dest', updating '*dest' to include it */
241
55d09dc8
KW
242 PERL_ARGS_ASSERT_APPEND_UTF8_FROM_NATIVE_BYTE;
243
6f2d5cbc 244 if (NATIVE_BYTE_IS_INVARIANT(byte))
9ff651ce 245 *(*dest)++ = byte;
55d09dc8 246 else {
9ff651ce
KW
247 *(*dest)++ = UTF8_EIGHT_BIT_HI(byte);
248 *(*dest)++ = UTF8_EIGHT_BIT_LO(byte);
55d09dc8
KW
249 }
250}
251
e123187a 252/*
f2645549 253
6302f837
KW
254A helper function for the macro isUTF8_CHAR(), which should be used instead of
255this function. The macro will handle smaller code points directly saving time,
256using this function as a fall-back for higher code points.
f2645549 257
6302f837
KW
258Tests if the first bytes of string C<s> form a valid UTF-8 character. 0 is
259returned if the bytes starting at C<s> up to but not including C<e> do not form a
260complete well-formed UTF-8 character; otherwise the number of bytes in the
261character is returned.
f2645549 262
6302f837
KW
263Note that an INVARIANT (i.e. ASCII on non-EBCDIC) character is a valid UTF-8
264character.
e123187a
KW
265
266=cut */
267PERL_STATIC_INLINE STRLEN
6302f837 268S__is_utf8_char_slow(const U8 *s, const U8 *e)
e123187a
KW
269{
270 dTHX; /* The function called below requires thread context */
271
272 STRLEN actual_len;
273
274 PERL_ARGS_ASSERT__IS_UTF8_CHAR_SLOW;
275
6302f837
KW
276 assert(e >= s);
277 utf8n_to_uvchr(s, e - s, &actual_len, UTF8_CHECK_ONLY);
e123187a
KW
278
279 return (actual_len == (STRLEN) -1) ? 0 : actual_len;
280}
281
c8028aa6
TC
282/* ------------------------------- perl.h ----------------------------- */
283
284/*
dcccc8ff
KW
285=head1 Miscellaneous Functions
286
41188aa0 287=for apidoc AiR|bool|is_safe_syscall|const char *pv|STRLEN len|const char *what|const char *op_name
c8028aa6 288
6602b933 289Test that the given C<pv> doesn't contain any internal C<NUL> characters.
796b6530 290If it does, set C<errno> to C<ENOENT>, optionally warn, and return FALSE.
c8028aa6
TC
291
292Return TRUE if the name is safe.
293
796b6530 294Used by the C<IS_SAFE_SYSCALL()> macro.
c8028aa6
TC
295
296=cut
297*/
298
299PERL_STATIC_INLINE bool
41188aa0 300S_is_safe_syscall(pTHX_ const char *pv, STRLEN len, const char *what, const char *op_name) {
c8028aa6
TC
301 /* While the Windows CE API provides only UCS-16 (or UTF-16) APIs
302 * perl itself uses xce*() functions which accept 8-bit strings.
303 */
304
305 PERL_ARGS_ASSERT_IS_SAFE_SYSCALL;
306
6c4650b3 307 if (len > 1) {
c8028aa6 308 char *null_at;
41188aa0 309 if (UNLIKELY((null_at = (char *)memchr(pv, 0, len-1)) != NULL)) {
c8028aa6 310 SETERRNO(ENOENT, LIB_INVARG);
1d505182 311 Perl_ck_warner(aTHX_ packWARN(WARN_SYSCALLS),
c8028aa6 312 "Invalid \\0 character in %s for %s: %s\\0%s",
41188aa0 313 what, op_name, pv, null_at+1);
c8028aa6
TC
314 return FALSE;
315 }
316 }
317
318 return TRUE;
319}
320
321/*
7cb3f959
TC
322
323Return true if the supplied filename has a newline character
324immediately before the final NUL.
325
326My original look at this incorrectly used the len from SvPV(), but
327that's incorrect, since we allow for a NUL in pv[len-1].
328
329So instead, strlen() and work from there.
330
331This allow for the user reading a filename, forgetting to chomp it,
332then calling:
333
334 open my $foo, "$file\0";
335
336*/
337
338#ifdef PERL_CORE
339
340PERL_STATIC_INLINE bool
341S_should_warn_nl(const char *pv) {
342 STRLEN len;
343
344 PERL_ARGS_ASSERT_SHOULD_WARN_NL;
345
346 len = strlen(pv);
347
348 return len > 0 && pv[len-1] == '\n';
349}
350
351#endif
352
81d52ecd
JH
353/* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */
354
355#define MAX_CHARSET_NAME_LENGTH 2
356
357PERL_STATIC_INLINE const char *
358get_regex_charset_name(const U32 flags, STRLEN* const lenp)
359{
360 /* Returns a string that corresponds to the name of the regex character set
361 * given by 'flags', and *lenp is set the length of that string, which
362 * cannot exceed MAX_CHARSET_NAME_LENGTH characters */
363
364 *lenp = 1;
365 switch (get_regex_charset(flags)) {
366 case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS;
367 case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS;
368 case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS;
369 case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS;
370 case REGEX_ASCII_MORE_RESTRICTED_CHARSET:
371 *lenp = 2;
372 return ASCII_MORE_RESTRICT_PAT_MODS;
373 }
374 /* The NOT_REACHED; hides an assert() which has a rather complex
375 * definition in perl.h. */
376 NOT_REACHED; /* NOTREACHED */
377 return "?"; /* Unknown */
378}
379
7cb3f959 380/*
ed382232
TC
381
382Return false if any get magic is on the SV other than taint magic.
383
384*/
385
386PERL_STATIC_INLINE bool
387S_sv_only_taint_gmagic(SV *sv) {
388 MAGIC *mg = SvMAGIC(sv);
389
390 PERL_ARGS_ASSERT_SV_ONLY_TAINT_GMAGIC;
391
392 while (mg) {
393 if (mg->mg_type != PERL_MAGIC_taint
394 && !(mg->mg_flags & MGf_GSKIP)
395 && mg->mg_virtual->svt_get) {
396 return FALSE;
397 }
398 mg = mg->mg_moremagic;
399 }
400
401 return TRUE;
402}
403
ed8ff0f3
DM
404/* ------------------ cop.h ------------------------------------------- */
405
406
407/* Enter a block. Push a new base context and return its address. */
408
409PERL_STATIC_INLINE PERL_CONTEXT *
410S_cx_pushblock(pTHX_ U8 type, U8 gimme, SV** sp, I32 saveix)
411{
412 PERL_CONTEXT * cx;
413
414 PERL_ARGS_ASSERT_CX_PUSHBLOCK;
415
416 CXINC;
417 cx = CX_CUR();
418 cx->cx_type = type;
419 cx->blk_gimme = gimme;
420 cx->blk_oldsaveix = saveix;
421 cx->blk_oldsp = sp - PL_stack_base;
422 cx->blk_oldcop = PL_curcop;
423 cx->blk_oldmarksp = PL_markstack_ptr - PL_markstack;
424 cx->blk_oldscopesp = PL_scopestack_ix;
425 cx->blk_oldpm = PL_curpm;
426 cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor;
427
428 PL_tmps_floor = PL_tmps_ix;
429 CX_DEBUG(cx, "PUSH");
430 return cx;
431}
432
433
434/* Exit a block (RETURN and LAST). */
435
436PERL_STATIC_INLINE void
437S_cx_popblock(pTHX_ PERL_CONTEXT *cx)
438{
439 PERL_ARGS_ASSERT_CX_POPBLOCK;
440
441 CX_DEBUG(cx, "POP");
442 /* these 3 are common to cx_popblock and cx_topblock */
443 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
444 PL_scopestack_ix = cx->blk_oldscopesp;
445 PL_curpm = cx->blk_oldpm;
446
447 /* LEAVE_SCOPE() should have made this true. /(?{})/ cheats
448 * and leaves a CX entry lying around for repeated use, so
449 * skip for multicall */ \
450 assert( (CxTYPE(cx) == CXt_SUB && CxMULTICALL(cx))
451 || PL_savestack_ix == cx->blk_oldsaveix);
452 PL_curcop = cx->blk_oldcop;
453 PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
454}
455
456/* Continue a block elsewhere (e.g. NEXT, REDO, GOTO).
457 * Whereas cx_popblock() restores the state to the point just before
458 * cx_pushblock() was called, cx_topblock() restores it to the point just
459 * *after* cx_pushblock() was called. */
460
461PERL_STATIC_INLINE void
462S_cx_topblock(pTHX_ PERL_CONTEXT *cx)
463{
464 PERL_ARGS_ASSERT_CX_TOPBLOCK;
465
466 CX_DEBUG(cx, "TOP");
467 /* these 3 are common to cx_popblock and cx_topblock */
468 PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp;
469 PL_scopestack_ix = cx->blk_oldscopesp;
470 PL_curpm = cx->blk_oldpm;
471
472 PL_stack_sp = PL_stack_base + cx->blk_oldsp;
473}
474
475
a73d8813
DM
476PERL_STATIC_INLINE void
477S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
478{
479 U8 phlags = CX_PUSHSUB_GET_LVALUE_MASK(Perl_was_lvalue_sub);
480
481 PERL_ARGS_ASSERT_CX_PUSHSUB;
482
483 ENTRY_PROBE(CvNAMED(cv)
484 ? HEK_KEY(CvNAME_HEK(cv))
485 : GvENAME(CvGV(cv)),
486 CopFILE((const COP *)CvSTART(cv)),
487 CopLINE((const COP *)CvSTART(cv)),
488 CopSTASHPV((const COP *)CvSTART(cv)));
489 cx->blk_sub.cv = cv;
490 cx->blk_sub.olddepth = CvDEPTH(cv);
491 cx->blk_sub.prevcomppad = PL_comppad;
492 cx->cx_type |= (hasargs) ? CXp_HASARGS : 0;
493 cx->blk_sub.retop = retop;
494 SvREFCNT_inc_simple_void_NN(cv);
495 cx->blk_u16 = PL_op->op_private & (phlags|OPpDEREF);
496}
497
498
499/* subsets of cx_popsub() */
500
501PERL_STATIC_INLINE void
502S_cx_popsub_common(pTHX_ PERL_CONTEXT *cx)
503{
504 CV *cv;
505
506 PERL_ARGS_ASSERT_CX_POPSUB_COMMON;
507 assert(CxTYPE(cx) == CXt_SUB);
508
509 PL_comppad = cx->blk_sub.prevcomppad;
510 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
511 cv = cx->blk_sub.cv;
512 CvDEPTH(cv) = cx->blk_sub.olddepth;
513 cx->blk_sub.cv = NULL;
514 SvREFCNT_dec(cv);
515}
516
517
518/* handle the @_ part of leaving a sub */
519
520PERL_STATIC_INLINE void
521S_cx_popsub_args(pTHX_ PERL_CONTEXT *cx)
522{
523 AV *av;
524
525 PERL_ARGS_ASSERT_CX_POPSUB_ARGS;
526 assert(CxTYPE(cx) == CXt_SUB);
527 assert(AvARRAY(MUTABLE_AV(
528 PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[
529 CvDEPTH(cx->blk_sub.cv)])) == PL_curpad);
530
531 CX_POP_SAVEARRAY(cx);
532 av = MUTABLE_AV(PAD_SVl(0));
533 if (UNLIKELY(AvREAL(av)))
534 /* abandon @_ if it got reified */
535 clear_defarray(av, 0);
536 else {
537 CLEAR_ARGARRAY(av);
538 }
539}
540
541
542PERL_STATIC_INLINE void
543S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
544{
545 PERL_ARGS_ASSERT_CX_POPSUB;
546 assert(CxTYPE(cx) == CXt_SUB);
547
548 RETURN_PROBE(CvNAMED(cx->blk_sub.cv)
549 ? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))
550 : GvENAME(CvGV(cx->blk_sub.cv)),
551 CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
552 CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
553 CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));
554
555 if (CxHASARGS(cx))
556 cx_popsub_args(cx);
557 cx_popsub_common(cx);
558}
559
560
6a7d52cc
DM
561PERL_STATIC_INLINE void
562S_cx_pushformat(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, GV *gv)
563{
564 PERL_ARGS_ASSERT_CX_PUSHFORMAT;
565
566 cx->blk_format.cv = cv;
567 cx->blk_format.retop = retop;
568 cx->blk_format.gv = gv;
569 cx->blk_format.dfoutgv = PL_defoutgv;
570 cx->blk_format.prevcomppad = PL_comppad;
571 cx->blk_u16 = 0;
572
573 SvREFCNT_inc_simple_void_NN(cv);
574 CvDEPTH(cv)++;
575 SvREFCNT_inc_void(cx->blk_format.dfoutgv);
576}
577
578
579PERL_STATIC_INLINE void
580S_cx_popformat(pTHX_ PERL_CONTEXT *cx)
581{
582 CV *cv;
583 GV *dfout;
584
585 PERL_ARGS_ASSERT_CX_POPFORMAT;
586 assert(CxTYPE(cx) == CXt_FORMAT);
587
588 dfout = cx->blk_format.dfoutgv;
589 setdefout(dfout);
590 cx->blk_format.dfoutgv = NULL;
591 SvREFCNT_dec_NN(dfout);
592
593 PL_comppad = cx->blk_format.prevcomppad;
594 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
595 cv = cx->blk_format.cv;
596 cx->blk_format.cv = NULL;
597 --CvDEPTH(cv);
598 SvREFCNT_dec_NN(cv);
599}
600
601
13febba5
DM
602PERL_STATIC_INLINE void
603S_cx_pusheval(pTHX_ PERL_CONTEXT *cx, OP *retop, SV *namesv)
604{
605 PERL_ARGS_ASSERT_CX_PUSHEVAL;
606
607 cx->blk_eval.retop = retop;
608 cx->blk_eval.old_namesv = namesv;
609 cx->blk_eval.old_eval_root = PL_eval_root;
610 cx->blk_eval.cur_text = PL_parser ? PL_parser->linestr : NULL;
611 cx->blk_eval.cv = NULL; /* later set by doeval_compile() */
612 cx->blk_eval.cur_top_env = PL_top_env;
613
614 assert(!(PL_in_eval & ~ 0x7F));
615 assert(!(PL_op->op_type & ~0x1FF));
616 cx->blk_u16 = (PL_in_eval & 0x7F) | ((U16)PL_op->op_type << 7);
617}
618
619
620PERL_STATIC_INLINE void
621S_cx_popeval(pTHX_ PERL_CONTEXT *cx)
622{
623 SV *sv;
624
625 PERL_ARGS_ASSERT_CX_POPEVAL;
626 assert(CxTYPE(cx) == CXt_EVAL);
627
628 PL_in_eval = CxOLD_IN_EVAL(cx);
629 PL_eval_root = cx->blk_eval.old_eval_root;
630 sv = cx->blk_eval.cur_text;
631 if (sv && SvSCREAM(sv)) {
632 cx->blk_eval.cur_text = NULL;
633 SvREFCNT_dec_NN(sv);
634 }
635
636 sv = cx->blk_eval.old_namesv;
637 if (sv && !SvTEMP(sv))/* TEMP implies cx_popeval() re-entrantly called */
638 sv_2mortal(sv);
639}
6a7d52cc 640
a73d8813 641
ed382232 642/*
c8028aa6
TC
643 * ex: set ts=8 sts=4 sw=4 et:
644 */